From 47318dfe180b59f585419c928d6b066d7b09cf9f Mon Sep 17 00:00:00 2001 From: Gergely Polonkai Date: Thu, 21 Apr 2016 23:27:19 +0200 Subject: [PATCH] Upgrade packages --- .gitmodules | 15 - elpa/ag-0.42/ag-pkg.el | 1 - .../ag-autoloads.el | 31 +- elpa/ag-20160321.1606/ag-pkg.el | 1 + elpa/{ag-0.42 => ag-20160321.1606}/ag.el | 276 +- elpa/buffer-move-0.6.1/buffer-move-pkg.el | 1 - .../buffer-move-autoloads.el | 12 +- .../buffer-move-pkg.el | 1 + .../buffer-move.el | 25 +- elpa/company-0.8.12.signed | 1 - elpa/company-0.8.12/.dir-locals.el | 4 - elpa/company-0.8.12/.elpaignore | 5 - elpa/company-0.8.12/ChangeLog | 310 - elpa/company-0.8.12/NEWS.md | 329 - elpa/company-0.8.12/README.md | 4 - elpa/company-0.8.12/company-pkg.el | 2 - elpa/company-0.8.12/company-pysmell.el | 69 - elpa/company-0.8.12/company-ropemacs.el | 72 - elpa/company-0.8.12/test/all.el | 28 - elpa/company-0.8.12/test/async-tests.el | 217 - elpa/company-0.8.12/test/clang-tests.el | 46 - elpa/company-0.8.12/test/core-tests.el | 481 -- elpa/company-0.8.12/test/elisp-tests.el | 190 - elpa/company-0.8.12/test/frontends-tests.el | 332 - elpa/company-0.8.12/test/keywords-tests.el | 32 - elpa/company-0.8.12/test/template-tests.el | 91 - .../company-0.8.12/test/transformers-tests.el | 58 - .../company-abbrev.el | 9 +- .../company-autoloads.el | 148 +- .../company-bbdb.el | 10 +- .../company-capf.el | 36 +- .../company-clang.el | 44 +- .../company-cmake.el | 6 +- .../company-css.el | 10 +- .../company-dabbrev-code.el | 16 +- .../company-dabbrev.el | 83 +- .../company-eclim.el | 16 +- .../company-elisp.el | 6 +- .../company-etags.el | 31 +- .../company-files.el | 63 +- .../company-gtags.el | 7 +- .../company-ispell.el | 20 +- .../company-keywords.el | 39 +- .../company-nxml.el | 4 +- .../company-oddmuse.el | 6 +- elpa/company-20160413.1347/company-pkg.el | 8 + .../company-semantic.el | 61 +- .../company-template.el | 65 +- .../company-tempo.el | 20 +- .../company-xcode.el | 6 +- .../company-yasnippet.el | 69 +- .../company.el | 778 ++- elpa/dash-20160223.1028/dash-pkg.el | 1 - .../dash-autoloads.el | 2 +- elpa/dash-20160306.1222/dash-pkg.el | 1 + .../dash.el | 27 +- elpa/erlang-2.4.1/erlang-pkg.el | 1 - .../erlang-autoloads.el | 31 +- elpa/erlang-20151013.157/erlang-eunit.el | 453 ++ elpa/erlang-20151013.157/erlang-flymake.el | 103 + elpa/erlang-20151013.157/erlang-pkg.el | 4 + elpa/erlang-20151013.157/erlang-skels-old.el | 1268 ++++ elpa/erlang-20151013.157/erlang-skels.el | 1701 +++++ elpa/erlang-20151013.157/erlang-start.el | 124 + .../erlang.el | 3770 ++++++----- elpa/erlang-20151013.157/erlang_appwiz.el | 1345 ++++ elpa/fiplr-0.1.3/fiplr-autoloads.el | 43 - elpa/fiplr-0.1.3/fiplr-pkg.el | 1 - elpa/fiplr-0.1.3/fiplr.el | 243 - elpa/fiplr-20140723.2345/fiplr-autoloads.el | 65 + elpa/fiplr-20140723.2345/fiplr-pkg.el | 6 + elpa/fiplr-20140723.2345/fiplr.el | 346 + elpa/ggtags-20151214.1344/ggtags-autoloads.el | 51 + elpa/ggtags-20151214.1344/ggtags-pkg.el | 1 + elpa/ggtags-20151214.1344/ggtags.el | 2376 +++++++ .../git-commit-20160130.649/git-commit-pkg.el | 1 - .../git-commit-autoloads.el | 9 +- .../git-commit-20160414.251/git-commit-pkg.el | 1 + .../git-commit.el | 20 +- elpa/git-gutter-0.78/git-gutter-pkg.el | 1 - .../git-gutter-autoloads.el | 45 +- .../git-gutter-20160409.713/git-gutter-pkg.el | 1 + .../git-gutter.el | 550 +- elpa/gitconfig-mode-0.3/gitconfig-mode-pkg.el | 1 - elpa/gitconfig-mode-0.3/gitconfig-mode.el | 105 - .../gitconfig-mode-autoloads.el | 6 +- .../gitconfig-mode-pkg.el | 1 + .../gitconfig-mode.el | 137 + .../gitignore-mode-pkg.el | 1 - .../gitignore-mode-autoloads.el | 6 +- .../gitignore-mode-pkg.el | 1 + .../gitignore-mode.el | 6 +- elpa/go-mode-20131222/go-mode-pkg.el | 1 - elpa/go-mode-20131222/go-mode.el | 1166 ---- .../go-mode-autoloads.el | 41 +- elpa/go-mode-20160404.2/go-mode-pkg.el | 5 + elpa/go-mode-20160404.2/go-mode.el | 2069 ++++++ elpa/grizzl-0.1.1/grizzl-core.el | 226 - elpa/grizzl-0.1.1/grizzl-pkg.el | 3 - elpa/grizzl-0.1.1/grizzl-read.el | 186 - elpa/grizzl-0.1.1/grizzl.el | 26 - .../grizzl-autoloads.el | 38 +- elpa/grizzl-20160130.2351/grizzl-pkg.el | 1 + elpa/grizzl-20160130.2351/grizzl.el | 399 ++ .../haml-mode-autoloads.el | 4 +- elpa/haml-mode-20150508.2011/haml-mode-pkg.el | 1 + .../haml-mode.el | 33 +- elpa/haml-mode-3.1.8/haml-mode-pkg.el | 1 - elpa/helm-20160421.621/emacs-helm.sh | 106 + elpa/helm-20160421.621/helm-adaptive.el | 244 + elpa/helm-20160421.621/helm-apt.el | 300 + elpa/helm-20160421.621/helm-autoloads.el | 940 +++ elpa/helm-20160421.621/helm-bookmark.el | 739 +++ elpa/helm-20160421.621/helm-buffers.el | 895 +++ elpa/helm-20160421.621/helm-color.el | 164 + elpa/helm-20160421.621/helm-command.el | 259 + elpa/helm-20160421.621/helm-config.el | 169 + elpa/helm-20160421.621/helm-dabbrev.el | 356 ++ elpa/helm-20160421.621/helm-easymenu.el | 90 + elpa/helm-20160421.621/helm-elisp-package.el | 408 ++ elpa/helm-20160421.621/helm-elisp.el | 913 +++ elpa/helm-20160421.621/helm-elscreen.el | 102 + elpa/helm-20160421.621/helm-eshell.el | 265 + elpa/helm-20160421.621/helm-eval.el | 204 + elpa/helm-20160421.621/helm-external.el | 213 + elpa/helm-20160421.621/helm-files.el | 3548 +++++++++++ elpa/helm-20160421.621/helm-font.el | 201 + elpa/helm-20160421.621/helm-grep.el | 1418 +++++ elpa/helm-20160421.621/helm-help.el | 1493 +++++ elpa/helm-20160421.621/helm-id-utils.el | 133 + elpa/helm-20160421.621/helm-imenu.el | 276 + elpa/helm-20160421.621/helm-info.el | 238 + elpa/helm-20160421.621/helm-locate.el | 391 ++ elpa/helm-20160421.621/helm-man.el | 115 + elpa/helm-20160421.621/helm-misc.el | 334 + elpa/helm-20160421.621/helm-mode.el | 1218 ++++ elpa/helm-20160421.621/helm-multi-match.el | 373 ++ elpa/helm-20160421.621/helm-net.el | 526 ++ elpa/helm-20160421.621/helm-org.el | 319 + elpa/helm-20160421.621/helm-pkg.el | 9 + elpa/helm-20160421.621/helm-plugin.el | 137 + elpa/helm-20160421.621/helm-regexp.el | 646 ++ elpa/helm-20160421.621/helm-ring.el | 470 ++ elpa/helm-20160421.621/helm-semantic.el | 223 + elpa/helm-20160421.621/helm-sys.el | 315 + elpa/helm-20160421.621/helm-tags.el | 341 + elpa/helm-20160421.621/helm-types.el | 280 + elpa/helm-20160421.621/helm-utils.el | 808 +++ .../helm-core-autoloads.el | 202 + elpa/helm-core-20160419.2355/helm-core-pkg.el | 7 + elpa/helm-core-20160419.2355/helm-lib.el | 743 +++ .../helm-multi-match.el | 373 ++ elpa/helm-core-20160419.2355/helm-source.el | 1016 +++ elpa/helm-core-20160419.2355/helm.el | 5549 +++++++++++++++++ .../helm-gtags-autoloads.el | 148 + .../helm-gtags-20160417.555/helm-gtags-pkg.el | 1 + elpa/helm-gtags-20160417.555/helm-gtags.el | 1319 ++++ elpa/jinja2-mode-0.1/jinja2-mode-pkg.el | 1 - .../jinja2-mode-autoloads.el | 4 +- .../jinja2-mode-pkg.el | 1 + .../jinja2-mode.el | 5 +- elpa/js2-mode-20150909/.dir-locals.el | 1 - elpa/js2-mode-20150909/.elpaignore | 4 - elpa/js2-mode-20150909/ChangeLog | 164 - elpa/js2-mode-20150909/LICENSE | 674 -- elpa/js2-mode-20150909/NEWS.md | 219 - elpa/js2-mode-20150909/README.md | 55 - elpa/js2-mode-20150909/js2-mode-pkg.el | 2 - .../js2-imenu-extras.el | 0 .../js2-mode-autoloads.el | 33 +- elpa/js2-mode-20160409.1113/js2-mode-pkg.el | 8 + .../js2-mode.el | 652 +- .../js2-old-indent.el | 257 +- elpa/json-mode-1.2.0/json-mode-pkg.el | 1 - .../json-mode-autoloads.el | 24 +- elpa/json-mode-20151116.2000/json-mode-pkg.el | 1 + .../json-mode.el | 61 +- .../json-reformat-autoloads.el | 26 + .../json-reformat-pkg.el | 1 + .../json-reformat.el | 221 + .../json-snatcher-autoloads.el | 22 + .../json-snatcher-pkg.el | 1 + .../json-snatcher.el | 351 ++ elpa/magit-20160223.828/magit.info | 164 - .../AUTHORS.md | 6 +- .../COPYING | 0 .../dir | 0 .../git-rebase.el | 9 +- .../magit-apply.el | 25 +- .../magit-autoloads.el | 126 +- .../magit-autorevert.el | 0 .../magit-bisect.el | 0 .../magit-blame.el | 0 .../magit-commit.el | 12 +- .../magit-core.el | 0 .../magit-diff.el | 160 +- .../magit-ediff.el | 92 +- .../magit-extras.el | 0 .../magit-git.el | 223 +- .../magit-log.el | 4 +- .../magit-mode.el | 43 +- .../magit-pkg.el | 8 +- .../magit-process.el | 24 +- .../magit-remote.el | 59 +- .../magit-section.el | 16 +- .../magit-sequence.el | 0 .../magit-stash.el | 14 +- .../magit-submodule.el | 108 +- .../magit-utils.el | 9 + .../magit-wip.el | 8 +- .../magit.el | 68 +- elpa/magit-20160421.459/magit.info | 166 + .../magit.info-1 | 278 +- .../magit.info-2 | Bin 22974 -> 23460 bytes .../magit-gerrit-pkg.el | 1 - .../magit-gerrit-autoloads.el | 4 +- .../magit-gerrit-pkg.el | 1 + .../magit-gerrit.el | 13 +- .../magit-gh-pulls-autoloads.el | 4 +- .../magit-gh-pulls-pkg.el | 2 +- .../magit-gh-pulls.el | 25 +- .../dir | 0 .../magit-popup-autoloads.el | 2 +- .../magit-popup-pkg.el | 2 +- .../magit-popup.el | 0 .../magit-popup.info | 18 +- elpa/markdown-mode-2.0/markdown-mode-pkg.el | 1 - .../markdown-mode-autoloads.el | 17 +- .../markdown-mode-pkg.el | 1 + .../markdown-mode.el | 4211 +++++++++---- .../img/nyan-frame-1.xpm | 170 + .../img/nyan-frame-2.xpm | 157 + .../img/nyan-frame-3.xpm | 159 + .../img/nyan-frame-4.xpm | 157 + .../img/nyan-frame-5.xpm | 157 + .../img/nyan-frame-6.xpm | 165 + elpa/nyan-mode-20151017.2235/img/nyan.xpm | 157 + .../img/outerspace.xpm | 142 + elpa/nyan-mode-20151017.2235/img/rainbow.xpm | 42 + .../mus/nyanlooped.mp3 | Bin 0 -> 433006 bytes .../nyan-mode-autoloads.el | 40 + elpa/nyan-mode-20151017.2235/nyan-mode-pkg.el | 5 + elpa/nyan-mode-20151017.2235/nyan-mode.el | 246 + elpa/popup-20160409.2133/popup-autoloads.el | 15 + elpa/popup-20160409.2133/popup-pkg.el | 1 + elpa/popup-20160409.2133/popup.el | 1428 +++++ elpa/s-20160115.58/s-pkg.el | 1 - .../s-autoloads.el | 2 +- elpa/s-20160405.920/s-pkg.el | 1 + elpa/{s-20160115.58 => s-20160405.920}/s.el | 19 +- .../sass-mode-autoloads.el | 13 +- elpa/sass-mode-20150508.2012/sass-mode-pkg.el | 1 + .../sass-mode.el | 41 +- elpa/sass-mode-3.0.16/sass-mode-pkg.el | 1 - elpa/vala-mode-0.1/vala-mode-pkg.el | 1 - .../vala-mode-autoloads.el | 17 +- elpa/vala-mode-20150324.1525/vala-mode-pkg.el | 1 + .../vala-mode.el | 32 +- .../dir | 0 .../with-editor-autoloads.el | 2 +- .../with-editor-pkg.el | 2 +- .../with-editor.el | 0 .../with-editor.info | 11 +- elpa/yaml-mode-0.0.9/yaml-mode-pkg.el | 1 - .../yaml-mode-autoloads.el | 6 +- elpa/yaml-mode-20160220.340/yaml-mode-pkg.el | 1 + .../yaml-mode.el | 182 +- emacs-async | 1 - emacs-helm-gtags | 1 - ggtags | 1 - helm | 1 - init.el | 5 - nyan-mode | 1 - 273 files changed, 52696 insertions(+), 10190 deletions(-) delete mode 100644 elpa/ag-0.42/ag-pkg.el rename elpa/{ag-0.42 => ag-20160321.1606}/ag-autoloads.el (75%) create mode 100644 elpa/ag-20160321.1606/ag-pkg.el rename elpa/{ag-0.42 => ag-20160321.1606}/ag.el (60%) delete mode 100644 elpa/buffer-move-0.6.1/buffer-move-pkg.el rename elpa/{buffer-move-0.6.1 => buffer-move-20160108.708}/buffer-move-autoloads.el (80%) create mode 100644 elpa/buffer-move-20160108.708/buffer-move-pkg.el rename elpa/{buffer-move-0.6.1 => buffer-move-20160108.708}/buffer-move.el (84%) delete mode 100644 elpa/company-0.8.12.signed delete mode 100644 elpa/company-0.8.12/.dir-locals.el delete mode 100644 elpa/company-0.8.12/.elpaignore delete mode 100644 elpa/company-0.8.12/ChangeLog delete mode 100644 elpa/company-0.8.12/NEWS.md delete mode 100644 elpa/company-0.8.12/README.md delete mode 100644 elpa/company-0.8.12/company-pkg.el delete mode 100644 elpa/company-0.8.12/company-pysmell.el delete mode 100644 elpa/company-0.8.12/company-ropemacs.el delete mode 100644 elpa/company-0.8.12/test/all.el delete mode 100644 elpa/company-0.8.12/test/async-tests.el delete mode 100644 elpa/company-0.8.12/test/clang-tests.el delete mode 100644 elpa/company-0.8.12/test/core-tests.el delete mode 100644 elpa/company-0.8.12/test/elisp-tests.el delete mode 100644 elpa/company-0.8.12/test/frontends-tests.el delete mode 100644 elpa/company-0.8.12/test/keywords-tests.el delete mode 100644 elpa/company-0.8.12/test/template-tests.el delete mode 100644 elpa/company-0.8.12/test/transformers-tests.el rename elpa/{company-0.8.12 => company-20160413.1347}/company-abbrev.el (85%) rename elpa/{company-0.8.12 => company-20160413.1347}/company-autoloads.el (63%) rename elpa/{company-0.8.12 => company-20160413.1347}/company-bbdb.el (86%) rename elpa/{company-0.8.12 => company-20160413.1347}/company-capf.el (82%) rename elpa/{company-0.8.12 => company-20160413.1347}/company-clang.el (92%) rename elpa/{company-0.8.12 => company-20160413.1347}/company-cmake.el (97%) rename elpa/{company-0.8.12 => company-20160413.1347}/company-css.el (97%) rename elpa/{company-0.8.12 => company-20160413.1347}/company-dabbrev-code.el (87%) rename elpa/{company-0.8.12 => company-20160413.1347}/company-dabbrev.el (67%) rename elpa/{company-0.8.12 => company-20160413.1347}/company-eclim.el (93%) rename elpa/{company-0.8.12 => company-20160413.1347}/company-elisp.el (97%) rename elpa/{company-0.8.12 => company-20160413.1347}/company-etags.el (74%) rename elpa/{company-0.8.12 => company-20160413.1347}/company-files.el (58%) rename elpa/{company-0.8.12 => company-20160413.1347}/company-gtags.el (95%) rename elpa/{company-0.8.12 => company-20160413.1347}/company-ispell.el (78%) rename elpa/{company-0.8.12 => company-20160413.1347}/company-keywords.el (89%) rename elpa/{company-0.8.12 => company-20160413.1347}/company-nxml.el (97%) rename elpa/{company-0.8.12 => company-20160413.1347}/company-oddmuse.el (91%) create mode 100644 elpa/company-20160413.1347/company-pkg.el rename elpa/{company-0.8.12 => company-20160413.1347}/company-semantic.el (74%) rename elpa/{company-0.8.12 => company-20160413.1347}/company-template.el (76%) rename elpa/{company-0.8.12 => company-20160413.1347}/company-tempo.el (74%) rename elpa/{company-0.8.12 => company-20160413.1347}/company-xcode.el (96%) rename elpa/{company-0.8.12 => company-20160413.1347}/company-yasnippet.el (51%) rename elpa/{company-0.8.12 => company-20160413.1347}/company.el (81%) delete mode 100644 elpa/dash-20160223.1028/dash-pkg.el rename elpa/{dash-20160223.1028 => dash-20160306.1222}/dash-autoloads.el (81%) create mode 100644 elpa/dash-20160306.1222/dash-pkg.el rename elpa/{dash-20160223.1028 => dash-20160306.1222}/dash.el (99%) delete mode 100644 elpa/erlang-2.4.1/erlang-pkg.el rename elpa/{erlang-2.4.1 => erlang-20151013.157}/erlang-autoloads.el (72%) create mode 100644 elpa/erlang-20151013.157/erlang-eunit.el create mode 100644 elpa/erlang-20151013.157/erlang-flymake.el create mode 100644 elpa/erlang-20151013.157/erlang-pkg.el create mode 100644 elpa/erlang-20151013.157/erlang-skels-old.el create mode 100644 elpa/erlang-20151013.157/erlang-skels.el create mode 100644 elpa/erlang-20151013.157/erlang-start.el rename elpa/{erlang-2.4.1 => erlang-20151013.157}/erlang.el (62%) create mode 100644 elpa/erlang-20151013.157/erlang_appwiz.el delete mode 100644 elpa/fiplr-0.1.3/fiplr-autoloads.el delete mode 100644 elpa/fiplr-0.1.3/fiplr-pkg.el delete mode 100644 elpa/fiplr-0.1.3/fiplr.el create mode 100644 elpa/fiplr-20140723.2345/fiplr-autoloads.el create mode 100644 elpa/fiplr-20140723.2345/fiplr-pkg.el create mode 100644 elpa/fiplr-20140723.2345/fiplr.el create mode 100644 elpa/ggtags-20151214.1344/ggtags-autoloads.el create mode 100644 elpa/ggtags-20151214.1344/ggtags-pkg.el create mode 100644 elpa/ggtags-20151214.1344/ggtags.el delete mode 100644 elpa/git-commit-20160130.649/git-commit-pkg.el rename elpa/{git-commit-20160130.649 => git-commit-20160414.251}/git-commit-autoloads.el (85%) create mode 100644 elpa/git-commit-20160414.251/git-commit-pkg.el rename elpa/{git-commit-20160130.649 => git-commit-20160414.251}/git-commit.el (97%) delete mode 100644 elpa/git-gutter-0.78/git-gutter-pkg.el rename elpa/{git-gutter-0.78 => git-gutter-20160409.713}/git-gutter-autoloads.el (61%) create mode 100644 elpa/git-gutter-20160409.713/git-gutter-pkg.el rename elpa/{git-gutter-0.78 => git-gutter-20160409.713}/git-gutter.el (64%) delete mode 100644 elpa/gitconfig-mode-0.3/gitconfig-mode-pkg.el delete mode 100644 elpa/gitconfig-mode-0.3/gitconfig-mode.el rename elpa/{gitconfig-mode-0.3 => gitconfig-mode-20160319.302}/gitconfig-mode-autoloads.el (60%) create mode 100644 elpa/gitconfig-mode-20160319.302/gitconfig-mode-pkg.el create mode 100644 elpa/gitconfig-mode-20160319.302/gitconfig-mode.el delete mode 100644 elpa/gitignore-mode-1.1.0/gitignore-mode-pkg.el rename elpa/{gitignore-mode-1.1.0 => gitignore-mode-20160319.302}/gitignore-mode-autoloads.el (65%) create mode 100644 elpa/gitignore-mode-20160319.302/gitignore-mode-pkg.el rename elpa/{gitignore-mode-1.1.0 => gitignore-mode-20160319.302}/gitignore-mode.el (94%) delete mode 100644 elpa/go-mode-20131222/go-mode-pkg.el delete mode 100644 elpa/go-mode-20131222/go-mode.el rename elpa/{go-mode-20131222 => go-mode-20160404.2}/go-mode-autoloads.el (70%) create mode 100644 elpa/go-mode-20160404.2/go-mode-pkg.el create mode 100644 elpa/go-mode-20160404.2/go-mode.el delete mode 100644 elpa/grizzl-0.1.1/grizzl-core.el delete mode 100644 elpa/grizzl-0.1.1/grizzl-pkg.el delete mode 100644 elpa/grizzl-0.1.1/grizzl-read.el delete mode 100644 elpa/grizzl-0.1.1/grizzl.el rename elpa/{grizzl-0.1.1 => grizzl-20160130.2351}/grizzl-autoloads.el (61%) create mode 100644 elpa/grizzl-20160130.2351/grizzl-pkg.el create mode 100644 elpa/grizzl-20160130.2351/grizzl.el rename elpa/{haml-mode-3.1.8 => haml-mode-20150508.2011}/haml-mode-autoloads.el (85%) create mode 100644 elpa/haml-mode-20150508.2011/haml-mode-pkg.el rename elpa/{haml-mode-3.1.8 => haml-mode-20150508.2011}/haml-mode.el (97%) delete mode 100644 elpa/haml-mode-3.1.8/haml-mode-pkg.el create mode 100755 elpa/helm-20160421.621/emacs-helm.sh create mode 100644 elpa/helm-20160421.621/helm-adaptive.el create mode 100644 elpa/helm-20160421.621/helm-apt.el create mode 100644 elpa/helm-20160421.621/helm-autoloads.el create mode 100644 elpa/helm-20160421.621/helm-bookmark.el create mode 100644 elpa/helm-20160421.621/helm-buffers.el create mode 100644 elpa/helm-20160421.621/helm-color.el create mode 100644 elpa/helm-20160421.621/helm-command.el create mode 100644 elpa/helm-20160421.621/helm-config.el create mode 100644 elpa/helm-20160421.621/helm-dabbrev.el create mode 100644 elpa/helm-20160421.621/helm-easymenu.el create mode 100644 elpa/helm-20160421.621/helm-elisp-package.el create mode 100644 elpa/helm-20160421.621/helm-elisp.el create mode 100644 elpa/helm-20160421.621/helm-elscreen.el create mode 100644 elpa/helm-20160421.621/helm-eshell.el create mode 100644 elpa/helm-20160421.621/helm-eval.el create mode 100644 elpa/helm-20160421.621/helm-external.el create mode 100644 elpa/helm-20160421.621/helm-files.el create mode 100644 elpa/helm-20160421.621/helm-font.el create mode 100644 elpa/helm-20160421.621/helm-grep.el create mode 100644 elpa/helm-20160421.621/helm-help.el create mode 100644 elpa/helm-20160421.621/helm-id-utils.el create mode 100644 elpa/helm-20160421.621/helm-imenu.el create mode 100644 elpa/helm-20160421.621/helm-info.el create mode 100644 elpa/helm-20160421.621/helm-locate.el create mode 100644 elpa/helm-20160421.621/helm-man.el create mode 100644 elpa/helm-20160421.621/helm-misc.el create mode 100644 elpa/helm-20160421.621/helm-mode.el create mode 100644 elpa/helm-20160421.621/helm-multi-match.el create mode 100644 elpa/helm-20160421.621/helm-net.el create mode 100644 elpa/helm-20160421.621/helm-org.el create mode 100644 elpa/helm-20160421.621/helm-pkg.el create mode 100644 elpa/helm-20160421.621/helm-plugin.el create mode 100644 elpa/helm-20160421.621/helm-regexp.el create mode 100644 elpa/helm-20160421.621/helm-ring.el create mode 100644 elpa/helm-20160421.621/helm-semantic.el create mode 100644 elpa/helm-20160421.621/helm-sys.el create mode 100644 elpa/helm-20160421.621/helm-tags.el create mode 100644 elpa/helm-20160421.621/helm-types.el create mode 100644 elpa/helm-20160421.621/helm-utils.el create mode 100644 elpa/helm-core-20160419.2355/helm-core-autoloads.el create mode 100644 elpa/helm-core-20160419.2355/helm-core-pkg.el create mode 100644 elpa/helm-core-20160419.2355/helm-lib.el create mode 100644 elpa/helm-core-20160419.2355/helm-multi-match.el create mode 100644 elpa/helm-core-20160419.2355/helm-source.el create mode 100644 elpa/helm-core-20160419.2355/helm.el create mode 100644 elpa/helm-gtags-20160417.555/helm-gtags-autoloads.el create mode 100644 elpa/helm-gtags-20160417.555/helm-gtags-pkg.el create mode 100644 elpa/helm-gtags-20160417.555/helm-gtags.el delete mode 100644 elpa/jinja2-mode-0.1/jinja2-mode-pkg.el rename elpa/{jinja2-mode-0.1 => jinja2-mode-20141128.207}/jinja2-mode-autoloads.el (84%) create mode 100644 elpa/jinja2-mode-20141128.207/jinja2-mode-pkg.el rename elpa/{jinja2-mode-0.1 => jinja2-mode-20141128.207}/jinja2-mode.el (99%) delete mode 100644 elpa/js2-mode-20150909/.dir-locals.el delete mode 100644 elpa/js2-mode-20150909/.elpaignore delete mode 100644 elpa/js2-mode-20150909/ChangeLog delete mode 100644 elpa/js2-mode-20150909/LICENSE delete mode 100644 elpa/js2-mode-20150909/NEWS.md delete mode 100644 elpa/js2-mode-20150909/README.md delete mode 100644 elpa/js2-mode-20150909/js2-mode-pkg.el rename elpa/{js2-mode-20150909 => js2-mode-20160409.1113}/js2-imenu-extras.el (100%) rename elpa/{js2-mode-20150909 => js2-mode-20160409.1113}/js2-mode-autoloads.el (64%) create mode 100644 elpa/js2-mode-20160409.1113/js2-mode-pkg.el rename elpa/{js2-mode-20150909 => js2-mode-20160409.1113}/js2-mode.el (96%) rename elpa/{js2-mode-20150909 => js2-mode-20160409.1113}/js2-old-indent.el (67%) delete mode 100644 elpa/json-mode-1.2.0/json-mode-pkg.el rename elpa/{json-mode-1.2.0 => json-mode-20151116.2000}/json-mode-autoloads.el (63%) create mode 100644 elpa/json-mode-20151116.2000/json-mode-pkg.el rename elpa/{json-mode-1.2.0 => json-mode-20151116.2000}/json-mode.el (61%) create mode 100644 elpa/json-reformat-20160212.53/json-reformat-autoloads.el create mode 100644 elpa/json-reformat-20160212.53/json-reformat-pkg.el create mode 100644 elpa/json-reformat-20160212.53/json-reformat.el create mode 100644 elpa/json-snatcher-20150511.2047/json-snatcher-autoloads.el create mode 100644 elpa/json-snatcher-20150511.2047/json-snatcher-pkg.el create mode 100644 elpa/json-snatcher-20150511.2047/json-snatcher.el delete mode 100644 elpa/magit-20160223.828/magit.info rename elpa/{magit-20160223.828 => magit-20160421.459}/AUTHORS.md (97%) rename elpa/{magit-20160223.828 => magit-20160421.459}/COPYING (100%) rename elpa/{magit-20160223.828 => magit-20160421.459}/dir (100%) rename elpa/{magit-20160223.828 => magit-20160421.459}/git-rebase.el (98%) rename elpa/{magit-20160223.828 => magit-20160421.459}/magit-apply.el (96%) rename elpa/{magit-20160223.828 => magit-20160421.459}/magit-autoloads.el (94%) rename elpa/{magit-20160223.828 => magit-20160421.459}/magit-autorevert.el (100%) rename elpa/{magit-20160223.828 => magit-20160421.459}/magit-bisect.el (100%) rename elpa/{magit-20160223.828 => magit-20160421.459}/magit-blame.el (100%) rename elpa/{magit-20160223.828 => magit-20160421.459}/magit-commit.el (97%) rename elpa/{magit-20160223.828 => magit-20160421.459}/magit-core.el (100%) rename elpa/{magit-20160223.828 => magit-20160421.459}/magit-diff.el (94%) rename elpa/{magit-20160223.828 => magit-20160421.459}/magit-ediff.el (83%) rename elpa/{magit-20160223.828 => magit-20160421.459}/magit-extras.el (100%) rename elpa/{magit-20160223.828 => magit-20160421.459}/magit-git.el (88%) rename elpa/{magit-20160223.828 => magit-20160421.459}/magit-log.el (99%) rename elpa/{magit-20160223.828 => magit-20160421.459}/magit-mode.el (96%) rename elpa/{magit-20160223.828 => magit-20160421.459}/magit-pkg.el (55%) rename elpa/{magit-20160223.828 => magit-20160421.459}/magit-process.el (97%) rename elpa/{magit-20160223.828 => magit-20160421.459}/magit-remote.el (93%) rename elpa/{magit-20160223.828 => magit-20160421.459}/magit-section.el (98%) rename elpa/{magit-20160223.828 => magit-20160421.459}/magit-sequence.el (100%) rename elpa/{magit-20160223.828 => magit-20160421.459}/magit-stash.el (97%) rename elpa/{magit-20160223.828 => magit-20160421.459}/magit-submodule.el (62%) rename elpa/{magit-20160223.828 => magit-20160421.459}/magit-utils.el (98%) rename elpa/{magit-20160223.828 => magit-20160421.459}/magit-wip.el (97%) rename elpa/{magit-20160223.828 => magit-20160421.459}/magit.el (98%) create mode 100644 elpa/magit-20160421.459/magit.info rename elpa/{magit-20160223.828 => magit-20160421.459}/magit.info-1 (97%) rename elpa/{magit-20160223.828 => magit-20160421.459}/magit.info-2 (97%) delete mode 100644 elpa/magit-gerrit-20160128.1926/magit-gerrit-pkg.el rename elpa/{magit-gerrit-20160128.1926 => magit-gerrit-20160226.130}/magit-gerrit-autoloads.el (78%) create mode 100644 elpa/magit-gerrit-20160226.130/magit-gerrit-pkg.el rename elpa/{magit-gerrit-20160128.1926 => magit-gerrit-20160226.130}/magit-gerrit.el (98%) rename elpa/{magit-gh-pulls-20160222.1802 => magit-gh-pulls-20160413.1451}/magit-gh-pulls-autoloads.el (85%) rename elpa/{magit-gh-pulls-20160222.1802 => magit-gh-pulls-20160413.1451}/magit-gh-pulls-pkg.el (73%) rename elpa/{magit-gh-pulls-20160222.1802 => magit-gh-pulls-20160413.1451}/magit-gh-pulls.el (97%) rename elpa/{magit-popup-20160130.649 => magit-popup-20160414.251}/dir (100%) rename elpa/{magit-popup-20160130.649 => magit-popup-20160414.251}/magit-popup-autoloads.el (90%) rename elpa/{magit-popup-20160130.649 => magit-popup-20160414.251}/magit-popup-pkg.el (77%) rename elpa/{magit-popup-20160130.649 => magit-popup-20160414.251}/magit-popup.el (100%) rename elpa/{magit-popup-20160130.649 => magit-popup-20160414.251}/magit-popup.info (99%) delete mode 100644 elpa/markdown-mode-2.0/markdown-mode-pkg.el rename elpa/{markdown-mode-2.0 => markdown-mode-20160409.650}/markdown-mode-autoloads.el (62%) create mode 100644 elpa/markdown-mode-20160409.650/markdown-mode-pkg.el rename elpa/{markdown-mode-2.0 => markdown-mode-20160409.650}/markdown-mode.el (53%) create mode 100644 elpa/nyan-mode-20151017.2235/img/nyan-frame-1.xpm create mode 100644 elpa/nyan-mode-20151017.2235/img/nyan-frame-2.xpm create mode 100644 elpa/nyan-mode-20151017.2235/img/nyan-frame-3.xpm create mode 100644 elpa/nyan-mode-20151017.2235/img/nyan-frame-4.xpm create mode 100644 elpa/nyan-mode-20151017.2235/img/nyan-frame-5.xpm create mode 100644 elpa/nyan-mode-20151017.2235/img/nyan-frame-6.xpm create mode 100644 elpa/nyan-mode-20151017.2235/img/nyan.xpm create mode 100644 elpa/nyan-mode-20151017.2235/img/outerspace.xpm create mode 100644 elpa/nyan-mode-20151017.2235/img/rainbow.xpm create mode 100644 elpa/nyan-mode-20151017.2235/mus/nyanlooped.mp3 create mode 100644 elpa/nyan-mode-20151017.2235/nyan-mode-autoloads.el create mode 100644 elpa/nyan-mode-20151017.2235/nyan-mode-pkg.el create mode 100644 elpa/nyan-mode-20151017.2235/nyan-mode.el create mode 100644 elpa/popup-20160409.2133/popup-autoloads.el create mode 100644 elpa/popup-20160409.2133/popup-pkg.el create mode 100644 elpa/popup-20160409.2133/popup.el delete mode 100644 elpa/s-20160115.58/s-pkg.el rename elpa/{s-20160115.58 => s-20160405.920}/s-autoloads.el (81%) create mode 100644 elpa/s-20160405.920/s-pkg.el rename elpa/{s-20160115.58 => s-20160405.920}/s.el (98%) rename elpa/{sass-mode-3.0.16 => sass-mode-20150508.2012}/sass-mode-autoloads.el (65%) create mode 100644 elpa/sass-mode-20150508.2012/sass-mode-pkg.el rename elpa/{sass-mode-3.0.16 => sass-mode-20150508.2012}/sass-mode.el (88%) delete mode 100644 elpa/sass-mode-3.0.16/sass-mode-pkg.el delete mode 100644 elpa/vala-mode-0.1/vala-mode-pkg.el rename elpa/{vala-mode-0.1 => vala-mode-20150324.1525}/vala-mode-autoloads.el (69%) create mode 100644 elpa/vala-mode-20150324.1525/vala-mode-pkg.el rename elpa/{vala-mode-0.1 => vala-mode-20150324.1525}/vala-mode.el (94%) rename elpa/{with-editor-20160223.1155 => with-editor-20160408.201}/dir (100%) rename elpa/{with-editor-20160223.1155 => with-editor-20160408.201}/with-editor-autoloads.el (90%) rename elpa/{with-editor-20160223.1155 => with-editor-20160408.201}/with-editor-pkg.el (69%) rename elpa/{with-editor-20160223.1155 => with-editor-20160408.201}/with-editor.el (100%) rename elpa/{with-editor-20160223.1155 => with-editor-20160408.201}/with-editor.info (98%) delete mode 100644 elpa/yaml-mode-0.0.9/yaml-mode-pkg.el rename elpa/{yaml-mode-0.0.9 => yaml-mode-20160220.340}/yaml-mode-autoloads.el (79%) create mode 100644 elpa/yaml-mode-20160220.340/yaml-mode-pkg.el rename elpa/{yaml-mode-0.0.9 => yaml-mode-20160220.340}/yaml-mode.el (73%) delete mode 160000 emacs-async delete mode 160000 emacs-helm-gtags delete mode 160000 ggtags delete mode 160000 helm delete mode 160000 nyan-mode diff --git a/.gitmodules b/.gitmodules index 4477c81..c94277c 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,21 +1,6 @@ -[submodule "nyan-mode"] - path = nyan-mode - url = git://github.com/TeMPOraL/nyan-mode.git -[submodule "helm"] - path = helm - url = git://github.com/emacs-helm/helm.git -[submodule "emacs-async"] - path = emacs-async - url = git://github.com/jwiegley/emacs-async.git [submodule "gobgen"] path = gobgen url = git://github.com/gergelypolonkai/gobgen.el.git -[submodule "emacs-helm-gtags"] - path = emacs-helm-gtags - url = git://github.com/syohex/emacs-helm-gtags.git [submodule "move-line"] path = move-line url = git://github.com/nflath/move-line.git -[submodule "ggtags"] - path = ggtags - url = https://github.com/leoliu/ggtags.git diff --git a/elpa/ag-0.42/ag-pkg.el b/elpa/ag-0.42/ag-pkg.el deleted file mode 100644 index 2242b1d..0000000 --- a/elpa/ag-0.42/ag-pkg.el +++ /dev/null @@ -1 +0,0 @@ -(define-package "ag" "0.42" "A front-end for ag ('the silver searcher'), the C ack replacement." (quote nil)) diff --git a/elpa/ag-0.42/ag-autoloads.el b/elpa/ag-20160321.1606/ag-autoloads.el similarity index 75% rename from elpa/ag-0.42/ag-autoloads.el rename to elpa/ag-20160321.1606/ag-autoloads.el index 27f8e90..2e7e6ec 100644 --- a/elpa/ag-0.42/ag-autoloads.el +++ b/elpa/ag-20160321.1606/ag-autoloads.el @@ -1,12 +1,9 @@ ;;; ag-autoloads.el --- automatically extracted autoloads ;; ;;; Code: - +(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) -;;;### (autoloads (ag-kill-other-buffers ag-kill-buffers ag-project-dired-regexp -;;;;;; ag-project-dired ag-dired-regexp ag-dired ag-project-regexp -;;;;;; ag-project-files ag-project ag-regexp ag-files ag) "ag" "ag.el" -;;;;;; (21529 49183 36687 867000)) +;;;### (autoloads nil "ag" "ag.el" (22297 19677 174516 738000)) ;;; Generated autoloads from ag.el (autoload 'ag "ag" "\ @@ -18,12 +15,13 @@ If called with a prefix, prompts for flags to pass to ag. \(fn STRING DIRECTORY)" t nil) (autoload 'ag-files "ag" "\ -Search using ag in a given DIRECTORY and file type regex FILE-REGEX -for a given search STRING, with STRING defaulting to the symbol under point. +Search using ag in a given DIRECTORY for a given search STRING, +limited to files that match FILE-TYPE. STRING defaults to +the symbol under point. If called with a prefix, prompts for flags to pass to ag. -\(fn STRING FILE-REGEX DIRECTORY)" t nil) +\(fn STRING FILE-TYPE DIRECTORY)" t nil) (autoload 'ag-regexp "ag" "\ Search using ag in a given directory for a given regexp. @@ -42,12 +40,13 @@ If called with a prefix, prompts for flags to pass to ag. \(fn STRING)" t nil) (autoload 'ag-project-files "ag" "\ -Search using ag in a given DIRECTORY and file type regex FILE-REGEX -for a given search STRING, with STRING defaulting to the symbol under point. +Search using ag for a given search STRING, +limited to files that match FILE-TYPE. STRING defaults to the +symbol under point. If called with a prefix, prompts for flags to pass to ag. -\(fn STRING FILE-REGEX)" t nil) +\(fn STRING FILE-TYPE)" t nil) (autoload 'ag-project-regexp "ag" "\ Guess the root of the current project and search it with ag @@ -104,26 +103,20 @@ See also `ag-dired-regexp'. \(fn REGEXP)" t nil) (autoload 'ag-kill-buffers "ag" "\ -Kill all ag-mode buffers. +Kill all `ag-mode' buffers. \(fn)" t nil) (autoload 'ag-kill-other-buffers "ag" "\ -Kill all ag-mode buffers other than the current buffer. +Kill all `ag-mode' buffers other than the current buffer. \(fn)" t nil) ;;;*** -;;;### (autoloads nil nil ("ag-pkg.el") (21529 49183 172114 552000)) - -;;;*** - -(provide 'ag-autoloads) ;; Local Variables: ;; version-control: never ;; no-byte-compile: t ;; no-update-autoloads: t -;; coding: utf-8 ;; End: ;;; ag-autoloads.el ends here diff --git a/elpa/ag-20160321.1606/ag-pkg.el b/elpa/ag-20160321.1606/ag-pkg.el new file mode 100644 index 0000000..5865126 --- /dev/null +++ b/elpa/ag-20160321.1606/ag-pkg.el @@ -0,0 +1 @@ +(define-package "ag" "20160321.1606" "A front-end for ag ('the silver searcher'), the C ack replacement." '((dash "2.8.0") (s "1.9.0") (cl-lib "0.5"))) diff --git a/elpa/ag-0.42/ag.el b/elpa/ag-20160321.1606/ag.el similarity index 60% rename from elpa/ag-0.42/ag.el rename to elpa/ag-20160321.1606/ag.el index 229b5ad..ae7b661 100644 --- a/elpa/ag-0.42/ag.el +++ b/elpa/ag-20160321.1606/ag.el @@ -4,8 +4,9 @@ ;; ;; Author: Wilfred Hughes ;; Created: 11 January 2013 -;; Version: 0.42 - +;; Version: 0.48 +;; Package-Version: 20160321.1606 +;; Package-Requires: ((dash "2.8.0") (s "1.9.0") (cl-lib "0.5")) ;;; Commentary: ;; Please see README.md for documentation, or read it online at @@ -32,8 +33,11 @@ ;; Boston, MA 02110-1301, USA. ;;; Code: -(eval-when-compile (require 'cl)) ;; dolist, defun*, flet +(require 'cl-lib) ;; cl-letf, cl-defun (require 'dired) ;; dired-sort-inhibit +(require 'dash) +(require 's) +(require 'find-dired) ;; find-dired-filter (defcustom ag-executable "ag" @@ -42,8 +46,14 @@ :group 'ag) (defcustom ag-arguments - (list "--smart-case" "--nogroup" "--column" "--") - "Default arguments passed to ag." + (list "--line-number" "--smart-case" "--nogroup" "--column" "--stats" "--") + "Default arguments passed to ag. + +Ag.el requires --nogroup and --column, so we recommend you add any +additional arguments to the start of this list. + +--line-number is required on Windows, as otherwise ag will not +print line numbers when the input is a stream." :type '(repeat (string)) :group 'ag) @@ -79,6 +89,11 @@ If set to nil, fall back to finding VCS root directories." (function :tag "Function")) :group 'ag) +(defcustom ag-ignore-list nil + "A list of patterns to ignore when searching." + :type '(repeat (string)) + :group 'ag) + (require 'compile) ;; Although ag results aren't exactly errors, we treat them as errors @@ -93,65 +108,120 @@ If set to nil, fall back to finding VCS root directories." "Face name to use for ag matches." :group 'ag) +(defvar ag-search-finished-hook nil + "Hook run when ag completes a search in a buffer.") + +(defun ag/run-finished-hook (buffer how-finished) + "Run the ag hook to signal that the search has completed." + (with-current-buffer buffer + (run-hooks 'ag-search-finished-hook))) + +(defmacro ag/with-patch-function (fun-name fun-args fun-body &rest body) + "Temporarily override the definition of FUN-NAME whilst BODY is executed. + +Assumes FUNCTION is already defined (see http://emacs.stackexchange.com/a/3452/304)." + `(cl-letf (((symbol-function ,fun-name) + (lambda ,fun-args ,fun-body))) + ,@body)) + (defun ag/next-error-function (n &optional reset) "Open the search result at point in the current window or a -different window, according to `ag-open-in-other-window'." +different window, according to `ag-reuse-window'." (if ag-reuse-window ;; prevent changing the window - (flet ((pop-to-buffer (buffer &rest args) - (switch-to-buffer buffer))) - (compilation-next-error-function n reset)) + (ag/with-patch-function + 'pop-to-buffer (buffer &rest args) (switch-to-buffer buffer) + (compilation-next-error-function n reset)) + ;; just navigate to the results as normal (compilation-next-error-function n reset))) +;; Note that we want to use as tight a regexp as we can to try and +;; handle weird file names (with colons in them) as well as possible. +;; E.g. we use [1-9][0-9]* rather than [0-9]+ so as to accept ":034:" +;; in file names. +(defvar ag/file-column-pattern + "^\\(.+?\\):\\([1-9][0-9]*\\):\\([1-9][0-9]*\\):" + "A regexp pattern that groups output into filename, line number and column number.") + (define-compilation-mode ag-mode "Ag" "Ag results compilation mode" - (let ((smbl 'compilation-ag-nogroup) - ;; Note that we want to use as tight a regexp as we can to try and - ;; handle weird file names (with colons in them) as well as possible. - ;; E.g. we use [1-9][0-9]* rather than [0-9]+ so as to accept ":034:" - ;; in file names. - (pttrn '("^\\([^:\n]+?\\):\\([1-9][0-9]*\\):\\([1-9][0-9]*\\):" 1 2 3))) - (set (make-local-variable 'compilation-error-regexp-alist) (list smbl)) - (set (make-local-variable 'compilation-error-regexp-alist-alist) (list (cons smbl pttrn)))) + (set (make-local-variable 'compilation-error-regexp-alist) + (list 'compilation-ag-nogroup)) + (set (make-local-variable 'compilation-error-regexp-alist-alist) + (list (cons 'compilation-ag-nogroup (list ag/file-column-pattern 1 2 3)))) (set (make-local-variable 'compilation-error-face) 'ag-hit-face) - (set (make-local-variable 'next-error-function) 'ag/next-error-function) + (set (make-local-variable 'next-error-function) #'ag/next-error-function) + (set (make-local-variable 'compilation-finish-functions) + #'ag/run-finished-hook) (add-hook 'compilation-filter-hook 'ag-filter nil t)) -(define-key ag-mode-map (kbd "p") 'compilation-previous-error) -(define-key ag-mode-map (kbd "n") 'compilation-next-error) +(define-key ag-mode-map (kbd "p") #'compilation-previous-error) +(define-key ag-mode-map (kbd "n") #'compilation-next-error) +(define-key ag-mode-map (kbd "k") '(lambda () (interactive) + (let (kill-buffer-query-functions) (kill-buffer)))) (defun ag/buffer-name (search-string directory regexp) + "Return a buffer name formatted according to ag.el conventions." (cond (ag-reuse-buffers "*ag search*") (regexp (format "*ag search regexp:%s dir:%s*" search-string directory)) (:else (format "*ag search text:%s dir:%s*" search-string directory)))) -(defun* ag/search (string directory - &key (regexp nil) (file-regex nil)) +(defun ag/format-ignore (ignores) + "Prepend '--ignore' to every item in IGNORES." + (apply #'append + (mapcar (lambda (item) (list "--ignore" item)) ignores))) + +(cl-defun ag/search (string directory + &key (regexp nil) (file-regex nil) (file-type nil)) "Run ag searching for the STRING given in DIRECTORY. If REGEXP is non-nil, treat STRING as a regular expression." (let ((default-directory (file-name-as-directory directory)) (arguments ag-arguments) (shell-command-switch "-c")) (unless regexp - (setq arguments (cons "--literal" arguments))) + (setq arguments (cons "--literal" arguments))) (if ag-highlight-search + ;; We're highlighting, so pass additional arguments for + ;; highlighting the current search term using shell escape + ;; sequences. (setq arguments (append '("--color" "--color-match" "30;43") arguments)) - (setq arguments (append '("--nocolor") arguments))) + ;; We're not highlighting. + (if (eq system-type 'windows-nt) + ;; Use --vimgrep to work around issue #97 on Windows. + (setq arguments (append '("--vimgrep") arguments)) + (setq arguments (append '("--nocolor") arguments)))) (when (char-or-string-p file-regex) (setq arguments (append `("--file-search-regex" ,file-regex) arguments))) + (when file-type + (setq arguments (cons (format "--%s" file-type) arguments))) + (when (integerp current-prefix-arg) + (setq arguments (cons (format "--context=%d" (abs current-prefix-arg)) arguments))) + (when ag-ignore-list + (setq arguments (append (ag/format-ignore ag-ignore-list) arguments))) (unless (file-exists-p default-directory) (error "No such directory %s" default-directory)) (let ((command-string - (mapconcat 'shell-quote-argument + (mapconcat #'shell-quote-argument (append (list ag-executable) arguments (list string ".")) " "))) - (when current-prefix-arg - (setq command-string (read-from-minibuffer "ag command: " command-string))) + ;; If we're called with a prefix, let the user modify the command before + ;; running it. Typically this means they want to pass additional arguments. + ;; The numeric value is used for context lines: positive is just context + ;; number (no modification), negative allows further modification. + (when (and current-prefix-arg (not (and (integerp current-prefix-arg) (> current-prefix-arg 0)))) + ;; Make a space in the command-string for the user to enter more arguments. + (setq command-string (ag/replace-first command-string " -- " " -- ")) + ;; Prompt for the command. + (let ((adjusted-point (- (length command-string) (length string) 5))) + (setq command-string + (read-from-minibuffer "ag command: " + (cons command-string adjusted-point))))) + ;; Call ag. (compilation-start command-string - 'ag-mode + #'ag-mode `(lambda (mode-name) ,(ag/buffer-name string directory regexp)))))) (defun ag/dwim-at-point () @@ -169,7 +239,7 @@ a PCRE pattern that matches files with that extension. Returns an empty string otherwise." (let ((file-name (buffer-file-name))) (if (stringp file-name) - (format "\\.%s" (file-name-extension file-name)) + (format "\\.%s$" (ag/escape-pcre (file-name-extension file-name))) ""))) (defun ag/longest-string (&rest strings) @@ -184,6 +254,13 @@ Returns an empty string otherwise." (setq longest-string string))))) longest-string)) +(defun ag/replace-first (string before after) + "Replace the first occurrence of BEFORE in STRING with AFTER." + (replace-regexp-in-string + (concat "\\(" (regexp-quote before) "\\)" ".*\\'") + after string + nil nil 1)) + (autoload 'vc-git-root "vc-git") (require 'vc-svn) @@ -194,6 +271,8 @@ Returns an empty string otherwise." (autoload 'vc-hg-root "vc-hg") +(autoload 'vc-bzr-root "vc-bzr") + (defun ag/project-root (file-path) "Guess the project root of the given FILE-PATH. @@ -204,9 +283,24 @@ roots." (or (ag/longest-string (vc-git-root file-path) (vc-svn-root file-path) - (vc-hg-root file-path)) + (vc-hg-root file-path) + (vc-bzr-root file-path)) file-path))) +(defun ag/dired-align-size-column () + (beginning-of-line) + (when (looking-at "^ ") + (forward-char 2) + (search-forward " " nil t 4) + (let* ((size-start (point)) + (size-end (search-forward " " nil t)) + (width (and size-end (- size-end size-start)))) + (when (and size-end + (< width 12) + (> width 1)) + (goto-char size-start) + (insert (make-string (- 12 width) ? )))))) + (defun ag/dired-filter (proc string) "Filter the output of ag to make it suitable for `dired-mode'." (let ((buf (process-buffer proc)) @@ -221,17 +315,20 @@ roots." (insert string) (goto-char beg) (or (looking-at "^") - (forward-line 1)) + (progn + (ag/dired-align-size-column) + (forward-line 1))) (while (looking-at "^") (insert " ") + (ag/dired-align-size-column) (forward-line 1)) (goto-char beg) (beginning-of-line) ;; Remove occurrences of default-directory. - (while (search-forward default-directory nil t) - (replace-match "" nil t)) - + (while (search-forward (concat " " default-directory) nil t) + (replace-match " " nil t)) + (goto-char (point-max)) (if (search-backward "\n" (process-mark proc) t) (progn @@ -260,6 +357,7 @@ roots." ;; will stay around until M-x list-processes. (delete-process proc) (force-mode-line-update))) + (run-hooks 'dired-after-readin-hook) (message "%s finished." (current-buffer)))))) (defun ag/kill-process () @@ -276,14 +374,14 @@ roots." "Escape the PCRE-special characters in REGEXP so that it is matched literally." (let ((alphanum "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789")) - (apply 'concat - (mapcar - (lambda (c) - (cond - ((not (string-match-p (regexp-quote c) alphanum)) - (concat "\\" c)) - (t c))) - (mapcar 'char-to-string (string-to-list regexp)))))) + (apply #'concat + (mapcar + (lambda (c) + (cond + ((not (string-match-p (regexp-quote c) alphanum)) + (concat "\\" c)) + (t c))) + (mapcar #'char-to-string (string-to-list regexp)))))) ;;;###autoload (defun ag (string directory) @@ -291,20 +389,21 @@ matched literally." with STRING defaulting to the symbol under point. If called with a prefix, prompts for flags to pass to ag." - (interactive (list (read-from-minibuffer "Search string: " (ag/dwim-at-point)) - (read-directory-name "Directory: "))) - (ag/search string directory)) + (interactive (list (ag/read-from-minibuffer "Search string") + (read-directory-name "Directory: "))) + (ag/search string directory)) ;;;###autoload -(defun ag-files (string file-regex directory) - "Search using ag in a given DIRECTORY and file type regex FILE-REGEX -for a given search STRING, with STRING defaulting to the symbol under point. +(defun ag-files (string file-type directory) + "Search using ag in a given DIRECTORY for a given search STRING, +limited to files that match FILE-TYPE. STRING defaults to +the symbol under point. If called with a prefix, prompts for flags to pass to ag." - (interactive (list (read-from-minibuffer "Search string: " (ag/dwim-at-point)) - (read-from-minibuffer "In filenames matching PCRE: " (ag/buffer-extension-regex)) + (interactive (list (ag/read-from-minibuffer "Search string") + (ag/read-file-type) (read-directory-name "Directory: "))) - (ag/search string directory :file-regex file-regex)) + (apply #'ag/search string directory file-type)) ;;;###autoload (defun ag-regexp (string directory) @@ -321,18 +420,38 @@ If called with a prefix, prompts for flags to pass to ag." for the given string. If called with a prefix, prompts for flags to pass to ag." - (interactive (list (read-from-minibuffer "Search string: " (ag/dwim-at-point)))) + (interactive (list (ag/read-from-minibuffer "Search string"))) (ag/search string (ag/project-root default-directory))) ;;;###autoload -(defun ag-project-files (string file-regex) - "Search using ag in a given DIRECTORY and file type regex FILE-REGEX -for a given search STRING, with STRING defaulting to the symbol under point. +(defun ag-project-files (string file-type) + "Search using ag for a given search STRING, +limited to files that match FILE-TYPE. STRING defaults to the +symbol under point. If called with a prefix, prompts for flags to pass to ag." - (interactive (list (read-from-minibuffer "Search string: " (ag/dwim-at-point)) - (read-from-minibuffer "In filenames matching PCRE: " (ag/buffer-extension-regex)))) - (ag/search string (ag/project-root default-directory) :file-regex file-regex)) + (interactive (list (ag/read-from-minibuffer "Search string") + (ag/read-file-type))) + (apply 'ag/search string (ag/project-root default-directory) file-type)) + +(defun ag/read-from-minibuffer (prompt) + "Read a value from the minibuffer with PROMPT. +If there's a string at point, offer that as a default." + (let* ((suggested (ag/dwim-at-point)) + (final-prompt + (if suggested + (format "%s (default %s): " prompt suggested) + (format "%s: " prompt))) + ;; Ask the user for input, but add `suggested' to the history + ;; so they can use M-n if they want to modify it. + (user-input (read-from-minibuffer + final-prompt + nil nil nil nil suggested))) + ;; Return the input provided by the user, or use `suggested' if + ;; the input was empty. + (if (> (length user-input) 0) + user-input + suggested))) ;;;###autoload (defun ag-project-regexp (regexp) @@ -341,8 +460,7 @@ for the given regexp. The regexp should be in PCRE syntax, not Emacs regexp syntax. If called with a prefix, prompts for flags to pass to ag." - (interactive (list (read-from-minibuffer "Search regexp: " - (ag/escape-pcre (ag/dwim-at-point))))) + (interactive (list (ag/read-from-minibuffer "Search regexp"))) (ag/search regexp (ag/project-root default-directory) :regexp t)) (autoload 'symbol-at-point "thingatpt") @@ -352,7 +470,8 @@ If called with a prefix, prompts for flags to pass to ag." (make-obsolete 'ag-project-at-point 'ag-project "0.19") ;;;###autoload -(defalias 'ag-regexp-project-at-point 'ag-project-regexp) ; TODO: mark as obsolete +(defalias 'ag-regexp-project-at-point 'ag-project-regexp) +(make-obsolete 'ag-regexp-project-at-point 'ag-project-regexp "0.46") ;;;###autoload (defun ag-dired (dir pattern) @@ -387,7 +506,10 @@ See also `find-dired'." (buffer-name (if ag-reuse-buffers "*ag dired*" (format "*ag dired pattern:%s dir:%s*" regexp dir))) - (cmd (concat "ag --nocolor -g '" regexp "' " dir " | grep -v '^$' | xargs -I {} ls " dired-listing-switches " {} &"))) + (cmd (concat ag-executable " --nocolor -g '" regexp "' " + (shell-quote-argument dir) + " | grep -v '^$' | sed s/\\'/\\\\\\\\\\'/ | xargs -I '{}' ls " + dired-listing-switches " '{}' &"))) (with-current-buffer (get-buffer-create buffer-name) (switch-to-buffer (current-buffer)) (widen) @@ -397,6 +519,7 @@ See also `find-dired'." (setq buffer-read-only nil)) (let ((inhibit-read-only t)) (erase-buffer)) (setq default-directory dir) + (run-hooks 'dired-before-readin-hook) (shell-command cmd (current-buffer)) (insert " " dir ":\n") (insert " " cmd "\n") @@ -408,7 +531,7 @@ See also `find-dired'." (set (make-local-variable 'dired-sort-inhibit) t) (set (make-local-variable 'revert-buffer-function) `(lambda (ignore-auto noconfirm) - (ag-dired ,orig-dir ,regexp))) + (ag-dired-regexp ,orig-dir ,regexp))) (if (fboundp 'dired-simple-subdir-alist) (dired-simple-subdir-alist) (set (make-local-variable 'dired-subdir-alist) @@ -438,7 +561,7 @@ See also `ag-dired-regexp'." ;;;###autoload (defun ag-kill-buffers () - "Kill all ag-mode buffers." + "Kill all `ag-mode' buffers." (interactive) (dolist (buffer (buffer-list)) (when (eq (buffer-local-value 'major-mode buffer) 'ag-mode) @@ -446,7 +569,7 @@ See also `ag-dired-regexp'." ;;;###autoload (defun ag-kill-other-buffers () - "Kill all ag-mode buffers other than the current buffer." + "Kill all `ag-mode' buffers other than the current buffer." (interactive) (let ((current-buffer (current-buffer))) (dolist (buffer (buffer-list)) @@ -480,5 +603,28 @@ This function is called from `compilation-filter-hook'." (while (re-search-forward "\033\\[[0-9;]*[mK]" end 1) (replace-match "" t t))))))) +(defun ag/get-supported-types () + "Query the ag executable for which file types it recognises." + (let* ((ag-output (shell-command-to-string (format "%s --list-file-types" ag-executable))) + (lines (-map #'s-trim (s-lines ag-output))) + (types (--keep (when (s-starts-with? "--" it) (s-chop-prefix "--" it )) lines)) + (extensions (--map (s-split " " it) (--filter (s-starts-with? "." it) lines)))) + (-zip types extensions))) + +(defun ag/read-file-type () + "Prompt the user for a known file type, or let them specify a PCRE regex." + (let* ((all-types-with-extensions (ag/get-supported-types)) + (all-types (mapcar 'car all-types-with-extensions)) + (file-type + (completing-read "Select file type: " + (append '("custom (provide a PCRE regex)") all-types))) + (file-type-extensions + (cdr (assoc file-type all-types-with-extensions)))) + (if file-type-extensions + (list :file-type file-type) + (list :file-regex + (read-from-minibuffer "Filenames which match PCRE: " + (ag/buffer-extension-regex)))))) + (provide 'ag) ;;; ag.el ends here diff --git a/elpa/buffer-move-0.6.1/buffer-move-pkg.el b/elpa/buffer-move-0.6.1/buffer-move-pkg.el deleted file mode 100644 index c8001f0..0000000 --- a/elpa/buffer-move-0.6.1/buffer-move-pkg.el +++ /dev/null @@ -1 +0,0 @@ -(define-package "buffer-move" "0.6.1" "" 'nil) diff --git a/elpa/buffer-move-0.6.1/buffer-move-autoloads.el b/elpa/buffer-move-20160108.708/buffer-move-autoloads.el similarity index 80% rename from elpa/buffer-move-0.6.1/buffer-move-autoloads.el rename to elpa/buffer-move-20160108.708/buffer-move-autoloads.el index 903bc03..80f4b5e 100644 --- a/elpa/buffer-move-0.6.1/buffer-move-autoloads.el +++ b/elpa/buffer-move-20160108.708/buffer-move-autoloads.el @@ -3,8 +3,8 @@ ;;; Code: (add-to-list 'load-path (or (file-name-directory #$) (car load-path))) -;;;### (autoloads nil "buffer-move" "buffer-move.el" (21831 16639 -;;;;;; 808187 792000)) +;;;### (autoloads nil "buffer-move" "buffer-move.el" (22297 19848 +;;;;;; 209528 72000)) ;;; Generated autoloads from buffer-move.el (autoload 'buf-move-up "buffer-move" "\ @@ -35,6 +35,14 @@ Swap the current buffer and the buffer on the right of the split. \(fn)" t nil) +(autoload 'buf-move "buffer-move" "\ +Begin moving the current buffer to different windows. + +Use the arrow keys to move in the desired direction. Pressing +any other key exits this function. + +\(fn)" t nil) + ;;;*** ;; Local Variables: diff --git a/elpa/buffer-move-20160108.708/buffer-move-pkg.el b/elpa/buffer-move-20160108.708/buffer-move-pkg.el new file mode 100644 index 0000000..dbed75e --- /dev/null +++ b/elpa/buffer-move-20160108.708/buffer-move-pkg.el @@ -0,0 +1 @@ +(define-package "buffer-move" "20160108.708" "easily swap buffers" 'nil :url "https://github.com/lukhas/buffer-move" :keywords '("lisp" "convenience")) diff --git a/elpa/buffer-move-0.6.1/buffer-move.el b/elpa/buffer-move-20160108.708/buffer-move.el similarity index 84% rename from elpa/buffer-move-0.6.1/buffer-move.el rename to elpa/buffer-move-20160108.708/buffer-move.el index a420b20..2fd0508 100644 --- a/elpa/buffer-move-0.6.1/buffer-move.el +++ b/elpa/buffer-move-20160108.708/buffer-move.el @@ -1,14 +1,15 @@ -;;; buffer-move.el --- +;;; buffer-move.el --- easily swap buffers ;; Copyright (C) 2004-2014 Lucas Bonnet ;; Copyright (C) 2014 Mathis Hofer -;; Copyright (C) 2014 Geyslan G. Bem +;; Copyright (C) 2014-2015 Geyslan G. Bem ;; Authors: Lucas Bonnet ;; Geyslan G. Bem ;; Mathis Hofer ;; Keywords: lisp,convenience -;; Version: 0.6.1 +;; Package-Version: 20160108.708 +;; Version: 0.6.2 ;; URL : https://github.com/lukhas/buffer-move ;; This program is free software; you can redistribute it and/or @@ -100,6 +101,10 @@ (buf-this-buf (window-buffer (selected-window)))) (if (null other-win) (error "No window in this direction") + (if (window-dedicated-p other-win) + (error "The window in this direction is dedicated")) + (if (string-match "^ \\*Minibuf" (buffer-name (window-buffer other-win))) + (error "The window in this direction is the Minibuf")) (if (eq buffer-move-behavior 'move) ;; switch selected window to previous buffer (moving) (switch-to-prev-buffer (selected-window)) @@ -147,6 +152,20 @@ (interactive) (buf-move-to 'right)) +;;;###autoload +(defun buf-move () + "Begin moving the current buffer to different windows. + +Use the arrow keys to move in the desired direction. Pressing +any other key exits this function." + (interactive) + (let ((map (make-sparse-keymap))) + (dolist (x '(("" . buf-move-up) + ("" . buf-move-left) + ("" . buf-move-down) + ("" . buf-move-right))) + (define-key map (read-kbd-macro (car x)) (cdr x))) + (set-transient-map map t))) (provide 'buffer-move) ;;; buffer-move.el ends here diff --git a/elpa/company-0.8.12.signed b/elpa/company-0.8.12.signed deleted file mode 100644 index 38c24e4..0000000 --- a/elpa/company-0.8.12.signed +++ /dev/null @@ -1 +0,0 @@ -Good signature from 474F05837FBDEF9B GNU ELPA Signing Agent (trust undefined) created at 2015-03-05T11:05:01+0100 using DSA \ No newline at end of file diff --git a/elpa/company-0.8.12/.dir-locals.el b/elpa/company-0.8.12/.dir-locals.el deleted file mode 100644 index 79d9a12..0000000 --- a/elpa/company-0.8.12/.dir-locals.el +++ /dev/null @@ -1,4 +0,0 @@ -((nil . ((indent-tabs-mode . nil) - (fill-column . 80) - (sentence-end-double-space . t) - (emacs-lisp-docstring-fill-column . 75)))) diff --git a/elpa/company-0.8.12/.elpaignore b/elpa/company-0.8.12/.elpaignore deleted file mode 100644 index 9f31d8a..0000000 --- a/elpa/company-0.8.12/.elpaignore +++ /dev/null @@ -1,5 +0,0 @@ -.travis.yml -.gitignore -Makefile -test/ -company-tests.el diff --git a/elpa/company-0.8.12/ChangeLog b/elpa/company-0.8.12/ChangeLog deleted file mode 100644 index 7ea2c2a..0000000 --- a/elpa/company-0.8.12/ChangeLog +++ /dev/null @@ -1,310 +0,0 @@ -2015-03-04 Dmitry Gutov - - Merge commit 'e085a333867959a1b36015a3ad8e12e5bd6550d9' from company - -2015-02-04 Dmitry Gutov - - Merge commit '3e70e12bd942bbd0acac4963b5caca63756ad784' from company - -2015-02-02 Dmitry Gutov - - Merge commit 'a015fb350abe50d250e3e7a9c3c762397326977f' from company - -2015-01-23 Dmitry Gutov - - Merge commit 'a4ac0dead8e9cb440c1f8aec9141d6c64bad4933' from company - -2015-01-15 Stefan Monnier - - * packages/company/test/clang-tests.el: Add copyright notice - -2015-01-13 Dmitry Gutov - - Merge commit 'd12ddaa05f582ecc00e74bc42fd46652153ec7a6' from company - -2015-01-13 Dmitry Gutov - - Merge commit 'eb0d8d9e687e1364098f9abc6f9281fcbc0d3abd' from company - -2014-10-28 Dmitry Gutov - - Merge commit 'd3fcbefcf56d2caad172e22f24de95397c635bf2' from company - -2014-10-15 Stefan Monnier - - * packages/company/company-xcode.el (company-xcode-fetch): Avoid - add-to-list on local var. - * packages/company/company.el (company--window-height) - (company--window-width): Move before first use. - -2014-10-15 Dmitry Gutov - - Merge commit '60d4c09c982a1c562a70cd6aa705f47ab3badcfb' from company - -2014-09-14 Dmitry Gutov - - Merge commit 'fa4ba155a3e22ddc4b8bc33fcbf8cc69ef8f0043' from company - -2014-09-13 Dmitry Gutov - - Merge commit '2ef6263c65a109b4d36503e6484fdbf4cb307d0f' from company - -2014-08-27 Dmitry Gutov - - Merge commit 'f4ffe2b47cf6854ff3bc3ca1717efe1258c01547' from company - -2014-07-26 Dmitry Gutov - - Merge commit 'b1d019a4c815ac8bdc240d69eaa74eb4e34640e8' from - company-master - -2014-07-01 Dmitry Gutov - - Merge commit '7c14dedc79bf0c6eaad5bf50b80ea80dd721afdc' from company - - Conflicts: - packages/company/company-pysmell.el - -2014-06-14 Stefan Monnier - - * company/company-capf.el: Don't ignore things like semantic-capf. - -2014-04-19 Dmitry Gutov - - Merge commit '51c140ca9ee32d27cacc7b2b07d4539bf98ae575' from - company-master - - Conflicts: - packages/company/company-pysmell.el - -2014-03-25 Dmitry Gutov - - Merge commit '4a7995ff69b25990dc520ed9e466dfbcdb7eafc8' from company - -2014-03-19 Dmitry Gutov - - Merge commit 'fec7c0b4a8651160c5d759cc6703b2c45852d5bb' - -2014-03-18 Dmitry Gutov - - Merge commit '7be4321260f0c73ef4c3cadc646f6bb496650253' from company - -2014-02-18 Dmitry Gutov - - Merge commit '119822078ee3024c2d27017d45ef4578fa36040f' from company - -2014-02-03 Dmitry Gutov - - Merge commit '67ab56a5469f16652e73667ec3b4f76ff6befee6' from company - -2014-01-25 Dmitry Gutov - - Merge commit '8dc8f9525714db66f659a2a51322345068764bd3' from company - - Conflicts: - packages/company/company-capf.el - -2014-01-24 Stefan Monnier - - * company-capf.el (company--capf-data): Don't get confused by lambda - exps. - -2014-01-20 Dmitry Gutov - - Merge commit '2badcc6227a88e1aba288f442af5f4e1ce55d366' from company - -2014-01-15 Dmitry Gutov - - Merge commit '8b4d7da0d6aa1e24379fe5ace5bd2705352ea07e' from company - -2014-01-14 Dmitry Gutov - - Merge commit '67a96dbbfe645b64291ed62eab6f1eb391a834e0' from company - - Conflicts: - packages/company/company-elisp.el - packages/company/company-oddmuse.el - -2014-01-13 Stefan Monnier - - * packages/company/company-etags.el: Require `cl' for `case'. - * packages/company/company-oddmuse.el: Avoid `eval-when' before - requiring `cl'. - * packages/company/company-elisp.el (company-elisp): Simplify. - -2013-10-06 Dmitry Gutov - - Sync from company/master - -2013-08-29 Stefan Monnier - - * packages/company/company-capf.el (company-capf): Add preliminary - support for doc-buffer, meta, location, and require-match. - -2013-08-21 Stefan Monnier - - * packages/company/company-cmake.el: Fix up copyright. Require CL. - * packages/company/company-template.el - (company-template--buffer-templates): Declare before first use. - * packages/company/company-eclim.el (json-array-type): Declare - json-array-type. - (company-eclim--candidates): Remove unused var `project-name'. - -2013-08-21 Stefan Monnier - - Sync from company/master - -2013-08-14 Stefan Monnier - - Mark merge point of company. - -2013-06-27 Stefan Monnier - - * GNUmakefile: Rename from Makefile. Add targets for in-place use. - (all, all-in-place): New targets. - * admin/archive-contents.el (archive--simple-package-p): Ignore - autosave files. - (archive--refresh-pkg-file): New function. - (archive--write-pkg-file): Print with ' and ` shorthands. - * packages/company/company-pysmell.el: Don't require pysmell during - compile. - * packages/muse/htmlize-hack.el: Don't require htmlize during compile. - * packages/shen-mode/shen-mode.el (shen-functions): Define during - compile. - * smart-operator/smart-operator.el (smart-operator-insert-1): Use - pcase. - -2013-05-26 Dmitry Gutov - - company: Release 0.6.10 - - * Plays nicer with `org-indent-mode`. - * Works in horizontally scrolled windows. - - Git commit 764d2aa4ba50081adf69408e62d4863905b68b7f - -2013-05-10 Dmitry Gutov - - company: Release 0.6.9 - - * `company-capf` respects `:exit-function` completion property. - * `company-backends`: `prefix` command can return `t` in the cdr. - * `company-clang-begin-after-member-access`: New option. - * Mouse click outside the tooltip aborts completion. - * `company-clang` uses standard input to pass the contents of current - buffer to - Clang 2.9+, otherwise saves the buffer and passes the path to the - file. - * `company-clang-auto-save` option has been removed. - * Better interaction with `outline-minor-mode`. - * `company-dabbrev-code` supports all `prog-mode` derivatives. - - Git commit 4c735454d91f9674da0ecea950504888b1e10ff7 - -2013-04-27 Stefan Monnier - - * company.el (company-capf): Add support for `sorted' and - `post-completion'. - (company--capf-data): New function. - (company-backend): Declare before first use. - (company-require-match-p): Only call company-require-match is needed. - (company--continue-failed): Don't use backward-delete-char - non-interactively. - (company-search-assert-enabled): Demote it, since it comes too late to - be inlined. - (company-begin-with): Use a lexical closure, so the code is - byte-compiled. - (company--replacement-string, company--create-lines) - (company-pseudo-tooltip-edit, company-doc-buffer): Silence the - byte-compiler. - -2013-04-16 Dmitry Gutov - - Release 0.6.8 - - * `company-auto-complete` is disabled by default. - * `company-auto-complete-chars` default value includes fewer syntax - classes. - * In expanded function calls, arguments skipped by the user default to - "argN". - * `company-eclim` and `company-clang` do not strip argument types from - fields. - * `company-clang` expands function calls for all three modes now. - * `company-clang` supports `c++-mode` by default. - - Git commit 92ac3d0ef663bca26abbda33cc20a02a58b1c328 - -2013-04-05 Dmitry Gutov - - company: Release 0.6.7 - - * Two `company-elisp` tweaks. - - Git commit 8dceda389115b397de48becc4b68a64f4dc4bbab - -2013-04-01 Dmitry Gutov - - company: Release 0.6.6 - - ## 2013-04-01 (0.6.6) - - * `company-elisp` doesn't offer completions when typing the name and - the arguments of a new function or macro definition, allowing to - fall back to other back-ends like `company-dabbrev-code`. - - ## 2013-03-30 (0.6.5) - - * Fixed keybindings when running in a terminal. - * `company-elisp-show-locals-first`: new customizable variable. - * `company-elisp` shows more accurate and comprehensive candidates - list. - - ## 2013-03-26 (0.6.4) - - * `company-eclim` shows valid completions after an opening paren. - * Expanded template does not get removed until the point leaves it. - After your input the last argument in a method call expanded by - `company-eclim`, you can press `` once more, to jump after the - closing paren. No other bundled back-ends are affected. - - ## 2013-03-25 (0.6.3) - - * New tooltip face colors used on themes with light background. - * Pseudo-tooltip stays up-to-date when text is inserted after the - point. - * Fixed `company-require-match` mechanics. - -2013-03-24 Dmitry Gutov - - company: Release 0.6.2 - -2013-03-23 Dmitry Gutov - - company: Release 0.6.1 - -2013-03-21 Dmitry Gutov - - company: Remove angle brackets from README - -2013-03-19 Dmitry Gutov - - company: Update pkg.el and summary string - -2013-03-19 Dmitry Gutov - - company-tests.el: add copyright boilerplate - -2013-03-19 Dmitry Gutov - - company-mode: Release 0.6 - -2011-08-01 Stefan Monnier - - * company/*.el: Fix case misunderstanding. Use checkdoc. - * company/company.el (company-capf): First cut at making Company use - completion-at-point-functions. - -2011-06-30 Chong Yidong - - Remove version numbers in packages/ directory - diff --git a/elpa/company-0.8.12/NEWS.md b/elpa/company-0.8.12/NEWS.md deleted file mode 100644 index c7a1afe..0000000 --- a/elpa/company-0.8.12/NEWS.md +++ /dev/null @@ -1,329 +0,0 @@ -# History of user-visible changes - -## 2015-02-02 (0.8.10) - -* New variable `company-lighter-base`. -* Better tracking of the current selection. -* Pressing `M-0`...`M-9` works in the search mode. -* Pressing `` or `` doesn't quit the search mode. - -## 2015-01-23 (0.8.9) - -* New commands `company-next-page` and `company-previous-page`, remapping - `scroll-up-command` and `scroll-down-command` during completion. - -## 2015-01-13 (0.8.8) - -* Pressing `M-n` or `M-p` doesn't quit the search mode. -* New command `company-complete-common-or-cycle`. No default binding. -* `company-search-toggle-filtering` replaced `company-search-kill-others`. -* Quitting the search mode resets the filtering. -* Pressing `backspace` in the search mode deletes the character at the end of - the search string. -* `company-semantic` displays function arguments as annotations. -* New user option, `company-bbdb-modes`. -* `company-show-numbers` and `company-complete-number` now use visual numbering - of the candidates, taking into account only the ones currently displayed. -* `company-complete-number` can be bound to keypad numbers directly, with or - without modifiers. -* `company-cmake` expands `` and `` placeholders inside variable - names. - -## 2014-10-15 (0.8.6) - -* `company-clang` and `company-template-c-like-templatify` support templated - functions and arguments. -* `company-dabbrev` ignores "uninteresting" buffers by default. Depends on the - new user option, `company-dabbrev-ignore-buffers`. -* `company-files` checks directory's last modification time. -* `company-files` supports relative paths and Windows drive letters. - -## 2014-08-13 (0.8.4) - -* `company-ropemacs` is only used when `ropemacs-mode` is on. -* `company-gtags` is enabled in all `prog-mode` derivatives by default. -* `company-end-of-buffer-workaround` is not used anymore. -* `company-begin-commands` includes some of `cc-mode` commands. - -## 2014-08-27 (0.8.3) - -* On Emacs 24.4 or newer, tooltip positioning takes line-spacing into account. -* New face `company-tooltip-search`, used for the search string in the tooltip. -* The default value of `company-dabbrev-minimum-length` is set to 4, independent - of the `company-minimum-prefix-length` value. - -## 2014-07-26 (0.8.2) - -* New user option `company-occurrence-weight-function`, allowing to tweak the - behavior of the transformer `company-sort-by-occurrence`. -* Setting `company-idle-delay` to `t` is deprecated. Use the value 0 instead. - -## 2014-07-01 (0.8.1) - -* `company-require-match` is not in effect when the new input doesn't continue - the previous prefix, and that prefix was a match. -* The meaning of `company-begin-commands` value t has slightly changed. -* New transformer, `company-sort-by-backend-importance`. -* When grouped back-ends are used, the back-end of the current candidate is - indicated in the mode-line, enclosed in angle brackets. -* New user option `company-gtags-insert-arguments`, t by default. -* `company-css` knows about CSS3. -* `company-gtags` supports `meta` and `annotation`. -* User option `company-dabbrev-code-other-buffers` can have a new value: `code`. -* New user option `company-tooltip-flip-when-above`. -* `company-clang` uses the standard header search paths by default. -* `C-h` is bound to `company-show-doc-buffer` (like `f1`). - -## 2014-04-19 (0.8.0) - -* `company-capf` is included in `company-backends` in any supported Emacs - version (>= 24.1). `company-elisp` goes before it if Emacs version is < 24.4. -* New user option `company-clang-insert-arguments`, by default t. -* Default value of `company-idle-delay` lowered to `0.5`. -* New user option `company-tooltip-minimum-width`, by default 0. -* New function `company-grab-symbol-cons`. -* `company-clang` fetches completion candidates asynchronously. -* Added support for asynchronous back-ends (experimental). -* Support for back-end command `crop` dropped (it was never documented). -* Support for Emacs 23 dropped. -* New user option `company-abort-manual-when-too-short`. - -## 2014-03-25 (0.7.3) - -* New user option `company-etags-ignore-case`. - -## 2014-03-19 (0.7.2) - -* Support for Emacs 22 officially dropped. -* `company-clang` supports `indent-tabs-mode` and multibyte chars before point. - -## 2014-03-18 (0.7.1) - -* Group of back-ends can now contain keyword `:with`, which makes all back-ends - after it to be skipped for prefix calculation. -* New function `company-version`. -* New bundled back-end `company-yasnippet`. -* Completion candidates returned from grouped back-ends are tagged to remember - which back-end each came from. -* New user option `company-tooltip-align-annotations`, off by default. -* New bundled back-end `company-bbdb`. - -## 2014-02-18 (0.7) - -* New back-end command, `match`, for non-prefix completion. -* New user option `company-continue-commands`. The default value aborts - completion on buffer saving commands. -* New back-end command, `annotation`, for text displayed inline in the popup - that's not a part of completion candidate. -* `company-capf`, `company-clang` and `company-eclim` use `annotation`. -* `company-preview*` faces inherit from `company-tooltip-selection` and - `company-tooltip-common-selection` on light themes. -* New user option `company-transformers`. -* First transformer, `company-sort-by-occurrence`. -* New user options controlling `company-dabbrev` and `company-dabbrev-code`. - -## 2014-01-25 (0.6.14) - -* The tooltip front-end is rendered with scrollbar, controlled by the user - option `company-tooltip-offset-display`. -* The tooltip front-end is rendered with margins, controlled by the user option - `company-tooltip-margin`. - -## 2014-01-14 (0.6.13) - -* Experimental support for non-prefix completion. -* Starting with Emacs version 24.4, `company-capf` is included in - `company-backends` and replaces `company-elisp`. -* `company-capf` supports completion tables that return non-default boundaries. -* `company-elisp` is enabled in `inferior-emacs-lisp-mode`. - -## 2013-09-28 (0.6.12) - -* Default value of `company-begin-commands` changed to `(self-insert-command)`. -* Futher improvement in `org-indent-mode` compatibility. - -## 2013-08-18 (0.6.11) - -* `company-template-c-like-templatify` removes all text after closing paren, for - use in backends that display additional info there. -* `company-cmake` is now bundled. -* Better `linum` compatibility in Emacs <= 24.2. -* `company-global-modes`: New option. - -## 2013-05-26 (0.6.10) - -* Plays nicer with `org-indent-mode`. -* Works in horizontally scrolled windows. - -## 2013-05-10 (0.6.9) - -* `company-capf` respects `:exit-function` completion property. -* `company-backends`: `prefix` command can return `t` in the cdr. -* `company-clang-begin-after-member-access`: New option. -* Mouse click outside the tooltip aborts completion. -* `company-clang` uses standard input to pass the contents of current buffer to - Clang 2.9+, otherwise saves the buffer and passes the path to the file. -* `company-clang-auto-save` option has been removed. -* Better interaction with `outline-minor-mode`. -* `company-dabbrev-code` supports all `prog-mode` derivatives. - -## 2013-04-16 (0.6.8) - -* `company-auto-complete` is disabled by default. -* `company-auto-complete-chars` default value includes fewer syntax classes. -* In expanded function calls, arguments skipped by the user default to "argN". -* `company-eclim` and `company-clang` do not strip argument types from fields. -* `company-clang` expands function calls for all three modes now. -* `company-clang` supports `c++-mode` by default. - -## 2013-04-05 (0.6.7) - -* Two `company-elisp` tweaks. - -## 2013-04-01 (0.6.6) - -* `company-elisp` doesn't offer completions when typing the name and the - arguments of a new function or macro definition, allowing to fall back to - other back-ends like `company-dabbrev-code`. - -## 2013-03-30 (0.6.5) - -* Fixed keybindings when running in a terminal. -* `company-elisp-show-locals-first`: new customizable variable. -* `company-elisp` shows more accurate and comprehensive candidates list. - -## 2013-03-26 (0.6.4) - -* `company-eclim` shows valid completions after an opening paren. -* Expanded template does not get removed until the point leaves it. After your - input the last argument in a method call expanded by `company-eclim`, you can - press `` once more, to jump after the closing paren. No other bundled - back-ends are affected. - -## 2013-03-25 (0.6.3) - -* New tooltip face colors used on themes with light background. -* Pseudo-tooltip stays up-to-date when text is inserted after the point. -* Fixed `company-require-match` mechanics. - -## 2013-03-24 (0.6.2) - -* `global-company-mode` is now autoloaded. - -## 2013-03-23 (0.6.1) - -* Documented `init` and `post-completion` back-end commands. -* `company-eclim` and `company-clang` only expand the template on explicit user - action (such as `company-complete-{selection,number,mouse}`). -* `company-template` has some breaking changes. When point is at one of the - fields, it's displayed at the beginning, not right after it; `` jumps to - the next field, `forward-word` and `subword-forward` remappings are removed; - when you jump to the next field, if the current one hasn't been edited, the - overlay gets removed but the text remains. -* `company-eclim` shows method overloads and expands templates for calls. -* `company-clang-objc-templatify` does not insert spaces after colons anymore. -* `company-clang` is now only initialized in supported buffers. - So, no error messages if you don't have Clang until you open a C file. -* `company-clang` recognizes Clang included in recent Xcode. -* New commands `company-select-previous-or-abort` and - `company-select-next-or-abort`, bound to `` and ``. - -## 2013-03-19 (0.6) - -* Across-the-board bugfixing. -* `company-pysmell` is not used by default anymore. -* Loading of `nxml`, `semantic`, `pymacs` and `ropemacs` is now deferred. -* Candidates from grouped back-ends are merged more conservatively: only - back-ends that return the same prefix at point are used. -* `company-clang` now shows meta information, too. -* Some performance improvements. -* Fixed two old tooltip annoyances. -* Instead of `overrriding-terminal-local-map`, we're now using - `emulation-mode-map-alists` (experimental). This largely means that when the - completion keymap is active, other minor modes' keymaps are still used, so, - for example, it's not as easy to accidentally circumvent `paredit-mode` - when it's enabled. -* `company-elisp` has seen some improvements. -* Added `company-capf`: completion adapter using - `completion-at-point-functions`. (Stefan Monnier) -* Clang completions now include macros and are case-sensitive. -* Switching between tag files now works correctly with `company-etags`. - -## 2010-02-24 (0.5) - -* `company-ropemacs` now provides location and docs. (Fernando H. Silva) -* Added `company-with-candidate-inserted` macro. -* Added `company-clang` back-end. -* Added new mechanism for non-consecutive insertion. - (So far only used by clang for ObjC.) -* The semantic back-end now shows meta information for local symbols. -* Added compatibility for CEDET in Emacs 23.2 and from CVS. (Oleg Andreev) - -## 2009-05-07 (0.4.3) - -* Added `company-other-backend`. -* Idle completion no longer interrupts multi-key command input. -* Added `company-ropemacs` and `company-pysmell` back-ends. - -## 2009-04-25 (0.4.2) - -* In C modes . and -> now count towards `company-minimum-prefix-length`. -* Reverted default front-end back to `company-preview-if-just-one-frontend`. -* The pseudo tooltip will no longer be clipped at the right window edge. -* Added `company-tooltip-minimum`. -* Windows compatibility fixes. - -## 2009-04-19 (0.4.1) - -* Added `global-company-mode`. -* Performance enhancements. -* Added `company-eclim` back-end. -* Added safer workaround for Emacs `posn-col-row` bug. - -## 2009-04-18 (0.4) - -* Automatic completion is now aborted if the prefix gets too short. -* Added option `company-dabbrev-time-limit`. -* `company-backends` now supports merging back-ends. -* Added back-end `company-dabbrev-code` for generic code. -* Fixed `company-begin-with`. - -## 2009-04-15 (0.3.1) - -* Added 'stop prefix to prevent dabbrev from completing inside of symbols. -* Fixed issues with tabbar-mode and line-spacing. -* Performance enhancements. - -## 2009-04-12 (0.3) - -* Added `company-begin-commands` option. -* Added abbrev, tempo and Xcode back-ends. -* Back-ends are now interactive. You can start them with M-x backend-name. -* Added `company-begin-with` for starting company from elisp-code. -* Added hooks. -* Added `company-require-match` and `company-auto-complete` options. - -## 2009-04-05 (0.2.1) - -* Improved Emacs Lisp back-end behavior for local variables. -* Added `company-elisp-detect-function-context` option. -* The mouse can now be used for selection. - -## 2009-03-22 (0.2) - -* Added `company-show-location`. -* Added etags back-end. -* Added work-around for end-of-buffer bug. -* Added `company-filter-candidates`. -* More local Lisp variables are now included in the candidates. - -## 2009-03-21 (0.1.5) - -* Fixed elisp documentation buffer always showing the same doc. -* Added `company-echo-strip-common-frontend`. -* Added `company-show-numbers` option and M-0 ... M-9 default bindings. -* Don't hide the echo message if it isn't shown. - -## 2009-03-20 (0.1) - -* Initial release. diff --git a/elpa/company-0.8.12/README.md b/elpa/company-0.8.12/README.md deleted file mode 100644 index 4f79bbc..0000000 --- a/elpa/company-0.8.12/README.md +++ /dev/null @@ -1,4 +0,0 @@ -See the [homepage](http://company-mode.github.com/). -[![githalytics.com alpha](https://cruel-carlota.pagodabox.com/336ef4be2595a7859d52e2c17b7da2b2 "githalytics.com")](http://githalytics.com/company-mode/company-mode) - -[![Build Status](https://travis-ci.org/company-mode/company-mode.png?branch=master)](https://travis-ci.org/company-mode/company-mode) diff --git a/elpa/company-0.8.12/company-pkg.el b/elpa/company-0.8.12/company-pkg.el deleted file mode 100644 index 675f15a..0000000 --- a/elpa/company-0.8.12/company-pkg.el +++ /dev/null @@ -1,2 +0,0 @@ -;; Generated package description from company.el -(define-package "company" "0.8.12" "Modular text completion framework" '((emacs "24.1") (cl-lib "0.5")) :url "http://company-mode.github.io/" :keywords '("abbrev" "convenience" "matching")) diff --git a/elpa/company-0.8.12/company-pysmell.el b/elpa/company-0.8.12/company-pysmell.el deleted file mode 100644 index 8a69e76..0000000 --- a/elpa/company-0.8.12/company-pysmell.el +++ /dev/null @@ -1,69 +0,0 @@ -;;; company-pysmell.el --- company-mode completion back-end for pysmell.el - -;; Copyright (C) 2009-2011, 2013-2014 Free Software Foundation, Inc. - -;; Author: Nikolaj Schumacher - -;; This file is part of GNU Emacs. - -;; GNU Emacs 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. - -;; GNU Emacs 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 GNU Emacs. If not, see . - - -;;; Commentary: -;; -;; The main problem with using this backend is installing Pysmell. -;; I couldn't manage to do that. --Dmitry - -;;; Code: - -(if t (require 'pysmell)) ;Don't load during compilation. -(require 'company) -(require 'cl-lib) - -(defvar-local company-pysmell--available-p 'unknown) - -(defun company-pysmell--available-p () - (if (eq company-pysmell--available-p 'unknown) - (setq company-pysmell--available-p - (locate-dominating-file buffer-file-name "PYSMELLTAGS")) - company-pysmell--available-p)) - -(defun company-pysmell--grab-symbol () - (let ((symbol (company-grab-symbol))) - (when symbol - (cons symbol - (save-excursion - (let ((pos (point))) - (goto-char (- (point) (length symbol))) - (while (eq (char-before) ?.) - (goto-char (1- (point))) - (skip-syntax-backward "w_")) - (- pos (point)))))))) - -;;;###autoload -(defun company-pysmell (command &optional arg &rest ignored) - "`company-mode' completion back-end for pysmell. -This requires pysmell.el and pymacs.el." - (interactive (list 'interactive)) - (cl-case command - (interactive (company-begin-backend 'company-pysmell)) - (prefix (and (derived-mode-p 'python-mode) - buffer-file-name - (not (company-in-string-or-comment)) - (company-pysmell--available-p) - (company-pysmell--grab-symbol))) - (candidates (delete "" (pysmell-get-all-completions))))) - -(provide 'company-pysmell) -;;; company-pysmell.el ends here diff --git a/elpa/company-0.8.12/company-ropemacs.el b/elpa/company-0.8.12/company-ropemacs.el deleted file mode 100644 index 4fc3813..0000000 --- a/elpa/company-0.8.12/company-ropemacs.el +++ /dev/null @@ -1,72 +0,0 @@ -;;; company-ropemacs.el --- company-mode completion back-end for ropemacs - -;; Copyright (C) 2009-2011, 2013-2014 Free Software Foundation, Inc. - -;; Author: Nikolaj Schumacher - -;; This file is part of GNU Emacs. - -;; GNU Emacs 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. - -;; GNU Emacs 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 GNU Emacs. If not, see . - - -;;; Commentary: -;; - -;;; Code: - -(require 'cl-lib) - -(defun company-ropemacs--grab-symbol () - (let ((symbol (company-grab-symbol))) - (when symbol - (cons symbol - (save-excursion - (let ((pos (point))) - (goto-char (- (point) (length symbol))) - (while (eq (char-before) ?.) - (goto-char (1- (point))) - (skip-syntax-backward "w_")) - (- pos (point)))))))) - -(defun company-ropemacs-doc-buffer (candidate) - "Return buffer with docstring of CANDIDATE if it is available." - (let ((doc (company-with-candidate-inserted candidate (rope-get-doc)))) - (when doc - (company-doc-buffer doc)))) - -(defun company-ropemacs-location (candidate) - "Return location of CANDIDATE in cons form (FILE . LINE) if it is available." - (let ((location (company-with-candidate-inserted candidate - (rope-definition-location)))) - (when location - (cons (elt location 0) (elt location 1))))) - -(defun company-ropemacs (command &optional arg &rest ignored) - "`company-mode' completion back-end for ropemacs. - -Depends on third-party code: Pymacs (both Python and Emacs packages), -rope, ropemacs and ropemode. Requires `ropemacs-mode' to be on." - (interactive (list 'interactive)) - (cl-case command - (interactive (company-begin-backend 'company-ropemacs)) - (prefix (and (bound-and-true-p ropemacs-mode) - (not (company-in-string-or-comment)) - (company-ropemacs--grab-symbol))) - (candidates (mapcar (lambda (element) (concat arg element)) - (rope-completions))) - (doc-buffer (company-ropemacs-doc-buffer arg)) - (location (company-ropemacs-location arg)))) - -(provide 'company-ropemacs) -;;; company-ropemacs.el ends here diff --git a/elpa/company-0.8.12/test/all.el b/elpa/company-0.8.12/test/all.el deleted file mode 100644 index 6d64a62..0000000 --- a/elpa/company-0.8.12/test/all.el +++ /dev/null @@ -1,28 +0,0 @@ -;;; all-tests.el --- company-mode tests -*- lexical-binding: t -*- - -;; Copyright (C) 2015 Free Software Foundation, Inc. - -;; Author: Dmitry Gutov - -;; This file is part of GNU Emacs. - -;; GNU Emacs 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. - -;; GNU Emacs 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 GNU Emacs. If not, see . - -(defvar company-test-path - (file-name-directory (or load-file-name buffer-file-name))) - -(require 'ert) - -(dolist (test-file (directory-files company-test-path t "-tests.el$")) - (load test-file nil t)) diff --git a/elpa/company-0.8.12/test/async-tests.el b/elpa/company-0.8.12/test/async-tests.el deleted file mode 100644 index c548898..0000000 --- a/elpa/company-0.8.12/test/async-tests.el +++ /dev/null @@ -1,217 +0,0 @@ -;;; async-tests.el --- company-mode tests -*- lexical-binding: t -*- - -;; Copyright (C) 2015 Free Software Foundation, Inc. - -;; Author: Dmitry Gutov - -;; This file is part of GNU Emacs. - -;; GNU Emacs 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. - -;; GNU Emacs 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 GNU Emacs. If not, see . - -(require 'company-tests) - -(defun company-async-backend (command &optional _) - (pcase command - (`prefix "foo") - (`candidates - (cons :async - (lambda (cb) - (run-with-timer 0.05 nil - #'funcall cb '("abc" "abd"))))))) - -(ert-deftest company-call-backend-forces-sync () - (let ((company-backend 'company-async-backend) - (company-async-timeout 0.1)) - (should (equal '("abc" "abd") (company-call-backend 'candidates))))) - -(ert-deftest company-call-backend-errors-on-timeout () - (with-temp-buffer - (let* ((company-backend (lambda (command &optional _arg) - (pcase command - (`candidates (cons :async 'ignore))))) - (company-async-timeout 0.1) - (err (should-error (company-call-backend 'candidates "foo")))) - (should (string-match-p "async timeout" (cadr err)))))) - -(ert-deftest company-call-backend-raw-passes-return-value-verbatim () - (let ((company-backend 'company-async-backend)) - (should (equal "foo" (company-call-backend-raw 'prefix))) - (should (equal :async (car (company-call-backend-raw 'candidates "foo")))) - (should (equal 'closure (cadr (company-call-backend-raw 'candidates "foo")))))) - -(ert-deftest company-manual-begin-forces-async-candidates-to-sync () - (with-temp-buffer - (company-mode) - (let (company-frontends - company-transformers - (company-backends (list 'company-async-backend))) - (company-manual-begin) - (should (equal "foo" company-prefix)) - (should (equal '("abc" "abd") company-candidates))))) - -(ert-deftest company-idle-begin-allows-async-candidates () - (with-temp-buffer - (company-mode) - (let (company-frontends - company-transformers - (company-backends (list 'company-async-backend))) - (company-idle-begin (current-buffer) (selected-window) - (buffer-chars-modified-tick) (point)) - (should (null company-candidates)) - (sleep-for 0.1) - (should (equal "foo" company-prefix)) - (should (equal '("abc" "abd") company-candidates))))) - -(ert-deftest company-idle-begin-cancels-async-candidates-if-buffer-changed () - (with-temp-buffer - (company-mode) - (let (company-frontends - (company-backends (list 'company-async-backend))) - (company-idle-begin (current-buffer) (selected-window) - (buffer-chars-modified-tick) (point)) - (should (null company-candidates)) - (insert "a") - (sleep-for 0.1) - (should (null company-candidates))))) - -(ert-deftest company-idle-begin-async-allows-immediate-callbacks () - (with-temp-buffer - (company-mode) - (let (company-frontends - (company-backends - (list (lambda (command &optional arg) - (pcase command - (`prefix (buffer-substring (point-min) (point))) - (`candidates - (let ((c (all-completions arg '("abc" "def")))) - (cons :async - (lambda (cb) (funcall cb c))))) - (`no-cache t))))) - (company-minimum-prefix-length 0)) - (company-idle-begin (current-buffer) (selected-window) - (buffer-chars-modified-tick) (point)) - (should (equal '("abc" "def") company-candidates)) - (let ((last-command-event ?a)) - (company-call 'self-insert-command 1)) - (should (equal '("abc") company-candidates))))) - -(ert-deftest company-multi-backend-forces-prefix-to-sync () - (with-temp-buffer - (let ((company-backend (list 'ignore - (lambda (command) - (should (eq command 'prefix)) - (cons :async - (lambda (cb) - (run-with-timer - 0.01 nil - (lambda () (funcall cb nil)))))) - (lambda (command) - (should (eq command 'prefix)) - "foo")))) - (should (equal "foo" (company-call-backend-raw 'prefix)))) - (let ((company-backend (list (lambda (_command) - (cons :async - (lambda (cb) - (run-with-timer - 0.01 nil - (lambda () (funcall cb "bar")))))) - (lambda (_command) - "foo")))) - (should (equal "bar" (company-call-backend-raw 'prefix)))))) - -(ert-deftest company-multi-backend-merges-deferred-candidates () - (with-temp-buffer - (let* ((immediate (lambda (command &optional _) - (pcase command - (`prefix "foo") - (`candidates - (cons :async - (lambda (cb) (funcall cb '("f")))))))) - (company-backend (list 'ignore - (lambda (command &optional arg) - (pcase command - (`prefix "foo") - (`candidates - (should (equal arg "foo")) - (cons :async - (lambda (cb) - (run-with-timer - 0.01 nil - (lambda () (funcall cb '("a" "b"))))))))) - (lambda (command &optional _) - (pcase command - (`prefix "foo") - (`candidates '("c" "d" "e")))) - immediate))) - (should (equal :async (car (company-call-backend-raw 'candidates "foo")))) - (should (equal '("a" "b" "c" "d" "e" "f") - (company-call-backend 'candidates "foo"))) - (let ((company-backend (list immediate))) - (should (equal '("f") (company-call-backend 'candidates "foo"))))))) - -(ert-deftest company-multi-backend-merges-deferred-candidates-2 () - (with-temp-buffer - (let ((company-backend (list (lambda (command &optional _) - (pcase command - (`prefix "foo") - (`candidates - (cons :async - (lambda (cb) (funcall cb '("a" "b"))))))) - (lambda (command &optional _) - (pcase command - (`prefix "foo") - (`candidates - (cons :async - (lambda (cb) (funcall cb '("c" "d"))))))) - (lambda (command &optional _) - (pcase command - (`prefix "foo") - (`candidates - (cons :async - (lambda (cb) (funcall cb '("e" "f")))))))))) - (should (equal :async (car (company-call-backend-raw 'candidates "foo")))) - (should (equal '("a" "b" "c" "d" "e" "f") - (company-call-backend 'candidates "foo")))))) - -(ert-deftest company-multi-backend-merges-deferred-candidates-3 () - (with-temp-buffer - (let ((company-backend (list (lambda (command &optional _) - (pcase command - (`prefix "foo") - (`candidates - (cons :async - (lambda (cb) (funcall cb '("a" "b"))))))) - (lambda (command &optional _) - (pcase command - (`prefix "foo") - (`candidates - (cons :async - (lambda (cb) - (run-with-timer - 0.01 nil - (lambda () - (funcall cb '("c" "d"))))))))) - (lambda (command &optional _) - (pcase command - (`prefix "foo") - (`candidates - (cons :async - (lambda (cb) - (run-with-timer - 0.01 nil - (lambda () - (funcall cb '("e" "f")))))))))))) - (should (equal :async (car (company-call-backend-raw 'candidates "foo")))) - (should (equal '("a" "b" "c" "d" "e" "f") - (company-call-backend 'candidates "foo")))))) diff --git a/elpa/company-0.8.12/test/clang-tests.el b/elpa/company-0.8.12/test/clang-tests.el deleted file mode 100644 index 09ba114..0000000 --- a/elpa/company-0.8.12/test/clang-tests.el +++ /dev/null @@ -1,46 +0,0 @@ -;;; clang-tests.el --- company-mode tests -*- lexical-binding: t -*- - -;; Copyright (C) 2015 Free Software Foundation, Inc. - -;; Author: Dmitry Gutov - -;; This file is part of GNU Emacs. - -;; GNU Emacs 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. - -;; GNU Emacs 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 GNU Emacs. If not, see . - -(require 'company-tests) -(require 'company-clang) - -(ert-deftest company-clang-objc-templatify () - (with-temp-buffer - (let ((text "createBookWithTitle:andAuthor:")) - (insert text) - (company-clang-objc-templatify text) - (should (equal "createBookWithTitle:arg0 andAuthor:arg1" (buffer-string))) - (should (looking-at "arg0")) - (should (null (overlay-get (company-template-field-at) 'display)))))) - -(ert-deftest company-clang-simple-annotation () - (let ((str (propertize - "foo" 'meta - "wchar_t * wmemchr(wchar_t *__p, wchar_t __c, size_t __n)"))) - (should (equal (company-clang 'annotation str) - "(wchar_t *__p, wchar_t __c, size_t __n)")))) - -(ert-deftest company-clang-generic-annotation () - (let ((str (propertize - "foo" 'meta - "shared_ptr<_Tp> make_shared(_Args &&__args...)"))) - (should (equal (company-clang 'annotation str) - "(_Args &&__args...)")))) diff --git a/elpa/company-0.8.12/test/core-tests.el b/elpa/company-0.8.12/test/core-tests.el deleted file mode 100644 index 13e547e..0000000 --- a/elpa/company-0.8.12/test/core-tests.el +++ /dev/null @@ -1,481 +0,0 @@ -;;; core-tests.el --- company-mode tests -*- lexical-binding: t -*- - -;; Copyright (C) 2015 Free Software Foundation, Inc. - -;; Author: Dmitry Gutov - -;; This file is part of GNU Emacs. - -;; GNU Emacs 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. - -;; GNU Emacs 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 GNU Emacs. If not, see . - -(require 'company-tests) - -(ert-deftest company-good-prefix () - (let ((company-minimum-prefix-length 5) - company-abort-manual-when-too-short - company--manual-action ;idle begin - (company-selection-changed t)) ;has no effect - (should (eq t (company--good-prefix-p "!@#$%"))) - (should (eq nil (company--good-prefix-p "abcd"))) - (should (eq nil (company--good-prefix-p 'stop))) - (should (eq t (company--good-prefix-p '("foo" . 5)))) - (should (eq nil (company--good-prefix-p '("foo" . 4)))) - (should (eq t (company--good-prefix-p '("foo" . t)))))) - -(ert-deftest company--manual-prefix-set-and-unset () - (with-temp-buffer - (insert "ab") - (company-mode) - (let (company-frontends - (company-backends - (list (lambda (command &optional _) - (cl-case command - (prefix (buffer-substring (point-min) (point))) - (candidates '("abc" "abd"))))))) - (company-manual-begin) - (should (equal "ab" company--manual-prefix)) - (company-abort) - (should (null company--manual-prefix))))) - -(ert-deftest company-abort-manual-when-too-short () - (let ((company-minimum-prefix-length 5) - (company-abort-manual-when-too-short t) - (company-selection-changed t)) ;has not effect - (let ((company--manual-action nil)) ;idle begin - (should (eq t (company--good-prefix-p "!@#$%"))) - (should (eq t (company--good-prefix-p '("foo" . 5)))) - (should (eq t (company--good-prefix-p '("foo" . t))))) - (let ((company--manual-action t) - (company--manual-prefix "abc")) ;manual begin from this prefix - (should (eq t (company--good-prefix-p "!@#$"))) - (should (eq nil (company--good-prefix-p "ab"))) - (should (eq nil (company--good-prefix-p 'stop))) - (should (eq t (company--good-prefix-p '("foo" . 4)))) - (should (eq t (company--good-prefix-p "abcd"))) - (should (eq t (company--good-prefix-p "abc"))) - (should (eq t (company--good-prefix-p '("bar" . t))))))) - -(ert-deftest company-common-with-non-prefix-completion () - (let ((company-backend #'ignore) - (company-prefix "abc") - company-candidates - company-candidates-length - company-candidates-cache - company-common) - (company-update-candidates '("abc" "def-abc")) - (should (null company-common)) - (company-update-candidates '("abc" "abe-c")) - (should (null company-common)) - (company-update-candidates '("abcd" "abcde" "abcdf")) - (should (equal "abcd" company-common)))) - -(ert-deftest company-multi-backend-with-lambdas () - (let ((company-backend - (list (lambda (command &optional _ &rest _r) - (cl-case command - (prefix "z") - (candidates '("a" "b")))) - (lambda (command &optional _ &rest _r) - (cl-case command - (prefix "z") - (candidates '("c" "d"))))))) - (should (equal (company-call-backend 'candidates "z") '("a" "b" "c" "d"))))) - -(ert-deftest company-multi-backend-filters-backends-by-prefix () - (let ((company-backend - (list (lambda (command &optional _ &rest _r) - (cl-case command - (prefix (cons "z" t)) - (candidates '("a" "b")))) - (lambda (command &optional _ &rest _r) - (cl-case command - (prefix "t") - (candidates '("c" "d")))) - (lambda (command &optional _ &rest _r) - (cl-case command - (prefix "z") - (candidates '("e" "f"))))))) - (should (equal (company-call-backend 'candidates "z") '("a" "b" "e" "f"))))) - -(ert-deftest company-multi-backend-remembers-candidate-backend () - (let ((company-backend - (list (lambda (command &optional _) - (cl-case command - (ignore-case nil) - (annotation "1") - (candidates '("a" "c")) - (post-completion "13"))) - (lambda (command &optional _) - (cl-case command - (ignore-case t) - (annotation "2") - (candidates '("b" "d")) - (post-completion "42"))) - (lambda (command &optional _) - (cl-case command - (annotation "3") - (candidates '("e")) - (post-completion "74")))))) - (let ((candidates (company-calculate-candidates nil))) - (should (equal candidates '("a" "b" "c" "d" "e"))) - (should (equal t (company-call-backend 'ignore-case))) - (should (equal "1" (company-call-backend 'annotation (nth 0 candidates)))) - (should (equal "2" (company-call-backend 'annotation (nth 1 candidates)))) - (should (equal "13" (company-call-backend 'post-completion (nth 2 candidates)))) - (should (equal "42" (company-call-backend 'post-completion (nth 3 candidates)))) - (should (equal "3" (company-call-backend 'annotation (nth 4 candidates)))) - (should (equal "74" (company-call-backend 'post-completion (nth 4 candidates))))))) - -(ert-deftest company-multi-backend-handles-keyword-with () - (let ((primo (lambda (command &optional _) - (cl-case command - (prefix "a") - (candidates '("abb" "abc" "abd"))))) - (secundo (lambda (command &optional _) - (cl-case command - (prefix "a") - (candidates '("acc" "acd")))))) - (let ((company-backend (list 'ignore 'ignore :with secundo))) - (should (null (company-call-backend 'prefix)))) - (let ((company-backend (list 'ignore primo :with secundo))) - (should (equal "a" (company-call-backend 'prefix))) - (should (equal '("abb" "abc" "abd" "acc" "acd") - (company-call-backend 'candidates "a")))))) - -(ert-deftest company-begin-backend-failure-doesnt-break-company-backends () - (with-temp-buffer - (insert "a") - (company-mode) - (should-error - (company-begin-backend #'ignore)) - (let (company-frontends - (company-backends - (list (lambda (command &optional _) - (cl-case command - (prefix "a") - (candidates '("a" "ab" "ac"))))))) - (let (this-command) - (company-call 'complete)) - (should (eq 3 company-candidates-length))))) - -(ert-deftest company-require-match-explicit () - (with-temp-buffer - (insert "ab") - (company-mode) - (let (company-frontends - (company-require-match 'company-explicit-action-p) - (company-backends - (list (lambda (command &optional _) - (cl-case command - (prefix (buffer-substring (point-min) (point))) - (candidates '("abc" "abd"))))))) - (let (this-command) - (company-complete)) - (let ((last-command-event ?e)) - (company-call 'self-insert-command 1)) - (should (eq 2 company-candidates-length)) - (should (eq 3 (point)))))) - -(ert-deftest company-dont-require-match-when-idle () - (with-temp-buffer - (insert "ab") - (company-mode) - (let (company-frontends - (company-minimum-prefix-length 2) - (company-require-match 'company-explicit-action-p) - (company-backends - (list (lambda (command &optional _) - (cl-case command - (prefix (buffer-substring (point-min) (point))) - (candidates '("abc" "abd"))))))) - (company-idle-begin (current-buffer) (selected-window) - (buffer-chars-modified-tick) (point)) - (should (eq 2 company-candidates-length)) - (let ((last-command-event ?e)) - (company-call 'self-insert-command 1)) - (should (eq nil company-candidates-length)) - (should (eq 4 (point)))))) - -(ert-deftest company-dont-require-match-if-was-a-match-and-old-prefix-ended () - (with-temp-buffer - (insert "ab") - (company-mode) - (let (company-frontends - company-auto-complete - (company-require-match t) - (company-backends - (list (lambda (command &optional _) - (cl-case command - (prefix (company-grab-word)) - (candidates '("abc" "ab" "abd")) - (sorted t)))))) - (let (this-command) - (company-complete)) - (let ((last-command-event ?e)) - (company-call 'self-insert-command 1)) - (should (eq 3 company-candidates-length)) - (should (eq 3 (point))) - (let ((last-command-event ? )) - (company-call 'self-insert-command 1)) - (should (null company-candidates-length)) - (should (eq 4 (point)))))) - -(ert-deftest company-dont-require-match-if-was-a-match-and-new-prefix-is-stop () - (with-temp-buffer - (company-mode) - (insert "c") - (let (company-frontends - (company-require-match t) - (company-backends - (list (lambda (command &optional _) - (cl-case command - (prefix (if (> (point) 2) - 'stop - (buffer-substring (point-min) (point)))) - (candidates '("a" "b" "c"))))))) - (let (this-command) - (company-complete)) - (should (eq 3 company-candidates-length)) - (let ((last-command-event ?e)) - (company-call 'self-insert-command 1)) - (should (not company-candidates))))) - -(ert-deftest company-should-complete-whitelist () - (with-temp-buffer - (insert "ab") - (company-mode) - (let (company-frontends - company-begin-commands - (company-backends - (list (lambda (command &optional _) - (cl-case command - (prefix (buffer-substring (point-min) (point))) - (candidates '("abc" "abd"))))))) - (let ((company-continue-commands nil)) - (let (this-command) - (company-complete)) - (company-call 'backward-delete-char 1) - (should (null company-candidates-length))) - (let ((company-continue-commands '(backward-delete-char))) - (let (this-command) - (company-complete)) - (company-call 'backward-delete-char 1) - (should (eq 2 company-candidates-length)))))) - -(ert-deftest company-should-complete-blacklist () - (with-temp-buffer - (insert "ab") - (company-mode) - (let (company-frontends - company-begin-commands - (company-backends - (list (lambda (command &optional _) - (cl-case command - (prefix (buffer-substring (point-min) (point))) - (candidates '("abc" "abd"))))))) - (let ((company-continue-commands '(not backward-delete-char))) - (let (this-command) - (company-complete)) - (company-call 'backward-delete-char 1) - (should (null company-candidates-length))) - (let ((company-continue-commands '(not backward-delete-char-untabify))) - (let (this-command) - (company-complete)) - (company-call 'backward-delete-char 1) - (should (eq 2 company-candidates-length)))))) - -(ert-deftest company-auto-complete-explicit () - (with-temp-buffer - (insert "ab") - (company-mode) - (let (company-frontends - (company-auto-complete 'company-explicit-action-p) - (company-auto-complete-chars '(? )) - (company-backends - (list (lambda (command &optional _) - (cl-case command - (prefix (buffer-substring (point-min) (point))) - (candidates '("abcd" "abef"))))))) - (let (this-command) - (company-complete)) - (let ((last-command-event ? )) - (company-call 'self-insert-command 1)) - (should (string= "abcd " (buffer-string)))))) - -(ert-deftest company-no-auto-complete-when-idle () - (with-temp-buffer - (insert "ab") - (company-mode) - (let (company-frontends - (company-auto-complete 'company-explicit-action-p) - (company-auto-complete-chars '(? )) - (company-minimum-prefix-length 2) - (company-backends - (list (lambda (command &optional _) - (cl-case command - (prefix (buffer-substring (point-min) (point))) - (candidates '("abcd" "abef"))))))) - (company-idle-begin (current-buffer) (selected-window) - (buffer-chars-modified-tick) (point)) - (let ((last-command-event ? )) - (company-call 'self-insert-command 1)) - (should (string= "ab " (buffer-string)))))) - -(ert-deftest company-clears-explicit-action-when-no-matches () - (with-temp-buffer - (company-mode) - (let (company-frontends - company-backends) - (company-call 'manual-begin) ;; fails - (should (null company-candidates)) - (should (null (company-explicit-action-p)))))) - -(ert-deftest company-ignore-case-replaces-prefix () - (with-temp-buffer - (company-mode) - (let (company-frontends - (company-backends - (list (lambda (command &optional _) - (cl-case command - (prefix (buffer-substring (point-min) (point))) - (candidates '("abcd" "abef")) - (ignore-case t)))))) - (insert "A") - (let (this-command) - (company-complete)) - (should (string= "ab" (buffer-string))) - (delete-char -2) - (insert "A") ; hack, to keep it in one test - (company-complete-selection) - (should (string= "abcd" (buffer-string)))))) - -(ert-deftest company-ignore-case-with-keep-prefix () - (with-temp-buffer - (insert "AB") - (company-mode) - (let (company-frontends - (company-backends - (list (lambda (command &optional _) - (cl-case command - (prefix (buffer-substring (point-min) (point))) - (candidates '("abcd" "abef")) - (ignore-case 'keep-prefix)))))) - (let (this-command) - (company-complete)) - (company-complete-selection) - (should (string= "ABcd" (buffer-string)))))) - -(ert-deftest company-non-prefix-completion () - (with-temp-buffer - (insert "tc") - (company-mode) - (let (company-frontends - (company-backends - (list (lambda (command &optional _) - (cl-case command - (prefix (buffer-substring (point-min) (point))) - (candidates '("tea-cup" "teal-color"))))))) - (let (this-command) - (company-complete)) - (should (string= "tc" (buffer-string))) - (company-complete-selection) - (should (string= "tea-cup" (buffer-string)))))) - -(defvar ct-sorted nil) - -(defun ct-equal-including-properties (list1 list2) - (or (and (not list1) (not list2)) - (and (ert-equal-including-properties (car list1) (car list2)) - (ct-equal-including-properties (cdr list1) (cdr list2))))) - -(ert-deftest company-strips-duplicates-within-groups () - (let* ((kvs '(("a" . "b") - ("a" . nil) - ("a" . "b") - ("a" . "c") - ("a" . "b") - ("b" . "c") - ("b" . nil) - ("a" . "b"))) - (fn (lambda (kvs) - (mapcar (lambda (kv) (propertize (car kv) 'ann (cdr kv))) - kvs))) - (company-backend - (lambda (command &optional arg) - (pcase command - (`prefix "") - (`sorted ct-sorted) - (`duplicates t) - (`annotation (get-text-property 0 'ann arg))))) - (reference '(("a" . "b") - ("a" . nil) - ("a" . "c") - ("b" . "c") - ("b" . nil) - ("a" . "b")))) - (let ((ct-sorted t)) - (should (ct-equal-including-properties - (company--preprocess-candidates (funcall fn kvs)) - (funcall fn reference)))) - (should (ct-equal-including-properties - (company--preprocess-candidates (funcall fn kvs)) - (funcall fn (butlast reference)))))) - -;;; Row and column - -(ert-deftest company-column-with-composition () - :tags '(interactive) - (with-temp-buffer - (save-window-excursion - (set-window-buffer nil (current-buffer)) - (insert "lambda ()") - (compose-region 1 (1+ (length "lambda")) "\\") - (should (= (company--column) 4))))) - -(ert-deftest company-column-with-line-prefix () - :tags '(interactive) - (with-temp-buffer - (save-window-excursion - (set-window-buffer nil (current-buffer)) - (insert "foo") - (put-text-property (point-min) (point) 'line-prefix " ") - (should (= (company--column) 5))))) - -(ert-deftest company-column-with-line-prefix-on-empty-line () - :tags '(interactive) - (with-temp-buffer - (save-window-excursion - (set-window-buffer nil (current-buffer)) - (insert "\n") - (forward-char -1) - (put-text-property (point-min) (point-max) 'line-prefix " ") - (should (= (company--column) 2))))) - -(ert-deftest company-column-with-tabs () - :tags '(interactive) - (with-temp-buffer - (save-window-excursion - (set-window-buffer nil (current-buffer)) - (insert "|\t|\t|\t(") - (let ((tab-width 8)) - (should (= (company--column) 25)))))) - -(ert-deftest company-row-with-header-line-format () - :tags '(interactive) - (with-temp-buffer - (save-window-excursion - (set-window-buffer nil (current-buffer)) - (should (= (company--row) 0)) - (setq header-line-format "aaaaaaa") - (should (= (company--row) 0))))) diff --git a/elpa/company-0.8.12/test/elisp-tests.el b/elpa/company-0.8.12/test/elisp-tests.el deleted file mode 100644 index 7fd02de..0000000 --- a/elpa/company-0.8.12/test/elisp-tests.el +++ /dev/null @@ -1,190 +0,0 @@ -;;; elisp-tests.el --- company-elisp tests - -;; Copyright (C) 2013-2015 Free Software Foundation, Inc. - -;; Author: Dmitry Gutov - -;; This file is part of GNU Emacs. - -;; GNU Emacs 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. - -;; GNU Emacs 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 GNU Emacs. If not, see . - -;;; Code: - -(require 'company-tests) -(require 'company-elisp) - -(defmacro company-elisp-with-buffer (contents &rest body) - (declare (indent 0)) - `(with-temp-buffer - (insert ,contents) - (setq major-mode 'emacs-lisp-mode) - (re-search-backward "|") - (replace-match "") - (let ((company-elisp-detect-function-context t)) - ,@body))) - -(ert-deftest company-elisp-candidates-predicate () - (company-elisp-with-buffer - "(foo ba|)" - (should (eq (company-elisp--candidates-predicate "ba") - 'boundp)) - (should (eq (let (company-elisp-detect-function-context) - (company-elisp--candidates-predicate "ba")) - 'company-elisp--predicate))) - (company-elisp-with-buffer - "(foo| )" - (should (eq (company-elisp--candidates-predicate "foo") - 'fboundp)) - (should (eq (let (company-elisp-detect-function-context) - (company-elisp--candidates-predicate "foo")) - 'company-elisp--predicate))) - (company-elisp-with-buffer - "(foo 'b|)" - (should (eq (company-elisp--candidates-predicate "b") - 'company-elisp--predicate)))) - -(ert-deftest company-elisp-candidates-predicate-in-docstring () - (company-elisp-with-buffer - "(def foo () \"Doo be doo `ide|" - (should (eq 'company-elisp--predicate - (company-elisp--candidates-predicate "ide"))))) - -;; This one's also an integration test. -(ert-deftest company-elisp-candidates-recognizes-binding-form () - (let ((company-elisp-detect-function-context t) - (obarray [when what whelp]) - (what 1) - (whelp 2) - (wisp 3)) - (company-elisp-with-buffer - "(let ((foo 7) (wh| )))" - (should (equal '("what" "whelp") - (company-elisp-candidates "wh")))) - (company-elisp-with-buffer - "(cond ((null nil) (wh| )))" - (should (equal '("when") - (company-elisp-candidates "wh")))))) - -(ert-deftest company-elisp-candidates-predicate-binding-without-value () - (cl-loop for (text prefix predicate) in '(("(let (foo|" "foo" boundp) - ("(let (foo (bar|" "bar" boundp) - ("(let (foo) (bar|" "bar" fboundp)) - do - (eval `(company-elisp-with-buffer - ,text - (should (eq ',predicate - (company-elisp--candidates-predicate ,prefix))))))) - -(ert-deftest company-elisp-finds-vars () - (let ((obarray [boo bar baz backquote]) - (boo t) - (bar t) - (baz t)) - (should (equal '("bar" "baz") - (company-elisp--globals "ba" 'boundp))))) - -(ert-deftest company-elisp-finds-functions () - (let ((obarray [when what whelp]) - (what t) - (whelp t)) - (should (equal '("when") - (company-elisp--globals "wh" 'fboundp))))) - -(ert-deftest company-elisp-finds-things () - (let ((obarray [when what whelp]) - (what t) - (whelp t)) - (should (equal '("what" "whelp" "when") - (sort (company-elisp--globals "wh" 'company-elisp--predicate) - 'string<))))) - -(ert-deftest company-elisp-locals-vars () - (company-elisp-with-buffer - "(let ((foo 5) (bar 6)) - (cl-labels ((borg ())) - (lambda (boo baz) - b|)))" - (should (equal '("bar" "baz" "boo") - (company-elisp--locals "b" nil))))) - -(ert-deftest company-elisp-locals-single-var () - (company-elisp-with-buffer - "(dotimes (itk 100) - (dolist (item items) - it|))" - (should (equal '("itk" "item") - (company-elisp--locals "it" nil))))) - -(ert-deftest company-elisp-locals-funs () - (company-elisp-with-buffer - "(cl-labels ((foo ()) - (fee ())) - (let ((fun 4)) - (f| )))" - (should (equal '("fee" "foo") - (sort (company-elisp--locals "f" t) 'string<))))) - -(ert-deftest company-elisp-locals-skips-current-varlist () - (company-elisp-with-buffer - "(let ((foo 1) - (f| )))" - (should (null (company-elisp--locals "f" nil))))) - -(ert-deftest company-elisp-show-locals-first () - (company-elisp-with-buffer - "(let ((floo 1) - (flop 2) - (flee 3)) - fl|)" - (let ((obarray [float-pi])) - (let (company-elisp-show-locals-first) - (should (eq nil (company-elisp 'sorted)))) - (let ((company-elisp-show-locals-first t)) - (should (eq t (company-elisp 'sorted))) - (should (equal '("flee" "floo" "flop" "float-pi") - (company-elisp-candidates "fl"))))))) - -(ert-deftest company-elisp-candidates-no-duplicates () - (company-elisp-with-buffer - "(let ((float-pi 4)) - f|)" - (let ((obarray [float-pi]) - (company-elisp-show-locals-first t)) - (should (equal '("float-pi") (company-elisp-candidates "f")))))) - -(ert-deftest company-elisp-shouldnt-complete-defun-name () - (company-elisp-with-buffer - "(defun foob|)" - (should (null (company-elisp 'prefix))))) - -(ert-deftest company-elisp-should-complete-def-call () - (company-elisp-with-buffer - "(defu|" - (should (equal "defu" (company-elisp 'prefix))))) - -(ert-deftest company-elisp-should-complete-in-defvar () - ;; It will also complete the var name, at least for now. - (company-elisp-with-buffer - "(defvar abc de|" - (should (equal "de" (company-elisp 'prefix))))) - -(ert-deftest company-elisp-shouldnt-complete-in-defun-arglist () - (company-elisp-with-buffer - "(defsubst foobar (ba|" - (should (null (company-elisp 'prefix))))) - -(ert-deftest company-elisp-prefix-in-defun-body () - (company-elisp-with-buffer - "(defun foob ()|)" - (should (equal "" (company-elisp 'prefix))))) diff --git a/elpa/company-0.8.12/test/frontends-tests.el b/elpa/company-0.8.12/test/frontends-tests.el deleted file mode 100644 index 613856e..0000000 --- a/elpa/company-0.8.12/test/frontends-tests.el +++ /dev/null @@ -1,332 +0,0 @@ -;;; frontends-tests.el --- company-mode tests -*- lexical-binding: t -*- - -;; Copyright (C) 2015 Free Software Foundation, Inc. - -;; Author: Dmitry Gutov - -;; This file is part of GNU Emacs. - -;; GNU Emacs 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. - -;; GNU Emacs 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 GNU Emacs. If not, see . - -(require 'company-tests) - -(ert-deftest company-pseudo-tooltip-does-not-get-displaced () - :tags '(interactive) - (with-temp-buffer - (save-window-excursion - (set-window-buffer nil (current-buffer)) - (save-excursion (insert " ff")) - (company-mode) - (let ((company-frontends '(company-pseudo-tooltip-frontend)) - (company-begin-commands '(self-insert-command)) - (company-backends - (list (lambda (c &optional _) - (cl-case c (prefix "") (candidates '("a" "b" "c"))))))) - (let (this-command) - (company-call 'complete)) - (company-call 'open-line 1) - (should (eq 1 (overlay-start company-pseudo-tooltip-overlay))))))) - -(ert-deftest company-pseudo-tooltip-show () - :tags '(interactive) - (with-temp-buffer - (save-window-excursion - (set-window-buffer nil (current-buffer)) - (insert "aaaa\n bb\nccccccc\nddd") - (search-backward "bb") - (let ((col (company--column)) - (company-candidates-length 2) - (company-candidates '("123" "45")) - (company-backend 'ignore)) - (company-pseudo-tooltip-show (company--row) col 0) - (let ((ov company-pseudo-tooltip-overlay)) - ;; With margins. - (should (eq (overlay-get ov 'company-width) 5)) - ;; FIXME: Make it 2? - (should (eq (overlay-get ov 'company-height) company-tooltip-limit)) - (should (eq (overlay-get ov 'company-column) col)) - (should (string= (overlay-get ov 'company-display) - "\n 123 \nc 45 c\nddd\n"))))))) - -(ert-deftest company-pseudo-tooltip-edit-updates-width () - :tags '(interactive) - (with-temp-buffer - (set-window-buffer nil (current-buffer)) - (let ((company-candidates-length 5) - (company-candidates '("123" "45" "67" "89" "1011")) - (company-backend 'ignore) - (company-tooltip-limit 4) - (company-tooltip-offset-display 'scrollbar)) - (company-pseudo-tooltip-show (company--row) - (company--column) - 0) - (should (eq (overlay-get company-pseudo-tooltip-overlay 'company-width) - 6)) - (company-pseudo-tooltip-edit 4) - (should (eq (overlay-get company-pseudo-tooltip-overlay 'company-width) - 7))))) - -(ert-deftest company-preview-show-with-annotations () - :tags '(interactive) - (with-temp-buffer - (save-window-excursion - (set-window-buffer nil (current-buffer)) - (save-excursion (insert "\n")) - (let ((company-candidates-length 1) - (company-candidates '("123"))) - (company-preview-show-at-point (point)) - (let* ((ov company-preview-overlay) - (str (overlay-get ov 'after-string))) - (should (string= str "123")) - (should (eq (get-text-property 0 'cursor str) 1))))))) - -(ert-deftest company-pseudo-tooltip-show-with-annotations () - :tags '(interactive) - (with-temp-buffer - (save-window-excursion - (set-window-buffer nil (current-buffer)) - (insert " ") - (save-excursion (insert "\n")) - (let ((company-candidates-length 2) - (company-backend (lambda (action &optional arg &rest _ignore) - (when (eq action 'annotation) - (cdr (assoc arg '(("123" . "(4)"))))))) - (company-candidates '("123" "45")) - company-tooltip-align-annotations) - (company-pseudo-tooltip-show-at-point (point) 0) - (let ((ov company-pseudo-tooltip-overlay)) - ;; With margins. - (should (eq (overlay-get ov 'company-width) 8)) - (should (string= (overlay-get ov 'company-display) - "\n 123(4) \n 45 \n"))))))) - -(ert-deftest company-pseudo-tooltip-show-with-annotations-right-aligned () - :tags '(interactive) - (with-temp-buffer - (save-window-excursion - (set-window-buffer nil (current-buffer)) - (insert " ") - (save-excursion (insert "\n")) - (let ((company-candidates-length 3) - (company-backend (lambda (action &optional arg &rest _ignore) - (when (eq action 'annotation) - (cdr (assoc arg '(("123" . "(4)") - ("67" . "(891011)"))))))) - (company-candidates '("123" "45" "67")) - (company-tooltip-align-annotations t)) - (company-pseudo-tooltip-show-at-point (point) 0) - (let ((ov company-pseudo-tooltip-overlay)) - ;; With margins. - (should (eq (overlay-get ov 'company-width) 13)) - (should (string= (overlay-get ov 'company-display) - "\n 123 (4) \n 45 \n 67 (891011) \n"))))))) - -(ert-deftest company-create-lines-shows-numbers () - (let ((company-show-numbers t) - (company-candidates '("x" "y" "z")) - (company-candidates-length 3) - (company-backend 'ignore)) - (should (equal '(" x 1 " " y 2 " " z 3 ") - (company--create-lines 0 999))))) - -(ert-deftest company-create-lines-truncates-annotations () - (let* ((ww (company--window-width)) - (data `(("1" . "(123)") - ("2" . nil) - ("3" . ,(concat "(" (make-string (- ww 2) ?4) ")")) - (,(make-string ww ?4) . "<4>"))) - (company-candidates (mapcar #'car data)) - (company-candidates-length 4) - (company-tooltip-margin 1) - (company-backend (lambda (cmd &optional arg) - (when (eq cmd 'annotation) - (cdr (assoc arg data))))) - company-tooltip-align-annotations) - (should (equal (list (format " 1(123)%s " (company-space-string (- ww 8))) - (format " 2%s " (company-space-string (- ww 3))) - (format " 3(444%s " (make-string (- ww 7) ?4)) - (format " %s " (make-string (- ww 2) ?4))) - (company--create-lines 0 999))) - (let ((company-tooltip-align-annotations t)) - (should (equal (list (format " 1%s(123) " (company-space-string (- ww 8))) - (format " 2%s " (company-space-string (- ww 3))) - (format " 3 (444%s " (make-string (- ww 8) ?4)) - (format " %s " (make-string (- ww 2) ?4))) - (company--create-lines 0 999)))))) - -(ert-deftest company-create-lines-truncates-common-part () - (let* ((ww (company--window-width)) - (company-candidates-length 2) - (company-tooltip-margin 1) - (company-backend #'ignore)) - (let* ((company-common (make-string (- ww 3) ?1)) - (company-candidates `(,(concat company-common "2") - ,(concat company-common "3")))) - (should (equal (list (format " %s2 " (make-string (- ww 3) ?1)) - (format " %s3 " (make-string (- ww 3) ?1))) - (company--create-lines 0 999)))) - (let* ((company-common (make-string (- ww 2) ?1)) - (company-candidates `(,(concat company-common "2") - ,(concat company-common "3")))) - (should (equal (list (format " %s " company-common) - (format " %s " company-common)) - (company--create-lines 0 999)))) - (let* ((company-common (make-string ww ?1)) - (company-candidates `(,(concat company-common "2") - ,(concat company-common "3"))) - (res (company--create-lines 0 999))) - (should (equal (list (format " %s " (make-string (- ww 2) ?1)) - (format " %s " (make-string (- ww 2) ?1))) - res)) - (should (eq 'company-tooltip-common-selection - (get-text-property (- ww 2) 'face - (car res)))) - (should (eq 'company-tooltip-selection - (get-text-property (1- ww) 'face - (car res)))) - ))) - -(ert-deftest company-create-lines-clears-out-non-printables () - :tags '(interactive) - (let (company-show-numbers - (company-candidates (list - (decode-coding-string "avalis\351e" 'utf-8) - "avatar")) - (company-candidates-length 2) - (company-backend 'ignore)) - (should (equal '(" avalis‗e " - " avatar ") - (company--create-lines 0 999))))) - -(ert-deftest company-create-lines-handles-multiple-width () - :tags '(interactive) - (let (company-show-numbers - (company-candidates '("蛙蛙蛙蛙" "è›™abc")) - (company-candidates-length 2) - (company-backend 'ignore)) - (should (equal '(" 蛙蛙蛙蛙 " - " 蛙abc ") - (company--create-lines 0 999))))) - -(ert-deftest company-create-lines-handles-multiple-width-in-annotation () - (let* (company-show-numbers - (alist '(("a" . " ︸") ("b" . " ︸︸"))) - (company-candidates (mapcar #'car alist)) - (company-candidates-length 2) - (company-backend (lambda (c &optional a) - (when (eq c 'annotation) - (assoc-default a alist))))) - (should (equal '(" a ︸ " - " b ︸︸ ") - (company--create-lines 0 999))))) - -(ert-deftest company-create-lines-with-multiple-width-and-keep-prefix () - :tags '(interactive) - (let* (company-show-numbers - (company-candidates '("MIRAI発売1カ月" - "MIRAI発売2カ月")) - (company-candidates-length 2) - (company-prefix "MIRAI発") - (company-backend (lambda (c &optional _arg) - (pcase c - (`ignore-case 'keep-prefix))))) - (should (equal '(" MIRAI発売1カ月 " - " MIRAI発売2カ月 ") - (company--create-lines 0 999))))) - -(ert-deftest company-fill-propertize-truncates-search-highlight () - (let ((company-search-string "foo") - (company-backend #'ignore) - (company-prefix "")) - (should (equal-including-properties - (company-fill-propertize "barfoo" nil 6 t nil nil) - #("barfoo" - 0 3 (face company-tooltip mouse-face company-tooltip-mouse) - 3 6 (face company-tooltip-search mouse-face company-tooltip-mouse)))) - (should (equal-including-properties - (company-fill-propertize "barfoo" nil 5 t "" " ") - #("barfo " - 0 3 (face company-tooltip mouse-face company-tooltip-mouse) - 3 5 (face company-tooltip-search mouse-face company-tooltip-mouse) - 5 6 (face company-tooltip mouse-face company-tooltip-mouse)))) - (should (equal-including-properties - (company-fill-propertize "barfoo" nil 3 t " " " ") - #(" bar " - 0 5 (face company-tooltip mouse-face company-tooltip-mouse)))))) - -(ert-deftest company-column-with-composition () - :tags '(interactive) - (with-temp-buffer - (save-window-excursion - (set-window-buffer nil (current-buffer)) - (insert "lambda ()") - (compose-region 1 (1+ (length "lambda")) "\\") - (should (= (company--column) 4))))) - -(ert-deftest company-plainify () - (let ((tab-width 8)) - (should (equal-including-properties - (company-plainify "\tabc\td\t") - (concat " " - "abc " - "d ")))) - (should (equal-including-properties - (company-plainify (propertize "foobar" 'line-prefix "-*-")) - "-*-foobar"))) - -(ert-deftest company-buffer-lines-with-lines-folded () - :tags '(interactive) - (with-temp-buffer - (insert (propertize "aaa\nbbb\nccc\nddd\n" 'display "aaa+\n")) - (insert "eee\nfff\nggg") - (should (equal (company-buffer-lines (point-min) (point-max)) - '("aaa" "eee" "fff" "ggg"))))) - -(ert-deftest company-buffer-lines-with-multiline-display () - :tags '(interactive) - (with-temp-buffer - (insert (propertize "a" 'display "bbb\nccc\ndddd\n")) - (insert "eee\nfff\nggg") - (should (equal (company-buffer-lines (point-min) (point-max)) - '("" "" "" "eee" "fff" "ggg"))))) - -(ert-deftest company-buffer-lines-with-multiline-after-string-at-eob () - :tags '(interactive) - (with-temp-buffer - (insert "a\nb\nc\n") - (let ((ov (make-overlay (point-max) (point-max) nil t t))) - (overlay-put ov 'after-string "~\n~\n~")) - (should (equal (company-buffer-lines (point-min) (point-max)) - '("a" "b" "c"))))) - -(ert-deftest company-modify-line () - (let ((str "-*-foobar")) - (should (equal-including-properties - (company-modify-line str "zz" 4) - "-*-fzzbar")) - (should (equal-including-properties - (company-modify-line str "xx" 0) - "xx-foobar")) - (should (equal-including-properties - (company-modify-line str "zz" 10) - "-*-foobar zz")))) - -(ert-deftest company-scrollbar-bounds () - (should (equal nil (company--scrollbar-bounds 0 3 3))) - (should (equal nil (company--scrollbar-bounds 0 4 3))) - (should (equal '(0 . 0) (company--scrollbar-bounds 0 1 2))) - (should (equal '(1 . 1) (company--scrollbar-bounds 2 2 4))) - (should (equal '(2 . 3) (company--scrollbar-bounds 7 4 12))) - (should (equal '(1 . 2) (company--scrollbar-bounds 3 4 12))) - (should (equal '(1 . 3) (company--scrollbar-bounds 4 5 11)))) diff --git a/elpa/company-0.8.12/test/keywords-tests.el b/elpa/company-0.8.12/test/keywords-tests.el deleted file mode 100644 index 05843b2..0000000 --- a/elpa/company-0.8.12/test/keywords-tests.el +++ /dev/null @@ -1,32 +0,0 @@ -;;; keywords-tests.el --- company-keywords tests -*- lexical-binding: t -*- - -;; Copyright (C) 2011, 2013-2015 Free Software Foundation, Inc. - -;; Author: Nikolaj Schumacher - -;; This file is part of GNU Emacs. - -;; GNU Emacs 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. - -;; GNU Emacs 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 GNU Emacs. If not, see . - -(require 'company-keywords) - -(ert-deftest company-sorted-keywords () - "Test that keywords in `company-keywords-alist' are in alphabetical order." - (dolist (pair company-keywords-alist) - (when (consp (cdr pair)) - (let ((prev (cadr pair))) - (dolist (next (cddr pair)) - (should (not (equal prev next))) - (should (string< prev next)) - (setq prev next)))))) diff --git a/elpa/company-0.8.12/test/template-tests.el b/elpa/company-0.8.12/test/template-tests.el deleted file mode 100644 index 09548c4..0000000 --- a/elpa/company-0.8.12/test/template-tests.el +++ /dev/null @@ -1,91 +0,0 @@ -;;; template-tests.el --- company-mode tests -*- lexical-binding: t -*- - -;; Copyright (C) 2015 Free Software Foundation, Inc. - -;; Author: Dmitry Gutov - -;; This file is part of GNU Emacs. - -;; GNU Emacs 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. - -;; GNU Emacs 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 GNU Emacs. If not, see . - -(require 'company-tests) -(require 'company-template) - -(ert-deftest company-template-removed-after-the-last-jump () - (with-temp-buffer - (insert "{ }") - (goto-char 2) - (let ((tpl (company-template-declare-template (point) (1- (point-max))))) - (save-excursion - (dotimes (_ 2) - (insert " ") - (company-template-add-field tpl (point) "foo"))) - (company-call 'template-forward-field) - (should (= 3 (point))) - (company-call 'template-forward-field) - (should (= 7 (point))) - (company-call 'template-forward-field) - (should (= 11 (point))) - (should (zerop (length (overlay-get tpl 'company-template-fields)))) - (should (null (overlay-buffer tpl)))))) - -(ert-deftest company-template-removed-after-input-and-jump () - (with-temp-buffer - (insert "{ }") - (goto-char 2) - (let ((tpl (company-template-declare-template (point) (1- (point-max))))) - (save-excursion - (insert " ") - (company-template-add-field tpl (point) "bar")) - (company-call 'template-move-to-first tpl) - (should (= 3 (point))) - (dolist (c (string-to-list "tee")) - (let ((last-command-event c)) - (company-call 'self-insert-command 1))) - (should (string= "{ tee }" (buffer-string))) - (should (overlay-buffer tpl)) - (company-call 'template-forward-field) - (should (= 7 (point))) - (should (null (overlay-buffer tpl)))))) - -(ert-deftest company-template-c-like-templatify () - (with-temp-buffer - (let ((text "foo(int a, short b)")) - (insert text) - (company-template-c-like-templatify text) - (should (equal "foo(arg0, arg1)" (buffer-string))) - (should (looking-at "arg0")) - (should (equal "int a" - (overlay-get (company-template-field-at) 'display)))))) - -(ert-deftest company-template-c-like-templatify-trims-after-closing-paren () - (with-temp-buffer - (let ((text "foo(int a, short b)!@ #1334 a")) - (insert text) - (company-template-c-like-templatify text) - (should (equal "foo(arg0, arg1)" (buffer-string))) - (should (looking-at "arg0"))))) - -(ert-deftest company-template-c-like-templatify-generics () - (with-temp-buffer - (let ((text "foo(int i, Dict, long l)")) - (insert text) - (company-template-c-like-templatify text) - (should (equal "foo(arg2, arg3, arg4)" (buffer-string))) - (should (looking-at "arg0")) - (should (equal "TKey" (overlay-get (company-template-field-at) 'display))) - (search-forward "arg3") - (forward-char -1) - (should (equal "Dict" - (overlay-get (company-template-field-at) 'display)))))) diff --git a/elpa/company-0.8.12/test/transformers-tests.el b/elpa/company-0.8.12/test/transformers-tests.el deleted file mode 100644 index 4d027e5..0000000 --- a/elpa/company-0.8.12/test/transformers-tests.el +++ /dev/null @@ -1,58 +0,0 @@ -;;; transformers-tests.el --- company-mode tests -*- lexical-binding: t -*- - -;; Copyright (C) 2015 Free Software Foundation, Inc. - -;; Author: Dmitry Gutov - -;; This file is part of GNU Emacs. - -;; GNU Emacs 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. - -;; GNU Emacs 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 GNU Emacs. If not, see . - -(require 'company-tests) - -(ert-deftest company-occurrence-prefer-closest-above () - (with-temp-buffer - (save-window-excursion - (set-window-buffer nil (current-buffer)) - (insert "foo0 -foo1 -") - (save-excursion - (insert " -foo3 -foo2")) - (let ((company-backend 'company-dabbrev) - (company-occurrence-weight-function - 'company-occurrence-prefer-closest-above)) - (should (equal '("foo1" "foo0" "foo3" "foo2" "foo4") - (company-sort-by-occurrence - '("foo0" "foo1" "foo2" "foo3" "foo4")))))))) - -(ert-deftest company-occurrence-prefer-any-closest () - (with-temp-buffer - (save-window-excursion - (set-window-buffer nil (current-buffer)) - (insert "foo0 -foo1 -") - (save-excursion - (insert " -foo3 -foo2")) - (let ((company-backend 'company-dabbrev) - (company-occurrence-weight-function - 'company-occurrence-prefer-any-closest)) - (should (equal '("foo1" "foo3" "foo0" "foo2" "foo4") - (company-sort-by-occurrence - '("foo0" "foo1" "foo2" "foo3" "foo4")))))))) diff --git a/elpa/company-0.8.12/company-abbrev.el b/elpa/company-20160413.1347/company-abbrev.el similarity index 85% rename from elpa/company-0.8.12/company-abbrev.el rename to elpa/company-20160413.1347/company-abbrev.el index a454aaa..24ec3b7 100644 --- a/elpa/company-0.8.12/company-abbrev.el +++ b/elpa/company-20160413.1347/company-abbrev.el @@ -1,6 +1,6 @@ -;;; company-abbrev.el --- company-mode completion back-end for abbrev +;;; company-abbrev.el --- company-mode completion backend for abbrev -;; Copyright (C) 2009-2011 Free Software Foundation, Inc. +;; Copyright (C) 2009-2011, 2015 Free Software Foundation, Inc. ;; Author: Nikolaj Schumacher @@ -35,7 +35,7 @@ ;;;###autoload (defun company-abbrev (command &optional arg &rest ignored) - "`company-mode' completion back-end for abbrev." + "`company-mode' completion backend for abbrev." (interactive (list 'interactive)) (cl-case command (interactive (company-begin-backend 'company-abbrev @@ -44,8 +44,7 @@ (candidates (nconc (delete "" (all-completions arg global-abbrev-table)) (delete "" (all-completions arg local-abbrev-table)))) - (meta (abbrev-expansion arg)) - (require-match t))) + (meta (abbrev-expansion arg)))) (provide 'company-abbrev) ;;; company-abbrev.el ends here diff --git a/elpa/company-0.8.12/company-autoloads.el b/elpa/company-20160413.1347/company-autoloads.el similarity index 63% rename from elpa/company-0.8.12/company-autoloads.el rename to elpa/company-20160413.1347/company-autoloads.el index 4f657b9..1a7f37b 100644 --- a/elpa/company-0.8.12/company-autoloads.el +++ b/elpa/company-20160413.1347/company-autoloads.el @@ -3,8 +3,8 @@ ;;; Code: (add-to-list 'load-path (or (file-name-directory #$) (car load-path))) -;;;### (autoloads nil "company" "company.el" (21831 16638 858187 -;;;;;; 859000)) +;;;### (autoloads nil "company" "company.el" (22297 19838 628699 +;;;;;; 424000)) ;;; Generated autoloads from company.el (autoload 'company-mode "company" "\ @@ -22,9 +22,12 @@ Completions can be searched with `company-search-candidates' or inactive, as well. The completion data is retrieved using `company-backends' and displayed -using `company-frontends'. If you want to start a specific back-end, call +using `company-frontends'. If you want to start a specific backend, call it interactively or use `company-begin-backend'. +By default, the completions list is sorted alphabetically, unless the +backend chooses otherwise, or `company-transformers' changes it later. + regular keymap (`company-mode-map'): \\{company-mode-map} @@ -55,93 +58,106 @@ See `company-mode' for more information on Company mode. \(fn &optional ARG)" t nil) +(autoload 'company-manual-begin "company" "\ + + +\(fn)" t nil) + +(autoload 'company-complete "company" "\ +Insert the common part of all candidates or the current selection. +The first time this is called, the common part is inserted, the second +time, or when the selection has been changed, the selected candidate is +inserted. + +\(fn)" t nil) + ;;;*** -;;;### (autoloads nil "company-abbrev" "company-abbrev.el" (21831 -;;;;;; 16638 696187 870000)) +;;;### (autoloads nil "company-abbrev" "company-abbrev.el" (22297 +;;;;;; 19840 603664 101000)) ;;; Generated autoloads from company-abbrev.el (autoload 'company-abbrev "company-abbrev" "\ -`company-mode' completion back-end for abbrev. +`company-mode' completion backend for abbrev. \(fn COMMAND &optional ARG &rest IGNORED)" t nil) ;;;*** -;;;### (autoloads nil "company-bbdb" "company-bbdb.el" (21831 16638 -;;;;;; 863187 858000)) +;;;### (autoloads nil "company-bbdb" "company-bbdb.el" (22297 19840 +;;;;;; 163671 971000)) ;;; Generated autoloads from company-bbdb.el (autoload 'company-bbdb "company-bbdb" "\ -`company-mode' completion back-end for BBDB. +`company-mode' completion backend for BBDB. \(fn COMMAND &optional ARG &rest IGNORE)" t nil) ;;;*** -;;;### (autoloads nil "company-css" "company-css.el" (21831 16638 -;;;;;; 709187 869000)) +;;;### (autoloads nil "company-css" "company-css.el" (22297 19838 +;;;;;; 501701 694000)) ;;; Generated autoloads from company-css.el (autoload 'company-css "company-css" "\ -`company-mode' completion back-end for `css-mode'. +`company-mode' completion backend for `css-mode'. \(fn COMMAND &optional ARG &rest IGNORED)" t nil) ;;;*** -;;;### (autoloads nil "company-dabbrev" "company-dabbrev.el" (21831 -;;;;;; 16638 718187 869000)) +;;;### (autoloads nil "company-dabbrev" "company-dabbrev.el" (22297 +;;;;;; 19839 391685 775000)) ;;; Generated autoloads from company-dabbrev.el (autoload 'company-dabbrev "company-dabbrev" "\ -dabbrev-like `company-mode' completion back-end. +dabbrev-like `company-mode' completion backend. \(fn COMMAND &optional ARG &rest IGNORED)" t nil) ;;;*** ;;;### (autoloads nil "company-dabbrev-code" "company-dabbrev-code.el" -;;;;;; (21831 16638 894187 856000)) +;;;;;; (22297 19839 228688 691000)) ;;; Generated autoloads from company-dabbrev-code.el (autoload 'company-dabbrev-code "company-dabbrev-code" "\ -dabbrev-like `company-mode' back-end for code. -The back-end looks for all symbols in the current buffer that aren't in +dabbrev-like `company-mode' backend for code. +The backend looks for all symbols in the current buffer that aren't in comments or strings. \(fn COMMAND &optional ARG &rest IGNORED)" t nil) ;;;*** -;;;### (autoloads nil "company-elisp" "company-elisp.el" (21831 16638 -;;;;;; 736187 867000)) +;;;### (autoloads nil "company-elisp" "company-elisp.el" (22297 19840 +;;;;;; 862659 468000)) ;;; Generated autoloads from company-elisp.el (autoload 'company-elisp "company-elisp" "\ -`company-mode' completion back-end for Emacs Lisp. +`company-mode' completion backend for Emacs Lisp. \(fn COMMAND &optional ARG &rest IGNORED)" t nil) ;;;*** -;;;### (autoloads nil "company-etags" "company-etags.el" (21831 16638 -;;;;;; 649187 873000)) +;;;### (autoloads nil "company-etags" "company-etags.el" (22297 19838 +;;;;;; 926694 94000)) ;;; Generated autoloads from company-etags.el (autoload 'company-etags "company-etags" "\ -`company-mode' completion back-end for etags. +`company-mode' completion backend for etags. \(fn COMMAND &optional ARG &rest IGNORED)" t nil) ;;;*** -;;;### (autoloads nil "company-files" "company-files.el" (21831 16638 -;;;;;; 745187 867000)) +;;;### (autoloads nil "company-files" "company-files.el" (22297 19839 +;;;;;; 535683 204000)) ;;; Generated autoloads from company-files.el (autoload 'company-files "company-files" "\ -`company-mode' completion back-end existing file names. +`company-mode' completion backend existing file names. Completions works for proper absolute and relative files paths. File paths with spaces are only supported inside strings. @@ -149,118 +165,106 @@ File paths with spaces are only supported inside strings. ;;;*** -;;;### (autoloads nil "company-gtags" "company-gtags.el" (21831 16638 -;;;;;; 899187 856000)) +;;;### (autoloads nil "company-gtags" "company-gtags.el" (22297 19837 +;;;;;; 942711 689000)) ;;; Generated autoloads from company-gtags.el (autoload 'company-gtags "company-gtags" "\ -`company-mode' completion back-end for GNU Global. +`company-mode' completion backend for GNU Global. \(fn COMMAND &optional ARG &rest IGNORED)" t nil) ;;;*** -;;;### (autoloads nil "company-ispell" "company-ispell.el" (21831 -;;;;;; 16638 631187 875000)) +;;;### (autoloads nil "company-ispell" "company-ispell.el" (22297 +;;;;;; 19840 704662 296000)) ;;; Generated autoloads from company-ispell.el (autoload 'company-ispell "company-ispell" "\ -`company-mode' completion back-end using Ispell. +`company-mode' completion backend using Ispell. \(fn COMMAND &optional ARG &rest IGNORED)" t nil) ;;;*** -;;;### (autoloads nil "company-keywords" "company-keywords.el" (21831 -;;;;;; 16638 658187 873000)) +;;;### (autoloads nil "company-keywords" "company-keywords.el" (22297 +;;;;;; 19839 758679 212000)) ;;; Generated autoloads from company-keywords.el (autoload 'company-keywords "company-keywords" "\ -`company-mode' back-end for programming language keywords. +`company-mode' backend for programming language keywords. \(fn COMMAND &optional ARG &rest IGNORED)" t nil) ;;;*** -;;;### (autoloads nil "company-nxml" "company-nxml.el" (21831 16638 -;;;;;; 667187 872000)) +;;;### (autoloads nil "company-nxml" "company-nxml.el" (22297 19840 +;;;;;; 287669 753000)) ;;; Generated autoloads from company-nxml.el (autoload 'company-nxml "company-nxml" "\ -`company-mode' completion back-end for `nxml-mode'. +`company-mode' completion backend for `nxml-mode'. \(fn COMMAND &optional ARG &rest IGNORED)" t nil) ;;;*** -;;;### (autoloads nil "company-oddmuse" "company-oddmuse.el" (21831 -;;;;;; 16638 755187 866000)) +;;;### (autoloads nil "company-oddmuse" "company-oddmuse.el" (22297 +;;;;;; 19838 346704 465000)) ;;; Generated autoloads from company-oddmuse.el (autoload 'company-oddmuse "company-oddmuse" "\ -`company-mode' completion back-end for `oddmuse-mode'. +`company-mode' completion backend for `oddmuse-mode'. \(fn COMMAND &optional ARG &rest IGNORED)" t nil) ;;;*** -;;;### (autoloads nil "company-pysmell" "company-pysmell.el" (21831 -;;;;;; 16638 848187 859000)) -;;; Generated autoloads from company-pysmell.el - -(autoload 'company-pysmell "company-pysmell" "\ -`company-mode' completion back-end for pysmell. -This requires pysmell.el and pymacs.el. - -\(fn COMMAND &optional ARG &rest IGNORED)" t nil) - -;;;*** - -;;;### (autoloads nil "company-semantic" "company-semantic.el" (21831 -;;;;;; 16638 936187 853000)) +;;;### (autoloads nil "company-semantic" "company-semantic.el" (22297 +;;;;;; 19838 125708 417000)) ;;; Generated autoloads from company-semantic.el (autoload 'company-semantic "company-semantic" "\ -`company-mode' completion back-end using CEDET Semantic. +`company-mode' completion backend using CEDET Semantic. \(fn COMMAND &optional ARG &rest IGNORED)" t nil) ;;;*** -;;;### (autoloads nil "company-tempo" "company-tempo.el" (21831 16638 -;;;;;; 874187 858000)) +;;;### (autoloads nil "company-tempo" "company-tempo.el" (22297 19839 +;;;;;; 349686 528000)) ;;; Generated autoloads from company-tempo.el (autoload 'company-tempo "company-tempo" "\ -`company-mode' completion back-end for tempo. +`company-mode' completion backend for tempo. \(fn COMMAND &optional ARG &rest IGNORED)" t nil) ;;;*** -;;;### (autoloads nil "company-xcode" "company-xcode.el" (21831 16638 -;;;;;; 885187 857000)) +;;;### (autoloads nil "company-xcode" "company-xcode.el" (22297 19840 +;;;;;; 505665 854000)) ;;; Generated autoloads from company-xcode.el (autoload 'company-xcode "company-xcode" "\ -`company-mode' completion back-end for Xcode projects. +`company-mode' completion backend for Xcode projects. \(fn COMMAND &optional ARG &rest IGNORED)" t nil) ;;;*** ;;;### (autoloads nil "company-yasnippet" "company-yasnippet.el" -;;;;;; (21831 16638 920187 854000)) +;;;;;; (22297 19840 373668 214000)) ;;; Generated autoloads from company-yasnippet.el (autoload 'company-yasnippet "company-yasnippet" "\ -`company-mode' back-end for `yasnippet'. +`company-mode' backend for `yasnippet'. -This back-end should be used with care, because as long as there are -snippets defined for the current major mode, this back-end will always -shadow back-ends that come after it. Recommended usages: +This backend should be used with care, because as long as there are +snippets defined for the current major mode, this backend will always +shadow backends that come after it. Recommended usages: -* In a buffer-local value of `company-backends', grouped with a back-end or +* In a buffer-local value of `company-backends', grouped with a backend or several that provide actual text completions. (add-hook 'js-mode-hook @@ -268,7 +272,7 @@ shadow back-ends that come after it. Recommended usages: (set (make-local-variable 'company-backends) '((company-dabbrev-code company-yasnippet))))) -* After keyword `:with', grouped with other back-ends. +* After keyword `:with', grouped with other backends. (push '(company-semantic :with company-yasnippet) company-backends) @@ -281,8 +285,8 @@ shadow back-ends that come after it. Recommended usages: ;;;*** ;;;### (autoloads nil nil ("company-capf.el" "company-clang.el" "company-cmake.el" -;;;;;; "company-eclim.el" "company-pkg.el" "company-ropemacs.el" -;;;;;; "company-template.el") (21831 16638 948260 900000)) +;;;;;; "company-eclim.el" "company-pkg.el" "company-template.el") +;;;;;; (22297 19841 194698 166000)) ;;;*** diff --git a/elpa/company-0.8.12/company-bbdb.el b/elpa/company-20160413.1347/company-bbdb.el similarity index 86% rename from elpa/company-0.8.12/company-bbdb.el rename to elpa/company-20160413.1347/company-bbdb.el index 58be84c..36307d0 100644 --- a/elpa/company-0.8.12/company-bbdb.el +++ b/elpa/company-20160413.1347/company-bbdb.el @@ -1,6 +1,6 @@ -;;; company-bbdb.el --- company-mode completion back-end for BBDB in message-mode +;;; company-bbdb.el --- company-mode completion backend for BBDB in message-mode -;; Copyright (C) 2013-2014 Free Software Foundation, Inc. +;; Copyright (C) 2013-2014, 2016 Free Software Foundation, Inc. ;; Author: Jan Tatarik @@ -28,7 +28,7 @@ (declare-function bbdb-search "bbdb-com") (defgroup company-bbdb nil - "Completion back-end for BBDB." + "Completion backend for BBDB." :group 'company) (defcustom company-bbdb-modes '(message-mode) @@ -44,13 +44,13 @@ ;;;###autoload (defun company-bbdb (command &optional arg &rest ignore) - "`company-mode' completion back-end for BBDB." + "`company-mode' completion backend for BBDB." (interactive (list 'interactive)) (cl-case command (interactive (company-begin-backend 'company-bbdb)) (prefix (and (memq major-mode company-bbdb-modes) (featurep 'bbdb-com) - (looking-back "^\\(To\\|Cc\\|Bcc\\): *\\(.*\\)" + (looking-back "^\\(To\\|Cc\\|Bcc\\): *.*?\\([^,; ]*\\)" (line-beginning-position)) (match-string-no-properties 2))) (candidates (company-bbdb--candidates arg)) diff --git a/elpa/company-0.8.12/company-capf.el b/elpa/company-20160413.1347/company-capf.el similarity index 82% rename from elpa/company-0.8.12/company-capf.el rename to elpa/company-20160413.1347/company-capf.el index 4962a26..866fd62 100644 --- a/elpa/company-0.8.12/company-capf.el +++ b/elpa/company-20160413.1347/company-capf.el @@ -1,6 +1,6 @@ -;;; company-capf.el --- company-mode completion-at-point-functions back-end -*- lexical-binding: t -*- +;;; company-capf.el --- company-mode completion-at-point-functions backend -*- lexical-binding: t -*- -;; Copyright (C) 2013-2014 Free Software Foundation, Inc. +;; Copyright (C) 2013-2016 Free Software Foundation, Inc. ;; Author: Stefan Monnier @@ -48,22 +48,36 @@ ;; the latter comes later. (remove 'tags-completion-at-point-function (default-value 'completion-at-point-functions))) + (completion-at-point-functions (company--capf-workaround)) (data (run-hook-wrapped 'completion-at-point-functions ;; Ignore misbehaving functions. #'completion--capf-wrapper 'optimist))) - (when (and (consp (cdr data)) (numberp (nth 1 data))) data))) + (when (and (consp (cdr data)) (integer-or-marker-p (nth 1 data))) data))) + +(declare-function python-shell-get-process "python") + +(defun company--capf-workaround () + ;; For http://debbugs.gnu.org/cgi/bugreport.cgi?bug=18067 + (if (or (not (listp completion-at-point-functions)) + (not (memq 'python-completion-complete-at-point completion-at-point-functions)) + (python-shell-get-process)) + completion-at-point-functions + (remq 'python-completion-complete-at-point completion-at-point-functions))) (defun company-capf (command &optional arg &rest _args) - "`company-mode' back-end using `completion-at-point-functions'." + "`company-mode' backend using `completion-at-point-functions'." (interactive (list 'interactive)) (pcase command (`interactive (company-begin-backend 'company-capf)) (`prefix (let ((res (company--capf-data))) (when res - (if (> (nth 2 res) (point)) - 'stop - (buffer-substring-no-properties (nth 1 res) (point)))))) + (let ((length (plist-get (nthcdr 4 res) :company-prefix-length)) + (prefix (buffer-substring-no-properties (nth 1 res) (point)))) + (cond + ((> (nth 2 res) (point)) 'stop) + (length (cons prefix length)) + (t prefix)))))) (`candidates (let ((res (company--capf-data))) (when res @@ -95,16 +109,16 @@ (cdr (assq 'display-sort-function meta)))))) (`match ;; Can't just use 0 when base-size (see above) is non-zero. - (let ((start (if (get-text-property 0 'font-lock-face arg) + (let ((start (if (get-text-property 0 'face arg) 0 - (next-single-property-change 0 'font-lock-face arg)))) + (next-single-property-change 0 'face arg)))) (when start ;; completions-common-part comes first, but we can't just look for this ;; value because it can be in a list. (or - (let ((value (get-text-property start 'font-lock-face arg))) + (let ((value (get-text-property start 'face arg))) (text-property-not-all start (length arg) - 'font-lock-face value arg)) + 'face value arg)) (length arg))))) (`duplicates t) (`no-cache t) ;Not much can be done here, as long as we handle diff --git a/elpa/company-0.8.12/company-clang.el b/elpa/company-20160413.1347/company-clang.el similarity index 92% rename from elpa/company-0.8.12/company-clang.el rename to elpa/company-20160413.1347/company-clang.el index e85e865..54d4b9b 100644 --- a/elpa/company-0.8.12/company-clang.el +++ b/elpa/company-20160413.1347/company-clang.el @@ -1,6 +1,6 @@ -;;; company-clang.el --- company-mode completion back-end for Clang -*- lexical-binding: t -*- +;;; company-clang.el --- company-mode completion backend for Clang -*- lexical-binding: t -*- -;; Copyright (C) 2009, 2011, 2013-2014 Free Software Foundation, Inc. +;; Copyright (C) 2009, 2011, 2013-2016 Free Software Foundation, Inc. ;; Author: Nikolaj Schumacher @@ -30,7 +30,7 @@ (require 'cl-lib) (defgroup company-clang nil - "Completion back-end for Clang." + "Completion backend for Clang." :group 'company) (defcustom company-clang-executable @@ -144,6 +144,18 @@ or automatically through a custom `company-clang-prefix-guesser'." (get-text-property 0 'meta candidate)) (defun company-clang--annotation (candidate) + (let ((ann (company-clang--annotation-1 candidate))) + (if (not (and ann (string-prefix-p "(*)" ann))) + ann + (with-temp-buffer + (insert ann) + (search-backward ")") + (let ((pt (1+ (point)))) + (re-search-forward ".\\_>" nil t) + (delete-region pt (point))) + (buffer-string))))) + +(defun company-clang--annotation-1 (candidate) (let ((meta (company-clang--meta candidate))) (cond ((null meta) nil) @@ -191,9 +203,11 @@ or automatically through a custom `company-clang-prefix-guesser'." (buf (get-buffer-create "*clang-output*")) ;; Looks unnecessary in Emacs 25.1 and later. (process-adaptive-read-buffering nil)) - (with-current-buffer buf (erase-buffer)) (if (get-buffer-process buf) (funcall callback nil) + (with-current-buffer buf + (erase-buffer) + (setq buffer-undo-list t)) (let ((process (apply #'start-process "company-clang" buf company-clang-executable args))) (set-process-sentinel @@ -275,26 +289,8 @@ or automatically through a custom `company-clang-prefix-guesser'." ver)) 0))) -(defun company-clang-objc-templatify (selector) - (let* ((end (point-marker)) - (beg (- (point) (length selector) 1)) - (templ (company-template-declare-template beg end)) - (cnt 0)) - (save-excursion - (goto-char beg) - (catch 'stop - (while (search-forward ":" end t) - (when (looking-at "([^)]*) ?") - (delete-region (match-beginning 0) (match-end 0))) - (company-template-add-field templ (point) (format "arg%d" cnt)) - (if (< (point) end) - (insert " ") - (throw 'stop t)) - (cl-incf cnt)))) - (company-template-move-to-first templ))) - (defun company-clang (command &optional arg &rest ignored) - "`company-mode' completion back-end for Clang. + "`company-mode' completion backend for Clang. Clang is a parser for C and ObjC. Clang version 1.1 or newer is required. Additional command line arguments can be specified in @@ -327,7 +323,7 @@ passed via standard input." (when (and company-clang-insert-arguments anno) (insert anno) (if (string-match "\\`:[^:]" anno) - (company-clang-objc-templatify anno) + (company-template-objc-templatify anno) (company-template-c-like-templatify (concat arg anno)))))))) diff --git a/elpa/company-0.8.12/company-cmake.el b/elpa/company-20160413.1347/company-cmake.el similarity index 97% rename from elpa/company-0.8.12/company-cmake.el rename to elpa/company-20160413.1347/company-cmake.el index e2962f5..010df32 100644 --- a/elpa/company-0.8.12/company-cmake.el +++ b/elpa/company-20160413.1347/company-cmake.el @@ -1,4 +1,4 @@ -;;; company-cmake.el --- company-mode completion back-end for CMake +;;; company-cmake.el --- company-mode completion backend for CMake ;; Copyright (C) 2013-2014 Free Software Foundation, Inc. @@ -29,7 +29,7 @@ (require 'cl-lib) (defgroup company-cmake nil - "Completion back-end for CMake." + "Completion backend for CMake." :group 'company) (defcustom company-cmake-executable @@ -178,7 +178,7 @@ They affect which types of symbols we get completion candidates for.") (point-max)))))) (defun company-cmake (command &optional arg &rest ignored) - "`company-mode' completion back-end for CMake. + "`company-mode' completion backend for CMake. CMake is a cross-platform, open-source make system." (interactive (list 'interactive)) (cl-case command diff --git a/elpa/company-0.8.12/company-css.el b/elpa/company-20160413.1347/company-css.el similarity index 97% rename from elpa/company-0.8.12/company-css.el rename to elpa/company-20160413.1347/company-css.el index ec48653..cf8c683 100644 --- a/elpa/company-0.8.12/company-css.el +++ b/elpa/company-20160413.1347/company-css.el @@ -1,4 +1,4 @@ -;;; company-css.el --- company-mode completion back-end for css-mode -*- lexical-binding: t -*- +;;; company-css.el --- company-mode completion backend for css-mode -*- lexical-binding: t -*- ;; Copyright (C) 2009, 2011, 2014 Free Software Foundation, Inc. @@ -26,6 +26,8 @@ (require 'company) (require 'cl-lib) +(declare-function web-mode-language-at-pos "web-mode" (&optional pos)) + (defconst company-css-property-alist ;; see http://www.w3.org/TR/CSS21/propidx.html '(("azimuth" angle "left-side" "far-left" "left" "center-left" "center" @@ -411,11 +413,13 @@ Returns \"\" if no property found, but feasible at this position." ;;;###autoload (defun company-css (command &optional arg &rest ignored) - "`company-mode' completion back-end for `css-mode'." + "`company-mode' completion backend for `css-mode'." (interactive (list 'interactive)) (cl-case command (interactive (company-begin-backend 'company-css)) - (prefix (and (derived-mode-p 'css-mode) + (prefix (and (or (derived-mode-p 'css-mode) + (and (derived-mode-p 'web-mode) + (string= (web-mode-language-at-pos) "css"))) (or (company-grab company-css-tag-regexp 1) (company-grab company-css-pseudo-regexp 1) (company-grab company-css-property-value-regexp 2) diff --git a/elpa/company-0.8.12/company-dabbrev-code.el b/elpa/company-20160413.1347/company-dabbrev-code.el similarity index 87% rename from elpa/company-0.8.12/company-dabbrev-code.el rename to elpa/company-20160413.1347/company-dabbrev-code.el index 256b57f..9331087 100644 --- a/elpa/company-0.8.12/company-dabbrev-code.el +++ b/elpa/company-20160413.1347/company-dabbrev-code.el @@ -1,4 +1,4 @@ -;;; company-dabbrev-code.el --- dabbrev-like company-mode back-end for code -*- lexical-binding: t -*- +;;; company-dabbrev-code.el --- dabbrev-like company-mode backend for code -*- lexical-binding: t -*- ;; Copyright (C) 2009, 2011, 2014 Free Software Foundation, Inc. @@ -30,7 +30,7 @@ (require 'cl-lib) (defgroup company-dabbrev-code nil - "dabbrev-like completion back-end for code." + "dabbrev-like completion backend for code." :group 'company) (defcustom company-dabbrev-code-modes @@ -40,10 +40,10 @@ "Modes that use `company-dabbrev-code'. In all these modes (and their derivatives) `company-dabbrev-code' will complete only symbols, not text in comments or strings. In other modes -`company-dabbrev-code' will pass control to other back-ends +`company-dabbrev-code' will pass control to other backends \(e.g. `company-dabbrev'\). Value t means complete in all modes." - :type '(choice (repeat (symbol :tag "Major mode")) - (const tag "All modes" t))) + :type '(choice (repeat :tag "Some modes" (symbol :tag "Major mode")) + (const :tag "All modes" t))) (defcustom company-dabbrev-code-other-buffers t "Determines whether `company-dabbrev-code' should search other buffers. @@ -69,7 +69,7 @@ also `company-dabbrev-code-time-limit'." "Non-nil to ignore case when collecting completion candidates." :type 'boolean) -(defsubst company-dabbrev-code--make-regexp (prefix) +(defun company-dabbrev-code--make-regexp (prefix) (concat "\\_<" (if (equal prefix "") "\\([a-zA-Z]\\|\\s_\\)" (regexp-quote prefix)) @@ -77,8 +77,8 @@ also `company-dabbrev-code-time-limit'." ;;;###autoload (defun company-dabbrev-code (command &optional arg &rest ignored) - "dabbrev-like `company-mode' back-end for code. -The back-end looks for all symbols in the current buffer that aren't in + "dabbrev-like `company-mode' backend for code. +The backend looks for all symbols in the current buffer that aren't in comments or strings." (interactive (list 'interactive)) (cl-case command diff --git a/elpa/company-0.8.12/company-dabbrev.el b/elpa/company-20160413.1347/company-dabbrev.el similarity index 67% rename from elpa/company-0.8.12/company-dabbrev.el rename to elpa/company-20160413.1347/company-dabbrev.el index 7519caf..85741f2 100644 --- a/elpa/company-0.8.12/company-dabbrev.el +++ b/elpa/company-20160413.1347/company-dabbrev.el @@ -1,6 +1,6 @@ -;;; company-dabbrev.el --- dabbrev-like company-mode completion back-end -*- lexical-binding: t -*- +;;; company-dabbrev.el --- dabbrev-like company-mode completion backend -*- lexical-binding: t -*- -;; Copyright (C) 2009, 2011, 2014 Free Software Foundation, Inc. +;; Copyright (C) 2009, 2011, 2014, 2015, 2016 Free Software Foundation, Inc. ;; Author: Nikolaj Schumacher @@ -29,7 +29,7 @@ (require 'cl-lib) (defgroup company-dabbrev nil - "dabbrev-like completion back-end." + "dabbrev-like completion backend." :group 'company) (defcustom company-dabbrev-other-buffers 'all @@ -74,46 +74,60 @@ This variable affects both `company-dabbrev' and `company-dabbrev-code'." :type 'integer :package-version '(company . "0.8.3")) -(defmacro company-dabrev--time-limit-while (test start limit &rest body) +(defcustom company-dabbrev-ignore-invisible nil + "Non-nil to skip invisible text." + :type 'boolean + :package-version '(company . "0.9.0")) + +(defmacro company-dabrev--time-limit-while (test start limit freq &rest body) (declare (indent 3) (debug t)) `(let ((company-time-limit-while-counter 0)) (catch 'done (while ,test ,@body (and ,limit - (eq (cl-incf company-time-limit-while-counter) 25) + (= (cl-incf company-time-limit-while-counter) ,freq) (setq company-time-limit-while-counter 0) (> (float-time (time-since ,start)) ,limit) (throw 'done 'company-time-out)))))) -(defsubst company-dabbrev--make-regexp (prefix) - (concat "\\<" (if (equal prefix "") - company-dabbrev-char-regexp - (regexp-quote prefix)) - "\\(" company-dabbrev-char-regexp "\\)*\\>")) +(defun company-dabbrev--make-regexp () + (concat "\\(?:" company-dabbrev-char-regexp "\\)+")) (defun company-dabbrev--search-buffer (regexp pos symbols start limit ignore-comments) (save-excursion - (let (match) + (cl-labels ((maybe-collect-match + () + (let ((match (match-string-no-properties 0))) + (when (and (>= (length match) company-dabbrev-minimum-length) + (not (and company-dabbrev-ignore-invisible + (invisible-p (match-beginning 0))))) + (push match symbols))))) (goto-char (if pos (1- pos) (point-min))) - ;; search before pos - (company-dabrev--time-limit-while (re-search-backward regexp nil t) - start limit - (setq match (match-string-no-properties 0)) - (if (and ignore-comments (company-in-string-or-comment)) - (goto-char (nth 8 (syntax-ppss))) - (when (>= (length match) company-dabbrev-minimum-length) - (push match symbols)))) + ;; Search before pos. + (let ((tmp-end (point))) + (company-dabrev--time-limit-while (> tmp-end (point-min)) + start limit 1 + (ignore-errors + (forward-char -10000)) + (forward-line 0) + (save-excursion + ;; Before, we used backward search, but it matches non-greedily, and + ;; that forced us to use the "beginning/end of word" anchors in + ;; `company-dabbrev--make-regexp'. It's also about 2x slower. + (while (re-search-forward regexp tmp-end t) + (if (and ignore-comments (save-match-data (company-in-string-or-comment))) + (re-search-forward "\\s>\\|\\s!\\|\\s\"" tmp-end t) + (maybe-collect-match)))) + (setq tmp-end (point)))) (goto-char (or pos (point-min))) - ;; search after pos + ;; Search after pos. (company-dabrev--time-limit-while (re-search-forward regexp nil t) - start limit - (setq match (match-string-no-properties 0)) - (if (and ignore-comments (company-in-string-or-comment)) + start limit 25 + (if (and ignore-comments (save-match-data (company-in-string-or-comment))) (re-search-forward "\\s>\\|\\s!\\|\\s\"" nil t) - (when (>= (length match) company-dabbrev-minimum-length) - (push match symbols)))) + (maybe-collect-match))) symbols))) (defun company-dabbrev--search (regexp &optional limit other-buffer-modes @@ -136,16 +150,28 @@ This variable affects both `company-dabbrev' and `company-dabbrev-code'." (cl-return)))) symbols)) +(defun company-dabbrev--prefix () + ;; Not in the middle of a word. + (unless (looking-at company-dabbrev-char-regexp) + ;; Emacs can't do greedy backward-search. + (company-grab-line (format "\\(?:^\\| \\)[^ ]*?\\(\\(?:%s\\)*\\)" + company-dabbrev-char-regexp) + 1))) + +(defun company-dabbrev--filter (prefix candidates) + (let ((completion-ignore-case company-dabbrev-ignore-case)) + (all-completions prefix candidates))) + ;;;###autoload (defun company-dabbrev (command &optional arg &rest ignored) - "dabbrev-like `company-mode' completion back-end." + "dabbrev-like `company-mode' completion backend." (interactive (list 'interactive)) (cl-case command (interactive (company-begin-backend 'company-dabbrev)) - (prefix (company-grab-word)) + (prefix (company-dabbrev--prefix)) (candidates (let* ((case-fold-search company-dabbrev-ignore-case) - (words (company-dabbrev--search (company-dabbrev--make-regexp arg) + (words (company-dabbrev--search (company-dabbrev--make-regexp) company-dabbrev-time-limit (pcase company-dabbrev-other-buffers (`t (list major-mode)) @@ -153,6 +179,7 @@ This variable affects both `company-dabbrev' and `company-dabbrev-code'." (downcase-p (if (eq company-dabbrev-downcase 'case-replace) case-replace company-dabbrev-downcase))) + (setq words (company-dabbrev--filter arg words)) (if downcase-p (mapcar 'downcase words) words))) diff --git a/elpa/company-0.8.12/company-eclim.el b/elpa/company-20160413.1347/company-eclim.el similarity index 93% rename from elpa/company-0.8.12/company-eclim.el rename to elpa/company-20160413.1347/company-eclim.el index 1f1beae..208daf5 100644 --- a/elpa/company-0.8.12/company-eclim.el +++ b/elpa/company-20160413.1347/company-eclim.el @@ -1,6 +1,6 @@ -;;; company-eclim.el --- company-mode completion back-end for Eclim +;;; company-eclim.el --- company-mode completion backend for Eclim -;; Copyright (C) 2009, 2011, 2013 Free Software Foundation, Inc. +;; Copyright (C) 2009, 2011, 2013, 2015 Free Software Foundation, Inc. ;; Author: Nikolaj Schumacher @@ -21,10 +21,10 @@ ;;; Commentary: ;; -;; Using `emacs-eclim' together with (or instead of) this back-end is +;; Using `emacs-eclim' together with (or instead of) this backend is ;; recommended, as it allows you to use other Eclim features. ;; -;; The alternative back-end provided by `emacs-eclim' uses `yasnippet' +;; The alternative backend provided by `emacs-eclim' uses `yasnippet' ;; instead of `company-template' to expand function calls, and it supports ;; some languages other than Java. @@ -35,7 +35,7 @@ (require 'cl-lib) (defgroup company-eclim nil - "Completion back-end for Eclim." + "Completion backend for Eclim." :group 'company) (defun company-eclim-executable-find () @@ -48,7 +48,9 @@ (cl-return file))))) (defcustom company-eclim-executable - (or (executable-find "eclim") (company-eclim-executable-find)) + (or (bound-and-true-p eclim-executable) + (executable-find "eclim") + (company-eclim-executable-find)) "Location of eclim executable." :type 'file) @@ -153,7 +155,7 @@ eclim can only complete correctly when the buffer has been saved." prefix))) (defun company-eclim (command &optional arg &rest ignored) - "`company-mode' completion back-end for Eclim. + "`company-mode' completion backend for Eclim. Eclim provides access to Eclipse Java IDE features for other editors. Eclim version 1.7.13 or newer (?) is required. diff --git a/elpa/company-0.8.12/company-elisp.el b/elpa/company-20160413.1347/company-elisp.el similarity index 97% rename from elpa/company-0.8.12/company-elisp.el rename to elpa/company-20160413.1347/company-elisp.el index 5efd8d0..3db0d8b 100644 --- a/elpa/company-0.8.12/company-elisp.el +++ b/elpa/company-20160413.1347/company-elisp.el @@ -1,4 +1,4 @@ -;;; company-elisp.el --- company-mode completion back-end for Emacs Lisp -*- lexical-binding: t -*- +;;; company-elisp.el --- company-mode completion backend for Emacs Lisp -*- lexical-binding: t -*- ;; Copyright (C) 2009, 2011-2013 Free Software Foundation, Inc. @@ -31,7 +31,7 @@ (require 'find-func) (defgroup company-elisp nil - "Completion back-end for Emacs Lisp." + "Completion backend for Emacs Lisp." :group 'company) (defcustom company-elisp-detect-function-context t @@ -193,7 +193,7 @@ first in the candidates list." ;;;###autoload (defun company-elisp (command &optional arg &rest ignored) - "`company-mode' completion back-end for Emacs Lisp." + "`company-mode' completion backend for Emacs Lisp." (interactive (list 'interactive)) (cl-case command (interactive (company-begin-backend 'company-elisp)) diff --git a/elpa/company-0.8.12/company-etags.el b/elpa/company-20160413.1347/company-etags.el similarity index 74% rename from elpa/company-0.8.12/company-etags.el rename to elpa/company-20160413.1347/company-etags.el index 1c01c91..ef53213 100644 --- a/elpa/company-0.8.12/company-etags.el +++ b/elpa/company-20160413.1347/company-etags.el @@ -1,4 +1,4 @@ -;;; company-etags.el --- company-mode completion back-end for etags +;;; company-etags.el --- company-mode completion backend for etags ;; Copyright (C) 2009-2011, 2014 Free Software Foundation, Inc. @@ -30,7 +30,7 @@ (require 'etags) (defgroup company-etags nil - "Completion back-end for etags." + "Completion backend for etags." :group 'company) (defcustom company-etags-use-main-table-list t @@ -45,17 +45,28 @@ buffer automatically." :type 'boolean :package-version '(company . "0.7.3")) +(defcustom company-etags-everywhere nil + "Non-nil to offer completions in comments and strings. +Set it to t or to a list of major modes." + :type '(choice (const :tag "Off" nil) + (const :tag "Any supported mode" t) + (repeat :tag "Some major modes" + (symbol :tag "Major mode"))) + :package-version '(company . "0.9.0")) + (defvar company-etags-modes '(prog-mode c-mode objc-mode c++-mode java-mode jde-mode pascal-mode perl-mode python-mode)) (defvar-local company-etags-buffer-table 'unknown) (defun company-etags-find-table () - (let ((file (locate-dominating-file (or buffer-file-name - default-directory) - "TAGS"))) + (let ((file (expand-file-name + "TAGS" + (locate-dominating-file (or buffer-file-name + default-directory) + "TAGS")))) (when (and file (file-regular-p file)) - (list (expand-file-name file))))) + (list file)))) (defun company-etags-buffer-table () (or (and company-etags-use-main-table-list tags-table-list) @@ -74,12 +85,14 @@ buffer automatically." ;;;###autoload (defun company-etags (command &optional arg &rest ignored) - "`company-mode' completion back-end for etags." + "`company-mode' completion backend for etags." (interactive (list 'interactive)) (cl-case command (interactive (company-begin-backend 'company-etags)) - (prefix (and (apply 'derived-mode-p company-etags-modes) - (not (company-in-string-or-comment)) + (prefix (and (apply #'derived-mode-p company-etags-modes) + (or (eq t company-etags-everywhere) + (apply #'derived-mode-p company-etags-everywhere) + (not (company-in-string-or-comment))) (company-etags-buffer-table) (or (company-grab-symbol) 'stop))) (candidates (company-etags--candidates arg)) diff --git a/elpa/company-0.8.12/company-files.el b/elpa/company-20160413.1347/company-files.el similarity index 58% rename from elpa/company-0.8.12/company-files.el rename to elpa/company-20160413.1347/company-files.el index 7cfc500..c19d3d6 100644 --- a/elpa/company-0.8.12/company-files.el +++ b/elpa/company-20160413.1347/company-files.el @@ -1,6 +1,6 @@ -;;; company-files.el --- company-mode completion back-end for file paths +;;; company-files.el --- company-mode completion backend for file paths -;; Copyright (C) 2009-2011, 2014 Free Software Foundation, Inc. +;; Copyright (C) 2009-2011, 2014-2015 Free Software Foundation, Inc. ;; Author: Nikolaj Schumacher @@ -30,9 +30,12 @@ (defun company-files--directory-files (dir prefix) (ignore-errors - (if (equal prefix "") - (directory-files dir nil "\\`[^.]\\|\\`.[^.]") - (file-name-all-completions prefix dir)))) + ;; Don't use directory-files. It produces directories without trailing /. + (let ((comp (sort (file-name-all-completions prefix dir) + (lambda (s1 s2) (string-lessp (downcase s1) (downcase s2)))))) + (if (equal prefix "") + (delete "../" (delete "./" comp)) + comp)))) (defvar company-files--regexps (let* ((root (if (eq system-type 'windows-nt) @@ -50,35 +53,47 @@ (and (cl-dolist (regexp company-files--regexps) (when (setq file (company-grab-line regexp 1)) (cl-return file))) + (company-files--connected-p file) (setq dir (file-name-directory file)) (not (string-match "//" dir)) (file-exists-p dir) - (file-name-all-completions (file-name-nondirectory file) dir) file))) +(defun company-files--connected-p (file) + (or (not (file-remote-p file)) + (file-remote-p file nil t))) + +(defun company-files--trailing-slash-p (file) + ;; `file-directory-p' is very expensive on remotes. We are relying on + ;; `file-name-all-completions' returning directories with trailing / instead. + (let ((len (length file))) + (and (> len 0) (eq (aref file (1- len)) ?/)))) + (defvar company-files--completion-cache nil) (defun company-files--complete (prefix) (let* ((dir (file-name-directory prefix)) - (key (list (file-name-nondirectory prefix) + (file (file-name-nondirectory prefix)) + (key (list file (expand-file-name dir) (nth 5 (file-attributes dir)))) - (file (file-name-nondirectory prefix)) - (completion-ignore-case read-file-name-completion-ignore-case) - candidates directories) + (completion-ignore-case read-file-name-completion-ignore-case)) (unless (company-file--keys-match-p key (car company-files--completion-cache)) - (dolist (file (company-files--directory-files dir file)) - (setq file (concat dir file)) - (push file candidates) - (when (file-directory-p file) - (push file directories))) - (dolist (directory (reverse directories)) - ;; Add one level of children. - (dolist (child (company-files--directory-files directory "")) - (push (concat directory - (unless (eq (aref directory (1- (length directory))) ?/) "/") - child) candidates))) - (setq company-files--completion-cache (cons key (nreverse candidates)))) + (let* ((candidates (mapcar (lambda (f) (concat dir f)) + (company-files--directory-files dir file))) + (directories (unless (file-remote-p dir) + (cl-remove-if-not (lambda (f) + (and (company-files--trailing-slash-p f) + (not (file-remote-p f)) + (company-files--connected-p f))) + candidates))) + (children (and directories + (cl-mapcan (lambda (d) + (mapcar (lambda (c) (concat d c)) + (company-files--directory-files d ""))) + directories)))) + (setq company-files--completion-cache + (cons key (append candidates children))))) (all-completions prefix (cdr company-files--completion-cache)))) @@ -88,7 +103,7 @@ ;;;###autoload (defun company-files (command &optional arg &rest ignored) - "`company-mode' completion back-end existing file names. + "`company-mode' completion backend existing file names. Completions works for proper absolute and relative files paths. File paths with spaces are only supported inside strings." (interactive (list 'interactive)) @@ -98,6 +113,8 @@ File paths with spaces are only supported inside strings." (candidates (company-files--complete arg)) (location (cons (dired-noselect (file-name-directory (directory-file-name arg))) 1)) + (post-completion (when (company-files--trailing-slash-p arg) + (delete-char -1))) (sorted t) (no-cache t))) diff --git a/elpa/company-0.8.12/company-gtags.el b/elpa/company-20160413.1347/company-gtags.el similarity index 95% rename from elpa/company-0.8.12/company-gtags.el rename to elpa/company-20160413.1347/company-gtags.el index aaa22b9..5050783 100644 --- a/elpa/company-0.8.12/company-gtags.el +++ b/elpa/company-20160413.1347/company-gtags.el @@ -1,4 +1,4 @@ -;;; company-gtags.el --- company-mode completion back-end for GNU Global +;;; company-gtags.el --- company-mode completion backend for GNU Global ;; Copyright (C) 2009-2011, 2014 Free Software Foundation, Inc. @@ -26,10 +26,11 @@ ;;; Code: (require 'company) +(require 'company-template) (require 'cl-lib) (defgroup company-gtags nil - "Completion back-end for GNU Global." + "Completion backend for GNU Global." :group 'company) (defcustom company-gtags-executable @@ -90,7 +91,7 @@ completion." ;;;###autoload (defun company-gtags (command &optional arg &rest ignored) - "`company-mode' completion back-end for GNU Global." + "`company-mode' completion backend for GNU Global." (interactive (list 'interactive)) (cl-case command (interactive (company-begin-backend 'company-gtags)) diff --git a/elpa/company-0.8.12/company-ispell.el b/elpa/company-20160413.1347/company-ispell.el similarity index 78% rename from elpa/company-0.8.12/company-ispell.el rename to elpa/company-20160413.1347/company-ispell.el index 4ce8dfc..c275bbe 100644 --- a/elpa/company-0.8.12/company-ispell.el +++ b/elpa/company-20160413.1347/company-ispell.el @@ -1,6 +1,6 @@ -;;; company-ispell.el --- company-mode completion back-end using Ispell +;;; company-ispell.el --- company-mode completion backend using Ispell -;; Copyright (C) 2009-2011, 2013-2015 Free Software Foundation, Inc. +;; Copyright (C) 2009-2011, 2013-2016 Free Software Foundation, Inc. ;; Author: Nikolaj Schumacher @@ -30,7 +30,7 @@ (require 'ispell) (defgroup company-ispell nil - "Completion back-end using Ispell." + "Completion backend using Ispell." :group 'company) (defcustom company-ispell-dictionary nil @@ -41,11 +41,16 @@ If nil, use `ispell-complete-word-dict'." (defvar company-ispell-available 'unknown) +(defalias 'company-ispell--lookup-words + (if (fboundp 'ispell-lookup-words) + 'ispell-lookup-words + 'lookup-words)) + (defun company-ispell-available () (when (eq company-ispell-available 'unknown) (condition-case err (progn - (lookup-words "WHATEVER") + (company-ispell--lookup-words "WHATEVER") (setq company-ispell-available t)) (error (message "Company: ispell-look-command not found") @@ -54,15 +59,16 @@ If nil, use `ispell-complete-word-dict'." ;;;###autoload (defun company-ispell (command &optional arg &rest ignored) - "`company-mode' completion back-end using Ispell." + "`company-mode' completion backend using Ispell." (interactive (list 'interactive)) (cl-case command (interactive (company-begin-backend 'company-ispell)) (prefix (when (company-ispell-available) (company-grab-word))) (candidates - (let ((words (lookup-words arg (or company-ispell-dictionary - ispell-complete-word-dict))) + (let ((words (company-ispell--lookup-words + arg + (or company-ispell-dictionary ispell-complete-word-dict))) (completion-ignore-case t)) (if (string= arg "") ;; Small optimization. diff --git a/elpa/company-0.8.12/company-keywords.el b/elpa/company-20160413.1347/company-keywords.el similarity index 89% rename from elpa/company-0.8.12/company-keywords.el rename to elpa/company-20160413.1347/company-keywords.el index f426c06..e59eaa2 100644 --- a/elpa/company-0.8.12/company-keywords.el +++ b/elpa/company-20160413.1347/company-keywords.el @@ -1,6 +1,6 @@ -;;; company-keywords.el --- A company back-end for programming language keywords +;;; company-keywords.el --- A company backend for programming language keywords -;; Copyright (C) 2009-2011 Free Software Foundation, Inc. +;; Copyright (C) 2009-2011, 2016 Free Software Foundation, Inc. ;; Author: Nikolaj Schumacher @@ -35,13 +35,16 @@ (defvar company-keywords-alist ;; Please contribute corrections or additions. `((c++-mode - "asm" "auto" "bool" "break" "case" "catch" "char" "class" "const" - "const_cast" "continue" "default" "delete" "do" "double" "dynamic_cast" - "else" "enum" "explicit" "export" "extern" "false" "float" "for" "friend" - "goto" "if" "inline" "int" "long" "mutable" "namespace" "new" - "operator" "private" "protected" "public" "register" "reinterpret_cast" - "return" "short" "signed" "sizeof" "static" "static_cast" "struct" "switch" - "template" "this" "throw" "true" "try" "typedef" "typeid" "typename" + "alignas" "alignof" "asm" "auto" "bool" "break" "case" "catch" "char" + "char16_t" "char32_t" "class" "const" "const_cast" "constexpr" "continue" + "decltype" "default" "delete" "do" "double" "dynamic_cast" "else" "enum" + "explicit" "export" "extern" "false" "final" "float" "for" "friend" + "goto" "if" "inline" "int" "long" "mutable" "namespace" "new" "noexcept" + "nullptr" "operator" "override" + "private" "protected" "public" "register" "reinterpret_cast" + "return" "short" "signed" "sizeof" "static" "static_assert" + "static_cast" "struct" "switch" "template" "this" "thread_local" + "throw" "true" "try" "typedef" "typeid" "typename" "union" "unsigned" "using" "virtual" "void" "volatile" "wchar_t" "while") (c-mode "auto" "break" "case" "char" "const" "continue" "default" "do" @@ -207,17 +210,31 @@ "do" "else" "elsif" "end" "ensure" "false" "for" "if" "in" "module" "next" "nil" "not" "or" "redo" "rescue" "retry" "return" "self" "super" "then" "true" "undef" "unless" "until" "when" "while" "yield") + (scala-mode + "abstract" "case" "catch" "class" "def" "do" "else" "extends" "false" + "final" "finally" "for" "forSome" "if" "implicit" "import" "lazy" "match" + "new" "null" "object" "override" "package" "private" "protected" + "return" "sealed" "super" "this" "throw" "trait" "true" "try" "type" "val" + "var" "while" "with" "yield") + (julia-mode + "abstract" "break" "case" "catch" "const" "continue" "do" "else" "elseif" + "end" "eval" "export" "false" "finally" "for" "function" "global" "if" + "ifelse" "immutable" "import" "importall" "in" "let" "macro" "module" + "otherwise" "quote" "return" "switch" "throw" "true" "try" "type" + "typealias" "using" "while" + ) ;; aliases (js2-mode . javascript-mode) (espresso-mode . javascript-mode) (js-mode . javascript-mode) (cperl-mode . perl-mode) - (jde-mode . java-mode)) + (jde-mode . java-mode) + (ess-julia-mode . julia-mode)) "Alist mapping major-modes to sorted keywords for `company-keywords'.") ;;;###autoload (defun company-keywords (command &optional arg &rest ignored) - "`company-mode' back-end for programming language keywords." + "`company-mode' backend for programming language keywords." (interactive (list 'interactive)) (cl-case command (interactive (company-begin-backend 'company-keywords)) diff --git a/elpa/company-0.8.12/company-nxml.el b/elpa/company-20160413.1347/company-nxml.el similarity index 97% rename from elpa/company-0.8.12/company-nxml.el rename to elpa/company-20160413.1347/company-nxml.el index 70e1c09..9c180e9 100644 --- a/elpa/company-0.8.12/company-nxml.el +++ b/elpa/company-20160413.1347/company-nxml.el @@ -1,4 +1,4 @@ -;;; company-nxml.el --- company-mode completion back-end for nxml-mode +;;; company-nxml.el --- company-mode completion backend for nxml-mode ;; Copyright (C) 2009-2011, 2013 Free Software Foundation, Inc. @@ -121,7 +121,7 @@ ;;;###autoload (defun company-nxml (command &optional arg &rest ignored) - "`company-mode' completion back-end for `nxml-mode'." + "`company-mode' completion backend for `nxml-mode'." (interactive (list 'interactive)) (cl-case command (interactive (company-begin-backend 'company-nxml)) diff --git a/elpa/company-0.8.12/company-oddmuse.el b/elpa/company-20160413.1347/company-oddmuse.el similarity index 91% rename from elpa/company-0.8.12/company-oddmuse.el rename to elpa/company-20160413.1347/company-oddmuse.el index aa30f2a..1b68950 100644 --- a/elpa/company-0.8.12/company-oddmuse.el +++ b/elpa/company-20160413.1347/company-oddmuse.el @@ -1,4 +1,4 @@ -;;; company-oddmuse.el --- company-mode completion back-end for oddmuse-mode +;;; company-oddmuse.el --- company-mode completion backend for oddmuse-mode ;; Copyright (C) 2009-2011, 2014 Free Software Foundation, Inc. @@ -27,7 +27,7 @@ (require 'company) (require 'cl-lib) -(eval-when-compile (require 'yaooddmuse nil t)) +(eval-when-compile (require 'yaoddmuse nil t)) (eval-when-compile (require 'oddmuse nil t)) (defvar company-oddmuse-link-regexp @@ -42,7 +42,7 @@ ;;;###autoload (defun company-oddmuse (command &optional arg &rest ignored) - "`company-mode' completion back-end for `oddmuse-mode'." + "`company-mode' completion backend for `oddmuse-mode'." (interactive (list 'interactive)) (cl-case command (interactive (company-begin-backend 'company-oddmuse)) diff --git a/elpa/company-20160413.1347/company-pkg.el b/elpa/company-20160413.1347/company-pkg.el new file mode 100644 index 0000000..8b8fb05 --- /dev/null +++ b/elpa/company-20160413.1347/company-pkg.el @@ -0,0 +1,8 @@ +(define-package "company" "20160413.1347" "Modular text completion framework" + '((emacs "24.1") + (cl-lib "0.5")) + :url "http://company-mode.github.io/" :keywords + '("abbrev" "convenience" "matching")) +;; Local Variables: +;; no-byte-compile: t +;; End: diff --git a/elpa/company-0.8.12/company-semantic.el b/elpa/company-20160413.1347/company-semantic.el similarity index 74% rename from elpa/company-0.8.12/company-semantic.el rename to elpa/company-20160413.1347/company-semantic.el index a1c7d16..8b13b72 100644 --- a/elpa/company-0.8.12/company-semantic.el +++ b/elpa/company-20160413.1347/company-semantic.el @@ -1,6 +1,6 @@ -;;; company-semantic.el --- company-mode completion back-end using Semantic +;;; company-semantic.el --- company-mode completion backend using Semantic -;; Copyright (C) 2009-2011, 2013 Free Software Foundation, Inc. +;; Copyright (C) 2009-2011, 2013-2016 Free Software Foundation, Inc. ;; Author: Nikolaj Schumacher @@ -26,6 +26,7 @@ ;;; Code: (require 'company) +(require 'company-template) (require 'cl-lib) (defvar semantic-idle-summary-function) @@ -38,15 +39,30 @@ (declare-function semantic-tag-start "semantic/tag") (declare-function semantic-tag-buffer "semantic/tag") (declare-function semantic-active-p "semantic") +(declare-function semantic-format-tag-prototype "semantic/format") (defgroup company-semantic nil - "Completion back-end using Semantic." + "Completion backend using Semantic." :group 'company) (defcustom company-semantic-metadata-function 'company-semantic-summary-and-doc "The function turning a semantic tag into doc information." :type 'function) +(defcustom company-semantic-begin-after-member-access t + "When non-nil, automatic completion will start whenever the current +symbol is preceded by \".\", \"->\" or \"::\", ignoring +`company-minimum-prefix-length'. + +If `company-begin-commands' is a list, it should include `c-electric-lt-gt' +and `c-electric-colon', for automatic completion right after \">\" and +\":\".") + +(defcustom company-semantic-insert-arguments t + "When non-nil, insert function arguments as a template after completion." + :type 'boolean + :package-version '(company . "0.9.0")) + (defvar company-semantic-modes '(c-mode c++-mode jde-mode java-mode)) (defvar-local company-semantic--current-tags nil @@ -89,7 +105,7 @@ (let ((completion-ignore-case nil) (context (semantic-analyze-current-context))) (setq company-semantic--current-tags - (semantic-analyze-possible-completions context)) + (semantic-analyze-possible-completions context 'no-unique)) (all-completions prefix company-semantic--current-tags)))) (defun company-semantic-completions-raw (prefix) @@ -100,33 +116,21 @@ (delete "" (mapcar 'semantic-tag-name company-semantic--current-tags))) (defun company-semantic-annotation (argument tags) - (let* ((tag (assoc argument tags)) + (let* ((tag (assq argument tags)) (kind (when tag (elt tag 1)))) (cl-case kind (function (let* ((prototype (semantic-format-tag-prototype tag nil nil)) (par-pos (string-match "(" prototype))) (when par-pos (substring prototype par-pos))))))) -(defun company-semantic--pre-prefix-length (prefix-length) - "Sum up the length of all chained symbols before POS. -Symbols are chained by \".\" or \"->\"." - (save-excursion - (let ((pos (point))) - (goto-char (- (point) prefix-length)) - (while (looking-back "->\\|\\.") - (goto-char (match-beginning 0)) - (skip-syntax-backward "w_")) - (- pos (point))))) - -(defun company-semantic--grab () - "Grab the semantic prefix, but return everything before -> or . as length." - (let ((symbol (company-grab-symbol))) - (when symbol - (cons symbol (company-semantic--pre-prefix-length (length symbol)))))) +(defun company-semantic--prefix () + (if company-semantic-begin-after-member-access + (company-grab-symbol-cons "\\.\\|->\\|::" 2) + (company-grab-symbol))) ;;;###autoload (defun company-semantic (command &optional arg &rest ignored) - "`company-mode' completion back-end using CEDET Semantic." + "`company-mode' completion backend using CEDET Semantic." (interactive (list 'interactive)) (cl-case command (interactive (company-begin-backend 'company-semantic)) @@ -134,9 +138,9 @@ Symbols are chained by \".\" or \"->\"." (semantic-active-p) (memq major-mode company-semantic-modes) (not (company-in-string-or-comment)) - (or (company-semantic--grab) 'stop))) + (or (company-semantic--prefix) 'stop))) (candidates (if (and (equal arg "") - (not (looking-back "->\\|\\."))) + (not (looking-back "->\\|\\." (- (point) 2)))) (company-semantic-completions-raw arg) (company-semantic-completions arg))) (meta (funcall company-semantic-metadata-function @@ -147,10 +151,17 @@ Symbols are chained by \".\" or \"->\"." (assoc arg company-semantic--current-tags))) ;; Because "" is an empty context and doesn't return local variables. (no-cache (equal arg "")) + (duplicates t) (location (let ((tag (assoc arg company-semantic--current-tags))) (when (buffer-live-p (semantic-tag-buffer tag)) (cons (semantic-tag-buffer tag) - (semantic-tag-start tag))))))) + (semantic-tag-start tag))))) + (post-completion (let ((anno (company-semantic-annotation + arg company-semantic--current-tags))) + (when (and company-semantic-insert-arguments anno) + (insert anno) + (company-template-c-like-templatify (concat arg anno))) + )))) (provide 'company-semantic) ;;; company-semantic.el ends here diff --git a/elpa/company-0.8.12/company-template.el b/elpa/company-20160413.1347/company-template.el similarity index 76% rename from elpa/company-0.8.12/company-template.el rename to elpa/company-20160413.1347/company-template.el index 21ae011..053429d 100644 --- a/elpa/company-0.8.12/company-template.el +++ b/elpa/company-20160413.1347/company-template.el @@ -1,6 +1,6 @@ -;;; company-template.el +;;; company-template.el --- utility library for template expansion -;; Copyright (C) 2009, 2010, 2014 Free Software Foundation, Inc. +;; Copyright (C) 2009, 2010, 2014-2016 Free Software Foundation, Inc. ;; Author: Nikolaj Schumacher @@ -93,16 +93,14 @@ (delq templ company-template--buffer-templates)) (delete-overlay templ)) -(defun company-template-add-field (templ pos text &optional display) - "Add new field to template TEMPL at POS, inserting TEXT. +(defun company-template-add-field (templ beg end &optional display) + "Add new field to template TEMPL spanning from BEG to END. When DISPLAY is non-nil, set the respective property on the overlay. Leave point at the end of the field." (cl-assert templ) - (goto-char pos) - (insert text) - (when (> (point) (overlay-end templ)) - (move-overlay templ (overlay-start templ) (point))) - (let ((ov (make-overlay pos (+ pos (length text)))) + (when (> end (overlay-end templ)) + (move-overlay templ (overlay-start templ) end)) + (let ((ov (make-overlay beg end)) (siblings (overlay-get templ 'company-template-fields))) ;; (overlay-put ov 'evaporate t) (overlay-put ov 'intangible t) @@ -149,7 +147,6 @@ Leave point at the end of the field." (defun company-template-c-like-templatify (call) (let* ((end (point-marker)) (beg (- (point) (length call))) - (cnt 0) (templ (company-template-declare-template beg end)) paren-open paren-close) (with-syntax-table (make-syntax-table (syntax-table)) @@ -167,29 +164,51 @@ Leave point at the end of the field." (forward-char 1) (backward-sexp) (forward-char) - (setq cnt (company-template--c-like-args templ angle-close - cnt)))) + (company-template--c-like-args templ angle-close))) + (when (looking-back "\\((\\*)\\)(" (line-beginning-position)) + (delete-region (match-beginning 1) (match-end 1))) (when paren-open (goto-char paren-open) - (company-template--c-like-args templ paren-close cnt))) + (company-template--c-like-args templ paren-close))) (if (overlay-get templ 'company-template-fields) (company-template-move-to-first templ) (company-template-remove-template templ) (goto-char end)))) -(defun company-template--c-like-args (templ end counter) +(defun company-template--c-like-args (templ end) (let ((last-pos (point))) (while (re-search-forward "\\([^,]+\\),?" end 'move) (when (zerop (car (parse-partial-sexp last-pos (point)))) - (let ((sig (buffer-substring-no-properties last-pos (match-end 1)))) - (save-excursion - (company-template-add-field templ last-pos - (format "arg%d" counter) sig) - (delete-region (point) (+ (point) (length sig)))) - (skip-chars-forward " ") - (setq last-pos (point)) - (cl-incf counter))))) - counter) + (company-template-add-field templ last-pos (match-end 1)) + (skip-chars-forward " ") + (setq last-pos (point)))))) + +;; objc ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun company-template-objc-templatify (selector) + (let* ((end (point-marker)) + (beg (- (point) (length selector) 1)) + (templ (company-template-declare-template beg end)) + (cnt 0)) + (save-excursion + (goto-char beg) + (catch 'stop + (while (search-forward ":" end t) + (if (looking-at "\\(([^)]*)\\) ?") + (company-template-add-field templ (point) (match-end 1)) + ;; Not sure which conditions this case manifests under, but + ;; apparently it did before, when I wrote the first test for this + ;; function. FIXME: Revisit it. + (company-template-add-field templ (point) + (progn + (insert (format "arg%d" cnt)) + (point))) + (when (< (point) end) + (insert " ")) + (cl-incf cnt)) + (when (>= (point) end) + (throw 'stop t))))) + (company-template-move-to-first templ))) (provide 'company-template) ;;; company-template.el ends here diff --git a/elpa/company-0.8.12/company-tempo.el b/elpa/company-20160413.1347/company-tempo.el similarity index 74% rename from elpa/company-0.8.12/company-tempo.el rename to elpa/company-20160413.1347/company-tempo.el index ac91988..cba42c3 100644 --- a/elpa/company-0.8.12/company-tempo.el +++ b/elpa/company-20160413.1347/company-tempo.el @@ -1,6 +1,6 @@ -;;; company-tempo.el --- company-mode completion back-end for tempo +;;; company-tempo.el --- company-mode completion backend for tempo -;; Copyright (C) 2009-2011 Free Software Foundation, Inc. +;; Copyright (C) 2009-2011, 2015 Free Software Foundation, Inc. ;; Author: Nikolaj Schumacher @@ -29,6 +29,15 @@ (require 'cl-lib) (require 'tempo) +(defgroup company-tempo nil + "Tempo completion backend." + :group 'company) + +(defcustom company-tempo-expand nil + "Whether to expand a tempo tag after completion." + :type '(choice (const :tag "Off" nil) + (const :tag "On" t))) + (defsubst company-tempo-lookup (match) (cdr (assoc match (tempo-build-collection)))) @@ -48,15 +57,14 @@ ;;;###autoload (defun company-tempo (command &optional arg &rest ignored) - "`company-mode' completion back-end for tempo." + "`company-mode' completion backend for tempo." (interactive (list 'interactive)) (cl-case command - (interactive (company-begin-backend 'company-tempo - 'company-tempo-insert)) + (interactive (company-begin-backend 'company-tempo)) (prefix (or (car (tempo-find-match-string tempo-match-finder)) "")) (candidates (all-completions arg (tempo-build-collection))) (meta (company-tempo-meta arg)) - (require-match t) + (post-completion (when company-tempo-expand (company-tempo-insert arg))) (sorted t))) (provide 'company-tempo) diff --git a/elpa/company-0.8.12/company-xcode.el b/elpa/company-20160413.1347/company-xcode.el similarity index 96% rename from elpa/company-0.8.12/company-xcode.el rename to elpa/company-20160413.1347/company-xcode.el index c7a6f80..56da198 100644 --- a/elpa/company-0.8.12/company-xcode.el +++ b/elpa/company-20160413.1347/company-xcode.el @@ -1,4 +1,4 @@ -;;; company-xcode.el --- company-mode completion back-end for Xcode projects +;;; company-xcode.el --- company-mode completion backend for Xcode projects ;; Copyright (C) 2009-2011, 2014 Free Software Foundation, Inc. @@ -29,7 +29,7 @@ (require 'cl-lib) (defgroup company-xcode nil - "Completion back-end for Xcode projects." + "Completion backend for Xcode projects." :group 'company) (defcustom company-xcode-xcodeindex-executable (executable-find "xcodeindex") @@ -106,7 +106,7 @@ valid in most contexts." company-xcode-tags)))))) ;;;###autoload (defun company-xcode (command &optional arg &rest ignored) - "`company-mode' completion back-end for Xcode projects." + "`company-mode' completion backend for Xcode projects." (interactive (list 'interactive)) (cl-case command (interactive (company-begin-backend 'company-xcode)) diff --git a/elpa/company-0.8.12/company-yasnippet.el b/elpa/company-20160413.1347/company-yasnippet.el similarity index 51% rename from elpa/company-0.8.12/company-yasnippet.el rename to elpa/company-20160413.1347/company-yasnippet.el index f0a7c38..e5fded4 100644 --- a/elpa/company-0.8.12/company-yasnippet.el +++ b/elpa/company-20160413.1347/company-yasnippet.el @@ -1,6 +1,6 @@ -;;; company-yasnippet.el --- company-mode completion back-end for Yasnippet +;;; company-yasnippet.el --- company-mode completion backend for Yasnippet -;; Copyright (C) 2014 Free Software Foundation, Inc. +;; Copyright (C) 2014, 2015 Free Software Foundation, Inc. ;; Author: Dmitry Gutov @@ -33,8 +33,47 @@ (declare-function yas-expand-snippet "yasnippet") (declare-function yas--template-content "yasnippet") (declare-function yas--template-expand-env "yasnippet") +(declare-function yas--warning "yasnippet") + +(defun company-yasnippet--key-prefixes () + ;; Mostly copied from `yas--templates-for-key-at-point'. + (defvar yas-key-syntaxes) + (save-excursion + (let ((original (point)) + (methods yas-key-syntaxes) + prefixes + method) + (while methods + (unless (eq method (car methods)) + (goto-char original)) + (setq method (car methods)) + (cond ((stringp method) + (skip-syntax-backward method) + (setq methods (cdr methods))) + ((functionp method) + (unless (eq (funcall method original) + 'again) + (setq methods (cdr methods)))) + (t + (setq methods (cdr methods)) + (yas--warning "Invalid element `%s' in `yas-key-syntaxes'" method))) + (let ((prefix (buffer-substring-no-properties (point) original))) + (unless (equal prefix (car prefixes)) + (push prefix prefixes)))) + prefixes))) (defun company-yasnippet--candidates (prefix) + ;; Process the prefixes in reverse: unlike Yasnippet, we look for prefix + ;; matches, so the longest prefix with any matches should be the most useful. + (cl-loop with tables = (yas--get-snippet-tables) + for key-prefix in (company-yasnippet--key-prefixes) + ;; Only consider keys at least as long as the symbol at point. + when (>= (length key-prefix) (length prefix)) + thereis (company-yasnippet--completions-for-prefix prefix + key-prefix + tables))) + +(defun company-yasnippet--completions-for-prefix (prefix key-prefix tables) (cl-mapcan (lambda (table) (let ((keyhash (yas--table-hash table)) @@ -43,28 +82,30 @@ (maphash (lambda (key value) (when (and (stringp key) - (string-prefix-p prefix key)) + (string-prefix-p key-prefix key)) (maphash (lambda (name template) (push (propertize key 'yas-annotation name - 'yas-template template) + 'yas-template template + 'yas-prefix-offset (- (length key-prefix) + (length prefix))) res)) value))) keyhash)) res)) - (yas--get-snippet-tables))) + tables)) ;;;###autoload (defun company-yasnippet (command &optional arg &rest ignore) - "`company-mode' back-end for `yasnippet'. + "`company-mode' backend for `yasnippet'. -This back-end should be used with care, because as long as there are -snippets defined for the current major mode, this back-end will always -shadow back-ends that come after it. Recommended usages: +This backend should be used with care, because as long as there are +snippets defined for the current major mode, this backend will always +shadow backends that come after it. Recommended usages: -* In a buffer-local value of `company-backends', grouped with a back-end or +* In a buffer-local value of `company-backends', grouped with a backend or several that provide actual text completions. (add-hook 'js-mode-hook @@ -72,7 +113,7 @@ shadow back-ends that come after it. Recommended usages: (set (make-local-variable 'company-backends) '((company-dabbrev-code company-yasnippet))))) -* After keyword `:with', grouped with other back-ends. +* After keyword `:with', grouped with other backends. (push '(company-semantic :with company-yasnippet) company-backends) @@ -93,10 +134,12 @@ shadow back-ends that come after it. Recommended usages: (unless company-tooltip-align-annotations " -> ") (get-text-property 0 'yas-annotation arg))) (candidates (company-yasnippet--candidates arg)) + (no-cache t) (post-completion - (let ((template (get-text-property 0 'yas-template arg))) + (let ((template (get-text-property 0 'yas-template arg)) + (prefix-offset (get-text-property 0 'yas-prefix-offset arg))) (yas-expand-snippet (yas--template-content template) - (- (point) (length arg)) + (- (point) (length arg) prefix-offset) (point) (yas--template-expand-env template)))))) diff --git a/elpa/company-0.8.12/company.el b/elpa/company-20160413.1347/company.el similarity index 81% rename from elpa/company-0.8.12/company.el rename to elpa/company-20160413.1347/company.el index ce0b5a4..23ed09a 100644 --- a/elpa/company-0.8.12/company.el +++ b/elpa/company-20160413.1347/company.el @@ -1,11 +1,11 @@ ;;; company.el --- Modular text completion framework -*- lexical-binding: t -*- -;; Copyright (C) 2009-2015 Free Software Foundation, Inc. +;; Copyright (C) 2009-2016 Free Software Foundation, Inc. ;; Author: Nikolaj Schumacher ;; Maintainer: Dmitry Gutov ;; URL: http://company-mode.github.io/ -;; Version: 0.8.12 +;; Version: 0.9.0-cvs ;; Keywords: abbrev, convenience, matching ;; Package-Requires: ((emacs "24.1") (cl-lib "0.5")) @@ -26,37 +26,32 @@ ;;; Commentary: ;; -;; Company is a modular completion mechanism. Modules for retrieving completion -;; candidates are called back-ends, modules for displaying them are front-ends. +;; Company is a modular completion framework. Modules for retrieving completion +;; candidates are called backends, modules for displaying them are frontends. ;; -;; Company comes with many back-ends, e.g. `company-elisp'. These are +;; Company comes with many backends, e.g. `company-etags'. These are ;; distributed in separate files and can be used individually. ;; -;; Place company.el and the back-ends you want to use in a directory and add the -;; following to your .emacs: -;; (add-to-list 'load-path "/path/to/company") -;; (autoload 'company-mode "company" nil t) +;; Enable `company-mode' in all buffers with M-x global-company-mode. For +;; further information look at the documentation for `company-mode' (C-h f +;; company-mode RET). ;; -;; Enable company-mode with M-x company-mode. For further information look at -;; the documentation for `company-mode' (C-h f company-mode RET) -;; -;; If you want to start a specific back-end, call it interactively or use +;; If you want to start a specific backend, call it interactively or use ;; `company-begin-backend'. For example: ;; M-x company-abbrev will prompt for and insert an abbrev. ;; -;; To write your own back-end, look at the documentation for `company-backends'. +;; To write your own backend, look at the documentation for `company-backends'. ;; Here is a simple example completing "foo": ;; ;; (defun company-my-backend (command &optional arg &rest ignored) ;; (pcase command -;; (`prefix (when (looking-back "foo\\>") -;; (match-string 0))) +;; (`prefix (company-grab-symbol)) ;; (`candidates (list "foobar" "foobaz" "foobarbaz")) ;; (`meta (format "This value is named %s" arg)))) ;; -;; Sometimes it is a good idea to mix several back-ends together, for example to -;; enrich gtags with dabbrev-code results (to emulate local variables). -;; To do this, add a list with both back-ends as an element in company-backends. +;; Sometimes it is a good idea to mix several backends together, for example to +;; enrich gtags with dabbrev-code results (to emulate local variables). To do +;; this, add a list with both backends as an element in `company-backends'. ;; ;;; Change Log: ;; @@ -66,6 +61,7 @@ (require 'cl-lib) (require 'newcomment) +(require 'pcase) ;; FIXME: Use `user-error'. (add-to-list 'debug-ignored-errors "^.* frontend cannot be used twice$") @@ -74,7 +70,7 @@ (add-to-list 'debug-ignored-errors "^Company not ") (add-to-list 'debug-ignored-errors "^No candidate number ") (add-to-list 'debug-ignored-errors "^Cannot complete at point$") -(add-to-list 'debug-ignored-errors "^No other back-end$") +(add-to-list 'debug-ignored-errors "^No other backend$") ;;; Compatibility (eval-and-compile @@ -104,8 +100,7 @@ buffer-local wherever it is set." "Face used for the tooltip.") (defface company-tooltip-selection - '((default :inherit company-tooltip) - (((class color) (min-colors 88) (background light)) + '((((class color) (min-colors 88) (background light)) (:background "light blue")) (((class color) (min-colors 88) (background dark)) (:background "orange1")) @@ -121,28 +116,26 @@ buffer-local wherever it is set." "Face used for the tooltip item under the mouse.") (defface company-tooltip-common - '((default :inherit company-tooltip) - (((background light)) + '((((background light)) :foreground "darkred") (((background dark)) :foreground "red")) "Face used for the common completion in the tooltip.") (defface company-tooltip-common-selection - '((default :inherit company-tooltip-selection) - (((background light)) - :foreground "darkred") - (((background dark)) - :foreground "red")) + '((default :inherit company-tooltip-common)) "Face used for the selected common completion in the tooltip.") (defface company-tooltip-annotation - '((default :inherit company-tooltip) - (((background light)) + '((((background light)) :foreground "firebrick4") (((background dark)) :foreground "red4")) - "Face used for the annotation in the tooltip.") + "Face used for the completion annotation in the tooltip.") + +(defface company-tooltip-annotation-selection + '((default :inherit company-tooltip-annotation)) + "Face used for the selected completion annotation in the tooltip.") (defface company-scrollbar-fg '((((background light)) @@ -152,8 +145,7 @@ buffer-local wherever it is set." "Face used for the tooltip scrollbar thumb.") (defface company-scrollbar-bg - '((default :inherit company-tooltip) - (((background light)) + '((((background light)) :background "wheat") (((background dark)) :background "gold")) @@ -161,7 +153,7 @@ buffer-local wherever it is set." (defface company-preview '((((background light)) - :inherit company-tooltip-selection) + :inherit (company-tooltip-selection company-tooltip)) (((background dark)) :background "blue4" :foreground "wheat")) @@ -169,7 +161,7 @@ buffer-local wherever it is set." (defface company-preview-common '((((background light)) - :inherit company-tooltip-selection) + :inherit company-tooltip-common-selection) (((background dark)) :inherit company-preview :foreground "red")) @@ -212,8 +204,8 @@ buffer-local wherever it is set." (defcustom company-frontends '(company-pseudo-tooltip-unless-just-one-frontend company-preview-if-just-one-frontend company-echo-metadata-frontend) - "The list of active front-ends (visualizations). -Each front-end is a function that takes one argument. It is called with + "The list of active frontends (visualizations). +Each frontend is a function that takes one argument. It is called with one of the following arguments: `show': When the visualization should start. @@ -300,8 +292,6 @@ This doesn't include the margins and the scroll bar." (company-keywords . "Programming language keywords") (company-nxml . "nxml") (company-oddmuse . "Oddmuse") - (company-pysmell . "PySmell") - (company-ropemacs . "ropemacs") (company-semantic . "Semantic") (company-tempo . "Tempo templates") (company-xcode . "Xcode"))) @@ -315,37 +305,39 @@ This doesn't include the margins and the scroll bar." (assq backend company-safe-backends)) (cl-return t)))))) -(defcustom company-backends `(,@(unless (version< "24.3.50" emacs-version) +(defcustom company-backends `(,@(unless (version< "24.3.51" emacs-version) (list 'company-elisp)) company-bbdb company-nxml company-css company-eclim company-semantic company-clang - company-xcode company-ropemacs company-cmake + company-xcode company-cmake company-capf + company-files (company-dabbrev-code company-gtags company-etags company-keywords) - company-oddmuse company-files company-dabbrev) - "The list of active back-ends (completion engines). + company-oddmuse company-dabbrev) + "The list of active backends (completion engines). -Only one back-end is used at a time. The choice depends on the order of +Only one backend is used at a time. The choice depends on the order of the items in this list, and on the values they return in response to the -`prefix' command (see below). But a back-end can also be a \"grouped\" +`prefix' command (see below). But a backend can also be a \"grouped\" one (see below). -`company-begin-backend' can be used to start a specific back-end, -`company-other-backend' will skip to the next matching back-end in the list. +`company-begin-backend' can be used to start a specific backend, +`company-other-backend' will skip to the next matching backend in the list. -Each back-end is a function that takes a variable number of arguments. -The first argument is the command requested from the back-end. It is one +Each backend is a function that takes a variable number of arguments. +The first argument is the command requested from the backend. It is one of the following: -`prefix': The back-end should return the text to be completed. It must be +`prefix': The backend should return the text to be completed. It must be text immediately before point. Returning nil from this command passes -control to the next back-end. The function should return `stop' if it +control to the next backend. The function should return `stop' if it should complete but cannot (e.g. if it is in the middle of a string). -Instead of a string, the back-end may return a cons where car is the prefix -and cdr is used in `company-minimum-prefix-length' test. It must be either -number or t, and in the latter case the test automatically succeeds. +Instead of a string, the backend may return a cons (PREFIX . LENGTH) +where LENGTH is a number used in place of PREFIX's length when +comparing against `company-minimum-prefix-length'. LENGTH can also +be just t, and in the latter case the test automatically succeeds. `candidates': The second argument is the prefix to be completed. The return value should be a list of candidates that match the prefix. @@ -355,7 +347,8 @@ prefix, but match it in some backend-defined way). Backends that use this feature must disable cache (return t to `no-cache') and might also want to respond to `match'. -Optional commands: +Optional commands +================= `sorted': Return t here to indicate that the candidates are sorted and will not need to be sorted again. @@ -364,16 +357,23 @@ not need to be sorted again. from the list. `no-cache': Usually company doesn't ask for candidates again as completion -progresses, unless the back-end returns t for this command. The second +progresses, unless the backend returns t for this command. The second argument is the latest prefix. +`ignore-case': Return t here if the backend returns case-insensitive +matches. This value is used to determine the longest common prefix (as +used in `company-complete-common'), and to filter completions when fetching +them from cache. + `meta': The second argument is a completion candidate. Return a (short) documentation string for it. `doc-buffer': The second argument is a completion candidate. Return a -buffer with documentation for it. Preferably use `company-doc-buffer', +buffer with documentation for it. Preferably use `company-doc-buffer'. If +not all buffer contents pertain to this candidate, return a cons of buffer +and window start position. -`location': The second argument is a completion candidate. Return the cons +`location': The second argument is a completion candidate. Return a cons of buffer and buffer location, or of file and line number where the completion candidate was defined. @@ -390,56 +390,62 @@ will be used when rendering the popup. This command only makes sense for backends that provide non-prefix completion. `require-match': If this returns t, the user is not allowed to enter -anything not offered as a candidate. Use with care! The default value nil -gives the user that choice with `company-require-match'. Return value -`never' overrides that option the other way around. +anything not offered as a candidate. Please don't use that value in normal +backends. The default value nil gives the user that choice with +`company-require-match'. Return value `never' overrides that option the +other way around. -`init': Called once for each buffer. The back-end can check for external +`init': Called once for each buffer. The backend can check for external programs and files and load any required libraries. Raising an error here -will show up in message log once, and the back-end will not be used for +will show up in message log once, and the backend will not be used for completion. `post-completion': Called after a completion candidate has been inserted into the buffer. The second argument is the candidate. Can be used to modify it, e.g. to expand a snippet. -The back-end should return nil for all commands it does not support or +The backend should return nil for all commands it does not support or does not know about. It should also be callable interactively and use `company-begin-backend' to start itself in that case. -Grouped back-ends: +Grouped backends +================ -An element of `company-backends' can also itself be a list of back-ends, -then it's considered to be a \"grouped\" back-end. +An element of `company-backends' can also be a list of backends. The +completions from backends in such groups are merged, but only from those +backends which return the same `prefix'. -When possible, commands taking a candidate as an argument are dispatched to -the back-end it came from. In other cases, the first non-nil value among -all the back-ends is returned. +If a backend command takes a candidate as an argument (e.g. `meta'), the +call is dispatched to the backend the candidate came from. In other +cases (except for `duplicates' and `sorted'), the first non-nil value among +all the backends is returned. -The latter is the case for the `prefix' command. But if the group contains -the keyword `:with', the back-ends after it are ignored for this command. +The group can also contain keywords. Currently, `:with' and `:sorted' +keywords are defined. If the group contains keyword `:with', the backends +listed after this keyword are ignored for the purpose of the `prefix' +command. If the group contains keyword `:sorted', the final list of +candidates is not sorted after concatenation. -The completions from back-ends in a group are merged (but only from those -that return the same `prefix'). - -Asynchronous back-ends: +Asynchronous backends +===================== The return value of each command can also be a cons (:async . FETCHER) where FETCHER is a function of one argument, CALLBACK. When the data arrives, FETCHER must call CALLBACK and pass it the appropriate return -value, as described above. +value, as described above. That call must happen in the same buffer as +where completion was initiated. True asynchronous operation is only supported for command `candidates', and only during idle completion. Other commands will block the user interface, -even if the back-end uses the asynchronous calling convention." +even if the backend uses the asynchronous calling convention." :type `(repeat (choice - :tag "Back-end" + :tag "backend" ,@(mapcar (lambda (b) `(const :tag ,(cdr b) ,(car b))) company-safe-backends) (symbol :tag "User defined") - (repeat :tag "Merged Back-ends" - (choice :tag "Back-end" + (repeat :tag "Merged backends" + (choice :tag "backend" ,@(mapcar (lambda (b) `(const :tag ,(cdr b) ,(car b))) company-safe-backends) @@ -457,7 +463,7 @@ without duplicates." :type '(choice (const :tag "None" nil) (const :tag "Sort by occurrence" (company-sort-by-occurrence)) - (const :tag "Sort by back-end importance" + (const :tag "Sort by backend importance" (company-sort-by-backend-importance)) (repeat :tag "User defined" (function)))) @@ -478,7 +484,7 @@ aborted manually." The hook is called with the selected candidate as an argument. If you indend to use it to post-process candidates from a specific -back-end, consider using the `post-completion' command instead." +backend, consider using the `post-completion' command instead." :type 'hook) (defcustom company-minimum-prefix-length 3 @@ -496,7 +502,7 @@ prefix it was started from." "If enabled, disallow non-matching input. This can be a function do determine if a match is required. -This can be overridden by the back-end, if it returns t or `never' to +This can be overridden by the backend, if it returns t or `never' to `require-match'. `company-auto-complete' also takes precedence over this." :type '(choice (const :tag "Off" nil) (function :tag "Predicate function") @@ -651,7 +657,7 @@ asynchronous call into synchronous.") (error (put backend 'company-init 'failed) (unless (memq backend company--disabled-backends) - (message "Company back-end '%s' could not be initialized:\n%s" + (message "Company backend '%s' could not be initialized:\n%s" backend (error-message-string err))) (cl-pushnew backend company--disabled-backends) nil))) @@ -668,7 +674,7 @@ asynchronous call into synchronous.") :package-version '(company . "0.8.10")) (defvar company-lighter '(" " - (company-backend + (company-candidates (:eval (if (consp company-backend) (company--group-lighter (nth company-selection @@ -699,9 +705,12 @@ Completions can be searched with `company-search-candidates' or inactive, as well. The completion data is retrieved using `company-backends' and displayed -using `company-frontends'. If you want to start a specific back-end, call +using `company-frontends'. If you want to start a specific backend, call it interactively or use `company-begin-backend'. +By default, the completions list is sorted alphabetically, unless the +backend chooses otherwise, or `company-transformers' changes it later. + regular keymap (`company-mode-map'): \\{company-mode-map} @@ -797,7 +806,9 @@ means that `company-mode' is always turned on except in `message-mode' buffers." (let ((col (car (posn-col-row posn))) ;; `posn-col-row' doesn't work well with lines of different height. ;; `posn-actual-col-row' doesn't handle multiple-width characters. - (row (cdr (posn-actual-col-row posn)))) + (row (cdr (or (posn-actual-col-row posn) + ;; When position is non-visible for some reason. + (posn-col-row posn))))) (when (and header-line-format (version< emacs-version "24.3.93.3")) ;; http://debbugs.gnu.org/18384 (cl-decf row)) @@ -818,9 +829,16 @@ means that `company-mode' is always turned on except in `message-mode' buffers." (or (match-string-no-properties (or expression 0)) ""))) (defun company-grab-line (regexp &optional expression) - (company-grab regexp expression (point-at-bol))) + "Return a match string for REGEXP if it matches text before point. +If EXPRESSION is non-nil, return the match string for the respective +parenthesized expression in REGEXP. +Matching is limited to the current line." + (let ((inhibit-field-text-motion t)) + (company-grab regexp expression (point-at-bol)))) (defun company-grab-symbol () + "If point is at the end of a symbol, return it. +Otherwise, if point is not inside a symbol, return an empty string." (if (looking-at "\\_>") (buffer-substring (point) (save-excursion (skip-syntax-backward "w_") (point))) @@ -828,6 +846,8 @@ means that `company-mode' is always turned on except in `message-mode' buffers." ""))) (defun company-grab-word () + "If point is at the end of a word, return it. +Otherwise, if point is not inside a symbol, return an empty string." (if (looking-at "\\>") (buffer-substring (point) (save-excursion (skip-syntax-backward "w") (point))) @@ -835,6 +855,9 @@ means that `company-mode' is always turned on except in `message-mode' buffers." ""))) (defun company-grab-symbol-cons (idle-begin-after-re &optional max-len) + "Return a string SYMBOL or a cons (SYMBOL . t). +SYMBOL is as returned by `company-grab-symbol'. If the text before point +matches IDLE-BEGIN-AFTER-RE, return it wrapped in a cons." (let ((symbol (company-grab-symbol))) (when symbol (save-excursion @@ -846,6 +869,7 @@ means that `company-mode' is always turned on except in `message-mode' buffers." symbol))))) (defun company-in-string-or-comment () + "Return non-nil if point is within a string or comment." (let ((ppss (syntax-ppss))) (or (car (setq ppss (nthcdr 3 ppss))) (car (setq ppss (cdr ppss))) @@ -864,7 +888,7 @@ means that `company-mode' is always turned on except in `message-mode' buffers." (lambda (result) (setq res result))) (while (eq res 'trash) (if (> (- (time-to-seconds) start) company-async-timeout) - (error "Company: Back-end %s async timeout with args %s" + (error "Company: backend %s async timeout with args %s" backend args) (sleep-for company-async-wait))) res)))) @@ -874,7 +898,7 @@ means that `company-mode' is always turned on except in `message-mode' buffers." (if (functionp company-backend) (apply company-backend args) (apply #'company--multi-backend-adapter company-backend args)) - (error (error "Company: Back-end %s error \"%s\" with args %s" + (error (error "Company: backend %s error \"%s\" with args %s" company-backend (error-message-string err) args)))) (defun company--multi-backend-adapter (backends command &rest args) @@ -882,14 +906,17 @@ means that `company-mode' is always turned on except in `message-mode' buffers." when (not (and (symbolp b) (eq 'failed (get b 'company-init)))) collect b))) - (setq backends - (if (eq command 'prefix) - (butlast backends (length (member :with backends))) - (delq :with backends))) + + (when (eq command 'prefix) + (setq backends (butlast backends (length (member :with backends))))) + + (unless (memq command '(sorted)) + (setq backends (cl-delete-if #'keywordp backends))) + (pcase command (`candidates (company--multi-backend-adapter-candidates backends (car args))) - (`sorted nil) + (`sorted (memq :sorted backends)) (`duplicates t) ((or `prefix `ignore-case `no-cache `require-match) (let (value) @@ -995,17 +1022,18 @@ Controlled by `company-auto-complete'.") (substring str (length company-prefix))) (defun company--insert-candidate (candidate) - (setq candidate (substring-no-properties candidate)) - ;; XXX: Return value we check here is subject to change. - (if (eq (company-call-backend 'ignore-case) 'keep-prefix) - (insert (company-strip-prefix candidate)) - (unless (equal company-prefix candidate) - (delete-region (- (point) (length company-prefix)) (point)) - (insert candidate)))) + (when (> (length candidate) 0) + (setq candidate (substring-no-properties candidate)) + ;; XXX: Return value we check here is subject to change. + (if (eq (company-call-backend 'ignore-case) 'keep-prefix) + (insert (company-strip-prefix candidate)) + (unless (equal company-prefix candidate) + (delete-region (- (point) (length company-prefix)) (point)) + (insert candidate))))) (defmacro company-with-candidate-inserted (candidate &rest body) "Evaluate BODY with CANDIDATE temporarily inserted. -This is a tool for back-ends that need candidates inserted before they +This is a tool for backends that need candidates inserted before they can retrieve meta-data for them." (declare (indent 1)) `(let ((inhibit-modification-hooks t) @@ -1053,7 +1081,7 @@ can retrieve meta-data for them." (dolist (frontend company-frontends) (condition-case-unless-debug err (funcall frontend command) - (error (error "Company: Front-end %s error \"%s\" on command %s" + (error (error "Company: frontend %s error \"%s\" on command %s" frontend (error-message-string err) command))))) (defun company-set-selection (selection &optional force-update) @@ -1068,7 +1096,8 @@ can retrieve meta-data for them." (defun company--group-lighter (candidate base) (let ((backend (or (get-text-property 0 'company-backend candidate) - (car company-backend)))) + (cl-some (lambda (x) (and (not (keywordp x)) x)) + company-backend)))) (when (and backend (symbolp backend)) (let ((name (replace-regexp-in-string "company-\\|-company" "" (symbol-name backend)))) @@ -1138,10 +1167,11 @@ can retrieve meta-data for them." t)))) (defun company--fetch-candidates (prefix) - (let ((c (if company--manual-action - (company-call-backend 'candidates prefix) - (company-call-backend-raw 'candidates prefix))) - res) + (let* ((non-essential (not (company-explicit-action-p))) + (c (if company--manual-action + (company-call-backend 'candidates prefix) + (company-call-backend-raw 'candidates prefix))) + res) (if (not (eq (car c) :async)) c (let ((buf (current-buffer)) @@ -1160,7 +1190,11 @@ can retrieve meta-data for them." company-candidates-cache (list (cons prefix (company--preprocess-candidates candidates)))) - (company-idle-begin buf win tick pt))))) + (unwind-protect + (company-idle-begin buf win tick pt) + (unless company-candidates + (setq company-backend nil + company-candidates-cache nil))))))) ;; FIXME: Relying on the fact that the callers ;; will interpret nil as "do nothing" is shaky. ;; A throw-catch would be one possible improvement. @@ -1171,7 +1205,7 @@ can retrieve meta-data for them." (unless (company-call-backend 'sorted) (setq candidates (sort candidates 'string<))) (when (company-call-backend 'duplicates) - (company--strip-duplicates candidates)) + (setq candidates (company--strip-duplicates candidates))) candidates) (defun company--postprocess-candidates (candidates) @@ -1182,27 +1216,37 @@ can retrieve meta-data for them." (company--transform-candidates candidates)) (defun company--strip-duplicates (candidates) - (let ((c2 candidates) - (annos 'unk)) - (while c2 - (setcdr c2 - (let ((str (pop c2))) - (while (let ((str2 (car c2))) - (if (not (equal str str2)) - (progn - (setq annos 'unk) - nil) - (when (eq annos 'unk) - (setq annos (list (company-call-backend - 'annotation str)))) - (let ((anno2 (company-call-backend - 'annotation str2))) - (if (member anno2 annos) - t - (push anno2 annos) - nil)))) - (pop c2)) - c2))))) + (let* ((annos 'unk) + (str (car candidates)) + (ref (cdr candidates)) + res str2 anno2) + (while ref + (setq str2 (pop ref)) + (if (not (equal str str2)) + (progn + (push str res) + (setq str str2) + (setq annos 'unk)) + (setq anno2 (company-call-backend + 'annotation str2)) + (cond + ((null anno2)) ; Skip it. + ((when (eq annos 'unk) + (let ((ann1 (company-call-backend 'annotation str))) + (if (null ann1) + ;; No annotation on the earlier element, drop it. + t + (setq annos (list ann1)) + nil))) + (setq annos (list anno2)) + (setq str str2)) + ((member anno2 annos)) ; Also skip. + (t + (push anno2 annos) + (push str res) ; Maintain ordering. + (setq str str2))))) + (when str (push str res)) + (nreverse res))) (defun company--transform-candidates (candidates) (let ((c candidates)) @@ -1281,8 +1325,8 @@ Keywords and function definition names are ignored." (defun company-sort-by-backend-importance (candidates) "Sort CANDIDATES as two priority groups. If `company-backend' is a function, do nothing. If it's a list, move -candidates from back-ends before keyword `:with' to the front. Candidates -from the rest of the back-ends in the group, if any, will be left at the end." +candidates from backends before keyword `:with' to the front. Candidates +from the rest of the backends in the group, if any, will be left at the end." (if (functionp company-backend) candidates (let ((low-priority (cdr (memq :with company-backend)))) @@ -1320,6 +1364,7 @@ from the rest of the back-ends in the group, if any, will be left at the end." (company-cancel)) (quit (company-cancel)))))) +;;;###autoload (defun company-manual-begin () (interactive) (company-assert-enabled) @@ -1346,7 +1391,7 @@ from the rest of the back-ends in the group, if any, will be left at the end." (when (ignore-errors (company-begin-backend backend)) (cl-return t)))) (unless company-candidates - (error "No other back-end"))) + (error "No other backend"))) (defun company-require-match-p () (let ((backend-value (company-call-backend 'require-match))) @@ -1461,10 +1506,14 @@ from the rest of the back-ends in the group, if any, will be left at the end." (setq company-prefix (company--prefix-str prefix) company-backend backend c (company-calculate-candidates company-prefix)) - ;; t means complete/unique. We don't start, so no hooks. (if (not (consp c)) - (when company--manual-action - (message "No completion found")) + (progn + (when company--manual-action + (message "No completion found")) + (when (eq c t) + ;; t means complete/unique. + ;; Run the hooks anyway, to e.g. clear the cache. + (company-cancel 'unique))) (when company--manual-action (setq company--manual-prefix prefix)) (company-update-candidates c) @@ -1485,14 +1534,8 @@ from the rest of the back-ends in the group, if any, will be left at the end." (company-call-frontends 'update))) (defun company-cancel (&optional result) - (unwind-protect - (when company-prefix - (if (stringp result) - (progn - (company-call-backend 'pre-completion result) - (run-hook-with-args 'company-completion-finished-hook result) - (company-call-backend 'post-completion result)) - (run-hook-with-args 'company-completion-cancelled-hook result))) + (let ((prefix company-prefix) + (backend company-backend)) (setq company-backend nil company-prefix nil company-candidates nil @@ -1508,9 +1551,19 @@ from the rest of the back-ends in the group, if any, will be left at the end." company-point nil) (when company-timer (cancel-timer company-timer)) + (company-echo-cancel t) (company-search-mode 0) (company-call-frontends 'hide) - (company-enable-overriding-keymap nil)) + (company-enable-overriding-keymap nil) + (when prefix + ;; FIXME: RESULT can also be e.g. `unique'. We should call + ;; `company-completion-finished-hook' in that case, with right argument. + (if (stringp result) + (let ((company-backend backend)) + (company-call-backend 'pre-completion result) + (run-hook-with-args 'company-completion-finished-hook result) + (company-call-backend 'post-completion result)) + (run-hook-with-args 'company-completion-cancelled-hook result)))) ;; Make return value explicit. nil) @@ -1526,6 +1579,7 @@ from the rest of the back-ends in the group, if any, will be left at the end." (and (symbolp command) (get command 'company-keep))) (defun company-pre-command () + (company--electric-restore-window-configuration) (unless (company-keep this-command) (condition-case-unless-debug err (when company-candidates @@ -1538,10 +1592,12 @@ from the rest of the back-ends in the group, if any, will be left at the end." (when company-timer (cancel-timer company-timer) (setq company-timer nil)) + (company-echo-cancel t) (company-uninstall-map)) (defun company-post-command () - (when (null this-command) + (when (and company-candidates + (null this-command)) ;; Happens when the user presses `C-g' while inside ;; `flyspell-post-command-hook', for example. ;; Or any other `post-command-hook' function that can call `sit-for', @@ -1557,6 +1613,7 @@ from the rest of the back-ends in the group, if any, will be left at the end." (if company-candidates (company-call-frontends 'post-command) (and (numberp company-idle-delay) + (not defining-kbd-macro) (company--should-begin) (setq company-timer (run-with-timer company-idle-delay nil @@ -1586,6 +1643,19 @@ from the rest of the back-ends in the group, if any, will be left at the end." ;;; search ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defcustom company-search-regexp-function #'regexp-quote + "Function to construct the search regexp from input. +It's called with one argument, the current search input. It must return +either a regexp without groups, or one where groups don't intersect and +each one wraps a part of the input string." + :type '(choice + (const :tag "Exact match" regexp-quote) + (const :tag "Words separated with spaces" company-search-words-regexp) + (const :tag "Words separated with spaces, in any order" + company-search-words-in-any-order-regexp) + (const :tag "All characters in given order, with anything in between" + company-search-flex-regexp))) + (defvar-local company-search-string "") (defvar company-search-lighter '(" " @@ -1601,11 +1671,42 @@ from the rest of the back-ends in the group, if any, will be left at the end." (defvar-local company--search-old-changed nil) +(defun company-search-words-regexp (input) + (mapconcat (lambda (word) (format "\\(%s\\)" (regexp-quote word))) + (split-string input " +" t) ".*")) + +(defun company-search-words-in-any-order-regexp (input) + (let* ((words (mapcar (lambda (word) (format "\\(%s\\)" (regexp-quote word))) + (split-string input " +" t))) + (permutations (company--permutations words))) + (mapconcat (lambda (words) + (mapconcat #'identity words ".*")) + permutations + "\\|"))) + +(defun company-search-flex-regexp (input) + (if (zerop (length input)) + "" + (concat (regexp-quote (string (aref input 0))) + (mapconcat (lambda (c) + (concat "[^" (string c) "]*" + (regexp-quote (string c)))) + (substring input 1) "")))) + +(defun company--permutations (lst) + (if (not lst) + '(nil) + (cl-mapcan + (lambda (e) + (mapcar (lambda (perm) (cons e perm)) + (company--permutations (cl-remove e lst :count 1)))) + lst))) + (defun company--search (text lines) - (let ((quoted (regexp-quote text)) + (let ((re (funcall company-search-regexp-function text)) (i 0)) (cl-dolist (line lines) - (when (string-match quoted line (length company-prefix)) + (when (string-match-p re line (length company-prefix)) (cl-return i)) (cl-incf i)))) @@ -1623,11 +1724,12 @@ from the rest of the back-ends in the group, if any, will be left at the end." (company--search-update-predicate ss)) (company--search-update-string ss))) -(defun company--search-update-predicate (&optional ss) - (let* ((company-candidates-predicate - (and (not (string= ss "")) +(defun company--search-update-predicate (ss) + (let* ((re (funcall company-search-regexp-function ss)) + (company-candidates-predicate + (and (not (string= re "")) company-search-filtering - (lambda (candidate) (string-match ss candidate)))) + (lambda (candidate) (string-match re candidate)))) (cc (company-calculate-candidates company-prefix))) (unless cc (error "No match")) (company-update-candidates cc))) @@ -1782,6 +1884,9 @@ Don't start this directly, use `company-search-candidates' or Regular characters are appended to the search string. +Customize `company-search-regexp-function' to change how the input +is interpreted when searching. + The command `company-search-toggle-filtering' (\\[company-search-toggle-filtering]) uses the search string to filter the completion candidates." (interactive) @@ -1805,33 +1910,40 @@ followed by `company-search-toggle-filtering'." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun company-select-next () - "Select the next candidate in the list." - (interactive) - (when (company-manual-begin) - (company-set-selection (1+ company-selection)))) +(defun company-select-next (&optional arg) + "Select the next candidate in the list. -(defun company-select-previous () - "Select the previous candidate in the list." - (interactive) +With ARG, move by that many elements." + (interactive "p") (when (company-manual-begin) - (company-set-selection (1- company-selection)))) + (company-set-selection (+ (or arg 1) company-selection)))) -(defun company-select-next-or-abort () +(defun company-select-previous (&optional arg) + "Select the previous candidate in the list. + +With ARG, move by that many elements." + (interactive "p") + (company-select-next (if arg (- arg) -1))) + +(defun company-select-next-or-abort (&optional arg) "Select the next candidate if more than one, else abort -and invoke the normal binding." - (interactive) +and invoke the normal binding. + +With ARG, move by that many elements." + (interactive "p") (if (> company-candidates-length 1) - (company-select-next) + (company-select-next arg) (company-abort) (company--unread-last-input))) -(defun company-select-previous-or-abort () +(defun company-select-previous-or-abort (&optional arg) "Select the previous candidate if more than one, else abort -and invoke the normal binding." - (interactive) +and invoke the normal binding. + +With ARG, move by that many elements." + (interactive "p") (if (> company-candidates-length 1) - (company-select-previous) + (company-select-previous arg) (company-abort) (company--unread-last-input))) @@ -1916,19 +2028,36 @@ and invoke the normal binding." (if (and (not (cdr company-candidates)) (equal company-common (car company-candidates))) (company-complete-selection) - (when company-common - (company--insert-candidate company-common))))) + (company--insert-candidate company-common)))) -(defun company-complete-common-or-cycle () - "Insert the common part of all candidates, or select the next one." - (interactive) +(defun company-complete-common-or-cycle (&optional arg) + "Insert the common part of all candidates, or select the next one. + +With ARG, move by that many elements." + (interactive "p") (when (company-manual-begin) (let ((tick (buffer-chars-modified-tick))) (call-interactively 'company-complete-common) (when (eq tick (buffer-chars-modified-tick)) - (let ((company-selection-wrap-around t)) + (let ((company-selection-wrap-around t) + (current-prefix-arg arg)) (call-interactively 'company-select-next)))))) +(defun company-indent-or-complete-common () + "Indent the current line or region, or complete the common part." + (interactive) + (cond + ((use-region-p) + (indent-region (region-beginning) (region-end))) + ((let ((old-point (point)) + (old-tick (buffer-chars-modified-tick)) + (tab-always-indent t)) + (call-interactively #'indent-for-tab-command) + (when (and (eq old-point (point)) + (eq old-tick (buffer-chars-modified-tick))) + (company-complete-common)))))) + +;;;###autoload (defun company-complete () "Insert the common part of all candidates or the current selection. The first time this is called, the common part is inserted, the second @@ -1944,7 +2073,7 @@ inserted." (defun company-complete-number (n) "Insert the Nth candidate visible in the tooltip. -To show the number next to the candidates in some back-ends, enable +To show the number next to the candidates in some backends, enable `company-show-numbers'. When called interactively, uses the last typed character, stripping the modifiers. That character must be a digit." (interactive @@ -2014,25 +2143,30 @@ character, stripping the modifiers. That character must be a digit." (insert string))) (current-buffer))) +(defvar company--electric-saved-window-configuration nil) + (defvar company--electric-commands - '(scroll-other-window scroll-other-window-down) + '(scroll-other-window scroll-other-window-down mwheel-scroll) "List of Commands that won't break out of electric commands.") +(defun company--electric-restore-window-configuration () + "Restore window configuration (after electric commands)." + (when (and company--electric-saved-window-configuration + (not (memq this-command company--electric-commands))) + (set-window-configuration company--electric-saved-window-configuration) + (setq company--electric-saved-window-configuration nil))) + (defmacro company--electric-do (&rest body) (declare (indent 0) (debug t)) `(when (company-manual-begin) - (save-window-excursion - (let ((height (window-height)) - (row (company--row)) - cmd) - ,@body - (and (< (window-height) height) - (< (- (window-height) row 2) company-tooltip-limit) - (recenter (- (window-height) row 2))) - (while (memq (setq cmd (key-binding (vector (list (read-event))))) - company--electric-commands) - (call-interactively cmd)) - (company--unread-last-input))))) + (cl-assert (null company--electric-saved-window-configuration)) + (setq company--electric-saved-window-configuration (current-window-configuration)) + (let ((height (window-height)) + (row (company--row))) + ,@body + (and (< (window-height) height) + (< (- (window-height) row 2) company-tooltip-limit) + (recenter (- (window-height) row 2)))))) (defun company--unread-last-input () (when last-input-event @@ -2042,32 +2176,39 @@ character, stripping the modifiers. That character must be a digit." (defun company-show-doc-buffer () "Temporarily show the documentation buffer for the selection." (interactive) - (company--electric-do - (let* ((selected (nth company-selection company-candidates)) - (doc-buffer (or (company-call-backend 'doc-buffer selected) - (error "No documentation available")))) - (with-current-buffer doc-buffer - (goto-char (point-min))) - (display-buffer doc-buffer t)))) + (let (other-window-scroll-buffer) + (company--electric-do + (let* ((selected (nth company-selection company-candidates)) + (doc-buffer (or (company-call-backend 'doc-buffer selected) + (error "No documentation available"))) + start) + (when (consp doc-buffer) + (setq start (cdr doc-buffer) + doc-buffer (car doc-buffer))) + (setq other-window-scroll-buffer (get-buffer doc-buffer)) + (let ((win (display-buffer doc-buffer t))) + (set-window-start win (if start start (point-min)))))))) (put 'company-show-doc-buffer 'company-keep t) (defun company-show-location () "Temporarily display a buffer showing the selected candidate in context." (interactive) - (company--electric-do - (let* ((selected (nth company-selection company-candidates)) - (location (company-call-backend 'location selected)) - (pos (or (cdr location) (error "No location available"))) - (buffer (or (and (bufferp (car location)) (car location)) - (find-file-noselect (car location) t)))) - (with-selected-window (display-buffer buffer t) - (save-restriction - (widen) - (if (bufferp (car location)) - (goto-char pos) - (goto-char (point-min)) - (forward-line (1- pos)))) - (set-window-start nil (point)))))) + (let (other-window-scroll-buffer) + (company--electric-do + (let* ((selected (nth company-selection company-candidates)) + (location (company-call-backend 'location selected)) + (pos (or (cdr location) (error "No location available"))) + (buffer (or (and (bufferp (car location)) (car location)) + (find-file-noselect (car location) t)))) + (setq other-window-scroll-buffer (get-buffer buffer)) + (with-selected-window (display-buffer buffer t) + (save-restriction + (widen) + (if (bufferp (car location)) + (goto-char pos) + (goto-char (point-min)) + (forward-line (1- pos)))) + (set-window-start nil (point))))))) (put 'company-show-location 'company-keep t) ;;; package functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -2081,7 +2222,7 @@ character, stripping the modifiers. That character must be a digit." (defun company-begin-backend (backend &optional callback) "Start a completion at point using BACKEND." - (interactive (let ((val (completing-read "Company back-end: " + (interactive (let ((val (completing-read "Company backend: " obarray 'functionp nil "company-"))) (when val @@ -2119,18 +2260,62 @@ Example: \(company-begin-with '\(\"foo\" \"foobar\" \"foobarbaz\"\)\)" require-match))) callback))) +(declare-function find-library-name "find-func") +(declare-function lm-version "lisp-mnt") + (defun company-version (&optional show-version) "Get the Company version as string. If SHOW-VERSION is non-nil, show the version in the echo area." (interactive (list t)) (with-temp-buffer + (require 'find-func) (insert-file-contents (find-library-name "company")) (require 'lisp-mnt) (if show-version (message "Company version: %s" (lm-version)) (lm-version)))) +(defun company-diag () + "Pop a buffer with information about completions at point." + (interactive) + (let* ((bb company-backends) + backend + (prefix (cl-loop for b in bb + thereis (let ((company-backend b)) + (setq backend b) + (company-call-backend 'prefix)))) + cc annotations) + (when (stringp prefix) + (let ((company-backend backend)) + (setq cc (company-call-backend 'candidates prefix) + annotations + (mapcar + (lambda (c) (cons c (company-call-backend 'annotation c))) + cc)))) + (pop-to-buffer (get-buffer-create "*company-diag*")) + (setq buffer-read-only nil) + (erase-buffer) + (insert (format "Emacs %s (%s) of %s on %s" + emacs-version system-configuration + (format-time-string "%Y-%m-%d" emacs-build-time) + emacs-build-system)) + (insert "\nCompany " (company-version) "\n\n") + (insert "company-backends: " (pp-to-string bb)) + (insert "\n") + (insert "Used backend: " (pp-to-string backend)) + (insert "\n") + (insert "Prefix: " (pp-to-string prefix)) + (insert "\n") + (insert (message "Completions:")) + (unless cc (insert " none")) + (save-excursion + (dolist (c annotations) + (insert "\n " (prin1-to-string (car c))) + (when (cdr c) + (insert " " (prin1-to-string (cdr c)))))) + (special-mode))) + ;;; pseudo-tooltip ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defvar-local company-pseudo-tooltip-overlay nil) @@ -2188,6 +2373,8 @@ If SHOW-VERSION is non-nil, show the version in the echo area." (if company-common (string-width company-common) 0))) + (_ (setq value (company--pre-render value) + annotation (and annotation (company--pre-render annotation t)))) (ann-ralign company-tooltip-align-annotations) (ann-truncate (< width (+ (length value) (length annotation) @@ -2214,38 +2401,62 @@ If SHOW-VERSION is non-nil, show the version in the echo area." (setq common (+ (min common width) margin)) (setq width (+ width margin (length right))) - (add-text-properties 0 width '(face company-tooltip - mouse-face company-tooltip-mouse) - line) - (add-text-properties margin common - '(face company-tooltip-common - mouse-face company-tooltip-mouse) - line) + (font-lock-append-text-property 0 width 'mouse-face + 'company-tooltip-mouse + line) (when (< ann-start ann-end) - (add-text-properties ann-start ann-end - '(face company-tooltip-annotation - mouse-face company-tooltip-mouse) - line)) + (font-lock-append-text-property ann-start ann-end 'face + (if selected + 'company-tooltip-annotation-selection + 'company-tooltip-annotation) + line)) + (font-lock-prepend-text-property margin common 'face + (if selected + 'company-tooltip-common-selection + 'company-tooltip-common) + line) (when selected - (if (and (not (string= company-search-string "")) - (string-match (regexp-quote company-search-string) value - (length company-prefix))) - (let ((beg (+ margin (match-beginning 0))) - (end (+ margin (match-end 0))) - (width (- width (length right)))) - (when (< beg width) - (add-text-properties beg (min end width) - '(face company-tooltip-search) - line))) - (add-text-properties 0 width '(face company-tooltip-selection - mouse-face company-tooltip-selection) - line) - (add-text-properties margin common - '(face company-tooltip-common-selection - mouse-face company-tooltip-selection) - line))) + (if (let ((re (funcall company-search-regexp-function + company-search-string))) + (and (not (string= re "")) + (string-match re value (length company-prefix)))) + (pcase-dolist (`(,mbeg . ,mend) (company--search-chunks)) + (let ((beg (+ margin mbeg)) + (end (+ margin mend)) + (width (- width (length right)))) + (when (< beg width) + (font-lock-prepend-text-property beg (min end width) + 'face 'company-tooltip-search + line)))) + (font-lock-append-text-property 0 width 'face + 'company-tooltip-selection + line))) + (font-lock-append-text-property 0 width 'face + 'company-tooltip + line) line)) +(defun company--search-chunks () + (let ((md (match-data t)) + res) + (if (<= (length md) 2) + (push (cons (nth 0 md) (nth 1 md)) res) + (while (setq md (nthcdr 2 md)) + (when (car md) + (push (cons (car md) (cadr md)) res)))) + res)) + +(defun company--pre-render (str &optional annotation-p) + (or (company-call-backend 'pre-render str annotation-p) + (progn + (when (or (text-property-not-all 0 (length str) 'face nil str) + (text-property-not-all 0 (length str) 'mouse-face nil str)) + (setq str (copy-sequence str)) + (remove-text-properties 0 (length str) + '(face nil font-lock-face nil mouse-face nil) + str)) + str))) + (defun company--clean-string (str) (replace-regexp-in-string "\\([^[:graph:] ]\\)\\|\\(\ufeff\\)\\|[[:multibyte:]]" @@ -2273,7 +2484,7 @@ If SHOW-VERSION is non-nil, show the version in the echo area." (while (and (not (eobp)) ; http://debbugs.gnu.org/19553 (> (setq lines-moved (vertical-motion 1)) 0) (<= (point) end)) - (let ((bound (min end (1- (point))))) + (let ((bound (min end (point)))) ;; A visual line can contain several physical lines (e.g. with outline's ;; folding overlay). Take only the first one. (push (buffer-substring beg @@ -2321,8 +2532,12 @@ If SHOW-VERSION is non-nil, show the version in the echo area." (or (cdr margins) 0))))) (when (and word-wrap (version< emacs-version "24.4.51.5")) - ;; http://debbugs.gnu.org/18384 + ;; http://debbugs.gnu.org/19300 (cl-decf ww)) + ;; whitespace-mode with newline-mark + (when (and buffer-display-table + (aref buffer-display-table ?\n)) + (cl-decf ww (1- (length (aref buffer-display-table ?\n))))) ww)) (defun company--replacement-string (lines old column nl &optional align-top) @@ -2357,8 +2572,7 @@ If SHOW-VERSION is non-nil, show the version in the echo area." (company--offset-line (pop lines) offset)) new)) - (let ((str (concat (when nl " ") - "\n" + (let ((str (concat (when nl " \n") (mapconcat 'identity (nreverse new) "\n") "\n"))) (font-lock-append-text-property 0 (length str) 'face 'default str) @@ -2510,7 +2724,7 @@ Returns a negative number if the tooltip should be displayed above point." (end (save-excursion (move-to-window-line (+ row (abs height))) (point))) - (ov (make-overlay (if nl beg (1- beg)) end nil t)) + (ov (make-overlay beg end nil t)) (args (list (mapcar 'company-plainify (company-buffer-lines beg end)) column nl above))) @@ -2551,7 +2765,9 @@ Returns a negative number if the tooltip should be displayed above point." (defun company-pseudo-tooltip-hide-temporarily () (when (overlayp company-pseudo-tooltip-overlay) (overlay-put company-pseudo-tooltip-overlay 'invisible nil) - (overlay-put company-pseudo-tooltip-overlay 'after-string nil))) + (overlay-put company-pseudo-tooltip-overlay 'line-prefix nil) + (overlay-put company-pseudo-tooltip-overlay 'after-string nil) + (overlay-put company-pseudo-tooltip-overlay 'display nil))) (defun company-pseudo-tooltip-unhide () (when company-pseudo-tooltip-overlay @@ -2559,12 +2775,15 @@ Returns a negative number if the tooltip should be displayed above point." (disp (overlay-get ov 'company-display))) ;; Beat outline's folding overlays, at least. (overlay-put ov 'priority 1) - ;; `display' could be better (http://debbugs.gnu.org/18285), but it - ;; doesn't work when the overlay is empty, which is what happens at eob. - ;; It also seems to interact badly with `cursor'. - ;; We deal with priorities by having the overlay start before the newline. - (overlay-put ov 'after-string disp) - (overlay-put ov 'invisible t) + ;; No (extra) prefix for the first line. + (overlay-put ov 'line-prefix "") + ;; `display' is better + ;; (http://debbugs.gnu.org/18285, http://debbugs.gnu.org/20847), + ;; but it doesn't work on 0-length overlays. + (if (< (overlay-start ov) (overlay-end ov)) + (overlay-put ov 'display disp) + (overlay-put ov 'after-string disp) + (overlay-put ov 'invisible t)) (overlay-put ov 'window (selected-window))))) (defun company-pseudo-tooltip-guard () @@ -2579,7 +2798,7 @@ Returns a negative number if the tooltip should be displayed above point." (when (>= overhang 0) overhang)))))) (defun company-pseudo-tooltip-frontend (command) - "`company-mode' front-end similar to a tooltip but based on overlays." + "`company-mode' frontend similar to a tooltip but based on overlays." (cl-case command (pre-command (company-pseudo-tooltip-hide-temporarily)) (post-command @@ -2616,17 +2835,22 @@ Returns a negative number if the tooltip should be displayed above point." (company-preview-hide) (let ((completion (nth company-selection company-candidates))) - (setq completion (propertize completion 'face 'company-preview)) - (add-text-properties 0 (length company-common) - '(face company-preview-common) completion) + (setq completion (copy-sequence (company--pre-render completion))) + (font-lock-append-text-property 0 (length completion) + 'face 'company-preview + completion) + (font-lock-prepend-text-property 0 (length company-common) + 'face 'company-preview-common + completion) ;; Add search string - (and company-search-string - (string-match (regexp-quote company-search-string) completion) - (add-text-properties (match-beginning 0) - (match-end 0) - '(face company-preview-search) - completion)) + (and (string-match (funcall company-search-regexp-function + company-search-string) + completion) + (pcase-dolist (`(,mbeg . ,mend) (company--search-chunks)) + (font-lock-prepend-text-property mbeg mend + 'face 'company-preview-search + completion))) (setq completion (company-strip-prefix completion)) @@ -2659,7 +2883,7 @@ Returns a negative number if the tooltip should be displayed above point." (setq company-preview-overlay nil))) (defun company-preview-frontend (command) - "`company-mode' front-end showing the selection as if it had been inserted." + "`company-mode' frontend showing the selection as if it had been inserted." (pcase command (`pre-command (company-preview-hide)) (`post-command (company-preview-show-at-point (point))) @@ -2694,13 +2918,19 @@ Returns a negative number if the tooltip should be displayed above point." (message "")))) (defun company-echo-show-soon (&optional getter) - (when company-echo-timer - (cancel-timer company-echo-timer)) + (company-echo-cancel) (setq company-echo-timer (run-with-timer 0 nil 'company-echo-show getter))) -(defsubst company-echo-show-when-idle (&optional getter) - (when (sit-for company-echo-delay) - (company-echo-show getter))) +(defun company-echo-cancel (&optional unset) + (when company-echo-timer + (cancel-timer company-echo-timer)) + (when unset + (setq company-echo-timer nil))) + +(defun company-echo-show-when-idle (&optional getter) + (company-echo-cancel) + (setq company-echo-timer + (run-with-idle-timer company-echo-delay nil 'company-echo-show getter))) (defun company-echo-format () @@ -2763,19 +2993,19 @@ Returns a negative number if the tooltip should be displayed above point." (company-echo-show))) (defun company-echo-frontend (command) - "`company-mode' front-end showing the candidates in the echo area." + "`company-mode' frontend showing the candidates in the echo area." (pcase command (`post-command (company-echo-show-soon 'company-echo-format)) (`hide (company-echo-hide)))) (defun company-echo-strip-common-frontend (command) - "`company-mode' front-end showing the candidates in the echo area." + "`company-mode' frontend showing the candidates in the echo area." (pcase command (`post-command (company-echo-show-soon 'company-echo-strip-common-format)) (`hide (company-echo-hide)))) (defun company-echo-metadata-frontend (command) - "`company-mode' front-end showing the documentation in the echo area." + "`company-mode' frontend showing the documentation in the echo area." (pcase command (`post-command (company-echo-show-when-idle 'company-fetch-metadata)) (`hide (company-echo-hide)))) diff --git a/elpa/dash-20160223.1028/dash-pkg.el b/elpa/dash-20160223.1028/dash-pkg.el deleted file mode 100644 index 6e0f516..0000000 --- a/elpa/dash-20160223.1028/dash-pkg.el +++ /dev/null @@ -1 +0,0 @@ -(define-package "dash" "20160223.1028" "A modern list library for Emacs" 'nil :keywords '("lists")) diff --git a/elpa/dash-20160223.1028/dash-autoloads.el b/elpa/dash-20160306.1222/dash-autoloads.el similarity index 81% rename from elpa/dash-20160223.1028/dash-autoloads.el rename to elpa/dash-20160306.1222/dash-autoloads.el index 46014cc..27c2f1c 100644 --- a/elpa/dash-20160223.1028/dash-autoloads.el +++ b/elpa/dash-20160306.1222/dash-autoloads.el @@ -3,7 +3,7 @@ ;;; Code: (add-to-list 'load-path (or (file-name-directory #$) (car load-path))) -;;;### (autoloads nil nil ("dash.el") (22221 60697 93676 700000)) +;;;### (autoloads nil nil ("dash.el") (22297 19836 790973 907000)) ;;;*** diff --git a/elpa/dash-20160306.1222/dash-pkg.el b/elpa/dash-20160306.1222/dash-pkg.el new file mode 100644 index 0000000..644d1f1 --- /dev/null +++ b/elpa/dash-20160306.1222/dash-pkg.el @@ -0,0 +1 @@ +(define-package "dash" "20160306.1222" "A modern list library for Emacs" 'nil :keywords '("lists")) diff --git a/elpa/dash-20160223.1028/dash.el b/elpa/dash-20160306.1222/dash.el similarity index 99% rename from elpa/dash-20160223.1028/dash.el rename to elpa/dash-20160306.1222/dash.el index f9cae39..4c285f9 100644 --- a/elpa/dash-20160223.1028/dash.el +++ b/elpa/dash-20160306.1222/dash.el @@ -4,7 +4,7 @@ ;; Author: Magnar Sveen ;; Version: 2.12.1 -;; Package-Version: 20160223.1028 +;; Package-Version: 20160306.1222 ;; Keywords: lists ;; This program is free software; you can redistribute it and/or modify @@ -1190,6 +1190,29 @@ as `(nth i list)` for all i from INDICES." (!cons (nth it list) r)) (nreverse r))) +(defun -select-columns (columns table) + "Select COLUMNS from TABLE. + +TABLE is a list of lists where each element represents one row. +It is assumed each row has the same length. + +Each row is transformed such that only the specified COLUMNS are +selected. + +See also: `-select-column', `-select-by-indices'" + (--map (-select-by-indices columns it) table)) + +(defun -select-column (column table) + "Select COLUMN from TABLE. + +TABLE is a list of lists where each element represents one row. +It is assumed each row has the same length. + +The single selected column is returned as a list. + +See also: `-select-columns', `-select-by-indices'" + (--mapcat (-select-by-indices (list column) it) table)) + (defmacro -> (x &optional form &rest more) "Thread the expr through the forms. Insert X as the second item in the first form, making a list of it if it is not a list @@ -2342,6 +2365,8 @@ structure such as plist or alist." "-find-last-index" "--find-last-index" "-select-by-indices" + "-select-columns" + "-select-column" "-grade-up" "-grade-down" "->" diff --git a/elpa/erlang-2.4.1/erlang-pkg.el b/elpa/erlang-2.4.1/erlang-pkg.el deleted file mode 100644 index 9f95373..0000000 --- a/elpa/erlang-2.4.1/erlang-pkg.el +++ /dev/null @@ -1 +0,0 @@ -(define-package "erlang" "2.4.1" "Major modes for editing and running Erlang" 'nil) diff --git a/elpa/erlang-2.4.1/erlang-autoloads.el b/elpa/erlang-20151013.157/erlang-autoloads.el similarity index 72% rename from elpa/erlang-2.4.1/erlang-autoloads.el rename to elpa/erlang-20151013.157/erlang-autoloads.el index 72d5b61..bea6be2 100644 --- a/elpa/erlang-2.4.1/erlang-autoloads.el +++ b/elpa/erlang-20151013.157/erlang-autoloads.el @@ -3,7 +3,7 @@ ;;; Code: (add-to-list 'load-path (or (file-name-directory #$) (car load-path))) -;;;### (autoloads nil "erlang" "erlang.el" (21600 43785 98197 57000)) +;;;### (autoloads nil "erlang" "erlang.el" (22297 19833 531790 580000)) ;;; Generated autoloads from erlang.el (autoload 'erlang-mode "erlang" "\ @@ -68,8 +68,10 @@ Other commands: \(fn)" t nil) +(dolist (r '("\\.erl$" "\\.app\\.src$" "\\.escript" "\\.hrl$" "\\.xrl$" "\\.yrl" "/ebin/.+\\.app")) (add-to-list 'auto-mode-alist (cons r 'erlang-mode))) + (autoload 'erlang-find-tag "erlang" "\ -Like `find-tag'. Capable of retreiving Erlang modules. +Like `find-tag'. Capable of retrieving Erlang modules. Tags can be given on the forms `tag', `module:', `module:tag'. @@ -97,11 +99,12 @@ Compile Erlang module in current buffer. (autoload 'inferior-erlang "erlang" "\ Run an inferior Erlang. +With prefix command, prompt for command to start Erlang with. This is just like running Erlang in a normal shell, except that an Emacs buffer is used for input and output. - -The command line history can be accessed with M-p and M-n. +\\ +The command line history can be accessed with \\[comint-previous-input] and \\[comint-next-input]. The history is saved between sessions. Entry to this mode calls the functions in the variables @@ -111,7 +114,25 @@ The following commands imitate the usual Unix interrupt and editing control characters: \\{erlang-shell-mode-map} -\(fn)" t nil) +\(fn &optional COMMAND)" t nil) + +;;;*** + +;;;### (autoloads nil "erlang-start" "erlang-start.el" (22297 19833 +;;;;;; 146797 463000)) +;;; Generated autoloads from erlang-start.el + +(let ((a '("\\.erl\\'" . erlang-mode)) (b '("\\.hrl\\'" . erlang-mode))) (or (assoc (car a) auto-mode-alist) (setq auto-mode-alist (cons a auto-mode-alist))) (or (assoc (car b) auto-mode-alist) (setq auto-mode-alist (cons b auto-mode-alist)))) + +(add-to-list 'interpreter-mode-alist (cons "escript" 'erlang-mode)) + +(let ((erl-ext '(".jam" ".vee" ".beam"))) (while erl-ext (let ((cie completion-ignored-extensions)) (while (and cie (not (string-equal (car cie) (car erl-ext)))) (setq cie (cdr cie))) (if (null cie) (setq completion-ignored-extensions (cons (car erl-ext) completion-ignored-extensions)))) (setq erl-ext (cdr erl-ext)))) + +;;;*** + +;;;### (autoloads nil nil ("erlang-eunit.el" "erlang-flymake.el" +;;;;;; "erlang-pkg.el" "erlang-skels-old.el" "erlang-skels.el" "erlang_appwiz.el") +;;;;;; (22297 19834 170483 735000)) ;;;*** diff --git a/elpa/erlang-20151013.157/erlang-eunit.el b/elpa/erlang-20151013.157/erlang-eunit.el new file mode 100644 index 0000000..a3c29c5 --- /dev/null +++ b/elpa/erlang-20151013.157/erlang-eunit.el @@ -0,0 +1,453 @@ +;; +;; %CopyrightBegin% +;; +;; Copyright Ericsson AB 2009-2010. All Rights Reserved. +;; +;; Licensed under the Apache License, Version 2.0 (the "License"); +;; you may not use this file except in compliance with the License. +;; You may obtain a copy of the License at +;; +;; http://www.apache.org/licenses/LICENSE-2.0 +;; +;; Unless required by applicable law or agreed to in writing, software +;; distributed under the License is distributed on an "AS IS" BASIS, +;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +;; See the License for the specific language governing permissions and +;; limitations under the License. +;; +;; %CopyrightEnd% +;;; +;;; Purpose: Provide EUnit utilities. +;;; +;;; Author: Klas Johansson + +(eval-when-compile + (require 'cl)) + +(defvar erlang-eunit-src-candidate-dirs '("../src" ".") + "*Name of directories which to search for source files matching +an EUnit test file. The first directory in the list will be used, +if there is no match.") + +(defvar erlang-eunit-test-candidate-dirs '("../test" ".") + "*Name of directories which to search for EUnit test files matching +a source file. The first directory in the list will be used, +if there is no match.") + +(defvar erlang-eunit-autosave nil + "*Set to non-nil to automtically save unsaved buffers before running tests. +This is useful, reducing the save-compile-load-test cycle to one keychord.") + +(defvar erlang-eunit-recent-info '((mode . nil) (module . nil) (test . nil) (cover . nil)) + "Info about the most recent running of an EUnit test representation.") + +(defvar erlang-error-regexp-alist + '(("^\\([^:( \t\n]+\\)[:(][ \t]*\\([0-9]+\\)[:) \t]" . (1 2))) + "*Patterns for matching Erlang errors.") + +;;; +;;; Switch between src/EUnit test buffers +;;; +(defun erlang-eunit-toggle-src-and-test-file-other-window () + "Switch to the src file if the EUnit test file is the current +buffer and vice versa" + (interactive) + (if (erlang-eunit-test-file-p buffer-file-name) + (erlang-eunit-open-src-file-other-window buffer-file-name) + (erlang-eunit-open-test-file-other-window buffer-file-name))) + +;;; +;;; Open the EUnit test file which corresponds to a src file +;;; +(defun erlang-eunit-open-test-file-other-window (src-file-path) + "Open the EUnit test file which corresponds to a src file" + (find-file-other-window (erlang-eunit-test-filename src-file-path))) + +;;; +;;; Open the src file which corresponds to the an EUnit test file +;;; +(defun erlang-eunit-open-src-file-other-window (test-file-path) + "Open the src file which corresponds to the an EUnit test file" + (find-file-other-window (erlang-eunit-src-filename test-file-path))) + +;;; Return the name and path of the EUnit test file +;;, (input may be either the source filename itself or the EUnit test filename) +(defun erlang-eunit-test-filename (file-path) + (if (erlang-eunit-test-file-p file-path) + file-path + (erlang-eunit-rewrite-filename file-path erlang-eunit-test-candidate-dirs))) + +;;; Return the name and path of the source file +;;, (input may be either the source filename itself or the EUnit test filename) +(defun erlang-eunit-src-filename (file-path) + (if (erlang-eunit-src-file-p file-path) + file-path + (erlang-eunit-rewrite-filename file-path erlang-eunit-src-candidate-dirs))) + +;;; Rewrite a filename from the src or test filename to the other +(defun erlang-eunit-rewrite-filename (orig-file-path candidate-dirs) + (or (erlang-eunit-locate-buddy orig-file-path candidate-dirs) + (erlang-eunit-buddy-file-path orig-file-path (car candidate-dirs)))) + +;;; Search for a file's buddy file (a source file's EUnit test file, +;;; or an EUnit test file's source file) in a list of candidate +;;; directories. +(defun erlang-eunit-locate-buddy (orig-file-path candidate-dirs) + (when candidate-dirs + (let ((buddy-file-path (erlang-eunit-buddy-file-path + orig-file-path + (car candidate-dirs)))) + (if (file-readable-p buddy-file-path) + buddy-file-path + (erlang-eunit-locate-buddy orig-file-path (cdr candidate-dirs)))))) + +(defun erlang-eunit-buddy-file-path (orig-file-path buddy-dir-name) + (let* ((orig-dir-name (file-name-directory orig-file-path)) + (buddy-dir-name (file-truename + (filename-join orig-dir-name buddy-dir-name))) + (buddy-base-name (erlang-eunit-buddy-basename orig-file-path))) + (filename-join buddy-dir-name buddy-base-name))) + +;;; Return the basename of the buddy file: +;;; /tmp/foo/src/x.erl --> x_tests.erl +;;; /tmp/foo/test/x_tests.erl --> x.erl +(defun erlang-eunit-buddy-basename (file-path) + (let ((src-module-name (erlang-eunit-source-module-name file-path))) + (cond + ((erlang-eunit-src-file-p file-path) + (concat src-module-name "_tests.erl")) + ((erlang-eunit-test-file-p file-path) + (concat src-module-name ".erl"))))) + +;;; Checks whether a file is a source file or not +(defun erlang-eunit-src-file-p (file-path) + (not (erlang-eunit-test-file-p file-path))) + +;;; Checks whether a file is a EUnit test file or not +(defun erlang-eunit-test-file-p (file-path) + (erlang-eunit-string-match-p "^\\(.+\\)_tests.erl$" file-path)) + +;;; Return the module name of the source file +;;; /tmp/foo/src/x.erl --> x +;;; /tmp/foo/test/x_tests.erl --> x +(defun erlang-eunit-source-module-name (file-path) + (interactive) + (let ((module-name (erlang-eunit-module-name file-path))) + (if (string-match "^\\(.+\\)_tests$" module-name) + (substring module-name (match-beginning 1) (match-end 1)) + module-name))) + +;;; Return the module name of the file +;;; /tmp/foo/src/x.erl --> x +;;; /tmp/foo/test/x_tests.erl --> x_tests +(defun erlang-eunit-module-name (file-path) + (interactive) + (file-name-sans-extension (file-name-nondirectory file-path))) + +;;; Older emacsen don't have string-match-p. +(defun erlang-eunit-string-match-p (regexp string &optional start) + (if (fboundp 'string-match-p) ;; appeared in emacs 23 + (string-match-p regexp string start) + (save-match-data ;; fallback for earlier versions of emacs + (string-match regexp string start)))) + +;;; Join filenames +(defun filename-join (dir file) + (if (or (= (elt file 0) ?/) + (= (car (last (append dir nil))) ?/)) + (concat dir file) + (concat dir "/" file))) + +;;; Get info about the most recent running of EUnit +(defun erlang-eunit-recent (key) + (cdr (assq key erlang-eunit-recent-info))) + +;;; Record info about the most recent running of EUnit +;;; Known modes are 'module-mode and 'test-mode +(defun erlang-eunit-record-recent (mode module test) + (setcdr (assq 'mode erlang-eunit-recent-info) mode) + (setcdr (assq 'module erlang-eunit-recent-info) module) + (setcdr (assq 'test erlang-eunit-recent-info) test)) + +;;; Record whether the most recent running of EUnit included cover +;;; compilation +(defun erlang-eunit-record-recent-compile (under-cover) + (setcdr (assq 'cover erlang-eunit-recent-info) under-cover)) + +;;; Determine options for EUnit. +(defun erlang-eunit-opts () + (if current-prefix-arg ", [verbose]" "")) + +;;; Determine current test function +(defun erlang-eunit-current-test () + (save-excursion + (erlang-end-of-function 1) + (erlang-beginning-of-function 1) + (erlang-name-of-function))) + +(defun erlang-eunit-simple-test-p (test-name) + (if (erlang-eunit-string-match-p "^\\(.+\\)_test$" test-name) t nil)) + +(defun erlang-eunit-test-generator-p (test-name) + (if (erlang-eunit-string-match-p "^\\(.+\\)_test_$" test-name) t nil)) + +;;; Run one EUnit test +(defun erlang-eunit-run-test (module-name test-name) + (let ((command + (cond ((erlang-eunit-simple-test-p test-name) + (format "eunit:test({%s, %s}%s)." + module-name test-name (erlang-eunit-opts))) + ((erlang-eunit-test-generator-p test-name) + (format "eunit:test({generator, %s, %s}%s)." + module-name test-name (erlang-eunit-opts))) + (t (format "%% WARNING: '%s' is not a test function" test-name))))) + (erlang-eunit-record-recent 'test-mode module-name test-name) + (erlang-eunit-inferior-erlang-send-command command))) + +;;; Run EUnit tests for the current module +(defun erlang-eunit-run-module-tests (module-name) + (let ((command (format "eunit:test(%s%s)." module-name (erlang-eunit-opts)))) + (erlang-eunit-record-recent 'module-mode module-name nil) + (erlang-eunit-inferior-erlang-send-command command))) + +(defun erlang-eunit-compile-and-run-recent () + "Compile the source and test files and repeat the most recent EUnit test run. + +With prefix arg, compiles for debug and runs tests with the verbose flag set." + (interactive) + (case (erlang-eunit-recent 'mode) + ('test-mode + (erlang-eunit-compile-and-test + 'erlang-eunit-run-test (list (erlang-eunit-recent 'module) + (erlang-eunit-recent 'test)))) + ('module-mode + (erlang-eunit-compile-and-test + 'erlang-eunit-run-module-tests (list (erlang-eunit-recent 'module)) + (erlang-eunit-recent 'cover))) + (t (error "EUnit has not yet been run. Please run a test first.")))) + +(defun erlang-eunit-cover-compile () + "Cover compile current module." + (interactive) + (let* ((erlang-compile-extra-opts + (append (list 'debug_info) erlang-compile-extra-opts)) + (module-name + (erlang-add-quotes-if-needed + (erlang-eunit-module-name buffer-file-name))) + (compile-command + (format "cover:compile_beam(%s)." module-name))) + (erlang-compile) + (if (erlang-eunit-last-compilation-successful-p) + (erlang-eunit-inferior-erlang-send-command compile-command)))) + +(defun erlang-eunit-analyze-coverage () + "Analyze the data collected by cover tool for the module in the +current buffer. + +Assumes that the module has been cover compiled prior to this +call. This function will do two things: print the number of +covered and uncovered functions in the erlang shell and display a +new buffer called * coverage* which shows the source +code along with the coverage analysis results." + (interactive) + (let* ((module-name (erlang-add-quotes-if-needed + (erlang-eunit-module-name buffer-file-name))) + (tmp-filename (make-temp-file "cover")) + (analyze-command (format "cover:analyze_to_file(%s, \"%s\"). " + module-name tmp-filename)) + (buf-name (format "*%s coverage*" module-name))) + (erlang-eunit-inferior-erlang-send-command analyze-command) + ;; The purpose of the following snippet is to get the result of the + ;; analysis from a file into a new buffer (or an old, if one with + ;; the specified name already exists). Also we want the erlang-mode + ;; *and* view-mode to be enabled. + (save-excursion + (let ((buf (get-buffer-create (format "*%s coverage*" module-name)))) + (set-buffer buf) + (setq buffer-read-only nil) + (insert-file-contents tmp-filename nil nil nil t) + (if (= (buffer-size) 0) + (kill-buffer buf) + ;; FIXME: this would be a good place to enable (emacs-mode) + ;; to get some nice syntax highlighting in the + ;; coverage report, but it doesn't play well with + ;; flymake. Leave it off for now. + (view-buffer buf)))) + (delete-file tmp-filename))) + +(defun erlang-eunit-compile-and-run-current-test () + "Compile the source and test files and run the current EUnit test. + +With prefix arg, compiles for debug and runs tests with the verbose flag set." + (interactive) + (let ((module-name (erlang-add-quotes-if-needed + (erlang-eunit-module-name buffer-file-name))) + (test-name (erlang-eunit-current-test))) + (erlang-eunit-compile-and-test + 'erlang-eunit-run-test (list module-name test-name)))) + +(defun erlang-eunit-compile-and-run-module-tests () + "Compile the source and test files and run all EUnit tests in the module. + +With prefix arg, compiles for debug and runs tests with the verbose flag set." + (interactive) + (let ((module-name (erlang-add-quotes-if-needed + (erlang-eunit-source-module-name buffer-file-name)))) + (erlang-eunit-compile-and-test + 'erlang-eunit-run-module-tests (list module-name)))) + +;;; Compile source and EUnit test file and finally run EUnit tests for +;;; the current module +(defun erlang-eunit-compile-and-test (test-fun test-args &optional under-cover) + "Compile the source and test files and run the EUnit test suite. + +If under-cover is set to t, the module under test is compile for +code coverage analysis. If under-cover is left out or not set, +coverage analysis is disabled. The result of the code coverage +is both printed to the erlang shell (the number of covered vs +uncovered functions in a module) and written to a buffer called +* coverage* (which shows the source code for the module +and the number of times each line is covered). +With prefix arg, compiles for debug and runs tests with the verbose flag set." + (erlang-eunit-record-recent-compile under-cover) + (let ((src-filename (erlang-eunit-src-filename buffer-file-name)) + (test-filename (erlang-eunit-test-filename buffer-file-name))) + + ;; The purpose of out-maneuvering `save-some-buffers', as is done + ;; below, is to ask the question about saving buffers only once, + ;; instead of possibly several: one for each file to compile, + ;; for instance for both x.erl and x_tests.erl. + (save-some-buffers erlang-eunit-autosave) + (flet ((save-some-buffers (&optional any) nil)) + + ;; Compilation of the source file is mandatory (the file must + ;; exist, otherwise the procedure is aborted). Compilation of the + ;; test file on the other hand, is optional, since eunit tests may + ;; be placed in the source file instead. Any compilation error + ;; will prevent the subsequent steps to be run (hence the `and') + (and (erlang-eunit-compile-file src-filename under-cover) + (if (file-readable-p test-filename) + (erlang-eunit-compile-file test-filename) + t) + (apply test-fun test-args) + (if under-cover + (save-excursion + (set-buffer (find-file-noselect src-filename)) + (erlang-eunit-analyze-coverage))))))) + +(defun erlang-eunit-compile-and-run-module-tests-under-cover () + "Compile the source and test files and run the EUnit test suite and measure +code coverage. + +With prefix arg, compiles for debug and runs tests with the verbose flag set." + (interactive) + (let ((module-name (erlang-add-quotes-if-needed + (erlang-eunit-source-module-name buffer-file-name)))) + (erlang-eunit-compile-and-test + 'erlang-eunit-run-module-tests (list module-name) t))) + +(defun erlang-eunit-compile-file (file-path &optional under-cover) + (if (file-readable-p file-path) + (save-excursion + (set-buffer (find-file-noselect file-path)) + ;; In order to run a code coverage analysis on a + ;; module, we have two options: + ;; + ;; * either compile the module with cover:compile instead of the + ;; regular compiler + ;; + ;; * or first compile the module with the regular compiler (but + ;; *with* debug_info) and then compile it for coverage + ;; analysis using cover:compile_beam. + ;; + ;; We could accomplish the first by changing the + ;; erlang-compile-erlang-function to cover:compile, but there's + ;; a risk that that's used for other purposes. Therefore, a + ;; safer alternative (although with more steps) is to add + ;; debug_info to the list of compiler options and go for the + ;; second alternative. + (if under-cover + (erlang-eunit-cover-compile) + (erlang-compile)) + (erlang-eunit-last-compilation-successful-p)) + (let ((msg (format "Could not read %s" file-path))) + (erlang-eunit-inferior-erlang-send-command + (format "%% WARNING: %s" msg)) + (error msg)))) + +(defun erlang-eunit-last-compilation-successful-p () + (save-excursion + (set-buffer inferior-erlang-buffer) + (goto-char compilation-parsing-end) + (erlang-eunit-all-list-elems-fulfill-p + (lambda (re) (let ((continue t) + (result t)) + (while continue ; ignore warnings, stop at errors + (if (re-search-forward re (point-max) t) + (if (erlang-eunit-is-compilation-warning) + t + (setq result nil) + (setq continue nil)) + (setq result t) + (setq continue nil))) + result)) + (mapcar (lambda (e) (car e)) erlang-error-regexp-alist)))) + +(defun erlang-eunit-is-compilation-warning () + (erlang-eunit-string-match-p + "[0-9]+: Warning:" + (buffer-substring (line-beginning-position) (line-end-position)))) + +(defun erlang-eunit-all-list-elems-fulfill-p (pred list) + (let ((matches-p t)) + (while (and list matches-p) + (if (not (funcall pred (car list))) + (setq matches-p nil)) + (setq list (cdr list))) + matches-p)) + +;;; Evaluate a command in an erlang buffer +(defun erlang-eunit-inferior-erlang-send-command (command) + "Evaluate a command in an erlang buffer." + (interactive "P") + (inferior-erlang-prepare-for-input) + (inferior-erlang-send-command command) + (sit-for 0) ;; redisplay + (inferior-erlang-wait-prompt)) + + +;;;==================================================================== +;;; Key bindings +;;;==================================================================== + +(defconst erlang-eunit-key-bindings + '(("\C-c\C-et" erlang-eunit-toggle-src-and-test-file-other-window) + ("\C-c\C-ek" erlang-eunit-compile-and-run-module-tests) + ("\C-c\C-ej" erlang-eunit-compile-and-run-current-test) + ("\C-c\C-el" erlang-eunit-compile-and-run-recent) + ("\C-c\C-ec" erlang-eunit-compile-and-run-module-tests-under-cover) + ("\C-c\C-ev" erlang-eunit-cover-compile) + ("\C-c\C-ea" erlang-eunit-analyze-coverage))) + +(defun erlang-eunit-add-key-bindings () + (dolist (binding erlang-eunit-key-bindings) + (erlang-eunit-bind-key (car binding) (cadr binding)))) + +(defun erlang-eunit-bind-key (key function) + (erlang-eunit-ensure-keymap-for-key key) + (local-set-key key function)) + +(defun erlang-eunit-ensure-keymap-for-key (key-seq) + (let ((prefix-keys (butlast (append key-seq nil))) + (prefix-seq "")) + (while prefix-keys + (setq prefix-seq (concat prefix-seq (make-string 1 (car prefix-keys)))) + (setq prefix-keys (cdr prefix-keys)) + (if (not (keymapp (lookup-key (current-local-map) prefix-seq))) + (local-set-key prefix-seq (make-sparse-keymap)))))) + +(add-hook 'erlang-mode-hook 'erlang-eunit-add-key-bindings) + + +(provide 'erlang-eunit) +;; erlang-eunit ends here diff --git a/elpa/erlang-20151013.157/erlang-flymake.el b/elpa/erlang-20151013.157/erlang-flymake.el new file mode 100644 index 0000000..2e447b5 --- /dev/null +++ b/elpa/erlang-20151013.157/erlang-flymake.el @@ -0,0 +1,103 @@ +;; erlang-flymake.el +;; +;; Syntax check erlang source code on the fly (integrates with flymake). +;; +;; Start using flymake with erlang by putting the following somewhere +;; in your .emacs file: +;; +;; (require 'erlang-flymake) +;; +;; Flymake is rather eager and does its syntax checks frequently by +;; default and if you are bothered by this, you might want to put the +;; following in your .emacs as well: +;; +;; (erlang-flymake-only-on-save) +;; +;; There are a couple of variables which control the compilation options: +;; * erlang-flymake-get-code-path-dirs-function +;; * erlang-flymake-get-include-dirs-function +;; * erlang-flymake-extra-opts +;; +;; This code is inspired by http://www.emacswiki.org/emacs/FlymakeErlang. + +(require 'flymake) +(eval-when-compile + (require 'cl)) + +(defvar erlang-flymake-command + "erlc" + "The command that will be used to perform the syntax check") + +(defvar erlang-flymake-get-code-path-dirs-function + 'erlang-flymake-get-code-path-dirs + "Return a list of ebin directories to add to the code path.") + +(defvar erlang-flymake-get-include-dirs-function + 'erlang-flymake-get-include-dirs + "Return a list of include directories to add to the compiler options.") + +(defvar erlang-flymake-extra-opts + (list "+warn_obsolete_guard" + "+warn_unused_import" + "+warn_shadow_vars" + "+warn_export_vars" + "+strong_validation" + "+report") + "A list of options that will be passed to the compiler") + +(defun erlang-flymake-only-on-save () + "Trigger flymake only when the buffer is saved (disables syntax +check on newline and when there are no changes)." + (interactive) + ;; There doesn't seem to be a way of disabling this; set to the + ;; largest int available as a workaround (most-positive-fixnum + ;; equates to 8.5 years on my machine, so it ought to be enough ;-) ) + (setq flymake-no-changes-timeout most-positive-fixnum) + (setq flymake-start-syntax-check-on-newline nil)) + + +(defun erlang-flymake-get-code-path-dirs () + (list (concat (erlang-flymake-get-app-dir) "ebin"))) + +(defun erlang-flymake-get-include-dirs () + (list (concat (erlang-flymake-get-app-dir) "include") + (concat (erlang-flymake-get-app-dir) "deps"))) + +(defun erlang-flymake-get-app-dir () + (let ((src-path (file-name-directory (buffer-file-name)))) + (file-name-directory (directory-file-name src-path)))) + +(defun erlang-flymake-init () + (let* ((temp-file + (flet ((flymake-get-temp-dir () (erlang-flymake-temp-dir))) + (flymake-init-create-temp-buffer-copy + 'flymake-create-temp-with-folder-structure))) + (code-dir-opts + (erlang-flymake-flatten + (mapcar (lambda (dir) (list "-pa" dir)) + (funcall erlang-flymake-get-code-path-dirs-function)))) + (inc-dir-opts + (erlang-flymake-flatten + (mapcar (lambda (dir) (list "-I" dir)) + (funcall erlang-flymake-get-include-dirs-function)))) + (compile-opts + (append inc-dir-opts + code-dir-opts + erlang-flymake-extra-opts))) + (list erlang-flymake-command (append compile-opts (list temp-file))))) + +(defun erlang-flymake-temp-dir () + ;; Squeeze the user's name in there in order to make sure that files + ;; for two users who are working on the same computer (like a linux + ;; box) don't collide + (format "%s/flymake-%s" temporary-file-directory user-login-name)) + +(defun erlang-flymake-flatten (list) + (apply #'append list)) + +(add-to-list 'flymake-allowed-file-name-masks + '("\\.erl\\'" erlang-flymake-init)) +(add-hook 'erlang-mode-hook 'flymake-mode) + +(provide 'erlang-flymake) +;; erlang-flymake ends here diff --git a/elpa/erlang-20151013.157/erlang-pkg.el b/elpa/erlang-20151013.157/erlang-pkg.el new file mode 100644 index 0000000..909a055 --- /dev/null +++ b/elpa/erlang-20151013.157/erlang-pkg.el @@ -0,0 +1,4 @@ +(define-package "erlang" "20151013.157" "Erlang major mode" 'nil) +;; Local Variables: +;; no-byte-compile: t +;; End: diff --git a/elpa/erlang-20151013.157/erlang-skels-old.el b/elpa/erlang-20151013.157/erlang-skels-old.el new file mode 100644 index 0000000..c271cce --- /dev/null +++ b/elpa/erlang-20151013.157/erlang-skels-old.el @@ -0,0 +1,1268 @@ +;; +;; %CopyrightBegin% +;; +;; Copyright Ericsson AB 2010. All Rights Reserved. +;; +;; Licensed under the Apache License, Version 2.0 (the "License"); +;; you may not use this file except in compliance with the License. +;; You may obtain a copy of the License at +;; +;; http://www.apache.org/licenses/LICENSE-2.0 +;; +;; Unless required by applicable law or agreed to in writing, software +;; distributed under the License is distributed on an "AS IS" BASIS, +;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +;; See the License for the specific language governing permissions and +;; limitations under the License. +;; +;; %CopyrightEnd% +;;; +;;; Purpose: Provide Erlang code skeletons. +;;; See 'erlang-skel-file' variable. + +(defvar erlang-tempo-tags nil + "Tempo tags for erlang mode") + +(defvar erlang-skel + '(("If" "if" erlang-skel-if) + ("Case" "case" erlang-skel-case) + ("Receive" "receive" erlang-skel-receive) + ("Receive After" "after" erlang-skel-receive-after) + ("Receive Loop" "loop" erlang-skel-receive-loop) + ("Module" "module" erlang-skel-module) + ("Author" "author" erlang-skel-author) + () + ("Small Header" "small-header" + erlang-skel-small-header erlang-skel-header) + ("Normal Header" "normal-header" + erlang-skel-normal-header erlang-skel-header) + ("Large Header" "large-header" + erlang-skel-large-header erlang-skel-header) + () + ("Small Server" "small-server" + erlang-skel-small-server erlang-skel-header) + () + ("Application" "application" + erlang-skel-application erlang-skel-header) + ("Supervisor" "supervisor" + erlang-skel-supervisor erlang-skel-header) + ("supervisor_bridge" "supervisor-bridge" + erlang-skel-supervisor-bridge erlang-skel-header) + ("gen_server" "generic-server" + erlang-skel-generic-server erlang-skel-header) + ("gen_event" "gen-event" + erlang-skel-gen-event erlang-skel-header) + ("gen_fsm" "gen-fsm" + erlang-skel-gen-fsm erlang-skel-header) + ("Library module" "gen-lib" + erlang-skel-lib erlang-skel-header) + ("Corba callback" "gen-corba-cb" + erlang-skel-corba-callback erlang-skel-header) + ("Small Common Test suite" "ct-test-suite-s" + erlang-skel-ct-test-suite-s erlang-skel-header) + ("Large Common Test suite" "ct-test-suite-l" + erlang-skel-ct-test-suite-l erlang-skel-header) + ("Erlang TS test suite" "ts-test-suite" + erlang-skel-ts-test-suite erlang-skel-header) + ) + "*Description of all skeleton templates. +Both functions and menu entries will be created. + +Each entry in `erlang-skel' should be a list with three or four +elements, or the empty list. + +The first element is the name which shows up in the menu. The second +is the `tempo' identifier (The string \"erlang-\" will be added in +front of it). The third is the skeleton descriptor, a variable +containing `tempo' attributes as described in the function +`tempo-define-template'. The optional fourth elements denotes a +function which should be called when the menu is selected. + +Functions corresponding to every template will be created. The name +of the function will be `tempo-template-erlang-X' where `X' is the +tempo identifier as specified in the second argument of the elements +in this list. + +A list with zero elements means that the a horizontal line should +be placed in the menu.") + +;; In XEmacs `user-mail-address' returns "x@y.z (Foo Bar)" ARGH! +;; What's wrong with that? RFC 822 says it's legal. [sverkerw] +;; This needs to use the customized value. If that's not sane, things like +;; add-log will lose anyhow. Avoid it if there _is_ a paren. +(defvar erlang-skel-mail-address + (if (or (not user-mail-address) (string-match "(" user-mail-address)) + (concat (user-login-name) "@" + (or (and (boundp 'mail-host-address) + mail-host-address) + (system-name))) + user-mail-address) + "Mail address of the user.") + +;; Expression templates: +(defvar erlang-skel-case + '((erlang-skel-skip-blank) o > + "case " p " of" n> p "_ ->" n> p "ok" n> "end" p) + "*The skeleton of a `case' expression. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-if + '((erlang-skel-skip-blank) o > + "if" n> p " ->" n> p "ok" n> "end" p) + "The skeleton of an `if' expression. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-receive + '((erlang-skel-skip-blank) o > + "receive" n> p "_ ->" n> p "ok" n> "end" p) + "*The skeleton of a `receive' expression. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-receive-after + '((erlang-skel-skip-blank) o > + "receive" n> p "_ ->" n> p "ok" n> "after " p "T ->" n> + p "ok" n> "end" p) + "*The skeleton of a `receive' expression with an `after' clause. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-receive-loop + '(& o "loop(" p ") ->" n> "receive" n> p "_ ->" n> + "loop(" p ")" n> "end.") + "*The skeleton of a simple `receive' loop. +Please see the function `tempo-define-template'.") + + +;; Attribute templates + +(defvar erlang-skel-module + '(& "-module(" + (erlang-add-quotes-if-needed (erlang-get-module-from-file-name)) + ")." n) + "*The skeleton of a `module' attribute. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-author + '(& "-author('" erlang-skel-mail-address "')." n) + "*The skeleton of a `author' attribute. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-vc nil + "*The skeleton template to generate a version control attribute. +The default is to insert nothing. Example of usage: + + (setq erlang-skel-vc '(& \"-rcs(\\\"$\Id: $ \\\").\") n) + +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-export + '(& "-export([" n> "])." n) + "*The skeleton of an `export' attribute. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-import + '(& "%%-import(Module, [Function/Arity, ...])." n) + "*The skeleton of an `import' attribute. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-compile nil + ;; '(& "%%-compile(export_all)." n) + "*The skeleton of a `compile' attribute. +Please see the function `tempo-define-template'.") + + +;; Comment templates. + +(defvar erlang-skel-date-function 'erlang-skel-dd-mmm-yyyy + "*Function which returns date string. +Look in the module `time-stamp' for a battery of functions.") + +(defvar erlang-skel-copyright-comment '() + "*The template for a copyright line in the header, normally empty. +This variable should be bound to a `tempo' template, for example: + '(& \"%%% Copyright (C) 2000, Yoyodyne, Inc.\" n) + +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-created-comment + '(& "%%% Created : " (funcall erlang-skel-date-function) " by " + (user-full-name) " <" erlang-skel-mail-address ">" n) + "*The template for the \"Created:\" comment line.") + +(defvar erlang-skel-author-comment + '(& "%%% Author : " (user-full-name) " <" erlang-skel-mail-address ">" n) + "*The template for creating the \"Author:\" line in the header. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-file-comment + '(& "%%% File : " (file-name-nondirectory buffer-file-name) n) +"*The template for creating the \"Module:\" line in the header. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-small-header + '(o (erlang-skel-include erlang-skel-module) + ;; erlang-skel-author) + n + (erlang-skel-include erlang-skel-compile + ;; erlang-skel-export + erlang-skel-vc)) + "*The template of a small header without any comments. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-normal-header + '(o (erlang-skel-include erlang-skel-copyright-comment + erlang-skel-file-comment + erlang-skel-author-comment) + "%%% Description : " p n + (erlang-skel-include erlang-skel-created-comment) n + (erlang-skel-include erlang-skel-small-header) n) + "*The template of a normal header. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-large-header + '(o (erlang-skel-separator) + (erlang-skel-include erlang-skel-copyright-comment + erlang-skel-file-comment + erlang-skel-author-comment) + "%%% Description : " p n + "%%%" n + (erlang-skel-include erlang-skel-created-comment) + (erlang-skel-separator) + (erlang-skel-include erlang-skel-small-header) ) + "*The template of a large header. +Please see the function `tempo-define-template'.") + + +;; Server templates. + +(defvar erlang-skel-small-server + '((erlang-skel-include erlang-skel-large-header) + "-export([start/0,init/1])." n n n + "start() ->" n> "spawn(" (erlang-get-module-from-file-name) + ", init, [self()])." n n + "init(From) ->" n> + "loop(From)." n n + "loop(From) ->" n> + "receive" n> + p "_ ->" n> + "loop(From)" n> + "end." + ) + "*Template of a small server. +Please see the function `tempo-define-template'.") + +;; Behaviour templates. + +(defvar erlang-skel-application + '((erlang-skel-include erlang-skel-large-header) + "-behaviour(application)." n n + "%% Application callbacks" n + "-export([start/2, stop/1])." n n + (erlang-skel-double-separator 2) + "%% Application callbacks" n + (erlang-skel-double-separator 2) + (erlang-skel-separator 2) + "%% Function: start(Type, StartArgs) -> {ok, Pid} |" n + "%% {ok, Pid, State} |" n + "%% {error, Reason}" n + "%% Description: This function is called whenever an application " n + "%% is started using application:start/1,2, and should start the processes" n + "%% of the application. If the application is structured according to the" n + "%% OTP design principles as a supervision tree, this means starting the" n + "%% top supervisor of the tree." n + (erlang-skel-separator 2) + "start(_Type, StartArgs) ->" n> + "case 'TopSupervisor':start_link(StartArgs) of" n> + "{ok, Pid} -> " n> + "{ok, Pid};" n> + "Error ->" n> + "Error" n> + "end." n + n + (erlang-skel-separator 2) + "%% Function: stop(State) -> void()" n + "%% Description: This function is called whenever an application" n + "%% has stopped. It is intended to be the opposite of Module:start/2 and" n + "%% should do any necessary cleaning up. The return value is ignored. "n + (erlang-skel-separator 2) + "stop(_State) ->" n> + "ok." n + n + (erlang-skel-double-separator 2) + "%% Internal functions" n + (erlang-skel-double-separator 2) + ) + "*The template of an application behaviour. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-supervisor + '((erlang-skel-include erlang-skel-large-header) + "-behaviour(supervisor)." n n + + "%% API" n + "-export([start_link/0])." n n + + "%% Supervisor callbacks" n + "-export([init/1])." n n + + "-define(SERVER, ?MODULE)." n n + + (erlang-skel-double-separator 2) + "%% API functions" n + (erlang-skel-double-separator 2) + (erlang-skel-separator 2) + "%% Function: start_link() -> {ok,Pid} | ignore | {error,Error}" n + "%% Description: Starts the supervisor" n + (erlang-skel-separator 2) + "start_link() ->" n> + "supervisor:start_link({local, ?SERVER}, ?MODULE, [])." n + n + (erlang-skel-double-separator 2) + "%% Supervisor callbacks" n + (erlang-skel-double-separator 2) + (erlang-skel-separator 2) + "%% Func: init(Args) -> {ok, {SupFlags, [ChildSpec]}} |" n + "%% ignore |" n + "%% {error, Reason}" n + "%% Description: Whenever a supervisor is started using "n + "%% supervisor:start_link/[2,3], this function is called by the new process "n + "%% to find out about restart strategy, maximum restart frequency and child "n + "%% specifications." n + (erlang-skel-separator 2) + "init([]) ->" n> + "AChild = {'AName',{'AModule',start_link,[]}," n> + "permanent,2000,worker,['AModule']}," n> + "{ok,{{one_for_all,0,1}, [AChild]}}." n + n + (erlang-skel-double-separator 2) + "%% Internal functions" n + (erlang-skel-double-separator 2) + ) + "*The template of an supervisor behaviour. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-supervisor-bridge + '((erlang-skel-include erlang-skel-large-header) + "-behaviour(supervisor_bridge)." n n + + "%% API" n + "-export([start_link/0])." n n + + "%% supervisor_bridge callbacks" n + "-export([init/1, terminate/2])." n n + + "-define(SERVER, ?MODULE)." n n + + "-record(state, {})." n n + + (erlang-skel-double-separator 2) + "%% API" n + (erlang-skel-double-separator 2) + (erlang-skel-separator 2) + "%% Function: start_link() -> {ok,Pid} | ignore | {error,Error}" n + "%% Description: Starts the supervisor bridge" n + (erlang-skel-separator 2) + "start_link() ->" n> + "supervisor_bridge:start_link({local, ?SERVER}, ?MODULE, [])." n + n + (erlang-skel-double-separator 2) + "%% supervisor_bridge callbacks" n + (erlang-skel-double-separator 2) + (erlang-skel-separator 2) + "%% Funcion: init(Args) -> {ok, Pid, State} |" n + "%% ignore |" n + "%% {error, Reason} " n + "%% Description:Creates a supervisor_bridge process, linked to the calling" n + "%% process, which calls Module:init/1 to start the subsystem. To ensure a" n + "%% synchronized start-up procedure, this function does not return until" n + "%% Module:init/1 has returned. " n + (erlang-skel-separator 2) + "init([]) ->" n> + "case 'AModule':start_link() of" n> + "{ok, Pid} ->" n> + "{ok, Pid, #state{}};" n> + "Error ->" n> + "Error" n> + "end." n + n + (erlang-skel-separator 2) + "%% Func: terminate(Reason, State) -> void()" n + "%% Description:This function is called by the supervisor_bridge when it is"n + "%% about to terminate. It should be the opposite of Module:init/1 and stop"n + "%% the subsystem and do any necessary cleaning up.The return value is ignored." + (erlang-skel-separator 2) + "terminate(Reason, State) ->" n> + "'AModule':stop()," n> + "ok." n + n + (erlang-skel-double-separator 2) + "%% Internal functions" n + (erlang-skel-double-separator 2) + ) + "*The template of an supervisor_bridge behaviour. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-generic-server + '((erlang-skel-include erlang-skel-large-header) + "-behaviour(gen_server)." n n + + "%% API" n + "-export([start_link/0])." n n + + "%% gen_server callbacks" n + "-export([init/1, handle_call/3, handle_cast/2, " + "handle_info/2," n> + "terminate/2, code_change/3])." n n + + "-record(state, {})." n n + + (erlang-skel-double-separator 2) + "%% API" n + (erlang-skel-double-separator 2) + (erlang-skel-separator 2) + "%% Function: start_link() -> {ok,Pid} | ignore | {error,Error}" n + "%% Description: Starts the server" n + (erlang-skel-separator 2) + "start_link() ->" n> + "gen_server:start_link({local, ?SERVER}, ?MODULE, [], [])." n + n + (erlang-skel-double-separator 2) + "%% gen_server callbacks" n + (erlang-skel-double-separator 2) + n + (erlang-skel-separator 2) + "%% Function: init(Args) -> {ok, State} |" n + "%% {ok, State, Timeout} |" n + "%% ignore |" n + "%% {stop, Reason}" n + "%% Description: Initializes the server" n + (erlang-skel-separator 2) + "init([]) ->" n> + "{ok, #state{}}." n + n + (erlang-skel-separator 2) + "%% Function: " + "%% handle_call(Request, From, State) -> {reply, Reply, State} |" n + "%% {reply, Reply, State, Timeout} |" n + "%% {noreply, State} |" n + "%% {noreply, State, Timeout} |" n + "%% {stop, Reason, Reply, State} |" n + "%% {stop, Reason, State}" n + "%% Description: Handling call messages" n + (erlang-skel-separator 2) + "handle_call(_Request, _From, State) ->" n> + "Reply = ok," n> + "{reply, Reply, State}." n + n + (erlang-skel-separator 2) + "%% Function: handle_cast(Msg, State) -> {noreply, State} |" n + "%% {noreply, State, Timeout} |" n + "%% {stop, Reason, State}" n + "%% Description: Handling cast messages" n + + (erlang-skel-separator 2) + "handle_cast(_Msg, State) ->" n> + "{noreply, State}." n + n + (erlang-skel-separator 2) + "%% Function: handle_info(Info, State) -> {noreply, State} |" n + "%% {noreply, State, Timeout} |" n + "%% {stop, Reason, State}" n + "%% Description: Handling all non call/cast messages" n + (erlang-skel-separator 2) + "handle_info(_Info, State) ->" n> + "{noreply, State}." n + n + (erlang-skel-separator 2) + "%% Function: terminate(Reason, State) -> void()" n + "%% Description: This function is called by a gen_server when it is about to"n + "%% terminate. It should be the opposite of Module:init/1 and do any necessary"n + "%% cleaning up. When it returns, the gen_server terminates with Reason." n + "%% The return value is ignored." n + + (erlang-skel-separator 2) + "terminate(_Reason, _State) ->" n> + "ok." n + n + (erlang-skel-separator 2) + "%% Func: code_change(OldVsn, State, Extra) -> {ok, NewState}" n + "%% Description: Convert process state when code is changed" n + (erlang-skel-separator 2) + "code_change(_OldVsn, State, _Extra) ->" n> + "{ok, State}." n + n + (erlang-skel-separator 2) + "%%% Internal functions" n + (erlang-skel-separator 2) + ) + "*The template of a generic server. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-gen-event + '((erlang-skel-include erlang-skel-large-header) + "-behaviour(gen_event)." n + + "%% API" n + "-export([start_link/0, add_handler/0])." n n + + "%% gen_event callbacks" n + "-export([init/1, handle_event/2, handle_call/2, " n> + "handle_info/2, terminate/2, code_change/3])." n n + + "-record(state, {})." n n + + (erlang-skel-double-separator 2) + "%% gen_event callbacks" n + (erlang-skel-double-separator 2) + (erlang-skel-separator 2) + "%% Function: start_link() -> {ok,Pid} | {error,Error} " n + "%% Description: Creates an event manager." n + (erlang-skel-separator 2) + "start_link() ->" n> + "gen_event:start_link({local, ?SERVER}). " n + n + (erlang-skel-separator 2) + "%% Function: add_handler() -> ok | {'EXIT',Reason} | term()" n + "%% Description: Adds an event handler" n + (erlang-skel-separator 2) + "add_handler() ->" n> + "gen_event:add_handler(?SERVER, ?MODULE, [])." n + n + (erlang-skel-double-separator 2) + "%% gen_event callbacks" n + (erlang-skel-double-separator 2) + (erlang-skel-separator 2) + "%% Function: init(Args) -> {ok, State}" n + "%% Description: Whenever a new event handler is added to an event manager,"n + "%% this function is called to initialize the event handler." n + (erlang-skel-separator 2) + "init([]) ->" n> + "{ok, #state{}}." n + n + (erlang-skel-separator 2) + "%% Function: "n + "%% handle_event(Event, State) -> {ok, State} |" n + "%% {swap_handler, Args1, State1, Mod2, Args2} |"n + "%% remove_handler" n + "%% Description:Whenever an event manager receives an event sent using"n + "%% gen_event:notify/2 or gen_event:sync_notify/2, this function is called for"n + "%% each installed event handler to handle the event. "n + (erlang-skel-separator 2) + "handle_event(_Event, State) ->" n> + "{ok, State}." n + n + (erlang-skel-separator 2) + "%% Function: " n + "%% handle_call(Request, State) -> {ok, Reply, State} |" n + "%% {swap_handler, Reply, Args1, State1, "n + "%% Mod2, Args2} |" n + "%% {remove_handler, Reply}" n + "%% Description: Whenever an event manager receives a request sent using"n + "%% gen_event:call/3,4, this function is called for the specified event "n + "%% handler to handle the request."n + (erlang-skel-separator 2) + "handle_call(_Request, State) ->" n> + "Reply = ok," n> + "{ok, Reply, State}." n + n + (erlang-skel-separator 2) + "%% Function: " n + "%% handle_info(Info, State) -> {ok, State} |" n + "%% {swap_handler, Args1, State1, Mod2, Args2} |" n + "%% remove_handler" n + "%% Description: This function is called for each installed event handler when"n + "%% an event manager receives any other message than an event or a synchronous"n + "%% request (or a system message)."n + (erlang-skel-separator 2) + "handle_info(_Info, State) ->" n> + "{ok, State}." n + n + (erlang-skel-separator 2) + "%% Function: terminate(Reason, State) -> void()" n + "%% Description:Whenever an event handler is deleted from an event manager,"n + "%% this function is called. It should be the opposite of Module:init/1 and "n + "%% do any necessary cleaning up. " n + (erlang-skel-separator 2) + "terminate(_Reason, _State) ->" n> + "ok." n + n + (erlang-skel-separator 2) + "%% Function: code_change(OldVsn, State, Extra) -> {ok, NewState} " n + "%% Description: Convert process state when code is changed" n + (erlang-skel-separator 2) + "code_change(_OldVsn, State, _Extra) ->" n> + "{ok, State}." n + n + (erlang-skel-separator 2) + "%%% Internal functions" n + (erlang-skel-separator 2) + ) + "*The template of a gen_event. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-gen-fsm + '((erlang-skel-include erlang-skel-large-header) + "-behaviour(gen_fsm)." n n + + "%% API" n + "-export([start_link/0])." n n + + "%% gen_fsm callbacks" n + "-export([init/1, state_name/2, state_name/3, handle_event/3," n> + "handle_sync_event/4, handle_info/3, terminate/3, code_change/4])." n n + + "-record(state, {})." n n + + (erlang-skel-double-separator 2) + "%% API" n + (erlang-skel-double-separator 2) + (erlang-skel-separator 2) + "%% Function: start_link() -> ok,Pid} | ignore | {error,Error}" n + "%% Description:Creates a gen_fsm process which calls Module:init/1 to"n + "%% initialize. To ensure a synchronized start-up procedure, this function" n + "%% does not return until Module:init/1 has returned. " n + (erlang-skel-separator 2) + "start_link() ->" n> + "gen_fsm:start_link({local, ?SERVER}, ?MODULE, [], [])." n + n + (erlang-skel-double-separator 2) + "%% gen_fsm callbacks" n + (erlang-skel-double-separator 2) + (erlang-skel-separator 2) + "%% Function: init(Args) -> {ok, StateName, State} |" n + "%% {ok, StateName, State, Timeout} |" n + "%% ignore |" n + "%% {stop, StopReason} " n + "%% Description:Whenever a gen_fsm is started using gen_fsm:start/[3,4] or"n + "%% gen_fsm:start_link/3,4, this function is called by the new process to "n + "%% initialize. " n + (erlang-skel-separator 2) + "init([]) ->" n> + "{ok, state_name, #state{}}." n + n + (erlang-skel-separator 2) + "%% Function: "n + "%% state_name(Event, State) -> {next_state, NextStateName, NextState}|" n + "%% {next_state, NextStateName, " n + "%% NextState, Timeout} |" n + "%% {stop, Reason, NewState}" n + "%% Description:There should be one instance of this function for each possible"n + "%% state name. Whenever a gen_fsm receives an event sent using" n + "%% gen_fsm:send_event/2, the instance of this function with the same name as"n + "%% the current state name StateName is called to handle the event. It is also "n + "%% called if a timeout occurs. " n + (erlang-skel-separator 2) + "state_name(_Event, State) ->" n> + "{next_state, state_name, State}." n + n + (erlang-skel-separator 2) + "%% Function:" n + "%% state_name(Event, From, State) -> {next_state, NextStateName, NextState} |"n + "%% {next_state, NextStateName, " n + "%% NextState, Timeout} |" n + "%% {reply, Reply, NextStateName, NextState}|"n + "%% {reply, Reply, NextStateName, " n + "%% NextState, Timeout} |" n + "%% {stop, Reason, NewState}|" n + "%% {stop, Reason, Reply, NewState}" n + "%% Description: There should be one instance of this function for each" n + "%% possible state name. Whenever a gen_fsm receives an event sent using" n + "%% gen_fsm:sync_send_event/2,3, the instance of this function with the same"n + "%% name as the current state name StateName is called to handle the event." n + (erlang-skel-separator 2) + "state_name(_Event, _From, State) ->" n> + "Reply = ok," n> + "{reply, Reply, state_name, State}." n + n + (erlang-skel-separator 2) + "%% Function: " n + "%% handle_event(Event, StateName, State) -> {next_state, NextStateName, "n + "%% NextState} |" n + "%% {next_state, NextStateName, "n + "%% NextState, Timeout} |" n + "%% {stop, Reason, NewState}" n + "%% Description: Whenever a gen_fsm receives an event sent using"n + "%% gen_fsm:send_all_state_event/2, this function is called to handle"n + "%% the event." n + (erlang-skel-separator 2) + "handle_event(_Event, StateName, State) ->" n> + "{next_state, StateName, State}." n + n + (erlang-skel-separator 2) + "%% Function: " n + "%% handle_sync_event(Event, From, StateName, "n + "%% State) -> {next_state, NextStateName, NextState} |" n + "%% {next_state, NextStateName, NextState, " n + "%% Timeout} |" n + "%% {reply, Reply, NextStateName, NextState}|" n + "%% {reply, Reply, NextStateName, NextState, " n + "%% Timeout} |" n + "%% {stop, Reason, NewState} |" n + "%% {stop, Reason, Reply, NewState}" n + "%% Description: Whenever a gen_fsm receives an event sent using"n + "%% gen_fsm:sync_send_all_state_event/2,3, this function is called to handle"n + "%% the event."n + (erlang-skel-separator 2) + "handle_sync_event(Event, From, StateName, State) ->" n> + "Reply = ok," n> + "{reply, Reply, StateName, State}." n + n + (erlang-skel-separator 2) + "%% Function: " n + "%% handle_info(Info,StateName,State)-> {next_state, NextStateName, NextState}|" n + "%% {next_state, NextStateName, NextState, "n + "%% Timeout} |" n + "%% {stop, Reason, NewState}" n + "%% Description: This function is called by a gen_fsm when it receives any"n + "%% other message than a synchronous or asynchronous event"n + "%% (or a system message)." n + (erlang-skel-separator 2) + "handle_info(_Info, StateName, State) ->" n> + "{next_state, StateName, State}." n + n + (erlang-skel-separator 2) + "%% Function: terminate(Reason, StateName, State) -> void()" n + "%% Description:This function is called by a gen_fsm when it is about"n + "%% to terminate. It should be the opposite of Module:init/1 and do any"n + "%% necessary cleaning up. When it returns, the gen_fsm terminates with"n + "%% Reason. The return value is ignored." n + (erlang-skel-separator 2) + "terminate(_Reason, _StateName, _State) ->" n> + "ok." n + n + (erlang-skel-separator 2) + "%% Function:" n + "%% code_change(OldVsn, StateName, State, Extra) -> {ok, StateName, NewState}" n + "%% Description: Convert process state when code is changed" n + (erlang-skel-separator 2) + "code_change(_OldVsn, StateName, State, _Extra) ->" n> + "{ok, StateName, State}." n + n + (erlang-skel-separator 2) + "%%% Internal functions" n + (erlang-skel-separator 2) + ) + "*The template of a gen_fsm. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-lib + '((erlang-skel-include erlang-skel-large-header) + + "%% API" n + "-export([])." n n + + (erlang-skel-double-separator 2) + "%% API" n + (erlang-skel-double-separator 2) + (erlang-skel-separator 2) + "%% Function: " n + "%% Description:" n + (erlang-skel-separator 2) + n + (erlang-skel-double-separator 2) + "%% Internal functions" n + (erlang-skel-double-separator 2) + ) + "*The template of a library module. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-corba-callback + '((erlang-skel-include erlang-skel-large-header) + "%% Include files" n n + + "%% API" n + "-export([])." n n + + "%% Corba callbacks" n + "-export([init/1, terminate/2, code_change/3])." n n + + "-record(state, {})." n n + + (erlang-skel-double-separator 2) + "%% Corba callbacks" n + (erlang-skel-double-separator 2) + (erlang-skel-separator 2) + "%% Function: init(Args) -> {ok, State} |" n + "%% {ok, State, Timeout} |" n + "%% ignore |" n + "%% {stop, Reason}" n + "%% Description: Initializes the server" n + (erlang-skel-separator 2) + "init([]) ->" n> + "{ok, #state{}}." n + n + (erlang-skel-separator 2) + "%% Function: terminate(Reason, State) -> void()" n + "%% Description: Shutdown the server" n + (erlang-skel-separator 2) + "terminate(_Reason, _State) ->" n> + "ok." n + n + (erlang-skel-separator 2) + "%% Function: code_change(OldVsn, State, Extra) -> {ok, NewState} " n + "%% Description: Convert process state when code is changed" n + (erlang-skel-separator 2) + "code_change(_OldVsn, State, _Extra) ->" n> + "{ok, State}." n + n + (erlang-skel-double-separator 2) + "%% Internal functions" n + (erlang-skel-double-separator 2) + ) + "*The template of a library module. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-ts-test-suite + '((erlang-skel-include erlang-skel-large-header) + "%% Note: This directive should only be used in test suites." n + "-compile(export_all)." n n + + "-include_lib(\"test_server/include/test_server.hrl\")." n n + + (erlang-skel-separator 2) + "%% TEST SERVER CALLBACK FUNCTIONS" n + (erlang-skel-separator 2) + n + (erlang-skel-separator 2) + "%% Function: init_per_suite(Config0) -> Config1 | {skip,Reason}" n + "%%" n + "%% Config0 = Config1 = [tuple()]" n + "%% A list of key/value pairs, holding the test case configuration." n + "%% Reason = term()" n + "%% The reason for skipping the suite." n + "%%" n + "%% Description: Initialization before the suite." n + "%%" n + "%% Note: This function is free to add any key/value pairs to the Config" n + "%% variable, but should NOT alter/remove any existing entries." n + (erlang-skel-separator 2) + "init_per_suite(Config) ->" n > + "Config." n n + + (erlang-skel-separator 2) + "%% Function: end_per_suite(Config) -> term()" n + "%%" n + "%% Config = [tuple()]" n + "%% A list of key/value pairs, holding the test case configuration." n + "%%" n + "%% Description: Cleanup after the suite." n + (erlang-skel-separator 2) + "end_per_suite(_Config) ->" n > + "ok." n n + + (erlang-skel-separator 2) + "%% Function: init_per_testcase(TestCase, Config0) -> Config1 |" n + "%% {skip,Reason}" n + "%% TestCase = atom()" n + "%% Name of the test case that is about to run." n + "%% Config0 = Config1 = [tuple()]" n + "%% A list of key/value pairs, holding the test case configuration." n + "%% Reason = term()" n + "%% The reason for skipping the test case." n + "%%" n + "%% Description: Initialization before each test case." n + "%%" n + "%% Note: This function is free to add any key/value pairs to the Config" n + "%% variable, but should NOT alter/remove any existing entries." n + (erlang-skel-separator 2) + "init_per_testcase(_TestCase, Config) ->" n > + "Config." n n + + (erlang-skel-separator 2) + "%% Function: end_per_testcase(TestCase, Config) -> term()" n + "%%" n + "%% TestCase = atom()" n + "%% Name of the test case that is finished." n + "%% Config = [tuple()]" n + "%% A list of key/value pairs, holding the test case configuration." n + "%%" n + "%% Description: Cleanup after each test case." n + (erlang-skel-separator 2) + "end_per_testcase(_TestCase, _Config) ->" n > + "ok."n n + + (erlang-skel-separator 2) + "%% Function: all(Clause) -> Descr | Spec | {skip,Reason}" n + "%%" n + "%% Clause = doc | suite" n + "%% Indicates expected return value." n + "%% Descr = [string()] | []" n + "%% String that describes the test suite." n + "%% Spec = [TestCase]" n + "%% A test specification." n + "%% TestCase = ConfCase | atom()" n + "%% Configuration case, or the name of a test case function." n + "%% ConfCase = {conf,Init,Spec,End} |" n + "%% {conf,Properties,Init,Spec,End}" n + "%% Init = End = {Mod,Func} | Func" n + "%% Initialization and cleanup function." n + "%% Mod = Func = atom()" n + "%% Properties = [parallel | sequence | Shuffle | {RepeatType,N}]" n + "%% Execution properties of the test cases (may be combined)." n + "%% Shuffle = shuffle | {shuffle,Seed}" n + "%% To get cases executed in random order." n + "%% Seed = {integer(),integer(),integer()}" n + "%% RepeatType = repeat | repeat_until_all_ok | repeat_until_all_fail |" n + "%% repeat_until_any_ok | repeat_until_any_fail" n + "%% To get execution of cases repeated." n + "%% N = integer() | forever" n + "%% Reason = term()" n + "%% The reason for skipping the test suite." n + "%%" n + "%% Description: Returns a description of the test suite when" n + "%% Clause == doc, and a test specification (list" n + "%% of the conf and test cases in the suite) when" n + "%% Clause == suite." n + (erlang-skel-separator 2) + "all(doc) -> " n > + "[\"Describe the main purpose of this suite\"];" n n + "all(suite) -> " n > + "[a_test_case]." n n + n + (erlang-skel-separator 2) + "%% TEST CASES" n + (erlang-skel-separator 2) + n + (erlang-skel-separator 2) + "%% Function: TestCase(Arg) -> Descr | Spec | ok | exit() | {skip,Reason}" n + "%%" n + "%% Arg = doc | suite | Config" n + "%% Indicates expected behaviour and return value." n + "%% Config = [tuple()]" n + "%% A list of key/value pairs, holding the test case configuration." n + "%% Descr = [string()] | []" n + "%% String that describes the test case." n + "%% Spec = [tuple()] | []" n + "%% A test specification, see all/1." n + "%% Reason = term()" n + "%% The reason for skipping the test case." n + "%%" n + "%% Description: Test case function. Returns a description of the test" n + "%% case (doc), then returns a test specification (suite)," n + "%% or performs the actual test (Config)." n + (erlang-skel-separator 2) + "a_test_case(doc) -> " n > + "[\"Describe the main purpose of this test case\"];" n n + "a_test_case(suite) -> " n > + "[];" n n + "a_test_case(Config) when is_list(Config) -> " n > + "ok." n + ) + "*The template of a library module. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-ct-test-suite-l + '((erlang-skel-include erlang-skel-large-header) + "%% Note: This directive should only be used in test suites." n + "-compile(export_all)." n n + + "-include_lib(\"common_test/include/ct.hrl\")." n n + + (erlang-skel-separator 2) + "%% COMMON TEST CALLBACK FUNCTIONS" n + (erlang-skel-separator 2) + n + (erlang-skel-separator 2) + "%% Function: suite() -> Info" n + "%%" n + "%% Info = [tuple()]" n + "%% List of key/value pairs." n + "%%" n + "%% Description: Returns list of tuples to set default properties" n + "%% for the suite." n + "%%" n + "%% Note: The suite/0 function is only meant to be used to return" n + "%% default data values, not perform any other operations." n + (erlang-skel-separator 2) + "suite() ->" n > + "[{timetrap,{minutes,10}}]." n n + + (erlang-skel-separator 2) + "%% Function: init_per_suite(Config0) ->" n + "%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1}" n + "%%" n + "%% Config0 = Config1 = [tuple()]" n + "%% A list of key/value pairs, holding the test case configuration." n + "%% Reason = term()" n + "%% The reason for skipping the suite." n + "%%" n + "%% Description: Initialization before the suite." n + "%%" n + "%% Note: This function is free to add any key/value pairs to the Config" n + "%% variable, but should NOT alter/remove any existing entries." n + (erlang-skel-separator 2) + "init_per_suite(Config) ->" n > + "Config." n n + + (erlang-skel-separator 2) + "%% Function: end_per_suite(Config0) -> term() | {save_config,Config1}" n + "%%" n + "%% Config0 = Config1 = [tuple()]" n + "%% A list of key/value pairs, holding the test case configuration." n + "%%" n + "%% Description: Cleanup after the suite." n + (erlang-skel-separator 2) + "end_per_suite(_Config) ->" n > + "ok." n n + + (erlang-skel-separator 2) + "%% Function: init_per_group(GroupName, Config0) ->" n + "%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1}" n + "%%" n + "%% GroupName = atom()" n + "%% Name of the test case group that is about to run." n + "%% Config0 = Config1 = [tuple()]" n + "%% A list of key/value pairs, holding configuration data for the group." n + "%% Reason = term()" n + "%% The reason for skipping all test cases and subgroups in the group." n + "%%" n + "%% Description: Initialization before each test case group." n + (erlang-skel-separator 2) + "init_per_group(_GroupName, Config) ->" n > + "Config." n n + + (erlang-skel-separator 2) + "%% Function: end_per_group(GroupName, Config0) ->" n + "%% term() | {save_config,Config1}" n + "%%" n + "%% GroupName = atom()" n + "%% Name of the test case group that is finished." n + "%% Config0 = Config1 = [tuple()]" n + "%% A list of key/value pairs, holding configuration data for the group." n + "%%" n + "%% Description: Cleanup after each test case group." n + (erlang-skel-separator 2) + "end_per_group(_GroupName, _Config) ->" n > + "ok." n n + + (erlang-skel-separator 2) + "%% Function: init_per_testcase(TestCase, Config0) ->" n + "%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1}" n + "%%" n + "%% TestCase = atom()" n + "%% Name of the test case that is about to run." n + "%% Config0 = Config1 = [tuple()]" n + "%% A list of key/value pairs, holding the test case configuration." n + "%% Reason = term()" n + "%% The reason for skipping the test case." n + "%%" n + "%% Description: Initialization before each test case." n + "%%" n + "%% Note: This function is free to add any key/value pairs to the Config" n + "%% variable, but should NOT alter/remove any existing entries." n + (erlang-skel-separator 2) + "init_per_testcase(_TestCase, Config) ->" n > + "Config." n n + + (erlang-skel-separator 2) + "%% Function: end_per_testcase(TestCase, Config0) ->" n + "%% term() | {save_config,Config1} | {fail,Reason}" n + "%%" n + "%% TestCase = atom()" n + "%% Name of the test case that is finished." n + "%% Config0 = Config1 = [tuple()]" n + "%% A list of key/value pairs, holding the test case configuration." n + "%% Reason = term()" n + "%% The reason for failing the test case." n + "%%" n + "%% Description: Cleanup after each test case." n + (erlang-skel-separator 2) + "end_per_testcase(_TestCase, _Config) ->" n > + "ok." n n + + (erlang-skel-separator 2) + "%% Function: groups() -> [Group]" n + "%%" n + "%% Group = {GroupName,Properties,GroupsAndTestCases}" n + "%% GroupName = atom()" n + "%% The name of the group." n + "%% Properties = [parallel | sequence | Shuffle | {RepeatType,N}]" n + "%% Group properties that may be combined." n + "%% GroupsAndTestCases = [Group | {group,GroupName} | TestCase]" n + "%% TestCase = atom()" n + "%% The name of a test case." n + "%% Shuffle = shuffle | {shuffle,Seed}" n + "%% To get cases executed in random order." n + "%% Seed = {integer(),integer(),integer()}" n + "%% RepeatType = repeat | repeat_until_all_ok | repeat_until_all_fail |" n + "%% repeat_until_any_ok | repeat_until_any_fail" n + "%% To get execution of cases repeated." n + "%% N = integer() | forever" n + "%%" n + "%% Description: Returns a list of test case group definitions." n + (erlang-skel-separator 2) + "groups() ->" n > + "[]." n n + + (erlang-skel-separator 2) + "%% Function: all() -> GroupsAndTestCases | {skip,Reason}" n + "%%" n + "%% GroupsAndTestCases = [{group,GroupName} | TestCase]" n + "%% GroupName = atom()" n + "%% Name of a test case group." n + "%% TestCase = atom()" n + "%% Name of a test case." n + "%% Reason = term()" n + "%% The reason for skipping all groups and test cases." n + "%%" n + "%% Description: Returns the list of groups and test cases that" n + "%% are to be executed." n + (erlang-skel-separator 2) + "all() -> " n > + "[my_test_case]." n n + + n + (erlang-skel-separator 2) + "%% TEST CASES" n + (erlang-skel-separator 2) + n + + (erlang-skel-separator 2) + "%% Function: TestCase() -> Info" n + "%%" n + "%% Info = [tuple()]" n + "%% List of key/value pairs." n + "%%" n + "%% Description: Test case info function - returns list of tuples to set" n + "%% properties for the test case." n + "%%" n + "%% Note: This function is only meant to be used to return a list of" n + "%% values, not perform any other operations." n + (erlang-skel-separator 2) + "my_test_case() -> " n > + "[]." n n + + (erlang-skel-separator 2) + "%% Function: TestCase(Config0) ->" n + "%% ok | exit() | {skip,Reason} | {comment,Comment} |" n + "%% {save_config,Config1} | {skip_and_save,Reason,Config1}" n + "%%" n + "%% Config0 = Config1 = [tuple()]" n + "%% A list of key/value pairs, holding the test case configuration." n + "%% Reason = term()" n + "%% The reason for skipping the test case." n + "%% Comment = term()" n + "%% A comment about the test case that will be printed in the html log." n + "%%" n + "%% Description: Test case function. (The name of it must be specified in" n + "%% the all/0 list or in a test case group for the test case" n + "%% to be executed)." n + (erlang-skel-separator 2) + "my_test_case(_Config) -> " n > + "ok." n + ) + "*The template of a library module. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-ct-test-suite-s + '((erlang-skel-include erlang-skel-large-header) + "-compile(export_all)." n n + + "-include_lib(\"common_test/include/ct.hrl\")." n n + + (erlang-skel-separator 2) + "%% Function: suite() -> Info" n + "%% Info = [tuple()]" n + (erlang-skel-separator 2) + "suite() ->" n > + "[{timetrap,{seconds,30}}]." n n + + (erlang-skel-separator 2) + "%% Function: init_per_suite(Config0) ->" n + "%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1}" n + "%% Config0 = Config1 = [tuple()]" n + "%% Reason = term()" n + (erlang-skel-separator 2) + "init_per_suite(Config) ->" n > + "Config." n n + + (erlang-skel-separator 2) + "%% Function: end_per_suite(Config0) -> term() | {save_config,Config1}" n + "%% Config0 = Config1 = [tuple()]" n + (erlang-skel-separator 2) + "end_per_suite(_Config) ->" n > + "ok." n n + + (erlang-skel-separator 2) + "%% Function: init_per_group(GroupName, Config0) ->" n + "%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1}" n + "%% GroupName = atom()" n + "%% Config0 = Config1 = [tuple()]" n + "%% Reason = term()" n + (erlang-skel-separator 2) + "init_per_group(_GroupName, Config) ->" n > + "Config." n n + + (erlang-skel-separator 2) + "%% Function: end_per_group(GroupName, Config0) ->" n + "%% term() | {save_config,Config1}" n + "%% GroupName = atom()" n + "%% Config0 = Config1 = [tuple()]" n + (erlang-skel-separator 2) + "end_per_group(_GroupName, _Config) ->" n > + "ok." n n + + (erlang-skel-separator 2) + "%% Function: init_per_testcase(TestCase, Config0) ->" n + "%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1}" n + "%% TestCase = atom()" n + "%% Config0 = Config1 = [tuple()]" n + "%% Reason = term()" n + (erlang-skel-separator 2) + "init_per_testcase(_TestCase, Config) ->" n > + "Config." n n + + (erlang-skel-separator 2) + "%% Function: end_per_testcase(TestCase, Config0) ->" n + "%% term() | {save_config,Config1} | {fail,Reason}" n + "%% TestCase = atom()" n + "%% Config0 = Config1 = [tuple()]" n + "%% Reason = term()" n + (erlang-skel-separator 2) + "end_per_testcase(_TestCase, _Config) ->" n > + "ok." n n + + (erlang-skel-separator 2) + "%% Function: groups() -> [Group]" n + "%% Group = {GroupName,Properties,GroupsAndTestCases}" n + "%% GroupName = atom()" n + "%% Properties = [parallel | sequence | Shuffle | {RepeatType,N}]" n + "%% GroupsAndTestCases = [Group | {group,GroupName} | TestCase]" n + "%% TestCase = atom()" n + "%% Shuffle = shuffle | {shuffle,{integer(),integer(),integer()}}" n + "%% RepeatType = repeat | repeat_until_all_ok | repeat_until_all_fail |" n + "%% repeat_until_any_ok | repeat_until_any_fail" n + "%% N = integer() | forever" n + (erlang-skel-separator 2) + "groups() ->" n > + "[]." n n + + (erlang-skel-separator 2) + "%% Function: all() -> GroupsAndTestCases | {skip,Reason}" n + "%% GroupsAndTestCases = [{group,GroupName} | TestCase]" n + "%% GroupName = atom()" n + "%% TestCase = atom()" n + "%% Reason = term()" n + (erlang-skel-separator 2) + "all() -> " n > + "[my_test_case]." n n + + (erlang-skel-separator 2) + "%% Function: TestCase() -> Info" n + "%% Info = [tuple()]" n + (erlang-skel-separator 2) + "my_test_case() -> " n > + "[]." n n + + (erlang-skel-separator 2) + "%% Function: TestCase(Config0) ->" n + "%% ok | exit() | {skip,Reason} | {comment,Comment} |" n + "%% {save_config,Config1} | {skip_and_save,Reason,Config1}" n + "%% Config0 = Config1 = [tuple()]" n + "%% Reason = term()" n + "%% Comment = term()" n + (erlang-skel-separator 2) + "my_test_case(_Config) -> " n > + "ok." n + ) + "*The template of a library module. +Please see the function `tempo-define-template'.") diff --git a/elpa/erlang-20151013.157/erlang-skels.el b/elpa/erlang-20151013.157/erlang-skels.el new file mode 100644 index 0000000..6880ec7 --- /dev/null +++ b/elpa/erlang-20151013.157/erlang-skels.el @@ -0,0 +1,1701 @@ +;; +;; %CopyrightBegin% +;; +;; Copyright Ericsson AB 2010-2014. All Rights Reserved. +;; +;; Licensed under the Apache License, Version 2.0 (the "License"); +;; you may not use this file except in compliance with the License. +;; You may obtain a copy of the License at +;; +;; http://www.apache.org/licenses/LICENSE-2.0 +;; +;; Unless required by applicable law or agreed to in writing, software +;; distributed under the License is distributed on an "AS IS" BASIS, +;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +;; See the License for the specific language governing permissions and +;; limitations under the License. +;; +;; %CopyrightEnd% +;;; +;;; Purpose: Provide Erlang code skeletons. +;;; See 'erlang-skel-file' variable. + +(defvar erlang-tempo-tags nil + "Tempo tags for erlang mode") + +(defvar erlang-skel + '(("If" "if" erlang-skel-if) + ("Case" "case" erlang-skel-case) + ("Receive" "receive" erlang-skel-receive) + ("Receive After" "after" erlang-skel-receive-after) + ("Receive Loop" "loop" erlang-skel-receive-loop) + ("Module" "module" erlang-skel-module) + ("Author" "author" erlang-skel-author) + ("Function" "function" erlang-skel-function) + ("Spec" "spec" erlang-skel-spec) + () + ("Small Header" "small-header" + erlang-skel-small-header erlang-skel-header) + ("Normal Header" "normal-header" + erlang-skel-normal-header erlang-skel-header) + ("Large Header" "large-header" + erlang-skel-large-header erlang-skel-header) + () + ("Small Server" "small-server" + erlang-skel-small-server erlang-skel-header) + () + ("Application" "application" + erlang-skel-application erlang-skel-header) + ("Supervisor" "supervisor" + erlang-skel-supervisor erlang-skel-header) + ("supervisor_bridge" "supervisor-bridge" + erlang-skel-supervisor-bridge erlang-skel-header) + ("gen_server" "generic-server" + erlang-skel-generic-server erlang-skel-header) + ("gen_event" "gen-event" + erlang-skel-gen-event erlang-skel-header) + ("gen_fsm" "gen-fsm" + erlang-skel-gen-fsm erlang-skel-header) + ("wx_object" "wx-object" + erlang-skel-wx-object erlang-skel-header) + ("Library module" "gen-lib" + erlang-skel-lib erlang-skel-header) + ("Corba callback" "gen-corba-cb" + erlang-skel-corba-callback erlang-skel-header) + ("Small Common Test suite" "ct-test-suite-s" + erlang-skel-ct-test-suite-s erlang-skel-header) + ("Large Common Test suite" "ct-test-suite-l" + erlang-skel-ct-test-suite-l erlang-skel-header) + ("Erlang TS test suite" "ts-test-suite" + erlang-skel-ts-test-suite erlang-skel-header) + ) + "*Description of all skeleton templates. +Both functions and menu entries will be created. + +Each entry in `erlang-skel' should be a list with three or four +elements, or the empty list. + +The first element is the name which shows up in the menu. The second +is the `tempo' identifier (The string \"erlang-\" will be added in +front of it). The third is the skeleton descriptor, a variable +containing `tempo' attributes as described in the function +`tempo-define-template'. The optional fourth elements denotes a +function which should be called when the menu is selected. + +Functions corresponding to every template will be created. The name +of the function will be `tempo-template-erlang-X' where `X' is the +tempo identifier as specified in the second argument of the elements +in this list. + +A list with zero elements means that the a horizontal line should +be placed in the menu.") + +(defvar erlang-skel-use-separators t + "A boolean than determines whether the skeletons include horizontal +separators. + +Should this variable be nil, the documentation for functions will not +include separators of the form %%--...") + +;; In XEmacs `user-mail-address' returns "x@y.z (Foo Bar)" ARGH! +;; What's wrong with that? RFC 822 says it's legal. [sverkerw] +;; This needs to use the customized value. If that's not sane, things like +;; add-log will lose anyhow. Avoid it if there _is_ a paren. +(defvar erlang-skel-mail-address + (if (or (not user-mail-address) (string-match "(" user-mail-address)) + (concat (user-login-name) "@" + (or (and (boundp 'mail-host-address) + mail-host-address) + (system-name))) + user-mail-address) + "Mail address of the user.") + +;; Expression templates: +(defvar erlang-skel-case + '((erlang-skel-skip-blank) o > + "case " p " of" n> p "_ ->" n> p "ok" n "end" > p) + "*The skeleton of a `case' expression. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-if + '((erlang-skel-skip-blank) o > + "if" n> p " ->" n> p "ok" n "end" > p) + "The skeleton of an `if' expression. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-receive + '((erlang-skel-skip-blank) o > + "receive" n> p "_ ->" n> p "ok" n "end" > p) + "*The skeleton of a `receive' expression. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-receive-after + '((erlang-skel-skip-blank) o > + "receive" n> p "_ ->" n> p "ok" n "after " > p "T ->" n> + p "ok" n "end" > p) + "*The skeleton of a `receive' expression with an `after' clause. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-receive-loop + '(& o "loop(" p ") ->" n> "receive" n> p "_ ->" n> + "loop(" p ")" n "end." >) + "*The skeleton of a simple `receive' loop. +Please see the function `tempo-define-template'.") + + +(defvar erlang-skel-function + '((erlang-skel-separator-start 2) + "%% @doc" n + "%% @spec" n + (erlang-skel-separator-end 2)) + "*The template of a function skeleton. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-spec + '("-spec " (erlang-skel-get-function-name) "(" (erlang-skel-get-function-args) ") -> undefined.") + "*The template of a -spec for the function following point. +Please see the function `tempo-define-template'.") + +;; Attribute templates + +(defvar erlang-skel-module + '(& "-module(" + (erlang-add-quotes-if-needed (erlang-get-module-from-file-name)) + ")." n) + "*The skeleton of a `module' attribute. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-author + '(& "-author('" erlang-skel-mail-address "')." n) + "*The skeleton of a `author' attribute. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-vc nil + "*The skeleton template to generate a version control attribute. +The default is to insert nothing. Example of usage: + + (setq erlang-skel-vc '(& \"-rcs(\\\"$\Id: $ \\\").\") n) + +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-export + '(& "-export([" n> "])." n) + "*The skeleton of an `export' attribute. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-import + '(& "%%-import(Module, [Function/Arity, ...])." n) + "*The skeleton of an `import' attribute. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-compile nil + ;; '(& "%%-compile(export_all)." n) + "*The skeleton of a `compile' attribute. +Please see the function `tempo-define-template'.") + + +;; Comment templates. + +(defvar erlang-skel-date-function 'erlang-skel-dd-mmm-yyyy + "*Function which returns date string. +Look in the module `time-stamp' for a battery of functions.") + +(defvar erlang-skel-copyright-comment + (if (boundp '*copyright-organization*) + '(& "%%% @copyright (C) " (format-time-string "%Y") ", " + *copyright-organization* n) + '(& "%%% @copyright (C) " (format-time-string "%Y") ", " + (user-full-name) n)) + "*The template for a copyright line in the header, normally empty. +This variable should be bound to a `tempo' template, for example: + '(& \"%%% Copyright (C) 2000, Yoyodyne, Inc.\" n) +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-created-comment + '(& "%%% Created : " (funcall erlang-skel-date-function) " by " + (user-full-name) " <" erlang-skel-mail-address ">" n) + "*The template for the \"Created:\" comment line.") + +(defvar erlang-skel-author-comment + '(& "%%% @author " (user-full-name) " <" erlang-skel-mail-address ">" n) + "*The template for creating the \"Author:\" line in the header. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-small-header + '(o (erlang-skel-include erlang-skel-module) + n + (erlang-skel-include erlang-skel-compile erlang-skel-vc)) + "*The template of a small header without any comments. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-normal-header + '(o (erlang-skel-include erlang-skel-author-comment) + (erlang-skel-include erlang-skel-copyright-comment) + "%%% @doc" n + "%%%" p n + "%%% @end" n + (erlang-skel-include erlang-skel-created-comment) n + (erlang-skel-include erlang-skel-small-header) n) + "*The template of a normal header. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-large-header + '(o (erlang-skel-separator) + (erlang-skel-include erlang-skel-author-comment) + (erlang-skel-include erlang-skel-copyright-comment) + "%%% @doc" n + "%%%" p n + "%%% @end" n + (erlang-skel-include erlang-skel-created-comment) + (erlang-skel-separator) + (erlang-skel-include erlang-skel-small-header) ) + "*The template of a large header. +Please see the function `tempo-define-template'.") + + + ;; Server templates. +(defvar erlang-skel-small-server + '((erlang-skel-include erlang-skel-large-header) + "-export([start/0, init/1])." n n n + "start() ->" n> "spawn(" (erlang-get-module-from-file-name) + ", init, [self()])." n n + "init(From) ->" n> + "loop(From)." n n + "loop(From) ->" n> + "receive" n> + p "_ ->" n> + "loop(From)" n + "end." > n + ) + "*Template of a small server. +Please see the function `tempo-define-template'.") + +;; Behaviour templates. +(defvar erlang-skel-application + '((erlang-skel-include erlang-skel-large-header) + "-behaviour(application)." n n + "%% Application callbacks" n + "-export([start/2, stop/1])." n n + (erlang-skel-double-separator-start 3) + "%%% Application callbacks" n + (erlang-skel-double-separator-end 3) n + (erlang-skel-separator-start 2) + "%% @private" n + "%% @doc" n + "%% This function is called whenever an application is started using" n + "%% application:start/[1,2], and should start the processes of the" n + "%% application. If the application is structured according to the OTP" n + "%% design principles as a supervision tree, this means starting the" n + "%% top supervisor of the tree." n + "%%" n + "%% @spec start(StartType, StartArgs) -> {ok, Pid} |" n + "%% {ok, Pid, State} |" n + "%% {error, Reason}" n + "%% StartType = normal | {takeover, Node} | {failover, Node}" n + "%% StartArgs = term()" n + (erlang-skel-separator-end 2) + "start(_StartType, _StartArgs) ->" n> + "case 'TopSupervisor':start_link() of" n> + "{ok, Pid} ->" n> + "{ok, Pid};" n> + "Error ->" n> + "Error" n + "end." > n + n + (erlang-skel-separator-start 2) + "%% @private" n + "%% @doc" n + "%% This function is called whenever an application has stopped. It" n + "%% is intended to be the opposite of Module:start/2 and should do" n + "%% any necessary cleaning up. The return value is ignored." n + "%%" n + "%% @spec stop(State) -> void()" n + (erlang-skel-separator-end 2) + "stop(_State) ->" n> + "ok." n + n + (erlang-skel-double-separator-start 3) + "%%% Internal functions" n + (erlang-skel-double-separator-end 3) + ) + "*The template of an application behaviour. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-supervisor + '((erlang-skel-include erlang-skel-large-header) + "-behaviour(supervisor)." n n + + "%% API" n + "-export([start_link/0])." n n + + "%% Supervisor callbacks" n + "-export([init/1])." n n + + "-define(SERVER, ?MODULE)." n n + + (erlang-skel-double-separator-start 3) + "%%% API functions" n + (erlang-skel-double-separator-end 3) n + (erlang-skel-separator-start 2) + "%% @doc" n + "%% Starts the supervisor" n + "%%" n + "%% @spec start_link() -> {ok, Pid} | ignore | {error, Error}" n + (erlang-skel-separator-end 2) + "start_link() ->" n> + "supervisor:start_link({local, ?SERVER}, ?MODULE, [])." n + n + (erlang-skel-double-separator-start 3) + "%%% Supervisor callbacks" n + (erlang-skel-double-separator-end 3) n + (erlang-skel-separator-start 2) + "%% @private" n + "%% @doc" n + "%% Whenever a supervisor is started using supervisor:start_link/[2,3]," n + "%% this function is called by the new process to find out about" n + "%% restart strategy, maximum restart intensity, and child" n + "%% specifications." n + "%%" n + "%% @spec init(Args) -> {ok, {SupFlags, [ChildSpec]}} |" n + "%% ignore |" n + "%% {error, Reason}" n + (erlang-skel-separator-end 2) + "init([]) ->" n + "" n> + "SupFlags = #{strategy => one_for_one," n> + "intensity => 1," n> + "period => 5}," n + "" n> + "AChild = #{id => 'AName'," n> + "start => {'AModule', start_link, []}," n> + "restart => permanent," n> + "shutdown => 5000," n> + "type => worker," n> + "modules => ['AModule']}," n + "" n> + "{ok, {SupFlags, [AChild]}}." n + n + (erlang-skel-double-separator-start 3) + "%%% Internal functions" n + (erlang-skel-double-separator-end 3) + ) + "*The template of a supervisor behaviour. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-supervisor-bridge + '((erlang-skel-include erlang-skel-large-header) + "-behaviour(supervisor_bridge)." n n + + "%% API" n + "-export([start_link/0])." n n + + "%% supervisor_bridge callbacks" n + "-export([init/1, terminate/2])." n n + + "-define(SERVER, ?MODULE)." n n + + "-record(state, {})." n n + + (erlang-skel-double-separator-start 3) + "%%% API" n + (erlang-skel-double-separator-end 3) n + (erlang-skel-separator-start 2) + "%% @doc" n + "%% Starts the supervisor bridge" n + "%%" n + "%% @spec start_link() -> {ok, Pid} | ignore | {error, Error}" n + (erlang-skel-separator-end 2) + "start_link() ->" n> + "supervisor_bridge:start_link({local, ?SERVER}, ?MODULE, [])." n + n + (erlang-skel-double-separator-start 3) + "%%% supervisor_bridge callbacks" n + (erlang-skel-double-separator-end 3) n + (erlang-skel-separator-start 2) + "%% @private" n + "%% @doc" n + "%% Creates a supervisor_bridge process, linked to the calling process," n + "%% which calls Module:init/1 to start the subsystem. To ensure a" n + "%% synchronized start-up procedure, this function does not return" n + "%% until Module:init/1 has returned." n + "%%" n + "%% @spec init(Args) -> {ok, Pid, State} |" n + "%% ignore |" n + "%% {error, Reason}" n + (erlang-skel-separator-end 2) + "init([]) ->" n> + "case 'AModule':start_link() of" n> + "{ok, Pid} ->" n> + "{ok, Pid, #state{}};" n> + "Error ->" n> + "Error" n + "end." > n + n + (erlang-skel-separator-start 2) + "%% @private" n + "%% @doc" n + "%% This function is called by the supervisor_bridge when it is about" n + "%% to terminate. It should be the opposite of Module:init/1 and stop" n + "%% the subsystem and do any necessary cleaning up.The return value is" n + "%% ignored." n + "%%" n + "%% @spec terminate(Reason, State) -> void()" n + (erlang-skel-separator-end 2) + "terminate(Reason, State) ->" n> + "'AModule':stop()," n> + "ok." n + n + (erlang-skel-double-separator-start 3) + "%%% Internal functions" n + (erlang-skel-double-separator-end 3) + ) + "*The template of a supervisor_bridge behaviour. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-generic-server + '((erlang-skel-include erlang-skel-large-header) + "-behaviour(gen_server)." n n + + "%% API" n + "-export([start_link/0])." n n + + "%% gen_server callbacks" n + "-export([init/1, handle_call/3, handle_cast/2, " + "handle_info/2," n> + "terminate/2, code_change/3])." n n + + "-define(SERVER, ?MODULE)." n n + + "-record(state, {})." n n + + (erlang-skel-double-separator-start 3) + "%%% API" n + (erlang-skel-double-separator-end 3) n + (erlang-skel-separator-start 2) + "%% @doc" n + "%% Starts the server" n + "%%" n + "%% @spec start_link() -> {ok, Pid} | ignore | {error, Error}" n + (erlang-skel-separator-end 2) + "start_link() ->" n> + "gen_server:start_link({local, ?SERVER}, ?MODULE, [], [])." n + n + (erlang-skel-double-separator-start 3) + "%%% gen_server callbacks" n + (erlang-skel-double-separator-end 3) + n + (erlang-skel-separator-start 2) + "%% @private" n + "%% @doc" n + "%% Initializes the server" n + "%%" n + "%% @spec init(Args) -> {ok, State} |" n + "%% {ok, State, Timeout} |" n + "%% ignore |" n + "%% {stop, Reason}" n + (erlang-skel-separator-end 2) + "init([]) ->" n> + "{ok, #state{}}." n + n + (erlang-skel-separator-start 2) + "%% @private" n + "%% @doc" n + "%% Handling call messages" n + "%%" n + "%% @spec handle_call(Request, From, State) ->" n + "%% {reply, Reply, State} |" n + "%% {reply, Reply, State, Timeout} |" n + "%% {noreply, State} |" n + "%% {noreply, State, Timeout} |" n + "%% {stop, Reason, Reply, State} |" n + "%% {stop, Reason, State}" n + (erlang-skel-separator-end 2) + "handle_call(_Request, _From, State) ->" n> + "Reply = ok," n> + "{reply, Reply, State}." n + n + (erlang-skel-separator-start 2) + "%% @private" n + "%% @doc" n + "%% Handling cast messages" n + "%%" n + "%% @spec handle_cast(Msg, State) -> {noreply, State} |" n + "%% {noreply, State, Timeout} |" n + "%% {stop, Reason, State}" n + (erlang-skel-separator-end 2) + "handle_cast(_Msg, State) ->" n> + "{noreply, State}." n + n + (erlang-skel-separator-start 2) + "%% @private" n + "%% @doc" n + "%% Handling all non call/cast messages" n + "%%" n + "%% @spec handle_info(Info, State) -> {noreply, State} |" n + "%% {noreply, State, Timeout} |" n + "%% {stop, Reason, State}" n + (erlang-skel-separator-end 2) + "handle_info(_Info, State) ->" n> + "{noreply, State}." n + n + (erlang-skel-separator-start 2) + "%% @private" n + "%% @doc" n + "%% This function is called by a gen_server when it is about to" n + "%% terminate. It should be the opposite of Module:init/1 and do any" n + "%% necessary cleaning up. When it returns, the gen_server terminates" n + "%% with Reason. The return value is ignored." n + "%%" n + "%% @spec terminate(Reason, State) -> void()" n + (erlang-skel-separator-end 2) + "terminate(_Reason, _State) ->" n> + "ok." n + n + (erlang-skel-separator-start 2) + "%% @private" n + "%% @doc" n + "%% Convert process state when code is changed" n + "%%" n + "%% @spec code_change(OldVsn, State, Extra) -> {ok, NewState}" n + (erlang-skel-separator-end 2) + "code_change(_OldVsn, State, _Extra) ->" n> + "{ok, State}." n + n + (erlang-skel-double-separator-start 3) + "%%% Internal functions" n + (erlang-skel-double-separator-end 3) + ) + "*The template of a generic server. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-gen-event + '((erlang-skel-include erlang-skel-large-header) + "-behaviour(gen_event)." n n + + "%% API" n + "-export([start_link/0, add_handler/0])." n n + + "%% gen_event callbacks" n + "-export([init/1, handle_event/2, handle_call/2, " n> + "handle_info/2, terminate/2, code_change/3])." n n + + "-define(SERVER, ?MODULE)." n n + + "-record(state, {})." n n + + (erlang-skel-double-separator-start 3) + "%%% API" n + (erlang-skel-double-separator-end 3) n + (erlang-skel-separator-start 2) + "%% @doc" n + "%% Creates an event manager" n + "%%" n + "%% @spec start_link() -> {ok, Pid} | {error, Error}" n + (erlang-skel-separator-end 2) + "start_link() ->" n> + "gen_event:start_link({local, ?SERVER})." n + n + (erlang-skel-separator-start 2) + "%% @doc" n + "%% Adds an event handler" n + "%%" n + "%% @spec add_handler() -> ok | {'EXIT', Reason} | term()" n + (erlang-skel-separator-end 2) + "add_handler() ->" n> + "gen_event:add_handler(?SERVER, ?MODULE, [])." n + n + (erlang-skel-double-separator-start 3) + "%%% gen_event callbacks" n + (erlang-skel-double-separator-end 3) n + (erlang-skel-separator-start 2) + "%% @private" n + "%% @doc" n + "%% Whenever a new event handler is added to an event manager," n + "%% this function is called to initialize the event handler." n + "%%" n + "%% @spec init(Args) -> {ok, State}" n + (erlang-skel-separator-end 2) + "init([]) ->" n> + "{ok, #state{}}." n + n + (erlang-skel-separator-start 2) + "%% @private" n + "%% @doc" n + "%% Whenever an event manager receives an event sent using" n + "%% gen_event:notify/2 or gen_event:sync_notify/2, this function is" n + "%% called for each installed event handler to handle the event." n + "%%" n + "%% @spec handle_event(Event, State) ->" n + "%% {ok, State} |" n + "%% {swap_handler, Args1, State1, Mod2, Args2} |"n + "%% remove_handler" n + (erlang-skel-separator-end 2) + "handle_event(_Event, State) ->" n> + "{ok, State}." n + n + (erlang-skel-separator-start 2) + "%% @private" n + "%% @doc" n + "%% Whenever an event manager receives a request sent using" n + "%% gen_event:call/3,4, this function is called for the specified" n + "%% event handler to handle the request." n + "%%" n + "%% @spec handle_call(Request, State) ->" n + "%% {ok, Reply, State} |" n + "%% {swap_handler, Reply, Args1, State1, Mod2, Args2} |" n + "%% {remove_handler, Reply}" n + (erlang-skel-separator-end 2) + "handle_call(_Request, State) ->" n> + "Reply = ok," n> + "{ok, Reply, State}." n + n + (erlang-skel-separator-start 2) + "%% @private" n + "%% @doc" n + "%% This function is called for each installed event handler when" n + "%% an event manager receives any other message than an event or a" n + "%% synchronous request (or a system message)." n + "%%" n + "%% @spec handle_info(Info, State) ->" n + "%% {ok, State} |" n + "%% {swap_handler, Args1, State1, Mod2, Args2} |" n + "%% remove_handler" n + (erlang-skel-separator-end 2) + "handle_info(_Info, State) ->" n> + "{ok, State}." n + n + (erlang-skel-separator-start 2) + "%% @private" n + "%% @doc" n + "%% Whenever an event handler is deleted from an event manager, this" n + "%% function is called. It should be the opposite of Module:init/1 and" n + "%% do any necessary cleaning up." n + "%%" n + "%% @spec terminate(Reason, State) -> void()" n + (erlang-skel-separator-end 2) + "terminate(_Reason, _State) ->" n> + "ok." n + n + (erlang-skel-separator-start 2) + "%% @private" n + "%% @doc" n + "%% Convert process state when code is changed" n + "%%" n + "%% @spec code_change(OldVsn, State, Extra) -> {ok, NewState}" n + (erlang-skel-separator-end 2) + "code_change(_OldVsn, State, _Extra) ->" n> + "{ok, State}." n + n + (erlang-skel-double-separator-start 3) + "%%% Internal functions" n + (erlang-skel-double-separator-end 3) + ) + "*The template of a gen_event. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-gen-fsm + '((erlang-skel-include erlang-skel-large-header) + "-behaviour(gen_fsm)." n n + + "%% API" n + "-export([start_link/0])." n n + + "%% gen_fsm callbacks" n + "-export([init/1, state_name/2, state_name/3, handle_event/3," n> + "handle_sync_event/4, handle_info/3, terminate/3, code_change/4])." n n + + "-define(SERVER, ?MODULE)." n n + + "-record(state, {})." n n + + (erlang-skel-double-separator-start 3) + "%%% API" n + (erlang-skel-double-separator-end 3) n + (erlang-skel-separator-start 2) + "%% @doc" n + "%% Creates a gen_fsm process which calls Module:init/1 to" n + "%% initialize. To ensure a synchronized start-up procedure, this" n + "%% function does not return until Module:init/1 has returned." n + "%%" n + "%% @spec start_link() -> {ok, Pid} | ignore | {error, Error}" n + (erlang-skel-separator-end 2) + "start_link() ->" n> + "gen_fsm:start_link({local, ?SERVER}, ?MODULE, [], [])." n + n + (erlang-skel-double-separator-start 3) + "%%% gen_fsm callbacks" n + (erlang-skel-double-separator-end 3) n + (erlang-skel-separator-start 2) + "%% @private" n + "%% @doc" n + "%% Whenever a gen_fsm is started using gen_fsm:start/[3,4] or" n + "%% gen_fsm:start_link/[3,4], this function is called by the new" n + "%% process to initialize." n + "%%" n + "%% @spec init(Args) -> {ok, StateName, State} |" n + "%% {ok, StateName, State, Timeout} |" n + "%% ignore |" n + "%% {stop, StopReason}" n + (erlang-skel-separator-end 2) + "init([]) ->" n> + "{ok, state_name, #state{}}." n + n + (erlang-skel-separator-start 2) + "%% @private" n + "%% @doc" n + "%% There should be one instance of this function for each possible" n + "%% state name. Whenever a gen_fsm receives an event sent using" n + "%% gen_fsm:send_event/2, the instance of this function with the same" n + "%% name as the current state name StateName is called to handle" n + "%% the event. It is also called if a timeout occurs." n + "%%" n + "%% @spec state_name(Event, State) ->" n + "%% {next_state, NextStateName, NextState} |" n + "%% {next_state, NextStateName, NextState, Timeout} |" n + "%% {stop, Reason, NewState}" n + (erlang-skel-separator-end 2) + "state_name(_Event, State) ->" n> + "{next_state, state_name, State}." n + n + (erlang-skel-separator-start 2) + "%% @private" n + "%% @doc" n + "%% There should be one instance of this function for each possible" n + "%% state name. Whenever a gen_fsm receives an event sent using" n + "%% gen_fsm:sync_send_event/[2,3], the instance of this function with" n + "%% the same name as the current state name StateName is called to" n + "%% handle the event." n + "%%" n + "%% @spec state_name(Event, From, State) ->" n + "%% {next_state, NextStateName, NextState} |"n + "%% {next_state, NextStateName, NextState, Timeout} |" n + "%% {reply, Reply, NextStateName, NextState} |" n + "%% {reply, Reply, NextStateName, NextState, Timeout} |" n + "%% {stop, Reason, NewState} |" n + "%% {stop, Reason, Reply, NewState}" n + (erlang-skel-separator-end 2) + "state_name(_Event, _From, State) ->" n> + "Reply = ok," n> + "{reply, Reply, state_name, State}." n + n + (erlang-skel-separator-start 2) + "%% @private" n + "%% @doc" n + "%% Whenever a gen_fsm receives an event sent using" n + "%% gen_fsm:send_all_state_event/2, this function is called to handle" n + "%% the event." n + "%%" n + "%% @spec handle_event(Event, StateName, State) ->" n + "%% {next_state, NextStateName, NextState} |" n + "%% {next_state, NextStateName, NextState, Timeout} |" n + "%% {stop, Reason, NewState}" n + (erlang-skel-separator-end 2) + "handle_event(_Event, StateName, State) ->" n> + "{next_state, StateName, State}." n + n + (erlang-skel-separator-start 2) + "%% @private" n + "%% @doc" n + "%% Whenever a gen_fsm receives an event sent using" n + "%% gen_fsm:sync_send_all_state_event/[2,3], this function is called" n + "%% to handle the event." n + "%%" n + "%% @spec handle_sync_event(Event, From, StateName, State) ->" n + "%% {next_state, NextStateName, NextState} |" n + "%% {next_state, NextStateName, NextState, Timeout} |" n + "%% {reply, Reply, NextStateName, NextState} |" n + "%% {reply, Reply, NextStateName, NextState, Timeout} |" n + "%% {stop, Reason, NewState} |" n + "%% {stop, Reason, Reply, NewState}" n + (erlang-skel-separator-end 2) + "handle_sync_event(_Event, _From, StateName, State) ->" n> + "Reply = ok," n> + "{reply, Reply, StateName, State}." n + n + (erlang-skel-separator-start 2) + "%% @private" n + "%% @doc" n + "%% This function is called by a gen_fsm when it receives any" n + "%% message other than a synchronous or asynchronous event" n + "%% (or a system message)." n + "%%" n + "%% @spec handle_info(Info,StateName,State)->" n + "%% {next_state, NextStateName, NextState} |" n + "%% {next_state, NextStateName, NextState, Timeout} |" n + "%% {stop, Reason, NewState}" n + (erlang-skel-separator-end 2) + "handle_info(_Info, StateName, State) ->" n> + "{next_state, StateName, State}." n + n + (erlang-skel-separator-start 2) + "%% @private" n + "%% @doc" n + "%% This function is called by a gen_fsm when it is about to" n + "%% terminate. It should be the opposite of Module:init/1 and do any" n + "%% necessary cleaning up. When it returns, the gen_fsm terminates with" n + "%% Reason. The return value is ignored." n + "%%" n + "%% @spec terminate(Reason, StateName, State) -> void()" n + (erlang-skel-separator-end 2) + "terminate(_Reason, _StateName, _State) ->" n> + "ok." n + n + (erlang-skel-separator-start 2) + "%% @private" n + "%% @doc" n + "%% Convert process state when code is changed" n + "%%" n + "%% @spec code_change(OldVsn, StateName, State, Extra) ->" n + "%% {ok, StateName, NewState}" n + (erlang-skel-separator-end 2) + "code_change(_OldVsn, StateName, State, _Extra) ->" n> + "{ok, StateName, State}." n + n + (erlang-skel-double-separator-start 3) + "%%% Internal functions" n + (erlang-skel-double-separator-end 3) + ) + "*The template of a gen_fsm. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-wx-object + '((erlang-skel-include erlang-skel-large-header) + "-behaviour(wx_object)." n n + + "-include_lib(\"wx/include/wx.hrl\")." n n + + "%% API" n + "-export([start_link/0])." n n + + "%% wx_object callbacks" n + "-export([init/1, handle_call/3, handle_cast/2, " + "handle_info/2," n> + "handle_event/2, terminate/2, code_change/3])." n n + + "-record(state, {})." n n + + (erlang-skel-double-separator-start 3) + "%%% API" n + (erlang-skel-double-separator-end 3) n + (erlang-skel-separator-start 2) + "%% @doc" n + "%% Starts the server" n + "%%" n + "%% @spec start_link() -> wxWindow()" n + (erlang-skel-separator-end 2) + "start_link() ->" n> + "wx_object:start_link(?MODULE, [], [])." n + n + (erlang-skel-double-separator-start 3) + "%%% wx_object callbacks" n + (erlang-skel-double-separator-end 3) + n + (erlang-skel-separator-start 2) + "%% @private" n + "%% @doc" n + "%% Initializes the server" n + "%%" n + "%% @spec init(Args) -> {wxWindow(), State} |" n + "%% {wxWindow(), State, Timeout} |" n + "%% ignore |" n + "%% {stop, Reason}" n + (erlang-skel-separator-end 2) + "init([]) ->" n> + "wx:new()," n> + "Frame = wxFrame:new()," n> + "{Frame, #state{}}." n + n + (erlang-skel-separator-start 2) + "%% @private" n + "%% @doc" n + "%% Handling events" n + "%%" n + "%% @spec handle_event(wx{}, State) ->" n + "%% {noreply, State} |" n + "%% {noreply, State, Timeout} |" n + "%% {stop, Reason, State}" n + (erlang-skel-separator-end 2) + "handle_event(#wx{}, State) ->" n> + "{noreply, State}." n + n + (erlang-skel-separator-start 2) + "%% @private" n + "%% @doc" n + "%% Handling call messages" n + "%%" n + "%% @spec handle_call(Request, From, State) ->" n + "%% {reply, Reply, State} |" n + "%% {reply, Reply, State, Timeout} |" n + "%% {noreply, State} |" n + "%% {noreply, State, Timeout} |" n + "%% {stop, Reason, Reply, State} |" n + "%% {stop, Reason, State}" n + (erlang-skel-separator-end 2) + "handle_call(_Request, _From, State) ->" n> + "Reply = ok," n> + "{reply, Reply, State}." n + n + (erlang-skel-separator-start 2) + "%% @private" n + "%% @doc" n + "%% Handling cast messages" n + "%%" n + "%% @spec handle_cast(Msg, State) -> {noreply, State} |" n + "%% {noreply, State, Timeout} |" n + "%% {stop, Reason, State}" n + (erlang-skel-separator-end 2) + "handle_cast(_Msg, State) ->" n> + "{noreply, State}." n + n + (erlang-skel-separator-start 2) + "%% @private" n + "%% @doc" n + "%% Handling all non call/cast messages" n + "%%" n + "%% @spec handle_info(Info, State) -> {noreply, State} |" n + "%% {noreply, State, Timeout} |" n + "%% {stop, Reason, State}" n + (erlang-skel-separator-end 2) + "handle_info(_Info, State) ->" n> + "{noreply, State}." n + n + (erlang-skel-separator-start 2) + "%% @private" n + "%% @doc" n + "%% This function is called by a wx_object when it is about to" n + "%% terminate. It should be the opposite of Module:init/1 and do any" n + "%% necessary cleaning up. When it returns, the wx_object terminates" n + "%% with Reason. The return value is ignored." n + "%%" n + "%% @spec terminate(Reason, State) -> void()" n + (erlang-skel-separator-end 2) + "terminate(_Reason, _State) ->" n> + "ok." n + n + (erlang-skel-separator-start 2) + "%% @private" n + "%% @doc" n + "%% Convert process state when code is changed" n + "%%" n + "%% @spec code_change(OldVsn, State, Extra) -> {ok, NewState}" n + (erlang-skel-separator-end 2) + "code_change(_OldVsn, State, _Extra) ->" n> + "{ok, State}." n + n + (erlang-skel-double-separator-start 3) + "%%% Internal functions" n + (erlang-skel-double-separator-end 3) + ) + "*The template of a generic server. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-lib + '((erlang-skel-include erlang-skel-large-header) + + "%% API" n + "-export([])." n n + + (erlang-skel-double-separator-start 3) + "%%% API" n + (erlang-skel-double-separator-end 3) n + (erlang-skel-separator-start 2) + "%% @doc" n + "%% @spec" n + (erlang-skel-separator-end 2) + n + (erlang-skel-double-separator-start 3) + "%%% Internal functions" n + (erlang-skel-double-separator-end 3) + ) + "*The template of a library module. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-corba-callback + '((erlang-skel-include erlang-skel-large-header) + "%% Include files" n n + + "%% API" n + "-export([])." n n + + "%% Corba callbacks" n + "-export([init/1, terminate/2, code_change/3])." n n + + "-record(state, {})." n n + + (erlang-skel-double-separator-start 3) + "%%% Corba callbacks" n + (erlang-skel-double-separator-end 3) n + (erlang-skel-separator-start 2) + "%% @private" n + "%% @doc" n + "%% Initializes the server" n + "%%" n + "%% @spec init(Args) -> {ok, State} |" n + "%% {ok, State, Timeout} |" n + "%% ignore |" n + "%% {stop, Reason}" n + (erlang-skel-separator-end 2) + "init([]) ->" n> + "{ok, #state{}}." n + n + (erlang-skel-separator-start 2) + "%% @private" n + "%% @doc" n + "%% Shutdown the server" n + "%%" n + "%% @spec terminate(Reason, State) -> void()" n + (erlang-skel-separator-end 2) + "terminate(_Reason, _State) ->" n> + "ok." n + n + (erlang-skel-separator-start 2) + "%% @private" n + "%% @doc" n + "%% Convert process state when code is changed" n + "%%" n + "%% @spec code_change(OldVsn, State, Extra) -> {ok, NewState}" n + (erlang-skel-separator-end 2) + "code_change(_OldVsn, State, _Extra) ->" n> + "{ok, State}." n + n + (erlang-skel-double-separator-start 3) + "%%% Internal functions" n + (erlang-skel-double-separator-end 3) + ) + "*The template of a library module. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-ts-test-suite + '((erlang-skel-include erlang-skel-large-header) + "%% Note: This directive should only be used in test suites." n + "-compile(export_all)." n n + + "-include_lib(\"test_server/include/test_server.hrl\")." n n + + (erlang-skel-separator-start 2) + "%% TEST SERVER CALLBACK FUNCTIONS" n + (erlang-skel-separator 2) + n + (erlang-skel-separator-start 2) + "%%" n + "%% @doc" n + "%% Initialization before the suite." n + "%%" n + "%% Config0 = Config1 = [tuple()]" n + "%% A list of key/value pairs, holding the test case configuration." n + "%% Reason = term()" n + "%% The reason for skipping the suite." n + "%%" n + "%% Note: This function is free to add any key/value pairs to the Config" n + "%% variable, but should NOT alter/remove any existing entries." n + "%%" n + "%% @spec init_per_suite(Config) -> Config" n + (erlang-skel-separator-end 2) + "init_per_suite(Config) ->" n > + "Config." n n + + (erlang-skel-separator-start 2) + "%% @doc" n + "%% Cleanup after the suite." n + "%% Config - [tuple()]" n + "%% A list of key/value pairs, holding the test case configuration." n + "%%" n + "%% @spec end_per_suite(Config) -> _" n + (erlang-skel-separator-end 2) + "end_per_suite(_Config) ->" n > + "ok." n n + + (erlang-skel-separator-start 2) + "%% @doc" n + "%% Initialization before each test case" n + "%%" n + "%% TestCase - atom()" n + "%% Name of the test case that is about to be run." n + "%% Config - [tuple()]" n + "%% A list of key/value pairs, holding the test case configuration." n + "%% Reason = term()" n + "%% The reason for skipping the test case." n + "%%" n + "%% Note: This function is free to add any key/value pairs to the Config" n + "%% variable, but should NOT alter/remove any existing entries." n + "%%" n + "%% @spec init_per_testcase(TestCase, Config) -> Config" n + (erlang-skel-separator-end 2) + "init_per_testcase(_TestCase, Config) ->" n > + "Config." n n + + (erlang-skel-separator-start 2) + "%% @doc" n + "%% Cleanup after each test case" n + "%%" n + "%% TestCase = atom()" n + "%% Name of the test case that is finished." n + "%% Config = [tuple()]" n + "%% A list of key/value pairs, holding the test case configuration." n + "%%" n + "%% @spec end_per_testcase(TestCase, Config) -> _" n + (erlang-skel-separator-end 2) + "end_per_testcase(_TestCase, _Config) ->" n > + "ok."n n + + (erlang-skel-separator-start 2) + "%% @doc" n + "%% Returns a description of the test suite when" n + "%% Clause == doc, and a test specification (list" n + "%% of the conf and test cases in the suite) when" n + "%% Clause == suite." n + "%% Returns a list of all test cases in this test suite" n + "%%" n + "%% Clause = doc | suite" n + "%% Indicates expected return value." n + "%% Descr = [string()] | []" n + "%% String that describes the test suite." n + "%% Spec = [TestCase]" n + "%% A test specification." n + "%% TestCase = ConfCase | atom()" n + "%% Configuration case, or the name of a test case function." n + "%% ConfCase = {conf,Init,Spec,End} |" n + "%% {conf,Properties,Init,Spec,End}" n + "%% Init = End = {Mod,Func} | Func" n + "%% Initialization and cleanup function." n + "%% Mod = Func = atom()" n + "%% Properties = [parallel | sequence | Shuffle | {RepeatType,N}]" n + "%% Execution properties of the test cases (may be combined)." n + "%% Shuffle = shuffle | {shuffle,Seed}" n + "%% To get cases executed in random order." n + "%% Seed = {integer(),integer(),integer()}" n + "%% RepeatType = repeat | repeat_until_all_ok | repeat_until_all_fail |" n + "%% repeat_until_any_ok | repeat_until_any_fail" n + "%% To get execution of cases repeated." n + "%% N = integer() | forever" n + "%% Reason = term()" n + "%% The reason for skipping the test suite." n + "%%" n + "%% @spec all(Clause) -> TestCases" n + (erlang-skel-separator-end 2) + "all(doc) ->" n > + "[\"Describe the main purpose of this suite\"];" n n + "all(suite) -> " n > + "[a_test_case]." n n + n + (erlang-skel-separator-start 2) + "%% TEST CASES" n + (erlang-skel-separator 2) + n + (erlang-skel-separator-start 2) + "%% @doc" n + "%% Test case function. Returns a description of the test" n + "%% case (doc), then returns a test specification (suite)," n + "%% or performs the actual test (Config)." n + "%%" n + "%% Arg = doc | suite | Config" n + "%% Indicates expected behaviour and return value." n + "%% Config = [tuple()]" n + "%% A list of key/value pairs, holding the test case configuration." n + "%% Descr = [string()] | []" n + "%% String that describes the test case." n + "%% Spec = [tuple()] | []" n + "%% A test specification, see all/1." n + "%% Reason = term()" n + "%% The reason for skipping the test case." n + "%%" n + "%% @spec TestCase(Arg) -> Descr | Spec | ok | exit() | {skip,Reason}" n + + (erlang-skel-separator-end 2) + "a_test_case(doc) -> " n > + "[\"Describe the main purpose of this test case\"];" n n + "a_test_case(suite) -> " n > + "[];" n n + "a_test_case(Config) when is_list(Config) -> " n > + "ok." n + ) + "*The template of a library module. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-ct-test-suite-s + '((erlang-skel-include erlang-skel-large-header) + "-compile(export_all)." n n + + "-include_lib(\"common_test/include/ct.hrl\")." n n + + (erlang-skel-separator-start 2) + "%% @spec suite() -> Info" n + "%% Info = [tuple()]" n + (erlang-skel-separator-end 2) + "suite() ->" n > + "[{timetrap,{seconds,30}}]." n n + + (erlang-skel-separator-start 2) + "%% @spec init_per_suite(Config0) ->" n + "%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1}" n + "%% Config0 = Config1 = [tuple()]" n + "%% Reason = term()" n + (erlang-skel-separator-end 2) + "init_per_suite(Config) ->" n > + "Config." n n + + (erlang-skel-separator-start 2) + "%% @spec end_per_suite(Config0) -> term() | {save_config,Config1}" n + "%% Config0 = Config1 = [tuple()]" n + (erlang-skel-separator-end 2) + "end_per_suite(_Config) ->" n > + "ok." n n + + (erlang-skel-separator-start 2) + "%% @spec init_per_group(GroupName, Config0) ->" n + "%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1}" n + "%% GroupName = atom()" n + "%% Config0 = Config1 = [tuple()]" n + "%% Reason = term()" n + (erlang-skel-separator-end 2) + "init_per_group(_GroupName, Config) ->" n > + "Config." n n + + (erlang-skel-separator-start 2) + "%% @spec end_per_group(GroupName, Config0) ->" n + "%% term() | {save_config,Config1}" n + "%% GroupName = atom()" n + "%% Config0 = Config1 = [tuple()]" n + (erlang-skel-separator-end 2) + "end_per_group(_GroupName, _Config) ->" n > + "ok." n n + + (erlang-skel-separator-start 2) + "%% @spec init_per_testcase(TestCase, Config0) ->" n + "%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1}" n + "%% TestCase = atom()" n + "%% Config0 = Config1 = [tuple()]" n + "%% Reason = term()" n + (erlang-skel-separator-end 2) + "init_per_testcase(_TestCase, Config) ->" n > + "Config." n n + + (erlang-skel-separator-start 2) + "%% @spec end_per_testcase(TestCase, Config0) ->" n + "%% term() | {save_config,Config1} | {fail,Reason}" n + "%% TestCase = atom()" n + "%% Config0 = Config1 = [tuple()]" n + "%% Reason = term()" n + (erlang-skel-separator-end 2) + "end_per_testcase(_TestCase, _Config) ->" n > + "ok." n n + + (erlang-skel-separator-start 2) + "%% @spec groups() -> [Group]" n + "%% Group = {GroupName,Properties,GroupsAndTestCases}" n + "%% GroupName = atom()" n + "%% Properties = [parallel | sequence | Shuffle | {RepeatType,N}]" n + "%% GroupsAndTestCases = [Group | {group,GroupName} | TestCase]" n + "%% TestCase = atom()" n + "%% Shuffle = shuffle | {shuffle,{integer(),integer(),integer()}}" n + "%% RepeatType = repeat | repeat_until_all_ok | repeat_until_all_fail |" n + "%% repeat_until_any_ok | repeat_until_any_fail" n + "%% N = integer() | forever" n + (erlang-skel-separator-end 2) + "groups() ->" n > + "[]." n n + + (erlang-skel-separator-start 2) + "%% @spec all() -> GroupsAndTestCases | {skip,Reason}" n + "%% GroupsAndTestCases = [{group,GroupName} | TestCase]" n + "%% GroupName = atom()" n + "%% TestCase = atom()" n + "%% Reason = term()" n + (erlang-skel-separator-end 2) + "all() -> " n > + "[my_test_case]." n n + + (erlang-skel-separator-start 2) + "%% @spec TestCase() -> Info" n + "%% Info = [tuple()]" n + (erlang-skel-separator-end 2) + "my_test_case() -> " n > + "[]." n n + + (erlang-skel-separator-start 2) + "%% @spec TestCase(Config0) ->" n + "%% ok | exit() | {skip,Reason} | {comment,Comment} |" n + "%% {save_config,Config1} | {skip_and_save,Reason,Config1}" n + "%% Config0 = Config1 = [tuple()]" n + "%% Reason = term()" n + "%% Comment = term()" n + (erlang-skel-separator-end 2) + "my_test_case(_Config) -> " n > + "ok." n + ) + "*The template of a library module. +Please see the function `tempo-define-template'.") + + +(defvar erlang-skel-ct-test-suite-l + '((erlang-skel-include erlang-skel-large-header) + "%% Note: This directive should only be used in test suites." n + "-compile(export_all)." n n + + "-include_lib(\"common_test/include/ct.hrl\")." n n + + (erlang-skel-separator-start 2) + "%% COMMON TEST CALLBACK FUNCTIONS" n + (erlang-skel-separator 2) + n + (erlang-skel-separator-start 2) + "%% @doc" n + "%% Returns list of tuples to set default properties" n + "%% for the suite." n + "%%" n + "%% Function: suite() -> Info" n + "%%" n + "%% Info = [tuple()]" n + "%% List of key/value pairs." n + "%%" n + "%% Note: The suite/0 function is only meant to be used to return" n + "%% default data values, not perform any other operations." n + "%%" n + "%% @spec suite() -> Info" n + (erlang-skel-separator-end 2) + "suite() ->" n > + "[{timetrap,{minutes,10}}]." n n + + (erlang-skel-separator-start 2) + "%% @doc" n + "%% Initialization before the whole suite" n + "%%" n + "%% Config0 = Config1 = [tuple()]" n + "%% A list of key/value pairs, holding the test case configuration." n + "%% Reason = term()" n + "%% The reason for skipping the suite." n + "%%" n + "%% Note: This function is free to add any key/value pairs to the Config" n + "%% variable, but should NOT alter/remove any existing entries." n + "%%" n + "%% @spec init_per_suite(Config0) ->" n + "%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1}" n + (erlang-skel-separator-end 2) + "init_per_suite(Config) ->" n > + "Config." n n + + (erlang-skel-separator-start 2) + "%% @doc" n + "%% Cleanup after the whole suite" n + "%%" n + "%% Config - [tuple()]" n + "%% A list of key/value pairs, holding the test case configuration." n + "%%" n + "%% @spec end_per_suite(Config) -> _" n + (erlang-skel-separator-end 2) + "end_per_suite(_Config) ->" n > + "ok." n n + + (erlang-skel-separator-start 2) + "%% @doc" n + "%% Initialization before each test case group." n + "%%" n + "%% GroupName = atom()" n + "%% Name of the test case group that is about to run." n + "%% Config0 = Config1 = [tuple()]" n + "%% A list of key/value pairs, holding configuration data for the group." n + "%% Reason = term()" n + "%% The reason for skipping all test cases and subgroups in the group." n + "%%" n + "%% @spec init_per_group(GroupName, Config0) ->" n + "%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1}" n + (erlang-skel-separator-end 2) + "init_per_group(_GroupName, Config) ->" n > + "Config." n n + + (erlang-skel-separator-start 2) + "%% @doc" n + "%% Cleanup after each test case group." n + "%%" n + "%% GroupName = atom()" n + "%% Name of the test case group that is finished." n + "%% Config0 = Config1 = [tuple()]" n + "%% A list of key/value pairs, holding configuration data for the group." n + "%%" n + "%% @spec end_per_group(GroupName, Config0) ->" n + "%% term() | {save_config,Config1}" n + (erlang-skel-separator-end 2) + "end_per_group(_GroupName, _Config) ->" n > + "ok." n n + (erlang-skel-separator-start 2) + "%% @doc" n + "%% Initialization before each test case" n + "%%" n + "%% TestCase - atom()" n + "%% Name of the test case that is about to be run." n + "%% Config0 = Config1 = [tuple()]" n + "%% A list of key/value pairs, holding the test case configuration." n + "%% Reason = term()" n + "%% The reason for skipping the test case." n + "%%" n + "%% Note: This function is free to add any key/value pairs to the Config" n + "%% variable, but should NOT alter/remove any existing entries." n + "%%" n + "%% @spec init_per_testcase(TestCase, Config0) ->" n + "%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1}" n + (erlang-skel-separator-end 2) + "init_per_testcase(_TestCase, Config) ->" n > + "Config." n n + + (erlang-skel-separator-start 2) + "%% @doc" n + "%% Cleanup after each test case" n + "%%" n + "%% TestCase - atom()" n + "%% Name of the test case that is finished." n + "%% Config0 = Config1 = [tuple()]" n + "%% A list of key/value pairs, holding the test case configuration." n + "%%" n + "%% @spec end_per_testcase(TestCase, Config0) ->" n + "%% term() | {save_config,Config1} | {fail,Reason}" n + (erlang-skel-separator-end 2) + "end_per_testcase(_TestCase, _Config) ->" n > + "ok." n n + + (erlang-skel-separator-start 2) + "%% @doc" n + "%% Returns a list of test case group definitions." n + "%%" n + "%% Group = {GroupName,Properties,GroupsAndTestCases}" n + "%% GroupName = atom()" n + "%% The name of the group." n + "%% Properties = [parallel | sequence | Shuffle | {RepeatType,N}]" n + "%% Group properties that may be combined." n + "%% GroupsAndTestCases = [Group | {group,GroupName} | TestCase]" n + "%% TestCase = atom()" n + "%% The name of a test case." n + "%% Shuffle = shuffle | {shuffle,Seed}" n + "%% To get cases executed in random order." n + "%% Seed = {integer(),integer(),integer()}" n + "%% RepeatType = repeat | repeat_until_all_ok | repeat_until_all_fail |" n + "%% repeat_until_any_ok | repeat_until_any_fail" n + "%% To get execution of cases repeated." n + "%% N = integer() | forever" n + "%%" n + "%% @spec: groups() -> [Group]" n + (erlang-skel-separator-end 2) + "groups() ->" n > + "[]." n n + + (erlang-skel-separator-start 2) + "%% @doc" n + "%% Returns the list of groups and test cases that" n + "%% are to be executed." n + "%%" n + "%% GroupsAndTestCases = [{group,GroupName} | TestCase]" n + "%% GroupName = atom()" n + "%% Name of a test case group." n + "%% TestCase = atom()" n + "%% Name of a test case." n + "%% Reason = term()" n + "%% The reason for skipping all groups and test cases." n + "%%" n + "%% @spec all() -> GroupsAndTestCases | {skip,Reason}" n + (erlang-skel-separator-end 2) + "all() -> " n > + "[my_test_case]." n n + + n + (erlang-skel-separator-start 2) + "%% TEST CASES" n + (erlang-skel-separator 2) + n + + (erlang-skel-separator-start 2) + "%% @doc " n + "%% Test case info function - returns list of tuples to set" n + "%% properties for the test case." n + "%%" n + "%% Info = [tuple()]" n + "%% List of key/value pairs." n + "%%" n + "%% Note: This function is only meant to be used to return a list of" n + "%% values, not perform any other operations." n + "%%" n + "%% @spec TestCase() -> Info " n + (erlang-skel-separator-end 2) + "my_test_case() -> " n > + "[]." n n + + (erlang-skel-separator 2) + "%% @doc Test case function. (The name of it must be specified in" n + "%% the all/0 list or in a test case group for the test case" n + "%% to be executed)." n + "%%" n + "%% Config0 = Config1 = [tuple()]" n + "%% A list of key/value pairs, holding the test case configuration." n + "%% Reason = term()" n + "%% The reason for skipping the test case." n + "%% Comment = term()" n + "%% A comment about the test case that will be printed in the html log." n + "%%" n + "%% @spec TestCase(Config0) ->" n + "%% ok | exit() | {skip,Reason} | {comment,Comment} |" n + "%% {save_config,Config1} | {skip_and_save,Reason,Config1}" n + (erlang-skel-separator-end 2) + "my_test_case(_Config) -> " n > + "ok." n + + ) + "*The template of a library module. + Please see the function `tempo-define-template'.") + +;; Skeleton code: + +;; This code is based on the package `tempo' which is part of modern +;; Emacsen. (GNU Emacs 19.25 (?) and XEmacs 19.14.) + +(defun erlang-skel-init () + "Generate the skeleton functions and menu items. +The variable `erlang-skel' contains the name and descriptions of +all skeletons. + +The skeleton routines are based on the `tempo' package. Should this +package not be present, this function does nothing." + (interactive) + (condition-case nil + (require 'tempo) + (error t)) + (if (featurep 'tempo) + (let ((skel erlang-skel) + (menu '())) + (while skel + (cond ((null (car skel)) + (setq menu (cons nil menu))) + (t + (funcall (symbol-function 'tempo-define-template) + (concat "erlang-" (nth 1 (car skel))) + ;; The tempo template used contains an `include' + ;; function call only, hence changes to the + ;; variables describing the templates take effect + ;; immdiately. + (list (list 'erlang-skel-include (nth 2 (car skel)))) + (nth 1 (car skel))) + (setq menu (cons (erlang-skel-make-menu-item + (car skel)) menu)))) + (setq skel (cdr skel))) + (setq erlang-menu-skel-items + (list nil (list "Skeletons" (nreverse menu)))) + (setq erlang-menu-items + (erlang-menu-add-above 'erlang-menu-skel-items + 'erlang-menu-version-items + erlang-menu-items)) + (erlang-menu-init)))) + +(defun erlang-skel-make-menu-item (skel) + (let ((func (intern (concat "tempo-template-erlang-" (nth 1 skel))))) + (cond ((null (nth 3 skel)) + (list (car skel) func)) + (t + (list (car skel) + (list 'lambda '() + '(interactive) + (list 'funcall + (list 'quote (nth 3 skel)) + (list 'quote func)))))))) + +;; Functions designed to be added to the skeleton menu. +;; (Not normally used) +(defun erlang-skel-insert (func) + "Insert skeleton generated by FUNC and goto first tempo mark." + (save-excursion (funcall func)) + (funcall (symbol-function 'tempo-forward-mark))) + +(defun erlang-skel-header (func) + "Insert the header generated by FUNC at the beginning of the buffer." + (goto-char (point-min)) + (save-excursion (funcall func)) + (funcall (symbol-function 'tempo-forward-mark))) + + +;; Functions used inside the skeleton descriptions. +(defun erlang-skel-skip-blank () + (skip-chars-backward " \t") + nil) + +(defun erlang-skel-include (&rest args) + "Include a template inside another template. + +Example of use, assuming that `erlang-skel-func' is defined: + + (defvar foo-skeleton '(\"%%% New function:\" + (erlang-skel-include erlang-skel-func))) + +Technically, this function returns the `tempo' attribute`(l ...)' which +can contain other `tempo' attributes. Please see the function +`tempo-define-template' for a description of the `(l ...)' attribute." + (let ((res '()) + entry) + (while args + (setq entry (car args)) + (while entry + (setq res (cons (car entry) res)) + (setq entry (cdr entry))) + (setq args (cdr args))) + (cons 'l (nreverse res)))) + +(defun erlang-skel-separator (&optional percent) + "Return a comment separator." + (let ((percent (or percent 3))) + (concat (make-string percent ?%) + (make-string (- 70 percent) ?-) + "\n"))) + +(defun erlang-skel-separator-start (&optional percent) + "Return a comment separator or an empty string if separators +are configured off." + (if erlang-skel-use-separators + (erlang-skel-separator percent) + "")) + +(defun erlang-skel-separator-end (&optional percent) + "Return a comment separator to end a function comment block or an +empty string if separators are configured off." + (if erlang-skel-use-separators + (concat "%% @end\n" (erlang-skel-separator percent)) + "")) + +(defun erlang-skel-double-separator (&optional percent) + "Return a double line (equals sign) comment separator." + (let ((percent (or percent 3))) + (concat (make-string percent ?%) + (make-string (- 70 percent) ?=) + "\n"))) + +(defun erlang-skel-double-separator-start (&optional percent) + "Return a double separator or a newline if separators are configured off." + (if erlang-skel-use-separators + (erlang-skel-double-separator percent) + "\n")) + +(defun erlang-skel-double-separator-end (&optional percent) + "Return a double separator or an empty string if separators are +configured off." + (if erlang-skel-use-separators + (erlang-skel-double-separator percent) + "")) + +(defun erlang-skel-dd-mmm-yyyy () + "Return the current date as a string in \"DD Mon YYYY\" form. +The first character of DD is space if the value is less than 10." + (let ((date (current-time-string))) + (format "%2d %s %s" + (string-to-int (substring date 8 10)) + (substring date 4 7) + (substring date -4)))) + +(defun erlang-skel-get-function-name () + (save-excursion + (erlang-beginning-of-function -1) + (erlang-get-function-name))) + +(defun erlang-skel-get-function-args () + (save-excursion + (erlang-beginning-of-function -1) + (erlang-get-function-arguments))) + +;; Local variables: +;; coding: iso-8859-1 +;; End: + +;;; erlang-skels.el ends here diff --git a/elpa/erlang-20151013.157/erlang-start.el b/elpa/erlang-20151013.157/erlang-start.el new file mode 100644 index 0000000..76e0575 --- /dev/null +++ b/elpa/erlang-20151013.157/erlang-start.el @@ -0,0 +1,124 @@ +;; erlang-start.el --- Load this file to initialize the Erlang package. + +;; Copyright (C) 1998 Ericsson Telecom AB + +;; Author: Anders Lindgren +;; Version: 2.3 +;; Keywords: erlang, languages, processes +;; Created: 1996-09-18 +;; Date: 1998-03-16 + +;;; Commentary: + +;; Introduction: +;; ------------ +;; +;; This package provides support for the programming language Erlang. +;; The package provides an editing mode with lots of bells and +;; whistles, compilation support, and it makes it possible for the +;; user to start Erlang shells that run inside Emacs. +;; +;; See the Erlang distribution for full documentation of this package. + +;; Installation: +;; ------------ +;; +;; Place this file in Emacs load path, byte-compile it, and add the +;; following line to the appropriate init file: +;; +;; (require 'erlang-start) +;; +;; The full documentation contains much more extensive description of +;; the installation procedure. + +;; Reporting Bugs: +;; -------------- +;; +;; Please send bug reports to the following email address: +;; support@erlang.ericsson.se +;; +;; Please state as exactly as possible: +;; - Version number of Erlang Mode (see the menu), Emacs, Erlang, +;; and of any other relevant software. +;; - What the expected result was. +;; - What you did, preferably in a repeatable step-by-step form. +;; - A description of the unexpected result. +;; - Relevant pieces of Erlang code causing the problem. +;; - Personal Emacs customisations, if any. +;; +;; Should the Emacs generate an error, please set the emacs variable +;; `debug-on-error' to `t'. Repeat the error and enclose the debug +;; information in your bug-report. +;; +;; To set the variable you can use the following command: +;; M-x set-variable RET debug-on-error RET t RET + +;;; Code: + +;; +;; Declare functions in "erlang.el". +;; + +(autoload 'erlang-mode "erlang" "Major mode for editing Erlang code." t) +(autoload 'erlang-version "erlang" + "Return the current version of Erlang mode." t) +(autoload 'erlang-shell "erlang" "Start a new Erlang shell." t) +(autoload 'run-erlang "erlang" "Start a new Erlang shell." t) + +(autoload 'erlang-compile "erlang" + "Compile Erlang module in current buffer." t) + +(autoload 'erlang-man-module "erlang" + "Find manual page for MODULE." t) +(autoload 'erlang-man-function "erlang" + "Find manual page for NAME, where NAME is module:function." t) + +(autoload 'erlang-find-tag "erlang" + "Like `find-tag'. Capable of retreiving Erlang modules.") +(autoload 'erlang-find-tag-other-window "erlang" + "Like `find-tag-other-window'. Capable of retreiving Erlang modules.") + + +;; +;; Associate files extensions ".erl" and ".hrl" with Erlang mode. +;; + +;;;###autoload +(let ((a '("\\.erl\\'" . erlang-mode)) + (b '("\\.hrl\\'" . erlang-mode))) + (or (assoc (car a) auto-mode-alist) + (setq auto-mode-alist (cons a auto-mode-alist))) + (or (assoc (car b) auto-mode-alist) + (setq auto-mode-alist (cons b auto-mode-alist)))) + +;; +;; Associate files using interpreter "escript" with Erlang mode. +;; + +;;;###autoload +(add-to-list 'interpreter-mode-alist (cons "escript" 'erlang-mode)) + +;; +;; Ignore files ending in ".jam", ".vee", and ".beam" when performing +;; file completion. +;; + +;;;###autoload +(let ((erl-ext '(".jam" ".vee" ".beam"))) + (while erl-ext + (let ((cie completion-ignored-extensions)) + (while (and cie (not (string-equal (car cie) (car erl-ext)))) + (setq cie (cdr cie))) + (if (null cie) + (setq completion-ignored-extensions + (cons (car erl-ext) completion-ignored-extensions)))) + (setq erl-ext (cdr erl-ext)))) + + +;; +;; The end. +;; + +(provide 'erlang-start) + +;; erlang-start.el ends here. diff --git a/elpa/erlang-2.4.1/erlang.el b/elpa/erlang-20151013.157/erlang.el similarity index 62% rename from elpa/erlang-2.4.1/erlang.el rename to elpa/erlang-20151013.157/erlang.el index 7c5d37b..466bf13 100644 --- a/elpa/erlang-2.4.1/erlang.el +++ b/elpa/erlang-20151013.157/erlang.el @@ -1,19 +1,32 @@ ;;; erlang.el --- Major modes for editing and running Erlang -;; Copyright (C) 1995-1998,2000 Ericsson Telecom AB - +;; Copyright (C) 2004 Free Software Foundation, Inc. ;; Author: Anders Lindgren -;; Version: 2.4.1 ;; Keywords: erlang, languages, processes -;; Date: 2000-09-11 +;; Date: 2011-12-11 -;; Lars Thorsýn's modifications of 2000-06-07 included. - +;; %CopyrightBegin% +;; +;; Copyright Ericsson AB 1996-2014. All Rights Reserved. +;; +;; Licensed under the Apache License, Version 2.0 (the "License"); +;; you may not use this file except in compliance with the License. +;; You may obtain a copy of the License at +;; +;; http://www.apache.org/licenses/LICENSE-2.0 +;; +;; Unless required by applicable law or agreed to in writing, software +;; distributed under the License is distributed on an "AS IS" BASIS, +;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +;; See the License for the specific language governing permissions and +;; limitations under the License. +;; +;; %CopyrightEnd% +;; + +;; Lars Thorsén's modifications of 2000-06-07 included. ;; The original version of this package was written by Robert Virding. ;; -;; Most skeletons has been written at Ericsson Telecom by -;; magnus@erix.ericsson.se and janne@erix.ericsson.se - ;;; Commentary: ;; Introduction: @@ -41,8 +54,9 @@ ;; -------------- ;; ;; Please send bug reports to the following email address: -;; support@erlang.ericsson.se -;; +;; erlang-bugs@erlang.org +;; or if you have a patch suggestion to: +;; erlang-patches@erlang.org ;; Please state as exactly as possible: ;; - Version number of Erlang Mode (see the menu), Emacs, Erlang, ;; and of any other relevant software. @@ -52,27 +66,58 @@ ;; - Relevant pieces of Erlang code causing the problem. ;; - Personal Emacs customisations, if any. ;; -;; Should the Emacs generate an error, please set the emacs variable +;; Should the Emacs generate an error, please set the Emacs variable ;; `debug-on-error' to `t'. Repeat the error and enclose the debug ;; information in your bug-report. ;; ;; To set the variable you can use the following command: ;; M-x set-variable RET debug-on-error RET t RET - ;;; Code: +(eval-when-compile (require 'cl)) + ;; Variables: -(defconst erlang-version "2.4.1" +(defconst erlang-version "2.7" "The version number of Erlang mode.") (defvar erlang-root-dir nil "The directory where the Erlang system is installed. -The name should not contain the ending slash. +The name should not contain the trailing slash. Should this variable be nil, no manual pages will show up in the Erlang mode menu.") +(eval-and-compile + (defconst erlang-emacs-major-version + (if (boundp 'emacs-major-version) + emacs-major-version + (string-match "\\([0-9]+\\)\\.\\([0-9]+\\)" emacs-version) + (erlang-string-to-int (substring emacs-version + (match-beginning 1) (match-end 1)))) + "Major version number of Emacs.")) + +(eval-and-compile + (defconst erlang-emacs-minor-version + (if (boundp 'emacs-minor-version) + emacs-minor-version + (string-match "\\([0-9]+\\)\\.\\([0-9]+\\)" emacs-version) + (erlang-string-to-int (substring emacs-version + (match-beginning 2) (match-end 2)))) + "Minor version number of Emacs.")) + +(defconst erlang-xemacs-p (string-match "Lucid\\|XEmacs" emacs-version) + "Non-nil when running under XEmacs or Lucid Emacs.") + +(defvar erlang-xemacs-popup-menu '("Erlang Mode Commands" . nil) + "Common popup menu for all buffers in Erlang mode. + +This variable is destructively modified every time the Erlang menu +is modified. The effect is that all changes take effect in all +buffers in Erlang mode, just like under GNU Emacs. + +Never EVER set this variable!") + (defvar erlang-menu-items '(erlang-menu-base-items erlang-menu-skel-items erlang-menu-shell-items @@ -80,10 +125,10 @@ Erlang mode menu.") erlang-menu-man-items erlang-menu-personal-items erlang-menu-version-items) - "*List of menu item list to combine to create Erland mode menu. + "*List of menu item list to combine to create Erlang mode menu. -External programs which temporary adds menu items to the Erland mode -menu use this variable. Please use the function `add-hook' to add +External programs which temporarily add menu items to the Erlang mode +menu may use this variable. Please use the function `add-hook' to add items. Please call the function `erlang-menu-init' after every change to this @@ -113,9 +158,12 @@ variable.") ("Mark Clause" erlang-mark-clause) nil ("New Clause" erlang-generate-new-clause) - ("Clone Arguments" erlang-clone-arguments))) + ("Clone Arguments" erlang-clone-arguments) + nil + ("Align Arrows" erlang-align-arrows))) ("Syntax Highlighting" - (("Level 3" erlang-font-lock-level-3) + (("Level 4" erlang-font-lock-level-4) + ("Level 3" erlang-font-lock-level-3) ("Level 2" erlang-font-lock-level-2) ("Level 1" erlang-font-lock-level-1) ("Off" erlang-font-lock-level-0))) @@ -126,10 +174,10 @@ variable.") ("Complete Word" erlang-complete-tag) ("Tags Apropos" tags-apropos) ("Search Files" tags-search)))) - "*Description of menu used in Erlang mode. + "Description of menu used in Erlang mode. -This variable must be a list. The elements are either nil representing -a horisontal line or a list with two or three elements. The first is +This variable must be a list. The elements are either nil representing +a horizontal line or a list with two or three elements. The first is the name of the menu item, the second is the function to call, or a submenu, on the same same form as ITEMS. The third optional argument is an expression which is evaluated every time the menu is displayed. @@ -141,7 +189,7 @@ Example: ((\"Yellow\" function-yellow) (\"Blue\" function-blue))) nil - (\"Region Funtion\" spook-function midnight-variable)) + (\"Region Function\" spook-function midnight-variable)) Call the function `erlang-menu-init' after modifying this variable.") @@ -150,7 +198,7 @@ Call the function `erlang-menu-init' after modifying this variable.") ("Shell" (("Start New Shell" erlang-shell) ("Display Shell" erlang-shell-display)))) - "*Description of the Shell menu used by Erlang mode. + "Description of the Shell menu used by Erlang mode. Please see the documentation of `erlang-menu-base-items'.") @@ -159,17 +207,17 @@ Please see the documentation of `erlang-menu-base-items'.") (("Compile Buffer" erlang-compile) ("Display Result" erlang-compile-display) ("Next Error" erlang-next-error)))) - "*Description of the Compile menu used by Erlang mode. + "Description of the Compile menu used by Erlang mode. Please see the documentation of `erlang-menu-base-items'.") (defvar erlang-menu-version-items '(nil ("Version" erlang-version)) - "*Description of the version menu used in Erlang mode.") + "Description of the version menu used in Erlang mode.") (defvar erlang-menu-personal-items nil - "*Description of personal menu items used in Erlang mode. + "Description of personal menu items used in Erlang mode. Please see the variable `erlang-menu-base-items' for a description of the format.") @@ -193,8 +241,8 @@ normally used by the user to personalise the programming environment. When used in a site init file, it could be used to customise Erlang mode for all users on the system. -The functions added to this hook is runed every time Erlang mode is -started. See also `erlang-load-hook', a hook which is runed once, +The functions added to this hook are run every time Erlang mode is +started. See also `erlang-load-hook', a hook which is run once, when Erlang mode is loaded into Emacs, and `erlang-shell-mode-hook' which is run every time a new inferior Erlang shell is started. @@ -235,11 +283,11 @@ the first time. Natural actions for the functions added to this hook are actions which only should be performed once, and actions which should be performed before starting Erlang mode. For example, a number of variables are -used by Erlang mode before `erlang-mode-hook' is runed. +used by Erlang mode before `erlang-mode-hook' is run. The following example sets the variable `erlang-root-dir' so that the manual pages can be retrieved (note that you must set the value of -`erlang-root-dir' to match the loation of Erlang on your system): +`erlang-root-dir' to match the location of Erlang on your system): (add-hook 'erlang-load-hook 'my-erlang-load-hook) @@ -250,7 +298,7 @@ manual pages can be retrieved (note that you must set the value of "Functions to run when a new Erlang source file is being edited. A useful function is `tempo-template-erlang-normal-header'. -\(This function only exists when the `tempo' packags is available.)") +\(This function only exists when the `tempo' package is available.)") (defvar erlang-check-module-name 'ask "*Non-nil means check that module name and file name agrees when saving. @@ -266,10 +314,10 @@ prompted. If the value is t the source is silently changed.") The list should contain the electric commands which should be active. Currently, the available electric commands are: - erlang-electric-comma - erlang-electric-semicolon - erlang-electric-gt - erlang-electric-newline + `erlang-electric-comma' + `erlang-electric-semicolon' + `erlang-electric-gt' + `erlang-electric-newline' Should the variable be bound to t, all electric commands are activated. @@ -293,7 +341,7 @@ inhibited.") '(erlang-electric-semicolon erlang-electric-comma erlang-electric-gt) - "*Command which can inhibit the next newline.") + "*Commands which can inhibit the next newline.") (defvar erlang-electric-semicolon-insert-blank-lines nil "*Number of blank lines inserted before header, or nil. @@ -327,6 +375,7 @@ The test is performed by the function `erlang-test-criteria-list'.") erlang-stop-when-at-guard erlang-next-lines-empty-p erlang-at-keyword-end-p + erlang-at-end-of-clause-p erlang-at-end-of-function-p) "*List of functions controlling `erlang-electric-comma'. The functions in this list are called, in order, whenever a comma @@ -343,7 +392,8 @@ then no prototype is inserted. The test is performed by the function `erlang-test-criteria-list'.") (defvar erlang-electric-arrow-criteria - '(erlang-next-lines-empty-p + '(erlang-stop-when-in-type-spec + erlang-next-lines-empty-p erlang-at-end-of-function-p) "*List of functions controlling the arrow aspect of `erlang-electric-gt'. The functions in this list are called, in order, whenever a `>' @@ -397,7 +447,7 @@ Setting this variable to zero, electric commands will always be triggered by `erlang-next-lines-empty-p', unless inhibited by other rules. -Should this variable be `nil', `erlang-next-lines-empty-p' will never +Should this variable be nil, `erlang-next-lines-empty-p' will never trigger an electric command. The same effect would be reached if the function `erlang-next-lines-empty-p' would be removed from the criteria lists. @@ -423,33 +473,33 @@ To activate the workaround, place the following in your `~/.emacs' file: (defvar erlang-indent-level 4 "*Indentation of Erlang calls/clauses within blocks.") +(put 'erlang-indent-level 'safe-local-variable 'integerp) (defvar erlang-indent-guard 2 "*Indentation of Erlang guards.") +(put 'erlang-indent-guard 'safe-local-variable 'integerp) (defvar erlang-argument-indent 2 "*Indentation of the first argument in a function call. When nil, indent to the column after the `(' of the function.") +(put 'erlang-argument-indent 'safe-local-variable '(lambda (val) (or (null val) (integerp val)))) (defvar erlang-tab-always-indent t - "*Non-nil means TAB in Erlang mode should always reindent the current line, + "*Non-nil means TAB in Erlang mode should always re-indent the current line, regardless of where in the line point is when the TAB command is used.") -(defvar erlang-error-regexp-alist - '(("^\\([^:( \t\n]+\\)[:(][ \t]*\\([0-9]+\\)[:) \t]" . (1 2))) - "*Patterns for matching Erlang errors.") - (defvar erlang-man-inhibit (eq system-type 'windows-nt) "Inhibit the creation of the Erlang Manual Pages menu. The Windows distribution of Erlang does not include man pages, hence -there is no idea to create the menu.") +there is no attempt to create the menu.") (defvar erlang-man-dirs '(("Man - Commands" "/man/man1" t) ("Man - Modules" "/man/man3" t) - ("Man - Unsupported" "/uc/man/man3" t)) + ("Man - Files" "/man/man4" t) + ("Man - Applications" "/man/man6" t)) "*The man directories displayed in the Erlang menu. Each item in the list should be a list with three elements, the first @@ -457,7 +507,7 @@ the name of the menu, the second the directory, and the last a flag. Should the flag the nil, the directory is absolute, should it be non-nil the directory is relative to the variable `erlang-root-dir'.") -(defvar erlang-man-max-menu-size 20 +(defvar erlang-man-max-menu-size 35 "*The maximum number of menu items in one menu allowed.") (defvar erlang-man-display-function 'erlang-man-display @@ -465,33 +515,463 @@ the directory is relative to the variable `erlang-root-dir'.") The function is called with one argument, the name of the file containing the man page. Use this variable when the default -function, erlang-man-display, does not work on your system.") +function, `erlang-man-display', does not work on your system.") -(defconst erlang-atom-regexp "\\([a-z][a-zA-Z0-9_]*\\|'[^\n']*[^\\]'\\)" - "Regexp which should match an Erlang atom. +(defvar erlang-compile-extra-opts '() + "*Additional options to the compilation command. +This is an elisp list of options. Each option can be either: +- an atom +- a dotted pair +- a string +Example: '(bin_opt_info (i . \"/path1/include\") (i . \"/path2/include\"))") -The regexp must be surrounded with a pair of regexp parentheses.") -(defconst erlang-atom-regexp-matches 1 - "Number of regexp parenthesis pairs in `erlang-atom-regexp'. +(defvar erlang-compile-command-function-alist + '((".erl\\'" . inferior-erlang-compute-erl-compile-command) + (".xrl\\'" . inferior-erlang-compute-leex-compile-command) + (".yrl\\'" . inferior-erlang-compute-yecc-compile-command) + ("." . inferior-erlang-compute-erl-compile-command)) + "*Alist of filename patterns vs corresponding compilation functions. +Each element looks like (REGEXP . FUNCTION). Compiling a file whose name +matches REGEXP specifies FUNCTION to use to compute the compilation +command. The FUNCTION will be called with two arguments: module name and +default compilation options, like output directory. The FUNCTION +is expected to return a string.") +(defvar erlang-leex-compile-opts '() + "*Options to pass to leex when compiling xrl files. +This is an elisp list of options. Each option can be either: +- an atom +- a dotted pair +- a string") + +(defvar erlang-yecc-compile-opts '() + "*Options to pass to yecc when compiling yrl files. +This is an elisp list of options. Each option can be either: +- an atom +- a dotted pair +- a string") + +(eval-and-compile + (defvar erlang-regexp-modern-p + (if (> erlang-emacs-major-version 21) t nil) + "Non-nil when this version of Emacs uses a modern version of regexp. +Supporting \_< and \_> This is determined by checking the version of Emacs used.")) + +(eval-and-compile + (defconst erlang-atom-quoted-regexp + "'\\(?:[^\\']\\|\\(?:\\\\.\\)\\)*'" + "Regexp describing a single-quoted atom")) + +(eval-and-compile + (defconst erlang-atom-regular-regexp + (if erlang-regexp-modern-p + "\\_<[[:lower:]]\\(?:\\sw\\|\\s_\\)*\\_>" + "\\<[[:lower:]]\\(?:\\sw\\|\\s_\\)*\\>") + "Regexp describing a regular (non-quoted) atom")) + +(eval-and-compile + (defconst erlang-atom-regexp + (concat "\\(" erlang-atom-quoted-regexp "\\|" + erlang-atom-regular-regexp "\\)") + "Regexp describing an Erlang atom.")) + +(eval-and-compile + (defconst erlang-atom-regexp-matches 1 + "Number of regexp parenthesis pairs in `erlang-atom-regexp'. + This is used to determine parenthesis matches in complex regexps which -contains `erlang-atom-regexp'.") +contains `erlang-atom-regexp'.")) -(defconst erlang-variable-regexp "\\([A-Z_][a-zA-Z0-9_]*\\)" - "Regexp which should match an Erlang variable. -The regexp must be surrounded with a pair of regexp parenthesis.") -(defconst erlang-variable-regexp-matches 1 - "Number of regexp parenthesis pairs in `erlang-variable-regexp'. +(eval-and-compile + (defconst erlang-variable-regexp + (if erlang-regexp-modern-p + "\\_<\\([[:upper:]_]\\(?:\\sw\\|\\s_\\)*\\)\\_>" + "\\<\\([[:upper:]_]\\(?:\\sw\\|\\s_\\)*\\)\\>") + "Regexp which should match an Erlang variable. + +The regexp must be surrounded with a pair of regexp parentheses.")) + +(eval-and-compile + (defconst erlang-variable-regexp-matches 1 + "Number of regexp parenthesis pairs in `erlang-variable-regexp'. + +This is used to determine matches in complex regexps which contains +`erlang-variable-regexp'.")) + + +(eval-and-compile + (defun erlang-regexp-opt (strings &optional paren) + "Like `regexp-opt', except if PAREN is `symbols', then the +resulting regexp is surrounded by \\_< and \\_>." + (if (eq paren 'symbols) + (if erlang-regexp-modern-p + (concat "\\_<" (regexp-opt strings t) "\\_>") + (concat "\\<" (regexp-opt strings t) "\\>")) + (regexp-opt strings paren)))) + + +(eval-and-compile + (defvar erlang-keywords + '("after" + "begin" + "catch" + "case" + "cond" + "end" + "fun" + "if" + "let" + "of" + "receive" + "try" + "when") + "Erlang reserved keywords")) + +(eval-and-compile + (defconst erlang-keywords-regexp (erlang-regexp-opt erlang-keywords 'symbols))) + +(eval-and-compile + (defvar erlang-operators + '("and" + "andalso" + "band" + "bnot" + "bor" + "bsl" + "bsr" + "bxor" + "div" + "not" + "or" + "orelse" + "rem" + "xor") + "Erlang operators")) +;; What about these? +;; '+' '-' '*' '/' '>', '>=', '<', '=<', '=:=', '==', '=/=', '/=' + +(eval-and-compile + (defconst erlang-operators-regexp (erlang-regexp-opt erlang-operators 'symbols))) + + +(eval-and-compile + (defvar erlang-guards + '("is_atom" + "is_binary" + "is_bitstring" + "is_boolean" + "is_float" + "is_function" + "is_integer" + "is_list" + "is_map" + "is_number" + "is_pid" + "is_port" + "is_record" + "is_reference" + "is_tuple" + "atom" + "binary" + "bitstring" + "boolean" + ;;"float" ; Not included to avoid clashes with the bif float/1 + "function" + "integer" + "list" + "number" + "pid" + "port" + "record" + "reference" + "tuple") + "Erlang guards")) + +(eval-and-compile + (defconst erlang-guards-regexp (erlang-regexp-opt erlang-guards 'symbols))) + +(eval-and-compile + (defvar erlang-predefined-types + '("any" + "arity" + "boolean" + "byte" + "char" + "cons" + "deep_string" + "iodata" + "iolist" + "maybe_improper_list" + "module" + "mfa" + "nil" + "neg_integer" + "none" + "non_neg_integer" + "nonempty_list" + "nonempty_improper_list" + "nonempty_maybe_improper_list" + "nonempty_string" + "no_return" + "pos_integer" + "string" + "term" + "timeout" + "map") + "Erlang type specs types")) + +(eval-and-compile + (defconst erlang-predefined-types-regexp + (erlang-regexp-opt erlang-predefined-types 'symbols))) + + +(eval-and-compile + (defvar erlang-int-bifs + '("abs" + "apply" + "atom_to_binary" + "atom_to_list" + "binary_to_atom" + "binary_to_existing_atom" + "binary_to_float" + "binary_to_integer" + "binary_to_list" + "binary_to_term" + "binary_part" + "bit_size" + "bitsize" + "bitstring_to_list" + "byte_size" + "check_old_code" + "check_process_code" + "date" + "delete_module" + "demonitor" + "disconnect_node" + "element" + "erase" + "error" + "exit" + "float" + "float_to_binary" + "float_to_list" + "garbage_collect" + "get" + "get_keys" + "group_leader" + "halt" + "hd" + "integer_to_list" + "integer_to_binary" + "iolist_size" + "iolist_to_binary" + "is_alive" + "is_atom" + "is_binary" + "is_bitstring" + "is_boolean" + "is_float" + "is_function" + "is_integer" + "is_list" + "is_map" + "is_number" + "is_pid" + "is_port" + "is_process_alive" + "is_record" + "is_reference" + "is_tuple" + "length" + "link" + "list_to_atom" + "list_to_binary" + "list_to_bitstring" + "list_to_existing_atom" + "list_to_float" + "list_to_integer" + "list_to_pid" + "list_to_tuple" + "load_module" + "make_ref" + "map_size" + "max" + "min" + "module_loaded" + "monitor" + "monitor_node" + "node" + "nodes" + "now" + "open_port" + "pid_to_list" + "port_close" + "port_command" + "port_connect" + "port_control" + "pre_loaded" + "process_flag" + "process_info" + "processes" + "purge_module" + "put" + "register" + "registered" + "round" + "self" + "setelement" + "size" + "spawn" + "spawn_link" + "spawn_monitor" + "spawn_opt" + "split_binary" + "statistics" + "term_to_binary" + "time" + "throw" + "tl" + "trunc" + "tuple_size" + "tuple_to_list" + "unlink" + "unregister" + "whereis") + "Erlang built-in functions (BIFs)")) + +(eval-and-compile + (defconst erlang-int-bif-regexp (erlang-regexp-opt erlang-int-bifs 'symbols))) + + +(eval-and-compile + (defvar erlang-ext-bifs + '("adler32" + "adler32_combine" + "alloc_info" + "alloc_sizes" + "append" + "append_element" + "await_proc_exit" + "await_sched_wall_time_modifications" + "bump_reductions" + "call_on_load_function" + "cancel_timer" + "crasher" + "crc32" + "crc32_combine" + "decode_packet" + "delay_trap" + "delete_element" + "dexit" + "dgroup_leader" + "display" + "display_nl" + "display_string" + "dist_exit" + "dlink" + "dmonitor_node" + "dmonitor_p" + "dsend" + "dt_append_vm_tag_data" + "dt_get_tag" + "dt_get_tag_data" + "dt_prepend_vm_tag_data" + "dt_put_tag" + "dt_restore_tag" + "dt_spread_tag" + "dunlink" + "convert_time_unit" + "external_size" + "finish_after_on_load" + "finish_loading" + "format_cpu_topology" + "fun_info" + "fun_info_mfa" + "fun_to_list" + "function_exported" + "garbage_collect_message_area" + "gather_gc_info_result" + "gather_sched_wall_time_result" + "get_cookie" + "get_module_info" + "get_stacktrace" + "hash" + "hibernate" + "insert_element" + "is_builtin" + "load_nif" + "loaded" + "localtime" + "localtime_to_universaltime" + "make_fun" + "make_tuple" + "match_spec_test" + "md5" + "md5_final" + "md5_init" + "md5_update" + "memory" + "module_info" + "monitor_node" + "monotonic_time" + "nif_error" + "phash" + "phash2" + "port_call" + "port_get_data" + "port_info" + "port_set_data" + "port_to_list" + "ports" + "posixtime_to_universaltime" + "prepare_loading" + "process_display" + "raise" + "read_timer" + "ref_to_list" + "resume_process" + "send" + "send_after" + "send_nosuspend" + "seq_trace" + "seq_trace_info" + "seq_trace_print" + "set_cookie" + "set_cpu_topology" + "setnode" + "spawn_opt" + "start_timer" + "subtract" + "suspend_process" + "system_flag" + "system_info" + "system_monitor" + "system_profile" + "system_time" + "trace" + "trace_delivered" + "trace_info" + "trace_pattern" + "time_offset" + "timestamp" + "universaltime" + "universaltime_to_localtime" + "universaltime_to_posixtime" + "unique_integer" + "yield") + "Erlang built-in functions (BIFs) that needs erlang: prefix")) + +(eval-and-compile + (defconst erlang-ext-bif-regexp + (erlang-regexp-opt (append erlang-int-bifs erlang-ext-bifs) 'symbols))) -This is used to determine matches in complex rexeps which contains -`erlang-variable-regexp'.") (defvar erlang-defun-prompt-regexp (concat "^" erlang-atom-regexp "\\s *(") - "*Regexp which should match beginning of a clause.") + "Regexp which should match beginning of a clause.") (defvar erlang-file-name-extension-regexp "\\.[eh]rl$" - "*Regexp which should match an erlang file name. + "*Regexp which should match an Erlang file name. This regexp is used when an Erlang module name is extracted from the name of an Erlang source file. @@ -501,1036 +981,244 @@ be excluded from the module name. To match all files set this variable to \"\\\\(\\\\..*\\\\|\\\\)$\". The matches all except the extension. This is useful if the Erlang -tags system should interpretate tags on the form `module:tag' for +tags system should interpret tags on the form `module:tag' for files written in other languages than Erlang.") -(defvar erlang-mode-map nil +(defvar erlang-inferior-shell-split-window t + "*If non-nil, when starting an inferior shell, split windows. +If nil, the inferior shell replaces the window. This is the traditional +behaviour.") + +(defconst inferior-erlang-use-cmm (boundp 'minor-mode-overriding-map-alist) + "Non-nil means use `compilation-minor-mode' in Erlang shell.") + +(defvar erlang-mode-map + (let ((map (make-sparse-keymap))) + (unless (boundp 'indent-line-function) + (define-key map "\t" 'erlang-indent-command)) + (define-key map ";" 'erlang-electric-semicolon) + (define-key map "," 'erlang-electric-comma) + (define-key map "<" 'erlang-electric-lt) + (define-key map ">" 'erlang-electric-gt) + (define-key map "\C-m" 'erlang-electric-newline) + (if (not (boundp 'delete-key-deletes-forward)) + (define-key map "\177" 'backward-delete-char-untabify) + (define-key map [(backspace)] 'backward-delete-char-untabify)) + ;;(unless (boundp 'fill-paragraph-function) + (define-key map "\M-q" 'erlang-fill-paragraph) + (unless (boundp 'beginning-of-defun-function) + (define-key map "\M-\C-a" 'erlang-beginning-of-function) + (define-key map "\M-\C-e" 'erlang-end-of-function) + (define-key map '(meta control h) 'erlang-mark-function)) ; Xemacs + (define-key map "\M-\t" 'erlang-complete-tag) + (define-key map "\C-c\M-\t" 'tempo-complete-tag) + (define-key map "\M-+" 'erlang-find-next-tag) + (define-key map "\C-c\M-a" 'erlang-beginning-of-clause) + (define-key map "\C-c\M-b" 'tempo-backward-mark) + (define-key map "\C-c\M-e" 'erlang-end-of-clause) + (define-key map "\C-c\M-f" 'tempo-forward-mark) + (define-key map "\C-c\M-h" 'erlang-mark-clause) + (define-key map "\C-c\C-c" 'comment-region) + (define-key map "\C-c\C-j" 'erlang-generate-new-clause) + (define-key map "\C-c\C-k" 'erlang-compile) + (define-key map "\C-c\C-l" 'erlang-compile-display) + (define-key map "\C-c\C-s" 'erlang-show-syntactic-information) + (define-key map "\C-c\C-q" 'erlang-indent-function) + (define-key map "\C-c\C-u" 'erlang-uncomment-region) + (define-key map "\C-c\C-y" 'erlang-clone-arguments) + (define-key map "\C-c\C-a" 'erlang-align-arrows) + (define-key map "\C-c\C-z" 'erlang-shell-display) + (unless inferior-erlang-use-cmm + (define-key map "\C-x`" 'erlang-next-error)) + map) "*Keymap used in Erlang mode.") (defvar erlang-mode-abbrev-table nil "Abbrev table in use in Erlang-mode buffers.") (defvar erlang-mode-syntax-table nil "Syntax table in use in Erlang-mode buffers.") -(defconst erlang-emacs-major-version - (if (boundp 'emacs-major-version) - emacs-major-version - (string-match "\\([0-9]+\\)\\.\\([0-9]+\\)" emacs-version) - (string-to-int (substring emacs-version - (match-beginning 1) (match-end 1)))) - "Major version number of Emacs.") -(defconst erlang-emacs-minor-version - (if (boundp 'emacs-minor-version) - emacs-minor-version - (string-match "\\([0-9]+\\)\\.\\([0-9]+\\)" emacs-version) - (string-to-int (substring emacs-version - (match-beginning 2) (match-end 2)))) - "Minor version number of Emacs.") -(defconst erlang-xemacs-p (string-match "Lucid\\|XEmacs" emacs-version) - "Non-nil when running under XEmacs or Lucid Emacs.") +(defvar erlang-skel-file "erlang-skels" + "The type of erlang-skeletons that should be used, default + uses edoc type, for the old type, standard comments, + set \"erlang-skels-old\" in your .emacs and restart. -(defvar erlang-xemacs-popup-menu '("Erlang Mode Commands" . nil) - "Common popup menu for all buffers in Erlang mode. + Or define your own and set the variable to that file.") -This variable is destructively modified every time the Erlang menu -is modified. The effect is that all changes take effekt in all -buffers in Erlang mode, just like under GNU Emacs. - -Never EVER set this variable!") - - ;; Tempo skeleton templates: +(load erlang-skel-file) -(defvar erlang-skel - '(("If" "if" erlang-skel-if) - ("Case" "case" erlang-skel-case) - ("Receive" "receive" erlang-skel-receive) - ("Receive After" "after" erlang-skel-receive-after) - ("Receive Loop" "loop" erlang-skel-receive-loop) - ("Module" "module" erlang-skel-module) - ("Author" "author" erlang-skel-author) - () - ("Small Header" "small-header" - erlang-skel-small-header erlang-skel-header) - ("Normal Header" "normal-header" - erlang-skel-normal-header erlang-skel-header) - ("Large Header" "large-header" - erlang-skel-large-header erlang-skel-header) - () - ("Small Server" "small-server" - erlang-skel-small-server erlang-skel-header) - () - ("Application" "application" - erlang-skel-application erlang-skel-header) - ("Supervisor" "supervisor" - erlang-skel-supervisor erlang-skel-header) - ("supervisor_bridge" "supervisor-bridge" - erlang-skel-supervisor-bridge erlang-skel-header) - ("gen_server" "generic-server" - erlang-skel-generic-server erlang-skel-header) - ("gen_event" "gen-event" - erlang-skel-gen-event erlang-skel-header) - ("gen_fsm" "gen-fsm" - erlang-skel-gen-fsm erlang-skel-header) - ("Library module" "gen-lib" - erlang-skel-lib erlang-skel-header) - ("Corba callback" "gen-corba-cb" - erlang-skel-corba-callback erlang-skel-header)) - "*Description of all skeletons templates. -Both functions and menu entries will be created. - -Each entry in `erlang-skel' should be a list with three or four -elements, or the empty list. - -The first element is the name which shows up in the menu. The second -is the `tempo' identfier (The string \"erlang-\" will be added in -front of it). The third is the skeleton descriptor, a variable -containing `tempo' attributes as described in the function -`tempo-define-template'. The optional fourth elements denotes a -function which should be called when the menu is selected. - -Functions corresponding to every template will be created. The name -of the function will be `tempo-template-erlang-X' where `X' is the -tempo identifier as specified in the second argument of the elements -in this list. - -A list with zero elements means that the a horisontal line should -be placed in the menu.") - -;; In XEmacs `user-mail-address' returns "x@y.z (Foo Bar)" ARGH! -;; What's wrong with that? RFC 822 says it's legal. [sverkerw] -(defvar erlang-skel-mail-address - (concat (user-login-name) "@" - (or (and (boundp 'mail-host-address) - (symbol-value 'mail-host-address)) - (system-name))) - "Mail address of the user.") - -;; Expression templates: -(defvar erlang-skel-case - '((erlang-skel-skip-blank) o > - "case " p " of" n> p "_ ->" n> p "ok" n> "end" p) - "*The skeleton of a `case' expression. -Please see the function `tempo-define-template'.") - -(defvar erlang-skel-if - '((erlang-skel-skip-blank) o > - "if" n> p " ->" n> p "ok" n> "end" p) - "The skeleton of an `if' expression. -Please see the function `tempo-define-template'.") - -(defvar erlang-skel-receive - '((erlang-skel-skip-blank) o > - "receive" n> p "_ ->" n> p "ok" n> "end" p) - "*The skeleton of a `receive' expression. -Please see the function `tempo-define-template'.") - -(defvar erlang-skel-receive-after - '((erlang-skel-skip-blank) o > - "receive" n> p "_ ->" n> p "ok" n> "after " p "T ->" n> - p "ok" n> "end" p) - "*The skeleton of a `receive' expression with an `after' clause. -Please see the function `tempo-define-template'.") - -(defvar erlang-skel-receive-loop - '(& o "loop(" p ") ->" n> "receive" n> p "_ ->" n> - "loop(" p ")" n> "end.") - "*The skeleton of a simple `recieve' loop. -Please see the function `tempo-define-template'.") - - -;; Attribute templates - -(defvar erlang-skel-module - '(& "-module(" - (erlang-add-quotes-if-needed (erlang-get-module-from-file-name)) - ")." n) - "*The skeleton of a `module' attribute. -Please see the function `tempo-define-template'.") - -(defvar erlang-skel-author - '(& "-author('" erlang-skel-mail-address "')." n) - "*The skeleton of a `author' attribute. -Please see the function `tempo-define-template'.") - -(defvar erlang-skel-vc nil - "*The skeleton template to generate a version control attribute. -The default is to insert nothing. Example of usage: - - (setq erlang-skel-vc '(& \"-rcs(\\\"$\Id: $ \\\").\") n) - -Please see the function `tempo-define-template'.") - -(defvar erlang-skel-export - '(& "-export([" n> "])." n) - "*The skeleton of an `export' attribute. -Please see the function `tempo-define-template'.") - -(defvar erlang-skel-import - '(& "%%-import(Module, [Function/Arity, ...])." n) - "*The skeleton of an `import' attribute. -Please see the function `tempo-define-template'.") - -(defvar erlang-skel-compile nil - ;; '(& "%%-compile(export_all)." n) - "*The skeleton of a `compile' attribute. -Please see the function `tempo-define-template'.") - - -;; Comment templates. - -(defvar erlang-skel-date-function 'erlang-skel-dd-mmm-yyyy - "*Function which returns date string. -Look in the module `time-stamp' for a battery of functions.") - -(defvar erlang-skel-copyright-comment '() - "*The template for a copyright line in the header, normally empty. -This variable should be bound to a `tempo' template, for example: - '(& \"%%% Copyright (C) 2000, Yoyodyne, Inc.\" n) - -Please see the function `tempo-define-template'.") - -(defvar erlang-skel-created-comment - '(& "%%% Created : " (funcall erlang-skel-date-function) " by " - (user-full-name) " <" erlang-skel-mail-address ">" n) - "*The template for the \"Created:\" comment line.") - -(defvar erlang-skel-author-comment - '(& "%%% Author : " (user-full-name) " <" erlang-skel-mail-address ">" n) - "*The template for creating the \"Author:\" line in the header. -Please see the function `tempo-define-template'.") - -(defvar erlang-skel-file-comment - '(& "%%% File : " (file-name-nondirectory buffer-file-name) n) - "*The template for creating the \"Module:\" line in the header. -Please see the function `tempo-define-template'.") - -(defvar erlang-skel-small-header - '(o (erlang-skel-include erlang-skel-module) - ;; erlang-skel-author) - n - (erlang-skel-include erlang-skel-compile - ;; erlang-skel-export - erlang-skel-vc)) - "*The template of a small header without any comments. -Please see the function `tempo-define-template'.") - -(defvar erlang-skel-normal-header - '(o (erlang-skel-include erlang-skel-copyright-comment - erlang-skel-file-comment - erlang-skel-author-comment) - "%%% Description : " p n - (erlang-skel-include erlang-skel-created-comment) n - (erlang-skel-include erlang-skel-small-header) n) - "*The template of a normal header. -Please see the function `tempo-define-template'.") - -(defvar erlang-skel-large-header - '(o (erlang-skel-separator) - (erlang-skel-include erlang-skel-copyright-comment - erlang-skel-file-comment - erlang-skel-author-comment) - "%%% Description : " p n - "%%%" n - (erlang-skel-include erlang-skel-created-comment) - (erlang-skel-separator) - (erlang-skel-include erlang-skel-small-header) ) - "*The template of a large header. -Please see the function `tempo-define-template'.") - - -;; Server templates. - -(defvar erlang-skel-small-server - '((erlang-skel-include erlang-skel-large-header) - "-export([start/0,init/1])." n n n - "start() ->" n> "spawn(" (erlang-get-module-from-file-name) - ", init, [self()])." n n - "init(From) ->" n> - "loop(From)." n n - "loop(From) ->" n> - "receive" n> - p "_ ->" n> - "loop(From)" n> - "end." - ) - "*Template of a small server. -Please see the function `tempo-define-template'.") - -;; Behaviour templates. - -(defvar erlang-skel-application - '((erlang-skel-include erlang-skel-large-header) - "-behaviour(application)." n - (erlang-skel-separator 2) - "%% Include files" n - (erlang-skel-separator 2) - n - (erlang-skel-separator 2) - "%% External exports" n - (erlang-skel-separator 2) - "-export([" n> "start/2," n> - "stop/1" n - " ])." n - n - (erlang-skel-separator 2) - "%% Internal exports" n - (erlang-skel-separator 2) - "-export([" n - " ])." n - n - (erlang-skel-separator 2) - "%% Macros" n - (erlang-skel-separator 2) - n - (erlang-skel-separator 2) - "%% Records" n - (erlang-skel-separator 2) - n - (erlang-skel-double-separator 2) - "%% External functions" n - (erlang-skel-double-separator 2) - (erlang-skel-separator 2) - "%% Func: start/2" n - "%% Returns: {ok, Pid} |" n - "%% {ok, Pid, State} |" n - "%% {error, Reason} " n - (erlang-skel-separator 2) - "start(Type, StartArgs) ->" n> - "case 'TopSupervisor':start_link(StartArgs) of" n> - "{ok, Pid} -> " n> - "{ok, Pid};" n> - "Error ->" n> - "Error" n> - "end." n - n - (erlang-skel-separator 2) - "%% Func: stop/1" n - "%% Returns: any "n - (erlang-skel-separator 2) - "stop(State) ->" n> - "ok." n - n - (erlang-skel-double-separator 2) - "%% Internal functions" n - (erlang-skel-double-separator 2) - ) - "*The template of an application behaviour. -Please see the function `tempo-define-template'.") - -(defvar erlang-skel-supervisor - '((erlang-skel-include erlang-skel-large-header) - "-behaviour(supervisor)." n - (erlang-skel-separator 2) - "%% Include files" n - (erlang-skel-separator 2) - n - (erlang-skel-separator 2) - "%% External exports" n - (erlang-skel-separator 2) - "-export([" n> "start_link/0" n - " ])." n - n - (erlang-skel-separator 2) - "%% Internal exports" n - (erlang-skel-separator 2) - "-export([" n> "init/1" n - " ])." n - n - (erlang-skel-separator 2) - "%% Macros" n - (erlang-skel-separator 2) - "-define(SERVER, ?MODULE)." n - n - (erlang-skel-separator 2) - "%% Records" n - (erlang-skel-separator 2) - n - (erlang-skel-double-separator 2) - "%% External functions" n - (erlang-skel-double-separator 2) - (erlang-skel-separator 2) - "%% Function: start_link/0" n - "%% Description: Starts the supervisor" n - (erlang-skel-separator 2) - "start_link() ->" n> - "supervisor:start_link({local, ?SERVER}, ?MODULE, [])." n - n - (erlang-skel-double-separator 2) - "%% Server functions" n - (erlang-skel-double-separator 2) - (erlang-skel-separator 2) - "%% Func: init/1" n - "%% Returns: {ok, {SupFlags, [ChildSpec]}} |" n - "%% ignore |" n - "%% {error, Reason} " n - (erlang-skel-separator 2) - "init([]) ->" n> - "AChild = {'AName',{'AModule',start_link,[]}," n> - "permanent,2000,worker,['AModule']}," n> - "{ok,{{one_for_all,0,1}, [AChild]}}." n - n - (erlang-skel-double-separator 2) - "%% Internal functions" n - (erlang-skel-double-separator 2) - ) - "*The template of an supervisor behaviour. -Please see the function `tempo-define-template'.") - -(defvar erlang-skel-supervisor-bridge - '((erlang-skel-include erlang-skel-large-header) - "-behaviour(supervisor_bridge)." n - (erlang-skel-separator 2) - "%% Include files" n - (erlang-skel-separator 2) - n - (erlang-skel-separator 2) - "%% External exports" n - (erlang-skel-separator 2) - "-export([" n> "start_link/0" n - " ])." n - n - (erlang-skel-separator 2) - "%% Internal exports" n - (erlang-skel-separator 2) - "-export([" n> "init/1, " n> "terminate/2" n - " ])." n - n - (erlang-skel-separator 2) - "%% Macros" n - (erlang-skel-separator 2) - "-define(SERVER, ?MODULE)." n - n - (erlang-skel-separator 2) - "%% Records" n - (erlang-skel-separator 2) - "-record(state, {})." n - n - (erlang-skel-double-separator 2) - "%% External functions" n - (erlang-skel-double-separator 2) - (erlang-skel-separator 2) - "%% Function: start_link/0" n - "%% Description: Starts the supervisor bridge" n - (erlang-skel-separator 2) - "start_link() ->" n> - "supervisor_bridge:start_link({local, ?SERVER}, ?MODULE, [])." n - n - (erlang-skel-double-separator 2) - "%% Server functions" n - (erlang-skel-double-separator 2) - (erlang-skel-separator 2) - "%% Func: init/1" n - "%% Returns: {ok, Pid, State} |" n - "%% ignore |" n - "%% {error, Reason} " n - (erlang-skel-separator 2) - "init([]) ->" n> - "case 'AModule':start_link() of" n> - "{ok, Pid} ->" n> - "{ok, Pid, #state{}};" n> - "Error ->" n> - "Error" n> - "end." n - n - (erlang-skel-separator 2) - "%% Func: terminate/2" n - "%% Purpose: Synchronized shutdown of the underlying sub system." n - "%% Returns: any" n - (erlang-skel-separator 2) - "terminate(Reason, State) ->" n> - "'AModule':stop()," n> - "ok." n - n - (erlang-skel-double-separator 2) - "%% Internal functions" n - (erlang-skel-double-separator 2) - ) - "*The template of an supervisor_bridge behaviour. -Please see the function `tempo-define-template'.") - -(defvar erlang-skel-generic-server - '((erlang-skel-include erlang-skel-large-header) - "-behaviour(gen_server)." n - (erlang-skel-separator 2) - "%% Include files" n - (erlang-skel-separator 2) - n - (erlang-skel-separator 2) - "%% External exports" n - "-export([start_link/0])." n - n - "%% gen_server callbacks" n - "-export([init/1, handle_call/3, handle_cast/2, " - "handle_info/2, terminate/2, code_change/3])." n n - "-record(state, {})." n - n - (erlang-skel-double-separator 2) - "%% External functions" n - (erlang-skel-double-separator 2) - (erlang-skel-separator 2) - "%% Function: start_link/0" n - "%% Description: Starts the server" n - (erlang-skel-separator 2) - "start_link() ->" n> - "gen_server:start_link({local, ?SERVER}, ?MODULE, [], [])." n - n - (erlang-skel-double-separator 2) - "%% Server functions" n - (erlang-skel-double-separator 2) - n - (erlang-skel-separator 2) - "%% Function: init/1" n - "%% Description: Initiates the server" n - "%% Returns: {ok, State} |" n - "%% {ok, State, Timeout} |" n - "%% ignore |" n - "%% {stop, Reason}" n - (erlang-skel-separator 2) - "init([]) ->" n> - "{ok, #state{}}." n - n - (erlang-skel-separator 2) - "%% Function: handle_call/3" n - "%% Description: Handling call messages" n - "%% Returns: {reply, Reply, State} |" n - "%% {reply, Reply, State, Timeout} |" n - "%% {noreply, State} |" n - "%% {noreply, State, Timeout} |" n - "%% {stop, Reason, Reply, State} | (terminate/2 is called)" n - "%% {stop, Reason, State} (terminate/2 is called)" n - (erlang-skel-separator 2) - "handle_call(Request, From, State) ->" n> - "Reply = ok," n> - "{reply, Reply, State}." n - n - (erlang-skel-separator 2) - "%% Function: handle_cast/2" n - "%% Description: Handling cast messages" n - "%% Returns: {noreply, State} |" n - "%% {noreply, State, Timeout} |" n - "%% {stop, Reason, State} (terminate/2 is called)" n - (erlang-skel-separator 2) - "handle_cast(Msg, State) ->" n> - "{noreply, State}." n - n - (erlang-skel-separator 2) - "%% Function: handle_info/2" n - "%% Description: Handling all non call/cast messages" n - "%% Returns: {noreply, State} |" n - "%% {noreply, State, Timeout} |" n - "%% {stop, Reason, State} (terminate/2 is called)" n - (erlang-skel-separator 2) - "handle_info(Info, State) ->" n> - "{noreply, State}." n - n - (erlang-skel-separator 2) - "%% Function: terminate/2" n - "%% Description: Shutdown the server" n - "%% Returns: any (ignored by gen_server)" n - (erlang-skel-separator 2) - "terminate(Reason, State) ->" n> - "ok." n - n - (erlang-skel-separator 2) - "%% Func: code_change/3" n - "%% Purpose: Convert process state when code is changed" n - "%% Returns: {ok, NewState}" n - (erlang-skel-separator 2) - "code_change(OldVsn, State, Extra) ->" n> - "{ok, State}." n - n - (erlang-skel-separator 2) - "%%% Internal functions" n - (erlang-skel-separator 2) - ) - "*The template of a generic server. -Please see the function `tempo-define-template'.") - -(defvar erlang-skel-gen-event - '((erlang-skel-include erlang-skel-large-header) - "-behaviour(gen_event)." n - (erlang-skel-separator 2) - "%% Include files" n - (erlang-skel-separator 2) - n - (erlang-skel-separator 2) - "%% External exports" n - "-export([start_link/0, add_handler/0])." n - n - "%% gen_event callbacks" n - "-export([init/1, handle_event/2, handle_call/2, " - "handle_info/2, terminate/2, code_change/3])." n n - "-record(state, {})." n - n - (erlang-skel-double-separator 2) - "%% External functions" n - (erlang-skel-double-separator 2) - (erlang-skel-separator 2) - "%% Function: start_link/0" n - "%% Description: Starts the server" n - (erlang-skel-separator 2) - "start_link() ->" n> - "gen_event:start_link({local, ?SERVER}). " n - n - (erlang-skel-separator 2) - "%% Function: add_handler/0" n - "%% Description: Adds an event handler" n - (erlang-skel-separator 2) - "add_handler() ->" n> - "gen_event:add_handler(?SERVER, ?MODULE, [])." n - n - (erlang-skel-double-separator 2) - "%% Server functions" n - (erlang-skel-double-separator 2) - (erlang-skel-separator 2) - "%% Func: init/1" n - "%% Returns: {ok, State} |" n - "%% Other" n - (erlang-skel-separator 2) - "init([]) ->" n> - "{ok, #state{}}." n - n - (erlang-skel-separator 2) - "%% Func: handle_event/2" n - "%% Returns: {ok, State} |" n - "%% {swap_handler, Args1, State1, Mod2, Args2} |" n - "%% remove_handler " n - (erlang-skel-separator 2) - "handle_event(Event, State) ->" n> - "{ok, State}." n - n - (erlang-skel-separator 2) - "%% Func: handle_call/2" n - "%% Returns: {ok, Reply, State} |" n - "%% {swap_handler, Reply, Args1, State1, Mod2, Args2} |" n - "%% {remove_handler, Reply} " n - (erlang-skel-separator 2) - "handle_call(Request, State) ->" n> - "Reply = ok," n> - "{ok, Reply, State}." n - n - (erlang-skel-separator 2) - "%% Func: handle_info/2" n - "%% Returns: {ok, State} |" n - "%% {swap_handler, Args1, State1, Mod2, Args2} |" n - "%% remove_handler " n - (erlang-skel-separator 2) - "handle_info(Info, State) ->" n> - "{ok, State}." n - n - (erlang-skel-separator 2) - "%% Func: terminate/2" n - "%% Purpose: Shutdown the server" n - "%% Returns: any" n - (erlang-skel-separator 2) - "terminate(Reason, State) ->" n> - "ok." n - n - (erlang-skel-separator 2) - "%% Func: code_change/3" n - "%% Purpose: Convert process state when code is changed" n - "%% Returns: {ok, NewState}" n - (erlang-skel-separator 2) - "code_change(OldVsn, State, Extra) ->" n> - "{ok, State}." n - n - (erlang-skel-separator 2) - "%%% Internal functions" n - (erlang-skel-separator 2) - ) - "*The template of a gen_event. -Please see the function `tempo-define-template'.") - -(defvar erlang-skel-gen-fsm - '((erlang-skel-include erlang-skel-large-header) - "-behaviour(gen_fsm)." n - (erlang-skel-separator 2) - "%% Include files" n - (erlang-skel-separator 2) - n - (erlang-skel-separator 2) - "%% External exports" n - "-export([start_link/0])." n - n - "%% gen_fsm callbacks" n - "-export([init/1, state_name/2, state_name/3, handle_event/3," n> - "handle_sync_event/4, handle_info/3, terminate/3, code_change/4])." n n - "-record(state, {})." n - n - (erlang-skel-double-separator 2) - "%% External functions" n - (erlang-skel-double-separator 2) - (erlang-skel-separator 2) - "%% Function: start_link/0" n - "%% Description: Starts the server" n - (erlang-skel-separator 2) - "start_link() ->" n> - "gen_fsm:start_link({local, ?SERVER}, ?MODULE, [], [])." n - n - (erlang-skel-double-separator 2) - "%% Server functions" n - (erlang-skel-double-separator 2) - (erlang-skel-separator 2) - "%% Func: init/1" n - "%% Returns: {ok, StateName, StateData} |" n - "%% {ok, StateName, StateData, Timeout} |" n - "%% ignore |" n - "%% {stop, StopReason} " n - (erlang-skel-separator 2) - "init([]) ->" n> - "{ok, state_name, #state{}}." n - n - (erlang-skel-separator 2) - "%% Func: StateName/2" n - "%% Returns: {next_state, NextStateName, NextStateData} |" n - "%% {next_state, NextStateName, NextStateData, Timeout} |" n - "%% {stop, Reason, NewStateData} " n - (erlang-skel-separator 2) - "state_name(Event, StateData) ->" n> - "{next_state, state_name, StateData}." n - n - (erlang-skel-separator 2) - "%% Func: StateName/3" n - "%% Returns: {next_state, NextStateName, NextStateData} |" n - "%% {next_state, NextStateName, NextStateData, Timeout} |" n - "%% {reply, Reply, NextStateName, NextStateData} |" n - "%% {reply, Reply, NextStateName, NextStateData, Timeout} |" n - "%% {stop, Reason, NewStateData} |" n - "%% {stop, Reason, Reply, NewStateData} " n - (erlang-skel-separator 2) - "state_name(Event, From, StateData) ->" n> - "Reply = ok," n> - "{reply, Reply, state_name, StateData}." n - n - (erlang-skel-separator 2) - "%% Func: handle_event/3" n - "%% Returns: {next_state, NextStateName, NextStateData} |" n - "%% {next_state, NextStateName, NextStateData, Timeout} |" n - "%% {stop, Reason, NewStateData} " n - (erlang-skel-separator 2) - "handle_event(Event, StateName, StateData) ->" n> - "{next_state, StateName, StateData}." n - n - (erlang-skel-separator 2) - "%% Func: handle_sync_event/4" n - "%% Returns: {next_state, NextStateName, NextStateData} |" n - "%% {next_state, NextStateName, NextStateData, Timeout} |" n - "%% {reply, Reply, NextStateName, NextStateData} |" n - "%% {reply, Reply, NextStateName, NextStateData, Timeout} |" n - "%% {stop, Reason, NewStateData} |" n - "%% {stop, Reason, Reply, NewStateData} " n - (erlang-skel-separator 2) - "handle_sync_event(Event, From, StateName, StateData) ->" n> - "Reply = ok," n> - "{reply, Reply, StateName, StateData}." n - n - (erlang-skel-separator 2) - "%% Func: handle_info/3" n - "%% Returns: {next_state, NextStateName, NextStateData} |" n - "%% {next_state, NextStateName, NextStateData, Timeout} |" n - "%% {stop, Reason, NewStateData} " n - (erlang-skel-separator 2) - "handle_info(Info, StateName, StateData) ->" n> - "{next_state, StateName, StateData}." n - n - (erlang-skel-separator 2) - "%% Func: terminate/3" n - "%% Purpose: Shutdown the fsm" n - "%% Returns: any" n - (erlang-skel-separator 2) - "terminate(Reason, StateName, StatData) ->" n> - "ok." n - n - (erlang-skel-separator 2) - "%% Func: code_change/4" n - "%% Purpose: Convert process state when code is changed" n - "%% Returns: {ok, NewState, NewStateData}" n - (erlang-skel-separator 2) - "code_change(OldVsn, StateName, StateData, Extra) ->" n> - "{ok, StateName, StateData}." n - n - (erlang-skel-separator 2) - "%%% Internal functions" n - (erlang-skel-separator 2) - ) - "*The template of a gen_fsm. -Please see the function `tempo-define-template'.") - -(defvar erlang-skel-lib - '((erlang-skel-include erlang-skel-large-header) - (erlang-skel-separator 2) - "%% Include files" n - (erlang-skel-separator 2) - n - (erlang-skel-separator 2) - "%% External exports" n - (erlang-skel-separator 2) - "-export([" n - " ])." n - n - (erlang-skel-separator 2) - "%% Internal exports" n - (erlang-skel-separator 2) - "-export([" n - " ])." n - n - (erlang-skel-separator 2) - "%% Macros" n - (erlang-skel-separator 2) - n - (erlang-skel-separator 2) - "%% Records" n - (erlang-skel-separator 2) - n - (erlang-skel-double-separator 2) - "%% External functions" n - (erlang-skel-double-separator 2) - (erlang-skel-separator 2) - "%% Function: " n - "%% Description:" n - (erlang-skel-separator 2) - n - (erlang-skel-double-separator 2) - "%% Internal functions" n - (erlang-skel-double-separator 2) - ) - "*The template of a library module. -Please see the function `tempo-define-template'.") - -(defvar erlang-skel-corba-callback - '((erlang-skel-include erlang-skel-large-header) - (erlang-skel-separator 2) - "%% Include files" n - (erlang-skel-separator 2) - n - (erlang-skel-separator 2) - "%% External exports" n - (erlang-skel-separator 2) - "-export([" n> "init/1, " n> "terminate/2," n> "code_change/3" n - " ])." n - n - (erlang-skel-separator 2) - "%% Internal exports" n - (erlang-skel-separator 2) - "-export([" n - " ])." n - n - (erlang-skel-separator 2) - "%% Macros" n - (erlang-skel-separator 2) - n - (erlang-skel-separator 2) - "%% Records" n - (erlang-skel-separator 2) - "-record(state, {})." n - n - (erlang-skel-double-separator 2) - "%% External functions" n - (erlang-skel-double-separator 2) - (erlang-skel-separator 2) - "%% Function: init/1" n - "%% Description: Initiates the server" n - "%% Returns: {ok, State} |" n - "%% {ok, State, Timeout} |" n - "%% ignore |" n - "%% {stop, Reason}" n - (erlang-skel-separator 2) - "init([]) ->" n> - "{ok, #state{}}." n - n - (erlang-skel-separator 2) - "%% Function: terminate/2" n - "%% Description: Shutdown the server" n - "%% Returns: any (ignored by gen_server)" n - (erlang-skel-separator 2) - "terminate(Reason, State) ->" n> - "ok." n - n - (erlang-skel-separator 2) - "%% Function: code_change/3" n - "%% Description: Convert process state when code is changed" n - "%% Returns: {ok, NewState}" n - (erlang-skel-separator 2) - "code_change(OldVsn, State, Extra) ->" n> - "{ok, State}." n - n - (erlang-skel-double-separator 2) - "%% Internal functions" n - (erlang-skel-double-separator 2) - ) - "*The template of a library module. -Please see the function `tempo-define-template'.") - - - ;; Font-lock variables -(defvar erlang-font-lock-modern-p - (cond ((>= erlang-emacs-major-version 20) t) - (erlang-xemacs-p (>= erlang-emacs-minor-version 14)) - ((= erlang-emacs-major-version 19) (>= erlang-emacs-minor-version 29)) - (t nil)) - "Non-nil when this version of Emacs uses a modern version of Font Lock. - -This is determinated by checking the version of Emacs used, the actual -font-lock code is not loaded.") - - ;; The next few variables define different Erlang font-lock patterns. -;; They could be appended to form a custom font-lock appearence. +;; They could be appended to form a custom font-lock appearance. ;; ;; The function `erlang-font-lock-set-face' could be used to change ;; the face of a pattern. ;; -;; Note that Erlang strings and atoms are hightlighted with using -;; syntactix analysis. +;; Note that Erlang strings and atoms are highlighted with using +;; syntactic analysis. -(defvar erlang-font-lock-keywords-func +(defvar erlang-font-lock-keywords-function-header (list - (list (concat "^" erlang-atom-regexp "\\s *(") + (list (concat "^" erlang-atom-regexp "\\s-*(") 1 'font-lock-function-name-face t)) "Font lock keyword highlighting a function header.") +(defface erlang-font-lock-exported-function-name-face + '((default (:inherit font-lock-function-name-face))) + "Face used for highlighting exported functions.") + +(defvar erlang-font-lock-exported-function-name-face + 'erlang-font-lock-exported-function-name-face) + +(defvar erlang-inhibit-exported-function-name-face nil + "Inhibit separate face for exported functions") + +(defvar erlang-font-lock-keywords-exported-function-header + (list + (list #'erlang-match-next-exported-function + 1 'erlang-font-lock-exported-function-name-face t)) + "Font lock keyword highlighting an exported function header.") + +(defvar erlang-font-lock-keywords-int-bifs + (list + (list (concat erlang-int-bif-regexp "\\s-*(") + 1 'font-lock-builtin-face)) + "Font lock keyword highlighting built in functions.") + +(defvar erlang-font-lock-keywords-ext-bifs + (list + (list (concat "\\<\\(erlang\\)\\s-*:\\s-*" erlang-ext-bif-regexp "\\s-*(") + '(1 'font-lock-builtin-face) + '(2 'font-lock-builtin-face))) + "Font lock keyword highlighting built in functions.") + +(defvar erlang-font-lock-keywords-int-function-calls + (list + (list (concat erlang-atom-regexp "\\s-*(") + 1 'font-lock-type-face)) + "Font lock keyword highlighting an internal function call.") + +(defvar erlang-font-lock-keywords-ext-function-calls + (list + (list (concat erlang-atom-regexp "\\s-*:\\s-*" + erlang-atom-regexp "\\s-*(") + '(1 'font-lock-type-face) + '(2 'font-lock-type-face))) + "Font lock keyword highlighting an external function call.") + +(defvar erlang-font-lock-keywords-fun-n + (list + (list (concat "\\(" erlang-atom-regexp "/[0-9]+\\)") + 1 'font-lock-type-face)) + "Font lock keyword highlighting a fun descriptor in F/N format.") + +(defvar erlang-font-lock-keywords-operators + (list + (list erlang-operators-regexp + 1 'font-lock-builtin-face)) + "Font lock keyword highlighting Erlang operators.") + (defvar erlang-font-lock-keywords-dollar (list (list "\\(\\$\\([^\\]\\|\\\\\\([^0-7^\n]\\|[0-7]+\\|\\^[a-zA-Z]\\)\\)\\)" - 1 'font-lock-string-face)) - "Font lock keyword highlighting numbers in ascii-form (e.g. $A).") + 1 'font-lock-constant-face)) + "Font lock keyword highlighting numbers in ASCII form (e.g. $A).") (defvar erlang-font-lock-keywords-arrow (list - (list "\\(->\\|:-\\)\\(\\s \\|$\\)" 2 'font-lock-function-name-face)) + (list "->\\(\\s \\|$\\)" 1 'font-lock-function-name-face)) "Font lock keyword highlighting clause arrow.") (defvar erlang-font-lock-keywords-lc (list - (list "\\(<-\\)\\(\\s \\|$\\)" 1 'font-lock-keyword-face) - (list "\\(||\\)\\(\\s \\|$\\)" 1 'font-lock-keyword-face)) + (list "\\(<-\\|<=\\|||\\)\\(\\s \\|$\\)" 1 'font-lock-keyword-face)) "Font lock keyword highlighting list comprehension operators.") (defvar erlang-font-lock-keywords-keywords (list - (list (concat "\\<\\(after\\|begin\\|c\\(atch\\|ase\\)\\|end\\|fun\\|if" - "\\|of\\|receive\\|when\\|andalso\\|orelse\\|query\\)\\([^a-zA-Z0-9_]\\|$\\)") - 1 'font-lock-keyword-face)) + (list erlang-keywords-regexp 1 'font-lock-keyword-face)) "Font lock keyword highlighting Erlang keywords.") (defvar erlang-font-lock-keywords-attr (list - (list (concat "^\\(-" erlang-atom-regexp "\\)\\s *\\(\\.\\|(\\)") - 1 'font-lock-function-name-face)) - "Font lock keyword highlighting attribues.") + (list (concat "^\\(-" erlang-atom-regexp "\\)\\(\\s-\\|\\.\\|(\\)") + 1 (if (boundp 'font-lock-preprocessor-face) + 'font-lock-preprocessor-face + 'font-lock-constant-face))) + "Font lock keyword highlighting attributes.") (defvar erlang-font-lock-keywords-quotes (list (list "`\\([-+a-zA-Z0-9_:*][-+a-zA-Z0-9_:*]+\\)'" 1 - (if erlang-font-lock-modern-p - 'font-lock-reference-face - 'font-lock-keyword-face) + 'font-lock-keyword-face t)) "Font lock keyword highlighting words in single quotes in comments. -This is not the keyword hightlighting Erlang strings and atoms, they +This is not the highlighting of Erlang strings and atoms, which are highlighted by syntactic analysis.") -;; Note: The guard `float' collides with the bif `float'. (defvar erlang-font-lock-keywords-guards (list - (list - (concat "\\<\\(" - "\\(is_\\)*\\(atom\\|function\\|binary\\|constant\\|float" - "\\|integer\\|list\\|number\\|p\\(id\\|ort\\)\\|" - "re\\(ference\\|cord\\)\\|tuple" - "\\)\\)\\s *(") - - 1 - (if erlang-font-lock-modern-p - 'font-lock-reference-face - 'font-lock-keyword-face))) + (list (concat "[^:]" erlang-guards-regexp "\\s-*(") + 1 'font-lock-builtin-face)) "Font lock keyword highlighting guards.") -(defvar erlang-font-lock-keywords-bifs +(defvar erlang-font-lock-keywords-predefined-types (list - (list - (concat - "\\<\\(" - "a\\(bs\\|live\\|pply\\|tom_to_list\\)\\|" - "binary_to_\\(list\\|term\\)\\|" - "concat_binary\\|d\\(ate\\|isconnect_node\\)\\|" - "e\\(lement\\|rase\\|xit\\)\\|" - "float\\(\\|_to_list\\)\\|" - "g\\(arbage_collect\\|et\\(\\|_keys\\)\\|roup_leader\\)\\|" - "h\\(alt\\|d\\)\\|" - "i\\(nte\\(ger_to_list\\|rnal_bif\\)\\|s_alive\\)\\|" - "l\\(ength\\|i\\(nk\\|st_to_\\(atom\\|binary\\|float\\|integer" - "\\|pid\\|tuple\\)\\)\\)\\|" - "make_ref\\|no\\(de\\(\\|_\\(link\\|unlink\\)\\|s\\)\\|talive\\)\\|" - "open_port\\|" - "p\\(id_to_list\\|rocess\\(_\\(flag\\|info\\)\\|es\\)\\|ut\\)\\|" - "r\\(egister\\(\\|ed\\)\\|ound\\)\\|" - "s\\(e\\(lf\\|telement\\)\\|ize\\|" - "p\\(awn\\(\\|_link\\)\\|lit_binary\\)\\|tatistics\\)\\|" - "t\\(erm_to_binary\\|hrow\\|ime\\|l\\|" - "r\\(ace\\|unc\\)\\|uple_to_list\\)\\|" - "un\\(link\\|register\\)\\|whereis" - "\\)\\s *(") - 1 - 'font-lock-keyword-face)) - "Font lock keyword highlighting built in functions.") + (list (concat "[^:]" erlang-predefined-types-regexp "\\s-*(") + 1 'font-lock-builtin-face)) + "Font lock keyword highlighting predefined types.") + (defvar erlang-font-lock-keywords-macros (list - (list (concat "?\\s *\\(" erlang-atom-regexp - "\\|" erlang-variable-regexp "\\)\\>") - 1 (if erlang-font-lock-modern-p - 'font-lock-reference-face - 'font-lock-type-face)) - (list (concat "^-\\(define\\|ifn?def\\)\\s *(\\s *\\(" erlang-atom-regexp - "\\|" erlang-variable-regexp "\\)\\>") - 2 (if erlang-font-lock-modern-p - 'font-lock-reference-face - 'font-lock-type-face))) + (list (concat "?\\s-*\\(" erlang-atom-regexp + "\\|" erlang-variable-regexp "\\)") + 1 'font-lock-constant-face) + (list (concat "^\\(-\\(?:define\\|ifn?def\\)\\)\\s-*(\\s-*\\(" erlang-atom-regexp + "\\|" erlang-variable-regexp "\\)") + (if (boundp 'font-lock-preprocessor-face) + (list 1 'font-lock-preprocessor-face t) + (list 1 'font-lock-constant-face t)) + (list 3 'font-lock-type-face t t)) + (list "^-e\\(lse\\|ndif\\)\\>" 0 'font-lock-preprocessor-face t)) "Font lock keyword highlighting macros. This must be placed in front of `erlang-font-lock-keywords-vars'.") (defvar erlang-font-lock-keywords-records (list - (list (concat "#\\s *" erlang-atom-regexp "\\>") - 1 'font-lock-type-face) + (list (concat "#\\s *" erlang-atom-regexp) + 1 'font-lock-type-face) ;; Don't highlight numerical constants. - (list "\\<[0-9][0-9]?#\\([0-9a-fA_F]+\\)\\>" - 1 nil t) - (list (concat "^-record(\\s *" erlang-atom-regexp "\\>") - 1 'font-lock-type-face)) + (list (if erlang-regexp-modern-p + "\\_<[0-9]+#\\([0-9a-zA-Z]+\\)" + "\\<[0-9]+#\\([0-9a-zA-Z]+\\)") + 1 nil t) + (list (concat "^-record\\s-*(\\s-*" erlang-atom-regexp) + 1 'font-lock-type-face)) "Font lock keyword highlighting Erlang records. This must be placed in front of `erlang-font-lock-keywords-vars'.") (defvar erlang-font-lock-keywords-vars (list - (list (concat "\\<" erlang-variable-regexp "\\>") - 1 (if erlang-font-lock-modern-p - 'font-lock-variable-name-face - 'font-lock-type-face))) + (list (concat "[^#]" erlang-variable-regexp) ; no numerical constants + 1 'font-lock-variable-name-face)) "Font lock keyword highlighting Erlang variables. -Must be preceded by `erlang-font-lock-keywords-macros' and `-records' -to work properly.") +Must be preceded by `erlang-font-lock-keywords-macros' to work properly.") - -(defvar erlang-font-lock-keywords-1 - (append erlang-font-lock-keywords-func - erlang-font-lock-keywords-dollar - erlang-font-lock-keywords-arrow - erlang-font-lock-keywords-keywords) - ;; DocStringOrig: erlang-font-lock-keywords +(defvar erlang-font-lock-descr-string "Font-lock keywords used by Erlang Mode. There exists three levels of Font Lock keywords for Erlang: `erlang-font-lock-keywords-1' - Function headers and reserved keywords. - `erlang-font-lock-keywords-2' - Bifs, guards and `singel quotes'. + `erlang-font-lock-keywords-2' - Bifs, guards and `single quotes'. `erlang-font-lock-keywords-3' - Variables, macros and records. + `erlang-font-lock-keywords-4' - Exported functions, Function names, + Funs, LCs (not Atoms). To use a specific level, please set the variable `font-lock-maximum-decoration' to the appropriate level. Note that the @@ -1539,66 +1227,51 @@ variable must be set before Erlang mode is activated. Example: (setq font-lock-maximum-decoration 2)") +(defvar erlang-font-lock-keywords-1 + (append erlang-font-lock-keywords-function-header + erlang-font-lock-keywords-dollar + erlang-font-lock-keywords-arrow + erlang-font-lock-keywords-keywords + ) + ;; DocStringOrig: erlang-font-lock-keywords + erlang-font-lock-descr-string) (defvar erlang-font-lock-keywords-2 (append erlang-font-lock-keywords-1 + erlang-font-lock-keywords-int-bifs + erlang-font-lock-keywords-ext-bifs erlang-font-lock-keywords-attr erlang-font-lock-keywords-quotes erlang-font-lock-keywords-guards - erlang-font-lock-keywords-bifs) + ) ;; DocStringCopy: erlang-font-lock-keywords - "Font-lock keywords used by Erlang Mode. - -There exists three levels of Font Lock keywords for Erlang: - `erlang-font-lock-keywords-1' - Function headers and reserved keywords. - `erlang-font-lock-keywords-2' - Bifs, guards and `single quotes'. - `erlang-font-lock-keywords-3' - Variables, macros and records. - -To use a specific level, please set the variable -`font-lock-maximum-decoration' to the appropriate level. Note that the -variable must be set before Erlang mode is activated. - -Example: - (setq font-lock-maximum-decoration 2)") - + erlang-font-lock-descr-string) (defvar erlang-font-lock-keywords-3 (append erlang-font-lock-keywords-2 + erlang-font-lock-keywords-operators erlang-font-lock-keywords-macros erlang-font-lock-keywords-records - erlang-font-lock-keywords-vars) + erlang-font-lock-keywords-vars + erlang-font-lock-keywords-predefined-types + ) ;; DocStringCopy: erlang-font-lock-keywords - "Font-lock keywords used by Erlang Mode. + erlang-font-lock-descr-string) -There exists three levels of Font Lock keywords for Erlang: - `erlang-font-lock-keywords-1' - Function headers and reserved keywords. - `erlang-font-lock-keywords-2' - Bifs, guards and `single quotes'. - `erlang-font-lock-keywords-3' - Variables, macros and records. - -To use a specific level, please set the variable -`font-lock-maximum-decoration' to the appropriate level. Note that the -variable must be set before Erlang mode is activated. - -Example: - (setq font-lock-maximum-decoration 2)") - - -(defvar erlang-font-lock-keywords erlang-font-lock-keywords-3 +(defvar erlang-font-lock-keywords-4 + (append erlang-font-lock-keywords-3 + erlang-font-lock-keywords-exported-function-header + erlang-font-lock-keywords-int-function-calls + erlang-font-lock-keywords-ext-function-calls + erlang-font-lock-keywords-fun-n + erlang-font-lock-keywords-lc + ) ;; DocStringCopy: erlang-font-lock-keywords - "Font-lock keywords used by Erlang Mode. - -There exists three levels of Font Lock keywords for Erlang: - `erlang-font-lock-keywords-1' - Function headers and reserved keywords. - `erlang-font-lock-keywords-2' - Bifs, guards and `single quotes'. - `erlang-font-lock-keywords-3' - Variables, macros and records. - -To use a specific level, please set the variable -`font-lock-maximum-decoration' to the appropriate level. Note that the -variable must be set before Erlang mode is activated. - -Example: - (setq font-lock-maximum-decoration 2)") + erlang-font-lock-descr-string) +(defvar erlang-font-lock-keywords erlang-font-lock-keywords-4 + ;; DocStringCopy: erlang-font-lock-keywords + erlang-font-lock-descr-string) (defvar erlang-font-lock-syntax-table nil "Syntax table used by Font Lock mode. @@ -1607,11 +1280,11 @@ The difference between this and the standard Erlang Mode syntax table is that `_' is treated as part of words by this syntax table. -Unfortuantely, XEmacs hasn't got support for a special Font +Unfortunately, XEmacs hasn't got support for a special Font Lock syntax table. The effect is that `apply' in the atom `foo_apply' will be highlighted as a bif.") - + ;;; Avoid errors while compiling this file. ;; `eval-when-compile' is not defined in Emacs 18. We define it as a @@ -1625,37 +1298,26 @@ Lock syntax table. The effect is that `apply' in the atom (or (fboundp 'unless) (defmacro unless (condition &rest body) "(unless CONDITION BODY...): If CONDITION is false, do BODY, else return nil." - (` (if (, condition) - nil - (,@ body))))) + `((if (, condition) nil ,@body)))) (or (fboundp 'when) (defmacro when (condition &rest body) "(when CONDITION BODY...): If CONDITION is true, do BODY, else return nil." - (` (if (, condition) - (progn (,@ body)) - nil)))) + `((if (, condition) (progn ,@body) nil)))) (or (fboundp 'char-before) (defmacro char-before (&optional pos) "Return the character in the current buffer just before POS." - (` (char-after (1- (or (, pos) (point))))))) - -(or (fboundp 'regexp-opt) - (defun regexp-opt (strings &optional paren) - "Return a regular expression that matches any string in -STRINGS. If PAREN is true, it will always enclose the regular -expression in parentheses. + `( (char-after (1- (or ,pos (point))))))) -Unlike its Emacs-20 namesake, it will not optimize the generated -expression." - ;; This stop-gap definition is taken from - ;; _GNU_Emacs_Lisp_Reference_Manual_, ed 2.5, for Emacs 20.3. - (let ((open (if paren "\\(" "")) - (close (if paren "\\)" ""))) - (concat open - (mapconcat 'regexp-quote strings "\\|") - close)))) +;; defvar some obsolete variables, which we still support for +;; backwards compatibility reasons. +(eval-when-compile + (defvar comment-indent-hook) + (defvar dabbrev-case-fold-search) + (defvar tempo-match-finder) + (defvar compilation-menu-map) + (defvar next-error-last-buffer)) (eval-when-compile (if (or (featurep 'bytecomp) @@ -1668,9 +1330,10 @@ expression." (setq byte-compile-warnings '(free-vars unresolved callargs redefine)))) (require 'comint) + (require 'tempo) (require 'compile)))) - + (defun erlang-version () "Return the current version of Erlang mode." (interactive) @@ -1745,20 +1408,27 @@ Other commands: (setq major-mode 'erlang-mode) (setq mode-name "Erlang") (erlang-syntax-table-init) - (erlang-keymap-init) + (use-local-map erlang-mode-map) (erlang-electric-init) (erlang-menu-init) (erlang-mode-variables) (erlang-check-module-name-init) - (erlang-add-compilation-alist erlang-error-regexp-alist) (erlang-man-init) (erlang-tags-init) (erlang-font-lock-init) (erlang-skel-init) + (tempo-use-tag-list 'erlang-tempo-tags) (run-hooks 'erlang-mode-hook) (if (zerop (buffer-size)) - (run-hooks 'erlang-new-file-hook))) + (run-hooks 'erlang-new-file-hook)) + ;; Doesn't exist in Emacs v21.4; required by Emacs v23. + (if (boundp 'after-change-major-mode-hook) + (run-hooks 'after-change-major-mode-hook))) +;;;###autoload +(dolist (r '("\\.erl$" "\\.app\\.src$" "\\.escript" + "\\.hrl$" "\\.xrl$" "\\.yrl" "/ebin/.+\\.app")) + (add-to-list 'auto-mode-alist (cons r 'erlang-mode))) (defun erlang-syntax-table-init () (if (null erlang-mode-syntax-table) @@ -1766,7 +1436,11 @@ Other commands: (modify-syntax-entry ?\n ">" table) (modify-syntax-entry ?\" "\"" table) (modify-syntax-entry ?# "." table) - (modify-syntax-entry ?$ "/" table) +;; (modify-syntax-entry ?$ "\\" table) ;; Creates problems with indention afterwards +;; (modify-syntax-entry ?$ "'" table) ;; Creates syntax highlighting and indention problems + (modify-syntax-entry ?$ "/" table) ;; Misses the corner case "string that ends with $" + ;; we have to live with that for now..it is the best alternative + ;; that can be worked around with "string hat ends with \$" (modify-syntax-entry ?% "<" table) (modify-syntax-entry ?& "." table) (modify-syntax-entry ?\' "\"" table) @@ -1781,8 +1455,8 @@ Other commands: (modify-syntax-entry ?\\ "\\" table) (modify-syntax-entry ?_ "_" table) (modify-syntax-entry ?| "." table) - (modify-syntax-entry ?^ "/" table) - + (modify-syntax-entry ?^ "'" table) + ;; Pseudo bit-syntax: Latin1 double angle quotes as parens. ;;(modify-syntax-entry ?\253 "(?\273" table) ;;(modify-syntax-entry ?\273 ")?\253" table) @@ -1792,66 +1466,27 @@ Other commands: (set-syntax-table erlang-mode-syntax-table)) -(defun erlang-keymap-init () - (if erlang-mode-map - nil - (setq erlang-mode-map (make-sparse-keymap)) - (erlang-mode-commands erlang-mode-map)) - (use-local-map erlang-mode-map)) - - -(defun erlang-mode-commands (map) - (define-key map "\t" 'erlang-indent-command) - (define-key map ";" 'erlang-electric-semicolon) - (define-key map "," 'erlang-electric-comma) - (define-key map "<" 'erlang-electric-lt) - (define-key map ">" 'erlang-electric-gt) - (define-key map "\C-m" 'erlang-electric-newline) - (define-key map "\177" 'backward-delete-char-untabify) - (define-key map "\M-q" 'erlang-fill-paragraph) - (define-key map "\M-\C-a" 'erlang-beginning-of-function) - (define-key map "\M-\C-e" 'erlang-end-of-function) - (define-key map "\M-\C-h" 'erlang-mark-function) - (define-key map "\M-\t" 'erlang-complete-tag) - (define-key map "\C-c\M-\t" 'tempo-complete-tag) - (define-key map "\C-c\M-a" 'erlang-beginning-of-clause) - (define-key map "\C-c\M-b" 'tempo-backward-mark) - (define-key map "\C-c\M-e" 'erlang-end-of-clause) - (define-key map "\C-c\M-f" 'tempo-forward-mark) - (define-key map "\C-c\M-h" 'erlang-mark-clause) - (define-key map "\C-c\C-c" 'comment-region) - (define-key map "\C-c\C-j" 'erlang-generate-new-clause) - (define-key map "\C-c\C-k" 'erlang-compile) - (define-key map "\C-c\C-l" 'erlang-compile-display) - (define-key map "\C-c\C-s" 'erlang-show-syntactic-information) - (define-key map "\C-c\C-q" 'erlang-indent-function) - (define-key map "\C-c\C-u" 'erlang-uncomment-region) - (define-key map "\C-c\C-y" 'erlang-clone-arguments) - (define-key map "\C-c\C-z" 'erlang-shell-display) - (define-key map "\C-x`" 'erlang-next-error)) - - (defun erlang-electric-init () ;; Set up electric character functions to work with ;; delsel/pending-del mode. Also, set up text properties for bit ;; syntax handling. - (mapcar #'(lambda (cmd) - (put cmd 'delete-selection t) ;for delsel (Emacs) - (put cmd 'pending-delete t)) ;for pending-del (XEmacs) - '(erlang-electric-semicolon - erlang-electric-comma - erlang-electric-gt)) - + (mapc #'(lambda (cmd) + (put cmd 'delete-selection t) ;for delsel (Emacs) + (put cmd 'pending-delete t)) ;for pending-del (XEmacs) + '(erlang-electric-semicolon + erlang-electric-comma + erlang-electric-gt)) + (put 'bitsyntax-open-outer 'syntax-table '(4 . ?>)) (put 'bitsyntax-open-outer 'rear-nonsticky '(category)) (put 'bitsyntax-open-inner 'rear-nonsticky '(category)) (put 'bitsyntax-close-inner 'rear-nonsticky '(category)) (put 'bitsyntax-close-outer 'syntax-table '(5 . ?<)) (put 'bitsyntax-close-outer 'rear-nonsticky '(category)) + (make-local-variable 'parse-sexp-lookup-properties) (setq parse-sexp-lookup-properties 't)) - (defun erlang-mode-variables () (or erlang-mode-abbrev-table (define-abbrev-table 'erlang-mode-abbrev-table ())) @@ -1884,34 +1519,20 @@ Other commands: (set (make-local-variable 'imenu-prev-index-position-function) 'erlang-beginning-of-function) (set (make-local-variable 'imenu-extract-index-name-function) - 'erlang-get-function-name) + 'erlang-get-function-name-and-arity) (set (make-local-variable 'tempo-match-finder) - "[^-a-zA-Z0-9_]\\([-a-zA-Z0-9_]*\\)\\=")) + "[^-a-zA-Z0-9_]\\([-a-zA-Z0-9_]*\\)\\=") + (set (make-local-variable 'beginning-of-defun-function) + 'erlang-beginning-of-function) + (set (make-local-variable 'end-of-defun-function) 'erlang-end-of-function) + (set (make-local-variable 'open-paren-in-column-0-is-defun-start) nil) + (set (make-local-variable 'fill-paragraph-function) 'erlang-fill-paragraph) + (set (make-local-variable 'comment-add) 1) + (set (make-local-variable 'outline-regexp) "[[:lower:]0-9_]+ *(.*) *-> *$") + (set (make-local-variable 'outline-level) (lambda () 1)) + (set (make-local-variable 'add-log-current-defun-function) + 'erlang-current-defun)) - -;; Compilation. -;; -;; The following code is compatible with the standard package `compilation', -;; making it possible to go to errors using `erlang-next-error'. -;; -;; The normal `compile' command works ofcourse. For best result, please -;; execute `make' with the `-w' flag. -;; -;; Please see the variables named `compiling-..' above. - -(defun erlang-add-compilation-alist (alist) - (require 'compile) - (cond ((boundp 'compilation-error-regexp-alist) ; Emacs 19 - (while alist - (or (assoc (car (car alist)) compilation-error-regexp-alist) - (setq compilation-error-regexp-alist - (cons (car alist) compilation-error-regexp-alist))) - (setq alist (cdr alist)))) - ((boundp 'compilation-error-regexp) - ;; Emacs 18, Only one regexp is allowed. - (funcall (symbol-function 'set) - 'compilation-error-regexp (car (car alist)))))) - (defun erlang-font-lock-init () "Initialize Font Lock for Erlang mode." (or erlang-font-lock-syntax-table @@ -1942,19 +1563,41 @@ Other commands: (set 'font-lock-keywords erlang-font-lock-keywords-1)) ((eq level 2) (set 'font-lock-keywords erlang-font-lock-keywords-2)) - (t - (set 'font-lock-keywords erlang-font-lock-keywords-3)))) + ((eq level 3) + (set 'font-lock-keywords erlang-font-lock-keywords-3)) + (t + (set 'font-lock-keywords erlang-font-lock-keywords-4)))) - ;; Modern font-locks can handle the above much more elegant: + ;; Modern font-locks can handle the above much more elegantly: (set (make-local-variable 'font-lock-defaults) '((erlang-font-lock-keywords erlang-font-lock-keywords-1 - erlang-font-lock-keywords-2 erlang-font-lock-keywords-3) + erlang-font-lock-keywords-2 + erlang-font-lock-keywords-3 + erlang-font-lock-keywords-4) nil nil ((?_ . "w")) erlang-beginning-of-clause - (font-lock-mark-block-function . erlang-mark-clause)))) + (font-lock-mark-block-function . erlang-mark-clause) + (font-lock-syntactic-keywords + ;; A dollar sign right before the double quote that ends a + ;; string is not a character escape. + ;; + ;; And a "string" consists of a double quote not escaped by a + ;; dollar sign, any number of non-backslash non-newline + ;; characters or escaped backslashes, a dollar sign + ;; (otherwise we wouldn't care) and a double quote. This + ;; doesn't match multi-line strings, but this is probably + ;; the best we can get, since while font-locking we don't + ;; know whether matching started inside a string: limiting + ;; search to a single line keeps things sane. + . (("\\(?:^\\|[^$]\\)\"\\(?:[^\"\n]\\|\\\\\"\\)*\\(\\$\\)\"" 1 "w") + ;; Likewise for atoms + ("\\(?:^\\|[^$]\\)'\\(?:[^'\n]\\|\\\\'\\)*\\(\\$\\)'" 1 "w") + ;; And the dollar sign in $\" or $\' escapes two + ;; characters, not just one. + ("\\(\\$\\)\\\\[\"']" 1 "'")))))) -;; Useful when definig yout own keywords. +;; Useful when defining your own keywords. (defun erlang-font-lock-set-face (ks &rest faces) "Replace the face components in a list of keywords. @@ -1973,14 +1616,14 @@ Normally, the expressions are just atoms representing the new face. They could however be more complex, returning different faces in different situations. -This function does only handle keywords with elements on the forms: +This function only handles keywords with elements on the forms: (REGEXP NUMBER FACE) (REGEXP NUMBER FACE OVERWRITE) This could be used when defining your own special font-lock setup, e.g: \(setq my-font-lock-keywords - (append erlang-font-lock-keywords-func + (append erlang-font-lock-keywords-function-header erlang-font-lock-keywords-dollar (erlang-font-lock-set-face erlang-font-lock-keywords-macros 'my-neon-green-face) @@ -2009,44 +1652,15 @@ For a more elaborate example, please see the beginning of the file (defun erlang-font-lock-level-0 () ;; DocStringOrig: font-cmd - "Fontify current buffer. Level ranges from 0 (off) to 3 (Christmas Tree). - -The following fontification level exists: - 0 - No fontification - 1 - Function headers, reserved keywords, strings and comments. - 2 - Bifs, guards and `single quotes'. - 3 - Variables, macros and records. - -To automatically activate font lock mode, place the following lines -in your ~/.emacs file: - -\(defun my-erlang-mode-hook () - (cond (window-system - (font-lock-mode 1)))) -\(add-hook 'erlang-mode-hook 'my-erlang-mode-hook) -\(setq font-lock-maximum-decoration t)" + "Unfontify current buffer." (interactive) (font-lock-mode 0)) (defun erlang-font-lock-level-1 () ;; DocStringCopy: font-cmd - "Fontify current buffer. Level ranges from 0 (off) to 3 (Christmas Tree). - -The following fontification level exists: - 0 - No fontification - 1 - Function headers, reserved keywords, strings and comments. - 2 - Bifs, guards and `single quotes'. - 3 - Variables, macros and records. - -To automatically activate font lock mode, place the following lines -in your ~/.emacs file: - -\(defun my-erlang-mode-hook () - (cond (window-system - (font-lock-mode 1)))) -\(add-hook 'erlang-mode-hook 'my-erlang-mode-hook) -\(setq font-lock-maximum-decoration t)" + "Fontify current buffer at level 1. +This highlights function headers, reserved keywords, strings and comments." (interactive) (require 'font-lock) (set 'font-lock-keywords erlang-font-lock-keywords-1) @@ -2056,22 +1670,9 @@ in your ~/.emacs file: (defun erlang-font-lock-level-2 () ;; DocStringCopy: font-cmd - "Fontify current buffer. Level ranges from 0 (off) to 3 (Christmas Tree). - -The following fontification level exists: - 0 - No fontification - 1 - Function headers, reserved keywords, strings and comments. - 2 - Bifs, guards and `single quotes'. - 3 - Variables, macros and records. - -To automatically activate font lock mode, place the following lines -in your ~/.emacs file: - -\(defun my-erlang-mode-hook () - (cond (window-system - (font-lock-mode 1)))) -\(add-hook 'erlang-mode-hook 'my-erlang-mode-hook) -\(setq font-lock-maximum-decoration t)" + "Fontify current buffer at level 2. +This highlights level 1 features (see `erlang-font-lock-level-1') +plus bifs, guards and `single quotes'." (interactive) (require 'font-lock) (set 'font-lock-keywords erlang-font-lock-keywords-2) @@ -2081,29 +1682,27 @@ in your ~/.emacs file: (defun erlang-font-lock-level-3 () ;; DocStringCopy: font-cmd - "Fontify current buffer. Level ranges from 0 (off) to 3 (Christmas Tree). - -The following fontification level exists: - 0 - No fontification - 1 - Function headers, reserved keywords, strings and comments. - 2 - Bifs, guards and `single quotes'. - 3 - Variables, macros and records. - -To automatically activate font lock mode, place the following lines -in your ~/.emacs file: - -\(defun my-erlang-mode-hook () - (cond (window-system - (font-lock-mode 1)))) -\(add-hook 'erlang-mode-hook 'my-erlang-mode-hook) -\(setq font-lock-maximum-decoration t)" + "Fontify current buffer at level 3. +This highlights level 2 features (see `erlang-font-lock-level-2') +plus variables, macros and records." (interactive) (require 'font-lock) (set 'font-lock-keywords erlang-font-lock-keywords-3) (font-lock-mode 1) (funcall (symbol-function 'font-lock-fontify-buffer))) - +(defun erlang-font-lock-level-4 () + ;; DocStringCopy: font-cmd + "Fontify current buffer at level 4. +This highlights level 3 features (see `erlang-font-lock-level-2') +plus variables, macros and records." + (interactive) + (require 'font-lock) + (set 'font-lock-keywords erlang-font-lock-keywords-4) + (font-lock-mode 1) + (funcall (symbol-function 'font-lock-fontify-buffer))) + + (defun erlang-menu-init () "Init menus for Erlang mode. @@ -2111,19 +1710,19 @@ The variable `erlang-menu-items' contain a description of the Erlang mode menu. Normally, the list contains atoms, representing variables bound to pieces of the menu. -Personal extentions could be added to `erlang-menu-personal-items'. +Personal extensions could be added to `erlang-menu-personal-items'. -Should any variable describing the menu configuration, this function -should be called." +This function should be called if any variable describing the +menu configuration is changed." (erlang-menu-install "Erlang" erlang-menu-items erlang-mode-map t)) (defun erlang-menu-install (name items keymap &optional popup) - "Install a menu on Emacs 19 or XEmacs based on an abstract description. + "Install a menu in Emacs or XEmacs based on an abstract description. NAME is the name of the menu. -ITEMS is a list. The elements are either nil representing a horisontal +ITEMS is a list. The elements are either nil representing a horizontal line or a list with two or three elements. The first is the name of the menu item, the second the function to call, or a submenu, on the same same form as ITEMS. The third optional element is an expression @@ -2131,8 +1730,8 @@ which is evaluated every time the menu is displayed. Should the expression evaluate to nil the menu item is ghosted. KEYMAP is the keymap to add to menu to. (When using XEmacs, the menu -will only be visible when this meny is the global, the local, or an -activated minor mode keymap.) +will only be visible when this menu is the global, the local, or an +activate minor mode keymap.) If POPUP is non-nil, the menu is bound to the XEmacs `mode-popup-menu' variable, i.e. it will popup when pressing the right mouse button. @@ -2162,7 +1761,7 @@ Please see the variable `erlang-menu-base-items'." id def first second third) (setq items (reverse items)) (while items - ;; Replace any occurence of atoms by their value. + ;; Replace any occurrence of atoms by their value. (while (and items (atom (car items)) (not (null (car items)))) (if (and (boundp (car items)) (listp (symbol-value (car items)))) @@ -2199,7 +1798,7 @@ Please see the variable `erlang-menu-base-items'." (let ((res '()) first second third entry) (while items - ;; Replace any occurence of atoms by their value. + ;; Replace any occurrence of atoms by their value. (while (and items (atom (car items)) (not (null (car items)))) (if (and (boundp (car items)) (listp (symbol-value (car items)))) @@ -2223,7 +1822,7 @@ Please see the variable `erlang-menu-base-items'." res)))) (setq items (cdr items))) (setq res (reverse res)) - ;; When adding a menu to a minor-mode keymap under Emacs 19, + ;; When adding a menu to a minor-mode keymap under Emacs, ;; it disappears when the mode is disabled. The expression ;; generated below imitates this behaviour. ;; (This could be expressed much clearer using backquotes, @@ -2322,7 +1921,7 @@ Example: The new menu is returned. No guarantee is given that the original menu is left unchanged." (delq entry items)) - + ;; Man code: (defun erlang-man-init () @@ -2390,7 +1989,7 @@ The format is described in the documentation of `erlang-man-dirs'." ;; Should the menu be to long, let's split it into a number of -;; smaller menus. Warning, this code contains beatiful +;; smaller menus. Warning, this code contains beautiful ;; destructive operations! (defun erlang-man-make-middle-menu (filelist) "Create the second level menu from FILELIST. @@ -2432,7 +2031,7 @@ menus is created." (defun erlang-man-make-menu-item (file) "Create a menu item containing the name of the man page." - (and (string-match ".*/\\([^/]+\\)\\.[^.]$" file) + (and (string-match ".+/\\([^/]+\\)\\.\\([124-9]\\|3\\(erl\\)?\\)\\(\\.gz\\)?$" file) (let ((page (substring file (match-beginning 1) (match-end 1)))) (list (capitalize page) (list 'lambda '() @@ -2443,7 +2042,7 @@ menus is created." (defun erlang-man-get-files (dir) "Return files in directory DIR." - (directory-files dir t ".*\\.[0-9]\\'")) + (directory-files dir t ".+\\.\\([124-9]\\|3\\(erl\\)?\\)\\(\\.gz\\)?\\'")) (defun erlang-man-module (&optional module) @@ -2463,7 +2062,7 @@ This function is aware of imported functions." (if (or (null module) (string= module "")) (error "No Erlang module name given")) (let ((dir-list erlang-man-dirs) - (pat (concat "\\b" (regexp-quote module) "\\.[^.]$")) + (pat (concat "/" (regexp-quote module) "\\.\\([124-9]\\|3\\(erl\\)?\\)\\(\\.gz\\)?$")) (file nil) file-list) (while (and dir-list (null file)) @@ -2478,18 +2077,18 @@ This function is aware of imported functions." (setq dir-list (cdr dir-list))) (if file (funcall erlang-man-display-function file) - (error "No manual page for module %s found." module)))) + (error "No manual page for module %s found" module)))) ;; Warning, the function `erlang-man-function' is a hack! ;; It links itself into the man code in a non-clean way. I have -;; choosed to keep it since it provides a very useful functionality -;; which is not possible to achive using a clean approach. +;; chosen to keep it since it provides a very useful functionality +;; which is not possible to achieve using a clean approach. ;; / AndersL (defvar erlang-man-function-name nil "Name of function for last `erlang-man-function' call. -Used for commnication between `erlang-man-function' and the +Used for communication between `erlang-man-function' and the patch to `Man-notify-when-ready'.") (defun erlang-man-function (&optional name) @@ -2531,7 +2130,7 @@ This function is aware of imported functions." (error "No Erlang module name given")) (cond ((fboundp 'Man-notify-when-ready) ;; Emacs 19: The man command could possibly start an - ;; asyncronous process, i.e. we must hook ourselves into + ;; asynchronous process, i.e. we must hook ourselves into ;; the system to be activated when the man-process ;; terminates. (if (null funcname) @@ -2562,15 +2161,15 @@ The reason for patching a function is that under Emacs 19, the man command is executed asynchronously." (condition-case nil (require 'advice) - ;; This should never happend since this is only called when + ;; This should never happened since this is only called when ;; running under Emacs 19. - (error (error (concat "This commands needs the package `advice', " + (error (error (concat "This command needs the package `advice', " "please upgrade your Emacs.")))) (require 'man) (defadvice Man-notify-when-ready (after erlang-Man-notify-when-ready activate) - "Sets point at the documentation of the function name in -erlang-man-function-name when the man-page is displayed." + "Set point at the documentation of the function name in +`erlang-man-function-name' when the man page is displayed." (if erlang-man-function-name (erlang-man-find-function (ad-get-arg 0) erlang-man-function-name)) (setq erlang-man-function-name nil))) @@ -2595,7 +2194,7 @@ erlang-man-function-name when the man-page is displayed." (defun erlang-man-display (file) "Display FILE as a `man' file. -This is de default manual page display function. +This is the default manual page display function. The variables `erlang-man-display-function' contains the function to be used." ;; Emacs 18 doesn't `provide' man. @@ -2604,7 +2203,7 @@ to be used." (error nil)) (if file (let ((process-environment (copy-sequence process-environment))) - (if (string-match "\\(.*\\)/man[^/]*/\\([^/]+\\)\\.[^.]$" file) + (if (string-match "\\(.*\\)/man[^/]*/\\([^.]+\\)\\.\\([124-9]\\|3\\(erl\\)?\\)\\(\\.gz\\)?$" file) (let ((dir (substring file (match-beginning 1) (match-end 1))) (page (substring file (match-beginning 2) (match-end 2)))) (if (fboundp 'setenv) @@ -2645,7 +2244,7 @@ For example: After installing the line, kill and restart Emacs, or restart Erlang mode with the command `M-x erlang-mode RET'."))) - + ;; Skeleton code: ;; This code is based on the package `tempo' which is part of modern @@ -2676,7 +2275,9 @@ package not be present, this function does nothing." ;; variables describing the templates take effect ;; immdiately. (list (list 'erlang-skel-include (nth 2 (car skel)))) - (nth 1 (car skel))) + (nth 1 (car skel)) + (car (car skel)) + 'erlang-tempo-tags) (setq menu (cons (erlang-skel-make-menu-item (car skel)) menu)))) (setq skel (cdr skel))) @@ -2727,7 +2328,7 @@ Example of use, assuming that `erlang-skel-func' is defined: (defvar foo-skeleton '(\"%%% New function:\" (erlang-skel-include erlang-skel-func))) -Techically, this function returns the `tempo' attribute`(l ...)' which +Technically, this function returns the `tempo' attribute`(l ...)' which can contain other `tempo' attributes. Please see the function `tempo-define-template' for a description of the `(l ...)' attribute." (let ((res '()) @@ -2740,18 +2341,20 @@ can contain other `tempo' attributes. Please see the function (setq args (cdr args))) (cons 'l (nreverse res)))) +(defvar erlang-skel-separator-length 70) + (defun erlang-skel-separator (&optional percent) "Return a comment separator." (let ((percent (or percent 3))) (concat (make-string percent ?%) - (make-string (- 70 percent) ?-) + (make-string (- erlang-skel-separator-length percent) ?-) "\n"))) (defun erlang-skel-double-separator (&optional percent) "Return a comment separator." (let ((percent (or percent 3))) (concat (make-string percent ?%) - (make-string (- 70 percent) ?=) + (make-string (- erlang-skel-separator-length percent) ?=) "\n"))) (defun erlang-skel-dd-mmm-yyyy () @@ -2759,10 +2362,10 @@ can contain other `tempo' attributes. Please see the function The first character of DD is space if the value is less than 10." (let ((date (current-time-string))) (format "%2d %s %s" - (string-to-int (substring date 8 10)) + (erlang-string-to-int (substring date 8 10)) (substring date 4 7) (substring date -4)))) - + ;; Indentation code: (defun erlang-indent-command (&optional whole-exp) @@ -2813,8 +2416,9 @@ Return the amount the indentation changed by." ((eq indent t) ;; This should never occur here. (error "Erlang mode error")) - ((= (char-syntax (following-char)) ?\)) - (setq indent (1- indent)))) + ;;((= (char-syntax (following-char)) ?\)) + ;; (setq indent (1- indent))) + ) (setq shift-amt (- indent (current-column))))) (if (zerop shift-amt) nil @@ -2828,7 +2432,7 @@ Return the amount the indentation changed by." (defun erlang-indent-region (beg end) - "Indent region of erlang code. + "Indent region of Erlang code. This is automagically called by the user level function `indent-region'." (interactive "r") @@ -2846,7 +2450,10 @@ This is automagically called by the user level function `indent-region'." ;; Parse the Erlang code from the beginning of the clause to ;; the beginning of the region. (while (< (point) indent-point) - (setq state (erlang-partial-parse (point) indent-point state))) + (let ((pt (point))) + (setq state (erlang-partial-parse pt indent-point state)) + (if (= pt (point)) + (error "Illegal syntax")))) ;; Indent every line in the region (while continue (goto-char indent-point) @@ -2867,8 +2474,9 @@ This is automagically called by the user level function `indent-region'." ((eq indent t) ;; This should never occur here. (error "Erlang mode error")) - ((= (char-syntax (following-char)) ?\)) - (setq indent (1- indent)))))) + ;;((= (char-syntax (following-char)) ?\)) + ;; (setq indent (1- indent))) + ))) (if (zerop (- indent (current-column))) nil (delete-region indent-point (point)) @@ -2881,8 +2489,11 @@ This is automagically called by the user level function `indent-region'." (if (>= from-end (- (point-max) indent-point)) (setq continue nil) (while (< (point) indent-point) - (setq state (erlang-partial-parse - (point) indent-point state)))))))) + (let ((pt (point))) + (setq state (erlang-partial-parse + pt indent-point state)) + (if (= pt (point)) + (error "Illegal syntax"))))))))) (defun erlang-indent-current-buffer () @@ -2929,7 +2540,10 @@ Return nil if line starts inside string, t if in a comment." (goto-char parse-start) (erlang-beginning-of-clause)) (while (< (point) indent-point) - (setq state (erlang-partial-parse (point) indent-point state))) + (let ((pt (point))) + (setq state (erlang-partial-parse pt indent-point state)) + (if (= pt (point)) + (error "Illegal syntax")))) (erlang-calculate-stack-indent indent-point state)))) (defun erlang-show-syntactic-information () @@ -2966,37 +2580,78 @@ Value is list (stack token-start token-type in-what)." ;; Word constituent: check and handle keywords. ((= cs ?w) - (if (looking-at "\\(end\\|after\\)[^_a-zA-Z0-9]") - ;; Must pop top icr layer, `after' will push a new - ;; layer next. - (progn - (while (and stack (eq (car (car stack)) '->)) - (erlang-pop stack)) - (if (and stack (memq (car (car stack)) '(icr begin))) - (erlang-pop stack)))) - (cond ((looking-at - "\\(if\\|case\\|receive\\|after\\)[^_a-zA-Z0-9]") + (cond ((looking-at "\\(end\\|after\\)[^_a-zA-Z0-9]") + ;; Must pop top icr layer, `after' will push a new + ;; layer next. + (progn + (while (and stack (eq (car (car stack)) '->)) + (erlang-pop stack)) + (if (and stack (memq (car (car stack)) '(icr begin fun try))) + (erlang-pop stack)))) + ((looking-at "catch\\b.*of") + t) + ((looking-at "catch\\b\\s *\\($\\|%\\|.*->\\)") + ;; Must pop top icr layer, `catch' in try/catch + ;;will push a new layer next. + (progn + (while (and stack (eq (car (car stack)) '->)) + (erlang-pop stack)) + (if (and stack (memq (car (car stack)) '(icr begin try))) + (erlang-pop stack)))) + ) + (cond ((looking-at "\\(if\\|case\\|receive\\)[^_a-zA-Z0-9]") ;; Must push a new icr (if/case/receive) layer. (erlang-push (list 'icr token (current-column)) stack)) + ((looking-at "\\(try\\|after\\)[^_a-zA-Z0-9]") + ;; Must handle separately, try catch or try X of -> catch + ;; same for `after', it could be + ;; receive after Time -> X end, or + ;; try after X end + (erlang-push (list 'try token (current-column)) stack)) + ((looking-at "\\(of\\)[^_a-zA-Z0-9]") + ;; Must handle separately, try X of -> catch + (if (and stack (eq (car (car stack)) 'try)) + (let ((try-column (nth 2 (car stack))) + (try-pos (nth 1 (car stack)))) + (erlang-pop stack) + (erlang-push (list 'icr try-pos try-column) stack)))) + ((looking-at "\\(fun\\)[^_a-zA-Z0-9]") - ;; Puch a new icr layer if we are defining a `fun' + ;; Push a new layer if we are defining a `fun' ;; expression, not when we are refering an existing - ;; function. + ;; function. 'fun's defines are only indented one level now. (if (save-excursion (goto-char (match-end 1)) (erlang-skip-blank to) + ;; Use erlang-variable-regexp here to look for an + ;; optional variable name to match EEP37 named funs. + (if (looking-at erlang-variable-regexp) + (progn + (goto-char (match-end 0)) + (erlang-skip-blank to))) (eq (following-char) ?\()) - (erlang-push (list 'icr token (current-column)) stack))) - ((looking-at "\\(begin\\|query\\)[^_a-zA-Z0-9]") + (erlang-push (list 'fun token (current-column)) stack))) + ((looking-at "\\(begin\\)[^_a-zA-Z0-9]") (erlang-push (list 'begin token (current-column)) stack)) - ((looking-at "when[^_a-zA-Z0-9][^->\.]*->") - (erlang-push (list 'when token (current-column)) stack))) + ;; Normal when case + ;;((looking-at "when\\s ") + ;;((looking-at "when\\s *\\($\\|%\\)") + ((looking-at "when[^_a-zA-Z0-9]") + (erlang-push (list 'when token (current-column)) stack)) + ((looking-at "catch\\b.*of") + t) + ((looking-at "catch\\b\\s *\\($\\|%\\|.*->\\)") + (erlang-push (list 'icr token (current-column)) stack)) + ;;(erlang-push (list '-> token (current-column)) stack)) + ;;((looking-at "^of$") + ;; (erlang-push (list 'icr token (current-column)) stack) + ;;(erlang-push (list '-> token (current-column)) stack)) + ) (forward-sexp 1)) - - ;; String: Try to skip over it. (Catch error if not complete.) - ((= cs ?\") - (condition-case nil - (progn + ;; String: Try to skip over it. (Catch error if not complete.) + ((= cs ?\") + (condition-case nil + (progn (forward-sexp 1) (if (> (point) to) (progn @@ -3006,49 +2661,71 @@ Value is list (stack token-start token-type in-what)." (setq in-what 'string) (goto-char to)))) - ;; Symbol constituent, punctuation, or expression prefix? - ((memq cs '(?. ?_ ?')) + ;; Expression prefix e.i. $ or ^ (Note ^ can be in the character + ;; literal $^ or part of string and $ outside of a string denotes + ;; a character literal) + ((= cs ?') + (cond + ((= (following-char) ?\") ;; $ or ^ was the last char in a string + (forward-char 1)) + (t + ;; Maybe a character literal, quote the next char to avoid + ;; situations as $" being seen as the begining of a string. + ;; Note the quoting something in the middle of a string is harmless. + (quote (following-char)) + (forward-char 1)))) + + ;; Symbol constituent or punctuation + + ((memq cs '(?. ?_)) (cond ;; Clause end ((= (following-char) ?\;) + (if (eq (car (car (last stack))) 'spec) + (while (memq (car (car stack)) '(when ::)) + (erlang-pop stack))) (if (and stack (eq (car (car stack)) '->)) (erlang-pop stack)) (forward-char 1)) + ;; Parameter separator + ((looking-at ",") + (forward-char 1) + (if (and stack (eq (car (car stack)) '::)) + ;; Type or spec + (erlang-pop stack))) + ;; Function end ((looking-at "\\.\\(\\s \\|\n\\|\\s<\\)") (setq stack nil) (forward-char 1)) ;; Function head - ((looking-at "->\\|:-") + ((looking-at "->") (if (and stack (eq (car (car stack)) 'when)) (erlang-pop stack)) (erlang-push (list '-> token (current-column)) stack) - (forward-char 2)) + (forward-char 2)) ;; List-comprehension divider ((looking-at "||") (erlang-push (list '|| token (current-column)) stack) (forward-char 2)) + + ;; Bit-syntax open. Note that map syntax allows "<<" to follow ":=" + ;; or "=>" without intervening whitespace, so handle that case here + ((looking-at "\\(:=\\|=>\\)?<<") + (erlang-push (list '<< token (current-column)) stack) + (forward-char (- (match-end 0) (match-beginning 0)))) - ;; Parameter separator - ((looking-at ",") - (forward-char 1)) - - ;; Bit-syntax open paren - ((looking-at "<<") - (erlang-push (list '\( token (current-column)) stack) - (forward-char 2)) - - ;; Bbit-syntax close paren + ;; Bit-syntax close ((looking-at ">>") (while (memq (car (car stack)) '(|| ->)) (erlang-pop stack)) - (cond ((eq (car (car stack)) '\() + (cond ((eq (car (car stack)) '<<) (erlang-pop stack)) - ((memq (car (car stack)) '(icr begin)) + ((memq (car (car stack)) '(icr begin fun)) (error "Missing `end'")) (t (error "Unbalanced parentheses"))) @@ -3056,14 +2733,34 @@ Value is list (stack token-start token-type in-what)." ;; Macro ((= (following-char) ??) - ;; Skip over macro name and any following whitespace. - (forward-word 1) - (skip-syntax-forward "-" to) - ;; Macro might have an argument list. Should be handled like - ;; an ordinary function argument list in consecutive calls - ;; to erlang-partial-parse. + ;; Skip over the ? + (forward-char 1) ) - + + ;; Type spec's + ((looking-at "-type\\s \\|-opaque\\s ") + (if stack + (forward-char 1) + (erlang-push (list 'icr token (current-column)) stack) + (forward-char 6))) + ((looking-at "-spec\\s ") + (if stack + (forward-char 1) + (forward-char 6) + (skip-chars-forward "^(\n") + (erlang-push (list 'spec (point) (current-column)) stack) + )) + + ;; Type spec delimiter + ((looking-at "::") + (erlang-push (list ':: token (current-column)) stack) + (forward-char 2)) + + ;; Don't follow through in the clause below + ;; '|' don't need spaces around it + ((looking-at "|") + (forward-char 1)) + ;; Other punctuation: Skip over it and any following punctuation ((= cs ?.) ;; Skip over all characters in the operand. @@ -3080,16 +2777,30 @@ Value is list (stack token-start token-type in-what)." ;; Close parenthesis ((= cs ?\)) - (while (memq (car (car stack)) '(|| ->)) + (while (memq (car (car stack)) '(|| -> :: when)) (erlang-pop stack)) (cond ((eq (car (car stack)) '\() - (erlang-pop stack)) - ((memq (car (car stack)) '(icr begin)) + (erlang-pop stack) + (if (and (eq (car (car stack)) 'fun) + (or (eq (car (car (last stack))) 'spec) + (eq (car (car (cdr stack))) '::))) ;; -type() + ;; Inside fun type def ') closes fun definition + (erlang-pop stack))) + ((eq (car (car stack)) 'icr) + (erlang-pop stack) + ;; Normal catch not try-catch might have caused icr + ;; and then incr should be removed and is not an error. + (if (eq (car (car stack)) '\() + (erlang-pop stack) + (error "Missing `end'") + )) + ((eq (car (car stack)) 'begin) (error "Missing `end'")) (t - (error "Unbalanced parenthesis"))) - (forward-char 1)) - + (error "Unbalanced parenthesis")) + ) + (forward-char 1)) + ;; Character quote: Skip it and the quoted char. ((= cs ?/) (forward-char 2)) @@ -3098,7 +2809,7 @@ Value is list (stack token-start token-type in-what)." ((= cs ?\\) (forward-char 1) (skip-syntax-forward "w")) - + ;; Everything else (t (forward-char 1))) @@ -3108,120 +2819,222 @@ Value is list (stack token-start token-type in-what)." "From the given last position and state (stack) calculate indentation. Return nil if inside string, t if in a comment." (let* ((stack (and state (car state))) - (token (nth 1 state)) - (stack-top (and stack (car stack)))) - (cond ((null state) ;No state - 0) - ((nth 3 state) - ;; Return nil or t. - (eq (nth 3 state) 'comment)) - ((null stack) - (if (looking-at "when[^_a-zA-Z0-9]") - erlang-indent-guard - 0)) - ((eq (car stack-top) '\() - ;; Element of list, tuple or part of an expression, - (if (null erlang-argument-indent) - ;; indent to next column. - (1+ (nth 2 stack-top)) - (goto-char (nth 1 stack-top)) - (cond ((looking-at "[({]\\s *\\($\\|%\\)") - ;; Line ends with parenthesis. - (+ (erlang-indent-find-preceding-expr) - erlang-argument-indent)) - (t - ;; Indent to the same column as the first - ;; argument. - (goto-char (1+ (nth 1 stack-top))) - (skip-chars-forward " \t") - (current-column))))) - ((eq (car stack-top) 'icr) - ;; The default indentation is the column of the option - ;; directly following the keyword. (This does not apply to - ;; `case'.) Should no option be on the same line, the - ;; indentation is the indentation of the keyword + - ;; `erlang-indent-level'. - ;; - ;; `after' should be indentated to the save level as the - ;; corresponding receive. - (if (looking-at "after[^_a-zA-Z0-9]") + (token (nth 1 state)) + (stack-top (and stack (car stack)))) + (cond ((null state) ;No state + 0) + ((nth 3 state) + ;; Return nil or t. + (eq (nth 3 state) 'comment)) + ((null stack) + (if (looking-at "when[^_a-zA-Z0-9]") + erlang-indent-guard + 0)) + ((eq (car stack-top) '\() + ;; Element of list, tuple or part of an expression, + (cond ((null erlang-argument-indent) + ;; indent to next column. + (1+ (nth 2 stack-top))) + ((= (char-syntax (following-char)) ?\)) + (goto-char (nth 1 stack-top)) + (cond ((looking-at "[({]\\s *\\($\\|%\\)") + ;; Line ends with parenthesis. + (let ((previous (erlang-indent-find-preceding-expr)) + (stack-pos (nth 2 stack-top))) + (if (>= previous stack-pos) stack-pos + (- (+ previous erlang-argument-indent) 1)))) + (t + (nth 2 stack-top)))) + ((= (following-char) ?,) + ;; a comma at the start of the line: line up with opening parenthesis. + (nth 2 stack-top)) + (t + (goto-char (nth 1 stack-top)) + (let ((base (cond ((looking-at "[({]\\s *\\($\\|%\\)") + ;; Line ends with parenthesis. + (erlang-indent-parenthesis (nth 2 stack-top))) + (t + ;; Indent to the same column as the first + ;; argument. + (goto-char (1+ (nth 1 stack-top))) + (skip-chars-forward " \t") + (current-column))))) + (erlang-indent-standard indent-point token base 't))))) + ;; + ((eq (car stack-top) '<<) + ;; Element of binary (possible comprehension) expression, + (cond ((null erlang-argument-indent) + ;; indent to next column. + (+ 2 (nth 2 stack-top))) + ((looking-at "\\(>>\\)[^_a-zA-Z0-9]") + (nth 2 stack-top)) + (t + (goto-char (nth 1 stack-top)) + ;; Indent to the same column as the first + ;; argument. + (goto-char (+ 2 (nth 1 stack-top))) + (skip-chars-forward " \t") + (current-column)))) + + ((memq (car stack-top) '(icr fun spec)) + ;; The default indentation is the column of the option + ;; directly following the keyword. (This does not apply to + ;; `case'.) Should no option be on the same line, the + ;; indentation is the indentation of the keyword + + ;; `erlang-indent-level'. + ;; + ;; `after' should be indented to the same level as the + ;; corresponding receive. + (cond ((looking-at "\\(after\\|of\\)\\($\\|[^_a-zA-Z0-9]\\)") + (nth 2 stack-top)) + ((looking-at "when[^_a-zA-Z0-9]") + ;; Handling one when part + (+ (nth 2 stack-top) erlang-indent-level erlang-indent-guard)) + (t + (save-excursion + (goto-char (nth 1 stack-top)) + (if (looking-at "case[^_a-zA-Z0-9]") + (+ (nth 2 stack-top) erlang-indent-level) + (skip-chars-forward "a-z") + (skip-chars-forward " \t") + (if (memq (following-char) '(?% ?\n)) + (+ (nth 2 stack-top) erlang-indent-level) + (current-column)))))) + ) + ((and (eq (car stack-top) '||) (looking-at "\\(]\\|>>\\)[^_a-zA-Z0-9]")) + (nth 2 (car (cdr stack)))) + ;; Real indentation, where operators create extra indentation etc. + ((memq (car stack-top) '(-> || try begin)) + (if (looking-at "\\(of\\)[^_a-zA-Z0-9]") (nth 2 stack-top) - (save-excursion - (goto-char (nth 1 stack-top)) - (if (looking-at "case[^_a-zA-Z0-9]") - (+ (nth 2 stack-top) erlang-indent-level) - (skip-chars-forward "a-z") - (skip-chars-forward " \t") - (if (memq (following-char) '(?% ?\n)) - (+ (nth 2 stack-top) erlang-indent-level) - (current-column)))))) - ;; Real indentation, where operators create extra indentation etc. - ((memq (car stack-top) '(-> || begin)) - (goto-char (nth 1 stack-top)) - ;; Check if there is more code after the '->' on the - ;; same line. If so use this indentation as base, else - ;; use parent indentation + 2 * level as base. - (let ((off erlang-indent-level) - (skip 2)) - (cond ((null (cdr stack))) ; Top level in function. - ((eq (car stack-top) 'begin) - (setq skip 5)) - ((eq (car stack-top) '->) - (setq off (* 2 erlang-indent-level)))) - (let ((base (erlang-indent-find-base stack indent-point off skip))) - ;; Look at last thing to see how we are to move relative - ;; to the base. - (goto-char token) - (cond ((looking-at "||\\|,\\|->\\|:-") - base) - ((erlang-at-keyword) - (+ (current-column) erlang-indent-level)) - ((or (= (char-syntax (following-char)) ?.) - (erlang-at-operator)) - (+ base erlang-indent-level)) - (t - (goto-char indent-point) - (cond ((memq (following-char) '(?\( ?{)) - ;; Function application or record. - (+ (erlang-indent-find-preceding-expr) - erlang-argument-indent)) - ;; Empty line, or end; treat it as the end of - ;; the block. (Here we have a choice: should - ;; the user be forced to reindent continued - ;; lines, or should the "end" be reindented?) - ((looking-at "\\(end\\|after\\)[^_a-zA-Z0-9]\\|$") - (if (eq (car (car stack)) '->) - (erlang-pop stack)) - (if stack - (erlang-caddr (car stack)) - 0)) - ;; Avoid trating comments a continued line. - ((= (following-char) ?%) - base) - ;; Continued line (e.g. line beginning - ;; with an operator.) - (t (+ base erlang-indent-level)))))))) + (goto-char (nth 1 stack-top)) + ;; Check if there is more code after the '->' on the + ;; same line. If so use this indentation as base, else + ;; use parent indentation + 2 * level as base. + (let ((off erlang-indent-level) + (skip 2)) + (cond ((null (cdr stack))) ; Top level in function. + ((eq (car stack-top) 'begin) + (setq skip 5)) + ((eq (car stack-top) 'try) + (setq skip 5)) + ((eq (car stack-top) '->) + ;; If in fun definition use standard indent level not double + ;;(if (not (eq (car (car (cdr stack))) 'fun)) + ;; Removed it made multi clause fun's look to bad + (setq off (* 2 erlang-indent-level)))) ;; ) + (let ((base (erlang-indent-find-base stack indent-point off skip))) + ;; Special cases + (goto-char indent-point) + (cond ((looking-at "\\(end\\|after\\)\\($\\|[^_a-zA-Z0-9]\\)") + (if (eq (car stack-top) '->) + (erlang-pop stack)) + (if stack + (erlang-caddr (car stack)) + 0)) + ((looking-at "catch\\b\\($\\|[^_a-zA-Z0-9]\\)") + ;; Are we in a try + (let ((start (if (eq (car stack-top) '->) + (car (cdr stack)) + stack-top))) + (if (null start) nil + (goto-char (nth 1 start))) + (cond ((looking-at "try\\($\\|[^_a-zA-Z0-9]\\)") + (progn + (if (eq (car stack-top) '->) + (erlang-pop stack)) + (if stack + (erlang-caddr (car stack)) + 0))) + (t (erlang-indent-standard indent-point token base 'nil))))) ;; old catch + (t + (erlang-indent-standard indent-point token base 'nil) + )))) + )) ((eq (car stack-top) 'when) (goto-char (nth 1 stack-top)) (if (looking-at "when\\s *\\($\\|%\\)") (progn (erlang-pop stack) - (if (and stack (eq (nth 0 (car stack)) 'icr)) + (if (and stack (memq (nth 0 (car stack)) '(icr fun))) (progn (goto-char (nth 1 (car stack))) (+ (nth 2 (car stack)) erlang-indent-guard ;; receive XYZ or receive ;; XYZ - (if (looking-at "[a-z]+\\s *\\($\\|%\\)") - erlang-indent-level - (* 2 erlang-indent-level)))) - erlang-indent-guard)) - ;; "when" is followed by code, let's indent to the same - ;; column. - (forward-char 4) ; Skip "when" - (skip-chars-forward " \t") - (current-column)))))) + ;; This if thing does not seem to be needed + ;;(if (looking-at "[a-z]+\\s *\\($\\|%\\)") + ;; erlang-indent-level + ;; (* 2 erlang-indent-level)))) + (* 2 erlang-indent-level))) + ;;erlang-indent-level)) + (+ erlang-indent-level erlang-indent-guard))) + ;; "when" is followed by code, let's indent to the same + ;; column. + (forward-char 4) ; Skip "when" + (skip-chars-forward " \t") + (current-column))) + ;; Type and Spec indentation + ((eq (car stack-top) '::) + (if (looking-at "}") + ;; Closing record definition with types + ;; pop stack and recurse + (erlang-calculate-stack-indent indent-point + (cons (erlang-pop stack) (cdr state))) + (cond ((null erlang-argument-indent) + ;; indent to next column. + (+ 2 (nth 2 stack-top))) + ((looking-at "::[^_a-zA-Z0-9]") + (nth 2 stack-top)) + (t + (let ((start-alternativ (if (looking-at "|") 2 0))) + (goto-char (nth 1 stack-top)) + (- (cond ((looking-at "::\\s *\\($\\|%\\)") + ;; Line ends with :: + (if (eq (car (car (last stack))) 'spec) + (+ (erlang-indent-find-preceding-expr 1) + erlang-argument-indent) + (+ (erlang-indent-find-preceding-expr 2) + erlang-argument-indent))) + (t + ;; Indent to the same column as the first + ;; argument. + (goto-char (+ 2 (nth 1 stack-top))) + (skip-chars-forward " \t") + (current-column))) start-alternativ)))))) + ))) +(defun erlang-indent-standard (indent-point token base inside-parenthesis) + "Standard indent when in blocks or tuple or arguments. + Look at last thing to see in what state we are, move relative to the base." + (goto-char token) + (cond ((looking-at "||\\|,\\|->\\||") + base) + ((erlang-at-keyword) + (+ (current-column) erlang-indent-level)) + ((or (= (char-syntax (following-char)) ?.) + (erlang-at-operator)) + (+ base erlang-indent-level)) + (t + (goto-char indent-point) + (cond ((memq (following-char) '(?\( )) + ;; Function application. + (+ (erlang-indent-find-preceding-expr) + erlang-argument-indent)) + ;; Empty line, or end; treat it as the end of + ;; the block. (Here we have a choice: should + ;; the user be forced to reindent continued + ;; lines, or should the "end" be reindented?) + + ;; Avoid treating comments a continued line. + ((= (following-char) ?%) + base) + ;; Continued line (e.g. line beginning + ;; with an operator.) + (t + (if (or (erlang-at-operator) (not inside-parenthesis)) + (+ base erlang-indent-level) + base)))))) (defun erlang-indent-find-base (stack indent-point &optional offset skip) "Find the base column for current stack." @@ -3230,37 +3043,86 @@ Return nil if inside string, t if in a comment." (save-excursion (let* ((stack-top (car stack))) (goto-char (nth 1 stack-top)) - (forward-char skip) - (if (looking-at "\\s *\\($\\|%\\)") - (progn - (if (memq (car stack-top) '(-> ||)) - (erlang-pop stack)) - ;; Take parent identation + offset, - ;; else just erlang-indent-level if no parent - (if stack - (+ (erlang-caddr (car stack)) - offset) - erlang-indent-level)) - (erlang-skip-blank indent-point) - (current-column))))) + (if (< skip (- (point-max) (point))) + (progn + (forward-char skip) + (if (looking-at "\\s *\\($\\|%\\)") + (progn + (if (memq (car stack-top) '(-> ||)) + (erlang-pop stack)) + ;; Take parent identation + offset, + ;; else just erlang-indent-level if no parent + (if stack + (+ (erlang-caddr (car stack)) + offset) + erlang-indent-level)) + (erlang-skip-blank indent-point) + (current-column))) + (+ (current-column) skip))))) ;; Does not handle `begin' .. `end'. -(defun erlang-indent-find-preceding-expr () +(defun erlang-indent-find-preceding-expr (&optional arg) "Return the first column of the preceding expression. This assumes that the preceding expression is either simple \(i.e. an atom) or parenthesized." (save-excursion - (forward-sexp -1) + (or arg (setq arg 1)) + (ignore-errors (forward-sexp (- arg))) (let ((col (current-column))) (skip-chars-backward " \t") - ;; Needed to match the colon in "'foo':'bar'". - (if (not (memq (preceding-char) '(?# ?:))) - col - (backward-char 1) - (forward-sexp -1) - (current-column))))) + ;; Special hack to handle: (note line break) + ;; [#myrecord{ + ;; foo = foo}] + ;; where the call (forward-sexp -1) will fail when point is at the `#'. + (or + (ignore-errors + ;; Needed to match the colon in "'foo':'bar'". + (cond ((eq (preceding-char) ?:) + (backward-char 1) + (forward-sexp -1) + (current-column)) + ((eq (preceding-char) ?#) + ;; We may now be at: + ;; - either a construction of a new record + ;; - or update of a record, in which case we want + ;; the column of the expression to be updated. + ;; + ;; To see which of the two cases we are at, we first + ;; move an expression backwards, check for keywords, + ;; then immediately an expression forwards. Moving + ;; backwards skips past tokens like `,' or `->', but + ;; when moving forwards again, we won't skip past such + ;; tokens. We use this: if, after having moved + ;; forwards, we're back where we started, then it was + ;; a record update. + ;; The check for keywords is to detect cases like: + ;; case Something of #record_construction{...} + (backward-char 1) + (let ((record-start (point)) + (record-start-col (current-column))) + (forward-sexp -1) + (let ((preceding-expr-col (current-column)) + ;; white space definition according to erl_scan + (white-space "\000-\040\200-\240")) + (if (erlang-at-keyword) + ;; The (forward-sexp -1) call moved past a keyword + (1+ record-start-col) + (forward-sexp 1) + (skip-chars-forward white-space record-start) + ;; Are we back where we started? If so, it was an update. + (if (= (point) record-start) + preceding-expr-col + (goto-char record-start) + (1+ (current-column))))))) + (t col))) + col)))) +(defun erlang-indent-parenthesis (stack-position) + (let ((previous (erlang-indent-find-preceding-expr))) + (if (> previous stack-position) + (+ stack-position erlang-argument-indent) + (+ previous erlang-argument-indent)))) (defun erlang-skip-blank (&optional lim) "Skip over whitespace and comments until limit reached." @@ -3280,18 +3142,18 @@ This assumes that the preceding expression is either simple (defun erlang-at-keyword () "Are we looking at an Erlang keyword which will increase indentation?" - (looking-at (concat "\\(when\\|if\\|fun\\|case\\|begin\\|query\\|" - "of\\|receive\\|after\\|catch\\)[^_a-zA-Z0-9]"))) + (looking-at (concat "\\(when\\|if\\|fun\\|case\\|begin\\|" + "of\\|receive\\|after\\|catch\\|try\\)\\b"))) (defun erlang-at-operator () "Are we looking at an Erlang operator?" (looking-at - "\\(bnot\\|div\\|mod\\|band\\|bor\\|bxor\\|bsl\\|bsr\\)[^_a-zA-Z0-9]")) + "\\(bnot\\|div\\|mod\\|band\\|bor\\|bxor\\|bsl\\|bsr\\)\\b")) (defun erlang-comment-indent () - "Compute erlang comment indentation. + "Compute Erlang comment indentation. -Used both by `indent-for-comment' and the erlang specific indentation +Used both by `indent-for-comment' and the Erlang specific indentation commands." (cond ((looking-at "%%%") 0) ((looking-at "%%") @@ -3302,7 +3164,7 @@ commands." (skip-chars-backward " \t") (max (if (bolp) 0 (1+ (current-column))) comment-column))))) - + ;;; Erlang movement commands ;; All commands below work as movement commands. I.e. if the point is @@ -3336,7 +3198,7 @@ Return t unless search stops due to end of buffer." (forward-char 1)))) ;; The regexp matches a function header that isn't ;; included in a string. - (and (re-search-forward "\\(\\`\\|\\`\n\\|[^\\]\n\\)\\([a-z]\\|'\\|-\\)" + (and (re-search-forward "\\(\\`\\|\\`\n\\|[^\\]\n\\)\\(-?[a-z]\\|'\\|-\\)" nil 'move (- arg)) (let ((beg (match-beginning 2))) (and beg (goto-char beg)) @@ -3366,7 +3228,7 @@ With argument, do this that many times." (interactive) (push-mark (point)) (erlang-end-of-clause 1) - ;; Sets the region. In Emacs 19 and XEmacs, we wants to activate + ;; Sets the region. In Emacs 19 and XEmacs, we want to activate ;; the region. (condition-case nil (push-mark (point) nil t) @@ -3470,20 +3332,23 @@ With negative argument go towards the beginning of the buffer." (goto-char (point-min))))) (setq arg (1+ arg))))) -(defun erlang-mark-function () - "Put mark at end of function, point at beginning." - (interactive) - (push-mark (point)) - (erlang-end-of-function 1) - ;; Sets the region. In Emacs 19 and XEmacs, we wants to activate - ;; the region. - (condition-case nil - (push-mark (point) nil t) - (error (push-mark (point)))) - (erlang-beginning-of-function 1) - ;; The above function deactivates the mark. - (if (boundp 'deactivate-mark) - (funcall (symbol-function 'set) 'deactivate-mark nil))) +(eval-and-compile + (if (default-boundp 'beginning-of-defun-function) + (defalias 'erlang-mark-function 'mark-defun) + (defun erlang-mark-function () + "Put mark at end of function, point at beginning." + (interactive) + (push-mark (point)) + (erlang-end-of-function 1) + ;; Sets the region. In Emacs 19 and XEmacs, we want to activate + ;; the region. + (condition-case nil + (push-mark (point) nil t) + (error (push-mark (point)))) + (erlang-beginning-of-function 1) + ;; The above function deactivates the mark. + (if (boundp 'deactivate-mark) + (funcall (symbol-function 'set) 'deactivate-mark nil))))) (defun erlang-pass-over-function () (while (progn @@ -3503,7 +3368,7 @@ With negative argument go towards the beginning of the buffer." (forward-sexp 1) (buffer-substring start (point))))) - + ;;; Miscellaneous (defun erlang-fill-paragraph (&optional justify) @@ -3566,7 +3431,7 @@ and initial `%':s." (defun erlang-uncomment-region (beg end) "Uncomment all commented lines in the region." (interactive "r") - (comment-region beg end -1)) + (uncomment-region beg end)) (defun erlang-generate-new-clause () @@ -3585,14 +3450,14 @@ the parentheses." (and (erlang-beginning-of-clause) (erlang-get-function-arrow))))) (if (or (null arrow) (null name)) - (error "Can't find name of current Erlang function.")) + (error "Can't find name of current Erlang function")) (if (and (bolp) (eolp)) nil (end-of-line) (newline)) (insert name) (save-excursion - (insert (concat ") " arrow))) + (insert ") " arrow)) (if erlang-new-clause-with-arguments (erlang-clone-arguments)))) @@ -3609,11 +3474,11 @@ at the end." (erlang-get-function-arguments)))) (p (point))) (if (null args) - (error "Can't clone argument list.")) + (error "Can't clone argument list")) (insert args) (set-mark p))) - -;;; Information retreival functions. + +;;; Information retrieval functions. (defun erlang-buffer-substring (beg end) "Like `buffer-substring-no-properties'. @@ -3634,9 +3499,10 @@ Return nil if file contains no `-module' attribute." (let ((md (match-data))) (unwind-protect (if (re-search-forward - (concat "^-module\\s *(\\s *\\(\\(" - erlang-atom-regexp - "\\)?\\)\\s *)\\s *\\.") + (eval-when-compile + (concat "^-module\\s *(\\s *\\(\\(" + erlang-atom-regexp + "\\)?\\)\\s *)\\s *\\.")) (point-max) t) (erlang-remove-quotes (erlang-buffer-substring (match-beginning 1) @@ -3669,9 +3535,9 @@ tags system could be used by files written in other languages." ;; Used by `erlang-get-export' and `erlang-get-import'. (defun erlang-get-function-arity-list () - "Parses list of `function/arity' as used by `-import' and `-export'. + "Parse list of `function/arity' as used by `-import' and `-export'. -The point must be placed at before the opening bracket. When the +Point must be before the opening bracket. When the function returns the point will be placed after the closing bracket. The function does not return an error if the list is incorrectly @@ -3687,15 +3553,15 @@ corresponds to the order of the parsed Erlang list." (while ; Note: `while' has no body. (progn (erlang-skip-blank) - (and (looking-at (concat erlang-atom-regexp - "/\\([0-9]+\\)\\>")) + (and (looking-at (eval-when-compile + (concat erlang-atom-regexp "/\\([0-9]+\\)\\>"))) (progn (setq res (cons (cons (erlang-remove-quotes (erlang-buffer-substring (match-beginning 1) (match-end 1))) - (string-to-int + (erlang-string-to-int (erlang-buffer-substring (match-beginning (+ 1 erlang-atom-regexp-matches)) @@ -3768,34 +3634,34 @@ function and arity as cdr part." If optional argument is non-nil, everything up to and including the first `(' is returned. -Normally used in conjuction with `erlang-beginning-of-clause', e.g.: +Normally used in conjunction with `erlang-beginning-of-clause', e.g.: (save-excursion (if (not (eobp)) (forward-char 1)) (and (erlang-beginning-of-clause) (erlang-get-function-name t)))" (let ((n (if arg 0 1))) - (and (looking-at (concat "^" erlang-atom-regexp "\\s *(")) + (and (looking-at (eval-when-compile + (concat "^" erlang-atom-regexp "\\s *("))) (erlang-buffer-substring (match-beginning n) (match-end n))))) (defun erlang-get-function-arrow () - "Return arrow of current function, could be \"->\", \":-\" or nil. + "Return arrow of current function, could be \"->\" or nil. -The \":-\" arrow is used by mnesia queries. - -Normally used in conjuction with `erlang-beginning-of-clause', e.g.: +Normally used in conjunction with `erlang-beginning-of-clause', e.g.: (save-excursion (if (not (eobp)) (forward-char 1)) (and (erlang-beginning-of-clause) (erlang-get-function-arrow)))" (and (save-excursion - (re-search-forward "[^-:]*-\\|:" (point-max) t) - (erlang-buffer-substring (- (point) 1) (+ (point) 1))))) + (re-search-forward "->" (point-max) t) + (erlang-buffer-substring (- (point) 2) (+ (point) 1))))) (defun erlang-get-function-arity () "Return the number of arguments of function at point, or nil." - (and (looking-at (concat "^" erlang-atom-regexp "\\s *(")) + (and (looking-at (eval-when-compile + (concat "^" erlang-atom-regexp "\\s *("))) (save-excursion (goto-char (match-end 0)) (condition-case nil @@ -3809,6 +3675,10 @@ Normally used in conjuction with `erlang-beginning-of-clause', e.g.: (setq cont nil)) ((looking-at "\\s *\\($\\|%\\)") (forward-line 1)) + ((looking-at "\\s *<<[^>]*?>>") + (when (zerop res) + (setq res (+ 1 res))) + (goto-char (match-end 0))) ((looking-at "\\s *,") (setq res (+ 1 res)) (goto-char (match-end 0))) @@ -3819,9 +3689,17 @@ Normally used in conjuction with `erlang-beginning-of-clause', e.g.: res) (error nil))))) +(defun erlang-get-function-name-and-arity () + "Return the name and arity of the function at point, or nil. +The return value is a string of the form \"foo/1\"." + (let ((name (erlang-get-function-name)) + (arity (erlang-get-function-arity))) + (and name arity (format "%s/%d" name arity)))) + (defun erlang-get-function-arguments () "Return arguments of current function, or nil." - (if (not (looking-at (concat "^" erlang-atom-regexp "\\s *("))) + (if (not (looking-at (eval-when-compile + (concat "^" erlang-atom-regexp "\\s *(")))) nil (save-excursion (condition-case nil @@ -3838,7 +3716,7 @@ Normally used in conjuction with `erlang-beginning-of-clause', e.g.: Should no explicit module name be present at the point, the list of imported functions is searched. -The following could be retured: +The following could be returned: (\"module\" \"function\") -- Both module and function name found. (nil \"function\") -- No module name was found. nil -- No function name found @@ -3850,7 +3728,8 @@ In the future the list may contain more elements." (if (eq (char-syntax (following-char)) ? ) (skip-chars-backward " \t")) (skip-chars-backward "a-zA-Z0-9_:'") - (cond ((looking-at (concat erlang-atom-regexp ":" erlang-atom-regexp)) + (cond ((looking-at (eval-when-compile + (concat erlang-atom-regexp ":" erlang-atom-regexp))) (setq res (list (erlang-remove-quotes (erlang-buffer-substring @@ -3874,13 +3753,18 @@ In the future the list may contain more elements." res))) -;; TODO: Escape single quotes inside the string. +;; TODO: Escape single quotes inside the string without +;; replace-regexp-in-string. (defun erlang-add-quotes-if-needed (str) "Return STR, possibly with quotes." - (if (and (stringp str) - (not (string-match (concat "\\`" erlang-atom-regexp "\\'") str))) - (concat "'" str "'") - str)) + (let ((case-fold-search nil)) ; force string matching to be case sensitive + (if (and (stringp str) + (not (string-match (eval-when-compile + (concat "\\`" erlang-atom-regexp "\\'")) str))) + (progn (if (fboundp 'replace-regexp-in-string) + (setq str (replace-regexp-in-string "'" "\\'" str t t ))) + (concat "'" str "'")) + str))) (defun erlang-remove-quotes (str) @@ -3888,36 +3772,66 @@ In the future the list may contain more elements." (let ((md (match-data))) (prog1 (if (string-match "\\`'\\(.*\\)'\\'" str) - (substring str (match-beginning 1) (match-end 1)) + (substring str 1 -1) str) (store-match-data md)))) - +(defun erlang-match-next-exported-function (max) + "Returns non-nil if there is an exported function in the current +buffer between point and MAX." + (block nil + (while (and (not erlang-inhibit-exported-function-name-face) + (erlang-match-next-function max)) + (when (erlang-last-match-exported-p) + (return (match-data)))))) + +(defun erlang-match-next-function (max) + "Searches forward in current buffer for the next erlang function, +bounded by position MAX." + (re-search-forward erlang-defun-prompt-regexp max 'move-point)) + +(defun erlang-last-match-exported-p () + "Returns non-nil if match-data describes the name and arity of an +exported function." + (save-excursion + (save-match-data + (goto-char (match-beginning 1)) + (erlang-function-exported-p + (erlang-remove-quotes (erlang-get-function-name)) + (erlang-get-function-arity))))) + +(defun erlang-function-exported-p (name arity) + "Returns non-nil if function of name and arity is exported in current buffer." + (save-excursion + (let* ((old-match-data (match-data)) + (exports (erlang-get-export))) + (store-match-data old-match-data) + (member (cons name arity) exports)))) + + ;;; Check module name -;; I don't want to use `advice' since it is not part of Emacs 18. -;; ;; The function `write-file', bound to C-x C-w, calls ;; `set-visited-file-name' which clears the hook. :-( -;; To make sure that the hook always is present, we add a piece of -;; code to the function `set-visited-file-name'. +;; To make sure that the hook always is present, we advise +;; `set-visited-file-name'. (defun erlang-check-module-name-init () "Initialize the functionality to compare file and module names. -We redefines the function `set-visited-file-name' since it clears -the variable `local-write-file-hooks'. The original function definition -is stored in `erlang-orig-set-visited-file-name'." - (if (fboundp 'erlang-orig-set-visited-file-name) - () - (fset 'erlang-orig-set-visited-file-name - (symbol-function 'set-visited-file-name)) - (defun set-visited-file-name (&rest args) - "Please see the function `erlang-orig-set-visited-file-name'." - (interactive "FSet visited file name: ") - (apply (symbol-function 'erlang-orig-set-visited-file-name) args) - (if (eq major-mode 'erlang-mode) - (add-hook 'local-write-file-hooks 'erlang-check-module-name)))) - (add-hook 'local-write-file-hooks 'erlang-check-module-name)) +Unless we have `before-save-hook', we redefine the function +`set-visited-file-name' since it clears the variable +`local-write-file-hooks'. The original function definition is +stored in `erlang-orig-set-visited-file-name'." + (if (boundp 'before-save-hook) + ;; If we have that, `make-local-hook' is obsolete. + (add-hook 'before-save-hook 'erlang-check-module-name nil t) + (require 'advice) + (unless (ad-advised-definition-p 'set-visited-file-name) + (defadvice set-visited-file-name (after erlang-set-visited-file-name + activate) + (if (eq major-mode 'erlang-mode) + (add-hook 'local-write-file-hooks 'erlang-check-module-name)))) + (add-hook 'local-write-file-hooks 'erlang-check-module-name))) (defun erlang-check-module-name () @@ -3928,10 +3842,12 @@ function. It it is nil, this function does nothing. If it is t, the source is silently changed. If it is set to the atom `ask', the user is prompted. -This function is normally placed in the hook `local-write-file-hook'." +This function is normally placed in the hook `local-write-file-hooks'." (if erlang-check-module-name - (let ((mn (erlang-get-module)) - (fn (erlang-get-module-from-file-name (buffer-file-name)))) + (let ((mn (erlang-add-quotes-if-needed + (erlang-get-module))) + (fn (erlang-add-quotes-if-needed + (erlang-get-module-from-file-name (buffer-file-name))))) (if (and (stringp mn) (stringp fn)) (or (string-equal mn fn) (if (or (eq erlang-check-module-name t) @@ -3942,9 +3858,10 @@ This function is normally placed in the hook `local-write-file-hook'." (widen) (goto-char (point-min)) (if (re-search-forward - (concat "^-module\\s *(\\s *\\(\\(" - erlang-atom-regexp - "\\)?\\)\\s *)\\s *\\.") + (eval-when-compile + (concat "^-module\\s *(\\s *\\(\\(" + erlang-atom-regexp + "\\)?\\)\\s *)\\s *\\.")) (point-max) t) (progn (goto-char (match-beginning 1)) @@ -3954,13 +3871,13 @@ This function is normally placed in the hook `local-write-file-hook'." ;; Must return nil since it is added to `local-write-file-hook'. nil) - + ;;; Electric functions. (defun erlang-electric-semicolon (&optional arg) "Insert a semicolon character and possibly a prototype for the next line. -The variable `erlang-electric-semicolon-criteria' states a critera, +The variable `erlang-electric-semicolon-criteria' states a criterion, when fulfilled a newline is inserted, the next line is indented and a prototype for the next line is inserted. Normally the prototype consists of \" ->\". Should the semicolon end the clause a new clause @@ -3986,6 +3903,7 @@ non-whitespace characters following the point on the current line." (setq erlang-electric-newline-inhibit nil) (setq erlang-electric-newline-inhibit t) (undo-boundary) + (erlang-indent-line) (end-of-line) (newline) (if (condition-case nil @@ -4007,8 +3925,8 @@ non-whitespace characters following the point on the current line." (defun erlang-electric-comma (&optional arg) "Insert a comma character and possibly a new indented line. -The variable `erlang-electric-comma-criteria' states a critera, -when fulfilled a newline is inserted and the next line is indeted. +The variable `erlang-electric-comma-criteria' states a criterion, +when fulfilled a newline is inserted and the next line is indented. Behaves just like the normal comma when supplied with a numerical arg, point is inside string or comment, or when there are @@ -4027,6 +3945,7 @@ non-whitespace characters following the point on the current line." (setq erlang-electric-newline-inhibit nil) (setq erlang-electric-newline-inhibit t) (undo-boundary) + (erlang-indent-line) (end-of-line) (newline) (condition-case nil @@ -4041,7 +3960,7 @@ non-whitespace characters following the point on the current line." (self-insert-command arg) ;; Was this the second char in bit-syntax open (`<<')? - (unless (< (point) 2) + (unless (<= (point) 2) (save-excursion (backward-char 2) (when (and (eq (char-after (point)) ?<) @@ -4061,8 +3980,8 @@ non-whitespace characters following the point on the current line." (forward-char 1)))))) (defun erlang-after-bitsyntax-close () - "Returns true if point is placed immediately after a bit-syntax close parenthesis (`>>')." - (and (>= (point) 2) + "Return t if point is immediately after a bit-syntax close parenthesis (`>>')." + (and (>= (point) 3) (save-excursion (backward-char 2) (and (eq (char-after (point)) ?>) @@ -4070,7 +3989,7 @@ non-whitespace characters following the point on the current line." 'bitsyntax-close-outer)))))) (defun erlang-after-arrow () - "Returns true if point is placed immediately after a function arrow (`->')." + "Return true if point is immediately after a function arrow (`->')." (and (>= (point) 2) (and (save-excursion @@ -4125,7 +4044,7 @@ non-whitespace characters following the point on the current line." (defun erlang-electric-arrow\ off (&optional arg) - "Insert a '>'-sign and possible a new indented line. + "Insert a '>'-sign and possibly a new indented line. This command is only `electric' when the `>' is part of an `->' arrow. The variable `erlang-electric-arrow-criteria' states a sequence of @@ -4136,8 +4055,8 @@ It behaves just like the normal greater than sign when supplied with a numerical arg, point is inside string or comment, or when there are non-whitespace characters following the point on the current line. -After being split/merged into erlang-after-arrow and -erlang-electric-gt, it is now unused and disabled." +After being split/merged into `erlang-after-arrow' and +`erlang-electric-gt', it is now unused and disabled." (interactive "P") (let ((prec (preceding-char))) (self-insert-command (prefix-numeric-value arg)) @@ -4162,8 +4081,8 @@ erlang-electric-gt, it is now unused and disabled." (defun erlang-electric-newline (&optional arg) "Break line at point and indent, continuing comment if within one. -The variable `erlang-electric-newline-criteria' states a critera, -when fulfilled a newline is inserted and the next line is indeted. +The variable `erlang-electric-newline-criteria' states a criterion, +when fulfilled a newline is inserted and the next line is indented. Should the current line begin with a comment, and the variable `comment-multi-line' be non-nil, a new comment start is inserted. @@ -4199,20 +4118,20 @@ the user pressed newline out of old habit, hence we will do nothing." (defun erlang-test-criteria-list (criteria) - "Given a list of criteria functions, test if criteria is fulfilled. + "Given a list of criterion functions, test if criteria are fulfilled. Each element in the criteria list can a function returning nil, t or -the atom `stop'. t means that the criteria is fulfilled, `stop' means -that it the criteria isn't fulfilled and that the search should stop, +the atom `stop'. t means that the criterion is fulfilled, `stop' means +that it isn't fulfilled and that the search should stop, and nil means continue searching. -Should the list contain the atom t the criteria is assumed to be +Should the list contain the atom t the criterion is assumed to be fulfilled, unless preceded by a function returning `stop', of course. -Should the argument be the atom t instead of a list, the criteria is +Should the argument be the atom t instead of a list, the criterion is assumed to be trivially true. -Should all function return nil, the criteria is assumed not to be +Should all functions return nil, the criteria are assumed not to be fulfilled. Return t if criteria fulfilled, nil otherwise." @@ -4240,7 +4159,9 @@ context, nil is returned." (let* ((lim (or lim (save-excursion (erlang-beginning-of-clause) (point)))) - (state (parse-partial-sexp lim (point)))) + (state (if (fboundp 'syntax-ppss) ; post Emacs 21.3 + (funcall (symbol-function 'syntax-ppss)) + (parse-partial-sexp lim (point))))) (cond ((eq (nth 3 state) ?') 'atom) ((nth 3 state) 'string) @@ -4257,6 +4178,15 @@ This function is designed to be a member of a criteria list." (erlang-beginning-of-function -1) (point)))) +(defun erlang-at-end-of-clause-p () + "Test if point is at end of an Erlang clause. + +This function is designed to be a member of a criteria list." + (eq (save-excursion (erlang-skip-blank) (point)) + (save-excursion + (erlang-beginning-of-clause -1) (point)))) + + (defun erlang-stop-when-inside-argument-list () "Return `stop' if inside parenthesis list, nil otherwise. @@ -4272,9 +4202,12 @@ This function is designed to be a member of a criteria list." (if (not (eq (following-char) ?\[)) 'stop ;; Do not return `stop' when inside a list comprehension - ;; construnction. (The point must be after `||'). + ;; construction. (The point must be after `||'). (while (< (point) orig-point) - (setq state (erlang-partial-parse (point) orig-point state))) + (let ((pt (point))) + (setq state (erlang-partial-parse pt orig-point state)) + (if (= pt (point)) + (error "Illegal syntax")))) (if (and (car state) (eq (car (car (car state))) '||)) nil 'stop))) @@ -4288,13 +4221,25 @@ This function is designed to be a member of a criteria list." This function is designed to be a member of a criteria list." (save-excursion (beginning-of-line) - (if (and (looking-at (concat "^" erlang-atom-regexp "\\s *(")) + (if (and (looking-at (eval-when-compile + (concat "^" erlang-atom-regexp "\\s *("))) (not (looking-at - (concat "^" erlang-atom-regexp ".*\\(->\\|:-\\)")))) + (eval-when-compile + (concat "^" erlang-atom-regexp ".*->"))))) 'stop nil))) +(defun erlang-stop-when-in-type-spec () + "Return `stop' when in a type spec line. + +This function is designed to be a member of a criteria list." + (save-excursion + (beginning-of-line) + (when (save-match-data (looking-at "-\\(spec\\|type\\|callback\\)")) + 'stop))) + + (defun erlang-next-lines-empty-p () "Return non-nil if next lines are empty. @@ -4323,11 +4268,11 @@ This function is designed to be a member of a criteria list." (erlang-skip-blank) (looking-at "end[^_a-zA-Z0-9]"))) - + ;; Erlang tags support which is aware of erlang modules. ;; ;; Not yet implemented under XEmacs. (Hint: The Emacs 19 etags -;; package work under XEmacs.) +;; package works under XEmacs.) (eval-when-compile (if (or (featurep 'bytecomp) @@ -4352,7 +4297,7 @@ This function is designed to be a member of a criteria list." (defvar erlang-tags-completion-table nil "Like `tags-completion-table', this table contains `tag' and `module:tag'.") (defvar erlang-tags-buffer-installed-p nil - "Non-nil when erlang module recognising functions installed.") + "Non-nil when Erlang module recognising functions installed.") (defvar erlang-tags-buffer-list '() "Temporary list of buffers.") (defvar erlang-tags-orig-completion-table nil @@ -4366,13 +4311,15 @@ This function is designed to be a member of a criteria list." (defvar erlang-tags-orig-regexp-search-function nil "Temporary storage for `find-tag-regexp-search-function'.") (defvar erlang-tags-orig-format-hooks nil - "Temporary storage for `tags-table-format-hooks'.") + "Temporary storage for `tags-table-format-hooks'.") ;v19 +(defvar erlang-tags-orig-format-functions nil + "Temporary storage for `tags-table-format-functions'.") ;v > 19 (defun erlang-tags-init () "Install an alternate version of tags, aware of Erlang modules. After calling this function, the tags functions are aware of -Erlang modules. Tags can be entered on the for `module:tag' aswell +Erlang modules. Tags can be entered on the for `module:tag' as well as on the old form `tag'. In the completion list, `module:tag' and `module:' shows up. @@ -4424,11 +4371,12 @@ works under XEmacs.)" ;; There exists a variable `find-tag-default-function'. It is not used ;; since `complete-tag' uses it to get current word under point. In that -;; situation we doesn't want the module to be prepended. +;; situation we don't want the module to be prepended. (defun erlang-find-tag-default () - "Return the default tag, searches `-import' list of imported functions. -Single quotes has been stripped away." + "Return the default tag. +Search `-import' list of imported functions. +Single quotes are been stripped away." (let ((mod-func (erlang-get-function-under-point))) (cond ((null mod-func) nil) @@ -4441,7 +4389,7 @@ Single quotes has been stripped away." ;; Return `t' since it is used inside `tags-loop-form'. ;;;###autoload (defun erlang-find-tag (modtagname &optional next-p regexp-p) - "Like `find-tag'. Capable of retreiving Erlang modules. + "Like `find-tag'. Capable of retrieving Erlang modules. Tags can be given on the forms `tag', `module:', `module:tag'." (interactive (erlang-tag-interactive "Find `module:tag' or `tag': ")) @@ -4488,7 +4436,7 @@ Tags can be given on the forms `tag', `module:', `module:tag'." (interactive (if (fboundp 'find-tag-regexp) (erlang-tag-interactive "Find `module:regexp' or `regexp': ") - (error "This version of Emacs can't find tags by regexps."))) + (error "This version of Emacs can't find tags by regexps"))) (funcall (if other-window 'erlang-find-tag-other-window 'erlang-find-tag) @@ -4497,6 +4445,7 @@ Tags can be given on the forms `tag', `module:', `module:tag'." ;; Just like C-u M-. This could be added to the menu. (defun erlang-find-next-tag () + "Find next tag, like \\[find-tag] with prefix arg." (interactive) (let ((current-prefix-arg '(4))) (if erlang-tags-installed @@ -4508,11 +4457,11 @@ Tags can be given on the forms `tag', `module:', `module:tag'." ;; be compatible with `tags.el'. ;; ;; Handles three cases: -;; * `module:' Loop over all possible filen-ames. Stop if a file-name +;; * `module:' Loop over all possible file names. Stop if a file-name ;; without extension and directory matches the module. ;; ;; * `module:tag' -;; Emacs 19: Replace testfunctions with functions aware of +;; Emacs 19: Replace test functions with functions aware of ;; Erlang modules. Tricky because the etags system wasn't ;; built for these kind of operations... ;; @@ -4629,25 +4578,36 @@ Tags can be given on the forms `tag', `module:', `module:tag'." (or default (error "There is no default tag")) spec))))) - + ;; Search tag functions which are aware of Erlang modules. The tactic -;; is to store new search functions into the local variabels of the +;; is to store new search functions into the local variables of the ;; TAGS buffers. The variables are restored directly after the ;; search. The situation is complicated by the fact that new TAGS ;; files can be loaded during the search. ;; -;; This code is Emacs 19 `etags' specific. (defun erlang-tags-install-module-check () "Install our own tag search functions." ;; Make sure our functions are installed in TAGS files loaded ;; into Emacs while searching. - (setq erlang-tags-orig-format-hooks - (symbol-value 'tags-table-format-hooks)) - (funcall (symbol-function 'set) 'tags-table-format-hooks - (cons 'erlang-tags-recognize-tags-table - erlang-tags-orig-format-hooks)) - (setq erlang-tags-buffer-list '()) + (cond + ((>= erlang-emacs-major-version 20) + (setq erlang-tags-orig-format-functions + (symbol-value 'tags-table-format-functions)) + (funcall (symbol-function 'set) 'tags-table-format-functions + (cons 'erlang-tags-recognize-tags-table + erlang-tags-orig-format-functions)) + (setq erlang-tags-buffer-list '()) + ) + (t + (setq erlang-tags-orig-format-hooks + (symbol-value 'tags-table-format-hooks)) + (funcall (symbol-function 'set) 'tags-table-format-hooks + (cons 'erlang-tags-recognize-tags-table + erlang-tags-orig-format-hooks)) + (setq erlang-tags-buffer-list '()) + )) + ;; Install our functions in the TAGS files already resident. (save-excursion (let ((files (symbol-value 'tags-table-computed-list))) @@ -4692,9 +4652,18 @@ Tags can be given on the forms `tag', `module:', `module:tag'." (defun erlang-tags-remove-module-check () "Remove our own tags search functions." - (funcall (symbol-function 'set) - 'tags-table-format-hooks - erlang-tags-orig-format-hooks) + (cond + ((>= erlang-emacs-major-version 20) + (funcall (symbol-function 'set) + 'tags-table-format-functions + erlang-tags-orig-format-functions) + ) + (t + (funcall (symbol-function 'set) + 'tags-table-format-hooks + erlang-tags-orig-format-hooks) + )) + ;; Remove our functions from the TAGS files. (Note that ;; `tags-table-computed-list' need not be the same list as when ;; the search was started.) @@ -4727,7 +4696,7 @@ Tags can be given on the forms `tag', `module:', `module:tag'." (defun erlang-tags-recognize-tags-table () "Install our functions in all loaded TAGS files. -This function is added to `tags-table-format-hooks' when searching +This function is added to `tags-table-format-hooks/functions' when searching for a tag on the form `module:tag'." (if (null (funcall (symbol-function 'etags-recognize-tags-table))) nil @@ -4739,7 +4708,7 @@ for a tag on the form `module:tag'." "Forward search function, aware of Erlang module prefix." (if (string-match ":" tag) (setq tag (substring tag (match-end 0) nil))) - ;; Avoid uninteded recursion. + ;; Avoid unintended recursion. (if (eq erlang-tags-orig-search-function 'erlang-tags-search-forward) (search-forward tag bound noerror count) (funcall erlang-tags-orig-search-function tag bound noerror count))) @@ -4785,7 +4754,7 @@ for a tag on the form `module:tag'." (string= mod (erlang-get-module-from-file-name (file-of-tag))))))) - + ;;; Tags completion, Emacs 19 `etags' specific. ;;; ;;; The basic idea is to create a second completion table `erlang-tags- @@ -4793,6 +4762,23 @@ for a tag on the form `module:tag'." ;;; `module:tag'. +(when (and (fboundp 'etags-tags-completion-table) + (fboundp 'tags-lazy-completion-table)) ; Emacs 23.1+ + (if (fboundp 'advice-add) + ;; Emacs 24.4+ + (advice-add 'etags-tags-completion-table :around + (lambda (oldfun) + (if (eq find-tag-default-function 'erlang-find-tag-for-completion) + (erlang-etags-tags-completion-table) + (funcall oldfun))) + (list :name 'erlang-replace-tags-table)) + ;; Emacs 23.1-24.3 + (defadvice etags-tags-completion-table (around erlang-replace-tags-table activate) + (if (eq find-tag-default-function 'erlang-find-tag-for-completion) + (setq ad-return-value (erlang-etags-tags-completion-table)) + ad-do-it)))) + + (defun erlang-complete-tag () "Perform tags completion on the text around point. Completes to the set of names listed in the current tags table. @@ -4804,10 +4790,20 @@ about Erlang modules." (require 'etags) (error nil)) (cond ((and erlang-tags-installed - (fboundp 'complete-tag)) ; Emacs 19 + (fboundp 'etags-tags-completion-table) + (fboundp 'tags-lazy-completion-table)) ; Emacs 23.1+ + ;; This depends on the advice called erlang-replace-tags-table + ;; above. It is not enough to let-bind + ;; tags-completion-table-function since that will not override + ;; the buffer-local value in the TAGS buffer. + (let ((find-tag-default-function 'erlang-find-tag-for-completion)) + (complete-tag))) + ((and erlang-tags-installed + (fboundp 'complete-tag) + (fboundp 'tags-complete-tag)) ; Emacs 19 (let ((orig-tags-complete-tag (symbol-function 'tags-complete-tag))) (fset 'tags-complete-tag - (symbol-function 'erlang-tags-complete-tag)) + (symbol-function 'erlang-tags-complete-tag)) (unwind-protect (funcall (symbol-function 'complete-tag)) (fset 'tags-complete-tag orig-tags-complete-tag)))) @@ -4816,11 +4812,20 @@ about Erlang modules." ((fboundp 'tag-complete-symbol) ; XEmacs (funcall (symbol-function 'tag-complete-symbol))) (t - (error "This version of Emacs can't complete tags.")))) + (error "This version of Emacs can't complete tags")))) + + +(defun erlang-find-tag-for-completion () + (let ((start (save-excursion + (skip-chars-backward "[:word:][:digit:]_:'") + (point)))) + (unless (eq start (point)) + (buffer-substring-no-properties start (point))))) + ;; Based on `tags-complete-tag', but this one uses -;; `erlang-tag-completion-table' instead of `tag-completion-table'. +;; `erlang-tags-completion-table' instead of `tags-completion-table'. ;; ;; This is the entry-point called by system function `completing-read'. (defun erlang-tags-complete-tag (string predicate what) @@ -4860,13 +4865,18 @@ about Erlang modules." ;; Based on `etags-tags-completion-table'. The difference is that we -;; adds three symbols to the vector, the tag, module: and module:tag. +;; add three symbols to the vector, the tag, module: and module:tag. ;; The module is extracted from the file name of a tag. (This one ;; only works if we are looking at an `etags' file. However, this is ;; the only format supported by Emacs, so far.) (defun erlang-etags-tags-completion-table () (let ((table (make-vector 511 0)) - (file nil)) + (file nil) + (progress-reporter + (when (fboundp 'make-progress-reporter) + (make-progress-reporter + (format "Making erlang tags completion table for %s..." buffer-file-name) + (point-min) (point-max))))) (save-excursion (goto-char (point-min)) ;; This monster regexp matches an etags tag line. @@ -4878,33 +4888,35 @@ about Erlang modules." ;; \6 is the line to start searching at; ;; \7 is the char to start searching at. (while (progn - (while (and - (eq (following-char) ?\f) - (looking-at "\f\n\\([^,\n]*\\),.*\n")) - (setq file (buffer-substring - (match-beginning 1) (match-end 1))) - (goto-char (match-end 0))) - (re-search-forward - "\ + (while (and + (eq (following-char) ?\f) + (looking-at "\f\n\\([^,\n]*\\),.*\n")) + (setq file (buffer-substring + (match-beginning 1) (match-end 1))) + (goto-char (match-end 0))) + (re-search-forward + "\ ^\\(\\([^\177]+[^-a-zA-Z0-9_$\177]+\\)?\\([-a-zA-Z0-9_$?:]+\\)\ \[^-a-zA-Z0-9_$?:\177]*\\)\177\\(\\([^\n\001]+\\)\001\\)?\ \\([0-9]+\\)?,\\([0-9]+\\)?\n" - nil t)) - (let ((tag (if (match-beginning 5) - ;; There is an explicit tag name. - (buffer-substring (match-beginning 5) (match-end 5)) - ;; No explicit tag name. Best guess. - (buffer-substring (match-beginning 3) (match-end 3)))) - (module (and file - (erlang-get-module-from-file-name file)))) - (intern tag table) - (if (stringp module) - (progn - (intern (concat module ":" tag) table) - ;; Only the first one will be stored in the table. - (intern (concat module ":") table)))))) + nil t)) + (let ((tag (if (match-beginning 5) + ;; There is an explicit tag name. + (buffer-substring (match-beginning 5) (match-end 5)) + ;; No explicit tag name. Best guess. + (buffer-substring (match-beginning 3) (match-end 3)))) + (module (and file + (erlang-get-module-from-file-name file)))) + (intern tag table) + (when (stringp module) + (intern (concat module ":" tag) table) + ;; Only the first ones will be stored in the table. + (intern (concat module ":") table) + (intern (concat module ":module_info") table)) + (when progress-reporter + (progress-reporter-update progress-reporter (point)))))) table)) - + ;;; ;;; Prepare for other methods to run an Erlang slave process. ;;; @@ -4927,6 +4939,9 @@ Erlang compilation package.") Change this variable to use your favorite Erlang compilation package.") +(defvar erlang-compile-erlang-function "c" + "Erlang function to call to compile an erlang file.") + (defvar erlang-compile-display-function 'inferior-erlang-run-or-select "Command to execute to view last compilation. @@ -4936,8 +4951,8 @@ Erlang compilation package.") (defvar erlang-next-error-function 'inferior-erlang-next-error "Command to execute to go to the next error. -Change this variable to use your favorite -Erlang compilation package.") +Change this variable to use your favorite Erlang compilation +package. Not used in Emacs 21.") ;;;###autoload @@ -4955,7 +4970,7 @@ future, a new shell on an already running host will be started." ;; It is customary for Emacs packages to supply a function on this ;; form, even though it violates the `erlang-*' name convention. -(fset 'run-erlang 'erlang-shell) +(defalias 'run-erlang 'erlang-shell) (defun erlang-shell-display () @@ -4983,7 +4998,7 @@ future, a new shell on an already running host will be started." (call-interactively erlang-next-error-function)) - + ;;; ;;; Erlang Shell Mode -- Major mode used for Erlang shells. ;;; @@ -4994,11 +5009,10 @@ future, a new shell on an already running host will be started." (defvar erlang-shell-buffer-name "*erlang*" - "*The name of the Erlang link shell buffer.") - + "The name of the Erlang link shell buffer.") (defvar erlang-shell-mode-map nil - "*Keymap used by Erlang shells.") + "Keymap used by Erlang shells.") (defvar erlang-shell-mode-hook nil @@ -5009,22 +5023,22 @@ normally used by the user to personalise the programming environment. When used in a site init file, it could be used to customise Erlang mode for all users on the system. -The functioned added to this hook is runed every time a new Erlang +The function added to this hook is run every time a new Erlang shell is started. -See also `erlang-load-hook', a hook which is runed once, when Erlang -mode is loaded, and `erlang-mode-hook' which is runed every time a new +See also `erlang-load-hook', a hook which is run once, when Erlang +mode is loaded, and `erlang-mode-hook' which is run every time a new Erlang source file is loaded into Emacs.") (defvar erlang-input-ring-file-name "~/.erlang_history" - "*When non-nil, file name used to store erlang shell history information.") + "*When non-nil, file name used to store Erlang shell history information.") (defun erlang-shell-mode () "Major mode for interacting with an Erlang shell. -We assume that we already are in comint-mode. +We assume that we already are in Comint mode. The following special commands are available: \\{erlang-shell-mode-map}" @@ -5037,12 +5051,16 @@ The following special commands are available: (setq erlang-shell-mode-map (copy-keymap comint-mode-map)) (erlang-shell-mode-commands erlang-shell-mode-map)) (use-local-map erlang-shell-mode-map) - (set (make-local-variable 'compilation-parsing-end) 1) - (set (make-local-variable 'compilation-error-list) nil) - (set (make-local-variable 'compilation-old-error-list) nil) + (unless inferior-erlang-use-cmm + ;; This was originally not a marker, but it needs to be, at least + ;; in Emacs 21, and should be backwards-compatible. Otherwise, + ;; would need to test whether compilation-parsing-end is a marker + ;; after requiring `compile'. + (set (make-local-variable 'compilation-parsing-end) (copy-marker 1)) + (set (make-local-variable 'compilation-error-list) nil) + (set (make-local-variable 'compilation-old-error-list) nil)) ;; Needed when compiling directly from the Erlang shell. (setq compilation-last-buffer (current-buffer)) - (erlang-add-compilation-alist erlang-error-regexp-alist) (setq comint-prompt-regexp "^[^>=]*> *") (setq comint-eol-on-send t) (setq comint-input-ignoredups t) @@ -5052,30 +5070,71 @@ The following special commands are available: ;; the call fails, just call the normal `add-hook'. (condition-case nil (progn - (funcall (symbol-function 'add-hook) 'comint-output-filter-functions - 'inferior-erlang-strip-delete nil t) - (funcall (symbol-function 'add-hook) 'comint-output-filter-functions - 'inferior-erlang-strip-ctrl-m nil t)) + (add-hook 'comint-output-filter-functions + 'inferior-erlang-strip-delete nil t) + (add-hook 'comint-output-filter-functions + 'inferior-erlang-strip-ctrl-m nil t)) (error + (funcall (symbol-function 'make-local-hook) + 'comint-output-filter-functions) ; obsolete as of Emacs 21.1 (add-hook 'comint-output-filter-functions 'inferior-erlang-strip-delete) (add-hook 'comint-output-filter-functions 'inferior-erlang-strip-ctrl-m))) - ;; Some older versions of comint doesn't have an input ring. + ;; Some older versions of comint don't have an input ring. (if (fboundp 'comint-read-input-ring) (progn (setq comint-input-ring-file-name erlang-input-ring-file-name) (comint-read-input-ring t) (make-local-variable 'kill-buffer-hook) (add-hook 'kill-buffer-hook 'comint-write-input-ring))) + ;; At least in Emacs 21, we need to be in `compilation-minor-mode' + ;; for `next-error' to work. We can avoid it clobbering the shell + ;; keys thus. + (when inferior-erlang-use-cmm + (compilation-minor-mode 1) + (set (make-local-variable 'minor-mode-overriding-map-alist) + `((compilation-minor-mode + . ,(let ((map (make-sparse-keymap))) + ;; It would be useful to put keymap properties on the + ;; error lines so that we could use RET and mouse-2 + ;; on them directly. + (when (boundp 'compilation-skip-threshold) ; new compile.el + (define-key map [mouse-2] #'erlang-mouse-2-command) + (define-key map "\C-m" #'erlang-RET-command)) + (if (boundp 'compilation-menu-map) + (define-key map [menu-bar compilation] + (cons "Errors" compilation-menu-map))) + map))))) (run-hooks 'erlang-shell-mode-hook)) +(defun erlang-mouse-2-command (event) + "Command bound to `mouse-2' in inferior Erlang buffer. +Selects Comint or Compilation mode command as appropriate." + (interactive "e") + (if (save-window-excursion + (save-excursion + (mouse-set-point event) + (consp (get-text-property (line-beginning-position) 'message)))) + (call-interactively (lookup-key compilation-mode-map [mouse-2])) + (call-interactively (lookup-key comint-mode-map [mouse-2])))) + +(defun erlang-RET-command () + "Command bound to `RET' in inferior Erlang buffer. +Selects Comint or Compilation mode command as appropriate." + (interactive) + (if (consp (get-text-property (line-beginning-position) 'message)) + (call-interactively (lookup-key compilation-mode-map "\C-m")) + (call-interactively (lookup-key comint-mode-map "\C-m")))) + (defun erlang-shell-mode-commands (map) (define-key map "\M-\t" 'erlang-complete-tag) (define-key map "\C-a" 'comint-bol) ; Normally the other way around. (define-key map "\C-c\C-a" 'beginning-of-line) (define-key map "\C-d" nil) ; Was `comint-delchar-or-maybe-eof' - (define-key map "\C-x`" 'erlang-next-error)) - + (define-key map "\M-\C-m" 'compile-goto-error) + (unless inferior-erlang-use-cmm + (define-key map "\C-x`" 'erlang-next-error))) + ;;; ;;; Inferior Erlang -- Run an Erlang shell as a subprocess. ;;; @@ -5102,17 +5161,17 @@ This variable influence the setting of other variables.") This must be a list of strings.") (defvar inferior-erlang-process-name "inferior-erlang" - "*The name of the inferior Erlang process.") + "The name of the inferior Erlang process.") (defvar inferior-erlang-buffer-name erlang-shell-buffer-name - "*The name of the inferior erlang buffer.") + "The name of the inferior Erlang buffer.") (defvar inferior-erlang-prompt-timeout 60 "*Number of seconds before `inferior-erlang-wait-prompt' timeouts. The time specified is waited after every output made by the inferior Erlang shell. When this variable is t, we assume that we always have -a prompt. When nil, we will wait forever, or until C-g.") +a prompt. When nil, we will wait forever, or until \\[keyboard-quit].") (defvar inferior-erlang-process nil "Process of last invoked inferior Erlang, or nil.") @@ -5120,14 +5179,19 @@ a prompt. When nil, we will wait forever, or until C-g.") (defvar inferior-erlang-buffer nil "Buffer of last invoked inferior Erlang, or nil.") +;; Enable uniquifying Erlang shell buffers based on directory name. +(eval-after-load "uniquify" + '(add-to-list 'uniquify-list-buffers-directory-modes 'erlang-shell-mode)) + ;;;###autoload -(defun inferior-erlang () +(defun inferior-erlang (&optional command) "Run an inferior Erlang. +With prefix command, prompt for command to start Erlang with. This is just like running Erlang in a normal shell, except that an Emacs buffer is used for input and output. - -The command line history can be accessed with M-p and M-n. +\\ +The command line history can be accessed with \\[comint-previous-input] and \\[comint-next-input]. The history is saved between sessions. Entry to this mode calls the functions in the variables @@ -5136,28 +5200,49 @@ Entry to this mode calls the functions in the variables The following commands imitate the usual Unix interrupt and editing control characters: \\{erlang-shell-mode-map}" - (interactive) + (interactive + (when current-prefix-arg + (list (if (fboundp 'read-shell-command) + ;; `read-shell-command' is a new function in Emacs 23. + (read-shell-command "Erlang command: ") + (read-string "Erlang command: "))))) (require 'comint) - (let ((opts inferior-erlang-machine-options)) - (cond ((eq inferior-erlang-shell-type 'oldshell) - (setq opts (cons "-oldshell" opts))) - ((eq inferior-erlang-shell-type 'newshell) - (setq opts (append '("-newshell" "-env" "TERM" "vt100") opts)))) - (setq inferior-erlang-buffer - (apply 'make-comint - inferior-erlang-process-name inferior-erlang-machine - nil opts))) + (let (cmd opts) + (if command + (setq cmd "sh" + opts (list "-c" command)) + (setq cmd inferior-erlang-machine + opts inferior-erlang-machine-options) + (cond ((eq inferior-erlang-shell-type 'oldshell) + (setq opts (cons "-oldshell" opts))) + ((eq inferior-erlang-shell-type 'newshell) + (setq opts (append '("-newshell" "-env" "TERM" "vt100") opts))))) + + ;; Using create-file-buffer and list-buffers-directory in this way + ;; makes uniquify give each buffer a unique name based on the + ;; directory. + (let ((fake-file-name (expand-file-name inferior-erlang-buffer-name default-directory))) + (setq inferior-erlang-buffer (create-file-buffer fake-file-name)) + (apply 'make-comint-in-buffer + inferior-erlang-process-name + inferior-erlang-buffer + cmd + nil opts) + (with-current-buffer inferior-erlang-buffer + (setq list-buffers-directory fake-file-name)))) + (setq inferior-erlang-process (get-buffer-process inferior-erlang-buffer)) - (process-kill-without-query inferior-erlang-process) - (switch-to-buffer inferior-erlang-buffer) + (if (> 21 erlang-emacs-major-version) ; funcalls to avoid compiler warnings + (funcall (symbol-function 'set-process-query-on-exit-flag) + inferior-erlang-process nil) + (funcall (symbol-function 'process-kill-without-query) inferior-erlang-process)) + (if erlang-inferior-shell-split-window + (switch-to-buffer-other-window inferior-erlang-buffer) + (switch-to-buffer inferior-erlang-buffer)) (if (and (not (eq system-type 'windows-nt)) (eq inferior-erlang-shell-type 'newshell)) (setq comint-process-echoes t)) - ;; `rename-buffer' takes only one argument in Emacs 18. - (condition-case nil - (rename-buffer inferior-erlang-buffer-name t) - (error (rename-buffer inferior-erlang-buffer-name))) (erlang-shell-mode)) @@ -5186,7 +5271,7 @@ Note, should the mouse pointer be places outside the raised frame, that frame will become deselected before the next command." (interactive) (or (inferior-erlang-running-p) - (error "No inferior Erlang process is running.")) + (error "No inferior Erlang process is running")) (let ((win (inferior-erlang-window inferior-erlang-display-buffer-any-frame)) (frames-p (fboundp 'selected-frame))) @@ -5225,11 +5310,11 @@ frame will become deselected before the next command." (defun inferior-erlang-wait-prompt () - "Wait until the inferior Erlang shell prompt appear." + "Wait until the inferior Erlang shell prompt appears." (if (eq inferior-erlang-prompt-timeout t) () (or (inferior-erlang-running-p) - (error "No inferior Erlang shell is running.")) + (error "No inferior Erlang shell is running")) (save-excursion (set-buffer inferior-erlang-buffer) (let ((msg nil)) @@ -5243,9 +5328,25 @@ frame will become deselected before the next command." (message "Waiting for Erlang shell prompt (press C-g to abort).")) (or (accept-process-output inferior-erlang-process inferior-erlang-prompt-timeout) - (error "No Erlang shell prompt before timeout."))) + (error "No Erlang shell prompt before timeout"))) (if msg (message "")))))) +(defun inferior-erlang-send-empty-cmd-unless-already-at-prompt () + "If not already at a prompt, try to send an empty cmd to get a prompt. +The empty command resembles hitting RET. This is useful in some +situations, for instance if a crash or error report from sasl +has been printed after the last prompt." + (save-excursion + (set-buffer inferior-erlang-buffer) + (if (> (point-max) 1) + ;; make sure we get a prompt if buffer contains data + (if (save-excursion + (goto-char (process-mark inferior-erlang-process)) + (forward-line 0) + (not (looking-at comint-prompt-regexp))) + (inferior-erlang-send-command ""))))) + +(autoload 'comint-send-input "comint") (defun inferior-erlang-send-command (cmd &optional hist) "Send command CMD to the inferior Erlang. @@ -5258,31 +5359,36 @@ the history list. Return the position after the newly inserted command." (or (inferior-erlang-running-p) - (error "No inferior Erlang process is running.")) + (error "No inferior Erlang process is running")) (let ((old-buffer (current-buffer)) - (insert-point (marker-position - (process-mark inferior-erlang-process))) + (insert-point (marker-position (process-mark inferior-erlang-process))) (insert-length (if comint-process-echoes 0 (1+ (length cmd))))) (set-buffer inferior-erlang-buffer) (goto-char insert-point) (insert cmd) - ;; Strange things happend if `comint-eol-on-send' is declared + ;; Strange things happened if `comint-eol-on-send' is declared ;; in the `let' expression above, but setq:d here. The ;; `set-buffer' statement obviously makes the buffer local ;; instance of `comint-eol-on-send' shadow this one. ;; I'm considering this a bug in Elisp. + ;; + ;; This was previously cautioned against in the Lisp manual. It + ;; has been sorted out in Emacs 21. -- fx (let ((comint-eol-on-send nil) (comint-input-filter (if hist comint-input-filter 'ignore))) - (comint-send-input)) + (if (and (not erlang-xemacs-p) + (>= emacs-major-version 22)) + (comint-send-input nil t) + (comint-send-input))) ;; Adjust all windows whose points are incorrect. (if (null comint-process-echoes) (walk-windows (function (lambda (window) (if (and (eq (window-buffer window) inferior-erlang-buffer) - (eq (window-point window) insert-point)) + (= (window-point window) insert-point)) (set-window-point window (+ insert-point insert-length))))) nil t)) @@ -5323,9 +5429,11 @@ Return the position after the newly inserted command." (replace-match "" t t)))))) -(defun inferior-erlang-compile () +(defun inferior-erlang-compile (arg) "Compile the file in the current buffer. +With prefix arg, compiles for debug. + Should Erlang return `{error, nofile}' it could not load the object module after completing the compilation. This is due to a bug in the compile command `c' when using the option `outdir'. @@ -5337,52 +5445,217 @@ There exists two workarounds for this bug: 2) Set the Emacs variable `erlang-compile-use-outdir' to nil. To do so, place the following line in your `~/.emacs'-file: (setq erlang-compile-use-outdir nil)" - (interactive) + (interactive "P") (save-some-buffers) + (inferior-erlang-prepare-for-input) + (let* ((dir (inferior-erlang-compile-outdir)) +;;; (file (file-name-nondirectory (buffer-file-name))) + (noext (substring (erlang-local-buffer-file-name) 0 -4)) + (opts (append (list (cons 'outdir dir)) + (if current-prefix-arg + (list 'debug_info 'export_all)) + erlang-compile-extra-opts)) + end) + (save-excursion + (set-buffer inferior-erlang-buffer) + (compilation-forget-errors)) + (setq end (inferior-erlang-send-command + (inferior-erlang-compute-compile-command noext opts) + nil)) + (sit-for 0) + (inferior-erlang-wait-prompt) + (save-excursion + (set-buffer inferior-erlang-buffer) + (setq compilation-error-list nil) + (set-marker compilation-parsing-end end)) + (setq compilation-last-buffer inferior-erlang-buffer))) + +(defun inferior-erlang-prepare-for-input (&optional no-display) + "Create an inferior erlang buffer if needed and ready it for input. +The buffer is displayed, according to `inferior-erlang-display-buffer' +unless the optional NO-DISPLAY is non-nil." (or (inferior-erlang-running-p) (save-excursion (inferior-erlang))) (or (inferior-erlang-running-p) - (error "Error starting inferior Erlang shell.")) - (let ((dir (file-name-directory (buffer-file-name))) - ;;; (file (file-name-nondirectory (buffer-file-name))) - (noext (substring (buffer-file-name) 0 -4)) - ;; Hopefully, noone else will ever use these... - (tmpvar "Tmp7236") - (tmpvar2 "Tmp8742") - end) - (inferior-erlang-display-buffer) - (inferior-erlang-wait-prompt) - (setq end (inferior-erlang-send-command - (if erlang-compile-use-outdir - (format "c(\"%s\", [{outdir, \"%s\"}])." noext dir) - (format - (concat - "f(%s), {ok, %s} = file:get_cwd(), " - "file:set_cwd(\"%s\"), " - "%s = c(\"%s\"), file:set_cwd(%s), f(%s), %s.") - tmpvar2 tmpvar - dir - tmpvar2 noext tmpvar tmpvar tmpvar2)) - nil)) - (save-excursion - (set-buffer inferior-erlang-buffer) - (setq compilation-error-list nil) - (setq compilation-parsing-end end)) - (setq compilation-last-buffer inferior-erlang-buffer))) + (error "Error starting inferior Erlang shell")) + (if (not no-display) + (inferior-erlang-display-buffer)) + (inferior-erlang-send-empty-cmd-unless-already-at-prompt) + (sit-for 0) + (inferior-erlang-wait-prompt)) +(defun inferior-erlang-compile-outdir () + "Return the directory to compile the current buffer into." + (let* ((buffer-dir (directory-file-name + (file-name-directory (erlang-local-buffer-file-name)))) + (parent-dir (directory-file-name + (file-name-directory buffer-dir))) + (ebin-dir (concat (file-name-as-directory parent-dir) "ebin")) + (buffer-dir-base-name (file-name-nondirectory + (expand-file-name + (concat (file-name-as-directory buffer-dir) + "."))))) + (if (and (string= buffer-dir-base-name "src") + (file-directory-p ebin-dir)) + (file-name-as-directory ebin-dir) + (file-name-as-directory buffer-dir)))) + +(defun inferior-erlang-compute-compile-command (module-name opts) + (let ((ccfn erlang-compile-command-function-alist) + (res (inferior-erlang-compute-erl-compile-command module-name opts)) + ccfn-entry + done) + (if (not (null (erlang-local-buffer-file-name))) + (while (and (not done) (not (null ccfn))) + (setq ccfn-entry (car ccfn)) + (setq ccfn (cdr ccfn)) + (if (string-match (car ccfn-entry) (erlang-local-buffer-file-name)) + (let ((c-fn (cdr ccfn-entry))) + (setq done t) + (if (not (null c-fn)) + (setq result (funcall c-fn module-name opts))))))) + result)) + +(defun inferior-erlang-compute-erl-compile-command (module-name opts) + (let* ((out-dir-opt (assoc 'outdir opts)) + (out-dir (cdr out-dir-opt))) + (if erlang-compile-use-outdir + (format "%s(\"%s\"%s)." + erlang-compile-erlang-function + module-name + (inferior-erlang-format-comma-opts opts)) + (let (;; Hopefully, noone else will ever use these... + (tmpvar "Tmp7236") + (tmpvar2 "Tmp8742")) + (format + (concat + "f(%s), {ok, %s} = file:get_cwd(), " + "file:set_cwd(\"%s\"), " + "%s = %s(\"%s\"%s), file:set_cwd(%s), f(%s), %s.") + tmpvar2 tmpvar + out-dir + tmpvar2 + erlang-compile-erlang-function + module-name (inferior-erlang-format-comma-opts + (remq out-dir-opt opts)) + tmpvar tmpvar tmpvar2))))) + +(defun inferior-erlang-compute-leex-compile-command (module-name opts) + (let ((file-name (erlang-local-buffer-file-name)) + (erl-compile-expr (inferior-erlang-remove-any-trailing-dot + (inferior-erlang-compute-erl-compile-command + module-name opts)))) + (format (concat "f(LErr1__), f(LErr2__), " + "case case leex:file(\"%s\", [%s]) of" + " ok -> ok;" + " {ok,_} -> ok;" + " {ok,_,_} -> ok;" + " LErr1__ -> LErr1__ " + "end of" + " ok -> %s;" + " LErr2__ -> LErr2__ " + "end.") + file-name + (inferior-erlang-format-comma-opts erlang-leex-compile-opts) + erl-compile-expr))) + +(defun inferior-erlang-compute-yecc-compile-command (module-name opts) + (let ((file-name (erlang-local-buffer-file-name)) + (erl-compile-expr (inferior-erlang-remove-any-trailing-dot + (inferior-erlang-compute-erl-compile-command + module-name opts)))) + (format (concat "f(YErr1__), f(YErr2__), " + "case case yecc:file(\"%s\", [%s]) of" + " {ok,_} -> ok;" + " {ok,_,_} -> ok;" + " YErr1__ -> YErr1__ " + "end of" + " ok -> %s;" + " YErr2__ -> YErr2__ " + "end.") + file-name + (inferior-erlang-format-comma-opts erlang-yecc-compile-opts) + erl-compile-expr))) + +(defun inferior-erlang-remove-any-trailing-dot (str) + (if (string= (substring str -1) ".") + (substring str 0 (1- (length str))) + str)) + +(defun inferior-erlang-format-comma-opts (opts) + (if (null opts) + "" + (concat ", " (inferior-erlang-format-opts opts)))) + +(defun inferior-erlang-format-opts (opts) + (concat "[" (inferior-erlang-string-join (mapcar 'inferior-erlang-format-opt + opts) + ", ") + "]")) + +(defun inferior-erlang-format-opt (opt) + (cond ((stringp opt) (concat "\"" opt "\"")) + ((atom opt) (format "%s" opt)) + ((consp opt) (concat "{" (inferior-erlang-string-join + (mapcar 'inferior-erlang-format-opt + (list (car opt) (cdr opt))) + ", ") + "}")) + (t (error (format "Unexpected opt %s" opt))))) + +(defun inferior-erlang-string-join (strs sep) + (let ((result (or (car strs) ""))) + (setq strs (cdr strs)) + (while strs + (setq result (concat result sep (car strs))) + (setq strs (cdr strs))) + result)) + +(defun erlang-local-buffer-file-name () + ;; When editing a file remotely via tramp, + ;; the buffer's file name may be for example + ;; "/ssh:host.example.com:/some/path/x.erl" + ;; + ;; If I try to compile such a file using C-c C-k, an + ;; erlang shell on the remote host is automatically + ;; started if needed, but for it to successfully compile + ;; the file, the c(...) command that is sent must contain + ;; the file name "/some/path/x.erl" without the + ;; tramp-prefix "/ssh:host.example.com:". + (cond ((null (buffer-file-name)) + nil) + ((erlang-tramp-remote-file-p) + (erlang-tramp-get-localname)) + (t + (buffer-file-name)))) + +(defun erlang-tramp-remote-file-p () + (and (fboundp 'tramp-tramp-file-p) + (tramp-tramp-file-p (buffer-file-name)))) + +(defun erlang-tramp-get-localname () + (let ((tramp-info (tramp-dissect-file-name (buffer-file-name)))) + (if (fboundp 'tramp-file-name-localname) + (tramp-file-name-localname tramp-info) + ;; In old versions of tramp, it was `tramp-file-name-path' + ;; instead of the newer `tramp-file-name-localname' + (tramp-file-name-path tramp-info)))) ;; `next-error' only accepts buffers with major mode `compilation-mode' ;; or with the minor mode `compilation-minor-mode' activated. ;; (To activate the minor mode is out of the question, since it will ;; ruin the inferior Erlang keymap.) +;; This is done differently in Emacs 21. (defun inferior-erlang-next-error (&optional argp) "Just like `next-error'. Capable of finding error messages in an inferior Erlang buffer." (interactive "P") (let ((done nil) - (buf (and (boundp 'compilation-last-buffer) - compilation-last-buffer))) + (buf (or (and (boundp 'next-error-last-buffer) + next-error-last-buffer) + (and (boundp 'compilation-last-buffer) + compilation-last-buffer)))) (if (and (bufferp buf) (save-excursion (set-buffer buf) @@ -5400,16 +5673,90 @@ Capable of finding error messages in an inferior Erlang buffer." (defun inferior-erlang-change-directory (&optional dir) - "Make the inferior erlang change directory. + "Make the inferior Erlang change directory. The default is to go to the directory of the current buffer." (interactive) - (or dir (setq dir (file-name-directory (buffer-file-name)))) + (or dir (setq dir (file-name-directory (erlang-local-buffer-file-name)))) (or (inferior-erlang-running-p) - (error "No inferior Erlang is running.")) + (error "No inferior Erlang is running")) (inferior-erlang-display-buffer) + (inferior-erlang-send-empty-cmd-unless-already-at-prompt) (inferior-erlang-wait-prompt) (inferior-erlang-send-command (format "cd('%s')." dir) nil)) - + +(defun erlang-align-arrows (start end) + "Align arrows (\"->\") in function clauses from START to END. +When called interactively, aligns arrows after function clauses inside +the region. + +With a prefix argument, aligns all arrows, not just those in function +clauses. + +Example: + +sum(L) -> sum(L, 0). +sum([H|T], Sum) -> sum(T, Sum + H); +sum([], Sum) -> Sum. + +becomes: + +sum(L) -> sum(L, 0). +sum([H|T], Sum) -> sum(T, Sum + H); +sum([], Sum) -> Sum." + (interactive "r") + (save-excursion + (let (;; regexp for matching arrows. without a prefix argument, + ;; the regexp matches function heads. With a prefix, it + ;; matches any arrow. + (re (if current-prefix-arg + "^.*\\(\\)->" + (eval-when-compile + (concat "^" erlang-atom-regexp ".*\\(\\)->")))) + ;; part of regexp matching directly before the arrow + (arrow-match-pos (if current-prefix-arg + 1 + (1+ erlang-atom-regexp-matches))) + ;; accumulator for positions where arrows are found, ordered + ;; by buffer position (from greatest to smallest) + (arrow-positions '()) + ;; accumulator for longest distance from start of line to arrow + (most-indent 0) + ;; marker to track the end of the region we're aligning + (end-marker (progn (goto-char end) + (point-marker)))) + ;; Pass 1: Find the arrow positions, adjust the whitespace + ;; before each arrow to one space, and find the greatest + ;; indentation level. + (goto-char start) + (while (re-search-forward re end-marker t) + (goto-char (match-beginning arrow-match-pos)) + (just-one-space) ; adjust whitespace + (setq arrow-positions (cons (point) arrow-positions)) + (setq most-indent (max most-indent (erlang-column-number)))) + (set-marker end-marker nil) ; free the marker + ;; Pass 2: Insert extra padding so that all arrow indentation is + ;; equal. This is done last-to-first by buffer position, so that + ;; inserting spaces before one arrow doesn't change the + ;; positions of the next ones. + (mapc (lambda (arrow-pos) + (goto-char arrow-pos) + (let* ((pad (- most-indent (erlang-column-number)))) + (when (> pad 0) + (insert-char ?\ pad)))) + arrow-positions)))) + +(defun erlang-column-number () + "Return the column number of the current position in the buffer. +Tab characters are counted by their visual width." + (string-width (buffer-substring (line-beginning-position) (point)))) + +(defun erlang-current-defun () + "`add-log-current-defun-function' for Erlang." + (save-excursion + (erlang-beginning-of-function) + (if (looking-at "[a-z0-9_]+") + (match-string 0)))) + ;; Aliases for backward compatibility with older versions of Erlang Mode. ;; ;; Unfortuantely, older versions of Emacs doesn't have `defalias' and @@ -5420,7 +5767,7 @@ The default is to go to the directory of the current buffer." Simplified version of a combination `defalias' and `make-obsolete', it assumes that NEWDEF is loaded." - (fset sym (symbol-function newdef)) + (defalias sym (symbol-function newdef)) (if (fboundp 'make-obsolete) (make-obsolete sym newdef))) @@ -5440,10 +5787,29 @@ it assumes that NEWDEF is loaded." (erlang-obsolete 'name-of-erlang-function 'erlang-name-of-function) +;; Fixme: shouldn't redefine `set-visited-file-name' anyhow -- see above. +(defconst erlang-unload-hook + (list (lambda () + (defalias 'set-visited-file-name + 'erlang-orig-set-visited-file-name) + (when (featurep 'advice) + (ad-unadvise 'Man-notify-when-ready) + (ad-unadvise 'set-visited-file-name))))) + + +(defun erlang-string-to-int (string) + (if (fboundp 'string-to-number) + (string-to-number string) + (funcall (symbol-function 'string-to-int) string))) + ;; The end... (provide 'erlang) (run-hooks 'erlang-load-hook) +;; Local variables: +;; coding: iso-8859-1 +;; End: + ;;; erlang.el ends here diff --git a/elpa/erlang-20151013.157/erlang_appwiz.el b/elpa/erlang-20151013.157/erlang_appwiz.el new file mode 100644 index 0000000..ecbce66 --- /dev/null +++ b/elpa/erlang-20151013.157/erlang_appwiz.el @@ -0,0 +1,1345 @@ +;;; -*- Emacs-Lisp -*- +;;; File: erlang_appwiz.el +;;; Author: Johan Bevermyr +;;; Created: Tue Dec 9 13:14:24 1997 +;;; Purpose: Adds a simple application wizard to erlang.el. + +;; OBS! Must be loaded before the erlang.el file is loaded. +;; Add the following to your .emacs file before erlang.el is loaded. +;; +;; (load "erlang_appwiz" t nil) +;; +;; Customisation of makefile generation: +;; +;; The templates for generating makefiles are stored in the +;; variables erlang-skel-makefile-src and erlang-skel-makefile-middle. +;; +;; These can be modified by setting the variables before or after this +;; file is loaded. +;; +;; For example, to generate OTP-style make files: +;; +;; +;;(defvar erlang-skel-makefile-src +;; '((erlang-skel-include erlang-skel-nomodule-header) +;; "CC_ROOT := $(shell pwd | sed 's/erts.*$$//')" n +;; "AUTOCONF := $(CC_ROOT)/erts/autoconf" n +;; "TARGET := $(shell $(AUTOCONF)/config.guess)" +;; "include $(CC_ROOT)/internal_tools/make/$(TARGET)/otp.mk" n +;; n +;; "# ----------------------------------------------------" n +;; "# Application version " n +;; "# ----------------------------------------------------" n +;; "include ../vsn.mk" n +;; "VSN=$(KERNEL_VSN)" n +;; n +;; "# ----------------------------------------------------" n +;; "# Release directory specification" n +;; "# ----------------------------------------------------" n +;; "RELEASE_PATH= ../../../release/$(TARGET)" n +;; "RELSYSDIR = $(RELEASE_PATH)/lib/kernel-$(VSN)" n +;; n +;; "# ----------------------------------------------------" n +;; "# Target Specs" n +;; "# ----------------------------------------------------" n +;; n +;; "MODULES= " appwiz-erlang-modulename n +;; n +;; "HRL_FILES=" +;; n +;; INTERNAL_HRL_FILES= appwiz-erlang-modulename "_sup.hrl" n +;; n +;; "ERL_FILES= $(MODULES:%=%.erl)" n +;; n +;; "TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) $(APP_TARGET)" n +;; n +;; "APP_FILE= " appwiz-erlang-modulename ".app" n +;; n +;; "APP_SRC= $(APP_FILE).src" n +;; "APP_TARGET= ../ebin/$(APP_FILE)" n +;; n +;; "# ----------------------------------------------------" n +;; "# FLAGS " n +;; "# ----------------------------------------------------" n +;; "ERL_FLAGS += " n +;; "ERL_COMPILE_FLAGS += -I../include" n +;; n +;; "# ----------------------------------------------------" n +;; "# Targets" n +;; "# ----------------------------------------------------" n +;; n +;; "debug opt: $(TARGET_FILES)" n +;; n +;; "clean:" n +;; " rm -f $(TARGET_FILES) $(GEN_FILES)" n +;; " rm -f core" n +;; n +;; "docs:" n +;; n +;; "# ----------------------------------------------------" n +;; "# Special Build Targets " n +;; "# ----------------------------------------------------" n +;; " " n +;; "$(APP_TARGET): $(APP_SRC) " n +;; " sed -e 's;%VSN%;$(VSN);' $(APP_SRC) > $(APP_TARGET)" n +;; " " n +;; "# ----------------------------------------------------" n +;; "# Release Target " n +;; "# ----------------------------------------------------" n +;; "include $(CC_ROOT)/internal_tools/make/otp_release_targets.mk" n +;; n +;; "release_spec: opt" n +;; " $(INSTALL_DIR) $(RELSYSDIR)/src " n +;; " $(INSTALL_DATA) $(ERL_FILES) $(RELSYSDIR)/src " n +;; " $(INSTALL_DATA) $(INTERNAL_HRL_FILES) $(RELSYSDIR)/src " n +;; " $(INSTALL_DIR) $(RELSYSDIR)/include " n +;; " $(INSTALL_DATA) $(HRL_FILES) $(RELSYSDIR)/include " n +;; " $(INSTALL_DIR) $(RELSYSDIR)/ebin " n +;; " $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin " n +;; n +;; "release_docs_spec:" n +;; )) +;; +;; +;; + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Erlang application wizard +;; + +(defun erlang-application-wizard (directory name) + "Creates all files and directories needed for an application. +The top-level directory is placed in DIRECTORY. NAME is used when +creating the root directory and for naming application files." + + (interactive "DApplication root directory: \nsName of application: ") + (let ((dir nil) + (lastchar (substring directory (- (length directory) 1))) + (apptype (completing-read "Type of application: " + '(("gen_server" 1) + ("gen_event" 2) + ("gen_fsm" 3) + ("other" 4)) + nil t "gen_server")) + (appname nil) + (apptemplate nil) + (apitemplate nil) + (extension nil)) + + (if (string= lastchar "/") + (setq dir directory) + (setq dir (concat directory "/"))) + + ;; determine type of application + (cond ((string= apptype "gen_server") + (setq extension "_server") + (setq appname (concat name extension)) + (setq apptemplate 'tempo-template-erlang-generic-server) + (setq apitemplate 'tempo-template-erlang-large-header)) + ((string= apptype "gen_event") + (setq extension "_event") + (setq appname (concat name extension)) + (setq apptemplate 'tempo-template-erlang-gen-event) + (setq apitemplate 'tempo-template-erlang-large-header)) + ((string= apptype "gen_fsm") + (setq extension "_fsm") + (setq appname (concat name extension)) + (setq apptemplate 'tempo-template-erlang-gen-fsm) + (setq apitemplate 'tempo-template-large-header)) + (t + ;; use defaults _work + (setq extension "_work") + (setq appname (concat name extension)) + (setq apptemplate 'tempo-template-erlang-large-header) + (setq apitemplate 'tempo-template-erlang-large-header))) + + (setq appwiz-erlang-modulename appname) + (setq appwiz-erlang-ext extension) + + ;; create directories + (make-directory (concat dir name "/" "src") t) + (make-directory (concat dir name "/" "ebin") t) + (make-directory (concat dir name "/" "include") t) + + ;; create directory content + ;;;;;;;;; .erl + (find-file (concat dir name "/" "src/" name ".erl")) + (funcall apitemplate) + (insert "API module for the application " name ".") + (save-buffer) + + ;;;;;;;;; _app.erl + (find-file (concat dir name "/" "src/" name "_app.erl")) + (tempo-template-erlang-application) + (insert "Application callback module for the application " name ".") + + (let ((quotedname (erlang-add-quotes-if-needed + (concat name "_sup"))) + (start (point))) + (while (search-forward "'TopSupervisor':start_link" nil t) + (replace-match (concat quotedname ":start_link") nil t)) + (goto-char start)) + + (save-buffer) + + ;;;;;;;;; _sup.erl + (find-file (concat dir name "/" "src/" name "_sup.erl")) + (tempo-template-erlang-supervisor) + (insert "Top level supervisor for the application " name ".") + + + (let ((quotedname (erlang-add-quotes-if-needed appname)) + (start (point))) + (while (search-forward "'AName'" nil t) + (replace-match quotedname nil t)) + (goto-char start)) + + (let ((quotedname (erlang-add-quotes-if-needed appname)) + (start (point))) + (goto-char 0) + (while (search-forward "'AMODULE'" nil t) + (replace-match quotedname nil t)) + (goto-char start)) + + (save-buffer) + + ;;;;;;;;; _sup.hrl + (find-file (concat dir name "/" "src/" name "_sup.hrl")) + (tempo-template-erlang-nomodule-header) + (save-buffer) + + ;;;;;;;;; _(application).erl + (find-file (concat dir name "/" "src/" appname ".erl")) + (funcall apptemplate) + (save-buffer) + + ;;;;;;;;; makefile (src) + (find-file (concat dir name "/" "src/makefile")) + (setq appwiz-erlang-modulename name) + (setq appwiz-erlang-ext extension) + (tempo-template-erlang-makefile-src) + (insert "Makefile for application " name ".") + (let ((start (point))) + (goto-char 0) + (while (search-forward "%" nil t) + (replace-match "#" nil t)) + (goto-char start)) + (save-buffer) + + ;;;;;;;;; makefile (middle) + (find-file (concat dir name "/" "makefile")) + (tempo-template-erlang-makefile-middle) + (insert "Makefile for application " name ".") + (let ((start (point))) + (goto-char 0) + (while (search-forward "%" nil t) + (replace-match "#" nil t)) + (goto-char start)) + (save-buffer) + + ;;;;;;;;; .app + (find-file (concat dir name "/" "ebin/" name ".app")) + (erlang-mode) + (tempo-template-erlang-app) + (insert "Application specification file for " name ".") + (save-buffer))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; These are setq:ed +;; + +(defvar appwiz-erlang-modulename "foo") +(defvar appwiz-erlang-ext "_work") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Skeletons. +;; Skeletons for nomodule header and .app file added by JB. +;; + +(defvar erlang-skel + '(("If" "if" erlang-skel-if) + ("Case" "case" erlang-skel-case) + ("Receive" "receive" erlang-skel-receive) + ("Receive After" "after" erlang-skel-receive-after) + ("Receive Loop" "loop" erlang-skel-receive-loop) + ("Module" "module" erlang-skel-module) + ("Author" "author" erlang-skel-author) + ("Query" "query" erlang-skel-query) + () + ("Small Header" "small-header" + erlang-skel-small-header erlang-skel-header) + ("Normal Header" "normal-header" + erlang-skel-normal-header erlang-skel-header) + ("Large Header" "large-header" + erlang-skel-large-header erlang-skel-header) + ("No Moudle Header" "nomodule-header" + erlang-skel-nomodule-header erlang-skel-header) + () + ("Small Server" "small-server" + erlang-skel-small-server erlang-skel-header) + () + ("application" "application" + erlang-skel-application erlang-skel-header) + ("app" "app" + erlang-skel-app erlang-skel-header) + ("supervisor" "supervisor" + erlang-skel-supervisor erlang-skel-header) + ("supervisor_bridge" "supervisor-bridge" + erlang-skel-supervisor-bridge erlang-skel-header) + ("gen_server" "generic-server" + erlang-skel-generic-server erlang-skel-header) + ("gen_event" "gen-event" + erlang-skel-gen-event erlang-skel-header) + ("gen_fsm" "gen-fsm" + erlang-skel-gen-fsm erlang-skel-header)) + "*Description of all skeletons templates. +Both functions and menu entries will be created. + +Each entry in `erlang-skel' should be a list with three or four +elements, or the empty list. + +The first element is the name which shows up in the menu. The second +is the `tempo' identfier (The string \"erlang-\" will be added in +front of it). The third is the skeleton descriptor, a variable +containing `tempo' attributes as described in the function +`tempo-define-template'. The optinal fourth elements denotes a +function which should be called when the menu is selected. + +Functions corresponding to every template will be created. The name +of the function will be `tempo-template-erlang-X' where `X' is the +tempo identifier as specified in the second argument of the elements +in this list. + +A list with zero elemets means that the a horisontal line should +be placed in the menu.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Template for .app file skeleton +;; + +(defvar erlang-skel-app + '((erlang-skel-include erlang-skel-nomodule-header) + "{application, " + (erlang-add-quotes-if-needed (erlang-get-module-from-file-name)) "," n> + "[{description, \"" (erlang-get-module-from-file-name) "\"}," n> + "{vsn, \"0.1\"}," n> + "{modules, [" + (erlang-add-quotes-if-needed (erlang-get-module-from-file-name)) "," n> + (erlang-add-quotes-if-needed + (concat (erlang-get-module-from-file-name) "_app")) "," n> + (erlang-add-quotes-if-needed + (concat (erlang-get-module-from-file-name) "_sup")) "," n> + (erlang-add-quotes-if-needed + (concat (erlang-get-module-from-file-name) appwiz-erlang-ext)) "]}," n> + "{registered, [" + (erlang-add-quotes-if-needed + (concat (erlang-get-module-from-file-name) appwiz-erlang-ext)) "," + (erlang-add-quotes-if-needed + (concat (erlang-get-module-from-file-name) "_sup")) "]}," n> + "{applications, [kernel," n> + "stdlib," n> + "sasl," n> + "mnesia]}," n> + "{env, []}," n> + "{mod, {" + (erlang-add-quotes-if-needed + (concat (erlang-get-module-from-file-name) "_app")) + ", []}}]}." n + ) + "*The template of an application file +Please see the function `tempo-define-template'.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Template for no-module header skeleton. +;; + +(defvar erlang-skel-nomodule-header + '(o (erlang-skel-separator) + (erlang-skel-include erlang-skel-copyright-comment + erlang-skel-file-comment + erlang-skel-author-comment) + "%%% Purpose : " p n + (erlang-skel-include erlang-skel-created-comment) + (erlang-skel-separator) n) + "*The template of a normal header. +Please see the function `tempo-define-template'.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; .app extension added. +;; + +(defvar erlang-file-name-extension-regexp "\\.\\(erl\\|hrl\\|app\\)$" + "*Regexp which should match an erlang file name. + +This regexp is used when an Erlang module name is extracted from the +name of an Erlang source file. + +The regexp should only match the section of the file name which should +be excluded from the module name. + +To match all files set this variable to \"\\\\(\\\\..*\\\\|\\\\)$\". +The matches all except the extension. This is useful if the Erlang +tags system should interpretate tags on the form `module:tag' for +files written in other languages than Erlang.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Wizard menu added. +;; + +(defvar erlang-menu-items + '(("Indent" + (("Indent Line" erlang-indent-command) + ("Indent Region " erlang-indent-region + (if erlang-xemacs-p (mark) mark-active)) + ("Indent Clause" erlang-indent-caluse) + ("Indent Function" erlang-indent-function) + ("Indent Buffer" erlang-indent-current-buffer))) + ("Edit" + (("Fill Comment" erlang-fill-paragraph) + ("Comment Region" comment-region + (if erlang-xemacs-p (mark) mark-active)) + ("Uncomment Region" erlang-uncomment-region + (if erlang-xemacs-p (mark) mark-active)) + nil + ("beginning of Function" erlang-beginning-of-function) + ("End of Function" erlang-end-of-function) + ("Mark Function" erlang-mark-function) + nil + ("beginning of Clause" erlang-beginning-of-clause) + ("End of Clause" erlang-end-of-clause) + ("Mark Clause" erlang-mark-clause) + nil + ("New Clause" erlang-generate-new-clause) + ("Clone Arguments" erlang-clone-arguments))) + ("Font Lock Mode" + (("Level 3" erlang-font-lock-level-3) + ("Level 2" erlang-font-lock-level-2) + ("Level 1" erlang-font-lock-level-1) + ("Off" erlang-font-lock-level-0))) + ("TAGS" + (("Find Tag" find-tag) + ("Find Next Tag" erlang-find-next-tag) + ;("Find Regexp" find-tag-regexp) + ("Complete Word" erlang-complete-tag) + ("Tags Apropos" tags-apropos) + ("Search Files" tags-search))) + nil + ("Erlang Shell" inferior-erlang-run-or-select) + ("Compile" erlang-compile) + ("Next Error" inferior-erlang-next-error) + nil + ("Version" erlang-version) + nil + ("Wizards" + (("Application Wizard" erlang-application-wizard)))) + "*Description of menu used in Erlang mode. + +This variable must be a list. The elements are either nil representing +a horisontal line or a list with two or three elements. The first is +the name of the menu item, the second is the function to call, or a +submenu, on the same same form as ITEMS. The third optional argument +is an expression which is evaluated every time the menu is displayed. +Should the expression evaluate to nil the menu item is ghosted. + +Example: + '((\"Func1\" function-one) + (\"SubItem\" + ((\"Yellow\" function-yellow) + (\"Blue\" function-blue))) + nil + (\"Region Funtion\" spook-function midnight-variable)) + +Call the function `erlang-menu-init' after modifying this variable.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Prefixing space removed from date string +;; + +(defun erlang-skel-d-mmm-yyyy () + "Return the current date as a string in \"DD Mon YYYY\" form. +The first character of DD is *not* space if the value is less than 10." + (let ((date (current-time-string))) + (format "%d %s %s" + (string-to-int (substring date 8 10)) + (substring date 4 7) + (substring date -4)))) + +(defvar erlang-skel-date-function 'erlang-skel-d-mmm-yyyy + "*Function which returns date string. +Look in the module `time-stamp' for a battery of functions.") + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Fixed skeletons. erlang-add-quotes-if-needed introduced where needed. +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Server templates. + +(defvar erlang-skel-small-server + '((erlang-skel-include erlang-skel-large-header) + "-export([start/0,init/1])." n n n + "start() ->" n> "spawn(" + (erlang-add-quotes-if-needed (erlang-get-module-from-file-name)) + ", init, [self()])." n n + "init(From) ->" n> + "loop(From)." n n + "loop(From) ->" n> + "receive" n> + p "_ ->" n> + "loop(From)" n> + "end." + ) + "*Template of a small server. +Please see the function `tempo-define-template'.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Behaviour templates. + +(defvar erlang-skel-application + '((erlang-skel-include erlang-skel-large-header) + "-behaviour(application)." n + n + "%% application callbacks" n + "-export([start/2, stop/1])." n n + (erlang-skel-separator) + "%%% Callback functions from application" n + (erlang-skel-separator) + n + (erlang-skel-separator 2) + "%% Func: start/2" n + "%% Returns: {ok, Pid} |" n + "%% {ok, Pid, State} |" n + "%% {error, Reason} " n + (erlang-skel-separator 2) + "start(Type, StartArgs) ->" n> + "case 'TopSupervisor':start_link(StartArgs) of" n> + "{ok, Pid} -> " n> + "{ok, Pid};" n> + "Error ->" n> + "Error" n> + "end." n + n + (erlang-skel-separator 2) + "%% Func: stop/1" n + "%% Returns: any "n + (erlang-skel-separator 2) + "stop(State) ->" n> + "ok." n + n + (erlang-skel-separator) + "%%% Internal functions" n + (erlang-skel-separator) + ) + "*The template of an application behaviour. +Please see the function `tempo-define-template'.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defvar erlang-skel-supervisor + '((erlang-skel-include erlang-skel-large-header) + "-behaviour(supervisor)." n + n + "%% External exports" n + "-export([start_link/1])." n + n + "%% supervisor callbacks" n + "-export([init/1])." n n + (erlang-skel-separator) + "%%% API" n + (erlang-skel-separator) + "start_link(StartArgs) ->" n> + "supervisor:start_link({local, " + (erlang-add-quotes-if-needed (erlang-get-module-from-file-name)) "}, " + (erlang-add-quotes-if-needed (erlang-get-module-from-file-name)) + ", StartArgs)." n + n + (erlang-skel-separator) + "%%% Callback functions from supervisor" n + (erlang-skel-separator) + n + (erlang-skel-separator 2) + "%% Func: init/1" n + "%% Returns: {ok, {SupFlags, [ChildSpec]}} |" n + "%% ignore |" n + "%% {error, Reason} " n + (erlang-skel-separator 2) + "init(StartArgs) ->" n> + "AChild = {'AName',{'AModule',start_link,[]}," n> + "permanent,2000,worker,['AModule']}," n> + "{ok,{{one_for_all,4,3600}, [AChild]}}." n + n + (erlang-skel-separator) + "%%% Internal functions" n + (erlang-skel-separator) + ) + "*The template of an supervisor behaviour. +Please see the function `tempo-define-template'.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defvar erlang-skel-supervisor-bridge + '((erlang-skel-include erlang-skel-large-header) + "-behaviour(supervisor_bridge)." n + n + "%% External exports" n + "-export([start_link/0])." n + n + "%% supervisor callbacks" n + "-export([init/1, terminate/2])." n n + "-record(state, {})." n + n + (erlang-skel-separator) + "%%% API" n + (erlang-skel-separator) + "start_link() -> " n> + "supervisor_bridge:start_link({local, " + (erlang-add-quotes-if-needed (erlang-get-module-from-file-name)) "}, " + (erlang-add-quotes-if-needed (erlang-get-module-from-file-name)) + ", [])." n + n + (erlang-skel-separator) + "%%% Callback functions from supervisor_bridge" n + (erlang-skel-separator) + n + (erlang-skel-separator 2) + "%% Func: init/1" n + "%% Returns: {ok, Pid, State} |" n + "%% ignore |" n + "%% {error, Reason} " n + (erlang-skel-separator 2) + "init([]) ->" n> + "case 'AModule':start_link() of" n> + "{ok, Pid} ->" n> + "{ok, Pid, #state{}};" n> + "Error ->" n> + "Error" n> + "end." n + n + (erlang-skel-separator 2) + "%% Func: terminate/2" n + "%% Purpose: Synchronized shutdown of the underlying sub system." n + "%% Returns: any" n + (erlang-skel-separator 2) + "terminate(Reason, State) ->" n> + "'AModule':stop()," n> + "ok." n + n + (erlang-skel-separator) + "%%% Internal functions" n + (erlang-skel-separator) + ) + "*The template of an supervisor_bridge behaviour. +Please see the function `tempo-define-template'.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defvar erlang-skel-generic-server + '((erlang-skel-include erlang-skel-large-header) + "-behaviour(gen_server)." n + n + "%% External exports" n + "-export([start_link/0])." n + n + "%% gen_server callbacks" n + "-export([init/1, handle_call/3, handle_cast/2, " + "handle_info/2, terminate/2])." n n + "-record(state, {})." n + n + (erlang-skel-separator) + "%%% API" n + (erlang-skel-separator) + "start_link() -> " n> + "gen_server:start_link({local, " + (erlang-add-quotes-if-needed (erlang-get-module-from-file-name)) "}, " + (erlang-add-quotes-if-needed (erlang-get-module-from-file-name)) + ", [], [])." n + n + (erlang-skel-separator) + "%%% Callback functions from gen_server" n + (erlang-skel-separator) + n + (erlang-skel-separator 2) + "%% Func: init/1" n + "%% Returns: {ok, State} |" n + "%% {ok, State, Timeout} |" n + "%% ignore |" n + "%% {stop, Reason}" n + (erlang-skel-separator 2) + "init([]) ->" n> + "{ok, #state{}}." n + n + (erlang-skel-separator 2) + "%% Func: handle_call/3" n + "%% Returns: {reply, Reply, State} |" n + "%% {reply, Reply, State, Timeout} |" n + "%% {noreply, State} |" n + "%% {noreply, State, Timeout} |" n + "%% {stop, Reason, Reply, State} | (terminate/2 is called)" n + "%% {stop, Reason, State} (terminate/2 is called)" n + (erlang-skel-separator 2) + "handle_call(Request, From, State) ->" n> + "Reply = ok," n> + "{reply, Reply, State}." n + n + (erlang-skel-separator 2) + "%% Func: handle_cast/2" n + "%% Returns: {noreply, State} |" n + "%% {noreply, State, Timeout} |" n + "%% {stop, Reason, State} (terminate/2 is called)" n + (erlang-skel-separator 2) + "handle_cast(Msg, State) ->" n> + "{noreply, State}." n + n + (erlang-skel-separator 2) + "%% Func: handle_info/2" n + "%% Returns: {noreply, State} |" n + "%% {noreply, State, Timeout} |" n + "%% {stop, Reason, State} (terminate/2 is called)" n + (erlang-skel-separator 2) + "handle_info(Info, State) ->" n> + "{noreply, State}." n + n + (erlang-skel-separator 2) + "%% Func: terminate/2" n + "%% Purpose: Shutdown the server" n + "%% Returns: any (ignored by gen_server)" n + (erlang-skel-separator 2) + "terminate(Reason, State) ->" n> + "ok." n + n + (erlang-skel-separator) + "%%% Internal functions" n + (erlang-skel-separator) + ) + "*The template of a generic server. +Please see the function `tempo-define-template'.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defvar erlang-skel-gen-event + '((erlang-skel-include erlang-skel-large-header) + "-behaviour(gen_event)." n + n + "%% External exports" n + "-export([start_link/0, add_handler/0])." n + n + "%% gen_event callbacks" n + "-export([init/1, handle_event/2, handle_call/2, " + "handle_info/2, terminate/2])." n n + "-record(state, {})." n + n + (erlang-skel-separator) + "%%% API" n + (erlang-skel-separator) + "start_link() ->" n> + "gen_event:start_link({local, " + (erlang-add-quotes-if-needed (erlang-get-module-from-file-name)) "}). " n + n + "add_handler() ->" n> + "gen_event:add_handler(" + (erlang-add-quotes-if-needed (erlang-get-module-from-file-name)) ", " + (erlang-add-quotes-if-needed (erlang-get-module-from-file-name)) + ", [])." n + n + (erlang-skel-separator) + "%%% Callback functions from gen_event" n + (erlang-skel-separator) + n + (erlang-skel-separator 2) + "%% Func: init/1" n + "%% Returns: {ok, State} |" n + "%% Other" n + (erlang-skel-separator 2) + "init([]) ->" n> + "{ok, #state{}}." n + n + (erlang-skel-separator 2) + "%% Func: handle_event/2" n + "%% Returns: {ok, State} |" n + "%% {swap_handler, Args1, State1, Mod2, Args2} |" n + "%% remove_handler " n + (erlang-skel-separator 2) + "handle_event(Event, State) ->" n> + "{ok, State}." n + n + (erlang-skel-separator 2) + "%% Func: handle_call/2" n + "%% Returns: {ok, Reply, State} |" n + "%% {swap_handler, Reply, Args1, State1, Mod2, Args2} |" n + "%% {remove_handler, Reply} " n + (erlang-skel-separator 2) + "handle_call(Request, State) ->" n> + "Reply = ok," n> + "{ok, Reply, State}." n + n + (erlang-skel-separator 2) + "%% Func: handle_info/2" n + "%% Returns: {ok, State} |" n + "%% {swap_handler, Args1, State1, Mod2, Args2} |" n + "%% remove_handler " n + (erlang-skel-separator 2) + "handle_info(Info, State) ->" n> + "{ok, State}." n + n + (erlang-skel-separator 2) + "%% Func: terminate/2" n + "%% Purpose: Shutdown the server" n + "%% Returns: any" n + (erlang-skel-separator 2) + "terminate(Reason, State) ->" n> + "ok." n + n + (erlang-skel-separator) + "%%% Internal functions" n + (erlang-skel-separator) + ) + "*The template of a gen_event. +Please see the function `tempo-define-template'.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defvar erlang-skel-gen-fsm + '((erlang-skel-include erlang-skel-large-header) + "-behaviour(gen_fsm)." n + n + "%% External exports" n + "-export([start_link/0])." n + n + "%% gen_fsm callbacks" n + "-export([init/1, state_name/2, state_name/3, handle_event/3," n> + "handle_sync_event/4, handle_info/3, terminate/3])." n n + "-record(state, {})." n + n + (erlang-skel-separator) + "%%% API" n + (erlang-skel-separator) + "start_link() ->" n> + "gen_fsm:start_link({local, " + (erlang-add-quotes-if-needed (erlang-get-module-from-file-name)) "}, " + (erlang-add-quotes-if-needed (erlang-get-module-from-file-name)) + ", [], [])." n + n + (erlang-skel-separator) + "%%% Callback functions from gen_fsm" n + (erlang-skel-separator) + n + (erlang-skel-separator 2) + "%% Func: init/1" n + "%% Returns: {ok, StateName, StateData} |" n + "%% {ok, StateName, StateData, Timeout} |" n + "%% ignore |" n + "%% {stop, StopReason} " n + (erlang-skel-separator 2) + "init([]) ->" n> + "{ok, state_name, #state{}}." n + n + (erlang-skel-separator 2) + "%% Func: StateName/2" n + "%% Returns: {next_state, NextStateName, NextStateData} |" n + "%% {next_state, NextStateName, NextStateData, Timeout} |" n + "%% {stop, Reason, NewStateData} " n + (erlang-skel-separator 2) + "state_name(Event, StateData) ->" n> + "{nextstate, state_name, StateData}." n + n + (erlang-skel-separator 2) + "%% Func: StateName/3" n + "%% Returns: {next_state, NextStateName, NextStateData} |" n + "%% {next_state, NextStateName, NextStateData, Timeout} |" n + "%% {reply, Reply, NextStateName, NextStateData} |" n + "%% {reply, Reply, NextStateName, NextStateData, Timeout} |" n + "%% {stop, Reason, NewStateData} |" n + "%% {stop, Reason, Reply, NewStateData} " n + (erlang-skel-separator 2) + "state_name(Event, From, StateData) ->" n> + "Reply = ok," n> + "{reply, Reply, state_name, StateData}." n + n + (erlang-skel-separator 2) + "%% Func: handle_event/3" n + "%% Returns: {next_state, NextStateName, NextStateData} |" n + "%% {next_state, NextStateName, NextStateData, Timeout} |" n + "%% {stop, Reason, NewStateData} " n + (erlang-skel-separator 2) + "handle_event(Event, StateName, StateData) ->" n> + "{nextstate, StateName, StateData}." n + n + (erlang-skel-separator 2) + "%% Func: handle_sync_event/4" n + "%% Returns: {next_state, NextStateName, NextStateData} |" n + "%% {next_state, NextStateName, NextStateData, Timeout} |" n + "%% {reply, Reply, NextStateName, NextStateData} |" n + "%% {reply, Reply, NextStateName, NextStateData, Timeout} |" n + "%% {stop, Reason, NewStateData} |" n + "%% {stop, Reason, Reply, NewStateData} " n + (erlang-skel-separator 2) + "handle_sync_event(Event, From, StateName, StateData) ->" n> + "Reply = ok," n> + "{reply, Reply, StateName, StateData}." n + n + (erlang-skel-separator 2) + "%% Func: handle_info/3" n + "%% Returns: {next_state, NextStateName, NextStateData} |" n + "%% {next_state, NextStateName, NextStateData, Timeout} |" n + "%% {stop, Reason, NewStateData} " n + (erlang-skel-separator 2) + "handle_info(Info, StateName, StateData) ->" n> + "{nextstate, StateName, StateData}." n + n + (erlang-skel-separator 2) + "%% Func: terminate/3" n + "%% Purpose: Shutdown the fsm" n + "%% Returns: any" n + (erlang-skel-separator 2) + "terminate(Reason, StateName, StatData) ->" n> + "ok." n + n + (erlang-skel-separator) + "%%% Internal functions" n + (erlang-skel-separator) + ) + "*The template of a gen_fsm. +Please see the function `tempo-define-template'.") + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Original erlang-add-quotes-if-needed is broken, we install a +;; new version. +;; + +(add-hook 'erlang-load-hook 'my-erlang-load-mods) + +(defun fixed-erlang-add-quotes-if-needed (str) + "Return STR, possibly with quotes." + (let ((saved-case-fold-search case-fold-search) + (result nil)) + (setq case-fold-search nil) + (setq result (if (string-match (concat "\\`" erlang-atom-regexp "\\'") str) + str + (concat "'" str "'"))) + (setq case-fold-search saved-case-fold-search) + result)) + +(defun my-erlang-load-mods () + (fset 'erlang-add-quotes-if-needed + (symbol-function 'fixed-erlang-add-quotes-if-needed)) + (appwiz-skel-init)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Additional skeletons which are not shown in the Erlang menu. +;; + +(defvar appwiz-skel + '( +; ("generic-server-no-api" erlang-skel-generic-server-no-api) +; ("generic-server-api" erlang-skel-generic-server-api) +; ("gen-event-no-api" erlang-skel-gen-event-no-api) +; ("gen-event-api" erlang-skel-gen-event-api) +; ("gen-fsm-no-api" erlang-skel-gen-fsm-no-api) +; ("gen-fsm-api" erlang-skel-gen-fsm-api) + ("makefile-middle" erlang-skel-makefile-middle) + ("makefile-src" erlang-skel-makefile-src))) + +(defun appwiz-skel-init () + "Generate the skeleton functions." + (interactive) + (condition-case nil + (require 'tempo) + (error t)) + (if (featurep 'tempo) + (let ((skel appwiz-skel)) + (while skel + (funcall (symbol-function 'tempo-define-template) + (concat "erlang-" (nth 0 (car skel))) + ;; The tempo template used contains an `include' + ;; function call only, hence changes to the + ;; variables describing the templates take effect + ;; immdiately. + (list (list 'erlang-skel-include (nth 1 (car skel)))) + (nth 0 (car skel))) + (setq skel (cdr skel)))))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; +;;;; +;; +;;(defvar erlang-skel-generic-server-no-api +;; '((erlang-skel-include erlang-skel-large-header) +;; "-behaviour(gen_server)." n +;; n +;; "%% gen_server callbacks" n +;; "-export([init/1, handle_call/3, handle_cast/2, " +;; "handle_info/2, terminate/2])." n n +;; "-record(state, {})." n +;; n +;; (erlang-skel-separator) +;; "%%% Callback functions from gen_server" n +;; (erlang-skel-separator) +;; n +;; (erlang-skel-separator 2) +;; "%% Func: init/1" n +;; "%% Returns: {ok, State} |" n +;; "%% {ok, State, Timeout} |" n +;; "%% ignore |" n +;; "%% {stop, Reason}" n +;; (erlang-skel-separator 2) +;; "init([]) ->" n> +;; "{ok, #state{}}." n +;; n +;; (erlang-skel-separator 2) +;; "%% Func: handle_call/3" n +;; "%% Returns: {reply, Reply, State} |" n +;; "%% {reply, Reply, State, Timeout} |" n +;; "%% {noreply, State} |" n +;; "%% {noreply, State, Timeout} |" n +;; "%% {stop, Reason, Reply, State} | (terminate/2 is called)" n +;; "%% {stop, Reason, State} (terminate/2 is called)" n +;; (erlang-skel-separator 2) +;; "handle_call(Request, From, State) ->" n> +;; "Reply = ok," n> +;; "{reply, Reply, State}." n +;; n +;; (erlang-skel-separator 2) +;; "%% Func: handle_cast/2" n +;; "%% Returns: {noreply, State} |" n +;; "%% {noreply, State, Timeout} |" n +;; "%% {stop, Reason, State} (terminate/2 is called)" n +;; (erlang-skel-separator 2) +;; "handle_cast(Msg, State) ->" n> +;; "{noreply, State}." n +;; n +;; (erlang-skel-separator 2) +;; "%% Func: handle_info/2" n +;; "%% Returns: {noreply, State} |" n +;; "%% {noreply, State, Timeout} |" n +;; "%% {stop, Reason, State} (terminate/2 is called)" n +;; (erlang-skel-separator 2) +;; "handle_info(Info, State) ->" n> +;; "{noreply, State}." n +;; n +;; (erlang-skel-separator 2) +;; "%% Func: terminate/2" n +;; "%% Purpose: Shutdown the server" n +;; "%% Returns: any (ignored by gen_server)" n +;; (erlang-skel-separator 2) +;; "terminate(Reason, State) ->" n> +;; "ok." n +;; n +;; (erlang-skel-separator) +;; "%%% Internal functions" n +;; (erlang-skel-separator) +;; ) +;; "*The template of a generic server. +;;Please see the function `tempo-define-template'.") +;; +;;(defvar erlang-skel-generic-server-api +;; '((erlang-skel-include erlang-skel-large-header) +;; "%% External exports" n +;; "-export([start_link/0])." n +;; n +;; (erlang-skel-separator) +;; "%%% API" n +;; (erlang-skel-separator) +;; "start_link() ->" n> +;; "gen_server:start_link({local, " +;; (erlang-add-quotes-if-needed +;; (concat (erlang-get-module-from-file-name) "_server")) "}, " +;; (erlang-add-quotes-if-needed +;; (concat (erlang-get-module-from-file-name) "_server")) ", [], [])." n +;; n +;; )) +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; +;;;; +;; +;;(defvar erlang-skel-gen-event-no-api +;; '((erlang-skel-include erlang-skel-large-header) +;; "-behaviour(gen_event)." n +;; n +;; "%% gen_event callbacks" n +;; "-export([init/1, handle_event/2, handle_call/2, " +;; "handle_info/2, terminate/2])." n n +;; "-record(state, {})." n +;; n +;; (erlang-skel-separator) +;; "%%% Callback functions from gen_event" n +;; (erlang-skel-separator) +;; n +;; (erlang-skel-separator 2) +;; "%% Func: init/1" n +;; "%% Returns: {ok, State} |" n +;; "%% Other" n +;; (erlang-skel-separator 2) +;; "init([]) ->" n> +;; "{ok, #state{}}." n +;; n +;; (erlang-skel-separator 2) +;; "%% Func: handle_event/2" n +;; "%% Returns: {ok, State} |" n +;; "%% {swap_handler, Args1, State1, Mod2, Args2} |" n +;; "%% remove_handler " n +;; (erlang-skel-separator 2) +;; "handle_event(Event, State) ->" n> +;; "{ok, State}." n +;; n +;; (erlang-skel-separator 2) +;; "%% Func: handle_call/2" n +;; "%% Returns: {ok, Reply, State} |" n +;; "%% {swap_handler, Reply, Args1, State1, Mod2, Args2} |" n +;; "%% {remove_handler, Reply} " n +;; (erlang-skel-separator 2) +;; "handle_call(Request, State) ->" n> +;; "Reply = ok," n> +;; "{ok, Reply, State}." n +;; n +;; (erlang-skel-separator 2) +;; "%% Func: handle_info/2" n +;; "%% Returns: {ok, State} |" n +;; "%% {swap_handler, Args1, State1, Mod2, Args2} |" n +;; "%% remove_handler " n +;; (erlang-skel-separator 2) +;; "handle_info(Info, State) ->" n> +;; "{ok, State}." n +;; n +;; (erlang-skel-separator 2) +;; "%% Func: terminate/2" n +;; "%% Purpose: Shutdown the server" n +;; "%% Returns: any" n +;; (erlang-skel-separator 2) +;; "terminate(Reason, State) ->" n> +;; "ok." n +;; n +;; (erlang-skel-separator) +;; "%%% Internal functions" n +;; (erlang-skel-separator) +;; ) +;; "*The template of a gen_event. +;;Please see the function `tempo-define-template'.") +;; +;;(defvar erlang-skel-gen-event-api +;; '((erlang-skel-include erlang-skel-large-header) +;; "%% External exports" n +;; "-export([start_link/0, add_handler/0])." n +;; n +;; (erlang-skel-separator) +;; "%%% API" n +;; (erlang-skel-separator) +;; "start_link() ->" n> +;; "gen_event:start_link({local, " +;; (erlang-add-quotes-if-needed +;; (concat (erlang-get-module-from-file-name) "_event")) "}). " n +;; n +;; "add_handler() ->" n> +;; "gen_event:add_handler(" +;; (erlang-add-quotes-if-needed +;; (concat (erlang-get-module-from-file-name) "_event")) ", " +;; (erlang-add-quotes-if-needed +;; (concat (erlang-get-module-from-file-name) "_event")) ", [])." n +;; n)) +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; +;;;; +;; +;;(defvar erlang-skel-gen-fsm +;; '((erlang-skel-include erlang-skel-large-header) +;; "-behaviour(gen_fsm)." n +;; n +;; "%% gen_fsm callbacks" n +;; "-export([init/1, state_name/2, state_name/3, handle_event/3," n> +;; "handle_sync_event/4, handle_info/3, terminate/3])." n n +;; "-record(state, {})." n +;; n +;; (erlang-skel-separator) +;; "%%% Callback functions from gen_fsm" n +;; (erlang-skel-separator) +;; n +;; (erlang-skel-separator 2) +;; "%% Func: init/1" n +;; "%% Returns: {ok, StateName, StateData} |" n +;; "%% {ok, StateName, StateData, Timeout} |" n +;; "%% ignore |" n +;; "%% {stop, StopReason} " n +;; (erlang-skel-separator 2) +;; "init([]) ->" n> +;; "{ok, state_name, #state{}}." n +;; n +;; (erlang-skel-separator 2) +;; "%% Func: StateName/2" n +;; "%% Returns: {next_state, NextStateName, NextStateData} |" n +;; "%% {next_state, NextStateName, NextStateData, Timeout} |" n +;; "%% {stop, Reason, NewStateData} " n +;; (erlang-skel-separator 2) +;; "state_name(Event, StateData) ->" n> +;; "{nextstate, state_name, StateData}." n +;; n +;; (erlang-skel-separator 2) +;; "%% Func: StateName/3" n +;; "%% Returns: {next_state, NextStateName, NextStateData} |" n +;; "%% {next_state, NextStateName, NextStateData, Timeout} |" n +;; "%% {reply, Reply, NextStateName, NextStateData} |" n +;; "%% {reply, Reply, NextStateName, NextStateData, Timeout} |" n +;; "%% {stop, Reason, NewStateData} |" n +;; "%% {stop, Reason, Reply, NewStateData} " n +;; (erlang-skel-separator 2) +;; "state_name(Event, From, StateData) ->" n> +;; "Reply = ok," n> +;; "{reply, Reply, state_name, StateData}." n +;; n +;; (erlang-skel-separator 2) +;; "%% Func: handle_event/3" n +;; "%% Returns: {next_state, NextStateName, NextStateData} |" n +;; "%% {next_state, NextStateName, NextStateData, Timeout} |" n +;; "%% {stop, Reason, NewStateData} " n +;; (erlang-skel-separator 2) +;; "handle_event(Event, StateName, StateData) ->" n> +;; "{nextstate, StateName, StateData}." n +;; n +;; (erlang-skel-separator 2) +;; "%% Func: handle_sync_event/4" n +;; "%% Returns: {next_state, NextStateName, NextStateData} |" n +;; "%% {next_state, NextStateName, NextStateData, Timeout} |" n +;; "%% {reply, Reply, NextStateName, NextStateData} |" n +;; "%% {reply, Reply, NextStateName, NextStateData, Timeout} |" n +;; "%% {stop, Reason, NewStateData} |" n +;; "%% {stop, Reason, Reply, NewStateData} " n +;; (erlang-skel-separator 2) +;; "handle_sync_event(Event, From, StateName, StateData) ->" n> +;; "Reply = ok," n> +;; "{reply, Reply, StateName, StateData}." n +;; n +;; (erlang-skel-separator 2) +;; "%% Func: handle_info/3" n +;; "%% Returns: {next_state, NextStateName, NextStateData} |" n +;; "%% {next_state, NextStateName, NextStateData, Timeout} |" n +;; "%% {stop, Reason, NewStateData} " n +;; (erlang-skel-separator 2) +;; "handle_info(Info, StateName, StateData) ->" n> +;; "{nextstate, StateName, StateData}." n +;; n +;; (erlang-skel-separator 2) +;; "%% Func: terminate/3" n +;; "%% Purpose: Shutdown the fsm" n +;; "%% Returns: any" n +;; (erlang-skel-separator 2) +;; "terminate(Reason, StateName, StatData) ->" n> +;; "ok." n +;; n +;; (erlang-skel-separator) +;; "%%% Internal functions" n +;; (erlang-skel-separator) +;; ) +;; "*The template of a gen_fsm. +;;Please see the function `tempo-define-template'.") +;; +;;(defvar erlang-skel-gen-fsm-no-api +;; '((erlang-skel-include erlang-skel-large-header) +;; "%% External exports" n +;; "-export([start_link/0])." n +;; n +;; (erlang-skel-separator) +;; "%%% API" n +;; (erlang-skel-separator) +;; "start_link() ->" n> +;; "gen_fsm:start_link({local, " +;; (erlang-add-quotes-if-needed +;; (concat (erlang-get-module-from-file-name) "_fsm")) "}, " +;; (erlang-add-quotes-if-needed +;; (concat (erlang-get-module-from-file-name) "_fsm")) ", [], [])." n +;; n +;; )) +;; + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; requires that the variables appwiz-erlang-modulename and +;; appwiz-erlang-ext are defined. +;; + +(defvar erlang-skel-makefile-src + '((erlang-skel-include erlang-skel-nomodule-header) + "MAKE = make" n + n + "ERL = erlc" n + n + "EBIN = ../ebin" n + n + (erlang-skel-makefile-separator) + n + (upcase appwiz-erlang-modulename) "_HEADER_FILES = " + appwiz-erlang-modulename "_sup.hrl" n + n + (upcase appwiz-erlang-modulename) "_SOURCE_FILES = \\" n + " " appwiz-erlang-modulename ".erl" " " + appwiz-erlang-modulename "_sup.erl \\" n + " " appwiz-erlang-modulename "_app.erl" " " + appwiz-erlang-modulename appwiz-erlang-ext ".erl" n + n + (upcase appwiz-erlang-modulename) "_OBJECT_FILES = $(" + (upcase appwiz-erlang-modulename) "_SOURCE_FILES:.erl=.jam)" n + n + n + (erlang-skel-makefile-separator) + "#" n + "# Transformations " n + "#" n + n + ".erl.jam:" n + " $(ERL) $<" n + n + (erlang-skel-makefile-separator) n + n + n + "def : " + appwiz-erlang-modulename n + n + appwiz-erlang-modulename ": $(" + (upcase appwiz-erlang-modulename) "_OBJECT_FILES)" n + " cp $(" (upcase appwiz-erlang-modulename) "_OBJECT_FILES) " + "$(EBIN)" n + n + "clean :" n + " /bin/rm -f $(" (upcase appwiz-erlang-modulename) + "_OBJECT_FILES)" n + n + "$(" (upcase appwiz-erlang-modulename) "_OBJECT_FILES): $(" + (upcase appwiz-erlang-modulename) "_HEADER_FILES)" n + n + ".SUFFIXES : .erl .jam" n + n + )) + +(defvar erlang-skel-makefile-middle + '((erlang-skel-include erlang-skel-nomodule-header) + "MAKE = make" n + n + (erlang-skel-makefile-separator) + n + "def:" n + " (cd src ; $(MAKE))" n + n + "clean:" n + " (cd src ; $(MAKE) clean)" n + n + )) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun erlang-skel-makefile-separator () + "Return a comment separator." + (concat (make-string 70 ?\#) "\n")) diff --git a/elpa/fiplr-0.1.3/fiplr-autoloads.el b/elpa/fiplr-0.1.3/fiplr-autoloads.el deleted file mode 100644 index 5d0b744..0000000 --- a/elpa/fiplr-0.1.3/fiplr-autoloads.el +++ /dev/null @@ -1,43 +0,0 @@ -;;; fiplr-autoloads.el --- automatically extracted autoloads -;; -;;; Code: - - -;;;### (autoloads (fiplr-clear-cache fiplr-find-directory fiplr-find-file -;;;;;; fiplr-root) "fiplr" "fiplr.el" (21530 2995 788494 33000)) -;;; Generated autoloads from fiplr.el - -(autoload 'fiplr-root "fiplr" "\ -Locate the root of the project by walking up the directory tree. - -\(fn)" nil nil) - -(autoload 'fiplr-find-file "fiplr" "\ -Runs a completing prompt to find a file from the project. - -\(fn)" nil nil) - -(autoload 'fiplr-find-directory "fiplr" "\ -Runs a completing prompt to find a directory from the project. - -\(fn)" nil nil) - -(autoload 'fiplr-clear-cache "fiplr" "\ -Clears the internal caches used by fiplr so the project is searched again. - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads nil nil ("fiplr-pkg.el") (21530 2995 927265 98000)) - -;;;*** - -(provide 'fiplr-autoloads) -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; coding: utf-8 -;; End: -;;; fiplr-autoloads.el ends here diff --git a/elpa/fiplr-0.1.3/fiplr-pkg.el b/elpa/fiplr-0.1.3/fiplr-pkg.el deleted file mode 100644 index 85e575e..0000000 --- a/elpa/fiplr-0.1.3/fiplr-pkg.el +++ /dev/null @@ -1 +0,0 @@ -(define-package "fiplr" "0.1.3" "Fuzzy finder for files in a project." (quote nil)) diff --git a/elpa/fiplr-0.1.3/fiplr.el b/elpa/fiplr-0.1.3/fiplr.el deleted file mode 100644 index 4541d3d..0000000 --- a/elpa/fiplr-0.1.3/fiplr.el +++ /dev/null @@ -1,243 +0,0 @@ -;;; fiplr.el --- Fuzzy finder for files in a project. - -;; Copyright © 2013 Chris Corbyn -;; -;; Author: Chris Corbyn -;; URL: https://github.com/d11wtq/fiplr -;; Version: 0.1.3 -;; Keywords: convenience, usability, project - -;; This file is not part of GNU Emacs. - -;;; --- License - -;; Licensed under the same terms as Emacs. - -;;; --- Commentary - -;; Overview: -;; -;; Fiplr makes it really use to find files anywhere within your entire project -;; by using a cached directory tree and delegating to ido while you search the -;; tree. -;; -;; M-x fiplr-find-file -;; -;; By default it looks through all the parent directories of the file you're -;; editing until it finds a .git, .hg, .bzr or .svn directory. You can -;; customize this list of root markers by setting `fiplr-root-markers'. -;; -;; (setq fiplr-root-markers '(".git" ".svn")) -;; -;; Some files are ignored from the directory tree because they are not text -;; files, or simply to speed up the search. The default list can be -;; customized by setting `fiplr-ignored-globs'. -;; -;; (setq fiplr-ignored-globs '((directories (".git" ".svn")) -;; (files ("*.jpg" "*.png" "*.zip" "*~")))) -;; -;; These globs are used by the UNIX `find' command's -name flag. -;; -;; Usage: -;; -;; Find files: M-x fiplr-find-file -;; Find directories: M-x fiplr-find-directory -;; Clear caches: M-x fiplr-clear-cache -;; -;; For convenience, bind "C-x f" to `fiplr-find-file': -;; -;; (global-set-key (kbd "C-x f") 'fiplr-find-file) -;; - -(require 'cl) - -;;; --- Package Configuration - -;; A cache to avoid repeat searching. -(setq *fiplr-file-cache* '()) - -;; A cache to avoid repeat searching. -(setq *fiplr-directory-cache* '()) - -;; The default set of files/directories to look for at the root of a project. -(defvar *fiplr-default-root-markers* - '(".git" ".svn" ".hg" ".bzr")) - -;; The default set of patterns to exclude from searches. -(defvar *fiplr-default-ignored-globs* - '((directories (".git" ".svn" ".hg" ".bzr")) - (files (".#*" "*.so")))) - -;; Customization group declaration. -(defgroup fiplr nil - "Configuration options for fiplr - find in project.") - -;; Settings for project root directories. -(defcustom fiplr-root-markers *fiplr-default-root-markers* - "A list of files or directories that are found at the root of a project." - :type '(repeat string) - :group 'fiplr - :options *fiplr-default-root-markers*) - -;; Settings for files and directories that should be ignored. -(defcustom fiplr-ignored-globs *fiplr-default-ignored-globs* - "An alist of glob patterns to exclude from search results." - :type '(alist :key-type symbol :value-type (repeat string)) - :group 'fiplr - :options *fiplr-default-ignored-globs*) - -;;; --- Public Functions - -;; Defines fiplr's determination of the project root. -;;;###autoload -(defun fiplr-root () - "Locate the root of the project by walking up the directory tree." - "The first directory containing one of fiplr-root-markers is the root." - "If no root marker is found, the current working directory is used." - (let ((cwd (if (buffer-file-name) - (directory-file-name - (file-name-directory (buffer-file-name))) - (file-truename ".")))) - (or (fiplr-find-root cwd fiplr-root-markers) - cwd))) - -;; Locate a file in the current project. -;;;###autoload -(defun fiplr-find-file () - "Runs a completing prompt to find a file from the project." - "The root of the project is the return value of `fiplr-root'." - (interactive) - (fiplr-find-file-in-directory (fiplr-root) fiplr-ignored-globs)) - -;; Locate a directory in the current project. -;;;###autoload -(defun fiplr-find-directory () - "Runs a completing prompt to find a directory from the project." - "The root of the project is the return value of `fiplr-root'." - (interactive) - (fiplr-find-directory-in-directory (fiplr-root) fiplr-ignored-globs)) - -;; Clear the caches. -;;;###autoload -(defun fiplr-clear-cache () - "Clears the internal caches used by fiplr so the project is searched again." - (interactive) - (setq *fiplr-file-cache* '()) - (setq *fiplr-directory-cache* '())) - -;;; --- Private Functions - -;; Search algorithm to find dir with .git etc. -(defun fiplr-find-root (path root-markers) - "Tail-recursive part of project-root." - (let* ((this-dir (file-name-as-directory (file-truename path))) - (parent-dir (expand-file-name (concat this-dir ".."))) - (system-root-dir (expand-file-name "/"))) - (cond - ((fiplr-root-p path root-markers) this-dir) - ((equal system-root-dir this-dir) nil) - (t (fiplr-find-root parent-dir root-markers))))) - -;; Predicate looking at path for a root marker. -(defun fiplr-root-p (path root-markers) - "Predicate to check if the given directory is a project root." - (let ((dir (file-name-as-directory path))) - (cl-member-if (lambda (marker) - (file-exists-p (concat dir marker))) - root-markers))) - -;; Builds a gigantic `find' shell command with -prune, -o, -not and shit. -(defun fiplr-list-files-shell-command (type path ignored-globs) - "Builds the `find' command to locate all project files & directories." - "Path is the base directory to recurse from." - "Ignored-globs is an alist with keys 'directories and 'files." - (let* ((type-abbrev - (lambda (assoc-type) - (cl-case assoc-type - ('directories "d") - ('files "f")))) - (name-matcher - (lambda (glob) - (mapconcat 'identity - `("-name" ,(shell-quote-argument glob)) - " "))) - (grouped-name-matchers - (lambda (type) - (mapconcat 'identity - `(,(shell-quote-argument "(") - ,(mapconcat (lambda (v) (funcall name-matcher v)) - (cadr (assoc type ignored-globs)) - " -o ") - ,(shell-quote-argument ")")) - " "))) - (matcher - (lambda (assoc-type) - (mapconcat 'identity - `(,(shell-quote-argument "(") - "-type" - ,(funcall type-abbrev assoc-type) - ,(funcall grouped-name-matchers assoc-type) - ,(shell-quote-argument ")")) - " ")))) - (mapconcat 'identity - `("find" - ,(shell-quote-argument (directory-file-name path)) - ,(funcall matcher 'directories) - "-prune" - "-o" - "-not" - ,(funcall matcher 'files) - "-type" - ,(funcall type-abbrev type) - "-print") - " "))) - -;; List all files found under the given path, ignoring ignored-globs. -(defun fiplr-list-files (type path ignored-globs) - "Expands to a flat list of files/directories found under path." - "The first parameter - type - is the symbol 'directories or 'files." - (let* ((prefix (file-name-as-directory (file-truename path))) - (prefix-length (length prefix)) - (list-string - (shell-command-to-string (fiplr-list-files-shell-command - type - prefix - ignored-globs)))) - (reverse (reduce (lambda (acc file) - (if (> (length file) prefix-length) - (cons (substring file prefix-length) acc) - acc)) - (split-string list-string "[\r\n]+" t) - :initial-value '())))) - -;; Runs the find file prompt for the specified path. -(defun fiplr-find-file-in-directory (path ignored-globs) - "Locate a file under the specified directory." - "If the directory has been searched previously, the cache is used." - (let ((root-dir (file-name-as-directory path))) - (unless (assoc root-dir *fiplr-file-cache*) - (push (cons root-dir (fiplr-list-files 'files root-dir ignored-globs)) - *fiplr-file-cache*)) - (let* ((project-files (cdr (assoc root-dir *fiplr-file-cache*))) - (prompt "Find project file: ") - (file (ido-completing-read prompt project-files))) - (find-file (concat root-dir file))))) - -;; Runs the find directory prompt for the specified path. -(defun fiplr-find-directory-in-directory (path ignored-globs) - "Locate a directory under the specified directory." - "If the directory has been searched previously, the cache is used." - (let ((root-dir (file-name-as-directory path))) - (unless (assoc root-dir *fiplr-directory-cache*) - (push (cons root-dir (fiplr-list-files 'directories root-dir ignored-globs)) - *fiplr-directory-cache*)) - (let* ((project-dirs (cdr (assoc root-dir *fiplr-directory-cache*))) - (prompt "Find project directory: ") - (dirname (ido-completing-read prompt project-dirs))) - (condition-case nil - (dired (concat root-dir dirname)) - (error (message (concat "Cannot open directory: " dirname))))))) - -(provide 'fiplr) - -;;; fiplr.el ends here diff --git a/elpa/fiplr-20140723.2345/fiplr-autoloads.el b/elpa/fiplr-20140723.2345/fiplr-autoloads.el new file mode 100644 index 0000000..e3d7430 --- /dev/null +++ b/elpa/fiplr-20140723.2345/fiplr-autoloads.el @@ -0,0 +1,65 @@ +;;; fiplr-autoloads.el --- automatically extracted autoloads +;; +;;; Code: +(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) + +;;;### (autoloads nil "fiplr" "fiplr.el" (22297 19831 573825 595000)) +;;; Generated autoloads from fiplr.el + +(autoload 'fiplr-find-file "fiplr" "\ +Runs a completing prompt to find a file from the project. +The root of the project is the return value of `fiplr-root'. + +\(fn)" t nil) + +(autoload 'fiplr-find-file-other-window "fiplr" "\ +Runs a completing prompt to find a file from the project. +The root of the project is the return value of `fiplr-root'. The +file is opened using `find-file-other-window'. + +\(fn)" t nil) + +(autoload 'fiplr-find-file-other-frame "fiplr" "\ +Runs a completing prompt to find a file from the project. +The root of the project is the return value of `fiplr-root'. The +file is opened using `find-file-other-frame'. + +\(fn)" t nil) + +(autoload 'fiplr-find-directory "fiplr" "\ +Runs a completing prompt to find a directory from the project. +The root of the project is the return value of `fiplr-root'. + +\(fn)" t nil) + +(autoload 'fiplr-find-directory-other-window "fiplr" "\ +Runs a completing prompt to find a directory from the project. +The root of the project is the return value of `fiplr-root'. The +directory is opened using `dired-other-window'. + +\(fn)" t nil) + +(autoload 'fiplr-find-directory-other-frame "fiplr" "\ +Runs a completing prompt to find a directory from the project. +The root of the project is the return value of `fiplr-root'. The +directory is opened using `dired-other-frame'. + +\(fn)" t nil) + +(autoload 'fiplr-clear-cache "fiplr" "\ +Clears the internal caches used by fiplr so the project is searched again. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil nil ("fiplr-pkg.el") (22297 19831 829667 665000)) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; End: +;;; fiplr-autoloads.el ends here diff --git a/elpa/fiplr-20140723.2345/fiplr-pkg.el b/elpa/fiplr-20140723.2345/fiplr-pkg.el new file mode 100644 index 0000000..818b9f8 --- /dev/null +++ b/elpa/fiplr-20140723.2345/fiplr-pkg.el @@ -0,0 +1,6 @@ +(define-package "fiplr" "20140723.2345" "Fuzzy Search for Files in Projects" + '((grizzl "0.1.0") + (cl-lib "0.1"))) +;; Local Variables: +;; no-byte-compile: t +;; End: diff --git a/elpa/fiplr-20140723.2345/fiplr.el b/elpa/fiplr-20140723.2345/fiplr.el new file mode 100644 index 0000000..4a6394f --- /dev/null +++ b/elpa/fiplr-20140723.2345/fiplr.el @@ -0,0 +1,346 @@ +;;; fiplr.el --- Fuzzy finder for files in a project. + +;; Copyright © 2013 Chris Corbyn +;; +;; Author: Chris Corbyn +;; URL: https://github.com/d11wtq/fiplr +;; Version: 0.2.8 +;; Keywords: convenience, usability, project + +;; This file is NOT part of GNU Emacs. + +;;; --- License + +;; Licensed under the same terms as Emacs. + +;;; --- Commentary + +;; Overview: +;; +;; Fiplr makes it really easy to find files anywhere within your entire +;; project by using a cached directory tree and delegating to grizzl.el +;; while you search the tree. +;; +;; M-x fiplr-find-file +;; +;; By default it looks through all the parent directories of the file you're +;; editing until it finds a .git, .hg, .bzr or .svn directory. You can +;; customize this list of root markers by setting `fiplr-root-markers'. +;; +;; (setq fiplr-root-markers '(".git" ".svn")) +;; +;; Some files are ignored from the directory tree because they are not text +;; files, or simply to speed up the search. The default list can be +;; customized by setting `fiplr-ignored-globs'. +;; +;; (setq fiplr-ignored-globs '((directories (".git" ".svn")) +;; (files ("*.jpg" "*.png" "*.zip" "*~")))) +;; +;; These globs are used by the UNIX `find' command's -name flag. +;; +;; Usage: +;; +;; Find files: M-x fiplr-find-file +;; Find directories: M-x fiplr-find-directory +;; Clear caches: M-x fiplr-clear-cache +;; +;; For convenience, bind "C-x f" to `fiplr-find-file': +;; +;; (global-set-key (kbd "C-x f") 'fiplr-find-file) +;; +;; Because fiplr caches the project tree, you may sometimes wish to clear the +;; cache while searching. Use "C-c r" to do this. + +(eval-when-compile + (require 'cl-lib) + (require 'grizzl)) + +;;; --- Package Configuration + +(defvar *fiplr-caches* '((files) (directories)) + "Internal caches used by fiplr.") + +(defvar *fiplr-default-root-markers* '(".git" ".svn" ".hg" ".bzr") + "A list of files/directories to look for that mark a project root.") + +(defvar *fiplr-default-ignored-globs* + '((directories (".git" ".svn" ".hg" ".bzr")) + (files (".#*" "*~" "*.so" "*.jpg" "*.png" "*.gif" "*.pdf" "*.gz" "*.zip"))) + "An alist of files and directories to exclude from searches.") + +(defgroup fiplr nil + "Configuration options for fiplr - find in project." + :group 'convenience) + +(defcustom fiplr-root-markers *fiplr-default-root-markers* + "A list of files or directories that are found at the root of a project." + :type '(repeat string) + :group 'fiplr) + +(defcustom fiplr-ignored-globs *fiplr-default-ignored-globs* + "An alist of glob patterns to exclude from search results." + :type '(alist :key-type symbol :value-type (repeat string)) + :group 'fiplr) + +(defcustom fiplr-list-files-function 'fiplr-list-files + "A function receiving DIR, TYPE and IGNORED, returning a list of files. + +DIR is the directory under which to locate files (recursively). +TYPE is one of the symboles 'FILES or 'DIRECTORIES. +IGNORED is an alist of glob patterns to exclude. Its keys are 'DIRECTORIES +and 'FILES, so that entire directories can be excluded. + +This setting allows for cross-platform compatibility by abstracting away the +details of locating files in a directory tree. The default uses a GNU/BSD +compatible `find' command. + +This function is only invoked once, when building the search index." + :type 'function + :group 'fiplr) + +;;; --- Public Functions + +;;;###autoload +(defun fiplr-find-file () + "Runs a completing prompt to find a file from the project. +The root of the project is the return value of `fiplr-root'." + (interactive) + (fiplr-find-file-in-directory (fiplr-root) fiplr-ignored-globs)) + +;;;###autoload +(defun fiplr-find-file-other-window () + "Runs a completing prompt to find a file from the project. +The root of the project is the return value of `fiplr-root'. The +file is opened using `find-file-other-window'." + (interactive) + (fiplr-find-file-in-directory (fiplr-root) fiplr-ignored-globs + #'find-file-other-window)) + +;;;###autoload +(defun fiplr-find-file-other-frame () + "Runs a completing prompt to find a file from the project. +The root of the project is the return value of `fiplr-root'. The +file is opened using `find-file-other-frame'." + (interactive) + (fiplr-find-file-in-directory (fiplr-root) fiplr-ignored-globs + #'find-file-other-frame)) + +;;;###autoload +(defun fiplr-find-directory () + "Runs a completing prompt to find a directory from the project. +The root of the project is the return value of `fiplr-root'." + (interactive) + (fiplr-find-directory-in-directory (fiplr-root) fiplr-ignored-globs)) + +;;;###autoload +(defun fiplr-find-directory-other-window () + "Runs a completing prompt to find a directory from the project. +The root of the project is the return value of `fiplr-root'. The +directory is opened using `dired-other-window'." + (interactive) + (fiplr-find-directory-in-directory (fiplr-root) fiplr-ignored-globs + #'dired-other-window)) + +;;;###autoload +(defun fiplr-find-directory-other-frame () + "Runs a completing prompt to find a directory from the project. +The root of the project is the return value of `fiplr-root'. The +directory is opened using `dired-other-frame'." + (interactive) + (fiplr-find-directory-in-directory (fiplr-root) fiplr-ignored-globs + #'dired-other-frame)) + +;;;###autoload +(defun fiplr-clear-cache () + "Clears the internal caches used by fiplr so the project is searched again." + (interactive) + (setq *fiplr-caches* + (list (list 'files) + (list 'directories)))) + +;;; --- Minor Mode Definition + +(defvar *fiplr-keymap* (make-sparse-keymap) + "Internal keymap used by the minor-mode in fiplr.") + +(define-key *fiplr-keymap* (kbd "C-c r") 'fiplr-reload-list) + +(define-minor-mode fiplr-mode + "Toggle the internal mode used by fiplr." + nil + " fiplr" + *fiplr-keymap*) + +;;; --- Private Macros + +(defmacro fiplr-cache (type) + "Get the internal cache used by fiplr for files of TYPE." + `(cdr (assoc ,type *fiplr-caches*))) + +;;; --- Private Functions + +(defun fiplr-root () + "Locate the root of the project by walking up the directory tree. +The first directory containing one of fiplr-root-markers is the root. +If no root marker is found, the current working directory is used." + (let ((cwd (if (buffer-file-name) + (directory-file-name + (file-name-directory (buffer-file-name))) + (file-truename ".")))) + (or (fiplr-find-root cwd fiplr-root-markers) + cwd))) + +(defun fiplr-find-root (path root-markers) + "Tail-recursive part of project-root." + (let* ((this-dir (file-name-as-directory (file-truename path))) + (parent-dir (expand-file-name (concat this-dir ".."))) + (system-root-dir (expand-file-name "/"))) + (cond + ((fiplr-root-p path root-markers) this-dir) + ((equal system-root-dir this-dir) nil) + (t (fiplr-find-root parent-dir root-markers))))) + +(defun fiplr-anyp (pred seq) + "True if any value in SEQ matches PRED." + (catch 'found + (cl-map nil (lambda (v) + (when (funcall pred v) + (throw 'found v))) + seq))) + +(defun fiplr-root-p (path root-markers) + "Predicate to check if the given directory is a project root." + (let ((dir (file-name-as-directory path))) + (fiplr-anyp (lambda (marker) + (file-exists-p (concat dir marker))) + root-markers))) + +(defun fiplr-list-files-shell-command (type path ignored-globs) + "Builds the `find' command to locate all project files & directories. + +PATH is the base directory to recurse from. +IGNORED-GLOBS is an alist with keys 'DIRECTORIES and 'FILES." + (let* ((type-abbrev + (lambda (assoc-type) + (cl-case assoc-type + ('directories "d") + ('files "f")))) + (name-matcher + (lambda (glob) + (mapconcat 'identity + `("-name" ,(shell-quote-argument glob)) + " "))) + (grouped-name-matchers + (lambda (type) + (mapconcat 'identity + `(,(shell-quote-argument "(") + ,(mapconcat (lambda (v) (funcall name-matcher v)) + (cadr (assoc type ignored-globs)) + " -o ") + ,(shell-quote-argument ")")) + " "))) + (matcher + (lambda (assoc-type) + (mapconcat 'identity + `(,(shell-quote-argument "(") + "-type" + ,(funcall type-abbrev assoc-type) + ,(funcall grouped-name-matchers assoc-type) + ,(shell-quote-argument ")")) + " ")))) + (mapconcat 'identity + `("find" + "-L" + ,(shell-quote-argument (directory-file-name path)) + ,(funcall matcher 'directories) + "-prune" + "-o" + "-not" + ,(funcall matcher 'files) + "-type" + ,(funcall type-abbrev type) + "-print") + " "))) + +(defun fiplr-list-files (type path ignored-globs) + "Expands to a flat list of files/directories found under PATH. +The first parameter TYPE is the symbol 'DIRECTORIES or 'FILES." + (let* ((prefix (file-name-as-directory (file-truename path))) + (prefix-length (length prefix)) + (list-string + (shell-command-to-string (fiplr-list-files-shell-command + type + prefix + ignored-globs)))) + (reverse (cl-reduce (lambda (acc file) + (if (> (length file) prefix-length) + (cons (substring file prefix-length) acc) + acc)) + (split-string list-string "[\r\n]+" t) + :initial-value '())))) + +(defun fiplr-reload-list () + "Clear caches and reload the file listing." + (interactive) + (when (minibufferp) + (exit-minibuffer)) + (fiplr-clear-cache) + (funcall last-command)) + +(defun fiplr-report-progress (n total) + "Show the number of files processed in the message area." + (when (= 0 (mod n 1000)) + (message (format "Indexing (%d/%d)" n total)))) + +(defun fiplr-find-file-in-directory + (path ignored-globs &optional find-file-function) + "Locate a file under the specified PATH. +If the directory has been searched previously, the cache is used. +Use FIND-FILE-FUNCTION to open the selected file, or `find-file' +if FIND-FILE-FUNCTION is `nil'." + (let* ((root-dir (file-name-as-directory path)) + (index (fiplr-get-index 'files root-dir ignored-globs)) + (file (minibuffer-with-setup-hook + (lambda () + (fiplr-mode 1)) + (grizzl-completing-read (format "Find in project (%s)" root-dir) + index)))) + (if (eq this-command 'fiplr-reload-list) ; exited for reload + (fiplr-reload-list) + (funcall (or find-file-function #'find-file) + (concat root-dir file))))) + +(defun fiplr-find-directory-in-directory + (path ignored-globs &optional dired-function) + "Locate a directory and run dired under the specified PATH. +If the directory has been searched previously, the cache is used. +Use DIRED-FUNCTION to open the selected file, or `dired' if +DIRED-FUNCTION is `nil'." + (let* ((root-dir (file-name-as-directory path)) + (index (fiplr-get-index 'directories root-dir ignored-globs)) + (dir (minibuffer-with-setup-hook + (lambda () + (fiplr-mode 1)) + (grizzl-completing-read (format "Dired in project (%s)" root-dir) + index)))) + (if (eq this-command 'fiplr-reload-list) ; exited for reload + (fiplr-reload-list) + (funcall (or dired-function #'dired) (concat root-dir dir))))) + +(defun fiplr-get-index (type path ignored-globs) + "Internal function to lazily get a fiplr fuzzy search index." + (let ((fiplr-cache-key (cons path ignored-globs))) + (unless (assoc fiplr-cache-key (fiplr-cache type)) + (message (format "Scanning... (%s)" path)) + (push (cons fiplr-cache-key + (grizzl-make-index (funcall fiplr-list-files-function + type + path + ignored-globs) + :progress-fn #'fiplr-report-progress)) + (fiplr-cache type))) + (cdr (assoc fiplr-cache-key (fiplr-cache type))))) + +(provide 'fiplr) + +;;; fiplr.el ends here diff --git a/elpa/ggtags-20151214.1344/ggtags-autoloads.el b/elpa/ggtags-20151214.1344/ggtags-autoloads.el new file mode 100644 index 0000000..7a4aed4 --- /dev/null +++ b/elpa/ggtags-20151214.1344/ggtags-autoloads.el @@ -0,0 +1,51 @@ +;;; ggtags-autoloads.el --- automatically extracted autoloads +;; +;;; Code: +(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) + +;;;### (autoloads nil "ggtags" "ggtags.el" (22297 20828 347968 373000)) +;;; Generated autoloads from ggtags.el + +(autoload 'ggtags-find-project "ggtags" "\ + + +\(fn)" nil nil) + +(autoload 'ggtags-find-tag-dwim "ggtags" "\ +Find NAME by context. +If point is at a definition tag, find references, and vice versa. +If point is at a line that matches `ggtags-include-pattern', find +the include file instead. + +When called interactively with a prefix arg, always find +definition tags. + +\(fn NAME &optional WHAT)" t nil) + +(autoload 'ggtags-mode "ggtags" "\ +Toggle Ggtags mode on or off. +With a prefix argument ARG, enable Ggtags mode if ARG is +positive, and disable it otherwise. If called from Lisp, enable +the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'. +\\{ggtags-mode-map} + +\(fn &optional ARG)" t nil) + +(autoload 'ggtags-build-imenu-index "ggtags" "\ +A function suitable for `imenu-create-index-function'. + +\(fn)" nil nil) + +(autoload 'ggtags-try-complete-tag "ggtags" "\ +A function suitable for `hippie-expand-try-functions-list'. + +\(fn OLD)" nil nil) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; End: +;;; ggtags-autoloads.el ends here diff --git a/elpa/ggtags-20151214.1344/ggtags-pkg.el b/elpa/ggtags-20151214.1344/ggtags-pkg.el new file mode 100644 index 0000000..f505ad7 --- /dev/null +++ b/elpa/ggtags-20151214.1344/ggtags-pkg.el @@ -0,0 +1 @@ +(define-package "ggtags" "20151214.1344" "emacs frontend to GNU Global source code tagging system" '((emacs "24") (cl-lib "0.5")) :url "https://github.com/leoliu/ggtags" :keywords '("tools" "convenience")) diff --git a/elpa/ggtags-20151214.1344/ggtags.el b/elpa/ggtags-20151214.1344/ggtags.el new file mode 100644 index 0000000..2aaacce --- /dev/null +++ b/elpa/ggtags-20151214.1344/ggtags.el @@ -0,0 +1,2376 @@ +;;; ggtags.el --- emacs frontend to GNU Global source code tagging system -*- lexical-binding: t; -*- + +;; Copyright (C) 2013-2015 Free Software Foundation, Inc. + +;; Author: Leo Liu +;; Version: 0.8.11 +;; Package-Version: 20151214.1344 +;; Keywords: tools, convenience +;; Created: 2013-01-29 +;; URL: https://github.com/leoliu/ggtags +;; Package-Requires: ((emacs "24") (cl-lib "0.5")) + +;; 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: + +;; A package to integrate GNU Global source code tagging system +;; (http://www.gnu.org/software/global) with Emacs. +;; +;; Usage: +;; +;; `ggtags' is similar to the standard `etags' package. These keys +;; `M-.', `M-,', `M-*' and `C-M-.' should work as expected in +;; `ggtags-mode'. See the README in https://github.com/leoliu/ggtags +;; for more details. +;; +;; All commands are available from the `Ggtags' menu in `ggtags-mode'. + +;;; NEWS 0.8.11 (2015-12-15): + +;; - `ggtags-highlight-tag-delay' is renamed to `ggtags-highlight-tag' +;; - Tag highlighting can be disabled by setting +;; `ggtags-highlight-tag' to nil. +;; +;; See full NEWS on https://github.com/leoliu/ggtags#news + +;;; Code: + +(eval-when-compile + (require 'url-parse)) + +(require 'cl-lib) +(require 'ewoc) +(require 'compile) +(require 'etags) +(require 'tabulated-list) ;preloaded since 24.3 + +(eval-when-compile + (unless (fboundp 'setq-local) + (defmacro setq-local (var val) + (list 'set (list 'make-local-variable (list 'quote var)) val))) + + (unless (fboundp 'defvar-local) + (defmacro defvar-local (var val &optional docstring) + (declare (debug defvar) (doc-string 3)) + (list 'progn (list 'defvar var val docstring) + (list 'make-variable-buffer-local (list 'quote var))))) + + (or (fboundp 'add-function) (defmacro add-function (&rest _))) ;24.4 + (or (fboundp 'remove-function) (defmacro remove-function (&rest _))) + + (defmacro ignore-errors-unless-debug (&rest body) + "Ignore all errors while executing BODY unless debug is on." + (declare (debug t) (indent 0)) + `(condition-case-unless-debug nil (progn ,@body) (error nil))) + + (defmacro with-display-buffer-no-window (&rest body) + (declare (debug t) (indent 0)) + ;; See http://debbugs.gnu.org/13594 + `(let ((display-buffer-overriding-action + (if (and ggtags-auto-jump-to-match + ;; Appeared in emacs 24.4. + (fboundp 'display-buffer-no-window)) + (list #'display-buffer-no-window) + display-buffer-overriding-action))) + ,@body))) + +(eval-and-compile + (or (fboundp 'user-error) ;24.3 + (defalias 'user-error 'error)) + (or (fboundp 'read-only-mode) ;24.3 + (defalias 'read-only-mode 'toggle-read-only)) + (or (fboundp 'register-read-with-preview) ;24.4 + (defalias 'register-read-with-preview 'read-char))) + +(defgroup ggtags nil + "GNU Global source code tagging system." + :group 'tools) + +(defface ggtags-highlight '((t (:underline t))) + "Face used to highlight a valid tag at point." + :group 'ggtags) + +(defface ggtags-global-line '((t (:inherit secondary-selection))) + "Face used to highlight matched line in Global buffer." + :group 'ggtags) + +(defcustom ggtags-executable-directory nil + "If non-nil the directory to search global executables." + :type '(choice (const :tag "Unset" nil) directory) + :risky t + :group 'ggtags) + +(defcustom ggtags-oversize-limit (* 10 1024 1024) + "The over size limit for the GTAGS file. +When the size of the GTAGS file is below this limit, ggtags +always maintains up-to-date tags for the whole source tree by +running `global -u'. For projects with GTAGS larger than this +limit, only files edited in Ggtags mode are updated (via `global +--single-update')." + :safe 'numberp + :type '(choice (const :tag "None" nil) + (const :tag "Always" t) + number) + :group 'ggtags) + +(defcustom ggtags-include-pattern + '("^\\s-*#\\s-*\\(?:include\\|import\\)\\s-*[\"<]\\(?:[./]*\\)?\\(.*?\\)[\">]" . 1) + "Pattern used to detect #include files. +Value can be (REGEXP . SUB) or a function with no arguments. +REGEXP should match from the beginning of line." + :type '(choice (const :tag "Disable" nil) + (cons regexp integer) + function) + :safe 'stringp + :group 'ggtags) + +;; See also: http://article.gmane.org/gmane.comp.gnu.global.bugs/1751 +(defcustom ggtags-use-project-gtagsconf t + "Non-nil to use GTAGSCONF file found at project root. +File .globalrc and gtags.conf are checked in order. + +Note: GNU Global v6.2.13 has the feature of using gtags.conf at +project root. Setting this variable to nil doesn't disable this +feature." + :safe 'booleanp + :type 'boolean + :group 'ggtags) + +(defcustom ggtags-project-duration 600 + "Seconds to keep information of a project in memory." + :type 'number + :group 'ggtags) + +(defcustom ggtags-process-environment nil + "Similar to `process-environment' with higher precedence. +Elements are run through `substitute-env-vars' before use. +GTAGSROOT will always be expanded to current project root +directory. This is intended for project-wise ggtags-specific +process environment settings. Note on remote hosts (e.g. tramp) +directory local variables is not enabled by default per +`enable-remote-dir-locals' (which see)." + :safe 'ggtags-list-of-string-p + :type '(repeat string) + :group 'ggtags) + +(defcustom ggtags-auto-jump-to-match 'history + "Strategy on how to jump to match: nil, first or history. + + nil: never automatically jump to any match; + first: jump to the first match; +history: jump to the match stored in search history." + :type '(choice (const :tag "First match" first) + (const :tag "Search History" history) + (const :tag "Never" nil)) + :group 'ggtags) + +(defcustom ggtags-global-window-height 8 ; ggtags-global-mode + "Number of lines for the *ggtags-global* popup window. +If nil, use Emacs default." + :type '(choice (const :tag "Default" nil) integer) + :group 'ggtags) + +(defcustom ggtags-global-abbreviate-filename 40 + "Non-nil to display file names abbreviated e.g. \"/u/b/env\". +If an integer abbreviate only names longer than that number." + :type '(choice (const :tag "No" nil) + (const :tag "Always" t) + integer) + :group 'ggtags) + +(defcustom ggtags-split-window-function split-window-preferred-function + "A function to control how ggtags pops up the auxiliary window." + :type 'function + :group 'ggtags) + +(defcustom ggtags-use-idutils (and (executable-find "mkid") t) + "Non-nil to also generate the idutils DB." + :type 'boolean + :group 'ggtags) + +(defcustom ggtags-use-sqlite3 nil + "Use sqlite3 for storage instead of Berkeley DB. +This feature requires GNU Global 6.3.3+ and is ignored if `gtags' +isn't built with sqlite3 support." + :type 'boolean + :safe 'booleanp + :group 'ggtags) + +(defcustom ggtags-sort-by-nearness nil + "Sort tags by nearness to current directory. +GNU Global 6.5+ required." + :type 'boolean + :safe #'booleanp + :group 'ggtags) + +(defcustom ggtags-update-on-save t + "Non-nil to update tags for current buffer on saving." + ;; It is reported that `global --single-update' can be slow in sshfs + ;; directories. See https://github.com/leoliu/ggtags/issues/85. + :safe #'booleanp + :type 'boolean + :group 'ggtags) + +(defcustom ggtags-global-output-format 'grep + "Global output format: path, ctags, ctags-x, grep or cscope." + :type '(choice (const path) + (const ctags) + (const ctags-x) + (const grep) + (const cscope)) + :group 'ggtags) + +(defcustom ggtags-global-use-color t + "Non-nil to use color in output if supported by Global. +Note: processing colored output takes noticeable time +particularly when the output is large." + :type 'boolean + :safe 'booleanp + :group 'ggtags) + +(defcustom ggtags-global-ignore-case nil + "Non-nil if Global should ignore case in the search pattern." + :safe 'booleanp + :type 'boolean + :group 'ggtags) + +(defcustom ggtags-global-treat-text nil + "Non-nil if Global should include matches from text files. +This affects `ggtags-find-file' and `ggtags-grep'." + :safe 'booleanp + :type 'boolean + :group 'ggtags) + +;; See also https://github.com/leoliu/ggtags/issues/52 +(defcustom ggtags-global-search-libpath-for-reference t + "If non-nil global will search GTAGSLIBPATH for references. +Search is only continued in GTAGSLIBPATH if it finds no matches +in current project." + :safe 'booleanp + :type 'boolean + :group 'ggtags) + +(defcustom ggtags-global-large-output 1000 + "Number of lines in the Global buffer to indicate large output." + :type 'number + :group 'ggtags) + +(defcustom ggtags-global-history-length history-length + "Maximum number of items to keep in `ggtags-global-search-history'." + :type 'integer + :group 'ggtags) + +(defcustom ggtags-enable-navigation-keys t + "If non-nil key bindings in `ggtags-navigation-map' are enabled." + :safe 'booleanp + :type 'boolean + :group 'ggtags) + +(defcustom ggtags-find-tag-hook nil + "Hook run immediately after finding a tag." + :options '(recenter reposition-window) + :type 'hook + :group 'ggtags) + +(defcustom ggtags-get-definition-function #'ggtags-get-definition-default + "Function called by `ggtags-show-definition' to get definition. +It is passed a list of definition candidates of the form: + + (TEXT NAME FILE LINE) + +where TEXT is usually the source line of the definition. + +The return value is passed to `ggtags-print-definition-function'." + :type 'function + :group 'ggtags) + +(defcustom ggtags-print-definition-function + (lambda (s) (ggtags-echo "%s" (or s "[definition not found]"))) + "Function used by `ggtags-show-definition' to print definition." + :type 'function + :group 'ggtags) + +(defcustom ggtags-mode-sticky t + "If non-nil enable Ggtags Mode in files visited." + :safe 'booleanp + :type 'boolean + :group 'ggtags) + +(defcustom ggtags-mode-prefix-key "\C-c" + "Key binding used for `ggtags-mode-prefix-map'. +Users should change the value using `customize-variable' to +properly update `ggtags-mode-map'." + :set (lambda (sym value) + (when (bound-and-true-p ggtags-mode-map) + (let ((old (and (boundp sym) (symbol-value sym)))) + (and old (define-key ggtags-mode-map old nil))) + (and value + (bound-and-true-p ggtags-mode-prefix-map) + (define-key ggtags-mode-map value ggtags-mode-prefix-map))) + (set-default sym value)) + :type 'key-sequence + :group 'ggtags) + +(defcustom ggtags-completing-read-function nil + "Ggtags specific `completing-read-function' (which see). +Nil means using the value of `completing-read-function'." + :type '(choice (const :tag "Use completing-read-function" nil) + function) + :group 'ggtags) + +(define-obsolete-variable-alias 'ggtags-highlight-tag-delay 'ggtags-highlight-tag + "0.8.11") + +(defcustom ggtags-highlight-tag 0.25 + "If non-nil time in seconds before highlighting tag at point. +Set to `nil' to disable tag highlighting." + :set (lambda (sym value) + (when (fboundp 'ggtags-setup-highlight-tag-at-point) + (ggtags-setup-highlight-tag-at-point value)) + (set-default sym value)) + :type '(choice (const :tag "Disable" nil) number) + :group 'ggtags) + +(defcustom ggtags-bounds-of-tag-function (lambda () + (bounds-of-thing-at-point 'symbol)) + "Function to get the start and end positions of the tag at point." + :type 'function + :group 'ggtags) + +;; Used by ggtags-global-mode +(defvar ggtags-global-error "match" + "Stem of message to print when no matches are found.") + +(defconst ggtags-bug-url "https://github.com/leoliu/ggtags/issues") + +(defvar ggtags-global-last-buffer nil) + +(defvar ggtags-global-continuation nil) + +(defvar ggtags-current-tag-name nil) + +(defvar ggtags-highlight-tag-overlay nil) + +(defvar ggtags-highlight-tag-timer nil) + +(defmacro ggtags-with-temp-message (message &rest body) + (declare (debug t) (indent 1)) + (let ((init-time (make-symbol "-init-time-")) + (tmp-msg (make-symbol "-tmp-msg-"))) + `(let ((,init-time (float-time)) + (,tmp-msg ,message)) + (with-temp-message ,tmp-msg + (prog1 (progn ,@body) + (message "%sdone (%.2fs)" ,(or tmp-msg "") + (- (float-time) ,init-time))))))) + +(defmacro ggtags-delay-finish-functions (&rest body) + "Delay running `compilation-finish-functions' until after BODY." + (declare (indent 0) (debug t)) + (let ((saved (make-symbol "-saved-")) + (exit-args (make-symbol "-exit-args-"))) + `(let ((,saved compilation-finish-functions) + ,exit-args) + (setq-local compilation-finish-functions nil) + (add-hook 'compilation-finish-functions + (lambda (&rest args) (setq ,exit-args args)) + nil t) + (unwind-protect (progn ,@body) + (setq-local compilation-finish-functions ,saved) + (and ,exit-args (apply #'run-hook-with-args + 'compilation-finish-functions ,exit-args)))))) + +(defmacro ggtags-ensure-global-buffer (&rest body) + (declare (debug t) (indent 0)) + `(progn + (or (and (buffer-live-p ggtags-global-last-buffer) + (with-current-buffer ggtags-global-last-buffer + (derived-mode-p 'ggtags-global-mode))) + (error "No global buffer found")) + (with-current-buffer ggtags-global-last-buffer ,@body))) + +(defun ggtags-list-of-string-p (xs) + "Return non-nil if XS is a list of strings." + (cl-every #'stringp xs)) + +(defun ggtags-ensure-localname (file) + (and file (or (file-remote-p file 'localname) file))) + +(defun ggtags-echo (format-string &rest args) + "Print formatted text to echo area." + (let (message-log-max) (apply #'message format-string args))) + +(defun ggtags-forward-to-line (line) + "Move to line number LINE in current buffer." + (cl-check-type line (integer 1)) + (save-restriction + (widen) + (goto-char (point-min)) + (forward-line (1- line)))) + +(defun ggtags-kill-window () + "Quit selected window and kill its buffer." + (interactive) + (quit-window t)) + +(defun ggtags-program-path (name) + (if ggtags-executable-directory + (expand-file-name name ggtags-executable-directory) + name)) + +(defun ggtags-process-succeed-p (program &rest args) + "Return non-nil if successfully running PROGRAM with ARGS." + (let ((program (ggtags-program-path program))) + (condition-case err + (zerop (apply #'process-file program nil nil nil args)) + (error (message "`%s' failed: %s" program (error-message-string err)) + nil)))) + +(defun ggtags-process-string (program &rest args) + (with-temp-buffer + (let ((exit (apply #'process-file + (ggtags-program-path program) nil t nil args)) + (output (progn + (goto-char (point-max)) + (skip-chars-backward " \t\n") + (buffer-substring (point-min) (point))))) + (or (zerop exit) + (error "`%s' non-zero exit: %s" program output)) + output))) + +(defun ggtags-tag-at-point () + (pcase (funcall ggtags-bounds-of-tag-function) + (`(,beg . ,end) (buffer-substring beg end)))) + +;;; Store for project info and settings + +(defvar ggtags-projects (make-hash-table :size 7 :test #'equal)) + +(cl-defstruct (ggtags-project (:constructor ggtags-project--make) + (:copier nil) + (:type vector) + :named) + root tag-size has-refs has-path-style has-color dirty-p mtime timestamp) + +(defun ggtags-make-project (root) + (cl-check-type root string) + (pcase (nthcdr 5 (file-attributes (expand-file-name "GTAGS" root))) + (`(,mtime ,_ ,tag-size . ,_) + (let* ((default-directory (file-name-as-directory root)) + (rtags-size (nth 7 (file-attributes "GRTAGS"))) + (has-refs + (when rtags-size + (and (or (> rtags-size (* 32 1024)) + (with-demoted-errors "ggtags-make-project: %S" + (not (equal "" (ggtags-process-string "global" "-crs"))))) + 'has-refs))) + ;; http://thread.gmane.org/gmane.comp.gnu.global.bugs/1518 + (has-path-style + (and (ggtags-process-succeed-p "global" "--path-style" "shorter" "--help") + 'has-path-style)) + ;; http://thread.gmane.org/gmane.comp.gnu.global.bugs/1542 + (has-color (and (ggtags-process-succeed-p "global" "--color" "--help") + 'has-color))) + (puthash default-directory + (ggtags-project--make :root default-directory + :tag-size tag-size + :has-refs has-refs + :has-path-style has-path-style + :has-color has-color + :mtime (float-time mtime) + :timestamp (float-time)) + ggtags-projects))))) + +(defun ggtags-project-expired-p (project) + (or (< (ggtags-project-timestamp project) 0) + (> (- (float-time) + (ggtags-project-timestamp project)) + ggtags-project-duration))) + +(defun ggtags-project-update-mtime-maybe (&optional project) + "Update PROJECT's modtime and if current file is newer. +Value is new modtime if updated." + (let ((project (or project (ggtags-find-project)))) + (when (and (ggtags-project-p project) + (consp (visited-file-modtime)) + (> (float-time (visited-file-modtime)) + (ggtags-project-mtime project))) + (setf (ggtags-project-dirty-p project) t) + (setf (ggtags-project-mtime project) + (float-time (visited-file-modtime)))))) + +(defun ggtags-project-oversize-p (&optional project) + (pcase ggtags-oversize-limit + (`nil nil) + (`t t) + (size (let ((project (or project (ggtags-find-project)))) + (and project (> (ggtags-project-tag-size project) size)))))) + +(defvar-local ggtags-last-default-directory nil) +(defvar-local ggtags-project-root 'unset + "Internal variable for project root directory.") + +;;;###autoload +(defun ggtags-find-project () + ;; See https://github.com/leoliu/ggtags/issues/42 + ;; + ;; It is unsafe to cache `ggtags-project-root' in non-file buffers + ;; whose `default-directory' can often change. + (unless (equal ggtags-last-default-directory default-directory) + (kill-local-variable 'ggtags-project-root)) + (let ((project (gethash ggtags-project-root ggtags-projects))) + (if (ggtags-project-p project) + (if (ggtags-project-expired-p project) + (progn + (remhash ggtags-project-root ggtags-projects) + (ggtags-find-project)) + project) + (setq ggtags-last-default-directory default-directory) + (setq ggtags-project-root + (or (ignore-errors-unless-debug + (file-name-as-directory + (concat (file-remote-p default-directory) + ;; Resolves symbolic links + (ggtags-process-string "global" "-pr")))) + ;; 'global -pr' resolves symlinks before checking the + ;; GTAGS file which could cause issues such as + ;; https://github.com/leoliu/ggtags/issues/22, so + ;; let's help it out. + ;; + ;; Note: `locate-dominating-file' doesn't accept + ;; function for NAME before 24.3. + (let ((dir (locate-dominating-file default-directory "GTAGS"))) + ;; `file-truename' may strip the trailing '/' on + ;; remote hosts, see http://debbugs.gnu.org/16851 + (and dir (file-regular-p (expand-file-name "GTAGS" dir)) + (file-name-as-directory (file-truename dir)))))) + (when ggtags-project-root + (if (gethash ggtags-project-root ggtags-projects) + (ggtags-find-project) + (ggtags-make-project ggtags-project-root)))))) + +(defun ggtags-current-project-root () + (and (ggtags-find-project) + (ggtags-project-root (ggtags-find-project)))) + +(defun ggtags-check-project () + (or (ggtags-find-project) (error "File GTAGS not found"))) + +(defun ggtags-ensure-project () + (or (ggtags-find-project) + (progn (call-interactively #'ggtags-create-tags) + ;; Need checking because `ggtags-create-tags' can create + ;; tags in any directory. + (ggtags-check-project)))) + +(defvar delete-trailing-lines) ;new in 24.3 + +(defun ggtags-save-project-settings (&optional noconfirm) + "Save Gnu Global's specific environment variables." + (interactive "P") + (ggtags-check-project) + (let* ((inhibit-read-only t) ; for `add-dir-local-variable' + (default-directory (ggtags-current-project-root)) + ;; Not using `ggtags-with-current-project' to preserve + ;; environment variables that may be present in + ;; `ggtags-process-environment'. + (process-environment + (append ggtags-process-environment + process-environment + (and (not (ggtags-project-has-refs (ggtags-find-project))) + (list "GTAGSLABEL=ctags")))) + (envlist (delete-dups + (cl-loop for x in process-environment + when (string-match + "^\\(GTAGS[^=\n]*\\|MAKEOBJDIRPREFIX\\)=" x) + ;; May have duplicates thus `delete-dups'. + collect (concat (match-string 1 x) + "=" + (getenv (match-string 1 x)))))) + (help-form (format "y: save\nn: don't save\n=: diff\n?: help\n"))) + (add-dir-local-variable nil 'ggtags-process-environment envlist) + ;; Remove trailing newlines by `add-dir-local-variable'. + (let ((delete-trailing-lines t)) (delete-trailing-whitespace)) + (or noconfirm + (while (pcase (read-char-choice + (format "Save `%s'? (y/n/=/?) " buffer-file-name) + '(?y ?n ?= ??)) + ;; ` required for 24.1 and 24.2 + (`?n (user-error "Aborted")) + (`?y nil) + (`?= (diff-buffer-with-file) 'loop) + (`?? (help-form-show) 'loop)))) + (save-buffer) + (kill-buffer))) + +(defun ggtags-toggle-project-read-only () + (interactive) + (ggtags-check-project) + (let ((inhibit-read-only t) ; for `add-dir-local-variable' + (val (not buffer-read-only)) + (default-directory (ggtags-current-project-root))) + (add-dir-local-variable nil 'buffer-read-only val) + (save-buffer) + (kill-buffer) + (when buffer-file-name + (read-only-mode (if val +1 -1))) + (when (called-interactively-p 'interactive) + (message "Project read-only-mode is %s" (if val "on" "off"))) + val)) + +(defun ggtags-visit-project-root (&optional project) + "Visit the root directory of (current) PROJECT in dired. +When called with a prefix \\[universal-argument], choose from past projects." + (interactive (list (and current-prefix-arg + (completing-read "Project: " ggtags-projects)))) + (dired (cl-typecase project + (string project) + (ggtags-project (ggtags-project-root project)) + (t (ggtags-ensure-project) (ggtags-current-project-root))))) + +(defmacro ggtags-with-current-project (&rest body) + "Eval BODY in current project's `process-environment'." + (declare (debug t) (indent 0)) + (let ((gtagsroot (make-symbol "-gtagsroot-")) + (root (make-symbol "-ggtags-project-root-"))) + `(let* ((,root ggtags-project-root) + (,gtagsroot (when (ggtags-find-project) + (ggtags-ensure-localname + (directory-file-name (ggtags-current-project-root))))) + (process-environment + (append (let ((process-environment (copy-sequence process-environment))) + (and ,gtagsroot (setenv "GTAGSROOT" ,gtagsroot)) + (mapcar #'substitute-env-vars ggtags-process-environment)) + process-environment + (and ,gtagsroot (list (concat "GTAGSROOT=" ,gtagsroot))) + (and (ggtags-find-project) + (not (ggtags-project-has-refs (ggtags-find-project))) + (list "GTAGSLABEL=ctags"))))) + (unwind-protect (save-current-buffer ,@body) + (setq ggtags-project-root ,root))))) + +(defun ggtags-get-libpath () + (let ((path (ggtags-with-current-project (getenv "GTAGSLIBPATH")))) + (and path (mapcar (apply-partially #'concat (file-remote-p default-directory)) + (split-string path (regexp-quote path-separator) t))))) + +(defun ggtags-project-relative-file (file) + "Get file name relative to current project root." + (ggtags-check-project) + (if (file-name-absolute-p file) + (file-relative-name file (if (string-prefix-p (ggtags-current-project-root) + file) + (ggtags-current-project-root) + (locate-dominating-file file "GTAGS"))) + file)) + +(defun ggtags-project-file-p (file) + "Return non-nil if FILE is part of current project." + (when (ggtags-find-project) + (with-temp-buffer + (ggtags-with-current-project + ;; NOTE: `process-file' requires all files in ARGS be relative + ;; to `default-directory'; see its doc string for details. + (let ((default-directory (ggtags-current-project-root))) + (process-file (ggtags-program-path "global") nil t nil + "-vP" (concat "^" (ggtags-project-relative-file file) "$")))) + (goto-char (point-min)) + (not (re-search-forward "^file not found" nil t))))) + +(defun ggtags-invalidate-buffer-project-root (root) + (mapc (lambda (buf) + (with-current-buffer buf + (and buffer-file-truename + (string-prefix-p root buffer-file-truename) + (kill-local-variable 'ggtags-project-root)))) + (buffer-list))) + +(defun ggtags-create-tags (root) + "Create tag files (e.g. GTAGS) in directory ROOT. +If file .globalrc or gtags.conf exists in ROOT, it will be used +as configuration file per `ggtags-use-project-gtagsconf'. + +If file gtags.files exists in ROOT, it should be a list of source +files to index, which can be used to speed gtags up in large +source trees. See Info node `(global)gtags' for details." + (interactive "DRoot directory: ") + (let ((process-environment (copy-sequence process-environment))) + (when (zerop (length root)) (error "No root directory provided")) + (setenv "GTAGSROOT" (ggtags-ensure-localname + (expand-file-name + (directory-file-name (file-name-as-directory root))))) + (ggtags-with-current-project + (let ((conf (and ggtags-use-project-gtagsconf + (cl-loop for name in '(".globalrc" "gtags.conf") + for full = (expand-file-name name root) + thereis (and (file-exists-p full) full))))) + (unless (or conf (getenv "GTAGSLABEL") + (not (yes-or-no-p "Use `ctags' backend? "))) + (setenv "GTAGSLABEL" "ctags")) + (ggtags-with-temp-message "`gtags' in progress..." + (let ((default-directory (file-name-as-directory root)) + (args (cl-remove-if + #'null + (list (and ggtags-use-idutils "--idutils") + (and ggtags-use-sqlite3 + (ggtags-process-succeed-p "gtags" "--sqlite3" "--help") + "--sqlite3") + (and conf "--gtagsconf") + (and conf (ggtags-ensure-localname conf)))))) + (condition-case err + (apply #'ggtags-process-string "gtags" args) + (error (if (and ggtags-use-idutils + (stringp (cadr err)) + (string-match-p "mkid not found" (cadr err))) + ;; Retry without mkid + (apply #'ggtags-process-string + "gtags" (cl-remove "--idutils" args)) + (signal (car err) (cdr err))))))))) + (ggtags-invalidate-buffer-project-root (file-truename root)) + (message "GTAGS generated in `%s'" root) + root)) + +(defun ggtags-explain-tags () + "Explain how each file is indexed in current project." + (interactive (ignore (ggtags-check-project) + (or (ggtags-process-succeed-p "gtags" "--explain" "--help") + (user-error "Global 6.4+ required")))) + (ggtags-check-project) + (ggtags-with-current-project + (let ((default-directory (ggtags-current-project-root))) + (compilation-start (concat (ggtags-program-path "gtags") " --explain"))))) + +(defun ggtags-update-tags (&optional force) + "Update GNU Global tag database. +Do nothing if GTAGS exceeds the oversize limit unless FORCE. + +When called interactively on large (per `ggtags-oversize-limit') +projects, the update process runs in the background without +blocking emacs." + (interactive (progn + (ggtags-check-project) + ;; Mark project info expired. + (setf (ggtags-project-timestamp (ggtags-find-project)) -1) + (list 'interactive))) + (cond ((and (eq force 'interactive) (ggtags-project-oversize-p)) + (ggtags-with-current-project + (with-display-buffer-no-window + (with-current-buffer (compilation-start "global -u") + ;; A hack to fool compilation mode to display `global + ;; -u finished' on finish. + (setq mode-name "global -u") + (add-hook 'compilation-finish-functions + #'ggtags-update-tags-finish nil t))))) + ((or force (and (ggtags-find-project) + (not (ggtags-project-oversize-p)) + (ggtags-project-dirty-p (ggtags-find-project)))) + (ggtags-with-current-project + (ggtags-with-temp-message "`global -u' in progress..." + (ggtags-process-string "global" "-u") + (ggtags-update-tags-finish)))))) + +(defun ggtags-update-tags-finish (&optional buf how) + (if (and how buf (string-prefix-p "exited abnormally" how)) + (display-buffer buf) + (setf (ggtags-project-dirty-p (ggtags-find-project)) nil) + (setf (ggtags-project-mtime (ggtags-find-project)) (float-time)))) + +(defun ggtags-update-tags-single (file &optional nowait) + ;; NOTE: NOWAIT is ignored if file is remote file; see + ;; `tramp-sh-handle-process-file'. + (cl-check-type file string) + (let ((nowait (unless (file-remote-p file) nowait))) + (ggtags-with-current-project + ;; See comment in `ggtags-project-file-p'. + (let ((default-directory (ggtags-current-project-root))) + (process-file (ggtags-program-path "global") nil (and nowait 0) nil + "--single-update" (ggtags-project-relative-file file)))))) + +(defun ggtags-delete-tags () + "Delete file GTAGS, GRTAGS, GPATH, ID etc. generated by gtags." + (interactive (ignore (ggtags-check-project))) + (when (ggtags-current-project-root) + (let* ((re (concat "\\`" (regexp-opt '("GPATH" "GRTAGS" "GTAGS" "ID")) "\\'")) + (files (cl-remove-if-not + (lambda (file) + ;; Don't trust `directory-files'. + (let ((case-fold-search nil)) + (string-match-p re (file-name-nondirectory file)))) + (directory-files (ggtags-current-project-root) t re))) + (buffer "*GTags File List*")) + (or files (user-error "No tag files found")) + (with-output-to-temp-buffer buffer + (princ (mapconcat #'identity files "\n"))) + (let ((win (get-buffer-window buffer))) + (unwind-protect + (progn + (fit-window-to-buffer win) + (when (yes-or-no-p "Remove GNU Global tag files? ") + (with-demoted-errors (mapc #'delete-file files)) + (remhash (ggtags-current-project-root) ggtags-projects) + (and (overlayp ggtags-highlight-tag-overlay) + (delete-overlay ggtags-highlight-tag-overlay)))) + (when (window-live-p win) + (quit-window t win))))))) + +(defvar-local ggtags-completion-cache nil) + +;; See global/libutil/char.c +;; (defconst ggtags-regexp-metachars "[][$()*+.?\\{}|^]") +(defvar ggtags-completion-flag "") ;internal use + +(defvar ggtags-completion-table + (completion-table-dynamic + (lambda (prefix) + (let ((cache-key (concat prefix "$" ggtags-completion-flag))) + (unless (equal cache-key (car ggtags-completion-cache)) + (setq ggtags-completion-cache + (cons cache-key + (ignore-errors-unless-debug + ;; May throw global: only name char is allowed + ;; with -c option. + (ggtags-with-current-project + (split-string + (apply #'ggtags-process-string + "global" + (append (and completion-ignore-case '("--ignore-case")) + ;; Note -c alone returns only definitions + (list (concat "-c" ggtags-completion-flag) prefix))) + "\n" t))))))) + (cdr ggtags-completion-cache)))) + +(defun ggtags-completion-at-point () + "A function for `completion-at-point-functions'." + (pcase (funcall ggtags-bounds-of-tag-function) + (`(,beg . ,end) + (and (< beg end) (list beg end ggtags-completion-table))))) + +(defun ggtags-read-tag (&optional type confirm prompt require-match default) + (ggtags-ensure-project) + (let ((default (or default (ggtags-tag-at-point))) + (prompt (or prompt (capitalize (symbol-name (or type 'tag))))) + (ggtags-completion-flag (pcase type + (`(or nil definition) "T") + (`symbol "s") + (`reference "r") + (`id "I") + (`path "P") + ((pred stringp) type) + (_ ggtags-completion-flag)))) + (setq ggtags-current-tag-name + (cond (confirm + (ggtags-update-tags) + (let ((completing-read-function + (or ggtags-completing-read-function + completing-read-function))) + (completing-read + (format (if default "%s (default %s): " "%s: ") prompt default) + ggtags-completion-table nil require-match nil nil default))) + (default (substring-no-properties default)) + (t (ggtags-read-tag type t prompt require-match default)))))) + +(defun ggtags-sort-by-nearness-p () + (and ggtags-sort-by-nearness + (ggtags-process-succeed-p "global" "--nearness" "--help"))) + +(defun ggtags-global-build-command (cmd &rest args) + ;; CMD can be definition, reference, symbol, grep, idutils + (let ((xs (append (list (shell-quote-argument (ggtags-program-path "global")) + "-v" + (format "--result=%s" ggtags-global-output-format) + (and ggtags-global-ignore-case "--ignore-case") + (and ggtags-global-use-color + (ggtags-find-project) + (ggtags-project-has-color (ggtags-find-project)) + "--color=always") + (and (ggtags-sort-by-nearness-p) "--nearness") + (and (ggtags-find-project) + (ggtags-project-has-path-style (ggtags-find-project)) + "--path-style=shorter") + (and ggtags-global-treat-text "--other") + (pcase cmd + ((pred stringp) cmd) + (`definition nil) ;-d not supported by Global 5.7.1 + (`reference "--reference") + (`symbol "--symbol") + (`path "--path") + (`grep "--grep") + (`idutils "--idutils"))) + args))) + (mapconcat #'identity (delq nil xs) " "))) + +;; Can be three values: nil, t and a marker; t means start marker has +;; been saved in the tag ring. +(defvar ggtags-global-start-marker nil) +(defvar ggtags-global-start-file nil) +(defvar ggtags-tag-ring-index nil) +(defvar ggtags-global-search-history nil) + +(defvar ggtags-auto-jump-to-match-target nil) + +(defvar-local ggtags-global-exit-info nil) ; (EXIT-STATUS COUNT DB) + +(defun ggtags-global-save-start-marker () + (when (markerp ggtags-global-start-marker) + (setq ggtags-tag-ring-index nil) + (ring-insert find-tag-marker-ring ggtags-global-start-marker) + (setq ggtags-global-start-marker t))) + +(defun ggtags-global-start (command &optional directory) + (let* ((default-directory (or directory (ggtags-current-project-root))) + (split-window-preferred-function ggtags-split-window-function) + (env ggtags-process-environment)) + (unless (and (markerp ggtags-global-start-marker) + (marker-position ggtags-global-start-marker)) + (setq ggtags-global-start-marker (point-marker))) + ;; Record the file name for `ggtags-navigation-start-file'. + (setq ggtags-global-start-file buffer-file-name) + (setq ggtags-auto-jump-to-match-target + (nth 4 (assoc (ggtags-global-search-id command default-directory) + ggtags-global-search-history))) + (ggtags-navigation-mode +1) + (ggtags-update-tags) + (ggtags-with-current-project + (with-current-buffer (with-display-buffer-no-window + (compilation-start command 'ggtags-global-mode)) + (setq-local ggtags-process-environment env) + (setq ggtags-global-last-buffer (current-buffer)))))) + +(defun ggtags-find-tag-continue () + (interactive) + (ggtags-ensure-global-buffer + (ggtags-navigation-mode +1) + (let ((split-window-preferred-function ggtags-split-window-function)) + (ignore-errors (compilation-next-error 1)) + (compile-goto-error)))) + +(defun ggtags-find-tag (cmd &rest args) + (ggtags-check-project) + (ggtags-global-start (apply #'ggtags-global-build-command cmd args) + (and (ggtags-sort-by-nearness-p) default-directory))) + +(defun ggtags-include-file () + "Calculate the include file based on `ggtags-include-pattern'." + (pcase ggtags-include-pattern + (`nil nil) + ((pred functionp) + (funcall ggtags-include-pattern)) + (`(,re . ,sub) + (save-excursion + (beginning-of-line) + (and (looking-at re) (match-string sub)))) + (_ (warn "Invalid value for `ggtags-include-pattern': %s" + ggtags-include-pattern) + nil))) + +;;;###autoload +(defun ggtags-find-tag-dwim (name &optional what) + "Find NAME by context. +If point is at a definition tag, find references, and vice versa. +If point is at a line that matches `ggtags-include-pattern', find +the include file instead. + +When called interactively with a prefix arg, always find +definition tags." + (interactive + (let ((include (and (not current-prefix-arg) (ggtags-include-file)))) + (ggtags-ensure-project) + (if include (list include 'include) + (list (ggtags-read-tag 'definition current-prefix-arg) + (and current-prefix-arg 'definition))))) + (ggtags-check-project) ; For `ggtags-current-project-root' below. + (cond + ((eq what 'include) + (ggtags-find-file name)) + ((or (eq what 'definition) + (not buffer-file-name) + (not (ggtags-project-has-refs (ggtags-find-project))) + (not (ggtags-project-file-p buffer-file-name))) + (ggtags-find-definition name)) + (t (ggtags-find-tag + (format "--from-here=%d:%s" + (line-number-at-pos) + (shell-quote-argument + ;; Note `ggtags-find-tag' may bind `default-directory' + ;; to project root. + (funcall (if (ggtags-sort-by-nearness-p) + #'file-relative-name #'ggtags-project-relative-file) + buffer-file-name))) + (shell-quote-argument name))))) + +(defun ggtags-find-tag-mouse (event) + (interactive "e") + (with-selected-window (posn-window (event-start event)) + (save-excursion + (goto-char (posn-point (event-start event))) + (call-interactively #'ggtags-find-tag-dwim)))) + +;; Another option for `M-.'. +(defun ggtags-find-definition (name) + (interactive (list (ggtags-read-tag 'definition current-prefix-arg))) + (ggtags-find-tag 'definition (shell-quote-argument name))) + +(defun ggtags-setup-libpath-search (type name) + (pcase (and ggtags-global-search-libpath-for-reference + (ggtags-get-libpath)) + ((and libs (guard libs)) + (cl-labels ((cont (buf how) + (pcase ggtags-global-exit-info + (`(0 0 ,_) + (with-temp-buffer + (setq default-directory + (file-name-as-directory (pop libs))) + (and libs (setq ggtags-global-continuation #'cont)) + (if (ggtags-find-project) + (ggtags-find-tag type (shell-quote-argument name)) + (cont buf how)))) + (_ (ggtags-global-handle-exit buf how))))) + (setq ggtags-global-continuation #'cont))))) + +(defun ggtags-find-reference (name) + (interactive (list (ggtags-read-tag 'reference current-prefix-arg))) + (ggtags-setup-libpath-search 'reference name) + (ggtags-find-tag 'reference (shell-quote-argument name))) + +(defun ggtags-find-other-symbol (name) + "Find tag NAME that is a reference without a definition." + (interactive (list (ggtags-read-tag 'symbol current-prefix-arg))) + (ggtags-setup-libpath-search 'symbol name) + (ggtags-find-tag 'symbol (shell-quote-argument name))) + +(defun ggtags-quote-pattern (pattern) + (prin1-to-string (substring-no-properties pattern))) + +(defun ggtags-idutils-query (pattern) + (interactive (list (ggtags-read-tag 'id t))) + (ggtags-find-tag 'idutils "--" (ggtags-quote-pattern pattern))) + +(defun ggtags-grep (pattern &optional invert-match) + "Grep for lines matching PATTERN. +Invert the match when called with a prefix arg \\[universal-argument]." + (interactive (list (ggtags-read-tag 'definition 'confirm + (if current-prefix-arg + "Inverted grep pattern" "Grep pattern")) + current-prefix-arg)) + (ggtags-find-tag 'grep (and invert-match "--invert-match") + "--" (ggtags-quote-pattern pattern))) + +(defun ggtags-find-file (pattern &optional invert-match) + (interactive (list (ggtags-read-tag 'path 'confirm (if current-prefix-arg + "Inverted path pattern" + "Path pattern") + nil (thing-at-point 'filename)) + current-prefix-arg)) + (let ((ggtags-global-output-format 'path)) + (ggtags-find-tag 'path (and invert-match "--invert-match") + "--" (ggtags-quote-pattern pattern)))) + +;; Note: Coloured output requested in http://goo.gl/Y9IcX and appeared +;; in global v6.2.12. +(defun ggtags-find-tag-regexp (regexp directory) + "List tags matching REGEXP in DIRECTORY (default to project root). +When called interactively with a prefix, ask for the directory." + (interactive + (progn + (ggtags-check-project) + (list (ggtags-read-tag "" t "POSIX regexp") + (if current-prefix-arg + (read-directory-name "Directory: " nil nil t) + (ggtags-current-project-root))))) + (ggtags-check-project) + (ggtags-global-start + (ggtags-global-build-command nil nil "-l" "--" (ggtags-quote-pattern regexp)) + (file-name-as-directory directory))) + +(defvar ggtags-navigation-mode) + +(defun ggtags-foreach-file (fn) + "Invoke FN with each file found. +FN is invoked while *ggtags-global* buffer is current." + (ggtags-ensure-global-buffer + (save-excursion + (goto-char (point-min)) + (while (with-demoted-errors "compilation-next-error: %S" + (compilation-next-error 1 'file) + t) + (funcall fn (caar + (compilation--loc->file-struct + (compilation--message->loc + (get-text-property (point) 'compilation-message))))))))) + +(defun ggtags-query-replace (from to &optional delimited) + "Query replace FROM with TO on files in the Global buffer. +If not in navigation mode, do a grep on FROM first. + +Note: the regular expression FROM must be supported by both +Global and Emacs." + (interactive + ;; Note: in 24.4 query-replace-read-args returns a list of 4 elements. + (let ((args (query-replace-read-args "Query replace (regexp)" t t))) + (list (nth 0 args) (nth 1 args) (nth 2 args)))) + (unless ggtags-navigation-mode + (let ((ggtags-auto-jump-to-match nil)) + (ggtags-grep from))) + (let ((file-form + '(let ((files)) + (ggtags-ensure-global-buffer + (ggtags-with-temp-message "Waiting for Grep to finish..." + (while (get-buffer-process (current-buffer)) + (sit-for 0.2))) + (ggtags-foreach-file + (lambda (file) (push (expand-file-name file) files)))) + (ggtags-navigation-mode -1) + (nreverse files)))) + (tags-query-replace from to delimited file-form))) + +(defun ggtags-global-normalise-command (cmd) + (if (string-match + (concat (regexp-quote (ggtags-global-build-command nil)) "\\s-*") + cmd) + (substring-no-properties cmd (match-end 0)) + cmd)) + +(defun ggtags-global-search-id (cmd directory) + (sha1 (concat directory (make-string 1 0) + (ggtags-global-normalise-command cmd)))) + +(defun ggtags-global-current-search () + ;; CMD DIR ENV LINE TEXT + (ggtags-ensure-global-buffer + (list (ggtags-global-normalise-command (car compilation-arguments)) + default-directory + ggtags-process-environment + (line-number-at-pos) + (buffer-substring-no-properties + (line-beginning-position) (line-end-position))))) + +(defun ggtags-global-rerun-search (data) + (pcase data + (`(,cmd ,dir ,env ,line ,_text) + (with-current-buffer (let ((ggtags-auto-jump-to-match nil) + ;; Switch current project to DIR. + (default-directory dir) + (ggtags-project-root dir) + (ggtags-process-environment env)) + (ggtags-global-start + (ggtags-global-build-command cmd) dir)) + (add-hook 'compilation-finish-functions + (lambda (buf _msg) + (with-current-buffer buf + (ggtags-forward-to-line line) + (compile-goto-error))) + nil t))))) + +(defvar-local ggtags-global-search-ewoc nil) +(defvar ggtags-view-search-history-last nil) + +(defvar ggtags-view-search-history-mode-map + (let ((m (make-sparse-keymap))) + (define-key m "p" 'ggtags-view-search-history-prev) + (define-key m "\M-p" 'ggtags-view-search-history-prev) + (define-key m "n" 'ggtags-view-search-history-next) + (define-key m "\M-n" 'ggtags-view-search-history-next) + (define-key m "\C-k" 'ggtags-view-search-history-kill) + (define-key m [remap yank] (lambda (&optional arg) (interactive "P") (yank arg))) + (define-key m "\C-c\C-c" 'ggtags-view-search-history-update) + (define-key m "r" 'ggtags-save-to-register) + (define-key m "\r" 'ggtags-view-search-history-action) + (define-key m "q" 'ggtags-kill-window) + m)) + +(defun ggtags-view-search-history-remember () + (setq ggtags-view-search-history-last + (pcase (ewoc-locate ggtags-global-search-ewoc) + (`nil nil) + (node (ewoc-data node))))) + +(defun ggtags-view-search-history-next (&optional arg) + (interactive "p") + (let ((arg (or arg 1))) + (prog1 (funcall (if (cl-minusp arg) #'ewoc-goto-prev #'ewoc-goto-next) + ggtags-global-search-ewoc (abs arg)) + (ggtags-view-search-history-remember)))) + +(defun ggtags-view-search-history-prev (&optional arg) + (interactive "p") + (ggtags-view-search-history-next (- (or arg 1)))) + +(defun ggtags-view-search-history-kill (&optional append) + (interactive "P") + (let* ((node (or (ewoc-locate ggtags-global-search-ewoc) + (user-error "No node at point"))) + (next (ewoc-next ggtags-global-search-ewoc node)) + (text (filter-buffer-substring (ewoc-location node) + (if next (ewoc-location next) + (point-max))))) + (put-text-property + 0 (length text) 'yank-handler + (list (lambda (arg) + (if (not ggtags-global-search-ewoc) + (insert (car arg)) + (let* ((inhibit-read-only t) + (node (unless (looking-at-p "[ \t\n]*\\'") + (ewoc-locate ggtags-global-search-ewoc)))) + (if node + (ewoc-enter-before ggtags-global-search-ewoc + node (cadr arg)) + (ewoc-enter-last ggtags-global-search-ewoc (cadr arg))) + (setq ggtags-view-search-history-last (cadr arg))))) + (list text (ewoc-data node))) + text) + (if append (kill-append text nil) + (kill-new text)) + (let ((inhibit-read-only t)) + (ewoc-delete ggtags-global-search-ewoc node)))) + +(defun ggtags-view-search-history-update (&optional noconfirm) + "Update `ggtags-global-search-history' to current buffer." + (interactive "P") + (when (and (buffer-modified-p) + (or noconfirm + (yes-or-no-p "Modify `ggtags-global-search-history'?"))) + (setq ggtags-global-search-history + (ewoc-collect ggtags-global-search-ewoc #'identity)) + (set-buffer-modified-p nil))) + +(defun ggtags-view-search-history-action () + (interactive) + (let ((data (ewoc-data (or (ewoc-locate ggtags-global-search-ewoc) + (user-error "No search at point"))))) + (ggtags-view-search-history-remember) + (quit-window t) + (ggtags-global-rerun-search (cdr data)))) + +(defvar bookmark-make-record-function) + +(define-derived-mode ggtags-view-search-history-mode special-mode "SearchHist" + "Major mode for viewing search history." + :group 'ggtags + (setq-local ggtags-enable-navigation-keys nil) + (setq-local bookmark-make-record-function #'ggtags-make-bookmark-record) + (setq truncate-lines t) + (add-hook 'kill-buffer-hook #'ggtags-view-search-history-update nil t)) + +(defun ggtags-view-search-history-restore-last () + (when ggtags-view-search-history-last + (cl-loop for n = (ewoc-nth ggtags-global-search-ewoc 0) + then (ewoc-next ggtags-global-search-ewoc n) + while n when (eq (ewoc-data n) + ggtags-view-search-history-last) + do (progn (goto-char (ewoc-location n)) (cl-return t))))) + +(defun ggtags-view-search-history () + "Pop to a buffer to view or re-run past searches. + +\\{ggtags-view-search-history-mode-map}" + (interactive) + (or ggtags-global-search-history (user-error "No search history")) + (let ((split-window-preferred-function ggtags-split-window-function) + (inhibit-read-only t)) + (pop-to-buffer "*Ggtags Search History*") + (erase-buffer) + (ggtags-view-search-history-mode) + (cl-labels ((prop (s) + (propertize s 'face 'minibuffer-prompt)) + (prop-tag (cmd) + (with-temp-buffer + (insert cmd) + (forward-sexp -1) + (if (eobp) + cmd + (put-text-property (point) (point-max) + 'face font-lock-constant-face) + (buffer-string)))) + (pp (data) + (pcase data + (`(,_id ,cmd ,dir ,_env ,line ,text) + (insert (prop " cmd: ") (prop-tag cmd) "\n" + (prop " dir: ") dir "\n" + (prop "line: ") (number-to-string line) "\n" + (prop "text: ") text "\n" + (propertize (make-string 32 ?-) 'face 'shadow)))))) + (setq ggtags-global-search-ewoc + (ewoc-create #'pp "Global search history keys: n:next p:prev r:register RET:choose\n"))) + (dolist (data ggtags-global-search-history) + (ewoc-enter-last ggtags-global-search-ewoc data)) + (ggtags-view-search-history-restore-last) + (set-buffer-modified-p nil) + (fit-window-to-buffer nil (floor (frame-height) 2)))) + +(defun ggtags-save-to-register (r) + "Save current search session to register R. +Use \\[jump-to-register] to restore the search session." + (interactive (list (register-read-with-preview "Save search to register: "))) + (cl-labels ((prn (data) + (pcase data + (`(,command ,root ,_env ,line ,_) + (princ (format "a ggtags search session `%s' in directory `%s' at line %d." + command root line)))))) + (set-register r (registerv-make + (if ggtags-global-search-ewoc + (cdr (ewoc-data (ewoc-locate ggtags-global-search-ewoc))) + (ggtags-global-current-search)) + :jump-func #'ggtags-global-rerun-search + :print-func #'prn)))) + +(defun ggtags-make-bookmark-record () + `(,(and ggtags-current-tag-name (format "*ggtags %s*" ggtags-current-tag-name)) + (ggtags-search . ,(if ggtags-global-search-ewoc + (cdr (ewoc-data (ewoc-locate ggtags-global-search-ewoc))) + (ggtags-global-current-search))) + (handler . ggtags-bookmark-jump))) + +(declare-function bookmark-prop-get "bookmark") + +(defun ggtags-bookmark-jump (bmk) + (ggtags-global-rerun-search (bookmark-prop-get bmk 'ggtags-search))) + +(defun ggtags-browse-file-as-hypertext (file line) + "Browse FILE in hypertext (HTML) form." + (interactive (if (or current-prefix-arg (not buffer-file-name)) + (list (read-file-name "Browse file: " nil nil t) + (read-number "Line: " 1)) + (list buffer-file-name (line-number-at-pos)))) + (cl-check-type line (integer 1)) + (or (and file (file-exists-p file)) (error "File `%s' doesn't exist" file)) + (ggtags-check-project) + (or (file-exists-p (expand-file-name "HTML" (ggtags-current-project-root))) + (if (yes-or-no-p "No hypertext form exists; run htags? ") + (let ((default-directory (ggtags-current-project-root))) + (ggtags-with-current-project (ggtags-process-string "htags"))) + (user-error "Aborted"))) + (let ((url (ggtags-process-string "gozilla" "-p" (format "+%d" line) + (file-relative-name file)))) + (or (equal (file-name-extension + (url-filename (url-generic-parse-url url))) "html") + (user-error "No hypertext form for `%s'" file)) + (when (called-interactively-p 'interactive) + (message "Browsing %s" url)) + (browse-url url))) + +(defun ggtags-next-mark (&optional arg) + "Move to the next (newer) mark in the tag marker ring." + (interactive) + (and (ring-empty-p find-tag-marker-ring) (user-error "Tag ring empty")) + (setq ggtags-tag-ring-index + ;; Note `ring-minus1' gets newer item. + (funcall (if arg #'ring-plus1 #'ring-minus1) + (or ggtags-tag-ring-index + (progn + (ring-insert find-tag-marker-ring (point-marker)) + 0)) + (ring-length find-tag-marker-ring))) + (let ((m (ring-ref find-tag-marker-ring ggtags-tag-ring-index)) + (i (- (ring-length find-tag-marker-ring) ggtags-tag-ring-index))) + (ggtags-echo "%d%s marker%s" i (pcase (mod i 10) + ;; ` required for 24.1 and 24.2 + (`1 "st") + (`2 "nd") + (`3 "rd") + (_ "th")) + (if (marker-buffer m) "" " (dead)")) + (if (not (marker-buffer m)) + (ding) + (switch-to-buffer (marker-buffer m)) + (goto-char m)))) + +(defun ggtags-prev-mark () + "Move to the previous (older) mark in the tag marker ring." + (interactive) + (ggtags-next-mark 'previous)) + +(defvar ggtags-view-tag-history-mode-map + (let ((m (make-sparse-keymap))) + (define-key m "\M-n" 'next-error-no-select) + (define-key m "\M-p" 'previous-error-no-select) + (define-key m "q" 'ggtags-kill-window) + m)) + +(define-derived-mode ggtags-view-tag-history-mode tabulated-list-mode "TagHist" + :abbrev-table nil :group 'ggtags) + +(defun ggtags-view-tag-history () + "Pop to a buffer listing visited locations from newest to oldest. +The buffer is a next error buffer and works with standard +commands `next-error' and `previous-error'. + +\\{ggtags-view-tag-history-mode-map}" + (interactive) + (and (ring-empty-p find-tag-marker-ring) + (user-error "Tag ring empty")) + (let ((split-window-preferred-function ggtags-split-window-function) + (inhibit-read-only t)) + (pop-to-buffer "*Tag Ring*") + (erase-buffer) + (ggtags-view-tag-history-mode) + (setq next-error-function #'ggtags-view-tag-history-next-error + next-error-last-buffer (current-buffer)) + (setq tabulated-list-entries + ;; Use a function so that revert can work properly. + (lambda () + (let ((counter (ring-length find-tag-marker-ring)) + (elements (or (ring-elements find-tag-marker-ring) + (user-error "Tag ring empty"))) + (action (lambda (_button) (next-error 0))) + (get-line (lambda (m) + (with-current-buffer (marker-buffer m) + (save-excursion + (goto-char m) + (buffer-substring (line-beginning-position) + (line-end-position))))))) + (setq tabulated-list-format + `[("ID" ,(max (1+ (floor (log counter 10))) 2) + car-less-than-car) + ("Buffer" ,(max (cl-loop for m in elements + for b = (marker-buffer m) + maximize + (length (and b (buffer-name b)))) + 6) + t :right-align t) + ("Position" ,(max (cl-loop for m in elements + for p = (or (marker-position m) 1) + maximize (1+ (floor (log p 10)))) + 8) + (lambda (x y) + (< (string-to-number (aref (cadr x) 2)) + (string-to-number (aref (cadr y) 2)))) + :right-align t) + ("Contents" 100 t)]) + (tabulated-list-init-header) + (mapcar (lambda (x) + (prog1 + (list counter + (if (marker-buffer x) + (vector (number-to-string counter) + `(,(buffer-name (marker-buffer x)) + face link + follow-link t + marker ,x + action ,action) + (number-to-string (marker-position x)) + (funcall get-line x)) + (vector (number-to-string counter) + "(dead)" "?" "?"))) + (cl-decf counter))) + elements)))) + (setq tabulated-list-sort-key '("ID" . t)) + (tabulated-list-print) + (fit-window-to-buffer nil (floor (frame-height) 2)))) + +(defun ggtags-view-tag-history-next-error (&optional arg reset) + (if (not reset) + (forward-button arg) + (goto-char (point-min)) + (forward-button (if (button-at (point)) 0 1))) + (when (get-buffer-window) + (set-window-point (get-buffer-window) (point))) + (pcase (button-get (button-at (point)) 'marker) + ((and (pred markerp) m) + (if (eq (get-buffer-window) (selected-window)) + (pop-to-buffer (marker-buffer m)) + (switch-to-buffer (marker-buffer m))) + (goto-char (marker-position m))) + (_ (error "Dead marker")))) + +(defun ggtags-global-exit-message-1 () + "Get the total of matches and db file used." + (save-excursion + (goto-char (point-max)) + (if (re-search-backward + "^\\w+ \\(not found\\)\\|^\\([0-9]+\\) \\w+ located" nil t) + (cons (or (and (match-string 1) 0) + (string-to-number (match-string 2))) + (when (re-search-forward + "using \\(?:\\(idutils\\)\\|'[^']*/\\(\\w+\\)'\\)" + (line-end-position) + t) + (or (and (match-string 1) "ID") + (match-string 2)))) + (cons 0 nil)))) + +(defun ggtags-global-exit-message-function (_process-status exit-status msg) + "A function for `compilation-exit-message-function'." + (pcase (ggtags-global-exit-message-1) + (`(,count . ,db) + (setq ggtags-global-exit-info (list exit-status count db)) + ;; Clear the start marker in case of zero matches. + (and (zerop count) + (markerp ggtags-global-start-marker) + (not ggtags-global-continuation) + (setq ggtags-global-start-marker nil)) + (cons (if (> exit-status 0) + msg + (format "found %d %s" count + (funcall (if (= count 1) #'car #'cadr) + (pcase db + ;; ` required for 24.1 and 24.2 + (`"GTAGS" '("definition" "definitions")) + (`"GSYMS" '("symbol" "symbols")) + (`"GRTAGS" '("reference" "references")) + (`"GPATH" '("file" "files")) + (`"ID" '("identifier" "identifiers")) + (_ '("match" "matches")))))) + exit-status)))) + +(defun ggtags-global-column (start) + ;; START is the beginning position of source text. + (let ((mbeg (text-property-any start (line-end-position) 'global-color t))) + (and mbeg (- mbeg start)))) + +;;; NOTE: Must not match the 'Global started at Mon Jun 3 10:24:13' +;;; line or `compilation-auto-jump' will jump there and fail. See +;;; comments before the 'gnu' entry in +;;; `compilation-error-regexp-alist-alist'. +(defvar ggtags-global-error-regexp-alist-alist + (append + `((path "^\\(?:[^\"'\n]*/\\)?[^ )\t\n]+$" 0) + ;; ACTIVE_ESCAPE src/dialog.cc 172 + (ctags "^\\([^ \t\n]+\\)[ \t]+\\(.*?\\)[ \t]+\\([0-9]+\\)$" + 2 3 nil nil 2 (1 font-lock-function-name-face)) + ;; ACTIVE_ESCAPE 172 src/dialog.cc #undef ACTIVE_ESCAPE + (ctags-x "^\\([^ \t\n]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\(\\(?:[^/\n]*/\\)?[^ \t\n]+\\)" + 3 2 (,(lambda () (ggtags-global-column (1+ (match-end 0))))) + nil 3 (1 font-lock-function-name-face)) + ;; src/dialog.cc:172:#undef ACTIVE_ESCAPE + (grep "^\\(.+?\\):\\([0-9]+\\):\\(?:$\\|[^0-9\n]\\|[0-9][^0-9\n]\\|[0-9][0-9].\\)" + 1 2 (,(lambda () (ggtags-global-column (1+ (match-end 2))))) nil 1) + ;; src/dialog.cc ACTIVE_ESCAPE 172 #undef ACTIVE_ESCAPE + (cscope "^\\(.+?\\)[ \t]+\\([^ \t\n]+\\)[ \t]+\\([0-9]+\\).*\\(?:[^0-9\n]\\|[^0-9\n][0-9]\\|[^:\n][0-9][0-9]\\)$" + 1 3 nil nil 1 (2 font-lock-function-name-face))) + compilation-error-regexp-alist-alist)) + +(defun ggtags-abbreviate-file (start end) + (let ((inhibit-read-only t) + (amount (if (numberp ggtags-global-abbreviate-filename) + (- (- end start) ggtags-global-abbreviate-filename) + 999)) + (advance-word (lambda () + "Return the length of the text made invisible." + (let ((wend (min end (progn (forward-word 1) (point)))) + (wbeg (max start (progn (backward-word 1) (point))))) + (goto-char wend) + (if (<= (- wend wbeg) 1) + 0 + (put-text-property (1+ wbeg) wend 'invisible t) + (1- (- wend wbeg))))))) + (goto-char start) + (while (and (> amount 0) (> end (point))) + (cl-decf amount (funcall advance-word))))) + +(defun ggtags-abbreviate-files (start end) + (goto-char start) + (let* ((error-re (cdr (assq (car compilation-error-regexp-alist) + ggtags-global-error-regexp-alist-alist))) + (sub (cadr error-re))) + (when (and ggtags-global-abbreviate-filename error-re) + (while (re-search-forward (car error-re) end t) + (when (and (or (not (numberp ggtags-global-abbreviate-filename)) + (> (length (match-string sub)) + ggtags-global-abbreviate-filename)) + ;; Ignore bogus file lines such as: + ;; Global found 2 matches at Thu Jan 31 13:45:19 + (get-text-property (match-beginning sub) 'compilation-message)) + (ggtags-abbreviate-file (match-beginning sub) (match-end sub))))))) + +(defvar-local ggtags-global-output-lines 0) + +(defun ggtags-global--display-buffer (&optional buffer desired-point) + (pcase (let ((buffer (or buffer (current-buffer))) + (split-window-preferred-function ggtags-split-window-function)) + (and (not (get-buffer-window buffer)) + (display-buffer buffer '(nil (allow-no-window . t))))) + ((and (pred windowp) w) + (with-selected-window w + (compilation-set-window-height w) + (and desired-point (goto-char desired-point)))))) + +(defun ggtags-global-filter () + "Called from `compilation-filter-hook' (which see)." + (let ((ansi-color-apply-face-function + (lambda (beg end face) + (when face + (ansi-color-apply-overlay-face beg end face) + (put-text-property beg end 'global-color t))))) + (ansi-color-apply-on-region compilation-filter-start (point))) + ;; Get rid of line "Using config file '/PATH/TO/.globalrc'." or + ;; "Using default configuration." + (when (re-search-backward + "^ *Using \\(?:config file '.*\\|default configuration.\\)\n" + compilation-filter-start t) + (replace-match "")) + (cl-incf ggtags-global-output-lines + (count-lines compilation-filter-start (point))) + ;; If the number of output lines is small + ;; `ggtags-global-handle-exit' takes care of displaying the buffer. + (when (and (> ggtags-global-output-lines 30) ggtags-navigation-mode) + (ggtags-global--display-buffer nil (or compilation-current-error (point-min)))) + (when (and (eq ggtags-auto-jump-to-match 'history) + (numberp ggtags-auto-jump-to-match-target) + (not compilation-current-error) + ;; `ggtags-global-output-lines' is imprecise but use it + ;; as first approximation. + (> (+ 10 ggtags-global-output-lines) ggtags-auto-jump-to-match-target) + (> (line-number-at-pos (point-max)) + ggtags-auto-jump-to-match-target)) + (ggtags-forward-to-line ggtags-auto-jump-to-match-target) + (setq-local ggtags-auto-jump-to-match-target nil) + (ggtags-delay-finish-functions + (with-display-buffer-no-window + (condition-case nil + (let ((compilation-auto-jump-to-first-error t)) + (compilation-auto-jump (current-buffer) (point))) + (error (message "\ +ggtags: history match invalid, jump to first match instead") + (first-error))))) + ;; `compilation-filter' restores point and as a result commands + ;; dependent on point such as `ggtags-navigation-next-file' and + ;; `ggtags-navigation-previous-file' fail to work. + (run-with-idle-timer + 0 nil + (lambda (buf pt) + (and (buffer-live-p buf) + (with-current-buffer buf (goto-char pt)))) + (current-buffer) (point))) + (make-local-variable 'ggtags-global-large-output) + (when (> ggtags-global-output-lines ggtags-global-large-output) + (cl-incf ggtags-global-large-output 500) + (ggtags-echo "Output %d lines (Type `C-c C-k' to cancel)" + ggtags-global-output-lines))) + +(defun ggtags-global-handle-exit (buf how) + "A function for `compilation-finish-functions' (which see)." + (cond + (ggtags-global-continuation + (let ((cont (prog1 ggtags-global-continuation + (setq ggtags-global-continuation nil)))) + (funcall cont buf how))) + ((string-prefix-p "exited abnormally" how) + ;; If exit abnormally display the buffer for inspection. + (ggtags-global--display-buffer) + (when (save-excursion + (goto-char (point-max)) + (re-search-backward + (eval-when-compile + (format "^global: %s not found.$" + (regexp-opt '("GTAGS" "GRTAGS" "GSYMS" "GPATH")))) + nil t)) + (ggtags-echo "WARNING: Global tag files missing in `%s'" + ggtags-project-root) + (remhash ggtags-project-root ggtags-projects))) + (ggtags-auto-jump-to-match + (if (pcase (compilation-next-single-property-change + (point-min) 'compilation-message) + ((and pt (guard pt)) + (compilation-next-single-property-change + (save-excursion (goto-char pt) (end-of-line) (point)) + 'compilation-message))) + ;; There are multiple matches so pop up the buffer. + (and ggtags-navigation-mode (ggtags-global--display-buffer)) + ;; For the `compilation-auto-jump' in idle timer to run. + ;; See also: http://debbugs.gnu.org/13829 + (sit-for 0) + (ggtags-navigation-mode -1) + (ggtags-navigation-mode-cleanup buf 0))))) + +(defvar ggtags-global-mode-font-lock-keywords + '(("^Global \\(exited abnormally\\|interrupt\\|killed\\|terminated\\)\\(?:.*with code \\([0-9]+\\)\\)?.*" + (1 'compilation-error) + (2 'compilation-error nil t)) + ("^Global found \\([0-9]+\\)" (1 compilation-info-face)))) + +(defvar compilation-always-kill) ;new in 24.3 + +(define-compilation-mode ggtags-global-mode "Global" + "A mode for showing outputs from gnu global." + ;; Note: Place `ggtags-global-output-format' as first element for + ;; `ggtags-abbreviate-files'. + (setq-local compilation-error-regexp-alist (list ggtags-global-output-format)) + (when (markerp ggtags-global-start-marker) + (setq ggtags-project-root + (buffer-local-value 'ggtags-project-root + (marker-buffer ggtags-global-start-marker)))) + (pcase ggtags-auto-jump-to-match + (`history (make-local-variable 'ggtags-auto-jump-to-match-target) + (setq-local compilation-auto-jump-to-first-error + (not ggtags-auto-jump-to-match-target))) + (`nil (setq-local compilation-auto-jump-to-first-error nil)) + (_ (setq-local compilation-auto-jump-to-first-error t))) + (setq-local compilation-scroll-output nil) + ;; See `compilation-move-to-column' for details. + (setq-local compilation-first-column 0) + (setq-local compilation-error-screen-columns nil) + (setq-local compilation-disable-input t) + (setq-local compilation-always-kill t) + (setq-local compilation-error-face 'compilation-info) + (setq-local compilation-exit-message-function + 'ggtags-global-exit-message-function) + ;; See: https://github.com/leoliu/ggtags/issues/26 + (setq-local find-file-suppress-same-file-warnings t) + (setq-local truncate-lines t) + (jit-lock-register #'ggtags-abbreviate-files) + (add-hook 'compilation-filter-hook 'ggtags-global-filter nil 'local) + (add-hook 'compilation-finish-functions 'ggtags-global-handle-exit nil t) + (setq-local bookmark-make-record-function #'ggtags-make-bookmark-record) + (setq-local ggtags-enable-navigation-keys nil) + (add-hook 'kill-buffer-hook (lambda () (ggtags-navigation-mode -1)) nil t)) + +;; NOTE: Need this to avoid putting menu items in +;; `emulation-mode-map-alists', which creates double entries. See +;; http://i.imgur.com/VJJTzVc.png +(defvar ggtags-navigation-map + (let ((map (make-sparse-keymap))) + (define-key map "\M-n" 'next-error) + (define-key map "\M-p" 'previous-error) + (define-key map "\M-}" 'ggtags-navigation-next-file) + (define-key map "\M-{" 'ggtags-navigation-previous-file) + (define-key map "\M-=" 'ggtags-navigation-start-file) + (define-key map "\M->" 'ggtags-navigation-last-error) + (define-key map "\M-<" 'first-error) + ;; Note: shadows `isearch-forward-regexp' but it can still be + ;; invoked with `C-u C-s'. + (define-key map "\C-\M-s" 'ggtags-navigation-isearch-forward) + ;; Add an alternative binding because C-M-s is reported not + ;; working on some systems. + (define-key map "\M-ss" 'ggtags-navigation-isearch-forward) + (define-key map "\C-c\C-k" + (lambda () (interactive) + (ggtags-ensure-global-buffer (kill-compilation)))) + (define-key map "\M-o" 'ggtags-navigation-visible-mode) + (define-key map [return] 'ggtags-navigation-mode-done) + (define-key map "\r" 'ggtags-navigation-mode-done) + (define-key map [remap pop-tag-mark] 'ggtags-navigation-mode-abort) + map)) + +(defvar ggtags-mode-map-alist + `((ggtags-enable-navigation-keys . ,ggtags-navigation-map))) + +(defvar ggtags-navigation-mode-map + (let ((map (make-sparse-keymap)) + (menu (make-sparse-keymap "GG-Navigation"))) + ;; Menu items: (info "(elisp)Extended Menu Items") + (define-key map [menu-bar ggtags-navigation] (cons "GG-Navigation" menu)) + ;; Ordered backwards + (define-key menu [visible-mode] + '(menu-item "Visible mode" ggtags-navigation-visible-mode + :button (:toggle . (ignore-errors + (ggtags-ensure-global-buffer + visible-mode))))) + (define-key menu [done] + '(menu-item "Finish navigation" ggtags-navigation-mode-done)) + (define-key menu [abort] + '(menu-item "Abort" ggtags-navigation-mode-abort)) + (define-key menu [last-match] + '(menu-item "Last match" ggtags-navigation-last-error)) + (define-key menu [first-match] '(menu-item "First match" first-error)) + (define-key menu [previous-file] + '(menu-item "Previous file" ggtags-navigation-previous-file)) + (define-key menu [next-file] + '(menu-item "Next file" ggtags-navigation-next-file)) + (define-key menu [isearch-forward] + '(menu-item "Find match with isearch" ggtags-navigation-isearch-forward)) + (define-key menu [previous] + '(menu-item "Previous match" previous-error)) + (define-key menu [next] + '(menu-item "Next match" next-error)) + map)) + +(defun ggtags-move-to-tag (&optional name) + "Move to NAME tag in current line." + (let ((tag (or name ggtags-current-tag-name))) + ;; Do nothing if on the tag already i.e. by `ggtags-global-column'. + (unless (or (not tag) (looking-at (concat (regexp-quote tag) "\\_>"))) + (let ((orig (point)) + (regexps (mapcar (lambda (fmtstr) + (format fmtstr (regexp-quote tag))) + '("\\_<%s\\_>" "%s\\_>" "%s")))) + (beginning-of-line) + (if (cl-loop for re in regexps + ;; Note: tag might not agree with current + ;; major-mode's symbol, so try harder. For + ;; example, in `php-mode' $cacheBackend is a + ;; symbol, but cacheBackend is a tag. + thereis (re-search-forward re (line-end-position) t)) + (goto-char (match-beginning 0)) + (goto-char orig)))))) + +(defun ggtags-navigation-mode-cleanup (&optional buf time) + (let ((buf (or buf ggtags-global-last-buffer))) + (and (buffer-live-p buf) + (with-current-buffer buf + (when (get-buffer-process (current-buffer)) + (kill-compilation)) + (when (and (derived-mode-p 'ggtags-global-mode) + (get-buffer-window)) + (quit-windows-on (current-buffer))) + (and time (run-with-idle-timer time nil #'kill-buffer buf)))))) + +(defun ggtags-navigation-mode-done () + (interactive) + (ggtags-navigation-mode -1) + (setq tags-loop-scan t + tags-loop-operate '(ggtags-find-tag-continue)) + (ggtags-navigation-mode-cleanup)) + +(defun ggtags-navigation-mode-abort () + "Abort navigation and return to where the search was started." + (interactive) + (ggtags-navigation-mode -1) + (ggtags-navigation-mode-cleanup nil 0) + ;; Run after (ggtags-navigation-mode -1) or + ;; ggtags-global-start-marker might not have been saved. + (when (and ggtags-global-start-marker + (not (markerp ggtags-global-start-marker))) + (setq ggtags-global-start-marker nil) + (pop-tag-mark))) + +(defun ggtags-navigation-next-file (n) + (interactive "p") + (ggtags-ensure-global-buffer + (compilation-next-file n) + (compile-goto-error))) + +(defun ggtags-navigation-previous-file (n) + (interactive "p") + (ggtags-navigation-next-file (- n))) + +(defun ggtags-navigation-start-file () + "Move to the file where navigation session starts." + (interactive) + (let ((start-file (or ggtags-global-start-file + (user-error "Cannot decide start file")))) + (ggtags-ensure-global-buffer + (pcase (cl-block nil + (ggtags-foreach-file + (lambda (file) + (when (file-equal-p file start-file) + (cl-return (point)))))) + (`nil (user-error "No matches for `%s'" start-file)) + (n (goto-char n) (compile-goto-error)))))) + +(defun ggtags-navigation-last-error () + (interactive) + (ggtags-ensure-global-buffer + (goto-char (point-max)) + (compilation-previous-error 1) + (compile-goto-error))) + +(defun ggtags-navigation-isearch-forward (&optional regexp-p) + (interactive "P") + (ggtags-ensure-global-buffer + (let ((saved (if visible-mode 1 -1))) + (visible-mode 1) + (with-selected-window (get-buffer-window (current-buffer)) + (isearch-forward regexp-p) + (beginning-of-line) + (visible-mode saved) + (compile-goto-error))))) + +(defun ggtags-navigation-visible-mode (&optional arg) + (interactive (list (or current-prefix-arg 'toggle))) + (ggtags-ensure-global-buffer + (visible-mode arg))) + +(defvar ggtags-global-line-overlay nil) + +(defun ggtags-global-next-error-function () + (when (eq next-error-last-buffer ggtags-global-last-buffer) + (ggtags-move-to-tag) + (ggtags-global-save-start-marker) + (and (ggtags-project-update-mtime-maybe) + (message "File `%s' is newer than GTAGS" + (file-name-nondirectory buffer-file-name))) + (and ggtags-mode-sticky (ggtags-mode 1)) + (ignore-errors + (ggtags-ensure-global-buffer + (unless (overlayp ggtags-global-line-overlay) + (setq ggtags-global-line-overlay (make-overlay (point) (point))) + (overlay-put ggtags-global-line-overlay 'face 'ggtags-global-line)) + (move-overlay ggtags-global-line-overlay + (line-beginning-position) (line-end-position) + (current-buffer)) + ;; Update search history + (let ((id (ggtags-global-search-id (car compilation-arguments) + default-directory))) + (setq ggtags-global-search-history + (cl-remove id ggtags-global-search-history :test #'equal :key #'car)) + (add-to-history 'ggtags-global-search-history + (cons id (ggtags-global-current-search)) + ggtags-global-history-length)))) + (run-hooks 'ggtags-find-tag-hook))) + +(put 'ggtags-navigation-mode-lighter 'risky-local-variable t) + +(defvar ggtags-navigation-mode-lighter + '(" GG[" + (:eval + (if (not (buffer-live-p ggtags-global-last-buffer)) + '(:propertize "??" face error help-echo "No Global buffer") + (with-current-buffer ggtags-global-last-buffer + (pcase (or ggtags-global-exit-info '(0 0 "")) + (`(,exit ,count ,db) + `((:propertize ,(pcase db + (`"GTAGS" "D") + (`"GRTAGS" "R") + (`"GSYMS" "S") + (`"GPATH" "F") + (`"ID" "I")) + face success) + (:propertize + ,(pcase (get-text-property (line-beginning-position) + 'compilation-message) + (`nil "?") + ;; Assume the first match appears at line 5 + (_ (number-to-string (- (line-number-at-pos) 4)))) + face success) + "/" + (:propertize ,(number-to-string count) face success) + ,(unless (zerop exit) + `(":" (:propertize ,(number-to-string exit) face error))))))))) + "]") + "Ligher for `ggtags-navigation-mode'; set to nil to disable it.") + +(define-minor-mode ggtags-navigation-mode nil + :lighter ggtags-navigation-mode-lighter + :global t + (if ggtags-navigation-mode + (progn + ;; Higher priority for `ggtags-navigation-mode' to avoid being + ;; hijacked by modes such as `view-mode'. + (add-to-list 'emulation-mode-map-alists 'ggtags-mode-map-alist) + (add-hook 'next-error-hook 'ggtags-global-next-error-function) + (add-hook 'minibuffer-setup-hook 'ggtags-minibuffer-setup-function)) + (setq emulation-mode-map-alists + (delq 'ggtags-mode-map-alist emulation-mode-map-alists)) + (remove-hook 'next-error-hook 'ggtags-global-next-error-function) + (remove-hook 'minibuffer-setup-hook 'ggtags-minibuffer-setup-function))) + +(defun ggtags-minibuffer-setup-function () + ;; Disable ggtags-navigation-mode in minibuffer. + (setq-local ggtags-enable-navigation-keys nil)) + +(defun ggtags-kill-file-buffers (&optional interactive) + "Kill all buffers visiting files in current project." + (interactive "p") + (ggtags-check-project) + (let ((directories (cons (ggtags-current-project-root) (ggtags-get-libpath))) + (count 0)) + (dolist (buf (buffer-list)) + (let ((file (and (buffer-live-p buf) + (not (eq buf (current-buffer))) + (buffer-file-name buf)))) + (when (and file (cl-some (lambda (dir) + ;; Don't use `file-in-directory-p' + ;; to allow symbolic links. + (string-prefix-p dir file)) + directories)) + (and (kill-buffer buf) (cl-incf count))))) + (and interactive + (message "%d %s killed" count (if (= count 1) "buffer" "buffers"))))) + +(defun ggtags-after-save-function () + (when (ggtags-find-project) + (ggtags-project-update-mtime-maybe) + (and buffer-file-name ggtags-update-on-save + (ggtags-update-tags-single buffer-file-name 'nowait)))) + +(defun ggtags-global-output (buffer cmds callback &optional cutoff) + "Asynchronously pipe the output of running CMDS to BUFFER. +When finished invoke CALLBACK in BUFFER with process exit status." + (or buffer (error "Output buffer required")) + (when (get-buffer-process (get-buffer buffer)) + ;; Notice running multiple processes in the same buffer so that we + ;; can fix the caller. See for example `ggtags-eldoc-function'. + (message "Warning: detected %S already running in %S; interrupting..." + (get-buffer-process buffer) buffer) + (interrupt-process (get-buffer-process buffer))) + (let* ((program (car cmds)) + (args (cdr cmds)) + (cutoff (and cutoff (+ cutoff (if (get-buffer buffer) + (with-current-buffer buffer + (line-number-at-pos (point-max))) + 0)))) + (proc (apply #'start-file-process program buffer program args)) + (filter (lambda (proc string) + (and (buffer-live-p (process-buffer proc)) + (with-current-buffer (process-buffer proc) + (goto-char (process-mark proc)) + (insert string) + (when (and (> (line-number-at-pos (point-max)) cutoff) + (process-live-p proc)) + (interrupt-process (current-buffer))))))) + (sentinel (lambda (proc _msg) + (when (memq (process-status proc) '(exit signal)) + (with-current-buffer (process-buffer proc) + (set-process-buffer proc nil) + (funcall callback (process-exit-status proc))))))) + (set-process-query-on-exit-flag proc nil) + (and cutoff (set-process-filter proc filter)) + (set-process-sentinel proc sentinel) + proc)) + +(cl-defun ggtags-fontify-code (code &optional (mode major-mode)) + (cl-check-type mode function) + (cl-typecase code + ((not string) code) + (string (cl-labels ((prepare-buffer () + (with-current-buffer + (get-buffer-create " *Code-Fontify*") + (delay-mode-hooks (funcall mode)) + (setq font-lock-mode t) + (funcall font-lock-function font-lock-mode) + (setq jit-lock-mode nil) + (current-buffer)))) + (with-current-buffer (prepare-buffer) + (let ((inhibit-read-only t)) + (erase-buffer) + (insert code) + (font-lock-default-fontify-region + (point-min) (point-max) nil)) + (buffer-string)))))) + +(defun ggtags-get-definition-default (defs) + (and (caar defs) + (concat (ggtags-fontify-code (caar defs)) + (and (cdr defs) " [guess]")))) + +(defun ggtags-show-definition (name) + (interactive (list (ggtags-read-tag 'definition current-prefix-arg))) + (ggtags-check-project) + (let* ((re (cadr (assq 'grep ggtags-global-error-regexp-alist-alist))) + (current (current-buffer)) + (buffer (get-buffer-create " *ggtags-definition*")) + ;; Need these bindings so that let-binding + ;; `ggtags-print-definition-function' can work see + ;; `ggtags-eldoc-function'. + (get-fn ggtags-get-definition-function) + (print-fn ggtags-print-definition-function) + (show (lambda (_status) + (goto-char (point-min)) + (let ((defs (cl-loop while (re-search-forward re nil t) + collect (list (buffer-substring (1+ (match-end 2)) + (line-end-position)) + name + (match-string 1) + (string-to-number (match-string 2)))))) + (kill-buffer buffer) + (with-current-buffer current + (funcall print-fn (funcall get-fn defs))))))) + (ggtags-with-current-project + (ggtags-global-output + buffer + (list (ggtags-program-path "global") + "--result=grep" "--path-style=absolute" name) + show 100)))) + +(defvar ggtags-mode-prefix-map + (let ((m (make-sparse-keymap))) + ;; Globally bound to `M-g p'. + ;; (define-key m "\M-'" 'previous-error) + (define-key m (kbd "M-DEL") 'ggtags-delete-tags) + (define-key m "\M-p" 'ggtags-prev-mark) + (define-key m "\M-n" 'ggtags-next-mark) + (define-key m "\M-f" 'ggtags-find-file) + (define-key m "\M-o" 'ggtags-find-other-symbol) + (define-key m "\M-g" 'ggtags-grep) + (define-key m "\M-i" 'ggtags-idutils-query) + (define-key m "\M-b" 'ggtags-browse-file-as-hypertext) + (define-key m "\M-k" 'ggtags-kill-file-buffers) + (define-key m "\M-h" 'ggtags-view-tag-history) + (define-key m "\M-j" 'ggtags-visit-project-root) + (define-key m "\M-/" 'ggtags-view-search-history) + (define-key m (kbd "M-SPC") 'ggtags-save-to-register) + (define-key m (kbd "M-%") 'ggtags-query-replace) + (define-key m "\M-?" 'ggtags-show-definition) + m)) + +(defvar ggtags-mode-map + (let ((map (make-sparse-keymap)) + (menu (make-sparse-keymap "Ggtags"))) + (define-key map "\M-." 'ggtags-find-tag-dwim) + (define-key map (kbd "M-]") 'ggtags-find-reference) + (define-key map (kbd "C-M-.") 'ggtags-find-tag-regexp) + (define-key map ggtags-mode-prefix-key ggtags-mode-prefix-map) + ;; Menu items + (define-key map [menu-bar ggtags] (cons "Ggtags" menu)) + ;; Ordered backwards + (define-key menu [report-bugs] + `(menu-item "Report bugs" + (lambda () (interactive) + (browse-url ggtags-bug-url) + (message "Please visit %s" ggtags-bug-url)) + :help ,(format "Visit %s" ggtags-bug-url))) + (define-key menu [custom-ggtags] + '(menu-item "Customize Ggtags" + (lambda () (interactive) (customize-group 'ggtags)))) + (define-key menu [eldoc-mode] + '(menu-item "Toggle eldoc mode" eldoc-mode :button (:toggle . eldoc-mode))) + (define-key menu [save-project] + '(menu-item "Save project settings" ggtags-save-project-settings)) + (define-key menu [toggle-read-only] + '(menu-item "Toggle project read-only" ggtags-toggle-project-read-only + :button (:toggle . buffer-read-only))) + (define-key menu [visit-project-root] + '(menu-item "Visit project root" ggtags-visit-project-root)) + (define-key menu [sep2] menu-bar-separator) + (define-key menu [browse-hypertext] + '(menu-item "Browse as hypertext" ggtags-browse-file-as-hypertext + :enable (ggtags-find-project))) + (define-key menu [delete-tags] + '(menu-item "Delete tags" ggtags-delete-tags + :enable (ggtags-find-project) + :help "Delete file GTAGS, GRTAGS, GPATH, ID etc.")) + (define-key menu [kill-buffers] + '(menu-item "Kill project file buffers" ggtags-kill-file-buffers + :enable (ggtags-find-project))) + (define-key menu [view-tag] + '(menu-item "View tag history" ggtags-view-tag-history)) + (define-key menu [pop-mark] + '(menu-item "Pop mark" pop-tag-mark + :help "Pop to previous mark and destroy it")) + (define-key menu [next-mark] + '(menu-item "Next mark" ggtags-next-mark)) + (define-key menu [prev-mark] + '(menu-item "Previous mark" ggtags-prev-mark)) + (define-key menu [sep1] menu-bar-separator) + (define-key menu [previous-error] + '(menu-item "Previous match" previous-error)) + (define-key menu [next-error] + '(menu-item "Next match" next-error)) + (define-key menu [rerun-search] + '(menu-item "View past searches" ggtags-view-search-history)) + (define-key menu [save-to-register] + '(menu-item "Save search to register" ggtags-save-to-register)) + (define-key menu [find-file] + '(menu-item "Find files" ggtags-find-file)) + (define-key menu [query-replace] + '(menu-item "Query replace" ggtags-query-replace)) + (define-key menu [idutils] + '(menu-item "Query idutils DB" ggtags-idutils-query)) + (define-key menu [grep] + '(menu-item "Grep" ggtags-grep)) + (define-key menu [find-symbol] + '(menu-item "Find other symbol" ggtags-find-other-symbol + :help "Find references without definition")) + (define-key menu [find-tag-regexp] + '(menu-item "Find tag matching regexp" ggtags-find-tag-regexp)) + (define-key menu [show-definition] + '(menu-item "Show definition" ggtags-show-definition)) + (define-key menu [find-reference] + '(menu-item "Find reference" ggtags-find-reference)) + (define-key menu [find-tag-continue] + '(menu-item "Continue find tag" tags-loop-continue)) + (define-key menu [find-tag] + '(menu-item "Find tag" ggtags-find-tag-dwim)) + (define-key menu [update-tags] + '(menu-item "Update tag files" ggtags-update-tags + :visible (ggtags-find-project))) + (define-key menu [run-gtags] + '(menu-item "Run gtags" ggtags-create-tags + :visible (not (ggtags-find-project)))) + map)) + +(defvar ggtags-mode-line-project-keymap + (let ((map (make-sparse-keymap))) + (define-key map [mode-line mouse-1] 'ggtags-visit-project-root) + map)) + +(put 'ggtags-mode-line-project-name 'risky-local-variable t) +(defvar ggtags-mode-line-project-name + '("[" (:eval (let ((name (if (stringp ggtags-project-root) + (file-name-nondirectory + (directory-file-name ggtags-project-root)) + "?"))) + (propertize + name 'face compilation-info-face + 'help-echo (if (stringp ggtags-project-root) + (concat "mouse-1 to visit " ggtags-project-root) + "mouse-1 to set project") + 'mouse-face 'mode-line-highlight + 'keymap ggtags-mode-line-project-keymap))) + "]") + "Mode line construct for displaying current project name. +The value is the name of the project root directory. Setting it +to nil disables displaying this information.") + +;;;###autoload +(define-minor-mode ggtags-mode nil + :lighter (:eval (if ggtags-navigation-mode "" " GG")) + (ggtags-setup-highlight-tag-at-point ggtags-highlight-tag) + (if ggtags-mode + (progn + (add-hook 'after-save-hook 'ggtags-after-save-function nil t) + ;; Append to serve as a fallback method. + (add-hook 'completion-at-point-functions + #'ggtags-completion-at-point t t) + ;; Work around http://debbugs.gnu.org/19324 + (or eldoc-documentation-function + (setq-local eldoc-documentation-function #'ignore)) + (add-function :after-until (local 'eldoc-documentation-function) + #'ggtags-eldoc-function '((name . ggtags-eldoc-function) + (depth . -100))) + (unless (memq 'ggtags-mode-line-project-name + mode-line-buffer-identification) + (setq mode-line-buffer-identification + (append mode-line-buffer-identification + '(ggtags-mode-line-project-name))))) + (remove-hook 'after-save-hook 'ggtags-after-save-function t) + (remove-hook 'completion-at-point-functions #'ggtags-completion-at-point t) + (remove-function (local 'eldoc-documentation-function) 'ggtags-eldoc-function) + (setq mode-line-buffer-identification + (delq 'ggtags-mode-line-project-name mode-line-buffer-identification)) + (ggtags-cancel-highlight-tag-at-point 'keep-timer))) + +(defvar ggtags-highlight-tag-map + (let ((map (make-sparse-keymap))) + ;; Bind down- events so that the global keymap won't ``shine + ;; through''. See `mode-line-buffer-identification-keymap' for + ;; similar workaround. + (define-key map [S-mouse-1] 'ggtags-find-tag-dwim) + (define-key map [S-down-mouse-1] 'ignore) + (define-key map [S-mouse-3] 'ggtags-find-reference) + (define-key map [S-down-mouse-3] 'ignore) + map) + "Keymap used for valid tag at point.") + +(put 'ggtags-active-tag 'face 'ggtags-highlight) +(put 'ggtags-active-tag 'keymap ggtags-highlight-tag-map) +;; (put 'ggtags-active-tag 'mouse-face 'match) +(put 'ggtags-active-tag 'help-echo + "S-mouse-1 for definitions\nS-mouse-3 for references") + +(defun ggtags-setup-highlight-tag-at-point (flag) + (cond ((null flag) (ggtags-cancel-highlight-tag-at-point)) + ((not (timerp ggtags-highlight-tag-timer)) + (setq ggtags-highlight-tag-timer + (run-with-idle-timer flag t #'ggtags-highlight-tag-at-point))) + (t (timer-set-idle-time ggtags-highlight-tag-timer flag t)))) + +(defun ggtags-cancel-highlight-tag-at-point (&optional keep-timer) + (when (and (not keep-timer) + (timerp ggtags-highlight-tag-timer)) + (cancel-timer ggtags-highlight-tag-timer) + (setq ggtags-highlight-tag-timer nil)) + (when ggtags-highlight-tag-overlay + (delete-overlay ggtags-highlight-tag-overlay) + (setq ggtags-highlight-tag-overlay nil))) + +(defun ggtags-highlight-tag-at-point () + (when (and ggtags-mode ggtags-project-root (ggtags-find-project)) + (unless (overlayp ggtags-highlight-tag-overlay) + (setq ggtags-highlight-tag-overlay (make-overlay (point) (point) nil t)) + (overlay-put ggtags-highlight-tag-overlay 'modification-hooks + (list (lambda (o after &rest _args) + (and (not after) (delete-overlay o)))))) + (let ((bounds (funcall ggtags-bounds-of-tag-function)) + (o ggtags-highlight-tag-overlay)) + (cond + ((and bounds + (eq (overlay-buffer o) (current-buffer)) + (= (overlay-start o) (car bounds)) + (= (overlay-end o) (cdr bounds))) + ;; Overlay matches current tag so do nothing. + nil) + ((and bounds (let ((completion-ignore-case nil)) + (test-completion + (buffer-substring (car bounds) (cdr bounds)) + ggtags-completion-table))) + (move-overlay o (car bounds) (cdr bounds) (current-buffer)) + (overlay-put o 'category 'ggtags-active-tag)) + (t (move-overlay o + (or (car bounds) (point)) + (or (cdr bounds) (point)) + (current-buffer)) + (overlay-put o 'category nil)))))) + +;;; eldoc + +(defvar-local ggtags-eldoc-cache nil) + +(declare-function eldoc-message "eldoc") +(defun ggtags-eldoc-function () + "A function suitable for `eldoc-documentation-function' (which see)." + (pcase (ggtags-tag-at-point) + (`nil nil) + (tag (if (equal tag (car ggtags-eldoc-cache)) + (cadr ggtags-eldoc-cache) + (and ggtags-project-root (ggtags-find-project) + (let* ((ggtags-print-definition-function + (lambda (s) + (setq ggtags-eldoc-cache (list tag s)) + (eldoc-message s)))) + ;; Prevent multiple runs of ggtags-show-definition + ;; for the same tag. + (setq ggtags-eldoc-cache (list tag)) + (condition-case err + (ggtags-show-definition tag) + (file-error + (remove-function (local 'eldoc-documentation-function) + 'ggtags-eldoc-function) + (message "\ +Function `ggtags-eldoc-function' disabled for eldoc in current buffer: %S" err))) + nil)))))) + +;;; imenu + +(defun ggtags-goto-imenu-index (name line &rest _args) + (ggtags-forward-to-line line) + (ggtags-move-to-tag name)) + +;;;###autoload +(defun ggtags-build-imenu-index () + "A function suitable for `imenu-create-index-function'." + (let ((file (and buffer-file-name (file-relative-name buffer-file-name)))) + (and file (with-temp-buffer + (when (with-demoted-errors "ggtags-build-imenu-index: %S" + (zerop (ggtags-with-current-project + (process-file (ggtags-program-path "global") + nil t nil "-x" "-f" file)))) + (goto-char (point-min)) + (cl-loop while (re-search-forward + "^\\([^ \t]+\\)[ \t]+\\([0-9]+\\)" nil t) + collect (list (match-string 1) + (string-to-number (match-string 2)) + 'ggtags-goto-imenu-index))))))) + +;;; hippie-expand + +;;;###autoload +(defun ggtags-try-complete-tag (old) + "A function suitable for `hippie-expand-try-functions-list'." + (eval-and-compile (require 'hippie-exp)) + (unless old + (he-init-string (or (car (funcall ggtags-bounds-of-tag-function)) (point)) + (point)) + (setq he-expand-list + (and (not (equal he-search-string "")) + (ggtags-find-project) + (sort (all-completions he-search-string + ggtags-completion-table) + #'string-lessp)))) + (if (null he-expand-list) + (progn + (if old (he-reset-string)) + nil) + (he-substitute-string (car he-expand-list)) + (setq he-expand-list (cdr he-expand-list)) + t)) + +(defun ggtags-reload (&optional force) + (interactive "P") + (unload-feature 'ggtags force) + (require 'ggtags)) + +(provide 'ggtags) +;;; ggtags.el ends here diff --git a/elpa/git-commit-20160130.649/git-commit-pkg.el b/elpa/git-commit-20160130.649/git-commit-pkg.el deleted file mode 100644 index 448d55f..0000000 --- a/elpa/git-commit-20160130.649/git-commit-pkg.el +++ /dev/null @@ -1 +0,0 @@ -(define-package "git-commit" "20160130.649" "Edit Git commit messages" '((emacs "24.4") (dash "20151021.113") (with-editor "20160128.1201")) :url "https://github.com/magit/magit" :keywords '("git" "tools" "vc")) diff --git a/elpa/git-commit-20160130.649/git-commit-autoloads.el b/elpa/git-commit-20160414.251/git-commit-autoloads.el similarity index 85% rename from elpa/git-commit-20160130.649/git-commit-autoloads.el rename to elpa/git-commit-20160414.251/git-commit-autoloads.el index 02b0b8d..6c60c32 100644 --- a/elpa/git-commit-20160130.649/git-commit-autoloads.el +++ b/elpa/git-commit-20160414.251/git-commit-autoloads.el @@ -3,8 +3,8 @@ ;;; Code: (add-to-list 'load-path (or (file-name-directory #$) (car load-path))) -;;;### (autoloads nil "git-commit" "git-commit.el" (22221 60698 575000 -;;;;;; 0)) +;;;### (autoloads nil "git-commit" "git-commit.el" (22297 19830 709841 +;;;;;; 48000)) ;;; Generated autoloads from git-commit.el (defvar global-git-commit-mode t "\ @@ -25,6 +25,11 @@ provide such a commit message. \(fn &optional ARG)" t nil) +;;;*** + +;;;### (autoloads nil nil ("git-commit-pkg.el") (22297 19831 32984 +;;;;;; 389000)) + ;;;*** ;; Local Variables: diff --git a/elpa/git-commit-20160414.251/git-commit-pkg.el b/elpa/git-commit-20160414.251/git-commit-pkg.el new file mode 100644 index 0000000..74f722d --- /dev/null +++ b/elpa/git-commit-20160414.251/git-commit-pkg.el @@ -0,0 +1 @@ +(define-package "git-commit" "20160414.251" "Edit Git commit messages" '((emacs "24.4") (dash "20151021.113") (with-editor "20160408.201")) :url "https://github.com/magit/magit" :keywords '("git" "tools" "vc")) diff --git a/elpa/git-commit-20160130.649/git-commit.el b/elpa/git-commit-20160414.251/git-commit.el similarity index 97% rename from elpa/git-commit-20160130.649/git-commit.el rename to elpa/git-commit-20160414.251/git-commit.el index 4a61575..c5785bd 100644 --- a/elpa/git-commit-20160130.649/git-commit.el +++ b/elpa/git-commit-20160414.251/git-commit.el @@ -11,9 +11,9 @@ ;; Marius Vollmer ;; Maintainer: Jonas Bernoulli -;; Package-Requires: ((emacs "24.4") (dash "20151021.113") (with-editor "20160128.1201")) +;; Package-Requires: ((emacs "24.4") (dash "20151021.113") (with-editor "20160408.201")) ;; Keywords: git tools vc -;; Package-Version: 20160130.649 +;; Package-Version: 20160414.251 ;; Homepage: https://github.com/magit/magit ;; This file is not part of GNU Emacs. @@ -466,7 +466,7 @@ second line is empty." t ; Just try; we don't know whether --allow-empty-message was used. (and (or (equal (match-string 2) "") (y-or-n-p "Summary line is too long. Commit anyway? ")) - (or (equal (match-string 3) "") + (or (not (match-string 3)) (y-or-n-p "Second line is not empty. Commit anyway? "))))))) (defun git-commit-cancel-message () @@ -512,6 +512,9 @@ With a numeric prefix ARG, go forward ARG comments." (with-temp-buffer (insert str) (goto-char (point-min)) + (when (re-search-forward (concat flush " -+ >8 -+$") nil t) + (delete-region (point-at-bol) (point-max))) + (goto-char (point-min)) (flush-lines flush) (goto-char (point-max)) (unless (eq (char-before) ?\n) @@ -610,7 +613,7 @@ With a numeric prefix ARG, go forward ARG comments." ;; Summary line (format "\\(.\\{0,%d\\}\\)\\(.*\\)" git-commit-summary-max-length) ;; Non-empty non-comment second line - (format "\\(?:\n%s\\|\n\\(.*\\)\\)?" comment-start))) + (format "\\(?:\n%s\\|\n\\(.+\\)\\)?" comment-start))) (defun git-commit-mode-font-lock-keywords () `(;; Comments @@ -648,6 +651,7 @@ With a numeric prefix ARG, go forward ARG comments." (save-excursion (goto-char (point-min)) (when (re-search-forward "^diff --git" nil t) + (beginning-of-line) (let ((buffer (current-buffer))) (insert (with-temp-buffer @@ -657,15 +661,17 @@ With a numeric prefix ARG, go forward ARG comments." (delete-region (point) (point-max))))) (diff-mode) (let (font-lock-verbose font-lock-support-mode) - (if (fboundp 'font-lock-flush) - (font-lock-flush) + (if (fboundp 'font-lock-ensure) + (font-lock-ensure) (with-no-warnings (font-lock-fontify-buffer)))) (let (next (pos (point-min))) (while (setq next (next-single-property-change pos 'face)) (put-text-property pos next 'font-lock-face (get-text-property pos 'face)) - (setq pos next))) + (setq pos next)) + (put-text-property pos (point-max) 'font-lock-face + (get-text-property pos 'face))) (buffer-string))))))) ;;; git-commit.el ends soon diff --git a/elpa/git-gutter-0.78/git-gutter-pkg.el b/elpa/git-gutter-0.78/git-gutter-pkg.el deleted file mode 100644 index 94fb1ed..0000000 --- a/elpa/git-gutter-0.78/git-gutter-pkg.el +++ /dev/null @@ -1 +0,0 @@ -(define-package "git-gutter" "0.78" "Port of Sublime Text plugin GitGutter" '((cl-lib "0.5") (emacs "24"))) diff --git a/elpa/git-gutter-0.78/git-gutter-autoloads.el b/elpa/git-gutter-20160409.713/git-gutter-autoloads.el similarity index 61% rename from elpa/git-gutter-0.78/git-gutter-autoloads.el rename to elpa/git-gutter-20160409.713/git-gutter-autoloads.el index 9c4dcd0..ee9f745 100644 --- a/elpa/git-gutter-0.78/git-gutter-autoloads.el +++ b/elpa/git-gutter-20160409.713/git-gutter-autoloads.el @@ -3,8 +3,8 @@ ;;; Code: (add-to-list 'load-path (or (file-name-directory #$) (car load-path))) -;;;### (autoloads nil "git-gutter" "git-gutter.el" (21633 45696 229043 -;;;;;; 874000)) +;;;### (autoloads nil "git-gutter" "git-gutter.el" (22297 19829 459863 +;;;;;; 402000)) ;;; Generated autoloads from git-gutter.el (autoload 'git-gutter:linum-setup "git-gutter" "\ @@ -38,57 +38,16 @@ See `git-gutter-mode' for more information on Git-Gutter mode. \(fn &optional ARG)" t nil) -(autoload 'git-gutter:revert-hunk "git-gutter" "\ -Revert current hunk. - -\(fn)" t nil) - -(autoload 'git-gutter:stage-hunk "git-gutter" "\ -Stage this hunk like 'git add -p'. - -\(fn)" t nil) - -(autoload 'git-gutter:popup-hunk "git-gutter" "\ -Popup current diff hunk. - -\(fn &optional DIFFINFO)" t nil) - -(autoload 'git-gutter:next-hunk "git-gutter" "\ -Move to next diff hunk - -\(fn ARG)" t nil) - -(autoload 'git-gutter:previous-hunk "git-gutter" "\ -Move to previous diff hunk - -\(fn ARG)" t nil) - (autoload 'git-gutter "git-gutter" "\ Show diff information in gutter \(fn)" t nil) -(autoload 'git-gutter:clear "git-gutter" "\ -Clear diff information in gutter. - -\(fn)" t nil) - (autoload 'git-gutter:toggle "git-gutter" "\ Toggle to show diff information. \(fn)" t nil) -(autoload 'git-gutter:set-start-revision "git-gutter" "\ -Set start revision. If `start-rev' is nil or empty string then reset -start revision. - -\(fn START-REV)" t nil) - -(autoload 'git-gutter:update-all-windows "git-gutter" "\ -Update git-gutter informations for all visible buffers. - -\(fn)" t nil) - ;;;*** ;; Local Variables: diff --git a/elpa/git-gutter-20160409.713/git-gutter-pkg.el b/elpa/git-gutter-20160409.713/git-gutter-pkg.el new file mode 100644 index 0000000..ff865bb --- /dev/null +++ b/elpa/git-gutter-20160409.713/git-gutter-pkg.el @@ -0,0 +1 @@ +(define-package "git-gutter" "20160409.713" "Port of Sublime Text plugin GitGutter" '((cl-lib "0.5") (emacs "24")) :url "https://github.com/syohex/emacs-git-gutter") diff --git a/elpa/git-gutter-0.78/git-gutter.el b/elpa/git-gutter-20160409.713/git-gutter.el similarity index 64% rename from elpa/git-gutter-0.78/git-gutter.el rename to elpa/git-gutter-20160409.713/git-gutter.el index 5eb003c..99e877e 100644 --- a/elpa/git-gutter-0.78/git-gutter.el +++ b/elpa/git-gutter-20160409.713/git-gutter.el @@ -1,10 +1,11 @@ ;;; git-gutter.el --- Port of Sublime Text plugin GitGutter -*- lexical-binding: t; -*- -;; Copyright (C) 2014 by Syohei YOSHIDA +;; Copyright (C) 2016 by Syohei YOSHIDA ;; Author: Syohei YOSHIDA ;; URL: https://github.com/syohex/emacs-git-gutter -;; Version: 0.78 +;; Package-Version: 20160409.713 +;; Version: 0.87 ;; Package-Requires: ((cl-lib "0.5") (emacs "24")) ;; This program is free software; you can redistribute it and/or modify @@ -37,127 +38,117 @@ "Character width of gutter window. Emacs mistakes width of some characters. It is better to explicitly assign width to this variable, if you use full-width character for signs of changes" - :type 'integer - :group 'git-gutter) + :type 'integer) (defcustom git-gutter:diff-option "" "Option of 'git diff'" - :type 'string - :group 'git-gutter) + :type 'string) + +(defcustom git-gutter:subversion-diff-option "" + "Option of 'svn diff'" + :type 'string) (defcustom git-gutter:mercurial-diff-option "" "Option of 'hg diff'" - :type 'string - :group 'git-gutter) + :type 'string) (defcustom git-gutter:bazaar-diff-option "" "Option of 'bzr diff'" - :type 'string - :group 'git-gutter) + :type 'string) (defcustom git-gutter:update-commands '(ido-switch-buffer helm-buffers-list) "Each command of this list is executed, gutter information is updated." :type '(list (function :tag "Update command") - (repeat :inline t (function :tag "Update command"))) - :group 'git-gutter) + (repeat :inline t (function :tag "Update command")))) (defcustom git-gutter:update-windows-commands '(kill-buffer ido-kill-buffer) "Each command of this list is executed, gutter information is updated and gutter information of other windows." :type '(list (function :tag "Update command") - (repeat :inline t (function :tag "Update command"))) - :group 'git-gutter) + (repeat :inline t (function :tag "Update command")))) (defcustom git-gutter:update-hooks '(after-save-hook after-revert-hook find-file-hook after-change-major-mode-hook - text-scale-mode-hook magit-revert-buffer-hook) + text-scale-mode-hook) "hook points of updating gutter" :type '(list (hook :tag "HookPoint") - (repeat :inline t (hook :tag "HookPoint"))) - :group 'git-gutter) + (repeat :inline t (hook :tag "HookPoint")))) + +(defcustom git-gutter:always-show-separator nil + "Show separator even if there are no changes." + :type 'boolean) (defcustom git-gutter:separator-sign nil "Separator sign" - :type 'string - :group 'git-gutter) + :type 'string) (defcustom git-gutter:modified-sign "=" "Modified sign" - :type 'string - :group 'git-gutter) + :type 'string) (defcustom git-gutter:added-sign "+" "Added sign" - :type 'string - :group 'git-gutter) + :type 'string) (defcustom git-gutter:deleted-sign "-" "Deleted sign" - :type 'string - :group 'git-gutter) + :type 'string) (defcustom git-gutter:unchanged-sign nil "Unchanged sign" - :type 'string - :group 'git-gutter) + :type 'string) (defcustom git-gutter:hide-gutter nil "Hide gutter if there are no changes" - :type 'boolean - :group 'git-gutter) + :type 'boolean) (defcustom git-gutter:lighter " GitGutter" "Minor mode lighter in mode-line" - :type 'string - :group 'git-gutter) + :type 'string) (defcustom git-gutter:verbosity 0 "Log/message level. 4 means all, 0 nothing." - :type 'integer - :group 'git-gutter) + :type 'integer) + +(defcustom git-gutter:visual-line nil + "Show sign at gutter by visual line." + :type 'boolean) (defface git-gutter:separator - '((t (:foreground "cyan" :weight bold))) - "Face of separator" - :group 'git-gutter) + '((t (:foreground "cyan" :weight bold :inherit default))) + "Face of separator") (defface git-gutter:modified - '((t (:foreground "magenta" :weight bold))) - "Face of modified" - :group 'git-gutter) + '((t (:foreground "magenta" :weight bold :inherit default))) + "Face of modified") (defface git-gutter:added - '((t (:foreground "green" :weight bold))) - "Face of added" - :group 'git-gutter) + '((t (:foreground "green" :weight bold :inherit default))) + "Face of added") (defface git-gutter:deleted '((t (:foreground "red" :weight bold))) - "Face of deleted" - :group 'git-gutter) + "Face of deleted") (defface git-gutter:unchanged '((t (:background "yellow"))) - "Face of unchanged" - :group 'git-gutter) + "Face of unchanged") (defcustom git-gutter:disabled-modes nil "A list of modes which `global-git-gutter-mode' should be disabled." - :type '(repeat symbol) - :group 'git-gutter) + :type '(repeat symbol)) -(defcustom git-gutter:handled-backends '(git hg) +(defcustom git-gutter:handled-backends '(git) "List of version control backends for which `git-gutter.el` will be used. -`git', `hg', and `bzr' are supported." - :type '(repeat symbol) - :group 'git-gutter) +`git', `svn', `hg', and `bzr' are supported." + :type '(repeat symbol)) -(defvar git-gutter:view-diff-function 'git-gutter:view-diff-infos +(defvar git-gutter:view-diff-function #'git-gutter:view-diff-infos "Function of viewing changes") -(defvar git-gutter:clear-function 'git-gutter:clear-diff-infos +(defvar git-gutter:clear-function #'git-gutter:clear-diff-infos "Function of clear changes") (defvar git-gutter:init-function 'nil @@ -165,17 +156,21 @@ gutter information of other windows." (defcustom git-gutter-mode-on-hook nil "Hook run when git-gutter mode enable" - :type 'hook - :group 'git-gutter) + :type 'hook) (defcustom git-gutter-mode-off-hook nil "Hook run when git-gutter mode disable" - :type 'hook - :group 'git-gutter) + :type 'hook) + +(defcustom git-gutter:update-interval 0 + "Time interval in seconds for updating diff information." + :type 'integer) + +(defcustom git-gutter:ask-p t + "Ask whether commit/revert or not" + :type 'boolean) (defvar git-gutter:enabled nil) -(defvar git-gutter:toggle-flag t) -(defvar git-gutter:force nil) (defvar git-gutter:diffinfos nil) (defvar git-gutter:has-indirect-buffers nil) (defvar git-gutter:real-this-command nil) @@ -184,6 +179,8 @@ gutter information of other windows." (defvar git-gutter:vcs-type nil) (defvar git-gutter:start-revision nil) (defvar git-gutter:revision-history nil) +(defvar git-gutter:update-timer nil) +(defvar git-gutter:last-sha1 nil) (defvar git-gutter:popup-buffer "*git-gutter:diff*") (defvar git-gutter:ignore-commands @@ -200,7 +197,7 @@ gutter information of other windows." (when it ,@body))) (defsubst git-gutter:execute-command (cmd output &rest args) - (apply 'process-file cmd nil output nil args)) + (apply #'process-file cmd nil output nil args)) (defun git-gutter:in-git-repository-p () (when (executable-find "git") @@ -210,28 +207,22 @@ gutter information of other windows." (string= "true" (buffer-substring-no-properties (point) (line-end-position))))))) -(defun git-gutter:in-hg-repository-p () - (and (executable-find "hg") - (locate-dominating-file default-directory ".hg") - (zerop (git-gutter:execute-command "hg" nil "root")) - (not (string-match-p "/\.hg/" default-directory)))) - -(defun git-gutter:in-bzr-repository-p () - (and (executable-find "bzr") - (locate-dominating-file default-directory ".bzr") - (zerop (git-gutter:execute-command "bzr" nil "root")) - (not (string-match-p "/\.bzr/" default-directory)))) +(defun git-gutter:in-repository-common-p (cmd check-subcmd repodir) + (and (executable-find cmd) + (locate-dominating-file default-directory repodir) + (zerop (apply #'git-gutter:execute-command cmd nil check-subcmd)) + (not (string-match-p (regexp-quote (concat "/" repodir "/")) default-directory)))) (defsubst git-gutter:vcs-check-function (vcs) (cl-case vcs - (git 'git-gutter:in-git-repository-p) - (hg 'git-gutter:in-hg-repository-p) - (bzr 'git-gutter:in-bzr-repository-p))) + (git (git-gutter:in-git-repository-p)) + (svn (git-gutter:in-repository-common-p "svn" '("info") ".svn")) + (hg (git-gutter:in-repository-common-p "hg" '("root") ".hg")) + (bzr (git-gutter:in-repository-common-p "bzr" '("root") ".bzr")))) (defsubst git-gutter:in-repository-p () (cl-loop for vcs in git-gutter:handled-backends - for check-func = (git-gutter:vcs-check-function vcs) - when (funcall check-func) + when (git-gutter:vcs-check-function vcs) return (set (make-local-variable 'git-gutter:vcs-type) vcs))) (defsubst git-gutter:changes-to-number (str) @@ -255,26 +246,26 @@ gutter information of other windows." (goto-char (point-max))) (buffer-substring curpoint (point))))) -(defun git-gutter:process-diff-output (proc) - (when (buffer-live-p (process-buffer proc)) - (let ((regexp "^@@ -\\(?:[0-9]+\\),?\\([0-9]*\\) \\+\\([0-9]+\\),?\\([0-9]*\\) @@")) - (with-current-buffer (process-buffer proc) - (goto-char (point-min)) - (cl-loop while (re-search-forward regexp nil t) - for new-line = (string-to-number (match-string 2)) - for orig-changes = (git-gutter:changes-to-number (match-string 1)) - for new-changes = (git-gutter:changes-to-number (match-string 3)) - for type = (cond ((zerop orig-changes) 'added) - ((zerop new-changes) 'deleted) - (t 'modified)) - for end-line = (if (eq type 'deleted) - new-line - (1- (+ new-line new-changes))) - for content = (git-gutter:diff-content) - collect - (let ((start (if (zerop new-line) 1 new-line)) - (end (if (zerop end-line) 1 end-line))) - (git-gutter:make-diffinfo type content start end))))))) +(defun git-gutter:process-diff-output (buf) + (when (buffer-live-p buf) + (with-current-buffer buf + (goto-char (point-min)) + (cl-loop with regexp = "^@@ -\\(?:[0-9]+\\),?\\([0-9]*\\) \\+\\([0-9]+\\),?\\([0-9]*\\) @@" + while (re-search-forward regexp nil t) + for new-line = (string-to-number (match-string 2)) + for orig-changes = (git-gutter:changes-to-number (match-string 1)) + for new-changes = (git-gutter:changes-to-number (match-string 3)) + for type = (cond ((zerop orig-changes) 'added) + ((zerop new-changes) 'deleted) + (t 'modified)) + for end-line = (if (eq type 'deleted) + new-line + (1- (+ new-line new-changes))) + for content = (git-gutter:diff-content) + collect + (let ((start (if (zerop new-line) 1 new-line)) + (end (if (zerop end-line) 1 end-line))) + (git-gutter:make-diffinfo type content start end)))))) (defsubst git-gutter:window-margin () (or git-gutter:window-width (git-gutter:longest-sign-width))) @@ -297,10 +288,25 @@ gutter information of other windows." (defun git-gutter:start-git-diff-process (file proc-buf) (let ((arg (git-gutter:git-diff-arguments file))) - (apply 'start-file-process "git-gutter" proc-buf - "git" "--no-pager" "diff" "--no-color" "--no-ext-diff" "--relative" "-U0" + (apply #'start-file-process "git-gutter" proc-buf + "git" "--no-pager" "-c" "diff.autorefreshindex=0" + "diff" "--no-color" "--no-ext-diff" "--relative" "-U0" arg))) +(defun git-gutter:svn-diff-arguments (file) + (let (args) + (unless (string= git-gutter:subversion-diff-option "") + (setq args (nreverse (split-string git-gutter:subversion-diff-option)))) + (when (git-gutter:revision-set-p) + (push "-r" args) + (push git-gutter:start-revision args)) + (nreverse (cons file args)))) + +(defsubst git-gutter:start-svn-diff-process (file proc-buf) + (let ((args (git-gutter:svn-diff-arguments file))) + (apply #'start-file-process "git-gutter" proc-buf "svn" "diff" "--diff-cmd" + "diff" "-x" "-U0" args))) + (defun git-gutter:hg-diff-arguments (file) (let (args) (unless (string= git-gutter:mercurial-diff-option "") @@ -312,7 +318,7 @@ gutter information of other windows." (defsubst git-gutter:start-hg-diff-process (file proc-buf) (let ((args (git-gutter:hg-diff-arguments file))) - (apply 'start-file-process "git-gutter" proc-buf "hg" "diff" "-U0" args))) + (apply #'start-file-process "git-gutter" proc-buf "hg" "diff" "-U0" args))) (defun git-gutter:bzr-diff-arguments (file) (let (args) @@ -325,12 +331,13 @@ gutter information of other windows." (defsubst git-gutter:start-bzr-diff-process (file proc-buf) (let ((args (git-gutter:bzr-diff-arguments file))) - (apply 'start-file-process "git-gutter" proc-buf + (apply #'start-file-process "git-gutter" proc-buf "bzr" "diff" "--context=0" args))) (defun git-gutter:start-diff-process1 (file proc-buf) (cl-case git-gutter:vcs-type (git (git-gutter:start-git-diff-process file proc-buf)) + (svn (git-gutter:start-svn-diff-process file proc-buf)) (hg (git-gutter:start-hg-diff-process file proc-buf)) (bzr (git-gutter:start-bzr-diff-process file proc-buf)))) @@ -345,7 +352,7 @@ gutter information of other windows." (lambda (proc _event) (when (eq (process-status proc) 'exit) (setq git-gutter:enabled nil) - (let ((diffinfos (git-gutter:process-diff-output proc))) + (let ((diffinfos (git-gutter:process-diff-output (process-buffer proc)))) (when (buffer-live-p curbuf) (with-current-buffer curbuf (git-gutter:update-diffinfo diffinfos) @@ -384,20 +391,23 @@ gutter information of other windows." when (overlay-get ov 'linum-str) return ov)) -(defun git-gutter:view-at-pos-linum (sign pos) - (git-gutter:awhen (git-gutter:linum-get-overlay pos) - (overlay-put it 'before-string - (propertize " " - 'display - `((margin left-margin) - ,(concat sign (overlay-get it 'linum-str))))))) +(defun git-gutter:put-signs-linum (sign points) + (dolist (pos points) + (git-gutter:awhen (git-gutter:linum-get-overlay pos) + (overlay-put it 'before-string + (propertize " " + 'display + `((margin left-margin) + ,(concat sign (overlay-get it 'linum-str)))))))) -(defun git-gutter:view-at-pos (sign pos) +(defun git-gutter:put-signs (sign points) (if git-gutter:linum-enabled - (git-gutter:view-at-pos-linum sign pos) - (let ((ov (make-overlay pos pos))) - (overlay-put ov 'before-string (git-gutter:before-string sign)) - (overlay-put ov 'git-gutter t)))) + (git-gutter:put-signs-linum sign points) + (dolist (pos points) + (let ((ov (make-overlay pos pos)) + (gutter-sign (git-gutter:before-string sign))) + (overlay-put ov 'before-string gutter-sign) + (overlay-put ov 'git-gutter t))))) (defsubst git-gutter:sign-width (sign) (cl-loop for s across sign @@ -409,19 +419,29 @@ gutter information of other windows." git-gutter:deleted-sign))) (when git-gutter:unchanged-sign (push git-gutter:unchanged-sign signs)) - (+ (apply 'max (mapcar 'git-gutter:sign-width signs)) + (+ (apply #'max (mapcar 'git-gutter:sign-width signs)) (git-gutter:sign-width git-gutter:separator-sign)))) +(defun git-gutter:next-visual-line (arg) + (let ((line-move-visual t)) + (with-no-warnings + (next-line arg)))) + (defun git-gutter:view-for-unchanged () (save-excursion (let ((sign (if git-gutter:unchanged-sign (propertize git-gutter:unchanged-sign 'face 'git-gutter:unchanged) - " "))) + " ")) + (move-fn (if git-gutter:visual-line + #'git-gutter:next-visual-line + #'forward-line)) + points) (goto-char (point-min)) (while (not (eobp)) - (git-gutter:view-at-pos sign (point)) - (forward-line 1))))) + (push (point) points) + (funcall move-fn 1)) + (git-gutter:put-signs sign points)))) (defsubst git-gutter:check-file-and-directory () (and (git-gutter:base-file) @@ -463,15 +483,17 @@ gutter information of other windows." (defsubst git-gutter:linum-padding () (cl-loop repeat (git-gutter:window-margin) collect " " into paddings - finally return (apply 'concat paddings))) + finally return (apply #'concat paddings))) (defun git-gutter:linum-prepend-spaces () (save-excursion (goto-char (point-min)) - (let ((padding (git-gutter:linum-padding))) + (let ((padding (git-gutter:linum-padding)) + points) (while (not (eobp)) - (git-gutter:view-at-pos-linum padding (point)) - (forward-line 1))))) + (push (point) points) + (forward-line 1)) + (git-gutter:put-signs-linum padding points)))) (defun git-gutter:linum-update (diffinfos) (let ((linum-width (car (window-margins)))) @@ -500,10 +522,14 @@ gutter information of other windows." (car (window-margins))))) (set-window-margins curwin margin (cdr (window-margins curwin))))))) +(defun git-gutter:show-backends () + (mapconcat (lambda (backend) + (capitalize (symbol-name backend))) + git-gutter:handled-backends "/")) + ;;;###autoload (define-minor-mode git-gutter-mode "Git-Gutter mode" - :group 'git-gutter :init-value nil :global nil :lighter git-gutter:lighter @@ -515,7 +541,6 @@ gutter information of other windows." (funcall git-gutter:init-function)) (make-local-variable 'git-gutter:enabled) (set (make-local-variable 'git-gutter:has-indirect-buffers) nil) - (set (make-local-variable 'git-gutter:toggle-flag) t) (make-local-variable 'git-gutter:diffinfos) (set (make-local-variable 'git-gutter:start-revision) nil) (add-hook 'kill-buffer-hook 'git-gutter:kill-buffer-hook nil t) @@ -523,16 +548,19 @@ gutter information of other windows." (add-hook 'post-command-hook 'git-gutter:post-command-hook nil t) (dolist (hook git-gutter:update-hooks) (add-hook hook 'git-gutter nil t)) - (git-gutter)) + (git-gutter) + (when (and (not git-gutter:update-timer) (> git-gutter:update-interval 0)) + (setq git-gutter:update-timer + (run-with-idle-timer 1 git-gutter:update-interval 'git-gutter:live-update)))) (when (> git-gutter:verbosity 2) - (message "Here is not Git/Mercurial work tree")) + (message "Here is not %s work tree" (git-gutter:show-backends))) (git-gutter-mode -1)) (remove-hook 'kill-buffer-hook 'git-gutter:kill-buffer-hook t) (remove-hook 'pre-command-hook 'git-gutter:pre-command-hook) (remove-hook 'post-command-hook 'git-gutter:post-command-hook t) (dolist (hook git-gutter:update-hooks) (remove-hook hook 'git-gutter t)) - (git-gutter:clear))) + (git-gutter:clear-gutter))) (defun git-gutter--turn-on () (when (and (buffer-file-name) @@ -540,8 +568,7 @@ gutter information of other windows." (git-gutter-mode +1))) ;;;###autoload -(define-global-minor-mode global-git-gutter-mode git-gutter-mode git-gutter--turn-on - :group 'git-gutter) +(define-global-minor-mode global-git-gutter-mode git-gutter-mode git-gutter--turn-on) (defsubst git-gutter:show-gutter-p (diffinfos) (if git-gutter:hide-gutter @@ -553,49 +580,57 @@ gutter information of other windows." (git-gutter:set-window-margin (git-gutter:window-margin)))) (defun git-gutter:view-set-overlays (diffinfos) + (when (or git-gutter:unchanged-sign git-gutter:separator-sign) + (git-gutter:view-for-unchanged)) (save-excursion (goto-char (point-min)) (cl-loop with curline = 1 + with move-fn = (if git-gutter:visual-line + #'git-gutter:next-visual-line + #'forward-line) + for info in diffinfos for start-line = (plist-get info :start-line) for end-line = (plist-get info :end-line) for type = (plist-get info :type) for sign = (git-gutter:propertized-sign type) + for points = nil do - (progn - (forward-line (- start-line curline)) + (let ((bound (progn + (forward-line (- end-line curline)) + (point)))) + (forward-line (- start-line end-line)) (cl-case type ((modified added) - (setq curline start-line) - (while (and (<= curline end-line) (not (eobp))) - (git-gutter:view-at-pos sign (point)) - (cl-incf curline) - (forward-line 1))) + (while (and (<= (point) bound) (not (eobp))) + (push (point) points) + (funcall move-fn 1)) + (git-gutter:put-signs sign points)) (deleted - (git-gutter:view-at-pos sign (point)) - (forward-line 1) - (setq curline (1+ end-line)))))))) + (git-gutter:put-signs sign (list (point))) + (forward-line 1))) + (setq curline (1+ end-line)))))) (defun git-gutter:view-diff-infos (diffinfos) - (when diffinfos - (when (or git-gutter:unchanged-sign git-gutter:separator-sign) - (git-gutter:view-for-unchanged)) + (when (or diffinfos git-gutter:always-show-separator) (git-gutter:view-set-overlays diffinfos)) (git-gutter:show-gutter diffinfos)) (defsubst git-gutter:reset-window-margin-p () - (or git-gutter:force - git-gutter:hide-gutter - (not global-git-gutter-mode))) + (or git-gutter:hide-gutter (not global-git-gutter-mode))) (defun git-gutter:clear-diff-infos () (when (git-gutter:reset-window-margin-p) (git-gutter:set-window-margin 0)) (remove-overlays (point-min) (point-max) 'git-gutter t)) -(defsubst git-gutter:clear-gutter () - (when git-gutter:clear-function - (funcall git-gutter:clear-function))) +(defun git-gutter:clear-gutter () + (save-restriction + (widen) + (when git-gutter:clear-function + (funcall git-gutter:clear-function))) + (setq git-gutter:enabled nil + git-gutter:diffinfos nil)) (defun git-gutter:update-diffinfo (diffinfos) (save-restriction @@ -607,7 +642,7 @@ gutter information of other windows." (defun git-gutter:search-near-diff-index (diffinfos is-reverse) (cl-loop with current-line = (line-number-at-pos) - with cmp-fn = (if is-reverse '> '<) + with cmp-fn = (if is-reverse #'> #'<) for diffinfo in (if is-reverse (reverse diffinfos) diffinfos) for index = 0 then (1+ index) for start-line = (plist-get diffinfo :start-line) @@ -617,12 +652,15 @@ gutter information of other windows." index))) (defun git-gutter:search-here-diffinfo (diffinfos) - (cl-loop with current-line = (line-number-at-pos) - for diffinfo in diffinfos - for start = (plist-get diffinfo :start-line) - for end = (or (plist-get diffinfo :end-line) (1+ start)) - when (and (>= current-line start) (<= current-line end)) - return diffinfo)) + (save-restriction + (widen) + (cl-loop with current-line = (line-number-at-pos) + for diffinfo in diffinfos + for start = (plist-get diffinfo :start-line) + for end = (or (plist-get diffinfo :end-line) (1+ start)) + when (and (>= current-line start) (<= current-line end)) + return diffinfo + finally do (error "Here is not changed!!")))) (defun git-gutter:collect-deleted-line (str) (with-temp-buffer @@ -662,22 +700,30 @@ gutter information of other windows." (defsubst git-gutter:popup-buffer-window () (get-buffer-window (get-buffer git-gutter:popup-buffer))) -;;;###autoload +(defun git-gutter:query-action (action action-fn update-fn) + (git-gutter:awhen (git-gutter:search-here-diffinfo git-gutter:diffinfos) + (save-window-excursion + (when git-gutter:ask-p + (git-gutter:popup-hunk it)) + (when (or (not git-gutter:ask-p) (yes-or-no-p (format "%s current hunk ? " action))) + (funcall action-fn it) + (funcall update-fn)) + (if git-gutter:ask-p + (delete-window (git-gutter:popup-buffer-window)) + (message "%s current hunk." action))))) + (defun git-gutter:revert-hunk () "Revert current hunk." (interactive) - (git-gutter:awhen (git-gutter:search-here-diffinfo git-gutter:diffinfos) - (save-window-excursion - (git-gutter:popup-hunk it) - (when (yes-or-no-p "Revert current hunk ?") - (git-gutter:do-revert-hunk it) - (save-buffer)) - (delete-window (git-gutter:popup-buffer-window))))) + (git-gutter:query-action "Revert" #'git-gutter:do-revert-hunk #'save-buffer)) (defun git-gutter:extract-hunk-header () (git-gutter:awhen (git-gutter:base-file) (with-temp-buffer - (when (zerop (git-gutter:execute-command "git" t "diff" "--relative" it)) + (when (zerop (git-gutter:execute-command + "git" t "--no-pager" "-c" "diff.autorefreshindex=0" + "diff" "--no-color" "--no-ext-diff" + "--relative" (file-name-nondirectory it))) (goto-char (point-min)) (forward-line 4) (buffer-substring-no-properties (point-min) (point)))))) @@ -724,23 +770,30 @@ gutter information of other windows." (options (list "--cached" patch))) (when dir-option (setq options (cons "--directory" (cons dir-option options)))) - (unless (zerop (apply 'git-gutter:execute-command + (unless (zerop (apply #'git-gutter:execute-command "git" nil "apply" "--unidiff-zero" options)) (message "Failed: stating this hunk")) (delete-file patch))))) -;;;###autoload (defun git-gutter:stage-hunk () "Stage this hunk like 'git add -p'." + (interactive) + (git-gutter:query-action "Stage" #'git-gutter:do-stage-hunk #'git-gutter)) + +(defsubst git-gutter:line-point (line) + (save-excursion + (goto-char (point-min)) + (forward-line (1- line)) + (point))) + +(defun git-gutter:mark-hunk () (interactive) (git-gutter:awhen (git-gutter:search-here-diffinfo git-gutter:diffinfos) - (save-window-excursion - (git-gutter:popup-hunk it) - (when (yes-or-no-p "Stage current hunk ?") - (git-gutter:do-stage-hunk it) - (git-gutter)) - (delete-window (git-gutter:popup-buffer-window))))) + (let ((start (git-gutter:line-point (plist-get it :start-line))) + (end (git-gutter:line-point (1+ (plist-get it :end-line))))) + (goto-char start) + (push-mark end nil t)))) (defun git-gutter:update-popuped-buffer (diffinfo) (with-current-buffer (get-buffer-create git-gutter:popup-buffer) @@ -754,7 +807,6 @@ gutter information of other windows." (view-mode +1) (current-buffer))) -;;;###autoload (defun git-gutter:popup-hunk (&optional diffinfo) "Popup current diff hunk." (interactive) @@ -763,7 +815,6 @@ gutter information of other windows." (save-selected-window (pop-to-buffer (git-gutter:update-popuped-buffer it))))) -;;;###autoload (defun git-gutter:next-hunk (arg) "Move to next diff hunk" (interactive "p") @@ -781,10 +832,11 @@ gutter information of other windows." (diffinfo (nth real-index diffinfos))) (goto-char (point-min)) (forward-line (1- (plist-get diffinfo :start-line))) + (when (> git-gutter:verbosity 0) + (message "Move to %d/%d hunk" (1+ real-index) len)) (when (buffer-live-p (get-buffer git-gutter:popup-buffer)) (git-gutter:update-popuped-buffer diffinfo))))) -;;;###autoload (defun git-gutter:previous-hunk (arg) "Move to previous diff hunk" (interactive "p") @@ -811,7 +863,7 @@ gutter information of other windows." (defun git-gutter () "Show diff information in gutter" (interactive) - (when (or git-gutter:force git-gutter:toggle-flag) + (when (or git-gutter:vcs-type (git-gutter:in-repository-p)) (let* ((file (git-gutter:base-file)) (proc-buf (git-gutter:diff-process-buffer file))) (when (and (called-interactively-p 'interactive) (get-buffer proc-buf)) @@ -828,6 +880,10 @@ gutter information of other windows." (when git-gutter-mode (run-with-idle-timer 0.1 nil 'git-gutter))) +(defadvice toggle-truncate-lines (after git-gutter:toggle-truncate-lines activate) + (when (and git-gutter-mode git-gutter:visual-line) + (run-with-idle-timer 0.1 nil 'git-gutter))) + ;; `quit-window' and `switch-to-buffer' are called from other ;; commands. So we should use `defadvice' instead of `post-command-hook'. (defadvice quit-window (after git-gutter:quit-window activate) @@ -838,41 +894,32 @@ gutter information of other windows." (when git-gutter-mode (git-gutter))) -;;;###autoload (defun git-gutter:clear () "Clear diff information in gutter." (interactive) - (save-restriction - (widen) - (git-gutter:clear-gutter)) - (setq git-gutter:enabled nil - git-gutter:diffinfos nil)) + (git-gutter-mode -1)) +(make-obsolete 'git-gutter:clear #'git-gutter-mode "0.86") ;;;###autoload (defun git-gutter:toggle () "Toggle to show diff information." (interactive) - (let ((git-gutter:force t)) - (if git-gutter:enabled - (progn - (git-gutter:clear) - (setq git-gutter-mode nil - git-gutter:toggle-flag nil)) - (git-gutter) - (setq git-gutter-mode t - git-gutter:toggle-flag t)) - (force-mode-line-update))) + (if git-gutter-mode + (git-gutter-mode -1) + (git-gutter-mode +1))) +(make-obsolete 'git-gutter:toggle #'git-gutter-mode "0.86") (defun git-gutter:revision-valid-p (revision) (zerop (cl-case git-gutter:vcs-type (git (git-gutter:execute-command "git" nil "rev-parse" "--quiet" "--verify" revision)) + (svn (git-gutter:execute-command "svn" nil "info" "-r" revision + (file-relative-name (buffer-file-name)))) (hg (git-gutter:execute-command "hg" nil "id" "-r" revision)) (bzr (git-gutter:execute-command "bzr" nil "revno" "-r" revision))))) -;;;###autoload (defun git-gutter:set-start-revision (start-rev) "Set start revision. If `start-rev' is nil or empty string then reset start revision." @@ -885,9 +932,8 @@ start revision." (setq git-gutter:start-revision start-rev) (git-gutter)) -;;;###autoload (defun git-gutter:update-all-windows () - "Update git-gutter informations for all visible buffers." + "Update git-gutter information for all visible buffers." (interactive) (dolist (win (window-list)) (let ((buf (window-buffer win))) @@ -895,10 +941,124 @@ start revision." (when git-gutter-mode (git-gutter)))))) +(defun git-gutter:start-update-timer () + (interactive) + (when git-gutter:update-timer + (error "Update timer is already running.")) + (setq git-gutter:update-timer + (run-with-idle-timer 1 git-gutter:update-interval 'git-gutter:live-update))) + +(defun git-gutter:cancel-update-timer () + (interactive) + (unless git-gutter:update-timer + (error "Timer is no running.")) + (cancel-timer git-gutter:update-timer) + (setq git-gutter:update-timer nil)) + +(defsubst git-gutter:write-current-content (tmpfile) + (let ((content (buffer-substring-no-properties (point-min) (point-max)))) + (with-temp-file tmpfile + (insert content)))) + +(defsubst git-gutter:original-file-content (file) + (with-temp-buffer + (when (zerop (process-file "git" nil t nil "show" (concat ":" file))) + (buffer-substring-no-properties (point-min) (point-max))))) + +(defun git-gutter:write-original-content (tmpfile filename) + (git-gutter:awhen (git-gutter:original-file-content filename) + (with-temp-file tmpfile + (insert it) + t))) + +(defsubst git-gutter:start-raw-diff-process (proc-buf original now) + (start-file-process "git-gutter:update-timer" proc-buf + "diff" "-U0" original now)) + +(defun git-gutter:start-live-update (file original now) + (let ((proc-bufname (git-gutter:diff-process-buffer file))) + (when (get-buffer proc-bufname) + (kill-buffer proc-bufname)) + (let* ((curbuf (current-buffer)) + (proc-buf (get-buffer-create proc-bufname)) + (process (git-gutter:start-raw-diff-process proc-buf original now))) + (set-process-query-on-exit-flag process nil) + (set-process-sentinel + process + (lambda (proc _event) + (when (eq (process-status proc) 'exit) + (setq git-gutter:enabled nil) + (let ((diffinfos (git-gutter:process-diff-output (process-buffer proc)))) + (when (buffer-live-p curbuf) + (with-current-buffer curbuf + (git-gutter:update-diffinfo diffinfos) + (setq git-gutter:enabled t))) + (kill-buffer proc-buf) + (delete-file original) + (delete-file now)))))))) + +(defun git-gutter:should-update-p () + (let ((sha1 (secure-hash 'sha1 (current-buffer)))) + (unless (equal sha1 git-gutter:last-sha1) + (setq git-gutter:last-sha1 sha1)))) + +(defun git-gutter:live-update () + (git-gutter:awhen (git-gutter:base-file) + (when (and git-gutter:enabled + (buffer-modified-p) + (git-gutter:should-update-p)) + (let ((file (file-name-nondirectory it)) + (now (make-temp-file "git-gutter-cur")) + (original (make-temp-file "git-gutter-orig"))) + (when (git-gutter:write-original-content original file) + (git-gutter:write-current-content now) + (git-gutter:start-live-update file original now)))))) + ;; for linum-user (when (and global-linum-mode (not (boundp 'git-gutter-fringe))) (git-gutter:linum-setup)) +(defun git-gutter:all-hunks () + "Cound unstaged hunks in all buffers" + (let ((sum 0)) + (dolist (buf (buffer-list)) + (with-current-buffer buf + (when git-gutter-mode + (cl-incf sum (git-gutter:buffer-hunks))))) + sum)) + +(defun git-gutter:buffer-hunks () + "Count unstaged hunks in current buffer." + (length git-gutter:diffinfos)) + +(defun git-gutter:stat-hunk (hunk) + (cl-case (plist-get hunk :type) + (modified (with-temp-buffer + (insert (plist-get hunk :content)) + (goto-char (point-min)) + (let ((added 0) + (deleted 0)) + (while (not (eobp)) + (cond ((looking-at-p "\\+") (cl-incf added)) + ((looking-at-p "\\-") (cl-incf deleted))) + (forward-line 1)) + (cons added deleted)))) + (added (cons (- (plist-get hunk :end-line) (plist-get hunk :start-line)) 0)) + (deleted (cons 0 (- (plist-get hunk :end-line) (plist-get hunk :start-line)))))) + +(defun git-gutter:statistic () + "Return statistic unstaged hunks in current buffer." + (interactive) + (cl-loop for hunk in git-gutter:diffinfos + for (add . del) = (git-gutter:stat-hunk hunk) + sum add into added + sum del into deleted + finally + return (progn + (when (called-interactively-p 'interactive) + (message "Added %d lines, Deleted %d lines" added deleted)) + (cons added deleted)))) + (provide 'git-gutter) ;;; git-gutter.el ends here diff --git a/elpa/gitconfig-mode-0.3/gitconfig-mode-pkg.el b/elpa/gitconfig-mode-0.3/gitconfig-mode-pkg.el deleted file mode 100644 index cddf1dd..0000000 --- a/elpa/gitconfig-mode-0.3/gitconfig-mode-pkg.el +++ /dev/null @@ -1 +0,0 @@ -(define-package "gitconfig-mode" "0.3" "Major mode for editing .gitconfig files" 'nil) diff --git a/elpa/gitconfig-mode-0.3/gitconfig-mode.el b/elpa/gitconfig-mode-0.3/gitconfig-mode.el deleted file mode 100644 index 2994719..0000000 --- a/elpa/gitconfig-mode-0.3/gitconfig-mode.el +++ /dev/null @@ -1,105 +0,0 @@ -;;; gitconfig-mode.el --- Major mode for editing .gitconfig files -*- lexical-binding: t; -*- - -;; Copyright (c) 2012, 2013 Sebastian Wiesner -;; -;; Author: Sebastian Wiesner -;; URL: https://github.com/lunaryorn/git-modes -;; Version: 0.3 -;; Keywords: convenience vc git - -;; This file is not part of GNU Emacs. - -;; 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 2 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, write to the Free Software Foundation, Inc., 51 -;; Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. - -;;; Commentary: - -;; A major mode for editing .gitconfig files. - -;;; Code: - -(require 'conf-mode) - -(defun gitconfig-line-indented-p () - "Determine whether the current line is indented correctly. - -Return t if so, or nil otherwise." - (save-excursion - (beginning-of-line) - (or (looking-at "^\\[\\_<.*?\\]") - (looking-at "^\t\\_<\\(?:\\sw|\\s_\\)")))) - -(defun gitconfig-point-in-indentation-p () - "Determine whether the point is in the indentation of the current line. - -Return t if so, or nil otherwise." - (save-excursion - (let ((pos (point))) - (back-to-indentation) - (< pos (point))))) - -(defun gitconfig-indent-line () - "Indent the current line." - (interactive) - (unless (gitconfig-line-indented-p) - (let ((old-point (point-marker)) - (was-in-indent (gitconfig-point-in-indentation-p))) - (beginning-of-line) - (delete-horizontal-space) - (unless (= (char-after) ?\[) - (insert-char ?\t 1)) - (if was-in-indent - (back-to-indentation) - (goto-char (marker-position old-point)))))) - -(defvar gitconfig-mode-syntax-table - (let ((table (make-syntax-table conf-unix-mode-syntax-table))) - ;; ; is a comment in .gitconfig - (modify-syntax-entry ?\; "<" table) - table) - "Syntax table to use in .gitconfig buffers.") - -(defvar gitconfig-mode-font-lock-keywords - `( - ;; Highlight section and subsection gitconfig headers, and override - ;; syntactic fontification in these. - ("^\\s-*\\[\\_<\\(\\(?:\\sw\\|\\s_\\)+\\)\\_>\\(?:\\s-+\\(\\s\".+?\\s\"\\)\\)?\\]\\s-*" - (1 'font-lock-type-face t nil) - (2 'font-lock-function-name-face t t)) - ("^\\s-*\\_<\\(\\(?:\\sw\\|\\s_\\)+\\)\\_>\\s-*\\(?:=.*\\)?$" - (1 'font-lock-variable-name-face)) - ;; Highlight booleans and numbers - (,(format "=\\s-*%s\\s-*$" - (regexp-opt '("yes" "no" "true" "false" "on" "off") 'words)) - (1 'font-lock-keyword-face)) - ("=\\s-*\\<\\([0-9]+\\)\\>\\s-*$" (1 'font-lock-constant-face)))) - -;;;###autoload -(define-derived-mode gitconfig-mode conf-unix-mode "Gitconfig" - "A major mode for editing .gitconfig files." - ;; .gitconfig is indented with tabs only - (conf-mode-initialize "#" gitconfig-mode-font-lock-keywords) - (setq indent-tabs-mode t) - (set (make-local-variable 'indent-line-function) - 'gitconfig-indent-line)) - -;;;###autoload -(setq auto-mode-alist - (append '(("/\\.gitconfig\\'" . gitconfig-mode) - ("/\\.git/config\\'" . gitconfig-mode)) - auto-mode-alist)) - -(provide 'gitconfig-mode) - -;;; gitconfig-mode.el ends here diff --git a/elpa/gitconfig-mode-0.3/gitconfig-mode-autoloads.el b/elpa/gitconfig-mode-20160319.302/gitconfig-mode-autoloads.el similarity index 60% rename from elpa/gitconfig-mode-0.3/gitconfig-mode-autoloads.el rename to elpa/gitconfig-mode-20160319.302/gitconfig-mode-autoloads.el index 1fe7d36..cf522ab 100644 --- a/elpa/gitconfig-mode-0.3/gitconfig-mode-autoloads.el +++ b/elpa/gitconfig-mode-20160319.302/gitconfig-mode-autoloads.el @@ -3,8 +3,8 @@ ;;; Code: (add-to-list 'load-path (or (file-name-directory #$) (car load-path))) -;;;### (autoloads nil "gitconfig-mode" "gitconfig-mode.el" (21633 -;;;;;; 45695 432043 861000)) +;;;### (autoloads nil "gitconfig-mode" "gitconfig-mode.el" (22297 +;;;;;; 19828 264884 774000)) ;;; Generated autoloads from gitconfig-mode.el (autoload 'gitconfig-mode "gitconfig-mode" "\ @@ -12,7 +12,7 @@ A major mode for editing .gitconfig files. \(fn)" t nil) -(setq auto-mode-alist (append '(("/\\.gitconfig\\'" . gitconfig-mode) ("/\\.git/config\\'" . gitconfig-mode)) auto-mode-alist)) +(dolist (pattern '("/\\.gitconfig\\'" "/\\.git/config\\'" "/modules/.*/config\\'" "/git/config\\'" "/\\.gitmodules\\'" "/etc/gitconfig\\'")) (add-to-list 'auto-mode-alist (cons pattern 'gitconfig-mode))) ;;;*** diff --git a/elpa/gitconfig-mode-20160319.302/gitconfig-mode-pkg.el b/elpa/gitconfig-mode-20160319.302/gitconfig-mode-pkg.el new file mode 100644 index 0000000..e282571 --- /dev/null +++ b/elpa/gitconfig-mode-20160319.302/gitconfig-mode-pkg.el @@ -0,0 +1 @@ +(define-package "gitconfig-mode" "20160319.302" "Major mode for editing .gitconfig files" 'nil :url "https://github.com/magit/git-modes" :keywords '("convenience" "vc" "git")) diff --git a/elpa/gitconfig-mode-20160319.302/gitconfig-mode.el b/elpa/gitconfig-mode-20160319.302/gitconfig-mode.el new file mode 100644 index 0000000..a2aa6de --- /dev/null +++ b/elpa/gitconfig-mode-20160319.302/gitconfig-mode.el @@ -0,0 +1,137 @@ +;;; gitconfig-mode.el --- Major mode for editing .gitconfig files -*- lexical-binding: t; -*- + +;; Copyright (c) 2012-2013 Sebastian Wiesner +;; Copyright (C) 2012-2016 The Magit Project Contributors + +;; Author: Sebastian Wiesner +;; Maintainer: Jonas Bernoulli +;; Homepage: https://github.com/magit/git-modes +;; Keywords: convenience vc git +;; Package-Version: 20160319.302 + +;; This file is not part of GNU Emacs. + +;; This file 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 file 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 file. If not, see . + +;;; Commentary: + +;; A major mode for editing .gitconfig files. + +;;; Code: + +(require 'rx) +(require 'conf-mode) + +(defun gitconfig-line-indented-p () + "Return t if the current line is indented correctly." + (save-excursion + (beginning-of-line) + (or (looking-at (rx line-start "[" + symbol-start + (minimal-match (zero-or-more not-newline)) + symbol-end "]")) + (looking-at (concat (rx line-start) + (gitconfig-indentation-string) + (rx symbol-start (or (syntax word) + (syntax symbol))))) + (looking-at (rx (zero-or-one "\t") (or "#" ";")))))) + +(defun gitconfig-point-in-indentation-p () + "Return if the point is in the indentation of the current line." + (save-excursion + (let ((pos (point))) + (back-to-indentation) + (<= pos (point))))) + +(defun gitconfig-indent-line () + "Indent the current line." + (interactive) + (if (gitconfig-line-indented-p) + (when (gitconfig-point-in-indentation-p) + (back-to-indentation)) + (let ((old-point (point-marker)) + (was-in-indent (gitconfig-point-in-indentation-p))) + (beginning-of-line) + (delete-horizontal-space) + (unless (equal (char-after) ?\[) + (insert (gitconfig-indentation-string))) + (if was-in-indent + (back-to-indentation) + (goto-char (marker-position old-point))) + (set-marker old-point nil)))) + +(defun gitconfig-indentation-string () + (if indent-tabs-mode "\t" (make-string tab-width ?\ ))) + +(defvar gitconfig-mode-syntax-table + (let ((table (make-syntax-table conf-unix-mode-syntax-table))) + ;; ; is a comment in .gitconfig + (modify-syntax-entry ?\; "<" table) + ;; ' is not used for string quoting + (modify-syntax-entry ?\' "." table) + table) + "Syntax table to use in .gitconfig buffers.") + +(defvar gitconfig-mode-font-lock-keywords + `( + ;; Highlight section and subsection gitconfig headers, and override + ;; syntactic fontification in these. + (,(rx line-start (zero-or-more (syntax whitespace)) + "[" symbol-start + (group (one-or-more (or (syntax word) (syntax symbol)))) + symbol-end + (optional (one-or-more (syntax whitespace)) + (group (syntax string-quote) + (minimal-match (one-or-more not-newline)) + (syntax string-quote))) + "]" (zero-or-more (syntax whitespace)) line-end) + (1 'font-lock-type-face t nil) + (2 'font-lock-function-name-face t t)) + (,(rx line-start (zero-or-more (syntax whitespace)) symbol-start + (group (one-or-more (or (syntax word) (syntax symbol)))) + symbol-end (zero-or-more (syntax whitespace)) + (optional "=" (zero-or-more not-newline)) line-end) + (1 'font-lock-variable-name-face)) + ;; Highlight booleans and numbers + (,(rx "=" + (zero-or-more (syntax whitespace)) word-start + (group (or "yes" "no" "true" "false" "on" "off")) + word-end (zero-or-more (syntax whitespace)) line-end) + (1 'font-lock-keyword-face)) + (,(rx "=" + (zero-or-more (syntax whitespace)) word-start + (group (one-or-more digit)) + word-end (zero-or-more (syntax whitespace)) line-end) + (1 'font-lock-constant-face)))) + +;;;###autoload +(define-derived-mode gitconfig-mode conf-unix-mode "Gitconfig" + "A major mode for editing .gitconfig files." + ;; .gitconfig is indented with tabs only + (conf-mode-initialize "#" gitconfig-mode-font-lock-keywords) + (setq indent-tabs-mode t) + (set (make-local-variable 'indent-line-function) + 'gitconfig-indent-line)) + +;;;###autoload +(dolist (pattern '("/\\.gitconfig\\'" "/\\.git/config\\'" + "/modules/.*/config\\'" "/git/config\\'" + "/\\.gitmodules\\'" "/etc/gitconfig\\'")) + (add-to-list 'auto-mode-alist (cons pattern 'gitconfig-mode))) + +(provide 'gitconfig-mode) +;; Local Variables: +;; indent-tabs-mode: nil +;; End: +;;; gitconfig-mode.el ends here diff --git a/elpa/gitignore-mode-1.1.0/gitignore-mode-pkg.el b/elpa/gitignore-mode-1.1.0/gitignore-mode-pkg.el deleted file mode 100644 index ae6eaa4..0000000 --- a/elpa/gitignore-mode-1.1.0/gitignore-mode-pkg.el +++ /dev/null @@ -1 +0,0 @@ -(define-package "gitignore-mode" "1.1.0" "Major mode for editing .gitignore files" 'nil) diff --git a/elpa/gitignore-mode-1.1.0/gitignore-mode-autoloads.el b/elpa/gitignore-mode-20160319.302/gitignore-mode-autoloads.el similarity index 65% rename from elpa/gitignore-mode-1.1.0/gitignore-mode-autoloads.el rename to elpa/gitignore-mode-20160319.302/gitignore-mode-autoloads.el index 82e25c6..7af4092 100644 --- a/elpa/gitignore-mode-1.1.0/gitignore-mode-autoloads.el +++ b/elpa/gitignore-mode-20160319.302/gitignore-mode-autoloads.el @@ -3,8 +3,8 @@ ;;; Code: (add-to-list 'load-path (or (file-name-directory #$) (car load-path))) -;;;### (autoloads nil "gitignore-mode" "gitignore-mode.el" (21831 -;;;;;; 16635 816188 71000)) +;;;### (autoloads nil "gitignore-mode" "gitignore-mode.el" (22297 +;;;;;; 19827 120905 236000)) ;;; Generated autoloads from gitignore-mode.el (autoload 'gitignore-mode "gitignore-mode" "\ @@ -12,7 +12,7 @@ A major mode for editing .gitignore files. \(fn)" t nil) -(dolist (pattern (list "/\\.gitignore\\'" "/\\.git/info/exclude\\'" "/git/ignore\\'")) (add-to-list 'auto-mode-alist (cons pattern 'gitignore-mode))) +(dolist (pattern (list "/\\.gitignore\\'" "/info/exclude\\'" "/git/ignore\\'")) (add-to-list 'auto-mode-alist (cons pattern 'gitignore-mode))) ;;;*** diff --git a/elpa/gitignore-mode-20160319.302/gitignore-mode-pkg.el b/elpa/gitignore-mode-20160319.302/gitignore-mode-pkg.el new file mode 100644 index 0000000..32a6f9e --- /dev/null +++ b/elpa/gitignore-mode-20160319.302/gitignore-mode-pkg.el @@ -0,0 +1 @@ +(define-package "gitignore-mode" "20160319.302" "Major mode for editing .gitignore files" 'nil :url "https://github.com/magit/git-modes" :keywords '("convenience" "vc" "git")) diff --git a/elpa/gitignore-mode-1.1.0/gitignore-mode.el b/elpa/gitignore-mode-20160319.302/gitignore-mode.el similarity index 94% rename from elpa/gitignore-mode-1.1.0/gitignore-mode.el rename to elpa/gitignore-mode-20160319.302/gitignore-mode.el index 57d8eed..9329e93 100644 --- a/elpa/gitignore-mode-1.1.0/gitignore-mode.el +++ b/elpa/gitignore-mode-20160319.302/gitignore-mode.el @@ -1,13 +1,13 @@ ;;; gitignore-mode.el --- Major mode for editing .gitignore files -*- lexical-binding: t; -*- ;; Copyright (c) 2012-2013 Sebastian Wiesner -;; Copyright (C) 2012-2015 The Magit Project Developers +;; Copyright (C) 2012-2016 The Magit Project Contributors ;; Author: Sebastian Wiesner ;; Maintainer: Jonas Bernoulli ;; Homepage: https://github.com/magit/git-modes ;; Keywords: convenience vc git -;; Package-Version: 1.1.0 +;; Package-Version: 20160319.302 ;; This file is not part of GNU Emacs. @@ -50,7 +50,7 @@ ;;;###autoload (dolist (pattern (list "/\\.gitignore\\'" - "/\\.git/info/exclude\\'" + "/info/exclude\\'" "/git/ignore\\'")) (add-to-list 'auto-mode-alist (cons pattern 'gitignore-mode))) diff --git a/elpa/go-mode-20131222/go-mode-pkg.el b/elpa/go-mode-20131222/go-mode-pkg.el deleted file mode 100644 index 2e6cc14..0000000 --- a/elpa/go-mode-20131222/go-mode-pkg.el +++ /dev/null @@ -1 +0,0 @@ -(define-package "go-mode" "20131222" "Major mode for the Go programming language" 'nil) diff --git a/elpa/go-mode-20131222/go-mode.el b/elpa/go-mode-20131222/go-mode.el deleted file mode 100644 index 0824d24..0000000 --- a/elpa/go-mode-20131222/go-mode.el +++ /dev/null @@ -1,1166 +0,0 @@ -;;; go-mode.el --- Major mode for the Go programming language - -;;; Version: 20131222 - -;; Copyright 2013 The Go Authors. All rights reserved. -;; Use of this source code is governed by a BSD-style -;; license that can be found in the LICENSE file. - -(require 'cl) -(require 'etags) -(require 'ffap) -(require 'ring) -(require 'url) - -;; XEmacs compatibility guidelines -;; - Minimum required version of XEmacs: 21.5.32 -;; - Feature that cannot be backported: POSIX character classes in -;; regular expressions -;; - Functions that could be backported but won't because 21.5.32 -;; covers them: plenty. -;; - Features that are still partly broken: -;; - godef will not work correctly if multibyte characters are -;; being used -;; - Fontification will not handle unicode correctly -;; -;; - Do not use \_< and \_> regexp delimiters directly; use -;; go--regexp-enclose-in-symbol -;; -;; - The character `_` must not be a symbol constituent but a -;; character constituent -;; -;; - Do not use process-lines -;; -;; - Use go--old-completion-list-style when using a plain list as the -;; collection for completing-read -;; -;; - Use go--kill-whole-line instead of kill-whole-line (called -;; kill-entire-line in XEmacs) -;; -;; - Use go--position-bytes instead of position-bytes -(defmacro go--xemacs-p () - `(featurep 'xemacs)) - -(defalias 'go--kill-whole-line - (if (fboundp 'kill-whole-line) - #'kill-whole-line - #'kill-entire-line)) - -;; Delete the current line without putting it in the kill-ring. -(defun go--delete-whole-line (&optional arg) - ;; Emacs uses both kill-region and kill-new, Xemacs only uses - ;; kill-region. In both cases we turn them into operations that do - ;; not modify the kill ring. This solution does depend on the - ;; implementation of kill-line, but it's the only viable solution - ;; that does not require to write kill-line from scratch. - (flet ((kill-region (beg end) - (delete-region beg end)) - (kill-new (s) ())) - (go--kill-whole-line arg))) - -;; declare-function is an empty macro that only byte-compile cares -;; about. Wrap in always false if to satisfy Emacsen without that -;; macro. -(if nil - (declare-function go--position-bytes "go-mode" (point))) - -;; XEmacs unfortunately does not offer position-bytes. We can fall -;; back to just using (point), but it will be incorrect as soon as -;; multibyte characters are being used. -(if (fboundp 'position-bytes) - (defalias 'go--position-bytes #'position-bytes) - (defun go--position-bytes (point) point)) - -(defun go--old-completion-list-style (list) - (mapcar (lambda (x) (cons x nil)) list)) - -;; GNU Emacs 24 has prog-mode, older GNU Emacs and XEmacs do not, so -;; copy its definition for those. -(if (not (fboundp 'prog-mode)) - (define-derived-mode prog-mode fundamental-mode "Prog" - "Major mode for editing source code." - (set (make-local-variable 'require-final-newline) mode-require-final-newline) - (set (make-local-variable 'parse-sexp-ignore-comments) t) - (setq bidi-paragraph-direction 'left-to-right))) - -(defun go--regexp-enclose-in-symbol (s) - ;; XEmacs does not support \_<, GNU Emacs does. In GNU Emacs we make - ;; extensive use of \_< to support unicode in identifiers. Until we - ;; come up with a better solution for XEmacs, this solution will - ;; break fontification in XEmacs for identifiers such as "typeµ". - ;; XEmacs will consider "type" a keyword, GNU Emacs won't. - - (if (go--xemacs-p) - (concat "\\<" s "\\>") - (concat "\\_<" s "\\_>"))) - -;; Move up one level of parentheses. -(defun go-goto-opening-parenthesis (&optional legacy-unused) - ;; The old implementation of go-goto-opening-parenthesis had an - ;; optional argument to speed up the function. It didn't change the - ;; function's outcome. - - ;; Silently fail if there's no matching opening parenthesis. - (condition-case nil - (backward-up-list) - (scan-error nil))) - - -(defconst go-dangling-operators-regexp "[^-]-\\|[^+]\\+\\|[/*&><.=|^]") -(defconst go-identifier-regexp "[[:word:][:multibyte:]]+") -(defconst go-label-regexp go-identifier-regexp) -(defconst go-type-regexp "[[:word:][:multibyte:]*]+") -(defconst go-func-regexp (concat (go--regexp-enclose-in-symbol "func") "\\s *\\(" go-identifier-regexp "\\)")) -(defconst go-func-meth-regexp (concat - (go--regexp-enclose-in-symbol "func") "\\s *\\(?:(\\s *" - "\\(" go-identifier-regexp "\\s +\\)?" go-type-regexp - "\\s *)\\s *\\)?\\(" - go-identifier-regexp - "\\)(")) -(defconst go-builtins - '("append" "cap" "close" "complex" "copy" - "delete" "imag" "len" "make" "new" - "panic" "print" "println" "real" "recover") - "All built-in functions in the Go language. Used for font locking.") - -(defconst go-mode-keywords - '("break" "default" "func" "interface" "select" - "case" "defer" "go" "map" "struct" - "chan" "else" "goto" "package" "switch" - "const" "fallthrough" "if" "range" "type" - "continue" "for" "import" "return" "var") - "All keywords in the Go language. Used for font locking.") - -(defconst go-constants '("nil" "true" "false" "iota")) -(defconst go-type-name-regexp (concat "\\(?:[*(]\\)*\\(?:" go-identifier-regexp "\\.\\)?\\(" go-identifier-regexp "\\)")) - -(defvar go-dangling-cache) -(defvar go-godoc-history nil) -(defvar go--coverage-current-file-name) - -(defgroup go nil - "Major mode for editing Go code" - :group 'languages) - -(defgroup go-cover nil - "Options specific to `cover`" - :group 'go) - -(defcustom go-fontify-function-calls t - "Fontify function and method calls if this is non-nil." - :type 'boolean - :group 'go) - -(defcustom go-mode-hook nil - "Hook called by `go-mode'." - :type 'hook - :group 'go) - -(defcustom go-command "go" - "The 'go' command. Some users have multiple Go development -trees and invoke the 'go' tool via a wrapper that sets GOROOT and -GOPATH based on the current directory. Such users should -customize this variable to point to the wrapper script." - :type 'string - :group 'go) - -(defcustom gofmt-command "gofmt" - "The 'gofmt' command. Some users may replace this with 'goimports' -from https://github.com/bradfitz/goimports." - :type 'string - :group 'go) - -(defface go-coverage-untracked - '((t (:foreground "#505050"))) - "Coverage color of untracked code." - :group 'go-cover) - -(defface go-coverage-0 - '((t (:foreground "#c00000"))) - "Coverage color for uncovered code." - :group 'go-cover) -(defface go-coverage-1 - '((t (:foreground "#808080"))) - "Coverage color for covered code with weight 1." - :group 'go-cover) -(defface go-coverage-2 - '((t (:foreground "#748c83"))) - "Coverage color for covered code with weight 2." - :group 'go-cover) -(defface go-coverage-3 - '((t (:foreground "#689886"))) - "Coverage color for covered code with weight 3." - :group 'go-cover) -(defface go-coverage-4 - '((t (:foreground "#5ca489"))) - "Coverage color for covered code with weight 4." - :group 'go-cover) -(defface go-coverage-5 - '((t (:foreground "#50b08c"))) - "Coverage color for covered code with weight 5." - :group 'go-cover) -(defface go-coverage-6 - '((t (:foreground "#44bc8f"))) - "Coverage color for covered code with weight 6." - :group 'go-cover) -(defface go-coverage-7 - '((t (:foreground "#38c892"))) - "Coverage color for covered code with weight 7." - :group 'go-cover) -(defface go-coverage-8 - '((t (:foreground "#2cd495"))) - "Coverage color for covered code with weight 8. -For mode=set, all covered lines will have this weight." - :group 'go-cover) -(defface go-coverage-9 - '((t (:foreground "#20e098"))) - "Coverage color for covered code with weight 9." - :group 'go-cover) -(defface go-coverage-10 - '((t (:foreground "#14ec9b"))) - "Coverage color for covered code with weight 10." - :group 'go-cover) -(defface go-coverage-covered - '((t (:foreground "#2cd495"))) - "Coverage color of covered code." - :group 'go-cover) - -(defvar go-mode-syntax-table - (let ((st (make-syntax-table))) - (modify-syntax-entry ?+ "." st) - (modify-syntax-entry ?- "." st) - (modify-syntax-entry ?% "." st) - (modify-syntax-entry ?& "." st) - (modify-syntax-entry ?| "." st) - (modify-syntax-entry ?^ "." st) - (modify-syntax-entry ?! "." st) - (modify-syntax-entry ?= "." st) - (modify-syntax-entry ?< "." st) - (modify-syntax-entry ?> "." st) - (modify-syntax-entry ?/ (if (go--xemacs-p) ". 1456" ". 124b") st) - (modify-syntax-entry ?* ". 23" st) - (modify-syntax-entry ?\n "> b" st) - (modify-syntax-entry ?\" "\"" st) - (modify-syntax-entry ?\' "\"" st) - (modify-syntax-entry ?` "\"" st) - (modify-syntax-entry ?\\ "\\" st) - ;; It would be nicer to have _ as a symbol constituent, but that - ;; would trip up XEmacs, which does not support the \_< anchor - (modify-syntax-entry ?_ "w" st) - - st) - "Syntax table for Go mode.") - -(defun go--build-font-lock-keywords () - ;; we cannot use 'symbols in regexp-opt because GNU Emacs <24 - ;; doesn't understand that - (append - `((,(go--regexp-enclose-in-symbol (regexp-opt go-mode-keywords t)) . font-lock-keyword-face) - (,(go--regexp-enclose-in-symbol (regexp-opt go-builtins t)) . font-lock-builtin-face) - (,(go--regexp-enclose-in-symbol (regexp-opt go-constants t)) . font-lock-constant-face) - (,go-func-regexp 1 font-lock-function-name-face)) ;; function (not method) name - - (if go-fontify-function-calls - `((,(concat "\\(" go-identifier-regexp "\\)[[:space:]]*(") 1 font-lock-function-name-face) ;; function call/method name - (,(concat "[^[:word:][:multibyte:]](\\(" go-identifier-regexp "\\))[[:space:]]*(") 1 font-lock-function-name-face)) ;; bracketed function call - `((,go-func-meth-regexp 1 font-lock-function-name-face))) ;; method name - - `( - (,(concat (go--regexp-enclose-in-symbol "type") "[[:space:]]*\\([^[:space:]]+\\)") 1 font-lock-type-face) ;; types - (,(concat (go--regexp-enclose-in-symbol "type") "[[:space:]]*" go-identifier-regexp "[[:space:]]*" go-type-name-regexp) 1 font-lock-type-face) ;; types - (,(concat "[^[:word:][:multibyte:]]\\[\\([[:digit:]]+\\|\\.\\.\\.\\)?\\]" go-type-name-regexp) 2 font-lock-type-face) ;; Arrays/slices - (,(concat "\\(" go-identifier-regexp "\\)" "{") 1 font-lock-type-face) - (,(concat (go--regexp-enclose-in-symbol "map") "\\[[^]]+\\]" go-type-name-regexp) 1 font-lock-type-face) ;; map value type - (,(concat (go--regexp-enclose-in-symbol "map") "\\[" go-type-name-regexp) 1 font-lock-type-face) ;; map key type - (,(concat (go--regexp-enclose-in-symbol "chan") "[[:space:]]*\\(?:<-\\)?" go-type-name-regexp) 1 font-lock-type-face) ;; channel type - (,(concat (go--regexp-enclose-in-symbol "\\(?:new\\|make\\)") "\\(?:[[:space:]]\\|)\\)*(" go-type-name-regexp) 1 font-lock-type-face) ;; new/make type - ;; TODO do we actually need this one or isn't it just a function call? - (,(concat "\\.\\s *(" go-type-name-regexp) 1 font-lock-type-face) ;; Type conversion - (,(concat (go--regexp-enclose-in-symbol "func") "[[:space:]]+(" go-identifier-regexp "[[:space:]]+" go-type-name-regexp ")") 1 font-lock-type-face) ;; Method receiver - (,(concat (go--regexp-enclose-in-symbol "func") "[[:space:]]+(" go-type-name-regexp ")") 1 font-lock-type-face) ;; Method receiver without variable name - ;; Like the original go-mode this also marks compound literal - ;; fields. There, it was marked as to fix, but I grew quite - ;; accustomed to it, so it'll stay for now. - (,(concat "^[[:space:]]*\\(" go-label-regexp "\\)[[:space:]]*:\\(\\S.\\|$\\)") 1 font-lock-constant-face) ;; Labels and compound literal fields - (,(concat (go--regexp-enclose-in-symbol "\\(goto\\|break\\|continue\\)") "[[:space:]]*\\(" go-label-regexp "\\)") 2 font-lock-constant-face)))) ;; labels in goto/break/continue - -(defvar go-mode-map - (let ((m (make-sparse-keymap))) - (define-key m "}" #'go-mode-insert-and-indent) - (define-key m ")" #'go-mode-insert-and-indent) - (define-key m "," #'go-mode-insert-and-indent) - (define-key m ":" #'go-mode-insert-and-indent) - (define-key m "=" #'go-mode-insert-and-indent) - (define-key m (kbd "C-c C-a") #'go-import-add) - (define-key m (kbd "C-c C-j") #'godef-jump) - (define-key m (kbd "C-x 4 C-c C-j") #'godef-jump-other-window) - (define-key m (kbd "C-c C-d") #'godef-describe) - m) - "Keymap used by Go mode to implement electric keys.") - -(defun go-mode-insert-and-indent (key) - "Invoke the global binding of KEY, then reindent the line." - - (interactive (list (this-command-keys))) - (call-interactively (lookup-key (current-global-map) key)) - (indent-according-to-mode)) - -(defmacro go-paren-level () - `(car (syntax-ppss))) - -(defmacro go-in-string-or-comment-p () - `(nth 8 (syntax-ppss))) - -(defmacro go-in-string-p () - `(nth 3 (syntax-ppss))) - -(defmacro go-in-comment-p () - `(nth 4 (syntax-ppss))) - -(defmacro go-goto-beginning-of-string-or-comment () - `(goto-char (nth 8 (syntax-ppss)))) - -(defun go--backward-irrelevant (&optional stop-at-string) - "Skips backwards over any characters that are irrelevant for -indentation and related tasks. - -It skips over whitespace, comments, cases and labels and, if -STOP-AT-STRING is not true, over strings." - - (let (pos (start-pos (point))) - (skip-chars-backward "\n\s\t") - (if (and (save-excursion (beginning-of-line) (go-in-string-p)) (looking-back "`") (not stop-at-string)) - (backward-char)) - (if (and (go-in-string-p) (not stop-at-string)) - (go-goto-beginning-of-string-or-comment)) - (if (looking-back "\\*/") - (backward-char)) - (if (go-in-comment-p) - (go-goto-beginning-of-string-or-comment)) - (setq pos (point)) - (beginning-of-line) - (if (or (looking-at (concat "^" go-label-regexp ":")) (looking-at "^[[:space:]]*\\(case .+\\|default\\):")) - (end-of-line 0) - (goto-char pos)) - (if (/= start-pos (point)) - (go--backward-irrelevant stop-at-string)) - (/= start-pos (point)))) - -(defun go--buffer-narrowed-p () - "Return non-nil if the current buffer is narrowed." - (/= (buffer-size) - (- (point-max) - (point-min)))) - -(defun go-previous-line-has-dangling-op-p () - "Returns non-nil if the current line is a continuation line." - (let* ((cur-line (line-number-at-pos)) - (val (gethash cur-line go-dangling-cache 'nope))) - (if (or (go--buffer-narrowed-p) (equal val 'nope)) - (save-excursion - (beginning-of-line) - (go--backward-irrelevant t) - (setq val (looking-back go-dangling-operators-regexp)) - (if (not (go--buffer-narrowed-p)) - (puthash cur-line val go-dangling-cache)))) - val)) - -(defun go--at-function-definition () - "Return non-nil if point is on the opening curly brace of a -function definition. - -We do this by first calling (beginning-of-defun), which will take -us to the start of *some* function. We then look for the opening -curly brace of that function and compare its position against the -curly brace we are checking. If they match, we return non-nil." - (if (= (char-after) ?\{) - (save-excursion - (let ((old-point (point)) - start-nesting) - (beginning-of-defun) - (when (looking-at "func ") - (setq start-nesting (go-paren-level)) - (skip-chars-forward "^{") - (while (> (go-paren-level) start-nesting) - (forward-char) - (skip-chars-forward "^{") 0) - (if (and (= (go-paren-level) start-nesting) (= old-point (point))) - t)))))) - -(defun go--indentation-for-opening-parenthesis () - "Return the semantic indentation for the current opening parenthesis. - -If point is on an opening curly brace and said curly brace -belongs to a function declaration, the indentation of the func -keyword will be returned. Otherwise the indentation of the -current line will be returned." - (save-excursion - (if (go--at-function-definition) - (progn - (beginning-of-defun) - (current-indentation)) - (current-indentation)))) - -(defun go-indentation-at-point () - (save-excursion - (let (start-nesting) - (back-to-indentation) - (setq start-nesting (go-paren-level)) - - (cond - ((go-in-string-p) - (current-indentation)) - ((looking-at "[])}]") - (go-goto-opening-parenthesis) - (if (go-previous-line-has-dangling-op-p) - (- (current-indentation) tab-width) - (go--indentation-for-opening-parenthesis))) - ((progn (go--backward-irrelevant t) (looking-back go-dangling-operators-regexp)) - ;; only one nesting for all dangling operators in one operation - (if (go-previous-line-has-dangling-op-p) - (current-indentation) - (+ (current-indentation) tab-width))) - ((zerop (go-paren-level)) - 0) - ((progn (go-goto-opening-parenthesis) (< (go-paren-level) start-nesting)) - (if (go-previous-line-has-dangling-op-p) - (current-indentation) - (+ (go--indentation-for-opening-parenthesis) tab-width))) - (t - (current-indentation)))))) - -(defun go-mode-indent-line () - (interactive) - (let (indent - shift-amt - (pos (- (point-max) (point))) - (point (point)) - (beg (line-beginning-position))) - (back-to-indentation) - (if (go-in-string-or-comment-p) - (goto-char point) - (setq indent (go-indentation-at-point)) - (if (looking-at (concat go-label-regexp ":\\([[:space:]]*/.+\\)?$\\|case .+:\\|default:")) - (decf indent tab-width)) - (setq shift-amt (- indent (current-column))) - (if (zerop shift-amt) - nil - (delete-region beg (point)) - (indent-to indent)) - ;; If initial point was within line's indentation, - ;; position after the indentation. Else stay at same point in text. - (if (> (- (point-max) pos) (point)) - (goto-char (- (point-max) pos)))))) - -(defun go-beginning-of-defun (&optional count) - (setq count (or count 1)) - (let ((first t) - failure) - (dotimes (i (abs count)) - (while (and (not failure) - (or first (go-in-string-or-comment-p))) - (if (>= count 0) - (progn - (go--backward-irrelevant) - (if (not (re-search-backward go-func-meth-regexp nil t)) - (setq failure t))) - (if (looking-at go-func-meth-regexp) - (forward-char)) - (if (not (re-search-forward go-func-meth-regexp nil t)) - (setq failure t))) - (setq first nil))) - (if (< count 0) - (beginning-of-line)) - (not failure))) - -(defun go-end-of-defun () - (let (orig-level) - ;; It can happen that we're not placed before a function by emacs - (if (not (looking-at "func")) - (go-beginning-of-defun -1)) - (skip-chars-forward "^{") - (forward-char) - (setq orig-level (go-paren-level)) - (while (>= (go-paren-level) orig-level) - (skip-chars-forward "^}") - (forward-char)))) - -;;;###autoload -(define-derived-mode go-mode prog-mode "Go" - "Major mode for editing Go source text. - -This mode provides (not just) basic editing capabilities for -working with Go code. It offers almost complete syntax -highlighting, indentation that is almost identical to gofmt and -proper parsing of the buffer content to allow features such as -navigation by function, manipulation of comments or detection of -strings. - -In addition to these core features, it offers various features to -help with writing Go code. You can directly run buffer content -through gofmt, read godoc documentation from within Emacs, modify -and clean up the list of package imports or interact with the -Playground (uploading and downloading pastes). - -The following extra functions are defined: - -- `gofmt' -- `godoc' -- `go-import-add' -- `go-remove-unused-imports' -- `go-goto-imports' -- `go-play-buffer' and `go-play-region' -- `go-download-play' -- `godef-describe' and `godef-jump' -- `go-coverage' - -If you want to automatically run `gofmt' before saving a file, -add the following hook to your emacs configuration: - -\(add-hook 'before-save-hook #'gofmt-before-save) - -If you want to use `godef-jump' instead of etags (or similar), -consider binding godef-jump to `M-.', which is the default key -for `find-tag': - -\(add-hook 'go-mode-hook (lambda () - (local-set-key (kbd \"M-.\") #'godef-jump))) - -Please note that godef is an external dependency. You can install -it with - -go get code.google.com/p/rog-go/exp/cmd/godef - - -If you're looking for even more integration with Go, namely -on-the-fly syntax checking, auto-completion and snippets, it is -recommended that you look at goflymake -\(https://github.com/dougm/goflymake), gocode -\(https://github.com/nsf/gocode), go-eldoc -\(github.com/syohex/emacs-go-eldoc) and yasnippet-go -\(https://github.com/dominikh/yasnippet-go)" - - ;; Font lock - (set (make-local-variable 'font-lock-defaults) - '(go--build-font-lock-keywords)) - - ;; Indentation - (set (make-local-variable 'indent-line-function) #'go-mode-indent-line) - - ;; Comments - (set (make-local-variable 'comment-start) "// ") - (set (make-local-variable 'comment-end) "") - (set (make-local-variable 'comment-use-syntax) t) - (set (make-local-variable 'comment-start-skip) "\\(//+\\|/\\*+\\)\\s *") - - (set (make-local-variable 'beginning-of-defun-function) #'go-beginning-of-defun) - (set (make-local-variable 'end-of-defun-function) #'go-end-of-defun) - - (set (make-local-variable 'parse-sexp-lookup-properties) t) - (if (boundp 'syntax-propertize-function) - (set (make-local-variable 'syntax-propertize-function) #'go-propertize-syntax)) - - (set (make-local-variable 'go-dangling-cache) (make-hash-table :test 'eql)) - (add-hook 'before-change-functions (lambda (x y) (setq go-dangling-cache (make-hash-table :test 'eql))) t t) - - - (setq imenu-generic-expression - '(("type" "^type *\\([^ \t\n\r\f]*\\)" 1) - ("func" "^func *\\(.*\\) {" 1))) - (imenu-add-to-menubar "Index") - - ;; Go style - (setq indent-tabs-mode t) - - ;; Handle unit test failure output in compilation-mode - ;; - ;; Note the final t argument to add-to-list for append, ie put these at the - ;; *ends* of compilation-error-regexp-alist[-alist]. We want go-test to be - ;; handled first, otherwise other elements will match that don't work, and - ;; those alists are traversed in *reverse* order: - ;; http://lists.gnu.org/archive/html/bug-gnu-emacs/2001-12/msg00674.html - (when (and (boundp 'compilation-error-regexp-alist) - (boundp 'compilation-error-regexp-alist-alist)) - (add-to-list 'compilation-error-regexp-alist 'go-test t) - (add-to-list 'compilation-error-regexp-alist-alist - '(go-test . ("^\t+\\([^()\t\n]+\\):\\([0-9]+\\):? .*$" 1 2)) t))) - -;;;###autoload -(add-to-list 'auto-mode-alist (cons "\\.go\\'" 'go-mode)) - -(defun go--apply-rcs-patch (patch-buffer) - "Apply an RCS-formatted diff from PATCH-BUFFER to the current -buffer." - (let ((target-buffer (current-buffer)) - ;; Relative offset between buffer line numbers and line numbers - ;; in patch. - ;; - ;; Line numbers in the patch are based on the source file, so - ;; we have to keep an offset when making changes to the - ;; buffer. - ;; - ;; Appending lines decrements the offset (possibly making it - ;; negative), deleting lines increments it. This order - ;; simplifies the forward-line invocations. - (line-offset 0)) - (save-excursion - (with-current-buffer patch-buffer - (goto-char (point-min)) - (while (not (eobp)) - (unless (looking-at "^\\([ad]\\)\\([0-9]+\\) \\([0-9]+\\)") - (error "invalid rcs patch or internal error in go--apply-rcs-patch")) - (forward-line) - (let ((action (match-string 1)) - (from (string-to-number (match-string 2))) - (len (string-to-number (match-string 3)))) - (cond - ((equal action "a") - (let ((start (point))) - (forward-line len) - (let ((text (buffer-substring start (point)))) - (with-current-buffer target-buffer - (decf line-offset len) - (goto-char (point-min)) - (forward-line (- from len line-offset)) - (insert text))))) - ((equal action "d") - (with-current-buffer target-buffer - (go--goto-line (- from line-offset)) - (incf line-offset len) - (go--delete-whole-line len))) - (t - (error "invalid rcs patch or internal error in go--apply-rcs-patch"))))))))) - -(defun gofmt () - "Formats the current buffer according to the gofmt tool." - - (interactive) - (let ((tmpfile (make-temp-file "gofmt" nil ".go")) - (patchbuf (get-buffer-create "*Gofmt patch*")) - (errbuf (get-buffer-create "*Gofmt Errors*")) - (coding-system-for-read 'utf-8) - (coding-system-for-write 'utf-8)) - - (with-current-buffer errbuf - (setq buffer-read-only nil) - (erase-buffer)) - (with-current-buffer patchbuf - (erase-buffer)) - - (write-region nil nil tmpfile) - - ;; We're using errbuf for the mixed stdout and stderr output. This - ;; is not an issue because gofmt -w does not produce any stdout - ;; output in case of success. - (if (zerop (call-process gofmt-command nil errbuf nil "-w" tmpfile)) - (if (zerop (call-process-region (point-min) (point-max) "diff" nil patchbuf nil "-n" "-" tmpfile)) - (progn - (kill-buffer errbuf) - (message "Buffer is already gofmted")) - (go--apply-rcs-patch patchbuf) - (kill-buffer errbuf) - (message "Applied gofmt")) - (message "Could not apply gofmt. Check errors for details") - (gofmt--process-errors (buffer-file-name) tmpfile errbuf)) - - (kill-buffer patchbuf) - (delete-file tmpfile))) - - -(defun gofmt--process-errors (filename tmpfile errbuf) - ;; Convert the gofmt stderr to something understood by the compilation mode. - (with-current-buffer errbuf - (goto-char (point-min)) - (insert "gofmt errors:\n") - (while (search-forward-regexp (concat "^\\(" (regexp-quote tmpfile) "\\):") nil t) - (replace-match (file-name-nondirectory filename) t t nil 1)) - (compilation-mode) - (display-buffer errbuf))) - -;;;###autoload -(defun gofmt-before-save () - "Add this to .emacs to run gofmt on the current buffer when saving: - (add-hook 'before-save-hook 'gofmt-before-save). - -Note that this will cause go-mode to get loaded the first time -you save any file, kind of defeating the point of autoloading." - - (interactive) - (when (eq major-mode 'go-mode) (gofmt))) - -(defun godoc--read-query () - "Read a godoc query from the minibuffer." - ;; Compute the default query as the symbol under the cursor. - ;; TODO: This does the wrong thing for e.g. multipart.NewReader (it only grabs - ;; half) but I see no way to disambiguate that from e.g. foobar.SomeMethod. - (let* ((bounds (bounds-of-thing-at-point 'symbol)) - (symbol (if bounds - (buffer-substring-no-properties (car bounds) - (cdr bounds))))) - (completing-read (if symbol - (format "godoc (default %s): " symbol) - "godoc: ") - (go--old-completion-list-style (go-packages)) nil nil nil 'go-godoc-history symbol))) - -(defun godoc--get-buffer (query) - "Get an empty buffer for a godoc query." - (let* ((buffer-name (concat "*godoc " query "*")) - (buffer (get-buffer buffer-name))) - ;; Kill the existing buffer if it already exists. - (when buffer (kill-buffer buffer)) - (get-buffer-create buffer-name))) - -(defun godoc--buffer-sentinel (proc event) - "Sentinel function run when godoc command completes." - (with-current-buffer (process-buffer proc) - (cond ((string= event "finished\n") ;; Successful exit. - (goto-char (point-min)) - (view-mode 1) - (display-buffer (current-buffer) t)) - ((/= (process-exit-status proc) 0) ;; Error exit. - (let ((output (buffer-string))) - (kill-buffer (current-buffer)) - (message (concat "godoc: " output))))))) - -;;;###autoload -(defun godoc (query) - "Show go documentation for a query, much like M-x man." - (interactive (list (godoc--read-query))) - (unless (string= query "") - (set-process-sentinel - (start-process-shell-command "godoc" (godoc--get-buffer query) - (concat "godoc " query)) - 'godoc--buffer-sentinel) - nil)) - -(defun go-goto-imports () - "Move point to the block of imports. - -If using - - import ( - \"foo\" - \"bar\" - ) - -it will move point directly behind the last import. - -If using - - import \"foo\" - import \"bar\" - -it will move point to the next line after the last import. - -If no imports can be found, point will be moved after the package -declaration." - (interactive) - ;; FIXME if there's a block-commented import before the real - ;; imports, we'll jump to that one. - - ;; Generally, this function isn't very forgiving. it'll bark on - ;; extra whitespace. It works well for clean code. - (let ((old-point (point))) - (goto-char (point-min)) - (cond - ((re-search-forward "^import ()" nil t) - (backward-char 1) - 'block-empty) - ((re-search-forward "^import ([^)]+)" nil t) - (backward-char 2) - 'block) - ((re-search-forward "\\(^import \\([^\"]+ \\)?\"[^\"]+\"\n?\\)+" nil t) - 'single) - ((re-search-forward "^[[:space:]\n]*package .+?\n" nil t) - (message "No imports found, moving point after package declaration") - 'none) - (t - (goto-char old-point) - (message "No imports or package declaration found. Is this really a Go file?") - 'fail)))) - -(defun go-play-buffer () - "Like `go-play-region', but acts on the entire buffer." - (interactive) - (go-play-region (point-min) (point-max))) - -(defun go-play-region (start end) - "Send the region to the Playground and stores the resulting -link in the kill ring." - (interactive "r") - (let* ((url-request-method "POST") - (url-request-extra-headers - '(("Content-Type" . "application/x-www-form-urlencoded"))) - (url-request-data - (encode-coding-string - (buffer-substring-no-properties start end) - 'utf-8)) - (content-buf (url-retrieve - "http://play.golang.org/share" - (lambda (arg) - (cond - ((equal :error (car arg)) - (signal 'go-play-error (cdr arg))) - (t - (re-search-forward "\n\n") - (kill-new (format "http://play.golang.org/p/%s" (buffer-substring (point) (point-max)))) - (message "http://play.golang.org/p/%s" (buffer-substring (point) (point-max))))))))))) - -;;;###autoload -(defun go-download-play (url) - "Downloads a paste from the playground and inserts it in a Go -buffer. Tries to look for a URL at point." - (interactive (list (read-from-minibuffer "Playground URL: " (ffap-url-p (ffap-string-at-point 'url))))) - (with-current-buffer - (let ((url-request-method "GET") url-request-data url-request-extra-headers) - (url-retrieve-synchronously (concat url ".go"))) - (let ((buffer (generate-new-buffer (concat (car (last (split-string url "/"))) ".go")))) - (goto-char (point-min)) - (re-search-forward "\n\n") - (copy-to-buffer buffer (point) (point-max)) - (kill-buffer) - (with-current-buffer buffer - (go-mode) - (switch-to-buffer buffer))))) - -(defun go-propertize-syntax (start end) - (save-excursion - (goto-char start) - (while (search-forward "\\" end t) - (put-text-property (1- (point)) (point) 'syntax-table (if (= (char-after) ?`) '(1) '(9)))))) - -(defun go-import-add (arg import) - "Add a new import to the list of imports. - -When called with a prefix argument asks for an alternative name -to import the package as. - -If no list exists yet, one will be created if possible. - -If an identical import has been commented, it will be -uncommented, otherwise a new import will be added." - - ;; - If there's a matching `// import "foo"`, uncomment it - ;; - If we're in an import() block and there's a matching `"foo"`, uncomment it - ;; - Otherwise add a new import, with the appropriate syntax - (interactive - (list - current-prefix-arg - (replace-regexp-in-string "^[\"']\\|[\"']$" "" (completing-read "Package: " (go--old-completion-list-style (go-packages)))))) - (save-excursion - (let (as line import-start) - (if arg - (setq as (read-from-minibuffer "Import as: "))) - (if as - (setq line (format "%s \"%s\"" as import)) - (setq line (format "\"%s\"" import))) - - (goto-char (point-min)) - (if (re-search-forward (concat "^[[:space:]]*//[[:space:]]*import " line "$") nil t) - (uncomment-region (line-beginning-position) (line-end-position)) - (case (go-goto-imports) - ('fail (message "Could not find a place to add import.")) - ('block-empty - (insert "\n\t" line "\n")) - ('block - (save-excursion - (re-search-backward "^import (") - (setq import-start (point))) - (if (re-search-backward (concat "^[[:space:]]*//[[:space:]]*" line "$") import-start t) - (uncomment-region (line-beginning-position) (line-end-position)) - (insert "\n\t" line))) - ('single (insert "import " line "\n")) - ('none (insert "\nimport (\n\t" line "\n)\n"))))))) - -(defun go-root-and-paths () - (let* ((output (split-string (shell-command-to-string (concat go-command " env GOROOT GOPATH")) - "\n")) - (root (car output)) - (paths (split-string (cadr output) ":"))) - (append (list root) paths))) - -(defun go--string-prefix-p (s1 s2 &optional ignore-case) - "Return non-nil if S1 is a prefix of S2. -If IGNORE-CASE is non-nil, the comparison is case-insensitive." - (eq t (compare-strings s1 nil nil - s2 0 (length s1) ignore-case))) - -(defun go--directory-dirs (dir) - "Recursively return all subdirectories in DIR." - (if (file-directory-p dir) - (let ((dir (directory-file-name dir)) - (dirs '()) - (files (directory-files dir nil nil t))) - (dolist (file files) - (unless (member file '("." "..")) - (let ((file (concat dir "/" file))) - (if (file-directory-p file) - (setq dirs (append (cons file - (go--directory-dirs file)) - dirs)))))) - dirs) - '())) - - -(defun go-packages () - (sort - (delete-dups - (mapcan - (lambda (topdir) - (let ((pkgdir (concat topdir "/pkg/"))) - (mapcan (lambda (dir) - (mapcar (lambda (file) - (let ((sub (substring file (length pkgdir) -2))) - (unless (or (go--string-prefix-p "obj/" sub) (go--string-prefix-p "tool/" sub)) - (mapconcat #'identity (cdr (split-string sub "/")) "/")))) - (if (file-directory-p dir) - (directory-files dir t "\\.a$")))) - (if (file-directory-p pkgdir) - (go--directory-dirs pkgdir))))) - (go-root-and-paths))) - #'string<)) - -(defun go-unused-imports-lines () - ;; FIXME Technically, -o /dev/null fails in quite some cases (on - ;; Windows, when compiling from within GOPATH). Practically, - ;; however, it has the same end result: There won't be a - ;; compiled binary/archive, and we'll get our import errors when - ;; there are any. - (reverse (remove nil - (mapcar - (lambda (line) - (if (string-match "^\\(.+\\):\\([[:digit:]]+\\): imported and not used: \".+\".*$" line) - (if (string= (file-truename (match-string 1 line)) (file-truename buffer-file-name)) - (string-to-number (match-string 2 line))))) - (split-string (shell-command-to-string - (concat go-command - (if (string-match "_test\.go$" buffer-file-truename) - " test -c" - " build -o /dev/null"))) "\n"))))) - -(defun go-remove-unused-imports (arg) - "Removes all unused imports. If ARG is non-nil, unused imports -will be commented, otherwise they will be removed completely." - (interactive "P") - (save-excursion - (let ((cur-buffer (current-buffer)) flymake-state lines) - (when (boundp 'flymake-mode) - (setq flymake-state flymake-mode) - (flymake-mode-off)) - (save-some-buffers nil (lambda () (equal cur-buffer (current-buffer)))) - (if (buffer-modified-p) - (message "Cannot operate on unsaved buffer") - (setq lines (go-unused-imports-lines)) - (dolist (import lines) - (go--goto-line import) - (beginning-of-line) - (if arg - (comment-region (line-beginning-position) (line-end-position)) - (go--delete-whole-line))) - (message "Removed %d imports" (length lines))) - (if flymake-state (flymake-mode-on))))) - -(defun godef--find-file-line-column (specifier other-window) - "Given a file name in the format of `filename:line:column', -visit FILENAME and go to line LINE and column COLUMN." - (if (not (string-match "\\(.+\\):\\([0-9]+\\):\\([0-9]+\\)" specifier)) - ;; We've only been given a directory name - (funcall (if other-window #'find-file-other-window #'find-file) specifier) - (let ((filename (match-string 1 specifier)) - (line (string-to-number (match-string 2 specifier))) - (column (string-to-number (match-string 3 specifier)))) - (with-current-buffer (funcall (if other-window #'find-file-other-window #'find-file) filename) - (go--goto-line line) - (beginning-of-line) - (forward-char (1- column)) - (if (buffer-modified-p) - (message "Buffer is modified, file position might not have been correct")))))) - -(defun godef--call (point) - "Call godef, acquiring definition position and expression -description at POINT." - (if (go--xemacs-p) - (error "godef does not reliably work in XEmacs, expect bad results")) - (if (not (buffer-file-name (go--coverage-origin-buffer))) - (error "Cannot use godef on a buffer without a file name") - (let ((outbuf (get-buffer-create "*godef*"))) - (with-current-buffer outbuf - (erase-buffer)) - (call-process-region (point-min) - (point-max) - "godef" - nil - outbuf - nil - "-i" - "-t" - "-f" - (file-truename (buffer-file-name (go--coverage-origin-buffer))) - "-o" - (number-to-string (go--position-bytes (point)))) - (with-current-buffer outbuf - (split-string (buffer-substring-no-properties (point-min) (point-max)) "\n"))))) - -(defun godef-describe (point) - "Describe the expression at POINT." - (interactive "d") - (condition-case nil - (let ((description (cdr (butlast (godef--call point) 1)))) - (if (not description) - (message "No description found for expression at point") - (message "%s" (mapconcat #'identity description "\n")))) - (file-error (message "Could not run godef binary")))) - -(defun godef-jump (point &optional other-window) - "Jump to the definition of the expression at POINT." - (interactive "d") - (condition-case nil - (let ((file (car (godef--call point)))) - (cond - ((string= "-" file) - (message "godef: expression is not defined anywhere")) - ((string= "godef: no identifier found" file) - (message "%s" file)) - ((go--string-prefix-p "godef: no declaration found for " file) - (message "%s" file)) - ((go--string-prefix-p "error finding import path for " file) - (message "%s" file)) - (t - (push-mark) - (ring-insert find-tag-marker-ring (point-marker)) - (godef--find-file-line-column file other-window)))) - (file-error (message "Could not run godef binary")))) - -(defun godef-jump-other-window (point) - (interactive "d") - (godef-jump point t)) - -(defun go--goto-line (line) - (goto-char (point-min)) - (forward-line (1- line))) - -(defun go--line-column-to-point (line column) - (save-excursion - (go--goto-line line) - (forward-char (1- column)) - (point))) - -(defstruct go--covered - start-line start-column end-line end-column covered count) - -(defun go--coverage-file () - "Return the coverage file to use, either by reading it from the -current coverage buffer or by prompting for it." - (if (boundp 'go--coverage-current-file-name) - go--coverage-current-file-name - (read-file-name "Coverage file: " nil nil t))) - -(defun go--coverage-origin-buffer () - "Return the buffer to base the coverage on." - (or (buffer-base-buffer) (current-buffer))) - -(defun go--coverage-face (count divisor) - "Return the intensity face for COUNT when using DIVISOR -to scale it to a range [0,10]. - -DIVISOR scales the absolute cover count to values from 0 to 10. -For DIVISOR = 0 the count will always translate to 8." - (let* ((norm (cond - ((= count 0) - -0.1) ;; Uncovered code, set to -0.1 so n becomes 0. - ((= divisor 0) - 0.8) ;; covermode=set, set to 0.8 so n becomes 8. - (t - (/ (log count) divisor)))) - (n (1+ (floor (* norm 9))))) ;; Convert normalized count [0,1] to intensity [0,10] - (concat "go-coverage-" (number-to-string n)))) - -(defun go--coverage-make-overlay (range divisor) - "Create a coverage overlay for a RANGE of covered/uncovered -code. Uses DIVISOR to scale absolute counts to a [0,10] scale." - (let* ((count (go--covered-count range)) - (face (go--coverage-face count divisor)) - (ov (make-overlay (go--line-column-to-point (go--covered-start-line range) - (go--covered-start-column range)) - (go--line-column-to-point (go--covered-end-line range) - (go--covered-end-column range))))) - - (overlay-put ov 'face face) - (overlay-put ov 'help-echo (format "Count: %d" count)))) - -(defun go--coverage-clear-overlays () - "Remove existing overlays and put a single untracked overlay -over the entire buffer." - (remove-overlays) - (overlay-put (make-overlay (point-min) (point-max)) - 'face - 'go-coverage-untracked)) - -(defun go--coverage-parse-file (coverage-file file-name) - "Parse COVERAGE-FILE and extract coverage information and -divisor for FILE-NAME." - (let (ranges - (max-count 0)) - (with-temp-buffer - (insert-file-contents coverage-file) - (go--goto-line 2) ;; Skip over mode - (while (not (eobp)) - (let* ((parts (split-string (buffer-substring (point-at-bol) (point-at-eol)) ":")) - (file (car parts)) - (rest (split-string (nth 1 parts) "[., ]"))) - - (destructuring-bind - (start-line start-column end-line end-column num count) - (mapcar #'string-to-number rest) - - (when (string= (file-name-nondirectory file) file-name) - (if (> count max-count) - (setq max-count count)) - (push (make-go--covered :start-line start-line - :start-column start-column - :end-line end-line - :end-column end-column - :covered (/= count 0) - :count count) - ranges))) - - (forward-line))) - - (list ranges (if (> max-count 0) (log max-count) 0))))) - -(defun go-coverage (&optional coverage-file) - "Open a clone of the current buffer and overlay it with -coverage information gathered via go test -coverprofile=COVERAGE-FILE. - -If COVERAGE-FILE is nil, it will either be inferred from the -current buffer if it's already a coverage buffer, or be prompted -for." - (interactive) - (let* ((cur-buffer (current-buffer)) - (origin-buffer (go--coverage-origin-buffer)) - (gocov-buffer-name (concat (buffer-name origin-buffer) "")) - (coverage-file (or coverage-file (go--coverage-file))) - (ranges-and-divisor (go--coverage-parse-file - coverage-file - (file-name-nondirectory (buffer-file-name origin-buffer)))) - (cov-mtime (nth 5 (file-attributes coverage-file))) - (cur-mtime (nth 5 (file-attributes (buffer-file-name origin-buffer))))) - - (if (< (float-time cov-mtime) (float-time cur-mtime)) - (message "Coverage file is older than the source file.")) - - (with-current-buffer (or (get-buffer gocov-buffer-name) - (make-indirect-buffer origin-buffer gocov-buffer-name t)) - (set (make-local-variable 'go--coverage-current-file-name) coverage-file) - - (save-excursion - (go--coverage-clear-overlays) - (dolist (range (car ranges-and-divisor)) - (go--coverage-make-overlay range (cadr ranges-and-divisor)))) - - (if (not (eq cur-buffer (current-buffer))) - (display-buffer (current-buffer) #'display-buffer-reuse-window))))) - -(provide 'go-mode) - -;;; go-mode.el ends here diff --git a/elpa/go-mode-20131222/go-mode-autoloads.el b/elpa/go-mode-20160404.2/go-mode-autoloads.el similarity index 70% rename from elpa/go-mode-20131222/go-mode-autoloads.el rename to elpa/go-mode-20160404.2/go-mode-autoloads.el index 36f5296..f335b4d 100644 --- a/elpa/go-mode-20131222/go-mode-autoloads.el +++ b/elpa/go-mode-20160404.2/go-mode-autoloads.el @@ -1,9 +1,10 @@ ;;; go-mode-autoloads.el --- automatically extracted autoloads ;; ;;; Code: -(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) + -;;;### (autoloads nil "go-mode" "go-mode.el" (21633 45694 92043 840000)) +;;;### (autoloads nil "go-mode" "go-mode.el" (22297 19826 179922 +;;;;;; 64000)) ;;; Generated autoloads from go-mode.el (autoload 'go-mode "go-mode" "\ @@ -25,14 +26,22 @@ Playground (uploading and downloading pastes). The following extra functions are defined: - `gofmt' -- `godoc' +- `godoc' and `godoc-at-point' - `go-import-add' - `go-remove-unused-imports' +- `go-goto-arguments' +- `go-goto-docstring' +- `go-goto-function' +- `go-goto-function-name' - `go-goto-imports' +- `go-goto-return-values' +- `go-goto-method-receiver' - `go-play-buffer' and `go-play-region' - `go-download-play' - `godef-describe' and `godef-jump' - `go-coverage' +- `go-set-project' +- `go-reset-gopath' If you want to automatically run `gofmt' before saving a file, add the following hook to your emacs configuration: @@ -49,16 +58,17 @@ for `find-tag': Please note that godef is an external dependency. You can install it with -go get code.google.com/p/rog-go/exp/cmd/godef +go get github.com/rogpeppe/godef If you're looking for even more integration with Go, namely on-the-fly syntax checking, auto-completion and snippets, it is -recommended that you look at goflymake -\(https://github.com/dougm/goflymake), gocode -\(https://github.com/nsf/gocode), go-eldoc -\(github.com/syohex/emacs-go-eldoc) and yasnippet-go -\(https://github.com/dominikh/yasnippet-go) +recommended that you look at flycheck +\(see URL `https://github.com/flycheck/flycheck') or flymake in combination +with goflymake (see URL `https://github.com/dougm/goflymake'), gocode +\(see URL `https://github.com/nsf/gocode'), go-eldoc +\(see URL `github.com/syohex/emacs-go-eldoc') and yasnippet-go +\(see URL `https://github.com/dominikh/yasnippet-go') \(fn)" t nil) @@ -74,21 +84,28 @@ you save any file, kind of defeating the point of autoloading. \(fn)" t nil) (autoload 'godoc "go-mode" "\ -Show go documentation for a query, much like M-x man. +Show Go documentation for QUERY, much like M-x man. \(fn QUERY)" t nil) (autoload 'go-download-play "go-mode" "\ -Downloads a paste from the playground and inserts it in a Go -buffer. Tries to look for a URL at point. +Download a paste from the playground and insert it in a Go buffer. +Tries to look for a URL at point. \(fn URL)" t nil) ;;;*** +;;;### (autoloads nil nil ("go-mode-pkg.el") (22297 19826 479482 +;;;;;; 139000)) + +;;;*** + +(provide 'go-mode-autoloads) ;; Local Variables: ;; version-control: never ;; no-byte-compile: t ;; no-update-autoloads: t +;; coding: utf-8 ;; End: ;;; go-mode-autoloads.el ends here diff --git a/elpa/go-mode-20160404.2/go-mode-pkg.el b/elpa/go-mode-20160404.2/go-mode-pkg.el new file mode 100644 index 0000000..bf2e100 --- /dev/null +++ b/elpa/go-mode-20160404.2/go-mode-pkg.el @@ -0,0 +1,5 @@ +(define-package "go-mode" "20160404.2" "Major mode for the Go programming language" 'nil :url "https://github.com/dominikh/go-mode.el" :keywords + '("languages" "go")) +;; Local Variables: +;; no-byte-compile: t +;; End: diff --git a/elpa/go-mode-20160404.2/go-mode.el b/elpa/go-mode-20160404.2/go-mode.el new file mode 100644 index 0000000..eccb74e --- /dev/null +++ b/elpa/go-mode-20160404.2/go-mode.el @@ -0,0 +1,2069 @@ +;;; go-mode.el --- Major mode for the Go programming language + +;; Copyright 2013 The go-mode Authors. All rights reserved. +;; Use of this source code is governed by a BSD-style +;; license that can be found in the LICENSE file. + +;; Author: The go-mode Authors +;; Version: 1.3.1 +;; Keywords: languages go +;; URL: https://github.com/dominikh/go-mode.el +;; +;; This file is not part of GNU Emacs. + +;;; Code: + +(require 'cl-lib) +(require 'compile) +(require 'etags) +(require 'ffap) +(require 'find-file) +(require 'ring) +(require 'url) + +;; XEmacs compatibility guidelines +;; - Minimum required version of XEmacs: 21.5.32 +;; - Feature that cannot be backported: POSIX character classes in +;; regular expressions +;; - Functions that could be backported but won't because 21.5.32 +;; covers them: plenty. +;; - Features that are still partly broken: +;; - godef will not work correctly if multibyte characters are +;; being used +;; - Fontification will not handle unicode correctly +;; +;; - Do not use \_< and \_> regexp delimiters directly; use +;; go--regexp-enclose-in-symbol +;; +;; - The character `_` must not be a symbol constituent but a +;; character constituent +;; +;; - Do not use process-lines +;; +;; - Use go--old-completion-list-style when using a plain list as the +;; collection for completing-read +;; +;; - Use go--position-bytes instead of position-bytes +(defmacro go--xemacs-p () + (featurep 'xemacs)) + +(defmacro go--has-syntax-propertize-p () + (boundp 'syntax-propertize-function)) + +(defun go--delete-whole-line (&optional arg) + "Delete the current line without putting it in the `kill-ring'. +Derived from function `kill-whole-line'. ARG is defined as for that +function." + (setq arg (or arg 1)) + (if (and (> arg 0) + (eobp) + (save-excursion (forward-visible-line 0) (eobp))) + (signal 'end-of-buffer nil)) + (if (and (< arg 0) + (bobp) + (save-excursion (end-of-visible-line) (bobp))) + (signal 'beginning-of-buffer nil)) + (cond ((zerop arg) + (delete-region (progn (forward-visible-line 0) (point)) + (progn (end-of-visible-line) (point)))) + ((< arg 0) + (delete-region (progn (end-of-visible-line) (point)) + (progn (forward-visible-line (1+ arg)) + (unless (bobp) + (backward-char)) + (point)))) + (t + (delete-region (progn (forward-visible-line 0) (point)) + (progn (forward-visible-line arg) (point)))))) + +;; declare-function is an empty macro that only byte-compile cares +;; about. Wrap in always false if to satisfy Emacsen without that +;; macro. +(if nil + (declare-function go--position-bytes "go-mode" (point))) + +;; XEmacs unfortunately does not offer position-bytes. We can fall +;; back to just using (point), but it will be incorrect as soon as +;; multibyte characters are being used. +(if (fboundp 'position-bytes) + (defalias 'go--position-bytes #'position-bytes) + (defun go--position-bytes (point) point)) + +(defun go--old-completion-list-style (list) + (mapcar (lambda (x) (cons x nil)) list)) + +;; GNU Emacs 24 has prog-mode, older GNU Emacs and XEmacs do not, so +;; copy its definition for those. +(if (not (fboundp 'prog-mode)) + (define-derived-mode prog-mode fundamental-mode "Prog" + "Major mode for editing source code." + (set (make-local-variable 'require-final-newline) mode-require-final-newline) + (set (make-local-variable 'parse-sexp-ignore-comments) t) + (setq bidi-paragraph-direction 'left-to-right))) + +(defun go--regexp-enclose-in-symbol (s) + "Enclose S as regexp symbol. +XEmacs does not support \\_<, GNU Emacs does. In GNU Emacs we +make extensive use of \\_< to support unicode in identifiers. +Until we come up with a better solution for XEmacs, this solution +will break fontification in XEmacs for identifiers such as +\"typeµ\". XEmacs will consider \"type\" a keyword, GNU Emacs +won't." + (if (go--xemacs-p) + (concat "\\<" s "\\>") + (concat "\\_<" s "\\_>"))) + +(defun go-goto-opening-parenthesis (&optional _legacy-unused) + "Move up one level of parentheses." + ;; The old implementation of go-goto-opening-parenthesis had an + ;; optional argument to speed up the function. It didn't change the + ;; function's outcome. + + ;; Silently fail if there's no matching opening parenthesis. + (condition-case nil + (backward-up-list) + (scan-error nil))) + + +(defconst go-dangling-operators-regexp "[^-]-\\|[^+]\\+\\|[/*&><.=|^]") +(defconst go-identifier-regexp "[[:word:][:multibyte:]]+") +(defconst go-type-name-no-prefix-regexp "\\(?:[[:word:][:multibyte:]]+\\.\\)?[[:word:][:multibyte:]]+") +(defconst go-qualified-identifier-regexp (concat go-identifier-regexp "\\." go-identifier-regexp)) +(defconst go-label-regexp go-identifier-regexp) +(defconst go-type-regexp "[[:word:][:multibyte:]*]+") +(defconst go-func-regexp (concat (go--regexp-enclose-in-symbol "func") "\\s *\\(" go-identifier-regexp "\\)")) +(defconst go-func-meth-regexp (concat + (go--regexp-enclose-in-symbol "func") "\\s *\\(?:(\\s *" + "\\(" go-identifier-regexp "\\s +\\)?" go-type-regexp + "\\s *)\\s *\\)?\\(" + go-identifier-regexp + "\\)(")) + +(defconst go-builtins + '("append" "cap" "close" "complex" "copy" + "delete" "imag" "len" "make" "new" + "panic" "print" "println" "real" "recover") + "All built-in functions in the Go language. Used for font locking.") + +(defconst go-mode-keywords + '("break" "default" "func" "interface" "select" + "case" "defer" "go" "map" "struct" + "chan" "else" "goto" "package" "switch" + "const" "fallthrough" "if" "range" "type" + "continue" "for" "import" "return" "var") + "All keywords in the Go language. Used for font locking.") + +(defconst go-constants '("nil" "true" "false" "iota")) +(defconst go-type-name-regexp (concat "\\(?:[*(]\\)*\\(\\(?:" go-identifier-regexp "\\.\\)?" go-identifier-regexp "\\)")) + +;; Maximum number of identifiers that can be highlighted as type names +;; in one function type/declaration. +(defconst go--font-lock-func-param-num-groups 16) + +(defvar go-dangling-cache) +(defvar go-godoc-history nil) +(defvar go--coverage-current-file-name) + +(defgroup go nil + "Major mode for editing Go code." + :link '(url-link "https://github.com/dominikh/go-mode.el") + :group 'languages) + +(defgroup go-cover nil + "Options specific to `cover`." + :group 'go) + +(defgroup godoc nil + "Options specific to `godoc'." + :group 'go) + +(defcustom go-fontify-function-calls t + "Fontify function and method calls if this is non-nil." + :type 'boolean + :group 'go) + +(defcustom go-mode-hook nil + "Hook called by `go-mode'." + :type 'hook + :group 'go) + +(defcustom go-command "go" + "The 'go' command. +Some users have multiple Go development trees and invoke the 'go' +tool via a wrapper that sets GOROOT and GOPATH based on the +current directory. Such users should customize this variable to +point to the wrapper script." + :type 'string + :group 'go) + +(defcustom gofmt-command "gofmt" + "The 'gofmt' command. +Some users may replace this with 'goimports' +from https://github.com/bradfitz/goimports." + :type 'string + :group 'go) + +(defcustom gofmt-args nil + "Additional arguments to pass to gofmt." + :type '(repeat string) + :group 'go) + +(defcustom gofmt-show-errors 'buffer + "Where to display gofmt error output. +It can either be displayed in its own buffer, in the echo area, or not at all. + +Please note that Emacs outputs to the echo area when writing +files and will overwrite gofmt's echo output if used from inside +a `before-save-hook'." + :type '(choice + (const :tag "Own buffer" buffer) + (const :tag "Echo area" echo) + (const :tag "None" nil)) + :group 'go) + +(defcustom godef-command "godef" + "The 'godef' command." + :type 'string + :group 'go) + +(defcustom go-other-file-alist + '(("_test\\.go\\'" (".go")) + ("\\.go\\'" ("_test.go"))) + "See the documentation of `ff-other-file-alist' for details." + :type '(repeat (list regexp (choice (repeat string) function))) + :group 'go) + +(defcustom go-packages-function 'go-packages-native + "Function called by `go-packages' to determine the list of +available packages. This is used in e.g. tab completion in +`go-import-add'. + +This package provides two functions: `go-packages-native' uses +elisp to find all .a files in all /pkg/ directories. +`go-packages-go-list' uses 'go list all' to determine all Go +packages. `go-packages-go-list' generally produces more accurate +results, but can be slower than `go-packages-native'." + :type 'function + :package-version '(go-mode . 1.4.0) + :group 'go) + +(defcustom go-guess-gopath-functions (list #'go-godep-gopath + #'go-wgo-gopath + #'go-gb-gopath + #'go-plain-gopath) + "Functions to call in sequence to detect a project's GOPATH. + +The functions in this list will be called one after another, +until a function returns non-nil. The order of the functions in +this list is important, as some project layouts may superficially +look like others. For example, a subset of wgo projects look like +gb projects. That's why we need to detect wgo first, to avoid +mis-identifying them as gb projects." + :type '(repeat function) + :group 'go) + +(defcustom godoc-command "go doc" + "Which executable to use for `godoc'. This can either be +'godoc' or 'go doc', both as an absolute path or an executable in +PATH." + :type 'string + :group 'go) + +(defcustom godoc-and-godef-command "godoc" + "Which executable to use for `godoc' in +`godoc-and-godef-command'. Must be 'godoc' and not 'go doc' and +can be an absolute path or an executable in PATH." + :type 'string + :group 'go) + +(defcustom godoc-use-completing-read nil + "Provide auto-completion for godoc. Only really desirable when using `godoc' instead of `go doc'." + :type 'boolean + :group 'godoc) + +(defcustom godoc-at-point-function #'godoc-and-godef + "Function to call to display the documentation for an +identifier at a given position. + +This package provides two functions: `godoc-and-godef' uses a +combination of godef and godoc to find the documentation. This +approach has several caveats. See its documentation for more +information. The second function, `godoc-gogetdoc' uses an +additional tool that correctly determines the documentation for +any identifier. It provides better results than +`godoc-and-godef'. " + :type 'function + :group 'godoc) + +(defun godoc-and-godef (point) + "Use a combination of godef and godoc to guess the documentation. + +Due to a limitation in godoc, it is not possible to differentiate +between functions and methods, which may cause `godoc-at-point' +to display more documentation than desired. Furthermore, it +doesn't work on package names or variables. + +Consider using godoc-gogetdoc instead for more accurate results." + (condition-case nil + (let* ((output (godef--call point)) + (file (car output)) + (name-parts (split-string (cadr output) " ")) + (first (car name-parts))) + (if (not (godef--successful-p file)) + (message "%s" (godef--error file)) + (go--godoc (format "%s %s" + (file-name-directory file) + (if (or (string= first "type") (string= first "const")) + (cadr name-parts) + (car name-parts))) + godoc-and-godef-command))) + (file-error (message "Could not run godef binary")))) + +(defun godoc-gogetdoc (point) + "Use the gogetdoc tool to find the documentation for an identifier. + +You can install gogetdoc with 'go get -u github.com/zmb3/gogetdoc'." + (if (not (buffer-file-name (go--coverage-origin-buffer))) + ;; TODO: gogetdoc supports unsaved files, but not introducing + ;; new artifical files, so this limitation will stay for now. + (error "Cannot use gogetdoc on a buffer without a file name")) + (let ((posn (format "%s:#%d" (shell-quote-argument (file-truename buffer-file-name)) (1- (go--position-bytes point)))) + (out (godoc--get-buffer ""))) + (with-current-buffer (get-buffer-create "*go-gogetdoc-input*") + (setq buffer-read-only nil) + (erase-buffer) + (go--insert-modified-files) + (call-process-region (point-min) (point-max) "gogetdoc" nil out nil + "-modified" + (format "-pos=%s" posn))) + (with-current-buffer out + (goto-char (point-min)) + (godoc-mode) + (display-buffer (current-buffer) t)))) + +(defun go--kill-new-message (url) + "Make URL the latest kill and print a message." + (kill-new url) + (message "%s" url)) + +(defcustom go-play-browse-function 'go--kill-new-message + "Function to call with the Playground URL. +See `go-play-region' for more details." + :type '(choice + (const :tag "Nothing" nil) + (const :tag "Kill + Message" go--kill-new-message) + (const :tag "Browse URL" browse-url) + (function :tag "Call function")) + :group 'go) + +(defcustom go-coverage-display-buffer-func 'display-buffer-reuse-window + "How `go-coverage' should display the coverage buffer. +See `display-buffer' for a list of possible functions." + :type 'function + :group 'go-cover) + +(defface go-coverage-untracked + '((t (:foreground "#505050"))) + "Coverage color of untracked code." + :group 'go-cover) + +(defface go-coverage-0 + '((t (:foreground "#c00000"))) + "Coverage color for uncovered code." + :group 'go-cover) +(defface go-coverage-1 + '((t (:foreground "#808080"))) + "Coverage color for covered code with weight 1." + :group 'go-cover) +(defface go-coverage-2 + '((t (:foreground "#748c83"))) + "Coverage color for covered code with weight 2." + :group 'go-cover) +(defface go-coverage-3 + '((t (:foreground "#689886"))) + "Coverage color for covered code with weight 3." + :group 'go-cover) +(defface go-coverage-4 + '((t (:foreground "#5ca489"))) + "Coverage color for covered code with weight 4." + :group 'go-cover) +(defface go-coverage-5 + '((t (:foreground "#50b08c"))) + "Coverage color for covered code with weight 5." + :group 'go-cover) +(defface go-coverage-6 + '((t (:foreground "#44bc8f"))) + "Coverage color for covered code with weight 6." + :group 'go-cover) +(defface go-coverage-7 + '((t (:foreground "#38c892"))) + "Coverage color for covered code with weight 7." + :group 'go-cover) +(defface go-coverage-8 + '((t (:foreground "#2cd495"))) + "Coverage color for covered code with weight 8. +For mode=set, all covered lines will have this weight." + :group 'go-cover) +(defface go-coverage-9 + '((t (:foreground "#20e098"))) + "Coverage color for covered code with weight 9." + :group 'go-cover) +(defface go-coverage-10 + '((t (:foreground "#14ec9b"))) + "Coverage color for covered code with weight 10." + :group 'go-cover) +(defface go-coverage-covered + '((t (:foreground "#2cd495"))) + "Coverage color of covered code." + :group 'go-cover) + +(defvar go-mode-syntax-table + (let ((st (make-syntax-table))) + (modify-syntax-entry ?+ "." st) + (modify-syntax-entry ?- "." st) + (modify-syntax-entry ?% "." st) + (modify-syntax-entry ?& "." st) + (modify-syntax-entry ?| "." st) + (modify-syntax-entry ?^ "." st) + (modify-syntax-entry ?! "." st) + (modify-syntax-entry ?= "." st) + (modify-syntax-entry ?< "." st) + (modify-syntax-entry ?> "." st) + (modify-syntax-entry ?/ (if (go--xemacs-p) ". 1456" ". 124b") st) + (modify-syntax-entry ?* ". 23" st) + (modify-syntax-entry ?\n "> b" st) + (modify-syntax-entry ?\" "\"" st) + (modify-syntax-entry ?\' "\"" st) + (modify-syntax-entry ?` "\"" st) + (modify-syntax-entry ?\\ "\\" st) + ;; It would be nicer to have _ as a symbol constituent, but that + ;; would trip up XEmacs, which does not support the \_< anchor + (modify-syntax-entry ?_ "w" st) + + st) + "Syntax table for Go mode.") + +(defun go--build-font-lock-keywords () + ;; we cannot use 'symbols in regexp-opt because GNU Emacs <24 + ;; doesn't understand that + (append + `((go--match-func + ,@(mapcar (lambda (x) `(,x font-lock-type-face)) + (number-sequence 1 go--font-lock-func-param-num-groups))) + (,(go--regexp-enclose-in-symbol (regexp-opt go-mode-keywords t)) . font-lock-keyword-face) + (,(concat "\\(" (go--regexp-enclose-in-symbol (regexp-opt go-builtins t)) "\\)[[:space:]]*(") 1 font-lock-builtin-face) + (,(go--regexp-enclose-in-symbol (regexp-opt go-constants t)) . font-lock-constant-face) + (,go-func-regexp 1 font-lock-function-name-face)) ;; function (not method) name + + (if go-fontify-function-calls + `((,(concat "\\(" go-identifier-regexp "\\)[[:space:]]*(") 1 font-lock-function-name-face) ;; function call/method name + (,(concat "[^[:word:][:multibyte:]](\\(" go-identifier-regexp "\\))[[:space:]]*(") 1 font-lock-function-name-face)) ;; bracketed function call + `((,go-func-meth-regexp 2 font-lock-function-name-face))) ;; method name + + `( + ("\\(`[^`]*`\\)" 1 font-lock-multiline) ;; raw string literal, needed for font-lock-syntactic-keywords + (,(concat (go--regexp-enclose-in-symbol "type") "[[:space:]]+\\([^[:space:](]+\\)") 1 font-lock-type-face) ;; types + (,(concat (go--regexp-enclose-in-symbol "type") "[[:space:]]+" go-identifier-regexp "[[:space:]]*" go-type-name-regexp) 1 font-lock-type-face) ;; types + (,(concat "[^[:word:][:multibyte:]]\\[\\([[:digit:]]+\\|\\.\\.\\.\\)?\\]" go-type-name-regexp) 2 font-lock-type-face) ;; Arrays/slices + (,(concat "\\(" go-identifier-regexp "\\)" "{") 1 font-lock-type-face) + (,(concat (go--regexp-enclose-in-symbol "map") "\\[[^]]+\\]" go-type-name-regexp) 1 font-lock-type-face) ;; map value type + (,(concat (go--regexp-enclose-in-symbol "map") "\\[" go-type-name-regexp) 1 font-lock-type-face) ;; map key type + (,(concat (go--regexp-enclose-in-symbol "chan") "[[:space:]]*\\(?:<-[[:space:]]*\\)?" go-type-name-regexp) 1 font-lock-type-face) ;; channel type + (,(concat (go--regexp-enclose-in-symbol "\\(?:new\\|make\\)") "\\(?:[[:space:]]\\|)\\)*(" go-type-name-regexp) 1 font-lock-type-face) ;; new/make type + ;; TODO do we actually need this one or isn't it just a function call? + (,(concat "\\.\\s *(" go-type-name-regexp) 1 font-lock-type-face) ;; Type conversion + ;; Like the original go-mode this also marks compound literal + ;; fields. There, it was marked as to fix, but I grew quite + ;; accustomed to it, so it'll stay for now. + (,(concat "^[[:space:]]*\\(" go-label-regexp "\\)[[:space:]]*:\\(\\S.\\|$\\)") 1 font-lock-constant-face) ;; Labels and compound literal fields + (,(concat (go--regexp-enclose-in-symbol "\\(goto\\|break\\|continue\\)") "[[:space:]]*\\(" go-label-regexp "\\)") 2 font-lock-constant-face)))) ;; labels in goto/break/continue + +(defconst go--font-lock-syntactic-keywords + ;; Override syntax property of raw string literal contents, so that + ;; backslashes have no special meaning in ``. Used in Emacs 23 or older. + '((go--match-raw-string-literal + (1 (7 . ?`)) + (2 (15 . nil)) ;; 15 = "generic string" + (3 (7 . ?`))))) + +(let ((m (define-prefix-command 'go-goto-map))) + (define-key m "a" #'go-goto-arguments) + (define-key m "d" #'go-goto-docstring) + (define-key m "f" #'go-goto-function) + (define-key m "i" #'go-goto-imports) + (define-key m "m" #'go-goto-method-receiver) + (define-key m "n" #'go-goto-function-name) + (define-key m "r" #'go-goto-return-values)) + +(defvar go-mode-map + (let ((m (make-sparse-keymap))) + (unless (boundp 'electric-indent-chars) + (define-key m "}" #'go-mode-insert-and-indent) + (define-key m ")" #'go-mode-insert-and-indent)) + (define-key m (kbd "C-c C-a") #'go-import-add) + (define-key m (kbd "C-c C-j") #'godef-jump) + (define-key m (kbd "C-x 4 C-c C-j") #'godef-jump-other-window) + (define-key m (kbd "C-c C-d") #'godef-describe) + (define-key m (kbd "C-c C-f") 'go-goto-map) + m) + "Keymap used by go-mode.") + +(easy-menu-define go-mode-menu go-mode-map + "Menu for Go mode." + '("Go" + ["Describe Expression" godef-describe t] + ["Jump to Definition" godef-jump t] + "---" + ["Add Import" go-import-add t] + ["Remove Unused Imports" go-remove-unused-imports t] + ["Go to Imports" go-goto-imports t] + "---" + ("Playground" + ["Send Buffer" go-play-buffer t] + ["Send Region" go-play-region t] + ["Download" go-download-play t]) + "---" + ["Coverage" go-coverage t] + ["Gofmt" gofmt t] + ["Godoc" godoc t] + "---" + ["Customize Mode" (customize-group 'go) t])) + +(defun go-mode-insert-and-indent (key) + "Invoke the global binding of KEY, then reindent the line." + + (interactive (list (this-command-keys))) + (call-interactively (lookup-key (current-global-map) key)) + (indent-according-to-mode)) + +(defmacro go-paren-level () + `(car (syntax-ppss))) + +(defmacro go-in-string-or-comment-p () + `(nth 8 (syntax-ppss))) + +(defmacro go-in-string-p () + `(nth 3 (syntax-ppss))) + +(defmacro go-in-comment-p () + `(nth 4 (syntax-ppss))) + +(defmacro go-goto-beginning-of-string-or-comment () + `(goto-char (nth 8 (syntax-ppss)))) + +(defun go--backward-irrelevant (&optional stop-at-string) + "Skip backwards over any characters that are irrelevant for +indentation and related tasks. + +It skips over whitespace, comments, cases and labels and, if +STOP-AT-STRING is not true, over strings." + + (let (pos (start-pos (point))) + (skip-chars-backward "\n\s\t") + (if (and (save-excursion (beginning-of-line) (go-in-string-p)) + (looking-back "`") + (not stop-at-string)) + (backward-char)) + (if (and (go-in-string-p) + (not stop-at-string)) + (go-goto-beginning-of-string-or-comment)) + (if (looking-back "\\*/") + (backward-char)) + (if (go-in-comment-p) + (go-goto-beginning-of-string-or-comment)) + (setq pos (point)) + (beginning-of-line) + (if (or (looking-at (concat "^" go-label-regexp ":")) + (looking-at "^[[:space:]]*\\(case .+\\|default\\):")) + (end-of-line 0) + (goto-char pos)) + (if (/= start-pos (point)) + (go--backward-irrelevant stop-at-string)) + (/= start-pos (point)))) + +(defun go--buffer-narrowed-p () + "Return non-nil if the current buffer is narrowed." + (/= (buffer-size) + (- (point-max) + (point-min)))) + +(defun go--match-raw-string-literal (end) + "Search for a raw string literal. +Set point to the end of the occurence found on success. Return nil on failure." + (unless (go-in-string-or-comment-p) + (when (search-forward "`" end t) + (goto-char (match-beginning 0)) + (if (go-in-string-or-comment-p) + (progn (goto-char (match-end 0)) + (go--match-raw-string-literal end)) + (when (looking-at "\\(`\\)\\([^`]*\\)\\(`\\)") + (goto-char (match-end 0)) + t))))) + +(defun go-previous-line-has-dangling-op-p () + "Return non-nil if the current line is a continuation line." + (let* ((cur-line (line-number-at-pos)) + (val (gethash cur-line go-dangling-cache 'nope))) + (if (or (go--buffer-narrowed-p) (equal val 'nope)) + (save-excursion + (beginning-of-line) + (go--backward-irrelevant t) + (setq val (looking-back go-dangling-operators-regexp)) + (if (not (go--buffer-narrowed-p)) + (puthash cur-line val go-dangling-cache)))) + val)) + +(defun go--at-function-definition () + "Return non-nil if point is on the opening curly brace of a +function definition. + +We do this by first calling (beginning-of-defun), which will take +us to the start of *some* function. We then look for the opening +curly brace of that function and compare its position against the +curly brace we are checking. If they match, we return non-nil." + (if (= (char-after) ?\{) + (save-excursion + (let ((old-point (point)) + start-nesting) + (beginning-of-defun) + (when (looking-at "func ") + (setq start-nesting (go-paren-level)) + (skip-chars-forward "^{") + (while (> (go-paren-level) start-nesting) + (forward-char) + (skip-chars-forward "^{") 0) + (if (and (= (go-paren-level) start-nesting) (= old-point (point))) + t)))))) + +(defun go--indentation-for-opening-parenthesis () + "Return the semantic indentation for the current opening parenthesis. + +If point is on an opening curly brace and said curly brace +belongs to a function declaration, the indentation of the func +keyword will be returned. Otherwise the indentation of the +current line will be returned." + (save-excursion + (if (go--at-function-definition) + (progn + (beginning-of-defun) + (current-indentation)) + (current-indentation)))) + +(defun go-indentation-at-point () + (save-excursion + (let (start-nesting) + (back-to-indentation) + (setq start-nesting (go-paren-level)) + + (cond + ((go-in-string-p) + (current-indentation)) + ((looking-at "[])}]") + (go-goto-opening-parenthesis) + (if (go-previous-line-has-dangling-op-p) + (- (current-indentation) tab-width) + (go--indentation-for-opening-parenthesis))) + ((progn (go--backward-irrelevant t) (looking-back go-dangling-operators-regexp)) + ;; only one nesting for all dangling operators in one operation + (if (go-previous-line-has-dangling-op-p) + (current-indentation) + (+ (current-indentation) tab-width))) + ((zerop (go-paren-level)) + 0) + ((progn (go-goto-opening-parenthesis) (< (go-paren-level) start-nesting)) + (if (go-previous-line-has-dangling-op-p) + (current-indentation) + (+ (go--indentation-for-opening-parenthesis) tab-width))) + (t + (current-indentation)))))) + +(defun go-mode-indent-line () + (interactive) + (let (indent + shift-amt + (pos (- (point-max) (point))) + (point (point)) + (beg (line-beginning-position))) + (back-to-indentation) + (if (go-in-string-or-comment-p) + (goto-char point) + (setq indent (go-indentation-at-point)) + (if (looking-at (concat go-label-regexp ":\\([[:space:]]*/.+\\)?$\\|case .+:\\|default:")) + (cl-decf indent tab-width)) + (setq shift-amt (- indent (current-column))) + (if (zerop shift-amt) + nil + (delete-region beg (point)) + (indent-to indent)) + ;; If initial point was within line's indentation, + ;; position after the indentation. Else stay at same point in text. + (if (> (- (point-max) pos) (point)) + (goto-char (- (point-max) pos)))))) + +(defun go-beginning-of-defun (&optional count) + (unless (bolp) + (end-of-line)) + (setq count (or count 1)) + (let (first failure) + (dotimes (i (abs count)) + (setq first t) + (while (and (not failure) + (or first (go-in-string-or-comment-p))) + (if (>= count 0) + (progn + (go--backward-irrelevant) + (if (not (re-search-backward go-func-meth-regexp nil t)) + (setq failure t))) + (if (looking-at go-func-meth-regexp) + (forward-char)) + (if (not (re-search-forward go-func-meth-regexp nil t)) + (setq failure t))) + (setq first nil))) + (if (< count 0) + (beginning-of-line)) + (not failure))) + +(defun go-end-of-defun () + (let (orig-level) + ;; It can happen that we're not placed before a function by emacs + (if (not (looking-at "func")) + (go-beginning-of-defun -1)) + ;; Find the { that starts the function, i.e., the next { that isn't + ;; preceded by struct or interface, or a comment or struct tag. BUG: + ;; breaks if there's a comment between the struct/interface keyword and + ;; bracket, like this: + ;; + ;; struct /* why? */ { + (while (progn + (skip-chars-forward "^{") + (forward-char) + (or (go-in-string-or-comment-p) + (looking-back "\\(struct\\|interface\\)\\s-*{")))) + (setq orig-level (go-paren-level)) + (while (>= (go-paren-level) orig-level) + (skip-chars-forward "^}") + (forward-char)))) + +(defun go--find-enclosing-parentheses (position) + "Return points of outermost '(' and ')' surrounding POSITION if +such parentheses exist. + +If outermost '(' exists but ')' does not, it returns the next blank +line or end-of-buffer position instead of the position of the closing +parenthesis. + +If the starting parenthesis is not found, it returns (POSITION +POSITION)." + (save-excursion + (let (beg end) + (goto-char position) + (while (> (go-paren-level) 0) + (re-search-backward "[(\\[{]" nil t) + (when (looking-at "(") + (setq beg (point)))) + (if (null beg) + (list position position) + (goto-char position) + (while (and (> (go-paren-level) 0) + (search-forward ")" nil t))) + (when (> (go-paren-level) 0) + (unless (re-search-forward "^[[:space:]]*$" nil t) + (goto-char (point-max)))) + (list beg (point)))))) + +(defun go--search-next-comma (end) + "Search forward from point for a comma whose nesting level is +the same as point. If it reaches the end of line or a closing +parenthesis before a comma, it stops at it." + (let ((orig-level (go-paren-level))) + (while (and (< (point) end) + (or (looking-at "[^,)\n]") + (> (go-paren-level) orig-level))) + (forward-char)) + (when (and (looking-at ",") + (< (point) (1- end))) + (forward-char)))) + +(defun go--looking-at-keyword () + (and (looking-at (concat "\\(" go-identifier-regexp "\\)")) + (member (match-string 1) go-mode-keywords))) + +(defun go--match-func (end) + "Search for identifiers used as type names from a function +parameter list, and set the identifier positions as the results +of last search. Return t if search succeeded." + (when (re-search-forward (go--regexp-enclose-in-symbol "func") end t) + (let ((regions (go--match-func-type-names end))) + (if (null regions) + ;; Nothing to highlight. This can happen if the current func + ;; is "func()". Try next one. + (go--match-func end) + ;; There are something to highlight. Set those positions as + ;; last search results. + (setq regions (go--filter-match-data regions end)) + (when regions + (set-match-data (go--make-match-data regions)) + t))))) + +(defun go--match-func-type-names (end) + (cond + ;; Function declaration (e.g. "func foo(") + ((looking-at (concat "[[:space:]\n]*" go-identifier-regexp "[[:space:]\n]*(")) + (goto-char (match-end 0)) + (nconc (go--match-parameter-list end) + (go--match-function-result end))) + ;; Method declaration, function literal, or function type + ((looking-at "[[:space:]]*(") + (goto-char (match-end 0)) + (let ((regions (go--match-parameter-list end))) + ;; Method declaration (e.g. "func (x y) foo(") + (when (looking-at (concat "[[:space:]]*" go-identifier-regexp "[[:space:]\n]*(")) + (goto-char (match-end 0)) + (setq regions (nconc regions (go--match-parameter-list end)))) + (nconc regions (go--match-function-result end)))))) + +(defun go--parameter-list-type (end) + "Return `present' if the parameter list has names, or `absent' if +not, assuming point is at the beginning of a parameter list, just +after '('." + (save-excursion + (skip-chars-forward "[:space:]\n" end) + (cond ((> (point) end) + nil) + ((looking-at (concat go-identifier-regexp "[[:space:]\n]*,")) + (goto-char (match-end 0)) + (go--parameter-list-type end)) + ((or (looking-at go-qualified-identifier-regexp) + (looking-at (concat go-type-name-no-prefix-regexp "[[:space:]\n]*\\(?:)\\|\\'\\)")) + (go--looking-at-keyword) + (looking-at "[*\\[]\\|\\.\\.\\.\\|\\'")) + 'absent) + (t 'present)))) + +(defconst go--opt-dotdotdot-regexp "\\(?:\\.\\.\\.\\)?") +(defconst go--parameter-type-regexp + (concat go--opt-dotdotdot-regexp "[[:space:]*\n]*\\(" go-type-name-no-prefix-regexp "\\)[[:space:]\n]*\\([,)]\\|\\'\\)")) +(defconst go--func-type-in-parameter-list-regexp + (concat go--opt-dotdotdot-regexp "[[:space:]*\n]*\\(" (go--regexp-enclose-in-symbol "func") "\\)")) + +(defun go--match-parameters-common (identifier-regexp end) + (let ((acc ()) + (start -1)) + (while (progn (skip-chars-forward "[:space:]\n" end) + (and (not (looking-at "\\(?:)\\|\\'\\)")) + (< start (point)) + (<= (point) end))) + (setq start (point)) + (cond + ((looking-at (concat identifier-regexp go--parameter-type-regexp)) + (setq acc (nconc acc (list (match-beginning 1) (match-end 1)))) + (goto-char (match-beginning 2))) + ((looking-at (concat identifier-regexp go--func-type-in-parameter-list-regexp)) + (goto-char (match-beginning 1)) + (setq acc (nconc acc (go--match-func-type-names end))) + (go--search-next-comma end)) + (t + (go--search-next-comma end)))) + (when (and (looking-at ")") + (< (point) end)) + (forward-char)) + acc)) + +(defun go--match-parameters-with-identifier-list (end) + (go--match-parameters-common + (concat go-identifier-regexp "[[:space:]\n]+") + end)) + +(defun go--match-parameters-without-identifier-list (end) + (go--match-parameters-common "" end)) + +(defun go--filter-match-data (regions end) + "Remove points from REGIONS if they are beyond END. +REGIONS are a list whose size is multiple of 2. Element 2n is beginning of a +region and 2n+1 is end of it. + +This function is used to make sure we don't override end point +that `font-lock-mode' gave to us." + (when regions + (let* ((vec (vconcat regions)) + (i 0) + (len (length vec))) + (while (and (< i len) + (<= (nth i regions) end) + (<= (nth (1+ i) regions) end)) + (setq i (+ i 2))) + (cond ((= i len) + regions) + ((zerop i) + nil) + (t + (butlast regions (- (length regions) i))))))) + +(defun go--make-match-data (regions) + (let ((deficit (- (* 2 go--font-lock-func-param-num-groups) + (length regions)))) + (when (> deficit 0) + (let ((last (car (last regions)))) + (setq regions (nconc regions (make-list deficit last)))))) + `(,(car regions) ,@(last regions) ,@regions)) + +(defun go--match-parameter-list (end) + "Return a list of identifier positions that are used as type +names in a function parameter list, assuming point is at the +beginning of a parameter list. Return nil if the text after +point does not look like a parameter list. + +Set point to end of closing parenthesis on success. + +In Go, the names must either all be present or all be absent +within a list of parameters. + +Parsing a parameter list is a little bit complicated because we +have to scan through the parameter list to determine whether or +not the list has names. Until a type name is found or reaching +end of a parameter list, we are not sure which form the parameter +list is. + +For example, X and Y are type names in a parameter list \"(X, +Y)\" but are parameter names in \"(X, Y int)\". We cannot say if +X is a type name until we see int after Y. + +Note that even \"(int, float T)\" is a valid parameter +list. Builtin type names are not reserved words. In this example, +int and float are parameter names and only T is a type name. + +In this function, we first scan the parameter list to see if the +list has names, and then handle it accordingly." + (let ((name (go--parameter-list-type end))) + (cond ((eq name 'present) + (go--match-parameters-with-identifier-list end)) + ((eq name 'absent) + (go--match-parameters-without-identifier-list end)) + (t nil)))) + +(defun go--match-function-result (end) + "Return a list of identifier positions that are used as type +names in a function result, assuming point is at the beginning of +a result. + +Function result is a unparenthesized type or a parameter list." + (cond ((and (looking-at (concat "[[:space:]*]*\\(" go-type-name-no-prefix-regexp "\\)")) + (not (member (match-string 1) go-mode-keywords))) + (list (match-beginning 1) (match-end 1))) + ((looking-at "[[:space:]]*(") + (goto-char (match-end 0)) + (go--match-parameter-list end)) + (t nil))) + +;;;###autoload +(define-derived-mode go-mode prog-mode "Go" + "Major mode for editing Go source text. + +This mode provides (not just) basic editing capabilities for +working with Go code. It offers almost complete syntax +highlighting, indentation that is almost identical to gofmt and +proper parsing of the buffer content to allow features such as +navigation by function, manipulation of comments or detection of +strings. + +In addition to these core features, it offers various features to +help with writing Go code. You can directly run buffer content +through gofmt, read godoc documentation from within Emacs, modify +and clean up the list of package imports or interact with the +Playground (uploading and downloading pastes). + +The following extra functions are defined: + +- `gofmt' +- `godoc' and `godoc-at-point' +- `go-import-add' +- `go-remove-unused-imports' +- `go-goto-arguments' +- `go-goto-docstring' +- `go-goto-function' +- `go-goto-function-name' +- `go-goto-imports' +- `go-goto-return-values' +- `go-goto-method-receiver' +- `go-play-buffer' and `go-play-region' +- `go-download-play' +- `godef-describe' and `godef-jump' +- `go-coverage' +- `go-set-project' +- `go-reset-gopath' + +If you want to automatically run `gofmt' before saving a file, +add the following hook to your emacs configuration: + +\(add-hook 'before-save-hook #'gofmt-before-save) + +If you want to use `godef-jump' instead of etags (or similar), +consider binding godef-jump to `M-.', which is the default key +for `find-tag': + +\(add-hook 'go-mode-hook (lambda () + (local-set-key (kbd \"M-.\") #'godef-jump))) + +Please note that godef is an external dependency. You can install +it with + +go get github.com/rogpeppe/godef + + +If you're looking for even more integration with Go, namely +on-the-fly syntax checking, auto-completion and snippets, it is +recommended that you look at flycheck +\(see URL `https://github.com/flycheck/flycheck') or flymake in combination +with goflymake \(see URL `https://github.com/dougm/goflymake'), gocode +\(see URL `https://github.com/nsf/gocode'), go-eldoc +\(see URL `github.com/syohex/emacs-go-eldoc') and yasnippet-go +\(see URL `https://github.com/dominikh/yasnippet-go')" + + ;; Font lock + (set (make-local-variable 'font-lock-defaults) + '(go--build-font-lock-keywords)) + + ;; Indentation + (set (make-local-variable 'indent-line-function) #'go-mode-indent-line) + + ;; Comments + (set (make-local-variable 'comment-start) "// ") + (set (make-local-variable 'comment-end) "") + (set (make-local-variable 'comment-use-syntax) t) + (set (make-local-variable 'comment-start-skip) "\\(//+\\|/\\*+\\)\\s *") + + (set (make-local-variable 'beginning-of-defun-function) #'go-beginning-of-defun) + (set (make-local-variable 'end-of-defun-function) #'go-end-of-defun) + + (set (make-local-variable 'parse-sexp-lookup-properties) t) + (if (go--has-syntax-propertize-p) + (set (make-local-variable 'syntax-propertize-function) #'go-propertize-syntax) + (set (make-local-variable 'font-lock-syntactic-keywords) + go--font-lock-syntactic-keywords) + (set (make-local-variable 'font-lock-multiline) t)) + + (if (boundp 'electric-indent-chars) + (set (make-local-variable 'electric-indent-chars) '(?\n ?} ?\)))) + + (set (make-local-variable 'compilation-error-screen-columns) nil) + + (set (make-local-variable 'go-dangling-cache) (make-hash-table :test 'eql)) + (add-hook 'before-change-functions (lambda (x y) (setq go-dangling-cache (make-hash-table :test 'eql))) t t) + + ;; ff-find-other-file + (setq ff-other-file-alist 'go-other-file-alist) + + (setq imenu-generic-expression + '(("type" "^type *\\([^ \t\n\r\f]*\\)" 1) + ("func" "^func *\\(.*\\) {" 1))) + (imenu-add-to-menubar "Index") + + ;; Go style + (setq indent-tabs-mode t) + + ;; Handle unit test failure output in compilation-mode + ;; + ;; Note that we add our entry to the beginning of + ;; compilation-error-regexp-alist. In older versions of Emacs, the + ;; list was processed from the end, and we would've wanted to add + ;; ours last. But at some point this changed, and now the list is + ;; processed from the beginning. It's important that our entry comes + ;; before gnu, because gnu matches go test output, but includes the + ;; leading whitespace in the file name. + ;; + ;; http://lists.gnu.org/archive/html/bug-gnu-emacs/2001-12/msg00674.html + ;; documents the old, reverseed order. + (when (and (boundp 'compilation-error-regexp-alist) + (boundp 'compilation-error-regexp-alist-alist)) + (add-to-list 'compilation-error-regexp-alist 'go-test) + (add-to-list 'compilation-error-regexp-alist-alist + '(go-test . ("^\t+\\([^()\t\n]+\\):\\([0-9]+\\):? .*$" 1 2)) t))) + +;;;###autoload +(add-to-list 'auto-mode-alist (cons "\\.go\\'" 'go-mode)) + +(defun go--apply-rcs-patch (patch-buffer) + "Apply an RCS-formatted diff from PATCH-BUFFER to the current buffer." + (let ((target-buffer (current-buffer)) + ;; Relative offset between buffer line numbers and line numbers + ;; in patch. + ;; + ;; Line numbers in the patch are based on the source file, so + ;; we have to keep an offset when making changes to the + ;; buffer. + ;; + ;; Appending lines decrements the offset (possibly making it + ;; negative), deleting lines increments it. This order + ;; simplifies the forward-line invocations. + (line-offset 0)) + (save-excursion + (with-current-buffer patch-buffer + (goto-char (point-min)) + (while (not (eobp)) + (unless (looking-at "^\\([ad]\\)\\([0-9]+\\) \\([0-9]+\\)") + (error "invalid rcs patch or internal error in go--apply-rcs-patch")) + (forward-line) + (let ((action (match-string 1)) + (from (string-to-number (match-string 2))) + (len (string-to-number (match-string 3)))) + (cond + ((equal action "a") + (let ((start (point))) + (forward-line len) + (let ((text (buffer-substring start (point)))) + (with-current-buffer target-buffer + (cl-decf line-offset len) + (goto-char (point-min)) + (forward-line (- from len line-offset)) + (insert text))))) + ((equal action "d") + (with-current-buffer target-buffer + (go--goto-line (- from line-offset)) + (cl-incf line-offset len) + (go--delete-whole-line len))) + (t + (error "invalid rcs patch or internal error in go--apply-rcs-patch"))))))))) + +(defun gofmt--is-goimports-p () + (string-equal (file-name-base gofmt-command) "goimports")) + +(defun gofmt () + "Format the current buffer according to the gofmt tool." + (interactive) + (let ((tmpfile (make-temp-file "gofmt" nil ".go")) + (patchbuf (get-buffer-create "*Gofmt patch*")) + (errbuf (if gofmt-show-errors (get-buffer-create "*Gofmt Errors*"))) + (coding-system-for-read 'utf-8) + (coding-system-for-write 'utf-8) + our-gofmt-args) + + (unwind-protect + (save-restriction + (widen) + (if errbuf + (with-current-buffer errbuf + (setq buffer-read-only nil) + (erase-buffer))) + (with-current-buffer patchbuf + (erase-buffer)) + + (write-region nil nil tmpfile) + + (when (and (gofmt--is-goimports-p) buffer-file-name) + (setq our-gofmt-args + (append our-gofmt-args + (list "-srcdir" (file-name-directory (file-truename buffer-file-name)))))) + (setq our-gofmt-args (append our-gofmt-args + gofmt-args + (list "-w" tmpfile))) + (message "Calling gofmt: %s %s" gofmt-command our-gofmt-args) + ;; We're using errbuf for the mixed stdout and stderr output. This + ;; is not an issue because gofmt -w does not produce any stdout + ;; output in case of success. + (if (zerop (apply #'call-process gofmt-command nil errbuf nil our-gofmt-args)) + (progn + (if (zerop (call-process-region (point-min) (point-max) "diff" nil patchbuf nil "-n" "-" tmpfile)) + (message "Buffer is already gofmted") + (go--apply-rcs-patch patchbuf) + (message "Applied gofmt")) + (if errbuf (gofmt--kill-error-buffer errbuf))) + (message "Could not apply gofmt") + (if errbuf (gofmt--process-errors (buffer-file-name) tmpfile errbuf)))) + + (kill-buffer patchbuf) + (delete-file tmpfile)))) + + +(defun gofmt--process-errors (filename tmpfile errbuf) + (with-current-buffer errbuf + (if (eq gofmt-show-errors 'echo) + (progn + (message "%s" (buffer-string)) + (gofmt--kill-error-buffer errbuf)) + ;; Convert the gofmt stderr to something understood by the compilation mode. + (goto-char (point-min)) + (if (save-excursion + (save-match-data + (search-forward "flag provided but not defined: -srcdir" nil t))) + (insert "Your version of goimports is too old and doesn't support vendoring. Please update goimports!\n\n")) + (insert "gofmt errors:\n") + (let ((truefile + (if (gofmt--is-goimports-p) + (concat (file-name-directory filename) (file-name-nondirectory tmpfile)) + tmpfile))) + (while (search-forward-regexp (concat "^\\(" (regexp-quote truefile) "\\):") nil t) + (replace-match (file-name-nondirectory filename) t t nil 1))) + (compilation-mode) + (display-buffer errbuf)))) + +(defun gofmt--kill-error-buffer (errbuf) + (let ((win (get-buffer-window errbuf))) + (if win + (quit-window t win) + (kill-buffer errbuf)))) + +;;;###autoload +(defun gofmt-before-save () + "Add this to .emacs to run gofmt on the current buffer when saving: + (add-hook 'before-save-hook 'gofmt-before-save). + +Note that this will cause go-mode to get loaded the first time +you save any file, kind of defeating the point of autoloading." + + (interactive) + (when (eq major-mode 'go-mode) (gofmt))) + +(defun godoc--read-query () + "Read a godoc query from the minibuffer." + (if godoc-use-completing-read + (completing-read "godoc; " + (go--old-completion-list-style (go-packages)) nil nil nil 'go-godoc-history) + (read-from-minibuffer "godoc: " nil nil nil 'go-godoc-history))) + +(defun godoc--get-buffer (query) + "Get an empty buffer for a godoc query." + (let* ((buffer-name (concat "*godoc " query "*")) + (buffer (get-buffer buffer-name))) + ;; Kill the existing buffer if it already exists. + (when buffer (kill-buffer buffer)) + (get-buffer-create buffer-name))) + +(defun godoc--buffer-sentinel (proc event) + "Sentinel function run when godoc command completes." + (with-current-buffer (process-buffer proc) + (cond ((string= event "finished\n") ;; Successful exit. + (goto-char (point-min)) + (godoc-mode) + (display-buffer (current-buffer) t)) + ((/= (process-exit-status proc) 0) ;; Error exit. + (let ((output (buffer-string))) + (kill-buffer (current-buffer)) + (message (concat "godoc: " output))))))) + +(define-derived-mode godoc-mode special-mode "Godoc" + "Major mode for showing Go documentation." + (view-mode-enter)) + +;;;###autoload +(defun godoc (query) + "Show Go documentation for QUERY, much like M-x man." + (interactive (list (godoc--read-query))) + (go--godoc query godoc-command)) + +(defun go--godoc (query command) + (unless (string= query "") + (set-process-sentinel + (start-process-shell-command "godoc" (godoc--get-buffer query) + (concat command " " query)) + 'godoc--buffer-sentinel) + nil)) + +(defun godoc-at-point (point) + "Show Go documentation for the identifier at POINT. + +It uses `godoc-at-point-function' to look up the documentation." + (interactive "d") + (funcall godoc-at-point-function point)) + +(defun go-goto-imports () + "Move point to the block of imports. + +If using + + import ( + \"foo\" + \"bar\" + ) + +it will move point directly behind the last import. + +If using + + import \"foo\" + import \"bar\" + +it will move point to the next line after the last import. + +If no imports can be found, point will be moved after the package +declaration." + (interactive) + ;; FIXME if there's a block-commented import before the real + ;; imports, we'll jump to that one. + + ;; Generally, this function isn't very forgiving. it'll bark on + ;; extra whitespace. It works well for clean code. + (let ((old-point (point))) + (goto-char (point-min)) + (cond + ((re-search-forward "^import ()" nil t) + (backward-char 1) + 'block-empty) + ((re-search-forward "^import ([^)]+)" nil t) + (backward-char 2) + 'block) + ((re-search-forward "\\(^import \\([^\"]+ \\)?\"[^\"]+\"\n?\\)+" nil t) + 'single) + ((re-search-forward "^[[:space:]\n]*package .+?\n" nil t) + (message "No imports found, moving point after package declaration") + 'none) + (t + (goto-char old-point) + (message "No imports or package declaration found. Is this really a Go file?") + 'fail)))) + +(defun go-play-buffer () + "Like `go-play-region', but acts on the entire buffer." + (interactive) + (go-play-region (point-min) (point-max))) + +(defun go-play-region (start end) + "Send the region to the Playground. +If non-nil `go-play-browse-function' is called with the +Playground URL." + (interactive "r") + (let* ((url-request-method "POST") + (url-request-extra-headers + '(("Content-Type" . "application/x-www-form-urlencoded"))) + (url-request-data + (encode-coding-string + (buffer-substring-no-properties start end) + 'utf-8)) + (content-buf (url-retrieve + "http://play.golang.org/share" + (lambda (arg) + (cond + ((equal :error (car arg)) + (signal 'go-play-error (cdr arg))) + (t + (re-search-forward "\n\n") + (let ((url (format "http://play.golang.org/p/%s" + (buffer-substring (point) (point-max))))) + (when go-play-browse-function + (funcall go-play-browse-function url))))))))))) + +;;;###autoload +(defun go-download-play (url) + "Download a paste from the playground and insert it in a Go buffer. +Tries to look for a URL at point." + (interactive (list (read-from-minibuffer "Playground URL: " (ffap-url-p (ffap-string-at-point 'url))))) + (with-current-buffer + (let ((url-request-method "GET") url-request-data url-request-extra-headers) + (url-retrieve-synchronously (concat url ".go"))) + (let ((buffer (generate-new-buffer (concat (car (last (split-string url "/"))) ".go")))) + (goto-char (point-min)) + (re-search-forward "\n\n") + (copy-to-buffer buffer (point) (point-max)) + (kill-buffer) + (with-current-buffer buffer + (go-mode) + (switch-to-buffer buffer))))) + +(defun go-propertize-syntax (start end) + (save-excursion + (goto-char start) + (while (search-forward "\\" end t) + (put-text-property (1- (point)) (point) 'syntax-table (if (= (char-after) ?`) '(1) '(9)))))) + +(defun go-import-add (arg import) + "Add a new IMPORT to the list of imports. + +When called with a prefix ARG asks for an alternative name to +import the package as. + +If no list exists yet, one will be created if possible. + +If an identical import has been commented, it will be +uncommented, otherwise a new import will be added." + + ;; - If there's a matching `// import "foo"`, uncomment it + ;; - If we're in an import() block and there's a matching `"foo"`, uncomment it + ;; - Otherwise add a new import, with the appropriate syntax + (interactive + (list + current-prefix-arg + (replace-regexp-in-string "^[\"']\\|[\"']$" "" (completing-read "Package: " (go--old-completion-list-style (go-packages)))))) + (save-excursion + (let (as line import-start) + (if arg + (setq as (read-from-minibuffer "Import as: "))) + (if as + (setq line (format "%s \"%s\"" as import)) + (setq line (format "\"%s\"" import))) + + (goto-char (point-min)) + (if (re-search-forward (concat "^[[:space:]]*//[[:space:]]*import " line "$") nil t) + (uncomment-region (line-beginning-position) (line-end-position)) + (cl-case (go-goto-imports) + ('fail (message "Could not find a place to add import.")) + ('block-empty + (insert "\n\t" line "\n")) + ('block + (save-excursion + (re-search-backward "^import (") + (setq import-start (point))) + (if (re-search-backward (concat "^[[:space:]]*//[[:space:]]*" line "$") import-start t) + (uncomment-region (line-beginning-position) (line-end-position)) + (insert "\n\t" line))) + ('single (insert "import " line "\n")) + ('none (insert "\nimport (\n\t" line "\n)\n"))))))) + +(defun go-root-and-paths () + (let* ((output (process-lines go-command "env" "GOROOT" "GOPATH")) + (root (car output)) + (paths (split-string (cadr output) path-separator))) + (cons root paths))) + +(defun go--string-prefix-p (s1 s2 &optional ignore-case) + "Return non-nil if S1 is a prefix of S2. +If IGNORE-CASE is non-nil, the comparison is case-insensitive." + (eq t (compare-strings s1 nil nil + s2 0 (length s1) ignore-case))) + +(defun go--directory-dirs (dir) + "Recursively return all subdirectories in DIR." + (if (file-directory-p dir) + (let ((dir (directory-file-name dir)) + (dirs '()) + (files (directory-files dir nil nil t))) + (dolist (file files) + (unless (member file '("." "..")) + (let ((file (concat dir "/" file))) + (if (file-directory-p file) + (setq dirs (append (cons file + (go--directory-dirs file)) + dirs)))))) + dirs) + '())) + + +(defun go-packages () + (funcall go-packages-function)) + +(defun go-packages-native () + "Return a list of all installed Go packages. It looks for +archive files in /pkg/" + (sort + (delete-dups + (cl-mapcan + (lambda (topdir) + (let ((pkgdir (concat topdir "/pkg/"))) + (cl-mapcan (lambda (dir) + (mapcar (lambda (file) + (let ((sub (substring file (length pkgdir) -2))) + (unless (or (go--string-prefix-p "obj/" sub) (go--string-prefix-p "tool/" sub)) + (mapconcat #'identity (cdr (split-string sub "/")) "/")))) + (if (file-directory-p dir) + (directory-files dir t "\\.a$")))) + (if (file-directory-p pkgdir) + (go--directory-dirs pkgdir))))) + (go-root-and-paths))) + #'string<)) + +(defun go-packages-go-list () + "Return a list of all Go packages, using `go list'" + (process-lines go-command "list" "-e" "all")) + +(defun go-unused-imports-lines () + (reverse (remove nil + (mapcar + (lambda (line) + (when (string-match "^\\(.+\\):\\([[:digit:]]+\\): imported and not used: \".+\".*$" line) + (let ((error-file-name (match-string 1 line)) + (error-line-num (match-string 2 line))) + (if (string= (file-truename error-file-name) (file-truename buffer-file-name)) + (string-to-number error-line-num))))) + (split-string (shell-command-to-string + (concat go-command + (if (string-match "_test\\.go$" buffer-file-truename) + " test -c" + (concat " build -o " null-device)) + " -gcflags=-e" + " " + (shell-quote-argument (file-truename buffer-file-name)))) "\n"))))) + +(defun go-remove-unused-imports (arg) + "Remove all unused imports. +If ARG is non-nil, unused imports will be commented, otherwise +they will be removed completely." + (interactive "P") + (save-excursion + (let ((cur-buffer (current-buffer)) flymake-state lines) + (when (boundp 'flymake-mode) + (setq flymake-state flymake-mode) + (flymake-mode-off)) + (save-some-buffers nil (lambda () (equal cur-buffer (current-buffer)))) + (if (buffer-modified-p) + (message "Cannot operate on unsaved buffer") + (setq lines (go-unused-imports-lines)) + (dolist (import lines) + (go--goto-line import) + (beginning-of-line) + (if arg + (comment-region (line-beginning-position) (line-end-position)) + (go--delete-whole-line))) + (message "Removed %d imports" (length lines))) + (if flymake-state (flymake-mode-on))))) + +(defun godef--find-file-line-column (specifier other-window) + "Given a file name in the format of `filename:line:column', +visit FILENAME and go to line LINE and column COLUMN." + (if (not (string-match "\\(.+\\):\\([0-9]+\\):\\([0-9]+\\)" specifier)) + ;; We've only been given a directory name + (funcall (if other-window #'find-file-other-window #'find-file) specifier) + (let ((filename (match-string 1 specifier)) + (line (string-to-number (match-string 2 specifier))) + (column (string-to-number (match-string 3 specifier)))) + (funcall (if other-window #'find-file-other-window #'find-file) filename) + (go--goto-line line) + (beginning-of-line) + (forward-char (1- column)) + (if (buffer-modified-p) + (message "Buffer is modified, file position might not have been correct"))))) + +(defun godef--call (point) + "Call godef, acquiring definition position and expression +description at POINT." + (if (go--xemacs-p) + (error "godef does not reliably work in XEmacs, expect bad results")) + (if (not (buffer-file-name (go--coverage-origin-buffer))) + (error "Cannot use godef on a buffer without a file name") + (let ((outbuf (get-buffer-create "*godef*")) + (coding-system-for-read 'utf-8) + (coding-system-for-write 'utf-8)) + (with-current-buffer outbuf + (erase-buffer)) + (call-process-region (point-min) + (point-max) + godef-command + nil + outbuf + nil + "-i" + "-t" + "-f" + (file-truename (buffer-file-name (go--coverage-origin-buffer))) + "-o" + (number-to-string (go--position-bytes point))) + (with-current-buffer outbuf + (split-string (buffer-substring-no-properties (point-min) (point-max)) "\n"))))) + +(defun godef--successful-p (output) + (not (or (string= "-" output) + (string= "godef: no identifier found" output) + (go--string-prefix-p "godef: no declaration found for " output) + (go--string-prefix-p "error finding import path for " output)))) + +(defun godef--error (output) + (cond + ((godef--successful-p output) + nil) + ((string= "-" output) + "godef: expression is not defined anywhere") + (t + output))) + +(defun godef-describe (point) + "Describe the expression at POINT." + (interactive "d") + (condition-case nil + (let ((description (cdr (butlast (godef--call point) 1)))) + (if (not description) + (message "No description found for expression at point") + (message "%s" (mapconcat #'identity description "\n")))) + (file-error (message "Could not run godef binary")))) + +(defun godef-jump (point &optional other-window) + "Jump to the definition of the expression at POINT." + (interactive "d") + (condition-case nil + (let ((file (car (godef--call point)))) + (if (not (godef--successful-p file)) + (message "%s" (godef--error file)) + (push-mark) + (ring-insert find-tag-marker-ring (point-marker)) + (godef--find-file-line-column file other-window))) + (file-error (message "Could not run godef binary")))) + +(defun godef-jump-other-window (point) + (interactive "d") + (godef-jump point t)) + +(defun go--goto-line (line) + (goto-char (point-min)) + (forward-line (1- line))) + +(defun go--line-column-to-point (line column) + (save-excursion + (go--goto-line line) + (forward-char (1- column)) + (point))) + +(cl-defstruct go--covered + start-line start-column end-line end-column covered count) + +(defun go--coverage-file () + "Return the coverage file to use, either by reading it from the +current coverage buffer or by prompting for it." + (if (boundp 'go--coverage-current-file-name) + go--coverage-current-file-name + (read-file-name "Coverage file: " nil nil t))) + +(defun go--coverage-origin-buffer () + "Return the buffer to base the coverage on." + (or (buffer-base-buffer) (current-buffer))) + +(defun go--coverage-face (count divisor) + "Return the intensity face for COUNT when using DIVISOR +to scale it to a range [0,10]. + +DIVISOR scales the absolute cover count to values from 0 to 10. +For DIVISOR = 0 the count will always translate to 8." + (let* ((norm (cond + ((= count 0) + -0.1) ;; Uncovered code, set to -0.1 so n becomes 0. + ((= divisor 0) + 0.8) ;; covermode=set, set to 0.8 so n becomes 8. + (t + (/ (log count) divisor)))) + (n (1+ (floor (* norm 9))))) ;; Convert normalized count [0,1] to intensity [0,10] + (concat "go-coverage-" (number-to-string n)))) + +(defun go--coverage-make-overlay (range divisor) + "Create a coverage overlay for a RANGE of covered/uncovered code. +Use DIVISOR to scale absolute counts to a [0,10] scale." + (let* ((count (go--covered-count range)) + (face (go--coverage-face count divisor)) + (ov (make-overlay (go--line-column-to-point (go--covered-start-line range) + (go--covered-start-column range)) + (go--line-column-to-point (go--covered-end-line range) + (go--covered-end-column range))))) + + (overlay-put ov 'face face) + (overlay-put ov 'help-echo (format "Count: %d" count)))) + +(defun go--coverage-clear-overlays () + "Remove existing overlays and put a single untracked overlay +over the entire buffer." + (remove-overlays) + (overlay-put (make-overlay (point-min) (point-max)) + 'face + 'go-coverage-untracked)) + +(defun go--coverage-parse-file (coverage-file file-name) + "Parse COVERAGE-FILE and extract coverage information and +divisor for FILE-NAME." + (let (ranges + (max-count 0)) + (with-temp-buffer + (insert-file-contents coverage-file) + (go--goto-line 2) ;; Skip over mode + (while (not (eobp)) + (let* ((parts (split-string (buffer-substring (point-at-bol) (point-at-eol)) ":")) + (file (car parts)) + (rest (split-string (nth 1 parts) "[., ]"))) + + (cl-destructuring-bind + (start-line start-column end-line end-column num count) + (mapcar #'string-to-number rest) + + (when (string= (file-name-nondirectory file) file-name) + (if (> count max-count) + (setq max-count count)) + (push (make-go--covered :start-line start-line + :start-column start-column + :end-line end-line + :end-column end-column + :covered (/= count 0) + :count count) + ranges))) + + (forward-line))) + + (list ranges (if (> max-count 0) (log max-count) 0))))) + +(defun go-coverage (&optional coverage-file) + "Open a clone of the current buffer and overlay it with +coverage information gathered via go test -coverprofile=COVERAGE-FILE. + +If COVERAGE-FILE is nil, it will either be inferred from the +current buffer if it's already a coverage buffer, or be prompted +for." + (interactive) + (let* ((cur-buffer (current-buffer)) + (origin-buffer (go--coverage-origin-buffer)) + (gocov-buffer-name (concat (buffer-name origin-buffer) "")) + (coverage-file (or coverage-file (go--coverage-file))) + (ranges-and-divisor (go--coverage-parse-file + coverage-file + (file-name-nondirectory (buffer-file-name origin-buffer)))) + (cov-mtime (nth 5 (file-attributes coverage-file))) + (cur-mtime (nth 5 (file-attributes (buffer-file-name origin-buffer))))) + + (if (< (float-time cov-mtime) (float-time cur-mtime)) + (message "Coverage file is older than the source file.")) + + (with-current-buffer (or (get-buffer gocov-buffer-name) + (make-indirect-buffer origin-buffer gocov-buffer-name t)) + (set (make-local-variable 'go--coverage-current-file-name) coverage-file) + + (save-excursion + (go--coverage-clear-overlays) + (dolist (range (car ranges-and-divisor)) + (go--coverage-make-overlay range (cadr ranges-and-divisor)))) + + (if (not (eq cur-buffer (current-buffer))) + (display-buffer (current-buffer) `(,go-coverage-display-buffer-func)))))) + +(defun go-goto-function (&optional arg) + "Go to the function defintion (named or anonymous) surrounding point. + +If we are on a docstring, follow the docstring down. +If no function is found, assume that we are at the top of a file +and search forward instead. + +If point is looking at the func keyword of an anonymous function, +go to the surrounding function. + +If ARG is non-nil, anonymous functions are ignored." + (interactive "P") + (let ((p (point))) + (cond + ((save-excursion + (beginning-of-line) + (looking-at "^//")) + ;; In case we are looking at the docstring, move on forward until we are + ;; not anymore + (beginning-of-line) + (while (looking-at "^//") + (forward-line 1)) + ;; If we are still not looking at a function, retry by calling self again. + (when (not (looking-at "\\")) + (go-goto-function arg))) + + ;; If we're already looking at an anonymous func, look for the + ;; surrounding function. + ((and (looking-at "\\") + (not (looking-at "^func\\>"))) + (re-search-backward "\\" nil t)) + + ((not (looking-at "\\")) + ;; If point is on the "func" keyword, step back a word and retry + (if (string= (symbol-name (symbol-at-point)) "func") + (backward-word) + ;; If we are not looking at the beginning of a function line, do a regexp + ;; search backwards + (re-search-backward "\\" nil t)) + + ;; If nothing is found, assume that we are at the top of the file and + ;; should search forward instead. + (when (not (looking-at "\\")) + (re-search-forward "\\" nil t) + (forward-word -1)) + + ;; If we have landed at an anonymous function, it is possible that we + ;; were not inside it but below it. If we were not inside it, we should + ;; go to the containing function. + (while (and (not (go--in-function-p p)) + (not (looking-at "^func\\>"))) + (go-goto-function arg))))) + + (cond + ((go-in-comment-p) + ;; If we are still in a comment, redo the call so that we get out of it. + (go-goto-function arg)) + + ((and (looking-at "\\")) + (go-goto-function)) + (let ((start (point))) + (go--goto-opening-curly-brace) + + (unless (looking-at "{") + (error "expected to be looking at opening curly brace")) + (forward-list 1) + (and (>= compare-point start) + (<= compare-point (point)))))) + +(defun go-goto-function-name (&optional arg) + "Go to the name of the current function. + +If the function is a test, place point after 'Test'. +If the function is anonymous, place point on the 'func' keyword. + +If ARG is non-nil, anonymous functions are skipped." + (interactive "P") + (when (not (looking-at "\\")) + (go-goto-function arg)) + ;; If we are looking at func( we are on an anonymous function and + ;; nothing else should be done. + (when (not (looking-at "\\ -;; URL: https://github.com/d11wtq/grizzl -;; Version: 0.1.1 -;; Keywords: convenience, usability - -;; This file is NOT part of GNU Emacs. - -;;; --- License - -;; Licensed under the same terms as Emacs. - -;;; --- Commentary - -;; Grizzl provides a fuzzy completion framework for general purpose -;; use in Emacs Lisp projects. -;; -;; grizzl-core.el provides the underlying data structures and sesrch -;; algorithm without any UI attachment. At the core, a fuzzy search -;; index is created from a list of strings, using `grizzl-make-index'. -;; A fuzzy search term is then used to get a result from this index -;; with `grizzl-search'. Because grizzl considers the usage of a -;; fuzzy search index to operate in real-time as a user enters a -;; search term in the minibuffer, the framework optimizes for this use -;; case. Any result can be passed back into `grizzl-search' as a hint -;; to continue searching. The search algorithm is able to understand -;; insertions and deletions and therefore minimizes the work it needs -;; to do in this case. The intended use here is to collect a result -;; on each key press and feed that result into the search for the next -;; key press. Once a search is complete, the matched strings are then -;; read, using `grizzl-result-strings'. The results are ordered on the -;; a combination of the Levenshtein Distance and a character-proximity -;; scoring calculation. This means shorter strings are favoured, but -;; adjacent letters are more heavily favoured. -;; -;; It is assumed that the index will be re-used across multiple -;; searches on larger sets of data. -;; -;; - -(eval-when-compile - (require 'cl-lib)) - -;;; --- Public Functions - -;;;###autoload -(defun grizzl-make-index (strings &rest options) - "Makes an index from the list STRINGS for use with `grizzl-search'. - -If :PROGRESS-FN is given as a keyword argument, it is called repeatedly -with integers N and TOTAL. - -If :CASE-SENSITIVE is specified as a non-nil keyword argument, the index -will be created case-sensitive, otherwise it will be case-insensitive." - (let ((lookup-table (make-hash-table)) - (total-strs (length strings)) - (case-sensitive (plist-get options :case-sensitive)) - (progress-fn (plist-get options :progress-fn)) - (string-data (vconcat (mapcar (lambda (s) - (cons s (length s))) - strings)))) - (reduce (lambda (list-offset str) - (grizzl-index-insert str list-offset lookup-table - :case-sensitive case-sensitive) - (when progress-fn - (funcall progress-fn (1+ list-offset) total-strs)) - (1+ list-offset)) - strings - :initial-value 0) - (maphash (lambda (char str-map) - (maphash (lambda (list-offset locations) - (puthash list-offset (reverse locations) str-map)) - str-map)) lookup-table) - `((case-sensitive . ,case-sensitive) - (lookup-table . ,lookup-table) - (string-data . ,string-data)))) - -;;;###autoload -(defun grizzl-search (term index &optional old-result) - "Fuzzy searches for TERM in INDEX prepared with `grizzl-make-index'. - -OLD-RESULT may be specified as an existing search result to increment from. -The result can be read with `grizzl-result-strings'." - (let* ((cased-term (if (grizzl-index-case-sensitive-p index) - term - (downcase term))) - (result (grizzl-rewind-result cased-term index old-result)) - (matches (copy-hash-table (grizzl-result-matches result))) - (from-pos (length (grizzl-result-term result))) - (remainder (substring cased-term from-pos)) - (lookup-table (grizzl-lookup-table index))) - (reduce (lambda (acc-res ch) - (let ((sub-table (gethash ch lookup-table))) - (if (not sub-table) - (clrhash matches) - (grizzl-search-increment sub-table matches)) - (grizzl-cons-result cased-term matches acc-res))) - remainder - :initial-value result))) - -;;;###autoload -(defun grizzl-result-count (result) - "Returns the number of matches present in RESULT." - (hash-table-count (grizzl-result-matches result))) - -;;;###autoload -(defun grizzl-result-strings (result index &rest options) - "Returns the ordered list of matched strings in RESULT, using INDEX. - -If the :START option is specified, results are read from the given offset. -If the :END option is specified, up to :END results are returned." - (let* ((matches (grizzl-result-matches result)) - (strings (grizzl-index-strings index)) - (loaded '()) - (start (plist-get options :start)) - (end (plist-get options :end))) - (maphash (lambda (string-offset char-offset) - (push string-offset loaded)) - matches) - (let* ((ordered (sort loaded - (lambda (a b) - (< (cadr (gethash a matches)) - (cadr (gethash b matches)))))) - (best (if (or start end) - (delete-if-not 'identity - (subseq ordered (or start 0) end)) - ordered))) - (mapcar (lambda (n) - (car (elt strings n))) - best)))) - -;;; --- Private Functions - -(defun grizzl-cons-result (term matches results) - "Build a new result for TERM and hash-table MATCHES consed with RESULTS." - (cons (cons term matches) results)) - -(defun grizzl-rewind-result (term index result) - "Adjusts RESULT according to TERM, ready for a new search." - (if result - (let* ((old-term (grizzl-result-term result)) - (new-len (length term)) - (old-len (length old-term))) - (if (and (>= new-len old-len) - (string-equal old-term (substring term 0 old-len))) - result - (grizzl-rewind-result term index (cdr result)))) - (grizzl-cons-result "" (grizzl-base-matches index) nil))) - -(defun grizzl-base-matches (index) - "Returns the full set of matches in INDEX, with an out-of-bound offset." - (let ((matches (make-hash-table))) - (reduce (lambda (n s-len) - (puthash n (list -1 0 (cdr s-len)) matches) - (1+ n)) - (grizzl-index-strings index) - :initial-value 0) - matches)) - -(defun grizzl-result-term (result) - "Returns the search term used to find the matches in RESULT." - (car (car result))) - -(defun grizzl-result-matches (result) - "Returns the internal hash used to track the matches in RESULT." - (cdar result)) - -(defun grizzl-index-insert (string list-offset index &rest options) - "Inserts STRING at LIST-OFFSET into INDEX." - (let ((case-sensitive (plist-get options :case-sensitive))) - (reduce (lambda (char-offset cs-char) - (let* ((char (if case-sensitive - cs-char - (downcase cs-char))) - (str-map (or (gethash char index) - (puthash char (make-hash-table) index))) - (offsets (gethash list-offset str-map))) - (puthash list-offset - (cons char-offset offsets) - str-map) - (1+ char-offset))) - string - :initial-value 0))) - -(defun grizzl-lookup-table (index) - "Returns the lookup table portion of INDEX." - (cdr (assoc 'lookup-table index))) - -(defun grizzl-index-strings (index) - "Returns the vector of strings stored in INDEX." - (cdr (assoc 'string-data index))) - -(defun grizzl-index-case-sensitive-p (index) - "Predicate to test of INDEX is case-sensitive." - (cdr (assoc 'case-sensitive index))) - -(defun grizzl-search-increment (sub-table result) - "Use the search lookup table to filter already-accumulated results." - (cl-flet ((next-offset (key current sub-table) - (find-if (lambda (v) - (> v current)) - (gethash key sub-table)))) - (maphash (lambda (k v) - (let* ((oldpos (car v)) - (oldrank (cadr v)) - (len (caddr v)) - (newpos (next-offset k oldpos sub-table))) - (if newpos - (puthash k (list newpos - (grizzl-inc-rank oldrank oldpos newpos len) - len) - result) - (remhash k result)))) - result))) - -(defun grizzl-inc-rank (oldrank oldpos newpos len) - "Increment the current match distance as a new char is matched." - (let ((distance (if (< oldpos 0) 1 (- newpos oldpos)))) - (+ oldrank (* len (* distance distance))))) - -(provide 'grizzl-core) - -;;; grizzl-core.el ends here diff --git a/elpa/grizzl-0.1.1/grizzl-pkg.el b/elpa/grizzl-0.1.1/grizzl-pkg.el deleted file mode 100644 index e296607..0000000 --- a/elpa/grizzl-0.1.1/grizzl-pkg.el +++ /dev/null @@ -1,3 +0,0 @@ -(define-package "grizzl" "0.1.1" - "Fuzzy Search Library & Completing Read" - '((cl-lib "0.1"))) diff --git a/elpa/grizzl-0.1.1/grizzl-read.el b/elpa/grizzl-0.1.1/grizzl-read.el deleted file mode 100644 index e08a2c2..0000000 --- a/elpa/grizzl-0.1.1/grizzl-read.el +++ /dev/null @@ -1,186 +0,0 @@ -;;; grizzl-read.el --- A fuzzy completing-read backed by grizzl. - -;; Copyright © 2013 Chris Corbyn -;; -;; Author: Chris Corbyn -;; URL: https://github.com/d11wtq/grizzl -;; Version: 0.1.1 -;; Keywords: convenience, usability - -;; This file is NOT part of GNU Emacs. - -;;; --- License - -;; Licensed under the same terms as Emacs. - -;;; --- Commentary - -;; grizzl-read.el provides an implementation of the built-in Emacs -;; completing-read function, except it is backed by the grizzl fuzzy -;; search index. The goals are similar to ido-mode and helm, but grizzl -;; is heavily optimized for large data-sets, and as-such uses a -;; persistent fuzzy search index in its algorithm. -;; -;; The indexing and searching algorithm itself is defined in grizzl-core.el -;; with grizzl-read.el simply wrapping the search in a minibuffer with a -;; minor-mode defined. -;; -;; ---- Usage -;; -;; Call `grizzl-completing-read' with an index returned by -;; `grizzl-make-index': -;; -;; (defvar *index* (grizzl-make-index '("one" "two" "three"))) -;; (grizzl-completing-read "Number: " index) -;; -;; When the user hits ENTER, either one of the strings is returned on -;; success, or nil of nothing matched. -;; -;; The arrow keys can be used to navigate within the results. -;; - -(eval-when-compile - (require 'cl-lib)) - -;;; --- Configuration Variables - -(defvar *grizzl-read-max-results* 10 - "The maximum number of results to show in `grizzl-completing-read'.") - -;;; --- Runtime Processing Variables - -(defvar *grizzl-current-result* nil - "The search result in `grizzl-completing-read'.") - -(defvar *grizzl-current-selection* 0 - "The selected offset in `grizzl-completing-read'.") - -;;; --- Minor Mode Definition - -(defvar *grizzl-keymap* (make-sparse-keymap) - "Internal keymap used by the minor-mode in `grizzl-completing-read'.") - -(define-key *grizzl-keymap* (kbd "") 'grizzl-set-selection+1) -(define-key *grizzl-keymap* (kbd "C-p") 'grizzl-set-selection+1) -(define-key *grizzl-keymap* (kbd "") 'grizzl-set-selection-1) -(define-key *grizzl-keymap* (kbd "C-n") 'grizzl-set-selection-1) - -(define-minor-mode grizzl-mode - "Toggle the internal mode used by `grizzl-completing-read'." - nil - " Grizzl" - *grizzl-keymap*) - -;;; --- Public Functions - -;;;###autoload -(defun grizzl-completing-read (prompt index) - "Performs a completing-read in the minibuffer using INDEX to fuzzy search. -Each key pressed in the minibuffer filters down the list of matches." - (minibuffer-with-setup-hook - (lambda () - (setq *grizzl-current-result* nil) - (setq *grizzl-current-selection* 0) - (grizzl-mode 1) - (lexical-let* - ((hookfun (lambda () - (setq *grizzl-current-result* - (grizzl-search (minibuffer-contents) - index - *grizzl-current-result*)) - (grizzl-display-result index prompt))) - (exitfun (lambda () - (grizzl-mode -1) - (remove-hook 'post-command-hook hookfun t)))) - (add-hook 'minibuffer-exit-hook exitfun nil t) - (add-hook 'post-command-hook hookfun nil t))) - (read-from-minibuffer ">>> ") - (grizzl-selected-result index))) - -;;;###autoload -(defun grizzl-selected-result (index) - "Get the selected string from INDEX in a `grizzl-completing-read'." - (elt (grizzl-result-strings *grizzl-current-result* index - :start 0 - :end *grizzl-read-max-results*) - (grizzl-current-selection))) - -;;;###autoload -(defun grizzl-set-selection+1 () - "Move the selection up one row in `grizzl-completing-read'." - (interactive) - (grizzl-move-selection 1)) - -;;;###autoload -(defun grizzl-set-selection-1 () - "Move the selection down one row in `grizzl-completing-read'." - (interactive) - (grizzl-move-selection -1)) - -;;; --- Private Functions - -(defun grizzl-move-selection (delta) - "Move the selection by DELTA rows in `grizzl-completing-read'." - (setq *grizzl-current-selection* (+ (grizzl-current-selection) delta)) - (when (not (= (grizzl-current-selection) *grizzl-current-selection*)) - (beep))) - -(defun grizzl-display-result (index prompt) - "Renders a series of overlays to list the matches in the result." - (let* ((matches (grizzl-result-strings *grizzl-current-result* index - :start 0 - :end *grizzl-read-max-results*))) - (delete-all-overlays) - (overlay-put (make-overlay (point-min) (point-min)) - 'before-string - (format "%s\n%s\n" - (mapconcat 'identity - (grizzl-map-format-matches matches) - "\n") - (grizzl-format-prompt-line prompt))) - (set-window-text-height nil (max 3 (+ 2 (length matches)))))) - -(defun grizzl-map-format-matches (matches) - "Convert the set of string MATCHES into propertized text objects." - (if (= 0 (length matches)) - (list (propertize "-- NO MATCH --" 'face 'outline-3)) - (cdr (reduce (lambda (acc str) - (let* ((idx (car acc)) - (lst (cdr acc)) - (sel (= idx (grizzl-current-selection)))) - (cons (1+ idx) - (cons (grizzl-format-match str sel) lst)))) - matches - :initial-value '(0))))) - -(defun grizzl-format-match (match-str selected) - "Default match string formatter in `grizzl-completing-read'. - -MATCH-STR is the string in the selection list and SELECTED is non-nil -if this is the current selection." - (let ((margin (if selected "> " " ")) - (face (if selected 'diredp-symlink 'default))) - (propertize (format "%s%s" margin match-str) 'face face))) - -(defun grizzl-format-prompt-line (prompt) - "Returns a string to render a full-width prompt in `grizzl-completing-read'." - (let* ((count (grizzl-result-count *grizzl-current-result*)) - (match-info (format " (%d candidate%s) ---- *-" - count (if (= count 1) "" "s")))) - (concat (propertize (format "-*%s *-" prompt) 'face 'modeline-inactive) - (propertize " " - 'face 'modeline-inactive - 'display `(space :align-to (- right - ,(1+ (length match-info))))) - (propertize match-info 'face 'modeline-inactive)))) - -(defun grizzl-current-selection () - "Get the currently selected index in `grizzl-completing-read'." - (let ((max-selection - (min (1- *grizzl-read-max-results*) - (1- (grizzl-result-count *grizzl-current-result*))))) - (max 0 (min max-selection *grizzl-current-selection*)))) - -(provide 'grizzl-read) - -;;; grizzl-read.el ends here diff --git a/elpa/grizzl-0.1.1/grizzl.el b/elpa/grizzl-0.1.1/grizzl.el deleted file mode 100644 index e60212c..0000000 --- a/elpa/grizzl-0.1.1/grizzl.el +++ /dev/null @@ -1,26 +0,0 @@ -;;; grizzl.el --- Fast fuzzy search index for Emacs. - -;; Copyright © 2013 Chris Corbyn -;; -;; Author: Chris Corbyn -;; URL: https://github.com/d11wtq/grizzl -;; Version: 0.1.1 -;; Keywords: convenience, usability - -;; This file is NOT part of GNU Emacs. - -;;; --- License - -;; Licensed under the same terms as Emacs. - -;;; --- Commentary - -;; This package is broken into separate files. -;; - -(require 'grizzl-core) -(require 'grizzl-read) - -(provide 'grizzl) - -;;; grizzl.el ends here diff --git a/elpa/grizzl-0.1.1/grizzl-autoloads.el b/elpa/grizzl-20160130.2351/grizzl-autoloads.el similarity index 61% rename from elpa/grizzl-0.1.1/grizzl-autoloads.el rename to elpa/grizzl-20160130.2351/grizzl-autoloads.el index 5e04778..aa8f249 100644 --- a/elpa/grizzl-0.1.1/grizzl-autoloads.el +++ b/elpa/grizzl-20160130.2351/grizzl-autoloads.el @@ -1,14 +1,12 @@ ;;; grizzl-autoloads.el --- automatically extracted autoloads ;; ;;; Code: - +(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) -;;;### (autoloads (grizzl-result-strings grizzl-result-count grizzl-search -;;;;;; grizzl-make-index) "grizzl-core" "grizzl-core.el" (21530 -;;;;;; 3273 796740 656000)) -;;; Generated autoloads from grizzl-core.el +;;;### (autoloads nil "grizzl" "grizzl.el" (22297 19824 853945 777000)) +;;; Generated autoloads from grizzl.el -(autoload 'grizzl-make-index "grizzl-core" "\ +(autoload 'grizzl-make-index "grizzl" "\ Makes an index from the list STRINGS for use with `grizzl-search'. If :PROGRESS-FN is given as a keyword argument, it is called repeatedly @@ -19,7 +17,7 @@ will be created case-sensitive, otherwise it will be case-insensitive. \(fn STRINGS &rest OPTIONS)" nil nil) -(autoload 'grizzl-search "grizzl-core" "\ +(autoload 'grizzl-search "grizzl" "\ Fuzzy searches for TERM in INDEX prepared with `grizzl-make-index'. OLD-RESULT may be specified as an existing search result to increment from. @@ -27,12 +25,12 @@ The result can be read with `grizzl-result-strings'. \(fn TERM INDEX &optional OLD-RESULT)" nil nil) -(autoload 'grizzl-result-count "grizzl-core" "\ +(autoload 'grizzl-result-count "grizzl" "\ Returns the number of matches present in RESULT. \(fn RESULT)" nil nil) -(autoload 'grizzl-result-strings "grizzl-core" "\ +(autoload 'grizzl-result-strings "grizzl" "\ Returns the ordered list of matched strings in RESULT, using INDEX. If the :START option is specified, results are read from the given offset. @@ -40,46 +38,32 @@ If the :END option is specified, up to :END results are returned. \(fn RESULT INDEX &rest OPTIONS)" nil nil) -;;;*** - -;;;### (autoloads (grizzl-set-selection-1 grizzl-set-selection+1 -;;;;;; grizzl-selected-result grizzl-completing-read) "grizzl-read" -;;;;;; "grizzl-read.el" (21530 3273 902738 462000)) -;;; Generated autoloads from grizzl-read.el - -(autoload 'grizzl-completing-read "grizzl-read" "\ +(autoload 'grizzl-completing-read "grizzl" "\ Performs a completing-read in the minibuffer using INDEX to fuzzy search. Each key pressed in the minibuffer filters down the list of matches. \(fn PROMPT INDEX)" nil nil) -(autoload 'grizzl-selected-result "grizzl-read" "\ +(autoload 'grizzl-selected-result "grizzl" "\ Get the selected string from INDEX in a `grizzl-completing-read'. \(fn INDEX)" nil nil) -(autoload 'grizzl-set-selection+1 "grizzl-read" "\ +(autoload 'grizzl-set-selection+1 "grizzl" "\ Move the selection up one row in `grizzl-completing-read'. \(fn)" t nil) -(autoload 'grizzl-set-selection-1 "grizzl-read" "\ +(autoload 'grizzl-set-selection-1 "grizzl" "\ Move the selection down one row in `grizzl-completing-read'. \(fn)" t nil) ;;;*** -;;;### (autoloads nil nil ("grizzl-pkg.el" "grizzl.el") (21530 3273 -;;;;;; 979764 956000)) - -;;;*** - -(provide 'grizzl-autoloads) ;; Local Variables: ;; version-control: never ;; no-byte-compile: t ;; no-update-autoloads: t -;; coding: utf-8 ;; End: ;;; grizzl-autoloads.el ends here diff --git a/elpa/grizzl-20160130.2351/grizzl-pkg.el b/elpa/grizzl-20160130.2351/grizzl-pkg.el new file mode 100644 index 0000000..bf87f2c --- /dev/null +++ b/elpa/grizzl-20160130.2351/grizzl-pkg.el @@ -0,0 +1 @@ +(define-package "grizzl" "20160130.2351" "Fast fuzzy search index for Emacs." '((cl-lib "0.5") (emacs "24.3")) :url "https://github.com/grizzl/grizzl" :keywords '("convenience" "usability")) diff --git a/elpa/grizzl-20160130.2351/grizzl.el b/elpa/grizzl-20160130.2351/grizzl.el new file mode 100644 index 0000000..625800a --- /dev/null +++ b/elpa/grizzl-20160130.2351/grizzl.el @@ -0,0 +1,399 @@ +;;; grizzl.el --- Fast fuzzy search index for Emacs. -*- lexical-binding: t -*- + +;; Copyright © 2013-2014 Chris Corbyn +;; Copyright © 2015 Bozhidar Batsov +;; +;; Author: Chris Corbyn +;; Maintainer: Bozhidar Batsov +;; URL: https://github.com/grizzl/grizzl +;; Package-Version: 20160130.2351 +;; Version: 0.1.2 +;; Keywords: convenience, usability +;; Package-Requires: ((cl-lib "0.5") (emacs "24.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 . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; Grizzl provides a fuzzy completion framework for general purpose +;; use in Emacs Lisp projects. +;; +;; grizzl provides the underlying data structures and sesrch +;; algorithm without any UI attachment. At the core, a fuzzy search +;; index is created from a list of strings, using `grizzl-make-index'. +;; A fuzzy search term is then used to get a result from this index +;; with `grizzl-search'. Because grizzl considers the usage of a +;; fuzzy search index to operate in real-time as a user enters a +;; search term in the minibuffer, the framework optimizes for this use +;; case. Any result can be passed back into `grizzl-search' as a hint +;; to continue searching. The search algorithm is able to understand +;; insertions and deletions and therefore minimizes the work it needs +;; to do in this case. The intended use here is to collect a result +;; on each key press and feed that result into the search for the next +;; key press. Once a search is complete, the matched strings are then +;; read, using `grizzl-result-strings'. The results are ordered on the +;; a combination of the Levenshtein Distance and a character-proximity +;; scoring calculation. This means shorter strings are favoured, but +;; adjacent letters are more heavily favoured. +;; +;; It is assumed that the index will be re-used across multiple +;; searches on larger sets of data. +;; +;; Call `grizzl-completing-read' with an index returned by +;; `grizzl-make-index': +;; +;; (defvar *index* (grizzl-make-index '("one" "two" "three"))) +;; (grizzl-completing-read "Number: " *index*) +;; +;; When the user hits ENTER, either one of the strings is returned on +;; success, or nil of nothing matched. +;; +;; The arrow keys can be used to navigate within the results. + + +;;; Code: + +(eval-when-compile + (require 'cl-lib)) + +;;; --- Public Functions + +;;;###autoload +(defun grizzl-make-index (strings &rest options) + "Makes an index from the list STRINGS for use with `grizzl-search'. + +If :PROGRESS-FN is given as a keyword argument, it is called repeatedly +with integers N and TOTAL. + +If :CASE-SENSITIVE is specified as a non-nil keyword argument, the index +will be created case-sensitive, otherwise it will be case-insensitive." + (let ((lookup-table (make-hash-table)) + (total-strs (length strings)) + (case-sensitive (plist-get options :case-sensitive)) + (progress-fn (plist-get options :progress-fn)) + (string-data (vconcat (mapcar (lambda (s) + (cons s (length s))) + strings)))) + (cl-reduce (lambda (list-offset str) + (grizzl-index-insert str list-offset lookup-table + :case-sensitive case-sensitive) + (when progress-fn + (funcall progress-fn (1+ list-offset) total-strs)) + (1+ list-offset)) + strings + :initial-value 0) + (maphash (lambda (_char str-map) + (maphash (lambda (list-offset locations) + (puthash list-offset (reverse locations) str-map)) + str-map)) lookup-table) + `((case-sensitive . ,case-sensitive) + (lookup-table . ,lookup-table) + (string-data . ,string-data)))) + +;;;###autoload +(defun grizzl-search (term index &optional old-result) + "Fuzzy searches for TERM in INDEX prepared with `grizzl-make-index'. + +OLD-RESULT may be specified as an existing search result to increment from. +The result can be read with `grizzl-result-strings'." + (let* ((cased-term (if (grizzl-index-case-sensitive-p index) + term + (downcase term))) + (result (grizzl-rewind-result cased-term index old-result)) + (matches (copy-hash-table (grizzl-result-matches result))) + (from-pos (length (grizzl-result-term result))) + (remainder (substring cased-term from-pos)) + (lookup-table (grizzl-lookup-table index))) + (cl-reduce (lambda (acc-res ch) + (let ((sub-table (gethash ch lookup-table))) + (if (not sub-table) + (clrhash matches) + (grizzl-search-increment sub-table matches)) + (grizzl-cons-result cased-term matches acc-res))) + remainder + :initial-value result))) + +;;;###autoload +(defun grizzl-result-count (result) + "Returns the number of matches present in RESULT." + (hash-table-count (grizzl-result-matches result))) + +;;;###autoload +(defun grizzl-result-strings (result index &rest options) + "Returns the ordered list of matched strings in RESULT, using INDEX. + +If the :START option is specified, results are read from the given offset. +If the :END option is specified, up to :END results are returned." + (let* ((matches (grizzl-result-matches result)) + (strings (grizzl-index-strings index)) + (loaded '())) + (maphash (lambda (string-offset _char-offset) + (push string-offset loaded)) + matches) + (let* ((ordered (sort loaded + (lambda (a b) + (< (cadr (gethash a matches)) + (cadr (gethash b matches)))))) + (start (or (plist-get options :start) 0)) + (end (min (plist-get options :end) (length ordered))) + (best (if (or start end) + (cl-delete-if-not 'identity + (cl-subseq ordered start end)) + ordered))) + (mapcar (lambda (n) + (car (elt strings n))) + best)))) + +;;; --- Private Functions + +(defun grizzl-cons-result (term matches results) + "Build a new result for TERM and hash-table MATCHES consed with RESULTS." + (cons (cons term matches) results)) + +(defun grizzl-rewind-result (term index result) + "Adjusts RESULT according to TERM, ready for a new search." + (if result + (let* ((old-term (grizzl-result-term result)) + (new-len (length term)) + (old-len (length old-term))) + (if (and (>= new-len old-len) + (string-equal old-term (substring term 0 old-len))) + result + (grizzl-rewind-result term index (cdr result)))) + (grizzl-cons-result "" (grizzl-base-matches index) nil))) + +(defun grizzl-base-matches (index) + "Returns the full set of matches in INDEX, with an out-of-bound offset." + (let ((matches (make-hash-table))) + (cl-reduce (lambda (n s-len) + (puthash n (list -1 0 (cdr s-len)) matches) + (1+ n)) + (grizzl-index-strings index) + :initial-value 0) + matches)) + +(defun grizzl-result-term (result) + "Returns the search term used to find the matches in RESULT." + (car (car result))) + +(defun grizzl-result-matches (result) + "Returns the internal hash used to track the matches in RESULT." + (cdar result)) + +(defun grizzl-index-insert (string list-offset index &rest options) + "Inserts STRING at LIST-OFFSET into INDEX." + (let ((case-sensitive (plist-get options :case-sensitive))) + (cl-reduce (lambda (char-offset cs-char) + (let* ((char (if case-sensitive + cs-char + (downcase cs-char))) + (str-map (or (gethash char index) + (puthash char (make-hash-table) index))) + (offsets (gethash list-offset str-map))) + (puthash list-offset + (cons char-offset offsets) + str-map) + (1+ char-offset))) + string + :initial-value 0))) + +(defun grizzl-lookup-table (index) + "Returns the lookup table portion of INDEX." + (cdr (assoc 'lookup-table index))) + +(defun grizzl-index-strings (index) + "Returns the vector of strings stored in INDEX." + (cdr (assoc 'string-data index))) + +(defun grizzl-index-case-sensitive-p (index) + "Predicate to test of INDEX is case-sensitive." + (cdr (assoc 'case-sensitive index))) + +(defun grizzl-search-increment (sub-table result) + "Use the search lookup table to filter already-accumulated results." + (cl-flet ((next-offset (key current sub-table) + (cl-find-if (lambda (v) + (> v current)) + (gethash key sub-table)))) + (maphash (lambda (k v) + (let* ((oldpos (car v)) + (oldrank (cadr v)) + (len (cl-caddr v)) + (newpos (next-offset k oldpos sub-table))) + (if newpos + (puthash k (list newpos + (grizzl-inc-rank oldrank oldpos newpos len) + len) + result) + (remhash k result)))) + result))) + +(defun grizzl-inc-rank (oldrank oldpos newpos len) + "Increment the current match distance as a new char is matched." + (let ((distance (if (< oldpos 0) 1 (- newpos oldpos)))) + (+ oldrank (* len (* distance distance))))) + +;;; --- Configuration Variables + +(defvar *grizzl-read-max-results* 10 + "The maximum number of results to show in `grizzl-completing-read'.") + +;;; --- Runtime Processing Variables + +(defvar *grizzl-current-result* nil + "The search result in `grizzl-completing-read'.") + +(defvar *grizzl-current-selection* 0 + "The selected offset in `grizzl-completing-read'.") + +(defface grizzl-selection-face + `((((class color) (background light)) + (:foreground "red")) + (((class color) (background dark)) + (:foreground "red")) + (t (:foreground "red"))) + "Face for selected result." + :group 'grizzl-mode) + + +;;; --- Minor Mode Definition + +(defvar *grizzl-keymap* (make-sparse-keymap) + "Internal keymap used by the minor-mode in `grizzl-completing-read'.") + +(define-key *grizzl-keymap* (kbd "") 'grizzl-set-selection+1) +(define-key *grizzl-keymap* (kbd "C-p") 'grizzl-set-selection+1) +(define-key *grizzl-keymap* (kbd "") 'grizzl-set-selection-1) +(define-key *grizzl-keymap* (kbd "C-n") 'grizzl-set-selection-1) + +(define-minor-mode grizzl-mode + "Toggle the internal mode used by `grizzl-completing-read'." + nil + " Grizzl" + *grizzl-keymap*) + +;;; --- Public Functions + +;;;###autoload +(defun grizzl-completing-read (prompt index) + "Performs a completing-read in the minibuffer using INDEX to fuzzy search. +Each key pressed in the minibuffer filters down the list of matches." + (minibuffer-with-setup-hook + (lambda () + (setq *grizzl-current-result* nil) + (setq *grizzl-current-selection* 0) + (grizzl-mode 1) + (let* ((hookfun (lambda () + (setq *grizzl-current-result* + (grizzl-search (minibuffer-contents) + index + *grizzl-current-result*)) + (grizzl-display-result index prompt))) + (exitfun (lambda () + (grizzl-mode -1) + (remove-hook 'post-command-hook hookfun t)))) + (add-hook 'minibuffer-exit-hook exitfun nil t) + (add-hook 'post-command-hook hookfun nil t))) + (let ((read-value (read-from-minibuffer ">>> "))) + (or (grizzl-selected-result index) read-value)))) + +;;;###autoload +(defun grizzl-selected-result (index) + "Get the selected string from INDEX in a `grizzl-completing-read'." + (elt (grizzl-result-strings *grizzl-current-result* index + :start 0 + :end *grizzl-read-max-results*) + (grizzl-current-selection))) + +;;;###autoload +(defun grizzl-set-selection+1 () + "Move the selection up one row in `grizzl-completing-read'." + (interactive) + (grizzl-move-selection 1)) + +;;;###autoload +(defun grizzl-set-selection-1 () + "Move the selection down one row in `grizzl-completing-read'." + (interactive) + (grizzl-move-selection -1)) + +;;; --- Private Functions + +(defun grizzl-move-selection (delta) + "Move the selection by DELTA rows in `grizzl-completing-read'." + (setq *grizzl-current-selection* (+ (grizzl-current-selection) delta)) + (when (not (= (grizzl-current-selection) *grizzl-current-selection*)) + (beep))) + +(defun grizzl-display-result (index prompt) + "Renders a series of overlays to list the matches in the result." + (let* ((matches (grizzl-result-strings *grizzl-current-result* index + :start 0 + :end *grizzl-read-max-results*))) + (delete-all-overlays) + (overlay-put (make-overlay (point-min) (point-min)) + 'before-string + (format "%s\n%s\n" + (mapconcat 'identity + (grizzl-map-format-matches matches) + "\n") + (grizzl-format-prompt-line prompt))) + (set-window-text-height nil (max 3 (+ 2 (length matches)))))) + +(defun grizzl-map-format-matches (matches) + "Convert the set of string MATCHES into propertized text objects." + (if (= 0 (length matches)) + (list (propertize "-- NO MATCH --" 'face 'outline-3)) + (cdr (cl-reduce (lambda (acc str) + (let* ((idx (car acc)) + (lst (cdr acc)) + (sel (= idx (grizzl-current-selection)))) + (cons (1+ idx) + (cons (grizzl-format-match str sel) lst)))) + matches + :initial-value '(0))))) + +(defun grizzl-format-match (match-str selected) + "Default match string formatter in `grizzl-completing-read'. + +MATCH-STR is the string in the selection list and SELECTED is non-nil +if this is the current selection." + (let ((margin (if selected "> " " ")) + (face (if selected 'grizzl-selection-face 'default))) + (propertize (format "%s%s" margin match-str) 'face face))) + +(defun grizzl-format-prompt-line (prompt) + "Returns a string to render a full-width prompt in `grizzl-completing-read'." + (let* ((count (grizzl-result-count *grizzl-current-result*)) + (match-info (format " (%d candidate%s) ---- *-" + count (if (= count 1) "" "s")))) + (concat (propertize (format "-*%s *-" prompt) 'face 'modeline-inactive) + (propertize " " + 'face 'modeline-inactive + 'display `(space :align-to (- right + ,(1+ (length match-info))))) + (propertize match-info 'face 'modeline-inactive)))) + +(defun grizzl-current-selection () + "Get the currently selected index in `grizzl-completing-read'." + (let ((max-selection + (min (1- *grizzl-read-max-results*) + (1- (grizzl-result-count *grizzl-current-result*))))) + (max 0 (min max-selection *grizzl-current-selection*)))) + +(provide 'grizzl) + +;;; grizzl.el ends here diff --git a/elpa/haml-mode-3.1.8/haml-mode-autoloads.el b/elpa/haml-mode-20150508.2011/haml-mode-autoloads.el similarity index 85% rename from elpa/haml-mode-3.1.8/haml-mode-autoloads.el rename to elpa/haml-mode-20150508.2011/haml-mode-autoloads.el index c015733..22c92e4 100644 --- a/elpa/haml-mode-3.1.8/haml-mode-autoloads.el +++ b/elpa/haml-mode-20150508.2011/haml-mode-autoloads.el @@ -3,8 +3,8 @@ ;;; Code: (add-to-list 'load-path (or (file-name-directory #$) (car load-path))) -;;;### (autoloads nil "haml-mode" "haml-mode.el" (21831 16635 83188 -;;;;;; 122000)) +;;;### (autoloads nil "haml-mode" "haml-mode.el" (22297 19823 772965 +;;;;;; 110000)) ;;; Generated autoloads from haml-mode.el (autoload 'haml-mode "haml-mode" "\ diff --git a/elpa/haml-mode-20150508.2011/haml-mode-pkg.el b/elpa/haml-mode-20150508.2011/haml-mode-pkg.el new file mode 100644 index 0000000..1483a7e --- /dev/null +++ b/elpa/haml-mode-20150508.2011/haml-mode-pkg.el @@ -0,0 +1 @@ +(define-package "haml-mode" "20150508.2011" "Major mode for editing Haml files" '((ruby-mode "1.0")) :url "http://github.com/nex3/haml/tree/master" :keywords '("markup" "language" "html")) diff --git a/elpa/haml-mode-3.1.8/haml-mode.el b/elpa/haml-mode-20150508.2011/haml-mode.el similarity index 97% rename from elpa/haml-mode-3.1.8/haml-mode.el rename to elpa/haml-mode-20150508.2011/haml-mode.el index ad7ed82..e022958 100644 --- a/elpa/haml-mode-3.1.8/haml-mode.el +++ b/elpa/haml-mode-20150508.2011/haml-mode.el @@ -1,13 +1,14 @@ ;;; haml-mode.el --- Major mode for editing Haml files -;; Copyright (c) 2007, 2008 Nathan Weizenbaum +;; Copyright (c) 2007, 2008 Natalie Weizenbaum -;; Author: Nathan Weizenbaum +;; Author: Natalie Weizenbaum ;; URL: http://github.com/nex3/haml/tree/master +;; Package-Version: 20150508.2011 ;; Package-Requires: ((ruby-mode "1.0")) -;; Version: 3.1.8 +;; Version: DEV ;; Created: 2007-03-08 -;; By: Nathan Weizenbaum +;; By: Natalie Weizenbaum ;; Keywords: markup, language, html ;;; Commentary: @@ -104,7 +105,7 @@ The line containing RE is matched, as well as all lines indented beneath it." ("^!!!.*" 0 font-lock-constant-face) ("\\s| *$" 0 font-lock-string-face))) -(defconst haml-filter-re (haml-nested-regexp ":\\w+")) +(defconst haml-filter-re (haml-nested-regexp ":[[:alnum:]_\\-]+")) (defconst haml-comment-re (haml-nested-regexp "\\(?:-\\#\\|/\\)[^\n]*")) (defun haml-highlight-comment (limit) @@ -167,7 +168,7 @@ This requires that `css-mode' is available. (defun haml-fontify-region-as-javascript (beg end) "Fontify javascript code from BEG to END. -This requires that Karl Landström's javascript mode be available, either as the +This requires that Karl Landström's javascript mode be available, either as the \"js.el\" bundled with Emacs >= 23, or as \"javascript.el\" found in ELPA and elsewhere." (let ((keywords (or (and (featurep 'js) js--font-lock-keywords-3) @@ -467,7 +468,6 @@ changes in the initial region." (defvar haml-mode-syntax-table (let ((table (make-syntax-table))) (modify-syntax-entry ?: "." table) - (modify-syntax-entry ?_ "w" table) (modify-syntax-entry ?' "\"" table) table) "Syntax table in use in `haml-mode' buffers.") @@ -493,7 +493,6 @@ changes in the initial region." "Major mode for editing Haml files. \\{haml-mode-map}" - (set-syntax-table haml-mode-syntax-table) (setq font-lock-extend-region-functions '(haml-extend-region-contextual)) (set (make-local-variable 'jit-lock-contextually) t) (set (make-local-variable 'font-lock-multiline) t) @@ -502,6 +501,8 @@ changes in the initial region." (set (make-local-variable 'parse-sexp-lookup-properties) t) (set (make-local-variable 'comment-start) "-#") (setq font-lock-defaults '((haml-font-lock-keywords) t t)) + (when (boundp 'electric-indent-inhibit) + (setq electric-indent-inhibit t)) (setq indent-tabs-mode nil)) ;; Useful functions @@ -681,14 +682,14 @@ See http://www.w3.org/TR/html-markup/syntax.html.") (defun haml-indent-p () "Return t if the current line can have lines nested beneath it." (let ((attr-props (haml-parse-multiline-attr-hash))) - (when attr-props - (return-from haml-indent-p - (if (haml-unclosed-attr-hash-p) (cdr (assq 'hash-indent attr-props)) - (list (+ (cdr (assq 'indent attr-props)) haml-indent-offset) nil))))) - (unless (or (haml-unnestable-tag-p)) - (loop for opener in haml-block-openers - if (looking-at opener) return t - finally return nil))) + (if attr-props + (if (haml-unclosed-attr-hash-p) + (cdr (assq 'hash-indent attr-props)) + (+ (cdr (assq 'indent attr-props)) haml-indent-offset)) + (unless (or (haml-unnestable-tag-p)) + (loop for opener in haml-block-openers + if (looking-at opener) return t + finally return nil))))) (defun* haml-parse-multiline-attr-hash () "Parses a multiline attribute hash, and returns diff --git a/elpa/haml-mode-3.1.8/haml-mode-pkg.el b/elpa/haml-mode-3.1.8/haml-mode-pkg.el deleted file mode 100644 index 3ce6fa1..0000000 --- a/elpa/haml-mode-3.1.8/haml-mode-pkg.el +++ /dev/null @@ -1 +0,0 @@ -(define-package "haml-mode" "3.1.8" "Major mode for editing Haml files" '((ruby-mode "1.0"))) diff --git a/elpa/helm-20160421.621/emacs-helm.sh b/elpa/helm-20160421.621/emacs-helm.sh new file mode 100755 index 0000000..1213a86 --- /dev/null +++ b/elpa/helm-20160421.621/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/elpa/helm-20160421.621/helm-adaptive.el b/elpa/helm-20160421.621/helm-adaptive.el new file mode 100644 index 0000000..29b675f --- /dev/null +++ b/elpa/helm-20160421.621/helm-adaptive.el @@ -0,0 +1,244 @@ +;;; 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 + (assoc (assoc-default 'type source) + helm-type-attributes)) + (assoc-default 'candidate-transformer + (assoc (assoc-default 'type source) + helm-type-attributes)) + (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)) + (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 (CANIDATE . USAGE-COUNT) + ;; pairs + (mapcar (lambda (candidate-info) + (let ((count 0)) + (cl-dolist (pattern-info (cdr candidate-info)) + (if (not (equal (car pattern-info) + helm-pattern)) + (cl-incf count (cdr pattern-info)) + + ;; 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 (cdr pattern-info))) + (cl-return))) + (cons (car candidate-info) count))) + (cdr source-info)))) + (if (and usage (consp usage)) + ;; sort the list in descending order, so candidates with highest + ;; priorty come first + (progn + (setq usage (sort usage (lambda (first second) + (> (cdr first) (cdr second))))) + + ;; put those candidates first which have the highest usage count + (cl-loop for (info . _freq) in usage + for member = (cl-member info candidates + :test 'helm-adaptive-compare) + when member collect (car member) into sorted + and do + (setq candidates (cl-remove info candidates + :test 'helm-adaptive-compare)) + finally return (append sorted candidates))) + (message "Your `%s' is maybe corrupted or too old, \ +you should reinitialize it with `helm-reset-adaptive-history'" + helm-adaptive-history-file) + (sit-for 1) + candidates)) + ;; if there is no information stored for this source then do nothing + candidates))) + +;;;###autoload +(defun helm-reset-adaptive-history () + "Delete all `helm-adaptive-history' and his file. +Useful when you have a old or corrupted `helm-adaptive-history-file'." + (interactive) + (when (y-or-n-p "Really delete all your `helm-adaptive-history'? ") + (setq helm-adaptive-history nil) + (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/elpa/helm-20160421.621/helm-apt.el b/elpa/helm-20160421.621/helm-apt.el new file mode 100644 index 0000000..d8ea2fa --- /dev/null +++ b/elpa/helm-20160421.621/helm-apt.el @@ -0,0 +1,300 @@ +;;; 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")))) + (beg (point)) + end + (cand-list (mapconcat (lambda (x) (format "'%s'" x)) + (helm-marked-candidates) " "))) + (goto-char (point-max)) + (insert (concat command cand-list)) + (setq end (point)) + (if (y-or-n-p (format "%s package(s)" (symbol-name action))) + (progn + (setq helm-external-commands-list nil) + (setq helm-apt-installed-packages nil) + (term-char-mode) (term-send-input)) + (delete-region beg end)))) + +;;;###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/elpa/helm-20160421.621/helm-autoloads.el b/elpa/helm-20160421.621/helm-autoloads.el new file mode 100644 index 0000000..a407d5e --- /dev/null +++ b/elpa/helm-20160421.621/helm-autoloads.el @@ -0,0 +1,940 @@ +;;; helm-autoloads.el --- automatically extracted autoloads +;; +;;; Code: +(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) + +;;;### (autoloads nil "helm-adaptive" "helm-adaptive.el" (22297 20826 +;;;;;; 911994 142000)) +;;; Generated autoloads from helm-adaptive.el + +(defvar helm-adaptive-mode nil "\ +Non-nil if Helm-Adaptive mode is enabled. +See the command `helm-adaptive-mode' for a description of this minor mode. +Setting this variable directly does not take effect; +either customize it (see the info node `Easy Customization') +or call the function `helm-adaptive-mode'.") + +(custom-autoload 'helm-adaptive-mode "helm-adaptive" nil) + +(autoload 'helm-adaptive-mode "helm-adaptive" "\ +Toggle adaptive sorting in all sources. + +\(fn &optional ARG)" t nil) + +(autoload 'helm-reset-adaptive-history "helm-adaptive" "\ +Delete all `helm-adaptive-history' and his file. +Useful when you have a old or corrupted `helm-adaptive-history-file'. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-apt" "helm-apt.el" (22297 20826 663998 +;;;;;; 593000)) +;;; Generated autoloads from helm-apt.el + +(autoload 'helm-apt "helm-apt" "\ +Preconfigured `helm' : frontend of APT package manager. +With a prefix arg reload cache. + +\(fn ARG)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-bookmark" "helm-bookmark.el" (22297 20827 +;;;;;; 343986 390000)) +;;; Generated autoloads from helm-bookmark.el + +(autoload 'helm-bookmarks "helm-bookmark" "\ +Preconfigured `helm' for bookmarks. + +\(fn)" t nil) + +(autoload 'helm-filtered-bookmarks "helm-bookmark" "\ +Preconfigured helm for bookmarks (filtered by category). +Optional source `helm-source-bookmark-addressbook' is loaded +only if external library addressbook-bookmark.el is available. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-buffers" "helm-buffers.el" (22297 20826 +;;;;;; 572000 244000)) +;;; Generated autoloads from helm-buffers.el + +(autoload 'helm-buffers-list "helm-buffers" "\ +Preconfigured `helm' to list buffers. + +\(fn)" t nil) + +(autoload 'helm-mini "helm-buffers" "\ +Preconfigured `helm' lightweight version (buffer -> recentf). + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-color" "helm-color.el" (22297 20827 210988 +;;;;;; 776000)) +;;; Generated autoloads from helm-color.el + +(autoload 'helm-colors "helm-color" "\ +Preconfigured `helm' for color. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-command" "helm-command.el" (22297 20826 +;;;;;; 137008 49000)) +;;; Generated autoloads from helm-command.el + +(autoload 'helm-M-x "helm-command" "\ +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, are passed AFTER starting `helm-M-x'. + +You can get help on each command by persistent action. + +\(fn ARG &optional COMMAND-NAME)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-config" "helm-config.el" (22297 20827 +;;;;;; 301987 144000)) +;;; Generated autoloads from helm-config.el + +(autoload 'helm-configuration "helm-config" "\ +Customize `helm'. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-dabbrev" "helm-dabbrev.el" (22297 20826 +;;;;;; 746997 104000)) +;;; Generated autoloads from helm-dabbrev.el + +(autoload 'helm-dabbrev "helm-dabbrev" "\ +Preconfigured helm for dynamic abbreviations. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-elisp" "helm-elisp.el" (22297 20827 256987 +;;;;;; 951000)) +;;; Generated autoloads from helm-elisp.el + +(autoload 'helm-lisp-completion-at-point "helm-elisp" "\ +Preconfigured helm for lisp symbol completion at point. + +\(fn)" t nil) + +(autoload 'helm-complete-file-name-at-point "helm-elisp" "\ +Preconfigured helm to complete file name at point. + +\(fn &optional FORCE)" t nil) + +(autoload 'helm-lisp-indent "helm-elisp" "\ + + +\(fn)" t nil) + +(autoload 'helm-lisp-completion-or-file-name-at-point "helm-elisp" "\ +Preconfigured helm to complete lisp symbol or filename at point. +Filename completion happen if string start after or between a double quote. + +\(fn)" t nil) + +(autoload 'helm-apropos "helm-elisp" "\ +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. + +\(fn DEFAULT)" t nil) + +(autoload 'helm-manage-advice "helm-elisp" "\ +Preconfigured `helm' to disable/enable function advices. + +\(fn)" t nil) + +(autoload 'helm-locate-library "helm-elisp" "\ +Preconfigured helm to locate elisp libraries. + +\(fn)" t nil) + +(autoload 'helm-timers "helm-elisp" "\ +Preconfigured `helm' for timers. + +\(fn)" t nil) + +(autoload 'helm-complex-command-history "helm-elisp" "\ +Preconfigured helm for complex command history. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-elisp-package" "helm-elisp-package.el" +;;;;;; (22297 20826 183007 225000)) +;;; Generated autoloads from helm-elisp-package.el + +(autoload 'helm-list-elisp-packages "helm-elisp-package" "\ +Preconfigured helm for listing and handling emacs packages. + +\(fn ARG)" t nil) + +(autoload 'helm-list-elisp-packages-no-fetch "helm-elisp-package" "\ +Preconfigured helm for emacs packages. +Same as `helm-list-elisp-packages' but don't fetch packages on remote. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-elscreen" "helm-elscreen.el" (22297 20826 +;;;;;; 63009 378000)) +;;; Generated autoloads from helm-elscreen.el + +(autoload 'helm-elscreen "helm-elscreen" "\ +Preconfigured helm to list elscreen. + +\(fn)" t nil) + +(autoload 'helm-elscreen-history "helm-elscreen" "\ +Preconfigured helm to list elscreen in history order. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-eshell" "helm-eshell.el" (22297 20826 +;;;;;; 307004 999000)) +;;; Generated autoloads from helm-eshell.el + +(autoload 'helm-esh-pcomplete "helm-eshell" "\ +Preconfigured helm to provide helm completion in eshell. + +\(fn)" t nil) + +(autoload 'helm-eshell-history "helm-eshell" "\ +Preconfigured helm for eshell history. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-eval" "helm-eval.el" (22297 20826 994992 +;;;;;; 653000)) +;;; Generated autoloads from helm-eval.el + +(autoload 'helm-eval-expression "helm-eval" "\ +Preconfigured helm for `helm-source-evaluation-result'. + +\(fn ARG)" t nil) + +(autoload 'helm-eval-expression-with-eldoc "helm-eval" "\ +Preconfigured helm for `helm-source-evaluation-result' with `eldoc' support. + +\(fn)" t nil) + +(autoload 'helm-calcul-expression "helm-eval" "\ +Preconfigured helm for `helm-source-calculation-result'. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-external" "helm-external.el" (22297 20825 +;;;;;; 971011 29000)) +;;; Generated autoloads from helm-external.el + +(autoload 'helm-run-external-command "helm-external" "\ +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'. + +\(fn PROGRAM)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-files" "helm-files.el" (22297 20826 787996 +;;;;;; 368000)) +;;; Generated autoloads from helm-files.el + +(autoload 'helm-browse-project "helm-files" "\ +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 +. + +\(fn ARG)" t nil) + +(autoload 'helm-find "helm-files" "\ +Preconfigured `helm' for the find shell command. + +\(fn ARG)" t nil) + +(autoload 'helm-find-files "helm-files" "\ +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. + +\(fn ARG)" t nil) + +(autoload 'helm-for-files "helm-files" "\ +Preconfigured `helm' for opening files. +Run all sources defined in `helm-for-files-preferred-list'. + +\(fn)" t nil) + +(autoload 'helm-multi-files "helm-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. + +\(fn)" t nil) + +(autoload 'helm-recentf "helm-files" "\ +Preconfigured `helm' for `recentf'. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-font" "helm-font.el" (22297 20826 353004 +;;;;;; 173000)) +;;; Generated autoloads from helm-font.el + +(autoload 'helm-select-xfont "helm-font" "\ +Preconfigured `helm' to select Xfont. + +\(fn)" t nil) + +(autoload 'helm-ucs "helm-font" "\ +Preconfigured helm for `ucs-names' math symbols. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-grep" "helm-grep.el" (22297 20827 384985 +;;;;;; 653000)) +;;; Generated autoloads from helm-grep.el + +(autoload 'helm-goto-precedent-file "helm-grep" "\ +Go to precedent file in helm grep/etags buffers. + +\(fn)" t nil) + +(autoload 'helm-goto-next-file "helm-grep" "\ +Go to precedent file in helm grep/etags buffers. + +\(fn)" t nil) + +(autoload 'helm-do-grep-ag "helm-grep" "\ +Preconfigured helm for grepping with AG in `default-directory'. +With prefix-arg prompt for type if available with your AG version. + +\(fn ARG)" t nil) + +(autoload 'helm-grep-do-git-grep "helm-grep" "\ +Preconfigured helm for git-grepping `default-directory'. +With a prefix arg ARG git-grep the whole repository. + +\(fn ARG)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-help" "helm-help.el" (22297 20825 925011 +;;;;;; 854000)) +;;; Generated autoloads from helm-help.el + +(autoload 'helm-documentation "helm-help" "\ +Preconfigured helm for helm documentation. +With a prefix arg refresh the documentation. + +Find here the documentation of all sources actually documented. + +\(fn ARG)" t nil) + +(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") + +(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'.") + +(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") + +(autoload 'helm-describe-helm-attribute "helm-help" "\ +Display the full documentation of HELM-ATTRIBUTE. +HELM-ATTRIBUTE should be a symbol. + +\(fn HELM-ATTRIBUTE)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-id-utils" "helm-id-utils.el" (22297 20826 +;;;;;; 617999 418000)) +;;; Generated autoloads from helm-id-utils.el + +(autoload 'helm-gid "helm-id-utils" "\ +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 . + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-imenu" "helm-imenu.el" (22297 20826 481001 +;;;;;; 877000)) +;;; Generated autoloads from helm-imenu.el + +(autoload 'helm-imenu "helm-imenu" "\ +Preconfigured `helm' for `imenu'. + +\(fn)" t nil) + +(autoload 'helm-imenu-in-all-buffers "helm-imenu" "\ +Preconfigured helm for fetching imenu entries of all buffers. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-info" "helm-info.el" (22297 20826 398003 +;;;;;; 366000)) +;;; Generated autoloads from helm-info.el + +(autoload 'helm-info "helm-info" "\ +Preconfigured `helm' for searching Info files' indices. + +\(fn)" t nil) + +(autoload 'helm-info-at-point "helm-info" "\ +Preconfigured `helm' for searching info at point. +With a prefix-arg insert symbol at point. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-locate" "helm-locate.el" (22297 20826 +;;;;;; 17010 203000)) +;;; Generated autoloads from helm-locate.el + +(autoload 'helm-projects-find-files "helm-locate" "\ +Find files with locate in `helm-locate-project-list'. +With a prefix arg refresh the database in each project. + +\(fn UPDATE)" t nil) + +(autoload 'helm-locate "helm-locate" "\ +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'. + +\(fn ARG)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-man" "helm-man.el" (22297 20827 40991 +;;;;;; 828000)) +;;; Generated autoloads from helm-man.el + +(autoload 'helm-man-woman "helm-man" "\ +Preconfigured `helm' for Man and Woman pages. +With a prefix arg reinitialize the cache. + +\(fn ARG)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-misc" "helm-misc.el" (22297 20826 870994 +;;;;;; 878000)) +;;; Generated autoloads from helm-misc.el + +(autoload 'helm-browse-menubar "helm-misc" "\ +Preconfigured helm to the menubar using lacarte.el. + +\(fn)" t nil) + +(autoload 'helm-world-time "helm-misc" "\ +Preconfigured `helm' to show world time. +Default action change TZ environment variable locally to emacs. + +\(fn)" t nil) + +(autoload 'helm-insert-latex-math "helm-misc" "\ +Preconfigured helm for latex math symbols completion. + +\(fn)" t nil) + +(autoload 'helm-ratpoison-commands "helm-misc" "\ +Preconfigured `helm' to execute ratpoison commands. + +\(fn)" t nil) + +(autoload 'helm-stumpwm-commands "helm-misc" "\ +Preconfigured helm for stumpwm commands. + +\(fn)" t nil) + +(autoload 'helm-minibuffer-history "helm-misc" "\ +Preconfigured `helm' for `minibuffer-history'. + +\(fn)" t nil) + +(autoload 'helm-comint-input-ring "helm-misc" "\ +Preconfigured `helm' that provide completion of `comint' history. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-mode" "helm-mode.el" (22297 20825 796014 +;;;;;; 170000)) +;;; Generated autoloads from helm-mode.el + +(autoload 'helm-comp-read "helm-mode" "\ +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. + +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. + +\(fn 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 EXEC-WHEN-ONLY-ONE QUIT-WHEN-NO-CAND (volatile t) SORT (fc-transformer (quote helm-cr-default-transformer)) HIST-FC-TRANSFORMER MARKED-CANDIDATES NOMARK (alistp t) (candidate-number-limit helm-candidate-number-limit))" nil nil) + +(autoload 'helm-read-file-name "helm-mode" "\ +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'. + +\(fn 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 (quote 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))" nil nil) + +(defvar helm-mode nil "\ +Non-nil if Helm mode is enabled. +See the command `helm-mode' for a description of this minor mode. +Setting this variable directly does not take effect; +either customize it (see the info node `Easy Customization') +or call the function `helm-mode'.") + +(custom-autoload 'helm-mode "helm-mode" nil) + +(autoload 'helm-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. + +\(fn &optional ARG)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-net" "helm-net.el" (22297 20827 169989 +;;;;;; 513000)) +;;; Generated autoloads from helm-net.el + +(autoload 'helm-surfraw "helm-net" "\ +Preconfigured `helm' to search PATTERN with search ENGINE. + +\(fn PATTERN ENGINE)" t nil) + +(autoload 'helm-google-suggest "helm-net" "\ +Preconfigured `helm' for google search with google suggest. + +\(fn)" t nil) + +(autoload 'helm-wikipedia-suggest "helm-net" "\ +Preconfigured `helm' for Wikipedia lookup with Wikipedia suggest. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-org" "helm-org.el" (22297 20827 426984 +;;;;;; 900000)) +;;; Generated autoloads from helm-org.el + +(autoload 'helm-org-agenda-files-headings "helm-org" "\ +Preconfigured helm for org files headings. + +\(fn)" t nil) + +(autoload 'helm-org-in-buffer-headings "helm-org" "\ +Preconfigured helm for org buffer headings. + +\(fn)" t nil) + +(autoload 'helm-org-parent-headings "helm-org" "\ +Preconfigured helm for org headings that are parents of the +current heading. + +\(fn)" t nil) + +(autoload 'helm-org-capture-templates "helm-org" "\ +Preconfigured helm for org templates. + +\(fn)" t nil) + +(autoload 'helm-org-completing-read-tags "helm-org" "\ + + +\(fn PROMPT COLLECTION PRED REQ INITIAL HIST DEF INHERIT-INPUT-METHOD NAME BUFFER)" nil nil) + +;;;*** + +;;;### (autoloads nil "helm-regexp" "helm-regexp.el" (22297 20827 +;;;;;; 127990 267000)) +;;; Generated autoloads from helm-regexp.el + +(autoload 'helm-moccur-mode "helm-regexp" "\ +Major mode to provide actions in helm moccur saved buffer. + +Special commands: +\\{helm-moccur-mode-map} + +\(fn)" t nil) + +(autoload 'helm-regexp "helm-regexp" "\ +Preconfigured helm to build regexps. +`query-replace-regexp' can be run from there against found regexp. + +\(fn)" t nil) + +(autoload 'helm-occur "helm-regexp" "\ +Preconfigured helm for Occur. + +\(fn)" t nil) + +(autoload 'helm-occur-from-isearch "helm-regexp" "\ +Invoke `helm-occur' from isearch. + +\(fn)" t nil) + +(autoload 'helm-multi-occur-from-isearch "helm-regexp" "\ +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. + +\(fn &optional ARG)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-ring" "helm-ring.el" (22297 20825 884012 +;;;;;; 590000)) +;;; Generated autoloads from helm-ring.el + +(defvar helm-push-mark-mode nil "\ +Non-nil if Helm-Push-Mark mode is enabled. +See the command `helm-push-mark-mode' for a description of this minor mode. +Setting this variable directly does not take effect; +either customize it (see the info node `Easy Customization') +or call the function `helm-push-mark-mode'.") + +(custom-autoload 'helm-push-mark-mode "helm-ring" nil) + +(autoload 'helm-push-mark-mode "helm-ring" "\ +Provide an improved version of `push-mark'. +Modify the behavior of `push-mark' to update +the `global-mark-ring' after each new visit. + +\(fn &optional ARG)" t nil) + +(autoload 'helm-mark-ring "helm-ring" "\ +Preconfigured `helm' for `helm-source-mark-ring'. + +\(fn)" t nil) + +(autoload 'helm-global-mark-ring "helm-ring" "\ +Preconfigured `helm' for `helm-source-global-mark-ring'. + +\(fn)" t nil) + +(autoload 'helm-all-mark-rings "helm-ring" "\ +Preconfigured `helm' for `helm-source-global-mark-ring' and `helm-source-mark-ring'. + +\(fn)" t nil) + +(autoload 'helm-register "helm-ring" "\ +Preconfigured `helm' for Emacs registers. + +\(fn)" t nil) + +(autoload 'helm-show-kill-ring "helm-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. + +\(fn)" t nil) + +(autoload 'helm-execute-kmacro "helm-ring" "\ +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. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-semantic" "helm-semantic.el" (22297 20826 +;;;;;; 523001 123000)) +;;; Generated autoloads from helm-semantic.el + +(autoload 'helm-semantic "helm-semantic" "\ +Preconfigured `helm' for `semantic'. +If ARG is supplied, pre-select symbol at point instead of current + +\(fn ARG)" t nil) + +(autoload 'helm-semantic-or-imenu "helm-semantic" "\ +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. + +\(fn ARG)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-sys" "helm-sys.el" (22297 20826 704997 +;;;;;; 857000)) +;;; Generated autoloads from helm-sys.el + +(autoload 'helm-top "helm-sys" "\ +Preconfigured `helm' for top command. + +\(fn)" t nil) + +(autoload 'helm-list-emacs-process "helm-sys" "\ +Preconfigured `helm' for emacs process. + +\(fn)" t nil) + +(autoload 'helm-xrandr-set "helm-sys" "\ +Preconfigured helm for xrandr. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-tags" "helm-tags.el" (22297 20826 262005 +;;;;;; 807000)) +;;; Generated autoloads from helm-tags.el + +(autoload 'helm-etags-select "helm-tags" "\ +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. + +\(fn REINIT)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-utils" "helm-utils.el" (22297 20826 91008 +;;;;;; 876000)) +;;; Generated autoloads from helm-utils.el + +(defvar helm-popup-tip-mode nil "\ +Non-nil if Helm-Popup-Tip mode is enabled. +See the command `helm-popup-tip-mode' for a description of this minor mode. +Setting this variable directly does not take effect; +either customize it (see the info node `Easy Customization') +or call the function `helm-popup-tip-mode'.") + +(custom-autoload 'helm-popup-tip-mode "helm-utils" nil) + +(autoload 'helm-popup-tip-mode "helm-utils" "\ +Show help-echo informations in a popup tip at end of line. + +\(fn &optional ARG)" t nil) + +;;;*** + +;;;### (autoloads nil nil ("helm-easymenu.el" "helm-multi-match.el" +;;;;;; "helm-pkg.el" "helm-plugin.el" "helm-types.el") (22297 20827 +;;;;;; 514325 542000)) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; End: +;;; helm-autoloads.el ends here diff --git a/elpa/helm-20160421.621/helm-bookmark.el b/elpa/helm-20160421.621/helm-bookmark.el new file mode 100644 index 0000000..9ce49ce --- /dev/null +++ b/elpa/helm-20160421.621/helm-bookmark.el @@ -0,0 +1,739 @@ +;;; 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-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)) + + +(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)) + +(defvar helm-source-bookmark-helm-find-files + (helm-make-source "Bookmark helm-find-files sessions" 'helm-source-filtered-bookmarks + :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. +;; +;; +(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 + (helm-bookmark-addressbook-setup-alist)))) + (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) + (helm-aif (cdr contacts) + (progn + (when cc (addressbook-set-mail-buffer-1 (car it) nil cc)) + (cl-loop for bmk in (cdr 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 '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/elpa/helm-20160421.621/helm-buffers.el b/elpa/helm-20160421.621/helm-buffers.el new file mode 100644 index 0000000..a59427f --- /dev/null +++ b/elpa/helm-20160421.621/helm-buffers.el @@ -0,0 +1,895 @@ +;;; 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-plugin) +(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") + + +(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-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) + +(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) + (matchplugin :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) + (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 (abbreviate-file-name default-directory))) + (file-name (helm-aif (buffer-file-name buf) (abbreviate-file-name it))) + (name (buffer-name buf)) + (name-prefix (when (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-force-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 ((type (get-text-property + 0 'type (helm-get-selection nil 'withprop)))) + (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))) + (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 (helm-get-current-source) 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." + (let (helm-persistent-action-use-special-display) + (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))) + (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) + "Persistent action to kill buffer." + (if (eql (get-buffer buffer) (get-buffer helm-current-buffer)) + (progn + (message "Can't kill `helm-current-buffer' without quitting session") + (sit-for 1)) + (with-current-buffer (get-buffer buffer) + (kill-buffer buffer)) + (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))) + (when (y-or-n-p (format "kill buffer (%s)? " b)) + (helm-buffers-persistent-kill-1 b)) + (message nil))) + (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 (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 t) + (helm-attrset 'filtered-candidate-transformer + (cons 'helm-shadow-boring-buffers + (remove 'helm-skip-boring-buffers + filter-attrs)) + helm-source-buffers-list t)) + (helm-force-update)))) +(put 'helm-buffers-toggle-show-hidden-buffers 'helm-only t) + + +;;; 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)) + +(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/elpa/helm-20160421.621/helm-color.el b/elpa/helm-20160421.621/helm-color.el new file mode 100644 index 0000000..4122cf3 --- /dev/null +++ b/elpa/helm-20160421.621/helm-color.el @@ -0,0 +1,164 @@ +;;; 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) + +;;; 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 + :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/elpa/helm-20160421.621/helm-command.el b/elpa/helm-20160421.621/helm-command.el new file mode 100644 index 0000000..69beab2 --- /dev/null +++ b/elpa/helm-20160421.621/helm-command.el @@ -0,0 +1,259 @@ +;;; 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) + + +(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)) + +(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 + (let ((msg "Error: Specifying a prefix arg before calling `helm-M-x'")) + (when current-prefix-arg + (ding) + (message "%s" msg) + (while (not (sit-for 1)) + (discard-input)) + (user-error msg)) + (setq current-prefix-arg nil) + (helm-comp-read + "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 + :must-match t + :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, are passed AFTER starting `helm-M-x'. + +You can get help on each command by persistent action." + (interactive (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 arg))) + ;; 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)))))) + + +(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/elpa/helm-20160421.621/helm-config.el b/elpa/helm-20160421.621/helm-config.el new file mode 100644 index 0000000..7f3d9ca --- /dev/null +++ b/elpa/helm-20160421.621/helm-config.el @@ -0,0 +1,169 @@ +;;; 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-display-same-window\\)\\>" 1 font-lock-keyword-face) + ("(\\<\\(with-helm-restore-variables\\)\\>" 1 font-lock-keyword-face) + ("(\\<\\(define-helm-type-attribute\\)\\>" 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)))) + + +;;; 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/elpa/helm-20160421.621/helm-dabbrev.el b/elpa/helm-20160421.621/helm-dabbrev.el new file mode 100644 index 0000000..6f64f67 --- /dev/null +++ b/elpa/helm-20160421.621/helm-dabbrev.el @@ -0,0 +1,356 @@ +;;; 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-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 + '((emacs-lisp-mode . lisp-interaction-mode)) + "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) + ;; 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 to find if its + ;; `major-mode' is: + ;; - same as the `cur-maj-mode' + ;; - derived from `cur-maj-mode' + ;; - 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 + ;; `helm-dabbrev-major-mode-assoc'. + (let* ((cur-maj-mode (with-current-buffer start-buffer major-mode)) + (c-assoc-mode (assq cur-maj-mode helm-dabbrev-major-mode-assoc)) + (c-rassoc-mode (rassq cur-maj-mode helm-dabbrev-major-mode-assoc)) + (o-assoc-mode (assq major-mode helm-dabbrev-major-mode-assoc)) + (o-rassoc-mode (rassq major-mode helm-dabbrev-major-mode-assoc)) + (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) + (or (eq cdr-c-assoc-mode major-mode) + (eq (car c-rassoc-mode) major-mode) + (eq (cdr (assq cdr-c-assoc-mode helm-dabbrev-major-mode-assoc)) + major-mode) + (eq (car (rassq cdr-c-assoc-mode helm-dabbrev-major-mode-assoc)) + 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 helm-dabbrev-major-mode-assoc)) + cur-maj-mode) + (eq (car (rassq cdr-o-assoc-mode helm-dabbrev-major-mode-assoc)) + cur-maj-mode))))) + +(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/elpa/helm-20160421.621/helm-easymenu.el b/elpa/helm-20160421.621/helm-easymenu.el new file mode 100644 index 0000000..9ab3580 --- /dev/null +++ b/elpa/helm-20160421.621/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/elpa/helm-20160421.621/helm-elisp-package.el b/elpa/helm-20160421.621/helm-elisp-package.el new file mode 100644 index 0000000..29914d4 --- /dev/null +++ b/elpa/helm-20160421.621/helm-elisp-package.el @@ -0,0 +1,408 @@ +;;; 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. + +(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) + (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 "%d package(s) can be upgraded, Refreshing packages list done" + (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 (progn + (when (boundp 'package-selected-packages) + (customize-save-variable + 'package-selected-packages + (append (mapcar 'package-desc-name installed-list) + package-selected-packages))) + (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) + (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 + (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))) + +(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. + (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 installed-p = (assq name package-alist) + 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 upgrade-p + (eq helm-el-package--show-only 'upgrade)) + (and installed-p + (eq helm-el-package--show-only 'installed)) + (and (not installed-p) + (eq helm-el-package--show-only 'uninstalled)) + (eq helm-el-package--show-only 'all)) + collect cand)) + +(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-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)) + (pkg-name (package-desc-name pkg-desc)) + (acts (if helm-el-package--upgrades + (append actions '(("Upgrade all packages" + . helm-el-package-upgrade-all-action))) + actions))) + (cond ((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) + ("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-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)))) + (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/elpa/helm-20160421.621/helm-elisp.el b/elpa/helm-20160421.621/helm-elisp.el new file mode 100644 index 0000000..abb2995 --- /dev/null +++ b/elpa/helm-20160421.621/helm-elisp.el @@ -0,0 +1,913 @@ +;;; 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 + helm-def-source--helm-attributes) + "A list of functions that build helm sources to use in `helm-apropos'." + :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))) + + +;;; 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 + :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 +;; +;; +(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" + :nomark t + :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--helm-attributes (&optional _default) + (let ((def-act (lambda (candidate) + (let (special-display-buffer-names + special-display-regexps + helm-persistent-action-use-special-display) + (with-output-to-temp-buffer "*Help*" + (princ (get (intern candidate) 'helm-attrdoc))))))) + (helm-build-sync-source "Helm attributes" + :candidates (lambda () + (mapcar 'symbol-name helm-attributes)) + :fuzzy-match helm-apropos-fuzzy-match + :nomark t + :persistent-action (lambda (candidate) + (helm-elisp--persistent-help + candidate def-act)) + :persistent-help "Describe helm attribute" + :action def-act))) + +(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-symbol-1 (c) + (let ((helm-execute-action-at-once-if-one t) + (helm-quit-if-no-candidate + `(lambda () + (message "`%s' Not Documented as a symbol" ,c)))) + (helm :sources '(helm-source-info-elisp + helm-source-info-cl + helm-source-info-eieio) + :resume 'noresume + :buffer "*helm lookup*" + :input c))) + +(defun helm-info-lookup-symbol (candidate) + (run-with-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)))) + (if (and (helm-attr 'help-running-p) + (string= candidate (helm-attr 'help-current-symbol)) + (null helm-persistent-action-use-special-display)) + (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)) + (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) + :buffer "*helm apropos*" + :preselect (and default (concat "\\_<" (regexp-quote default) "\\_>")))) + + +;;; Advices +;; +;; +(defvar helm-source-advice + '((name . "Function Advice") + (candidates . helm-advice-candidates) + (action ("Toggle Enable/Disable" . helm-advice-toggle)) + (persistent-action . helm-advice-persistent-action) + (nomark) + (multiline) + (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 + when (file-directory-p dir) + append (directory-files dir t (concat (regexp-opt (get-load-suffixes)) + "\\'")) + into lst + finally return (helm-fast-remove-dups lst :test 'equal))) + +;;;###autoload +(defun helm-locate-library () + "Preconfigured helm to locate elisp libraries." + (interactive) + (helm :sources (helm-build-in-buffer-source "Elisp libraries (Scan)" + :data (lambda () (helm-locate-library-scan-list)) + :fuzzy-match t + :keymap helm-generic-files-map + :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/elpa/helm-20160421.621/helm-elscreen.el b/elpa/helm-20160421.621/helm-elscreen.el new file mode 100644 index 0000000..44ac52c --- /dev/null +++ b/elpa/helm-20160421.621/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/elpa/helm-20160421.621/helm-eshell.el b/elpa/helm-20160421.621/helm-eshell.el new file mode 100644 index 0000000..b8473d6 --- /dev/null +++ b/elpa/helm-20160421.621/helm-eshell.el @@ -0,0 +1,265 @@ +;;; 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) + + +(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) + :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/elpa/helm-20160421.621/helm-eval.el b/elpa/helm-20160421.621/helm-eval.el new file mode 100644 index 0000000..2159439 --- /dev/null +++ b/elpa/helm-20160421.621/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/elpa/helm-20160421.621/helm-external.el b/elpa/helm-20160421.621/helm-external.el new file mode 100644 index 0000000..899b2d4 --- /dev/null +++ b/elpa/helm-20160421.621/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/elpa/helm-20160421.621/helm-files.el b/elpa/helm-20160421.621/helm-files.el new file mode 100644 index 0000000..5a66c84 --- /dev/null +++ b/elpa/helm-20160421.621/helm-files.el @@ -0,0 +1,3548 @@ +;;; 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) + + +(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-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-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) + + +;;; 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-='" 'helm-find-files-ediff-files + "Ediff Merge File `C-c ='" '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 + "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-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 + (mapcar (lambda (f) + (if (file-directory-p f) + (concat (helm-basename f) "/") + (helm-basename f))) + 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-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 (mapcar 'helm-basename 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 + (when (and (helm-file-completion-source-p) + (not (helm-ff-invalid-tramp-name-p))) + (with-helm-window + (when helm-follow-mode + (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)) + (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." + (helm-aif (and (helm-file-completion-source-p) + (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)) + (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 \"~/\"." + (when (and (helm-file-completion-source-p) + (not (helm-ff-invalid-tramp-name-p))) + (with-helm-window + (let* ((history-p (string= (assoc-default + 'name (helm-get-current-source)) + "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)))) + (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) + (string-match + "/?\\$.*/\\|/\\./\\|/\\.\\./\\|/~.*/\\|//\\|\\(/[[:alpha:]]:/\\|\\s\\+\\)" + helm-pattern) + (with-current-buffer (window-buffer (minibuffer-window)) (eolp)) + (not (string-match helm-ff-url-regexp 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))) + +(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 ((method (match-string 1 pattern)) + (tn (match-string 0 pattern)) + (all-methods (mapcar 'car tramp-methods))) + (helm-fast-remove-dups + (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 tn host))) + :test 'equal)))) + +(defun helm-ff-before-action-hook-fn () + "Exit helm when user try to execute action on an invalid tramp fname." + (let ((cand (helm-get-selection))) + (when (and (helm-file-completion-source-p) + (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-set-pattern (pattern) + "Handle tramp filenames in `helm-pattern'." + (let ((methods (mapcar 'car tramp-methods)) + (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) + (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) + (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) + (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 (not (string-match reg pattern)) + (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. + (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 "") + ;; 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))) + (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)))) + (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) "")) + (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-name (assoc-default 'name (helm-get-current-source)))) + (when (or force (helm-file-completion-source-p) + (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))))) + (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)))) + ((save-match-data + (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 ":\\([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))) + +(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 (buffer-local-value + 'helm-follow-mode + (get-buffer-create helm-buffer)) + helm--temp-follow-flag)) + (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)))))) + (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'. + ((string-match (image-file-name-regexp) candidate) + (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 "#"))) + ;; On second hit we open file. + ;; On Third hit we kill it's buffer maybe. + (t + (helm-ff-kill-or-find-buffer-fname candidate))))) + +(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))))) + (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))) + +(defvar dired-async-mode) +(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. +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))) + (marker (cl-case action + ((copy rename) 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 + (mapcar (lambda (f) + (if (file-directory-p f) + (concat (helm-basename f) "/") + (helm-basename f))) + 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)) + +(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) + (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 helm-ff-transformer-show-only-basename + (helm-basename c) c)) + :filter-one-by-one + (lambda (c) + (if 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)) + :buffer "*helm browse project*")) + +;;;###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") + (cond ((and (require 'helm-ls-git nil t) + (fboundp 'helm-ls-git-root-dir) + (helm-ls-git-root-dir)) + (helm-ls-git-ls)) + ((and (require 'helm-ls-hg nil t) + (fboundp 'helm-hg-root) + (helm-hg-root)) + (helm-hg-find-files-in-project)) + ((and (require 'helm-ls-svn nil t) + (fboundp 'helm-ls-svn-root-dir) + (helm-ls-svn-root-dir)) + (helm-ls-svn-ls)) + (t (let ((cur-dir (helm-browse-project-get--root-dir + (helm-current-directory)))) + (if (or arg (gethash cur-dir helm--browse-project-cache)) + (helm-browse-project-find-files cur-dir (equal arg '(16))) + (helm :sources (helm-browse-project-build-buffers-source cur-dir) + :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." + (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))) + (default-input (or hist (helm-find-files-initial-input))) + (input (cond ((and (eq major-mode 'org-agenda-mode) + org-directory + (not default-input)) + (expand-file-name org-directory)) + ((and (eq major-mode 'dired-mode) default-input) + (file-name-directory default-input)) + ((and (not (string= default-input "")) + default-input)) + (t (expand-file-name (helm-current-directory))))) + (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) + default-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*")) + +(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/elpa/helm-20160421.621/helm-font.el b/elpa/helm-20160421.621/helm-font.el new file mode 100644 index 0000000..c88e3ba --- /dev/null +++ b/elpa/helm-20160421.621/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/elpa/helm-20160421.621/helm-grep.el b/elpa/helm-20160421.621/helm-grep.el new file mode 100644 index 0000000..22f4087 --- /dev/null +++ b/elpa/helm-20160421.621/helm-grep.el @@ -0,0 +1,1418 @@ +;;; 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) + (let* ((com (if recursive + helm-grep-default-recurse-command + helm-grep-default-command)) + (exe (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-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) + (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) + +(defun helm-do-grep-1 (targets &optional recurse zgrep exts default-input input) + "Launch grep on a list of TARGETS files. +When RECURSE is given use -r option of grep and prompt user +to set the --include args of grep. +You can give more than one arg separated by space at prompt. +e.g *.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. +ZGREP when non--nil use zgrep instead, without prompting for a choice +in recurse, and ignoring EXTS, search being made on +`helm-zgrep-file-extension-regexp'." + (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 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 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))) + (follow (and helm-follow-mode-persistent + (assoc-default 'follow helm-source-grep))) + (src-name (if zgrep + "Zgrep" + (capitalize (if recurse + (helm-grep-command t) + (helm-grep-command)))))) + ;; When called as action from an other source e.g *-find-files + ;; we have to kill action buffer. + (when (get-buffer helm-action-buffer) + (kill-buffer helm-action-buffer)) + ;; If `helm-find-files' haven't already started, + ;; give a default value to `helm-ff-default-directory' + ;; and set locally `default-directory' to this value . See below [1]. + (unless helm-ff-default-directory + (setq helm-ff-default-directory default-directory)) + ;; We need to store these vars locally + ;; to pass infos later to `helm-resume'. + (helm-set-local-variable + 'helm-zgrep-recurse-flag (and recurse zgrep) + 'helm-grep-last-targets targets + 'helm-grep-include-files (or include-files types) + 'helm-grep-in-recurse recurse + 'helm-grep-use-zgrep zgrep + 'helm-grep-default-command + (cond (zgrep helm-default-zgrep-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. + (setq helm-source-grep (helm-make-source src-name 'helm-grep-class + :follow follow)) + (helm + :sources 'helm-source-grep + :buffer (format "*helm %s*" + (if zgrep "zgrep" (helm-grep-command recurse))) + :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)) + (add-text-properties beg end '(face 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) + (prog1 + (start-process-shell-command + "ag" helm-buffer cmd-line) + (set-process-sentinel + (get-buffer-process helm-buffer) + (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 + "[%s process finished - (%s results)] " + (upcase (helm-grep--ag-command)) + (helm-get-candidate-number)) + 'face 'helm-grep-finish)))) + (force-mode-line-update)))))))) + +(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) + +(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 +;; +;; +(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-command helm-grep-git-grep-command) + 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 nil nil default input))) + + +;;;###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 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/elpa/helm-20160421.621/helm-help.el b/elpa/helm-20160421.621/helm-help.el new file mode 100644 index 0000000..3529253 --- /dev/null +++ b/elpa/helm-20160421.621/helm-help.el @@ -0,0 +1,1493 @@ +;;; 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-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 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 of 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. + +*** 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 directories, so when copying them in the same directory +they would be overwrited. + +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'. +The directory selection with \"**foo/\" 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 => \"%\" + +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 renames action 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-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 + +All the prefix args passed BEFORE running `helm-M-x' are ignored, +you should get an error message if you do so. +When you want to pass prefix args, pass them AFTER starting `helm-M-x', +you will see a prefix arg counter appearing in mode-line notifying you +the number of prefix args entered.") + +;;; 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") + + +;;; Attribute Documentation +;; +;; +;;;###autoload +(defun helm-describe-helm-attribute (helm-attribute) + "Display the full documentation of HELM-ATTRIBUTE. +HELM-ATTRIBUTE should be a symbol." + (interactive (list (intern + (completing-read + "Describe helm attribute: " + (mapcar 'symbol-name helm-attributes) + nil t)))) + (with-output-to-temp-buffer "*Help*" + (princ (get helm-attribute 'helm-attrdoc)))) + +(helm-document-attribute 'name "mandatory" + " The name of the source. It is also the heading which appears + above the list of matches from the source. Must be unique.") + +(helm-document-attribute 'header-name "optional" + " 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.") + +(helm-document-attribute 'candidates "mandatory if candidates-in-buffer attribute is not provided" + " 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. + + If the candidates have to be retrieved asynchronously (for + example, by an external command which takes a while to run) + then the function should start the external command + asynchronously and return the associated process object. + Helm will take care of managing the process (receiving the + output from it, killing it if necessary, etc.). The process + should return candidates matching the current pattern (see + variable `helm-pattern'.) + You should use instead `candidates-process' attribute for + async processes, a warning will popup when using async process + in a `candidates' attribute. + + Note that currently results from asynchronous sources appear + last in the helm buffer regardless of their position in + `helm-sources'.") + +(helm-document-attribute 'candidates-process + "Same as `candidates' attributes but for process function." + " You should use this attribute when using a function involving + an async process instead of `candidates'.") + +(helm-document-attribute 'action "mandatory if type attribute is not provided" + " It is a list of (DISPLAY . FUNCTION) pairs or 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.") + +(helm-document-attribute 'coerce "optional" + " 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)") + +(helm-document-attribute 'type "optional if action attribute is provided" + " Indicates the type of the items the source returns. + + Merge attributes not specified in the source itself from + `helm-type-attributes'. + + This attribute is implemented by plug-in.") + +(helm-document-attribute 'init "optional" + " 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. + + For example, if a source needs to work with the current + directory then it can store its value here, because later + helm does its job in the minibuffer and in the + `helm-buffer' and the current directory can be different + there.") + +(helm-document-attribute 'match "optional" + " 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'). + + 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.") + +(helm-document-attribute 'candidate-transformer "optional" + " 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.") + +(helm-document-attribute 'filtered-candidate-transformer "optional" + " 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 dislpayed 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. + + This option has no effect for asynchronous sources. (Not yet, + at least.") + +(helm-document-attribute 'action-transformer "optional" + " 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.") + +(helm-document-attribute 'pattern-transformer "optional" + " 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'.") + +(helm-document-attribute 'volatile "optional" + " 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.") + +(helm-document-attribute 'requires-pattern "optional" + " 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.") + +(helm-document-attribute 'persistent-action "optional" + " 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.") + +(helm-document-attribute 'candidates-in-buffer "optional" + " Shortcut attribute for making and narrowing candidates using + buffers. This newly-introduced attribute prevents us from + forgetting to add volatile and match attributes. + + See docstring of `helm-candidates-in-buffer'. + + (candidates-in-buffer) is equivalent of three attributes: + (candidates . helm-candidates-in-buffer) + (volatile) + (match identity) + + (candidates-in-buffer . candidates-function) is equivalent of: + (candidates . candidates-function) + (volatile) + (match identity) + + This attribute is implemented by plug-in.") + +(helm-document-attribute 'search "optional" + " 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'. This attribute is meant to be used with + (candidates . helm-candidates-in-buffer) or + (candidates-in-buffer) in short.") + +(helm-document-attribute 'get-line "optional" + " 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'.") + +(helm-document-attribute 'display-to-real "optional" + " Function called with one parameter; the selected candidate. + + The function transforms the selected candidate, and the result + is passed to the action function. The display-to-real + attribute provides another way to pass other string than one + shown in Helm buffer. + + Traditionally, it is possible to make candidates, + candidate-transformer or filtered-candidate-transformer + function return a list with (DISPLAY . REAL) pairs. But if REAL + can be generated from DISPLAY, display-to-real is more + convenient and faster.") + +(helm-document-attribute 'real-to-display "optional" + " Function called with one parameter; the selected candidate. + + The inverse of display-to-real attribute. + + The function transforms the selected candidate, which is passed + to the action function, for display. The real-to-display + attribute provides the other way to pass other string than one + shown in Helm buffer. + + Traditionally, it is possible to make candidates, + candidate-transformer or filtered-candidate-transformer + function return a list with (DISPLAY . REAL) pairs. But if + DISPLAY can be generated from REAL, real-to-display is more + convenient. + + Note that DISPLAY parts returned from candidates / + candidate-transformer are IGNORED as the name `display-to-real' + says.") + +(helm-document-attribute 'cleanup "optional" + " 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.") + +(helm-document-attribute 'candidate-number-limit "optional" + " Override `helm-candidate-number-limit' only for this source.") + +(helm-document-attribute 'accept-empty "optional" + " Pass empty string \"\" to action function.") + +(helm-document-attribute 'dummy "optional" + " Set `helm-pattern' to candidate. If this attribute is + specified, The candidates attribute is ignored. + + This attribute is implemented by plug-in.") + +(helm-document-attribute 'multiline "optional" + " Enable to selection multiline candidates.") + +(helm-document-attribute 'update "optional" + (substitute-command-keys + " Function called with no parameters at before \"init\" function when \ +\\\\[helm-force-update] is pressed.")) + +(helm-document-attribute 'mode-line "optional" + " Source local `helm-mode-line-string' (included in + `mode-line-format'). It accepts also variable/function name.") + +(helm-document-attribute 'header-line "optional" + " Source local `header-line-format'. + It accepts also variable/function name. ") + +(helm-document-attribute + 'resume "optional" + " 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.") + +(helm-document-attribute 'keymap "optional" + " 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.") + +(helm-document-attribute 'help-message "optional" + " Help message for this source. + If not present, `helm-help-message' value will be used.") + +(helm-document-attribute 'match-part "optional" + " Allow matching candidate in the line with `candidates-in-buffer'. + In candidates-in-buffer sources, match is done with + `re-search-forward' which allow matching only a regexp on the + `helm-buffer'; when this search is done, match-part allow + matching only a specific part of the current line e.g. with a + line like this: + + filename:candidate-containing-the-word-filename + + What you want is to ignore \"filename\" part and match only + \"candidate-containing-the-word-filename\" + + So give a function matching only the part of candidate after \":\" + + 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. + + NOTE: This have effect only on sources using + `candidates-in-buffer'.") + +(helm-document-attribute 'match-strict "optional" + " 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. For anonymous + function don't add the dot, e.g: + + \(match-strict (lambda () (foo))).") + +(helm-document-attribute 'nohighlight "optional" + " Disable highlight match in this source.") + +(helm-document-attribute 'no-matchplugin "optional" + " Disable matchplugin for this source.") + +(helm-document-attribute 'history "optional" + " Allow passing history variable to helm from source. + It should be a quoted symbol evaluated from source, i.e: + (history . ,'history-var)") + +(helm-document-attribute 'follow "optional" + " Enable `helm-follow-mode' for this source only. + You must give it a value of 1 or -1, though giving a -1 value + is surely not what you want, e.g: (follow . 1) + + See `helm-follow-mode' for more infos") + +(helm-document-attribute 'follow-delay "optional" + " `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'.") + +(helm-document-attribute 'allow-dups "optional" + " Allow helm collecting duplicates candidates.") + +(helm-document-attribute 'filter-one-by-one "optional" + " 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.") + +(helm-document-attribute 'nomark "optional" + " Don't allow marking candidates when this attribute is present.") + +(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/elpa/helm-20160421.621/helm-id-utils.el b/elpa/helm-20160421.621/helm-id-utils.el new file mode 100644 index 0000000..ee51cb3 --- /dev/null +++ b/elpa/helm-20160421.621/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/elpa/helm-20160421.621/helm-imenu.el b/elpa/helm-20160421.621/helm-imenu.el new file mode 100644 index 0000000..3aaaa4a --- /dev/null +++ b/elpa/helm-20160421.621/helm-imenu.el @@ -0,0 +1,276 @@ +;;; 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 '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) + + +;;; 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 nil nil nil nil 'pulse))) + +(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 + for mm = (with-current-buffer b major-mode) + for cmm = (with-helm-current-buffer major-mode) + when (or (with-helm-current-buffer + (derived-mode-p mm)) + (with-current-buffer b + (derived-mode-p cmm))) + 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 of all buffers." + (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/elpa/helm-20160421.621/helm-info.el b/elpa/helm-20160421.621/helm-info.el new file mode 100644 index 0000000..43c02c8 --- /dev/null +++ b/elpa/helm-20160421.621/helm-info.el @@ -0,0 +1,238 @@ +;;; 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 'helm-plugin) +(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)) + (infobuf (current-buffer)) + Info-history + start end) + (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) + end (point-at-eol)) + (with-current-buffer tobuf + (insert-buffer-substring infobuf start end) + (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/elpa/helm-20160421.621/helm-locate.el b/elpa/helm-20160421.621/helm-locate.el new file mode 100644 index 0000000..03289d6 --- /dev/null +++ b/elpa/helm-20160421.621/helm-locate.el @@ -0,0 +1,391 @@ +;;; 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)) + + +(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." + (when helm-ff-locate-db-filename + (cond ((and helm-ff-default-directory + from-ff + (file-exists-p (expand-file-name + helm-ff-locate-db-filename + helm-ff-default-directory)) + (expand-file-name + helm-ff-locate-db-filename + helm-ff-default-directory))) + ((and (not from-ff) + (file-exists-p (expand-file-name + helm-ff-locate-db-filename + default-directory)) + (expand-file-name + helm-ff-locate-db-filename + default-directory)))))) + + +(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))) + +;;;###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/elpa/helm-20160421.621/helm-man.el b/elpa/helm-20160421.621/helm-man.el new file mode 100644 index 0000000..9989ea9 --- /dev/null +++ b/elpa/helm-20160421.621/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/elpa/helm-20160421.621/helm-misc.el b/elpa/helm-20160421.621/helm-misc.el new file mode 100644 index 0000000..202e5a9 --- /dev/null +++ b/elpa/helm-20160421.621/helm-misc.el @@ -0,0 +1,334 @@ +;;; 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) + + +(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 + '((name . "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 + '((name . "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 + ;; FIXME: do we still need to remove possible '(nil) candidates. + (lacarte-get-overall-menu-item-alist maps))) + +;;;###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 + '((name . "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 + '((name . "Ratpoison Commands") + (init . helm-ratpoison-commands-init) + (candidates-in-buffer) + (action ("Execute the command" . helm-ratpoison-commands-execute)) + (display-to-real . helm-ratpoison-commands-display-to-real) + (candidate-number-limit))) + +(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 + '((name . "Stumpwm Commands") + (init . helm-stumpwm-commands-init) + (candidates-in-buffer) + (action ("Execute the command" . helm-stumpwm-commands-execute)) + (candidate-number-limit))) + +(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/elpa/helm-20160421.621/helm-mode.el b/elpa/helm-20160421.621/helm-mode.el new file mode 100644 index 0000000..47af057 --- /dev/null +++ b/elpa/helm-20160421.621/helm-mode.el @@ -0,0 +1,1218 @@ +;;; 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-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 (quote ,test) 'commandp) + (funcall (quote ,test) (intern elm)) + (funcall (quote ,test) elm)) + (wrong-type-argument + (funcall (quote ,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 test) + (cl-loop for i in collection when (funcall test i) collect i)) + (alistp collection) + (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)))) + +;;;###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 + 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. + +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)) + ;; When DEFAULT is initially a list, candidates + ;; come already computed with DEFAULT list appended, + ;; and DEFAULT is set to the car of this list. + (if (and default (not (string= default ""))) + (delq nil (cons default (delete default cands))) + cands)))) + (history-get-candidates (lambda () + (let ((all (helm-comp-read-get-candidates + history test nil alistp))) + (when all + (delete + "" + (helm-fast-remove-dups + (if (and default (not (string= default ""))) + (delq nil (cons default + (delete default all))) + all) + :test 'equal)))))) + (src-hist (helm-build-sync-source (format "%s History" name) + :candidates history-get-candidates + :fuzzy-match fuzzy + :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. + for cand = (replace-regexp-in-string "\\s\\" "" i) + collect cand))) + (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 + :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 + :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 + (when (and (eq helm-exit-status 0) + (eq must-match 'confirm)) + ;; Return empty string only if it is the DEFAULT + ;; value and helm-pattern is empty. + ;; otherwise return helm-pattern + (if (and (string= helm-pattern "") default) + default (identity helm-pattern))) + (unless (or (eq helm-exit-status 1) + must-match) ; FIXME this should not be needed now. + default) + (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))))) + (when (and default (listp default)) + ;; When DEFAULT is a list move the list on head of COLLECTION + ;; and set it to its car. #bugfix `grep-read-files'. + (setq collection + ;; COLLECTION is maybe a function or a table. + (append default + (helm-comp-read-get-candidates + collection test nil (listp collection)))) + ;; Ensure `all-completions' will not be used + ;; a second time to recompute COLLECTION [1]. + (setq alistp t) + (setq default (car default))) + (helm-comp-read + prompt collection + :test test + :history history + :reverse-history helm-mode-reverse-history + :input-history history + :must-match require-match + :alistp alistp ; Ensure `all-completions' is used when non-nil [1]. + :name name + :requires-pattern (if (and (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 + (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)) + (when (and (not (string= helm-pattern "")) + (eq helm-exit-status 0) + (eq must-match 'confirm)) + (identity helm-pattern)) + (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)) + " ")) + (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) + (unless (string= 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/elpa/helm-20160421.621/helm-multi-match.el b/elpa/helm-20160421.621/helm-multi-match.el new file mode 100644 index 0000000..a926adb --- /dev/null +++ b/elpa/helm-20160421.621/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 +(defconst helm-mm-default-match-functions + '(helm-mm-exact-match helm-mm-match)) +(defconst 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/elpa/helm-20160421.621/helm-net.el b/elpa/helm-20160421.621/helm-net.el new file mode 100644 index 0000000..cc88539 --- /dev/null +++ b/elpa/helm-20160421.621/helm-net.el @@ -0,0 +1,526 @@ +;;; 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-wikipedia-follow-delay 2 + "Delay before wikipedia summary popup." + :type 'number + :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 + :volatile t + :keymap helm-map + :follow 1 + :follow-delay helm-wikipedia-follow-delay + :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)) + (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 + 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/elpa/helm-20160421.621/helm-org.el b/elpa/helm-20160421.621/helm-org.el new file mode 100644 index 0000000..33b0695 --- /dev/null +++ b/elpa/helm-20160421.621/helm-org.el @@ -0,0 +1,319 @@ +;;; 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-RET'" . helm-org--open-heading-in-indirect-buffer) + ("Refile to this heading `C-w`''" . helm-org-heading-refile) + ("Insert link to this heading `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-w") 'helm-org-heading-refile) + (define-key map (kbd "C-l") 'helm-org-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-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))))) + +;;;###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 nil)) + (helm :sources (helm-source-org-headings-for-files + (list (current-buffer))) + :candidate-number-limit 99999 + :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/elpa/helm-20160421.621/helm-pkg.el b/elpa/helm-20160421.621/helm-pkg.el new file mode 100644 index 0000000..d18b51c --- /dev/null +++ b/elpa/helm-20160421.621/helm-pkg.el @@ -0,0 +1,9 @@ +(define-package "helm" "20160421.621" "Helm is an Emacs incremental and narrowing framework" + '((emacs "24.3") + (async "1.7") + (popup "0.5.3") + (helm-core "1.9.4")) + :url "https://emacs-helm.github.io/helm/") +;; Local Variables: +;; no-byte-compile: t +;; End: diff --git a/elpa/helm-20160421.621/helm-plugin.el b/elpa/helm-20160421.621/helm-plugin.el new file mode 100644 index 0000000..82f60d4 --- /dev/null +++ b/elpa/helm-20160421.621/helm-plugin.el @@ -0,0 +1,137 @@ +;;; helm-plugin.el --- Helm plugins -*- 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) + + +;;; Plug-in: `info-index' +;; +;; +(defun helm-make-info-source (source file) + `(,@source + (name . ,(concat "Info Index: " file)) + (info-file . ,file) + (init . helm-info-init) + (display-to-real . helm-info-display-to-real) + (get-line . buffer-substring) + (candidates-in-buffer) + (action ("Goto node" . helm-info-goto)))) + +(defun helm-compile-source--info-index (source) + (helm-aif (helm-interpret-value (assoc-default 'info-index source)) + (helm-make-info-source source it) + source)) + +(add-to-list 'helm-compile-source-functions 'helm-compile-source--info-index) + +(helm-document-attribute 'info-index "info-index plugin" + " Create a source of info index very easily. + + Example: + + (defvar helm-source-info-wget '((info-index . \"wget\"))") + + +;;; Plug-in: `candidates-file' +;; +;; List all lines in a file. +(defun helm-compile-source--candidates-file (source) + (if (assoc-default 'candidates-file source) + `((init helm-p-candidates-file-init + ,@(let ((orig-init (assoc-default 'init source))) + (cond ((null orig-init) nil) + ((functionp orig-init) (list orig-init)) + (t orig-init)))) + (candidates-in-buffer) + ,@source) + source)) +(add-to-list 'helm-compile-source-functions 'helm-compile-source--candidates-file) + +(defun helm-p-candidates-file-init () + (cl-destructuring-bind (file &optional updating) + (helm-mklist (helm-attr 'candidates-file)) + (setq file (helm-interpret-value file)) + (with-current-buffer (helm-candidate-buffer 'global) + (insert-file-contents file) + (when updating + (buffer-disable-undo) + (font-lock-mode -1) + (auto-revert-mode 1))))) + +(helm-document-attribute 'candidates-file "candidates-file plugin" + " Use a file as the candidates buffer. + + 1st argument is a filename, string or function name or variable + name. If optional 2nd argument is non-nil, the file is opened with + `auto-revert-mode' enabled. + + Example: + + \(defvar helm-source-test-file + '((name . \"test1\") + (candidates-file \"~/.emacs.el\" t))) + + Will list all lines in .emacs.el.") + + +;;; Plug-in: `persistent-help' +;; +;; Add help about persistent action in `helm-buffer' header. +(defun helm-compile-source--persistent-help (source) + (if (assoc 'header-line source) + source + (append source '((header-line . helm-persistent-help-string))))) +(add-to-list 'helm-compile-source-functions 'helm-compile-source--persistent-help) + +(defun helm-persistent-help-string () + (substitute-command-keys + (concat "\\\\[helm-execute-persistent-action]: " + (or (helm-interpret-value (helm-attr 'persistent-help)) + (helm-aif (or (assoc-default + 'persistent-action + (helm-get-current-source)) + (assoc-default + 'action (helm-get-current-source))) + (cond ((symbolp it) + (symbol-name it)) + ((listp it) + (or (ignore-errors (caar it)) "")))) + "") + " (keeping session)"))) + + +;;; Document new attributes +;; +;; +(helm-document-attribute 'persistent-help "persistent-help plug-in" + " A string to explain persistent-action of this source. It also + accepts a function or a variable name.") + + +(provide 'helm-plugin) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-plugin ends here diff --git a/elpa/helm-20160421.621/helm-regexp.el b/elpa/helm-20160421.621/helm-regexp.el new file mode 100644 index 0000000..13a5623 --- /dev/null +++ b/elpa/helm-20160421.621/helm-regexp.el @@ -0,0 +1,646 @@ +;;; 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) +(require 'helm-plugin) + +(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 + :matchplugin 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 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/elpa/helm-20160421.621/helm-ring.el b/elpa/helm-20160421.621/helm-ring.el new file mode 100644 index 0000000..18e327d --- /dev/null +++ b/elpa/helm-20160421.621/helm-ring.el @@ -0,0 +1,470 @@ +;;; 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)) + (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) + +(defadvice push-mark (around helm-push-mark-mode) + (helm--push-mark location nomsg activate)) + +;;;###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 + (if (fboundp 'advice-add) + (advice-add 'push-mark :override #'helm--push-mark) + (ad-activate 'push-mark)) + (if (fboundp 'advice-remove) + (advice-remove 'push-mark #'helm--push-mark) + (ad-deactivate '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/elpa/helm-20160421.621/helm-semantic.el b/elpa/helm-20160421.621/helm-semantic.el new file mode 100644 index 0000000..3de1c39 --- /dev/null +++ b/elpa/helm-20160421.621/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) + (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 + :preselect (if (or arg imenu-p) + (thing-at-point 'symbol) + 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/elpa/helm-20160421.621/helm-sys.el b/elpa/helm-20160421.621/helm-sys.el new file mode 100644 index 0000000..d06225c --- /dev/null +++ b/elpa/helm-20160421.621/helm-sys.el @@ -0,0 +1,315 @@ +;;; 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) + + +(defun helm-top-command-set-fn (var _value) + (set var + (cl-case system-type + (darwin "env COLUMNS=%s ps -axo pid,user,pri,nice,ucomm,tty,start,vsz,%%cpu,%%mem,etime,command") + (t "env COLUMNS=%s top -b -n 1")))) + +(defcustom helm-top-command "env COLUMNS=%s top -b -n 1" + "Top command used to display output of top. +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 by default instead. +If you modify this the number and order of elements displayed +should be the same as top command to have the sort commands +working properly, that is 12 elements with the 2 first being +PID and USER and the last 4 being %CPU, %MEM, TIME and COMMAND. +A format string where %s will be replaced with `frame-width'." + :group 'helm-sys + :type 'string + :set 'helm-top-command-set-fn) + + +;;; 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-source-top + (helm-build-in-buffer-source "Top" + :header-name (lambda (name) (concat name " (Press C-c C-u to refresh)")) + :init #'helm-top-init + :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 + :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-name (assoc-default 'name (helm-get-current-source)))) + (helm-aif (and (stringp src-name) + (string= src-name "Top") + (helm-get-selection nil t)) + (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." + (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)) + (com-1 (nth 11 split-1)) + (com-2 (nth 11 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)) + (mem-1 (string-to-number (nth 9 split-1))) + (mem-2 (string-to-number (nth 9 split-2)))) + (> mem-1 mem-2))) + +(defun helm-top-sort-by-user (s1 s2) + (let* ((split-1 (split-string s1)) + (split-2 (split-string s2)) + (user-1 (nth 1 split-1)) + (user-2 (nth 1 split-2))) + (string< user-1 user-2))) + +(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-force-update)) + +(defun helm-top-run-sort-by-cpu () + (interactive) + (helm-top-set-mode-line "CPU") + (setq helm-top-sort-fn nil) + (helm-force-update)) + +(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-force-update)) + +(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-force-update)) + + +;;; 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 + '((name . "Change Resolution") + (candidates + . (lambda () + (with-temp-buffer + (call-process "xrandr" nil (current-buffer) nil + "--screen" (helm-xrandr-screen) "-q") + (goto-char 1) + (cl-loop with modes = nil + 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 + ("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 + '((name . "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 ("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/elpa/helm-20160421.621/helm-tags.el b/elpa/helm-20160421.621/helm-tags.el new file mode 100644 index 0000000..4cc4e6b --- /dev/null +++ b/elpa/helm-20160421.621/helm-tags.el @@ -0,0 +1,341 @@ +;;; 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. + (add-to-list 'helm-etags-mtime-alist + (cons f (helm-etags-mtime f)))))))))) + +(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/elpa/helm-20160421.621/helm-types.el b/elpa/helm-20160421.621/helm-types.el new file mode 100644 index 0000000..670ecf4 --- /dev/null +++ b/elpa/helm-20160421.621/helm-types.el @@ -0,0 +1,280 @@ +;;; 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)) + + +;; 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 + "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/elpa/helm-20160421.621/helm-utils.el b/elpa/helm-20160421.621/helm-utils.el new file mode 100644 index 0000000..e567f97 --- /dev/null +++ b/elpa/helm-20160421.621/helm-utils.el @@ -0,0 +1,808 @@ +;;; 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) + + +;; CUA workaround +(defadvice cua-delete-region (around helm-avoid-cua activate) + (ignore-errors ad-do-it)) + +(defadvice copy-region-as-kill (around helm-avoid-cua activate) + (if cua-mode + (ignore-errors ad-do-it) + ad-do-it)) + + +;;; 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) + (goto-char (point-min)) + (helm-goto-char (point-at-bol lineno)) + (unless noanim + (helm-highlight-current-line nil nil nil nil 'pulse))) + +(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)) + ((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 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* ((pattern (regexp-quote helm-pattern)) + (reg1 (concat "\\_<" pattern "\\_>")) + (reg2 (concat "\\_<" pattern)) + (reg3 helm-pattern) + (split (split-string 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 "\\`" pattern) str) 1 0) + (cond ((string-match r1 str) 5) + ((and (string-match " " pattern) + (string-match (concat "\\_<" (car lst)) str) + (cl-loop for r in (cdr lst) + always (string-match r str))) 4) + ((and (string-match " " pattern) + (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 pattern)) + (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 ":")) + (meth (car (member (car split) (mapcar 'car tramp-methods))))) + (when (and meth (<= (length split) 2)) + (cadr 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 pulse) + "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) + (when pulse + (sit-for 0.3) + (helm-match-line-cleanup)))) + +(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))) + +(add-hook 'helm-after-persistent-action-hook 'helm-persistent-autoresize-hook) +(add-hook 'helm-cleanup-hook 'helm-match-line-cleanup) +(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-idle-timer + 1 nil + (lambda () + (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-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-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=\\|^ *

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. + +\(fn KEYMAP KEY FUNCTIONS &optional DELAY)" nil nil) + +(autoload 'helm-multi-key-defun "helm" "\ +Define NAME as a multi-key command running FUNS. +After DELAY seconds, the FUNS list is reinitialized. +See `helm-define-multi-key'. + +\(fn NAME DOCSTRING FUNS &optional DELAY)" nil t) + +(put 'helm-multi-key-defun 'lisp-indent-function '2) + +(autoload 'helm-define-key-with-subkeys "helm" "\ +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. + +\(fn MAP KEY SUBKEY COMMAND &optional OTHER-SUBKEYS MENU EXIT-FN)" nil nil) + +(put 'helm-define-key-with-subkeys 'lisp-indent-function '1) + +(autoload 'helm-debug-open-last-log "helm" "\ +Open helm log file of last helm session. +If `helm-last-log-file' is nil, switch to `helm-debug-buffer' . + +\(fn)" t nil) + +(autoload 'helm "helm" "\ +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)" nil nil) + +(autoload 'helm-other-buffer "helm" "\ +Simplified `helm' interface with other `helm-buffer'. +Call `helm' only with ANY-SOURCES and ANY-BUFFER as args. + +\(fn ANY-SOURCES ANY-BUFFER)" nil nil) + +(autoload 'helm-debug-toggle "helm" "\ +Enable/disable helm debugging from outside of helm session. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil nil ("helm-core-pkg.el" "helm-lib.el" "helm-multi-match.el" +;;;;;; "helm-source.el") (22297 20819 302900 527000)) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; End: +;;; helm-core-autoloads.el ends here diff --git a/elpa/helm-core-20160419.2355/helm-core-pkg.el b/elpa/helm-core-20160419.2355/helm-core-pkg.el new file mode 100644 index 0000000..e9f381e --- /dev/null +++ b/elpa/helm-core-20160419.2355/helm-core-pkg.el @@ -0,0 +1,7 @@ +(define-package "helm-core" "20160419.2355" "Development files for Helm" + '((emacs "24.3") + (async "1.7")) + :url "https://emacs-helm.github.io/helm/") +;; Local Variables: +;; no-byte-compile: t +;; End: diff --git a/elpa/helm-core-20160419.2355/helm-lib.el b/elpa/helm-core-20160419.2355/helm-lib.el new file mode 100644 index 0000000..5a7c7cd --- /dev/null +++ b/elpa/helm-core-20160419.2355/helm-lib.el @@ -0,0 +1,743 @@ +;;; 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) + + +;;; 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.") + +;;; 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)) + +;;; 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'." + (helm-with-gensyms (flag) + `(let ((,flag t)) + (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 + ,@(cdr clause1) + (helm-acond ,@(cdr clauses)))))))) + +(defun helm-current-line-contents () + "Current line string without properties." + (buffer-substring-no-properties (point-at-bol) (point-at-eol))) + +;;; 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) + (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) + (cl-loop for event = (read-key prompt) do + (cl-case event + ((?\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-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))) + +;;; 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)) + + +;;; 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." + (describe-function (helm-symbolify func)) + (message nil)) + +(defun helm-describe-variable (var) + "VAR is symbol or string." + (describe-variable (helm-symbolify var)) + (message nil)) + +(defun helm-describe-face (face) + "VAR is symbol or string." + (describe-face (helm-symbolify face)) + (message nil)) + +(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)) + +;;; 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")) + +(cl-defun helm-walk-directory (directory &key (path 'basename) + (directories t) + 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. +Argument MATCH can be a predicate or a regexp. +Argument SKIP-SUBDIRS when non--nil will skip `helm-walk-ignore-directories' +unless it is given as a list of directories, in this case this list will be used +instead of `helm-walk-ignore-directories'." + (let* ((result '()) + (fn (cl-case path + (basename 'file-name-nondirectory) + (relative 'file-relative-name) + (full 'identity) + (t path)))) + (cl-labels ((ls-rec (dir) + (unless (and skip-subdirs + (member (helm-basename dir) + (if (listp skip-subdirs) + skip-subdirs + helm-walk-ignore-directories))) + (cl-loop with ls = (sort (file-name-all-completions "" dir) + 'string-lessp) + for f in ls + ;; Use `directory-file-name' to remove the final slash. + ;; Needed to avoid infloop on symlinks symlinking + ;; a directory inside it [1]. + for file = (directory-file-name + (expand-file-name f dir)) + unless (member f '("./" "../")) + ;; A directory. + if (char-equal (aref f (1- (length f))) ?/) + do (progn (when directories + (push (funcall fn file) result)) + ;; Don't recurse in symlinks. + ;; `file-symlink-p' have to be called + ;; on the directory with its final + ;; slash removed [1]. + (and (not (file-symlink-p file)) + (ls-rec file))) + else do + (if match + (and (if (functionp match) + (funcall match f) + (and (stringp match) + (string-match match f))) + (push (funcall fn file) result)) + (push (funcall fn file) result)))))) + (ls-rec directory) + (nreverse result)))) + +(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/elpa/helm-core-20160419.2355/helm-multi-match.el b/elpa/helm-core-20160419.2355/helm-multi-match.el new file mode 100644 index 0000000..a926adb --- /dev/null +++ b/elpa/helm-core-20160419.2355/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 +(defconst helm-mm-default-match-functions + '(helm-mm-exact-match helm-mm-match)) +(defconst 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/elpa/helm-core-20160419.2355/helm-source.el b/elpa/helm-core-20160419.2355/helm-source.el new file mode 100644 index 0000000..6510620 --- /dev/null +++ b/elpa/helm-core-20160419.2355/helm-source.el @@ -0,0 +1,1016 @@ +;;; 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 + " Function called with one parameter; the selected candidate. + + The function transforms the selected candidate, and the result + is passed to the action function. The display-to-real + attribute provides another way to pass to action other string than + the one shown in Helm buffer. + + Traditionally, it is possible to make candidates, + candidate-transformer or filtered-candidate-transformer + function return a list with (DISPLAY . REAL) pairs. But if REAL + can be generated from DISPLAY, display-to-real is more + convenient and faster. + + NOTE: This is deprecated and you have better time using `filter-one-by-one'.") + + (real-to-display + :initarg :real-to-display + :initform nil + :custom function + :documentation + " Function called with one parameter; the selected candidate. + The real value of candidates will be shown in display. + See `display-to-real'.") + + (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. + You must give it a value of 1 or -1, though giving a -1 value + is surely not what you want, e.g: (follow . 1) + + 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'.") + + (dont-plug + :initarg :dont-plug + :initform '(helm-compile-source--persistent-help) + :custom list + :documentation + " A list of compile functions plugin to ignore.") + + (matchplugin + :initarg :matchplugin + :initform t + :custom boolean) + + (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")) + + (dont-plug + :initform '(helm-compile-source--multi-match + helm-compile-source--persistent-help + ;; Ensure this will not be plugged + ;; if user have somewhere old helm-migemo.el. + helm-compile-source--migemo)) + + (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 :MATCHPLUGIN 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.") + + (matchplugin :initform nil) + (dont-plug :initform '(helm-compile-source--multi-match + helm-compile-source--persistent-help))) + + "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.") + + (dont-plug + :initform '(helm-compile-source--candidates-in-buffer + helm-compile-source--multi-match + helm-compile-source--persistent-help + helm-compile-source--migemo)) + + (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 matchplugin, + 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 + :MATCHPLUGIN 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.") + +(defclass helm-source-dummy (helm-source) + ((candidates + :initform '("dummy")) + + (filtered-candidate-transformer + :initform 'helm-dummy-candidate) + + (matchplugin + :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 (quote ,predicate) candidate) + (helm-append-at-nth + actions (quote ,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 'matchplugin) + (setf (slot-value source 'match) + (helm-source-mm-get-search-or-match-fns source 'match))) + (helm-aif (and (null (slot-value source 'matchplugin)) + (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 'matchplugin) + (setf (slot-value source 'search) + (helm-source-mm-get-search-or-match-fns source 'search))) + (helm-aif (and (null (slot-value source 'matchplugin)) + (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 'matchplugin)) + nil "`matchplugin' 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/elpa/helm-core-20160419.2355/helm.el b/elpa/helm-core-20160419.2355/helm.el new file mode 100644 index 0000000..c075ea4 --- /dev/null +++ b/elpa/helm-core-20160419.2355/helm.el @@ -0,0 +1,5549 @@ +;;; helm.el --- Emacs incremental and narrowing framework -*- lexical-binding: t -*- + +;; Copyright (C) 2007 Tamas Patrovics +;; 2008 ~ 2011 rubikitch +;; 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-persistent-action-use-special-display nil + "If non-`nil', use `special-display-function' in persistent action." + :group 'helm + :type 'boolean) + +(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-size 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. 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) + "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', use last state of `helm-follow-mode' for the next helm session. +To make this behavior persistent across emacs sessions, set the +`follow' attribute explicitly in the source." + :group 'helm + :type 'boolean) + +(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) + + +;;; 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-type-attributes nil + "It's a list of \(TYPE ATTRIBUTES ...\). +ATTRIBUTES are the same as attributes for `helm-sources'. TYPE +connects the value to the appropriate sources. Don't set this +directly, use `define-helm-type-attribute' instead. + +This alist is for specifying common attributes for multiple +sources. For example, sources which provide files can specify +common attributes with a `file' type.") + +(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.") + +(defvar helm-update-hook nil + "Run after the helm buffer is updated. +This hook runs at the beginning of buffer. The first candidate is +selected after running this hook. See also +`helm-after-update-hook'.") + +(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 + "With the only remaining candidate, executes the default action and then exits. +This variable accepts a function with no args and returns a boolean +value.") + +(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-compile-source-functions + '(helm-compile-source--type + helm-compile-source--dummy + helm-compile-source--candidates-in-buffer) + "Functions to compile elements of `helm-sources' (plug-in).") + +(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. + +** Visible Marks + +Visible marks are displayed next to selected candidates, if any. +Some Helm actions operate on marked candidates. + +** 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. + +** 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-candidate-buffer-alist nil) +(defvar helm-tick-hash (make-hash-table :test 'equal)) +(defvar helm-issued-errors nil) +(defvar helm-debug-root-directory nil + "When non-`nil', saves helm log messages to `helm-last-log-file'. +Use only for debugging purposes because of the size of the log files. +See `helm-log-save-maybe' for more info.") +(defvar helm-last-log-file nil + "The name of the log file of the last helm session.") +(defvar helm-follow-mode nil) +(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) +(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-attributes nil "List of all `helm' attributes.") +(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\\)://\\)") + +;; 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) + (add-to-list 'helm-issued-errors msg)))) + +(defun helm-log-save-maybe () + "May be save log buffer to `helm-last-log-file'. +If `helm-debug-root-directory' is non-`nil' then a valid +directory, 'helm-debug-', is created and messages +logged to a file named with todays date and time." + (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))))) + +;;;###autoload +(defun helm-debug-open-last-log () + "Open helm log file of last helm session. +If `helm-last-log-file' is nil, switch to `helm-debug-buffer' ." + (interactive) + (if helm-last-log-file + (view-file helm-last-log-file) + (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")))) + + +;; Programming Tools + +(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)))) + + +;; 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")))) + +(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 +(i.e a variable)." + (let ((src (or source (helm-get-current-source)))) + (helm-aif (or (assq attribute-name src) + (helm-get-attribute-from-source-type 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)) + alter-type) + "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 ALTER-TYPE is non-`nil' alter the value of ATTRIBUTE-NAME in `helm-attributes' +if it exists. +If SRC is omitted, use current source. +If operation succeed, return value, otherwise nil." + (let ((from-type (helm-get-attribute-from-source-type attribute-name src)) + done) + (helm-aif (or (assq attribute-name src) + (and alter-type from-type)) + (prog1 (setcdr it value) (setq done t)) + (unless from-type + (setcdr src (cons (cons attribute-name value) (cdr src))) + (setq done t))) + (and done value))) + +(defun helm-get-attribute-from-source-type (attribute source) + "Get ATTRIBUTE from type attribute of SOURCE." + (when (assq 'type source) + (assq attribute + (assq (cdr (assq 'type source)) + helm-type-attributes)))) + +(defun helm-get-attribute-from-type (attribute type) + "Get ATTRIBUTE from TYPE. +arg TYPE is an existing type defined in `helm-type-attributes'." + (assq attribute (assq type helm-type-attributes))) + +(defun helm-get-actions-from-type (source) + "Get actions list from type attribute of SOURCE." + (when (assq 'type source) + (helm-get-attribute-from-source-type 'action source))) + +(defun helm-inherit-attribute-from-source (attribute source) + "Get the ATTRIBUTE of SOURCE." + (helm-aif (assq attribute source) + it + (helm-get-attribute-from-source-type attribute source))) + +(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-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 (quote ,predicate) candidate) + (helm-append-at-nth + actions (quote ,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)))) + +(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. + +Attributes: + +- type + `helm-type-attributes' are merged in. +- candidates-buffer + candidates, volatile and match attribute are created." + (cond + ;; action + ((helm-action-window) + helm-sources) + ;; memoized + (helm-compiled-sources) + ;; first time + (t + (prog1 + (setq helm-compiled-sources + (helm-compile-sources + helm-sources helm-compile-source-functions)) + (helm-log "helm-compiled-sources = %S" helm-compiled-sources))))) + +(defun helm-get-selection (&optional buffer force-display-part) + "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)))) + (source (helm-get-current-source))) + (helm-aif (and (not force-display-part) + (assoc-default 'display-to-real source)) + (helm-funcall-with-source source it disp) + disp))))) + (unless (equal selection "") + (helm-log "selection = %S" selection) + selection))))) + +(defun helm-get-actions-from-current-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)) + (helm-aif (helm-attr 'action-transformer) + (helm-funcall-with-source + (helm-get-current-source) 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))) + (helm-attr 'action nil 'ignorefn)))) + +(defun helm-get-current-source () + "Return the source for the current selection. +Allow also checking if helm-buffer contain candidates." + (or helm-current-source + (with-helm-buffer + ;; Return nil when no--candidates. + (cl-block exit + ;; This goto-char shouldn't be necessary, but point is moved to + ;; point-min somewhere else which shouldn't happen. + (goto-char (overlay-start helm-selection-overlay)) + (let* ((header-pos (or (helm-get-previous-header-pos) + (helm-get-next-header-pos))) + (source-name + (save-excursion + (unless header-pos + (cl-return-from exit nil)) + (goto-char header-pos) + (helm-current-line-contents)))) + (cl-loop 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* ((b (get-buffer buffer)) + (key (concat (buffer-name b) "/" (helm-attr 'name))) + (source-tick (or (gethash key helm-tick-hash) 0)) + (buffer-tick (buffer-chars-modified-tick b)) + (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 (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." + (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'. + (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)) + (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) + mode-line-in-non-selected-windows + (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) + ;; 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)) + (if (fboundp 'advice-add) + (progn + (advice-remove 'tramp-read-passwd + #'helm--advice-tramp-read-passwd) + (advice-remove 'ange-ftp-get-passwd + #'helm--advice-ange-ftp-get-passwd)) + (ad-deactivate 'tramp-read-passwd) + (ad-deactivate 'ange-ftp-get-passwd)) + (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 "") + (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 helm-full-frame cur-dir) + (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-size)))))) + + +;;; 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-major-mode) + (helm-log "Enabling major-mode %S" major-mode) + (helm-log "kill local variables: %S" (buffer-local-variables)) + (kill-all-local-variables) + (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-follow-mode) nil) + (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) + ;; 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) 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) + +(defadvice tramp-read-passwd (around disable-helm-update) + ;; 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) + (let (stimers) + (unwind-protect + (progn + (setq stimers (with-timeout-suspend)) + ad-do-it) + (with-timeout-unsuspend stimers) + (setq helm--reading-passwd-or-string nil) + (setq helm-suspend-update-flag nil)))) + +(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))) + +(defadvice ange-ftp-get-passwd (around disable-helm-update) + ;; 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 + ad-do-it + (setq helm--reading-passwd-or-string nil) + (setq helm-suspend-update-flag nil))) + +(defun helm--maybe-update-keymap (&optional map) + "Handle different keymaps in multiples sources. + +Overrides `helm-map' with the local map of current source. If no +map is found in current source, does nothing (keeps previous +map)." + (with-helm-buffer + (helm-aif (or map (assoc-default 'keymap (helm-get-current-source))) + ;; We used a timer in the past to leave + ;; enough time to helm to setup its keymap + ;; when changing source from a recursive minibuffer. + ;; e.g C-x C-f M-y C-g + ;; => *find-files have now the bindings of *kill-ring. + ;; It is no more true now we are using `minor-mode-overriding-map-alist' + ;; and `helm--minor-mode' thus it fix 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 'undefined)) + 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 + ;; 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) + (setq helm-debug 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: source compiler +;; +;; +(defun helm-compile-sources (sources funcs) + "Compile SOURCES with FUNCS. +See `helm-compile-source-functions'. +Helm plug-ins are realized by this function." + (mapcar + (lambda (source) + (cl-loop with src = (if (listp source) source (symbol-value source)) + for noplug = (assoc 'dont-plug src) + for f in funcs + unless (and noplug (memq f (cdr noplug))) + do (setq src (funcall f src)) + finally (cl-return src))) + sources)) + + +;; 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 (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")) + inhibit-quit) + `(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 CANDIDATE in SOURCE." + `(helm-aif (assoc-default 'filter-one-by-one ,source) + (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 ,candidate)) + finally return ,candidate) + (setq ,candidate (funcall it ,candidate))) + ,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) + (add-text-properties + (match-beginning 0) (match-end 0) '(face 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 + (split-string helm-pattern) + (split-string helm-pattern "" t)) + for p in patterns + for re = (helm--maybe-get-migemo-pattern p) + ;; Multi matches (regexps patterns). + if multi-match do + (progn + (while (re-search-forward re nil t) + (add-text-properties + (match-beginning 0) (match-end 0) + '(face helm-match))) + (goto-char (point-min))) + ;; Fuzzy matches (literal patterns). + else do + (when (search-forward re nil t) + (add-text-properties + (match-beginning 0) (match-end 0) + '(face 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) + (unless (assoc 'candidates-process source) + (helm-display-mode-line (helm-get-current-source)) + (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 (or (assoc 'matchplugin source) + (null (assoc 'no-matchplugin 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 (&optional without-hook) + "Goto first line of `helm-buffer'." + (goto-char (point-min)) + (unless without-hook + (save-excursion (helm-log-run-hook 'helm-update-hook))) + (helm-next-line)) + +(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-get-selection nil t))) + (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 () + (let ((src (helm-get-current-source))) + (helm-log-run-hook 'helm-update-hook) + (helm-aif (get-buffer-window helm-buffer 'visible) + (with-selected-window it + (helm-skip-noncandidate-line 'next) + (helm-mark-current-line) + (helm-display-mode-line src) + (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) + (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 + (helm-log-run-hook 'helm-select-action-hook) + (setq helm-saved-selection (helm-get-selection)) + (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) + (helm-set-pattern helm-input 'noupdate)) + (helm-saved-selection + (setq helm-saved-current-source (helm-get-current-source)) + (let ((actions (helm-get-actions-from-current-source))) + (if (functionp actions) + (message "Sole action: %s" 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) + "Setup mode-line and header-line for `helm-buffer'." + (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 (eq (cdr (assq 'follow source)) 1) " (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 + `(" " mode-line-buffer-identification " " + (:eval (format "L%-3d" (helm-candidate-number-at-point))) + ,follow + (:eval ,(and marked + (concat + " " + (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 " " mode-line-end-spaces) + 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) + "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) + (when (helm-get-previous-header-pos) + (helm-mark-current-line)) + (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)))) + (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 () + (with-helm-buffer + (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-next-line 1) + (helm-previous-line 1))) + (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))) + (helm-follow-execute-persistent-action-maybe)) + +(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* ((empty-buffer-p (with-current-buffer helm-buffer + (eq (point-min) (point-max)))) + (sel (helm-get-selection)) + (unknown (and (not empty-buffer-p) + (string= (get-text-property + 0 'display + (helm-get-selection nil 'withprop)) + "[?]")))) + (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 `helm-selection-overlay' to CANDIDATE-OR-REGEXP on startup. +Arg CANDIDATE-OR-REGEXP can be a string or a cons cell of two +strings. When cons cell, helm tries jumping to first element of +cons cell and then to the second, and so on. This allows finer +preselection if there are duplicates before the candidate we +want to preselect." + (with-helm-window + (when candidate-or-regexp + (if (and helm-force-updating-p source) + (helm-goto-source source) + (goto-char (point-min)) + (forward-line 1)) + (let ((start (point))) + (or + (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)) + (goto-char 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 (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))) + + +;;; Plugins (Deprecated in favor of helm-types) +;; +;; i.e Inherit instead of helm-type-* classes in your own classes. + +;; [DEPRECATED] Enable multi-match by default in old sources. +;; This is deprecated and will not run in sources +;; created by helm-source. +;; Keep it for backward compatibility with old sources. +(defun helm-compile-source--multi-match (source) + (if (assoc 'no-matchplugin source) + source + (let* ((searchers helm-mm-default-search-functions) + (defmatch (helm-aif (assoc-default 'match source) + (helm-mklist it))) + (defmatch-strict (helm-aif (assoc-default 'match-strict source) + (helm-mklist it))) + (defsearch (helm-aif (assoc-default 'search source) + (helm-mklist it))) + (defsearch-strict (helm-aif (assoc-default 'search-strict source) + (helm-mklist it))) + (matchfns (cond (defmatch-strict) + (defmatch + (append helm-mm-default-match-functions defmatch)) + (t helm-mm-default-match-functions))) + (searchfns (cond (defsearch-strict) + (defsearch + (append searchers defsearch)) + (t searchers)))) + `(,(if (assoc 'candidates-in-buffer source) + `(search ,@searchfns) `(match ,@matchfns)) + ,@source)))) + +(add-to-list 'helm-compile-source-functions 'helm-compile-source--multi-match) + +(defun helm-compile-source--type (source) + (helm-aif (assoc-default 'type source) + (append source (assoc-default it helm-type-attributes) nil) + source)) + +(defun define-helm-type-attribute (type definition &optional doc) + "Register type attribute of TYPE as DEFINITION with DOC. +DOC is displayed in `helm-type-attributes' docstring. + +Using this function is better than setting `helm-type-attributes' +directly." + (cl-loop for i in definition do + ;; without `ignore-errors', error at emacs22 + (ignore-errors (setf i (delete nil i)))) + (helm-add-type-attribute type definition) + (and doc (helm-document-type-attribute type doc)) + nil) + +(defun helm-document-attribute (attribute short-doc &optional long-doc) + "Register ATTRIBUTE documentation introduced by plug-in. +SHORT-DOC is displayed beside attribute name. +LONG-DOC is displayed below attribute name and short documentation." + (declare (indent 2)) + (if long-doc + (setq short-doc (concat "(" short-doc ")")) + (setq long-doc short-doc + short-doc "")) + (add-to-list 'helm-attributes attribute t) + (put attribute 'helm-attrdoc + (concat "- " (symbol-name attribute) + " " short-doc "\n\n" long-doc "\n"))) + +(defun helm-add-type-attribute (type definition) + (helm-aif (assq type helm-type-attributes) + (setq helm-type-attributes (delete it helm-type-attributes))) + (push (cons type definition) helm-type-attributes)) + +(defun helm-document-type-attribute (type doc) + (add-to-list 'helm-types type t) + (put type 'helm-typeattrdoc + (concat "- " (symbol-name type) "\n\n" doc "\n"))) + +;; Built-in plug-in: dummy +(defun helm-dummy-candidate (_candidate _source) + "Use `helm-pattern' as CANDIDATE in SOURCE." + ;; `source' is defined in filtered-candidate-transformer + (list helm-pattern)) + +(defun helm-compile-source--dummy (source) + (if (assoc 'dummy source) + (progn + (unless (helm-attr-defined + 'filtered-candidate-transformer source) + (helm-attrset 'filtered-candidate-transformer + 'helm-dummy-candidate source)) + (append source + '((candidates "dummy") + (accept-empty) + (match identity) + (volatile)))) + source)) + +;; Built-in plug-in: candidates-in-buffer +(defun helm-candidates-in-buffer (&optional source) + "The top level function used to store candidates in `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. This function is meant to be used in +candidates-in-buffer or candidates attribute of an helm source. +It is especially fast for many (1000+) candidates. + +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)) + +`candidates-in-buffer' is now deprecated in favor of +`helm-source-in-buffer' class. + +Description provided here for backward compatibility. + +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. It is the task of +`helm-candidates-in-buffer'. As long as +`helm-candidate-buffer' is used,`(candidates-in-buffer)' is +sufficient in most cases. + +Note that `(candidates-in-buffer)' is shortcut of three attributes: + (candidates . helm-candidates-in-buffer) + (volatile) + (match identity) +And `(candidates-in-buffer . func)' is shortcut of three attributes: + (candidates . func) + (volatile) + (match identity) +The expansion is performed in `helm-get-sources'. + +The `candidates-in-buffer' attribute implies the volatile attribute. +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))) + (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)) + +(defun helm-compile-source--candidates-in-buffer (source) + (helm-aif (assoc 'candidates-in-buffer source) + (append source + `((candidates . ,(or (cdr it) + (lambda () + (helm-candidates-in-buffer source)))) + (volatile) (match identity))) + source)) + + +;;; 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." + (setq helm-saved-selection (helm-get-selection)) + (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 (helm-get-current-source)) + (helm-get-actions-from-current-source)))) + (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))) + +;; Utility: Persistent Action +(defmacro with-helm-display-same-window (&rest body) + "Execute BODY in the window used for persistent action. +Make `pop-to-buffer' and `display-buffer' display in the same window." + (declare (indent 0) (debug t)) + `(let ((display-buffer-function 'helm-persistent-action-display-buffer)) + ,@body)) + +(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* ((attr-val (assoc-default attr (helm-get-current-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)))) + (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)) + (with-helm-display-same-window + (helm-execute-selection-action-1 + nil (or fn (helm-get-actions-from-current-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)))) + +(defun helm-persistent-action-display-buffer (buf &optional action) + "Make `pop-to-buffer' and `display-buffer' display in the same window. +If `helm-persistent-action-use-special-display' is non-`nil' and +BUF is to be displayed by `special-display-function', use it. +Otherwise ignore `special-display-buffer-names' and `special-display-regexps'. +Argument ACTION, when present, is used as second argument of `display-buffer'." + (let* ((name (buffer-name buf)) + display-buffer-function pop-up-windows pop-up-frames + ;; Disable `special-display-regexps' and `special-display-buffer-names' + ;; unless `helm-persistent-action-use-special-display' is non-`nil'. + (special-display-buffer-names + (and helm-persistent-action-use-special-display + special-display-buffer-names)) + (special-display-regexps + (and helm-persistent-action-use-special-display + special-display-regexps)) + (same-window-regexps + (unless (and helm-persistent-action-use-special-display + (or (member name + (mapcar (lambda (x) (or (car-safe x) x)) + special-display-buffer-names)) + (cl-loop for x in special-display-regexps + thereis (string-match (or (car-safe x) x) + name)))) + '(".")))) + ;; Don't loose minibuffer when displaying persistent window in + ;; another frame. + ;; This happen when the displayed persistent buffer-name is one of + ;; `special-display-buffer-names' or match `special-display-regexps' + ;; and `helm-persistent-action-use-special-display' is enabled. + (with-selected-window (if (or special-display-regexps + special-display-buffer-names) + (minibuffer-window) + (selected-window)) + ;; Be sure window of BUF is not dedicated. + (set-window-dedicated-p (get-buffer-window buf) nil) + (display-buffer buf action)))) + +;; 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 helm-visible-mark-overlays + when (equal (point-at-bol) (overlay-start o)) + return o)) + +(defun helm-delete-visible-mark (overlay) + (setq helm-marked-candidates + (remove + (cons (helm-get-current-source) (helm-get-selection)) + helm-marked-candidates)) + (delete-overlay overlay) + (setq helm-visible-mark-overlays + (delq overlay helm-visible-mark-overlays))) + +(defun helm-make-visible-mark () + (let ((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 (helm-get-current-source))) + (overlay-put o 'string (buffer-substring (overlay-start o) (overlay-end o))) + (overlay-put o 'real (helm-get-selection)) + (add-to-list 'helm-visible-mark-overlays o)) + (push (cons (helm-get-current-source) (helm-get-selection)) + 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 () + "Return non-`nil' if current source is a file completion source." + (or minibuffer-completing-file-name + (let ((cur-source (cdr (assoc 'name (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 ((nomark (assq 'nomark (helm-get-current-source))) + (follow (if helm-follow-mode 1 -1))) + (helm-follow-mode -1) + (unwind-protect + (if nomark + (message "Marking not allowed in this source") + (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* ((prefix (get-text-property (point-at-bol) 'display)) + (cand (helm-get-selection)) + (bn (and (helm-file-completion-source-p) + (helm-basename cand))) + (src-name (assoc-default 'name + (helm-get-current-source)))) + (when (and (not (helm-this-visible-mark)) + (not (or (string= prefix "[?]") + (string= prefix "[@]")))) + ;; Don't mark possibles directories ending with . or .. + ;; autosave files/links and non--existent file. + (unless + (and (or (helm-file-completion-source-p) + (string= + src-name "Files from Current Directory")) + (or (string-match + "^[.]?#.*#?$\\|[^#]*[.]\\{1,2\\}$" bn) + ;; We need to test here when not using + ;; a transformer that tag prefix + ;; (i.e on tramp). + (not (file-exists-p cand)))) + (helm-make-visible-mark)))) + (if (helm-pos-multiline-p) + (progn + (goto-char + (or (helm-get-next-candidate-separator-pos) + (point-max))) + (forward-line 1)) + (forward-line 1)) + (end-of-line)))) + (helm-mark-current-line)) + (helm-follow-mode follow) (message nil)))))) +(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 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) + when (equal (assq 'name source) (assq 'name current-src)) + append (helm--compute-marked real source with-wildcard) + into cands + finally return (or cands + (append + (helm--compute-marked + (helm-get-selection) current-src + with-wildcard) + cands))))) + (helm-log "Marked candidates = %S" candidates) + candidates))) + +(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-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 +;; +;; +(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]. + +It can also be enabled specifically for a source by adding the +`follow' attribute to the source. +Value of this attribute can be -1, 1, or 'never. +If the source is defined with its own class, +you can use `helm-setup-user-source' e.g: + + (defmethod helm-setup-user-source ((source helm-grep-class)) + (setf (slot-value source 'follow) 1)) + +Otherwise, use `helm-attrset' to setup the `follow' attribute of the existing source, +which see. + +Even with `follow' attribute, a source can be interactively disabled or enabled +unless `follow' attribute value is 'never. +When enabling interactively `helm-follow-mode' in a source, you can keep it enabled +for next helm sessions by setting `helm-follow-mode-persistent' to a non-nil value. + +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 "p") + (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 + ;; If `helm-follow-mode' is called with a negative + ;; ARG, assume follow is already enabled. + ;; i.e turn it off now. + (< arg 0) + (eq (cdr fol-attr) 1) + helm-follow-mode))) + (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-attrset 'follow (if enabled -1 1) src) + (setq helm-follow-mode (not enabled)) + (message "helm-follow-mode is %s" + (if helm-follow-mode + "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) + +(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-execute-persistent-action-maybe () + "Execute persistent action in mode `helm-follow-mode'. +This happen after `helm-input-idle-delay' secs." + (let ((src (helm-get-current-source))) + (and (not (get-buffer-window helm-action-buffer 'visible)) + (eq (assoc-default 'follow src) 1) + (sit-for (or (assoc-default 'follow-delay src) + helm-follow-input-idle-delay + (and helm-input-idle-delay + (max helm-input-idle-delay 0.01)))) + (helm-window) + (helm-get-selection) + (save-excursion + (helm-execute-persistent-action))))) + + +;;; 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 diff --git a/elpa/helm-gtags-20160417.555/helm-gtags-autoloads.el b/elpa/helm-gtags-20160417.555/helm-gtags-autoloads.el new file mode 100644 index 0000000..35a9108 --- /dev/null +++ b/elpa/helm-gtags-20160417.555/helm-gtags-autoloads.el @@ -0,0 +1,148 @@ +;;; helm-gtags-autoloads.el --- automatically extracted autoloads +;; +;;; Code: +(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) + +;;;### (autoloads nil "helm-gtags" "helm-gtags.el" (22297 20823 749050 +;;;;;; 904000)) +;;; Generated autoloads from helm-gtags.el + +(autoload 'helm-gtags-clear-all-cache "helm-gtags" "\ + + +\(fn)" t nil) + +(autoload 'helm-gtags-clear-cache "helm-gtags" "\ + + +\(fn)" t nil) + +(autoload 'helm-gtags-next-history "helm-gtags" "\ +Jump to next position on context stack + +\(fn)" t nil) + +(autoload 'helm-gtags-previous-history "helm-gtags" "\ +Jump to previous position on context stack + +\(fn)" t nil) + +(autoload 'helm-gtags-select "helm-gtags" "\ + + +\(fn)" t nil) + +(autoload 'helm-gtags-select-path "helm-gtags" "\ + + +\(fn)" t nil) + +(autoload 'helm-gtags-tags-in-this-function "helm-gtags" "\ +Show tagnames which are referenced in this function and jump to it. + +\(fn)" t nil) + +(autoload 'helm-gtags-create-tags "helm-gtags" "\ + + +\(fn DIR LABEL)" t nil) + +(autoload 'helm-gtags-find-tag "helm-gtags" "\ +Jump to definition + +\(fn TAG)" t nil) + +(autoload 'helm-gtags-find-tag-other-window "helm-gtags" "\ +Jump to definition in other window. + +\(fn TAG)" t nil) + +(autoload 'helm-gtags-find-rtag "helm-gtags" "\ +Jump to referenced point + +\(fn TAG)" t nil) + +(autoload 'helm-gtags-find-symbol "helm-gtags" "\ +Jump to the symbol location + +\(fn TAG)" t nil) + +(autoload 'helm-gtags-find-pattern "helm-gtags" "\ +Grep and jump by gtags tag files. + +\(fn PATTERN)" t nil) + +(autoload 'helm-gtags-find-files "helm-gtags" "\ +Find file from tagged with gnu global. + +\(fn FILE)" t nil) + +(autoload 'helm-gtags-find-tag-from-here "helm-gtags" "\ +Jump point by current point information. +Jump to definition point if cursor is on its reference. +Jump to reference point if curosr is on its definition + +\(fn)" t nil) + +(autoload 'helm-gtags-dwim "helm-gtags" "\ +Find by context. Here is +- on include statement then jump to included file +- on symbol definition then jump to its references +- on reference point then jump to its definition. + +\(fn)" t nil) + +(autoload 'helm-gtags-parse-file "helm-gtags" "\ +Parse current file with gnu global. This is similar to `imenu'. +You can jump definitions of functions, symbols in this file. + +\(fn)" t nil) + +(autoload 'helm-gtags-pop-stack "helm-gtags" "\ +Jump to previous point on the context stack and pop it from stack. + +\(fn)" t nil) + +(autoload 'helm-gtags-show-stack "helm-gtags" "\ +Show current context stack. + +\(fn)" t nil) + +(autoload 'helm-gtags-clear-stack "helm-gtags" "\ +Clear current context stack. + +\(fn)" t nil) + +(autoload 'helm-gtags-clear-all-stacks "helm-gtags" "\ +Clear all context stacks. + +\(fn)" t nil) + +(autoload 'helm-gtags-update-tags "helm-gtags" "\ +Update TAG file. Update All files with `C-u' prefix. +Generate new TAG file in selected directory with `C-u C-u' + +\(fn)" t nil) + +(autoload 'helm-gtags-resume "helm-gtags" "\ +Resurrect previously invoked `helm-gtags` command. + +\(fn)" t nil) + +(autoload 'helm-gtags-mode "helm-gtags" "\ +Toggle Helm-Gtags mode on or off. +With a prefix argument ARG, enable Helm-Gtags mode if ARG is +positive, and disable it otherwise. If called from Lisp, enable +the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'. +\\{helm-gtags-mode-map} + +\(fn &optional ARG)" t nil) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; End: +;;; helm-gtags-autoloads.el ends here diff --git a/elpa/helm-gtags-20160417.555/helm-gtags-pkg.el b/elpa/helm-gtags-20160417.555/helm-gtags-pkg.el new file mode 100644 index 0000000..a19a951 --- /dev/null +++ b/elpa/helm-gtags-20160417.555/helm-gtags-pkg.el @@ -0,0 +1 @@ +(define-package "helm-gtags" "20160417.555" "GNU GLOBAL helm interface" '((emacs "24.3") (helm "1.7.7")) :url "https://github.com/syohex/emacs-helm-gtags") diff --git a/elpa/helm-gtags-20160417.555/helm-gtags.el b/elpa/helm-gtags-20160417.555/helm-gtags.el new file mode 100644 index 0000000..7e8fd17 --- /dev/null +++ b/elpa/helm-gtags-20160417.555/helm-gtags.el @@ -0,0 +1,1319 @@ +;;; helm-gtags.el --- GNU GLOBAL helm interface -*- lexical-binding: t; -*- + +;; Copyright (C) 2016 by Syohei YOSHIDA + +;; Author: Syohei YOSHIDA +;; URL: https://github.com/syohex/emacs-helm-gtags +;; Package-Version: 20160417.555 +;; Version: 1.5.6 +;; Package-Requires: ((emacs "24.3") (helm "1.7.7")) + +;; 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: + +;; `helm-gtags.el' is a `helm' interface of GNU Global. +;; `helm-gtags.el' is not compatible `anything-gtags.el', but `helm-gtags.el' +;; is designed for fast search. + +;; +;; To use this package, add these lines to your init.el or .emacs file: +;; +;; ;; Enable helm-gtags-mode +;; (add-hook 'c-mode-hook 'helm-gtags-mode) +;; (add-hook 'c++-mode-hook 'helm-gtags-mode) +;; (add-hook 'asm-mode-hook 'helm-gtags-mode) +;; +;; ;; Set key bindings +;; (eval-after-load "helm-gtags" +;; '(progn +;; (define-key helm-gtags-mode-map (kbd "M-t") 'helm-gtags-find-tag) +;; (define-key helm-gtags-mode-map (kbd "M-r") 'helm-gtags-find-rtag) +;; (define-key helm-gtags-mode-map (kbd "M-s") 'helm-gtags-find-symbol) +;; (define-key helm-gtags-mode-map (kbd "M-g M-p") 'helm-gtags-parse-file) +;; (define-key helm-gtags-mode-map (kbd "C-c <") 'helm-gtags-previous-history) +;; (define-key helm-gtags-mode-map (kbd "C-c >") 'helm-gtags-next-history) +;; (define-key helm-gtags-mode-map (kbd "M-,") 'helm-gtags-pop-stack))) +;; + +;;; Code: + +(require 'cl-lib) +(require 'helm) +(require 'helm-files) +(require 'which-func) +(require 'pulse) + +(declare-function helm-comp-read "helm-mode") +(declare-function cygwin-convert-file-name-from-windows "cygw32.c") +(declare-function cygwin-convert-file-name-to-windows "cygw32.c") + +(defgroup helm-gtags nil + "GNU GLOBAL for helm." + :group 'helm) + +(defcustom helm-gtags-path-style 'root + "Style of file path" + :type '(choice (const :tag "Root of the current project" root) + (const :tag "Relative from the current directory" relative) + (const :tag "Absolute Path" absolute))) + +(defcustom helm-gtags-ignore-case nil + "Ignore case in each search." + :type 'boolean) + +(defcustom helm-gtags-read-only nil + "Gtags read only mode." + :type 'boolean) + +(defcustom helm-gtags-auto-update nil + "*If non-nil, tag files are updated whenever a file is saved." + :type 'boolean) + +(defcustom helm-gtags-pulse-at-cursor t + "If non-nil, pulse at point after jumping" + :type 'boolean) + +(defcustom helm-gtags-cache-select-result nil + "*If non-nil, results of helm-gtags-select and helm-gtags-select-path are cached." + :type 'boolean) + +(defcustom helm-gtags-cache-max-result-size (* 10 1024 1024) ;10M + "Max size(bytes) to cache for each select result." + :type 'integer) + +(defcustom helm-gtags-update-interval-second 60 + "Tags are updated in `after-save-hook' if this seconds is passed from last update. +Always update if value of this variable is nil." + :type '(choice (integer :tag "Update interval seconds") + (boolean :tag "Update every time" nil))) + +(defcustom helm-gtags-highlight-candidate t + "Highlight candidate or not" + :type 'boolean) + +(defcustom helm-gtags-use-input-at-cursor nil + "Use input at cursor" + :type 'boolean) + +(defcustom helm-gtags-prefix-key "\C-c" + "If non-nil, it is used for the prefix key of gtags-xxx command." + :type 'string) + +(defcustom helm-gtags-suggested-key-mapping nil + "If non-nil, suggested key mapping is enabled." + :type 'boolean) + +(defcustom helm-gtags-preselect nil + "If non-nil, preselect current file and line." + :type 'boolean) + +(defcustom helm-gtags-display-style nil + "Style of display result." + :type '(choice (const :tag "Show in detail" detail) + (const :tag "Normal style" nil))) + +(defcustom helm-gtags-fuzzy-match nil + "Enable fuzzy match" + :type 'boolean) + +(defcustom helm-gtags-maximum-candidates (if helm-gtags-fuzzy-match 100 9999) + "Maximum number of helm candidates" + :type 'integer) + +(defcustom helm-gtags-direct-helm-completing nil + "Use helm mode directly." + :type 'boolean) + +(defface helm-gtags-file + '((t :inherit font-lock-keyword-face)) + "Face for line numbers in the error list.") + +(defface helm-gtags-lineno + '((t :inherit font-lock-doc-face)) + "Face for line numbers in the error list.") + +(defface helm-gtags-match + '((t :inherit helm-match)) + "Face for word matched against tagname") + +(defvar helm-gtags--tag-location nil) +(defvar helm-gtags--last-update-time 0) +(defvar helm-gtags--completing-history nil) +(defvar helm-gtags--context-stack (make-hash-table :test 'equal)) +(defvar helm-gtags--result-cache (make-hash-table :test 'equal)) +(defvar helm-gtags--saved-context nil) +(defvar helm-gtags--use-otherwin nil) +(defvar helm-gtags--local-directory nil) +(defvar helm-gtags--parsed-file nil) +(defvar helm-gtags--current-position nil) +(defvar helm-gtags--real-tag-location nil) +(defvar helm-gtags--last-input nil) +(defvar helm-gtags--query nil) +(defvar helm-gtags--last-default-directory nil) + +(defconst helm-gtags--buffer "*helm gtags*") + +(defconst helm-gtags--include-regexp + "\\`\\s-*#\\(?:include\\|import\\)\\s-*[\"<]\\(?:[./]*\\)?\\(.*?\\)[\">]") + +(defmacro helm-declare-obsolete-variable (old new version) + `(progn + (defvaralias ,old ,new) + (make-obsolete-variable ,old ,new ,version))) + +(helm-declare-obsolete-variable + 'helm-c-gtags-path-style 'helm-gtags-path-style "0.8") +(helm-declare-obsolete-variable + 'helm-c-gtags-ignore-case 'helm-gtags-ignore-case "0.8") +(helm-declare-obsolete-variable + 'helm-c-gtags-read-only 'helm-gtags-read-only "0.8") + +;; completsion function for completing-read. +(defun helm-gtags--completing-gtags (string predicate code) + (helm-gtags--complete 'tag string predicate code)) +(defun helm-gtags--completing-pattern (string predicate code) + (helm-gtags--complete 'pattern string predicate code)) +(defun helm-gtags--completing-grtags (string predicate code) + (helm-gtags--complete 'rtag string predicate code)) +(defun helm-gtags--completing-gsyms (string predicate code) + (helm-gtags--complete 'symbol string predicate code)) +(defun helm-gtags--completing-files (string predicate code) + (helm-gtags--complete 'find-file string predicate code)) + +(defconst helm-gtags-comp-func-alist + '((tag . helm-gtags--completing-gtags) + (pattern . helm-gtags--completing-pattern) + (rtag . helm-gtags--completing-grtags) + (symbol . helm-gtags--completing-gsyms) + (find-file . helm-gtags--completing-files))) + +(defconst helm-gtags--search-option-alist + '((pattern . "-g") + (rtag . "-r") + (symbol . "-s") + (find-file . "-Poa"))) + +(defsubst helm-gtags--windows-p () + (memq system-type '(windows-nt ms-dos))) + +(defun helm-gtags--remove-carrige-returns () + (when (helm-gtags--windows-p) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "\xd" nil t) + (replace-match ""))))) + +;; Work around for GNU global Windows issue +(defsubst helm-gtags--use-abs-path-p (gtagslibpath) + (and (helm-gtags--windows-p) gtagslibpath)) + +(defun helm-gtags--construct-options (type completion) + (let ((find-file-p (eq type 'find-file)) + (gtagslibpath (getenv "GTAGSLIBPATH")) + options) + (unless find-file-p + (push "--result=grep" options)) + (when completion + (push "-c" options)) + (helm-aif (assoc-default type helm-gtags--search-option-alist) + (push it options)) + (when (or (eq helm-gtags-path-style 'absolute) + (helm-gtags--use-abs-path-p gtagslibpath)) + (push "-a" options)) + (when helm-gtags-ignore-case + (push "-i" options)) + (when (and current-prefix-arg (not find-file-p)) + (push "-l" options)) + (when gtagslibpath + (push "-T" options)) + options)) + +(defun helm-gtags--complete (type string predicate code) + (let* ((options (helm-gtags--construct-options type t)) + (args (reverse (cons string options))) + candidates) + (with-temp-buffer + (apply #'process-file "global" nil t nil args) + (goto-char (point-min)) + (while (re-search-forward "^\\(.+\\)$" nil t) + (push (match-string-no-properties 1) candidates))) + (if (not code) + (try-completion string candidates predicate) + (all-completions string candidates predicate)))) + +(defun helm-gtags--token-at-point (type) + (if (not (eq type 'find-file)) + (thing-at-point 'symbol) + (let ((line (helm-current-line-contents))) + (when (string-match helm-gtags--include-regexp line) + (match-string-no-properties 1 line))))) + +(defconst helm-gtags--prompt-alist + '((tag . "Find Definition: ") + (pattern . "Find Pattern: ") + (rtag . "Find Reference: ") + (symbol . "Find Symbol: ") + (find-file . "Find File: "))) + +(defun helm-gtags--read-tagname (type &optional default-tagname) + (let ((tagname (helm-gtags--token-at-point type)) + (prompt (assoc-default type helm-gtags--prompt-alist)) + (comp-func (assoc-default type helm-gtags-comp-func-alist))) + (if (and tagname helm-gtags-use-input-at-cursor) + tagname + (when (and (not tagname) default-tagname) + (setq tagname default-tagname)) + (when tagname + (setq prompt (format "%s(default \"%s\") " prompt tagname))) + (let ((completion-ignore-case helm-gtags-ignore-case) + (completing-read-function 'completing-read-default)) + (if (and helm-gtags-direct-helm-completing (memq type '(tag rtag symbol find-file))) + (helm-comp-read prompt comp-func + :history 'helm-gtags--completing-history + :exec-when-only-one t + :default tagname) + (completing-read prompt comp-func nil nil nil + 'helm-gtags--completing-history tagname)))))) + +(defun helm-gtags--path-libpath-p (tagroot) + (helm-aif (getenv "GTAGSLIBPATH") + (cl-loop for path in (parse-colon-path it) + for libpath = (file-name-as-directory (expand-file-name path)) + thereis (string= tagroot libpath)))) + +(defun helm-gtags--tag-directory () + (with-temp-buffer + (helm-aif (getenv "GTAGSROOT") + it + (unless (zerop (process-file "global" nil t nil "-p")) + (error "GTAGS not found")) + (goto-char (point-min)) + (when (looking-at "^\\([^\r\n]+\\)") + (let ((tag-path (match-string-no-properties 1))) + (file-name-as-directory + (if (eq system-type 'cygwin) + (cygwin-convert-file-name-from-windows tag-path) + tag-path))))))) + +(defun helm-gtags--find-tag-directory () + (setq helm-gtags--real-tag-location nil) + (let ((tagroot (helm-gtags--tag-directory))) + (if (and (helm-gtags--path-libpath-p tagroot) helm-gtags--tag-location) + (progn + (setq helm-gtags--real-tag-location tagroot) + helm-gtags--tag-location) + (setq helm-gtags--tag-location tagroot)))) + +(defun helm-gtags--base-directory () + (let ((dir (or helm-gtags--last-default-directory + helm-gtags--local-directory + (cl-case helm-gtags-path-style + (root (or helm-gtags--real-tag-location + helm-gtags--tag-location)) + (otherwise default-directory)))) + (remote (file-remote-p default-directory))) + (if (and remote (not (file-remote-p dir))) + (concat remote dir) + dir))) + +(defsubst helm-gtags--new-context-info (index stack) + (list :index index :stack stack)) + +(defun helm-gtags--put-context-stack (tag-location index stack) + (puthash tag-location (helm-gtags--new-context-info index stack) + helm-gtags--context-stack)) + +(defsubst helm-gtags--current-context () + (let ((file (buffer-file-name (current-buffer)))) + (list :file file :position (point) :readonly buffer-file-read-only))) + +(defsubst helm-gtags--save-current-context () + (setq helm-gtags--saved-context (helm-gtags--current-context))) + +(defun helm-gtags--open-file (file readonly) + (if readonly + (find-file-read-only file) + (find-file file))) + +(defun helm-gtags--open-file-other-window (file readonly) + (setq helm-gtags--use-otherwin nil) + (if readonly + (find-file-read-only-other-window file) + (find-file-other-window file))) + +(defun helm-gtags--get-context-info () + (let* ((tag-location (helm-gtags--find-tag-directory)) + (context-info (gethash tag-location helm-gtags--context-stack)) + (context-stack (plist-get context-info :stack))) + (if (null context-stack) + (error "Context stack is empty(TAG at %s)" tag-location) + context-info))) + +(defun helm-gtags--get-or-create-context-info () + (or (gethash helm-gtags--tag-location helm-gtags--context-stack) + (helm-gtags--new-context-info -1 nil))) + +;;;###autoload +(defun helm-gtags-clear-all-cache () + (interactive) + (clrhash helm-gtags--result-cache)) + +;;;###autoload +(defun helm-gtags-clear-cache () + (interactive) + (helm-gtags--find-tag-directory) + (let* ((tag-location (or helm-gtags--real-tag-location + helm-gtags--tag-location)) + (gtags-path (concat tag-location "GTAGS")) + (gpath-path (concat tag-location "GPATH"))) + (remhash gtags-path helm-gtags--result-cache) + (remhash gpath-path helm-gtags--result-cache))) + +(defun helm-gtags--move-to-context (context) + (let ((file (plist-get context :file)) + (curpoint (plist-get context :position)) + (readonly (plist-get context :readonly))) + (helm-gtags--open-file file readonly) + (goto-char curpoint) + (recenter))) + +;;;###autoload +(defun helm-gtags-next-history () + "Jump to next position on context stack" + (interactive) + (let* ((context-info (helm-gtags--get-context-info)) + (current-index (plist-get context-info :index)) + (context-stack (plist-get context-info :stack)) + context) + (when (<= current-index -1) + (error "This context is latest in context stack")) + (setf (nth current-index context-stack) (helm-gtags--current-context)) + (cl-decf current-index) + (if (= current-index -1) + (setq context helm-gtags--current-position + helm-gtags--current-position nil) + (setq context (nth current-index context-stack))) + (helm-gtags--put-context-stack helm-gtags--tag-location + current-index context-stack) + (helm-gtags--move-to-context context))) + +;;;###autoload +(defun helm-gtags-previous-history () + "Jump to previous position on context stack" + (interactive) + (let* ((context-info (helm-gtags--get-context-info)) + (current-index (plist-get context-info :index)) + (context-stack (plist-get context-info :stack)) + (context-length (length context-stack))) + (cl-incf current-index) + (when (>= current-index context-length) + (error "This context is last in context stack")) + (if (= current-index 0) + (setq helm-gtags--current-position (helm-gtags--current-context)) + (setf (nth (- current-index 1) context-stack) (helm-gtags--current-context))) + (let ((prev-context (nth current-index context-stack))) + (helm-gtags--move-to-context prev-context)) + (helm-gtags--put-context-stack helm-gtags--tag-location + current-index context-stack))) + +(defun helm-gtags--get-result-cache (file) + (helm-gtags--find-tag-directory) + (let* ((file-path (concat (or helm-gtags--real-tag-location + helm-gtags--tag-location) + file)) + (file-mtime (nth 5 (file-attributes file-path))) + (hash-value (gethash file-path helm-gtags--result-cache)) + (cached-file-mtime (nth 0 hash-value))) + (if (and cached-file-mtime (equal cached-file-mtime file-mtime)) + (nth 1 hash-value) + nil))) + +(defun helm-gtags--put-result-cache (file cache) + (helm-gtags--find-tag-directory) + (let* ((file-path (concat (or helm-gtags--real-tag-location + helm-gtags--tag-location) + file)) + (file-mtime (nth 5 (file-attributes file-path))) + (hash-value (list file-mtime cache))) + (puthash file-path hash-value helm-gtags--result-cache))) + +(defun helm-gtags--referer-function (file ref-line) + (let ((is-opened (cl-loop with path = (concat default-directory file) + for buf in (buffer-list) + when (string= (buffer-file-name buf) path) + return it)) + retval) + (with-current-buffer (find-file-noselect file) + (goto-char (point-min)) + (forward-line (1- ref-line)) + (unless (zerop (current-indentation)) + (setq retval (which-function))) + (unless is-opened + (kill-buffer (current-buffer))) + retval))) + +(defun helm-gtags--show-detail () + (goto-char (point-min)) + (while (not (eobp)) + (let ((line (helm-current-line-contents))) + (let* ((file-and-line (helm-gtags--extract-file-and-line line)) + (file (car file-and-line)) + (ref-line (cdr file-and-line)) + (ref-func (helm-gtags--referer-function file ref-line))) + (when ref-func + (search-forward ":" nil nil 2) + (insert " " ref-func "|")) + (forward-line 1))))) + +(defun helm-gtags--print-path-in-gtagslibpath (args) + (let ((libpath (getenv "GTAGSLIBPATH"))) + (when libpath + (dolist (path (parse-colon-path libpath)) + (let ((default-directory (file-name-as-directory path))) + (apply #'process-file "global" nil t nil "-Poa" args)))))) + +(defun helm-gtags--exec-global-command (type input &optional detail) + (let ((args (helm-gtags--construct-command type input))) + (helm-gtags--find-tag-directory) + (helm-gtags--save-current-context) + (let ((buf-coding buffer-file-coding-system)) + (with-current-buffer (helm-candidate-buffer 'global) + (let ((default-directory (helm-gtags--base-directory)) + (input (car (last args))) + (coding-system-for-read buf-coding) + (coding-system-for-write buf-coding)) + (unless (zerop (apply #'process-file "global" nil '(t nil) nil args)) + (error (format "%s: not found" input))) + ;; --path options does not support searching under GTAGSLIBPATH + (when (eq type 'find-file) + (helm-gtags--print-path-in-gtagslibpath args)) + (helm-gtags--remove-carrige-returns) + (when detail + (helm-gtags--show-detail))))))) + +(defun helm-gtags--construct-command (type &optional in) + (setq helm-gtags--local-directory nil) + (let ((dir (helm-attr 'helm-gtags-base-directory (helm-get-current-source)))) + (when (and dir (not (eq type 'find-file))) + (setq helm-gtags--local-directory dir))) + (let ((input (or in helm-gtags--query)) + (options (helm-gtags--construct-options type nil))) + (when (string= input "") + (error "Input is empty!!")) + (setq helm-gtags--last-input input) + (reverse (cons input options)))) + +(defun helm-gtags--tags-init (&optional input) + (helm-gtags--exec-global-command 'tag input)) + +(defun helm-gtags--pattern-init (&optional input) + (helm-gtags--exec-global-command 'pattern input helm-gtags-display-style)) + +(defun helm-gtags--rtags-init (&optional input) + (helm-gtags--exec-global-command 'rtag input helm-gtags-display-style)) + +(defun helm-gtags--gsyms-init () + (helm-gtags--exec-global-command 'symbol nil helm-gtags-display-style)) + +(defun helm-gtags--files-init () + (helm-gtags--exec-global-command 'find-file nil)) + +(defun helm-gtags--real-file-name () + (let ((buffile (buffer-file-name))) + (unless buffile + (error "This buffer is not related to file.")) + (if (file-remote-p buffile) + (tramp-file-name-localname (tramp-dissect-file-name buffile)) + (file-truename buffile)))) + +(defun helm-gtags--find-tag-from-here-init () + (helm-gtags--find-tag-directory) + (helm-gtags--save-current-context) + (let ((token (helm-gtags--token-at-point 'from-here))) + (unless token + (error "Cursor is not on symbol.")) + (let* ((filename (helm-gtags--real-file-name)) + (from-here-opt (format "--from-here=%d:%s" + (line-number-at-pos) + (if (eq system-type 'cygwin) + (cygwin-convert-file-name-to-windows filename) + filename)))) + (setq helm-gtags--last-input token) + (with-current-buffer (helm-candidate-buffer 'global) + (let* ((default-directory (helm-gtags--base-directory)) + (status (process-file "global" nil '(t nil) nil + "--result=grep" from-here-opt token))) + (helm-gtags--remove-carrige-returns) + (unless (zerop status) + (cond ((= status 1) + (error "Error: %s%s" (buffer-string) filename)) + ((= status 3) + (error "Error: %s" (buffer-string))) + (t (error "%s: not found" token))))))))) + +(defun helm-gtags--parse-file-init () + (with-current-buffer (helm-candidate-buffer 'global) + (unless (zerop (process-file "global" nil t nil + "--result=cscope" "-f" helm-gtags--parsed-file)) + (error "Failed: 'global --result=cscope -f %s" helm-gtags--parsed-file)) + (helm-gtags--remove-carrige-returns))) + +(defun helm-gtags--push-context (context) + (let* ((context-info (helm-gtags--get-or-create-context-info)) + (current-index (plist-get context-info :index)) + (context-stack (plist-get context-info :stack))) + (unless (= current-index -1) + (setq context-stack (nthcdr (1+ current-index) context-stack))) + (setq helm-gtags--current-position nil) + (push context context-stack) + (helm-gtags--put-context-stack helm-gtags--tag-location -1 context-stack))) + +(defsubst helm-gtags--select-find-file-func () + (if helm-gtags--use-otherwin + #'helm-gtags--open-file-other-window + #'helm-gtags--open-file)) + +(defun helm-gtags--do-open-file (open-func file line) + (funcall open-func file helm-gtags-read-only) + (goto-char (point-min)) + (forward-line (1- line)) + (back-to-indentation) + (recenter) + (helm-gtags--push-context helm-gtags--saved-context) + (when helm-gtags-pulse-at-cursor + (pulse-momentary-highlight-one-line (point)))) + +(defun helm-gtags--find-line-number (cand) + (if (string-match "\\s-+\\([1-9][0-9]+\\)\\s-+" cand) + (string-to-number (match-string-no-properties 1 cand)) + (error "Can't find line number in %s" cand))) + +(defun helm-gtags--parse-file-action (cand) + (let ((line (helm-gtags--find-line-number cand)) + (open-func (helm-gtags--select-find-file-func))) + (helm-gtags--do-open-file open-func helm-gtags--parsed-file line))) + +(defsubst helm-gtags--has-drive-letter-p (path) + (string-match-p "\\`[a-zA-Z]:" path)) + +(defun helm-gtags--extract-file-and-line (cand) + (if (and (helm-gtags--windows-p) (helm-gtags--has-drive-letter-p cand)) + (when (string-match "\\(\\`[a-zA-Z]:[^:]+\\):\\([^:]+\\)" cand) + (cons (match-string-no-properties 1 cand) + (string-to-number (match-string-no-properties 2 cand)))) + (let ((elems (split-string cand ":"))) + (cons (cl-first elems) (string-to-number (cl-second elems)))))) + +(defun helm-gtags--action-openfile (cand) + (let* ((file-and-line (helm-gtags--extract-file-and-line cand)) + (filename (car file-and-line)) + (line (cdr file-and-line)) + (open-func (helm-gtags--select-find-file-func)) + (default-directory (helm-gtags--base-directory))) + (helm-gtags--do-open-file open-func filename line))) + +(defun helm-gtags--action-openfile-other-window (cand) + (let ((helm-gtags--use-otherwin t)) + (helm-gtags--action-openfile cand))) + +(defun helm-gtags--file-content-at-pos (file pos) + (with-current-buffer (find-file-noselect file) + (save-excursion + (goto-char pos) + (format "%s:%d:%s:%s" + file (line-number-at-pos) + (helm-aif (which-function) (format "[%s]" it) "") + (helm-current-line-contents))))) + +(defun helm-gtags--files-candidate-transformer (file) + (if (eq helm-gtags-path-style 'absolute) + file + (let ((removed-regexp (concat "\\`" helm-gtags--tag-location))) + (replace-regexp-in-string removed-regexp "" file)))) + +(defun helm-gtags--show-stack-init () + (cl-loop with context-stack = (plist-get (helm-gtags--get-context-info) :stack) + with stack-length = (length context-stack) + for context in (reverse context-stack) + for file = (plist-get context :file) + for pos = (plist-get context :position) + for index = (1- stack-length) then (1- index) + for line = (helm-gtags--file-content-at-pos file pos) + for cand = (helm-gtags--files-candidate-transformer line) + collect (cons cand (propertize cand 'index index)))) + +(defun helm-gtags--persistent-action (cand) + (let* ((file-and-line (helm-gtags--extract-file-and-line cand)) + (filename (car file-and-line)) + (line (cdr file-and-line)) + (default-directory (helm-gtags--base-directory))) + (when (eq helm-gtags-path-style 'relative) + (setq helm-gtags--last-default-directory default-directory)) + (find-file filename) + (goto-char (point-min)) + (forward-line (1- line)) + (helm-highlight-current-line))) + +(defvar helm-gtags--find-file-action + (helm-make-actions + "Open file" #'helm-gtags--action-openfile + "Open file other window" #'helm-gtags--action-openfile-other-window)) + +(defvar helm-source-gtags-tags + (helm-build-in-buffer-source "Jump to definitions" + :init 'helm-gtags--tags-init + :candidate-number-limit helm-gtags-maximum-candidates + :real-to-display 'helm-gtags--candidate-transformer + :persistent-action 'helm-gtags--persistent-action + :fuzzy-match helm-gtags-fuzzy-match + :action helm-gtags--find-file-action)) + +(defvar helm-source-gtags-pattern + (helm-build-in-buffer-source "Find pattern" + :init 'helm-gtags--pattern-init + :candidate-number-limit helm-gtags-maximum-candidates + :real-to-display 'helm-gtags--candidate-transformer + :persistent-action 'helm-gtags--persistent-action + :fuzzy-match helm-gtags-fuzzy-match + :action helm-gtags--find-file-action)) + +(defvar helm-source-gtags-rtags + (helm-build-in-buffer-source "Jump to references" + :init 'helm-gtags--rtags-init + :candidate-number-limit helm-gtags-maximum-candidates + :real-to-display 'helm-gtags--candidate-transformer + :persistent-action 'helm-gtags--persistent-action + :fuzzy-match helm-gtags-fuzzy-match + :action helm-gtags--find-file-action)) + +(defvar helm-source-gtags-gsyms + (helm-build-in-buffer-source "Jump to symbols" + :init 'helm-gtags--gsyms-init + :candidate-number-limit helm-gtags-maximum-candidates + :real-to-display 'helm-gtags--candidate-transformer + :persistent-action 'helm-gtags--persistent-action + :fuzzy-match helm-gtags-fuzzy-match + :action helm-gtags--find-file-action)) + +(defun helm-gtags--highlight-candidate (candidate) + (let ((regexp (concat "\\_<" helm-gtags--last-input "\\_>")) + (limit (1- (length candidate))) + (last-pos 0) + (case-fold-search nil)) + (while (and (< last-pos limit) + (string-match regexp candidate last-pos)) + (put-text-property (match-beginning 0) (match-end 0) + 'face 'helm-gtags-match + candidate) + (setq last-pos (1+ (match-end 0)))) + candidate)) + +(defun helm-gtags--transformer-regexp (candidate) + (if (and (helm-gtags--windows-p) (helm-gtags--has-drive-letter-p candidate)) + "\\`\\([a-zA-Z]:[^:]+\\):\\([^:]+\\):\\(.*\\)" + "\\`\\([^:]+\\):\\([^:]+\\):\\(.*\\)")) + +(defun helm-gtags--candidate-transformer (candidate) + (if (not helm-gtags-highlight-candidate) + candidate + (let ((regexp (helm-gtags--transformer-regexp candidate))) + (when (string-match regexp candidate) + (format "%s:%s:%s" + (propertize (match-string 1 candidate) 'face 'helm-gtags-file) + (propertize (match-string 2 candidate) 'face 'helm-gtags-lineno) + (helm-gtags--highlight-candidate (match-string 3 candidate))))))) + +(defun helm-gtags--parse-file-candidate-transformer (file) + (let ((removed-file (replace-regexp-in-string "\\`\\S-+ " "" file))) + (when (string-match "\\`\\(\\S-+\\) \\(\\S-+\\) \\(.+\\)\\'" removed-file) + (format "%-25s %-5s %s" + (match-string-no-properties 1 removed-file) + (match-string-no-properties 2 removed-file) + (match-string-no-properties 3 removed-file))))) + +(defvar helm-source-gtags-find-tag-from-here + (helm-build-in-buffer-source "Find tag from here" + :init 'helm-gtags--find-tag-from-here-init + :candidate-number-limit helm-gtags-maximum-candidates + :real-to-display 'helm-gtags--candidate-transformer + :persistent-action 'helm-gtags--persistent-action + :fuzzy-match helm-gtags-fuzzy-match + :action helm-gtags--find-file-action)) + +(defvar helm-source-gtags-parse-file + (helm-build-in-buffer-source "Parse file" + :init 'helm-gtags--parse-file-init + :candidate-number-limit helm-gtags-maximum-candidates + :real-to-display 'helm-gtags--parse-file-candidate-transformer + :fuzzy-match helm-gtags-fuzzy-match + :action 'helm-gtags--parse-file-action)) + +(defun helm-gtags--show-stack-action (cand) + (let* ((index (get-text-property 0 'index cand)) + (context-info (helm-gtags--get-context-info)) + (context-stack (plist-get context-info :stack))) + (helm-gtags--put-context-stack helm-gtags--tag-location + index context-stack) + (helm-gtags--move-to-context (nth index context-stack)))) + +(defvar helm-source-gtags-show-stack + (helm-build-sync-source "Show Context Stack" + :candidates 'helm-gtags--show-stack-init + :volatile t + :candidate-number-limit helm-gtags-maximum-candidates + :persistent-action 'helm-gtags--persistent-action + :fuzzy-match helm-gtags-fuzzy-match + :action 'helm-gtags--show-stack-action)) + +;;;###autoload +(defun helm-gtags-select () + (interactive) + (helm-gtags--common '(helm-source-gtags-select) nil)) + +;;;###autoload +(defun helm-gtags-select-path () + (interactive) + (helm-gtags--common '(helm-source-gtags-select-path) nil)) + +(defsubst helm-gtags--beginning-of-defun () + (cl-case major-mode + ((c-mode c++-mode java-mode) 'c-beginning-of-defun) + (php-mode 'php-beginning-of-defun) + (otherwise #'beginning-of-defun))) + +(defsubst helm-gtags--end-of-defun () + (cl-case major-mode + ((c-mode c++-mode java-mode malabar-mode) 'c-end-of-defun) + (php-mode 'php-end-of-defun) + (otherwise #'end-of-defun))) + +(defun helm-gtags--current-funcion-bound () + (save-excursion + (let (start) + (funcall (helm-gtags--beginning-of-defun)) + (setq start (line-number-at-pos)) + (funcall (helm-gtags--end-of-defun)) + (cons start (line-number-at-pos))))) + +(defun helm-gtags--tags-refered-from-this-function () + (let* ((file (helm-gtags--real-file-name)) + (bound (helm-gtags--current-funcion-bound)) + (start-line (car bound)) + (end-line (cdr bound))) + (with-temp-buffer + (unless (process-file "global" nil t nil "-f" "-r" file) + (error "Failed: global -f -r %s" file)) + (goto-char (point-min)) + (let (tagnames finish) + (while (and (not finish) (not (eobp))) + (let* ((cols (split-string (helm-current-line-contents) nil t)) + (lineno (string-to-number (cl-second cols)))) + (if (and (> lineno start-line) (< lineno end-line)) + (let* ((tag (cl-first cols)) + (elm (cl-find tag tagnames :test 'equal))) + (unless elm + (push tag tagnames))) + (when (>= lineno end-line) + (setq finish t))) + (forward-line 1))) + (reverse tagnames))))) + +(defun helm-gtags--tag-in-function-persistent-action (cand) + (let* ((bound (helm-gtags--current-funcion-bound)) + (limit (save-excursion + (goto-char (point-min)) + (forward-line (cdr bound)) + (goto-char (line-end-position)) + (point)))) + (when (search-forward cand nil limit) + (helm-highlight-current-line)))) + +;;;###autoload +(defun helm-gtags-tags-in-this-function () + "Show tagnames which are referenced in this function and jump to it." + (interactive) + (let ((tags (helm-gtags--tags-refered-from-this-function))) + (unless tags + (error "There are no tags which are refered from this function.")) + (let* ((name (format "Tags in [%s]" (which-function))) + (tag (helm-comp-read + "Tagnames: " tags + :must-match t :name name + :persistent-action 'helm-gtags--tag-in-function-persistent-action))) + (helm-gtags-find-tag tag)))) + +(defun helm-gtags--source-select-tag (candidate) + (helm-build-in-buffer-source "Select Tag" + :init (lambda () (helm-gtags--tags-init candidate)) + :candidate-number-limit helm-gtags-maximum-candidates + :persistent-action 'helm-gtags--persistent-action + :fuzzy-match helm-gtags-fuzzy-match + :action helm-gtags--find-file-action)) + +(defun helm-gtags--source-select-rtag (candidate) + (helm-build-in-buffer-source "Select Rtag" + :init (lambda () (helm-gtags--rtags-init candidate)) + :candidate-number-limit helm-gtags-maximum-candidates + :persistent-action 'helm-gtags--persistent-action + :fuzzy-match helm-gtags-fuzzy-match + :action helm-gtags--find-file-action)) + +(defsubst helm-gtags--action-by-timer (src) + (run-with-timer 0.1 nil (lambda () (helm-gtags--common (list src) nil)))) + +(defun helm-gtags--select-tag-action (c) + (helm-gtags--action-by-timer (helm-gtags--source-select-tag c))) + +(defun helm-gtags--select-rtag-action (c) + (helm-gtags--action-by-timer (helm-gtags--source-select-rtag c))) + +(defun helm-gtags--select-cache-init-common (args tagfile) + (let ((cache (helm-gtags--get-result-cache tagfile))) + (if cache + (insert cache) + (apply #'process-file "global" nil t nil args) + (let* ((cache (buffer-string)) + (cache-size (length cache))) + (when (<= cache-size helm-gtags-cache-max-result-size) + (helm-gtags--put-result-cache tagfile cache)))))) + +(defun helm-gtags--source-select-init () + (with-current-buffer (helm-candidate-buffer 'global) + (if (not helm-gtags-cache-select-result) + (progn + (process-file "global" nil t nil "-c") + (helm-gtags--remove-carrige-returns)) + (helm-gtags--select-cache-init-common '("-c") "GTAGS")))) + +(defvar helm-source-gtags-select + (helm-build-in-buffer-source "Find tag from here" + :init 'helm-gtags--source-select-init + :candidate-number-limit helm-gtags-maximum-candidates + :persistent-action #'ignore + :fuzzy-match helm-gtags-fuzzy-match + :action (helm-make-actions + "Goto the location" #'helm-gtags--select-tag-action + "Goto the location(other buffer)" + (lambda (c) + (setq helm-gtags--use-otherwin t) + (helm-gtags--select-tag-action c)) + "Move to the referenced point" #'helm-gtags--select-rtag-action))) + +(defun helm-gtags--select-path-init () + (helm-gtags--find-tag-directory) + (with-current-buffer (helm-candidate-buffer 'global) + (let ((options (if (eq helm-gtags-path-style 'relative) "-Po" "-Poa"))) + (if (not helm-gtags-cache-select-result) + (progn + (process-file "global" nil t nil options) + (helm-gtags--remove-carrige-returns)) + (helm-gtags--select-cache-init-common (list options) "GPATH"))))) + +(defun helm-gtags--file-name (name) + (let ((remote (file-remote-p default-directory))) + (if (not remote) + name + (cl-case helm-gtags-path-style + (relative name) + (otherwise (concat remote name)))))) + +(defun helm-gtags--find-file-common (open-fn cand) + (let ((default-directory (helm-gtags--base-directory))) + (funcall open-fn (helm-gtags--file-name cand)))) + +(defun helm-gtags--find-file (cand) + (helm-gtags--find-file-common #'find-file cand)) + +(defun helm-gtags--find-file-other-window (cand) + (helm-gtags--find-file-common #'find-file-other-window cand)) + +(defvar helm-gtags--file-util-action + (helm-make-actions + "Open file" #'helm-gtags--find-file + "Open file other window" #'helm-gtags--find-file-other-window)) + +(defun helm-gtags--file-persistent-action (cand) + (let ((default-directory (with-helm-current-buffer + default-directory))) + (helm-ff-kill-or-find-buffer-fname (helm-gtags--file-name cand)))) + +(defvar helm-source-gtags-select-path + (helm-build-in-buffer-source "Select path" + :init 'helm-gtags--select-path-init + :candidate-number-limit helm-gtags-maximum-candidates + :real-to-display 'helm-gtags--files-candidate-transformer + :persistent-action #'helm-gtags--file-persistent-action + :fuzzy-match helm-gtags-fuzzy-match + :action helm-gtags--file-util-action)) + +(defun helm-gtags--searched-directory () + (cl-case (prefix-numeric-value current-prefix-arg) + (4 (let ((dir (read-directory-name "Input Directory: "))) + (setq helm-gtags--local-directory (file-name-as-directory dir)))) + (16 (file-name-directory (buffer-file-name))))) + +(defsubst helm-gtags--using-other-window-p () + (< (prefix-numeric-value current-prefix-arg) 0)) + +(defun helm-gtags--make-gtags-sentinel (action) + (lambda (process _event) + (when (eq (process-status process) 'exit) + (if (zerop (process-exit-status process)) + (message "Success: %s TAGS" action) + (message "Failed: %s TAGS(%d)" action (process-exit-status process)))))) + +(defsubst helm-gtags--read-gtagslabel () + (let ((labels '("default" "native" "ctags" "pygments"))) + (completing-read "GTAGSLABEL(Default: default): " labels nil t nil nil "default"))) + +(defsubst helm-gtags--label-option (label) + (concat "--gtagslabel=" label)) + +;;;###autoload +(defun helm-gtags-create-tags (dir label) + (interactive + (list (read-directory-name "Root Directory: ") + (helm-gtags--read-gtagslabel))) + (let ((default-directory dir) + (proc-buf (get-buffer-create " *helm-gtags-create*"))) + (let ((proc (start-file-process "helm-gtags-create" proc-buf + "gtags" "-q" (helm-gtags--label-option label)))) + (set-process-sentinel proc (helm-gtags--make-gtags-sentinel 'create))))) + +(defun helm-gtags--find-tag-simple () + (or (getenv "GTAGSROOT") + (locate-dominating-file default-directory "GTAGS") + (if (not (yes-or-no-p "File GTAGS not found. Run 'gtags'? ")) + (user-error "Abort") + (let* ((tagroot (read-directory-name "Root Directory: ")) + (label (helm-gtags--read-gtagslabel)) + (default-directory tagroot)) + (message "gtags is generating tags....") + (unless (zerop (process-file "gtags" nil nil nil + "-q" (helm-gtags--label-option label))) + (error "Faild: 'gtags -q'")) + tagroot)))) + +(defun helm-gtags--current-file-and-line () + (let* ((buffile (buffer-file-name)) + (path (cl-case helm-gtags-path-style + (absolute buffile) + (root + (file-relative-name buffile (helm-gtags--find-tag-directory))) + (relative + (file-relative-name buffile (helm-gtags--base-directory)))))) + (format "%s:%d" path (line-number-at-pos)))) + +(defsubst helm-gtags--clear-variables () + (setq helm-gtags--last-default-directory nil)) + +(defun helm-gtags--common (srcs tagname) + (helm-gtags--clear-variables) + (let ((helm-quit-if-no-candidate t) + (helm-execute-action-at-once-if-one t) + (dir (helm-gtags--searched-directory)) + (src (car srcs)) + (preselect-regexp (when helm-gtags-preselect + (regexp-quote (helm-gtags--current-file-and-line))))) + (when (symbolp src) + (setq src (symbol-value src))) + (unless helm-gtags--use-otherwin + (setq helm-gtags--use-otherwin (helm-gtags--using-other-window-p))) + (when tagname + (setq helm-gtags--query tagname)) + (let ((tagroot (helm-gtags--find-tag-simple))) + (helm-attrset 'helm-gtags-base-directory dir src) + (when tagname + (helm-attrset 'name (format "%s in %s" tagname (or dir tagroot)) src)) + (helm :sources srcs :buffer helm-gtags--buffer + :preselect preselect-regexp)))) + +;;;###autoload +(defun helm-gtags-find-tag (tag) + "Jump to definition" + (interactive + (list (helm-gtags--read-tagname 'tag))) + (helm-gtags--common '(helm-source-gtags-tags) tag)) + +;;;###autoload +(defun helm-gtags-find-tag-other-window (tag) + "Jump to definition in other window." + (interactive + (list (helm-gtags--read-tagname 'tag))) + (setq helm-gtags--use-otherwin t) + (helm-gtags-find-tag tag)) + +;;;###autoload +(defun helm-gtags-find-rtag (tag) + "Jump to referenced point" + (interactive + (list (helm-gtags--read-tagname 'rtag (which-function)))) + (helm-gtags--common '(helm-source-gtags-rtags) tag)) + +;;;###autoload +(defun helm-gtags-find-symbol (tag) + "Jump to the symbol location" + (interactive + (list (helm-gtags--read-tagname 'symbol))) + (helm-gtags--common '(helm-source-gtags-gsyms) tag)) + +;;;###autoload +(defun helm-gtags-find-pattern (pattern) + "Grep and jump by gtags tag files." + (interactive + (list (helm-gtags--read-tagname 'pattern))) + (helm-gtags--common '(helm-source-gtags-pattern) pattern)) + +(defun helm-gtags--find-file-after-hook () + (helm-gtags--push-context helm-gtags--saved-context)) + +(defvar helm-source-gtags-files + (helm-build-in-buffer-source "Find files" + :init #'helm-gtags--files-init + :candidate-number-limit helm-gtags-maximum-candidates + :real-to-display #'helm-gtags--files-candidate-transformer + :persistent-action #'helm-gtags--file-persistent-action + :fuzzy-match helm-gtags-fuzzy-match + :action helm-gtags--file-util-action)) + +;;;###autoload +(defun helm-gtags-find-files (file) + "Find file from tagged with gnu global." + (interactive + (list (helm-gtags--read-tagname 'find-file))) + (add-hook 'helm-after-action-hook 'helm-gtags--find-file-after-hook) + (unwind-protect + (helm-gtags--common '(helm-source-gtags-files) file) + (remove-hook 'helm-after-action-hook 'helm-gtags--find-file-after-hook))) + +;;;###autoload +(defun helm-gtags-find-tag-from-here () + "Jump point by current point information. +Jump to definition point if cursor is on its reference. +Jump to reference point if curosr is on its definition" + (interactive) + (helm-gtags--common '(helm-source-gtags-find-tag-from-here) nil)) + +;;;###autoload +(defun helm-gtags-dwim () + "Find by context. Here is +- on include statement then jump to included file +- on symbol definition then jump to its references +- on reference point then jump to its definition." + (interactive) + (let ((line (helm-current-line-contents))) + (if (string-match helm-gtags--include-regexp line) + (let ((helm-gtags-use-input-at-cursor t)) + (helm-gtags-find-files (match-string-no-properties 1 line))) + (if (and (buffer-file-name) (thing-at-point 'symbol)) + (helm-gtags-find-tag-from-here) + (call-interactively 'helm-gtags-find-tag))))) + +(defun helm-gtags--set-parsed-file () + (let* ((this-file (file-name-nondirectory (buffer-file-name))) + (file (if current-prefix-arg + (read-file-name "Parsed File: " nil this-file) + this-file))) + (setq helm-gtags--parsed-file (expand-file-name file)))) + +(defun helm-gtags--find-preselect-line () + (let ((defun-bound (bounds-of-thing-at-point 'defun))) + (if (not defun-bound) + (line-number-at-pos) + (let ((defun-begin-line (line-number-at-pos (car defun-bound))) + (filename (helm-gtags--real-file-name))) + (with-temp-buffer + (unless (zerop (process-file "global" nil t nil "-f" filename)) + (error "Failed: global -f")) + (goto-char (point-min)) + (let (start-line) + (while (and (not start-line) + (re-search-forward "^\\S-+\\s-+\\([1-9][0-9]*\\)" nil t)) + (let ((line (string-to-number (match-string-no-properties 1)))) + (when (>= line defun-begin-line) + (setq start-line line)))) + (or start-line (line-number-at-pos)))))))) + +;;;###autoload +(defun helm-gtags-parse-file () + "Parse current file with gnu global. This is similar to `imenu'. +You can jump definitions of functions, symbols in this file." + (interactive) + (helm-gtags--find-tag-directory) + (helm-gtags--save-current-context) + (setq helm-gtags--use-otherwin (helm-gtags--using-other-window-p)) + (helm-gtags--set-parsed-file) + (helm-attrset 'name + (format "Parsed File: %s" + (file-relative-name helm-gtags--parsed-file + helm-gtags--tag-location)) + helm-source-gtags-parse-file) + (let ((presel (when helm-gtags-preselect + (format "^\\S-+\\s-+%d\\s-+" (helm-gtags--find-preselect-line))))) + (helm :sources '(helm-source-gtags-parse-file) + :buffer helm-gtags--buffer :preselect presel))) + +;;;###autoload +(defun helm-gtags-pop-stack () + "Jump to previous point on the context stack and pop it from stack." + (interactive) + (let* ((context-info (helm-gtags--get-context-info)) + (context-stack (plist-get context-info :stack)) + (context (pop context-stack))) + (helm-gtags--put-context-stack helm-gtags--tag-location -1 context-stack) + (helm-gtags--move-to-context context))) + +;;;###autoload +(defun helm-gtags-show-stack () + "Show current context stack." + (interactive) + (helm-other-buffer 'helm-source-gtags-show-stack + (get-buffer-create helm-gtags--buffer))) + +;;;###autoload +(defun helm-gtags-clear-stack () + "Clear current context stack." + (interactive) + (let ((tag-location (helm-gtags--find-tag-directory))) + (message "Clear '%s' context stack." tag-location) + (remhash tag-location helm-gtags--context-stack))) + +;;;###autoload +(defun helm-gtags-clear-all-stacks () + "Clear all context stacks." + (interactive) + (message "Clear all context statks.") + (setq helm-gtags--context-stack (make-hash-table :test 'equal))) + +(defun helm-gtags--read-tag-directory () + (let ((dir (read-directory-name "Directory tag generated: " nil nil t))) + ;; On Windows, "gtags d:/tmp" work, but "gtags d:/tmp/" doesn't + (directory-file-name (expand-file-name dir)))) + +(defsubst helm-gtags--how-to-update-tags () + (cl-case (prefix-numeric-value current-prefix-arg) + (4 'entire-update) + (16 'generate-other-directory) + (otherwise 'single-update))) + +(defun helm-gtags--update-tags-command (how-to) + (cl-case how-to + (entire-update '("global" "-u")) + (generate-other-directory (list "gtags" (helm-gtags--read-tag-directory))) + (single-update (list "global" "--single-update" (helm-gtags--real-file-name))))) + +(defun helm-gtags--update-tags-p (how-to interactive-p current-time) + (or interactive-p + (and (eq how-to 'single-update) + (buffer-file-name) + (or (not helm-gtags-update-interval-second) + (>= (- current-time helm-gtags--last-update-time) + helm-gtags-update-interval-second))))) + +;;;###autoload +(defun helm-gtags-update-tags () + "Update TAG file. Update All files with `C-u' prefix. +Generate new TAG file in selected directory with `C-u C-u'" + (interactive) + (let ((how-to (helm-gtags--how-to-update-tags)) + (interactive-p (called-interactively-p 'interactive)) + (current-time (float-time (current-time)))) + (when (helm-gtags--update-tags-p how-to interactive-p current-time) + (let* ((cmds (helm-gtags--update-tags-command how-to)) + (proc (apply #'start-file-process "helm-gtags-update-tag" nil cmds))) + (if (not proc) + (message "Failed: %s" (mapconcat 'identity cmds " ")) + (set-process-sentinel proc (helm-gtags--make-gtags-sentinel 'update)) + (setq helm-gtags--last-update-time current-time)))))) + +;;;###autoload +(defun helm-gtags-resume () + "Resurrect previously invoked `helm-gtags` command." + (interactive) + (unless (get-buffer helm-gtags--buffer) + (error "Error: helm-gtags buffer is not existed.")) + (helm-resume helm-gtags--buffer)) + +(defsubst helm-gtags--check-browser-installed (browser) + (let ((used-browser (or browser "mozilla"))) + (unless (executable-find used-browser) + (error "Not found browser '%s'" used-browser)))) + +(defun helm-gtags-display-browser () + "Display current screen on hypertext browser. +`browse-url-generic-program' is used as browser if its value is non-nil. +`mozilla' is used in other case." + (interactive) + (let ((file (buffer-file-name))) + (if (not file) + (error "This buffer is not related to file.") + (let* ((lineopt (concat "+" (number-to-string (line-number-at-pos)))) + (browser (symbol-value 'browse-url-generic-program)) + (args (list lineopt file))) + (helm-gtags--check-browser-installed browser) + (when browser + (setq args (append (list "-b" browser) args))) + ;; `gozilla' commend never returns error status if command is failed. + (apply #'process-file "gozilla" nil nil nil args))))) + +(defvar helm-gtags-mode-name " HelmGtags") +(defvar helm-gtags-mode-map (make-sparse-keymap)) + +;;;###autoload +(define-minor-mode helm-gtags-mode () + "Enable helm-gtags" + :init-value nil + :global nil + :keymap helm-gtags-mode-map + :lighter helm-gtags-mode-name + (if helm-gtags-mode + (when helm-gtags-auto-update + (add-hook 'after-save-hook 'helm-gtags-update-tags nil t)) + (when helm-gtags-auto-update + (remove-hook 'after-save-hook 'helm-gtags-update-tags t)))) + +;; Key mapping of gtags-mode. +(when helm-gtags-suggested-key-mapping + ;; Current key mapping. + (let ((command-table '(("h" . helm-gtags-display-browser) + ("P" . helm-gtags-find-files) + ("f" . helm-gtags-parse-file) + ("g" . helm-gtags-find-pattern) + ("s" . helm-gtags-find-symbol) + ("r" . helm-gtags-find-rtag) + ("t" . helm-gtags-find-tag) + ("d" . helm-gtags-find-tag))) + (key-func (if (string-prefix-p "\\" helm-gtags-prefix-key) + #'concat + (lambda (prefix key) (kbd (concat prefix " " key)))))) + (cl-loop for (key . command) in command-table + do + (define-key helm-gtags-mode-map (funcall key-func helm-gtags-prefix-key key) command)) + + ;; common + (define-key helm-gtags-mode-map "\C-]" 'helm-gtags-find-tag-from-here) + (define-key helm-gtags-mode-map "\C-t" 'helm-gtags-pop-stack) + (define-key helm-gtags-mode-map "\e*" 'helm-gtags-pop-stack) + (define-key helm-gtags-mode-map "\e." 'helm-gtags-find-tag) + (define-key helm-gtags-mode-map "\C-x4." 'helm-gtags-find-tag-other-window))) + +(provide 'helm-gtags) + +;; Local Variables: +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-gtags.el ends here diff --git a/elpa/jinja2-mode-0.1/jinja2-mode-pkg.el b/elpa/jinja2-mode-0.1/jinja2-mode-pkg.el deleted file mode 100644 index e0ee105..0000000 --- a/elpa/jinja2-mode-0.1/jinja2-mode-pkg.el +++ /dev/null @@ -1 +0,0 @@ -(define-package "jinja2-mode" "0.1" "A major mode for jinja2" 'nil) diff --git a/elpa/jinja2-mode-0.1/jinja2-mode-autoloads.el b/elpa/jinja2-mode-20141128.207/jinja2-mode-autoloads.el similarity index 84% rename from elpa/jinja2-mode-0.1/jinja2-mode-autoloads.el rename to elpa/jinja2-mode-20141128.207/jinja2-mode-autoloads.el index 21908d5..a0cbb91 100644 --- a/elpa/jinja2-mode-0.1/jinja2-mode-autoloads.el +++ b/elpa/jinja2-mode-20141128.207/jinja2-mode-autoloads.el @@ -3,8 +3,8 @@ ;;; Code: (add-to-list 'load-path (or (file-name-directory #$) (car load-path))) -;;;### (autoloads nil "jinja2-mode" "jinja2-mode.el" (21705 22864 -;;;;;; 361785 859000)) +;;;### (autoloads nil "jinja2-mode" "jinja2-mode.el" (22297 19822 +;;;;;; 398989 683000)) ;;; Generated autoloads from jinja2-mode.el (autoload 'jinja2-mode "jinja2-mode" "\ diff --git a/elpa/jinja2-mode-20141128.207/jinja2-mode-pkg.el b/elpa/jinja2-mode-20141128.207/jinja2-mode-pkg.el new file mode 100644 index 0000000..dca35fb --- /dev/null +++ b/elpa/jinja2-mode-20141128.207/jinja2-mode-pkg.el @@ -0,0 +1 @@ +(define-package "jinja2-mode" "20141128.207" "A major mode for jinja2" 'nil) diff --git a/elpa/jinja2-mode-0.1/jinja2-mode.el b/elpa/jinja2-mode-20141128.207/jinja2-mode.el similarity index 99% rename from elpa/jinja2-mode-0.1/jinja2-mode.el rename to elpa/jinja2-mode-20141128.207/jinja2-mode.el index b191b26..3488d9b 100644 --- a/elpa/jinja2-mode-0.1/jinja2-mode.el +++ b/elpa/jinja2-mode-20141128.207/jinja2-mode.el @@ -3,7 +3,8 @@ ;; Copyright (C) 2011 Florian Mounier aka paradoxxxzero ;; Author: Florian Mounier aka paradoxxxzero -;; Version: 0.1 +;; Version: 0.2 +;; Package-Version: 20141128.207 ;; 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 @@ -293,7 +294,7 @@ ;;;###autoload -(define-derived-mode jinja2-mode sgml-mode "Jinja2" +(define-derived-mode jinja2-mode html-mode "Jinja2" "Major mode for editing jinja2 files" :group 'jinja2 ;; Disabling this because of this emacs bug: diff --git a/elpa/js2-mode-20150909/.dir-locals.el b/elpa/js2-mode-20150909/.dir-locals.el deleted file mode 100644 index db35973..0000000 --- a/elpa/js2-mode-20150909/.dir-locals.el +++ /dev/null @@ -1 +0,0 @@ -((nil . ((sentence-end-double-space . t)))) diff --git a/elpa/js2-mode-20150909/.elpaignore b/elpa/js2-mode-20150909/.elpaignore deleted file mode 100644 index b51163d..0000000 --- a/elpa/js2-mode-20150909/.elpaignore +++ /dev/null @@ -1,4 +0,0 @@ -.travis.yml -.gitignore -Makefile -tests diff --git a/elpa/js2-mode-20150909/ChangeLog b/elpa/js2-mode-20150909/ChangeLog deleted file mode 100644 index 092c25e..0000000 --- a/elpa/js2-mode-20150909/ChangeLog +++ /dev/null @@ -1,164 +0,0 @@ -2015-09-09 Dmitry Gutov - - Undo some breakage - -2015-09-09 Dmitry Gutov - - Merge commit '5c9d8b82dddec2fab370ec8798569c7fc5698093' from js2-mode - -2015-07-18 Dmitry Gutov - - Merge commit '494c421bfa6f1b72b577267cb3841b0eff262250' from js2-mode - -2015-07-13 Dmitry Gutov - - Merge commit 'f3a899bb1c36e25e078eed2890eb2fecb22f4175' from js2-mode - -2015-04-24 Dmitry Gutov - - Merge commit 'ac93b9eef9b6ac44d187b9688d68a7a5f205b3fe' from js2-mode - - Conflicts: - packages/js2-mode/js2-mode.el - -2015-04-15 Stefan Monnier - - * js2-mode.el (js2-mode): Use cursor-sensor-mode if available. - - (js2-export-node): Fix apparent paren typo. - (js2-get-token-internal-1): Remove unused var `quote-char'. - (js2-clear-face): Also remove cursor-sensor-functions. - (js2-parse-primary-expr): Remove unused var `pn'. - (js2-parse-legacy-array-comp): Remove unused var `first'. - (js2-mode-show-node, js2-mode-show-warn-or-err): Use - cursor-sensor-functions if available. - (js2-mode-hide-overlay, js2-echo-error): Adapt to new calling - convention. - (js2-echo-help): Declare obsolete. - (js2-mode-extend-comment): Look for the appropriate property. - -2015-02-02 Dmitry Gutov - - Merge commit '7558a961a03b3a9d26fafc69d9665e4aadf47738' from js2-mode - -2014-11-18 Dmitry Gutov - - Merge commit '3abcd90ddc2f446ddf0fb874dd79ba870c26ad2d' from js2-mode - -2014-11-15 Dmitry Gutov - - Merge commit '2c744815cf9e4653625dd25f2e7f8b59c152782d' from js2-mode - - Conflicts: - packages/js2-mode/js2-imenu-extras.el - -2014-10-15 Stefan Monnier - - * packages/js2-mode/js2-imenu-extras.el: Use Unix-style EOL. - -2014-01-14 Dmitry Gutov - - Merge commit '3575aaa39f311822dcedd53235ba036e9cf68ab8' from js2-mode - -2013-11-07 Stefan Monnier - - * js2-mode/tests: Add copyright headers. - -2013-11-06 Dmitry Gutov - - Merge remote-tracking branch 'js2-mode/master' - -2013-10-06 Dmitry Gutov - - Add packages/js2-mode/.elpaignore - -2013-08-21 Stefan Monnier - - Sync from js2-mode/master - -2013-08-20 Stefan Monnier - - * packages/js2-mode/js2-mode.el: Remove unused variables. Use posix - character classes. Do a bit of CSE simplification. - (js2-parse-highlight-member-expr-node): Flip test order to simplify - code. - (js2-re-search-forward, js2-re-search-backward): Don't quote code. - (js2-echo-help): Defalias applies to symbol, not functions. - -2013-08-15 Stefan Monnier - - Fix up copyrights and the checking code - -2013-08-15 Stefan Monnier - - Mark merge point of js2-mode. - -2013-06-19 Dmitry Gutov - - js2-mode: Merge from upstream - - Git commit 714dca50644c75884d9d90f10328c7a12e02cdcc - -2013-06-08 Dmitry Gutov - - js2-mode: Merge from upstream - - Git commit 1c53de75e0acd19d61ad45a91b32c183948e5128 - -2013-05-10 Dmitry Gutov - - js2-mode: Fix a typo - - Git commit c50f3d1d9db63bcbea3f02036ee17ab0d7511be0 - -2013-05-10 Dmitry Gutov - - js2-mode: Merge from upstream - - * js2-imenu-extras: New file. - - Git commit 3c69aea0c267e7bbadd5e35eb6cab54764c9d91c - -2013-03-07 Dmitry Gutov - - js2-mode: Merge from upstream (js2-multiline-decl-indentation) - -2013-02-28 Dmitry Gutov - - js2-mode: Merge from upstream - -2013-02-19 Dmitry Gutov - - js2-mode: Use \\' instead of $ - -2013-02-19 Dmitry Gutov - - Merge from upstream - -2013-02-17 Dmitry Gutov - - Merge from upstream - -2012-12-26 Dmitry Gutov - - * js2-mode: same for Returns -> Return - -2012-12-26 Dmitry Gutov - - Re-apply the Toggles -> Toggle wording change - -2012-12-25 Dmitry Gutov - - * js2-mode: merge from upstream - - Lots of small changes, too many to enumerate. - -2012-10-31 Stefan Monnier - - * admin/update-archive.sh: Keep old packages. - -2011-07-01 Chong Yidong - - Give every package its own directory in packages/ including single-file - packages. - diff --git a/elpa/js2-mode-20150909/LICENSE b/elpa/js2-mode-20150909/LICENSE deleted file mode 100644 index 94a9ed0..0000000 --- a/elpa/js2-mode-20150909/LICENSE +++ /dev/null @@ -1,674 +0,0 @@ - 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/elpa/js2-mode-20150909/NEWS.md b/elpa/js2-mode-20150909/NEWS.md deleted file mode 100644 index 2984e91..0000000 --- a/elpa/js2-mode-20150909/NEWS.md +++ /dev/null @@ -1,219 +0,0 @@ -# History of user-visible changes - -## 20150909 - -* `js2-mode` now derives from `js-mode`. That means the former - function will run `js-mode-hook`, as well as `js2-mode-hook`. The - key bindings will default to `js-mode-map` where they're not set in - `js2-mode-map`. And in Emacs 25 or later (including the snapshot - builds), `js2-mode` uses the indentation code from `js-mode`. Where - feasible, the user options (and functions) now have aliases, but if - you're using Emacs 25 and you see an indentation-related setting - that stopped working, try looking for a corresponding one in the - `js` group: `M-x customize-group RET js RET`. - -* New command: `js2-jump-to-definition`. It's bound to `M-.` by - default, via remapping `js-find-symbol`. To get back to the default - `M-.` binding (e.g. `find-tag`), put this in your init file: - - (eval-after-load 'js (define-key js-mode-map (kbd "M-.") nil)) - -## 20150713 - -* More comprehensive strict mode warnings and syntax errors. -* New minor mode: `js2-highlight-unused-variables-mode`. -* `js2-pretty-multiline-declarations` can take the value `dynamic` now. - -## 20150202 - -Support for: - -* [ES6 modules](http://www.2ality.com/2014/09/es6-modules-final.html). -* [Short-hand object literals](http://ariya.ofilabs.com/2013/02/es6-and-object-literal-property-value-shorthand.html). -* [Method definitions](http://ariya.ofilabs.com/2013/03/es6-and-method-definitions.html). -* ['u' and 'y' RegExp flags](https://mathiasbynens.be/notes/es6-unicode-regex). -* [Computed property names](http://people.mozilla.org/~jorendorff/es6-draft.html#sec-object-initializer). -* [Class statements and expressions](https://github.com/lukehoban/es6features#classes). -* [Template strings](http://tc39wiki.calculist.org/es6/template-strings/), including tagged ones. - -The variable `js2-allow-keywords-as-property-names` has been -removed. Instead we check if `js2-language-version` is 180 or highter. - -## 20141115 - -Support for: - -* Unicode characters in identifiers (improved). -* [Delegating yield](http://wiki.ecmascript.org/doku.php?id=harmony:generators#delegating_yield). -* [ES6 numeric literals](https://people.mozilla.org/~jorendorff/es6-draft.html#sec-literals-numeric-literals) (octal, binary). -* Harmony [array and generator comprehensions](http://wingolog.org/archives/2014/03/07/es6-generator-and-array-comprehensions-in-spidermonkey). - -## 20131106 - -Support for: - -* [Arrow functions](http://wiki.ecmascript.org/doku.php?id=harmony:arrow_function_syntax) -* [Generators](http://wiki.ecmascript.org/doku.php?id=harmony:generators) -* [Spread operator](http://wiki.ecmascript.org/doku.php?id=harmony:spread) - -## 20130510 - -### Support for JSLint global declaration - -See the docstring for `js2-include-jslint-globals`. - -## 20130216 - -### We don't rebind `RET` anymore - -Because well-behaving major modes aren't supposed to do that. - -So pressing it won't continue a block comment, or turn a string into a concatenation. -Pressing `M-j`, however, will. - -The options `js2-indent-on-enter-key` and `js2-enter-indents-newline` were also removed. - -To bring back the previous behavior, put this in your init file: - -```js -(eval-after-load 'js2-mode - '(define-key js2-mode-map (kbd "RET") 'js2-line-break)) -``` - -## 20120617 - -### Support for [default](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/default_parameters) and [rest](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/rest_parameters) parameters - -## 20120614 - -### Support for [for..of loops](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Statements/for...of) - -## Older changes - -### Popular indentation style - -```js -[foo, bar, baz].forEach(function (v) { - if (validate(v)) - process(v); -}); - -[a, b, c].some(function (v) { - return validate(v); -}); -``` - -### Pretty multiline variable declaration - -In the original mode, - -```js -var foo = 10, -bar = 20, -baz = 30; -``` - -In this mode when the value of `js2-pretty-multiline-declarations` is non-nil, - -```js -var foo = 10, - bar = 20, - baz = 30; -``` - -### Abbreviated destructuring assignments - -```js -let {a, b} = {a: 10, b: 20}; // Abbreviated (Not supported in the original mode) -let {a: a, b: b} = {a: 10, b: 20}; // Same as above (Supported in the original mode) - -(function ({responseText}) { /* */ })(xhr); // As the argument of function - -for (let [k, { name, age }] in Iterator(obj)) // nested - print(k, name, age); -``` - -### Expression closure in property value - -```js -let worker = { - get age() 20, - get sex() "male", - fire: function () _fire() -}; -``` - -### Fix for odd indentation of "else if" with no braces - -In the original mode, - -```js -if (foo) - return foo; -else if (bar) -return bar; // here -``` - -In this mode, - -```js -if (foo) - return foo; -else if (bar) - return bar; // fixed -``` - -### Imenu support for function nesting - -Supports function nesting and anonymous wrappers: - -```js -(function() { - var foo = function() { - function bar() { // shown as foo.bar. - function baz() {} // foo.bar.baz - var qux = function() {}; // foo.bar.quux - } - }; -}); -``` - -Examples of output: - -* [jQuery 1.5](https://gist.github.com/845449) -* [Underscore.js](https://gist.github.com/824262) -* [Backbone.js](https://gist.github.com/824260) - -For library-specific extension methods like `$.extend` and `dojo.declare`, see [js2-imenu-extras](/mooz/js2-mode/blob/master/js2-imenu-extras.el). - -### Undeclared/external variables highlighting - -Original mode highlights them only on the left side of assignments: - -```js -var house; -hose = new House(); // highlights "hose" -``` - -Here they are highlighted in all expressions: - -```js -function feed(fishes, food) { - for each (var fish in fshes) { // highlights "fshes" - food.feed(fsh); // highlights "fsh" - } - hood.discard(); // highlights "hood" -} -``` - -Destructuring assignments and array comprehensions (JS 1.7) are supported: - -```js -let three, [one, two] = [1, 2]; -thee = one + two; // highlights "thee" - -function revenue(goods) { - // highlights "coast" - return [price - coast for each ({price, cost} in goods)].reduce(add); -} -``` diff --git a/elpa/js2-mode-20150909/README.md b/elpa/js2-mode-20150909/README.md deleted file mode 100644 index b0ee444..0000000 --- a/elpa/js2-mode-20150909/README.md +++ /dev/null @@ -1,55 +0,0 @@ -About [![Build Status](https://travis-ci.org/mooz/js2-mode.png?branch=master)](https://travis-ci.org/mooz/js2-mode) -====== - -Improved JavaScript editing mode for GNU Emacs ([description here](http://elpa.gnu.org/packages/js2-mode.html)). - -For some of the latest changes, see [latest user-visible changes](https://github.com/mooz/js2-mode/wiki/Latest-user-visible-changes). - -Installation -====== - -The stable versions are hosted at [GNU ELPA](http://elpa.gnu.org/) -(M-x list-packages). - -You can also install the latest development version from -[Melpa](http://melpa.milkbox.net/#installing). - -Emacs 22 and 23 -=============== - -This version requires Emacs 24 and `cl-lib` (either built-in or from GNU ELPA above). -For a backward compatible version, check out the branch -[emacs23](https://github.com/mooz/js2-mode/tree/emacs23). - -Bugs -==== - -* See broken syntax highlighting and timer errors? Recently upgraded -Emacs from version 24.2 or earlier? - -* Try -[reinstalling or byte-recompiling](https://github.com/mooz/js2-mode/issues/72) -the package. - -Please report problems at . - -Contributing -====== - -`js2-mode` is subject to the same -[copyright assignment](http://www.gnu.org/prep/maintain/html_node/Copyright-Papers.html) -policy as Emacs itself, `org-mode`, `CEDET` and other packages in -[GNU ELPA](http://elpa.gnu.org/packages/). - -Any -[legally significant](http://www.gnu.org/prep/maintain/html_node/Legally-Significant.html#Legally-Significant) -contributions can only be accepted after the author has completed their -paperwork. Please ask for the request form, and we'll send it to you. - -See Also -====== - -Some third-party modes that use the generated syntax tree: - -* [js2-refactor](https://github.com/magnars/js2-refactor.el) -* [skewer-mode](https://github.com/skeeto/skewer-mode) diff --git a/elpa/js2-mode-20150909/js2-mode-pkg.el b/elpa/js2-mode-20150909/js2-mode-pkg.el deleted file mode 100644 index 911c5a7..0000000 --- a/elpa/js2-mode-20150909/js2-mode-pkg.el +++ /dev/null @@ -1,2 +0,0 @@ -;; Generated package description from js2-mode.el -(define-package "js2-mode" "20150909" "Improved JavaScript editing mode" '((emacs "24.1") (cl-lib "0.5")) :url "https://github.com/mooz/js2-mode/" :keywords '("languages" "javascript")) diff --git a/elpa/js2-mode-20150909/js2-imenu-extras.el b/elpa/js2-mode-20160409.1113/js2-imenu-extras.el similarity index 100% rename from elpa/js2-mode-20150909/js2-imenu-extras.el rename to elpa/js2-mode-20160409.1113/js2-imenu-extras.el diff --git a/elpa/js2-mode-20150909/js2-mode-autoloads.el b/elpa/js2-mode-20160409.1113/js2-mode-autoloads.el similarity index 64% rename from elpa/js2-mode-20150909/js2-mode-autoloads.el rename to elpa/js2-mode-20160409.1113/js2-mode-autoloads.el index c7d0ad6..e53ef56 100644 --- a/elpa/js2-mode-20150909/js2-mode-autoloads.el +++ b/elpa/js2-mode-20160409.1113/js2-mode-autoloads.el @@ -1,11 +1,10 @@ ;;; js2-mode-autoloads.el --- automatically extracted autoloads ;; ;;; Code: - +(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) -;;;### (autoloads (js2-imenu-extras-mode js2-imenu-extras-setup) -;;;;;; "js2-imenu-extras" "js2-imenu-extras.el" (22025 15144 706742 -;;;;;; 181000)) +;;;### (autoloads nil "js2-imenu-extras" "js2-imenu-extras.el" (22297 +;;;;;; 19274 703515 321000)) ;;; Generated autoloads from js2-imenu-extras.el (autoload 'js2-imenu-extras-setup "js2-imenu-extras" "\ @@ -20,8 +19,8 @@ Toggle Imenu support for frameworks and structural patterns. ;;;*** -;;;### (autoloads (js2-mode js2-minor-mode js2-highlight-unused-variables-mode) -;;;;;; "js2-mode" "js2-mode.el" (22025 15144 690742 118000)) +;;;### (autoloads nil "js2-mode" "js2-mode.el" (22297 19275 33509 +;;;;;; 465000)) ;;; Generated autoloads from js2-mode.el (autoload 'js2-highlight-unused-variables-mode "js2-mode" "\ @@ -42,18 +41,28 @@ Major mode for editing JavaScript code. \(fn)" t nil) -;;;*** - -;;;### (autoloads nil nil ("js2-mode-pkg.el" "js2-old-indent.el") -;;;;;; (22025 15144 743740 836000)) +(autoload 'js2-jsx-mode "js2-mode" "\ +Major mode for editing JSX code. + +To customize the indentation for this mode, set the SGML offset +variables (`sgml-basic-offset' et al) locally, like so: + + (defun set-jsx-indentation () + (setq-local sgml-basic-offset js2-basic-offset)) + (add-hook 'js2-jsx-mode-hook #'set-jsx-indentation) + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil nil ("js2-mode-pkg.el" "js2-old-indent.el") +;;;;;; (22297 19275 125905 653000)) ;;;*** -(provide 'js2-mode-autoloads) ;; Local Variables: ;; version-control: never ;; no-byte-compile: t ;; no-update-autoloads: t -;; coding: utf-8 ;; End: ;;; js2-mode-autoloads.el ends here diff --git a/elpa/js2-mode-20160409.1113/js2-mode-pkg.el b/elpa/js2-mode-20160409.1113/js2-mode-pkg.el new file mode 100644 index 0000000..5175b07 --- /dev/null +++ b/elpa/js2-mode-20160409.1113/js2-mode-pkg.el @@ -0,0 +1,8 @@ +(define-package "js2-mode" "20160409.1113" "Improved JavaScript editing mode" + '((emacs "24.1") + (cl-lib "0.5")) + :url "https://github.com/mooz/js2-mode/" :keywords + '("languages" "javascript")) +;; Local Variables: +;; no-byte-compile: t +;; End: diff --git a/elpa/js2-mode-20150909/js2-mode.el b/elpa/js2-mode-20160409.1113/js2-mode.el similarity index 96% rename from elpa/js2-mode-20150909/js2-mode.el rename to elpa/js2-mode-20160409.1113/js2-mode.el index 926003d..292af25 100644 --- a/elpa/js2-mode-20150909/js2-mode.el +++ b/elpa/js2-mode-20160409.1113/js2-mode.el @@ -60,6 +60,12 @@ ;; (add-to-list 'interpreter-mode-alist '("node" . js2-mode)) +;; Support for JSX is available via the derived mode `js2-jsx-mode'. If you +;; also want JSX support, use that mode instead: + +;; (add-to-list 'auto-mode-alist '("\\.jsx?\\'" . js2-jsx-mode)) +;; (add-to-list 'interpreter-mode-alist '("node" . js2-jsx-mode)) + ;; To customize how it works: ;; M-x customize-group RET js2-mode RET @@ -95,6 +101,7 @@ (require 'js2-old-indent) (defvaralias 'js2-basic-offset 'js-indent-level nil) (defalias 'js2-proper-indentation 'js--proper-indentation) + (defalias 'js2-jsx-indent-line 'js-jsx-indent-line) (defalias 'js2-indent-line 'js-indent-line) (defalias 'js2-re-search-forward 'js--re-search-forward))) @@ -192,7 +199,7 @@ Set `js2-include-rhino-externs' to t to include them.") (mapcar 'symbol-name '(__dirname __filename Buffer clearInterval clearTimeout require console exports global module process setInterval setTimeout - querystring)) + querystring setImmediate clearImmediate)) "Node.js externs. Set `js2-include-node-externs' to t to include them.") @@ -610,7 +617,9 @@ which doesn't seem particularly useful, but Rhino permits it." (defvar js2-NO_SUBS_TEMPLATE 167) ; template literal without substitutions (defvar js2-TAGGED_TEMPLATE 168) ; tagged template literal -(defconst js2-num-tokens (1+ js2-TAGGED_TEMPLATE)) +(defvar js2-AWAIT 169) ; await (pseudo keyword) + +(defconst js2-num-tokens (1+ js2-AWAIT)) (defconst js2-debug-print-trees nil) @@ -668,6 +677,7 @@ List of chars built up while scanning various tokens.") (string "") number number-base + number-legacy-octal-p regexp-flags comment-type follows-eol-p) @@ -1018,6 +1028,11 @@ in large files.") "Face used to highlight function name in calls." :group 'js2-mode) +(defface js2-object-property + '((t :inherit default)) + "Face used to highlight named property in object literal." + :group 'js2-mode) + (defface js2-instance-member '((t :foreground "DarkOrchid")) "Face used to highlight instance variables in javascript. @@ -1061,6 +1076,7 @@ Not currently used." "Face used to highlight undeclared variable identifiers.") (defcustom js2-init-hook nil + ;; FIXME: We don't really need this anymore. "List of functions to be called after `js2-mode' or `js2-minor-mode' has initialized all variables, before parsing the buffer for the first time." @@ -1350,6 +1366,9 @@ the correct number of ARGS must be provided." (js2-msg "msg.yield.parenthesized" "yield expression must be parenthesized.") +(js2-msg "msg.bad.await" + "await must be in async functions.") + ;; NativeGlobal (js2-msg "msg.cant.call.indirect" "Function '%s' must be called directly, and not by way of a " @@ -1712,6 +1731,9 @@ the correct number of ARGS must be provided." (js2-msg "msg.destruct.assign.no.init" "Missing = in destructuring declaration") +(js2-msg "msg.init.no.destruct" + "Binding initializer not in destructuring assignment") + (js2-msg "msg.no.octal.strict" "Octal numbers prohibited in strict mode.") @@ -2530,7 +2552,10 @@ so many of its properties will be nil. (js2-print-from-clause from)) (exports-list (js2-print-named-imports exports-list))) - (insert ";\n"))) + (unless (or (and default (not (js2-assign-node-p default))) + (and declaration (or (js2-function-node-p declaration) + (js2-class-node-p declaration)))) + (insert ";\n")))) (cl-defstruct (js2-while-node (:include js2-loop-node) @@ -3241,6 +3266,7 @@ a `js2-label-node' or the innermost enclosing loop.") params rest-p body generator-type + async lp rp))) "AST node for a function declaration. The `params' field is a Lisp list of nodes. Each node is either a simple @@ -3257,6 +3283,7 @@ The `params' field is a Lisp list of nodes. Each node is either a simple ignore-dynamic ; ignore value of the dynamic-scope flag (interpreter only) needs-activation ; t if we need an activation object for this frame generator-type ; STAR, LEGACY, COMPREHENSION or nil + async ; t if the function is defined as `async function` member-expr) ; nonstandard Ecma extension from Rhino (put 'cl-struct-js2-function-node 'js2-visitor 'js2-visit-function-node) @@ -3270,7 +3297,7 @@ The `params' field is a Lisp list of nodes. Each node is either a simple (defun js2-print-function-node (n i) (let* ((pad (js2-make-pad i)) - (getter (js2-node-get-prop n 'GETTER_SETTER)) + (method (js2-node-get-prop n 'METHOD_TYPE)) (name (or (js2-function-node-name n) (js2-function-node-member-expr n))) (params (js2-function-node-params n)) @@ -3278,8 +3305,10 @@ The `params' field is a Lisp list of nodes. Each node is either a simple (rest-p (js2-function-node-rest-p n)) (body (js2-function-node-body n)) (expr (not (eq (js2-function-node-form n) 'FUNCTION_STATEMENT)))) - (unless (or getter arrow) - (insert pad "function") + (unless method + (insert pad) + (when (js2-function-node-async n) (insert "async ")) + (unless arrow (insert "function")) (when (eq (js2-function-node-generator-type n) 'STAR) (insert "*"))) (when name @@ -3450,6 +3479,8 @@ The type field inherited from `js2-node' holds the operator." (cons js2-TYPEOF "typeof") (cons js2-INSTANCEOF "instanceof") (cons js2-DELPROP "delete") + (cons js2-AWAIT "await") + (cons js2-VOID "void") (cons js2-COMMA ",") (cons js2-COLON ":") (cons js2-OR "||") @@ -3530,7 +3561,7 @@ The type field holds the actual assignment operator.") len operand))) "AST node type for unary operator nodes. The type field can be NOT, BITNOT, POS, NEG, INC, DEC, -TYPEOF, DELPROP or TRIPLEDOT. For INC or DEC, a 'postfix node +TYPEOF, DELPROP, TRIPLEDOT or AWAIT. For INC or DEC, a 'postfix node property is added if the operator follows the operand." operand) ; a `js2-node' expression @@ -3550,7 +3581,9 @@ property is added if the operator follows the operand." (unless postfix (insert op)) (if (or (= tt js2-TYPEOF) - (= tt js2-DELPROP)) + (= tt js2-DELPROP) + (= tt js2-AWAIT) + (= tt js2-VOID)) (insert " ")) (js2-print-ast (js2-unary-node-operand n) 0) (when postfix @@ -3686,11 +3719,14 @@ Returns 0 if NODE is nil or its identifier field is nil." (num-value (js2-token-number (js2-current-token))) (num-base (js2-token-number-base - (js2-current-token)))))) + (js2-current-token))) + (legacy-octal-p (js2-token-number-legacy-octal-p + (js2-current-token)))))) "AST node for a number literal." value ; the original string, e.g. "6.02e23" num-value ; the parsed number value - num-base) ; the number's base + num-base ; the number's base + legacy-octal-p) ; whether the number is a legacy octal (0123 instead of 0o123) (put 'cl-struct-js2-number-node 'js2-visitor 'js2-visit-none) (put 'cl-struct-js2-number-node 'js2-printer 'js2-print-number-node) @@ -3810,9 +3846,32 @@ You can tell the quote type by looking at the first character." (insert ","))) (insert "]")) -(cl-defstruct (js2-class-node +(cl-defstruct (js2-object-node (:include js2-node) (:constructor nil) + (:constructor make-js2-object-node (&key (type js2-OBJECTLIT) + (pos js2-ts-cursor) + len + elems))) + "AST node for an object literal expression. +`elems' is a list of `js2-object-prop-node'." + elems) + +(put 'cl-struct-js2-object-node 'js2-visitor 'js2-visit-object-node) +(put 'cl-struct-js2-object-node 'js2-printer 'js2-print-object-node) + +(defun js2-visit-object-node (n v) + (dolist (e (js2-object-node-elems n)) + (js2-visit-ast e v))) + +(defun js2-print-object-node (n i) + (insert (js2-make-pad i) "{") + (js2-print-list (js2-object-node-elems n)) + (insert "}")) + +(cl-defstruct (js2-class-node + (:include js2-object-node) + (:constructor nil) (:constructor make-js2-class-node (&key (type js2-CLASS) (pos js2-ts-cursor) (form 'CLASS_STATEMENT) @@ -3824,7 +3883,7 @@ optional `js2-expr-node'" form ; CLASS_{STATEMENT|EXPRESSION} name ; class name (a `js2-node-name', or nil if anonymous) extends ; class heritage (a `js2-expr-node', or nil if none) - elems) + ) (put 'cl-struct-js2-class-node 'js2-visitor 'js2-visit-class-node) (put 'cl-struct-js2-class-node 'js2-printer 'js2-print-class-node) @@ -3856,28 +3915,29 @@ optional `js2-expr-node'" (js2-print-ast elem (1+ i)))) (insert "\n" pad "}"))) -(cl-defstruct (js2-object-node +(cl-defstruct (js2-computed-prop-name-node (:include js2-node) (:constructor nil) - (:constructor make-js2-object-node (&key (type js2-OBJECTLIT) - (pos js2-ts-cursor) - len - elems))) - "AST node for an object literal expression. -`elems' is a list of `js2-object-prop-node'." - elems) + (:constructor make-js2-computed-prop-name-node + (&key + (type js2-LB) + expr + (pos (js2-current-token-beg)) + (len (- js2-ts-cursor + (js2-current-token-beg)))))) + "AST node for a `ComputedPropertyName'." + expr) -(put 'cl-struct-js2-object-node 'js2-visitor 'js2-visit-object-node) -(put 'cl-struct-js2-object-node 'js2-printer 'js2-print-object-node) +(put 'cl-struct-js2-computed-prop-name-node 'js2-visitor 'js2-visit-computed-prop-name-node) +(put 'cl-struct-js2-computed-prop-name-node 'js2-printer 'js2-print-computed-prop-name-node) -(defun js2-visit-object-node (n v) - (dolist (e (js2-object-node-elems n)) - (js2-visit-ast e v))) +(defun js2-visit-computed-prop-name-node (n v) + (js2-visit-ast (js2-computed-prop-name-node-expr n) v)) -(defun js2-print-object-node (n i) - (insert (js2-make-pad i) "{") - (js2-print-list (js2-object-node-elems n)) - (insert "}")) +(defun js2-print-computed-prop-name-node (n i) + (insert (js2-make-pad i) "[") + (js2-print-ast (js2-computed-prop-name-node-expr n) 0) + (insert "]")) (cl-defstruct (js2-object-prop-node (:include js2-infix-node) @@ -3898,53 +3958,41 @@ both fields have the same value.") (defun js2-print-object-prop-node (n i) (let* ((left (js2-object-prop-node-left n)) - (right (js2-object-prop-node-right n)) - (computed (not (or (js2-string-node-p left) - (js2-number-node-p left) - (js2-name-node-p left))))) - (insert (js2-make-pad i)) - (if computed - (insert "[")) - (js2-print-ast left 0) - (if computed - (insert "]")) + (right (js2-object-prop-node-right n))) + (js2-print-ast left i) (if (not (js2-node-get-prop n 'SHORTHAND)) (progn (insert ": ") (js2-print-ast right 0))))) -(cl-defstruct (js2-getter-setter-node +(cl-defstruct (js2-method-node (:include js2-infix-node) (:constructor nil) - (:constructor make-js2-getter-setter-node (&key type ; GET, SET, or FUNCTION - (pos js2-ts-cursor) - len left right))) - "AST node for a getter/setter property in an object literal. -The `left' field is the `js2-name-node' naming the getter/setter prop. + (:constructor make-js2-method-node (&key (pos js2-ts-cursor) + len left right))) + "AST node for a method in an object literal or a class body. +The `left' field is the `js2-name-node' naming the method. The `right' field is always an anonymous `js2-function-node' with a node -property `GETTER_SETTER' set to js2-GET, js2-SET, or js2-FUNCTION. ") +property `METHOD_TYPE' set to 'GET or 'SET. ") -(put 'cl-struct-js2-getter-setter-node 'js2-visitor 'js2-visit-infix-node) -(put 'cl-struct-js2-getter-setter-node 'js2-printer 'js2-print-getter-setter) +(put 'cl-struct-js2-method-node 'js2-visitor 'js2-visit-infix-node) +(put 'cl-struct-js2-method-node 'js2-printer 'js2-print-method) -(defun js2-print-getter-setter (n i) +(defun js2-print-method (n i) (let* ((pad (js2-make-pad i)) - (left (js2-getter-setter-node-left n)) - (right (js2-getter-setter-node-right n)) - (computed (not (or (js2-string-node-p left) - (js2-number-node-p left) - (js2-name-node-p left))))) + (left (js2-method-node-left n)) + (right (js2-method-node-right n)) + (type (js2-node-get-prop right 'METHOD_TYPE))) (insert pad) - (if (/= (js2-node-type n) js2-FUNCTION) - (insert (if (= (js2-node-type n) js2-GET) "get " "set "))) + (when type + (insert (cdr (assoc type '((GET . "get ") + (SET . "set ") + (ASYNC . "async ") + (FUNCTION . "")))))) (when (and (js2-function-node-p right) (eq 'STAR (js2-function-node-generator-type right))) (insert "*")) - (when computed - (insert "[")) (js2-print-ast left 0) - (when computed - (insert "]")) (js2-print-ast right 0))) (cl-defstruct (js2-prop-get-node @@ -5106,6 +5154,8 @@ You should use `js2-print-tree' instead of this function." (or (js2-node-has-side-effects expr) (when (js2-string-node-p expr) (member (js2-string-node-value expr) '("use strict" "use asm")))))) + ((= tt js2-AWAIT) + (js2-node-has-side-effects (js2-unary-node-operand node))) ((= tt js2-COMMA) (js2-node-has-side-effects (js2-infix-node-right node))) ((or (= tt js2-AND) @@ -5855,7 +5905,7 @@ its relevant fields and puts it into `js2-ti-tokens'." (let (identifier-start is-unicode-escape-start c contains-escape escape-val str result base - look-for-slash continue tt + look-for-slash continue tt legacy-octal (token (js2-new-token 0))) (setq tt @@ -5977,6 +6027,7 @@ its relevant fields and puts it into `js2-ti-tokens'." ((and (or (eq c ?o) (eq c ?O)) (>= js2-language-version 200)) (setq base 8) + (setq legacy-octal nil) (setq c (js2-get-char))) ((js2-digit-p c) (setq base 'maybe-8)) @@ -6014,7 +6065,8 @@ its relevant fields and puts it into `js2-ti-tokens'." (js2-add-to-string c) (setq c (js2-get-char))) (when (eq base 'maybe-8) - (setq base 8)))) + (setq base 8 + legacy-octal t)))) (when (and (eq base 10) (memq c '(?. ?e ?E))) (when (eq c ?.) (cl-loop do @@ -6036,7 +6088,8 @@ its relevant fields and puts it into `js2-ti-tokens'." (js2-unget-char) (let ((str (js2-set-string-from-buffer token))) (setf (js2-token-number token) (js2-string-to-number str base) - (js2-token-number-base token) base)) + (js2-token-number-base token) base + (js2-token-number-legacy-octal-p token) (and (= base 8) legacy-octal))) (throw 'return js2-NUMBER)) ;; is it a string? (when (or (memq c '(?\" ?\')) @@ -6753,6 +6806,8 @@ Shown at or above `js2-highlight-level' 3.") (prop (if (string-match js2-ecma-object-props prop-name) 'font-lock-constant-face)))))) + (when (and (not face) target (not call-p) prop-name) + (setq face 'js2-object-property)) (when face (let ((pos (+ (js2-node-pos parent) ; absolute (js2-node-pos prop)))) ; relative @@ -6852,15 +6907,18 @@ of a simple name. Called before EXPR has a parent node." '("alias" "augments" "borrows" + "callback" "bug" "base" "config" "default" "define" "exception" + "func" "function" "member" "memberOf" + "method" "name" "namespace" "since" @@ -6891,6 +6949,7 @@ of a simple name. Called before EXPR has a parent node." "export" "fileoverview" "final" + "func" "function" "hidden" "ignore" @@ -6899,6 +6958,7 @@ of a simple name. Called before EXPR has a parent node." "inner" "interface" "license" + "method" "noalias" "noshadow" "notypecheck" @@ -7199,6 +7259,7 @@ are ignored." js2-additional-externs))) (defun js2-get-jslint-globals () + (js2-reparse) (cl-loop for node in (js2-ast-root-comments js2-mode-ast) when (and (eq 'block (js2-comment-node-format node)) (save-excursion @@ -7452,7 +7513,7 @@ For instance, processing a nested scope requires a parent function node." (let (result fn parent-qname p elem) (dolist (entry js2-imenu-recorder) ;; function node goes first - (cl-destructuring-bind (current-fn &rest (&whole chain head &rest)) entry + (cl-destructuring-bind (current-fn &rest (&whole chain head &rest _)) entry ;; Examine head's defining scope: ;; Pre-processed chain, or top-level/external, keep as-is. (if (or (stringp head) (js2-node-top-level-decl-p head)) @@ -7676,14 +7737,67 @@ Returns nil and consumes nothing if MATCH is not the next token." (defun js2-match-contextual-kwd (name) "Consume and return t if next token is `js2-NAME', and its string is NAME. Returns nil and keeps current token otherwise." - (if (or (/= (js2-get-token) js2-NAME) - (not (string= (js2-current-token-string) name))) - (progn - (js2-unget-token) - nil) + (if (js2-contextual-kwd-p (progn (js2-get-token) + (js2-current-token)) + name) + (progn (js2-record-face 'font-lock-keyword-face) t) + (js2-unget-token) + nil)) + +(defun js2-contextual-kwd-p (token name) + "Return t if TOKEN is `js2-NAME', and its string is NAME." + (and (= (js2-token-type token) js2-NAME) + (string= (js2-token-string token) name))) + +(defun js2-match-async-function () + (when (and (js2-contextual-kwd-p (js2-current-token) "async") + (= (js2-peek-token) js2-FUNCTION)) (js2-record-face 'font-lock-keyword-face) + (js2-get-token) t)) +(defun js2-match-async-arrow-function () + (and (js2-contextual-kwd-p (js2-current-token) "async") + (/= (js2-peek-token) js2-FUNCTION))) + +(defsubst js2-inside-function () + (cl-plusp js2-nesting-of-function)) + +(defsubst js2-inside-async-function () + (and (js2-inside-function) + (js2-function-node-async js2-current-script-or-fn))) + +(defun js2-parse-await-maybe (tt) + "Parse \"await\" as an AwaitExpression, if it is one." + (and (= tt js2-NAME) + (js2-contextual-kwd-p (js2-current-token) "await") + ;; Per the proposal, AwaitExpression consists of "await" + ;; followed by a UnaryExpression. So look ahead for one. + (let ((ts-state (make-js2-ts-state)) + (recorded-identifiers js2-recorded-identifiers) + (parsed-errors js2-parsed-errors) + (current-token (js2-current-token)) + (beg (js2-current-token-beg)) + (end (js2-current-token-end)) + pn) + (js2-get-token) + (setq pn (js2-make-unary js2-AWAIT 'js2-parse-unary-expr)) + (if (= (js2-node-type (js2-unary-node-operand pn)) js2-ERROR) + ;; The parse failed, so pretend like nothing happened and restore + ;; the previous parsing state. + (progn + (js2-ts-seek ts-state) + (setq js2-recorded-identifiers recorded-identifiers + js2-parsed-errors parsed-errors) + ;; And ensure the caller knows about the failure. + nil) + ;; The parse was successful, so process and return the "await". + (js2-record-face 'font-lock-keyword-face current-token) + (unless (js2-inside-async-function) + (js2-report-error "msg.bad.await" nil + beg (- end beg))) + pn)))) + (defun js2-get-prop-name-token () (js2-get-token (and (>= js2-language-version 170) 'KEYWORD_IS_NAME))) @@ -7734,9 +7848,6 @@ Returns t on match, nil if no match." (js2-unget-token)) nil)) -(defsubst js2-inside-function () - (cl-plusp js2-nesting-of-function)) - (defun js2-set-requires-activation () (if (js2-function-node-p js2-current-script-or-fn) (setf (js2-function-node-needs-activation js2-current-script-or-fn) t))) @@ -7987,16 +8098,22 @@ declared; probably to check them for errors." (list node))) ((js2-object-node-p node) (dolist (elem (js2-object-node-elems node)) - (when (js2-object-prop-node-p elem) + ;; js2-infix-node-p catches both object prop node and initialized + ;; binding element (which is directly an infix node). + (when (js2-infix-node-p elem) (push (js2-define-destruct-symbols - ;; In abbreviated destructuring {a, b}, right == left. - (js2-object-prop-node-right elem) + (js2-infix-node-left elem) decl-type face ignore-not-in-block) name-nodes))) (apply #'append (nreverse name-nodes))) ((js2-array-node-p node) (dolist (elem (js2-array-node-elems node)) (when elem + (setq elem (cond ((js2-infix-node-p elem) ;; default (=) + (js2-infix-node-left elem)) + ((js2-unary-node-p elem) ;; rest (...) + (js2-unary-node-operand elem)) + (t elem))) (push (js2-define-destruct-symbols elem decl-type face ignore-not-in-block) name-nodes))) @@ -8053,8 +8170,7 @@ represented by FN-NODE at POS." new-param-name-nodes (js2-define-destruct-symbols param js2-LP 'js2-function-param)) (js2-check-strict-function-params param-name-nodes new-param-name-nodes) - (setq param-name-nodes (append param-name-nodes new-param-name-nodes)) - (push param params)) + (setq param-name-nodes (append param-name-nodes new-param-name-nodes))) ;; variable name (t (when (and (>= js2-language-version 200) @@ -8068,22 +8184,23 @@ represented by FN-NODE at POS." (setq param (js2-create-name-node)) (js2-define-symbol js2-LP (js2-current-token-string) param) (js2-check-strict-function-params param-name-nodes (list param)) - (setq param-name-nodes (append param-name-nodes (list param))) - ;; default parameter value - (when (and (>= js2-language-version 200) - (js2-match-token js2-ASSIGN)) - (cl-assert (not paren-free-arrow)) - (let* ((pos (js2-node-pos param)) - (tt (js2-current-token-type)) - (op-pos (- (js2-current-token-beg) pos)) - (left param) - (right (js2-parse-assign-expr)) - (len (- (js2-node-end right) pos))) - (setq param (make-js2-assign-node - :type tt :pos pos :len len :op-pos op-pos - :left left :right right)) - (js2-node-add-children param left right))) - (push param params))) + (setq param-name-nodes (append param-name-nodes (list param))))) + ;; default parameter value + (when (and (not rest-param-at) + (>= js2-language-version 200) + (js2-match-token js2-ASSIGN)) + (cl-assert (not paren-free-arrow)) + (let* ((pos (js2-node-pos param)) + (tt (js2-current-token-type)) + (op-pos (- (js2-current-token-beg) pos)) + (left param) + (right (js2-parse-assign-expr)) + (len (- (js2-node-end right) pos))) + (setq param (make-js2-assign-node + :type tt :pos pos :len len :op-pos op-pos + :left left :right right)) + (js2-node-add-children param left right))) + (push param params) (when (and rest-param-at (> (length params) (1+ rest-param-at))) (js2-report-error "msg.param.after.rest" nil (js2-node-pos param) (js2-node-len param))) @@ -8116,7 +8233,7 @@ Last token scanned is the close-curly for the function body." (js2-name-node-name name) pos end) (js2-add-strict-warning "msg.anon.no.return.value" nil pos end))))) -(defun js2-parse-function-stmt () +(defun js2-parse-function-stmt (&optional async-p) (let ((pos (js2-current-token-beg)) (star-p (js2-match-token js2-MUL))) (js2-must-match-name "msg.unnamed.function.stmt") @@ -8124,28 +8241,31 @@ Last token scanned is the close-curly for the function body." pn member-expr) (cond ((js2-match-token js2-LP) - (js2-parse-function 'FUNCTION_STATEMENT pos star-p name)) + (js2-parse-function 'FUNCTION_STATEMENT pos star-p async-p name)) (js2-allow-member-expr-as-function-name (setq member-expr (js2-parse-member-expr-tail nil name)) (js2-parse-highlight-member-expr-fn-name member-expr) (js2-must-match js2-LP "msg.no.paren.parms") - (setf pn (js2-parse-function 'FUNCTION_STATEMENT pos star-p) + (setf pn (js2-parse-function 'FUNCTION_STATEMENT pos star-p async-p) (js2-function-node-member-expr pn) member-expr) pn) (t (js2-report-error "msg.no.paren.parms") (make-js2-error-node)))))) -(defun js2-parse-function-expr () +(defun js2-parse-async-function-stmt () + (js2-parse-function-stmt t)) + +(defun js2-parse-function-expr (&optional async-p) (let ((pos (js2-current-token-beg)) (star-p (js2-match-token js2-MUL)) name) (when (js2-match-token js2-NAME) (setq name (js2-create-name-node t))) (js2-must-match js2-LP "msg.no.paren.parms") - (js2-parse-function 'FUNCTION_EXPRESSION pos star-p name))) + (js2-parse-function 'FUNCTION_EXPRESSION pos star-p async-p name))) -(defun js2-parse-function-internal (function-type pos star-p &optional name) +(defun js2-parse-function-internal (function-type pos star-p &optional async-p name) (let (fn-node lp) (if (= (js2-current-token-type) js2-LP) ; eventually matched LP? (setq lp (js2-current-token-beg))) @@ -8153,7 +8273,8 @@ Last token scanned is the close-curly for the function body." :name name :form function-type :lp (if lp (- lp pos)) - :generator-type (and star-p 'STAR))) + :generator-type (and star-p 'STAR) + :async async-p)) (when name (js2-set-face (js2-node-pos name) (js2-node-end name) 'font-lock-function-name-face 'record) @@ -8208,7 +8329,7 @@ Last token scanned is the close-curly for the function body." (setf (js2-scope-parent-scope fn-node) js2-current-scope) fn-node)) -(defun js2-parse-function (function-type pos star-p &optional name) +(defun js2-parse-function (function-type pos star-p &optional async-p name) "Function parser. FUNCTION-TYPE is a symbol, POS is the beginning of the first token (function keyword, unless it's an arrow function), NAME is js2-name-node." @@ -8224,7 +8345,7 @@ arrow function), NAME is js2-name-node." (setq ts-state (make-js2-ts-state)) (setq continue (catch 'reparse (setq fn-node (js2-parse-function-internal - function-type pos star-p name)) + function-type pos star-p async-p name)) ;; Don't continue. nil)) (when continue @@ -8334,9 +8455,12 @@ node are given relative start positions and correct lengths." (defun js2-statement-helper () (let* ((tt (js2-get-token)) (first-tt tt) + (async-stmt (js2-match-async-function)) (parser (if (= tt js2-ERROR) #'js2-parse-semi - (aref js2-parsers tt))) + (if async-stmt + #'js2-parse-async-function-stmt + (aref js2-parsers tt)))) pn) ;; If the statement is set, then it's been told its label by now. (and js2-labeled-stmt @@ -8345,7 +8469,8 @@ node are given relative start positions and correct lengths." (setq pn (funcall parser)) ;; Don't do auto semi insertion for certain statement types. (unless (or (memq first-tt js2-no-semi-insertion) - (js2-labeled-stmt-node-p pn)) + (js2-labeled-stmt-node-p pn) + async-stmt) (js2-auto-insert-semicolon pn)) pn)) @@ -8752,20 +8877,41 @@ invalid export statements." (setq from-clause (js2-parse-from-clause))) (js2-unget-token)))) ((js2-match-token js2-DEFAULT) - (setq default (js2-parse-expr))) + (setq default (cond ((js2-match-token js2-CLASS) + (js2-parse-class-stmt)) + ((js2-match-token js2-NAME) + (if (js2-match-async-function) + (js2-parse-async-function-stmt) + (js2-unget-token) + (js2-parse-expr))) + ((js2-match-token js2-FUNCTION) + (js2-parse-function-stmt)) + (t (js2-parse-expr))))) ((or (js2-match-token js2-VAR) (js2-match-token js2-CONST) (js2-match-token js2-LET)) (setq declaration (js2-parse-variables (js2-current-token-type) (js2-current-token-beg)))) + ((js2-match-token js2-CLASS) + (setq declaration (js2-parse-class-stmt))) + ((js2-match-token js2-NAME) + (setq declaration + (if (js2-match-async-function) + (js2-parse-async-function-stmt) + (js2-unget-token) + (js2-parse-expr)))) + ((js2-match-token js2-FUNCTION) + (setq declaration (js2-parse-function-stmt))) (t (setq declaration (js2-parse-expr)))) (when from-clause (push from-clause children)) (when declaration (push declaration children) - (when (not (js2-function-node-p declaration)) + (when (not (or (js2-function-node-p declaration) + (js2-class-node-p declaration))) (js2-auto-insert-semicolon declaration))) (when default (push default children) - (when (not (js2-function-node-p default)) + (when (not (or (js2-function-node-p default) + (js2-class-node-p default))) (js2-auto-insert-semicolon default))) (let ((node (make-js2-export-node :pos beg @@ -8810,7 +8956,7 @@ Last matched token must be js2-FOR." ((= tt js2-SEMI) (js2-unget-token) (setq init (make-js2-empty-expr-node))) - ((or (= tt js2-VAR) (= tt js2-LET)) + ((or (= tt js2-VAR) (= tt js2-LET) (= tt js2-CONST)) (setq init (js2-parse-variables tt (js2-current-token-beg)))) (t (js2-unget-token) @@ -9548,9 +9694,20 @@ If NODE is non-nil, it is the AST node associated with the symbol." (let ((tt (js2-get-token)) (pos (js2-current-token-beg)) pn left right op-pos - ts-state recorded-identifiers parsed-errors) + ts-state recorded-identifiers parsed-errors + async-p) (if (= tt js2-YIELD) (js2-parse-return-or-yield tt t) + ;; TODO(mooz): Bit confusing. + ;; If we meet `async` token and it's not part of `async + ;; function`, then this `async` is for a succeeding async arrow + ;; function. + ;; Since arrow function parsing doesn't rely on neither + ;; `js2-parse-function-stmt' nor `js2-parse-function-expr' that + ;; interpret `async` token, we trash `async` and just remember + ;; we met `async` keyword to `async-p'. + (when (js2-match-async-arrow-function) + (setq async-p t)) ;; Save the tokenizer state in case we find an arrow function ;; and have to rewind. (setq ts-state (make-js2-ts-state) @@ -9584,9 +9741,12 @@ If NODE is non-nil, it is the AST node associated with the symbol." ((and (= tt js2-ARROW) (>= js2-language-version 200)) (js2-ts-seek ts-state) + (when async-p + (js2-record-face 'font-lock-keyword-face) + (js2-get-token)) (setq js2-recorded-identifiers recorded-identifiers js2-parsed-errors parsed-errors) - (setq pn (js2-parse-function 'FUNCTION_ARROW (js2-current-token-beg) nil))) + (setq pn (js2-parse-function 'FUNCTION_ARROW (js2-current-token-beg) nil async-p))) (t (js2-unget-token))) pn))) @@ -9616,7 +9776,7 @@ If NODE is non-nil, it is the AST node associated with the symbol." (js2-node-add-children pn test-expr if-true if-false)) pn)) -(defun js2-make-binary (type left parser) +(defun js2-make-binary (type left parser &optional no-get) "Helper for constructing a binary-operator AST node. LEFT is the left-side-expression, already parsed, and the binary operator should have just been matched. @@ -9627,7 +9787,7 @@ FIXME: The latter option is unused?" (op-pos (- (js2-current-token-beg) pos)) (right (if (js2-node-p parser) parser - (js2-get-token) + (unless no-get (js2-get-token)) (funcall parser))) (pn (make-js2-infix-node :type type :pos pos @@ -9816,6 +9976,7 @@ to parse the operand (for prefix operators)." ((= tt js2-DELPROP) (js2-get-token) (js2-make-unary js2-DELPROP 'js2-parse-unary-expr)) + ((js2-parse-await-maybe tt)) ((= tt js2-ERROR) (js2-get-token) (make-js2-error-node)) ; try to continue @@ -9968,9 +10129,9 @@ Returns an expression tree that includes PN, the parent node." (setq pn (js2-parse-tagged-template pn (make-js2-string-node :type tt)))) (t (js2-unget-token) - (setq continue nil)))) - (if (>= js2-highlight-level 2) - (js2-parse-highlight-member-expr-node pn)) + (setq continue nil))) + (if (>= js2-highlight-level 2) + (js2-parse-highlight-member-expr-node pn))) pn)) (defun js2-parse-tagged-template (tag-node tpl-node) @@ -10205,6 +10366,8 @@ array-literals, array comprehensions and regular expressions." (js2-parse-class-expr)) ((= tt js2-FUNCTION) (js2-parse-function-expr)) + ((js2-match-async-function) + (js2-parse-function-expr t)) ((= tt js2-LB) (js2-parse-array-comp-or-literal)) ((= tt js2-LC) @@ -10221,7 +10384,8 @@ array-literals, array comprehensions and regular expressions." ((= tt js2-NUMBER) (setq node (make-js2-number-node)) (when (and js2-in-use-strict-directive - (= (js2-number-node-num-base node) 8)) + (= (js2-number-node-num-base node) 8) + (js2-number-node-legacy-octal-p node)) (js2-report-error "msg.no.octal.strict")) node) ((or (= tt js2-STRING) (= tt js2-NO_SUBS_TEMPLATE)) @@ -10320,19 +10484,13 @@ array-literals, array comprehensions and regular expressions." (defun js2-parse-array-literal (pos) (let ((after-lb-or-comma t) - after-comma tt elems pn + after-comma tt elems pn was-rest (continue t)) (unless js2-is-in-destructuring (js2-push-scope (make-js2-scope))) ; for the legacy array comp (while continue (setq tt (js2-get-token)) (cond - ;; comma - ((= tt js2-COMMA) - (setq after-comma (js2-current-token-end)) - (if (not after-lb-or-comma) - (setq after-lb-or-comma t) - (push nil elems))) ;; end of array ((or (= tt js2-RB) (= tt js2-EOF)) ; prevent infinite loop @@ -10346,21 +10504,18 @@ array-literals, array comprehensions and regular expressions." :len (- js2-ts-cursor pos) :elems (nreverse elems))) (apply #'js2-node-add-children pn (js2-array-node-elems pn))) - ;; destructuring binding - (js2-is-in-destructuring - (push (if (or (= tt js2-LC) - (= tt js2-LB) - (= tt js2-NAME)) - ;; [a, b, c] | {a, b, c} | {a:x, b:y, c:z} | a - (js2-parse-destruct-primary-expr) - ;; invalid pattern - (js2-report-error "msg.bad.var") - (make-js2-error-node)) - elems) - (setq after-lb-or-comma nil - after-comma nil)) + ;; anything after rest element (...foo) + (was-rest + (js2-report-error "msg.param.after.rest")) + ;; comma + ((= tt js2-COMMA) + (setq after-comma (js2-current-token-end)) + (if (not after-lb-or-comma) + (setq after-lb-or-comma t) + (push nil elems))) ;; array comp ((and (>= js2-language-version 170) + (not js2-is-in-destructuring) (= tt js2-FOR) ; check for array comprehension (not after-lb-or-comma) ; "for" can't follow a comma elems ; must have at least 1 element @@ -10374,9 +10529,12 @@ array-literals, array comprehensions and regular expressions." (js2-report-error "msg.no.bracket.arg")) (if (and (= tt js2-TRIPLEDOT) (>= js2-language-version 200)) - ;; spread operator - (push (js2-make-unary tt 'js2-parse-assign-expr) - elems) + ;; rest/spread operator + (progn + (push (js2-make-unary tt 'js2-parse-assign-expr) + elems) + (if js2-is-in-destructuring + (setq was-rest t))) (js2-unget-token) (push (js2-parse-assign-expr) elems)) (setq after-lb-or-comma nil @@ -10526,6 +10684,7 @@ If ONLY-OF-P is non-nil, only the 'for (foo of bar)' form is allowed." (js2-set-face (js2-node-pos name) (js2-node-end name) 'font-lock-function-name-face 'record) (let ((node (js2-parse-class pos 'CLASS_STATEMENT name))) + (js2-record-imenu-functions node name) (js2-define-symbol js2-FUNCTION (js2-name-node-name name) node) @@ -10570,10 +10729,12 @@ If ONLY-OF-P is non-nil, only the 'for (foo of bar)' form is allowed." (defun js2-property-key-string (property-node) "Return the key of PROPERTY-NODE (a `js2-object-prop-node' or -`js2-getter-setter-node') as a string, or nil if it can't be +`js2-method-node') as a string, or nil if it can't be represented as a string (e.g., the key is computed by an expression)." (let ((key (js2-infix-node-left property-node))) + (when (js2-computed-prop-name-node-p key) + (setq key (js2-computed-prop-name-node-expr key))) (cond ((js2-name-node-p key) (js2-name-node-name key)) @@ -10605,12 +10766,11 @@ expression)." (= js2-MUL tt)) (setq previous-token (js2-current-token) tt (js2-get-prop-name-token))) - ;; Handle 'get' or 'set' keywords + ;; Handle getter, setter and async methods (let ((prop (js2-current-token-string))) (when (and (>= js2-language-version 200) (= js2-NAME tt) - (or (string= prop "get") - (string= prop "set")) + (member prop '("get" "set" "async")) (member (js2-peek-token) (list js2-NAME js2-STRING js2-NUMBER js2-LB))) (setq previous-token (js2-current-token) @@ -10619,7 +10779,7 @@ expression)." ;; Found a property (of any sort) ((member tt (list js2-NAME js2-STRING js2-NUMBER js2-LB)) (setq after-comma nil - elem (js2-parse-named-prop tt pos previous-token)) + elem (js2-parse-named-prop tt previous-token)) (if (and (null elem) (not js2-recover-from-parse-errors)) (setq continue nil))) @@ -10631,6 +10791,10 @@ expression)." (if after-comma (js2-parse-warn-trailing-comma "msg.extra.trailing.comma" pos elems after-comma))) + ;; Skip semicolons in a class body + ((and class-p + (= tt js2-SEMI)) + nil) (t (js2-report-error "msg.bad.prop") (unless js2-recover-from-parse-errors @@ -10654,7 +10818,16 @@ expression)." (lambda (previous-elem) (and (setq previous-elem-key-string (js2-property-key-string previous-elem)) - (string= previous-elem-key-string elem-key-string))) + ;; Check if the property is a duplicate. + (string= previous-elem-key-string elem-key-string) + ;; But make an exception for getter / setter pairs. + (not (and (js2-method-node-p elem) + (js2-method-node-p previous-elem) + (let ((type (js2-node-get-prop (js2-method-node-right elem) 'METHOD_TYPE)) + (previous-type (js2-node-get-prop (js2-method-node-right previous-elem) 'METHOD_TYPE))) + (and (member type '(GET SET)) + (member previous-type '(GET SET)) + (not (eq type previous-type)))))))) elems)) (js2-report-error "msg.dup.obj.lit.prop.strict" elem-key-string @@ -10665,44 +10838,34 @@ expression)." (js2-must-match js2-RC "msg.no.brace.prop") (nreverse elems))) -(defun js2-parse-named-prop (tt pos previous-token) +(defun js2-parse-named-prop (tt previous-token) "Parse a name, string, or getter/setter object property. When `js2-is-in-destructuring' is t, forms like {a, b, c} will be permitted." - (let ((key (cond - ;; Literal string keys: {'foo': 'bar'} - ((= tt js2-STRING) - (make-js2-string-node)) - ;; Handle computed keys: {[Symbol.iterator]: ...}, *[1+2]() {...}}, - ;; {[foo + bar]() { ... }}, {[get ['x' + 1]() {...}} - ((and (= tt js2-LB) - (>= js2-language-version 200)) - (prog1 (js2-parse-expr) - (js2-must-match js2-RB "msg.missing.computed.rb"))) - ;; Numeric keys: {12: 'foo'}, {10.7: 'bar'} - ((= tt js2-NUMBER) - (make-js2-number-node)) - ;; Unquoted names: {foo: 12} - ((= tt js2-NAME) - (js2-create-name-node)) - ;; Anything else is an error - (t (js2-report-error "msg.bad.prop")))) + (let ((key (js2-parse-prop-name tt)) (prop (and previous-token (js2-token-string previous-token))) (property-type (when previous-token (if (= (js2-token-type previous-token) js2-MUL) "*" - (js2-token-string previous-token))))) - (when (or (string= prop "get") - (string= prop "set")) + (js2-token-string previous-token)))) + pos) + (when (member prop '("get" "set" "async")) + (setq pos (js2-token-beg previous-token)) (js2-set-face (js2-token-beg previous-token) (js2-token-end previous-token) - 'font-lock-keyword-face 'record)) ; get/set + 'font-lock-keyword-face 'record)) ; get/set/async (cond ;; method definition: {f() {...}} ((and (= (js2-peek-token) js2-LP) (>= js2-language-version 200)) (when (js2-name-node-p key) ; highlight function name properties (js2-record-face 'font-lock-function-name-face)) - (js2-parse-getter-setter-prop pos key property-type)) + (js2-parse-method-prop pos key property-type)) + ;; binding element with initializer + ((and (= (js2-peek-token) js2-ASSIGN) + (>= js2-language-version 200)) + (if (not js2-is-in-destructuring) + (js2-report-error "msg.init.no.destruct")) + (js2-parse-initialized-binding key)) ;; regular prop (t (let ((beg (js2-current-token-beg)) @@ -10717,10 +10880,38 @@ When `js2-is-in-destructuring' is t, forms like {a, b, c} will be permitted." (if (js2-function-node-p (js2-object-prop-node-right expr)) 'font-lock-function-name-face - 'font-lock-variable-name-face) + 'js2-object-property) 'record) expr))))) +(defun js2-parse-initialized-binding (name) + "Parse a `SingleNameBinding' with initializer. + +`name' is the `BindingIdentifier'." + (when (js2-match-token js2-ASSIGN) + (js2-make-binary js2-ASSIGN name 'js2-parse-assign-expr t))) + +(defun js2-parse-prop-name (tt) + (cond + ;; Literal string keys: {'foo': 'bar'} + ((= tt js2-STRING) + (make-js2-string-node)) + ;; Handle computed keys: {[Symbol.iterator]: ...}, *[1+2]() {...}}, + ;; {[foo + bar]() { ... }}, {[get ['x' + 1]() {...}} + ((and (= tt js2-LB) + (>= js2-language-version 200)) + (make-js2-computed-prop-name-node + :expr (prog1 (js2-parse-assign-expr) + (js2-must-match js2-RB "msg.missing.computed.rb")))) + ;; Numeric keys: {12: 'foo'}, {10.7: 'bar'} + ((= tt js2-NUMBER) + (make-js2-number-node)) + ;; Unquoted names: {foo: 12} + ((= tt js2-NAME) + (js2-create-name-node)) + ;; Anything else is an error + (t (js2-report-error "msg.bad.prop")))) + (defun js2-parse-plain-property (prop) "Parse a non-getter/setter property in an object literal. PROP is the node representing the property: a number, name, @@ -10762,11 +10953,12 @@ string or expression." (js2-node-add-children result prop expr) result)))) -(defun js2-parse-getter-setter-prop (pos prop type-string) - "Parse getter or setter property in an object literal. +(defun js2-parse-method-prop (pos prop type-string) + "Parse method property in an object literal or a class body. JavaScript syntax is: - { get foo() {...}, set foo(x) {...} } + { foo(...) {...}, get foo() {...}, set foo(x) {...}, *foo(...) {...}, + async foo(...) {...} } and expression closure style is also supported @@ -10775,26 +10967,26 @@ and expression closure style is also supported POS is the start position of the `get' or `set' keyword. PROP is the `js2-name-node' representing the property name. TYPE-STRING is a string `get', `set', `*', or nil, indicating a found keyword." - (let ((type (cond - ((string= "get" type-string) js2-GET) - ((string= "set" type-string) js2-SET) - (t js2-FUNCTION))) - result end - (fn (js2-parse-function-expr))) + (let* ((type (or (cdr (assoc type-string '(("get" . GET) + ("set" . SET) + ("async" . ASYNC)))) + 'FUNCTION)) + result end + (fn (js2-parse-function-expr (eq type 'ASYNC)))) ;; it has to be an anonymous function, as we already parsed the name (if (/= (js2-node-type fn) js2-FUNCTION) (js2-report-error "msg.bad.prop") (if (cl-plusp (length (js2-function-name fn))) (js2-report-error "msg.bad.prop"))) - (js2-node-set-prop fn 'GETTER_SETTER type) ; for codegen + (js2-node-set-prop fn 'METHOD_TYPE type) ; for codegen (when (string= type-string "*") (setf (js2-function-node-generator-type fn) 'STAR)) + (unless pos (setq pos (js2-node-pos prop))) (setq end (js2-node-end fn) - result (make-js2-getter-setter-node :type type - :pos pos - :len (- end pos) - :left prop - :right fn)) + result (make-js2-method-node :pos pos + :len (- end pos) + :left prop + :right fn)) (js2-node-add-children result prop fn) result)) @@ -10815,6 +11007,68 @@ And, if CHECK-ACTIVATION-P is non-nil, use the value of TOKEN." (js2-check-activation-name s (or token js2-NAME))) name)) +;;; Use AST to extract semantic information + +(defun js2-get-element-index-from-array-node (elem array-node &optional hardcoded-array-index) + "Get index of ELEM from ARRAY-NODE or 0 and return it as string." + (let ((idx 0) elems (rlt hardcoded-array-index)) + (setq elems (js2-array-node-elems array-node)) + (if (and elem (not hardcoded-array-index)) + (setq rlt (catch 'nth-elt + (dolist (x elems) + ;; We know the ELEM does belong to ARRAY-NODE, + (if (eq elem x) (throw 'nth-elt idx)) + (setq idx (1+ idx))) + 0))) + (format "[%s]" rlt))) + +(defun js2-print-json-path (&optional hardcoded-array-index) + "Print the path to the JSON value under point, and save it in the kill ring. +If HARDCODED-ARRAY-INDEX provided, array index in JSON path is replaced with it." + (interactive "P") + (js2-reparse) + (let (previous-node current-node + key-name + rlt) + + ;; The `js2-node-at-point' starts scanning from AST root node. + ;; So there is no way to optimize it. + (setq current-node (js2-node-at-point)) + + (while (not (js2-ast-root-p current-node)) + (cond + ;; JSON property node + ((js2-object-prop-node-p current-node) + (setq key-name (js2-prop-node-name (js2-object-prop-node-left current-node))) + (if rlt (setq rlt (concat "." key-name rlt)) + (setq rlt (concat "." key-name)))) + + ;; Array node + ((or (js2-array-node-p current-node)) + (setq rlt (concat (js2-get-element-index-from-array-node previous-node + current-node + hardcoded-array-index) + rlt))) + + ;; Other nodes are ignored + (t)) + + ;; current node is archived + (setq previous-node current-node) + ;; Get parent node and continue the loop + (setq current-node (js2-node-parent current-node))) + + (cond + (rlt + ;; Clean the final result + (setq rlt (replace-regexp-in-string "^\\." "" rlt)) + (kill-new rlt) + (message "%s => kill-ring" rlt)) + (t + (message "No JSON path found!"))) + + rlt)) + ;;; Indentation support (bouncing) ;; In recent-enough Emacs, we reuse the indentation code from @@ -11315,7 +11569,23 @@ Selecting an error will jump it to the corresponding source-buffer error. (run-hooks 'js2-init-hook) - (js2-reparse)) + (let ((js2-idle-timer-delay 0)) + ;; Schedule parsing for after when the mode hooks run. + (js2-mode-reset-timer))) + +;; We may eventually want js2-jsx-mode to derive from js-jsx-mode, but that'd be +;; a bit more complicated and it doesn't net us much yet. +;;;###autoload +(define-derived-mode js2-jsx-mode js2-mode "JSX-IDE" + "Major mode for editing JSX code. + +To customize the indentation for this mode, set the SGML offset +variables (`sgml-basic-offset' et al) locally, like so: + + (defun set-jsx-indentation () + (setq-local sgml-basic-offset js2-basic-offset)) + (add-hook 'js2-jsx-mode-hook #'set-jsx-indentation)" + (set (make-local-variable 'indent-line-function) #'js2-jsx-indent-line)) (defun js2-mode-exit () "Exit `js2-mode' and clean up." @@ -11652,10 +11922,7 @@ PARSE-STATUS is as documented in `parse-partial-sexp'." (insert "\n") (indent-to col) (insert "*/")))) - ((and single - (save-excursion - (and (zerop (forward-line 1)) - (looking-at "\\s-*//")))) + (single (indent-to col) (insert "// "))) ;; Don't need to extend the comment after all. @@ -12302,7 +12569,10 @@ it marks the next defun after the ones already marked." (defun js2-jump-to-definition (&optional arg) "Jump to the definition of an object's property, variable or function." (interactive "P") - (ring-insert find-tag-marker-ring (point-marker)) + (if (eval-when-compile (fboundp 'xref-push-marker-stack)) + (xref-push-marker-stack) + (ring-insert find-tag-marker-ring (point-marker))) + (js2-reparse) (let* ((node (js2-node-at-point)) (parent (js2-node-parent node)) (names (if (js2-prop-get-node-p parent) diff --git a/elpa/js2-mode-20150909/js2-old-indent.el b/elpa/js2-mode-20160409.1113/js2-old-indent.el similarity index 67% rename from elpa/js2-mode-20150909/js2-old-indent.el rename to elpa/js2-mode-20160409.1113/js2-old-indent.el index efc9053..d8932d6 100644 --- a/elpa/js2-mode-20150909/js2-old-indent.el +++ b/elpa/js2-mode-20160409.1113/js2-old-indent.el @@ -54,6 +54,8 @@ ;;; Code: +(require 'sgml-mode) + (defvar js2-language-version) (declare-function js2-mark-safe-local "js2-mode") @@ -130,12 +132,12 @@ followed by an opening brace.") (defconst js2-indent-operator-re (concat "[-+*/%<>&^|?:.]\\([^-+*/]\\|$\\)\\|!?=\\|" - (regexp-opt '("in" "instanceof") 'words)) + (regexp-opt '("in" "instanceof") 'symbols)) "Regular expression matching operators that affect indentation of continued expressions.") (defconst js2-declaration-keyword-re - (regexp-opt '("var" "let" "const") 'words) + (regexp-opt '("var" "let" "const") 'symbols) "Regular expression matching variable declaration keywords.") (defun js2-re-search-forward-inner (regexp &optional bound count) @@ -215,30 +217,38 @@ and comments have been removed." (defun js2-looking-at-operator-p () "Return non-nil if text after point is a non-comma operator." + (defvar js2-mode-identifier-re) (and (looking-at js2-indent-operator-re) - (or (not (looking-at ":")) + (or (not (eq (char-after) ?:)) (save-excursion (and (js2-re-search-backward "[?:{]\\|\\_" nil t) - (looking-at "?")))))) + (eq (char-after) ??)))) + (not (and + (eq (char-after) ?*) + ;; Generator method (possibly using computed property). + (looking-at (concat "\\* *\\(?:\\[\\|" + js2-mode-identifier-re + " *(\\)")) + (save-excursion + (js2-backward-sws) + ;; We might misindent some expressions that would + ;; return NaN anyway. Shouldn't be a problem. + (memq (char-before) '(?, ?} ?{))))))) (defun js2-continued-expression-p () "Return non-nil if the current line continues an expression." (save-excursion (back-to-indentation) - (or (js2-looking-at-operator-p) - (when (catch 'found - (while (and (re-search-backward "\n" nil t) - (let ((state (syntax-ppss))) - (when (nth 4 state) - (goto-char (nth 8 state))) ;; skip comments - (skip-chars-backward " \t") - (if (bolp) - t - (throw 'found t)))))) - (backward-char) - (when (js2-looking-at-operator-p) - (backward-char) - (not (looking-at "\\*\\|\\+\\+\\|--\\|/[/*]"))))))) + (if (js2-looking-at-operator-p) + (or (not (memq (char-after) '(?- ?+))) + (progn + (forward-comment (- (point))) + (not (memq (char-before) '(?, ?\[ ?\())))) + (forward-comment (- (point))) + (or (bobp) (backward-char)) + (when (js2-looking-at-operator-p) + (backward-char) + (not (looking-at "\\*\\|\\+\\+\\|--\\|/[/*]")))))) (defun js2-end-of-do-while-loop-p () "Return non-nil if word after point is `while' of a do-while @@ -431,7 +441,7 @@ indentation is aligned to that column." (goto-char bracket) (cond ((looking-at "[({[][ \t]*\\(/[/*]\\|$\\)") - (when (save-excursion (skip-chars-backward " \t)") + (when (save-excursion (skip-chars-backward " \t\n)") (looking-at ")")) (backward-list)) (back-to-indentation) @@ -484,6 +494,215 @@ indentation is aligned to that column." (when (cl-plusp offset) (forward-char offset))))) +;;; JSX Indentation + +;; The following JSX indentation code is copied basically verbatim from js.el at +;; 958da7f, except that the prefixes on the functions/variables are changed. + +(defsubst js2--jsx-find-before-tag () + "Find where JSX starts. + +Assume JSX appears in the following instances: +- Inside parentheses, when returned or as the first argument + to a function, and after a newline +- When assigned to variables or object properties, but only + on a single line +- As the N+1th argument to a function + +This is an optimized version of (re-search-backward \"[(,]\n\" +nil t), except set point to the end of the match. This logic +executes up to the number of lines in the file, so it should be +really fast to reduce that impact." + (let (pos) + (while (and (> (point) (point-min)) + (not (progn + (end-of-line 0) + (when (or (eq (char-before) 40) ; ( + (eq (char-before) 44)) ; , + (setq pos (1- (point)))))))) + pos)) + +(defconst js2--jsx-end-tag-re + (concat "\\|/>") + "Find the end of a JSX element.") + +(defconst js2--jsx-after-tag-re "[),]" + "Find where JSX ends. +This complements the assumption of where JSX appears from +`js--jsx-before-tag-re', which see.") + +(defun js2--jsx-indented-element-p () + "Determine if/how the current line should be indented as JSX. + +Return `first' for the first JSXElement on its own line. +Return `nth' for subsequent lines of the first JSXElement. +Return `expression' for an embedded JS expression. +Return `after' for anything after the last JSXElement. +Return nil for non-JSX lines. + +Currently, JSX indentation supports the following styles: + +- Single-line elements (indented like normal JS): + + var element =
; + +- Multi-line elements (enclosed in parentheses): + + function () { + return ( +
+
+
+ ); + } + +- Function arguments: + + React.render( +
, + document.querySelector('.root') + );" + (let ((current-pos (point)) + (current-line (line-number-at-pos)) + last-pos + before-tag-pos before-tag-line + tag-start-pos tag-start-line + tag-end-pos tag-end-line + after-tag-line + parens paren type) + (save-excursion + (and + ;; Determine if we're inside a jsx element + (progn + (end-of-line) + (while (and (not tag-start-pos) + (setq last-pos (js2--jsx-find-before-tag))) + (while (forward-comment 1)) + (when (= (char-after) 60) ; < + (setq before-tag-pos last-pos + tag-start-pos (point))) + (goto-char last-pos)) + tag-start-pos) + (progn + (setq before-tag-line (line-number-at-pos before-tag-pos) + tag-start-line (line-number-at-pos tag-start-pos)) + (and + ;; A "before" line which also starts an element begins with js, so + ;; indent it like js + (> current-line before-tag-line) + ;; Only indent the jsx lines like jsx + (>= current-line tag-start-line))) + (cond + ;; Analyze bounds if there are any + ((progn + (while (and (not tag-end-pos) + (setq last-pos (re-search-forward js2--jsx-end-tag-re nil t))) + (while (forward-comment 1)) + (when (looking-at js2--jsx-after-tag-re) + (setq tag-end-pos last-pos))) + tag-end-pos) + (setq tag-end-line (line-number-at-pos tag-end-pos) + after-tag-line (line-number-at-pos after-tag-line)) + (or (and + ;; Ensure we're actually within the bounds of the jsx + (<= current-line tag-end-line) + ;; An "after" line which does not end an element begins with + ;; js, so indent it like js + (<= current-line after-tag-line)) + (and + ;; Handle another case where there could be e.g. comments after + ;; the element + (> current-line tag-end-line) + (< current-line after-tag-line) + (setq type 'after)))) + ;; They may not be any bounds (yet) + (t)) + ;; Check if we're inside an embedded multi-line js expression + (cond + ((not type) + (goto-char current-pos) + (end-of-line) + (setq parens (nth 9 (syntax-ppss))) + (while (and parens (not type)) + (setq paren (car parens)) + (cond + ((and (>= paren tag-start-pos) + ;; Curly bracket indicates the start of an embedded expression + (= (char-after paren) 123) ; { + ;; The first line of the expression is indented like sgml + (> current-line (line-number-at-pos paren)) + ;; Check if within a closing curly bracket (if any) + ;; (exclusive, as the closing bracket is indented like sgml) + (cond + ((progn + (goto-char paren) + (ignore-errors (let (forward-sexp-function) + (forward-sexp)))) + (< current-line (line-number-at-pos))) + (t))) + ;; Indicate this guy will be indented specially + (setq type 'expression)) + (t (setq parens (cdr parens))))) + t) + (t)) + (cond + (type) + ;; Indent the first jsx thing like js so we can indent future jsx things + ;; like sgml relative to the first thing + ((= current-line tag-start-line) 'first) + ('nth)))))) + +(defmacro js2--as-sgml (&rest body) + "Execute BODY as if in sgml-mode." + `(with-syntax-table sgml-mode-syntax-table + (let (forward-sexp-function + parse-sexp-lookup-properties) + ,@body))) + +(defun js2--expression-in-sgml-indent-line () + "Indent the current line as JavaScript or SGML (whichever is farther)." + (let* (indent-col + (savep (point)) + ;; Don't whine about errors/warnings when we're indenting. + ;; This has to be set before calling parse-partial-sexp below. + (inhibit-point-motion-hooks t) + (parse-status (save-excursion + (syntax-ppss (point-at-bol))))) + ;; Don't touch multiline strings. + (unless (nth 3 parse-status) + (setq indent-col (save-excursion + (back-to-indentation) + (if (>= (point) savep) (setq savep nil)) + (js2--as-sgml (sgml-calculate-indent)))) + (if (null indent-col) + 'noindent + ;; Use whichever indentation column is greater, such that the sgml + ;; column is effectively a minimum + (setq indent-col (max (js2-proper-indentation parse-status) + (+ indent-col js2-basic-offset))) + (if savep + (save-excursion (indent-line-to indent-col)) + (indent-line-to indent-col)))))) + +(defun js2-jsx-indent-line () + "Indent the current line as JSX (with SGML offsets). +i.e., customize JSX element indentation with `sgml-basic-offset' +et al." + (interactive) + (let ((indentation-type (js2--jsx-indented-element-p))) + (cond + ((eq indentation-type 'expression) + (js2--expression-in-sgml-indent-line)) + ((or (eq indentation-type 'first) + (eq indentation-type 'after)) + ;; Don't treat this first thing as a continued expression (often a "<" or + ;; ">" causes this misinterpretation) + (cl-letf (((symbol-function #'js2-continued-expression-p) 'ignore)) + (js2-indent-line))) + ((eq indentation-type 'nth) + (js2--as-sgml (sgml-indent-line))) + (t (js2-indent-line))))) + (provide 'js2-old-indent) ;;; js2-old-indent.el ends here diff --git a/elpa/json-mode-1.2.0/json-mode-pkg.el b/elpa/json-mode-1.2.0/json-mode-pkg.el deleted file mode 100644 index 80ff914..0000000 --- a/elpa/json-mode-1.2.0/json-mode-pkg.el +++ /dev/null @@ -1 +0,0 @@ -(define-package "json-mode" "1.2.0" "Major mode for editing JSON files" 'nil) diff --git a/elpa/json-mode-1.2.0/json-mode-autoloads.el b/elpa/json-mode-20151116.2000/json-mode-autoloads.el similarity index 63% rename from elpa/json-mode-1.2.0/json-mode-autoloads.el rename to elpa/json-mode-20151116.2000/json-mode-autoloads.el index 972545e..6da37e4 100644 --- a/elpa/json-mode-1.2.0/json-mode-autoloads.el +++ b/elpa/json-mode-20151116.2000/json-mode-autoloads.el @@ -3,20 +3,10 @@ ;;; Code: (add-to-list 'load-path (or (file-name-directory #$) (car load-path))) -;;;### (autoloads nil "json-mode" "json-mode.el" (21705 22863 857796 -;;;;;; 481000)) +;;;### (autoloads nil "json-mode" "json-mode.el" (22297 19821 80013 +;;;;;; 273000)) ;;; Generated autoloads from json-mode.el -(autoload 'json-mode-beautify "json-mode" "\ -Beautify / pretty-print from BEG to END, and optionally PRESERVE-KEY-ORDER. - -\(fn &optional PRESERVE-KEY-ORDER)" t nil) - -(autoload 'json-mode-beautify-ordered "json-mode" "\ -Beautify / pretty-print from BEG to END preserving key order. - -\(fn)" t nil) - (autoload 'json-mode "json-mode" "\ Major mode for editing JSON files @@ -24,6 +14,16 @@ Major mode for editing JSON files (add-to-list 'auto-mode-alist '("\\.json$" . json-mode)) +(autoload 'json-mode-show-path "json-mode" "\ + + +\(fn)" t nil) + +(autoload 'json-mode-beautify "json-mode" "\ +Beautify / pretty-print the active region (or the entire buffer if no active region). + +\(fn)" t nil) + ;;;*** ;; Local Variables: diff --git a/elpa/json-mode-20151116.2000/json-mode-pkg.el b/elpa/json-mode-20151116.2000/json-mode-pkg.el new file mode 100644 index 0000000..6e10799 --- /dev/null +++ b/elpa/json-mode-20151116.2000/json-mode-pkg.el @@ -0,0 +1 @@ +(define-package "json-mode" "20151116.2000" "Major mode for editing JSON files" '((json-reformat "0.0.5") (json-snatcher "1.0.0")) :url "https://github.com/joshwnj/json-mode") diff --git a/elpa/json-mode-1.2.0/json-mode.el b/elpa/json-mode-20151116.2000/json-mode.el similarity index 61% rename from elpa/json-mode-1.2.0/json-mode.el rename to elpa/json-mode-20151116.2000/json-mode.el index 168b3d1..91feee9 100644 --- a/elpa/json-mode-1.2.0/json-mode.el +++ b/elpa/json-mode-20151116.2000/json-mode.el @@ -1,10 +1,12 @@ ;;; json-mode.el --- Major mode for editing JSON files -;; Copyright (C) 2011-2013 Josh Johnston +;; Copyright (C) 2011-2014 Josh Johnston ;; Author: Josh Johnston ;; URL: https://github.com/joshwnj/json-mode -;; Version: 1.2.0 +;; Package-Version: 20151116.2000 +;; Version: 1.6.0 +;; Package-Requires: ((json-reformat "0.0.5") (json-snatcher "1.0.0")) ;; 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 @@ -27,6 +29,8 @@ (require 'js) (require 'rx) +(require 'json-snatcher) +(require 'json-reformat) (defconst json-mode-quoted-string-re (rx (group (char ?\") @@ -57,30 +61,6 @@ ) "Level one font lock.") -(defconst json-mode-beautify-command-python2 - "python2 -c \"import sys,json,collections; data=json.loads(sys.stdin.read(),object_pairs_hook=collections.OrderedDict); print json.dumps(data,sort_keys=%s,indent=4,separators=(',',': ')).decode('unicode_escape').encode('utf8','replace')\"") -(defconst json-mode-beautify-command-python3 - "python3 -c \"import sys,json,codecs,collections; data=json.loads(sys.stdin.read(),object_pairs_hook=collections.OrderedDict); print((codecs.getdecoder('unicode_escape')(json.dumps(data,sort_keys=%s,indent=4,separators=(',',': '))))[0])\"") - -;;;###autoload -(defun json-mode-beautify (&optional preserve-key-order) - "Beautify / pretty-print from BEG to END, and optionally PRESERVE-KEY-ORDER." - (interactive "P") - (shell-command-on-region (if (use-region-p) (region-beginning) (point-min)) - (if (use-region-p) (region-end) (point-max)) - (concat (if (executable-find "env") "env " "") - (format (if (executable-find "python2") - json-mode-beautify-command-python2 - json-mode-beautify-command-python3) - (if preserve-key-order "False" "True"))) - (current-buffer) t)) - -;;;###autoload -(defun json-mode-beautify-ordered () - "Beautify / pretty-print from BEG to END preserving key order." - (interactive) - (json-mode-beautify t)) - ;;;###autoload (define-derived-mode json-mode javascript-mode "JSON" "Major mode for editing JSON files" @@ -88,8 +68,37 @@ ;;;###autoload (add-to-list 'auto-mode-alist '("\\.json$" . json-mode)) +(add-to-list 'auto-mode-alist '("\\.jsonld$" . json-mode)) + +;;;###autoload +(defun json-mode-show-path () + (interactive) + (let ((temp-name "*json-path*")) + (with-output-to-temp-buffer temp-name (jsons-print-path)) + + (let ((temp-window (get-buffer-window temp-name))) + ;; delete the window if we have one, + ;; so we can recreate it in the correct position + (if temp-window + (delete-window temp-window)) + + ;; always put the temp window below the json window + (set-window-buffer (split-window-below) temp-name)) + )) + +(define-key json-mode-map (kbd "C-c C-p") 'json-mode-show-path) + +;;;###autoload +(defun json-mode-beautify () + "Beautify / pretty-print the active region (or the entire buffer if no active region)." + (interactive) + (let ((json-reformat:indent-width js-indent-level)) + (if (use-region-p) + (json-reformat-region (region-beginning) (region-end)) + (json-reformat-region (buffer-end -1) (buffer-end 1))))) (define-key json-mode-map (kbd "C-c C-f") 'json-mode-beautify) + (provide 'json-mode) ;;; json-mode.el ends here diff --git a/elpa/json-reformat-20160212.53/json-reformat-autoloads.el b/elpa/json-reformat-20160212.53/json-reformat-autoloads.el new file mode 100644 index 0000000..c13b725 --- /dev/null +++ b/elpa/json-reformat-20160212.53/json-reformat-autoloads.el @@ -0,0 +1,26 @@ +;;; json-reformat-autoloads.el --- automatically extracted autoloads +;; +;;; Code: +(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) + +;;;### (autoloads nil "json-reformat" "json-reformat.el" (22297 19820 +;;;;;; 80031 157000)) +;;; Generated autoloads from json-reformat.el + +(autoload 'json-reformat-region "json-reformat" "\ +Reformat the JSON in the specified region. + +If you want to customize the reformat style, +please see the documentation of `json-reformat:indent-width' +and `json-reformat:pretty-string?'. + +\(fn BEGIN END)" t nil) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; End: +;;; json-reformat-autoloads.el ends here diff --git a/elpa/json-reformat-20160212.53/json-reformat-pkg.el b/elpa/json-reformat-20160212.53/json-reformat-pkg.el new file mode 100644 index 0000000..30ebfcc --- /dev/null +++ b/elpa/json-reformat-20160212.53/json-reformat-pkg.el @@ -0,0 +1 @@ +(define-package "json-reformat" "20160212.53" "Reformatting tool for JSON" 'nil :url "https://github.com/gongo/json-reformat" :keywords '("json")) diff --git a/elpa/json-reformat-20160212.53/json-reformat.el b/elpa/json-reformat-20160212.53/json-reformat.el new file mode 100644 index 0000000..4bc0142 --- /dev/null +++ b/elpa/json-reformat-20160212.53/json-reformat.el @@ -0,0 +1,221 @@ +;;; json-reformat.el --- Reformatting tool for JSON + +;; Author: Wataru MIYAGUNI +;; URL: https://github.com/gongo/json-reformat +;; Package-Version: 20160212.53 +;; Version: 0.0.6 +;; Keywords: json + +;; Copyright (c) 2012 Wataru MIYAGUNI +;; +;; MIT License +;; +;; Permission is hereby granted, free of charge, to any person obtaining +;; a copy of this software and associated documentation files (the +;; "Software"), to deal in the Software without restriction, including +;; without limitation the rights to use, copy, modify, merge, publish, +;; distribute, sublicense, and/or sell copies of the Software, and to +;; permit persons to whom the Software is furnished to do so, subject to +;; the following conditions: +;; +;; The above copyright notice and this permission notice shall be +;; included in all copies or substantial portions of the Software. +;; +;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + + +;;; Commentary: + +;; json-reformat.el is a reformatting tool for JSON (http://json.org/). +;; +;; ## Usage +;; +;; 1. Specify region +;; 2. Call 'M-x json-reformat-region' +;; +;; ## Customize +;; +;; - `json-reformat:indent-width' +;; - `json-reformat:pretty-string?' +;; + +;;; Code: + +(require 'json) +(eval-when-compile (require 'cl)) + +(unless (require 'subr-x nil t) + ;; built-in subr-x from 24.4 + (defsubst hash-table-keys (hash-table) + "Return a list of keys in HASH-TABLE." + (let ((keys '())) + (maphash (lambda (k _v) (push k keys)) hash-table) + keys))) + +(put 'json-reformat-error 'error-message "JSON Reformat error") +(put 'json-reformat-error 'error-conditions '(json-reformat-error error)) + +(defconst json-reformat:special-chars-as-pretty-string + '((?\" . ?\") + (?\\ . ?\\))) + +(defcustom json-reformat:indent-width 4 + "How much indentation `json-reformat-region' should do at each level." + :type 'integer + :safe #'integerp + :group 'json-reformat) + +(defcustom json-reformat:pretty-string? nil + "Whether to decode the string. + +Example: + +{\"name\":\"foobar\",\"nick\":\"foo \\u00e4 bar\",\"description\":\"
\\nbaz\\n
\"} + +If nil: + + { + \"name\": \"foobar\", + \"nick\": \"foo \\u00e4 bar\", + \"description\": \"
\\nbaz\\n<\\/pre>\"
+    }
+
+Else t:
+
+    {
+        \"name\": \"foobar\",
+        \"nick\": \"foo ä bar\",
+        \"description\": \"
+    baz
+    
\"
+    }"
+  :type 'boolean
+  :safe #'booleanp
+  :group 'json-reformat)
+
+(defun json-reformat:indent (level)
+  (make-string (* level json-reformat:indent-width) ? ))
+
+(defun json-reformat:number-to-string (val)
+  (number-to-string val))
+
+(defun json-reformat:symbol-to-string (val)
+  (cond ((equal 't val) "true")
+        ((equal json-false val) "false")
+        (t (symbol-name val))))
+
+(defun json-reformat:encode-char-as-pretty (char)
+  (setq char (encode-char char 'ucs))
+  (let ((special-char (car (rassoc char json-reformat:special-chars-as-pretty-string))))
+    (if special-char
+        (format "\\%c" special-char)
+      (format "%c" char))))
+
+(defun json-reformat:string-to-string (val)
+  (if json-reformat:pretty-string?
+      (format "\"%s\"" (mapconcat 'json-reformat:encode-char-as-pretty val ""))
+    (json-encode-string val)))
+
+(defun json-reformat:vector-to-string (val level)
+  (if (= (length val) 0) "[]"
+    (concat "[\n"
+            (mapconcat
+             'identity
+             (loop for v across val
+                   collect (concat
+                            (json-reformat:indent (1+ level))
+                            (json-reformat:print-node v (1+ level))
+                            ))
+             (concat ",\n"))
+            "\n" (json-reformat:indent level) "]"
+            )))
+
+(defun json-reformat:print-node (val level)
+  (cond ((hash-table-p val) (json-reformat:tree-to-string (json-reformat:tree-sibling-to-plist val) level))
+        ((numberp val)      (json-reformat:number-to-string val))
+        ((vectorp val)      (json-reformat:vector-to-string val level))
+        ((null val)         "null")
+        ((symbolp val)      (json-reformat:symbol-to-string val))
+        (t                  (json-reformat:string-to-string val))))
+
+(defun json-reformat:tree-sibling-to-plist (root)
+  (let (pl)
+    (dolist (key (reverse (hash-table-keys root)) pl)
+      (setq pl (plist-put pl key (gethash key root))))))
+
+(defun json-reformat:tree-to-string (root level)
+  (concat "{\n"
+          (let (key val str)
+            (while root
+              (setq key (car root)
+                    val (cadr root)
+                    root (cddr root))
+              (setq str
+                    (concat str (json-reformat:indent (1+ level))
+                            "\"" key "\""
+                            ": "
+                            (json-reformat:print-node val (1+ level))
+                            (when root ",")
+                            "\n"
+                            )))
+            str)
+          (json-reformat:indent level)
+          "}"))
+
+(defun json-reformat-from-string (string)
+  (with-temp-buffer
+    (insert string)
+    (goto-char (point-min))
+    (condition-case errvar
+        (let ((json-key-type 'string)
+              (json-object-type 'hash-table)
+              json-tree)
+          (setq json-tree (json-read))
+          (json-reformat:print-node json-tree 0))
+      (json-error
+       (signal 'json-reformat-error
+               (list (error-message-string errvar)
+                     (line-number-at-pos (point))
+                     (point)))))))
+
+;;;###autoload
+(defun json-reformat-region (begin end)
+  "Reformat the JSON in the specified region.
+
+If you want to customize the reformat style,
+please see the documentation of `json-reformat:indent-width'
+and `json-reformat:pretty-string?'."
+  (interactive "*r")
+  (let ((start-line (line-number-at-pos begin))
+        (start-pos  begin))
+    (save-excursion
+      (save-restriction
+        (narrow-to-region begin end)
+        (goto-char (point-min))
+        (let (reformatted)
+          (condition-case errvar
+              (progn
+                (setq reformatted
+                      (json-reformat-from-string
+                       (buffer-substring-no-properties (point-min) (point-max))))
+                (delete-region (point-min) (point-max))
+                (insert reformatted))
+            (json-reformat-error
+             (let ((reason   (nth 1 errvar))
+                   (line     (nth 2 errvar))
+                   (position (nth 3 errvar)))
+               (message
+                "JSON parse error [Reason] %s [Position] In buffer, line %d (char %d)"
+                reason
+                (+ start-line line -1)
+                (+ start-pos position -1))))))))))
+
+(provide 'json-reformat)
+
+;;; json-reformat.el ends here
diff --git a/elpa/json-snatcher-20150511.2047/json-snatcher-autoloads.el b/elpa/json-snatcher-20150511.2047/json-snatcher-autoloads.el
new file mode 100644
index 0000000..9825131
--- /dev/null
+++ b/elpa/json-snatcher-20150511.2047/json-snatcher-autoloads.el
@@ -0,0 +1,22 @@
+;;; json-snatcher-autoloads.el --- automatically extracted autoloads
+;;
+;;; Code:
+(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
+
+;;;### (autoloads nil "json-snatcher" "json-snatcher.el" (22297 19818
+;;;;;;  764054 693000))
+;;; Generated autoloads from json-snatcher.el
+
+(autoload 'jsons-print-path "json-snatcher" "\
+Print the path to the JSON value under point, and save it in the kill ring.
+
+\(fn)" t nil)
+
+;;;***
+
+;; Local Variables:
+;; version-control: never
+;; no-byte-compile: t
+;; no-update-autoloads: t
+;; End:
+;;; json-snatcher-autoloads.el ends here
diff --git a/elpa/json-snatcher-20150511.2047/json-snatcher-pkg.el b/elpa/json-snatcher-20150511.2047/json-snatcher-pkg.el
new file mode 100644
index 0000000..6530e39
--- /dev/null
+++ b/elpa/json-snatcher-20150511.2047/json-snatcher-pkg.el
@@ -0,0 +1 @@
+(define-package "json-snatcher" "20150511.2047" "Grabs the path to JSON values in a JSON file" '((emacs "24")) :url "http://github.com/sterlingg/json-snatcher")
diff --git a/elpa/json-snatcher-20150511.2047/json-snatcher.el b/elpa/json-snatcher-20150511.2047/json-snatcher.el
new file mode 100644
index 0000000..61fb713
--- /dev/null
+++ b/elpa/json-snatcher-20150511.2047/json-snatcher.el
@@ -0,0 +1,351 @@
+;;; json-snatcher.el --- Grabs the path to JSON values in a JSON file -*- lexical-binding: t -*-
+
+;; Copyright (C) 2013 Sterling Graham 
+
+;; Author: Sterling Graham 
+;; URL: http://github.com/sterlingg/json-snatcher
+;; Package-Version: 20150511.2047
+;; Version: 1.0
+;; Package-Requires: ((emacs "24"))
+
+;; This file is not part of GNU Emacs.
+
+;;; Commentary:
+;;
+;; Well this was my first excursion into ELisp programmming.  It didn't go too badly once
+;; I fiddled around with a bunch of the functions.
+;;
+;; The process of getting the path to a JSON value at point starts with
+;; a call to the jsons-print-path function.
+;;
+;; It works by parsing the current buffer into a list of parse tree nodes
+;; if the buffer hasn't already been parsed in the current Emacs session.
+;; While parsing, the region occupied by the node is recorded into the
+;; jsons-parsed-regions hash table as a list.The list contains the location
+;; of the first character occupied by the node, the location of the last
+;; character occupied, and the path to the node.  The parse tree is also stored
+;; in the jsons-parsed list for possible future use.
+;;
+;; Once the buffer has been parsed, the node at point is looked up in the
+;; jsons-curr-region list, which is the list of regions described in the
+;; previous paragraph for the current buffer.  If point is not in one of these
+;; interval ranges nil is returned, otherwise the path to the value is returned
+;; in the form [] for objects, and [] for arrays.
+;; eg: ['value1'][0]['value2'] gets the array at with name value1, then gets the
+;; 0th element of the array (another object), then gets the value at 'value2'.
+;;
+
+;;; Installation:
+;;
+;; IMPORTANT: Works ONLY in Emacs 24 due to the use of the lexical-binding variable.
+;;
+;; To install add the json-snatcher.el file to your load-path, and
+;; add the following lines to your .emacs file:
+;;(require 'json-snatcher)
+;; (defun js-mode-bindings ()
+;;   "Sets a hotkey for using the json-snatcher plugin."
+;;   (when (string-match  "\\.json$" (buffer-name))
+;;       (local-set-key (kbd "C-c C-g") 'jsons-print-path)))
+;; (add-hook 'js-mode-hook 'js-mode-bindings)
+;; (add-hook 'js2-mode-hook 'js-mode-bindings)
+;;
+;; This binds the key to snatch the path to the JSON value to C-c C-g only
+;; when either JS mode, or JS2 mode is active on a buffer ending with
+;; the .json extension.
+
+;;; 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
+;; 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 GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Code:
+
+
+(defvar jsons-curr-token 0
+  "The current character in the buffer being parsed.")
+(defvar jsons-parsed (make-hash-table :test 'equal)
+  "Hashes each open buffer to the parse tree for that buffer.")
+(defvar jsons-parsed-regions (make-hash-table :test 'equal)
+  "Hashes each open buffer to the ranges in the buffer for each of the parse trees nodes.")
+(defvar jsons-curr-region () "The node ranges in the current buffer.")
+(defvar jsons-path-printer 'jsons-print-path-python "Default jsons path printer")
+(add-hook 'kill-buffer-hook 'jsons-remove-buffer)
+
+(defun jsons-consume-token ()
+  "Return the next token in the stream."
+  (goto-char jsons-curr-token)
+  (let* ((delim_regex "\\([\][\\{\\}:,]\\)")
+         ;; TODO: Improve this regex. Although now it SEEMS to be working, and can be
+         ;; used to validate escapes if needed later. The second half of the string regex is pretty
+         ;; pointless at the moment. I did it this way, so that the code closely mirrors
+         ;; the RFC.
+         (string_regex "\\(\"\\(\\([^\"\\\\\r\s\t\n]\\)*\\([\r\s\t\n]\\)*\\|\\(\\(\\\\\\\\\\)*\\\\\\(\\([^\r\s\t\n]\\|\\(u[0-9A-Fa-f]\\{4\\}\\)\\)\\)\\)\\)+\"\\)")
+         (num_regex "\\(-?\\(0\\|\\([1-9][[:digit:]]*\\)\\)\\(\\.[[:digit:]]+\\)?\\([eE][-+]?[[:digit:]]+\\)?\\)")
+         (literal_regex "\\(true\\|false\\|null\\)")
+         (full_regex (concat "\\(" delim_regex "\\|" literal_regex "\\|" string_regex "\\|" num_regex "\\)")))
+
+    (if (re-search-forward full_regex (point-max) "Not nil")
+        (progn
+          (setq jsons-curr-token (match-end 0))
+          (buffer-substring-no-properties (match-beginning 0) (match-end 0)))
+      (message "Reached EOF. Possibly invalid JSON."))))
+
+(defun jsons-array (path)
+  "Create a new json array object that contain the identifier \"json-array\".
+a list of the elements contained in the array, and the PATH to the array."
+  (let*(
+        (token (jsons-consume-token))
+        (array "json-array")
+        (elements ())
+        (i 0))
+    (while (not (string= token "]"))
+      (if (not (string= token ","))
+          (let ((json-val (jsons-value token path i)))
+            (setq i (+ i 1))
+            (push json-val elements)
+            (setq token (jsons-consume-token)))
+        (setq token (jsons-consume-token))))
+    (list array (reverse elements) path)))
+
+(defun jsons-literal (token path)
+  "Given a TOKEN and PATH, this function return the PATH to the literal."
+  (let ((match_start (match-beginning 0))
+        (match_end (match-end 0)))
+    (progn
+      (setq jsons-curr-region (append (list (list match_start match_end path)) jsons-curr-region))
+      (list "json-literal" token path (list match_start match_end)))))
+
+(defun jsons-member (token path)
+  "This function is called when a member in a JSON object needs to be parsed.
+Given the current TOKEN, and the PATH to this member."
+  (let* ((member ())
+         (value token)
+         (range_start (match-beginning 0))
+         (range_end (match-end 0))
+         )
+    (setq member (list "json-member" token))
+    (if (not (string= (jsons-consume-token) ":"))
+        (error "Encountered token other than : in jsons-member")
+      nil)
+    (let ((json-val (jsons-value (jsons-consume-token) (cons value path) nil)))
+      (setq member (list member (append json-val
+                                        (list range_start range_end))))
+      (setq jsons-curr-region (append (list (list range_start range_end (elt json-val 2))) jsons-curr-region))
+    member)))
+
+(defun jsons-number (token path)
+  "This function will return a json-number given by the current TOKEN.
+PATH points to the path to this number.  A json-number is defined as per
+the num_regex in the `jsons-get-tokens' function."
+  (progn
+    (setq jsons-curr-region (append (list (list (match-beginning 0) (match-end 0) path)) jsons-curr-region))
+    (list "json-number" token path)))
+
+(defun jsons-object (path)
+  "This function is called when a { is encountered while parsing.
+PATH is the path in the tree to this object."
+  (let*(
+        (token (jsons-consume-token))
+        (members (make-hash-table :test 'equal))
+        (object (list "json-object" members path)))
+    (while (not (string= token "}"))
+      (if (not (string= token ","))
+          (let ((json-mem (jsons-member token path)))
+            (puthash (elt (elt json-mem 0) 1) (elt json-mem 1) (elt object 1))
+            (setq token (jsons-consume-token)))
+        (setq token (jsons-consume-token))))
+    object))
+
+(defun jsons-string (token path)
+  "This function is called when a string is encountered while parsing.
+The TOKEN is the current token being examined.
+The PATH is the path to this string."
+(let ((match_start (match-beginning 0))
+      (match_end (match-end 0)))
+  (progn
+    (setq jsons-curr-region (append (list (list match_start match_end path)) jsons-curr-region))
+  (list "json-string" token path (list match_start match_end)))))
+
+(defun jsons-value (token path array-index)
+  "A value, which is either an object, array, string, number, or literal.
+The is-array variable is nil if inside an array, or the index in
+the array that it occupies.
+TOKEN is the current token being parsed.
+PATH is the path to this value.
+ARRAY-INDEX is non-nil if the value is contained within an array, and
+points to the index of this value in the containing array."
+;;TODO: Refactor the if array-index statement.
+  (if array-index
+      (if (jsons-is-number token)
+          (list "json-value" (jsons-number token (cons array-index path)) (list (match-beginning 0) (match-end 0)))
+        (cond
+         ((string= token "{") (jsons-object (cons array-index path)))
+         ((string= token "[") (jsons-array (cons array-index path)))
+         ((string= (substring token 0 1) "\"") (jsons-string token (cons array-index path)))
+         (t (jsons-literal token (cons array-index path)))))
+    (if (jsons-is-number token)
+        (list "json-value" (jsons-number token path) path (list (match-beginning 0) (match-end 0)))
+      (cond
+       ((string= token "{") (jsons-object path))
+       ((string= token "[") (jsons-array path))
+       ((string= (substring token 0 1) "\"") (jsons-string token path))
+       (t (jsons-literal token path))))))
+
+
+(defun jsons-get-path ()
+  "Function to check whether we can grab the json path from the cursor position in the json file."
+  (let ((i 0)
+        (node nil))
+    (setq jsons-curr-region (gethash (current-buffer) jsons-parsed-regions))
+    (when (not (gethash (current-buffer) jsons-parsed))
+      (jsons-parse))
+    (while (< i (length jsons-curr-region))
+      (let*
+          ((json_region (elt jsons-curr-region i))
+           (min_token (elt json_region 0))
+           (max_token (elt json_region 1)))
+        (when (and (> (point) min_token) (< (point) max_token))
+          (setq node (elt json_region 2))))
+      (setq i (+ i 1)))
+    node))
+
+(defun jsons-is-number (str)
+  "Test to see whether STR is a valid JSON number."
+  (progn
+    (match-end 0)
+    (save-match-data
+      (if (string-match "^\\(-?\\(0\\|\\([1-9][[:digit:]]*\\)\\)\\(\\.[[:digit:]]+\\)?\\([eE][-+]?[[:digit:]]+\\)?\\)$" str)
+          (progn
+            (match-end 0)
+            t)
+        nil))))
+
+(defun jsons-parse ()
+  "Parse the file given in file, return a list of nodes representing the file."
+  (save-excursion
+    (setq jsons-curr-token 0)
+    (setq jsons-curr-region ())
+    (if (not (gethash (current-buffer) jsons-parsed))
+        (let* ((token (jsons-consume-token))
+               (return_val nil))
+          (cond
+           ((string= token "{") (setq return_val (jsons-object ())))
+           ((string= token "[") (setq return_val (jsons-array ())))
+           (t nil))
+          (puthash (current-buffer) return_val jsons-parsed)
+          (puthash (current-buffer) jsons-curr-region jsons-parsed-regions)
+          return_val)
+      (gethash (current-buffer) jsons-parsed))))
+
+(defun jsons-print-to-buffer (node buffer)
+  "Prints the given NODE to the BUFFER specified in buffer argument.
+TODO: Remove extra comma printed after lists of object members, and lists of array members."
+  (let ((id (elt node 0)))
+    (cond
+     ((string= id "json-array")
+      (progn
+        (jsons-put-string buffer "[")
+        (mapc (lambda (x) (progn
+                            (jsons-print-to-buffer buffer x)
+                            (jsons-put-string buffer ",") )) (elt node 1))
+        (jsons-put-string buffer "]")))
+     ((string= id "json-literal")
+      (jsons-put-string buffer (elt node 1)))
+     ((string= id "json-member")
+      (jsons-put-string buffer (elt node 1))
+      (jsons-put-string buffer ": ")
+      (jsons-print-to-buffer buffer (elt node 2)))
+     ((string= id "json-number")
+      (jsons-put-string buffer (elt node 1)))
+     ((string= id "json-object")
+      (progn
+        (jsons-put-string buffer "{")
+        (maphash (lambda (key value)
+                   (progn
+                     (jsons-put-string buffer key)
+                     (jsons-put-string buffer ":")
+                     (jsons-print-to-buffer buffer value)
+                     (jsons-put-string buffer ","))) (elt node 1))
+      (jsons-put-string buffer "}")))
+     ((string= id "json-string")
+      (jsons-put-string buffer (elt node 1)))
+     ((string= id "json-value")
+      (jsons-print-to-buffer buffer (elt node 1)))
+     (t nil))))
+
+(defun jsons-print-path-jq ()
+  "Print the jq path to the JSON value under point, and save it in the kill ring."
+  (let* ((path (jsons-get-path))
+         (i 0)
+         (jq_str ".")
+         key)
+    (setq path (reverse path))
+    (while (< i (length path))
+      (if (numberp (elt path i))
+          (progn
+            (setq jq_str (concat jq_str "[" (number-to-string (elt path i)) "]"))
+            (setq i (+ i 1)))
+        (progn
+          (setq key (elt path i))
+          (setq jq_str (concat jq_str (substring key 1 (- (length key) 1))))
+          (setq i (+ i 1))))
+      (when (elt path i)
+        (unless (numberp (elt path i))
+          (setq jq_str (concat jq_str ".")))))
+    (progn (kill-new jq_str)
+           (princ jq_str))))
+
+(defun jsons-print-path-python ()
+  "Print the python path to the JSON value under point, and save it in the kill ring."
+  (let ((path (jsons-get-path))
+        (i 0)
+        (python_str ""))
+    (setq path (reverse path))
+    (while (< i (length path))
+      (if (numberp (elt path i))
+          (progn
+            (setq python_str (concat python_str "[" (number-to-string (elt path i)) "]"))
+            (setq i (+ i 1)))
+        (progn
+          (setq python_str (concat python_str "[" (elt path i) "]"))
+          (setq i (+ i 1)))))
+    (progn (kill-new python_str)
+           (princ python_str))))
+
+;;;###autoload
+(defun jsons-print-path ()
+  "Print the path to the JSON value under point, and save it in the kill ring."
+  (interactive)
+  (funcall jsons-path-printer))
+
+(defun jsons-put-string (buffer str)
+  "Append STR to the BUFFER specified in the argument."
+    (save-current-buffer
+      (set-buffer (get-buffer-create buffer))
+      (insert (prin1-to-string str t))))
+
+(defun jsons-remove-buffer ()
+  "Used to clean up the token regions, and parse tree used by the parser."
+  (progn
+    (remhash (current-buffer) jsons-parsed)
+    (remhash (current-buffer) jsons-parsed-regions)))
+
+(provide 'json-snatcher)
+
+;; Local-Variables:
+;; indent-tabs-mode: nil
+;; End:
+
+;;; json-snatcher.el ends here
diff --git a/elpa/magit-20160223.828/magit.info b/elpa/magit-20160223.828/magit.info
deleted file mode 100644
index 38c95e2..0000000
--- a/elpa/magit-20160223.828/magit.info
+++ /dev/null
@@ -1,164 +0,0 @@
-This is magit.info, produced by makeinfo version 5.2 from magit.texi.
-
-Magit is an interface to the version control system Git, implemented as
-an Emacs package.  Magit aspires to be a complete Git porcelain.  While
-we cannot (yet) claim that Magit wraps and improves upon each and every
-Git command, it is complete enough to allow even experienced Git users
-to perform almost all of their daily version control tasks directly from
-within Emacs.  While many fine Git clients exist, only Magit and Git
-itself deserve to be called porcelains.
-
-     Copyright (C) 2015-2016 Jonas Bernoulli 
-
-     You can redistribute this document 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 document 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.
-INFO-DIR-SECTION Emacs
-START-INFO-DIR-ENTRY
-* Magit: (magit).       Using Git from Emacs with Magit.
-END-INFO-DIR-ENTRY
-
-
-Indirect:
-magit.info-1: 1222
-magit.info-2: 316256
-
-Tag Table:
-(Indirect)
-Node: Top1222
-Node: Introduction5928
-Node: Installation10621
-Node: Updating from an older release10996
-Node: Installing from an Elpa archive12591
-Node: Installing from the Git repository13930
-Node: Post-installation tasks16726
-Node: Getting started18115
-Node: Interface concepts23850
-Node: Modes and Buffers24124
-Node: Switching Buffers25870
-Node: Naming Buffers28934
-Node: Quitting Windows31769
-Node: Automatic Refreshing of Magit Buffers33401
-Node: Automatic Saving of File-Visiting Buffers36169
-Node: Automatic Reverting of File-Visiting Buffers37354
-Node: Risk of Reverting Automatically42350
-Node: Sections44733
-Node: Section movement45674
-Node: Section visibility49601
-Node: Section hooks53192
-Node: Section types and values55473
-Node: Section options56743
-Node: Popup buffers and prefix commands57215
-Node: Completion and confirmation58529
-Node: Running Git61435
-Node: Viewing Git output61671
-Node: Running Git manually62671
-Node: Git executable64797
-Node: Global Git arguments66804
-Node: Inspecting67611
-Node: Status buffer68738
-Node: Status sections71261
-Node: Status header sections76008
-Node: Status options78567
-Node: Logging79291
-Node: Refreshing logs81820
-Node: Log Buffer83205
-Node: Select from log86294
-Node: Reflog87234
-Node: Diffing87712
-Node: Refreshing diffs90524
-Node: Diff buffer93505
-Node: Diff options95407
-Node: Revision buffer97039
-Node: Ediffing97994
-Node: References buffer101043
-Node: References sections105753
-Node: Bisecting106628
-Node: Visiting blobs108124
-Node: Blaming108633
-Node: Manipulating111953
-Node: Repository setup112245
-Node: Staging and unstaging113285
-Node: Staging from file-visiting buffers117180
-Node: Applying118348
-Node: Committing119991
-Node: Initiating a commit120574
-Node: Editing commit messages123886
-Node: Branching134282
-Node: Merging147096
-Node: Rebasing149180
-Node: Editing rebase sequences152128
-Node: Rebase sequence log155162
-Node: Cherry picking161906
-Node: Reverting163512
-Node: Resetting164875
-Node: Stashing166385
-Node: Transferring169530
-Node: Remotes169768
-Node: Fetching171054
-Node: Pulling172148
-Node: Pushing172994
-Node: Creating and sending patches177443
-Node: Applying patches178138
-Node: Miscellaneous179136
-Node: Tagging179427
-Node: Notes180212
-Node: Submodules182737
-Node: Common commands184057
-Node: Wip modes185805
-Node: Minor mode for buffers visiting files192541
-Node: Minor mode for buffers visiting blobs194684
-Node: Customizing195489
-Node: Per-repository configuration197161
-Node: Essential settings198795
-Node: Safety199119
-Node: Performance200952
-Node: Committing Performance207625
-Node: Plumbing208606
-Node: Calling Git209234
-Node: Getting a value from Git210757
-Node: Calling Git for effect213861
-Node: Section plumbing220365
-Node: Creating sections220593
-Node: Section selection224396
-Node: Matching sections226076
-Node: Refreshing buffers231278
-Node: Conventions234413
-Node: Confirmation and completion234590
-Node: Theming Faces235488
-Node: FAQ243639
-Node: Magit is slow244972
-Node: I changed several thousand files at once and now Magit is unusable245173
-Node: I am having problems committing245889
-Node: I don't understand how branching and pushing work246347
-Node: I don't like the key binding in v24246716
-Node: I cannot install the pre-requisites for Magit v2247055
-Node: I am using an Emacs release older than v244247520
-Node: I am using a Git release older than v194249133
-Node: I am using MS Windows and cannot push with Magit250120
-Node: How to install the gitman info manual?250699
-Node: How can I show Git's output?253227
-Node: Expanding a file to show the diff causes it to disappear254039
-Node: Point is wrong in the COMMIT_EDITMSG buffer254565
-Node: Can Magit be used as ediff-version-control-package?255583
-Node: How to show diffs for gpg-encrypted files?257607
-Node: Emacs 245 hangs when loading Magit258198
-Node: Symbol's value as function is void --some258767
-Node: Where is the branch manager259087
-Node: Keystroke Index259372
-Node: Command Index286718
-Node: Function Index316256
-Node: Variable Index328039
-
-End Tag Table
-
-
-Local Variables:
-coding: utf-8
-End:
diff --git a/elpa/magit-20160223.828/AUTHORS.md b/elpa/magit-20160421.459/AUTHORS.md
similarity index 97%
rename from elpa/magit-20160223.828/AUTHORS.md
rename to elpa/magit-20160421.459/AUTHORS.md
index 9dff861..71b5537 100644
--- a/elpa/magit-20160223.828/AUTHORS.md
+++ b/elpa/magit-20160421.459/AUTHORS.md
@@ -77,10 +77,12 @@ Contributors
 - Craig Andera 
 - Dale Hagglund 
 - Damien Cassou 
+- Dan Erikson 
 - Daniel Brockman 
 - Daniel Farina 
 - Daniel Hackney 
 - Dan LaManna 
+- Dato Simó 
 - David Abrahams 
 - David Hull 
 - David L. Rager 
@@ -95,6 +97,7 @@ Contributors
 - Felix Geller 
 - Feng Li 
 - Florian Ragwitz 
+- Fritz Grabo 
 - Geoff Shannon 
 - George Kadianakis 
 - Graham Clark 
@@ -132,7 +135,7 @@ Contributors
 - Lingchao Xin 
 - Lluís Vilanova 
 - Loic Dachary 
-- Luís Borges de Oliveira 
+- Luís Oliveira 
 - Luke Amdor 
 - Manuel Vázquez Acosta 
 - Marcel Wolf 
@@ -197,6 +200,7 @@ Contributors
 - Ron Parker 
 - Roy Crihfield 
 - Rüdiger Sonderfeld 
+- Russell Black 
 - Ryan C. Thompson 
 - Samuel Bronson 
 - Sanjoy Das 
diff --git a/elpa/magit-20160223.828/COPYING b/elpa/magit-20160421.459/COPYING
similarity index 100%
rename from elpa/magit-20160223.828/COPYING
rename to elpa/magit-20160421.459/COPYING
diff --git a/elpa/magit-20160223.828/dir b/elpa/magit-20160421.459/dir
similarity index 100%
rename from elpa/magit-20160223.828/dir
rename to elpa/magit-20160421.459/dir
diff --git a/elpa/magit-20160223.828/git-rebase.el b/elpa/magit-20160421.459/git-rebase.el
similarity index 98%
rename from elpa/magit-20160223.828/git-rebase.el
rename to elpa/magit-20160421.459/git-rebase.el
index fd60718..ba9e291 100644
--- a/elpa/magit-20160223.828/git-rebase.el
+++ b/elpa/magit-20160421.459/git-rebase.el
@@ -69,6 +69,11 @@
 (require 'with-editor)
 (require 'magit)
 
+(and (require 'async-bytecomp nil t)
+     (memq 'magit (bound-and-true-p async-bytecomp-allowed-packages))
+     (fboundp 'async-bytecomp-package-mode)
+     (async-bytecomp-package-mode 1))
+
 (eval-when-compile (require 'recentf))
 
 ;;; Options
@@ -383,7 +388,9 @@ running 'man git-rebase' at the command line) for details."
   (setq-local redisplay-highlight-region-function 'git-rebase-highlight-region)
   (setq-local redisplay-unhighlight-region-function 'git-rebase-unhighlight-region)
   (add-hook 'with-editor-pre-cancel-hook  'git-rebase-autostash-save  nil t)
-  (add-hook 'with-editor-post-cancel-hook 'git-rebase-autostash-apply nil t))
+  (add-hook 'with-editor-post-cancel-hook 'git-rebase-autostash-apply nil t)
+  (when (boundp 'save-place)
+    (setq save-place nil)))
 
 (defun git-rebase-cancel-confirm (force)
   (or (not (buffer-modified-p)) force (y-or-n-p "Abort this rebase? ")))
diff --git a/elpa/magit-20160223.828/magit-apply.el b/elpa/magit-20160421.459/magit-apply.el
similarity index 96%
rename from elpa/magit-20160223.828/magit-apply.el
rename to elpa/magit-20160421.459/magit-apply.el
index 996ee8a..d1770ad 100644
--- a/elpa/magit-20160223.828/magit-apply.el
+++ b/elpa/magit-20160421.459/magit-apply.el
@@ -35,7 +35,6 @@
 (require 'magit-wip)
 
 ;; For `magit-apply'
-(declare-function magit-anti-stage 'magit-rockstar)
 (declare-function magit-am-popup 'magit-sequence)
 ;; For `magit-discard-files'
 (declare-function magit-checkout-stage 'magit)
@@ -56,7 +55,7 @@
   "Whether unstaging a committed change reverts it instead.
 
 A committed change cannot be unstaged, because staging and
-unstaging are actions that are concern with the differences
+unstaging are actions that are concerned with the differences
 between the index and the working tree, not with committed
 changes.
 
@@ -87,22 +86,26 @@ With a prefix argument and if necessary, attempt a 3-way merge."
       (`(,_   file) (magit-apply-diff   it args))
       (`(,_  files) (magit-apply-diffs  it args)))))
 
+(defun magit-apply--section-content (section)
+  (buffer-substring-no-properties (if (eq (magit-section-type section) 'hunk)
+                                      (magit-section-start section)
+                                    (magit-section-content section))
+                                  (magit-section-end section)))
+
 (defun magit-apply-diffs (sections &rest args)
   (setq sections (magit-apply--get-diffs sections))
   (magit-apply-patch sections args
                      (mapconcat
                       (lambda (s)
                         (concat (magit-diff-file-header s)
-                                (buffer-substring (magit-section-content s)
-                                                  (magit-section-end s))))
+                                (magit-apply--section-content s)))
                       sections "")))
 
 (defun magit-apply-diff (section &rest args)
   (setq section (car (magit-apply--get-diffs (list section))))
   (magit-apply-patch section args
                      (concat (magit-diff-file-header section)
-                             (buffer-substring (magit-section-content section)
-                                               (magit-section-end section)))))
+                             (magit-apply--section-content section))))
 
 (defun magit-apply-hunks (sections &rest args)
   (let ((section (magit-section-parent (car sections))))
@@ -110,19 +113,15 @@ With a prefix argument and if necessary, attempt a 3-way merge."
       (user-error "Cannot un-/stage resolution hunks.  Stage the whole file"))
     (magit-apply-patch section args
                        (concat (magit-section-diff-header section)
-                               (mapconcat
-                                (lambda (s)
-                                  (buffer-substring (magit-section-start s)
-                                                    (magit-section-end s)))
-                                sections "")))))
+                               (mapconcat 'magit-apply--section-content
+                                          sections "")))))
 
 (defun magit-apply-hunk (section &rest args)
   (when (string-match "^diff --cc" (magit-section-parent-value section))
     (user-error "Cannot un-/stage resolution hunks.  Stage the whole file"))
   (magit-apply-patch (magit-section-parent section) args
                      (concat (magit-diff-file-header section)
-                             (buffer-substring (magit-section-start section)
-                                               (magit-section-end section)))))
+                             (magit-apply--section-content section))))
 
 (defun magit-apply-region (section &rest args)
   (unless (magit-diff-context-p)
diff --git a/elpa/magit-20160223.828/magit-autoloads.el b/elpa/magit-20160421.459/magit-autoloads.el
similarity index 94%
rename from elpa/magit-20160223.828/magit-autoloads.el
rename to elpa/magit-20160421.459/magit-autoloads.el
index 5fe1160..1e210d4 100644
--- a/elpa/magit-20160223.828/magit-autoloads.el
+++ b/elpa/magit-20160421.459/magit-autoloads.el
@@ -3,8 +3,8 @@
 ;;; Code:
 (add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
 
-;;;### (autoloads nil "git-rebase" "git-rebase.el" (22221 60708 733000
-;;;;;;  0))
+;;;### (autoloads nil "git-rebase" "git-rebase.el" (22297 19813 681145
+;;;;;;  600000))
 ;;; Generated autoloads from git-rebase.el
 
 (autoload 'git-rebase-mode "git-rebase" "\
@@ -23,7 +23,7 @@ running 'man git-rebase' at the command line) for details.
 
 ;;;***
 
-;;;### (autoloads nil "magit" "magit.el" (22221 60708 792000 0))
+;;;### (autoloads nil "magit" "magit.el" (22297 19815 953104 965000))
 ;;; Generated autoloads from magit.el
 
 (autoload 'magit-status "magit" "\
@@ -315,7 +315,7 @@ Merge commit REV into the current branch; and edit message.
 Perform the merge and prepare a commit message but let the user
 edit it.
 
-\(git merge --edit [ARGS] rev)
+\(git merge --edit --no-ff [ARGS] rev)
 
 \(fn REV &optional ARGS)" t nil)
 
@@ -324,7 +324,7 @@ Merge commit REV into the current branch; pretending it failed.
 Pretend the merge failed to give the user the opportunity to
 inspect the merge and change the commit message.
 
-\(git merge --no-commit [ARGS] rev)
+\(git merge --no-commit --no-ff [ARGS] rev)
 
 \(fn REV &optional ARGS)" t nil)
 
@@ -339,13 +339,14 @@ Abort the current merge operation.
 \(git merge --abort)
 
 \(fn)" t nil)
+ (autoload 'magit-reset-popup "magit" nil t)
 
 (autoload 'magit-reset-index "magit" "\
 Reset the index to COMMIT.
 Keep the head and working tree as-is, so if COMMIT refers to the
 head this effectively unstages all changes.
 
-\(git reset COMMIT)
+\(git reset COMMIT .)
 
 \(fn COMMIT)" t nil)
 
@@ -456,8 +457,8 @@ Git, and Emacs in the echo area.
 
 ;;;***
 
-;;;### (autoloads nil "magit-apply" "magit-apply.el" (22221 60708
-;;;;;;  751000 0))
+;;;### (autoloads nil "magit-apply" "magit-apply.el" (22297 19814
+;;;;;;  251135 404000))
 ;;; Generated autoloads from magit-apply.el
 
 (autoload 'magit-stage-file "magit-apply" "\
@@ -493,8 +494,8 @@ Remove all changes from the staging area.
 
 ;;;***
 
-;;;### (autoloads nil "magit-autorevert" "magit-autorevert.el" (22221
-;;;;;;  60708 705000 0))
+;;;### (autoloads nil "magit-autorevert" "magit-autorevert.el" (22297
+;;;;;;  19812 575165 378000))
 ;;; Generated autoloads from magit-autorevert.el
 
 (defvar magit-revert-buffers t)
@@ -522,8 +523,8 @@ See `auto-revert-mode' for more information on Auto-Revert mode.
 
 ;;;***
 
-;;;### (autoloads nil "magit-bisect" "magit-bisect.el" (22221 60708
-;;;;;;  745000 0))
+;;;### (autoloads nil "magit-bisect" "magit-bisect.el" (22297 19814
+;;;;;;  112137 891000))
 ;;; Generated autoloads from magit-bisect.el
  (autoload 'magit-bisect-popup "magit-bisect" nil t)
 
@@ -574,8 +575,8 @@ bisect run'.
 
 ;;;***
 
-;;;### (autoloads nil "magit-blame" "magit-blame.el" (22221 60708
-;;;;;;  783000 0))
+;;;### (autoloads nil "magit-blame" "magit-blame.el" (22297 19815
+;;;;;;  594111 386000))
 ;;; Generated autoloads from magit-blame.el
  (autoload 'magit-blame-popup "magit-blame" nil t)
 
@@ -599,8 +600,8 @@ only arguments available from `magit-blame-popup' should be used.
 
 ;;;***
 
-;;;### (autoloads nil "magit-commit" "magit-commit.el" (22221 60708
-;;;;;;  708000 0))
+;;;### (autoloads nil "magit-commit" "magit-commit.el" (22297 19812
+;;;;;;  710162 964000))
 ;;; Generated autoloads from magit-commit.el
 
 (autoload 'magit-commit "magit-commit" "\
@@ -682,8 +683,8 @@ Create a squash commit targeting COMMIT and instantly rebase.
 
 ;;;***
 
-;;;### (autoloads nil "magit-diff" "magit-diff.el" (22221 60708 779000
-;;;;;;  0))
+;;;### (autoloads nil "magit-diff" "magit-diff.el" (22297 19815 500113
+;;;;;;  67000))
 ;;; Generated autoloads from magit-diff.el
 
 (autoload 'magit-diff-dwim "magit-diff" "\
@@ -748,8 +749,8 @@ for a revision.
 
 ;;;***
 
-;;;### (autoloads nil "magit-ediff" "magit-ediff.el" (22221 60708
-;;;;;;  770000 0))
+;;;### (autoloads nil "magit-ediff" "magit-ediff.el" (22297 19815
+;;;;;;  231117 878000))
 ;;; Generated autoloads from magit-ediff.el
  (autoload 'magit-ediff-popup "magit-ediff" nil t)
 
@@ -827,10 +828,18 @@ Show changes introduced by COMMIT using Ediff.
 
 \(fn COMMIT)" t nil)
 
+(autoload 'magit-ediff-show-stash "magit-ediff" "\
+Show changes introduced by STASH using Ediff.
+`magit-ediff-show-stash-with-index' controls whether a
+three-buffer Ediff is used in order to distinguish changes in the
+stash that were staged.
+
+\(fn STASH)" t nil)
+
 ;;;***
 
-;;;### (autoloads nil "magit-extras" "magit-extras.el" (22221 60708
-;;;;;;  711000 0))
+;;;### (autoloads nil "magit-extras" "magit-extras.el" (22297 19812
+;;;;;;  849160 478000))
 ;;; Generated autoloads from magit-extras.el
 
 (autoload 'magit-run-git-gui "magit-extras" "\
@@ -900,8 +909,8 @@ on a position in a file-visiting buffer.
 
 ;;;***
 
-;;;### (autoloads nil "magit-log" "magit-log.el" (22221 60708 775000
-;;;;;;  0))
+;;;### (autoloads nil "magit-log" "magit-log.el" (22297 19815 391115
+;;;;;;  16000))
 ;;; Generated autoloads from magit-log.el
 
 (autoload 'magit-log-current "magit-log" "\
@@ -969,8 +978,8 @@ Show commits in a branch that are not merged in the upstream branch.
 
 ;;;***
 
-;;;### (autoloads nil "magit-remote" "magit-remote.el" (22221 60708
-;;;;;;  805000 0))
+;;;### (autoloads nil "magit-remote" "magit-remote.el" (22297 19816
+;;;;;;  537094 521000))
 ;;; Generated autoloads from magit-remote.el
 
 (autoload 'magit-clone "magit-remote" "\
@@ -1031,6 +1040,16 @@ Fetch from another repository.
 
 \(fn REMOTE ARGS)" t nil)
 
+(autoload 'magit-fetch-branch "magit-remote" "\
+Fetch a BRANCH from a REMOTE.
+
+\(fn REMOTE BRANCH ARGS)" t nil)
+
+(autoload 'magit-fetch-refspec "magit-remote" "\
+Fetch a REFSPEC from a REMOTE.
+
+\(fn REMOTE REFSPEC ARGS)" t nil)
+
 (autoload 'magit-fetch-all "magit-remote" "\
 Fetch from all remotes.
 
@@ -1192,8 +1211,8 @@ is asked to pull.  START has to be reachable from that commit.
 
 ;;;***
 
-;;;### (autoloads nil "magit-sequence" "magit-sequence.el" (22221
-;;;;;;  60708 797000 0))
+;;;### (autoloads nil "magit-sequence" "magit-sequence.el" (22297
+;;;;;;  19816 152101 407000))
 ;;; Generated autoloads from magit-sequence.el
 
 (autoload 'magit-sequencer-continue "magit-sequence" "\
@@ -1341,8 +1360,8 @@ Abort the current rebase operation, restoring the original branch.
 
 ;;;***
 
-;;;### (autoloads nil "magit-stash" "magit-stash.el" (22221 60708
-;;;;;;  764000 0))
+;;;### (autoloads nil "magit-stash" "magit-stash.el" (22297 19814
+;;;;;;  722126 982000))
 ;;; Generated autoloads from magit-stash.el
  (autoload 'magit-stash-popup "magit-stash" nil t)
 
@@ -1364,7 +1383,7 @@ Applying the resulting stash has the inverse effect.
 \(fn MESSAGE)" t nil)
 
 (autoload 'magit-stash-worktree "magit-stash" "\
-Create a stash of the working tree only.
+Create a stash of unstaged changes in the working tree.
 Untracked files are included according to popup arguments.
 One prefix argument is equivalent to `--include-untracked'
 while two prefix arguments are equivalent to `--all'.
@@ -1394,7 +1413,7 @@ Unstaged and untracked changes are not stashed.
 \(fn)" t nil)
 
 (autoload 'magit-snapshot-worktree "magit-stash" "\
-Create a snapshot of the working tree only.
+Create a snapshot of unstaged changes in the working tree.
 Untracked files are included according to popup arguments.
 One prefix argument is equivalent to `--include-untracked'
 while two prefix arguments are equivalent to `--all'.
@@ -1441,18 +1460,22 @@ Show all diffs of a stash in a buffer.
 
 ;;;***
 
-;;;### (autoloads nil "magit-submodule" "magit-submodule.el" (22221
-;;;;;;  60708 818000 0))
+;;;### (autoloads nil "magit-submodule" "magit-submodule.el" (22297
+;;;;;;  19817 180083 21000))
 ;;; Generated autoloads from magit-submodule.el
  (autoload 'magit-submodule-popup "magit-submodule" nil t)
 
 (autoload 'magit-submodule-add "magit-submodule" "\
 Add the repository at URL as a submodule.
+
 Optional PATH is the path to the submodule relative to the root
-of the superproject. If it is nil then the path is determined
+of the superproject.  If it is nil, then the path is determined
 based on URL.
 
-\(fn URL &optional PATH)" t nil)
+Optional NAME is the name of the submodule.  If it is nil, then
+PATH also becomes the name.
+
+\(fn URL &optional PATH NAME)" t nil)
 
 (autoload 'magit-submodule-setup "magit-submodule" "\
 Clone and register missing submodules and checkout appropriate commits.
@@ -1486,27 +1509,34 @@ Unregister the submodule at PATH.
 
 \(fn PATH)" t nil)
 
-(autoload 'magit-insert-submodule-commits "magit-submodule" "\
-For internal use, don't add to a hook.
-
-\(fn SECTION RANGE)" nil nil)
-
-(autoload 'magit-insert-unpulled-module-commits "magit-submodule" "\
-Insert sections for all submodules with unpulled commits.
+(autoload 'magit-insert-modules-unpulled-from-upstream "magit-submodule" "\
+Insert sections for modules that haven't been pulled from the upstream.
 These sections can be expanded to show the respective commits.
 
 \(fn)" nil nil)
 
-(autoload 'magit-insert-unpushed-module-commits "magit-submodule" "\
-Insert sections for all submodules with unpushed commits.
+(autoload 'magit-insert-modules-unpulled-from-pushremote "magit-submodule" "\
+Insert sections for modules that haven't been pulled from the push-remote.
+These sections can be expanded to show the respective commits.
+
+\(fn)" nil nil)
+
+(autoload 'magit-insert-modules-unpushed-to-upstream "magit-submodule" "\
+Insert sections for modules that haven't been pushed to the upstream.
+These sections can be expanded to show the respective commits.
+
+\(fn)" nil nil)
+
+(autoload 'magit-insert-modules-unpushed-to-pushremote "magit-submodule" "\
+Insert sections for modules that haven't been pushed to the push-remote.
 These sections can be expanded to show the respective commits.
 
 \(fn)" nil nil)
 
 ;;;***
 
-;;;### (autoloads nil "magit-wip" "magit-wip.el" (22221 60708 721000
-;;;;;;  0))
+;;;### (autoloads nil "magit-wip" "magit-wip.el" (22297 19813 56156
+;;;;;;  776000))
 ;;; Generated autoloads from magit-wip.el
 
 (defvar magit-wip-after-save-mode nil "\
@@ -1573,7 +1603,7 @@ command which is about to be called are committed.
 
 ;;;### (autoloads nil nil ("magit-core.el" "magit-git.el" "magit-mode.el"
 ;;;;;;  "magit-pkg.el" "magit-process.el" "magit-section.el" "magit-utils.el")
-;;;;;;  (22221 60708 822158 468000))
+;;;;;;  (22297 19818 84560 140000))
 
 ;;;***
 
diff --git a/elpa/magit-20160223.828/magit-autorevert.el b/elpa/magit-20160421.459/magit-autorevert.el
similarity index 100%
rename from elpa/magit-20160223.828/magit-autorevert.el
rename to elpa/magit-20160421.459/magit-autorevert.el
diff --git a/elpa/magit-20160223.828/magit-bisect.el b/elpa/magit-20160421.459/magit-bisect.el
similarity index 100%
rename from elpa/magit-20160223.828/magit-bisect.el
rename to elpa/magit-20160421.459/magit-bisect.el
diff --git a/elpa/magit-20160223.828/magit-blame.el b/elpa/magit-20160421.459/magit-blame.el
similarity index 100%
rename from elpa/magit-20160223.828/magit-blame.el
rename to elpa/magit-20160421.459/magit-blame.el
diff --git a/elpa/magit-20160223.828/magit-commit.el b/elpa/magit-20160421.459/magit-commit.el
similarity index 97%
rename from elpa/magit-20160223.828/magit-commit.el
rename to elpa/magit-20160421.459/magit-commit.el
index 85b6288..3119aa7 100644
--- a/elpa/magit-20160223.828/magit-commit.el
+++ b/elpa/magit-20160421.459/magit-commit.el
@@ -245,10 +245,14 @@ depending on the value of option `magit-commit-squash-confirm'."
                           current-prefix-arg
                           magit-commit-squash-confirm))))
         (let ((magit-commit-show-diff nil))
-          (magit-run-git-with-editor "commit"
-                                     (unless edit "--no-edit")
-                                     (concat option "=" commit)
-                                     args))
+          (push (concat option "=" commit) args)
+          (unless edit
+            (push "--no-edit" args))
+          (if rebase
+              (with-editor "GIT_EDITOR"
+                (let ((magit-process-popup-time -1))
+                  (magit-call-git "commit" args)))
+            (magit-run-git-with-editor "commit" args)))
       (magit-log-select
         `(lambda (commit)
            (magit-commit-squash-internal ,option commit ',args ,rebase ,edit t)
diff --git a/elpa/magit-20160223.828/magit-core.el b/elpa/magit-20160421.459/magit-core.el
similarity index 100%
rename from elpa/magit-20160223.828/magit-core.el
rename to elpa/magit-20160421.459/magit-core.el
diff --git a/elpa/magit-20160223.828/magit-diff.el b/elpa/magit-20160421.459/magit-diff.el
similarity index 94%
rename from elpa/magit-20160223.828/magit-diff.el
rename to elpa/magit-20160421.459/magit-diff.el
index 1af889f..5c55844 100644
--- a/elpa/magit-20160223.828/magit-diff.el
+++ b/elpa/magit-20160421.459/magit-diff.el
@@ -164,6 +164,13 @@ many spaces.  Otherwise, highlight neither."
                                (integer :tag "Spaces" :value ,tab-width)
                                (const :tag "Neither" nil)))))
 
+(defcustom magit-diff-hide-trailing-cr-characters
+  (and (memq system-type '(ms-dos windows-nt)) t)
+  "Whether to hide ^M characters at the end of a line in diffs."
+  :package-version '(magit . "2.6.0")
+  :group 'magit-diff
+  :type 'boolean)
+
 ;;;; Revision Mode
 
 (defgroup magit-revision nil
@@ -332,11 +339,11 @@ and https://debbugs.gnu.org/cgi/bugreport.cgi?bug=7847."
 
 (defface magit-diff-removed
  '((((class color) (background light))
-     :background "#ffdddd"
-     :foreground "#aa2222")
-    (((class color) (background dark))
-     :background "#553333"
-     :foreground "#ffdddd"))
+    :background "#ffdddd"
+    :foreground "#aa2222")
+   (((class color) (background dark))
+    :background "#553333"
+    :foreground "#ffdddd"))
   "Face for lines in a diff that have been removed."
   :group 'magit-faces)
 
@@ -556,6 +563,24 @@ and https://debbugs.gnu.org/cgi/bugreport.cgi?bug=7847."
            (default-value 'magit-diff-arguments))))
     (magit-invoke-popup 'magit-diff-popup nil arg)))
 
+(defun magit-diff-buffer-file-popup (arg)
+  "Popup console for diff commans.
+
+This is a variant of `magit-diff-popup' which shows the same popup
+but which limits the diff to the file being visited in the current
+buffer."
+  (interactive "P")
+  (-if-let (file (magit-file-relative-name))
+      (let ((magit-diff-arguments
+             (magit-popup-import-file-args
+              (-if-let (buffer (magit-mode-get-buffer 'magit-diff-mode))
+                  (with-current-buffer buffer
+                    (nth 2 magit-refresh-args))
+                (default-value 'magit-diff-arguments))
+              (list file))))
+        (magit-invoke-popup 'magit-diff-popup nil arg))
+    (user-error "Buffer isn't visiting a file")))
+
 (defun magit-diff-refresh-popup (arg)
   "Popup console for changing diff arguments in the current buffer."
   (interactive "P")
@@ -933,7 +958,7 @@ which, as the name suggests always visits the actual file."
                          (expand-file-name it)
                        (user-error "No file at point"))
                      current-prefix-arg))
-  (if (file-accessible-directory-p file)
+  (if (magit-file-accessible-directory-p file)
       (magit-diff-visit-directory file other-window)
     (let ((current (magit-current-section))
           (rev (cond (force-worktree nil)
@@ -1237,13 +1262,6 @@ is set in `magit-mode-setup'."
           "\\(\\+*\\)"   ; add
           "\\(-*\\)$"))  ; del
 
-(defconst magit-diff-submodule-re
-  (concat "^Submodule \\([^ ]+\\) \\(?:"
-          "\\([^ ]+ (new submodule)\\)\\|"
-          "\\([^ ]+ (submodule deleted)\\)\\|"
-          "\\(contains \\(?:modified\\|untracked\\) content\\)\\|"
-          "\\([^ :]+\\)\\( (rewind)\\)?:\\)$"))
-
 (defun magit-diff-wash-diffs (args &optional limit)
   (when (member "--stat" args)
     (magit-diff-wash-diffstat))
@@ -1303,7 +1321,7 @@ section or a child thereof."
 
 (defun magit-diff-wash-diff (args)
   (cond
-   ((looking-at magit-diff-submodule-re)
+   ((looking-at "^Submodule")
     (magit-diff-wash-submodule))
    ((looking-at "^\\* Unmerged path \\(.*\\)")
     (let ((file (magit-decode-git-path (match-string 1))))
@@ -1381,7 +1399,9 @@ section or a child thereof."
         (setq orig (magit-decode-git-path orig)))
       (setq file (magit-decode-git-path file))
       ;; KLUDGE `git-log' ignores `--no-prefix' when `-L' is used.
-      (when (derived-mode-p 'magit-log-mode)
+      (when (and (derived-mode-p 'magit-log-mode)
+                 (--first (string-match-p "\\`-L" it)
+                          (nth 1 magit-refresh-args)))
         (setq file (substring file 2))
         (when orig
           (setq orig (substring orig 2))))
@@ -1406,42 +1426,66 @@ section or a child thereof."
     (magit-wash-sequence #'magit-diff-wash-hunk)))
 
 (defun magit-diff-wash-submodule ()
-  (magit-bind-match-strings (module new deleted dirty range rewind) nil
-    (magit-delete-line)
-    (when (and dirty
-               (looking-at magit-diff-submodule-re)
-               (string= (match-string 1) module))
-      (setq range (match-string 5))
-      (magit-delete-line))
-    (while (looking-at "^  \\([<>]\\) \\(.+\\)$")
-      (magit-delete-line))
-    (if range
-        (let ((default-directory
-                (file-name-as-directory
-                 (expand-file-name module (magit-toplevel)))))
-          (setf (magit-section-value
-                 (magit-insert-section (file module t)
-                   (magit-insert-heading
-                     (concat (propertize (concat "modified   " module)
-                                         'face 'magit-diff-file-heading)
-                             " ("
-                             (if rewind "rewind" "new commits")
-                             (and dirty ", modified content")
-                             ")"))
-                   (unless rewind
-                     (magit-git-wash
-                         (apply-partially 'magit-log-wash-log 'module)
-                       "log" "--oneline" "--left-right" range)
-                     (delete-char -1))))
-                module))
-      (magit-insert-section (file module)
-        (insert (propertize (if new
-                                (concat "new module " module)
-                              (concat "modified   " module))
-                            'face 'magit-diff-file-heading))
-        (cond (dirty   (insert " (modified content)"))
-              (deleted (insert " (deleted submodule)")))
-        (insert ?\n)))))
+  ;; See `show_submodule_summary' in submodule.c and "this" commit.
+  (when (looking-at "^Submodule \\([^ ]+\\)")
+    (let ((module (match-string 1))
+          untracked modified)
+      (when (looking-at "^Submodule [^ ]+ contains untracked content$")
+        (magit-delete-line)
+        (setq untracked t))
+      (when (looking-at "^Submodule [^ ]+ contains modified content$")
+        (magit-delete-line)
+        (setq modified t))
+      (cond
+       ((and (looking-at "^Submodule \\([^ ]+\\) \\([^ :]+\\)\\( (rewind)\\)?:$")
+             (equal (match-string 1) module))
+        (magit-bind-match-strings (_module range rewind) nil
+          (magit-delete-line)
+          (while (looking-at "^  \\([<>]\\) \\(.+\\)$")
+            (magit-delete-line))
+          (when rewind
+            (setq range (replace-regexp-in-string "[^.]\\(\\.\\.\\)[^.]"
+                                                  "..." range t t 1)))
+          (magit-insert-section (file module t)
+            (magit-insert-heading
+              (concat (propertize (concat "modified   " module)
+                                  'face 'magit-diff-file-heading)
+                      " ("
+                      (cond (rewind "rewind")
+                            ((string-match-p "\\.\\.\\." range) "non-ff")
+                            (t "new commits"))
+                      (and (or modified untracked)
+                           (concat ", "
+                                   (and modified "modified")
+                                   (and modified untracked " and ")
+                                   (and untracked "untracked")
+                                   " content"))
+                      ")"))
+            (let ((default-directory
+                    (file-name-as-directory
+                     (expand-file-name module (magit-toplevel)))))
+              (magit-git-wash (apply-partially 'magit-log-wash-log 'module)
+                "log" "--oneline" "--left-right" range)
+              (delete-char -1)))))
+       ((and (looking-at "^Submodule \\([^ ]+\\) \\([^ ]+\\) (\\([^)]+\\))$")
+             (equal (match-string 1) module))
+        (magit-bind-match-strings (_module _range msg) nil
+          (magit-delete-line)
+          (magit-insert-section (file module)
+            (magit-insert-heading
+              (concat (propertize (concat "submodule  " module)
+                                  'face 'magit-diff-file-heading)
+                      " (" msg ")")))))
+       (t
+        (magit-insert-section (file module)
+          (magit-insert-heading
+            (concat (propertize (concat "modified   " module)
+                                'face 'magit-diff-file-heading)
+                    " ("
+                    (and modified "modified")
+                    (and modified untracked " and ")
+                    (and untracked "untracked")
+                    " content)"))))))))
 
 (defun magit-diff-wash-hunk ()
   (when (looking-at "^@\\{2,\\} \\(.+?\\) @\\{2,\\}\\(?: \\(.*\\)\\)?")
@@ -1490,9 +1534,15 @@ Staging and applying changes is documented in info node
   :group 'magit-revision
   (hack-dir-local-variables-non-file-buffer))
 
-(defun magit-revision-refresh-buffer (rev __const _args _files)
+(defun magit-revision-refresh-buffer (rev __const _args files)
   (setq header-line-format
-        (propertize (format " %s %s" (capitalize (magit-object-type rev)) rev)
+        (propertize (concat " " (capitalize (magit-object-type rev))
+                            " " rev
+                            (pcase (length files)
+                              (0)
+                              (1 (concat " in file " (car files)))
+                              (_ (concat " in files "
+                                         (mapconcat #'identity files ", ")))))
                     'face 'magit-header-line))
   (magit-insert-section (commitbuf)
     (run-hook-with-args 'magit-revision-sections-hook rev)))
@@ -1904,6 +1954,10 @@ are highlighted."
               (stage nil))
           (forward-line)
           (while (< (point) end)
+            (when (and magit-diff-hide-trailing-cr-characters
+                       (char-equal ?\r (char-before (line-end-position))))
+              (put-text-property (1- (line-end-position)) (line-end-position)
+                                 'invisible t))
             (put-text-property
              (point) (1+ (line-end-position)) 'face
              (cond
diff --git a/elpa/magit-20160223.828/magit-ediff.el b/elpa/magit-20160421.459/magit-ediff.el
similarity index 83%
rename from elpa/magit-20160223.828/magit-ediff.el
rename to elpa/magit-20160421.459/magit-ediff.el
index 4e06ccf..e4b41cf 100644
--- a/elpa/magit-20160223.828/magit-ediff.el
+++ b/elpa/magit-20160421.459/magit-ediff.el
@@ -66,6 +66,38 @@ hunk is in.  Otherwise, `magit-ediff-dwim' runs
   :group 'magit-ediff
   :type 'boolean)
 
+(defcustom magit-ediff-show-stash-with-index t
+  "Whether `magit-ediff-show-stash' shows the state of the index.
+
+If non-nil, use a third Ediff buffer to distinguish which changes
+in the stash were staged.  In cases where the stash contains no
+staged changes, fall back to a two-buffer Ediff.
+
+More specificaly, a stash is a merge commit, stash@{N}, with
+potentially three parents.
+
+* stash@{N}^1 represents the HEAD commit at the time the stash
+  was created.
+
+* stash@{N}^2 records any changes that were staged when the stash
+  was made.
+
+* stash@{N}^3, if it exists, contains files that were untracked
+  when stashing.
+
+If this option is non-nil, `magit-ediff-show-stash' will run
+Ediff on a file using three buffers: one for stash@{N}, another
+for stash@{N}^1, and a third for stash@{N}^2.
+
+Otherwise, Ediff uses two buffers, comparing
+stash@{N}^1..stash@{N}.  Along with any unstaged changes, changes
+in the index commit, stash@{N}^2, will be shown in this
+comparison unless they conflicted with changes in the working
+tree at the time of stashing."
+  :package-version '(magit . "2.6.0")
+  :group 'magit-ediff
+  :type 'boolean)
+
 (defvar magit-ediff-previous-winconf nil)
 
 ;;;###autoload (autoload 'magit-ediff-popup "magit-ediff" nil t)
@@ -79,7 +111,8 @@ hunk is in.  Otherwise, `magit-ediff-dwim' runs
              (?m "Resolve"       magit-ediff-resolve)
              (?w "Show worktree" magit-ediff-show-working-tree)
              (?r "Diff range"    magit-ediff-compare)
-             (?c "Show commit"   magit-ediff-show-commit))
+             (?c "Show commit"   magit-ediff-show-commit) nil
+             (?z "Show stash"    magit-ediff-show-stash))
   :max-action-columns 2)
 
 ;;;###autoload
@@ -179,7 +212,7 @@ range)."
   (interactive (-let [(revA revB) (magit-ediff-compare--read-revisions
                                    nil current-prefix-arg)]
                  (nconc (list revA revB)
-                        (magit-ediff-compare--read-files revA revB))))
+                        (magit-ediff-read-files revA revB))))
   (magit-with-toplevel
     (let ((conf (current-window-configuration))
           (bufA (if revA
@@ -217,7 +250,10 @@ range)."
       (setq revA input))
     (list revA revB)))
 
-(defun magit-ediff-compare--read-files (revA revB &optional fileB)
+(defun magit-ediff-read-files (revA revB &optional fileB)
+  "Read file in REVB, return it and the corresponding file in REVA.
+When FILEB is non-nil, use this as REVB's file instead of
+prompting for it."
   (unless fileB
     (setq fileB (magit-read-file-choice
                  (format "File to compare between %s and %s"
@@ -231,8 +267,8 @@ range)."
              (format "File in %s to compare with %s in %s"
                      revA fileB (or revB "the working tree"))
              (magit-changed-files revB revA)
-             (format "File in %s to compare with %s in %s"
-                     revA fileB (or revB "the working tree"))))
+             (format "No files have changed between %s and %s"
+                     revA revB)))
         fileB))
 
 ;;;###autoload
@@ -265,6 +301,9 @@ mind at all, then it asks the user for a command to run."
          (`(commit . ,value)
           (setq command #'magit-ediff-show-commit
                 revB value))
+         (`(stash . ,value)
+          (setq command #'magit-ediff-show-stash
+                revB value))
          ((pred stringp)
           (-let [(a b) (magit-ediff-compare--read-revisions range)]
             (setq command #'magit-ediff-compare
@@ -292,9 +331,11 @@ mind at all, then it asks the user for a command to run."
                  (?v "resol[v]e" 'magit-ediff-resolve))))
              ((eq command 'magit-ediff-compare)
               (apply 'magit-ediff-compare revA revB
-                     (magit-ediff-compare--read-files revA revB file)))
+                     (magit-ediff-read-files revA revB file)))
              ((eq command 'magit-ediff-show-commit)
               (magit-ediff-show-commit revB))
+             ((eq command 'magit-ediff-show-stash)
+              (magit-ediff-show-stash revB))
              (file
               (funcall command file))
              (t
@@ -390,7 +431,44 @@ FILE must be relative to the top directory of the repository."
         (revB commit))
     (apply #'magit-ediff-compare
            revA revB
-           (magit-ediff-compare--read-files revA revB (magit-current-file)))))
+           (magit-ediff-read-files revA revB (magit-current-file)))))
+
+;;;###autoload
+(defun magit-ediff-show-stash (stash)
+  "Show changes introduced by STASH using Ediff.
+`magit-ediff-show-stash-with-index' controls whether a
+three-buffer Ediff is used in order to distinguish changes in the
+stash that were staged."
+  (interactive (list (magit-read-stash "Stash")))
+  (-let* ((revA (concat stash "^1"))
+          (revB (concat stash "^2"))
+          (revC stash)
+          ((fileA fileC) (magit-ediff-read-files revA revC))
+          (fileB fileC))
+    (if (and magit-ediff-show-stash-with-index
+             (member fileA (magit-changed-files revB revA)))
+        (let ((conf (current-window-configuration))
+              (bufA (magit-get-revision-buffer revA fileA))
+              (bufB (magit-get-revision-buffer revB fileB))
+              (bufC (magit-get-revision-buffer revC fileC)))
+          (ediff-buffers3
+           (or bufA (magit-find-file-noselect revA fileA))
+           (or bufB (magit-find-file-noselect revB fileB))
+           (or bufC (magit-find-file-noselect revC fileC))
+           `((lambda ()
+               (setq-local
+                ediff-quit-hook
+                (lambda ()
+                  ,@(unless bufA
+                      '((ediff-kill-buffer-carefully ediff-buffer-A)))
+                  ,@(unless bufB
+                      '((ediff-kill-buffer-carefully ediff-buffer-B)))
+                  ,@(unless bufC
+                      '((ediff-kill-buffer-carefully ediff-buffer-C)))
+                  (let ((magit-ediff-previous-winconf ,conf))
+                    (run-hooks 'magit-ediff-quit-hook))))))
+           'ediff-buffers3))
+      (magit-ediff-compare revA revC fileA fileC))))
 
 (defun magit-ediff-cleanup-auxiliary-buffers ()
   (let* ((ctl-buf ediff-control-buffer)
diff --git a/elpa/magit-20160223.828/magit-extras.el b/elpa/magit-20160421.459/magit-extras.el
similarity index 100%
rename from elpa/magit-20160223.828/magit-extras.el
rename to elpa/magit-20160421.459/magit-extras.el
diff --git a/elpa/magit-20160223.828/magit-git.el b/elpa/magit-20160421.459/magit-git.el
similarity index 88%
rename from elpa/magit-20160223.828/magit-git.el
rename to elpa/magit-20160421.459/magit-git.el
index 006268e..37cfa10 100644
--- a/elpa/magit-20160223.828/magit-git.el
+++ b/elpa/magit-20160421.459/magit-git.el
@@ -184,6 +184,23 @@ change the upstream and many which create new branches."
 
 ;;; Git
 
+(defvar magit--refresh-cache nil)
+
+(defmacro magit--with-refresh-cache (key &rest body)
+  (declare (indent 1))
+  (let ((k (cl-gensym)))
+    `(if magit--refresh-cache
+         (let ((,k ,key))
+           (--if-let (assoc ,k (cdr magit--refresh-cache))
+               (progn (cl-incf (caar magit--refresh-cache))
+                      (cdr it))
+             (cl-incf (cdar magit--refresh-cache))
+             (let ((value ,(macroexp-progn body)))
+               (push (cons ,k value)
+                     (cdr magit--refresh-cache))
+               value)))
+       ,@body)))
+
 (defun magit-process-git-arguments (args)
   "Prepare ARGS for a function that invokes Git.
 
@@ -213,12 +230,14 @@ to do the following.
 If there is no output return nil.  If the output begins with a
 newline return an empty string.  Like `magit-git-string' but
 ignore `magit-git-debug'."
-  (with-temp-buffer
-    (apply #'magit-process-file magit-git-executable nil (list t nil) nil
-           (magit-process-git-arguments args))
-    (unless (bobp)
-      (goto-char (point-min))
-      (buffer-substring-no-properties (point) (line-end-position)))))
+  (setq args (-flatten args))
+  (magit--with-refresh-cache (cons default-directory args)
+    (with-temp-buffer
+      (apply #'magit-process-file magit-git-executable nil (list t nil) nil
+             (magit-process-git-arguments args))
+      (unless (bobp)
+        (goto-char (point-min))
+        (buffer-substring-no-properties (point) (line-end-position))))))
 
 (defun magit-git-true (&rest args)
   "Execute Git with ARGS, returning t if it prints \"true\".
@@ -269,11 +288,13 @@ add a section in the respective process buffer."
   "Execute Git with ARGS, returning the first line of its output.
 If there is no output return nil.  If the output begins with a
 newline return an empty string."
-  (with-temp-buffer
-    (apply #'magit-git-insert args)
-    (unless (bobp)
-      (goto-char (point-min))
-      (buffer-substring-no-properties (point) (line-end-position)))))
+  (setq args (-flatten args))
+  (magit--with-refresh-cache (cons default-directory args)
+    (with-temp-buffer
+      (apply #'magit-git-insert args)
+      (unless (bobp)
+        (goto-char (point-min))
+        (buffer-substring-no-properties (point) (line-end-position))))))
 
 (defun magit-git-lines (&rest args)
   "Execute Git with ARGS, returning its output as a list of lines.
@@ -330,7 +351,7 @@ call function WASHER with no argument."
     (let ((dir (file-name-as-directory
                 (expand-file-name (or file default-directory))))
           (previous nil))
-      (while (not (file-accessible-directory-p dir))
+      (while (not (magit-file-accessible-directory-p dir))
         (setq dir (file-name-directory (directory-file-name dir)))
         (when (equal dir previous)
           (throw 'unsafe-default-dir nil))
@@ -348,10 +369,11 @@ call function WASHER with no argument."
 All symlinks are followed.  If optional PATH is non-nil, then
 it has to be a path relative to the control directory and its
 absolute path is returned."
-  (magit--with-safe-default-directory nil
-    (--when-let (magit-rev-parse-safe "--git-dir")
-      (setq it (file-name-as-directory (magit-expand-git-file-name it)))
-      (if path (expand-file-name (convert-standard-filename path) it) it))))
+  (magit--with-refresh-cache (list default-directory 'magit-git-dir path)
+    (magit--with-safe-default-directory nil
+      (--when-let (magit-rev-parse-safe "--git-dir")
+        (setq it (file-name-as-directory (magit-expand-git-file-name it)))
+        (if path (expand-file-name (convert-standard-filename path) it) it)))))
 
 (defun magit-toplevel (&optional directory)
   "Return the absolute path to the toplevel of the current repository.
@@ -372,57 +394,59 @@ tree is involved, or when called from within a sub-directory of
 the gitdir or from the toplevel of a gitdir, which itself is not
 located within the working tree, then it is not possible to avoid
 returning the truename."
-  (magit--with-safe-default-directory directory
-    (-if-let (topdir (magit-rev-parse-safe "--show-toplevel"))
-        (let (updir)
-          (setq topdir (magit-expand-git-file-name topdir))
-          (if (and
-               ;; Always honor these settings.
-               (not find-file-visit-truename)
-               (not (getenv "GIT_WORK_TREE"))
-               ;; `--show-cdup' is the relative path to the toplevel
-               ;; from `(file-truename default-directory)'.  Here we
-               ;; pretend it is relative to `default-directory', and
-               ;; go to that directory.  Then we check whether
-               ;; `--show-toplevel' still returns the same value and
-               ;; whether `--show-cdup' now is the empty string.  If
-               ;; both is the case, then we are at the toplevel of
-               ;; the same working tree, but also avoided needlessly
-               ;; following any symlinks.
-               (progn
-                 (setq updir (file-name-as-directory
-                              (magit-rev-parse-safe "--show-cdup")))
-                 (setq updir (if (file-name-absolute-p updir)
-                                 (concat (file-remote-p default-directory) updir)
-                               (expand-file-name updir)))
-                 (let ((default-directory updir))
-                   (and (string-equal (magit-rev-parse-safe "--show-cdup") "")
-                        (--when-let (magit-rev-parse-safe "--show-toplevel")
-                          (string-equal (magit-expand-git-file-name it)
-                                        topdir))))))
-              updir
-            (concat (file-remote-p default-directory)
-                    (file-name-as-directory topdir))))
-      (-when-let (gitdir (magit-rev-parse-safe "--git-dir"))
-        (setq gitdir (file-name-as-directory
-                      (if (file-name-absolute-p gitdir)
-                          ;; We might have followed a symlink.
-                          (concat (file-remote-p default-directory)
-                                  (magit-expand-git-file-name gitdir))
-                        (expand-file-name gitdir))))
-        (if (magit-bare-repo-p)
-            gitdir
-          (let* ((link (expand-file-name "gitdir" gitdir))
-                 (wtree (and (file-exists-p link)
-                             (magit-file-line link))))
-            (if (and wtree
-                     ;; Ignore .git/gitdir files that result from a
-                     ;; Git bug.  See #2364.
-                     (not (equal wtree ".git")))
-                ;; Return the linked working tree.
-                (file-name-directory wtree)
-              ;; Step outside the control directory to enter the working tree.
-              (file-name-directory (directory-file-name gitdir)))))))))
+  (magit--with-refresh-cache
+      (cons (or directory default-directory) 'magit-toplevel)
+    (magit--with-safe-default-directory directory
+      (-if-let (topdir (magit-rev-parse-safe "--show-toplevel"))
+          (let (updir)
+            (setq topdir (magit-expand-git-file-name topdir))
+            (if (and
+                 ;; Always honor these settings.
+                 (not find-file-visit-truename)
+                 (not (getenv "GIT_WORK_TREE"))
+                 ;; `--show-cdup' is the relative path to the toplevel
+                 ;; from `(file-truename default-directory)'.  Here we
+                 ;; pretend it is relative to `default-directory', and
+                 ;; go to that directory.  Then we check whether
+                 ;; `--show-toplevel' still returns the same value and
+                 ;; whether `--show-cdup' now is the empty string.  If
+                 ;; both is the case, then we are at the toplevel of
+                 ;; the same working tree, but also avoided needlessly
+                 ;; following any symlinks.
+                 (progn
+                   (setq updir (file-name-as-directory
+                                (magit-rev-parse-safe "--show-cdup")))
+                   (setq updir (if (file-name-absolute-p updir)
+                                   (concat (file-remote-p default-directory) updir)
+                                 (expand-file-name updir)))
+                   (let ((default-directory updir))
+                     (and (string-equal (magit-rev-parse-safe "--show-cdup") "")
+                          (--when-let (magit-rev-parse-safe "--show-toplevel")
+                            (string-equal (magit-expand-git-file-name it)
+                                          topdir))))))
+                updir
+              (concat (file-remote-p default-directory)
+                      (file-name-as-directory topdir))))
+        (-when-let (gitdir (magit-rev-parse-safe "--git-dir"))
+          (setq gitdir (file-name-as-directory
+                        (if (file-name-absolute-p gitdir)
+                            ;; We might have followed a symlink.
+                            (concat (file-remote-p default-directory)
+                                    (magit-expand-git-file-name gitdir))
+                          (expand-file-name gitdir))))
+          (if (magit-bare-repo-p)
+              gitdir
+            (let* ((link (expand-file-name "gitdir" gitdir))
+                   (wtree (and (file-exists-p link)
+                               (magit-file-line link))))
+              (if (and wtree
+                       ;; Ignore .git/gitdir files that result from a
+                       ;; Git bug.  See #2364.
+                       (not (equal wtree ".git")))
+                  ;; Return the linked working tree.
+                  (file-name-directory wtree)
+                ;; Step outside the control directory to enter the working tree.
+                (file-name-directory (directory-file-name gitdir))))))))))
 
 (defmacro magit-with-toplevel (&rest body)
   (declare (indent defun) (debug (body)))
@@ -564,10 +588,13 @@ range.  Otherwise, it can be any revision or range accepted by
                              "Failed to parse Cygwin mount: %S" it))
                     ;; If --exec-path is not a native Windows path,
                     ;; then we probably have a cygwin git.
-                    (and (not (string-match-p
-                               "\\`[a-zA-Z]:"
-                               (car (process-lines "git" "--exec-path"))))
-                         (ignore-errors (process-lines "mount"))))
+                    (let ((process-environment
+                           (append magit-git-environment process-environment)))
+                      (and (not (string-match-p
+                                 "\\`[a-zA-Z]:"
+                                 (car (process-lines
+                                       magit-git-executable "--exec-path"))))
+                           (ignore-errors (process-lines "mount")))))
              #'> :key (-lambda ((cyg . _win)) (length cyg))))
   "Alist of (CYGWIN . WIN32) directory names.
 Sorted from longest to shortest CYGWIN name."
@@ -605,7 +632,7 @@ Sorted from longest to shortest CYGWIN name."
   (or (magit-file-relative-name)
       (magit-file-at-point)
       (and (derived-mode-p 'magit-log-mode)
-           (nth 3 magit-refresh-args))))
+           (car (nth 2 magit-refresh-args)))))
 
 ;;; Predicates
 
@@ -983,14 +1010,19 @@ where COMMITS is the number of commits in TAG but not in REV."
   (--map (substring it 6) (magit-list-refnames "refs/notes")))
 
 (defun magit-remote-list-tags (remote)
-  (--map (substring it 51)
-         (--filter (not (string-match-p "\\^{}$" it))
-                   (magit-git-lines "ls-remote" "--tags" remote))))
+  (--keep (and (not (string-match-p "\\^{}$" it))
+               (substring it 51))
+          (magit-git-lines "ls-remote" "--tags" remote)))
 
 (defun magit-remote-list-branches (remote)
-  (--map (substring it 52)
-         (--filter (not (string-match-p "\\^{}$" it))
-                   (magit-git-lines "ls-remote" "--heads" remote))))
+  (--keep (and (not (string-match-p "\\^{}$" it))
+               (substring it 52))
+          (magit-git-lines "ls-remote" "--heads" remote)))
+
+(defun magit-remote-list-refs (remote)
+  (--keep (and (not (string-match-p "\\^{}$" it))
+               (substring it 41))
+          (magit-git-lines "ls-remote" remote)))
 
 (defun magit-get-submodules ()
   (--mapcat (and (string-match "^160000 [0-9a-z]\\{40\\} 0\t\\(.+\\)$" it)
@@ -1150,7 +1182,7 @@ Return a list of two integers: (A>B B>A)."
            (delete-file (concat (file-remote-p default-directory) ,file)))))))
 
 (defun magit-commit-tree (message &optional tree &rest parents)
-  (magit-git-string "commit-tree" "-m" message
+  (magit-git-string "commit-tree" "--no-gpg-sign" "-m" message
                     (--mapcat (list "-p" it) (delq nil parents))
                     (or tree (magit-git-string "write-tree"))))
 
@@ -1236,17 +1268,23 @@ Return a list of two integers: (A>B B>A)."
     (prompt &optional remote default local-branch require-match)
   (let ((choice (magit-completing-read
                  prompt
-                 (nconc (and local-branch
-                             (if remote
-                                 (concat remote "/" local-branch)
-                               (--map (concat it "/" local-branch)
-                                      (magit-list-remotes))))
-                        (magit-list-remote-branch-names remote t))
+                 (-union (and local-branch
+                              (if remote
+                                  (concat remote "/" local-branch)
+                                (--map (concat it "/" local-branch)
+                                       (magit-list-remotes))))
+                         (magit-list-remote-branch-names remote t))
                  nil require-match nil 'magit-revision-history default)))
     (if (or remote (string-match "\\`\\([^/]+\\)/\\(.+\\)" choice))
         choice
       (user-error "`%s' doesn't have the form REMOTE/BRANCH" choice))))
 
+(defun magit-read-refspec (prompt remote)
+  (magit-completing-read prompt
+                         (prog2 (message "Determining available refs...")
+                             (magit-remote-list-refs remote)
+                           (message "Determining available refs...done"))))
+
 (defun magit-read-local-branch (prompt &optional secondary-default)
   (magit-completing-read prompt (magit-list-local-branch-names)
                          nil t nil 'magit-revision-history
@@ -1301,9 +1339,9 @@ Return a list of two integers: (A>B B>A)."
     (&optional (branch (magit-get-current-branch)) prompt)
   (magit-completing-read
    (or prompt (format "Change upstream of %s to" branch))
-   (nconc (--map (concat it "/" branch)
-                 (magit-list-remotes))
-          (delete branch (magit-list-branch-names)))
+   (-union (--map (concat it "/" branch)
+                  (magit-list-remotes))
+           (delete branch (magit-list-branch-names)))
    nil nil nil 'magit-revision-history
    (or (let ((r (magit-remote-branch-at-point))
              (l (magit-branch-at-point)))
@@ -1352,6 +1390,15 @@ Return a list of two integers: (A>B B>A)."
                                  (magit-remote-at-point)
                                  (magit-get-remote))))))
 
+(defun magit-read-remote-or-url (prompt &optional default)
+  (magit-completing-read prompt
+                         (nconc (magit-list-remotes)
+                                (list "https://" "git://" "git@"))
+                         nil nil nil nil
+                         (or default
+                             (magit-remote-at-point)
+                             (magit-get-remote))))
+
 ;;; Variables
 
 (defun magit-get (&rest keys)
diff --git a/elpa/magit-20160223.828/magit-log.el b/elpa/magit-20160421.459/magit-log.el
similarity index 99%
rename from elpa/magit-20160223.828/magit-log.el
rename to elpa/magit-20160421.459/magit-log.el
index aed85bd..f9c7729 100644
--- a/elpa/magit-20160223.828/magit-log.el
+++ b/elpa/magit-20160421.459/magit-log.el
@@ -879,8 +879,8 @@ Do not add this to a hook variable."
           (insert ?\s))
         (when side
           (insert (propertize side 'face (if (string= side "<")
-                                             'magit-diff-removed
-                                           'magit-diff-added)))
+                                             'magit-cherry-equivalent
+                                           'magit-cherry-unmatched)))
           (insert ?\s))
         (when align
           (insert (propertize hash 'face 'magit-hash) ?\s))
diff --git a/elpa/magit-20160223.828/magit-mode.el b/elpa/magit-20160421.459/magit-mode.el
similarity index 96%
rename from elpa/magit-20160223.828/magit-mode.el
rename to elpa/magit-20160421.459/magit-mode.el
index fbae834..ea701a3 100644
--- a/elpa/magit-20160223.828/magit-mode.el
+++ b/elpa/magit-20160421.459/magit-mode.el
@@ -349,6 +349,7 @@ starts complicating other things, then it will be removed."
     (define-key map "w" 'magit-am-popup)
     (define-key map "W" 'magit-patch-popup)
     (define-key map "x" 'magit-reset)
+    (define-key map "X" 'magit-reset-popup)
     (define-key map "y" 'magit-show-refs-popup)
     (define-key map "Y" 'magit-cherry)
     (define-key map "z" 'magit-stash-popup)
@@ -643,8 +644,13 @@ latter is displayed in its place."
                     (rev (if args (cons rev args) rev))
                     (t   (if (member "--cached" args) "staged" "unstaged")))))))
     (if magit-buffer-locked-p
-        (rename-buffer (funcall magit-generate-buffer-name-function
-                                major-mode magit-buffer-locked-p))
+        (let ((name (funcall magit-generate-buffer-name-function
+                             major-mode magit-buffer-locked-p)))
+          (-if-let (locked (get-buffer name))
+              (let ((unlocked (current-buffer)))
+                (set-buffer locked)
+                (kill-buffer unlocked))
+            (rename-buffer name)))
       (user-error "Buffer has no value it could be locked to"))))
 
 (defun magit-mode-bury-buffer (&optional kill-buffer)
@@ -690,16 +696,26 @@ Refresh the current buffer if its major mode derives from
 Run hooks `magit-pre-refresh-hook' and `magit-post-refresh-hook'."
   (interactive)
   (unless inhibit-magit-refresh
-    (magit-run-hook-with-benchmark 'magit-pre-refresh-hook)
-    (when (derived-mode-p 'magit-mode)
-      (magit-refresh-buffer))
-    (--when-let (and magit-refresh-status-buffer
-                     (not (derived-mode-p 'magit-status-mode))
-                     (magit-mode-get-buffer 'magit-status-mode))
-      (with-current-buffer it
-        (magit-refresh-buffer)))
-    (magit-auto-revert-buffers)
-    (magit-run-hook-with-benchmark 'magit-post-refresh-hook)))
+    (let ((start (current-time))
+          (magit--refresh-cache (list (cons 0 0))))
+      (when magit-refresh-verbose
+        (message "Refreshing magit..."))
+      (magit-run-hook-with-benchmark 'magit-pre-refresh-hook)
+      (when (derived-mode-p 'magit-mode)
+        (magit-refresh-buffer))
+      (--when-let (and magit-refresh-status-buffer
+                       (not (derived-mode-p 'magit-status-mode))
+                       (magit-mode-get-buffer 'magit-status-mode))
+        (with-current-buffer it
+          (magit-refresh-buffer)))
+      (magit-auto-revert-buffers)
+      (magit-run-hook-with-benchmark 'magit-post-refresh-hook)
+      (when magit-refresh-verbose
+        (message "Refreshing magit...done (%.3fs, cached %s/%s)"
+                 (float-time (time-subtract (current-time) start))
+                 (caar magit--refresh-cache)
+                 (+ (caar magit--refresh-cache)
+                    (cdar magit--refresh-cache)))))))
 
 (defun magit-refresh-all ()
   "Refresh all buffers belonging to the current repository.
@@ -722,7 +738,8 @@ Run hooks `magit-pre-refresh-hook' and `magit-post-refresh-hook'."
   "Refresh the current Magit buffer."
   (setq magit-refresh-start-time (current-time))
   (let ((refresh (intern (format "%s-refresh-buffer"
-                                 (substring (symbol-name major-mode) 0 -5)))))
+                                 (substring (symbol-name major-mode) 0 -5))))
+        (magit--refresh-cache (or magit--refresh-cache (list (cons 0 0)))))
     (when (functionp refresh)
       (when magit-refresh-verbose
         (message "Refreshing buffer `%s'..." (buffer-name)))
diff --git a/elpa/magit-20160223.828/magit-pkg.el b/elpa/magit-20160421.459/magit-pkg.el
similarity index 55%
rename from elpa/magit-20160223.828/magit-pkg.el
rename to elpa/magit-20160421.459/magit-pkg.el
index 0b98849..ddd61b5 100644
--- a/elpa/magit-20160223.828/magit-pkg.el
+++ b/elpa/magit-20160421.459/magit-pkg.el
@@ -1,10 +1,10 @@
-(define-package "magit" "20160223.828" "A Git porcelain inside Emacs"
+(define-package "magit" "20160421.459" "A Git porcelain inside Emacs"
   '((emacs "24.4")
     (async "20150909.2257")
     (dash "20151021.113")
-    (with-editor "20160128.1201")
-    (git-commit "20160119.1409")
-    (magit-popup "20160119.1409"))
+    (with-editor "20160408.201")
+    (git-commit "20160412.130")
+    (magit-popup "20160408.156"))
   :url "https://github.com/magit/magit" :keywords
   '("git" "tools" "vc"))
 ;; Local Variables:
diff --git a/elpa/magit-20160223.828/magit-process.el b/elpa/magit-20160421.459/magit-process.el
similarity index 97%
rename from elpa/magit-20160223.828/magit-process.el
rename to elpa/magit-20160421.459/magit-process.el
index 918c94c..1a4015c 100644
--- a/elpa/magit-20160223.828/magit-process.el
+++ b/elpa/magit-20160421.459/magit-process.el
@@ -172,6 +172,12 @@ non-nil, then the password is read from the user instead."
   :group 'magit-process
   :type '(repeat (regexp)))
 
+(defcustom magit-process-ensure-unix-line-ending t
+  "Whether Magit should ensure a unix coding system when talking to Git."
+  :package-version '(magit . "2.6.0")
+  :group 'magit-process
+  :type 'boolean)
+
 (defface magit-process-ok
   '((t :inherit magit-section-heading :foreground "green"))
   "Face for zero exit-status."
@@ -301,9 +307,11 @@ Process output goes into a new section in the buffer returned by
 (defun magit-process-file (&rest args)
   "Process files synchronously in a separate process.
 Identical to `process-file' but temporarily enable Cygwin's
-\"noglob\" option during the call."
+\"noglob\" option during the call and ensure unix eol
+conversion."
   (let ((process-environment (append (magit-cygwin-env-vars)
-                                     process-environment)))
+                                     process-environment))
+        (default-process-coding-system (magit--process-coding-system)))
     (apply #'process-file args)))
 
 (defun magit-cygwin-env-vars ()
@@ -340,6 +348,7 @@ flattened before use."
     (run-hooks 'magit-pre-call-git-hook)
     (-let* ((process-environment (append (magit-cygwin-env-vars)
                                          process-environment))
+            (default-process-coding-system (magit--process-coding-system))
             (flat-args (magit-process-git-arguments args))
             ((process-buf . section)
              (magit-process-setup magit-git-executable flat-args))
@@ -460,7 +469,8 @@ Magit status buffer."
                   ;; which would modify the input (issue #20).
                   (and (not input) magit-process-connection-type))
                  (process-environment (append (magit-cygwin-env-vars)
-                                              process-environment)))
+                                              process-environment))
+                 (default-process-coding-system (magit--process-coding-system)))
              (apply #'start-file-process
                     (file-name-nondirectory program)
                     process-buf program args))))
@@ -672,6 +682,14 @@ Return the matched string suffixed with \": \", if needed."
             ((string-suffix-p ":"  prompt) (concat prompt " "))
             (t                             (concat prompt ": "))))))
 
+(defun magit--process-coding-system ()
+  (if magit-process-ensure-unix-line-ending
+      (cons (coding-system-change-eol-conversion
+             (car default-process-coding-system) 'unix)
+            (coding-system-change-eol-conversion
+             (cdr default-process-coding-system) 'unix))
+      default-process-coding-system))
+
 (defvar magit-credential-hook nil
   "Hook run before Git needs credentials.")
 
diff --git a/elpa/magit-20160223.828/magit-remote.el b/elpa/magit-20160421.459/magit-remote.el
similarity index 93%
rename from elpa/magit-20160223.828/magit-remote.el
rename to elpa/magit-20160421.459/magit-remote.el
index 7a29ac4..489f4d4 100644
--- a/elpa/magit-20160223.828/magit-remote.el
+++ b/elpa/magit-20160421.459/magit-remote.el
@@ -184,6 +184,8 @@ Delete the symbolic-ref \"refs/remotes//HEAD\"."
               (?e "elsewhere"              magit-fetch)
               (?a "all remotes"            magit-fetch-all)
               "Fetch"
+              (?o "another branch"         magit-fetch-branch)
+              (?r "explicit refspec"       magit-fetch-refspec)
               (?m "submodules"             magit-submodule-fetch))
   :default-action 'magit-fetch
   :max-action-columns 1)
@@ -219,6 +221,26 @@ Delete the symbolic-ref \"refs/remotes//HEAD\"."
                      (magit-fetch-arguments)))
   (magit-git-fetch remote args))
 
+;;;###autoload
+(defun magit-fetch-branch (remote branch args)
+  "Fetch a BRANCH from a REMOTE."
+  (interactive
+   (let ((remote (magit-read-remote-or-url "Fetch from remote or url")))
+     (list remote
+           (magit-read-remote-branch "Fetch branch" remote)
+           (magit-fetch-arguments))))
+  (magit-git-fetch remote (cons branch args)))
+
+;;;###autoload
+(defun magit-fetch-refspec (remote refspec args)
+  "Fetch a REFSPEC from a REMOTE."
+  (interactive
+   (let ((remote (magit-read-remote-or-url "Fetch from remote or url")))
+     (list remote
+           (magit-read-refspec "Fetch using refspec" remote)
+           (magit-fetch-arguments))))
+  (magit-git-fetch remote (cons refspec args)))
+
 ;;;###autoload
 (defun magit-fetch-all (args)
   "Fetch from all remotes."
@@ -249,8 +271,7 @@ removed on the respective remote."
   "Popup console for pull commands."
   'magit-commands
   :man-page "git-pull"
-  :variables '("Variables"
-               (?r "branch.%s.rebase"
+  :variables '((?r "branch.%s.rebase"
                    magit-cycle-branch*rebase
                    magit-pull-format-branch*rebase))
   :actions '((lambda ()
@@ -312,6 +333,8 @@ missing.  To add them use something like:
              (?f "remotes"           magit-fetch-all-no-prune)
              (?F "remotes and prune" magit-fetch-all-prune)
              "Fetch"
+             (?o "another branch"    magit-fetch-branch)
+             (?s "explicit refspec"  magit-fetch-refspec)
              (?m "submodules"        magit-submodule-fetch))
   :default-action 'magit-fetch
   :max-action-columns 1)
@@ -377,9 +400,11 @@ available in the popup.  If the value is t, then that argument is
 redundant.  But note that changing the value of this option does
 not take affect immediately, the argument will only be added or
 removed after restarting Emacs."
-  :package-version '(magit . "2.4.0")
+  :package-version '(magit . "2.6.0")
   :group 'magit-commands
-  :type 'boolean)
+  :type '(choice (const :tag "don't set" nil)
+                 (const :tag "set branch..pushRemote" t)
+                 (const :tag "set remote.pushDefault" default)))
 
 ;;;###autoload (autoload 'magit-push-popup "magit-remote" nil t)
 (magit-define-popup magit-push-popup
@@ -428,14 +453,20 @@ the push-remote can be changed before pushed to it."
   (interactive
    (list (magit-push-arguments)
          (and (magit--push-current-set-pushremote-p current-prefix-arg)
-              (magit-read-remote (format "Set push-remote of %s and push there"
-                                         (magit-get-current-branch))))))
+              (magit-read-remote
+               (if (eq magit-push-current-set-remote-if-missing 'default)
+                   "Set `remote.pushDefault' and push there"
+                 (format "Set `branch.%s.pushRemote' and push there"
+                         (magit-get-current-branch)))))))
   (--if-let (magit-get-current-branch)
       (progn (when push-remote
-               (magit-call-git "config"
-                               (format "branch.%s.pushRemote"
-                                       (magit-get-current-branch))
-                               push-remote))
+               (magit-call-git
+                "config"
+                (if (eq magit-push-current-set-remote-if-missing 'default)
+                    "remote.pushDefault"
+                  (format "branch.%s.pushRemote"
+                          (magit-get-current-branch)))
+                push-remote))
              (-if-let (remote (magit-get-push-remote it))
                  (if (member remote (magit-list-remotes))
                      (magit-git-push it (concat remote "/" it) args)
@@ -453,8 +484,12 @@ the push-remote can be changed before pushed to it."
   (--if-let (magit-get-push-branch)
       (concat (magit-branch-set-face it) "\n")
     (and (magit--push-current-set-pushremote-p)
-         (concat (propertize "pushRemote" 'face 'bold)
-                 ", after setting that\n"))))
+         (concat
+          (propertize (if (eq magit-push-current-set-remote-if-missing 'default)
+                          "pushDefault"
+                        "pushRemote")
+                      'face 'bold)
+          ", after setting that\n"))))
 
 ;;;###autoload
 (defun magit-push-current-to-upstream (args &optional upstream)
diff --git a/elpa/magit-20160223.828/magit-section.el b/elpa/magit-20160421.459/magit-section.el
similarity index 98%
rename from elpa/magit-20160223.828/magit-section.el
rename to elpa/magit-20160421.459/magit-section.el
index 596a6fc..93f2c50 100644
--- a/elpa/magit-20160223.828/magit-section.el
+++ b/elpa/magit-20160421.459/magit-section.el
@@ -436,7 +436,7 @@ hidden."
         (dolist (s sections)
           (magit-section-show s)
           (magit-section-hide-children s))
-      (let ((children (cl-mapcan 'magit-section-children sections)))
+      (let ((children (-mapcat 'magit-section-children sections)))
         (cond ((and (-any? 'magit-section-hidden   children)
                     (-any? 'magit-section-children children))
                (mapc 'magit-section-show-headings sections))
@@ -625,7 +625,9 @@ TYPE is the section type, a symbol.  Many commands that act on
 the current section behave differently depending on that type.
 Also if a variable `magit-TYPE-section-map' exists, then use
 that as the text-property `keymap' of all text belonging to the
-section (but this may be overwritten in subsections).
+section (but this may be overwritten in subsections).  TYPE can
+also have the form `(eval FORM)' in which case FORM is evaluated
+at runtime.
 
 Optional VALUE is the value of the section, usually a string
 that is required when acting on the section.
@@ -656,12 +658,18 @@ anything this time around.
 
 \(fn [NAME] (TYPE &optional VALUE HIDE) &rest BODY)"
   (declare (indent defun)
-           (debug ([&optional symbolp] (symbolp &optional form form) body)))
+           (debug ([&optional symbolp]
+                   (&or [("eval" symbolp) &optional form form]
+                        [symbolp &optional form form])
+                   body)))
   (let ((s (if (symbolp (car args))
                (pop args)
              (cl-gensym "section"))))
     `(let* ((,s (make-magit-section
-                 :type ',(nth 0 (car args))
+                 :type ,(let ((type (nth 0 (car args))))
+                          (if (eq (car-safe type) 'eval)
+                              (cadr type)
+                            `',type))
                  :value ,(nth 1 (car args))
                  :start (point-marker)
                  :parent magit-insert-section--parent)))
diff --git a/elpa/magit-20160223.828/magit-sequence.el b/elpa/magit-20160421.459/magit-sequence.el
similarity index 100%
rename from elpa/magit-20160223.828/magit-sequence.el
rename to elpa/magit-20160421.459/magit-sequence.el
diff --git a/elpa/magit-20160223.828/magit-stash.el b/elpa/magit-20160421.459/magit-stash.el
similarity index 97%
rename from elpa/magit-20160223.828/magit-stash.el
rename to elpa/magit-20160421.459/magit-stash.el
index bc435e8..bf5a8f1 100644
--- a/elpa/magit-20160223.828/magit-stash.el
+++ b/elpa/magit-20160421.459/magit-stash.el
@@ -77,7 +77,7 @@ Applying the resulting stash has the inverse effect."
 
 ;;;###autoload
 (defun magit-stash-worktree (message &optional include-untracked)
-  "Create a stash of the working tree only.
+  "Create a stash of unstaged changes in the working tree.
 Untracked files are included according to popup arguments.
 One prefix argument is equivalent to `--include-untracked'
 while two prefix arguments are equivalent to `--all'."
@@ -129,7 +129,7 @@ Unstaged and untracked changes are not stashed."
 
 ;;;###autoload
 (defun magit-snapshot-worktree (&optional include-untracked)
-  "Create a snapshot of the working tree only.
+  "Create a snapshot of unstaged changes in the working tree.
 Untracked files are included according to popup arguments.
 One prefix argument is equivalent to `--include-untracked'
 while two prefix arguments are equivalent to `--all'."
@@ -368,18 +368,18 @@ instead of \"Stashes:\"."
       "--" (or files (nth 3 magit-refresh-args)))))
 
 (defun magit-insert-stash-index ()
-  "Insert section showing the index commit of the stash."
+  "Insert section showing staged changes of the stash."
   (let ((stash (car magit-refresh-args)))
     (magit-stash-insert-section (format "%s^2" stash)
                                 (format "%s^..%s^2" stash stash)
-                                "Index")))
+                                "Staged")))
 
 (defun magit-insert-stash-worktree ()
-  "Insert section showing the worktree commit of the stash."
+  "Insert section showing unstaged changes of the stash."
   (let ((stash (car magit-refresh-args)))
     (magit-stash-insert-section stash
                                 (format "%s^2..%s" stash stash)
-                                "Working tree")))
+                                "Unstaged")))
 
 (defun magit-insert-stash-untracked ()
   "Insert section showing the untracked files commit of the stash."
@@ -390,7 +390,7 @@ instead of \"Stashes:\"."
                                   (format "%s^..%s^3" stash stash)
                                   "Untracked files"
                                   (magit-git-items "ls-tree" "-z" "--name-only"
-                                                   "--full-tree" rev)))))
+                                                   "-r" "--full-tree" rev)))))
 
 ;;; magit-stash.el ends soon
 (provide 'magit-stash)
diff --git a/elpa/magit-20160223.828/magit-submodule.el b/elpa/magit-20160421.459/magit-submodule.el
similarity index 62%
rename from elpa/magit-20160223.828/magit-submodule.el
rename to elpa/magit-20160421.459/magit-submodule.el
index e4c59b3..6e942ce 100644
--- a/elpa/magit-20160223.828/magit-submodule.el
+++ b/elpa/magit-20160421.459/magit-submodule.el
@@ -41,11 +41,15 @@
               (?d "Deinit" magit-submodule-deinit)))
 
 ;;;###autoload
-(defun magit-submodule-add (url &optional path)
+(defun magit-submodule-add (url &optional path name)
   "Add the repository at URL as a submodule.
+
 Optional PATH is the path to the submodule relative to the root
-of the superproject. If it is nil then the path is determined
-based on URL."
+of the superproject.  If it is nil, then the path is determined
+based on URL.
+
+Optional NAME is the name of the submodule.  If it is nil, then
+PATH also becomes the name."
   (interactive
    (magit-with-toplevel
      (let ((path (read-file-name
@@ -62,8 +66,9 @@ based on URL."
                    (let ((default-directory path))
                      (magit-get "remote" (or (magit-get-remote) "origin")
                                 "url"))))
-             (and path (directory-file-name (file-relative-name path)))))))
-  (magit-run-git "submodule" "add" url path))
+             (and path (directory-file-name (file-relative-name path)))
+             (magit-read-string-ns "Name submodule" path)))))
+  (magit-run-git "submodule" "add" (and name (list "--name" name)) url path))
 
 ;;;###autoload
 (defun magit-submodule-setup ()
@@ -114,59 +119,74 @@ With a prefix argument fetch all remotes."
 ;;; Sections
 
 ;;;###autoload
-(defun magit-insert-submodule-commits (section range)
+(defun magit-insert-modules-unpulled-from-upstream ()
+  "Insert sections for modules that haven't been pulled from the upstream.
+These sections can be expanded to show the respective commits."
+  (magit-insert-submodules "Modules unpulled from @{upstream}"
+                           'modules-unpulled-from-upstream
+                           'magit-get-upstream-ref
+                           "HEAD..%s"))
+
+;;;###autoload
+(defun magit-insert-modules-unpulled-from-pushremote ()
+  "Insert sections for modules that haven't been pulled from the push-remote.
+These sections can be expanded to show the respective commits."
+  (magit-insert-submodules "Modules unpulled from "
+                           'modules-unpulled-from-pushremote
+                           'magit-get-push-branch
+                           "HEAD..%s"))
+
+;;;###autoload
+(defun magit-insert-modules-unpushed-to-upstream ()
+  "Insert sections for modules that haven't been pushed to the upstream.
+These sections can be expanded to show the respective commits."
+  (magit-insert-submodules "Modules unmerged into @{upstream}"
+                           'modules-unpushed-to-upstream
+                           'magit-get-upstream-ref
+                           "%s..HEAD"))
+
+;;;###autoload
+(defun magit-insert-modules-unpushed-to-pushremote ()
+  "Insert sections for modules that haven't been pushed to the push-remote.
+These sections can be expanded to show the respective commits."
+  (magit-insert-submodules "Modules unpushed to "
+                           'modules-unpushed-to-pushremote
+                           'magit-get-push-branch
+                           "%s..HEAD"))
+
+(defun magit-insert-submodules (heading type fn format)
   "For internal use, don't add to a hook."
-  (if (magit-section-hidden section)
-      (setf (magit-section-washer section)
-            (apply-partially #'magit-insert-submodule-commits section range))
-    (magit-git-wash (apply-partially 'magit-log-wash-log 'module)
-      "log" "--oneline" range)
-    (when (> (point) (magit-section-content section))
-      (delete-char -1))))
-
-;;;###autoload
-(defun magit-insert-unpulled-module-commits ()
-  "Insert sections for all submodules with unpulled commits.
-These sections can be expanded to show the respective commits."
   (-when-let (modules (magit-get-submodules))
-    (magit-insert-section section (unpulled-modules)
-      (magit-insert-heading "Unpulled modules:")
+    (magit-insert-section section ((eval type) nil t)
+      (string-match "\\`\\(.+\\) \\([^ ]+\\)\\'" heading)
+      (magit-insert-heading
+        (concat
+         (propertize (match-string 1 heading) 'face 'magit-section-heading) " "
+         (propertize (match-string 2 heading) 'face 'magit-branch-remote) ":"))
       (magit-with-toplevel
         (dolist (module modules)
           (let ((default-directory
                   (expand-file-name (file-name-as-directory module))))
-            (-when-let (tracked (magit-get-upstream-ref))
+            (--when-let (and (magit-file-accessible-directory-p default-directory)
+                             (funcall fn))
               (magit-insert-section sec (file module t)
                 (magit-insert-heading
                   (concat (propertize module 'face 'magit-diff-file-heading) ":"))
-                (magit-insert-submodule-commits
-                 section (concat "HEAD.." tracked)))))))
-      (if (> (point) (magit-section-content section))
-          (insert ?\n)
-        (magit-cancel-section)))))
-
-;;;###autoload
-(defun magit-insert-unpushed-module-commits ()
-  "Insert sections for all submodules with unpushed commits.
-These sections can be expanded to show the respective commits."
-  (-when-let (modules (magit-get-submodules))
-    (magit-insert-section section (unpushed-modules)
-      (magit-insert-heading "Unpushed modules:")
-      (magit-with-toplevel
-        (dolist (module modules)
-          (let ((default-directory
-                  (expand-file-name (file-name-as-directory module))))
-            (-when-let (tracked (magit-get-upstream-ref))
-              (magit-insert-section sec (file module t)
-                (magit-insert-heading
-                  (concat (propertize module 'face 'magit-diff-file-heading) ":"))
-                (magit-insert-submodule-commits
-                 section (concat tracked "..HEAD")))))))
+                (magit-git-wash (apply-partially 'magit-log-wash-log 'module)
+                  "log" "--oneline" (format format it))
+                (when (> (point) (magit-section-content sec))
+                  (delete-char -1)))))))
       (if (> (point) (magit-section-content section))
           (insert ?\n)
         (magit-cancel-section)))))
 
 ;;; magit-submodule.el ends soon
+
+(define-obsolete-function-alias 'magit-insert-unpulled-module-commits
+  'magit-insert-modules-unpulled-from-upstream "Magit 2.6.0")
+(define-obsolete-function-alias 'magit-insert-unpushed-module-commits
+  'magit-insert-modules-unpushed-to-upstream "Magit 2.6.0")
+
 (provide 'magit-submodule)
 ;; Local Variables:
 ;; indent-tabs-mode: nil
diff --git a/elpa/magit-20160223.828/magit-utils.el b/elpa/magit-20160421.459/magit-utils.el
similarity index 98%
rename from elpa/magit-20160223.828/magit-utils.el
rename to elpa/magit-20160421.459/magit-utils.el
index ca65830..d988fd6 100644
--- a/elpa/magit-20160223.828/magit-utils.el
+++ b/elpa/magit-20160421.459/magit-utils.el
@@ -405,6 +405,15 @@ Unless optional argument KEEP-EMPTY-LINES is t, trim all empty lines."
       (insert-file-contents file)
       (split-string (buffer-string) "\n" (not keep-empty-lines)))))
 
+;;; Kludges
+
+(defun magit-file-accessible-directory-p (filename)
+  "Like `file-accessible-directory-p' but work around an Apple bug.
+See http://debbugs.gnu.org/cgi/bugreport.cgi?bug=21573#17
+and https://github.com/magit/magit/issues/2295."
+  (and (file-directory-p filename)
+       (file-accessible-directory-p filename)))
+
 ;;; magit-utils.el ends soon
 (provide 'magit-utils)
 ;; Local Variables:
diff --git a/elpa/magit-20160223.828/magit-wip.el b/elpa/magit-20160421.459/magit-wip.el
similarity index 97%
rename from elpa/magit-20160223.828/magit-wip.el
rename to elpa/magit-20160421.459/magit-wip.el
index 6e34997..3702e27 100644
--- a/elpa/magit-20160223.828/magit-wip.el
+++ b/elpa/magit-20160421.459/magit-wip.el
@@ -207,13 +207,13 @@ commit message."
     (unless (equal parent wipref)
       (setq start-msg (concat "restart autosaving " start-msg))
       (magit-update-ref wipref start-msg
-                        (magit-git-string "commit-tree" "-p" parent
-                                          "-m" start-msg
+                        (magit-git-string "commit-tree" "--no-gpg-sign"
+                                          "-p" parent "-m" start-msg
                                           (concat parent "^{tree}")))
       (setq parent wipref))
     (magit-update-ref wipref msg
-                      (magit-git-string "commit-tree" tree
-                                        "-p" parent "-m" msg))))
+                      (magit-git-string "commit-tree" "--no-gpg-sign"
+                                        "-p" parent "-m" msg tree))))
 
 (defun magit-wip-get-ref ()
   (let ((ref (or (magit-git-string "symbolic-ref" "HEAD") "HEAD")))
diff --git a/elpa/magit-20160223.828/magit.el b/elpa/magit-20160421.459/magit.el
similarity index 98%
rename from elpa/magit-20160223.828/magit.el
rename to elpa/magit-20160421.459/magit.el
index 1117f79..2668e91 100644
--- a/elpa/magit-20160223.828/magit.el
+++ b/elpa/magit-20160421.459/magit.el
@@ -16,7 +16,7 @@
 ;;	Rémi Vanicat      
 ;;	Yann Hodique      
 
-;; Package-Requires: ((emacs "24.4") (async "20150909.2257") (dash "20151021.113") (with-editor "20160128.1201") (git-commit "20160119.1409") (magit-popup "20160119.1409"))
+;; Package-Requires: ((emacs "24.4") (async "20150909.2257") (dash "20151021.113") (with-editor "20160408.201") (git-commit "20160412.130") (magit-popup "20160408.156"))
 ;; Keywords: git tools vc
 ;; Homepage: https://github.com/magit/magit
 
@@ -640,8 +640,8 @@ Do so depending on the value of `status.showUntrackedFiles'."
             (magit-insert-heading "Untracked files:")
             (dolist (file files)
               (magit-insert-section (file file)
-                (insert (propertize file 'face 'magit-filename) ?\n))))
-          (insert ?\n))))))
+                (insert (propertize file 'face 'magit-filename) ?\n)))
+            (insert ?\n)))))))
 
 (defun magit-insert-un/tracked-files-1 (files directory)
   (while (and files (string-prefix-p (or directory "") (car files)))
@@ -927,14 +927,14 @@ reference, but it is not checked out."
           (branches (magit-list-local-branch-names)))
       (dolist (line (magit-git-lines "branch" "-vv"
                                      (cadr magit-refresh-args)))
-        (string-match magit-refs-branch-line-re line)
-        (magit-bind-match-strings
-            (branch hash message upstream ahead behind gone) line
-          (when (string-match-p "(HEAD detached" branch)
-            (setq branch nil))
-          (magit-insert-branch
-           branch magit-refs-local-branch-format current branches
-           'magit-branch-local hash message upstream ahead behind gone))))
+        (when (string-match magit-refs-branch-line-re line)
+          (magit-bind-match-strings
+              (branch hash message upstream ahead behind gone) line
+            (when (string-match-p "(HEAD detached" branch)
+              (setq branch nil))
+            (magit-insert-branch
+             branch magit-refs-local-branch-format current branches
+             'magit-branch-local hash message upstream ahead behind gone)))))
     (insert ?\n)))
 
 (defun magit-insert-remote-branches ()
@@ -1143,7 +1143,10 @@ FILE must be relative to the top directory of the repository."
           (setq magit-buffer-revision  (magit-rev-format "%H" rev)
                 magit-buffer-refname   rev
                 magit-buffer-file-name (expand-file-name file topdir))
-          (let ((buffer-file-name magit-buffer-file-name))
+          (let ((buffer-file-name magit-buffer-file-name)
+                (after-change-major-mode-hook
+                 (remq 'global-diff-hl-mode-enable-in-buffers
+                       after-change-major-mode-hook)))
             (normal-mode t))
           (setq buffer-read-only t)
           (set-buffer-modified-p nil)
@@ -1792,10 +1795,11 @@ merge.
   "Merge commit REV into the current branch; and edit message.
 Perform the merge and prepare a commit message but let the user
 edit it.
-\n(git merge --edit [ARGS] rev)"
+\n(git merge --edit --no-ff [ARGS] rev)"
   (interactive (list (magit-read-other-branch-or-commit "Merge")
                      (magit-merge-arguments)))
   (magit-merge-assert)
+  (cl-pushnew "--no-ff" args :test #'equal)
   (with-editor "GIT_EDITOR"
     (let ((magit-process-popup-time -1))
       (magit-run-git-async "merge" "--edit" args rev))))
@@ -1805,10 +1809,11 @@ edit it.
   "Merge commit REV into the current branch; pretending it failed.
 Pretend the merge failed to give the user the opportunity to
 inspect the merge and change the commit message.
-\n(git merge --no-commit [ARGS] rev)"
+\n(git merge --no-commit --no-ff [ARGS] rev)"
   (interactive (list (magit-read-other-branch-or-commit "Merge")
                      (magit-merge-arguments)))
   (magit-merge-assert)
+  (cl-pushnew "--no-ff" args :test #'equal)
   (magit-run-git "merge" "--no-commit" args rev))
 
 ;;;###autoload
@@ -1901,12 +1906,23 @@ If no merge is in progress, do nothing."
 
 ;;;; Reset
 
+;;;###autoload (autoload 'magit-reset-popup "magit" nil t)
+(magit-define-popup magit-reset-popup
+  "Popup console for reset commands."
+  'magit-commands
+  :man-page "git-reset"
+  :actions '((?m "reset mixed  (HEAD and index)"         magit-reset-head)
+             (?s "reset soft   (HEAD only)"              magit-reset-soft)
+             (?h "reset hard   (HEAD, index, and files)" magit-reset-hard)
+             (?i "reset index  (index only)"             magit-reset-index))
+  :max-action-columns 1)
+
 ;;;###autoload
 (defun magit-reset-index (commit)
   "Reset the index to COMMIT.
 Keep the head and working tree as-is, so if COMMIT refers to the
 head this effectively unstages all changes.
-\n(git reset COMMIT)"
+\n(git reset COMMIT .)"
   (interactive (list (magit-read-branch-or-commit "Reset index to")))
   (magit-reset-internal nil commit "."))
 
@@ -2262,12 +2278,13 @@ the current repository."
 
 (magit-define-popup magit-file-popup
   "Popup console for Magit commands in file-visiting buffers."
-  :actions '((?s "Stage"   magit-stage-file)
-             (?l "Log"     magit-log-buffer-file)
-             (?c "Commit"  magit-commit-popup)
-             (?u "Unstage" magit-unstage-file)
-             (?b "Blame"   magit-blame-popup) nil nil
-             (?p "Find blob" magit-blob-previous))
+  :actions '((?s "Stage"     magit-stage-file)
+             (?d "Diff"      magit-diff-buffer-file-popup)
+             (?b "Blame"     magit-blame-popup)
+             (?u "Unstage"   magit-unstage-file)
+             (?l "Log"       magit-log-buffer-file)
+             (?p "Find blob" magit-blob-previous)
+             (?c "Commit"    magit-commit-popup))
   :max-action-columns 3)
 
 (defvar magit-file-mode-lighter "")
@@ -2385,6 +2402,7 @@ Currently this only adds the following key bindings.
              (?f "Fetching"        magit-fetch-popup)
              (?F "Pulling"         magit-pull-popup)
              (?l "Logging"         magit-log-popup)
+             (?L "Change logs"     magit-log-refresh-popup)
              (?m "Merging"         magit-merge-popup)
              (?M "Remoting"        magit-remote-popup)
              (?o "Submodules"      magit-submodule-popup)
@@ -2395,6 +2413,7 @@ Currently this only adds the following key bindings.
              (?V "Reverting"       magit-revert-popup)
              (?w "Apply patches"   magit-am-popup)
              (?W "Format patches"  magit-patch-popup)
+             (?X "Resetting"       magit-reset-popup)
              (?y "Show Refs"       magit-show-refs-popup)
              (?z "Stashing"        magit-stash-popup)
              (?! "Running"         magit-run-popup)
@@ -2529,7 +2548,7 @@ With prefix argument simply read a directory name using
 (defun magit-list-repos-1 (directory depth)
   (cond ((file-readable-p (expand-file-name ".git" directory))
          (list directory))
-        ((and (> depth 0) (file-accessible-directory-p directory))
+        ((and (> depth 0) (magit-file-accessible-directory-p directory))
          (--mapcat (when (file-directory-p it)
                      (magit-list-repos-1 it (1- depth)))
                    (directory-files directory t "^[^.]" t)))))
@@ -2838,10 +2857,11 @@ Git, and Emacs in the echo area."
                               (package-desc-version (cadr it)))))))))))
     (if (stringp magit-version)
         (when (called-interactively-p 'any)
-          (message "Magit %s, Git %s, Emacs %s"
+          (message "Magit %s, Git %s, Emacs %s, %s"
                    (or magit-version "(unknown)")
                    (or (magit-git-version t) "(unknown)")
-                   emacs-version))
+                   emacs-version
+                   system-type))
       (setq debug (reverse debug))
       (setq magit-version 'error)
       (when magit-version
diff --git a/elpa/magit-20160421.459/magit.info b/elpa/magit-20160421.459/magit.info
new file mode 100644
index 0000000..73cbd46
--- /dev/null
+++ b/elpa/magit-20160421.459/magit.info
@@ -0,0 +1,166 @@
+This is magit.info, produced by makeinfo version 5.2 from magit.texi.
+
+Magit is an interface to the version control system Git, implemented as
+an Emacs package.  Magit aspires to be a complete Git porcelain.  While
+we cannot (yet) claim that Magit wraps and improves upon each and every
+Git command, it is complete enough to allow even experienced Git users
+to perform almost all of their daily version control tasks directly from
+within Emacs.  While many fine Git clients exist, only Magit and Git
+itself deserve to be called porcelains.
+
+     Copyright (C) 2015-2016 Jonas Bernoulli 
+
+     You can redistribute this document 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 document 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.
+INFO-DIR-SECTION Emacs
+START-INFO-DIR-ENTRY
+* Magit: (magit).       Using Git from Emacs with Magit.
+END-INFO-DIR-ENTRY
+
+
+Indirect:
+magit.info-1: 1222
+magit.info-2: 321654
+
+Tag Table:
+(Indirect)
+Node: Top1222
+Node: Introduction6032
+Node: Installation10725
+Node: Updating from an older release11100
+Node: Installing from an Elpa archive12695
+Node: Installing from the Git repository14034
+Node: Post-installation tasks16830
+Node: Getting started18219
+Node: Interface concepts23954
+Node: Modes and Buffers24228
+Node: Switching Buffers25974
+Node: Naming Buffers29038
+Node: Quitting Windows31873
+Node: Automatic Refreshing of Magit Buffers33505
+Node: Automatic Saving of File-Visiting Buffers36273
+Node: Automatic Reverting of File-Visiting Buffers37458
+Node: Risk of Reverting Automatically42454
+Node: Sections44837
+Node: Section movement45778
+Node: Section visibility49705
+Node: Section hooks53296
+Node: Section types and values55577
+Node: Section options56847
+Node: Popup buffers and prefix commands57319
+Node: Completion and confirmation58633
+Node: Running Git61539
+Node: Viewing Git output61775
+Node: Running Git manually62775
+Node: Git executable64901
+Node: Global Git arguments66908
+Node: Inspecting67715
+Node: Status buffer68842
+Node: Status sections71365
+Node: Status header sections76612
+Node: Status options79171
+Node: Logging79895
+Node: Refreshing logs82424
+Node: Log Buffer83809
+Node: Select from log86898
+Node: Reflog87838
+Node: Diffing88316
+Node: Refreshing diffs91128
+Node: Diff buffer94109
+Node: Diff options96011
+Node: Revision buffer97767
+Node: Ediffing98722
+Node: References buffer102180
+Node: References sections106890
+Node: Bisecting107765
+Node: Visiting blobs109261
+Node: Blaming109770
+Node: Manipulating113090
+Node: Repository setup113382
+Node: Staging and unstaging114422
+Node: Staging from file-visiting buffers118317
+Node: Applying119485
+Node: Committing121128
+Node: Initiating a commit121711
+Node: Editing commit messages125023
+Node: Branching135419
+Node: Merging148233
+Node: Rebasing150317
+Node: Editing rebase sequences153265
+Node: Rebase sequence log156299
+Node: Cherry picking163043
+Node: Reverting164649
+Node: Resetting166012
+Node: Stashing167522
+Node: Transferring170696
+Node: Remotes170934
+Node: Fetching172220
+Node: Pulling173586
+Node: Pushing174432
+Node: Creating and sending patches179176
+Node: Applying patches179871
+Node: Miscellaneous180869
+Node: Tagging181160
+Node: Notes181945
+Node: Submodules184470
+Node: Common commands185790
+Node: Wip modes187538
+Node: Minor mode for buffers visiting files194274
+Node: Minor mode for buffers visiting blobs196768
+Node: Customizing197573
+Node: Per-repository configuration199245
+Node: Essential settings200879
+Node: Safety201203
+Node: Performance203036
+Node: Committing Performance209709
+Node: Plumbing210690
+Node: Calling Git211318
+Node: Getting a value from Git212841
+Node: Calling Git for effect215945
+Node: Section plumbing222449
+Node: Creating sections222677
+Node: Section selection226576
+Node: Matching sections228256
+Node: Refreshing buffers233458
+Node: Conventions236593
+Node: Confirmation and completion236770
+Node: Theming Faces237668
+Node: FAQ245819
+Node: Magit is slow247230
+Node: I changed several thousand files at once and now Magit is unusable247431
+Node: I am having problems committing248147
+Node: Diffs are collapsed after un-/staging248593
+Node: I don't understand how branching and pushing work249864
+Node: I don't like the key binding in v24250239
+Node: I cannot install the pre-requisites for Magit v2250578
+Node: I am using an Emacs release older than v244251043
+Node: I am using a Git release older than v194252656
+Node: I am using MS Windows and cannot push with Magit253643
+Node: How to install the gitman info manual?254224
+Node: How can I show Git's output?256752
+Node: Diffs contain control sequences257539
+Node: Expanding a file to show the diff causes it to disappear258544
+Node: Point is wrong in the COMMIT_EDITMSG buffer259073
+Node: Can Magit be used as ediff-version-control-package?260091
+Node: How to show diffs for gpg-encrypted files?262115
+Node: Emacs 245 hangs when loading Magit262706
+Node: Symbol's value as function is void --some263275
+Node: Where is the branch manager263595
+Node: Keystroke Index263880
+Node: Command Index291671
+Node: Function Index321654
+Node: Variable Index333777
+
+End Tag Table
+
+
+Local Variables:
+coding: utf-8
+End:
diff --git a/elpa/magit-20160223.828/magit.info-1 b/elpa/magit-20160421.459/magit.info-1
similarity index 97%
rename from elpa/magit-20160223.828/magit.info-1
rename to elpa/magit-20160421.459/magit.info-1
index fe00cdd..5318474 100644
--- a/elpa/magit-20160223.828/magit.info-1
+++ b/elpa/magit-20160421.459/magit.info-1
@@ -70,6 +70,7 @@ itself deserve to be called porcelains.
 
 — The Detailed Node Listing —
 
+
 Installation
 
 * Updating from an older release::
@@ -77,6 +78,9 @@ Installation
 * Installing from the Git repository::
 * Post-installation tasks::
 
+
+
+
 Interface concepts
 
 * Modes and Buffers::
@@ -94,6 +98,7 @@ Modes and Buffers
 * Automatic Saving of File-Visiting Buffers::
 * Automatic Reverting of File-Visiting Buffers::
 
+
 Sections
 
 * Section movement::
@@ -102,6 +107,9 @@ Sections
 * Section types and values::
 * Section options::
 
+
+
+
 Running Git
 
 * Viewing Git output::
@@ -126,6 +134,7 @@ Status buffer
 * Status header sections::
 * Status options::
 
+
 Logging
 
 * Refreshing logs::
@@ -133,6 +142,7 @@ Logging
 * Select from log::
 * Reflog::
 
+
 Diffing
 
 * Refreshing diffs::
@@ -140,6 +150,8 @@ Diffing
 * Diff options::
 * Revision buffer::
 
+
+
 References buffer
 
 * References sections::
@@ -157,20 +169,27 @@ Manipulating
 * Resetting::
 * Stashing::
 
+
 Staging and unstaging
 
 * Staging from file-visiting buffers::
 
+
+
 Committing
 
 * Initiating a commit::
 * Editing commit messages::
 
+
+
+
 Rebasing
 
 * Editing rebase sequences::
 * Rebase sequence log::
 
+
 Cherry picking
 
 * Reverting::
@@ -184,6 +203,8 @@ Transferring
 * Creating and sending patches::
 * Applying patches::
 
+
+
 Miscellaneous
 
 * Tagging::
@@ -194,11 +215,14 @@ Miscellaneous
 * Minor mode for buffers visiting files::
 * Minor mode for buffers visiting blobs::
 
+
+
 Customizing
 
 * Per-repository configuration::
 * Essential settings::
 
+
 Essential settings
 
 * Safety::
@@ -216,12 +240,15 @@ Calling Git
 * Getting a value from Git::
 * Calling Git for effect::
 
+
 Section plumbing
 
 * Creating sections::
 * Section selection::
 * Matching sections::
 
+
+
 Conventions
 
 * Confirmation and completion::
@@ -232,6 +259,7 @@ FAQ
 * Magit is slow::
 * I changed several thousand files at once and now Magit is unusable::
 * I am having problems committing::
+* Diffs are collapsed after un-/staging::
 * I don't understand how branching and pushing work::
 * I don’t like the key binding in v2.4: I don't like the key binding in v24. 
 * I cannot install the pre-requisites for Magit v2::
@@ -240,6 +268,7 @@ FAQ
 * I am using MS Windows and cannot push with Magit::
 * How to install the gitman info manual?::
 * How can I show Git's output?::
+* Diffs contain control sequences::
 * Expanding a file to show the diff causes it to disappear::
 * Point is wrong in the COMMIT_EDITMSG buffer::
 * Can Magit be used as ediff-version-control-package?::
@@ -248,7 +277,6 @@ FAQ
 * Symbol's value as function is void --some::
 * Where is the branch manager::
 
-
 
 File: magit.info,  Node: Introduction,  Next: Installation,  Prev: Top,  Up: Top
 
@@ -1934,6 +1962,30 @@ default the following functions are also members of that hook:
      ‘magit-insert-unpulled-or-recent-commits’ (provided there are no
      unpulled commits) show.
 
+ -- Function: magit-insert-modules-unpulled-from-upstream
+
+     Insert sections for modules that haven’t been pulled from the
+     upstream yet.  These sections can be expanded to show the
+     respective commits.
+
+ -- Function: magit-insert-modules-unpulled-from-pushremote
+
+     Insert sections for modules that haven’t been pulled from the
+     push-remote yet.  These sections can be expanded to show the
+     respective commits.
+
+ -- Function: magit-insert-modules-unpushed-to-upstream
+
+     Insert sections for modules that haven’t been pushed to the
+     upstream yet.  These sections can be expanded to show the
+     respective commits.
+
+ -- Function: magit-insert-modules-unpushed-to-pushremote
+
+     Insert sections for modules that haven’t been pushed to the
+     push-remote yet.  These sections can be expanded to show the
+     respective commits.
+
  -- Function: magit-insert-unpulled-cherries
 
      Insert section showing unpulled commits.  Like
@@ -1941,11 +1993,6 @@ default the following functions are also members of that hook:
      been applied yet (i.e.  a commit with a patch-id not shared with
      any local commit) with "+", and all others with "-".
 
- -- Function: magit-insert-unpulled-module-commits
-
-     Insert sections for all submodules with unpulled commits.  These
-     sections can be expanded to show the respective commits.
-
  -- Function: magit-insert-unpushed-cherries
 
      Insert section showing unpushed commits.  Like
@@ -1954,11 +2001,6 @@ default the following functions are also members of that hook:
      not shared with any upstream commit) with "+" and all others with
      "-".
 
- -- Function: magit-insert-unpushed-module-commits
-
-     Insert sections for all submodules with unpushed commits.  These
-     sections can be expanded to show the respective commits.
-
    See *note References buffer: References buffer. for some more section
 inserters, which could be used here.
 
@@ -2579,6 +2621,10 @@ File: magit.info,  Node: Diff options,  Next: Revision buffer,  Prev: Diff buffe
      value is an integer, highlight indentation with at least that many
      spaces.  Otherwise, highlight neither.
 
+ -- User Option: magit-diff-hide-trailing-cr-characters
+
+     Whether to hide ^M characters at the end of a line in diffs.
+
 
 File: magit.info,  Node: Revision buffer,  Prev: Diff options,  Up: Diffing
 
@@ -2671,6 +2717,10 @@ File: magit.info,  Node: Ediffing,  Next: References buffer,  Prev: Diffing,  Up
 
      Show changes to a file introduced by a commit using Ediff.
 
+‘E z’     (‘magit-ediff-show-stash’)
+
+     Show changes to a file introduced by a stash using Ediff.
+
  -- User Option: magit-ediff-dwim-show-on-hunks
 
      This option controls what command ‘magit-ediff-dwim’ calls when
@@ -2679,6 +2729,13 @@ File: magit.info,  Node: Ediffing,  Next: References buffer,  Prev: Diffing,  Up
      ‘magit-ediff-show-unstaged’ to show staged and unstaged changes,
      respectively.
 
+ -- User Option: magit-ediff-show-stash-with-index
+
+     This option controls whether ‘magit-ediff-show-stash’ includes a
+     buffer containing the file’s state in the index at the time the
+     stash was created.  This makes it possible to tell which changes in
+     the stash were staged.
+
  -- User Option: magit-ediff-quit-hook
 
      This hook is run after quitting an Ediff session that was created
@@ -4461,10 +4518,10 @@ Also see *note (gitman)git-stash:: .
 
 ‘z w’     (‘magit-stash-worktree’)
 
-     Create a stash of the working tree only.  Untracked files are
-     included according to popup arguments.  One prefix argument is
-     equivalent to ‘--include-untracked’ while two prefix arguments are
-     equivalent to ‘--all’.
+     Create a stash of unstaged changes in the working tree.  Untracked
+     files are included according to popup arguments.  One prefix
+     argument is equivalent to ‘--include-untracked’ while two prefix
+     arguments are equivalent to ‘--all’.
 
 ‘z x’     (‘magit-stash-keep-index’)
 
@@ -4487,10 +4544,10 @@ Also see *note (gitman)git-stash:: .
 
 ‘z W’     (‘magit-snapshot-worktree’)
 
-     Create a snapshot of the working tree only.  Untracked files are
-     included according to popup arguments.  One prefix argument is
-     equivalent to ‘--include-untracked’ while two prefix arguments are
-     equivalent to ‘--all’-.
+     Create a snapshot of unstaged changes in the working tree.
+     Untracked files are included according to popup arguments.  One
+     prefix argument is equivalent to ‘--include-untracked’ while two
+     prefix arguments are equivalent to ‘--all’-.
 
 ‘z a’     (‘magit-stash-apply’)
 
@@ -4616,6 +4673,16 @@ _push-remote_, see *note Branching: Branching.
 
      Fetch from another repository.
 
+‘f o’     (‘magit-fetch-branch’)
+
+     Fetch a branch from a remote, both of which are read from the
+     minibuffer.
+
+‘f r’     (‘magit-fetch-refspec’)
+
+     Fetch from a remote using an explicit refspec, both of which are
+     read from the minibuffer.
+
 ‘f a’     (‘magit-fetch-all’)
 
      Fetch from all remotes.
@@ -4705,6 +4772,15 @@ _push-remote_, see *note Branching: Branching.
      Push an arbitrary branch or commit somewhere.  Both the source and
      the target are read in the minibuffer.
 
+‘P r’     (‘magit-push-refspecs’)
+
+     Push one or multiple refspecs to a remote, both of which are read
+     in the minibuffer.
+
+     To use multiple refspecs, separate them with commas.  Completion is
+     only available for the part before the colon, or when no colon is
+     used.
+
 ‘P m’     (‘magit-push-matching’)
 
      Push all matching branches to another repository.  If multiple
@@ -5220,6 +5296,20 @@ few key bindings, but this might be extended in the future.
      Unstage all changes to the file being visited in the current
      buffer.
 
+‘C-c M-g c’     (‘magit-commit-popup’)
+
+     This prefix command shows suffix commands along with the
+     appropriate infix arguments in a popup buffer.  See *note
+     Initiating a commit: Initiating a commit.
+
+‘C-c M-g d’     (‘magit-diff-buffer-file-popup’)
+
+     This prefix command shows the same suffix commands and infix
+     arguments in a popup buffer as ‘magit-diff-popup’.  But this
+     variant has to be called from a file-visiting buffer and the
+     visited file is automatically used in the popup to limit the diff
+     to that file.
+
 ‘C-c M-g l’     (‘magit-log-buffer-file’)
 
      This command shows the log for the file of blob that the current
@@ -5236,12 +5326,6 @@ few key bindings, but this might be extended in the future.
 
      Visit the previous blob which modified the current file.
 
-‘C-c M-g c’     (‘magit-commit-popup’)
-
-     This prefix command shows suffix commands along with the
-     appropriate infix arguments in a popup buffer.  See *note
-     Initiating a commit: Initiating a commit.
-
 
 File: magit.info,  Node: Minor mode for buffers visiting blobs,  Prev: Minor mode for buffers visiting files,  Up: Miscellaneous
 
@@ -5897,7 +5981,8 @@ File: magit.info,  Node: Creating sections,  Next: Section selection,  Up: Secti
      current section behave differently depending on that type.  Also if
      a variable ‘magit-TYPE-section-map’ exists, then use that as the
      text-property ‘keymap’ of all text belonging to the section (but
-     this may be overwritten in subsections).
+     this may be overwritten in subsections).  TYPE can also have the
+     form ‘(eval FORM)’ in which case FORM is evaluated at runtime.
 
      Optional VALUE is the value of the section, usually a string that
      is required when acting on the section.
@@ -6387,6 +6472,7 @@ made it into the manual yet, see
 * Magit is slow::
 * I changed several thousand files at once and now Magit is unusable::
 * I am having problems committing::
+* Diffs are collapsed after un-/staging::
 * I don't understand how branching and pushing work::
 * I don’t like the key binding in v2.4: I don't like the key binding in v24. 
 * I cannot install the pre-requisites for Magit v2::
@@ -6395,6 +6481,7 @@ made it into the manual yet, see
 * I am using MS Windows and cannot push with Magit::
 * How to install the gitman info manual?::
 * How can I show Git's output?::
+* Diffs contain control sequences::
 * Expanding a file to show the diff causes it to disappear::
 * Point is wrong in the COMMIT_EDITMSG buffer::
 * Can Magit be used as ediff-version-control-package?::
@@ -6426,7 +6513,7 @@ satisfactory performance, because that requires some heavy refactoring.
 one commit.  Also see *note Performance: Performance.
 
 
-File: magit.info,  Node: I am having problems committing,  Next: I don't understand how branching and pushing work,  Prev: I changed several thousand files at once and now Magit is unusable,  Up: FAQ
+File: magit.info,  Node: I am having problems committing,  Next: Diffs are collapsed after un-/staging,  Prev: I changed several thousand files at once and now Magit is unusable,  Up: FAQ
 
 A.3 I am having problems committing
 ===================================
@@ -6436,9 +6523,34 @@ emacsclient executable.  See *note (with-editor)Configuring
 With-Editor:: and *note (with-editor)Debugging::.
 
 
-File: magit.info,  Node: I don't understand how branching and pushing work,  Next: I don't like the key binding in v24,  Prev: I am having problems committing,  Up: FAQ
+File: magit.info,  Node: Diffs are collapsed after un-/staging,  Next: I don't understand how branching and pushing work,  Prev: I am having problems committing,  Up: FAQ
 
-A.4 I don’t understand how branching and pushing work
+A.4 Diffs are collapsed after un-/staging
+=========================================
+
+Currently when one part of a Magit buffer has to be updated the whole
+buffer is recreated from scratch.  That obviously isn’t good for
+performance and will be fixed eventually.  Meanwhile we need a kludge
+that prevents the update from taking very long under certain
+circumstances, e.g.  when showing the difference for hundrets of changes
+files.
+
+   For that reason the variable ‘magit-diff-expansion-treshhold’ was
+added, defaulting to one second.  If it takes longer than that to
+recreate a Magit buffer, then no further diff sections are expanded
+because that’s one of the steps that take the longest.  If a diff is not
+expanded, then some work can be delayed until it actually is.
+
+   You can then still expand sections manually, but when you refresh the
+complete buffer explicitly using ‘g’ or by performing an action which
+triggers a refresh, then previously expanded diffs could be collapsed.
+You can set ‘magit-diff-expansion-treshhold’ to a higher value to
+prevent that from happening.
+
+
+File: magit.info,  Node: I don't understand how branching and pushing work,  Next: I don't like the key binding in v24,  Prev: Diffs are collapsed after un-/staging,  Up: FAQ
+
+A.5 I don’t understand how branching and pushing work
 =====================================================
 
 Please see *note Branching: Branching. and
@@ -6447,7 +6559,7 @@ Please see *note Branching: Branching. and
 
 File: magit.info,  Node: I don't like the key binding in v24,  Next: I cannot install the pre-requisites for Magit v2,  Prev: I don't understand how branching and pushing work,  Up: FAQ
 
-A.5 I don’t like the key binding in v2.4
+A.6 I don’t like the key binding in v2.4
 ========================================
 
 Please see .
@@ -6455,7 +6567,7 @@ Please see .
 
 File: magit.info,  Node: I cannot install the pre-requisites for Magit v2,  Next: I am using an Emacs release older than v244,  Prev: I don't like the key binding in v24,  Up: FAQ
 
-A.6 I cannot install the pre-requisites for Magit v2
+A.7 I cannot install the pre-requisites for Magit v2
 ====================================================
 
 An Elpa archive featuring obsolete Magit v1.4.2 and its dependencies is
@@ -6465,7 +6577,7 @@ obsolete and no longer maintained.
 
 File: magit.info,  Node: I am using an Emacs release older than v244,  Next: I am using a Git release older than v194,  Prev: I cannot install the pre-requisites for Magit v2,  Up: FAQ
 
-A.7 I am using an Emacs release older than v24.4
+A.8 I am using an Emacs release older than v24.4
 ================================================
 
 At least Emacs v24.4 is required.  There is no way around it, if you
@@ -6498,7 +6610,7 @@ is available from .
 
 File: magit.info,  Node: I am using a Git release older than v194,  Next: I am using MS Windows and cannot push with Magit,  Prev: I am using an Emacs release older than v244,  Up: FAQ
 
-A.8 I am using a Git release older than v1.9.4
+A.9 I am using a Git release older than v1.9.4
 ==============================================
 
 At least Git v1.9.4 is required.  There is no way around it, if you want
@@ -6520,8 +6632,8 @@ is available from .
 
 File: magit.info,  Node: I am using MS Windows and cannot push with Magit,  Next: How to install the gitman info manual?,  Prev: I am using a Git release older than v194,  Up: FAQ
 
-A.9 I am using MS Windows and cannot push with Magit
-====================================================
+A.10 I am using MS Windows and cannot push with Magit
+=====================================================
 
 It’s almost certain that Magit is only incidental to this issue.  It is
 much more likely that this is a configuration issue, even if you can
@@ -6533,7 +6645,7 @@ push on the command line.
 
 File: magit.info,  Node: How to install the gitman info manual?,  Next: How can I show Git's output?,  Prev: I am using MS Windows and cannot push with Magit,  Up: FAQ
 
-A.10 How to install the gitman info manual?
+A.11 How to install the gitman info manual?
 ===========================================
 
 Git’s manpages can be exported as an info manual called ‘gitman’.
@@ -6586,9 +6698,9 @@ variation with used the Emacs Lisp implementation provided by the
 just one of many issues.)
 
 
-File: magit.info,  Node: How can I show Git's output?,  Next: Expanding a file to show the diff causes it to disappear,  Prev: How to install the gitman info manual?,  Up: FAQ
+File: magit.info,  Node: How can I show Git's output?,  Next: Diffs contain control sequences,  Prev: How to install the gitman info manual?,  Up: FAQ
 
-A.11 How can I show Git’s output?
+A.12 How can I show Git’s output?
 =================================
 
 To show the output of recently run git commands, press ‘$’ (or, if that
@@ -6603,9 +6715,31 @@ For debugging purposes it’s possible to do so anyway by setting
 ‘magit-git-debug’ to ‘t’.
 
 
-File: magit.info,  Node: Expanding a file to show the diff causes it to disappear,  Next: Point is wrong in the COMMIT_EDITMSG buffer,  Prev: How can I show Git's output?,  Up: FAQ
+File: magit.info,  Node: Diffs contain control sequences,  Next: Expanding a file to show the diff causes it to disappear,  Prev: How can I show Git's output?,  Up: FAQ
 
-A.12 Expanding a file to show the diff causes it to disappear
+A.13 Diffs contain control sequences
+====================================
+
+This happens when you configure Git to always color diffs and/or all of
+its output.  The valid values for relevant Git variables ‘color.ui’ and
+‘color.diff’ are ‘false’, ‘true’ and ‘always’, and the default is
+‘true’.  You should leave it that because then you get colorful output
+in terminals but git’s output is consumed by something else, then no
+colors are used.
+
+   If you actually use some other tool which expects that requires that
+you force git to output control sequences (which is highly unlikely),
+then you can override these settings just for Magit by using:
+
+     (setq magit-git-global-arguments
+           (nconc magit-git-global-arguments
+     	     '("-c" "color.ui=false"
+     	       "-c" "color.diff=false")))
+
+
+File: magit.info,  Node: Expanding a file to show the diff causes it to disappear,  Next: Point is wrong in the COMMIT_EDITMSG buffer,  Prev: Diffs contain control sequences,  Up: FAQ
+
+A.14 Expanding a file to show the diff causes it to disappear
 =============================================================
 
 This is probably caused by a change of a ‘diff.*’ Git variable.  You
@@ -6615,7 +6749,7 @@ that setting in Magit by customizing ‘magit-git-global-arguments’.
 
 File: magit.info,  Node: Point is wrong in the COMMIT_EDITMSG buffer,  Next: Can Magit be used as ediff-version-control-package?,  Prev: Expanding a file to show the diff causes it to disappear,  Up: FAQ
 
-A.13 Point is wrong in the COMMIT_EDITMSG buffer
+A.15 Point is wrong in the COMMIT_EDITMSG buffer
 ================================================
 
 Neither Magit nor ‘git-commit‘ fiddle with point in the buffer used to
@@ -6639,7 +6773,7 @@ help:
 
 File: magit.info,  Node: Can Magit be used as ediff-version-control-package?,  Next: How to show diffs for gpg-encrypted files?,  Prev: Point is wrong in the COMMIT_EDITMSG buffer,  Up: FAQ
 
-A.14 Can Magit be used as ediff-version-control-package?
+A.16 Can Magit be used as ediff-version-control-package?
 ========================================================
 
 No, it cannot.  For that to work the functions ‘ediff-magit-internal’
@@ -6674,7 +6808,7 @@ only shows yet-to-be resolved conflicts.
 
 File: magit.info,  Node: How to show diffs for gpg-encrypted files?,  Next: Emacs 245 hangs when loading Magit,  Prev: Can Magit be used as ediff-version-control-package?,  Up: FAQ
 
-A.15 How to show diffs for gpg-encrypted files?
+A.17 How to show diffs for gpg-encrypted files?
 ===============================================
 
 Git supports showing diffs for encrypted files, but has to be told to do
@@ -6687,7 +6821,7 @@ affects the diffs displayed inside Magit.
 
 File: magit.info,  Node: Emacs 245 hangs when loading Magit,  Next: Symbol's value as function is void --some,  Prev: How to show diffs for gpg-encrypted files?,  Up: FAQ
 
-A.16 Emacs 24.5 hangs when loading Magit
+A.18 Emacs 24.5 hangs when loading Magit
 ========================================
 
 This is actually triggered by loading Tramp.  See
@@ -6699,7 +6833,7 @@ Google’s ‘8.8.8.8’) may also be sufficient to work around the issue.
 
 File: magit.info,  Node: Symbol's value as function is void --some,  Next: Where is the branch manager,  Prev: Emacs 245 hangs when loading Magit,  Up: FAQ
 
-A.17 Symbol’s value as function is void –some
+A.19 Symbol’s value as function is void –some
 =============================================
 
 Update ‘dash’, restart Emacs, and then it will be defined.
@@ -6707,7 +6841,7 @@ Update ‘dash’, restart Emacs, and then it will be defined.
 
 File: magit.info,  Node: Where is the branch manager,  Prev: Symbol's value as function is void --some,  Up: FAQ
 
-A.18 Where is the branch manager
+A.20 Where is the branch manager
 ================================
 
 ‘y’ is bound to the command that shows the "refs buffer", the successor
@@ -6826,13 +6960,15 @@ Appendix B Keystroke Index
 * C-c M-g:                               Minor mode for buffers visiting files.
                                                               (line  19)
 * C-c M-g b:                             Minor mode for buffers visiting files.
-                                                              (line  39)
+                                                              (line  53)
 * C-c M-g c:                             Minor mode for buffers visiting files.
-                                                              (line  49)
-* C-c M-g l:                             Minor mode for buffers visiting files.
                                                               (line  33)
+* C-c M-g d:                             Minor mode for buffers visiting files.
+                                                              (line  39)
+* C-c M-g l:                             Minor mode for buffers visiting files.
+                                                              (line  47)
 * C-c M-g p:                             Minor mode for buffers visiting files.
-                                                              (line  45)
+                                                              (line  59)
 * C-c M-g s:                             Minor mode for buffers visiting files.
                                                               (line  24)
 * C-c M-g u:                             Minor mode for buffers visiting files.
@@ -6875,16 +7011,19 @@ Appendix B Keystroke Index
 * E s:                                   Ediffing.            (line  45)
 * E u:                                   Ediffing.            (line  50)
 * E w:                                   Ediffing.            (line  58)
+* E z:                                   Ediffing.            (line  66)
 * f:                                     Editing rebase sequences.
                                                               (line  63)
 * f <1>:                                 Fetching.            (line  11)
 * F:                                     Pulling.             (line  11)
-* f a:                                   Fetching.            (line  28)
+* f a:                                   Fetching.            (line  38)
 * f e:                                   Fetching.            (line  24)
 * F e:                                   Pulling.             (line  24)
-* f m:                                   Fetching.            (line  32)
+* f m:                                   Fetching.            (line  42)
+* f o:                                   Fetching.            (line  28)
 * f p:                                   Fetching.            (line  16)
 * F p:                                   Pulling.             (line  16)
+* f r:                                   Fetching.            (line  33)
 * f u:                                   Fetching.            (line  20)
 * F u:                                   Pulling.             (line  20)
 * g:                                     Automatic Refreshing of Magit Buffers.
@@ -6992,11 +7131,12 @@ Appendix B Keystroke Index
 * p <3>:                                 Minor mode for buffers visiting blobs.
                                                               (line  12)
 * P e:                                   Pushing.             (line  35)
-* P m:                                   Pushing.             (line  44)
+* P m:                                   Pushing.             (line  53)
 * P o:                                   Pushing.             (line  39)
 * P p:                                   Pushing.             (line  16)
-* P t:                                   Pushing.             (line  50)
-* P T:                                   Pushing.             (line  56)
+* P r:                                   Pushing.             (line  44)
+* P t:                                   Pushing.             (line  59)
+* P T:                                   Pushing.             (line  65)
 * P u:                                   Pushing.             (line  26)
 * q:                                     Quitting Windows.    (line   6)
 * q <1>:                                 Log Buffer.          (line  12)
@@ -7179,7 +7319,7 @@ Appendix C Command Index
 * magit-blame-next-chunk-same-commit:    Blaming.             (line  58)
 * magit-blame-popup:                     Blaming.             (line  24)
 * magit-blame-popup <1>:                 Minor mode for buffers visiting files.
-                                                              (line  39)
+                                                              (line  53)
 * magit-blame-previous-chunk:            Blaming.             (line  62)
 * magit-blame-previous-chunk-same-commit: Blaming.            (line  66)
 * magit-blame-quit:                      Blaming.             (line  70)
@@ -7187,7 +7327,7 @@ Appendix C Command Index
 * magit-blob-next:                       Minor mode for buffers visiting blobs.
                                                               (line  16)
 * magit-blob-previous:                   Minor mode for buffers visiting files.
-                                                              (line  45)
+                                                              (line  59)
 * magit-blob-previous <1>:               Minor mode for buffers visiting blobs.
                                                               (line  12)
 * magit-branch:                          Branching.           (line 190)
@@ -7213,7 +7353,7 @@ Appendix C Command Index
 * magit-commit-instant-squash:           Initiating a commit. (line  62)
 * magit-commit-popup:                    Initiating a commit. (line   8)
 * magit-commit-popup <1>:                Minor mode for buffers visiting files.
-                                                              (line  49)
+                                                              (line  33)
 * magit-commit-reword:                   Initiating a commit. (line  32)
 * magit-commit-squash:                   Initiating a commit. (line  54)
 * magit-copy-buffer-revision:            Common commands.     (line  21)
@@ -7222,6 +7362,8 @@ Appendix C Command Index
                                                               (line  13)
 * magit-describe-section <1>:            Matching sections.   (line   6)
 * magit-diff:                            Diffing.             (line  29)
+* magit-diff-buffer-file-popup:          Minor mode for buffers visiting files.
+                                                              (line  39)
 * magit-diff-default-context:            Refreshing diffs.    (line  62)
 * magit-diff-dwim:                       Diffing.             (line  25)
 * magit-diff-flip-revs:                  Refreshing diffs.    (line  45)
@@ -7260,14 +7402,17 @@ Appendix C Command Index
 * magit-ediff-resolve:                   Ediffing.            (line  32)
 * magit-ediff-show-commit:               Ediffing.            (line  62)
 * magit-ediff-show-staged:               Ediffing.            (line  54)
+* magit-ediff-show-stash:                Ediffing.            (line  66)
 * magit-ediff-show-unstaged:             Ediffing.            (line  50)
 * magit-ediff-show-working-tree:         Ediffing.            (line  58)
 * magit-ediff-stage:                     Ediffing.            (line  45)
 * magit-fetch:                           Fetching.            (line  24)
-* magit-fetch-all:                       Fetching.            (line  28)
+* magit-fetch-all:                       Fetching.            (line  38)
+* magit-fetch-branch:                    Fetching.            (line  28)
 * magit-fetch-from-pushremote:           Fetching.            (line  16)
 * magit-fetch-from-upstream:             Fetching.            (line  20)
 * magit-fetch-popup:                     Fetching.            (line  11)
+* magit-fetch-refspec:                   Fetching.            (line  33)
 * magit-file-popup:                      Minor mode for buffers visiting files.
                                                               (line  19)
 * magit-find-file:                       Visiting blobs.      (line   6)
@@ -7292,7 +7437,7 @@ Appendix C Command Index
 * magit-log-branches:                    Logging.             (line  48)
 * magit-log-buffer-file:                 Logging.             (line  67)
 * magit-log-buffer-file <1>:             Minor mode for buffers visiting files.
-                                                              (line  33)
+                                                              (line  47)
 * magit-log-bury-buffer:                 Log Buffer.          (line  12)
 * magit-log-current:                     Logging.             (line  31)
 * magit-log-double-commit-limit:         Log Buffer.          (line  53)
@@ -7338,12 +7483,13 @@ Appendix C Command Index
 * magit-push-current:                    Pushing.             (line  35)
 * magit-push-current-to-pushremote:      Pushing.             (line  16)
 * magit-push-current-to-upstream:        Pushing.             (line  26)
-* magit-push-implicitly args:            Pushing.             (line  64)
-* magit-push-matching:                   Pushing.             (line  44)
+* magit-push-implicitly args:            Pushing.             (line  73)
+* magit-push-matching:                   Pushing.             (line  53)
 * magit-push-popup:                      Pushing.             (line  11)
-* magit-push-tag:                        Pushing.             (line  56)
-* magit-push-tags:                       Pushing.             (line  50)
-* magit-push-to-remote remote args:      Pushing.             (line  75)
+* magit-push-refspecs:                   Pushing.             (line  44)
+* magit-push-tag:                        Pushing.             (line  65)
+* magit-push-tags:                       Pushing.             (line  59)
+* magit-push-to-remote remote args:      Pushing.             (line  84)
 * magit-rebase:                          Rebasing.            (line  25)
 * magit-rebase-abort:                    Rebasing.            (line  84)
 * magit-rebase-autosquash:               Rebasing.            (line  57)
@@ -7460,7 +7606,7 @@ Appendix C Command Index
 * magit-stash-worktree:                  Stashing.            (line  25)
 * magit-status:                          Status buffer.       (line  22)
 * magit-submodule-add:                   Submodules.          (line  13)
-* magit-submodule-fetch:                 Fetching.            (line  32)
+* magit-submodule-fetch:                 Fetching.            (line  42)
 * magit-submodule-fetch <1>:             Submodules.          (line  37)
 * magit-submodule-init:                  Submodules.          (line  24)
 * magit-submodule-init <1>:              Submodules.          (line  41)
diff --git a/elpa/magit-20160223.828/magit.info-2 b/elpa/magit-20160421.459/magit.info-2
similarity index 97%
rename from elpa/magit-20160223.828/magit.info-2
rename to elpa/magit-20160421.459/magit.info-2
index bbd3ef1770e6ba7eb763c9ddc8a6437198c53399..7b78ff236cfe9ce1810e2bef607b530fec177096 100644
GIT binary patch
delta 379
zcmdnDnQ_T>#tj)fjE0jlc_uQNZ~o1b%rkiwC->w`$(iiA`6;D2sl}6f<+Ug85_h#S
zG&0cS(o)DxOwTOQ&CDxKEh^E4s?jaYD=5v$NlnpBE6UH+EiEW6DN0SuwNeN!Nh~QX
zp1eWae{z+)h%mD9;tZhjlKjcDZ{j;?(4l%>2A!y~z(0q&G83
zRkAV}TTEW4AUgTBJlEto^1YLb6v~)POo2jDn|&2iSSDvG^Gx2WYRhC{viXnd4LPZl
zRNa!I#LS$`ymZ~
 ;; URL: https://github.com/terranpro/magit-gerrit
-;; Package-Version: 20160128.1926
+;; Package-Version: 20160226.130
 ;; Package-Requires: ((magit "2.3.1"))
 ;;
 ;; This program is free software; you can redistribute it and/or
@@ -271,6 +271,11 @@ Succeed even if branch already exist
 (defun magit-gerrit-review-at-point ()
   (get-text-property (point) 'magit-gerrit-jobj))
 
+(defsubst magit-gerrit-process-wait ()
+  (while (and magit-this-process
+	      (eq (process-status magit-this-process) 'run))
+    (sleep-for 0.005)))
+
 (defun magit-gerrit-view-patchset-diff ()
   "View the Diff for a Patchset"
   (interactive)
@@ -281,7 +286,7 @@ Succeed even if branch already exist
 	(let* ((magit-proc (magit-fetch magit-gerrit-remote ref)))
 	  (message (format "Waiting a git fetch from %s to complete..."
 			   magit-gerrit-remote))
-	  (magit-process-wait))
+	  (magit-gerrit-process-wait))
 	(message (format "Generating Gerrit Patchset for refs %s dir %s" ref dir))
 	(magit-diff "FETCH_HEAD~1..FETCH_HEAD")))))
 
@@ -298,7 +303,7 @@ Succeed even if branch already exist
 	(let* ((magit-proc (magit-fetch magit-gerrit-remote ref)))
 	  (message (format "Waiting a git fetch from %s to complete..."
 			   magit-gerrit-remote))
-	  (magit-process-wait))
+	  (magit-gerrit-process-wait))
 	(message (format "Checking out refs %s to %s in %s" ref branch dir))
 	(magit-gerrit-create-branch-force branch "FETCH_HEAD")))))
 
@@ -506,7 +511,7 @@ Succeed even if branch already exist
   :options '((?m "Comment"                      "--message "       magit-gerrit-read-comment)))
 
 ;; Attach Magit Gerrit to Magit's default help popup
-(magit-define-popup-action 'magit-dispatch-popup ?R "Gerrit"
+(magit-define-popup-action 'magit-dispatch-popup (string-to-char magit-gerrit-popup-prefix) "Gerrit"
   'magit-gerrit-popup)
 
 (magit-define-popup magit-gerrit-copy-review-popup
diff --git a/elpa/magit-gh-pulls-20160222.1802/magit-gh-pulls-autoloads.el b/elpa/magit-gh-pulls-20160413.1451/magit-gh-pulls-autoloads.el
similarity index 85%
rename from elpa/magit-gh-pulls-20160222.1802/magit-gh-pulls-autoloads.el
rename to elpa/magit-gh-pulls-20160413.1451/magit-gh-pulls-autoloads.el
index 1f9a731..f5c9406 100644
--- a/elpa/magit-gh-pulls-20160222.1802/magit-gh-pulls-autoloads.el
+++ b/elpa/magit-gh-pulls-20160413.1451/magit-gh-pulls-autoloads.el
@@ -3,8 +3,8 @@
 ;;; Code:
 (add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
 
-;;;### (autoloads nil "magit-gh-pulls" "magit-gh-pulls.el" (22221
-;;;;;;  60704 390000 0))
+;;;### (autoloads nil "magit-gh-pulls" "magit-gh-pulls.el" (22297
+;;;;;;  19803 997314 423000))
 ;;; Generated autoloads from magit-gh-pulls.el
 
 (autoload 'magit-gh-pulls-mode "magit-gh-pulls" "\
diff --git a/elpa/magit-gh-pulls-20160222.1802/magit-gh-pulls-pkg.el b/elpa/magit-gh-pulls-20160413.1451/magit-gh-pulls-pkg.el
similarity index 73%
rename from elpa/magit-gh-pulls-20160222.1802/magit-gh-pulls-pkg.el
rename to elpa/magit-gh-pulls-20160413.1451/magit-gh-pulls-pkg.el
index 561b26b..d808d20 100644
--- a/elpa/magit-gh-pulls-20160222.1802/magit-gh-pulls-pkg.el
+++ b/elpa/magit-gh-pulls-20160413.1451/magit-gh-pulls-pkg.el
@@ -1 +1 @@
-(define-package "magit-gh-pulls" "20160222.1802" "GitHub pull requests extension for Magit" '((emacs "24") (gh "0.9.1") (magit "2.1.0") (pcache "0.2.3") (s "1.6.1")) :url "https://github.com/sigma/magit-gh-pulls" :keywords '("git" "tools"))
+(define-package "magit-gh-pulls" "20160413.1451" "GitHub pull requests extension for Magit" '((emacs "24") (gh "0.9.1") (magit "2.1.0") (pcache "0.2.3") (s "1.6.1")) :url "https://github.com/sigma/magit-gh-pulls" :keywords '("git" "tools"))
diff --git a/elpa/magit-gh-pulls-20160222.1802/magit-gh-pulls.el b/elpa/magit-gh-pulls-20160413.1451/magit-gh-pulls.el
similarity index 97%
rename from elpa/magit-gh-pulls-20160222.1802/magit-gh-pulls.el
rename to elpa/magit-gh-pulls-20160413.1451/magit-gh-pulls.el
index 94e91ef..76caa9f 100644
--- a/elpa/magit-gh-pulls-20160222.1802/magit-gh-pulls.el
+++ b/elpa/magit-gh-pulls-20160413.1451/magit-gh-pulls.el
@@ -4,7 +4,7 @@
 
 ;; Author: Yann Hodique 
 ;; Keywords: git tools
-;; Package-Version: 20160222.1802
+;; Package-Version: 20160413.1451
 ;; Version: 0.5.2
 ;; URL: https://github.com/sigma/magit-gh-pulls
 ;; Package-Requires: ((emacs "24") (gh "0.9.1") (magit "2.1.0") (pcache "0.2.3") (s "1.6.1"))
@@ -64,6 +64,7 @@
 (require 'gh-pulls)
 (require 'pcache)
 (require 's)
+(require 'cl-lib)
 
 (defgroup magit-gh-pulls nil
   "Github.com pull-requests for Magit."
@@ -234,20 +235,21 @@ option, or inferred from remotes."
                             (funcall magit-gh-pulls-maybe-filter-pulls
                                      (oref (gh-pulls-list api user proj) :data))))
                    (num-total-stubs (length stubs))
+                   (i 0)
                    (branch (magit-get-current-branch)))
               (when (or (> (length stubs) 0) (not cached?))
                 (magit-insert-section (pulls)
                   (magit-insert-heading "Pull Requests:")
                   (dolist (stub stubs)
+                    (cl-incf i)
                     (let* ((id (oref stub :number))
-                           (req (oref (gh-pulls-get api user proj id) :data))
-                           (base-sha (oref (oref req :base) :sha))
-                           (base-ref (oref (oref req :base) :ref))
-                           (head-sha (oref (oref req :head) :sha))
+                           (base-sha (oref (oref stub :base) :sha))
+                           (base-ref (oref (oref stub :base) :ref))
+                           (head-sha (oref (oref stub :head) :sha))
                            ;; branch has been deleted in the meantime...
-                           (invalid (equal (oref (oref req :head) :ref) head-sha))
+                           (invalid (equal (oref (oref stub :head) :ref) head-sha))
                            (have-commits
-                            (and (>= magit-gh-pulls-pull-detail-limit num-total-stubs)
+                            (and (>= magit-gh-pulls-pull-detail-limit i)
                                  (eql 0 (magit-git-exit-code "cat-file" "-e" base-sha))
                                  (eql 0 (magit-git-exit-code "cat-file" "-e" head-sha))))
                            (applied (and have-commits
@@ -262,7 +264,7 @@ option, or inferred from remotes."
                                                     'face 'magit-branch-local)
                                       base-ref)
                                     (propertize
-                                     (oref req :title) 'face
+                                     (oref stub :title) 'face
                                      (cond (applied 'magit-cherry-equivalent)
                                            (have-commits nil)
                                            (invalid 'error)
@@ -362,7 +364,7 @@ option, or inferred from remotes."
     (unfetched-pull
      (let* ((req (magit-gh-section-req-data))
             (head (oref req :head)))
-       (magit-run-git "fetch" (oref (oref head :repo) :git-url)
+       (magit-run-git "fetch" (oref (oref head :repo) :ssh-url)
                       (oref head :ref))))
     (pull nil)
     (invalid-pull
@@ -428,9 +430,10 @@ option, or inferred from remotes."
            (default-title (magit-git-string "log"
                                             (format "%s..%s" base-branch head-branch)
                                             "--format=%s" "--reverse"))
-           (default-body (mapconcat 'identity (magit-git-lines "log"
+           (default-body (mapconcat 'identity (magit-git-items "log"
                                                                (format "%s..%s" base-branch head-branch)
-                                                               "-1" "--format=%b") " ")))
+                                                               "--reverse" "--format=**%s**%n%b") "\n")))
+
       (if (member "--use-pr-editor" (magit-gh-pulls-arguments))
         (magit-gh-pulls-init-pull-editor api user proj default-title default-body base head callback)
         (let* ((title (read-string "Title: " default-title))
diff --git a/elpa/magit-popup-20160130.649/dir b/elpa/magit-popup-20160414.251/dir
similarity index 100%
rename from elpa/magit-popup-20160130.649/dir
rename to elpa/magit-popup-20160414.251/dir
diff --git a/elpa/magit-popup-20160130.649/magit-popup-autoloads.el b/elpa/magit-popup-20160414.251/magit-popup-autoloads.el
similarity index 90%
rename from elpa/magit-popup-20160130.649/magit-popup-autoloads.el
rename to elpa/magit-popup-20160414.251/magit-popup-autoloads.el
index 74c8caf..e1c2c52 100644
--- a/elpa/magit-popup-20160130.649/magit-popup-autoloads.el
+++ b/elpa/magit-popup-20160414.251/magit-popup-autoloads.el
@@ -4,7 +4,7 @@
 (add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
 
 ;;;### (autoloads nil nil ("magit-popup-pkg.el" "magit-popup.el")
-;;;;;;  (22221 60697 911041 79000))
+;;;;;;  (22297 19803 512290 263000))
 
 ;;;***
 
diff --git a/elpa/magit-popup-20160130.649/magit-popup-pkg.el b/elpa/magit-popup-20160414.251/magit-popup-pkg.el
similarity index 77%
rename from elpa/magit-popup-20160130.649/magit-popup-pkg.el
rename to elpa/magit-popup-20160414.251/magit-popup-pkg.el
index a62d46b..f26a531 100644
--- a/elpa/magit-popup-20160130.649/magit-popup-pkg.el
+++ b/elpa/magit-popup-20160414.251/magit-popup-pkg.el
@@ -1,4 +1,4 @@
-(define-package "magit-popup" "20160130.649" "Define prefix-infix-suffix command combos"
+(define-package "magit-popup" "20160414.251" "Define prefix-infix-suffix command combos"
   '((emacs "24.4")
     (async "20150909.2257")
     (dash "20151021.113"))
diff --git a/elpa/magit-popup-20160130.649/magit-popup.el b/elpa/magit-popup-20160414.251/magit-popup.el
similarity index 100%
rename from elpa/magit-popup-20160130.649/magit-popup.el
rename to elpa/magit-popup-20160414.251/magit-popup.el
diff --git a/elpa/magit-popup-20160130.649/magit-popup.info b/elpa/magit-popup-20160414.251/magit-popup.info
similarity index 99%
rename from elpa/magit-popup-20160130.649/magit-popup.info
rename to elpa/magit-popup-20160414.251/magit-popup.info
index a4b6822..b80a74a 100644
--- a/elpa/magit-popup-20160130.649/magit-popup.info
+++ b/elpa/magit-popup-20160414.251/magit-popup.info
@@ -53,17 +53,19 @@ suffix commands.
 
 — The Detailed Node Listing —
 
+
 Usage
 
 * Customizing existing popups::
 * Other options::
 
+
+
 Defining prefix and suffix commands
 
 * Defining prefix commands::
 * Defining suffix commands::
 
-
 
 File: magit-popup.info,  Node: Introduction,  Next: Usage,  Prev: Top,  Up: Top
 
@@ -694,13 +696,13 @@ directly.
 
 Tag Table:
 Node: Top994
-Node: Introduction2168
-Node: Usage4745
-Node: Customizing existing popups9402
-Node: Other options14930
-Node: Defining prefix and suffix commands16979
-Node: Defining prefix commands19075
-Node: Defining suffix commands25755
+Node: Introduction2170
+Node: Usage4747
+Node: Customizing existing popups9404
+Node: Other options14932
+Node: Defining prefix and suffix commands16981
+Node: Defining prefix commands19077
+Node: Defining suffix commands25757
 
 End Tag Table
 
diff --git a/elpa/markdown-mode-2.0/markdown-mode-pkg.el b/elpa/markdown-mode-2.0/markdown-mode-pkg.el
deleted file mode 100644
index fcebc54..0000000
--- a/elpa/markdown-mode-2.0/markdown-mode-pkg.el
+++ /dev/null
@@ -1 +0,0 @@
-(define-package "markdown-mode" "2.0" "Emacs Major mode for Markdown-formatted text files" (quote nil))
diff --git a/elpa/markdown-mode-2.0/markdown-mode-autoloads.el b/elpa/markdown-mode-20160409.650/markdown-mode-autoloads.el
similarity index 62%
rename from elpa/markdown-mode-2.0/markdown-mode-autoloads.el
rename to elpa/markdown-mode-20160409.650/markdown-mode-autoloads.el
index bbab932..dbec9ec 100644
--- a/elpa/markdown-mode-2.0/markdown-mode-autoloads.el
+++ b/elpa/markdown-mode-20160409.650/markdown-mode-autoloads.el
@@ -1,10 +1,10 @@
 ;;; markdown-mode-autoloads.el --- automatically extracted autoloads
 ;;
 ;;; Code:
-
+(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
 
-;;;### (autoloads (gfm-mode markdown-mode) "markdown-mode" "markdown-mode.el"
-;;;;;;  (21483 45918 447833 502000))
+;;;### (autoloads nil "markdown-mode" "markdown-mode.el" (22297 19801
+;;;;;;  343360 509000))
 ;;; Generated autoloads from markdown-mode.el
 
 (autoload 'markdown-mode "markdown-mode" "\
@@ -12,6 +12,10 @@ Major mode for editing Markdown files.
 
 \(fn)" t nil)
 
+(add-to-list 'auto-mode-alist '("\\.markdown\\'" . markdown-mode) t)
+
+(add-to-list 'auto-mode-alist '("\\.md\\'" . markdown-mode) t)
+
 (autoload 'gfm-mode "markdown-mode" "\
 Major mode for editing GitHub Flavored Markdown files.
 
@@ -19,16 +23,9 @@ Major mode for editing GitHub Flavored Markdown files.
 
 ;;;***
 
-;;;### (autoloads nil nil ("markdown-mode-pkg.el") (21483 45918 571803
-;;;;;;  838000))
-
-;;;***
-
-(provide 'markdown-mode-autoloads)
 ;; Local Variables:
 ;; version-control: never
 ;; no-byte-compile: t
 ;; no-update-autoloads: t
-;; coding: utf-8
 ;; End:
 ;;; markdown-mode-autoloads.el ends here
diff --git a/elpa/markdown-mode-20160409.650/markdown-mode-pkg.el b/elpa/markdown-mode-20160409.650/markdown-mode-pkg.el
new file mode 100644
index 0000000..910d08c
--- /dev/null
+++ b/elpa/markdown-mode-20160409.650/markdown-mode-pkg.el
@@ -0,0 +1 @@
+(define-package "markdown-mode" "20160409.650" "Major mode for Markdown-formatted text" '((emacs "24") (cl-lib "0.5")) :url "http://jblevins.org/projects/markdown-mode/" :keywords '("markdown" "github flavored markdown" "itex"))
diff --git a/elpa/markdown-mode-2.0/markdown-mode.el b/elpa/markdown-mode-20160409.650/markdown-mode.el
similarity index 53%
rename from elpa/markdown-mode-2.0/markdown-mode.el
rename to elpa/markdown-mode-20160409.650/markdown-mode.el
index 78b2965..18d3c91 100644
--- a/elpa/markdown-mode-2.0/markdown-mode.el
+++ b/elpa/markdown-mode-20160409.650/markdown-mode.el
@@ -1,6 +1,6 @@
-;;; markdown-mode.el --- Emacs Major mode for Markdown-formatted text files
+;;; markdown-mode.el --- Major mode for Markdown-formatted text -*- lexical-binding: t; -*-
 
-;; Copyright (C) 2007-2013 Jason R. Blevins 
+;; Copyright (C) 2007-2016 Jason R. Blevins 
 ;; Copyright (C) 2007, 2009 Edward O'Connor 
 ;; Copyright (C) 2007 Conal Elliott 
 ;; Copyright (C) 2008 Greg Bognar 
@@ -22,11 +22,19 @@
 ;; Copyright (C) 2012 Zhenlei Jia 
 ;; Copyright (C) 2012 Peter Jones 
 ;; Copyright (C) 2013 Matus Goljer 
+;; Copyright (C) 2015 Google, Inc. (Contributor: Samuel Freilich )
+;; Copyright (C) 2015 Antonis Kanouras 
+;; Copyright (C) 2015 Howard Melman 
+;; Copyright (C) 2015-2016 Danny McClanahan 
+;; Copyright (C) 2015-2016 Syohei Yoshida 
+;; Copyright (C) 2016 Vitalie Spinu 
 
 ;; Author: Jason R. Blevins 
 ;; Maintainer: Jason R. Blevins 
 ;; Created: May 24, 2007
-;; Version: 2.0
+;; Version: 2.1
+;; Package-Version: 20160409.650
+;; Package-Requires: ((emacs "24") (cl-lib "0.5"))
 ;; Keywords: Markdown, GitHub Flavored Markdown, itex
 ;; URL: http://jblevins.org/projects/markdown-mode/
 
@@ -50,51 +58,52 @@
 ;;; Commentary:
 
 ;; markdown-mode is a major mode for editing [Markdown][]-formatted
-;; text files in GNU Emacs.  markdown-mode is free software, licensed
+;; text.  markdown-mode is free software, licensed
 ;; under the GNU GPL.
 ;;
 ;;  [Markdown]: http://daringfireball.net/projects/markdown/
 ;;
-;; The latest stable version is markdown-mode 2.0, released on March 24, 2013:
+;; The latest stable version is markdown-mode 2.1, released on January 9, 2016:
 ;;
 ;;    * [markdown-mode.el][]
 ;;    * [Screenshot][][^theme]
 ;;    * [Release notes][]
 ;;
 ;;  [markdown-mode.el]: http://jblevins.org/projects/markdown-mode/markdown-mode.el
-;;  [screenshot]: http://jblevins.org/projects/markdown-mode/screenshots/20130131-002.png
-;;  [release notes]: http://jblevins.org/projects/markdown-mode/rev-2-0
+;;  [Screenshot]: http://jblevins.org/projects/markdown-mode/screenshots/20160108-001.png
+;;  [Release notes]: http://jblevins.org/projects/markdown-mode/rev-2-1
 ;;
 ;; [^theme]: The theme used in the screenshot is
-;;   [color-theme-twilight](https://github.com/crafterm/twilight-emacs).
+;;     [color-theme-twilight](https://github.com/crafterm/twilight-emacs).
+;;
+;; The latest development version can be obtained from the Git
+;; repository at  or from
+;; [GitHub][]:
+;;
+;;     git clone git://jblevins.org/git/markdown-mode.git
+;;     git clone https://github.com/jrblevin/markdown-mode.git
+;;
+;;  [devel.el]: http://jblevins.org/git/markdown-mode.git/plain/markdown-mode.el
+;;  [GitHub]: https://github.com/jrblevin/markdown-mode/
 ;;
 ;; markdown-mode is also available in several package managers, including:
 ;;
-;;    * Debian and Ubuntu Linux: [emacs-goodies-el][]
+;;    * Debian Linux: [elpa-markdown-mode][] and [emacs-goodies-el][]
+;;    * Ubuntu Linux: [elpa-markdown-mode][elpa-ubuntu] and [emacs-goodies-el][emacs-goodies-el-ubuntu]
 ;;    * RedHat and Fedora Linux: [emacs-goodies][]
-;;    * OpenBSD: [textproc/markdown-mode][]
-;;    * Arch Linux (AUR): [emacs-markdown-mode-git][]
+;;    * NetBSD: [textproc/markdown-mode][]
 ;;    * MacPorts: [markdown-mode.el][macports-package] ([pending][macports-ticket])
 ;;    * FreeBSD: [textproc/markdown-mode.el][freebsd-port]
 ;;
+;;  [elpa-markdown-mode]: https://packages.debian.org/sid/lisp/elpa-markdown-mode
+;;  [elpa-ubuntu]: http://packages.ubuntu.com/search?keywords=elpa-markdown-mode
 ;;  [emacs-goodies-el]: http://packages.debian.org/emacs-goodies-el
-;;  [emacs-goodies]: https://admin.fedoraproject.org/pkgdb/acls/name/emacs-goodies
+;;  [emacs-goodies-el-ubuntu]: http://packages.ubuntu.com/search?keywords=emacs-goodies-el
+;;  [emacs-goodies]: https://apps.fedoraproject.org/packages/emacs-goodies
 ;;  [textproc/markdown-mode]: http://pkgsrc.se/textproc/markdown-mode
-;;  [emacs-markdown-mode-git]: http://aur.archlinux.org/packages.php?ID=30389
 ;;  [macports-package]: https://trac.macports.org/browser/trunk/dports/editors/markdown-mode.el/Portfile
 ;;  [macports-ticket]: http://trac.macports.org/ticket/35716
 ;;  [freebsd-port]: http://svnweb.freebsd.org/ports/head/textproc/markdown-mode.el
-;;
-;; The latest development version can be downloaded directly
-;; ([markdown-mode.el][devel.el]) or it can be obtained from the
-;; (browsable and clonable) Git repository at
-;; .  The entire repository,
-;; including the full project history, can be cloned via the Git protocol
-;; by running
-;;
-;;     git clone git://jblevins.org/git/markdown-mode.git
-;;
-;;  [devel.el]: http://jblevins.org/git/markdown-mode.git/plain/markdown-mode.el
 
 ;;; Installation:
 
@@ -111,6 +120,10 @@
 ;; There is no official Markdown file extension, nor is there even a
 ;; _de facto_ standard, so you can easily add, change, or remove any
 ;; of the file extensions above as needed.
+;;
+;; `markdown-mode' depends on `cl-lib', which has been bundled with
+;; GNU Emacs since 24.3.  Users of GNU Emacs 24.1 and 24.2 can install
+;; `cl-lib' with `package.el'.
 
 ;;; Usage:
 
@@ -184,6 +197,11 @@
 ;;     `C-c C-i I` behaves similarly and inserts a reference-style
 ;;     image.
 ;;
+;;     Local images associated with image links may be displayed
+;;     inline in the buffer by pressing `C-c C-i C-t`
+;;     (`markdown-toggle-inline-images'). This is a toggle command, so
+;;     pressing this once again will remove inline images.
+;;
 ;;   * Styles: `C-c C-s`
 ;;
 ;;     `C-c C-s e` inserts markup to make a region or word italic (`e`
@@ -192,8 +210,9 @@
 ;;     the word italic.  If the point is at an italic word or phrase,
 ;;     remove the italic markup.  Otherwise, simply insert italic
 ;;     delimiters and place the cursor in between them.  Similarly,
-;;     use `C-c C-s s` for bold (``) and `C-c C-s c` for
-;;     inline code (``).
+;;     use `C-c C-s s` for bold (``), `C-c C-s c` for
+;;     inline code (``), and `C-c C-s k` for inserting ``
+;;     tags.
 ;;
 ;;     `C-c C-s b` inserts a blockquote using the active region, if any,
 ;;     or starts a new blockquote.  `C-c C-s C-b` is a variation which
@@ -212,7 +231,7 @@
 ;;     line is not blank, they use the text on the current line.
 ;;     Finally, the setext commands will prompt for heading text if
 ;;     there is no active region and the current line is blank.
-;;     
+;;
 ;;     `C-c C-t h` inserts a heading with automatically chosen type and
 ;;     level (both determined by the previous heading).  `C-c C-t H`
 ;;     behaves similarly, but uses setext (underlined) headings when
@@ -252,10 +271,14 @@
 ;;     and save the result in the file `basename.html`, where
 ;;     `basename` is the name of the Markdown file with the extension
 ;;     removed.  *Export and View:* press `C-c C-c v` to export the
-;;     file and view it in a browser.  **For both export commands, the
-;;     output file will be overwritten without notice.**
-;;     *Open:* `C-c C-c o` will open the Markdown source file directly
-;;     using `markdown-open-command'.
+;;     file and view it in a browser.  *Open:* `C-c C-c o` will open
+;;     the Markdown source file directly using `markdown-open-command'.
+;;     *Live Export*: Press `C-c C-c l` to turn on
+;;     `markdown-live-preview-mode' to view the exported output
+;;     side-by-side with the source Markdown. **For all export commands,
+;;     the output file will be overwritten without notice.**
+;;     `markdown-live-preview-window-function' can be customized to open
+;;     in a browser other than `eww'.
 ;;
 ;;     To summarize:
 ;;
@@ -265,6 +288,7 @@
 ;;       - `C-c C-c v`: `markdown-command' > `basename.html` > browser.
 ;;       - `C-c C-c w`: `markdown-command' > kill ring.
 ;;       - `C-c C-c o`: `markdown-open-command'.
+;;       - `C-c C-c l`: `markdown-live-preview-mode' > `*eww*` buffer.
 ;;
 ;;     `C-c C-c c` will check for undefined references.  If there are
 ;;     any, a small buffer will open with a list of undefined
@@ -288,9 +312,9 @@
 ;;     or in the other window with the `C-u` prefix).  Use `M-p` and
 ;;     `M-n` to quickly jump to the previous or next link of any type.
 ;;
-;;   * Jumping: `C-c C-j`
+;;   * Jumping: `C-c C-l`
 ;;
-;;     Use `C-c C-j` to jump from the object at point to its counterpart
+;;     Use `C-c C-l` to jump from the object at point to its counterpart
 ;;     elsewhere in the text, when possible.  Jumps between reference
 ;;     links and definitions; between footnote markers and footnote
 ;;     text.  If more than one link uses the same reference name, a
@@ -329,8 +353,8 @@
 ;;
 ;;   * Editing Lists: `M-RET`, `M-UP`, `M-DOWN`, `M-LEFT`, and `M-RIGHT`
 ;;
-;;     New list items can be inserted with `M-RET`.  This command
-;;     determines the appropriate marker (one of the possible
+;;     New list items can be inserted with `M-RET` or `C-c C-j`.  This
+;;     command determines the appropriate marker (one of the possible
 ;;     unordered list markers or the next number in sequence for an
 ;;     ordered list) and indentation level by examining nearby list
 ;;     items.  If there is no list before or after the point, start a
@@ -341,6 +365,20 @@
 ;;     Existing list items can be moved up or down with `M-UP` or
 ;;     `M-DOWN` and indented or exdented with `M-RIGHT` or `M-LEFT`.
 ;;
+;;   * Editing Subtrees: `M-S-UP`, `M-S-DOWN`, `M-S-LEFT`, and `M-S-RIGHT`
+;;
+;;     Entire subtrees of ATX headings can be promoted and demoted
+;;     with `M-S-LEFT` and `M-S-RIGHT`, which mirror the bindings
+;;     for promotion and demotion of list items. Similarly, subtrees
+;;     can be moved up and down with `M-S-UP` and `M-S-DOWN`.
+;;
+;;     Please note the following "boundary" behavior for promotion and
+;;     demotion.  Any level-six headings will not be demoted further
+;;     (i.e., they remain at level six, since Markdown and HTML define
+;;     only six levels) and any level-one headings will promoted away
+;;     entirely (i.e., heading markup will be removed, since a
+;;     level-zero heading is not defined).
+;;
 ;;   * Shifting the Region: `C-c <` and `C-c >`
 ;;
 ;;     Text in the region can be indented or exdented as a group using
@@ -454,9 +492,9 @@
 ;;     Markdown previewer which is capable of opening Markdown source files
 ;;     directly (default: `nil').  This command will be called
 ;;     with a single argument, the filename of the current buffer.
-;;     A representative program is the Mac app [Marked][], a
-;;     live-updating MultiMarkdown previewer which has a command line
-;;     utility at `/usr/local/bin/mark`.
+;;     A representative program is the Mac app [Marked 2][], a
+;;     live-updating Markdown previewer which can be [called from a
+;;     simple shell script](http://jblevins.org/log/marked-2-command).
 ;;
 ;;   * `markdown-hr-strings' - list of strings to use when inserting
 ;;     horizontal rules.  Different strings will not be distinguished
@@ -466,10 +504,19 @@
 ;;     demotion, keep these sorted from largest to smallest.
 ;;
 ;;   * `markdown-bold-underscore' - set to a non-nil value to use two
-;;     underscores for bold instead of two asterisks (default: `nil').
+;;     underscores when inserting bold text instead of two asterisks
+;;     (default: `nil').
 ;;
 ;;   * `markdown-italic-underscore' - set to a non-nil value to use
-;;     underscores for italic instead of asterisks (default: `nil').
+;;     underscores when inserting italic text instead of asterisks
+;;     (default: `nil').
+;;
+;;   * `markdown-asymmetric-header' - set to a non-nil value to use
+;;     asymmetric header styling, placing header characters only on
+;;     the left of headers (default: `nil').
+;;
+;;   * `markdown-list-indent-width' - depth of indentation for lists
+;;     when inserting, promoting, and demoting list items (default: 4).
 ;;
 ;;   * `markdown-indent-function' - the function to use for automatic
 ;;     indentation (default: `markdown-indent-line').
@@ -478,6 +525,11 @@
 ;;     automatically indent new lines when the enter key is pressed
 ;;     (default: `t')
 ;;
+;;   * `markdown-enable-wiki-links' - syntax highlighting for wiki
+;;     links (default: `nil').  Set this to a non-nil value to turn on
+;;     wiki link support by default.  Wiki link support can be toggled
+;;     later using the function `markdown-toggle-wiki-links'."
+;;
 ;;   * `markdown-wiki-link-alias-first' - set to a non-nil value to
 ;;     treat aliased wiki links like `[[link text|PageName]]`
 ;;     (default: `t').  When set to nil, they will be treated as
@@ -488,11 +540,11 @@
 ;;
 ;;   * `markdown-enable-math' - syntax highlighting for LaTeX
 ;;     fragments (default: `nil').  Set this to `t' to turn on math
-;;     support by default.  Math support can be toggled later using
-;;     the function `markdown-enable-math'."
+;;     support by default.  Math support can be enabled, disabled, or
+;;     toggled later using the function `markdown-toggle-math'."
 ;;
-;;   * `markdown-css-path' - CSS file to link to in XHTML output
-;;     (default: `""`).
+;;   * `markdown-css-paths' - CSS files to link to in XHTML output
+;;     (default: `nil`).
 ;;
 ;;   * `markdown-content-type' - when set to a nonempty string, an
 ;;     `http-equiv` attribute will be included in the XHTML ``
@@ -535,24 +587,65 @@
 ;;     (default: `end`).  The set of location options is the same as
 ;;     for `markdown-reference-location'.
 ;;
+;;   * `markdown-nested-imenu-heading-index' - Use nested imenu
+;;     heading instead of a flat index (default: `nil').  A nested
+;;     index may provide more natural browsing from the menu, but a
+;;     flat list may allow for faster keyboard navigation via tab
+;;     completion.
+;;
+;;   * `comment-auto-fill-only-comments' - variable is made
+;;     buffer-local and set to `nil' by default.  In programming
+;;     language modes, when this variable is non-nil, only comments
+;;     will be filled by auto-fill-mode.  However, comments in
+;;     Markdown documents are rare and the most users probably intend
+;;     for the actual content of the document to be filled.  Making
+;;     this variable buffer-local allows `markdown-mode' to override
+;;     the default behavior induced when the global variable is non-nil.
+;;
+;;   * `markdown-gfm-additional-languages', - additional languages to
+;;     make available, aside from those predefined in
+;;     `markdown-gfm-recognized-languages', when inserting GFM code
+;;     blocks (default: `nil`). Language strings must have be trimmed
+;;     of whitespace and not contain any curly braces. They may be of
+;;     arbitrary capitalization, though.
+;;
+;;   * `markdown-gfm-use-electric-backquote' - use
+;;     `markdown-electric-backquote' for interactive insertion of GFM
+;;     code blocks when backquote is pressed three times (default: `t`).
+;;
+;;   * `markdown-make-gfm-checkboxes-buttons' - Whether GitHub
+;;     Flavored Markdown style task lists (checkboxes) should be
+;;     turned into buttons that can be toggled with mouse-1 or RET. If
+;;     non-nil (default), then buttons are enabled.  This works in
+;;     `markdown-mode' as well as `gfm-mode'.
+;;
 ;; Additionally, the faces used for syntax highlighting can be modified to
 ;; your liking by issuing `M-x customize-group RET markdown-faces`
 ;; or by using the "Markdown Faces" link at the bottom of the mode
 ;; customization screen.
 ;;
-;; [Marked]: https://itunes.apple.com/us/app/marked/id448925439?ls=1&mt=12&partnerId=30&siteID=GpHp3Acs1Yo
+;; [Marked 2]: https://itunes.apple.com/us/app/marked-2/id890031187?mt=12&uo=4&at=11l5Vs&ct=mm
 
 ;;; Extensions:
 
-;; Besides supporting the basic Markdown syntax, markdown-mode also
-;; includes syntax highlighting for `[[Wiki Links]]` by default.  Wiki
-;; links may be followed by pressing `C-c C-o` when the point
+;; Besides supporting the basic Markdown syntax, Markdown Mode also
+;; includes syntax highlighting for `[[Wiki Links]]`.  This can be
+;; enabled by setting `markdown-enable-wiki-links' to a non-nil value.
+;; Wiki links may be followed by pressing `C-c C-o` when the point
 ;; is at a wiki link.  Use `M-p` and `M-n` to quickly jump to the
 ;; previous and next links (including links of other types).
 ;; Aliased or piped wiki links of the form `[[link text|PageName]]`
 ;; are also supported.  Since some wikis reverse these components, set
 ;; `markdown-wiki-link-alias-first' to nil to treat them as
-;; `[[PageName|link text]]`.
+;; `[[PageName|link text]]`.  If `markdown-wiki-link-fontify-missing'
+;; is also non-nil, Markdown Mode will highlight wiki links with
+;; missing target file in a different color.  By default, Markdown
+;; Mode only searches for target files in the current directory.
+;; Sequential parent directory search (as in [Ikiwiki][]) can be
+;; enabled by setting `markdown-wiki-link-search-parent-directories'
+;; to a non-nil value.
+;;
+;; [Ikiwiki]: https://ikiwiki.info
 ;;
 ;; [SmartyPants][] support is possible by customizing `markdown-command'.
 ;; If you install `SmartyPants.pl` at, say, `/usr/local/bin/smartypants`,
@@ -560,10 +653,7 @@
 ;; You can do this either by using `M-x customize-group markdown`
 ;; or by placing the following in your `.emacs` file:
 ;;
-;;     (defun markdown-custom ()
-;;       "markdown-mode-hook"
-;;       (setq markdown-command "markdown | smartypants"))
-;;     (add-hook 'markdown-mode-hook '(lambda() (markdown-custom)))
+;;     (setq markdown-command "markdown | smartypants")
 ;;
 ;; [SmartyPants]: http://daringfireball.net/projects/smartypants/
 ;;
@@ -574,39 +664,82 @@
 ;; in `.emacs`, and then restarting Emacs or calling
 ;; `markdown-reload-extensions'.
 
-;;; GitHub Flavored Markdown:
+;;; GitHub Flavored Markdown (GFM):
 
-;; A [GitHub Flavored Markdown][GFM] (GFM) mode, `gfm-mode', is also
-;; available.  The GitHub implementation of differs slightly from
-;; standard Markdown.  The most important differences are that
-;; newlines are significant, triggering hard line breaks, and that
-;; underscores inside of words (e.g., variable names) need not be
-;; escaped.  As such, `gfm-mode' turns off `auto-fill-mode' and turns
-;; on `visual-line-mode' (or `longlines-mode' if `visual-line-mode' is
-;; not available).  Underscores inside of words (such as
-;; test_variable) will not trigger emphasis.
+;; A [GitHub Flavored Markdown][GFM] mode, `gfm-mode', is also
+;; available.  The GitHub implementation differs slightly from
+;; standard Markdown in that it supports things like different
+;; behavior for underscores inside of words, automatic linking of
+;; URLs, strikethrough text, and fenced code blocks with an optional
+;; language keyword.
 ;;
-;; Wiki links in this mode will be treated as on GitHub, with hyphens
-;; replacing spaces in filenames and where the first letter of the
-;; filename capitalized.  For example, `[[wiki link]]' will map to a
-;; file named `Wiki-link` with the same extension as the current file.
+;; The GFM-specific features above apply to `README.md` files, wiki
+;; pages, and other Markdown-formatted files in repositories on
+;; GitHub.  GitHub also enables [additional features][GFM comments] for
+;; writing on the site (for issues, pull requests, messages, etc.)
+;; that are further extensions of GFM.  These features include task
+;; lists (checkboxes), newlines corresponding to hard line breaks,
+;; auto-linked references to issues and commits, wiki links, and so
+;; on.  To make matters more confusing, although task lists are not
+;; part of [GFM proper][GFM], [since 2014][] they are rendered (in a
+;; read-only fashion) in all Markdown documents in repositories on the
+;; site.  These additional extensions are supported to varying degrees
+;; by `markdown-mode' and `gfm-mode' as described below.
 ;;
-;; GFM code blocks, with optional programming language keywords, will
-;; be highlighted.  They can be inserted with `C-c C-s P`.  If there
-;; is an active region, the text in the region will be placed inside
-;; the code block.  You will be prompted for the name of the language,
-;; but may press enter to continue without naming a language.
+;; * **URL autolinking:** Both `markdown-mode' and `gfm-mode' support
+;;   highlighting of URLs without angle brackets.
 ;;
-;; For a more complete GitHub-flavored markdown experience, consider
-;; adding README.md to your `auto-mode-alist':
+;; * **Multiple underscores in words:** You must enable `gfm-mode' to
+;;   toggle support for underscores inside of words. In this mode
+;;   variable names such as `a_test_variable` will not trigger
+;;   emphasis (italics).
 ;;
-;;     (add-to-list 'auto-mode-alist '("README\\.md\\'" . gfm-mode))
+;; * **Fenced code blocks:** Code blocks quoted with backticks, with
+;;   optional programming language keywords, are highlighted in
+;;   both `markdown-mode' and `gfm-mode'.  They can be inserted with
+;;   `C-c C-s P`.  If there is an active region, the text in the
+;;   region will be placed inside the code block.  You will be
+;;   prompted for the name of the language, but may press enter to
+;;   continue without naming a language.
 ;;
-;; For GFM preview can be powered by setting `markdown-command' to
-;; use [Docter][].  This may also be configured to work with [Marked][]
-;; for `markdown-open-command'.
+;; * **Strikethrough:** Strikethrough text is only supported in
+;;   `gfm-mode' and can be inserted (and toggled) using `C-c C-s d`.
+;;   Following the mnemonics for the other style keybindings, the
+;;   letter `d` coincides with the HTML tag ``.
+;;
+;; * **Task lists:** GFM task lists will be rendered as checkboxes
+;;   (Emacs buttons) in both `markdown-mode' and `gfm-mode' when
+;;   `markdown-make-gfm-checkboxes-buttons' is set to a non-nil value
+;;   (and it is set to t by default).  These checkboxes can be
+;;   toggled by clicking `mouse-1` or pressing `RET` over the button.
+;;
+;; * **Wiki links:** Generic wiki links are supported in
+;;   `markdown-mode', but in `gfm-mode' specifically they will be
+;;   treated as they are on GitHub: spaces will be replaced by hyphens
+;;   in filenames and the first letter of the filename will be
+;;   capitalized.  For example, `[[wiki link]]' will map to a file
+;;   named `Wiki-link` with the same extension as the current file.
+;;
+;; * **Newlines:** Neither `markdown-mode' nor `gfm-mode' do anything
+;;   specifically with respect to newline behavior.  If you use
+;;   `gfm-mode' mostly to write text for comments or issues on the
+;;   GitHub site--where newlines are significant and correspond to
+;;   hard line breaks--then you may want to enable `visual-line-mode'
+;;   for line wrapping in buffers.  You can do this with a
+;;   `gfm-mode-hook' as follows:
+;;
+;;         ;; Use visual-line-mode in gfm-mode
+;;         (defun my-gfm-mode-hook ()
+;;           (visual-line-mode 1))
+;;         (add-hook 'gfm-mode-hook 'my-gfm-mode-hook)
+;;
+;; * **Preview:** GFM-specific preview can be powered by setting
+;;   `markdown-command' to use [Docter][].  This may also be
+;;   configured to work with [Marked 2][] for `markdown-open-command'.
 ;;
 ;; [GFM]: http://github.github.com/github-flavored-markdown/
+;; [GFM comments]: https://help.github.com/articles/writing-on-github/
+;; [since 2014]: https://github.com/blog/1825-task-lists-in-all-markdown-documents
 ;; [Docter]: https://github.com/alampros/Docter
 
 ;;; Acknowledgments:
@@ -678,19 +811,49 @@
 ;;   * Vegard Vesterheim  for a bug fix
 ;;     related to `orgtbl-mode'.
 ;;   * Makoto Motohashi  for before- and after-
-;;     export hooks and unit test improvements.
+;;     export hooks, unit test improvements, and updates to support
+;;     wide characters.
 ;;   * Michael Dwyer  for `gfm-mode' underscore regexp.
 ;;   * Chris Lott  for suggesting reference label
 ;;     completion.
+;;   * Gunnar Franke  for a completion bug report.
+;;   * David Glasser  for a `paragraph-separate' fix.
+;;   * Daniel Brotsky  for better auto-fill defaults.
+;;   * Samuel Freilich  for improved filling
+;;     behavior regarding list items, footnotes, and reference
+;;     definitions, improved killing of footnotes, and numerous other
+;;     tests and bug fixes.
+;;   * Antonis Kanouras  for strikethrough support.
+;;   * Tim Visher  for multiple CSS files and other
+;;     general improvements.
+;;   * Matt McClure  for a patch to prevent
+;;     overwriting source files with .html extensions upon export.
+;;   * Roger Bolsius  for ordered list improvements.
+;;   * Google's Open Source Programs Office for recognizing the project with
+;;     a monetary contribution in June 2015.
+;;   * Howard Melman  for supporting GFM checkboxes
+;;     as buttons.
+;;   * Danny McClanahan  for live preview
+;;     mode, completion of GFM programming language names, improved
+;;     font lock for fenced code blocks and metadata blocks, `cl-lib'
+;;     updates, and numerous other improvements.
+;;   * Syohei Yoshida  for better heading detection
+;;     and movement functions, improved italic font lock, fixing adaptive
+;;     filling for hanging list items, more efficient fontification,
+;;     and numerous other improvements.
+;;   * Vitalie Spinu  for improvements to font
+;;     lock and source code aesthetics.
+;;   * Kévin Le Gouguec  for improvements
+;;     related to ATX headings and Pandoc fancy lists.
 
 ;;; Bugs:
 
-;; Although markdown-mode is developed and tested primarily using
-;; GNU Emacs 24, compatibility with earlier Emacsen is also a
-;; priority.
+;; markdown-mode is developed and tested primarily for compatibility
+;; with GNU Emacs 24.3 and later.  If you find any bugs in
+;; markdown-mode, please construct a test case or a patch and open a
+;; ticket on the [GitHub issue tracker][issues].
 ;;
-;; If you find any bugs in markdown-mode, please construct a test case
-;; or a patch and email me at .
+;;  [issues]: https://github.com/jrblevin/markdown-mode/issues
 
 ;;; History:
 
@@ -707,7 +870,8 @@
 ;;   * 2011-08-12: [Version 1.8][]
 ;;   * 2011-08-15: [Version 1.8.1][]
 ;;   * 2013-01-25: [Version 1.9][]
-;;   * 2013-03-18: [Version 2.0][]
+;;   * 2013-03-24: [Version 2.0][]
+;;   * 2016-01-09: [Version 2.1][]
 ;;
 ;; [Version 1.3]: http://jblevins.org/projects/markdown-mode/rev-1-3
 ;; [Version 1.5]: http://jblevins.org/projects/markdown-mode/rev-1-5
@@ -717,6 +881,7 @@
 ;; [Version 1.8.1]: http://jblevins.org/projects/markdown-mode/rev-1-8-1
 ;; [Version 1.9]: http://jblevins.org/projects/markdown-mode/rev-1-9
 ;; [Version 2.0]: http://jblevins.org/projects/markdown-mode/rev-2-0
+;; [Version 2.1]: http://jblevins.org/projects/markdown-mode/rev-2-1
 
 
 ;;; Code:
@@ -724,12 +889,17 @@
 (require 'easymenu)
 (require 'outline)
 (require 'thingatpt)
-(eval-when-compile (require 'cl))
+(require 'cl-lib)
+
+(defvar jit-lock-start)
+(defvar jit-lock-end)
+
+(declare-function eww-open-file "eww")
 
 
 ;;; Constants =================================================================
 
-(defconst markdown-mode-version "2.0"
+(defconst markdown-mode-version "2.1"
   "Markdown mode version number.")
 
 (defconst markdown-output-buffer-name "*markdown-output*"
@@ -741,6 +911,12 @@
 (defvar markdown-reference-label-history nil
   "History of used reference labels.")
 
+(defvar markdown-live-preview-mode nil
+  "Sentinel variable for command `markdown-live-preview-mode'.")
+
+(defvar markdown-gfm-language-history nil
+  "History list of languages used in the current buffer in GFM code blocks.")
+
 
 ;;; Customizable Variables ====================================================
 
@@ -799,12 +975,20 @@ promotion and demotion functions."
   :type 'list)
 
 (defcustom markdown-bold-underscore nil
-  "Use two underscores for bold instead of two asterisks."
+  "Use two underscores when inserting bold text instead of two asterisks."
   :group 'markdown
   :type 'boolean)
 
 (defcustom markdown-italic-underscore nil
-  "Use underscores for italic instead of asterisks."
+  "Use underscores when inserting italic text instead of asterisks."
+  :group 'markdown
+  :type 'boolean)
+
+(defcustom markdown-asymmetric-header nil
+  "Determines if header style will be asymmetric.
+Set to non-nil to only have header characters to the left of the title.
+The default will ensure header characters are placed to the left and right
+of the title."
   :group 'markdown
   :type 'boolean)
 
@@ -822,11 +1006,37 @@ auto-indentation by pressing \\[newline-and-indent]."
   :group 'markdown
   :type 'boolean)
 
+(defcustom markdown-enable-wiki-links nil
+  "Syntax highlighting for wiki links.
+Set this to a non-nil value to turn on wiki link support by default.
+Support can be toggled later using the `markdown-toggle-wiki-links'
+function or \\[markdown-toggle-wiki-links]."
+  :group 'markdown
+  :type 'boolean
+  :safe 'booleanp)
+
 (defcustom markdown-wiki-link-alias-first t
   "When non-nil, treat aliased wiki links like [[alias text|PageName]].
 Otherwise, they will be treated as [[PageName|alias text]]."
   :group 'markdown
-  :type 'boolean)
+  :type 'boolean
+  :safe 'booleanp)
+
+(defcustom markdown-wiki-link-search-parent-directories nil
+  "When non-nil, search for wiki link targets in parent directories.
+This is the default search behavior of Ikiwiki."
+  :group 'markdown
+  :type 'boolean
+  :safe 'booleanp)
+
+(defcustom markdown-wiki-link-fontify-missing nil
+  "When non-nil, change wiki link face according to existence of target files.
+This is expensive because it requires checking for the file each time the buffer
+changes or the user switches windows.  It is disabled by default because it may
+cause lag when typing on slower machines."
+  :group 'markdown
+  :type 'boolean
+  :safe 'booleanp)
 
 (defcustom markdown-uri-types
   '("acap" "cid" "data" "dav" "fax" "file" "ftp" "gopher" "http" "https"
@@ -839,16 +1049,16 @@ Otherwise, they will be treated as [[PageName|alias text]]."
 (defcustom markdown-enable-math nil
   "Syntax highlighting for inline LaTeX and itex expressions.
 Set this to a non-nil value to turn on math support by default.
-Math support can be toggled later using `markdown-enable-math'
-or \\[markdown-enable-math]."
+Math support can be enabled, disabled, or toggled later using
+`markdown-toggle-math' or \\[markdown-toggle-math]."
   :group 'markdown
   :type 'boolean
   :safe 'booleanp)
 
-(defcustom markdown-css-path ""
+(defcustom markdown-css-paths nil
   "URL of CSS file to link to in the output XHTML."
   :group 'markdown
-  :type 'string)
+  :type 'list)
 
 (defcustom markdown-content-type ""
   "Content type string for the http-equiv header in XHTML output.
@@ -895,6 +1105,872 @@ and `iso-latin-1'.  Use `list-coding-systems' for more choices."
                  (const :tag "Immediately after the current block" immediately)
                  (const :tag "Before next header" header)))
 
+(defcustom markdown-unordered-list-item-prefix "  * "
+  "String inserted before unordered list items."
+  :group 'markdown
+  :type 'string)
+
+(defcustom markdown-nested-imenu-heading-index nil
+  "Use nested or flat imenu heading index.
+A nested index may provide more natural browsing from the menu,
+but a flat list may allow for faster keyboard navigation via tab
+completion."
+  :group 'markdown
+  :type 'boolean)
+
+(defcustom markdown-make-gfm-checkboxes-buttons t
+  "When non-nil, make GFM checkboxes into buttons."
+  :group 'markdown
+  :type 'boolean)
+
+(defcustom markdown-use-pandoc-style-yaml-metadata nil
+  "When non-nil, allow yaml metadata anywhere in the document."
+  :group 'markdown
+  :type 'boolean)
+
+(defcustom markdown-live-preview-window-function
+  'markdown-live-preview-window-eww
+  "Function to display preview of Markdown output within Emacs.
+Function must update the buffer containing the preview and return
+the buffer."
+  :group 'markdown
+  :type 'function)
+
+(defcustom markdown-live-preview-delete-export 'delete-on-destroy
+  "Delete exported html file when using `markdown-live-preview-export'.
+If set to 'delete-on-export, delete on every export. When set to
+'delete-on-destroy delete when quitting from command
+`markdown-live-preview-mode'. Never delete if set to nil."
+  :group 'markdown
+  :type 'symbol)
+
+(defcustom markdown-list-indent-width 4
+  "Depth of indentation for markdown lists.
+Used in `markdown-demote-list-item' and
+`markdown-promote-list-item'."
+  :group 'markdown
+  :type 'integer)
+
+(defcustom markdown-gfm-additional-languages nil
+  "Extra languages made available when inserting GFM code blocks.
+Language strings must have be trimmed of whitespace and not
+contain any curly braces. They may be of arbitrary
+capitalization, though."
+  :group 'markdown
+  :type '(repeat (string :validate markdown-validate-language-string)))
+
+(defcustom markdown-gfm-use-electric-backquote t
+  "Use `markdown-electric-backquote' when backquote is hit three times."
+  :group 'markdown
+  :type 'boolean)
+
+(defcustom markdown-gfm-downcase-languages t
+  "If non-nil, downcase suggested languages.
+This applies to insertions done with
+`markdown-electric-backquote'."
+  :group 'markdown
+  :type 'boolean)
+
+
+;;; Regular Expressions =======================================================
+
+(defconst markdown-regex-comment-start
+  "