[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] master ed956a5: * externals-list: Move some :subtrees to :externa
|
From: |
Stefan Monnier |
|
Subject: |
[elpa] master ed956a5: * externals-list: Move some :subtrees to :external. |
|
Date: |
Fri, 27 Nov 2020 00:46:18 -0500 (EST) |
branch: master
commit ed956a5ad0279f8c18f63146c37b43d91b70cb40
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>
* externals-list: Move some :subtrees to :external.
The affected subtrees are:
ack company-math easy-kill ggtags gnome-c-style
highlight-escape-sequences
nameless parsec rich-minority sotlisp spinner temp-buffer-browse
test-simple vdiff yasnippet ztree
---
externals-list | 34 +-
packages/ack/README.rst | 87 -
packages/ack/ack.el | 534 --
packages/ack/pcmpl-ack.el | 176 -
packages/company-math/.dir-locals.el | 3 -
packages/company-math/company-math.el | 240 -
packages/company-math/img/latex-symbols.png | Bin 3355 -> 0 bytes
packages/company-math/img/unicode-symbols.png | Bin 3333 -> 0 bytes
packages/company-math/readme.md | 73 -
packages/easy-kill/.elpaignore | 4 -
packages/easy-kill/.travis.yml | 23 -
packages/easy-kill/Makefile | 17 -
packages/easy-kill/README.rst | 123 -
packages/easy-kill/easy-kill.el | 832 ---
packages/easy-kill/test.el | 433 --
packages/ggtags/.gitignore | 1 -
packages/ggtags/Makefile | 12 -
packages/ggtags/README.rst | 444 --
packages/ggtags/ggtags.el | 2408 ---------
packages/gnome-c-style/.gitignore | 2 -
packages/gnome-c-style/Makefile | 16 -
packages/gnome-c-style/README | 1 -
packages/gnome-c-style/README.md | 88 -
packages/gnome-c-style/gnome-c-align.el | 547 --
packages/gnome-c-style/gnome-c-snippet.el | 703 ---
packages/gnome-c-style/gnome-c-style.el | 74 -
packages/gnome-c-style/gnome-c-tests.el | 284 --
packages/highlight-escape-sequences/README.md | 15 -
.../highlight-escape-sequences.el | 252 -
.../highlight-escape-sequences.png | Bin 20292 -> 0 bytes
packages/nameless/LICENSE | 340 --
packages/nameless/README.org | 129 -
packages/nameless/example-nameless.png | Bin 70945 -> 0 bytes
packages/nameless/nameless.el | 299 --
packages/parsec/.gitignore | 3 -
packages/parsec/README.org | 378 --
packages/parsec/examples/.nosearch | 0
packages/parsec/examples/full-csv-parser-tests.el | 51 -
packages/parsec/examples/full-csv-parser.el | 61 -
packages/parsec/examples/pjson-tests.el | 102 -
packages/parsec/examples/pjson.el | 124 -
packages/parsec/examples/scheme-tests.el | 88 -
packages/parsec/examples/scheme.el | 108 -
.../parsec/examples/simple-csv-parser-tests.el | 39 -
packages/parsec/examples/simple-csv-parser.el | 55 -
packages/parsec/examples/url-str-parser-tests.el | 48 -
packages/parsec/examples/url-str-parser.el | 56 -
packages/parsec/parsec-tests.el | 481 --
packages/parsec/parsec.el | 1042 ----
packages/rich-minority/LICENSE | 339 --
packages/rich-minority/README.org | 50 -
packages/rich-minority/rich-minority.el | 283 --
packages/sotlisp/.elpaignore | 4 -
packages/sotlisp/.gitignore | 1 -
packages/sotlisp/README.md | 59 -
packages/sotlisp/sotlisp.el | 717 ---
packages/spinner/README.org | 76 -
packages/spinner/all-spinners.gif | Bin 18314 -> 0 bytes
packages/spinner/some-spinners.gif | Bin 1932043 -> 0 bytes
packages/spinner/spinner.el | 334 --
packages/temp-buffer-browse/Makefile | 12 -
packages/temp-buffer-browse/README.rst | 20 -
packages/temp-buffer-browse/temp-buffer-browse.el | 175 -
packages/test-simple/.gitignore | 15 -
packages/test-simple/.travis.yml | 14 -
packages/test-simple/AUTHORS | 2 -
packages/test-simple/COPYING | 674 ---
packages/test-simple/Cask | 4 -
packages/test-simple/INSTALL | 18 -
packages/test-simple/Makefile.am | 65 -
packages/test-simple/NEWS | 5 -
packages/test-simple/README.md | 86 -
packages/test-simple/THANKS | 2 -
packages/test-simple/autogen.sh | 7 -
packages/test-simple/common.mk | 5 -
packages/test-simple/compute-lispdir.sh | 46 -
packages/test-simple/configure.ac | 44 -
packages/test-simple/copyright_exceptions | 0
packages/test-simple/elisp-comp | 94 -
packages/test-simple/example/gcd-tests.el | 42 -
packages/test-simple/example/gcd.el | 34 -
packages/test-simple/install-from-git.sh | 94 -
packages/test-simple/make-check-filter.rb | 21 -
packages/test-simple/test-simple.el | 386 --
packages/test-simple/test/.gitignore | 2 -
packages/test-simple/test/Makefile.am | 29 -
packages/test-simple/test/test-basic.el | 29 -
packages/test-simple/test/test-fns.el | 39 -
packages/test-simple/test/test-no-clear.el | 27 -
packages/vdiff/.github/workflows/test.yml | 30 -
packages/vdiff/.gitignore | 5 -
packages/vdiff/Cask | 7 -
packages/vdiff/LICENSE | 674 ---
packages/vdiff/Makefile | 19 -
packages/vdiff/README.org | 215 -
packages/vdiff/img/hydra.png | Bin 19666 -> 0 bytes
packages/vdiff/img/leuven.png | Bin 105779 -> 0 bytes
packages/vdiff/img/leuven3.png | Bin 120134 -> 0 bytes
packages/vdiff/img/wide-screen.png | Bin 43685 -> 0 bytes
packages/vdiff/vdiff-test.el | 210 -
packages/vdiff/vdiff.el | 2415 ---------
packages/yasnippet/.gitignore | 10 -
packages/yasnippet/.gitmodules | 0
packages/yasnippet/.travis.yml | 46 -
packages/yasnippet/CONTRIBUTING.md | 37 -
packages/yasnippet/NEWS | 565 ---
packages/yasnippet/README | 28 -
packages/yasnippet/README.mdown | 165 -
packages/yasnippet/Rakefile | 130 -
packages/yasnippet/doc/.nosearch | 0
packages/yasnippet/doc/faq.org | 87 -
packages/yasnippet/doc/images/bg-content-left.png | Bin 3275 -> 0 bytes
packages/yasnippet/doc/images/bg-content-right.png | Bin 3169 -> 0 bytes
packages/yasnippet/doc/images/bg-content.png | Bin 485 -> 0 bytes
.../doc/images/bg-navigation-item-hover.png | Bin 441 -> 0 bytes
.../yasnippet/doc/images/bg-navigation-item.png | Bin 502 -> 0 bytes
packages/yasnippet/doc/images/bg-navigation.png | Bin 104 -> 0 bytes
packages/yasnippet/doc/images/body.png | Bin 712 -> 0 bytes
.../yasnippet/doc/images/customization-group.png | Bin 60007 -> 0 bytes
packages/yasnippet/doc/images/dropdown-menu.png | Bin 31811 -> 0 bytes
packages/yasnippet/doc/images/external.png | Bin 165 -> 0 bytes
packages/yasnippet/doc/images/ido-menu.png | Bin 58102 -> 0 bytes
packages/yasnippet/doc/images/menu-1.png | Bin 68953 -> 0 bytes
packages/yasnippet/doc/images/menu-2.png | Bin 60421 -> 0 bytes
packages/yasnippet/doc/images/menu-groups.png | Bin 84358 -> 0 bytes
packages/yasnippet/doc/images/menu-parent.png | Bin 73275 -> 0 bytes
.../yasnippet/doc/images/minor-mode-indicator.png | Bin 5940 -> 0 bytes
packages/yasnippet/doc/images/x-menu.png | Bin 34263 -> 0 bytes
packages/yasnippet/doc/index.org | 47 -
packages/yasnippet/doc/nav-menu.html.inc | 16 -
packages/yasnippet/doc/org-setup.inc | 11 -
packages/yasnippet/doc/snippet-development.org | 474 --
packages/yasnippet/doc/snippet-expansion.org | 283 --
packages/yasnippet/doc/snippet-menu.org | 68 -
packages/yasnippet/doc/snippet-organization.org | 132 -
packages/yasnippet/doc/snippet-reference.org | 12 -
packages/yasnippet/doc/stylesheets/manual.css | 70 -
packages/yasnippet/doc/yas-doc-helper.el | 223 -
packages/yasnippet/yasnippet-debug.el | 359 --
packages/yasnippet/yasnippet-tests.el | 1744 -------
packages/yasnippet/yasnippet.el | 5289 --------------------
packages/ztree/README.md | 108 -
packages/ztree/ztree-diff-model.el | 386 --
packages/ztree/ztree-diff.el | 561 ---
packages/ztree/ztree-dir.el | 204 -
packages/ztree/ztree-util.el | 98 -
packages/ztree/ztree-view.el | 671 ---
packages/ztree/ztree.el | 37 -
148 files changed, 17 insertions(+), 30103 deletions(-)
diff --git a/externals-list b/externals-list
index 2402d91..5c21e60 100644
--- a/externals-list
+++ b/externals-list
@@ -32,7 +32,7 @@
;; some manual intervention (typically, because the two branches have
;; diverged).
-(("ack" :subtree "https://github.com/leoliu/ack-el";)
+(("ack" :external "https://github.com/leoliu/ack-el";)
("aggressive-indent" :subtree
"https://github.com/Malabarba/aggressive-indent-mode";)
("async" :external "https://github.com/jwiegley/emacs-async";)
("auctex" :external "git://git.sv.gnu.org/auctex.git")
@@ -65,20 +65,20 @@
("coffee-mode" :subtree
"https://github.com/defunkt/coffee-mode";)
("compact-docstrings" :subtree
"https://github.com/cpitclaudel/compact-docstrings";)
("company" :subtree
"https://github.com/company-mode/company-mode.git";)
- ("company-math" :subtree "https://github.com/vspinu/company-math.git";)
+ ("company-math" :external "https://github.com/vspinu/company-math.git";)
("context-coloring" :subtree
"https://github.com/jacksonrayhamilton/context-coloring.git";)
("cpio-mode" :external "https://github.com/dlewan/cpio-mode";)
("darkroom" :external
"https://github.com/capitaomorte/darkroom.git";)
("dash" :external "https://github.com/magnars/dash.el.git";)
("dbus-codegen" :subtree "https://github.com/ueno/dbus-codegen-el.git";)
- ("delight" :subtree "https://git.savannah.gnu.org/r/delight.git";)
+ ("delight" :external "https://git.savannah.gnu.org/r/delight.git";)
("diffview" :subtree "https://github.com/mgalgs/diffview-mode.git";)
("diff-hl" :subtree "https://github.com/dgutov/diff-hl.git";)
("dired-git-info" :external "https://github.com/clemera/dired-git-info";)
("disk-usage" :external
"https://gitlab.com/ambrevar/emacs-disk-usage";)
("dismal" :external nil)
("dts-mode" :subtree "https://github.com/bgamari/dts-mode.git";)
- ("easy-kill" :subtree "https://github.com/leoliu/easy-kill";)
+ ("easy-kill" :external "https://github.com/leoliu/easy-kill";)
("ebdb" :external "https://github.com/girzel/ebdb.git";)
("eev" :external "https://github.com/edrx/eev.git";)
;branch UTF-8
("eglot" :external "https://github.com/joaotavora/eglot.git";)
@@ -94,14 +94,14 @@
("flymake" :core "lisp/progmodes/flymake.el")
("frog-menu" :external "https://github.com/clemera/frog-menu";)
("gcmh" :external "https://gitlab.com/koral/gcmh";)
- ("ggtags" :subtree "https://github.com/leoliu/ggtags";)
- ("gnome-c-style" :subtree "https://github.com/ueno/gnome-c-style.git";)
+ ("ggtags" :external "https://github.com/leoliu/ggtags";)
+ ("gnome-c-style" :external "https://github.com/ueno/gnome-c-style.git";)
("gnorb" :subtree "https://github.com/girzel/gnorb";)
("gnu-elpa" :external nil)
("gpastel" :external
"https://gitlab.petton.fr/DamienCassou/gpastel";)
("greader" :external
"https://gitlab.com/michelangelo-rodriguez/greader";)
("guess-language" :external
"https://github.com/tmalsburg/guess-language.el";)
- ("highlight-escape-sequences" :subtree
"https://github.com/dgutov/highlight-escape-sequences/";)
+ ("highlight-escape-sequences" :external
"https://github.com/dgutov/highlight-escape-sequences/";)
("hyperbole" :external
"http://git.savannah.gnu.org/r/hyperbole.git";)
("ioccur" :subtree
"https://github.com/thierryvolpiatto/ioccur.git";)
("ivy-explorer" :external "https://github.com/clemera/ivy-explorer";)
@@ -116,7 +116,7 @@
("modus-operandi-theme":external
"https://gitlab.com/protesilaos/modus-themes";)
("modus-vivendi-theme" :external
"https://gitlab.com/protesilaos/modus-themes";)
("muse" :subtree "https://github.com/alexott/muse";)
- ("nameless" :subtree "https://github.com/Malabarba/Nameless";)
+ ("nameless" :external "https://github.com/Malabarba/Nameless";)
("names" :subtree "http://github.com/Malabarba/names";)
("objed" :external "https://github.com/clemera/objed";)
("omn-mode" :external nil)
@@ -125,7 +125,7 @@
("ntlm" :core "lisp/net/ntlm.el")
("on-screen" :subtree
"https://github.com/michael-heerdegen/on-screen.el.git";)
("pabbrev" :external "https://github.com/phillord/pabbrev.git";)
- ("parsec" :subtree
"https://github.com/cute-jumper/parsec.el.git";)
+ ("parsec" :external
"https://github.com/cute-jumper/parsec.el.git";)
("peg" :external) ;Was in
"https://github.com/ellerh/peg.el";
("persist" :external "https://gitlab.com/phillord/persist.git";)
("phps-mode" :external
"https://github.com/cjohansson/emacs-phps-mode";)
@@ -151,7 +151,7 @@
("realgud-trepan-ni" :external "https://github.com/realgud/realgud-ni";)
("rec-mode" :external
"https://git.savannah.gnu.org/git/recutils/rec-mode.git";)
("relint" :external "https://github.com/mattiase/relint";)
- ("rich-minority" :subtree "https://github.com/Malabarba/rich-minority";)
+ ("rich-minority" :external "https://github.com/Malabarba/rich-minority";)
("rt-liberation" :external "https://git.savannah.nongnu.org/git/rtliber";)
("rudel" :external nil) ;; Was
bzr::bzr://rudel.bzr.sourceforge.net/bzrroot/rudel/trunk
("scanner" :external "https://gitlab.com/rstocker/scanner.git";)
@@ -160,16 +160,16 @@
("smalltalk-mode" :external "git://git.sv.gnu.org/smalltalk")
("so-long" :core "lisp/so-long.el")
("soap-client" :core ("lisp/net/soap-client.el"
"lisp/net/soap-inspect.el"))
- ("sotlisp" :subtree
"https://github.com/Malabarba/speed-of-thought-lisp";)
- ("spinner" :subtree "https://github.com/Malabarba/spinner.el";)
+ ("sotlisp" :external
"https://github.com/Malabarba/speed-of-thought-lisp";)
+ ("spinner" :external "https://github.com/Malabarba/spinner.el";)
("sql-indent" :external
"https://github.com/alex-hhh/emacs-sql-indent";)
("sql-smie" :external nil)
("ssh-deploy" :external
"https://github.com/cjohansson/emacs-ssh-deploy";)
("svg" :core ("lisp/svg.el"))
("system-packages" :external
"https://gitlab.com/jabranham/system-packages";)
- ("temp-buffer-browse" :subtree
"https://github.com/leoliu/temp-buffer-browse";)
- ("test-simple" :subtree "https://github.com/rocky/emacs-test-simple";)
- ("vdiff" :subtree "https://github.com/justbur/emacs-vdiff";)
+ ("temp-buffer-browse" :external
"https://github.com/leoliu/temp-buffer-browse";)
+ ("test-simple" :external "https://github.com/rocky/emacs-test-simple";)
+ ("vdiff" :external "https://github.com/justbur/emacs-vdiff";)
("vcl-mode" :subtree "git://git.gnu.org.ua/vcl-mode")
("tramp" :external
"https://git.savannah.gnu.org/cgit/tramp.git/?h=elpa";)
("transient" :external "https://github.com/magit/transient";)
@@ -185,7 +185,7 @@
("xelb" :external "https://github.com/ch11ng/xelb.git";)
("xr" :external "https://github.com/mattiase/xr";)
("xref" :core "lisp/progmodes/xref.el")
- ("yasnippet" :subtree
"https://github.com/capitaomorte/yasnippet.git";)
+ ("yasnippet" :external
"https://github.com/capitaomorte/yasnippet.git";)
("zones" :external nil)
;https://www.emacswiki.org/emacs/zones.el
- ("ztree" :subtree "https://github.com/fourier/ztree";)
+ ("ztree" :external "https://github.com/fourier/ztree";)
)
diff --git a/packages/ack/README.rst b/packages/ack/README.rst
deleted file mode 100644
index c0a0ba0..0000000
--- a/packages/ack/README.rst
+++ /dev/null
@@ -1,87 +0,0 @@
-==============================================================
- The Simple Emacs Interface to `Ack <http://beyondgrep.com>`_-like Tools
-==============================================================
-
-This package integrates `ack <http://beyondgrep.com>`_ and its large
-set of options with `emacs <http://www.gnu.org/software/emacs>`_. The
-resulting ``*ack*`` buffer is just like vanilla ``*grep*`` buffer but
-the results come from your tool of choice.
-
-Ack-like tools such as `the silver searcher (ag)
-<https://github.com/ggreer/the_silver_searcher>`_, `ripgrep (rg)
-<https://github.com/BurntSushi/ripgrep>`_ are well supported, as are
-``git grep``, ``hg grep``.
-
-The program guesses good defaults, but lets you give ``C-u`` to
-customize directory to search in, as well as the give special commands
-and switches.
-
-Just ``M-x ack`` or do something like ``(global-set-key (kbd "C-c
-C-g") 'ack)``.
-
-It is part of `GNU ELPA <http://elpa.gnu.org>`_ - the official package
-archive for `emacs <http://www.gnu.org/software/emacs>`_. Patches,
-feature requests and bug reports are welcome.
-
-Colors are handled using the standard library ``ansi-color.el``
-
-Install
--------
-
-``M-x package-install RET ack RET``
-
-Screenshots
------------
-
-* ack
-
-.. figure:: http://i.imgur.com/VwWyzAe.png
- :target: http://i.imgur.com/VwWyzAe.png
- :alt: ack.png
-
-* git grep
-
-.. figure:: http://i.imgur.com/rwjC4pa.png
- :target: http://i.imgur.com/rwjC4pa.png
- :alt: ack-git-grep.png
-
-Usage
------
-
-- Type ``M-x ack`` and provide a pattern to search.
-- Type ``C-u M-x ack`` to search from current project root.
-- Type ``C-u C-u M-x ack`` to interactively choose a directory to search.
-
-While reading ack command and args from the minibuffer, the following
-key bindings may be useful:
-
-- ``M-I`` => insert a template for case-insensitive file name search
-- ``M-G`` => insert a template for ``git grep``, ``hg grep`` or ``bzr grep``
-- ``M-Y`` => grab the symbol at point from the window before entering
- the minibuffer
-- ``TAB`` => completion for ack options
-
-If you use the above keybindings very often, stick the corresponding
-command names in ``ack-minibuffer-setup-hook``. The following snippet
-makes ``M-x ack`` insert a ``git|hg|bzr grep`` template if searching
-from a project root. Then it will try to insert the symbol at point.
-
-.. code-block:: lisp
-
- (add-hook 'ack-minibuffer-setup-hook 'ack-skel-vc-grep t)
- (add-hook 'ack-minibuffer-setup-hook 'ack-yank-symbol-at-point t)
-
-Emacs23
--------
-
-Check out the `emacs23
-<https://github.com/leoliu/ack-el/tree/emacs23>`_ branch.
-
-Bugs
-----
-
-https://github.com/leoliu/ack-el/issues
-
-Contributors
-------------
-Phillip Lord. The original author and previous mantainer is Leo Liu.
diff --git a/packages/ack/ack.el b/packages/ack/ack.el
deleted file mode 100644
index 6d8a651..0000000
--- a/packages/ack/ack.el
+++ /dev/null
@@ -1,534 +0,0 @@
-;;; ack.el --- interface to ack-like tools -*- lexical-binding: t;
-*-
-
-;; Copyright (C) 2012-2018 Free Software Foundation, Inc.
-
-;; Author: Leo Liu <sdl.web@gmail.com>
-;; Maintainer: João Távora <joaotavora@gmail.com>
-;; Version: 1.10
-;; Keywords: tools, processes, convenience
-;; Created: 2012-03-24
-;; URL: https://github.com/leoliu/ack-el
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This package was originally written to provide an interface to ack
-;; http://beyondgrep.com -- a tool like grep, designed for programmers
-;; with large trees of heterogeneous source code. It builds on
-;; standard packages `compile.el' and `ansi-color.el' and lets you
-;; seamlessly run `ack' with its large set of options.
-;;
-;; Later it was enhanced to also support ack-like tools such as the
-;; silver search (ag) and git/hg/bzr grep facilities. So, while the
-;; name persists, actually using `ack' program is merely a suggestion.
-;;
-;; The basic usage pattern starts with `M-x ack', which will compose a
-;; suitable command-line in the minibuffer. A good variable to
-;; customize early on is `ack-defaults-function', which controls how
-;; this command can be modulated by one of more `C-u''s to control
-;; this process.
-;;
-;; If `ack-defaults-function' is `ack-quickgrep-defaults':
-;;
-;; + Type `M-x ack' to start searching immediately for the thing
-;; at point from the current project root.
-;; + Type `C-u M-x ack' to do the same but get a chance to edit the line.
-;; + Type `C-u C-u M-x ack' to interactively choose a directory to
-;; search from.
-;;
-;; If `ack-defaults-function' is `ack-legacy-defaults':
-;;
-;; + Type `M-x ack' and provide a pattern to search.
-;; + Type `C-u M-x ack' to search from current project root.
-;; + Type `C-u C-u M-x ack' to interactively choose a directory to
-;; search.
-;;
-;; Read the docstrings of `ack-quickgrep-defaults' and
-;; `ack-legacy-defaults' for finer details.
-;;
-;; Regardless of what function you put in `ack-defaults-function',
-;; when editing the minibuffer the following key bindings may be
-;; useful:
-;;
-;; + `M-I' inserts a template for case-insensitive file name search
-;; + `M-G' inserts a template for `git grep', `hg grep' or `bzr grep'
-;; + `M-Y' inserts the symbol at point from the window before entering
-;; the minibuffer
-;; + `TAB' completes ack options
-
-;;; Supported tools:
-
-;; + ack
-;; + grep
-;; + the_silver_search
-;; + git/hg/bzr grep
-
-;;; Bugs: https://github.com/leoliu/ack-el/issues
-
-;;; Code:
-
-(require 'compile)
-(require 'pcase)
-(require 'ansi-color)
-(require 'thingatpt)
-(autoload 'shell-completion-vars "shell")
-
-(eval-when-compile
- (unless (fboundp 'setq-local)
- (defmacro setq-local (var val)
- (list 'set (list 'make-local-variable (list 'quote var)) val))))
-
-(defgroup ack nil
- "Run `ack' and display the results."
- :group 'tools
- :group 'processes)
-
-;; Used implicitly by `define-compilation-mode'
-(defcustom ack-scroll-output nil
- "Similar to `compilation-scroll-output' but for the *Ack* buffer."
- :type 'boolean
- :group 'ack)
-
-(defcustom ack-command
- ;; Note: on GNU/Linux ack may be renamed to ack-grep
- (concat (file-name-nondirectory (or
- (executable-find "ack-grep")
- (executable-find "ack")
- (executable-find "ag")
- (concat
- (executable-find "rg")
- " -n -H -S --no-heading --color always -e")
- "ack")) " ")
- "The default command for \\[ack].
-
-Note also options to ack can be specified in ACK_OPTIONS
-environment variable and .ackrc, which you can disable by the
---noenv switch."
- :type 'string
- :safe 'stringp
- :group 'ack)
-
-(defcustom ack-buffer-name-function nil
- "If non-nil, a function to compute the name of an ack buffer.
-See `compilation-buffer-name-function' for details."
- :type '(choice function (const nil))
- :group 'ack)
-
-(defcustom ack-vc-grep-commands
- '((".git" . "git --no-pager grep --color -n -i")
- (".hg" . "hg grep -n -i")
- ;; Plugin bzr-grep required for bzr < 2.6
- (".bzr" . "bzr grep --color=always -n -i"))
- "An alist of vc grep commands for `ack-skel-vc-grep'.
-Each element is of the form (VC_DIR . CMD)."
- :type '(repeat (cons string string))
- :group 'ack)
-
-(define-obsolete-variable-alias
- 'ack-default-directory-function
- 'ack-defaults-function
- "1.7")
-
-(define-obsolete-function-alias 'ack-default-directory
- 'ack-legacy-defaults "1.7")
-
-(defcustom ack-defaults-function 'ack-quickgrep-defaults
- "A function to return a default parametrization for `ack'.
-It is called with one arg, the prefix arg to `ack'. It may
-return a single element, a string, which is the directory under
-which the `ack' command will be run. It may also return a list
-of (DIR AUTO-CONFIRM . SETUP-FUNCTIONS) which where DIR is a
-directory like previously described, AUTO-CONFIRM says to
-automatically confirm the minibuffer and SETUP-FUNCTIONS are
-added at the end of `ack-minibuffer-setup-hook'.
-
-Two functions are provided for the user to plug here:
-`ack-legacy-defaults' and `ack-quickgrep-defaults' (see their
-docstrings)."
- :type '(choice (const :tag "Use \"quickgrep\" defaults"
- ack-quickgrep-defaults)
- (const :tag "Use \"legacy\" defaults"
- ack-legacy-defaults)
- (function :tag "Use some other function"))
- :group 'ack)
-
-(defcustom ack-project-root-patterns
- (list (concat "\\`" (regexp-quote dir-locals-file) "\\'")
- "\\`Project\\.ede\\'"
- "\\.xcodeproj\\'" ; xcode
- "\\`\\.ropeproject\\'" ; python rope
- "\\`\\.\\(?:CVS\\|bzr\\|git\\|hg\\|svn\\)\\'")
- "A list of regexps to match files in a project root.
-Used by `ack-guess-project-root'."
- :type '(repeat string)
- :group 'ack)
-
-(defcustom ack-minibuffer-setup-hook nil
- "Ack-specific hook for `minibuffer-setup-hook'."
- :type 'hook
- :group 'ack)
-
-;;; ======== END of USER OPTIONS ========
-
-(defvar ack-history nil "History list for ack.")
-
-(defvar ack-first-column 0
- "Value to use for `compilation-first-column' in ack buffers.")
-
-(defvar ack-error-screen-columns nil
- "Value to use for `compilation-error-screen-columns' in ack buffers.")
-
-(defvar ack-error "ack match"
- "Stem of message to print when no matches are found.")
-
-(defvar ack-finish-functions nil
- "Value to use for `compilation-finish-functions' in ack buffers.")
-
-(defun ack-filter ()
- "Handle match highlighting escape sequences inserted by the ack process.
-This function is called from `compilation-filter-hook'."
- (save-excursion
- (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 'ack-color t)))))
- (ansi-color-apply-on-region compilation-filter-start (point)))))
-
-(defvar ack-mode-font-lock-keywords
- '(("^--$" 0 'shadow)
- ;; Command output lines.
- (": \\(.+\\): \\(?:Permission denied\\|No such \\(?:file or
directory\\|device or address\\)\\)$"
- 1 'compilation-error)
- ("^Ack \\(exited
abnormally\\|interrupt\\|killed\\|terminated\\)\\(?:.*with code
\\([0-9]+\\)\\)?.*"
- (1 'compilation-error)
- (2 'compilation-error nil t)))
- "Additional things to highlight in ack output.
-This gets tacked on the end of the generated expressions.")
-
-(defun ack--column-start ()
- (or (let* ((beg (match-end 0))
- (end (save-excursion
- (goto-char beg)
- (line-end-position)))
- (mbeg (text-property-any beg end 'ack-color t)))
- (when mbeg (- mbeg beg)))
- ;; Use column number from `ack' itself if available
- (when (match-string 4)
- (1- (string-to-number (match-string 4))))))
-
-(defun ack--column-end ()
- (let* ((beg (match-end 0))
- (end (save-excursion
- (goto-char beg)
- (line-end-position)))
- (mbeg (text-property-any beg end 'ack-color t))
- (mend (and mbeg (next-single-property-change
- mbeg 'ack-color nil end))))
- (when mend (- mend beg))))
-
-(defun ack--file ()
- (let (file)
- (save-excursion
- (while (progn
- (forward-line -1)
- (looking-at-p "^--$")))
- (setq file (or (get-text-property (line-beginning-position) 'ack-file)
- (progn
- (put-text-property (line-beginning-position)
- (line-end-position)
- 'font-lock-face
compilation-info-face)
- (buffer-substring-no-properties
- (line-beginning-position) (line-end-position))))))
- (put-text-property (line-beginning-position)
- (min (1+ (line-end-position)) (point-max)) 'ack-file
file)
- (list file)))
-
-;;; `compilation-mode-font-lock-keywords' ->
-;;; `compilation--ensure-parse' -> `compilation--parse-region' ->
-;;; `compilation-parse-errors' -> `compilation-error-properties'.
-;;; `compilation-error-properties' returns nil if a previous pattern
-;;; in the regexp alist has already been applied in a region.
-
-(defconst ack-error-regexp-alist
- `(;; Grouping line (--group or --heading).
- ("^\\([1-9][0-9]*\\)\\(:\\|-\\)\\(?:\\(?4:[1-9][0-9]*\\)\\2\\)?"
- ack--file 1 (ack--column-start . ack--column-end)
- nil nil (4 compilation-column-face nil t))
- ;; None grouping line (--nogroup or --noheading). Avoid matching
- ;; 'Ack started at Thu Jun 6 12:27:53'.
-
("^\\(.+?\\)\\(:\\|-\\)\\([1-9][0-9]*\\)\\2\\(?:\\(?:\\(?4:[1-9][0-9]*\\)\\2\\)\\|[^0-9\n]\\|[0-9][^0-9\n]\\|...\\)"
- 1 3 (ack--column-start . ack--column-end)
- nil 1 (4 compilation-column-face nil t))
- ("^Binary file \\(.+\\) matches$" 1 nil nil 0 1))
- "Ack version of `compilation-error-regexp-alist' (which see).")
-
-(defvar ack-process-setup-function 'ack-process-setup)
-
-(defun ack-process-setup ()
- ;; Handle `hg grep' output
- (when (string-match-p "^[ \t]*hg[ \t]" (car compilation-arguments))
- (setq compilation-error-regexp-alist
- '(("^\\(.+?:[0-9]+:\\)\\(?:\\([0-9]+\\):\\)?" 1 2)))
- (setq-local compilation-parse-errors-filename-function
- (lambda (file)
- (save-match-data
- (if (string-match "\\(.+\\):\\([0-9]+\\):" file)
- (match-string 1 file)
- file)))))
- ;; Handle `bzr grep' output
- (when (string-match-p "^[ \t]*bzr[ \t]" (car compilation-arguments))
- (setq-local compilation-parse-errors-filename-function
- (lambda (file)
- (save-match-data
- ;; 'bzr grep -r' has files like `termcolor.py~147'
- (if (string-match "\\(.+\\)~\\([0-9]+\\)" file)
- (match-string 1 file)
- file))))))
-
-(define-compilation-mode ack-mode "Ack"
- "A compilation mode tailored for ack."
- (setq-local compilation-disable-input t)
- (setq-local compilation-error-face 'compilation-info)
- (add-hook 'compilation-filter-hook 'ack-filter nil t))
-
-;;; `compilation-display-error' is introduced in 24.4
-(unless (fboundp 'compilation-display-error)
- (defun ack-mode-display-match ()
- "Display in another window the match in current line."
- (interactive)
- (setq compilation-current-error (point))
- (next-error-no-select 0))
- (define-key ack-mode-map "\C-o" #'ack-mode-display-match))
-
-(defun ack-skel-file ()
- "Insert a template for case-insensitive file name search."
- (interactive)
- (delete-minibuffer-contents)
- (let ((ack (or (car (split-string ack-command nil t)) "ack")))
- (cond ((equal ack "ag")
- (skeleton-insert `(nil ,ack " -ig '" _ "'")))
- ((equal ack "rg")
- (skeleton-insert
- `(nil ,ack " --color always --files --iglob '*" _ "*'")))
- (t (skeleton-insert `(nil ,ack " -g '(?i:" _ ")'"))))))
-
-;; Work around bug http://debbugs.gnu.org/13811
-(defvar ack--project-root nil) ; dynamically bound in `ack'
-
-(defvar ack--yanked-symbol nil) ; buffer-local in the minibuffer
-
-(defun ack-skel-vc-grep (&optional interactive)
- "Find a vc-controlled dir, insert a template for a vc grep search.
-If called interactively, INTERACTIVE is non-nil and calls to this
-function that cannot locate such a directory will produce an
-error, whereas in non-interactive calls they will silently exit,
-leaving the minibuffer unchanged.
-
-Additionally, interactive calls preceded by a previous
-`ack-yank-symbol-at-point' call, will recall the symbol inserted.
-
-This function is a suitable addition to
-`ack-minibuffer-setup-hook'."
- (interactive "p")
- (catch 'giveup
- (let* ((regexp (concat "\\`" (regexp-opt
- (mapcar 'car ack-vc-grep-commands))
- "\\'"))
- (guessed-root (or (ack-guess-project-root ack--project-root regexp)
- (if interactive
- (user-error
- "Cannot locate a vc project root from %s"
- ack--project-root)
- (throw 'giveup nil))))
- (which (progn
- (unless (or interactive
- (equal
- (file-truename ack--project-root)
- (file-truename guessed-root)))
- ;; See github
- ;; https://github.com/leoliu/ack-el/issues/10
- ;; for the reason for giving up here
- ;; non-interactively.
- (throw 'giveup nil))
- (car (directory-files guessed-root nil regexp))))
- (backend (downcase (substring which 1)))
- (cmd (or (cdr (assoc which ack-vc-grep-commands))
- (error "No command provided for `%s grep'" backend))))
- (when interactive
- (setq ack--project-root guessed-root)
- (ack-update-minibuffer-prompt))
- (delete-minibuffer-contents)
- (skeleton-insert `(nil ,cmd " '" _ "'"))
- (when (and interactive ack--yanked-symbol)
- (insert ack--yanked-symbol)))))
-
-(defun ack-yank-symbol-at-point ()
- "Yank the symbol from the window before entering the minibuffer."
- (interactive)
- (let ((symbol (and (minibuffer-selected-window)
- (with-current-buffer
- (window-buffer (minibuffer-selected-window))
- (thing-at-point 'symbol)))))
- (cond (symbol (insert symbol)
- (set (make-local-variable 'ack--yanked-symbol) symbol))
- (t (minibuffer-message "No symbol found")))))
-
-(defvar ack-minibuffer-local-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map minibuffer-local-map)
- (define-key map "\t" 'completion-at-point)
- (define-key map "\M-I" 'ack-skel-file)
- (define-key map "\M-G" 'ack-skel-vc-grep)
- (define-key map "\M-Y" 'ack-yank-symbol-at-point)
- (define-key map "'" 'skeleton-pair-insert-maybe)
- map)
- "Keymap used for reading `ack' command and args in minibuffer.")
-
-(defun ack-guess-project-root (start-directory &optional regexp)
- (let ((regexp (or regexp
- (mapconcat 'identity ack-project-root-patterns "\\|")))
- (parent (file-name-directory
- (directory-file-name (expand-file-name start-directory)))))
- (if (directory-files start-directory nil regexp)
- start-directory
- (unless (equal parent start-directory)
- (ack-guess-project-root parent regexp)))))
-
-(defun ack-legacy-defaults (arg)
- "A function for `ack-defaults-function'.
-With null ARG (no \\[universal-argument]), return
-`default-directory'; With one \\[universal-argument], find the
-project root according to `ack-project-root-patterns'; Otherwise,
-interactively choose a directory."
- (cond
- ((not arg) default-directory)
- ((= (prefix-numeric-value arg) 4)
- (or (ack-guess-project-root default-directory)
- (ack-legacy-defaults '(16))))
- (t (read-directory-name "In directory: " nil nil t))))
-
-(defun ack-quickgrep-defaults (arg)
- "A function for `ack-defaults-function'.
-With null ARG (no \\[universal-argument]) returns a list (DIR
-AUTO-CONFIRM SETUP) where DIR is guessed according to
-`ack-guess-project-root', AUTO-CONFIRM is t and SETUP contains
-`ack-skel-vc-grep' and `ack-yank-symbol-at-point'. This makes
-`ack' attempt to a \"git grep\" search immediately for the symbol
-at point. The \"git grep\" command line will only be suggested
-if it makes sense in the context (otherwise, a fallback to
-`ack-command', like \"ack\" or \"ag\", is used). Likewise, the
-search only starts immediately if there is indeed something \"at
-point\".
-
-With one \\[universal-argument], behaves like before except that
-AUTO-CONFIRM is nil. This composes an identical `ack' command
-but allows the user to edit it before searching, just like what
-would have happened if there was no symbol at point.
-
-With more \\[universal-argument]'s, behaves like before except
-that DIR is first requested from the user and \"git grep\" is not
-automatically attempted."
- (let ((numeric (prefix-numeric-value arg)))
- (append (list (if (> numeric 4)
- (read-directory-name "In directory: " nil nil t)
- (ack-guess-project-root default-directory))
- (and (thing-at-point 'symbol) (= numeric 1)))
- (if (> numeric 4)
- (list 'ack-yank-symbol-at-point)
- (list 'ack-skel-vc-grep 'ack-yank-symbol-at-point)))))
-
-(defun ack-update-minibuffer-prompt (&optional _beg _end _len)
- (when (minibufferp)
- (let ((inhibit-read-only t))
- (save-excursion
- (goto-char (minibuffer-prompt-end))
- (when (looking-at "\\(\\w+\\)\\s-")
- (put-text-property
- (point-min) (minibuffer-prompt-end)
- 'display
- (format "Run %s in `%s': "
- (match-string-no-properties 1)
- (if (string-prefix-p default-directory
- (expand-file-name ack--project-root))
- (file-name-nondirectory
- (directory-file-name ack--project-root))
- ack--project-root))))))))
-
-(defun ack-minibuffer-setup-function ()
- (shell-completion-vars)
- (add-hook 'after-change-functions
- #'ack-update-minibuffer-prompt nil t)
- (ack-update-minibuffer-prompt)
- (run-hooks 'ack-minibuffer-setup-hook))
-
-(defun ack--auto-confirm ()
- (when ack--yanked-symbol
- (throw 'ack--auto-confirm
- (buffer-substring-no-properties
- (minibuffer-prompt-end) (point-max)))))
-
-;;;###autoload
-(defun ack (command-args &optional directory)
- "Run ack using COMMAND-ARGS and collect output in a buffer.
-When called interactively, the value of DIRECTORY is provided by
-`ack-default-directory-function'.
-
-The following keys are available while reading from the
-minibuffer:
-
-\\{ack-minibuffer-local-map}"
- (interactive
- (pcase-let* ((defaults (funcall ack-defaults-function current-prefix-arg))
- (defaults (if (listp defaults) defaults (list defaults nil)))
- (`(,ack--project-root ,auto-confirm . ,setup) defaults)
- (ack--project-root (or ack--project-root default-directory))
- (ack-minibuffer-setup-hook (if setup
- (append
ack-minibuffer-setup-hook
- setup)
- ack-minibuffer-setup-hook))
- (ack-minibuffer-setup-hook (if auto-confirm
- (delete-dups
- (append
ack-minibuffer-setup-hook
-
'(ack-yank-symbol-at-point
- ack--auto-confirm)))
- ack-minibuffer-setup-hook))
- ;; Disable completion cycling; see http://debbugs.gnu.org/12221
- (completion-cycle-threshold nil))
- (list (minibuffer-with-setup-hook 'ack-minibuffer-setup-function
- (catch 'ack--auto-confirm
- (read-from-minibuffer "Ack: "
- `(,(concat ack-command "''")
- . ,(+ (length ack-command) 2))
- ack-minibuffer-local-map
- nil 'ack-history)))
- ack--project-root)))
- (let* ((lexical-default-directory
- (expand-file-name
- (or directory default-directory))))
- ;; Change to the compilation to ensure a correct
- ;; `default-directory' there and to ensure
- ;; `ack-buffer-name-function' can make use of
- ;; `compilation-arguments'.
- (with-current-buffer
- (let ((default-directory lexical-default-directory))
- (compilation-start command-args 'ack-mode))
- (when ack-buffer-name-function
- (rename-buffer (funcall ack-buffer-name-function "ack")))
- (setq default-directory lexical-default-directory)
- (current-buffer))))
-
-(provide 'ack)
-;;; ack.el ends here
diff --git a/packages/ack/pcmpl-ack.el b/packages/ack/pcmpl-ack.el
deleted file mode 100644
index 26ddb6e..0000000
--- a/packages/ack/pcmpl-ack.el
+++ /dev/null
@@ -1,176 +0,0 @@
-;;; pcmpl-ack.el --- completion for ack and ag -*- lexical-binding: t;
-*-
-
-;; Copyright (C) 2012-2015 Free Software Foundation, Inc.
-
-;; Author: Leo Liu <sdl.web@gmail.com>
-;; Keywords: tools, processes, convenience
-;; Created: 2012-09-26
-;; URL: https://github.com/leoliu/ack-el
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Provide pcompletion support for the cli tool `ack' which can be
-;; downloaded from http://beyondgrep.com.
-;;
-;; Install:
-;; (autoload 'pcomplete/ack "pcmpl-ack")
-;; (autoload 'pcomplete/ag "pcmpl-ack")
-;;
-;; Usage:
-;; - To complete short options type '-' first
-;; - To complete long options type '--' first
-;; - Color name completion is supported following
-;; --color-filename=, --color-match= and --color-lineno=
-;; - Type completion is supported following --type=
-
-;;; Code:
-
-(require 'pcomplete)
-
-(defcustom pcmpl-ack-program
- (file-name-nondirectory (or (executable-find "ack-grep")
- (executable-find "ack")
- "ack"))
- "Name of the ack program."
- :type 'file
- :group 'pcomplete)
-
-(defvar pcmpl-ack-color-options
- '("clear"
- "reset"
- "dark"
- "bold"
- "underline"
- "underscore"
- "blink"
- "reverse"
- "concealed"
- "black"
- "red"
- "green"
- "yellow"
- "blue"
- "magenta"
- "on_black"
- "on_red"
- "on_green"
- "on_yellow"
- "on_blue"
- "on_magenta"
- "on_cyan"
- "on_white")
- "Color names for the `ack' command.")
-
-(defun pcmpl-ack-run (buffer &rest args)
- "Run ack with ARGS and send the output to BUFFER."
- (condition-case nil
- (apply 'call-process (or pcmpl-ack-program "ack") nil buffer nil args)
- (file-error -1)))
-
-(defun pcmpl-ack-short-options ()
- "Short options for the `ack' command."
- (with-temp-buffer
- (let (options)
- (when (zerop (pcmpl-ack-run t "--help"))
- (goto-char (point-min))
- (while (re-search-forward "^ -\\([^-]\\)" nil t)
- (push (match-string 1) options))
- (mapconcat 'identity (nreverse options) "")))))
-
-(defun pcmpl-ack-long-options (&optional arg)
- "Long options for the `ack' command."
- (with-temp-buffer
- (let (options)
- (when (zerop (pcmpl-ack-run t (or arg "--help")))
- (goto-char (point-min))
- (while (re-search-forward
- "\\(?: ?\\|, \\)\\(--\\(\\[no\\]\\)?\\([[:alnum:]-]+=?\\)\\)"
- nil t)
- (if (not (match-string 2))
- (push (match-string 1) options)
- (push (concat "--" (match-string 3)) options)
- (push (concat "--no" (match-string 3)) options)))
- (nreverse options)))))
-
-(defun pcmpl-ack-type-options ()
- "A list of types for the `ack' command."
- (pcmpl-ack-long-options "--help-types"))
-
-;;;###autoload
-(defun pcomplete/ack ()
- "Completion for the `ack' command.
-Start an argument with `-' to complete short options and `--' for
-long options."
- ;; No space after =
- (while t
- (if (pcomplete-match "^-" 0)
- (cond
- ((pcomplete-match "^--color-\\w+=\\(\\S-*\\)" 0)
- (pcomplete-here* pcmpl-ack-color-options
- (pcomplete-match-string 1 0) t))
- ((pcomplete-match "^--\\(?:no\\)?ignore-dir=\\(\\S-*\\)" 0)
- (pcomplete-here* (pcomplete-dirs)
- (pcomplete-match-string 1 0) t))
- ((pcomplete-match "^--type=\\(\\S-*\\)" 0)
- (pcomplete-here* (mapcar (lambda (type-option)
- (substring type-option 2))
- (pcmpl-ack-type-options))
- (pcomplete-match-string 1 0) t))
- ((pcomplete-match "^--" 0)
- (pcomplete-here* (append (pcmpl-ack-long-options)
- (pcmpl-ack-type-options))))
- (t (pcomplete-opt (pcmpl-ack-short-options))))
- (pcomplete-here* (pcomplete-dirs-or-entries)))))
-
-;;;###autoload
-(defalias 'pcomplete/ack-grep 'pcomplete/ack)
-
-(defvar pcmpl-ack-ag-options nil)
-
-(defun pcmpl-ack-ag-options ()
- (or pcmpl-ack-ag-options
- (setq pcmpl-ack-ag-options
- (with-temp-buffer
- (when (zerop (call-process "ag" nil t nil "--help"))
- (let (short long)
- (goto-char (point-min))
- (while (re-search-forward "^ +\\(-[a-zA-Z]\\) " nil t)
- (push (match-string 1) short))
- (goto-char (point-min))
- (while (re-search-forward
- "^ +\\(?:-[a-zA-Z] \\)?\\(--\\(\\[no\\]\\)?[^
\t\n]+\\) "
- nil t)
- (if (match-string 2)
- (progn
- (replace-match "" nil nil nil 2)
- (push (match-string 1) long)
- (replace-match "no" nil nil nil 2)
- (push (match-string 1) long))
- (push (match-string 1) long)))
- (list (cons 'short (nreverse short))
- (cons 'long (nreverse long)))))))))
-
-;;;###autoload
-(defun pcomplete/ag ()
- "Completion for the `ag' command."
- (while t
- (if (pcomplete-match "^-" 0)
- (pcomplete-here* (cdr (assq (if (pcomplete-match "^--" 0) 'long 'short)
- (pcmpl-ack-ag-options))))
- (pcomplete-here* (pcomplete-dirs-or-entries)))))
-
-(provide 'pcmpl-ack)
-;;; pcmpl-ack.el ends here
diff --git a/packages/company-math/.dir-locals.el
b/packages/company-math/.dir-locals.el
deleted file mode 100644
index 064a938..0000000
--- a/packages/company-math/.dir-locals.el
+++ /dev/null
@@ -1,3 +0,0 @@
-
-((emacs-lisp-mode
- (indent-tabs-mode)))
diff --git a/packages/company-math/company-math.el
b/packages/company-math/company-math.el
deleted file mode 100644
index c55a717..0000000
--- a/packages/company-math/company-math.el
+++ /dev/null
@@ -1,240 +0,0 @@
-;;; company-math.el --- Completion backends for unicode math symbols and latex
tags
-;;
-;; Copyright (C) 2015 Free Software Foundation, Inc.
-;; Author: Vitalie Spinu <spinuvit@gmail.com>
-;; URL: https://github.com/vspinu/company-math
-;; Keywords: Unicode, symbols, completion
-;; Version: 1.3
-;; Package-Requires: ((company "0.8.0") (math-symbol-lists "1.2"))
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; This file is 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 3, or
-;; (at your option) any later version.
-;;
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with this program; see the file COPYING. If not, write to
-;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
-;; Floor, Boston, MA 02110-1301, USA.
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;;; Commentary:
-;;
-;;; Code:
-
-(require 'math-symbol-lists)
-(require 'company)
-(require 'cl-lib)
-
-(defgroup company-math nil
- "Completion back-ends for math symbols Unicode symbols and LaTeX tags."
- :group 'company
- :prefix "company-math-")
-
-(defcustom company-math-symbol-prefix "\\"
- "Prefix to use for latex and unicode symbols."
- :group 'company-math
- :type 'string)
-
-(defcustom company-math-subscript-prefix "__"
- "Prefix for unicode subscripts.
-When nil, no custom prefix is active. Irrespective of the value
-of this variable, prefix composed of `company-math-symbol-prefix'
-and \"_\" is always active (\"\\_\"). This variable takes effect
-in a new Emacs session."
- :group 'company-math
- :type '(choice (const :tag "No Custom Prefix" nil)
- string))
-
-(defcustom company-math-superscript-prefix "^^"
- "Prefix for unicode superscripts.
-When nil, no custom prefix is active. Irrespective of the value
-of this variable, prefix composed of `company-math-symbol-prefix'
-and \"^\" is always active (\"\\^\"). This variable takes effect
-in a new Emacs session."
- :group 'company-math
- :type '(choice (const :tag "No Custom Prefix" nil)
- string))
-
-;; no more custom since since v.1.2
-(when (boundp 'company-math-prefix-regexp)
- (warn "`company-math-prefix-regexp' is deprecated, please remove from your
custom settings."))
-
-(defvar company-math--latex-prefix-regexp
- (concat (regexp-quote company-math-symbol-prefix)
- "[^ \t\n]+"))
-
-(let ((psym (regexp-quote company-math-symbol-prefix))
- (psub (when company-math-symbol-prefix
- (concat "\\|" (regexp-quote company-math-subscript-prefix))))
- (psup (when company-math-superscript-prefix
- (concat "\\|" (regexp-quote company-math-superscript-prefix)))))
- (setq company-math--unicode-prefix-regexp
- (concat "\\(" psym psub psup "\\)[^ \t\n]*")))
-
-(defcustom company-math-allow-unicode-symbols-in-faces t
- "List of faces to allow the insertion of Unicode symbols.
-When set to special value t, allow on all faces except those in
-`company-math-disallow-unicode-symbols-in-faces'."
- :group 'company-math
- :type '(choice (const t)
- (repeat :tag "Faces" symbol)))
-
-(defcustom company-math-allow-latex-symbols-in-faces '(tex-math
font-latex-math-face org-latex-and-related)
- "List of faces to disallow the insertion of latex mathematical symbols.
-When set to special value t, allow on all faces except those in
-`company-math-disallow-latex-symbols-in-faces'."
- :group 'company-math
- :type '(choice (const t)
- (repeat :tag "Faces" symbol)))
-
-(defcustom company-math-disallow-unicode-symbols-in-faces
'(font-latex-math-face)
- "List of faces to disallow the insertion of Unicode symbols."
- :group 'company-math
- :type '(repeat symbol))
-
-(defcustom company-math-disallow-latex-symbols-in-faces '()
- "List of faces to disallow the insertion of latex mathematical symbols."
- :group 'company-math
- :type '(repeat symbol))
-
-
-;;; INTERNALS
-
-(defun company-math--make-candidates (alist prefix)
- "Build a list of math symbols ready to be used in a company backend.
-ALIST is one of the defined alist in package `math-symbol-lists'.
-PREFIX is a string to be prefixed to each symbol. Return a list
-of LaTeX symbols with text property :symbol being the
-corresponding unicode symbol."
- (delq nil
- (mapcar
- (lambda (el)
- (let* ((tex (concat prefix (substring (nth 1 el) 1)))
- (ch (and (nth 2 el) (decode-char 'ucs (nth 2 el))))
- (symb (and ch (char-to-string ch))))
- (propertize tex :symbol symb)))
- alist)))
-
-(defconst company-math--latex-commands
- (mapcar (lambda (c) (concat company-math-symbol-prefix c))
math-symbol-list-latex-commands)
- "List of LaTeX math completion candidates.")
-
-(defconst company-math--symbols
- (delete-dups
- (append (company-math--make-candidates math-symbol-list-basic
company-math-symbol-prefix)
- (company-math--make-candidates math-symbol-list-extended
company-math-symbol-prefix)))
- "List of LaTeX math completion candidates.")
-
-(defconst company-math--unicode
- (append
- (append (when company-math-subscript-prefix
- (company-math--make-candidates math-symbol-list-subscripts
company-math-subscript-prefix))
- (company-math--make-candidates math-symbol-list-subscripts (concat
company-math-symbol-prefix "_"))
- (when company-math-superscript-prefix
- (company-math--make-candidates math-symbol-list-superscripts
company-math-superscript-prefix))
- (company-math--make-candidates math-symbol-list-superscripts
(concat company-math-symbol-prefix "^")))
- company-math--symbols)
- "List of math completion candidates for unicode backend.")
-
-(defun company-math--prefix (regexp allow-faces disallow-faces)
- "Response to company prefix command.
-REGEXP is the regexp, ALLOW-FACES and DISALLOW-FACES are list of
-various faces to allow or disallow completion on."
- (let* ((face (get-text-property (point) 'face))
- (face (or (car-safe face) face))
- (insertp (and (not (memq face disallow-faces))
- (or (eq t allow-faces)
- (memq face allow-faces)))))
- (when insertp
- (save-excursion
- (let* ((ppss (syntax-ppss))
- (min-point (if (nth 3 ppss)
- (max (nth 8 ppss) (point-at-bol))
- (point-at-bol))))
- (when (looking-back regexp min-point 'greedy)
- (match-string 0)))))))
-
-(defun company-math--substitute-unicode (symbol)
- "Substitute preceding latex command with with SYMBOL."
- (let ((pos (point))
- (inhibit-point-motion-hooks t))
- (when (re-search-backward company-math--unicode-prefix-regexp) ; should
always match
- (goto-char (match-beginning 0))
- ;; allow subsups to start with \
- (let ((start (max (point-min) (- (point) (length
company-math-symbol-prefix)))))
- (when (string= (buffer-substring-no-properties start (point))
- company-math-symbol-prefix)
- (goto-char start)))
- (delete-region (point) pos)
- (insert symbol))))
-
-
-;;; BACKENDS
-
-;;;###autoload
-(defun company-latex-commands (command &optional arg &rest _ignored)
- "Company backend for latex commands.
-COMMAND and ARG is as required by company backends."
- (interactive (list 'interactive))
- (cl-case command
- (interactive (company-begin-backend 'company-latex-commands))
- (prefix (unless (company-in-string-or-comment)
- (company-math--prefix company-math--latex-prefix-regexp t '())))
- (candidates (all-completions arg company-math--latex-commands))
- (sorted t)))
-
-;;;###autoload
-(defun company-math-symbols-latex (command &optional arg &rest _ignored)
- "Company backend for LaTeX mathematical symbols.
-COMMAND and ARG is as required by company backends."
- (interactive (list 'interactive))
- (cl-case command
- (interactive (company-begin-backend 'company-math-symbols-latex))
- (prefix (unless (company-in-string-or-comment)
- (company-math--prefix company-math--latex-prefix-regexp
- company-math-allow-latex-symbols-in-faces
-
company-math-disallow-latex-symbols-in-faces)))
- (annotation (concat " " (get-text-property 0 :symbol arg)))
- (candidates (all-completions arg company-math--symbols))))
-
-;;;###autoload
-(defun company-math-symbols-unicode (command &optional arg &rest _ignored)
- "Company backend for insertion of Unicode mathematical symbols.
-COMMAND and ARG is as required by company backends.
-See the unicode-math page [1] for a list of fonts that have a
-good support for mathematical symbols. Unicode provides only a
-limited range of sub(super)scripts; see the wikipedia page [2]
-for details.
-
- [1]
http://ftp.snt.utwente.nl/pub/software/tex/help/Catalogue/entries/unicode-math.html
- [2] https://en.wikipedia.org/wiki/Unicode_subscripts_and_superscripts";
- (interactive (list 'interactive))
- (cl-case command
- (interactive (company-begin-backend 'company-math-symbols-unicode))
- (prefix (company-math--prefix company-math--unicode-prefix-regexp
- company-math-allow-unicode-symbols-in-faces
-
company-math-disallow-unicode-symbols-in-faces))
- (annotation (concat " " (get-text-property 0 :symbol arg)))
- ;; Space added to ensure that completions are never typed in full.
- ;; See https://github.com/company-mode/company-mode/issues/476
- (candidates (delq nil
- (mapcar (lambda (candidate)
- (when (get-text-property 0 :symbol candidate)
- (concat candidate " ")))
- (all-completions arg company-math--unicode))))
- (post-completion (company-math--substitute-unicode
- (get-text-property 0 :symbol arg)))))
-
-(provide 'company-math)
-;;; company-math.el ends here
diff --git a/packages/company-math/img/latex-symbols.png
b/packages/company-math/img/latex-symbols.png
deleted file mode 100644
index 781a46a..0000000
Binary files a/packages/company-math/img/latex-symbols.png and /dev/null differ
diff --git a/packages/company-math/img/unicode-symbols.png
b/packages/company-math/img/unicode-symbols.png
deleted file mode 100644
index 050e6fe..0000000
Binary files a/packages/company-math/img/unicode-symbols.png and /dev/null
differ
diff --git a/packages/company-math/readme.md b/packages/company-math/readme.md
deleted file mode 100644
index bd780f6..0000000
--- a/packages/company-math/readme.md
+++ /dev/null
@@ -1,73 +0,0 @@
-This add-on defines three *[company-mode](http://company-mode.github.io/)*
backends:
-
-* `company-math-symbols-latex` - math latex tags (_by default, active only on
latex math faces_)
-
-
-
-* `company-math-symbols-unicode` - math unicode symbols and
sub(super)scripts (_by default, active everywhere except math faces_)
-
-
-
-* `company-latex-commands` - latex commands
-
-## Usage ##
-
-Start math completion by typing the prefix <kbd>`\`</kbd> key. To select the
-completion type <kbd>RET</kbd>. Depending on the context and your configuration
-unicode symbol or latex tag will be inserted.
-
-Since version 1.2 sub(super)script completion is available for the
-`company-math-symbols-unicode` backend. Subscripts are inserted with either
`__`
-or `\_` prefixes. Superscripts with `^^` or `\^`. Customize
-`company-math-subscript-prefix` and `company-math-superscript-prefix` if you
-don't like this default.
-
-## Activation ##
-
-Install from ELPA or MELPA repositories.
-
-You can either register each backend globally:
-
-
-```elisp
-
-;; global activation of the unicode symbol completion
-(add-to-list 'company-backends 'company-math-symbols-unicode)
-
-```
-
-or locally per emacs mode:
-
-
-```elisp
-
-;; local configuration for TeX modes
-(defun my-latex-mode-setup ()
- (setq-local company-backends
- (append '((company-math-symbols-latex company-latex-commands))
- company-backends)))
-
-(add-hook 'tex-mode-hook 'my-latex-mode-setup)
-
-```
-
-If you are using `AUCTeX` you might need to use `TeX-mode-hook` instead:
-
-```elisp
-(add-hook 'TeX-mode-hook 'my-latex-mode-setup)
-```
-
-## Further Customization ##
-
-Set `company-tooltip-align-annotations` to t in order to align symbols to the
-right as in the snapshots from above.
-
-By default unicode symbols backend (`company-math-symbols-unicode`) is not
-active in latex math environments and latex math symbols
-(`company-math-symbols-latex`) is not available outside of math latex
-environments. You can use the following custom lists of faces to change this
-behavior: `company-math-disallow-unicode-symbols-in-faces`,
-`company-math-allow-unicode-symbols-in-faces`,
-`company-math-disallow-latex-symbols-in-faces`,
-`company-math-allow-latex-symbols-in-faces`.
-
diff --git a/packages/easy-kill/.elpaignore b/packages/easy-kill/.elpaignore
deleted file mode 100644
index 0596a8b..0000000
--- a/packages/easy-kill/.elpaignore
+++ /dev/null
@@ -1,4 +0,0 @@
-.travis.yml
-.gitignore
-Makefile
-test.el
diff --git a/packages/easy-kill/.travis.yml b/packages/easy-kill/.travis.yml
deleted file mode 100644
index f44ac89..0000000
--- a/packages/easy-kill/.travis.yml
+++ /dev/null
@@ -1,23 +0,0 @@
-# https://github.com/rolandwalker/emacs-travis
-
-language: emacs-lisp
-
-env:
- - EMACS=emacs24
- - EMACS=emacs-snapshot
-
-install:
- - if [ "$EMACS" = "emacs24" ]; then
- sudo add-apt-repository -y ppa:cassou/emacs &&
- sudo apt-get update -qq &&
- sudo apt-get install -qq emacs24 emacs24-el;
- fi
- - if [ "$EMACS" = "emacs-snapshot" ]; then
- sudo add-apt-repository -y ppa:ubuntu-elisp/ppa &&
- sudo apt-get update -qq &&
- sudo apt-get install -qq emacs-snapshot &&
- sudo apt-get install -qq emacs-snapshot-el;
- fi
-
-script:
- make test EMACS=${EMACS}
diff --git a/packages/easy-kill/Makefile b/packages/easy-kill/Makefile
deleted file mode 100644
index e73981f..0000000
--- a/packages/easy-kill/Makefile
+++ /dev/null
@@ -1,17 +0,0 @@
-.PHONY: all clean test
-
-EMACS = emacs
-
-ELCFILES = $(addsuffix .elc, $(basename $(wildcard *.el)))
-
-all: $(ELCFILES)
-
-%.elc : %.el
- @echo Compiling $<
- @${EMACS} -batch -q -no-site-file -L . -f batch-byte-compile $<
-
-clean:
- @rm -f *.elc
-
-test: all
- @${EMACS} -batch -L . -l test.el -f ert-run-tests-batch-and-exit
diff --git a/packages/easy-kill/README.rst b/packages/easy-kill/README.rst
deleted file mode 100644
index 02ad57b..0000000
--- a/packages/easy-kill/README.rst
+++ /dev/null
@@ -1,123 +0,0 @@
-====================================
- Kill & Mark Things Easily in Emacs
-====================================
-
-.. image:: https://travis-ci.org/leoliu/easy-kill.svg?branch=master
- :target: https://travis-ci.org/leoliu/easy-kill
- :align: right
- :alt: Travis CI build status
-
-Provide commands ``easy-kill`` and ``easy-mark`` to let users kill or
-mark things easily.
-
-Comments, bug reports and patches are highly appreciated.
-
-easy-kill
-~~~~~~~~~
-
-``easy-kill`` is a drop-in replacement for ``kill-ring-save``. To Use:
-::
-
- (global-set-key [remap kill-ring-save] 'easy-kill)
-
-After this configuration, ``M-w`` serves as both a command and a
-prefix key for other commands. ``M-w`` alone saves in the order of
-active region, url, email and finally current line (See
-``easy-kill-try-things``). As a prefix key:
-
-#. ``M-w w``: save word at point
-#. ``M-w s``: save sexp at point
-#. ``M-w l``: save list at point (enclosing sexp)
-#. ``M-w d``: save defun at point
-#. ``M-w f``: save file at point
-#. ``M-w b``: save ``buffer-file-name`` or ``default-directory``.
- ``-`` changes the kill to the directory name, ``+`` to full name
- and ``0`` to basename.
-
-The following keys modify the selection:
-
-#. ``@``: append selection to previous kill and exit. For example,
- ``M-w d @`` will append current function to last kill.
-#. ``C-w``: kill selection and exit
-#. ``+``, ``-`` and ``1..9``: expand/shrink selection
-#. ``0`` shrink the selection to the intitial size i.e. before any
- expansion
-#. ``C-SPC``: turn selection into an active region
-#. ``C-g``: abort
-#. ``?``: help
-
-For example, ``M-w w`` saves current word, repeat ``w`` to expand the
-kill to include the next word. ``5`` to include the next 5 words etc.
-The other commands also follow this pattern.
-
-``+``/``-`` does expanding/shrinking according to the thing selected.
-So for ``word`` the expansion is word-wise, for ``line`` line-wise,
-for ``list`` or ``sexp``, list-wise.
-
-``list-wise`` expanding/shrinking work well in lispy modes (elisp,
-Common Lisp, Scheme, Clojure etc.), smie-based modes (Prolog, SML,
-Modula2, Shell, Ruby, Octave, CSS, SQL etc.), Org mode, Nxml mode and
-Js2 mode.
-
-To copy the enclosing list in lispy modes, I used to do a lot of
-``C-M-u C-M-SPC M-w``. Now the key sequence is replaced by ``M-w l``
-(save list at point) as shown in `screenshot
-<http://i.imgur.com/8TNgPly.png>`_:
-
-.. figure:: http://i.imgur.com/8TNgPly.png
- :target: http://i.imgur.com/8TNgPly.png
- :alt: ``M-w l``
-
-easy-mark
-~~~~~~~~~
-
-``easy-mark`` is similar to ``easy-kill`` but marks the region
-immediately. It can be a handy replacement for ``mark-sexp`` allowing
-``+``/``-`` to do list-wise expanding/shrinking and marks the whole
-sexp even when in the middle of one. ::
-
- (global-set-key [remap mark-sexp] 'easy-mark)
-
-Install
-~~~~~~~
-
-``easy-kill`` is part of GNU ELPA and is also available on `MELPA
-<http://melpa.milkbox.net/#/easy-kill>`_.
-
-Extensions
-~~~~~~~~~~
-
-New things can be defined by following package ``thingatpt.el``'s
-convention, or by defining new functions named like
-``easy-kill-on-THING-NAME``. See ``easy-kill-on-buffer-file-name`` and
-``easy-kill-on-url`` for examples.
-
-NEWS
-~~~~
-
-0.9.3
-+++++
-
-#. Key ``?`` in ``easy-kill`` or ``easy-mark`` prints help info.
-#. ``M-w l`` can select the enclosing string.
-#. ``easy-mark`` learns exchanging point & mark.
-#. Key ``0`` now sets the selection to its initial size before any
- expansion.
-#. ``M-w l``, ``M-w s`` and list-wise ``+/-`` now work in Org mode.
-
-0.9.2
-+++++
-
-#. ``-`` can move pass the first selection.
-#. ``+``/``-`` on ``sexp`` no longer change ``thing`` to ``list``
-#. Mouse over the selection now shows description.
-#. Echo js2 node name.
-#. Append now uses sensible separator (customisable via
- ``easy-kill-alist``).
-#. The format of easy-kill-alist has changed. The old ``(CHAR .
- THING)`` format is still supported but may be removed in future.
-
-Bugs
-~~~~
-
-https://github.com/leoliu/easy-kill/issues
diff --git a/packages/easy-kill/easy-kill.el b/packages/easy-kill/easy-kill.el
deleted file mode 100644
index 5db6823..0000000
--- a/packages/easy-kill/easy-kill.el
+++ /dev/null
@@ -1,832 +0,0 @@
-;;; easy-kill.el --- kill & mark things easily -*- lexical-binding: t;
-*-
-
-;; Copyright (C) 2013-2014 Free Software Foundation, Inc.
-
-;; Author: Leo Liu <sdl.web@gmail.com>
-;; Version: 0.9.3
-;; Package-Requires: ((emacs "24") (cl-lib "0.5"))
-;; Keywords: killing, convenience
-;; Created: 2013-08-12
-;; URL: https://github.com/leoliu/easy-kill
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; `easy-kill' aims to be a drop-in replacement for `kill-ring-save'.
-;;
-;; To use: (global-set-key [remap kill-ring-save] 'easy-kill)
-
-;; `easy-mark' is similar to `easy-kill' but marks the region
-;; immediately. It can be a handy replacement for `mark-sexp' allowing
-;; `+'/`-' to do list-wise expanding/shrinking.
-;;
-;; To use: (global-set-key [remap mark-sexp] 'easy-mark)
-
-;; Please send bug reports or feature requests to:
-;; https://github.com/leoliu/easy-kill/issues
-
-;;; Code:
-
-(require 'cl-lib)
-(require 'thingatpt)
-(eval-when-compile (require 'cl)) ;For `defsetf'.
-
-(eval-and-compile
- (cond
- ((fboundp 'set-transient-map) nil)
- ((fboundp 'set-temporary-overlay-map) ; new in 24.3
- (defalias 'set-transient-map 'set-temporary-overlay-map))
- (t
- (defun set-transient-map (map &optional keep-pred)
- (let* ((clearfunsym (make-symbol "clear-temporary-overlay-map"))
- (overlaysym (make-symbol "t"))
- (alist (list (cons overlaysym map)))
- (clearfun
- `(lambda ()
- (unless ,(cond ((null keep-pred) nil)
- ((eq t keep-pred)
- `(eq this-command
- (lookup-key ',map
- (this-command-keys-vector))))
- (t `(funcall ',keep-pred)))
- (set ',overlaysym nil) ;Just in case.
- (remove-hook 'pre-command-hook ',clearfunsym)
- (setq emulation-mode-map-alists
- (delq ',alist emulation-mode-map-alists))))))
- (set overlaysym overlaysym)
- (fset clearfunsym clearfun)
- (add-hook 'pre-command-hook clearfunsym)
- (push alist emulation-mode-map-alists))))))
-
-(defcustom easy-kill-alist '((?w word " ")
- (?s sexp "\n")
- (?l list "\n")
- (?f filename "\n")
- (?d defun "\n\n")
- (?e line "\n")
- (?b buffer-file-name))
- "A list of (CHAR THING APPEND).
-CHAR is used immediately following `easy-kill' to select THING.
-APPEND is optional and if non-nil specifies the separator (a
-string) for appending current selection to previous kill.
-
-Note: each element can also be (CHAR . THING) but this is
-deprecated."
- :type '(repeat (list character symbol
- (choice string (const :tag "None" nil))))
- :group 'killing)
-
-(defcustom easy-kill-try-things '(url email line)
- "A list of things for `easy-kill' to try."
- :type '(repeat symbol)
- :group 'killing)
-
-(defcustom easy-mark-try-things '(url email sexp)
- "A list of things for `easy-mark' to try."
- :type '(repeat symbol)
- :group 'killing)
-
-(defface easy-kill-selection '((t (:inherit secondary-selection)))
- "Faced used to highlight kill candidate."
- :group 'killing)
-
-(defface easy-kill-origin '((t (:inverse-video t :inherit error)))
- "Faced used to highlight the origin."
- :group 'killing)
-
-(defvar easy-kill-base-map
- (let ((map (make-sparse-keymap)))
- (define-key map "-" 'easy-kill-shrink)
- (define-key map "+" 'easy-kill-expand)
- (define-key map "=" 'easy-kill-expand)
- (define-key map "@" 'easy-kill-append)
- ;; Note: didn't pick C-h because it is a very useful prefix key.
- (define-key map "?" 'easy-kill-help)
- (define-key map [remap set-mark-command] 'easy-kill-mark-region)
- (define-key map [remap kill-region] 'easy-kill-region)
- (define-key map [remap keyboard-quit] 'easy-kill-abort)
- (define-key map [remap exchange-point-and-mark]
- 'easy-kill-exchange-point-and-mark)
- (mapc (lambda (d)
- (define-key map (number-to-string d) 'easy-kill-digit-argument))
- (number-sequence 0 9))
- map))
-
-(defvar easy-kill-inhibit-message nil)
-
-(defun easy-kill-echo (format-string &rest args)
- "Same as `message' except not writing to *Messages* buffer.
-Do nothing if `easy-kill-inhibit-message' is non-nil."
- (unless easy-kill-inhibit-message
- (let (message-log-max)
- (apply 'message format-string args))))
-
-(defun easy-kill-trim (s &optional how)
- (let ((wchars "[ \t\n\r\f\v]*"))
- (pcase how
- (`left (and (string-match (concat "\\`" wchars) s)
- (substring s (match-end 0))))
- (`right (substring s 0 (string-match-p (concat wchars "\\'") s)))
- (_ (easy-kill-trim (easy-kill-trim s 'left) 'right)))))
-
-(defun easy-kill-mode-sname (m)
- (cl-check-type m (and (or symbol string) (not boolean)))
- (cl-etypecase m
- (symbol (easy-kill-mode-sname (symbol-name m)))
- (string (substring m 0 (string-match-p "\\(?:-minor\\)?-mode\\'" m)))))
-
-(defun easy-kill-fboundp (name)
- "Like `fboundp' but NAME can be string or symbol.
-The value is the function's symbol if non-nil."
- (cl-etypecase name
- (string (easy-kill-fboundp (intern-soft name)))
- (symbol (and (fboundp name) name))))
-
-(defun easy-kill-pair-to-list (pair)
- (pcase pair
- (`nil nil)
- (`(,beg . ,end) (list beg end))
- (_ (signal 'wrong-type-argument (list pair "Not a dot pair")))))
-
-(defun easy-kill-interprogram-cut (text)
- "Make non-empty TEXT available to other programs."
- (cl-check-type text string)
- (and interprogram-cut-function
- (not (equal text ""))
- (funcall interprogram-cut-function text)))
-
-(defun easy-kill-map ()
- "Build the keymap according to `easy-kill-alist'."
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map easy-kill-base-map)
- (mapc (lambda (c)
- ;; (define-key map (vector meta-prefix-char c) 'easy-kill-select)
- (define-key map (char-to-string c) 'easy-kill-thing))
- (mapcar 'car easy-kill-alist))
- map))
-
-(defun easy-kill--fmt (x y &optional z)
- (cl-etypecase x
- (character (easy-kill--fmt
- (single-key-description x)
- (symbol-name y)
- (and z (let ((print-escape-newlines t))
- (prin1-to-string z)))))
- (string (with-output-to-string
- (princ x)
- (princ (make-string (- 16 (mod (length x) 16)) ?\s))
- (princ y)
- (when z
- (princ (make-string (- 16 (mod (length y) 16)) ?\s))
- (princ z))))))
-
-(defun easy-kill-help ()
- (interactive)
- (help-setup-xref '(easy-kill-help) (called-interactively-p 'any))
- (with-help-window (help-buffer)
- (princ (concat (make-string 15 ?=) " "))
- (princ "Easy Kill/Mark Key Bindings ")
- (princ (concat (make-string 15 ?=) "\n\n"))
- (princ (easy-kill--fmt "Key" "Thing" "Separator"))
- (princ "\n")
- (princ (easy-kill--fmt "---" "-----" "---------"))
- (princ "\n\n")
- (princ (mapconcat (lambda (x) (pcase x
- (`(,c ,thing ,sep)
- (easy-kill--fmt c thing sep))
- ((or `(,c ,thing) `(,c . ,thing))
- (easy-kill--fmt c thing))))
- easy-kill-alist "\n"))
- (princ "\n\n")
- (princ (substitute-command-keys "\\{easy-kill-base-map}"))))
-
-(defvar easy-kill-candidate nil)
-
-(defun easy-kill--bounds ()
- (cons (overlay-start easy-kill-candidate)
- (overlay-end easy-kill-candidate)))
-
-;;; Note: gv-define-setter not available in 24.1 and 24.2
-;; (gv-define-setter easy-kill--bounds (val)
-;; (macroexp-let2 macroexp-copyable-p v val
-;; `(move-overlay easy-kill-candidate (car ,v) (cdr ,v))))
-
-(defsetf easy-kill--bounds () (v)
- `(let ((tmp ,v))
- (move-overlay easy-kill-candidate (car tmp) (cdr tmp))))
-
-(defmacro easy-kill-get (prop)
- "Get the value of the kill candidate's property PROP.
-Use `setf' to change property value."
- (pcase prop
- (`start '(overlay-start easy-kill-candidate))
- (`end '(overlay-end easy-kill-candidate))
- (`bounds '(easy-kill--bounds))
- (`buffer '(overlay-buffer easy-kill-candidate))
- (`properties '(append (list 'start (easy-kill-get start))
- (list 'end (easy-kill-get end))
- (list 'buffer (easy-kill-get buffer))
- (overlay-properties easy-kill-candidate)))
- (_ `(overlay-get easy-kill-candidate ',prop))))
-
-(defun easy-kill-init-candidate (n &optional mark)
- ;; Manipulate `easy-kill-candidate' directly during initialisation;
- ;; should use `easy-kill-get' elsewhere.
- (let ((o (make-overlay (point) (point))))
- (unless mark
- (overlay-put o 'face 'easy-kill-selection))
- (overlay-put o 'origin (point))
- (overlay-put o 'help-echo #'easy-kill-describe-candidate)
- ;; Use higher priority to avoid shadowing by, for example,
- ;; `hl-line-mode'.
- (overlay-put o 'priority 999)
- (when mark
- (overlay-put o 'mark 'start)
- (let ((i (make-overlay (point) (point))))
- (overlay-put i 'priority (1+ (overlay-get o 'priority)))
- (overlay-put i 'face 'easy-kill-origin)
- (overlay-put i 'as (propertize " " 'face 'easy-kill-origin))
- (overlay-put o 'origin-indicator i)))
- (setq easy-kill-candidate o)
- (save-restriction
- ;; Work around http://debbugs.gnu.org/15808; not needed in 24.4.
- (narrow-to-region (max (point-min) (- (point) 1000))
- (min (point-max) (+ (point) 1000)))
- (let ((easy-kill-inhibit-message t))
- (cl-dolist (thing easy-kill-try-things)
- (easy-kill-thing thing n)
- (or (string= (easy-kill-candidate) "")
- (cl-return)))))
- o))
-
-(defun easy-kill-indicate-origin ()
- (let ((i (easy-kill-get origin-indicator))
- (origin (easy-kill-get origin)))
- (cond
- ((not (overlayp i)) nil)
- ((= origin (point))
- (overlay-put i 'after-string nil))
- ((memq (char-after origin) '(?\t ?\n))
- (overlay-put i 'after-string (overlay-get i 'as)))
- (t (move-overlay i origin (1+ origin))
- (overlay-put i 'after-string nil)))))
-
-(defun easy-kill-candidate ()
- "Get the kill candidate as a string.
-If the overlay specified by variable `easy-kill-candidate' has
-non-zero length, it is the string covered by the overlay.
-Otherwise, it is the value of the overlay's candidate property."
- (with-current-buffer (easy-kill-get buffer)
- (or (pcase (easy-kill-get bounds)
- (`(,_x . ,_x) (easy-kill-get candidate))
- (`(,beg . ,end) (filter-buffer-substring beg end)))
- "")))
-
-(defun easy-kill-describe-candidate (&rest _)
- "Return a string that describes current kill candidate."
- (let* ((props (cl-loop for k in '(thing start end origin)
- with all = (easy-kill-get properties)
- ;; Allow describe-PROP to provide customised
- ;; description.
- for dk = (intern-soft (format "describe-%s" k))
- for dv = (and dk (plist-get all dk))
- for v = (or (if (functionp dv) (funcall dv) dv)
- (plist-get all k))
- when v collect (format "%s:\t%s" k v)))
- (txt (mapconcat #'identity props "\n")))
- (format "cmd:\t%s\n%s"
- (if (easy-kill-get mark) "easy-mark" "easy-kill")
- txt)))
-
-(defun easy-kill-adjust-candidate (thing &optional beg end)
- "Adjust kill candidate to THING, BEG, END.
-If BEG is a string, shrink the overlay to zero length and set its
-candidate property instead."
- (setf (easy-kill-get thing) thing)
- (cond ((stringp beg)
- (setf (easy-kill-get bounds) (cons (point) (point)))
- (setf (easy-kill-get candidate) beg)
- (let ((easy-kill-inhibit-message nil))
- (easy-kill-echo "%s" beg)))
- (t
- (setf (easy-kill-get bounds) (cons (or beg (easy-kill-get start))
- (or end (easy-kill-get end))))))
- (cond ((easy-kill-get mark)
- (easy-kill-mark-region)
- (easy-kill-indicate-origin))
- (t
- (easy-kill-interprogram-cut (easy-kill-candidate)))))
-
-(defun easy-kill-save-candidate ()
- (unless (string= (easy-kill-candidate) "")
- ;; Don't modify the clipboard here since it is called in
- ;; `pre-command-hook' per `easy-kill-activate-keymap' and will
- ;; confuse `yank' if it is current command. Also
- ;; `easy-kill-adjust-candidate' already did that.
- (let ((interprogram-cut-function nil)
- (interprogram-paste-function nil))
- (kill-new (if (and (easy-kill-get append) kill-ring)
- (cl-labels ((join (x sep y)
- (if sep (concat (easy-kill-trim x 'right)
- sep
- (easy-kill-trim y 'left))
- (concat x y))))
- (join (car kill-ring)
- (nth 2 (cl-rassoc (easy-kill-get thing)
- easy-kill-alist :key #'car))
- (easy-kill-candidate)))
- (easy-kill-candidate))
- (easy-kill-get append)))
- t))
-
-(defun easy-kill-destroy-candidate ()
- (let ((hook (make-symbol "easy-kill-destroy-candidate")))
- (fset hook `(lambda ()
- (let ((o ,easy-kill-candidate))
- (when o
- (let ((i (overlay-get o 'origin-indicator)))
- (and (overlayp i) (delete-overlay i)))
- (delete-overlay o)))
- (remove-hook 'post-command-hook ',hook)))
- ;; Run in `post-command-hook' so that exit commands can still use
- ;; `easy-kill-candidate'.
- (add-hook 'post-command-hook hook)))
-
-(defun easy-kill-expand ()
- (interactive)
- (easy-kill-thing nil '+))
-
-(defun easy-kill-digit-argument (n)
- "Expand selection by N number of things.
-If N is 0 shrink the selection to the initial size before any
-expansion."
- (interactive
- (list (- (logand (if (integerp last-command-event)
- last-command-event
- (get last-command-event 'ascii-character))
- ?\177)
- ?0)))
- (easy-kill-thing nil n))
-
-(defun easy-kill-shrink ()
- (interactive)
- (easy-kill-thing nil '-))
-
-(defun easy-kill-thing-handler (base mode)
- "Get the handler for MODE or nil if none is defined.
-For example, if BASE is \"easy-kill-on-list\" and MODE is
-nxml-mode `nxml:easy-kill-on-list', `easy-kill-on-list:nxml' are
-checked in order. The former is never defined in this package and
-is safe for users to customise. If neither is defined continue
-checking on the parent mode. Finally `easy-kill-on-list' is
-checked."
- (or (and mode (or (easy-kill-fboundp
- (concat (easy-kill-mode-sname mode) ":" base))
- (easy-kill-fboundp
- (concat base ":" (easy-kill-mode-sname mode)))))
- (let ((parent (get mode 'derived-mode-parent)))
- (and parent (easy-kill-thing-handler base parent)))
- (easy-kill-fboundp base)))
-
-(defun easy-kill-bounds-of-thing-at-point (thing)
- "Easy Kill wrapper for `bounds-of-thing-at-point'."
- (pcase (easy-kill-thing-handler
- (format "easy-kill-bounds-of-%s-at-point" thing)
- major-mode)
- ((and (pred functionp) fn) (funcall fn))
- (_ (bounds-of-thing-at-point thing))))
-
-(defun easy-kill-thing-forward-1 (thing &optional n)
- "Easy Kill wrapper for `forward-thing'."
- (pcase (easy-kill-thing-handler
- (format "easy-kill-thing-forward-%s" thing)
- major-mode)
- ((and (pred functionp) fn) (funcall fn n))
- (_ (forward-thing thing n))))
-
-;; Helper for `easy-kill-thing'.
-(defun easy-kill-thing-forward (n)
- (when (and (easy-kill-get thing) (/= n 0))
- (let* ((step (if (cl-minusp n) -1 +1))
- (thing (easy-kill-get thing))
- (bounds1 (or (easy-kill-pair-to-list
- (easy-kill-bounds-of-thing-at-point thing))
- (list (point) (point))))
- (start (easy-kill-get start))
- (end (easy-kill-get end))
- (front (or (car (cl-set-difference (list end start) bounds1))
- (pcase step
- (`-1 start)
- (`1 end))))
- (new-front (save-excursion
- (goto-char front)
- (with-demoted-errors
- (dotimes (_ (abs n))
- (easy-kill-thing-forward-1 thing step)))
- (point))))
- (pcase (and (/= front new-front)
- (sort (cons new-front bounds1) #'<))
- (`(,start ,_ ,end)
- (easy-kill-adjust-candidate thing start end)
- t)))))
-
-(defun easy-kill-thing (&optional thing n inhibit-handler)
- ;; N can be -, + and digits
- (interactive
- (list (pcase (assq last-command-event easy-kill-alist)
- (`(,_ ,th . ,_) th)
- (`(,_ . ,th) th))
- (prefix-numeric-value current-prefix-arg)))
- (let* ((thing (or thing (easy-kill-get thing)))
- (n (or n 1))
- (handler (and (not inhibit-handler)
- (easy-kill-thing-handler (format "easy-kill-on-%s"
thing)
- major-mode))))
- (when (easy-kill-get mark)
- (goto-char (easy-kill-get origin)))
- (cond
- (handler (funcall handler n))
- ((or (memq n '(+ -))
- (and (eq thing (easy-kill-get thing))
- (not (zerop n))))
- (easy-kill-thing-forward (pcase n
- (`+ 1)
- (`- -1)
- (_ n))))
- (t (pcase (easy-kill-bounds-of-thing-at-point thing)
- (`nil (easy-kill-echo "No `%s'" thing))
- (`(,start . ,end)
- (easy-kill-adjust-candidate thing start end)
- (unless (zerop n)
- (easy-kill-thing-forward (1- n)))))))
- (when (easy-kill-get mark)
- (easy-kill-adjust-candidate (easy-kill-get thing)))))
-
-(put 'easy-kill-abort 'easy-kill-exit t)
-(defun easy-kill-abort ()
- (interactive)
- (when (easy-kill-get mark)
- ;; The after-string may interfere with `goto-char'.
- (overlay-put (easy-kill-get origin-indicator) 'after-string nil)
- (goto-char (easy-kill-get origin))
- (setq deactivate-mark t))
- (ding))
-
-(put 'easy-kill-region 'easy-kill-exit t)
-(defun easy-kill-region ()
- "Kill current selection and exit."
- (interactive "*")
- (pcase (easy-kill-get bounds)
- (`(,_x . ,_x) (easy-kill-echo "Empty region"))
- (`(,beg . ,end) (kill-region beg end))))
-
-(put 'easy-kill-mark-region 'easy-kill-exit t)
-(defun easy-kill-mark-region ()
- (interactive)
- (pcase (easy-kill-get bounds)
- (`(,_x . ,_x)
- (easy-kill-echo "Empty region"))
- (`(,beg . ,end)
- (pcase (if (eq (easy-kill-get mark) 'end)
- (list end beg) (list beg end))
- (`(,m ,pt)
- (set-mark m)
- (goto-char pt)))
- (activate-mark))))
-
-(defun easy-kill-exchange-point-and-mark ()
- (interactive)
- (exchange-point-and-mark)
- (setf (easy-kill-get mark)
- (if (eq (point) (easy-kill-get start))
- 'end 'start)))
-
-(put 'easy-kill-append 'easy-kill-exit t)
-(defun easy-kill-append ()
- (interactive)
- (setf (easy-kill-get append) t)
- (when (easy-kill-save-candidate)
- (easy-kill-interprogram-cut (car kill-ring))
- (setq deactivate-mark t)
- (easy-kill-echo "Appended")))
-
-(defun easy-kill-exit-p (cmd)
- (and (symbolp cmd) (get cmd 'easy-kill-exit)))
-
-(defun easy-kill-activate-keymap ()
- (let ((map (easy-kill-map)))
- (set-transient-map
- map
- (lambda ()
- ;; Prevent any error from activating the keymap forever.
- (condition-case err
- (or (and (not (easy-kill-exit-p this-command))
- (or (eq this-command
- (lookup-key map (this-single-command-keys)))
- (let ((cmd (key-binding
- (this-single-command-keys) nil t)))
- (command-remapping cmd nil (list map)))))
- (ignore
- (easy-kill-destroy-candidate)
- (unless (or (easy-kill-get mark) (easy-kill-exit-p
this-command))
- (easy-kill-save-candidate))))
- (error (message "%s:%s" this-command (error-message-string err))
- nil))))))
-
-;;;###autoload
-(defun easy-kill (&optional n)
- "Kill thing at point in the order of region, url, email and line.
-Temporally activate additional key bindings as follows:
-
- letters => select or expand selection according to `easy-kill-alist';
- 1..9 => expand selection by that number;
- 0 => shrink to the initial selection;
- +,=/- => expand or shrink selection;
- @ => append selection to previous kill;
- ? => help;
- C-w => kill selection;
- C-SPC => turn selection into an active region;
- C-g => abort;
- others => save selection and exit."
- (interactive "p")
- (if (use-region-p)
- (if (fboundp 'rectangle-mark-mode) ; New in 24.4
- (with-no-warnings
- (kill-ring-save (region-beginning) (region-end) t))
- (kill-ring-save (region-beginning) (region-end)))
- (easy-kill-init-candidate n)
- (setf (easy-kill-get append) (eq last-command 'kill-region))
- (when (zerop (buffer-size))
- (easy-kill-echo "Warn: `easy-kill' activated in empty buffer"))
- (easy-kill-activate-keymap)))
-
-;;;###autoload
-(defalias 'easy-mark-sexp 'easy-mark
- "Use `easy-mark' instead. The alias may be removed in future.")
-
-;;;###autoload
-(defun easy-mark (&optional n)
- "Similar to `easy-kill' (which see) but for marking."
- (interactive "p")
- (let ((easy-kill-try-things easy-mark-try-things))
- (easy-kill-init-candidate n 'mark)
- (easy-kill-activate-keymap)
- (unless (easy-kill-get thing)
- (setf (easy-kill-get thing) 'sexp)
- (easy-kill-thing 'sexp n))))
-
-;;;; Extended things
-
-;;; Handler for `buffer-file-name'.
-
-(defun easy-kill-on-buffer-file-name (n)
- "Get `buffer-file-name' or `default-directory'.
-If N is zero, remove the directory part; -, remove the file name
-part; +, full path."
- (if (easy-kill-get mark)
- (easy-kill-echo "Not supported in `easy-mark'")
- (pcase (or buffer-file-name default-directory)
- (`nil (easy-kill-echo "No `buffer-file-name'"))
- (file (let* ((file (directory-file-name file))
- (text (pcase n
- (`- (file-name-directory file))
- (`0 (file-name-nondirectory file))
- (_ file))))
- (easy-kill-adjust-candidate 'buffer-file-name text))))))
-
-;;; Handler for `defun-name'.
-
-(defun easy-kill-on-defun-name (_n)
- "Get current defun name."
- (if (easy-kill-get mark)
- (easy-kill-echo "Not supported in `easy-mark'")
- (pcase (add-log-current-defun)
- (`nil (easy-kill-echo "No `defun-name' at point"))
- (name (easy-kill-adjust-candidate 'defun-name name)))))
-
-;;; Handler for `url'.
-
-(defun easy-kill-on-url (&optional _n)
- "Get url at point or from char properties.
-Char properties `help-echo', `shr-url' and `w3m-href-anchor' are
-inspected."
- (if (or (easy-kill-get mark) (easy-kill-bounds-of-thing-at-point 'url))
- (easy-kill-thing 'url nil t)
- (cl-labels ((get-url (text)
- (when (stringp text)
- (with-temp-buffer
- (insert text)
- (pcase (easy-kill-bounds-of-thing-at-point 'url)
- (`(,beg . ,end) (buffer-substring beg end)))))))
- (cl-dolist (p '(help-echo shr-url w3m-href-anchor))
- (pcase (get-char-property-and-overlay (point) p)
- (`(,text . ,ov)
- (pcase (or (get-url text)
- (get-url (and ov (overlay-get ov p))))
- ((and url (guard url))
- (easy-kill-adjust-candidate 'url url)
- (cl-return url)))))))))
-
-;;; `defun'
-
-;; Work around http://debbugs.gnu.org/17247
-(defun easy-kill-thing-forward-defun (&optional n)
- (pcase (or n 1)
- ((pred cl-minusp) (beginning-of-defun (- n)))
- (n (end-of-defun n))))
-
-;;; Handler for `sexp' and `list'.
-
-(defun easy-kill-bounds-of-list-at-point ()
- (let ((bos (and (nth 3 (syntax-ppss)) ;bounds of string
- (save-excursion
- (easy-kill-backward-up)
- (easy-kill-bounds-of-thing-at-point 'sexp))))
- (b (bounds-of-thing-at-point 'list))
- (b1-in-b2 (lambda (b1 b2)
- (and (> (car b1) (car b2))
- (< (cdr b1) (cdr b2))))))
- (cond
- ((not b) bos)
- ((not bos) b)
- ((= (car b) (point)) bos)
- ((funcall b1-in-b2 b bos) b)
- (t bos))))
-
-(defvar up-list-fn) ; Dynamically bound
-
-(defun easy-kill-backward-up ()
- (let ((ppss (syntax-ppss)))
- (condition-case nil
- (progn
- (funcall (or (bound-and-true-p up-list-fn) #'up-list) -1)
- ;; `up-list' may jump to another string.
- (when (and (nth 3 ppss) (< (point) (nth 8 ppss)))
- (goto-char (nth 8 ppss))))
- (scan-error (and (nth 3 ppss) (goto-char (nth 8 ppss)))))))
-
-(defun easy-kill-forward-down (point &optional bound)
- (condition-case nil
- (progn
- (easy-kill-backward-up)
- (backward-prefix-chars)
- (if (and (or (not bound) (> (point) bound))
- (/= point (point)))
- (easy-kill-forward-down (point) bound)
- (goto-char point)))
- (scan-error (goto-char point))))
-
-(defun easy-kill-bounds-of-list (n)
- (save-excursion
- (pcase n
- (`+ (goto-char (easy-kill-get start))
- (easy-kill-backward-up))
- (`- (easy-kill-forward-down (point) (easy-kill-get start)))
- (_ (error "Unsupported argument `%s'" n)))
- (easy-kill-bounds-of-thing-at-point 'sexp)))
-
-(defun easy-kill-on-list (n)
- (pcase n
- ((or `+ `-)
- (pcase (easy-kill-bounds-of-list n)
- (`(,beg . ,end)
- (easy-kill-adjust-candidate 'list beg end))))
- (_ (easy-kill-thing 'list n t))))
-
-(defun easy-kill-on-sexp (n)
- (pcase n
- ((or `+ `-)
- (unwind-protect (easy-kill-thing 'list n)
- (setf (easy-kill-get thing) 'sexp)))
- (_ (easy-kill-thing 'sexp n t))))
-
-;;; nxml support for list-wise +/-
-
-(defvar nxml-sexp-element-flag)
-
-(defun easy-kill-on-list:nxml (n)
- (let ((nxml-sexp-element-flag t)
- (up-list-fn 'nxml-up-element))
- (cond
- ((memq n '(+ -))
- (pcase (easy-kill-bounds-of-list n)
- (`(,beg . ,end) (easy-kill-adjust-candidate 'list beg end))))
- ((and (eq 'list (easy-kill-get thing))
- (not (zerop n)))
- (let ((new-end (save-excursion
- (goto-char (easy-kill-get end))
- (forward-sexp n)
- (point))))
- (when (and new-end (/= new-end (easy-kill-get end)))
- (easy-kill-adjust-candidate 'list nil new-end))))
- (t (save-excursion
- (ignore-errors (easy-kill-backward-up))
- (easy-kill-thing 'sexp n t)
- (setf (easy-kill-get thing) 'list))))))
-
-;;; org support for list-wise +/-
-
-(defun easy-kill-bounds-of-list-at-point:org ()
- (eval-and-compile (require 'org-element))
- (let ((x (org-element-at-point)))
- (cons (org-element-property :begin x)
- (org-element-property :end x))))
-
-(defun easy-kill-bounds-of-sexp-at-point:org ()
- (pcase (list (point) (easy-kill-bounds-of-list-at-point:org))
- (`(,beg (,beg . ,end))
- (cons beg end))
- (_ (bounds-of-thing-at-point 'sexp))))
-
-(defun easy-kill-thing-forward-list:org (&optional n)
- (pcase (or n 1)
- (`0 nil)
- (n (dotimes (_ (abs n))
- (condition-case nil
- (if (cl-minusp n)
- (org-backward-element)
- (org-forward-element))
- (error (pcase (easy-kill-bounds-of-thing-at-point 'list)
- (`(,beg . ,end)
- (goto-char (if (cl-minusp n) beg end))))))))))
-
-(defun easy-kill-org-up-element (&optional n)
- ;; Make `org-up-element' more like `up-list'.
- (pcase (or n 1)
- (`0 nil)
- (n (ignore-errors
- (dotimes (_ (abs n))
- (pcase (list (point) (easy-kill-bounds-of-thing-at-point 'list))
- (`(,_beg (,_beg . ,_)) (org-up-element))
- (`(,_ (,beg . ,_)) (goto-char beg)))))
- (when (cl-plusp n)
- (goto-char (cdr (easy-kill-bounds-of-thing-at-point 'list)))))))
-
-(defun easy-kill-on-list:org (n)
- (pcase n
- ((or `+ `-)
- (pcase (let ((up-list-fn #'easy-kill-org-up-element))
- (easy-kill-bounds-of-list n))
- (`(,beg . ,end) (easy-kill-adjust-candidate 'list beg end))))
- (_ (easy-kill-thing 'list n t)))
- (pcase (save-excursion
- (goto-char (easy-kill-get start))
- (org-element-type (org-element-at-point)))
- (`nil nil)
- (type (setf (easy-kill-get describe-thing)
- (lambda ()
- (format "%s (%s)" (easy-kill-get thing) type)))
- (easy-kill-echo "%s" type))))
-
-;;; js2 support for list-wise +/-
-
-(defun easy-kill-find-js2-node (beg end &optional inner)
- (eval-and-compile (require 'js2-mode nil t))
- (let* ((node (js2-node-at-point))
- (last-node node))
- (while (progn
- (if (or (js2-ast-root-p node)
- (and (<= (js2-node-abs-pos node) beg)
- (>= (js2-node-abs-end node) end)
- (or inner
- (not (and (= (js2-node-abs-pos node) beg)
- (= (js2-node-abs-end node) end))))))
- nil
- (setq last-node node
- node (js2-node-parent node))
- t)))
- (if inner last-node node)))
-
-(defun easy-kill-on-list:js2 (n)
- (let ((node (pcase n
- ((or `+ `-)
- (easy-kill-find-js2-node (easy-kill-get start)
- (easy-kill-get end)
- (eq n '-)))
- ((guard (and (eq 'list (easy-kill-get thing))
- (not (zerop n))))
- (error "List forward not supported in js2-mode"))
- (_ (js2-node-at-point)))))
- (easy-kill-adjust-candidate 'list
- (js2-node-abs-pos node)
- (js2-node-abs-end node))
- (setf (easy-kill-get describe-thing)
- ;; Also used by `sexp' so delay computation until needed.
- (lambda ()
- (format "%s (%s)" (easy-kill-get thing) (js2-node-short-name
node))))
- (easy-kill-echo "%s" (js2-node-short-name node))))
-
-(provide 'easy-kill)
-;;; easy-kill.el ends here
diff --git a/packages/easy-kill/test.el b/packages/easy-kill/test.el
deleted file mode 100644
index 6458d4c..0000000
--- a/packages/easy-kill/test.el
+++ /dev/null
@@ -1,433 +0,0 @@
-;;; test.el --- tests for easy-kill -*- lexical-binding: t;
-*-
-
-;; Copyright (C) 2014 Free Software Foundation, Inc.
-
-;; Author: Leo Liu <sdl.web@gmail.com>
-;; Keywords: maint
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Code:
-
-(require 'easy-kill)
-(require 'ert)
-
-;; (defmacro with-named-temp-buffer (name &rest body)
-;; (declare (indent with-current-buffer))
-;; `(unwind-protect
-;; (with-current-buffer (get-buffer-create ,name)
-;; ,@body)
-;; (and (get-buffer ,name) (kill-buffer ,name))))
-
-;; (ert-deftest test-compilation ()
-;; (should (zerop (call-process "emacs" nil nil nil
-;; "-batch" "-Q" "-f" "batch-byte-compile"
-;; "easy-kill.el"))))
-
-(ert-deftest test-easy-kill-trim ()
- (should (string= "" (easy-kill-trim " \f\t\n\n\n")))
- (should (string= "abc" (easy-kill-trim " \t\fabc")))
- (should (string= "abc" (easy-kill-trim "abc")))
- (should (string= " \t\fabc" (easy-kill-trim " \t\fabc" 'right)))
- (should (string= "abc" (easy-kill-trim " \t\fabc" 'left))))
-
-(ert-deftest test-easy-kill-get ()
- (with-temp-buffer
- (insert "two words")
- (easy-kill)
- (setf (easy-kill-get bounds) '(1 . 4))
- (should (string= (easy-kill-candidate) "two"))
- (should-error (setf (easy-kill-get bounds) nil))
- (setf (easy-kill-get end) (point-max))
- (should (= (easy-kill-get end) (point-max)))))
-
-(ert-deftest test-easy-kill-candidate ()
- (let ((w "yes"))
- (with-temp-buffer
- (insert w)
- (should-error (easy-kill-candidate))
- (easy-kill)
- (easy-kill-thing 'word)
- (should (string= w (easy-kill-candidate)))
- (easy-kill-thing 'buffer-file-name)
- (should (string= (directory-file-name default-directory)
- (easy-kill-candidate))))))
-
-(ert-deftest test-easy-kill-describe-candidate ()
- (with-temp-buffer
- (insert "(list 1 2 3)")
- (forward-word -1)
- (easy-kill)
- (easy-kill-thing 'sexp)
- (easy-kill-thing 'list)
- (should (string-match-p "^\\s-*thing:\\s-*list"
- (easy-kill-describe-candidate)))))
-
-(ert-deftest test-easy-kill-append ()
- (with-temp-buffer
- (insert "abc")
- (easy-kill)
- (easy-kill-thing 'word)
- (call-interactively #'easy-kill-append)
- (should (string= (car kill-ring) "abc"))))
-
-;;; Make sure the old format of easy-kill-alist is still supported.
-(ert-deftest test-old-easy-kill-alist ()
- (let ((easy-kill-alist '((?w . word)
- (?s . sexp)
- (?l . list)
- (?f . filename)
- (?d . defun)
- (?e . line)
- (?b . buffer-file-name)))
- (text "(first line\nsecond line\nthird line)"))
- (with-temp-buffer
- (insert text)
- (goto-char (point-min))
- (easy-kill)
- (let ((last-command-event ?d))
- (call-interactively #'easy-kill-thing))
- (should (string= text (easy-kill-candidate))))))
-
-(ert-deftest test-easy-kill-help ()
- (let ((easy-kill-alist '((?w . word)
- (?s . sexp)
- (?l . list)
- (?f filename)
- (?d defun "\n\n")
- (?e . line)
- (?b . buffer-file-name)
- (?x buffer-file-name-buffer-file-name "\t"))))
- (easy-kill-help)
- (with-current-buffer (help-buffer)
- (goto-char (point-min))
- (should (save-excursion
- (re-search-forward "^w\\s-*word$" nil t)))
- (should (save-excursion
- (re-search-forward "^d\\s-*defun\\s-*\"\\\\n\\\\n\"$" nil t)))
- (should (save-excursion
- (re-search-forward "^f\\s-*filename$" nil t)))
- (should (save-excursion
- (re-search-forward "^b\\s-*buffer-file-name$" nil t))))))
-
-(ert-deftest test-easy-kill-thing-handler ()
- (should (eq (easy-kill-thing-handler "easy-kill-on-list" 'nxml-mode)
- 'easy-kill-on-list:nxml))
- (should (eq (easy-kill-thing-handler "easy-kill-on-list" 'js2-mode)
- 'easy-kill-on-list:js2))
- (should (eq (easy-kill-thing-handler "easy-kill-on-sexp" 'nxml-mode)
- 'easy-kill-on-sexp))
- ;; XXX: side-effect
- (fset 'js2:easy-kill-on-list #'ignore)
- (eq (easy-kill-thing-handler "easy-kill-on-sexp" 'js2-mode)
- 'js2:easy-kill-on-list))
-
-(ert-deftest test-easy-kill-bounds-of-list-at-point ()
- (let ((text "\"abc (1 2 3) xyz\" ; dummy comment")
- (text2 "(progn
- \"[compile\"
- (should (string= \"display editor.\\nsome of the ways to
customize it;\"
- (easy-kill-candidate))))"))
- (cl-labels ((getb (bounds)
- (if bounds
- (buffer-substring (car bounds) (cdr bounds))
- "")))
- (with-temp-buffer
- (emacs-lisp-mode)
- (insert text)
- (search-backward "2")
- (should (string= (getb (easy-kill-bounds-of-list-at-point)) "(1 2 3)"))
- (up-list -1)
- (forward-word -1)
- (should (string= (getb (easy-kill-bounds-of-list-at-point))
- "\"abc (1 2 3) xyz\""))
- (search-forward "dummy")
- (forward-word -1)
- (should (string= (getb (easy-kill-bounds-of-list-at-point))
- "dummy"))
- ;; text2
- (erase-buffer)
- (insert text2)
- (goto-char (point-min))
- (re-search-forward "customize")
- (call-interactively 'easy-kill)
- (easy-kill-thing 'list)
- (should (string= "\"display editor.\\nsome of the ways to customize
it;\""
- (easy-kill-candidate)))))))
-
-(ert-deftest test-easy-kill-on-list ()
- (let ((text "(defun first-error (&optional n)
- \"This operates on the output from the \\\\[compile] command,
for instance.\"
- (interactive \"p\")
- (next-error n t)) ;some dummy comment here"))
- (with-temp-buffer
- (emacs-lisp-mode)
- (insert text)
- (goto-char (point-min))
- (search-forward "[compile")
- (call-interactively 'easy-kill)
- (easy-kill-thing 'list)
- (should (string= "[compile]" (easy-kill-candidate)))
- (up-list -1)
- (call-interactively 'easy-kill)
- (let ((clipboard))
- (cl-letf (((symbol-function 'easy-kill-interprogram-cut)
- (lambda (text) (setq clipboard text))))
- (easy-kill-thing 'list))
- (should (string= (easy-kill-candidate) clipboard)))
- (should (string= "\"This operates on the output from the \\\\[compile]
command, for instance.\""
- (easy-kill-candidate)))
- (easy-kill-thing 'list)
- (should (string-match-p "(interactive \"p\")" (easy-kill-candidate)))
- (should (string-prefix-p "\"This operates on" (easy-kill-candidate)))
- (forward-sexp 1) ; where bounds of list is nil
- (call-interactively 'easy-kill)
- (easy-kill-thing 'list)
- (should (string= "\"This operates on the output from the \\\\[compile]
command, for instance.\""
- (easy-kill-candidate)))
- (search-forward "dummy")
- (forward-word -1)
- (call-interactively 'easy-kill)
- (easy-kill-thing 'list)
- (should (string= "dummy" (easy-kill-candidate))))))
-
-(ert-deftest test-js2-mode ()
- :expected-result :failed
- (let ((js "function View(name, options) {
- options = options || {};
- this.name = name;
- this.root = options.root;
- var engines = options.engines;
- this.defaultEngine = options.defaultEngine;
- var ext = this.ext = extname(name);
- if (!ext && !this.defaultEngine) throw new Error('No default engine was
specified and no extension was provided.');
- if (!ext) name += (ext = this.ext = ('.' != this.defaultEngine[0] ? '.' :
'') + this.defaultEngine);
- this.engine = engines[ext] || (engines[ext] =
require(ext.slice(1)).__express);
- this.path = this.lookup(name);
-}")
- (buff (get-buffer-create "*js2*")))
- (eval-and-compile (require 'js2-mode nil t))
- (setq js2-idle-timer-delay 0)
- (global-font-lock-mode 1)
- (unwind-protect
- (with-current-buffer buff
- (js2-mode)
- (insert js)
- (goto-char (point-min))
- (js2-reparse t)
- ;; (js2-do-parse)
- (while js2-mode-buffer-dirty-p
- (sit-for 0.1))
- (search-forward "this.defaultEngine =")
- (forward-char -1)
- (easy-kill)
- (easy-kill-thing 'char)
- (easy-kill-thing 'list)
- (should (string= "this.defaultEngine = options.defaultEngine"
- (easy-kill-candidate)))
- ;; XXX: should also test (easy-kill-digit-argument 0)
- )
- (kill-buffer buff))))
-
-(ert-deftest test-nxml-mode ()
- (let ((xml "<?xml version=\"1.0\"?>
-<catalog>
- <book id=\"bk101\">
- <author>Gambardella, Matthew</author>
- <title>XML Developer's Guide</title>
- <genre>Computer</genre>
- <price>44.95</price>
- <publish_date>2000-10-01</publish_date>
- <description>An in-depth look at creating applications
- with XML.</description>
- </book>
-</catalog>"))
- (with-temp-buffer
- (nxml-mode)
- (insert xml)
- (goto-char (point-min))
- (search-forward "Gambardella")
- (easy-kill)
- (easy-kill-thing 'sexp)
- (easy-kill-expand)
- (easy-kill-expand)
- (easy-kill-shrink)
- (should (eq (easy-kill-get thing) 'sexp))
- (should (string= "<author>Gambardella, Matthew</author>"
- (easy-kill-candidate)))
- (call-interactively 'easy-kill)
- (easy-kill-thing 'list)
- (should (string= "<author>Gambardella, Matthew</author>"
- (easy-kill-candidate)))
- (easy-kill-thing nil 1)
- (easy-kill-digit-argument 0)
- (should (string= "<author>Gambardella, Matthew</author>"
- (easy-kill-candidate))))))
-
-(ert-deftest test-org-mode ()
- (let ((org "#+title: This is a title
-#+author: Leo Liu
-
-This is an example of org document.
-
-* Life
- One two three ....
-*** Fruits
- 1. apple
- 2. orange
- 3. mango
-
-* Sports cars
- + Lamborghini
- + Ferrari
- + Porsche
-"))
- (with-temp-buffer
- (org-mode)
- (insert org)
- (goto-char (point-min))
- (search-forward "This is")
- (call-interactively 'easy-kill)
- (easy-kill-thing 'sexp)
- (easy-kill-expand)
- (should (string= "#+title: This is a title\n" (easy-kill-candidate)))
- (search-forward "Fruits")
- (call-interactively 'easy-kill)
- (easy-kill-thing 'sexp)
- (easy-kill-expand)
- (should (string-prefix-p "*** Fruits" (easy-kill-candidate)))
- (search-forward "Ferrari")
- (call-interactively 'easy-kill)
- (easy-kill-thing 'list)
- (should (string= "Ferrari\n" (easy-kill-candidate)))
- (easy-kill-expand)
- (should (string= " + Ferrari\n" (easy-kill-candidate)))
- ;; org quirks
- (search-backward "Lamborghini")
- (call-interactively 'easy-kill)
- (easy-kill-thing 'list)
- ;; You get the whole plainlist here; see `org-element-at-point'.
- (easy-kill-expand)
- (should (string= " + Lamborghini\n + Ferrari\n + Porsche\n"
- (easy-kill-candidate)))
- (easy-kill-expand)
- (should (string= "* Sports cars\n + Lamborghini\n + Ferrari\n +
Porsche\n"
- (easy-kill-candidate))))))
-
-(ert-deftest test-elisp-mode ()
- (let ((el "(defun set-hard-newline-properties (from to)
- (let ((sticky (get-text-property from 'rear-nonsticky)))
- ;; XXX: (put-text-property from to 'hard 't)
- ;; If rear-nonsticky is not \"t\", add 'hard to rear-nonsticky
list
- (if (and (listp sticky) (not (memq 'hard sticky)))
- (put-text-property from (point) 'rear-nonsticky
- (cons 'hard sticky)))))"))
- (with-temp-buffer
- (insert el)
- (goto-char (point-min))
- (search-forward "put-text-property")
- (easy-kill)
- (easy-kill-thing 'sexp)
- (easy-kill-expand)
- (should (eq (easy-kill-get thing) 'sexp))
- (should (string= "(put-text-property from to 'hard 't)"
- (easy-kill-candidate)))
- (easy-kill-expand)
- (easy-kill-expand)
- (should (string= el (easy-kill-candidate)))
- (easy-kill-shrink)
- (easy-kill-shrink)
- (should (string= "(put-text-property from to 'hard 't)"
- (easy-kill-candidate)))
- (easy-kill-digit-argument 0)
- (should (string= (thing-at-point 'sexp) (easy-kill-candidate))))))
-
-(ert-deftest test-easy-kill-thing-forward ()
- (let ((txt "Emacs is the extensible
- display editor.
-some of the ways to customize it;
-24.3."))
- (with-temp-buffer
- (insert txt)
- (forward-line -1)
- (easy-kill)
- (easy-kill-thing 'line)
- (should (string= "some of the ways to customize it;\n24.3."
- (easy-kill-candidate)))
- (easy-kill-shrink)
- (should (string= "some of the ways to customize it;\n"
- (easy-kill-candidate)))
- (easy-kill-shrink)
- (should (string= " display editor.\nsome of the ways to customize
it;\n"
- (easy-kill-candidate)))
- (easy-kill-thing 'word)
- (easy-kill-shrink)
- (should (string= "editor.\nsome" (easy-kill-candidate)))
- (easy-kill-shrink)
- (should (string= "display editor.\nsome" (easy-kill-candidate)))
- (easy-kill-expand)
- (should (string= " editor.\nsome" (easy-kill-candidate)))
- (easy-kill-destroy-candidate)
- (goto-char (point-min))
- (forward-line 1)
- (call-interactively 'easy-mark)
- (should (string= " display" (easy-kill-candidate)))
- (goto-char (easy-kill-get origin))
- (deactivate-mark 1)
- ;; Test the case where there is no thing at point
- (call-interactively 'easy-kill)
- (setf (easy-kill-get thing) 'word)
- (setf (easy-kill-get bounds) (cons (point) (point)))
- (easy-kill-expand)
- (should (string= " display" (easy-kill-candidate)))
- (easy-kill-shrink)
- (easy-kill-shrink)
- (easy-kill-shrink)
- (should (string= "the extensible\n" (easy-kill-candidate))))))
-
-(ert-deftest test-workaround-defun-bug ()
- ;; http://debbugs.gnu.org/17247
- (let ((txt "(tan 2)\n\n(sin 2)\n(cos 2)\n"))
- (with-temp-buffer
- (insert txt)
- (easy-kill)
- (easy-kill-thing 'defun)
- (easy-kill-shrink)
- (should (string= "(sin 2)\n(cos 2)\n" (easy-kill-candidate)))
- (easy-kill-shrink)
- (should (string= txt (easy-kill-candidate))))))
-
-(ert-deftest test-easy-kill-exchange-point-and-mark ()
- (let ((txt "(delete-region (point)
- (if (re-search-forward \"[^ \\t\\n]\" nil t)
- (progn (beginning-of-line) (point))
- (point-max)))"))
- (with-temp-buffer
- (emacs-lisp-mode)
- (insert txt)
- (goto-char (point-min))
- (search-forward "re-search-forward")
- (call-interactively 'easy-mark)
- (should (string= "re-search-forward" (easy-kill-candidate)))
- (should (= (point) (easy-kill-get end)))
- (call-interactively 'easy-kill-exchange-point-and-mark)
- (easy-kill-expand)
- (should (= (point) (easy-kill-get start)))
- (should (= (mark t) (easy-kill-get end)))
- (call-interactively 'easy-kill-exchange-point-and-mark)
- (easy-kill-shrink)
- (should (= (mark t) (easy-kill-get start)))
- (should (= (point) (easy-kill-get end))))))
-
-;;; test.el ends here
diff --git a/packages/ggtags/.gitignore b/packages/ggtags/.gitignore
deleted file mode 100644
index 016d3b1..0000000
--- a/packages/ggtags/.gitignore
+++ /dev/null
@@ -1 +0,0 @@
-*.elc
\ No newline at end of file
diff --git a/packages/ggtags/Makefile b/packages/ggtags/Makefile
deleted file mode 100644
index 02fbd33..0000000
--- a/packages/ggtags/Makefile
+++ /dev/null
@@ -1,12 +0,0 @@
-.PHONY: all clean
-
-ELCFILES = $(addsuffix .elc, $(basename $(wildcard *.el)))
-
-all: $(ELCFILES)
-
-%.elc : %.el
- @echo Compiling $<
- @emacs -batch -q -no-site-file -f batch-byte-compile $<
-
-clean:
- @rm -f *.elc
diff --git a/packages/ggtags/README.rst b/packages/ggtags/README.rst
deleted file mode 100644
index 41a377a..0000000
--- a/packages/ggtags/README.rst
+++ /dev/null
@@ -1,444 +0,0 @@
-=========================================================
- Emacs frontend to GNU Global source code tagging system
-=========================================================
-
-This package is part of `GNU ELPA <http://elpa.gnu.org>`_ (``M-x
-list-packages``) and is also available on `MELPA
-<https://melpa.org/#/ggtags>`_.
-
-The goal is to make working with GNU Global in Emacs as effortlessly
-and intuitively as possible and to integrate tightly with standard
-emacs packages. ``ggtags.el`` is tested in Emacs 24 and 25. Patches,
-feature requests and bug reports are welcome. Thanks.
-
-Features
-~~~~~~~~
-
-#. Build on ``compile.el`` for asynchronicity and its large
- feature-set.
-#. Automatically update Global's tag files when needed with tuning for
- large source trees.
-#. Intuitive navigation among multiple matches with mode-line display
- of current match, total matches and exit status.
-#. Read tag with completion.
-#. Show definition at point.
-#. Jump to #include files.
-#. Support search history and saving a search to register/bookmark.
-#. Query replace.
-#. Manage Global's environment variables on a per-project basis.
-#. Highlight (definition) tag at point.
-#. Abbreviated display of file names.
-#. Support all Global search backends: ``grep``, ``idutils`` etc.
-#. Support `exuberant ctags <http://ctags.sourceforge.net/>`_ and
- ``pygments`` backend.
-#. Support all Global's output formats: ``grep``, ``ctags-x``,
- ``cscope`` etc.
-#. Support projects on remote hosts (e.g. via ``tramp``).
-#. Support eldoc.
-#. Search ``GTAGSLIBPATH`` for references and symbols.
-
-Screenshot
-~~~~~~~~~~
-
-.. figure:: http://i.imgur.com/wx8ZPGe.png
- :width: 500px
- :target: http://i.imgur.com/wx8ZPGe.png
- :alt: ggtags.png
-
-Why GNU Global
-~~~~~~~~~~~~~~
-
-The opengrok project composed a feature comparison `table
-<https://github.com/OpenGrok/OpenGrok/wiki/Comparison-with-Similar-Tools>`_
-between a few tools.
-
-Install Global and plugins
-~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-1. Compile and install Global with ``exuberant-ctags``
- ::
-
- ./configure --prefix=<PREFIX> --with-exuberant-ctags=/usr/local/bin/ctags
- make && make install
-
- The executable ``ctags`` is unfortunately named because ``emacs``
- also includes a command of the same name. So make sure it is from
- http://ctags.sourceforge.net. See ``plugin-factory/PLUGIN_HOWTO``
- (``plugin-factory/README`` for Global < 6.5) in GNU Global
- source for further information.
-
-2. Install ``pygments`` plugin
-
- The ``pygments`` plugin has been included in ``global`` since
- version ``6.3.2``. ``pip install pygments`` is the only step
- required. Note the plugin is not activated by the default
- ``gtags.conf`` or ``.globalrc``. See
- ``global/plugin-factory/PLUGIN_HOWTO.pygments`` for details.
-
- The following instructions are for older ``global``.
- ::
-
- pip install pygments
- git clone https://github.com/yoshizow/global-pygments-plugin.git
- cd global-pygments-plugin/
- sh reconf.sh
- ./configure --prefix=<PREFIX> --with-exuberant-ctags=/usr/local/bin/ctags
- make && make install
- cp sample.globalrc $HOME/.globalrc
-
- Make sure the value of ``<PREFIX>`` agree with step 1.
-
-Config
-~~~~~~
-
-Global with ``exuberant-ctags`` and ``pygments`` plugins can support
-dozens of programming languages. For example, to enable
-``ggtags-mode`` for C/C++/Java modes::
-
- (add-hook 'c-mode-common-hook
- (lambda ()
- (when (derived-mode-p 'c-mode 'c++-mode 'java-mode)
- (ggtags-mode 1))))
-
-Also see https://github.com/leoliu/ggtags/wiki for more examples.
-
-Usage
-~~~~~
-
-Open any file in a project and type ``M-x ggtags-mode``. Use ``M-.``
-(``ggtags-find-tag-dwim``) to find the tag at point. If the project
-has not been indexed (i.e. no ``GTAGS`` file exists), ``ggtags`` will
-ask for the project root directory and index it recursively.
-Alternatively one can invoke ``ggtags-create-tags`` to index a
-directory. The mode line will display the directory name next to the
-buffer name. If point is at a valid definition tag, it is underlined.
-
-``ggtags`` is similar to the standard ``etags`` package. For example
-these keys ``M-.``, ``M-,`` and ``C-M-.`` should work as expected in
-``ggtags-mode``.
-
-The following search commands are available:
-
-ggtags-find-tag-dwim
-
- Find a tag 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.
-
- To force finding a definition tag, call it with a prefix (``C-u``).
-
-ggtags-find-tag-mouse
-
- Like ``ggtags-find-tag-dwim`` but suitable for binding to mouse
- events.
-
-ggtags-find-definition
-
- Find definition tags. With ``C-u`` ask for the tag name with
- completion.
-
-ggtags-find-reference
-
- Find reference tags. With ``C-u`` ask for the tag name with completion.
-
-ggtags-find-other-symbol
-
- Find tags that have no definitions. With ``C-u`` ask for the tag
- name with completion.
-
-ggtags-find-tag-regexp
-
- Find definition tags matching a regexp. By default it lists all
- matching tags in the project. With ``C-u`` restrict the lists to a
- directory of choice.
-
-ggtags-idutils-query
-
- Use idutils to find matches.
-
-ggtags-grep
-
- Grep for lines matching a regexp. This is usually the slowest.
-
-ggtags-find-file
-
- Find a file from all the files indexed by ``gtags``.
-
-ggtags-query-replace
-
- Do a query replace in all files found in a search.
-
-Handling multiple matches
-+++++++++++++++++++++++++
-
-When a search finds multiple matches, a buffer named
-``*ggtags-global*`` is popped up and ``ggtags-navigation-mode`` is
-turned on to facilitate locating the right match.
-``ggtags-navigation-mode`` makes a few commands in the
-``*ggtags-global*`` buffer globally accessible:
-
-``M-n``
-
- Move to the next match.
-
-``M-p``
-
- Move to the previous match.
-
-``M-}``
-
- Move to next file.
-
-``M-{``
-
- Move to previous file.
-
-``M-=``
-
- Move to the file where navigation session starts.
-
-``M-<``
-
- Move to the first match.
-
-``M->``
-
- Move to the last match.
-
-``C-M-s`` or ``M-s s``
-
- Use ``isearch`` to find the match.
-
-``RET``
-
- Found the right match so exit navigation mode. Resumable by
- ``M-x tags-loop-continue``.
-
-``M-,`` (``M-*`` if Emacs < 25)
-
- Abort and go back to the location where the search was started.
-
-Miscellaneous commands
-++++++++++++++++++++++
-
-Commands are available from the ``Ggtags`` menu in ``ggtags-mode``.
-
-ggtags-prev-mark
-
- Move to the previously (older) visited location. Unlike ``M-,``
- (``M-*`` if Emacs < 25) this doesn't delete the location from the
- tag ring.
-
-ggtags-next-mark
-
- Move to the next (newer) visited location.
-
-ggtags-view-tag-history
-
- Pop to a buffer listing all visited locations from newest to
- oldest. The buffer is a next error buffer and works with standard
- commands ``next-error`` and ``previous-error``. In addition ``TAB``
- and ``S-TAB`` move to next/prev entry, and ``RET`` visits the
- location. ``M-n`` and ``M-p`` move to and display the next/previous
- entry.
-
-ggtags-view-search-history
-
- View or re-run past searches as kept in
- ``ggtags-global-search-history``.
-
-ggtags-kill-file-buffers
-
- Kill all file-visiting buffers of current project.
-
-ggtags-toggle-project-read-only
-
- Toggle opening files in ``read-only`` mode. Handy if the main
- purpose of source navigation is to read code.
-
-ggtags-visit-project-root
-
- Open the project root directory in ``dired``.
-
-ggtags-delete-tags
-
- Delete the GTAGS, GRTAGS, GPATH and ID files of current project.
-
-ggtags-explain-tags
-
- Explain how each file is indexed in current project.
-
-ggtags-browse-file-as-hypertext
-
- Use ``htags`` to generate HTML of the source tree. This allows
- browsing the project in a browser with cross-references.
-
-Integration with other packages
-+++++++++++++++++++++++++++++++
-
-* eldoc
-
- ``Eldoc`` support is set up by default on emacs 24.4+. For older
- versions set, for example, in the desired major mode:
-
- ::
-
- (setq-local eldoc-documentation-function #'ggtags-eldoc-function)
-
-* imenu
-
- Emacs major modes usually have excellent support for ``imenu`` so
- this is not enabled by default. To use:
- ::
-
- (setq-local imenu-create-index-function #'ggtags-build-imenu-index)
-
-* hippie-exp
- ::
-
- (setq-local hippie-expand-try-functions-list
- (cons 'ggtags-try-complete-tag
hippie-expand-try-functions-list))
-
-* company
-
- ``company`` can use ``ggtags`` as completion source via
- ``company-capf`` which is enabled by default.
-
-* helm
-
- If ``helm-mode`` is enabled ``ggtags`` will use it for completion if
- ``ggtags-completing-read-function`` is nil.
-
-NEWS
-~~~~
-
-[2018-07-25 Wed] 0.8.13
-+++++++++++++++++++++++
-
-#. Don't choke on tag names start with ``-`` (`#156
- <https://github.com/leoliu/ggtags/issues/156>`_).
-#. ``ggtags-show-definition`` supports ``ggtags-sort-by-nearness``.
-#. New variable ``ggtags-extra-args``.
-#. Unbreak ``ggtags-sort-by-nearness``.
-
-[2016-10-02 Sun] 0.8.12
-+++++++++++++++++++++++
-
-#. Work with Emacs 25.
-#. ``ggtags-navigation-mode`` is more discreet in displaying lighter
- when ``ggtags-enable-navigation-keys`` is set to nil.
-#. ``ggtags-make-project`` tries harder to find TAG files respecting
- ``GTAGSDBPATH``.
-#. Fix error "Selecting deleted buffer"
- (`#89 <https://github.com/leoliu/ggtags/issues/89>`_).
-
-[2015-12-15 Tue] 0.8.11
-+++++++++++++++++++++++
-
-#. ``ggtags-highlight-tag-delay`` is renamed to
- ``ggtags-highlight-tag``.
-#. Tag highlighting can be disabled by setting
- ``ggtags-highlight-tag`` to nil.
-
-[2015-06-12 Fri] 0.8.10
-+++++++++++++++++++++++
-
-#. Tags update on save is configurable by ``ggtags-update-on-save``.
-#. New command ``ggtags-explain-tags`` to explain how each file is
- indexed in current project. Global 6.4+ required.
-#. New user option ``ggtags-sort-by-nearness`` that sorts matched tags
- by nearness to current directory.
-
-[2015-01-16 Fri] 0.8.9
-++++++++++++++++++++++
-
-#. ``ggtags-visit-project-root`` can visit past projects.
-#. ``eldoc`` support enabled for emacs 24.4+.
-
-[2014-12-03 Wed] 0.8.8
-++++++++++++++++++++++
-
-#. Command ``ggtags-update-tags`` now runs in the background for large
- projects (per ``ggtags-oversize-limit``) without blocking emacs.
-
-[2014-11-10 Mon] 0.8.7
-++++++++++++++++++++++
-
-#. New navigation command ``ggtags-navigation-start-file``.
-#. New variable ``ggtags-use-sqlite3`` to enable sqlite3 storage.
-
-[2014-09-12 Fri] 0.8.6
-++++++++++++++++++++++
-
-#. ``ggtags-show-definition`` shows definition with font locking.
-
-[2014-06-22 Sun] 0.8.5
-++++++++++++++++++++++
-
-#. New command ``ggtags-find-tag-mouse`` for mouse support.
-#. New command ``ggtags-find-definition``.
-#. Variable ``ggtags-completing-read-function`` restored.
-#. ``ggtags-navigation-isearch-forward`` can also be invoked using
- ``M-s s``.
-#. Command ``ggtags-global-rerun-search`` renamed to
- ``ggtags-view-search-history``.
-#. The output buffer from ``ggtags-view-search-history`` looks
- cleaner.
-#. Search history items can be re-arranged with ``C-k`` and ``C-y``.
-
-[2014-05-06 Tue] 0.8.4
-++++++++++++++++++++++
-
-#. ``M-.`` (``ggtags-find-tag-dwim``) is smarter on new files.
-#. Always update tags for current file on save.
-#. Can continue search ``GTAGSLIBPATH`` if search turns up 0 matches.
- Customisable via ``ggtags-global-search-libpath-for-reference``.
-
-[2014-04-12 Sat] 0.8.3
-++++++++++++++++++++++
-
-#. Tweak mode-line lighter in ``ggtags-navigation-mode``.
-
-[2014-04-05 Sat] 0.8.2
-++++++++++++++++++++++
-
-#. Default ``ggtags-auto-jump-to-match`` to ``history``.
-#. Add eldoc support; see ``ggtags-eldoc-function``.
-#. Improved support for tramp.
-
-[2014-03-30 Sun] 0.8.1
-++++++++++++++++++++++
-
-#. Improve ``ggtags-view-tag-history`` and tag history navigation.
-#. New customsable variable ``ggtags-global-use-color``.
-#. Automatically jump to match from location stored in search history.
- See ``ggtags-auto-jump-to-match``.
-#. Rename ``ggtags-supress-navigation-keys`` to
- ``ggtags-enable-navigation-keys`` with a better way to suppress
- navigation key bindings in some buffers including
- ``*ggtags-global*`` buffer.
-
-[2014-03-24 Mon] 0.8.0
-++++++++++++++++++++++
-
-#. Record search history and re-run past searches.
-#. Bookmark or save search to register.
-#. New command ``ggtags-show-definition``.
-#. Project name on mode line.
-#. Automatically use ``.globalrc`` or ``gtags.conf`` file at project
- root.
-#. Better completion based on tag types.
-#. Use colored output to get column number for jumping to tag.
-#. Improve detection of stale GTAGS file based on file modification
- time.
-#. New customisable variables ``ggtags-executable-directory``,
- ``ggtags-global-always-update``, ``ggtags-mode-sticky`` and
- ``ggtags-supress-navigation-keys``.
-#. Other bug fixes.
-
-Bugs
-~~~~
-
-https://github.com/leoliu/ggtags/issues
diff --git a/packages/ggtags/ggtags.el b/packages/ggtags/ggtags.el
deleted file mode 100644
index f053310..0000000
--- a/packages/ggtags/ggtags.el
+++ /dev/null
@@ -1,2408 +0,0 @@
-;;; ggtags.el --- emacs frontend to GNU Global source code tagging system -*-
lexical-binding: t; -*-
-
-;; Copyright (C) 2013-2018 Free Software Foundation, Inc.
-
-;; Author: Leo Liu <sdl.web@gmail.com>
-;; Version: 0.8.13
-;; 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 <http://www.gnu.org/licenses/>.
-
-;;; 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-,' 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.13 (2018-07-25):
-
-;; - Don't choke on tag names start with `-'.
-;; - `ggtags-show-definition' supports `ggtags-sort-by-nearness'.
-;; - New variable `ggtags-extra-args'.
-;; - Unbreak `ggtags-sort-by-nearness'.
-;;
-;; 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))
- (or (boundp 'xref--marker-ring) ;25.1
- (defvaralias 'xref--marker-ring 'find-tag-marker-ring))
- (or (fboundp 'xref-push-marker-stack) ;25.1
- (defun xref-push-marker-stack (&optional m)
- (ring-insert xref--marker-ring (or m (point-marker)))))
- (or (fboundp 'xref-pop-marker-stack)
- (defalias 'xref-pop-marker-stack 'pop-tag-mark)))
-
-(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-extra-args nil
- "Extra arguments to pass to `gtags' in `ggtags-create-tags'."
- :type '(repeat string)
- :safe #'ggtags-list-of-string-p
- :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\r")
- (buffer-substring-no-properties (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-no-properties 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)
- (let* ((default-directory (file-name-as-directory root))
- ;; NOTE: use of GTAGSDBPATH is not recommended. -- GLOBAL(1)
- ;; ROOT and DB can be different directories due to GTAGSDBPATH.
- (dbdir (concat (file-remote-p root)
- (ggtags-process-string "global" "-p"))))
- (pcase (nthcdr 5 (file-attributes (expand-file-name "GTAGS" dbdir)))
- (`(,mtime ,_ ,tag-size . ,_)
- (let* ((rtags-size (nth 7 (file-attributes (expand-file-name "GRTAGS"
dbdir))))
- (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
- (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 (append (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))))
- ggtags-extra-args)))
- (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)
- (xref-push-marker-stack 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)))
-
-(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)
- ;; Note `ggtags-find-tag' binds `default-directory' to
- ;; project root.
- (shell-quote-argument
- (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 xref--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 (xref-push-marker-stack)
- 0))
- (ring-length xref--marker-ring)))
- (let ((m (ring-ref xref--marker-ring ggtags-tag-ring-index))
- (i (- (ring-length xref--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 xref--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 xref--marker-ring))
- (elements (or (ring-elements xref--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))
- ;; Manually run the `compilation-auto-jump' timer. Hackish but
- ;; everything else seems unreliable. See:
- ;;
- ;; - http://debbugs.gnu.org/13829
- ;; - http://debbugs.gnu.org/23987
- ;; - https://github.com/leoliu/ggtags/issues/89
- ;;
- (pcase (cl-find 'compilation-auto-jump timer-list :key #'timer--function)
- (`nil )
- (timer (timer-event-handler timer)))
- (ggtags-navigation-mode -1)
- (ggtags-navigation-mode-cleanup buf t)))))
-
-(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) ;Emacs
24
- (define-key map [remap xref-pop-marker-stack]
'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 kill)
- (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 kill (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 t)
- ;; 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)
- (xref-pop-marker-stack)))
-
-(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
- ;; If `ggtags-enable-navigation-keys' is set to nil only display the
- ;; lighter in `ggtags-mode' buffers.
- ;; See https://github.com/leoliu/ggtags/issues/124
- :lighter (:eval (and (or ggtags-enable-navigation-keys
- ggtags-mode)
- 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*")
- (let ((inhibit-read-only t))
- (erase-buffer))
- (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))
- (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*"))
- (args (list "--result=grep" "--path-style=absolute" name))
- ;; 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-no-properties
- (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
- (cons (ggtags-program-path "global")
- (if (ggtags-sort-by-nearness-p) (cons "--nearness=." args) args))
- 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" xref-pop-marker-stack
- :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))
- ;; TODO: bind `find-tag-continue' to `M-*' after dropping support
- ;; for emacs < 25.
- (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-no-properties
- (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/packages/gnome-c-style/.gitignore
b/packages/gnome-c-style/.gitignore
deleted file mode 100644
index 7c5214c..0000000
--- a/packages/gnome-c-style/.gitignore
+++ /dev/null
@@ -1,2 +0,0 @@
-*.elc
-
diff --git a/packages/gnome-c-style/Makefile b/packages/gnome-c-style/Makefile
deleted file mode 100644
index 571841e..0000000
--- a/packages/gnome-c-style/Makefile
+++ /dev/null
@@ -1,16 +0,0 @@
-EMACS ?= emacs
-RM ?= rm
-ELC = gnome-c-align.elc gnome-c-snippet.elc gnome-c-style.elc
-
-all: $(ELC)
-
-%.elc: %.el
- $(EMACS) -Q -batch --eval "(setq load-path (cons nil load-path))" \
- -f batch-byte-compile $<
-
-check:
- $(EMACS) -Q -batch --eval "(setq load-path (cons nil load-path))" \
- -l ert -l gnome-c-tests.el -f ert-run-tests-batch-and-exit
-
-clean:
- $(RM) -rf $(ELC)
diff --git a/packages/gnome-c-style/README b/packages/gnome-c-style/README
deleted file mode 120000
index 42061c0..0000000
--- a/packages/gnome-c-style/README
+++ /dev/null
@@ -1 +0,0 @@
-README.md
\ No newline at end of file
diff --git a/packages/gnome-c-style/README.md b/packages/gnome-c-style/README.md
deleted file mode 100644
index 69532eb..0000000
--- a/packages/gnome-c-style/README.md
+++ /dev/null
@@ -1,88 +0,0 @@
-gnome-c-style
-======
-
-gnome-c-style is an Emacs minor mode for editing C source code in [GNOME C
coding
style](https://developer.gnome.org/programming-guidelines/stable/c-coding-style.html.en).
-In particular, it is useful to properly line-up [function
arguments](https://developer.gnome.org/programming-guidelines/stable/c-coding-style.html.en#functions)
and
-[function declarations in header
files](https://developer.gnome.org/programming-guidelines/stable/c-coding-style.html.en#header-files).
-
-Install
-------
-
-* `M-x package-install gnome-c-style`
-* Add the following line to `~/.emacs.d/init.el`:
-
-```
-(add-hook 'c-mode-hook 'gnome-c-style-mode)
-```
-
-Usage
-------
-
-| Key | Command |
---------------|-----------------------------------------------------------|
-| C-c C-g a | Align argument list at the current point |
-| C-c C-g r | Align function declarations in the current region |
-| C-c C-g C-g | Compute optimal alignment columns from the current region |
-| C-c C-g g | Guess alignment columns from the current region |
-| C-c C-g f | Set alignment column to the current point |
-| C-c C-g c | Insert `module_object` |
-| C-c C-g C | Insert `MODULE_OBJECT` |
-| C-c C-g C-c | Insert `ModuleObject` |
-| C-c C-g s | Insert custom snippet |
-
-Example
-------
-
-If you have the following code in a header file:
-```c
-GGpgCtx *g_gpg_ctx_new (GError **error);
-
-typedef void (*GGpgProgressCallback) (gpointer user_data,
- const gchar *what,
- gint type,
- gint current,
- gint total);
-
-void g_gpg_ctx_set_progress_callback (GGpgCtx *ctx,
- GGpgProgressCallback callback,
- gpointer user_data,
- GDestroyNotify destroy_data);
-void g_gpg_ctx_add_signer (GGpgCtx *ctx, GGpgKey *key);
-guint g_gpg_ctx_get_n_signers (GGpgCtx *ctx);
-GGpgKey *g_gpg_ctx_get_signer (GGpgCtx *ctx, guint index);
-void g_gpg_ctx_clear_signers (GGpgCtx *ctx);
-```
-
-Mark the region, type `C-c C-g C-g`, and you will see the optimum
-alignment columns:
-
-```
-identifier-start: 9, arglist-start: 41, arglist-identifier-start: 64
-```
-
-Then, mark the region again, type `C-c C-g r`, and you will get the
-code aligned:
-
-```c
-GGpgCtx *g_gpg_ctx_new (GError **error);
-
-typedef void (*GGpgProgressCallback) (gpointer user_data,
- const gchar *what,
- gint type,
- gint current,
- gint total);
-
-void g_gpg_ctx_set_progress_callback (GGpgCtx *ctx,
- GGpgProgressCallback callback,
- gpointer user_data,
- GDestroyNotify destroy_data);
-void g_gpg_ctx_add_signer (GGpgCtx *ctx,
- GGpgKey *key);
-guint g_gpg_ctx_get_n_signers (GGpgCtx *ctx);
-GGpgKey *g_gpg_ctx_get_signer (GGpgCtx *ctx,
- guint index);
-void g_gpg_ctx_clear_signers (GGpgCtx *ctx);
-```
-
-Note that the `typedef` statement is skipped as it is not a function
-declaration.
diff --git a/packages/gnome-c-style/gnome-c-align.el
b/packages/gnome-c-style/gnome-c-align.el
deleted file mode 100644
index 734800a..0000000
--- a/packages/gnome-c-style/gnome-c-align.el
+++ /dev/null
@@ -1,547 +0,0 @@
-;; gnome-c-align.el --- GNOME-style code alignment -*- lexical-binding: t; -*-
-;; Copyright (C) 2016 Free Software Foundation, Inc.
-
-;; Author: Daiki Ueno <ueno@gnu.org>
-;; Keywords: GNOME, C, coding style
-
-;; 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 <http://www.gnu.org/licenses/>.
-
-;;; Code:
-
-(require 'cc-mode)
-(require 'cl-lib)
-
-(defcustom gnome-c-align-max-column 80
- "Maximum number of columns per line."
- :type '(choice (integer :tag "Columns")
- (const :tag "No wrap"))
- :group 'gnome-c-style)
-
-(defvar gnome-c-align-identifier-start-column nil)
-(make-variable-buffer-local 'gnome-c-align-identifier-start-column)
-
-(defvar gnome-c-align-arglist-start-column nil)
-(make-variable-buffer-local 'gnome-c-align-arglist-start-column)
-
-(defvar gnome-c-align-arglist-identifier-start-column nil)
-(make-variable-buffer-local 'gnome-c-align-arglist-identifier-start-column)
-
-(cl-defstruct (gnome-c-align--argument
- (:constructor nil)
- (:constructor gnome-c-align--make-argument (type-start
- type-identifier-end
- type-end
- identifier-start
- identifier-end))
- (:copier nil)
- (:predicate nil))
- (type-start nil :read-only t)
- (type-identifier-end nil :read-only t)
- (type-end nil :read-only t)
- (identifier-start nil :read-only t)
- (identifier-end nil :read-only t))
-
-(defun gnome-c-align--marker-column (marker)
- (save-excursion
- (goto-char marker)
- (current-column)))
-
-(defun gnome-c-align--indent-to-column (column)
- ;; Prefer 'char **foo' than 'char ** foo'
- (when (looking-back "\\*+" nil t)
- (setq column (- column (- (match-end 0) (match-beginning 0))))
- (goto-char (match-beginning 0)))
- ;; FIXME: should respect indent-tabs-mode?
- (let (indent-tabs-mode)
- (indent-to-column column)))
-
-(defun gnome-c-align--argument-type-width (arg)
- (- (gnome-c-align--marker-column (gnome-c-align--argument-type-end arg))
- (gnome-c-align--marker-column (gnome-c-align--argument-type-start arg))))
-
-(defun gnome-c-align--argument-type-identifier-width (arg)
- (- (gnome-c-align--marker-column
- (gnome-c-align--argument-type-identifier-end arg))
- (gnome-c-align--marker-column
- (gnome-c-align--argument-type-start arg))))
-
-(defun gnome-c-align--arglist-identifier-start-column (arglist start-column)
- (let ((max-type-identifier-width
- (apply #'max
- 0
- (mapcar #'gnome-c-align--argument-type-identifier-width
- arglist)))
- (max-extra-width
- (apply #'max
- 0
- (mapcar
- (lambda (argument)
- (- (gnome-c-align--argument-type-end argument)
- (gnome-c-align--argument-type-identifier-end argument)))
- arglist))))
- (+ start-column max-type-identifier-width max-extra-width)))
-
-(defun gnome-c-align--argument-identifier-width (argument)
- (if (gnome-c-align--argument-identifier-start argument)
- (- (gnome-c-align--marker-column
- (gnome-c-align--argument-identifier-end argument))
- (gnome-c-align--marker-column
- (gnome-c-align--argument-identifier-start argument)))
- 0))
-
-(defun gnome-c-align--arglist-identifier-width (arglist)
- (apply #'max 0 (mapcar #'gnome-c-align--argument-identifier-width arglist)))
-
-(defun gnome-c-align--normalize-arglist-region (arglist beg end)
- (save-excursion
- (save-restriction
- (narrow-to-region beg end)
- (goto-char (point-min))
- (while (re-search-forward "\\s-+" nil t)
- (replace-match " "))
- (goto-char (point-min))
- (while (re-search-forward "\\s-*," nil t)
- (replace-match ",\n"))
- (goto-char (point-min))
- (delete-trailing-whitespace)
- ;; Remove whitespace at the beginning of line
- (goto-char (point-min))
- (while (re-search-forward "^\\s-+" nil t)
- (replace-match ""))
- ;; Remove empty lines
- (goto-char (point-min))
- (delete-matching-lines "^$")
- ;; 'int * * * foo' -> 'int ***foo'
- (dolist (argument arglist)
- (goto-char (gnome-c-align--argument-type-end argument))
- (while (re-search-backward
- "\\(\\*+\\)\\s-+"
- (gnome-c-align--argument-type-identifier-end argument)
- t)
- (replace-match "\\1"))
- (when (gnome-c-align--argument-identifier-start argument)
- (goto-char (gnome-c-align--argument-identifier-start argument))
- (if (looking-back "\\* " nil)
- (delete-char -1)))
- (goto-char (gnome-c-align--argument-type-end argument))))))
-
-(defun gnome-c-align--parse-arglist (beg end)
- (save-excursion
- (save-restriction
- (narrow-to-region beg end)
- (let (type-start
- type-identifier-end
- type-end
- identifier-start
- identifier-end
- arglist
- last-token-start)
- (goto-char (point-max))
- (while (not (bobp))
- (c-backward-syntactic-ws)
- (setq identifier-end (point-marker))
- ;; Array argument, such as 'int a[]'
- (if (eq (preceding-char) ?\])
- (c-backward-sexp))
- (c-backward-token-2)
- (setq identifier-start (point-marker))
- (c-backward-syntactic-ws)
- (if (or (bobp) (eq (preceding-char) ?,))
- (progn
- ;; Identifier is omitted, or '...'.
- (setq type-start identifier-start
- type-identifier-end identifier-end
- type-end identifier-end
- identifier-start nil
- identifier-end nil)
- (c-backward-token-2))
- (setq type-end (point-marker)
- last-token-start type-end)
- (while (and (not (bobp))
- (progn
- (c-backward-token-2)
- (unless (eq (char-after) ?,)
- (setq last-token-start (point-marker)))))
- (c-backward-syntactic-ws))
- (setq type-start last-token-start)
- (save-excursion
- (goto-char type-end)
- (skip-chars-backward "* " type-start)
- (c-backward-syntactic-ws)
- (setq type-identifier-end (point-marker))))
- (push (gnome-c-align--make-argument type-start
- type-identifier-end
- type-end
- identifier-start
- identifier-end)
- arglist))
- arglist))))
-
-;;;###autoload
-(defun gnome-c-align-arglist-at-point (&optional identifier-start-column)
- "Reformat argument list at point, aligning argument to the right end."
- (interactive)
- (save-excursion
- (let* (start-column arglist)
- (cl-destructuring-bind (beg end)
- (gnome-c-align--arglist-region-at-point (point))
- (goto-char beg)
- (setq start-column (current-column))
- (save-restriction
- (narrow-to-region beg end)
- (setq arglist (gnome-c-align--parse-arglist (point-min) (point-max)))
- (gnome-c-align--normalize-arglist-region
- arglist (point-min) (point-max))
- (unless identifier-start-column
- (setq identifier-start-column
- (gnome-c-align--arglist-identifier-start-column arglist 0)))
- (dolist (argument arglist)
- (goto-char (gnome-c-align--argument-type-start argument))
- (let ((column (if (bobp) 0 start-column)))
- (when (not (bobp))
- (gnome-c-align--indent-to-column start-column))
- (when (gnome-c-align--argument-identifier-start argument)
- (setq column (+ column identifier-start-column))
- (goto-char (gnome-c-align--argument-identifier-start argument))
- (gnome-c-align--indent-to-column column)))))))))
-
-(cl-defstruct (gnome-c-align--decl
- (:constructor nil)
- (:constructor gnome-c-align--make-decl (start
- end
- identifier-start
- identifier-end
- arglist-start
- arglist-end
- arglist))
- (:copier nil)
- (:predicate nil))
- (start nil :read-only t)
- (end nil :read-only t)
- (identifier-start nil :read-only t)
- (identifier-end nil :read-only t)
- (arglist-start nil :read-only t)
- (arglist-end nil :read-only t)
- (arglist nil :read-only t))
-
-(defun gnome-c-align--decls-identifier-start-column (decls start-column)
- (apply #'max
- start-column
- (delq nil
- (mapcar
- (lambda (decl)
- (let ((decl-column
- (+ start-column
- (gnome-c-align--marker-column
- (gnome-c-align--decl-identifier-start decl)))))
- (if (and gnome-c-align-max-column
- (> decl-column gnome-c-align-max-column))
- nil
- decl-column)))
- decls))))
-
-(defun gnome-c-align--decl-identifier-width (decl)
- (- (gnome-c-align--marker-column
- (gnome-c-align--decl-identifier-end decl))
- (gnome-c-align--marker-column
- (gnome-c-align--decl-identifier-start decl))))
-
-(defun gnome-c-align--decls-arglist-start-column (decls start-column)
- (let ((arglist-width
- (+ (gnome-c-align--decls-arglist-identifier-start-column decls 0)
- (gnome-c-align--decls-arglist-identifier-width decls)
- (length ");"))))
- (apply #'max
- start-column
- (delq nil
- (mapcar
- (lambda (decl)
- (let ((decl-column
- (+ start-column
- (gnome-c-align--decl-identifier-width decl)
- 1)))
- (if (and gnome-c-align-max-column
- (> (+ decl-column arglist-width)
- gnome-c-align-max-column))
- nil
- decl-column)))
- decls)))))
-
-(defun gnome-c-align--decls-arglist-identifier-width (decls)
- (apply #'max 0 (mapcar (lambda (decl)
- (gnome-c-align--arglist-identifier-width
- (gnome-c-align--decl-arglist decl)))
- decls)))
-
-(defun gnome-c-align--decls-arglist-identifier-start-column (decls
start-column)
- (apply #'max 0 (mapcar (lambda (decl)
- ;; FIXME: should wrap lines inside argument list?
- (gnome-c-align--arglist-identifier-start-column
- (gnome-c-align--decl-arglist decl)
- start-column))
- decls)))
-
-(defun gnome-c-align--parse-decl (beg end)
- ;; Parse at most one func declaration found in BEG END.
- (save-excursion
- (save-restriction
- (narrow-to-region beg end)
- (let (arglist-start
- arglist-end
- identifier-start
- identifier-end
- vfunc-p)
- (goto-char (point-min))
- (c-forward-syntactic-ws)
- (unless (looking-at
- "typedef\\|#\\|G_\\(?:DECLARE\\|DEFINE\\)")
- (while (and (not (eobp))
- (not (eq (char-after) ?\()))
- (c-forward-token-2)
- (c-forward-syntactic-ws))
- ;; Identifier is vfunc.
- (when (looking-at "(\\s-*\\*")
- (c-forward-sexp)
- (c-forward-syntactic-ws)
- (setq vfunc-p t))
- (when (eq (char-after) ?\()
- (setq arglist-start (point-marker))
- (c-backward-syntactic-ws)
- (setq identifier-end (point-marker))
- (if vfunc-p
- (c-backward-sexp)
- (c-backward-token-2))
- (setq identifier-start (point-marker))
- (goto-char arglist-start)
- (c-forward-sexp)
- (setq arglist-end (point-marker))
- (gnome-c-align--make-decl beg end
- identifier-start identifier-end
- arglist-start arglist-end
- (gnome-c-align--parse-arglist
- (1+ arglist-start)
- (1- arglist-end)))))))))
-
-(defun gnome-c-align--normalize-decl (decl)
- (save-excursion
- ;; Replace newlines with a space
- (save-restriction
- ;; Ignore lines before identifier-start
- (goto-char (gnome-c-align--decl-identifier-start decl))
- (beginning-of-line)
- (narrow-to-region (point)
- (gnome-c-align--decl-arglist-end decl))
- (goto-char (point-min))
- (while (re-search-forward "\n" nil t)
- (replace-match " ")))
- ;; Replace consequent spaces with a space
- (save-restriction
- ;; Ignore lines before identifier-start
- (goto-char (gnome-c-align--decl-identifier-start decl))
- (beginning-of-line)
- (narrow-to-region (point)
- (gnome-c-align--decl-arglist-end decl))
- (goto-char (point-min))
- (while (re-search-forward "\\s-+" nil t)
- (replace-match " ")))
- (goto-char (gnome-c-align--decl-identifier-start decl))
- (if (looking-back "\\* " nil)
- (delete-char -1))
- ;; Normalize the argument list
- (gnome-c-align--normalize-arglist-region
- (gnome-c-align--decl-arglist decl)
- (gnome-c-align--decl-arglist-start decl)
- (gnome-c-align--decl-arglist-end decl))))
-
-(defun gnome-c-align--arglist-region-at-point (point)
- (save-excursion
- (let (start)
- (goto-char point)
- (c-beginning-of-statement-1)
- (c-backward-syntactic-ws)
- (unless (eq ?\( (preceding-char))
- (error "No containing argument list"))
- (setq start (point))
- (backward-char)
- (condition-case nil
- (c-forward-sexp)
- (error
- (error "No closing parenthesis")))
- (backward-char)
- (list start (point)))))
-
-;;;###autoload
-(defun gnome-c-align-set-column (symbol)
- "Set alignment column of SYMBOL."
- (interactive
- (let ((symbol-name (completing-read "Symbol to change: "
- '("identifier-start"
- "arglist-start"
- "arglist-identifier-start")
- nil t)))
- (list (intern (format "gnome-c-align-%s-column" symbol-name)))))
- (set symbol (current-column)))
-
-(defun gnome-c-align--scan-decls (beg end)
- (save-excursion
- (save-restriction
- (narrow-to-region beg end)
- (goto-char (point-min))
- (let (decls)
- (while (not (eobp))
- (let (decl-start decl-end decl)
- (c-forward-syntactic-ws)
- (setq decl-start (point-marker))
- (c-end-of-statement)
- (setq decl-end (point-marker))
- (setq decl (gnome-c-align--parse-decl decl-start decl-end))
- (when decl
- (push decl decls))))
- decls))))
-
-(defun gnome-c-align--guess-optimal-columns (beg end)
- (let ((buffer (current-buffer))
- decls)
- (with-temp-buffer
- (insert-buffer-substring-no-properties buffer beg end)
- (c-mode)
- (setq decls (gnome-c-align--scan-decls (point-min) (point-max)))
- (mapc #'gnome-c-align--normalize-decl decls)
- (let* ((identifier-start-column
- (gnome-c-align--decls-identifier-start-column
- decls 0))
- (arglist-start-column
- (gnome-c-align--decls-arglist-start-column
- decls identifier-start-column))
- (arglist-identifier-start-column
- (gnome-c-align--decls-arglist-identifier-start-column
- decls (+ (length "(") arglist-start-column))))
- (list (cons 'identifier-start-column
- identifier-start-column)
- (cons 'arglist-start-column
- arglist-start-column)
- (cons 'arglist-identifier-start-column
- arglist-identifier-start-column))))))
-
-;;;###autoload
-(defun gnome-c-align-guess-optimal-columns (beg end)
- "Compute the optimal alignment rule from the declarations in BEG and END.
-
-This sets `gnome-c-align-identifier-start-column',
-`gnome-c-align-arglist-start-column', and
-`gnome-c-align-arglist-identifier-start-column'."
- (interactive "r")
- (let ((columns (gnome-c-align--guess-optimal-columns beg end)))
- (setq gnome-c-align-identifier-start-column
- (cdr (assq 'identifier-start-column columns))
- gnome-c-align-arglist-start-column
- (cdr (assq 'arglist-start-column columns))
- gnome-c-align-arglist-identifier-start-column
- (cdr (assq 'arglist-identifier-start-column columns)))
- (message
- "identifier-start: %d, arglist-start: %d, arglist-identifier-start: %d"
- gnome-c-align-identifier-start-column
- gnome-c-align-arglist-start-column
- gnome-c-align-arglist-identifier-start-column)))
-
-;;;###autoload
-(defun gnome-c-align-guess-columns (beg end)
- "Guess the existing alignment rule from the declarations in BEG and END.
-
-This sets `gnome-c-align-identifier-start-column',
-`gnome-c-align-arglist-start-column', and
-`gnome-c-align-arglist-identifier-start-column'."
- (interactive "r")
- (let ((decls (gnome-c-align--scan-decls beg end))
- arglist)
- (unless decls
- (error "No function declaration in the region"))
- (setq arglist (gnome-c-align--parse-arglist
- (1+ (gnome-c-align--decl-arglist-start (car decls)))
- (1- (gnome-c-align--decl-arglist-end (car decls)))))
- (unless arglist
- (error "Empty argument list"))
- (unless (gnome-c-align--argument-identifier-start (car arglist))
- (error "No identifier in the argument list"))
- (setq gnome-c-align-identifier-start-column
- (gnome-c-align--marker-column
- (gnome-c-align--decl-identifier-start (car decls)))
- gnome-c-align-arglist-start-column
- (gnome-c-align--marker-column
- (gnome-c-align--decl-arglist-start (car decls)))
- gnome-c-align-arglist-identifier-start-column
- (gnome-c-align--marker-column
- (gnome-c-align--argument-identifier-start (car arglist))))
- (message
- "identifier-start: %d, arglist-start: %d, arglist-identifier-start: %d"
- gnome-c-align-identifier-start-column
- gnome-c-align-arglist-start-column
- gnome-c-align-arglist-identifier-start-column)))
-
-;;;###autoload
-(defun gnome-c-align-decls-region (beg end)
- "Reformat function declarations in the region between BEG and END.
-
-The `gnome-c-align-identifier-start-column',
-`gnome-c-align-arglist-start-column', and
-`gnome-c-align-arglist-identifier-start-column' variables
-control the widths.
-
-To set those variables, use \\[gnome-c-align-set-column],
-\\[gnome-c-align-guess-columns], or
-\\[gnome-c-align-guess-optimal-columns].
-
-If they are not set, this function internally calls
-\\[gnome-c-align-guess-optimal-columns] before formatting."
- (interactive "r")
- (save-excursion
- (let (decls)
- (save-restriction
- (narrow-to-region beg end)
- (unless (and gnome-c-align-identifier-start-column
- gnome-c-align-arglist-start-column
- gnome-c-align-arglist-identifier-start-column)
- (let ((columns (gnome-c-align--guess-optimal-columns beg end)))
- (unless gnome-c-align-identifier-start-column
- (setq gnome-c-align-identifier-start-column
- (cdr (assq 'identifier-start-column columns))))
- (unless gnome-c-align-arglist-start-column
- (setq gnome-c-align-arglist-start-column
- (cdr (assq 'arglist-start-column columns))))
- (unless gnome-c-align-arglist-identifier-start-column
- (setq gnome-c-align-arglist-identifier-start-column
- (cdr (assq 'arglist-identifier-start-column columns))))))
- (setq decls (gnome-c-align--scan-decls beg end))
- (dolist (decl decls)
- (gnome-c-align--normalize-decl decl)
- (goto-char (gnome-c-align--decl-identifier-start decl))
- (gnome-c-align--indent-to-column
- gnome-c-align-identifier-start-column)
- (goto-char (gnome-c-align--decl-identifier-end decl))
- (when (>= (current-column) gnome-c-align-arglist-start-column)
- (insert "\n"))
- (goto-char (gnome-c-align--decl-arglist-start decl))
- (gnome-c-align--indent-to-column
- gnome-c-align-arglist-start-column)
- (forward-char)
- (gnome-c-align-arglist-at-point
- (- (- gnome-c-align-arglist-identifier-start-column
- (length "("))
- gnome-c-align-arglist-start-column)))))))
-
-(provide 'gnome-c-align)
-
-;;; gnome-c-align.el ends here
diff --git a/packages/gnome-c-style/gnome-c-snippet.el
b/packages/gnome-c-style/gnome-c-snippet.el
deleted file mode 100644
index 469ccf6..0000000
--- a/packages/gnome-c-style/gnome-c-snippet.el
+++ /dev/null
@@ -1,703 +0,0 @@
-;;; gnome-c-snippet.el --- GNOME-style code generation -*- lexical-binding: t;
-*-
-;; Copyright (C) 2016 Free Software Foundation, Inc.
-
-;; Author: Daiki Ueno <ueno@gnu.org>
-;; Keywords: GNOME, C, coding style
-
-;; 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 <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; FIXME: The snippets defined here could be rewritten in yasnippet
-
-;;; Code:
-
-(require 'gnome-c-align)
-(require 'subword)
-
-(defvar gnome-c-snippet-package nil)
-(make-variable-buffer-local 'gnome-c-snippet-package)
-
-(defvar gnome-c-snippet-class nil)
-(make-variable-buffer-local 'gnome-c-snippet-class)
-
-(defvar gnome-c-snippet-parent-package nil)
-(make-variable-buffer-local 'gnome-c-snippet-parent-package)
-
-(defvar gnome-c-snippet-parent-class nil)
-(make-variable-buffer-local 'gnome-c-snippet-parent-class)
-
-(defconst gnome-c-snippet-guess-name-functions
- '(gnome-c-snippet--guess-name-from-header-buffer
- gnome-c-snippet--guess-name-from-declaration
- gnome-c-snippet--guess-name-from-file-name))
-
-(defcustom gnome-c-snippet-align-arglist t
- "Whether to align argument list of the inserted snippet"
- :type 'boolean
- :group 'gnome-c-style)
-
-(make-variable-buffer-local 'gnome-c-snippet-align-arglist)
-
-(defun gnome-c-snippet--find-declaration ()
- (save-excursion
- (let (beg end)
- (goto-char (point-min))
- (when (re-search-forward
- "^G_DECLARE_\\(?:FINAL\\|DERIVABLE\\)_TYPE\\s-*("
- nil t)
- (setq beg (match-beginning 0))
- (goto-char (match-end 0))
- (backward-char)
- (condition-case nil
- (progn
- (c-forward-sexp)
- (setq end (point)))
- (error)))
- (when (and beg end)
- (list beg end)))))
-
-(defun gnome-c-snippet--extract-names-from-declaration (beg end)
- (save-excursion
- (narrow-to-region beg end)
- (goto-char (point-min))
- (search-forward "(")
- (c-forward-syntactic-ws)
- (let ((capitalized-package-class
- (buffer-substring-no-properties (point)
- (progn
- (c-forward-token-2)
- (c-backward-syntactic-ws)
- (point))))
- uppercased-package uppercased-class
- capitalized-package capitalized-class capitalized-parent)
- (c-forward-syntactic-ws)
- (c-forward-token-2 3)
- (setq uppercased-package (split-string
- (buffer-substring (point)
- (progn
- (c-forward-token-2)
- (c-backward-syntactic-ws)
- (point)))
- "_"))
- (c-forward-syntactic-ws)
- (c-forward-token-2)
- (setq uppercased-class (split-string
- (buffer-substring (point)
- (progn
- (c-forward-token-2)
- (c-backward-syntactic-ws)
- (point)))
- "_"))
- (c-forward-syntactic-ws)
- (c-forward-token-2)
- (setq capitalized-parent (gnome-c-snippet--parse-name
- (buffer-substring (point)
- (progn
- (c-forward-token-2)
- (c-backward-syntactic-ws)
- (point)))))
- (catch 'error
- (let ((index 0))
- (dolist (uppercased uppercased-package)
- (let* ((length (length uppercased))
- (capitalized
- (substring capitalized-package-class
- index (+ index length))))
- (unless (equal (upcase capitalized) uppercased)
- (throw 'error nil))
- (push capitalized capitalized-package)
- (setq index (+ index length))))
- (dolist (uppercased uppercased-class)
- (let* ((length (length uppercased))
- (capitalized
- (substring capitalized-package-class
- index (+ index length))))
- (unless (equal (upcase capitalized) uppercased)
- (throw 'error nil))
- (push capitalized capitalized-class)
- (setq index (+ index length))))))
- (list (nreverse capitalized-package)
- (nreverse capitalized-class)
- capitalized-parent))))
-
-(defun gnome-c-snippet--find-header-buffer ()
- (pcase (file-name-extension buffer-file-name)
- ("h"
- (current-buffer))
- ("c"
- (let ((header-file-name
- (concat (file-name-sans-extension buffer-file-name) ".h")))
- (cl-find-if
- (lambda (buffer)
- (with-current-buffer buffer
- (equal buffer-file-name header-file-name)))
- (buffer-list))))))
-
-(defun gnome-c-snippet--guess-name-from-header-buffer (symbol)
- (let ((header-buffer (gnome-c-snippet--find-header-buffer)))
- (when header-buffer
- (with-current-buffer header-buffer
- (symbol-value (intern (format "gnome-c-snippet-%S" symbol)))))))
-
-(defun gnome-c-snippet--guess-name-from-declaration (symbol)
- (when (memq symbol '(package class parent-package parent-class))
- (let ((header-buffer (gnome-c-snippet--find-header-buffer)))
- (when header-buffer
- (with-current-buffer header-buffer
- (let ((region (gnome-c-snippet--find-declaration))
- names)
- (when region
- (setq names
- (apply #'gnome-c-snippet--extract-names-from-declaration
- region))
- (when names
- (pcase symbol
- (`package (car names))
- (`class (nth 1 names))
- (`parent-package (list (car (nth 2 names))))
- (`parent-class (cdr (nth 2 names))))))))))))
-
-(defun gnome-c-snippet--guess-name-from-file-name (symbol)
- (when (memq symbol '(package class))
- (let ((filename (file-name-sans-extension
- (file-name-nondirectory buffer-file-name))))
- (when (string-match-p "-" filename)
- (let ((names (split-string filename "-")))
- (pcase symbol
- (`package (list (upcase-initials (car names))))
- (`class (mapcar #'upcase-initials (cdr names)))))))))
-
-(defun gnome-c-snippet--parse-name (name)
- (with-temp-buffer
- (let (words)
- (insert (upcase-initials name))
- (goto-char (point-min))
- (while (not (eobp))
- ;; Skip characters not recognized by subword-mode.
- (if (looking-at "[^[:lower:][:upper:][:digit:]]+")
- (goto-char (match-end 0)))
- (push (buffer-substring (point) (progn (subword-forward 1)
- (point)))
- words))
- (nreverse words))))
-
-(defun gnome-c-snippet--read-name (prompt symbol &optional default)
- (when (or current-prefix-arg
- (not (symbol-value symbol)))
- (set symbol
- (gnome-c-snippet--parse-name
- (read-string prompt
- (or (if (symbol-value symbol)
- (gnome-c-snippet--format-Package
- (symbol-value symbol)))
- default)))))
- (symbol-value symbol))
-
-(defun gnome-c-snippet--read-package-and-class (parent)
- (append (list (gnome-c-snippet--read-name
- "Package (CamelCase): "
- 'gnome-c-snippet-package
- (gnome-c-snippet--format-Package
- (run-hook-with-args-until-success
- 'gnome-c-snippet-guess-name-functions
- 'package)))
- (gnome-c-snippet--read-name
- "Class (CamelCase): "
- 'gnome-c-snippet-class
- (gnome-c-snippet--format-Class
- (run-hook-with-args-until-success
- 'gnome-c-snippet-guess-name-functions
- 'class))))
- (when parent
- (list (gnome-c-snippet--read-name
- "Parent package (CamelCase): "
- 'gnome-c-snippet-parent-package
- (gnome-c-snippet--format-Package
- (run-hook-with-args-until-success
- 'gnome-c-snippet-guess-name-functions
- 'parent-package)))
- (gnome-c-snippet--read-name
- "Parent class (CamelCase): "
- 'gnome-c-snippet-parent-class
- (gnome-c-snippet--format-Class
- (run-hook-with-args-until-success
- 'gnome-c-snippet-guess-name-functions
- 'parent-class)))))))
-
-(defun gnome-c-snippet--read-package-and-interface (parent)
- (list (gnome-c-snippet--read-name
- "Package (CamelCase): "
- 'gnome-c-snippet-package
- (gnome-c-snippet--format-Package
- (run-hook-with-args-until-success
- 'gnome-c-snippet-guess-name-functions
- 'package)))
- (gnome-c-snippet--read-name
- "Interface (CamelCase): "
- 'gnome-c-snippet-class
- (gnome-c-snippet--format-Class
- (run-hook-with-args-until-success
- 'gnome-c-snippet-guess-name-functions
- 'class)))
- (when parent
- (list (gnome-c-snippet--read-name
- "Parent package (CamelCase): "
- 'gnome-c-snippet-parent-package
- (gnome-c-snippet--format-Package
- (run-hook-with-args-until-success
- 'gnome-c-snippet-guess-name-functions
- 'parent-package)))
- (gnome-c-snippet--read-name
- "Parent class (CamelCase): "
- 'gnome-c-snippet-parent-class
- (gnome-c-snippet--format-Class
- (run-hook-with-args-until-success
- 'gnome-c-snippet-guess-name-functions
- 'parent-class)))))))
-
-(defun gnome-c-snippet--format-PACKAGE (package)
- (mapconcat #'upcase package "_"))
-(defalias 'gnome-c-snippet--format-CLASS 'gnome-c-snippet--format-PACKAGE)
-
-(defun gnome-c-snippet--format-PACKAGE_CLASS (package class)
- (concat (gnome-c-snippet--format-PACKAGE package)
- "_"
- (gnome-c-snippet--format-CLASS class)))
-
-(defun gnome-c-snippet--format-package (package)
- (mapconcat #'downcase package "_"))
-(defalias 'gnome-c-snippet--format-class 'gnome-c-snippet--format-package)
-
-(defun gnome-c-snippet--format-package_class (package class)
- (concat (gnome-c-snippet--format-package package)
- "_"
- (gnome-c-snippet--format-class class)))
-
-(defun gnome-c-snippet--format-Package (package)
- (mapconcat #'identity package ""))
-(defalias 'gnome-c-snippet--format-Class 'gnome-c-snippet--format-Package)
-
-(defun gnome-c-snippet--format-PackageClass (package class)
- (concat (gnome-c-snippet--format-Package package)
- (gnome-c-snippet--format-Class class)))
-
-;;;###autoload
-(defun gnome-c-snippet-insert-package_class (package class)
- "Insert the class name before the current point."
- (interactive (gnome-c-snippet--read-package-and-class nil))
- (insert (gnome-c-snippet--format-package_class package class)))
-
-;;;###autoload
-(defun gnome-c-snippet-insert-PACKAGE_CLASS (package class)
- "Insert the class name before the current point."
- (interactive (gnome-c-snippet--read-package-and-class nil))
- (insert (gnome-c-snippet--format-PACKAGE_CLASS package class)))
-
-;;;###autoload
-(defun gnome-c-snippet-insert-PackageClass (package class)
- "Insert the class name (in CamelCase) before the current point."
- (interactive (gnome-c-snippet--read-package-and-class nil))
- (insert (gnome-c-snippet--format-PackageClass package class)))
-
-(defun gnome-c-snippet-insert-interface-declaration (package iface
- parent-package
parent-class)
- "Insert interface declaration for PACKAGE and IFACE"
- (interactive (gnome-c-snippet--read-package-and-interface t))
- (insert "\
-#define " (gnome-c-snippet--format-PACKAGE package) "_TYPE_"
(gnome-c-snippet--format-CLASS iface) " (" (gnome-c-snippet--format-package
package) "_" (gnome-c-snippet--format-class iface) "_get_type ())
-G_DECLARE_INTERFACE (" (gnome-c-snippet--format-PackageClass package iface) ",
"
-(gnome-c-snippet--format-package_class package iface) ", "
(gnome-c-snippet--format-PACKAGE package) ", " (gnome-c-snippet--format-CLASS
iface) ", " (gnome-c-snippet--format-PackageClass parent-package parent-class)
")
-"))
-
-(defun gnome-c-snippet--insert-class-declaration (package
- class
- parent-package
- parent-class
- derivable)
- (insert "\
-#define " (gnome-c-snippet--format-PACKAGE package) "_TYPE_"
(gnome-c-snippet--format-CLASS class) " ("
(gnome-c-snippet--format-package_class package class) "_get_type ())
-G_DECLARE_" (if derivable "DERIVABLE" "FINAL") "_TYPE ("
(gnome-c-snippet--format-PackageClass package class) ", "
-(gnome-c-snippet--format-package_class package class) ", "
(gnome-c-snippet--format-PACKAGE package) ", " (gnome-c-snippet--format-CLASS
class) ", " (gnome-c-snippet--format-PackageClass parent-package parent-class)
")
-"))
-
-(defun gnome-c-snippet-insert-final-class-declaration (package
- class
- parent-package
- parent-class)
- "Insert final class declaration for PACKAGE and CLASS."
- (interactive (gnome-c-snippet--read-package-and-class t))
- (gnome-c-snippet--insert-class-declaration package
- class
- parent-package
- parent-class
- nil))
-
-(defun gnome-c-snippet-insert-derivable-class-declaration (package
- class
- parent-package
- parent-class)
- "Insert derivable class declaration for PACKAGE and CLASS."
- (interactive (gnome-c-snippet--read-package-and-class t))
- (gnome-c-snippet--insert-class-declaration package
- class
- parent-package
- parent-class
- t))
-
-(defun gnome-c-snippet-insert-interface-definition (package
- iface
- parent-package
- parent-class)
- "Insert class definition for PACKAGE and CLASS."
- (interactive (gnome-c-snippet--read-package-and-interface t))
- (insert "\
-static void
-" (gnome-c-snippet--format-package_class package iface) "_default_init ("
(gnome-c-snippet--format-PackageClass package iface) "Interface *iface) {
-}
-
-G_DEFINE_INTERFACE (" (gnome-c-snippet--format-PackageClass package iface) ", "
-(gnome-c-snippet--format-package_class package iface) ", "
(gnome-c-snippet--format-PACKAGE parent-package) "_TYPE_"
(gnome-c-snippet--format-CLASS parent-class) ")
-"))
-
-(defun gnome-c-snippet--insert-class-definition (package
- class
- parent-package
- parent-class
- abstract
- code)
- (insert "\
-G_DEFINE_" (if abstract "ABSTRACT_" "") "TYPE" (if code "WITH_CODE" "") " ("
(gnome-c-snippet--format-PackageClass package class) ", "
-(gnome-c-snippet--format-package_class package class) ", "
(gnome-c-snippet--format-PACKAGE parent-package) "_TYPE_"
(gnome-c-snippet--format-CLASS parent-class) (if code ", " "") ")"))
-
-(defun gnome-c-snippet-insert-G_DEFINE_TYPE (package
- class
- parent-package
- parent-class)
- "Insert G_DEFINE_TYPE for PACKAGE and CLASS."
- (interactive (gnome-c-snippet--read-package-and-class t))
- (gnome-c-snippet--insert-class-definition package
- class
- parent-package
- parent-class
- nil
- nil))
-
-(defun gnome-c-snippet-insert-G_DEFINE_TYPE_WITH_CODE (package
- class
- parent-package
- parent-class)
- "Insert G_DEFINE_TYPE_WITH_CODE for PACKAGE and CLASS."
- (interactive (gnome-c-snippet--read-package-and-class t))
- (gnome-c-snippet--insert-class-definition package
- class
- parent-package
- parent-class
- nil
- t))
-
-(defun gnome-c-snippet-insert-G_DEFINE_ABSTRACT_TYPE (package
- class
- parent-package
- parent-class)
- "Insert G_DEFINE_ABSTRACT_TYPE for PACKAGE and CLASS."
- (interactive (gnome-c-snippet--read-package-and-class t))
- (gnome-c-snippet--insert-class-definition package
- class
- parent-package
- parent-class
- t
- nil))
-
-(defun gnome-c-snippet-insert-G_DEFINE_ABSTRACT_TYPE_WITH_CODE (package
- class
- parent-package
- parent-class)
- "Insert G_DEFINE_ABSTRACT_TYPE_WITH_CODE for PACKAGE and CLASS."
- (interactive (gnome-c-snippet--read-package-and-class t))
- (gnome-c-snippet--insert-class-definition package
- class
- parent-package
- parent-class
- t
- t))
-
-(defun gnome-c-snippet-insert-constructor (package class)
- "Insert `constructor' vfunc of GObjectClass for PACKAGE and CLASS."
- (interactive (gnome-c-snippet--read-package-and-class nil))
- (let (arglist-start body-start)
- (insert "\
-static GObject *
-" (gnome-c-snippet--format-package_class package class) "_constructor (")
- (setq arglist-start (point-marker))
- (insert "GType *object,
-guint n_construct_properties,
-GObjectConstructParam *construct_properties)\n")
- (setq body-start (point-marker))
- (if gnome-c-snippet-align-arglist
- (progn
- (goto-char arglist-start)
- (gnome-c-align-arglist-at-point))
- (indent-region arglist-start (point)))
- (goto-char body-start)
- (insert "{
- " (gnome-c-snippet--format-PackageClass package class) " *self = "
- (gnome-c-snippet--format-PACKAGE_CLASS package class) " (object);
-
- G_OBJECT_CLASS (" (gnome-c-snippet--format-package_class package class)
"_parent_class)->constructor (type, n_construct_properties,
construct_properties);
-}
-")
- (indent-region body-start (point))))
-
-(defun gnome-c-snippet-insert-set_property (package class)
- "Insert `set_property' vfunc of GObjectClass for PACKAGE and CLASS."
- (interactive (gnome-c-snippet--read-package-and-class nil))
- (let (arglist-start body-start)
- (insert "\
-static void
-" (gnome-c-snippet--format-package_class package class) "_set_property (")
- (setq arglist-start (point-marker))
- (insert "GObject *object,
-guint prop_id,
-const GValue *value,
-GParamSpec *pspec)\n")
- (setq body-start (point-marker))
- (if gnome-c-snippet-align-arglist
- (progn
- (goto-char arglist-start)
- (gnome-c-align-arglist-at-point))
- (indent-region arglist-start (point)))
- (goto-char body-start)
- (insert "{
- " (gnome-c-snippet--format-PackageClass package class) " *self = "
- (gnome-c-snippet--format-PACKAGE_CLASS package class) " (object);
-
- switch (prop_id)
- {
- default:
- G_OBJECT_WARN_INVALID_PROPERTY_ID (object, prop_id, pspec);
- break;
- }
-}
-")
- (indent-region body-start (point))))
-
-(defun gnome-c-snippet-insert-get_property (package class)
- "Insert `get_property' vfunc of GObjectClass for PACKAGE and CLASS."
- (interactive (gnome-c-snippet--read-package-and-class nil))
- (let (arglist-start body-start)
- (insert "\
-static void
-" (gnome-c-snippet--format-package_class package class) "_get_property (")
- (setq arglist-start (point-marker))
- (insert "GObject *object,
-guint prop_id,
-GValue *value,
-GParamSpec *pspec)\n")
- (setq body-start (point-marker))
- (if gnome-c-snippet-align-arglist
- (progn
- (goto-char arglist-start)
- (gnome-c-align-arglist-at-point))
- (indent-region arglist-start (point)))
- (goto-char body-start)
- (insert "{
- " (gnome-c-snippet--format-PackageClass package class) " *self = "
- (gnome-c-snippet--format-PACKAGE_CLASS package class) " (object);
-
- switch (prop_id)
- {
- default:
- G_OBJECT_WARN_INVALID_PROPERTY_ID (object, prop_id, pspec);
- break;
- }
-}
-")
- (indent-region body-start (point))))
-
-(defun gnome-c-snippet-insert-dispose (package class)
- "Insert `dispose' vfunc of GObjectClass for PACKAGE and CLASS."
- (interactive (gnome-c-snippet--read-package-and-class nil))
- (let (body-start)
- (insert "\
-static void
-" (gnome-c-snippet--format-package_class package class) "_dispose (GObject
*object)\n")
- (setq body-start (point-marker))
- (insert "{
- " (gnome-c-snippet--format-PackageClass package class) " *self = "
- (gnome-c-snippet--format-PACKAGE_CLASS package class) " (object);
-
- G_OBJECT_CLASS (" (gnome-c-snippet--format-package_class package class)
"_parent_class)->dispose (object);
-}
-")
- (indent-region body-start (point))))
-
-(defun gnome-c-snippet-insert-finalize (package class)
- "Insert `finalize' vfunc of GObjectClass for PACKAGE and CLASS."
- (interactive (gnome-c-snippet--read-package-and-class nil))
- (let (body-start)
- (insert "\
-static void
-" (gnome-c-snippet--format-package_class package class) "_finalize (GObject
*object)\n")
- (setq body-start (point-marker))
- (insert "{
- " (gnome-c-snippet--format-PackageClass package class) " *self = "
- (gnome-c-snippet--format-PACKAGE_CLASS package class) " (object);
-
- G_OBJECT_CLASS (" (gnome-c-snippet--format-package_class package class)
"_parent_class)->finalize (object);
-}
-")
- (indent-region body-start (point))))
-
-(defun gnome-c-snippet-insert-dispatch_properties_changed (package class)
- "Insert `dispatch_properties_changed' vfunc of GObjectClass for
-PACKAGE and CLASS."
- (interactive (gnome-c-snippet--read-package-and-class nil))
- (let (arglist-start body-start)
- (insert "\
-static void
-" (gnome-c-snippet--format-package_class package class)
"_dispatch_properties_changed (")
- (setq arglist-start (point-marker))
- (insert "GObject *object,
-guint n_pspecs,
-GParamSpec **pspecs)\n")
- (setq body-start (point-marker))
- (if gnome-c-snippet-align-arglist
- (progn
- (goto-char arglist-start)
- (gnome-c-align-arglist-at-point))
- (indent-region arglist-start (point)))
- (goto-char body-start)
- (insert "{
- " (gnome-c-snippet--format-PackageClass package class) " *self = "
- (gnome-c-snippet--format-PACKAGE_CLASS package class) " (object);
-
- G_OBJECT_CLASS (" (gnome-c-snippet--format-package_class package class)
"_parent_class)->dispatch_properties_changed (object, n_pspecs, pspecs);
-}
-")
- (indent-region body-start (point))))
-
-(defun gnome-c-snippet-insert-notify (package class)
- "Insert `notify' vfunc of GObjectClass for PACKAGE and CLASS."
- (interactive (gnome-c-snippet--read-package-and-class nil))
- (let (arglist-start body-start)
- (insert "\
-static void
-" (gnome-c-snippet--format-package_class package class) "_notify (")
- (setq arglist-start (point-marker))
- (insert "GObject *object,
-GParamSpec *pspec)\n")
- (setq body-start (point-marker))
- (if gnome-c-snippet-align-arglist
- (progn
- (goto-char arglist-start)
- (gnome-c-align-arglist-at-point))
- (indent-region arglist-start (point)))
- (insert "{
- " (gnome-c-snippet--format-PackageClass package class) " *self = "
- (gnome-c-snippet--format-PACKAGE_CLASS package class) " (object);
-
- G_OBJECT_CLASS (" (gnome-c-snippet--format-package_class package class)
"_parent_class)->notify (object, pspec);
-}
-")
- (indent-region body-start (point))))
-
-(defun gnome-c-snippet-insert-constructed (package class)
- "Insert `constructed' vfunc of GObjectClass for PACKAGE and CLASS."
- (interactive (gnome-c-snippet--read-package-and-class nil))
- (let (body-start)
- (insert "\
-static void
-" (gnome-c-snippet--format-package_class package class) "_constructed (GObject
*object)\n")
- (setq body-start (point-marker))
- (insert "{
- " (gnome-c-snippet--format-PackageClass package class) " *self = "
- (gnome-c-snippet--format-PACKAGE_CLASS package class) " (object);
-
- G_OBJECT_CLASS (" (gnome-c-snippet--format-package_class package class)
"_parent_class)->constructed (object);
-}
-")
- (indent-region body-start (point))))
-
-(defun gnome-c-snippet-insert-class-init (package class)
- "Insert `_class_init' function for PACKAGE and CLASS."
- (interactive (gnome-c-snippet--read-package-and-class nil))
- (insert "\
-static void
-" (gnome-c-snippet--format-package_class package class) "_class_init ("
(gnome-c-snippet--format-PackageClass package class) "Class *klass)\n")
- (insert "{
-}
-"))
-
-(defun gnome-c-snippet-insert-init (package class)
- "Insert `_init' function for PACKAGE and CLASS."
- (interactive (gnome-c-snippet--read-package-and-class nil))
- (insert "\
-static void
-" (gnome-c-snippet--format-package_class package class) "_init ("
(gnome-c-snippet--format-PackageClass package class) " *self)\n")
- (insert "{
-}
-"))
-
-(defvar gnome-c-snippet-snippet-commands
- '(("G_DECLARE_INTERFACE" . gnome-c-snippet-insert-interface-declaration)
- ("G_DECLARE_FINAL_TYPE" . gnome-c-snippet-insert-final-class-declaration)
- ("G_DECLARE_DERIVABLE_TYPE" .
- gnome-c-snippet-insert-derivable-class-declaration)
- ("G_DEFINE_INTERFACE" . gnome-c-snippet-insert-interface-definition)
- ("G_DEFINE_TYPE" . gnome-c-snippet-insert-G_DEFINE_TYPE)
- ("G_DEFINE_TYPE_WITH_CODE" .
gnome-c-snippet-insert-G_DEFINE_TYPE_WITH_CODE)
- ("G_DEFINE_ABSTRACT_TYPE" .
- gnome-c-snippet-insert-G_DEFINE_ABSTRACT_TYPE)
- ("G_DEFINE_ABSTRACT_TYPE_WITH_CODE" .
- gnome-c-snippet-insert-G_DEFINE_ABSTRACT_TYPE_WITH_CODE)
- ("GObjectClass.constructor" . gnome-c-snippet-insert-constructor)
- ("GObjectClass.set_property" . gnome-c-snippet-insert-set_property)
- ("GObjectClass.get_property" . gnome-c-snippet-insert-get_property)
- ("GObjectClass.dispose" . gnome-c-snippet-insert-dispose)
- ("GObjectClass.finalize" . gnome-c-snippet-insert-finalize)
- ("GObjectClass.dispatch_properties_changed" .
- gnome-c-snippet-insert-dispatch_properties_changed)
- ("GObjectClass.notify" . gnome-c-snippet-insert-notify)
- ("GObjectClass.constructed" . gnome-c-snippet-insert-constructed)
- ;; Will be overridden by `gnome-c-snippet-insert'.
- ("_class_init" . gnome-c-snippet-insert-class-init)
- ;; Will be overridden by `gnome-c-snippet-insert'.
- ("_init" . gnome-c-snippet-insert-init)))
-
-;;;###autoload
-(defun gnome-c-snippet-insert (command)
- (interactive
- (let ((commands (copy-tree gnome-c-snippet-snippet-commands)))
- (when (and gnome-c-snippet-package gnome-c-snippet-class)
- (setcar (assoc "_class_init" commands)
- (concat (gnome-c-snippet--format-package_class
- gnome-c-snippet-package gnome-c-snippet-class)
- "_class_init"))
- (setcar (assoc "_init" commands)
- (concat (gnome-c-snippet--format-package_class
- gnome-c-snippet-package gnome-c-snippet-class)
- "_init")))
- (let* ((name (completing-read "Snippet: " commands nil t))
- (entry (assoc name commands)))
- (unless entry
- (error "Unknown snippet: %s" name))
- (list (cdr entry)))))
- (call-interactively command))
-
-(provide 'gnome-c-snippet)
-
-;;; gnome-c-snippet.el ends here
diff --git a/packages/gnome-c-style/gnome-c-style.el
b/packages/gnome-c-style/gnome-c-style.el
deleted file mode 100644
index 66c6578..0000000
--- a/packages/gnome-c-style/gnome-c-style.el
+++ /dev/null
@@ -1,74 +0,0 @@
-;;; gnome-c-style.el --- minor mode for editing GNOME-style C source code -*-
lexical-binding: t; -*-
-;; Copyright (C) 2016 Free Software Foundation, Inc.
-
-;; Author: Daiki Ueno <ueno@gnu.org>
-;; Keywords: GNOME, C, coding style
-;; Version: 0.1
-;; Maintainer: Daiki Ueno <ueno@gnu.org>
-
-;; 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 <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This package provides a minor mode to help editing C source code
-;; in the GNOME C coding style:
-;;
-;;
<https://developer.gnome.org/programming-guidelines/stable/c-coding-style.html.en#header-files>
-;;
<https://developer.gnome.org/programming-guidelines/stable/c-coding-style.html.en#functions>
-;;
-;; It basically provides two functions: code alignment and snippet
-;; insertion. To align code, use `gnome-c-style-align-decls-region'
-;; to line-up multiple function declarations in region, and
-;; `gnome-c-style-align-arglist-at-point' to line-up arguments in the
-;; argument list at point.
-;;
-;; To insert code snippet, use `gnome-c-snippet-insert'. The command
-;; will let you choose a template to be inserted. This package also
-;; provide commands to insert package/class names in upper case,
-;; capital case, and lower case. For complete list of commands, do
-;; M-x describe-bindings.
-
-;;; Code:
-
-(require 'gnome-c-align)
-(require 'gnome-c-snippet)
-
-(defgroup gnome-c-style nil
- "GNOME-style C source code editing"
- :prefix "gnome-c-"
- :group 'c)
-
-(defvar gnome-c-style-mode-map
- (let ((keymap (make-sparse-keymap)))
- (define-key keymap "\C-c\C-ga" 'gnome-c-align-arglist-at-point)
- (define-key keymap "\C-c\C-gr" 'gnome-c-align-decls-region)
- (define-key keymap "\C-c\C-gf" 'gnome-c-align-set-column)
- (define-key keymap "\C-c\C-gg" 'gnome-c-align-guess-columns)
- (define-key keymap "\C-c\C-g\C-g" 'gnome-c-align-guess-optimal-columns)
- (define-key keymap "\C-c\C-gc" 'gnome-c-snippet-insert-package_class)
- (define-key keymap "\C-c\C-gC" 'gnome-c-snippet-insert-PACKAGE_CLASS)
- (define-key keymap "\C-c\C-g\C-c" 'gnome-c-snippet-insert-PackageClass)
- (define-key keymap "\C-c\C-gs" 'gnome-c-snippet-insert)
- keymap))
-
-;;;###autoload
-(define-minor-mode gnome-c-style-mode
- "A minor-mode for editing GNOME-style C source code."
- nil " GNOME" gnome-c-style-mode-map)
-
-(provide 'gnome-c-style)
-
-;;; gnome-c-style.el ends here
diff --git a/packages/gnome-c-style/gnome-c-tests.el
b/packages/gnome-c-style/gnome-c-tests.el
deleted file mode 100644
index 17dbfe1..0000000
--- a/packages/gnome-c-style/gnome-c-tests.el
+++ /dev/null
@@ -1,284 +0,0 @@
-;;; gnome-c-tests.el --- tests for gnome-c-style -*- lexical-binding: t; -*-
-;; Copyright (C) 2016 Free Software Foundation, Inc.
-
-;; Author: Daiki Ueno <ueno@gnu.org>
-;; Keywords: GNOME, C, coding style
-
-;; 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 <http://www.gnu.org/licenses/>.
-
-;;; Code:
-
-(require 'gnome-c-align)
-(require 'gnome-c-snippet)
-
-(defconst gnome-c-test-program-1 "\
-GGpgCtx *g_gpg_ctx_new (GError **error);
-
-typedef void (*GGpgProgressCallback) (gpointer user_data,
- const gchar *what,
- gint type,
- gint current,
- gint total);
-
-void g_gpg_ctx_set_progress_callback (GGpgCtx *ctx,
- GGpgProgressCallback callback,
- gpointer user_data,
- GDestroyNotify destroy_data);
-void g_gpg_ctx_add_signer (GGpgCtx *ctx, GGpgKey *key);
-guint g_gpg_ctx_get_n_signers (GGpgCtx *ctx);
-GGpgKey *g_gpg_ctx_get_signer (GGpgCtx *ctx, guint index);
-void g_gpg_ctx_clear_signers (GGpgCtx *ctx);
-")
-
-(defconst gnome-c-test-program-1-aligned "\
-GGpgCtx *g_gpg_ctx_new (GError **error);
-
-typedef void (*GGpgProgressCallback) (gpointer user_data,
- const gchar *what,
- gint type,
- gint current,
- gint total);
-
-void g_gpg_ctx_set_progress_callback (GGpgCtx *ctx,
- GGpgProgressCallback callback,
- gpointer user_data,
- GDestroyNotify destroy_data);
-void g_gpg_ctx_add_signer (GGpgCtx *ctx,
- GGpgKey *key);
-guint g_gpg_ctx_get_n_signers (GGpgCtx *ctx);
-GGpgKey *g_gpg_ctx_get_signer (GGpgCtx *ctx,
- guint index);
-void g_gpg_ctx_clear_signers (GGpgCtx *ctx);
-")
-
-(defconst gnome-c-test-program-2 "\
-GDK_AVAILABLE_IN_3_16
-const gchar ** gtk_widget_list_action_prefixes (GtkWidget
*widget);
-")
-
-(defconst gnome-c-test-program-3 "\
- /* overridable methods */
- void (*set_property) (GObject *object,
- guint property_id,
- const GValue *value,
- GParamSpec *pspec);
- void (*get_property) (GObject *object,
- guint property_id,
- GValue *value,
- GParamSpec *pspec);
-")
-
-(defconst gnome-c-test-program-4 "\
-FOO_AVAILABLE_IN_ALL
-int foo (struct foo ***a, int b, ...) G_GNUC_CONST;
-")
-
-(defconst gnome-c-test-program-4-aligned "\
-FOO_AVAILABLE_IN_ALL
-int foo (struct foo ***a,
- int b,
- ...) G_GNUC_CONST;
-")
-
-(defconst gnome-c-test-program-5 "\
-int * bar (const char * const * * a, int b);
-")
-
-(defconst gnome-c-test-program-5-aligned "\
-int *bar (const char * const **a,
- int b);
-")
-
-(defconst gnome-c-test-program-6 "\
-int foo (char **a, int b);
-type_1234567890 bar (char a, int b);
-int identifier_1234567890 (double a, double b);
-")
-
-(defconst gnome-c-test-program-6-aligned-1 "\
-int foo
- (char **a,
- int b);
-type_1234567890 bar
- (char a,
- int b);
-int identifier_1234567890
- (double a,
- double b);
-")
-
-(defconst gnome-c-test-program-6-aligned-2 "\
-int foo (char **a,
- int b);
-type_1234567890 bar (char a,
- int b);
-int identifier_1234567890
- (double a,
- double b);
-")
-
-(defconst gnome-c-test-program-7 "\
-G_DECLARE_FINAL_TYPE (GGpgEngineInfo, g_gpg_engine_info, G_GPG, ENGINE_INFO,
- GObject)
-")
-
-(ert-deftest gnome-c-test-align--guess-optimal-columns ()
- "Tests the `gnome-c-align--guess-optimal-columns'."
- (with-temp-buffer
- (insert gnome-c-test-program-1)
- (c-mode)
- (let* (gnome-c-align-max-column
- (columns
- (gnome-c-align--guess-optimal-columns (point-min) (point-max))))
- (should (= (cdr (assq 'identifier-start-column columns)) 9))
- (should (= (cdr (assq 'arglist-start-column columns)) 41))
- (should (= (cdr (assq 'arglist-identifier-start-column columns)) 64)))))
-
-(ert-deftest gnome-c-test-align-region ()
- "Tests the `gnome-c-align-decls-region'."
- (with-temp-buffer
- (insert gnome-c-test-program-1)
- (c-mode)
- (let (gnome-c-align-max-column)
- (gnome-c-align-guess-optimal-columns (point-min) (point-max))
- (gnome-c-align-decls-region (point-min) (point-max)))
- (should (equal (buffer-string) gnome-c-test-program-1-aligned))))
-
-(ert-deftest gnome-c-test-align-region-2 ()
- "Tests the `gnome-c-align-decls-region'."
- (with-temp-buffer
- (insert gnome-c-test-program-4)
- (c-mode)
- (let (gnome-c-align-max-column)
- (gnome-c-align-guess-optimal-columns (point-min) (point-max))
- (gnome-c-align-decls-region (point-min) (point-max)))
- (should (equal (buffer-string) gnome-c-test-program-4-aligned))))
-
-(ert-deftest gnome-c-test-align-region-3 ()
- "Tests the `gnome-c-align-decls-region'."
- (with-temp-buffer
- (insert gnome-c-test-program-5)
- (c-mode)
- (let (gnome-c-align-max-column)
- (gnome-c-align-guess-optimal-columns (point-min) (point-max))
- (gnome-c-align-decls-region (point-min) (point-max)))
- (should (equal (buffer-string) gnome-c-test-program-5-aligned))))
-
-(ert-deftest gnome-c-test-align-region-4 ()
- "Tests the `gnome-c-align-decls-region', with max columns set."
- (with-temp-buffer
- (insert gnome-c-test-program-6)
- (c-mode)
- (let ((gnome-c-align-max-column 20))
- (gnome-c-align-guess-optimal-columns (point-min) (point-max))
- (gnome-c-align-decls-region (point-min) (point-max)))
- (should (equal (buffer-string) gnome-c-test-program-6-aligned-1))))
-
-(ert-deftest gnome-c-test-align-region-5 ()
- "Tests the `gnome-c-align-decls-region', with max columns set."
- (with-temp-buffer
- (insert gnome-c-test-program-6)
- (c-mode)
- (let ((gnome-c-align-max-column 30))
- (gnome-c-align-guess-optimal-columns (point-min) (point-max))
- (gnome-c-align-decls-region (point-min) (point-max)))
- (should (equal (buffer-string) gnome-c-test-program-6-aligned-2))))
-
-(ert-deftest gnome-c-test-align-guess-columns-1 ()
- "Tests the `gnome-c-align-guess-columns'."
- (with-temp-buffer
- (insert gnome-c-test-program-2)
- (c-mode)
- (let (gnome-c-align-max-column)
- (gnome-c-align-guess-columns (point-min) (point-max)))
- (should (= gnome-c-align-identifier-start-column 24))
- (should (= gnome-c-align-arglist-start-column 56))
- (should (= gnome-c-align-arglist-identifier-start-column 80))))
-
-(ert-deftest gnome-c-test-align-guess-columns-2 ()
- "Tests the `gnome-c-align-guess-columns'."
- (with-temp-buffer
- (insert gnome-c-test-program-3)
- (c-mode)
- (let (gnome-c-align-max-column)
- (gnome-c-align-guess-columns (point-min) (point-max)))
- (should (= gnome-c-align-identifier-start-column 13))
- (should (= gnome-c-align-arglist-start-column 40))
- (should (= gnome-c-align-arglist-identifier-start-column 57))))
-
-(ert-deftest gnome-c-test-snippet-guess-name-from-declaration ()
- "Tests the `gnome-c-snippet--guess-name-from-declaration'."
- (with-temp-buffer
- (insert gnome-c-test-program-7)
- (c-mode)
- (setq buffer-file-name "gpgme-glib.h")
- (let ((package (gnome-c-snippet--guess-name-from-declaration 'package))
- (class (gnome-c-snippet--guess-name-from-declaration 'class))
- (parent-package
- (gnome-c-snippet--guess-name-from-declaration 'parent-package))
- (parent-class
- (gnome-c-snippet--guess-name-from-declaration 'parent-class)))
- (should (equal package '("G" "Gpg")))
- (should (equal class '("Engine" "Info")))
- (should (equal parent-package '("G")))
- (should (equal parent-class '("Object"))))))
-
-(ert-deftest gnome-c-test-snippet-guess-name-from-declaration-2 ()
- "Tests the `gnome-c-snippet--guess-name-from-declaration'."
- (let (buffer)
- (unwind-protect
- (progn
- (setq buffer (generate-new-buffer "header"))
- (with-current-buffer buffer
- (insert gnome-c-test-program-7)
- (c-mode)
- (setq buffer-file-name "gpgme-glib.h"))
- (with-temp-buffer
- (c-mode)
- (setq buffer-file-name "gpgme-glib.c")
- (let ((package
- (gnome-c-snippet--guess-name-from-declaration 'package))
- (class
- (gnome-c-snippet--guess-name-from-declaration 'class))
- (parent-package
- (gnome-c-snippet--guess-name-from-declaration
- 'parent-package))
- (parent-class
- (gnome-c-snippet--guess-name-from-declaration
- 'parent-class)))
- (should (equal package '("G" "Gpg")))
- (should (equal class '("Engine" "Info")))
- (should (equal parent-package '("G")))
- (should (equal parent-class '("Object"))))))
- (kill-buffer buffer))))
-
-(ert-deftest gnome-c-test-snippet-guess-name-from-file-name ()
- "Tests the `gnome-c-snippet--guess-name-from-file-name'"
- (with-temp-buffer
- (c-mode)
- (setq buffer-file-name "g-gpg-engine-info.c")
- (let ((package
- (gnome-c-snippet--guess-name-from-file-name 'package))
- (class
- (gnome-c-snippet--guess-name-from-file-name 'class))
- (parent-package
- (gnome-c-snippet--guess-name-from-file-name 'parent-package))
- (parent-class
- (gnome-c-snippet--guess-name-from-file-name 'parent-class)))
- (should (equal package '("G")))
- (should (equal class '("Gpg" "Engine" "Info")))
- (should (equal parent-package nil))
- (should (equal parent-class nil)))))
diff --git a/packages/highlight-escape-sequences/README.md
b/packages/highlight-escape-sequences/README.md
deleted file mode 100644
index cd91176..0000000
--- a/packages/highlight-escape-sequences/README.md
+++ /dev/null
@@ -1,15 +0,0 @@
-Highlight Escape Sequences
-----
-
-
-
-Look inside for instructions.
-
-The theme on the screenshot is
-[espresso](https://github.com/dgutov/espresso-theme), with the
-following addition:
-
-```
-(put 'hes-escape-backslash-face 'face-alias 'font-lock-builtin-face)
-(put 'hes-escape-sequence-face 'face-alias 'font-lock-builtin-face)
-```
diff --git a/packages/highlight-escape-sequences/highlight-escape-sequences.el
b/packages/highlight-escape-sequences/highlight-escape-sequences.el
deleted file mode 100644
index 0ee2991..0000000
--- a/packages/highlight-escape-sequences/highlight-escape-sequences.el
+++ /dev/null
@@ -1,252 +0,0 @@
-;;; highlight-escape-sequences.el --- Highlight escape sequences -*-
lexical-binding: t -*-
-
-;; Copyright (C) 2013, 2015-2017 Free Software Foundation, Inc.
-
-;; Author: Dmitry Gutov <dgutov@yandex.ru>
-;; Pavel Matcula <dev.plvlml@gmail.com>
-;; URL: https://github.com/dgutov/highlight-escape-sequences
-;; Keywords: convenience
-;; Version: 0.4
-
-;; This file is 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 of the License, 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This global minor mode highlights escape sequences in strings and
-;; other kinds of literals with `hes-escape-sequence-face' and with
-;; `hes-escape-backslash-face'. They inherit from faces
-;; `font-lock-regexp-grouping-construct' and
-;; `font-lock-regexp-grouping-backslash' by default, respectively.
-
-;; It currently supports `ruby-mode', `emacs-lisp-mode', JS escape
-;; sequences in both popular modes, C escapes is `c-mode', `c++-mode',
-;; `objc-mode' and `go-mode',
-;; and Java escapes in `java-mode' and `clojure-mode'.
-
-;; To enable it elsewhere, customize `hes-mode-alist'.
-
-;; Put this in the init file:
-;;
-;; (hes-mode)
-
-;;; Code:
-
-(defgroup hes-mode nil
- "Highlight escape sequences."
- :group 'convenience)
-
-(defface hes-escape-backslash-face
- '((default :inherit font-lock-regexp-grouping-backslash))
- "Face to highlight an escape backslash.")
-
-(defface hes-escape-sequence-face
- '((default :inherit font-lock-regexp-grouping-construct))
- "Face to highlight an escape sequence.")
-
-(defconst hes-common-escape-sequence-re
- (rx (submatch
- (and ?\\ (submatch
- (or (repeat 1 3 (in "0-7"))
- (and ?x (repeat 2 xdigit))
- (and ?u (repeat 4 xdigit))
- (any "\"\'\\bfnrtv"))))))
- "Regexp to match the most common escape sequences.
-
-Currently handles:
-- octals (\\0 to \\777),
-- hexadecimals (\\x00 to \\xFF),
-- unicodes (\\u0000 to \\uFFFF),
-- and backslash followed by one of \"\'\\bfnrtv.")
-
-(defconst hes-c/c++/objc-escape-sequence-re
- (rx (submatch
- (and ?\\ (submatch
- (or (repeat 1 3 (in "0-7"))
- (and ?x (1+ xdigit))
- (and ?u (repeat 4 xdigit))
- (and ?U (repeat 8 xdigit))
- (any "\"\'\?\\abfnrtv"))))))
- "Regexp to match C/C++/ObjC escape sequences.
-
-Currently handles:
-- octals (\\0 to \\777),
-- hexadecimals (\\x0 to \\xF..),
-- unicodes (\\u0000 to \\uFFFF, \\U00000000 to \\UFFFFFFFF),
-- and backslash followed by one of \"\'\?\\abfnrtv.")
-
-(defconst hes-java-escape-sequence-re
- (rx (submatch
- (and ?\\ (submatch
- (or (repeat 1 3 (in "0-7"))
- (and ?u (repeat 4 xdigit))
- (any "\"\'\\bfnrt"))))))
- "Regexp to match Java escape sequences.
-
-Currently handles:
-- octals (\\0 to \\777),
-- unicodes (\\u0000 to \\uFFFF),
-- and backslash followed by one of \"\'\\bfnrt.")
-
-(defconst hes-js-escape-sequence-re
- (rx (submatch
- (and ?\\ (submatch
- (or (repeat 1 3 (in "0-7"))
- (and ?x (repeat 2 xdigit))
- (and ?u (repeat 4 xdigit))
- ;; (any "\"\'\\bfnrtv")
- not-newline))))) ;; deprecated
- "Regexp to match JavaScript escape sequences.
-
-Currently handles:
-- octals (\\0 to \\777),
-- hexadecimals (\\x00 to \\xFF),
-- unicodes (\\u0000 to \\uFFFF),
-- and backslash followed by anything else.")
-
-(defconst hes-ruby-escape-sequence-re
- (rx (submatch
- (and ?\\ (submatch
- (or (repeat 1 3 (in "0-7"))
- (and ?x (repeat 1 2 xdigit))
- (and ?u
- (or (repeat 4 xdigit)
- (and ?{
- (repeat 1 6 xdigit)
- (0+ (1+ space)
- (repeat 1 6 xdigit))
- ?})))
- not-newline)))))
- "Regexp to match Ruby escape sequences.
-
-Currently handles:
-- octals (\\0 to \\777),
-- hexadecimals (\\x0 to \\xFF),
-- unicodes (\\u0000 to \\uFFFF),
-- unicodes in the \\u{} form,
-- and backslash followed by anything else.
-
-Currently doesn't handle \\C-, \\M-, etc.")
-
-(defconst hes-ruby-escape-sequence-keywords
- `((,hes-ruby-escape-sequence-re
- (0 (let* ((state (syntax-ppss))
- (term (nth 3 state)))
- (when (or (and (eq term ?')
- (member (match-string 2) '("\\" "'")))
- (if (fboundp 'ruby-syntax-expansion-allowed-p)
- (ruby-syntax-expansion-allowed-p state)
- (memq term '(?\" ?/ ?\n ?` t))))
- ;; TODO: Switch to `add-face-text-property' when we're
- ;; fine with only supporting Emacs 24.4 and up.
- (font-lock-prepend-text-property (match-beginning 1) (match-end 1)
- 'face 'hes-escape-backslash-face)
- (font-lock-prepend-text-property (match-beginning 2) (match-end 2)
- 'face 'hes-escape-sequence-face)
- nil))
- prepend))))
-
-(defconst hes-elisp-escape-sequence-re
- (rx (submatch
- (and ?\\ (submatch
- (or
- (and ?u (repeat 4 xdigit))
- (and ?U ?0 ?0 (repeat 6 xdigit))
- (and ?x (+ xdigit)) ;; variable number hex digits
- (+ (in "0-7")) ;; variable number octal digits
- not-newline)))))
-
- "Regexp to match Emacs Lisp escape sequences.
-
-Currently handles:
-- unicodes (\\uNNNN and \\U00NNNNNN)
-- hexadecimal (\\x...) and octal (\\0-7), variable number of digits
-- backslash followed by anything else.")
-
-(defun hes-make-simple-escape-sequence-keywords(re)
- `((,re
- (1 (when (nth 3 (syntax-ppss))
- 'hes-escape-backslash-face)
- prepend)
- (2 (when (nth 3 (syntax-ppss))
- 'hes-escape-sequence-face)
- prepend))))
-
-(defcustom hes-mode-alist
- `((c-mode . ,hes-c/c++/objc-escape-sequence-re)
- (c++-mode . ,hes-c/c++/objc-escape-sequence-re)
- (objc-mode . ,hes-c/c++/objc-escape-sequence-re)
- (go-mode . ,hes-c/c++/objc-escape-sequence-re)
- (java-mode . ,hes-java-escape-sequence-re)
- (clojure-mode . ,hes-java-escape-sequence-re)
- (js-mode . ,hes-js-escape-sequence-re)
- (js2-mode . ,hes-js-escape-sequence-re)
- (ruby-mode . ,hes-ruby-escape-sequence-keywords)
- (emacs-lisp-mode . ,hes-elisp-escape-sequence-re))
- "Alist of regexps or `font-lock-keywords' elements for major modes."
- :type '(repeat function)
- :set (lambda (symbol value)
- (if (bound-and-true-p hes-mode)
- (progn
- (hes-mode -1)
- (set-default symbol value)
- (hes-mode 1))
- (set-default symbol value))))
-
-;;;###autoload
-(defun turn-on-hes-mode()
- "Turn on highlighting of escape sequences."
- (interactive)
- (dolist (mode hes-mode-alist)
- (if (atom mode)
- (font-lock-add-keywords
- mode
- (hes-make-simple-escape-sequence-keywords
hes-common-escape-sequence-re)
- 'append)
- (when (stringp (cdr mode))
- (font-lock-add-keywords
- (car mode)
- (hes-make-simple-escape-sequence-keywords (cdr mode))
- 'append))
- (when (listp (cdr mode))
- (font-lock-add-keywords (car mode) (cdr mode) 'append)))))
-
-;;;###autoload
-(defun turn-off-hes-mode()
- "Turn off highlighting of escape sequences"
- (interactive)
- (dolist (mode hes-mode-alist)
- (if (atom mode)
- (font-lock-remove-keywords
- mode
- (hes-make-simple-escape-sequence-keywords
hes-common-escape-sequence-re))
- (when (stringp (cdr mode))
- (font-lock-remove-keywords
- (car mode)
- (hes-make-simple-escape-sequence-keywords (cdr mode))))
- (when (listp (cdr mode))
- (font-lock-remove-keywords (car mode) (cdr mode))))))
-
-;;;###autoload
-(define-minor-mode hes-mode
- "Toggle highlighting of escape sequences."
- :lighter "" :global t
- (if hes-mode
- (turn-on-hes-mode)
- (turn-off-hes-mode)))
-
-(provide 'highlight-escape-sequences)
-
-;;; highlight-escape-sequences.el ends here
diff --git a/packages/highlight-escape-sequences/highlight-escape-sequences.png
b/packages/highlight-escape-sequences/highlight-escape-sequences.png
deleted file mode 100644
index 6f0f1de..0000000
Binary files
a/packages/highlight-escape-sequences/highlight-escape-sequences.png and
/dev/null differ
diff --git a/packages/nameless/LICENSE b/packages/nameless/LICENSE
deleted file mode 100644
index 8cdb845..0000000
--- a/packages/nameless/LICENSE
+++ /dev/null
@@ -1,340 +0,0 @@
- GNU GENERAL PUBLIC LICENSE
- Version 2, June 1991
-
- Copyright (C) 1989, 1991 Free Software Foundation, Inc., <http://fsf.org/>
- 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
- Everyone is permitted to copy and distribute verbatim copies
- of this license document, but changing it is not allowed.
-
- Preamble
-
- The licenses for most software are designed to take away your
-freedom to share and change it. By contrast, the GNU General Public
-License is intended to guarantee your freedom to share and change free
-software--to make sure the software is free for all its users. This
-General Public License applies to most of the Free Software
-Foundation's software and to any other program whose authors commit to
-using it. (Some other Free Software Foundation software is covered by
-the GNU Lesser General Public License instead.) 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
-this service 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 make restrictions that forbid
-anyone to deny you these rights or to ask you to surrender the rights.
-These restrictions translate to certain responsibilities for you if you
-distribute copies of the software, or if you modify it.
-
- For example, if you distribute copies of such a program, whether
-gratis or for a fee, you must give the recipients all the rights that
-you have. 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.
-
- We protect your rights with two steps: (1) copyright the software, and
-(2) offer you this license which gives you legal permission to copy,
-distribute and/or modify the software.
-
- Also, for each author's protection and ours, we want to make certain
-that everyone understands that there is no warranty for this free
-software. If the software is modified by someone else and passed on, we
-want its recipients to know that what they have is not the original, so
-that any problems introduced by others will not reflect on the original
-authors' reputations.
-
- Finally, any free program is threatened constantly by software
-patents. We wish to avoid the danger that redistributors of a free
-program will individually obtain patent licenses, in effect making the
-program proprietary. To prevent this, we have made it clear that any
-patent must be licensed for everyone's free use or not licensed at all.
-
- The precise terms and conditions for copying, distribution and
-modification follow.
-
- GNU GENERAL PUBLIC LICENSE
- TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
-
- 0. This License applies to any program or other work which contains
-a notice placed by the copyright holder saying it may be distributed
-under the terms of this General Public License. The "Program", below,
-refers to any such program or work, and a "work based on the Program"
-means either the Program or any derivative work under copyright law:
-that is to say, a work containing the Program or a portion of it,
-either verbatim or with modifications and/or translated into another
-language. (Hereinafter, translation is included without limitation in
-the term "modification".) Each licensee is addressed as "you".
-
-Activities other than copying, distribution and modification are not
-covered by this License; they are outside its scope. The act of
-running the Program is not restricted, and the output from the Program
-is covered only if its contents constitute a work based on the
-Program (independent of having been made by running the Program).
-Whether that is true depends on what the Program does.
-
- 1. You may copy and distribute 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 and disclaimer of warranty; keep intact all the
-notices that refer to this License and to the absence of any warranty;
-and give any other recipients of the Program a copy of this License
-along with the Program.
-
-You may charge a fee for the physical act of transferring a copy, and
-you may at your option offer warranty protection in exchange for a fee.
-
- 2. You may modify your copy or copies of the Program or any portion
-of it, thus forming a work based on the Program, and copy and
-distribute such modifications or work under the terms of Section 1
-above, provided that you also meet all of these conditions:
-
- a) You must cause the modified files to carry prominent notices
- stating that you changed the files and the date of any change.
-
- b) You must cause any work that you distribute or publish, that in
- whole or in part contains or is derived from the Program or any
- part thereof, to be licensed as a whole at no charge to all third
- parties under the terms of this License.
-
- c) If the modified program normally reads commands interactively
- when run, you must cause it, when started running for such
- interactive use in the most ordinary way, to print or display an
- announcement including an appropriate copyright notice and a
- notice that there is no warranty (or else, saying that you provide
- a warranty) and that users may redistribute the program under
- these conditions, and telling the user how to view a copy of this
- License. (Exception: if the Program itself is interactive but
- does not normally print such an announcement, your work based on
- the Program is not required to print an announcement.)
-
-These requirements apply to the modified work as a whole. If
-identifiable sections of that work are not derived from the Program,
-and can be reasonably considered independent and separate works in
-themselves, then this License, and its terms, do not apply to those
-sections when you distribute them as separate works. But when you
-distribute the same sections as part of a whole which is a work based
-on the Program, the distribution of the whole must be on the terms of
-this License, whose permissions for other licensees extend to the
-entire whole, and thus to each and every part regardless of who wrote it.
-
-Thus, it is not the intent of this section to claim rights or contest
-your rights to work written entirely by you; rather, the intent is to
-exercise the right to control the distribution of derivative or
-collective works based on the Program.
-
-In addition, mere aggregation of another work not based on the Program
-with the Program (or with a work based on the Program) on a volume of
-a storage or distribution medium does not bring the other work under
-the scope of this License.
-
- 3. You may copy and distribute the Program (or a work based on it,
-under Section 2) in object code or executable form under the terms of
-Sections 1 and 2 above provided that you also do one of the following:
-
- a) Accompany it with the complete corresponding machine-readable
- source code, which must be distributed under the terms of Sections
- 1 and 2 above on a medium customarily used for software interchange; or,
-
- b) Accompany it with a written offer, valid for at least three
- years, to give any third party, for a charge no more than your
- cost of physically performing source distribution, a complete
- machine-readable copy of the corresponding source code, to be
- distributed under the terms of Sections 1 and 2 above on a medium
- customarily used for software interchange; or,
-
- c) Accompany it with the information you received as to the offer
- to distribute corresponding source code. (This alternative is
- allowed only for noncommercial distribution and only if you
- received the program in object code or executable form with such
- an offer, in accord with Subsection b above.)
-
-The source code for a work means the preferred form of the work for
-making modifications to it. For an executable work, complete source
-code means all the source code for all modules it contains, plus any
-associated interface definition files, plus the scripts used to
-control compilation and installation of the executable. However, as a
-special exception, the source code distributed need not include
-anything that is normally distributed (in either source or binary
-form) with the major components (compiler, kernel, and so on) of the
-operating system on which the executable runs, unless that component
-itself accompanies the executable.
-
-If distribution of executable or object code is made by offering
-access to copy from a designated place, then offering equivalent
-access to copy the source code from the same place counts as
-distribution of the source code, even though third parties are not
-compelled to copy the source along with the object code.
-
- 4. You may not copy, modify, sublicense, or distribute the Program
-except as expressly provided under this License. Any attempt
-otherwise to copy, modify, sublicense or distribute the Program is
-void, and will automatically terminate your rights under this License.
-However, parties who have received copies, or rights, from you under
-this License will not have their licenses terminated so long as such
-parties remain in full compliance.
-
- 5. You are not required to accept this License, since you have not
-signed it. However, nothing else grants you permission to modify or
-distribute the Program or its derivative works. These actions are
-prohibited by law if you do not accept this License. Therefore, by
-modifying or distributing the Program (or any work based on the
-Program), you indicate your acceptance of this License to do so, and
-all its terms and conditions for copying, distributing or modifying
-the Program or works based on it.
-
- 6. Each time you redistribute the Program (or any work based on the
-Program), the recipient automatically receives a license from the
-original licensor to copy, distribute or modify the Program subject to
-these terms and conditions. You may not impose any further
-restrictions on the recipients' exercise of the rights granted herein.
-You are not responsible for enforcing compliance by third parties to
-this License.
-
- 7. If, as a consequence of a court judgment or allegation of patent
-infringement or for any other reason (not limited to patent issues),
-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
-distribute so as to satisfy simultaneously your obligations under this
-License and any other pertinent obligations, then as a consequence you
-may not distribute the Program at all. For example, if a patent
-license would not permit royalty-free redistribution of the Program by
-all those who receive copies directly or indirectly through you, then
-the only way you could satisfy both it and this License would be to
-refrain entirely from distribution of the Program.
-
-If any portion of this section is held invalid or unenforceable under
-any particular circumstance, the balance of the section is intended to
-apply and the section as a whole is intended to apply in other
-circumstances.
-
-It is not the purpose of this section to induce you to infringe any
-patents or other property right claims or to contest validity of any
-such claims; this section has the sole purpose of protecting the
-integrity of the free software distribution system, which is
-implemented by public license practices. Many people have made
-generous contributions to the wide range of software distributed
-through that system in reliance on consistent application of that
-system; it is up to the author/donor to decide if he or she is willing
-to distribute software through any other system and a licensee cannot
-impose that choice.
-
-This section is intended to make thoroughly clear what is believed to
-be a consequence of the rest of this License.
-
- 8. If the distribution and/or use of the Program is restricted in
-certain countries either by patents or by copyrighted interfaces, the
-original copyright holder who places the Program under this License
-may add an explicit geographical distribution limitation excluding
-those countries, so that distribution is permitted only in or among
-countries not thus excluded. In such case, this License incorporates
-the limitation as if written in the body of this License.
-
- 9. The Free Software Foundation may publish revised and/or new versions
-of the 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 a version number of this License which applies to it and "any
-later version", you have the option of following the terms and conditions
-either of that version or of any later version published by the Free
-Software Foundation. If the Program does not specify a version number of
-this License, you may choose any version ever published by the Free Software
-Foundation.
-
- 10. If you wish to incorporate parts of the Program into other free
-programs whose distribution conditions are different, write to the author
-to ask for permission. For software which is copyrighted by the Free
-Software Foundation, write to the Free Software Foundation; we sometimes
-make exceptions for this. Our decision will be guided by the two goals
-of preserving the free status of all derivatives of our free software and
-of promoting the sharing and reuse of software generally.
-
- NO WARRANTY
-
- 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, 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.
-
- 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
-WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
-REDISTRIBUTE 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.
-
- 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
-convey the exclusion of warranty; and each file should have at least
-the "copyright" line and a pointer to where the full notice is found.
-
- {description}
- Copyright (C) {year} {fullname}
-
- 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.
-
-Also add information on how to contact you by electronic and paper mail.
-
-If the program is interactive, make it output a short notice like this
-when it starts in an interactive mode:
-
- Gnomovision version 69, Copyright (C) year name of author
- Gnomovision 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, the commands you use may
-be called something other than `show w' and `show c'; they could even be
-mouse-clicks or menu items--whatever suits your program.
-
-You should also get your employer (if you work as a programmer) or your
-school, if any, to sign a "copyright disclaimer" for the program, if
-necessary. Here is a sample; alter the names:
-
- Yoyodyne, Inc., hereby disclaims all copyright interest in the program
- `Gnomovision' (which makes passes at compilers) written by James Hacker.
-
- {signature of Ty Coon}, 1 April 1989
- Ty Coon, President of Vice
-
-This 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.
-
diff --git a/packages/nameless/README.org b/packages/nameless/README.org
deleted file mode 100644
index 46b861b..0000000
--- a/packages/nameless/README.org
+++ /dev/null
@@ -1,129 +0,0 @@
-#+OPTIONS: toc:nil num:nil
-
-* Nameless --- /less is more/
-*Hide package namespaces in your emacs-lisp code.*
-
-Simply put, turn on this minor mode, and the namespace prefix of the
-package you’re editing will be hidden by a ~:~. Here’s a comparison.
-The image to the *left* is what you normally see. The image to
-the *right* has ~nameless-mode~ turned on.\\
- [[file:example-nameless.png]]
-
-** Usage
-
-To use this package add the following configuration to your Emacs init file.
-
-#+BEGIN_SRC emacs-lisp
-(add-hook 'emacs-lisp-mode-hook #'nameless-mode)
-#+END_SRC
-
-You can configure a string to use instead of ~:~ by setting the
-~nameless-prefix~, and the name of the face used is ~nameless-face~.
-You can even just hide the prefix completely by setting this variable
-to an empty string.
-
-While the mode is active, the =C-c C--= key inserts the
-package namespace if appropriate.
-
-* Configuration
-
-** Quickly typing the namespace
-~nameless-mode~ binds the =C-c C--= key to
-~nameless-insert-name~, which immediately inserts the current name for
-you, or even expands aliases to the names they point to.
-
-Let’s say you’re in a file called ~foo-bar.el~.
-#+BEGIN_SRC text
- C-c C-- → foo-bar-
-fl C-c C-- → font-lock-
-#+END_SRC
-
-There’s also a command called ~nameless-insert-name-or-self-insert~.
-You can bind this to the =_= key and make it even faster to
-insert the name.
-** Configuring the namespace name
-Nameless guesses the package name with the ~lm-get-package-name~
-function, but sometimes this might not match the name you want to use.
-
-In these situations, simply set ~nameless-current-name~ as file-local variable.
-To do that, invoke the following command:
-#+BEGIN_SRC text
-M-x add-file-local-variable RET nameless-current-name RET "package-name"
-#+END_SRC
-You can also set the same name for all lisp files in a project by
-setting dir-local variables with ~M-x add-file-local-variable~.
-
-If you /don’t/ want Nameless to use a namespace name at all (neither
-manual nor automatic), you can set ~nameless-discover-current-name~ to
-~nil~. This will disable this functionality, so that Nameless will
-/only/ use aliases (see next item).
-
-** Requiring other packages as aliases
-Nameless can also be used to “import” other packages as aliases. For
-instance, in the default behaviour, functions in the ~font-lock~
-package (e.g., ~font-lock-add-keywords~) will be displayed with the
-~fl:~ prefix (e.g., ~fl:add-keywords~).
-
-You can configure your own aliases globally with ~nameless-global-aliases~.
-#+BEGIN_SRC emacs-lisp
-(setq nameless-global-aliases '(("fl" . "font-lock")
- ("s" . "seq")
- ("me" . "macroexp")
- ("c" . "cider")
- ("q" . "queue")))
-#+END_SRC
-
-You can also configure aliases per-file by setting ~nameless-aliases~
-as a file-local variable.
-#+BEGIN_SRC emacs-lisp
-;; Local Variables:
-;; nameless-aliases: (("c" . "cider"))
-;; End:
-#+END_SRC
-Note that there’s no ~quote~ before ~((c~!\\
-You can also configure it for a whole project, by setting it as a dir-local
variable.
-
-** Private symbols
-
-Private symbols in elisp are written with an extra dash after the
-prefix (e.g., ~foobar--indent-impl~). With Nameless, these are usually
-displayed as ~:-indent-impl~, but you can also make them be displayed
-as ~::indent-impl~ by setting
-
-#+BEGIN_SRC emacs-lisp
-(setq nameless-private-prefix t)
-#+END_SRC
-
-** Packages that don’t use ~-~ (hyphen) as a separator
-You can set ~nameless-separator~ file-locally to whatever separator
-you package uses. Most packages use hyphens, by some use ~/~, ~|~, or
-~:~.
-
-You can also set it to ~nil~ globally and the separator will never be
-hidden.
-** Indentation and paragraph filling
-Hiding parts of symbols could affect the way Emacs indents your code
-and fills your paragraphs. Nameless lets you decide whether you want
-that to happen or not.
-
-The default behavior is that code is indented according to what you
-see (i.e., according to short symbols), but text inside strings is
-*not*. So text inside strings will be filled in the same way as if you
-didn’t have ~nameless-mode~. Here’s how a docstring might be filled
-with ~nameless-mode~ enabled:
-#+BEGIN_SRC text
-If point is immediately after an alias configured in the name you
-had in `:aliases' or `:global-aliases', replace
-it with the full name for that alias.
-#+END_SRC
-Altough it may look strange that the second line is so short, that’s
-the correct way. When view on a ~*Help*~ buffer, that docstring will
-look like this:
-#+BEGIN_SRC text
-If point is immediately after an alias configured in the name you
-had in `nameless-aliases' or `nameless-global-aliases', replace
-it with the full name for that alias.
-#+END_SRC
-
-To change this behavior, configure the variable
-~nameless-affect-indentation-and-filling~.
diff --git a/packages/nameless/example-nameless.png
b/packages/nameless/example-nameless.png
deleted file mode 100644
index 38bea2d..0000000
Binary files a/packages/nameless/example-nameless.png and /dev/null differ
diff --git a/packages/nameless/nameless.el b/packages/nameless/nameless.el
deleted file mode 100644
index eede973..0000000
--- a/packages/nameless/nameless.el
+++ /dev/null
@@ -1,299 +0,0 @@
-;;; nameless.el --- Hide package namespace in your emacs-lisp code -*-
lexical-binding: t; -*-
-
-;; Copyright (C) 2015 Free Software Foundation, Inc.
-
-;; Author: Artur Malabarba <emacs@endlessparentheses.com>
-;; URL: https://github.com/Malabarba/nameless
-;; Keywords: convenience, lisp
-;; Version: 1.0.2
-;; Package-Requires: ((emacs "24.4"))
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Usage
-;; ─────
-;;
-;; To use this package add the following configuration to your Emacs init
-;; file.
-;;
-;; ┌────
-;; │ (add-hook 'emacs-lisp-mode-hook #'nameless-mode)
-;; └────
-;;
-;; You can configure a string to use instead of `:' by setting the
-;; `nameless-prefix', and the name of the face used is `nameless-face'.
-;;
-;; While the mode is active, the `_' key inserts the package
-;; namespace if appropriate.
-
-;;; Code:
-(require 'lisp-mnt)
-
-(defgroup nameless nil
- "Customization group for nameless."
- :group 'emacs)
-
-(defcustom nameless-prefix ":"
- "Prefix displayed instead of package namespace."
- :type 'string)
-
-(defcustom nameless-global-aliases '(("fl" . "font-lock"))
- "Alist from aliases to namespaces.
-This alist is used everywhere. It is designed for namespaces you
-use commonly. To apply aliases specific to a file, set the
-`nameless-aliases' variable with `add-file-local-variable'.
-
-Each element of this list should have the form (ALIAS . NAMESPACE),
-both strings. For example, if you set this variable to
- ((\"fl\" . \"font-lock\"))
-then expressions like (font-lock-add-keywords nil kwds) will be
-displayed as (fl/add-keywords nil kwds) instead.
-
-Furthermore typing `fl' followed by `\\[nameless-insert-name]' will
-automatically insert `font-lock-'."
- :type '(alist string string))
-
-(defvar nameless-aliases nil
- "Alist from aliases to namespaces.
-This variable takes the same syntax and has the same effect as
-`nameless-global-aliases'. Aliases set here take priority over
-those in `nameless-global-aliases'.
-This variable is designed to be used as a file-local or dir-local
-variable.")
-(put 'nameless-aliases 'safe-local-variable
- (lambda (x) (ignore-errors
- (let ((safe t))
- (mapc (lambda (cell)
- (unless (and (stringp (car cell))
- (stringp (cdr cell)))
- (setq safe nil)))
- x)
- safe))))
-
-(defcustom nameless-discover-current-name t
- "If non-nil, discover package name automatically.
-If nil, `nameless-current-name' must be set explicitly, or left as nil,
-in which case only namespaces from `nameless-global-aliases' and
-`nameless-aliases' are used."
- :type 'boolean)
-
-(defface nameless-face
- '((t :inherit font-lock-type-face))
- "Face used on `nameless-prefix'")
-
-(defcustom nameless-affect-indentation-and-filling 'outside-strings
- "If non-nil, code is indented and filled according to what you see.
-If nil, code is indented and filled according to its actual content.
-If the value is `outside-strings', behave like nil inside strings
-and behave like t otherwise.
-
-After changing this variable, you must reenable `nameless-mode'
-for it to take effect."
- :type '(choice (const :tag "Always affect indentation" t)
- (const :tag "Don't affect indentation" nil)
- (const :tag "Only outside strings" outside-strings)))
-(put 'nameless-current-name 'safe-local-variable #'symbolp)
-
-(defcustom nameless-private-prefix nil
- "If non-nil, private symbols are displayed with a double prefix.
-For instance, the function `foobar--internal-impl' will be
-displayed as `::internal-impl', instead of `:-internal-impl'."
- :type 'boolean)
-
-(defcustom nameless-separator "-"
- "Separator used between package prefix and rest of symbol.
-The separator is hidden along with the package name. For
-instance, setting it to \"/\" means that `init/bio' will be
-displayed as `:bio' (assuming `nameless-current-name' is
-\"init\"). The default is \"-\", since this is the
-separator recommended by the Elisp manual.
-
-Value can also be nil, in which case the separator is never hidden."
- :type '(choice string (constant nil)))
-
-
-;;; Font-locking
-(defun nameless--make-composition (s)
- "Return a list that composes S if passed to `compose-region'."
- (cdr (apply #'append (mapcar (lambda (x) (list '(Br . Bl) x)) s))))
-
-(defvar nameless-mode)
-(defun nameless--compose-as (display)
- "Compose the matched region and return a face spec."
- (when (and nameless-mode
- (not (get-text-property (match-beginning 1) 'composition))
- (not (get-text-property (match-beginning 1) 'display)))
- (let ((compose (save-match-data
- (and nameless-affect-indentation-and-filling
- (or (not (eq nameless-affect-indentation-and-filling
'outside-strings))
- (not (nth 3 (syntax-ppss)))))))
- (dis (concat display nameless-prefix))
- (beg (match-beginning 1))
- (end (match-end 1))
- (private-prefix (and nameless-private-prefix
- (equal nameless-separator (substring
(match-string 0) -1)))))
- (when private-prefix
- (setq beg (match-beginning 0))
- (setq end (match-end 0))
- (setq dis (concat dis nameless-prefix)))
- (if compose
- (compose-region beg end (nameless--make-composition dis))
- (add-text-properties beg end (list 'display dis)))
- '(face nameless-face))))
-
-(defvar-local nameless--font-lock-keywords nil)
-
-(defun nameless--ensure ()
- (save-excursion
- (font-lock-fontify-region (point-min) (point-max))))
-
-(defun nameless--remove-keywords ()
- "Remove font-lock keywords set by `nameless--add-keywords'."
- (font-lock-remove-keywords nil nameless--font-lock-keywords)
- (setq nameless--font-lock-keywords nil)
- (nameless--ensure))
-
-(defun nameless--add-keywords (&rest r)
- "Add font-lock keywords displaying ALIAS as DISPLAY.
-ALIAS may be nil, in which case it refers to `nameless-current-name'.
-
-\(fn (alias . display) [(alias . display) ...])"
- (setq-local font-lock-extra-managed-props
- `(composition display ,@font-lock-extra-managed-props))
- (let ((kws (mapcar (lambda (x) `(,(nameless--name-regexp (cdr x)) 1
(nameless--compose-as ,(car x)) prepend)) r)))
- (setq nameless--font-lock-keywords kws)
- (font-lock-add-keywords nil kws t))
- (nameless--ensure))
-
-
-;;; Name and regexp
-(defvar-local nameless-current-name nil)
-(put 'nameless-current-name 'safe-local-variable #'stringp)
-
-(defun nameless--in-arglist-p (l)
- "Is point L inside an arglist?"
- (save-excursion
- (goto-char l)
- (ignore-errors
- (backward-up-list)
- (or (progn (forward-sexp -1)
- (looking-at-p "[a-z-]lambda\\_>"))
- (progn (forward-sexp -1)
- (looking-at-p "\\(cl-\\)?def"))))))
-
-(defun nameless-insert-name (&optional noerror)
- "Insert `nameless-current-name' or the alias at point.
-If point is immediately after an alias configured in
-`nameless-aliases' or `nameless-global-aliases', replace it with
-the full name for that alias.
-Otherwise, insert `nameless-current-name'.
-
-If NOERROR is nil, signal an error if the alias at point is not
-configured, or if `nameless-current-name' is nil."
- (interactive)
- (if (string-match (rx (or (syntax symbol)
- (syntax word)))
- (string (char-before)))
- (let* ((r (point))
- (l (save-excursion
- (forward-sexp -1)
- (skip-chars-forward "^[:alnum:]")
- (point)))
- (alias (buffer-substring l r))
- (full-name (when alias
- (cdr (or (assoc alias nameless-aliases)
- (assoc alias nameless-global-aliases))))))
- (if full-name
- (progn (delete-region l r)
- (insert full-name "-")
- t)
- (unless noerror
- (user-error "No name for alias `%s', see `nameless-aliases'"
alias))))
- (if nameless-current-name
- (progn (insert nameless-current-name nameless-separator)
- t)
- (unless noerror
- (user-error "No name for current buffer, see
`nameless-current-name'")))))
-
-(defun nameless-insert-name-or-self-insert (&optional self-insert)
- "Insert the name of current package, with a hyphen.
-If point is in an argument list, or if we're typing an escaped
-character, insert the current character literally instead."
- (interactive "P")
- (let ((l (point)))
- (call-interactively #'self-insert-command)
- (unless (or self-insert
- (not nameless-current-name)
- (eq (char-before l) ?\\)
- (nameless--in-arglist-p l))
- (undo-boundary)
- (delete-region l (point))
- (unless (nameless-insert-name 'noerror)
- (call-interactively #'self-insert-command)))))
-
-(put 'nameless-insert-name-or-self-insert 'delete-selection t)
-
-(defun nameless--name-regexp (name)
- "Return a regexp of the current name."
- (concat "\\_<@?\\(" (regexp-quote name)
- nameless-separator "\\)\\(\\s_\\|\\sw\\)"))
-
-(defun nameless--filter-string (s)
- "Remove from string S any disply or composition properties.
-Return S."
- (let ((length (length s)))
- (remove-text-properties 0 length '(composition nil display nil) s)
- s))
-
-(defun nameless--after-hack-local-variables ()
- "Set font-lock-keywords after `hack-local-variables-hook'."
- (nameless--remove-keywords)
- (apply #'nameless--add-keywords
- `(,@(when nameless-current-name
- `((nil . ,nameless-current-name)))
- ,@nameless-global-aliases
- ,@nameless-aliases)))
-
-
-;;; Minor mode
-;;;###autoload
-(define-minor-mode nameless-mode
- nil nil " :" `((,(kbd "C-c C--") . nameless-insert-name))
- (if nameless-mode
- (progn
- (when (and (not nameless-current-name)
- nameless-discover-current-name
- (ignore-errors (string-match "\\.el\\'"
(lm-get-package-name))))
- (setq nameless-current-name
- (replace-regexp-in-string
"\\(-mode\\)?\\(-tests?\\)?\\.[^.]*\\'" "" (lm-get-package-name))))
- (add-function :filter-return (local 'filter-buffer-substring-function)
- #'nameless--filter-string)
- (nameless--after-hack-local-variables)
- (add-hook 'hack-local-variables-hook
- #'nameless--after-hack-local-variables
- nil 'local))
- (remove-function (local 'filter-buffer-substring-function)
- #'nameless--filter-string)
- (remove-hook 'hack-local-variables-hook
- #'nameless--after-hack-local-variables
- 'local)
- (nameless--remove-keywords)))
-
-;;;###autoload
-(define-obsolete-function-alias 'nameless-mode-from-hook 'nameless-mode
"1.0.0")
-
-(provide 'nameless)
-;;; nameless.el ends here
diff --git a/packages/parsec/.gitignore b/packages/parsec/.gitignore
deleted file mode 100644
index 4206e73..0000000
--- a/packages/parsec/.gitignore
+++ /dev/null
@@ -1,3 +0,0 @@
-*.hs
-*.hi
-*.o
diff --git a/packages/parsec/README.org b/packages/parsec/README.org
deleted file mode 100644
index 53d08db..0000000
--- a/packages/parsec/README.org
+++ /dev/null
@@ -1,378 +0,0 @@
-#+TITLE: parsec.el
-
-A parser combinator library for Emacs Lisp similar to Haskell's Parsec library.
-
-* Overview
-
-This work is based on [[https://github.com/jwiegley/][John Wiegley]]'s
[[https://github.com/jwiegley/emacs-pl][emacs-pl]]. The original
[[https://github.com/jwiegley/emacs-pl][emacs-pl]] is awesome,
-but I found following problems when I tried to use it:
-
-- It only contains a very limited set of combinators
-- Some of its functions (combinators) have different behaviors than their
- Haskell counterparts
-- It can't show error messages when parsing fails
-
-So I decided to make a new library on top of it. This library, however,
contains
-most of the parser combinators in =Text.Parsec.Combinator=, which should be
-enough in most use cases. Of course more combinators can be added if necessary!
-Most of the parser combinators have the same behavior as their Haskell
-counterparts. =parsec.el= also comes with a simple error handling mechanism so
-that it can display an error message showing how the parser fails.
-
-So we can
-
-- use these parser combinators to write parsers easily from scratch in Emacs
- Lisp like what we can do in Haskell
-- port existing Haskell program using Parsec to its equivalent Emacs Lisp
- program easily
-
-* Parsing Functions & Parser Combinators
-
- We compare the functions and macros defined in this library with their
Haskell
- counterparts, assuming you're already familiar with Haskell's Parsec. If you
- don't have any experience with parser combinators, look at the docstrings of
- these functions and macros and try them to see the results! They are really
- easy to learn and use!
-
- The *Usage* column for each function/combinator in the following tables is
- much simplified. Check the docstring of the function/combinator to see the
- full description.
-
-** Basic Parsing Functions
- These parsing functions are used as the basic building block for a parser.
By
- default, their return value is a *string*.
-
- | parsec.el | Haskell's Parsec | Usage
|
-
|------------------------+------------------+-------------------------------------------------------|
- | parsec-ch | char | parse a character
|
- | parsec-any-ch | anyChar | parse an arbitrary character
|
- | parsec-satisfy | satisfy | parse a character satisfying a
predicate |
- | parsec-newline | newline | parse '\n'
|
- | parsec-crlf | crlf | parse '\r\n'
|
- | parsec-eol | eol | parse newline or CRLF
|
- | parsec-eof, parsec-eob | eof | parse end of file
|
- | parsec-eol-or-eof | *N/A* | parse EOL or EOL
|
- | parsec-re | *N/A* | parse using a regular
expression |
- | parsec-one-of | oneOf | parse one of the characters
|
- | parsec-none-of | noneOf | parse any character other than
the supplied ones |
- | parsec-str | *N/A* | parse a string but consume
input only when successful |
- | parsec-string | string | parse a string and consume
input for partial matches |
- | parsec-num | *N/A* | parse a number
|
- | parsec-letter | letter | parse a letter
|
- | parsec-digit | digit | parse a digit
|
-
- Note:
- - =parsec-str= and =parsec-string= are different. =parsec-string= behaves the
- same as =string= in Haskell, and =parsec-str= is more like combining
- =string= and =try= in Haskell. Personally I found =parsec-str= easier to
use
- because =parsec-str= is "atomic", which is similar to =parsec-ch=.
- - Use the power of regular expressions provided by =parsec-re= and simplify
the parser!
-
-** Parser Combinators
- These combinators can be used to combine different parsers.
-
- | parsec.el | Haskell's Parsec | Usage
|
-
|---------------------------+------------------+--------------------------------------------------------------|
- | parsec-or | choice | try the parsers until one
succeeds |
- | parsec-try | try | try parser and consume no
input when an error occurs |
- | parsec-lookahead | lookahead | try parser and consume no
input when successful |
- | parsec-peek | try && lookahead | try parser without
comsuming any input |
- | parsec-peek-p | try && lookahead | same as parsec-peek except
the return value for failure |
- | parsec-with-error-message | <?> (similar) | use the new error message
when an error occurs |
- | parsec-many | many | apply the parser zero or
more times |
- | parsec-many1 | many1 | apply the parser one or
more times |
- | parsec-many-till | manyTill | apply parser zero or more
times until end succeeds |
- | parsec-until | *N/A* | parse until end succeeds
|
- | parsec-not-followed-by | notFollowedBy | succeed when the parser
fails |
- | parsec-endby | endby | apply parser zero or more
times, separated and ended by end |
- | parsec-sepby | sepby | apply parser zero or more
times, separated by sep |
- | parsec-between | between | apply parser between open
and close |
- | parsec-count | count | apply parser n times
|
- | parsec-option | option | apply parser, if it fails,
return opt |
- | parsec-optional | *N/A* | apply parser zero or one
time and return the result |
- | parsec-optional* | optional | apply parser zero or one
time and discard the result |
- | parsec-optional-maybe | optionMaybe | apply parser zero or one
time and return the result in Maybe |
-
- Note:
- - =parsec-or= can also be used to replace =<|>=.
- - =parsec-with-error-message= is slightly different from =<?>=. It will
- replace the error message even when the input is consumed.
- - By default, =parsec-many-till= behaves as Haskell's =manyTill=. However,
- =parsec-many-till= and =parsec-until= can accept an optional argument to
- specify which part(s) to be returned. You can use =:both= or =:end= as the
- optional argument to change the default behavior. See the docstrings for
- more information.
-
-** Parser Utilities
- These utilities can be used together with parser combinators to build a
- parser and ease the translation process if you're trying to port an existing
- Haskell program.
-
- | parsec.el | Haskell's Parsec | Usage
|
-
|----------------------------------+------------------+---------------------------------------------------------|
- | parsec-and | do block | try all parsers and
return the last result |
- | parsec-return | do block | try all parsers and
return the first result |
- | parsec-ensure | *N/A* | quit the parsing
when an error occurs |
- | parsec-ensure-with-error-message | *N/A* | quit the parsing
when an error occurs with new message |
- | parsec-collect | sequence | try all parsers and
collect the results into a list |
- | parsec-collect* | *N/A* | try all parsers and
collect non-nil results into a list |
- | parsec-start | parse | entry point
|
- | parsec-parse | parse | entry point (same as
parsec-start) |
- | parsec-with-input | parse | perform parsers on
input |
- | parsec-from-maybe | fromMaybe | retrieve value from
Maybe |
- | parsec-maybe-p | *N/A* | is a Maybe value or
not |
- | parsec-query | *N/A* | change the parser's
return value |
-
-** Variants that Return a String
-
- By default, the macros/functions that return multiple values will put the
- values into a list. These macros/functions are:
- - =parsec-many=
- - =parsec-many1=
- - =parsec-many-till=
- - =parsec-until=
- - =parsec-count=
- - =parsec-collect= and =parsec-collect*=
-
- They all have a variant that returns a string by concatenating the results
in
- the list:
- - =parsec-many-as-string= or =parsec-many-s=
- - =parsec-many1-as-string= or =parsec-many1-s=
- - =parsec-many-till-as-string= or =parsec-many-till-s=
- - =parsec-until-as-string= or =parsec-until-s=
- - =parsec-collect-as-string= or =parsec-collect-s=
- - =parsec-count-as-string= or =parsec-count-s=
-
- The =*-s= and =*-as-string= variants are the same, except the =*-s= variants
- have a shorter name. Using these =*-s= functions are recommended if you're
- dealing with strings very frequently in your code. These variants accept the
- same arguments and have the same behavior as their original counterpart that
- returns a list. The only difference is the return value.
-* Code Examples
- Some very simple examples are given here. You can see many code examples in
- the test files in this GitHub repo.
-
- The following code extract the "hello" from the comment:
- #+BEGIN_SRC elisp
- (parsec-with-input "/* hello */"
- (parsec-string "/*")
- (parsec-many-till-as-string (parsec-any-ch)
- (parsec-try
- (parsec-string "*/"))))
- #+END_SRC
-
- The following Haskell program does a similar thing:
- #+BEGIN_SRC haskell
- import Text.Parsec
-
- main :: IO ()
- main = print $ parse p "" "/* hello */"
- where
- p = do string "/*"
- manyTill anyChar (try (string "*/"))
- #+END_SRC
-
- The following code returns the "aeiou" before "end":
- #+BEGIN_SRC elisp
- (parsec-with-input "if aeiou end"
- (parsec-str "if ")
- (parsec-return
- (parsec-many-as-string (parsec-one-of ?a ?e ?i ?o ?u))
- (parsec-str " end")))
- #+END_SRC
-
-* Write a Parser: a Simple CSV Parser
- You can find the code in =examples/simple-csv-parser.el=. The code is based
- on the Haskell code in
[[http://book.realworldhaskell.org/read/using-parsec.html][Using Parsec]].
-
- An end-of-line should be a string =\n=. We use =(parsec-str "\n")= to parse
it
- (Note that since =\n= is also one character, =(parsec-ch ?\n)= also works).
- Some files may not contain a newline at the end, but we can view end-of-file
- as the end-of-line for the last line, and use =parsec-eof= (or =parsec-eob=)
- to parse the end-of-file. We use =parsec-or= to combine these two
combinators:
- #+BEGIN_SRC elisp
- (defun s-csv-eol ()
- (parsec-or (parsec-str "\n")
- (parsec-eof)))
- #+END_SRC
-
- A CSV file contains many lines and ends with an end-of-file. Use
- =parsec-return= to return the result of the first parser as the result.
- #+BEGIN_SRC elisp
- (defun s-csv-file ()
- (parsec-return (parsec-many (s-csv-line))
- (parsec-eof)))
- #+END_SRC
-
- A CSV line contains many CSV cells and ends with an end-of-line, and we
- should return the cells as the results:
- #+BEGIN_SRC elisp
- (defun s-csv-line ()
- (parsec-return (s-csv-cells)
- (s-csv-eol)))
- #+END_SRC
-
- CSV cells is a list, containing the first cell and the remaining cells:
- #+BEGIN_SRC elisp
- (defun s-csv-cells ()
- (cons (s-csv-cell-content) (s-csv-remaining-cells)))
- #+END_SRC
-
- A CSV cell consists any character that is not =,= or =\n=, and we use the
- =parsec-many-as-string= variant to return the whole content as a string
- instead of a list of single-character strings:
- #+BEGIN_SRC elisp
- (defun s-csv-cell-content ()
- (parsec-many-as-string (parsec-none-of ?, ?\n)))
- #+END_SRC
-
- For the remaining cells: if followed by a comma =,=, we try to parse more csv
- cells. Otherwise, we should return the =nil=:
- #+BEGIN_SRC elisp
- (defun s-csv-remaining-cells ()
- (parsec-or (parsec-and (parsec-ch ?,) (s-csv-cells)) nil))
- #+END_SRC
-
- OK. Our parser is almost done. To begin parsing the content in buffer =foo=,
- you need to wrap the parser inside =parsec-start= (or =parsec-parse=):
- #+BEGIN_SRC elisp
- (with-current-buffer "foo"
- (goto-char (point-min))
- (parsec-parse
- (s-csv-file)))
- #+END_SRC
-
- If you want to parse a string instead, we provide a simple wrapper macro
- =parsec-with-input=, and you feed a string as the input and put arbitraty
- parsers inside the macro body. =parsec-start= or =parsec-parse= is not
needed.
- #+BEGIN_SRC elisp
- (parsec-with-input "a1,b1,c1\na2,b2,c2"
- (s-csv-file))
- #+END_SRC
-
- The above code returns:
- #+BEGIN_SRC elisp
- (("a1" "b1" "c1") ("a2" "b2" "c2"))
- #+END_SRC
-
- Note that if we replace =parsec-many-as-string= with =parsec-many= in
- =s-csv-cell-content=:
- #+BEGIN_SRC elisp
- (defun s-csv-cell-content ()
- (parsec-many (parsec-none-of ?, ?\n)))
- #+END_SRC
-
- The result would be:
- #+BEGIN_SRC elisp
- ((("a" "1") ("b" "1") ("c" "1")) (("a" "2") ("b" "2") ("c" "2")))
- #+END_SRC
-
-* More Parser Examples
- I translate some Haskell Parsec examples into Emacs Lisp using =parsec.el=.
- You can see from these examples that it is very easy to write parsers using
- =parsec.el=, and if you know haskell, you can see that basically I just
- translate the Haskell into Emacs Lisp one by one because most of them are
just
- the same!
-
- You can find five examples under the =examples/= directory.
-
- Three of the examples are taken from the chapter
[[http://book.realworldhaskell.org/read/using-parsec.html][Using Parsec]] in
the book of
- [[http://book.realworldhaskell.org/read/][Real World Haskell]]:
- - =simple-csv-parser.el=: a simple csv parser with no support for quoted
- cells, as explained in previous section.
- - =full-csv-parser.el=: a full csv parser
- - =url-str-parser.el=: parser parameters in URL
-
- =pjson.el= is a translation of Haskell's
[[https://hackage.haskell.org/package/json-0.9.1/docs/src/Text-JSON-Parsec.html][json
library using Parsec]].
-
- =scheme.el= is a much simplified Scheme parser based on
[[https://en.wikibooks.org/wiki/Write_Yourself_a_Scheme_in_48_Hours/][Write
Yourself a
- Scheme in 48 Hours]].
-
- They're really simple but you can see how this library works!
-
-* Change the Return Values using =parsec-query=
- Parsing has side-effects such as forwarding the current point. In the
original
- [[https://github.com/jwiegley/emacs-pl][emacs-pl]], you can specify some
optional arguments to some parsing functions
- (=pl-ch=, =pl-re= etc.) to change the return values. In =parsec.el=, these
- functions don't have such a behavior. Instead, we provide a unified interface
- =parsec-query=, which accepts any parser, and changes the return value of the
- parser.
-
- You can speicify following arguments:
- #+BEGIN_EXAMPLE
- :beg --> return the point before applying the PARSER
- :end --> return the point after applying the PARSER
- :nil --> return nil
- :groups N --> return Nth group for `parsec-re'."
- #+END_EXAMPLE
-
- So instead of returning "b" as the result, the following code returns 2:
- #+BEGIN_SRC elisp
- (parsec-with-input "ab"
- (parsec-ch ?a)
- (parsec-query (parsec-ch ?b) :beg))
- #+END_SRC
-
- Returning a point means that you can also incorporate =parsec.el= with Emacs
- Lisp functions that can operate on points/regions, such as =goto-char= and
- =kill-region=.
-
- =:group= can be specified when using =parsec-re=:
- #+BEGIN_SRC elisp
- (parsec-with-input "ab"
- (parsec-query (parsec-re "\\(a\\)\\(b\\)") :group 2))
- #+END_SRC
-
- The above code will return "b" instead of "ab".
-* Error Messages
-
- =parsec.el= implements a simple error handling mechanism. When an error
- happens, it will show how the parser fails.
-
- For example, the following code fails:
- #+BEGIN_SRC elisp
- (parsec-with-input "aac"
- (parsec-count 2 (parsec-ch ?a))
- (parsec-ch ?b))
- #+END_SRC
-
- The return value is:
- #+BEGIN_SRC elisp
- (parsec-error . "Found \"c\" -> Expected \"b\"")
- #+END_SRC
-
- This also works when parser combinators fail:
- #+BEGIN_SRC elisp
- (parsec-with-input "a"
- (parsec-or (parsec-ch ?b)
- (parsec-ch ?c)))
- #+END_SRC
-
- The return value is:
- #+BEGIN_SRC elisp
- (parsec-error . "None of the parsers succeeds:
- Found \"a\" -> Expected \"c\"
- Found \"a\" -> Expected \"b\"")
- #+END_SRC
-
- If an error occurs, the return value is a cons cell that contains the error
- message in its =cdr=. Compared to Haskell's Parsec, it's really simple, but
at
- least the error message could tell us some information. Yeah, not perfect but
- usable.
-
- To test whether a parser returns an error, use =parsec-error-p=. If it
returns
- an error, you can use =parsec-error-str= to retrieve the error message as a
- string.
-
- You can decide what to do based on the return value of a parser:
- #+BEGIN_SRC elisp
- (let ((res (parsec-with-input "hello"
- (parsec-str "world"))))
- (if (parsec-error-p res)
- (message "Parser failed:\n%s" (parsec-error-str res))
- (message "Parser succeeded by returning %s" res)))
- #+END_SRC
-
-* Acknowledgement
- - Daan Leijen for Haskell's Parsec
- - [[https://github.com/jwiegley/][John Wiegley]] for
[[https://github.com/jwiegley/emacs-pl][emacs-pl]]
diff --git a/packages/parsec/examples/.nosearch
b/packages/parsec/examples/.nosearch
deleted file mode 100644
index e69de29..0000000
diff --git a/packages/parsec/examples/full-csv-parser-tests.el
b/packages/parsec/examples/full-csv-parser-tests.el
deleted file mode 100644
index fdf4c5e..0000000
--- a/packages/parsec/examples/full-csv-parser-tests.el
+++ /dev/null
@@ -1,51 +0,0 @@
-;;; full-csv-parser-tests.el --- Tests for full-csv-parser -*-
lexical-binding: t; -*-
-
-;; Copyright (C) 2016 Free Software Foundation, Inc.
-
-;; Author: Junpeng Qiu <qjpchmail@gmail.com>
-;; Keywords:
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;;
-
-;;; Code:
-
-(require 'ert)
-(require 'full-csv-parser)
-
-(ert-deftest test-full-csv ()
- (should
- (equal
- (parse-csv "\"a,1,s\",b,\r\nd,e,f")
- '(("a,1,s" "b" "")
- ("d" "e" "f"))))
- (should
- (equal
- (parse-csv "\"e\"\",f")
- (parsec-error-new-2 "\"" "`EOF'")))
- (should
- (equal
- (parse-csv "\"a,1,\r\n")
- (parsec-error-new-2 "\"" "`EOF'")))
- (should
- (equal
- (parse-csv "\"a,1,\",b,\r\nd,,f")
- '(("a,1," "b" "")
- ("d" "" "f")))))
-
-(provide 'full-csv-parser-tests)
-;;; full-csv-parser-tests.el ends here
diff --git a/packages/parsec/examples/full-csv-parser.el
b/packages/parsec/examples/full-csv-parser.el
deleted file mode 100644
index 156fbd9..0000000
--- a/packages/parsec/examples/full-csv-parser.el
+++ /dev/null
@@ -1,61 +0,0 @@
-;;; full-csv-parser.el --- Sample csv parser using parsec.el -*-
lexical-binding: t; -*-
-
-;; Copyright (C) 2016 Free Software Foundation, Inc.
-
-;; Author: Junpeng Qiu <qjpchmail@gmail.com>
-;; Keywords: extensions
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Ref: http://book.realworldhaskell.org/read/using-parsec.html
-
-;;; Code:
-
-(defun csv-file ()
- (parsec-start
- (parsec-return (parsec-endby (csv-line) (csv-eol))
- (parsec-eob))))
-
-(defun csv-line ()
- (parsec-sepby (csv-cell) (parsec-ch ?,)))
-
-(defun csv-cell ()
- (parsec-or (csv-quoted-cell) (parsec-many-as-string
- (parsec-none-of ?, ?\r ?\n))))
-
-(defun csv-quoted-cell ()
- (parsec-and (parsec-ch ?\")
- (parsec-return (parsec-many-as-string (csv-quoted-char))
- (parsec-ch ?\"))))
-
-(defun csv-quoted-char ()
- (parsec-or (parsec-re "[^\"]")
- (parsec-and (parsec-str "\"\"")
- "\"")))
-
-(defun csv-eol ()
- (parsec-or (parsec-str "\n\r")
- (parsec-str "\r\n")
- (parsec-str "\n")
- (parsec-str "\r")
- (parsec-eob)))
-
-(defun parse-csv (input)
- (parsec-with-input input
- (csv-file)))
-
-(provide 'full-csv-parser)
-;;; full-csv-parser.el ends here
diff --git a/packages/parsec/examples/pjson-tests.el
b/packages/parsec/examples/pjson-tests.el
deleted file mode 100644
index 7c7f6ed..0000000
--- a/packages/parsec/examples/pjson-tests.el
+++ /dev/null
@@ -1,102 +0,0 @@
-;;; pjson-tests.el --- Test for parsec json parser -*- lexical-binding: t;
-*-
-
-;; Copyright (C) 2016 Free Software Foundation, Inc.
-
-;; Author: Junpeng Qiu <qjpchmail@gmail.com>
-;; Keywords:
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;;
-
-;;; Code:
-
-(require 'ert)
-(require 'pjson)
-
-(ert-deftest test-pjson-number ()
- (should
- (equal
- (parsec-with-input "123"
- (pjson-number))
- 123)))
-
-(ert-deftest test-pjson-boolean ()
- (should
- (equal
- (parsec-with-input "false"
- (pjson-boolean))
- nil)))
-
-(ert-deftest test-pjson-null ()
- (should
- (equal
- (parsec-with-input "null"
- (pjson-null))
- nil)))
-
-(ert-deftest test-pjson-array ()
- (should
- (equal
- (parsec-with-input "[1,true,1,\"abc\",[1],null)"
- (pjson-array))
- (parsec-error-new-2 "]" ")")))
- (should
- (equal
- (parsec-with-input "[1,true,1,\"abc\",[1],null]"
- (pjson-array))
- (vector 1 t 1 "abc"
- (vector 1)
- nil))))
-(ert-deftest test-pjson-string ()
- (should
- (equal
- (parsec-with-input "\"asdf\""
- (pjson-string))
- "asdf")))
-
-(ert-deftest test-pjson-object ()
- (should
- (equal
- (parsec-with-input "{\"a\" :1, \"b\":2, \"c\":[1,true] }"
- (pjson-object))
- '(("a" . 1)
- ("b" . 2)
- ("c" .
- [1 t])))))
-
-(ert-deftest test-pjson-jvalue ()
- (should
- (equal
- (parsec-with-input "[false]" (pjson-jvalue))
- (vector nil))))
-
-(ert-deftest test-pjson-parse ()
- (should
- (equal
- (pjson-parse "{\"a\" :1, \"b\":2, \"c\":[1,{\"d\":null}]}")
- '(("a" . 1)
- ("b" . 2)
- ("c" .
- [1
- (("d"))]))))
- (should
- (equal
- (pjson-parse "{\"a\" :1, \"b\":2, [{ \"c\":[1,true] }]}")
- (parsec-error-new-2 "\"" "["))))
-
-(provide 'pjson-tests)
-;;; pjson-tests.el ends here
diff --git a/packages/parsec/examples/pjson.el
b/packages/parsec/examples/pjson.el
deleted file mode 100644
index f34f4d9..0000000
--- a/packages/parsec/examples/pjson.el
+++ /dev/null
@@ -1,124 +0,0 @@
-;;; pjson.el --- JSON parser using parsec.el -*- lexical-binding: t;
-*-
-
-;; Copyright (C) 2016 Free Software Foundation, Inc.
-
-;; Author: Junpeng Qiu <qjpchmail@gmail.com>
-;; Keywords: extensions
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Ref:
https://hackage.haskell.org/package/json-0.9.1/docs/src/Text-JSON-Parsec.html
-
-;;; Code:
-
-(defvar pjson-special-chars
- '((?\" . ?\")
- (?\\ . ?\\)
- (?/ . ?/)
- (?b . ?\b)
- (?f . ?\f)
- (?n . ?\n)
- (?r . ?\r)
- (?t . ?\t))
- "Characters which are escaped in JSON, with their elisp counterparts.")
-
-(defsubst pjson-spaces ()
- (parsec-many-as-string
- (parsec-re "[[:space:]\r\n]")))
-
-(defmacro pjson-tok (parser)
- `(parsec-return ,parser
- (pjson-spaces)))
-
-(defun pjson-value ()
- (parsec-and
- (pjson-spaces)
- (pjson-jvaule)))
-
-(defun pjson-jvalue ()
- (parsec-or (pjson-null)
- (pjson-boolean)
- (pjson-number)
- (pjson-string)
- (pjson-array)
- (pjson-object)))
-
-(defsubst pjson-null ()
- (parsec-and
- (pjson-tok (parsec-str "null"))
- nil))
-
-(defsubst pjson-boolean ()
- (parsec-or (parsec-and
- (pjson-tok (parsec-str "true"))
- t)
- (parsec-and
- (pjson-tok (parsec-str "false"))
- nil)))
-
-(defsubst pjson-array ()
- (apply #'vector
- (parsec-between (pjson-tok (parsec-ch ?\[))
- (pjson-tok (parsec-ch ?\]))
- (parsec-sepby
- (pjson-jvalue)
- (pjson-tok (parsec-ch ?,))))))
-
-(defun pjson-char ()
- (parsec-or
- (parsec-and (parsec-ch ?\\) (pjson-esc))
- (parsec-none-of ?\" ?\\)))
-
-(defun pjson-esc ()
- (parsec-or
- (assoc-default
- (parsec-satisfy (lambda (x) (assq x pjson-special-chars)))
- pjson-special-chars)
- (parsec-and (parsec-ch ?u)
- (pjson-uni))))
-
-(defun pjson-uni ()
- (format "%c" (string-to-number
- (parsec-re "[0-9a-zA-z]\\{4\\}")
- 16)))
-
-(defsubst pjson-string ()
- (parsec-between (pjson-tok (parsec-ch ?\"))
- (pjson-tok (parsec-ch ?\"))
- (parsec-many-as-string (pjson-char))))
-
-(defun pjson-field ()
- (cons (parsec-return (pjson-string)
- (pjson-tok (parsec-ch ?:)))
- (pjson-jvalue)))
-
-(defun pjson-object ()
- (parsec-between (pjson-tok (parsec-ch ?\{))
- (pjson-tok (parsec-ch ?\}))
- (parsec-sepby
- (pjson-field)
- (pjson-tok (parsec-ch ?,)))))
-
-(defun pjson-number ()
- (pjson-tok (string-to-number
- (parsec-re
"\\+?\\([0-9]+\\)\\(\\.[0-9]+\\)?\\([Ee][+-]?[0-9]+\\)?"))))
-
-(defun pjson-parse (input)
- (parsec-with-input input
- (pjson-object)))
-
-(provide 'pjson)
-;;; pjson.el ends here
diff --git a/packages/parsec/examples/scheme-tests.el
b/packages/parsec/examples/scheme-tests.el
deleted file mode 100644
index 9b30ff2..0000000
--- a/packages/parsec/examples/scheme-tests.el
+++ /dev/null
@@ -1,88 +0,0 @@
-;;; scheme-tests.el --- Tests for scheme parser -*- lexical-binding: t;
-*-
-
-;; Copyright (C) 2016 Free Software Foundation, Inc.
-
-;; Author: Junpeng Qiu <qjpchmail@gmail.com>
-;; Keywords:
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;;
-
-;;; Code:
-
-(require 'ert)
-(require 'scheme)
-
-(ert-deftest test-scheme-number ()
- (should
- (equal (scheme-read "25")
- (scheme-number 25))))
-
-(ert-deftest test-scheme-string ()
- (should
- (equal
- (scheme-read "\"This is a string\"")
- "This is a string")))
-
-(ert-deftest test-scheme-list ()
- (should
- (equal
- (scheme-read "(symbol)")
- '(List
- (Atom . "symbol"))))
- (should
- (equal
- (scheme-read "(a test)")
- '(List
- (Atom . "a")
- (Atom . "test")))))
-
-(ert-deftest test-scheme-dotted-list ()
- (should
- (equal
- (scheme-read "(a . test)")
- '(DottedList
- ((Atom . "a"))
- Atom . "test"))))
-
-(ert-deftest test-scheme-nested ()
- (should
- (equal
- (scheme-read "(a (nested) test)")
- '(List
- (Atom . "a")
- (List
- (Atom . "nested"))
- (Atom . "test")))))
-
-(ert-deftest test-scheme-quoted ()
- (should
- (equal
- (scheme-read "(a '(quoted (dotted . list)) test)")
- '(List
- (Atom . "a")
- (List
- (Atom . "quote")
- (List
- (Atom . "quoted")
- (DottedList
- ((Atom . "dotted"))
- Atom . "list")))
- (Atom . "test")))))
-
-(provide 'scheme-tests)
-;;; scheme-tests.el ends here
diff --git a/packages/parsec/examples/scheme.el
b/packages/parsec/examples/scheme.el
deleted file mode 100644
index 7d33953..0000000
--- a/packages/parsec/examples/scheme.el
+++ /dev/null
@@ -1,108 +0,0 @@
-;;; scheme.el --- Scheme parser using parsec.el -*- lexical-binding: t;
-*-
-
-;; Copyright (C) 2016 Free Software Foundation, Inc.
-
-;; Author: Junpeng Qiu <qjpchmail@gmail.com>
-;; Keywords: extensions
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Ref: https://en.wikibooks.org/wiki/Write_Yourself_a_Scheme_in_48_Hours/
-
-;;; Code:
-
-(defsubst scheme-bool (value)
- (cons 'Bool value))
-
-(defsubst scheme-true ()
- (scheme-bool 'True))
-
-(defsubst scheme-false ()
- (scheme-bool 'False))
-
-(defsubst scheme-atom (atom)
- (cons 'Atom atom))
-
-(defsubst scheme-number (number)
- (cons 'Number number))
-
-(defsubst scheme-list (&rest values)
- (cons 'List values))
-
-(defsubst scheme-dotted-list (head tail)
- (cons 'DottedList (cons head tail)))
-
-(defsubst scheme-symbol ()
- (parsec-re "[$!#%&|*+/:<=>?@^_~-]"))
-
-(defsubst scheme-spaces ()
- (parsec-many (parsec-ch ? )))
-
-(defun scheme-parse-string ()
- (parsec-and (parsec-ch ?\")
- (parsec-return (parsec-many-as-string (parsec-none-of ?\"))
- (parsec-ch ?\"))))
-
-(defun scheme-parse-atom ()
- (let (first rest atom)
- (parsec-and (setq first (parsec-or (parsec-letter) (scheme-symbol)))
- (setq rest (parsec-many (parsec-or (parsec-letter)
- (parsec-digit)
- (scheme-symbol)))))
- (setq atom (parsec-list-to-string (cons first rest)))
- (cond
- ((string= atom "#t") (scheme-true))
- ((string= atom "#f") (scheme-false))
- (t (scheme-atom atom)))))
-
-(defun scheme-parse-number ()
- (scheme-number
- (string-to-number (parsec-many1-as-string (parsec-digit)))))
-
-(defun scheme-parse-list ()
- (apply #'scheme-list (parsec-sepby (scheme-parse-expr) (scheme-spaces))))
-
-(defun scheme-parse-dotted-list ()
- (scheme-dotted-list (parsec-endby (scheme-parse-expr) (scheme-spaces))
- (parsec-and
- (parsec-ch ?.)
- (scheme-spaces)
- (scheme-parse-expr))))
-
-(defun scheme-parse-quoted ()
- (parsec-and
- (parsec-ch ?\')
- (scheme-list (scheme-atom "quote") (scheme-parse-expr))))
-
-(defun scheme-parse-expr ()
- (parsec-or (scheme-parse-atom)
- (scheme-parse-string)
- (scheme-parse-number)
- (scheme-parse-quoted)
- (parsec-between
- (parsec-ch ?\()
- (parsec-ch ?\))
- (parsec-or
- (parsec-try
- (scheme-parse-list))
- (scheme-parse-dotted-list)))))
-
-(defun scheme-read (expr)
- (parsec-with-input expr
- (scheme-parse-expr)))
-
-(provide 'scheme)
-;;; scheme.el ends here
diff --git a/packages/parsec/examples/simple-csv-parser-tests.el
b/packages/parsec/examples/simple-csv-parser-tests.el
deleted file mode 100644
index 9ae5063..0000000
--- a/packages/parsec/examples/simple-csv-parser-tests.el
+++ /dev/null
@@ -1,39 +0,0 @@
-;;; simple-csv-parser-tests.el --- Tests for simple csv parser -*-
lexical-binding: t; -*-
-
-;; Copyright (C) 2016 Free Software Foundation, Inc.
-
-;; Author: Junpeng Qiu <qjpchmail@gmail.com>
-;; Keywords:
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;;
-
-;;; Code:
-
-(require 'ert)
-(require 'simple-csv-parser)
-
-(ert-deftest test-simple-csv ()
- (should
- (equal
- (s-parse-csv "a1s,b,d,e,f\na,,c,d,\n")
- '(("a1s" "b" "d" "e" "f")
- ("a" "" "c" "d" "")))))
-
-
-(provide 'simple-csv-parser-tests)
-;;; simple-csv-parser-tests.el ends here
diff --git a/packages/parsec/examples/simple-csv-parser.el
b/packages/parsec/examples/simple-csv-parser.el
deleted file mode 100644
index af9d286..0000000
--- a/packages/parsec/examples/simple-csv-parser.el
+++ /dev/null
@@ -1,55 +0,0 @@
-;;; simple-csv-parser.el --- Simple CSV parser using parsec.el -*-
lexical-binding: t; -*-
-
-;; Copyright (C) 2016 Free Software Foundation, Inc.
-
-;; Author: Junpeng Qiu <qjpchmail@gmail.com>
-;; Keywords: extensions
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Ref: http://book.realworldhaskell.org/read/using-parsec.html
-
-;;; Code:
-
-(require 'parsec)
-
-(defun s-csv-file ()
- (parsec-return (parsec-many (s-csv-line))
- (parsec-eof)))
-
-(defun s-csv-line ()
- (parsec-return (s-csv-cells)
- (s-csv-eol)))
-
-(defun s-csv-eol ()
- (parsec-or (parsec-str "\n")
- (parsec-eof)))
-
-(defun s-csv-cells ()
- (cons (s-csv-cell-content) (s-csv-remaining-cells)))
-
-(defun s-csv-cell-content ()
- (parsec-many-as-string (parsec-none-of ?, ?\n)))
-
-(defun s-csv-remaining-cells ()
- (parsec-or (parsec-and (parsec-ch ?,) (s-csv-cells)) nil))
-
-(defun s-parse-csv (input)
- (parsec-with-input input
- (s-csv-file)))
-
-(provide 'simple-csv-parser)
-;;; simple-csv-parser.el ends here
diff --git a/packages/parsec/examples/url-str-parser-tests.el
b/packages/parsec/examples/url-str-parser-tests.el
deleted file mode 100644
index 2444c8c..0000000
--- a/packages/parsec/examples/url-str-parser-tests.el
+++ /dev/null
@@ -1,48 +0,0 @@
-;;; url-str-parser-tests.el --- Tests for url-str-parser -*- lexical-binding:
t; -*-
-
-;; Copyright (C) 2016 Free Software Foundation, Inc.
-
-;; Author: Junpeng Qiu <qjpchmail@gmail.com>
-;; Keywords:
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;;
-
-;;; Code:
-
-(require 'ert)
-(require 'url-str-parser)
-
-(ert-deftest test-url-str ()
- (should
- (equal
- (url-str-parse "foo=bar&a%21=b+c")
- '(("foo" Just . "bar")
- ("a!" Just . "b c"))))
- (should
- (equal
- (url-str-parse "foo=&a%21=b+c")
- '(("foo" Just . "")
- ("a!" Just . "b c"))))
- (should
- (equal
- (url-str-parse "foo&a%21=b+c")
- '(("foo" . Nothing)
- ("a!" Just . "b c")))))
-
-(provide 'url-str-parser-tests)
-;;; url-str-parser-tests.el ends here
diff --git a/packages/parsec/examples/url-str-parser.el
b/packages/parsec/examples/url-str-parser.el
deleted file mode 100644
index 9c39c3f..0000000
--- a/packages/parsec/examples/url-str-parser.el
+++ /dev/null
@@ -1,56 +0,0 @@
-;;; url-str-parser.el --- URL-encoded query string parser using parsec.el -*-
lexical-binding: t; -*-
-
-;; Copyright (C) 2016 Free Software Foundation, Inc.
-
-;; Author: Junpeng Qiu <qjpchmail@gmail.com>
-;; Keywords: extensions
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Ref: http://book.realworldhaskell.org/read/using-parsec.html
-
-;;; Code:
-
-
-(defun url-str-query ()
- (parsec-sepby (url-str-pair) (parsec-ch ?&)))
-
-(defun url-str-pair ()
- (cons
- (parsec-many1-as-string (url-str-char))
- (parsec-optional-maybe
- (parsec-and (parsec-ch ?=) (parsec-many-as-string (url-str-char))))))
-
-(defun url-str-char ()
- (parsec-or (parsec-re "[a-zA-z0-9$_.!*'(),-]")
- (parsec-and (parsec-ch ?+) " ")
- (url-str-hex)))
-
-(defun url-str-hex ()
- (parsec-and
- (parsec-ch ?%)
- (format "%c"
- (string-to-number (format "%s%s"
- (parsec-re "[0-9a-zA-z]")
- (parsec-re "[0-9a-zA-z]"))
- 16))))
-
-(defun url-str-parse (input)
- (parsec-with-input input
- (url-str-query)))
-
-(provide 'url-str-parser)
-;;; url-str-parser.el ends here
diff --git a/packages/parsec/parsec-tests.el b/packages/parsec/parsec-tests.el
deleted file mode 100644
index 359fcb7..0000000
--- a/packages/parsec/parsec-tests.el
+++ /dev/null
@@ -1,481 +0,0 @@
-;;; parsec-tests.el --- Tests for parsec.el -*- lexical-binding: t;
-*-
-
-;; Copyright (C) 2016 Free Software Foundation, Inc.
-
-;; Author: Junpeng Qiu <qjpchmail@gmail.com>
-;; Keywords:
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;;
-
-;;; Code:
-
-(require 'ert)
-(require 'parsec)
-
-(ert-deftest test-parsec-ch ()
- (should
- (equal
- (parsec-with-input "ab"
- (parsec-ch ?a)
- (parsec-ch ?b))
- "b"))
- (should
- (equal
- (parsec-with-input "ab"
- (parsec-query (parsec-ch ?a) :beg))
- 1)))
-
-(ert-deftest test-parsec-satisfy ()
- (should
- (equal
- (parsec-with-input "ab"
- (parsec-ch ?a)
- (parsec-satisfy (lambda (c) (char-equal c ?b))))
- "b"))
- (should
- (equal
- (parsec-with-input "ab"
- (parsec-ch ?a)
- (parsec-query (parsec-satisfy (lambda (c) (char-equal c ?b))) :end))
- 3)))
-
-(ert-deftest test-parsec-eol ()
- (should
- (equal
- (parsec-with-input "\na"
- (parsec-newline)
- (parsec-ch ?a))
- "a"))
- (should
- (equal
- (parsec-with-input "\r\na"
- (parsec-crlf)
- (parsec-ch ?a))
- "a"))
- (should
- (equal
- (parsec-with-input "\r\na"
- (parsec-eol)
- (parsec-ch ?a))
- "a"))
- (should
- (equal
- (parsec-with-input "\na"
- (parsec-eol)
- (parsec-ch ?a))
- "a"))
- (should
- (equal
- (parsec-with-input "\ra"
- (parsec-eol)
- (parsech-ch ?a))
- (parsec-error-new-2 "\n" "a"))))
-
-(ert-deftest test-parsec-eof ()
- (should
- (equal
- (parsec-with-input "\r\na"
- (parsec-eol)
- (parsec-ch ?a)
- (parsec-eof))
- nil)))
-
-(ert-deftest test-parsec-re ()
- (should
- (equal
- (parsec-with-input "abc"
- (parsec-query
- (parsec-re "\\(a\\)\\(bc\\)")
- :group 2))
- "bc")))
-
-(ert-deftest test-parsec-make-alternatives ()
- (should
- (equal
- (parsec-make-alternatives '(?-))
- "-"))
- (should
- (equal
- (parsec-make-alternatives '(?- ?\] ?a ?^))
- "]a^-"))
- (should
- (equal
- (parsec-make-alternatives '(?- ?^))
- "-^"))
- (should
- (equal
- (parsec-make-alternatives '(?^ ?\"))
- "\"^")))
-
-(ert-deftest test-parsec-one-of ()
- (should
- (equal
- (parsec-with-input "^]-"
- (parsec-many-as-string (parsec-one-of ?^ ?\] ?-)))
- "^]-"))
- (should
- (equal
- (parsec-with-input "^-"
- (parsec-many-as-string (parsec-one-of ?^ ?-)))
- "^-")))
-
-(ert-deftest test-parsec-none-of ()
- (should
- (equal
- (parsec-with-input "-[]"
- (parsec-none-of ?\] ?^)
- (parsec-one-of ?\[ ?\])
- (parsec-none-of ?- ?^))
- "]")))
-
-(ert-deftest test-parsec-str ()
- (should
- (equal
- (parsec-with-input "abc"
- (parsec-str "abc"))
- "abc"))
- (should
- (equal
- (parsec-with-input "abc"
- (parsec-or (parsec-str "ac")
- (parsec-ch ?a)))
- "a")))
-
-(ert-deftest test-parsec-string ()
- (should
- (equal
- (parsec-with-input "abc"
- (parsec-string "abc"))
- "abc"))
- (should
- (equal
- (parsec-with-input "abc"
- (parsec-or (parsec-string "ac")
- (parsec-ch ?a)))
- (parsec-error-new-2 "c" "b")))
- (should
- (equal
- (parsec-with-input "abc"
- (parsec-or (parsec-try (parsec-string "ac"))
- (parsec-ch ?a)))
- "a")))
-
-(ert-deftest test-parsec-or ()
- (should
- (equal
- (parsec-with-input "1"
- (parsec-or (parsec-letter)
- (parsec-digit)))
- "1"))
- (should
- (equal
- (parsec-with-input "124"
- (parsec-or (parsec-string "13")
- (parsec-ch ?1)))
- (parsec-error-new-2 "3" "2")))
- (should
- (equal
- (parsec-with-input "124"
- (parsec-or (parsec-str "13")
- (parsec-ch ?1)))
- "1")))
-
-(ert-deftest test-parsec-collect-optional ()
- (should
- (equal
- (parsec-with-input "abc-def"
- (parsec-collect-as-string
- (parsec-and
- (parsec-ch ?a)
- (parsec-str "bc"))
- (parsec-optional (parsec-ch ?-))
- (parsec-and
- (parsec-return (parsec-str "de")
- (parsec-ch ?f)))))
- "bc-de"))
- (should
- (equal
- (parsec-with-input "abcdef"
- (parsec-collect-as-string
- (parsec-and
- (parsec-ch ?a)
- (parsec-str "bc"))
- (parsec-optional (parsec-ch ?-))
- (parsec-and
- (parsec-return (parsec-str "de")
- (parsec-ch ?f)))))
- "bcde")))
-
-(ert-deftest test-parsec-try ()
- (should
- (equal
- (parsec-with-input "abc"
- (parsec-or (parsec-try (parsec-string "abd"))
- (parsec-str "abc")))
- "abc")))
-
-(ert-deftest test-parsec-lookahead ()
- (should
- (equal
- (parsec-with-input "abc"
- (parsec-lookahead (parsec-str "abc"))
- (point))
- (point-min)))
- (should
- (equal
- (parsec-with-input "abc"
- (parsec-start
- (parsec-lookahead
- (parsec-and
- (parsec-ch ?a)
- (parsec-ch ?c))))
- (point))
- (1+ (point-min))))
- (should
- (equal
- (parsec-with-input "abc"
- (parsec-start
- (parsec-try
- (parsec-lookahead
- (parsec-and
- (parsec-ch ?a)
- (parsec-ch ?c)))))
- (point))
- (point-min))))
-
-(ert-deftest test-parsec-error-handles ()
- (should
- (equal
- (parsec-with-input "abc"
- (parsec-with-error-message "foo"
- (parsec-str "abd")))
- (parsec-error-new "foo")))
- (should
- (equal
- (parsec-with-input "abc"
- (parsec-with-error-message "foo"
- (parsec-str "abc")))
- "abc"))
- (should
- (equal
- (condition-case err
- (parsec-with-input "abc"
- (parsec-ensure-with-error-message "foo"
- (parsec-str "abd")))
- (error (cdr err)))
- '("foo")))
- (should
- (equal
- (condition-case err
- (parsec-with-input "abc"
- (parsec-ensure-with-error-message "foo"
- (parsec-str "abc")))
- (error (cdr err)))
- "abc")))
-
-(ert-deftest test-parsec-many ()
- (should
- (equal
- (parsec-with-input "aaaaab"
- (parsec-collect-as-string
- (parsec-many-as-string (parsec-ch ?a))
- (parsec-many-as-string (parsec-ch ?c))
- (parsec-many1-as-string (parsec-ch ?b))))
- "aaaaab"))
- (should
- (equal
- (parsec-with-input "aaaaab"
- (parsec-collect-as-string
- (parsec-many-as-string (parsec-ch ?a))
- (parsec-many-as-string (parsec-ch ?c))
- (parsec-many1-as-string (parsec-ch ?b))
- (parsec-many1-as-string (parsec-ch ?c))))
- (parsec-error-new-2 "c" "`EOF'")))
- (should
- (equal
- (parsec-with-input "abababaa"
- (parsec-many1-as-string (parsec-string "ab")))
- (parsec-error-new-2 "b" "a")))
- (should
- (equal
- (parsec-with-input "abababaa"
- (parsec-many1-as-string (parsec-try (parsec-string "ab")))
- (parsec-str "aa"))
- "aa"))
- (should
- (equal
- (parsec-with-input "abababaa"
- (parsec-many1-as-string (parsec-str "ab"))
- (parsec-str "aa"))
- "aa")))
-
-
-(ert-deftest test-parsec-till ()
- (should
- (equal
- (parsec-with-input "abcd"
- (parsec-many-till-as-string (parsec-any-ch) (parsec-ch ?d)))
- "abc"))
- (should
- (equal
- (parsec-with-input "abcd"
- (parsec-many-till-as-string (parsec-any-ch) (parsec-ch ?d) :both))
- '("abc" . "d")))
- (should
- (equal
- (parsec-with-input "abcd"
- (parsec-many-till-as-string (parsec-any-ch) (parsec-ch ?d) :end))
- "d"))
- (should
- (equal
- (parsec-with-input "abcd"
- (parsec-with-error-message "eof"
- (parsec-many-till-as-string (parsec-any-ch) (parsec-ch ?e))))
- (parsec-error-new "eof")))
- (should
- (equal
- (parsec-with-input "abc"
- (parsec-until-as-string (parsec-ch ?c)))
- "ab"))
- (should
- (equal
- (parsec-with-input "abc"
- (parsec-until-as-string (parsec-ch ?c) :end))
- "c"))
- (should
- (equal
- (parsec-with-input "abc"
- (parsec-query (parsec-until-as-string (parsec-ch ?c)) :beg))
- 1)))
-
-(ert-deftest test-parsec-not-followed-by ()
- (should
- (equal
- (parsec-with-input "abd"
- (parsec-collect*
- (parsec-str "ab")
- (parsec-not-followed-by (parsec-ch ?c))
- (parsec-ch ?d)))
- '("ab" "d")))
- (should
- (equal
- (parsec-with-input "abd"
- (parsec-collect*
- (parsec-str "ab")
- (parsec-or (parsec-not-followed-by (parsec-ch ?d))
- (parsec-not-followed-by (parsec-ch ?c)))
- (parsec-ch ?d)))
- '("ab" "d"))))
-
-(ert-deftest test-parsec-endby ()
- (should
- (equal
- (parsec-with-input "abc\ndef"
- (parsec-endby (parsec-many-as-string (parsec-letter))
- (parsec-eol-or-eof)))
- '("abc" "def"))))
-
-(ert-deftest test-parsec-sepby ()
- (should
- (equal
- (parsec-with-input "ab,cd,ef"
- (parsec-sepby (parsec-many-as-string (parsec-re "[^,]"))
- (parsec-ch ?,)))
- '("ab" "cd" "ef"))))
-
-(ert-deftest test-parsec-between ()
- (should
- (equal
- (parsec-with-input "{abc}"
- (parsec-between
- (parsec-ch ?\{) (parsec-ch ?\})
- (parsec-or
- (parsec-str "ac")
- (parsec-many-as-string (parsec-letter)))))
- "abc"))
- (should
- (equal
- (parsec-with-input "{abc}"
- (parsec-between
- (parsec-ch ?\{) (parsec-ch ?\})
- (parsec-or
- (parsec-string "ac")
- (parsec-many-as-string (parsec-letter)))))
- (parsec-error-new-2 "c" "b"))))
-
-(ert-deftest test-parsec-count ()
- (should
- (equal
- (parsec-with-input "aaaab"
- (parsec-return (parsec-count-as-string 3 (parsec-ch ?a))
- (parsec-many1 (parsec-one-of ?a ?b))))
- "aaa")))
-
-(ert-deftest test-parsec-option ()
- (should
- (equal
- (parsec-with-input "ab"
- (parsec-option "opt" (parsec-string "ac")))
- (parsec-error-new-2 "c" "b")))
- (should
- (equal
- (parsec-with-input "ab"
- (parsec-option "opt" (parsec-str "ac")))
- "opt"))
- (should
- (equal
- (parsec-with-input "ab"
- (parsec-option "opt" (parsec-string "ab")))
- "ab")))
-
-(ert-deftest test-parsec-optional ()
- (should
- (equal
- (parsec-with-input "abcdef"
- (parsec-collect-as-string
- (parsec-str "abc")
- (parsec-optional (parsec-ch ?-))
- (parsec-str "def")))
- "abcdef"))
- (should
- (equal
- (parsec-with-input "abc-def"
- (parsec-collect-as-string
- (parsec-str "abc")
- (parsec-optional (parsec-ch ?-))
- (parsec-str "def")))
- "abc-def"))
- (should
- (equal
- (parsec-with-input "abcdef"
- (parsec-collect-as-string
- (parsec-str "abc")
- (parsec-from-maybe (parsec-optional-maybe (parsec-ch ?-)))
- (parsec-str "def")))
- "abcdef"))
- (should
- (equal
- (parsec-with-input "abc-def"
- (parsec-collect-as-string
- (parsec-str "abc")
- (parsec-from-maybe (parsec-optional-maybe (parsec-ch ?-)))
- (parsec-str "def")))
- "abc-def")))
-
-(provide 'parsec-tests)
-;;; parsec-tests.el ends here
diff --git a/packages/parsec/parsec.el b/packages/parsec/parsec.el
deleted file mode 100644
index 3432e3d..0000000
--- a/packages/parsec/parsec.el
+++ /dev/null
@@ -1,1042 +0,0 @@
-;;; parsec.el --- Parser combinator library -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2016 Free Software Foundation, Inc.
-
-;; Author: Junpeng Qiu <qjpchmail@gmail.com>
-;; Maintainer: Junpeng Qiu <qjpchmail@gmail.com>
-;; URL: https://github.com/cute-jumper/parsec.el
-;; Version: 0.1.3
-;; Package-Requires: ((emacs "24") (cl-lib "0.5"))
-;; Keywords: extensions
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; _____________
-
-;; PARSEC.EL
-
-;; Junpeng Qiu
-;; _____________
-
-
-;; Table of Contents
-;; _________________
-
-;; 1 Overview
-;; 2 Parsing Functions & Parser Combinators
-;; .. 2.1 Basic Parsing Functions
-;; .. 2.2 Parser Combinators
-;; .. 2.3 Parser Utilities
-;; .. 2.4 Variants that Return a String
-;; 3 Code Examples
-;; 4 Write a Parser: a Simple CSV Parser
-;; 5 More Parser Examples
-;; 6 Change the Return Values using `parsec-query'
-;; 7 Error Messages
-;; 8 Acknowledgement
-
-
-;; A parser combinator library for Emacs Lisp similar to Haskell's Parsec
-;; library.
-
-
-;; 1 Overview
-;; ==========
-
-;; This work is based on [John Wiegley]'s [emacs-pl]. The original
-;; [emacs-pl] is awesome, but I found following problems when I tried to
-;; use it:
-
-;; - It only contains a very limited set of combinators
-;; - Some of its functions (combinators) have different behaviors than
-;; their Haskell counterparts
-;; - It can't show error messages when parsing fails
-
-;; So I decided to make a new library on top of it. This library,
-;; however, contains most of the parser combinators in
-;; `Text.Parsec.Combinator', which should be enough in most use cases. Of
-;; course more combinators can be added if necessary! Most of the parser
-;; combinators have the same behavior as their Haskell counterparts.
-;; `parsec.el' also comes with a simple error handling mechanism so that
-;; it can display an error message showing how the parser fails.
-
-;; So we can
-
-;; - use these parser combinators to write parsers easily from scratch in
-;; Emacs Lisp like what we can do in Haskell
-;; - port existing Haskell program using Parsec to its equivalent Emacs
-;; Lisp program easily
-
-
-;; [John Wiegley] https://github.com/jwiegley/
-
-;; [emacs-pl] https://github.com/jwiegley/emacs-pl
-
-
-;; 2 Parsing Functions & Parser Combinators
-;; ========================================
-
-;; We compare the functions and macros defined in this library with their
-;; Haskell counterparts, assuming you're already familiar with Haskell's
-;; Parsec. If you don't have any experience with parser combinators, look
-;; at the docstrings of these functions and macros and try them to see
-;; the results! They are really easy to learn and use!
-
-;; The *Usage* column for each function/combinator in the following
-;; tables is much simplified. Check the docstring of the
-;; function/combinator to see the full description.
-
-
-;; 2.1 Basic Parsing Functions
-;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-;; These parsing functions are used as the basic building block for a
-;; parser. By default, their return value is a *string*.
-
-;; parsec.el Haskell's Parsec Usage
-;;
-------------------------------------------------------------------------------------------------
-;; parsec-ch char parse a character
-;; parsec-any-ch anyChar parse an arbitrary character
-;; parsec-satisfy satisfy parse a character satisfying a
predicate
-;; parsec-newline newline parse '\n'
-;; parsec-crlf crlf parse '\r\n'
-;; parsec-eol eol parse newline or CRLF
-;; parsec-eof, parsec-eob eof parse end of file
-;; parsec-eol-or-eof *N/A* parse EOL or EOL
-;; parsec-re *N/A* parse using a regular
expression
-;; parsec-one-of oneOf parse one of the characters
-;; parsec-none-of noneOf parse any character other than
the supplied ones
-;; parsec-str *N/A* parse a string but consume
input only when successful
-;; parsec-string string parse a string and consume
input for partial matches
-;; parsec-num *N/A* parse a number
-;; parsec-letter letter parse a letter
-;; parsec-digit digit parse a digit
-
-;; Note:
-;; - `parsec-str' and `parsec-string' are different. `parsec-string'
-;; behaves the same as `string' in Haskell, and `parsec-str' is more
-;; like combining `string' and `try' in Haskell. Personally I found
-;; `parsec-str' easier to use because `parsec-str' is "atomic", which
-;; is similar to `parsec-ch'.
-;; - Use the power of regular expressions provided by `parsec-re' and
-;; simplify the parser!
-
-
-;; 2.2 Parser Combinators
-;; ~~~~~~~~~~~~~~~~~~~~~~
-
-;; These combinators can be used to combine different parsers.
-
-;; parsec.el Haskell's Parsec Usage
-;;
-----------------------------------------------------------------------------------------------------------
-;; parsec-or choice try the parsers until one
succeeds
-;; parsec-try try try parser and consume no
input when an error occurs
-;; parsec-lookahead lookahead try parser and consume no
input when successful
-;; parsec-peek try && lookahead try parser without
comsuming any input
-;; parsec-peek-p try && lookahead same as parsec-peek except
the return value for failure
-;; parsec-with-error-message <?> (similar) use the new error message
when an error occurs
-;; parsec-many many apply the parser zero or
more times
-;; parsec-many1 many1 apply the parser one or
more times
-;; parsec-many-till manyTill apply parser zero or more
times until end succeeds
-;; parsec-until *N/A* parse until end succeeds
-;; parsec-not-followed-by notFollowedBy succeed when the parser
fails
-;; parsec-endby endby apply parser zero or more
times, separated and ended by end
-;; parsec-sepby sepby apply parser zero or more
times, separated by sep
-;; parsec-between between apply parser between open
and close
-;; parsec-count count apply parser n times
-;; parsec-option option apply parser, if it fails,
return opt
-;; parsec-optional *N/A* apply parser zero or one
time and return the result
-;; parsec-optional* optional apply parser zero or one
time and discard the result
-;; parsec-optional-maybe optionMaybe apply parser zero or one
time and return the result in Maybe
-
-;; Note:
-;; - `parsec-or' can also be used to replace `<|>'.
-;; - `parsec-with-error-message' is slightly different from `<?>'. It
-;; will replace the error message even when the input is consumed.
-;; - By default, `parsec-many-till' behaves as Haskell's `manyTill'.
-;; However, `parsec-many-till' and `parsec-until' can accept an
-;; optional argument to specify which part(s) to be returned. You can
-;; use `:both' or `:end' as the optional argument to change the default
-;; behavior. See the docstrings for more information.
-
-
-;; 2.3 Parser Utilities
-;; ~~~~~~~~~~~~~~~~~~~~
-
-;; These utilities can be used together with parser combinators to build
-;; a parser and ease the translation process if you're trying to port an
-;; existing Haskell program.
-
-;; parsec.el Haskell's Parsec Usage
-;;
-------------------------------------------------------------------------------------------------------------
-;; parsec-and do block try all parsers and
return the last result
-;; parsec-return do block try all parsers and
return the first result
-;; parsec-ensure *N/A* quit the parsing
when an error occurs
-;; parsec-ensure-with-error-message *N/A* quit the parsing
when an error occurs with new message
-;; parsec-collect sequence try all parsers and
collect the results into a list
-;; parsec-collect* *N/A* try all parsers and
collect non-nil results into a list
-;; parsec-start parse entry point
-;; parsec-parse parse entry point (same as
parsec-start)
-;; parsec-with-input parse perform parsers on
input
-;; parsec-from-maybe fromMaybe retrieve value from
Maybe
-;; parsec-maybe-p *N/A* is a Maybe value or
not
-;; parsec-query *N/A* change the parser's
return value
-
-
-;; 2.4 Variants that Return a String
-;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-;; By default, the macros/functions that return multiple values will put
-;; the values into a list. These macros/functions are:
-;; - `parsec-many'
-;; - `parsec-many1'
-;; - `parsec-many-till'
-;; - `parsec-until'
-;; - `parsec-count'
-;; - `parsec-collect' and `parsec-collect*'
-
-;; They all have a variant that returns a string by concatenating the
-;; results in the list:
-;; - `parsec-many-as-string' or `parsec-many-s'
-;; - `parsec-many1-as-string' or `parsec-many1-s'
-;; - `parsec-many-till-as-string' or `parsec-many-till-s'
-;; - `parsec-until-as-string' or `parsec-until-s'
-;; - `parsec-collect-as-string' or `parsec-collect-s'
-;; - `parsec-count-as-string' or `parsec-count-s'
-
-;; The `*-s' and `*-as-string' variants are the same, except the `*-s'
-;; variants have a shorter name. Using these `*-s' functions are
-;; recommended if you're dealing with strings very frequently in your
-;; code. These variants accept the same arguments and have the same
-;; behavior as their original counterpart that returns a list. The only
-;; difference is the return value.
-
-
-;; 3 Code Examples
-;; ===============
-
-;; Some very simple examples are given here. You can see many code
-;; examples in the test files in this GitHub repo.
-
-;; The following code extract the "hello" from the comment:
-;; ,----
-;; | (parsec-with-input "/* hello */"
-;; | (parsec-string "/*")
-;; | (parsec-many-till-as-string (parsec-any-ch)
-;; | (parsec-try
-;; | (parsec-string "*/"))))
-;; `----
-
-;; The following Haskell program does a similar thing:
-;; ,----
-;; | import Text.Parsec
-;; |
-;; | main :: IO ()
-;; | main = print $ parse p "" "/* hello */"
-;; | where
-;; | p = do string "/*"
-;; | manyTill anyChar (try (string "*/"))
-;; `----
-
-;; The following code returns the "aeiou" before "end":
-;; ,----
-;; | (parsec-with-input "if aeiou end"
-;; | (parsec-str "if ")
-;; | (parsec-return
-;; | (parsec-many-as-string (parsec-one-of ?a ?e ?i ?o ?u))
-;; | (parsec-str " end")))
-;; `----
-
-
-;; 4 Write a Parser: a Simple CSV Parser
-;; =====================================
-
-;; You can find the code in `examples/simple-csv-parser.el'. The code is
-;; based on the Haskell code in [Using Parsec].
-
-;; An end-of-line should be a string `\n'. We use `(parsec-str "\n")' to
-;; parse it (Note that since `\n' is also one character, `(parsec-ch
-;; ?\n)' also works). Some files may not contain a newline at the end,
-;; but we can view end-of-file as the end-of-line for the last line, and
-;; use `parsec-eof' (or `parsec-eob') to parse the end-of-file. We use
-;; `parsec-or' to combine these two combinators:
-;; ,----
-;; | (defun s-csv-eol ()
-;; | (parsec-or (parsec-str "\n")
-;; | (parsec-eof)))
-;; `----
-
-;; A CSV file contains many lines and ends with an end-of-file. Use
-;; `parsec-return' to return the result of the first parser as the
-;; result.
-;; ,----
-;; | (defun s-csv-file ()
-;; | (parsec-return (parsec-many (s-csv-line))
-;; | (parsec-eof)))
-;; `----
-
-;; A CSV line contains many CSV cells and ends with an end-of-line, and
-;; we should return the cells as the results:
-;; ,----
-;; | (defun s-csv-line ()
-;; | (parsec-return (s-csv-cells)
-;; | (s-csv-eol)))
-;; `----
-
-;; CSV cells is a list, containing the first cell and the remaining
-;; cells:
-;; ,----
-;; | (defun s-csv-cells ()
-;; | (cons (s-csv-cell-content) (s-csv-remaining-cells)))
-;; `----
-
-;; A CSV cell consists any character that is not =,= or `\n', and we use
-;; the `parsec-many-as-string' variant to return the whole content as a
-;; string instead of a list of single-character strings:
-;; ,----
-;; | (defun s-csv-cell-content ()
-;; | (parsec-many-as-string (parsec-none-of ?, ?\n)))
-;; `----
-
-;; For the remaining cells: if followed by a comma =,=, we try to parse
-;; more csv cells. Otherwise, we should return the `nil':
-;; ,----
-;; | (defun s-csv-remaining-cells ()
-;; | (parsec-or (parsec-and (parsec-ch ?,) (s-csv-cells)) nil))
-;; `----
-
-;; OK. Our parser is almost done. To begin parsing the content in buffer
-;; `foo', you need to wrap the parser inside `parsec-start' (or
-;; `parsec-parse'):
-;; ,----
-;; | (with-current-buffer "foo"
-;; | (goto-char (point-min))
-;; | (parsec-parse
-;; | (s-csv-file)))
-;; `----
-
-;; If you want to parse a string instead, we provide a simple wrapper
-;; macro `parsec-with-input', and you feed a string as the input and put
-;; arbitraty parsers inside the macro body. `parsec-start' or
-;; `parsec-parse' is not needed.
-;; ,----
-;; | (parsec-with-input "a1,b1,c1\na2,b2,c2"
-;; | (s-csv-file))
-;; `----
-
-;; The above code returns:
-;; ,----
-;; | (("a1" "b1" "c1") ("a2" "b2" "c2"))
-;; `----
-
-;; Note that if we replace `parsec-many-as-string' with `parsec-many' in
-;; `s-csv-cell-content':
-;; ,----
-;; | (defun s-csv-cell-content ()
-;; | (parsec-many (parsec-none-of ?, ?\n)))
-;; `----
-
-;; The result would be:
-;; ,----
-;; | ((("a" "1") ("b" "1") ("c" "1")) (("a" "2") ("b" "2") ("c" "2")))
-;; `----
-
-
-;; [Using Parsec] http://book.realworldhaskell.org/read/using-parsec.html
-
-
-;; 5 More Parser Examples
-;; ======================
-
-;; I translate some Haskell Parsec examples into Emacs Lisp using
-;; `parsec.el'. You can see from these examples that it is very easy to
-;; write parsers using `parsec.el', and if you know haskell, you can see
-;; that basically I just translate the Haskell into Emacs Lisp one by one
-;; because most of them are just the same!
-
-;; You can find five examples under the `examples/' directory.
-
-;; Three of the examples are taken from the chapter [Using Parsec] in the
-;; book of [Real World Haskell]:
-;; - `simple-csv-parser.el': a simple csv parser with no support for
-;; quoted cells, as explained in previous section.
-;; - `full-csv-parser.el': a full csv parser
-;; - `url-str-parser.el': parser parameters in URL
-
-;; `pjson.el' is a translation of Haskell's [json library using Parsec].
-
-;; `scheme.el' is a much simplified Scheme parser based on [Write
-;; Yourself a Scheme in 48 Hours].
-
-;; They're really simple but you can see how this library works!
-
-
-;; [Using Parsec] http://book.realworldhaskell.org/read/using-parsec.html
-
-;; [Real World Haskell] http://book.realworldhaskell.org/read/
-
-;; [json library using Parsec]
-;;
https://hackage.haskell.org/package/json-0.9.1/docs/src/Text-JSON-Parsec.html
-
-;; [Write Yourself a Scheme in 48 Hours]
-;; https://en.wikibooks.org/wiki/Write_Yourself_a_Scheme_in_48_Hours/
-
-
-;; 6 Change the Return Values using `parsec-query'
-;; ===============================================
-
-;; Parsing has side-effects such as forwarding the current point. In the
-;; original [emacs-pl], you can specify some optional arguments to some
-;; parsing functions (`pl-ch', `pl-re' etc.) to change the return values.
-;; In `parsec.el', these functions don't have such a behavior. Instead,
-;; we provide a unified interface `parsec-query', which accepts any
-;; parser, and changes the return value of the parser.
-
-;; You can speicify following arguments:
-;; ,----
-;; | :beg --> return the point before applying the PARSER
-;; | :end --> return the point after applying the PARSER
-;; | :nil --> return nil
-;; | :groups N --> return Nth group for `parsec-re'."
-;; `----
-
-;; So instead of returning "b" as the result, the following code returns
-;; 2:
-;; ,----
-;; | (parsec-with-input "ab"
-;; | (parsec-ch ?a)
-;; | (parsec-query (parsec-ch ?b) :beg))
-;; `----
-
-;; Returning a point means that you can also incorporate `parsec.el' with
-;; Emacs Lisp functions that can operate on points/regions, such as
-;; `goto-char' and `kill-region'.
-
-;; `:group' can be specified when using `parsec-re':
-;; ,----
-;; | (parsec-with-input "ab"
-;; | (parsec-query (parsec-re "\\(a\\)\\(b\\)") :group 2))
-;; `----
-
-;; The above code will return "b" instead of "ab".
-
-
-;; [emacs-pl] https://github.com/jwiegley/emacs-pl
-
-
-;; 7 Error Messages
-;; ================
-
-;; `parsec.el' implements a simple error handling mechanism. When an
-;; error happens, it will show how the parser fails.
-
-;; For example, the following code fails:
-;; ,----
-;; | (parsec-with-input "aac"
-;; | (parsec-count 2 (parsec-ch ?a))
-;; | (parsec-ch ?b))
-;; `----
-
-;; The return value is:
-;; ,----
-;; | (parsec-error . "Found \"c\" -> Expected \"b\"")
-;; `----
-
-;; This also works when parser combinators fail:
-;; ,----
-;; | (parsec-with-input "a"
-;; | (parsec-or (parsec-ch ?b)
-;; | (parsec-ch ?c)))
-;; `----
-
-;; The return value is:
-;; ,----
-;; | (parsec-error . "None of the parsers succeeds:
-;; | Found \"a\" -> Expected \"c\"
-;; | Found \"a\" -> Expected \"b\"")
-;; `----
-
-;; If an error occurs, the return value is a cons cell that contains the
-;; error message in its `cdr'. Compared to Haskell's Parsec, it's really
-;; simple, but at least the error message could tell us some information.
-;; Yeah, not perfect but usable.
-
-;; To test whether a parser returns an error, use `parsec-error-p'. If it
-;; returns an error, you can use `parsec-error-str' to retrieve the error
-;; message as a string.
-
-;; You can decide what to do based on the return value of a parser:
-;; ,----
-;; | (let ((res (parsec-with-input "hello"
-;; | (parsec-str "world"))))
-;; | (if (parsec-error-p res)
-;; | (message "Parser failed:\n%s" (parsec-error-str res))
-;; | (message "Parser succeeded by returning %s" res)))
-;; `----
-
-
-;; 8 Acknowledgement
-;; =================
-
-;; - Daan Leijen for Haskell's Parsec
-;; - [John Wiegley] for [emacs-pl]
-
-
-;; [John Wiegley] https://github.com/jwiegley/
-
-;; [emacs-pl] https://github.com/jwiegley/emacs-pl
-
-;;; Code:
-
-(require 'cl-lib)
-
-(defgroup parsec nil
- "Parser combinators for Emacs Lisp"
- :group 'development)
-
-(defvar parsec-last-error-message nil)
-
-(defun parsec-eof-or-char-as-string ()
- (let ((c (char-after)))
- (if c
- (char-to-string c)
- "`EOF'")))
-
-(defun parsec-error-new (msg)
- (cons 'parsec-error msg))
-
-(defun parsec-error-new-2 (expected found)
- (parsec-error-new (format "Found \"%s\" -> Expected \"%s\""
- found expected)))
-
-(defun parsec-error-p (obj)
- (and (consp obj)
- (eq (car obj) 'parsec-error)))
-
-(defalias 'parsec-error-str 'cdr)
-
-(defsubst parsec-throw (msg)
- (throw 'parsec-failed msg))
-
-(defun parsec-stop (&rest args)
- (parsec-throw
- (setq parsec-last-error-message
- (let ((msg (plist-get args :message))
- (expected (plist-get args :expected))
- (found (plist-get args :found)))
- (when (or (stringp msg)
- (and (stringp expected)
- (stringp found)))
- (if (stringp msg)
- (parsec-error-new msg)
- (parsec-error-new-2 expected found)))))))
-
-(defun parsec-ch (ch)
- "Parse a character CH."
- (let ((next-char (char-after)))
- (if (and (not (eobp))
- (char-equal next-char ch))
- (progn (forward-char 1)
- (char-to-string ch))
- (parsec-stop :expected (char-to-string ch)
- :found (parsec-eof-or-char-as-string)))))
-
-(defun parsec-any-ch ()
- "Parse any character."
- (if (not (eobp))
- (prog1 (char-to-string (char-after))
- (forward-char))
- (parsec-stop :expected "any char"
- :found (parsec-eof-or-char-as-string))))
-
-(defun parsec-satisfy (pred)
- "Parse any character that satisfies the predicate PRED."
- (let ((next-char (char-after)))
- (if (and (not (eobp))
- (funcall pred next-char))
- (progn (forward-char 1)
- (char-to-string next-char))
- (parsec-stop :expected (format "%s" pred)
- :found (parsec-eof-or-char-as-string)))))
-
-(defun parsec-re (regexp)
- "Parse the input matching the regular expression REGEXP."
- (if (looking-at regexp)
- (progn (goto-char (match-end 0))
- (match-string 0))
- (parsec-stop :expected regexp
- :found (parsec-eof-or-char-as-string))))
-
-(defun parsec-make-alternatives (chars)
- (let ((regex-head "")
- (regex-str "")
- (regex-end "")
- contains-caret-p)
- (dolist (c chars)
- (cond
- ((char-equal c ?\]) (setq regex-head "]"))
- ((char-equal c ?-) (setq regex-end "-"))
- ((char-equal c ?^) (setq contains-caret-p t))
- (t (setq regex-str (concat regex-str (char-to-string c))))))
- (when contains-caret-p
- (if (and
- (string-equal regex-end "-")
- (string-equal regex-head "")
- (string-equal regex-str ""))
- (setq regex-end "-^")
- (setq regex-str (concat regex-str "^"))))
- (concat regex-head regex-str regex-end)))
-
-(defun parsec-one-of (&rest chars)
- "Succeed if the current character is in the supplied list of CHARS.
-Return the parsed character.
-
-> (parsec-one-of ?a ?e ?i ?o ?u)
-
-Note this function is just a wrapper of `parsec-re'. For complicated use
cases,
-consider using `parsec-re' instead."
- (parsec-re (format "[%s]" (parsec-make-alternatives chars))))
-
-(defun parsec-none-of (&rest chars)
- "Succeed if the current character not in the supplied list of CHARS.
-Return the parsed character.
-
-> (parsec-none-of ?a ?e ?i ?o ?u)
-
-Note this function is just a wrapper of `parsec-re'. For complicated use
cases,
-consider using `parsec-re' instead."
- (parsec-re (format "[^%s]" (parsec-make-alternatives chars))))
-
-(defsubst parsec-str (str)
- "Parse STR and only consume the input for an exact match.
-Return the parsed string.
-
-Note this function's behavior is different from the `string'
-function of Haskll's Parsec. Use `parsec-string' if you want the
-same behavior as in Haskell."
- (parsec-re (regexp-quote str)))
-
-(defsubst parsec-string (str)
- "Parse STR and consume the input even for a partial match.
-Return the parsed string.
-
-It is equivalent to calling `parsec-ch' multiples times so the
-input will be consumed if the parser fails in the middle of the
-STR. This function has the same behavior as the `string' function
-of Haskell's Parsec. See also `parsec-str'."
- (mapc (lambda (c) (parsec-ch c)) str))
-
-(defsubst parsec-num (num)
- "Parse the number NUM and return the parsed number as a string."
- (parsec-re (regexp-quote (number-to-string num))))
-
-(defsubst parsec-letter ()
- "Parse any English letter."
- (parsec-re "[a-zA-Z]"))
-
-(defsubst parsec-digit ()
- "Parse any digit."
- (parsec-re "[0-9]"))
-
-(defmacro parsec-or (&rest parsers)
- "Try the PARSERS one by one.
-If the current parser succeeds, return its results. If the
-current parser fails without consuming any input, try the next
-parser if available. This combinator fails if the current parser
-fails after consuming some input or there is no more parsers."
- (let ((parser-sym (make-symbol "parser"))
- (error-sym (make-symbol "err"))
- (error-str-list-sym (make-symbol "err-list")))
- `(let (,error-str-list-sym ,parser-sym ,error-sym)
- (catch 'parsec-failed-or
- ,@(mapcar
- (lambda (parser)
- `(parsec-protect-atom parsec-or
- (parsec-start
- (throw 'parsec-failed-or
- (parsec-eavesdrop-error ,error-sym
- (parsec-make-atom parsec-or ,parser)
- (push (parsec-error-str ,error-sym)
,error-str-list-sym))))))
- parsers)
- (parsec-stop
- :message
- (replace-regexp-in-string
- "\n" "\n\t"
- (concat "None of the parsers succeeds:\n"
- (mapconcat #'identity ,error-str-list-sym "\n"))))))))
-
-(defalias 'parsec-and 'progn
- "Eval BODY sequentially and return the result of the last parser.
-This combinator fails if one of the parsers fails.")
-
-(defalias 'parsec-return 'prog1
- "Eval FIRST and BODY sequentially and return the results of the first parser.
-This combinator fails if one of the parsers fails.")
-
-(defalias 'parsec-collect 'list
- "Collect the results of all the parsers OBJECTS into a list.")
-
-(defun parsec-collect* (&rest args)
- "Collect the non-nil results of all the parsers ARGS into a list."
- (delq nil (apply #'parsec-collect args)))
-
-(defmacro parsec-collect-as-string (&rest forms)
- "Collect the results of all the parsers FORMS as a string."
- `(parsec-list-to-string (parsec-collect ,@forms)))
-
-(defalias 'parsec-collect-s 'parsec-collect-as-string)
-
-(defmacro parsec-start (&rest forms)
- "Eval the parsers FORMS and return the results or a `parsec-error'.
-This combinator should be used at the top level as the entry
-point of your parsing program."
- `(catch 'parsec-failed ,@forms))
-
-(defalias 'parsec-parse 'parsec-start)
-
-(defmacro parsec-try (parser)
- "Try PARSER, and pretend that no input is consumed when an error occurs."
- (let ((orig-pt-sym (make-symbol "orig-pt"))
- (error-sym (make-symbol "err")))
- `(let ((,orig-pt-sym (point)))
- (parsec-eavesdrop-error ,error-sym
- (parsec-and ,parser)
- (goto-char ,orig-pt-sym)))))
-
-(defmacro parsec-lookahead (parser)
- "Try PARSER, and pretend that no input is consumed when it succeeds."
- (let ((orig-pt-sym (make-symbol "orig-pt")))
- `(let ((,orig-pt-sym (point)))
- (parsec-return ,parser
- (goto-char ,orig-pt-sym)))))
-
-(defsubst parsec--atom-tag (name)
- (intern (format "parsec-failed-at-half-%s" name)))
-
-(defmacro parsec-protect-atom (name parser)
- "This must be used together with `parsec-make-atom'."
- (declare (indent 1))
- (let ((tag (parsec--atom-tag name)))
- `(catch 'parsec-failed-protect-atom
- (parsec-throw (catch ',tag
- (throw 'parsec-failed-protect-atom ,parser))))))
-
-(defmacro parsec-make-atom (name parser)
- (let ((orig-pt-sym (make-symbol "orig-pt"))
- (error-sym (make-symbol "err"))
- (tag (parsec--atom-tag name)))
- `(let ((,orig-pt-sym (point)))
- (parsec-eavesdrop-error ,error-sym
- ,parser
- (unless (= (point) ,orig-pt-sym)
- (throw ',tag ,error-sym))))))
-
-(defmacro parsec-eavesdrop-error (error-sym parser &rest handler)
- (declare (indent 2))
- `(catch 'parsec-failed-eavesdrop-error
- (let ((,error-sym (parsec-start
- (throw 'parsec-failed-eavesdrop-error ,parser))))
- ,@handler
- (parsec-throw ,error-sym))))
-
-(defmacro parsec-with-error-message (msg &rest forms)
- "Use MSG as the error message if an error occurs when Evaling the FORMS."
- (declare (indent 1))
- `(parsec-eavesdrop-error _
- (parsec-and ,@forms)
- (parsec-throw (parsec-error-new ,msg))))
-
-(defmacro parsec-ensure (&rest forms)
- "Exit the program immediately if FORMS fail."
- (let ((error-sym (make-symbol "err")))
- `(parsec-eavesdrop-error ,error-sym
- (parsec-and ,@forms)
- (error "%s" (parsec-error-str ,error-sym)))))
-
-(defmacro parsec-ensure-with-error-message (msg &rest forms)
- "Exit the program immediately with MSG if FORMS fail."
- (declare (indent 1))
- `(parsec-ensure
- (parsec-with-error-message ,msg
- (parsec-and ,@forms))))
-
-(defmacro parsec-many (parser)
- "Apply the PARSER zero or more times and return a list of the results."
- (let ((res-sym (make-symbol "results")))
- `(let (,res-sym)
- (parsec-protect-atom parsec-many
- (parsec-start
- (while (not (eobp))
- (push (parsec-make-atom parsec-many ,parser) ,res-sym))))
- (nreverse ,res-sym))))
-
-(defmacro parsec-many1 (parser)
- "Apply the PARSER one or more times and return a list of the results."
- `(cons ,parser (parsec-many ,parser)))
-
-(defsubst parsec-list-to-string (l)
- (if (stringp l)
- l
- (mapconcat #'identity l "")))
-
-(defmacro parsec-many-as-string (parser)
- "Apply the PARSER zero or more times and return the results as a string."
- `(mapconcat #'identity (parsec-many ,parser) ""))
-
-(defalias 'parsec-many-s 'parsec-many-as-string)
-
-(defmacro parsec-many1-as-string (parser)
- "Apply the PARSER one or more times and return the results as a string."
- `(mapconcat #'identity (parsec-many1 ,parser) ""))
-
-(defalias 'parsec-many1-s 'parsec-many1-as-string)
-
-(defmacro parsec-many-till (parser end &optional type)
- "Apply PARSER zero or more times until END succeeds.
-The return value is determined by TYPE. If TYPE is `:both', return
-the cons `(many . end)'. If TYPE is `:end', return the result of END.
-In other cases, return the result of PARSER.
-
-Used to scan comments:
-
-> (parsec-and
-> (parsec-str \"<--\")
-> (parsec-many-till (parsec-any-ch) (parsec-str \"-->\")))"
-
- (let ((res-sym (make-symbol "results"))
- (end-res-sym (make-symbol "end-result")))
- `(let ((,res-sym nil) ,end-res-sym)
- (setq ,end-res-sym
- (catch 'parsec-failed-many-till
- (while t
- (parsec-or (throw 'parsec-failed-many-till ,end)
- (push ,parser ,res-sym)))))
- (setq ,res-sym (nreverse ,res-sym))
- ,(cond
- ((eq type :both) `(cons ,res-sym ,end-res-sym))
- ((eq type :end) end-res-sym)
- (t res-sym)))))
-
-(defmacro parsec-many-till-as-string (parser end &optional type)
- "Apply PARSER zero or more times until END succeeds.
-Return the result of PARSER or END as a string. TYPE has the same
-meaning as `parsec-many-till'."
- (let ((res-sym (make-symbol "results")))
- (cond
- ((eq type :both)
- `(let ((,res-sym (parsec-many-till ,parser ,end ,type)))
- (cons (parsec-list-to-string (car ,res-sym))
- (parsec-list-to-string (cdr ,res-sym)))))
- (t
- `(parsec-list-to-string (parsec-many-till ,parser ,end ,type))))))
-
-(defalias 'parsec-many-till-s 'parsec-many-till-as-string)
-
-(defmacro parsec-until (parser &optional type)
- "Parse any characters until PARSER succeeds.
-TYPE has the same meaning as `parsec-many-till'."
- `(parsec-many-till (parsec-any-ch) ,parser ,type))
-
-(defmacro parsec-until-as-string (parser &optional type)
- "Parse any characters until PARSER succeeds.
-Return the result of either part as a string. TYPE has the same
-meaning as `parsec-many-till'."
- `(parsec-many-till-as-string (parsec-any-ch) ,parser ,type))
-
-(defalias 'parsec-until-s 'parsec-until-as-string)
-
-(defmacro parsec-not-followed-by (parser)
- "Succeed only when PARSER fails. Consume no input."
- (let ((res-sym (make-symbol "results")))
- `(catch 'parsec-failed-not-followed-by-out
- (parsec-try
- (let ((,res-sym
- (catch 'parsec-failed-not-followed-by-in
- (throw 'parsec-failed-not-followed-by-out
- (parsec-or (throw 'parsec-failed-not-followed-by-in
(parsec-try ,parser))
- nil)))))
- (parsec-stop :message (format "Unexpected followed by: %s"
,res-sym)))))))
-
-(defmacro parsec-endby (parser end)
- "Parse zero or more occurrences of PARSER, separated and ended by END.
-Return a list of values returned by PARSER."
- `(parsec-many (parsec-return ,parser
- ,end)))
-
-(defmacro parsec-sepby (parser separator)
- "Parse zero or more occurrences of PARSER, separated by SEPARATOR.
-Return a list of values returned by PARSER."
- `(parsec-or
- (cons ,parser (parsec-many (parsec-and ,separator ,parser)))
- nil))
-
-(defmacro parsec-between (open close parser)
- "Parse OPEN, followed by PARSER and CLOSE.
-Return the value returned by PARSER."
- `(parsec-and
- ,open
- (parsec-return ,parser
- ,close)))
-
-(defmacro parsec-count (n parser)
- "Parse N occurrences of PARSER.
-Return a list of N values returned by PARSER."
- (let ((res-sym (make-symbol "results")))
- `(let (,res-sym)
- (dotimes (_ ,n ,res-sym)
- (push ,parser ,res-sym)))))
-
-(defmacro parsec-count-as-string (n parser)
- "Parse N occurrences of PARSER.
-Return the N values returned by PARSER as a string."
- `(parsec-list-to-string (parsec-count ,n ,parser)))
-
-(defalias 'parsec-count-s 'parsec-count-as-string)
-
-(defmacro parsec-option (opt parser)
- "Try to apply PARSER and return OPT if PARSER fails without comsuming input."
- `(parsec-or ,parser ,opt))
-
-(defmacro parsec-optional (parser)
- "Apply PARSER zero or one time. Fail if PARSER fails after consuming input.
-Return the result of PARSER or nil.
-
-Note this combinator doesn't discard the result of PARSER so it is
-different from the `optional' function of Haskell's Parsec. If
-you want the Haskell's behavior, use `parsec-optional*'."
- `(parsec-or ,parser nil))
-
-(defmacro parsec-optional* (parser)
- "Apply PARSER zero or one time and discard the result.
-Fail if PARSER fails after consuming input.
-
-This combinator has the same behavior as the `optional' function of
-Haskell's Parsec."
- `(parsec-and ,parser nil))
-
-(defmacro parsec-peek (parser)
- "Apply PARSER without consuming any input.
-When PARSER succeeds, the result of the PARSER is returned.
-Otherwise, the return value is an error. Use `parsec-error-p' on
-the return value to see whether the PARSER fails or not. Use
-`parsec-peek-p' if you want nil to be returned when PARSER fails.
-
-This is a shortcut of combining `parsec-start', `parsec-try' and
-`parsec-lookahead'. Since arbitrary parser is allowed, this
-function can be viewed as a more powerful version of `looking-at'
-in Emacs Lisp."
- `(parsec-start
- (parsec-try
- (parsec-lookahead ,parser))))
-
-(defmacro parsec-peek-p (parser)
- "Same as `parsec-peek' except a nil is returned when the PARSER fails."
- (let ((res-sym (make-symbol "res")))
- `(let ((,res-sym (parsec-peek ,parser)))
- (unless (parsec-error-p ,res-sym)
- ,res-sym))))
-
-(defmacro parsec-query (parser &rest args)
- "Get an alternative return value of the PARSER specified by the ARGS.
-
-The args can be in the following forms:
-
- :beg --> return the point before applying the PARSER
- :end --> return the point after applying the PARSER
- :nil --> return nil
- :groups N --> return Nth group for `parsec-re'."
- (let ((orig-pt-sym (make-symbol "orig-pt"))
- (res-sym (make-symbol "results")))
- `(let ((,orig-pt-sym (point))
- (,res-sym ,parser))
- ,(cond
- ((memq :beg args) orig-pt-sym)
- ((memq :end args) '(point))
- ((memq :nil args) nil)
- ((and (memq :group args)
- (consp parser)
- (eq (car parser) 'parsec-re))
- (let ((group
- (cl-loop named outer for arg on args
- when (eq (car arg) :group) do
- (cl-return-from outer (cadr arg)))))
- (if (and group (integerp group))
- `(match-string ,group)
- (error "Invalid query :group %s" group))))
- (t res-sym)))))
-
-(defsubst parsec-just (x) (cons 'Just x))
-
-(defconst parsec-nothing 'Nothing)
-
-(defun parsec-maybe-p (x)
- (or (eq x parsec-nothing)
- (and
- (consp x)
- (eq (car x) 'Just))))
-
-(defun parsec-from-maybe (x)
- "Retrieve the value from Maybe monad X.
-If X is `(Just . p)', return p. Otherwise return nil."
- (and (consp x)
- (eq (car x) 'Just)
- (cdr x)))
-
-(defmacro parsec-optional-maybe (parser)
- "Apply PARSER zero or one time and return the value in a Maybe monad.
-If PARSER fails without consuming any input, return `parsec-nothing'.
-Otherwise, return `(Just . p)' where p is the result of PARSER."
- (let ((res-sym (make-symbol "result")))
- `(let ((,res-sym (parsec-optional ,parser)))
- (if ,res-sym
- (parsec-just ,res-sym)
- parsec-nothing))))
-
-(defun parsec-newline ()
- "Parse a newline character \"\\n\"."
- (parsec-ch ?\n))
-
-(defun parsec-crlf ()
- "Parse a carriage return (\'\\r\') followed by a newline \"\\n\"."
- (parsec-and (parsec-ch ?\r) (parsec-ch ?\n)))
-
-(defun parsec-eol ()
- "Parse a newline or a CRLF and return \"\\n\"."
- (parsec-or (parsec-newline) (parsec-crlf)))
-
-(defun parsec-eob ()
- "Indicate the end of file (buffer)."
- (unless (eobp)
- (parsec-stop :expected "`EOF'"
- :found (parsec-eof-or-char-as-string))))
-
-(defalias 'parsec-eof 'parsec-eob)
-
-(defun parsec-eol-or-eof ()
- "Indicate either eol or eof."
- (parsec-or (parsec-eol) (parsec-eof)))
-
-(defmacro parsec-with-input (input &rest parsers)
- "With INPUT, start parsing by applying PARSERS sequentially."
- (declare (indent 1))
- `(with-temp-buffer
- (insert ,input)
- (goto-char (point-min))
- (parsec-start
- ,@parsers)))
-
-(provide 'parsec)
-;;; parsec.el ends here
diff --git a/packages/rich-minority/LICENSE b/packages/rich-minority/LICENSE
deleted file mode 100644
index d7f1051..0000000
--- a/packages/rich-minority/LICENSE
+++ /dev/null
@@ -1,339 +0,0 @@
-GNU GENERAL PUBLIC LICENSE
- Version 2, June 1991
-
- Copyright (C) 1989, 1991 Free Software Foundation, Inc., <http://fsf.org/>
- 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
- Everyone is permitted to copy and distribute verbatim copies
- of this license document, but changing it is not allowed.
-
- Preamble
-
- The licenses for most software are designed to take away your
-freedom to share and change it. By contrast, the GNU General Public
-License is intended to guarantee your freedom to share and change free
-software--to make sure the software is free for all its users. This
-General Public License applies to most of the Free Software
-Foundation's software and to any other program whose authors commit to
-using it. (Some other Free Software Foundation software is covered by
-the GNU Lesser General Public License instead.) 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
-this service 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 make restrictions that forbid
-anyone to deny you these rights or to ask you to surrender the rights.
-These restrictions translate to certain responsibilities for you if you
-distribute copies of the software, or if you modify it.
-
- For example, if you distribute copies of such a program, whether
-gratis or for a fee, you must give the recipients all the rights that
-you have. 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.
-
- We protect your rights with two steps: (1) copyright the software, and
-(2) offer you this license which gives you legal permission to copy,
-distribute and/or modify the software.
-
- Also, for each author's protection and ours, we want to make certain
-that everyone understands that there is no warranty for this free
-software. If the software is modified by someone else and passed on, we
-want its recipients to know that what they have is not the original, so
-that any problems introduced by others will not reflect on the original
-authors' reputations.
-
- Finally, any free program is threatened constantly by software
-patents. We wish to avoid the danger that redistributors of a free
-program will individually obtain patent licenses, in effect making the
-program proprietary. To prevent this, we have made it clear that any
-patent must be licensed for everyone's free use or not licensed at all.
-
- The precise terms and conditions for copying, distribution and
-modification follow.
-
- GNU GENERAL PUBLIC LICENSE
- TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
-
- 0. This License applies to any program or other work which contains
-a notice placed by the copyright holder saying it may be distributed
-under the terms of this General Public License. The "Program", below,
-refers to any such program or work, and a "work based on the Program"
-means either the Program or any derivative work under copyright law:
-that is to say, a work containing the Program or a portion of it,
-either verbatim or with modifications and/or translated into another
-language. (Hereinafter, translation is included without limitation in
-the term "modification".) Each licensee is addressed as "you".
-
-Activities other than copying, distribution and modification are not
-covered by this License; they are outside its scope. The act of
-running the Program is not restricted, and the output from the Program
-is covered only if its contents constitute a work based on the
-Program (independent of having been made by running the Program).
-Whether that is true depends on what the Program does.
-
- 1. You may copy and distribute 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 and disclaimer of warranty; keep intact all the
-notices that refer to this License and to the absence of any warranty;
-and give any other recipients of the Program a copy of this License
-along with the Program.
-
-You may charge a fee for the physical act of transferring a copy, and
-you may at your option offer warranty protection in exchange for a fee.
-
- 2. You may modify your copy or copies of the Program or any portion
-of it, thus forming a work based on the Program, and copy and
-distribute such modifications or work under the terms of Section 1
-above, provided that you also meet all of these conditions:
-
- a) You must cause the modified files to carry prominent notices
- stating that you changed the files and the date of any change.
-
- b) You must cause any work that you distribute or publish, that in
- whole or in part contains or is derived from the Program or any
- part thereof, to be licensed as a whole at no charge to all third
- parties under the terms of this License.
-
- c) If the modified program normally reads commands interactively
- when run, you must cause it, when started running for such
- interactive use in the most ordinary way, to print or display an
- announcement including an appropriate copyright notice and a
- notice that there is no warranty (or else, saying that you provide
- a warranty) and that users may redistribute the program under
- these conditions, and telling the user how to view a copy of this
- License. (Exception: if the Program itself is interactive but
- does not normally print such an announcement, your work based on
- the Program is not required to print an announcement.)
-
-These requirements apply to the modified work as a whole. If
-identifiable sections of that work are not derived from the Program,
-and can be reasonably considered independent and separate works in
-themselves, then this License, and its terms, do not apply to those
-sections when you distribute them as separate works. But when you
-distribute the same sections as part of a whole which is a work based
-on the Program, the distribution of the whole must be on the terms of
-this License, whose permissions for other licensees extend to the
-entire whole, and thus to each and every part regardless of who wrote it.
-
-Thus, it is not the intent of this section to claim rights or contest
-your rights to work written entirely by you; rather, the intent is to
-exercise the right to control the distribution of derivative or
-collective works based on the Program.
-
-In addition, mere aggregation of another work not based on the Program
-with the Program (or with a work based on the Program) on a volume of
-a storage or distribution medium does not bring the other work under
-the scope of this License.
-
- 3. You may copy and distribute the Program (or a work based on it,
-under Section 2) in object code or executable form under the terms of
-Sections 1 and 2 above provided that you also do one of the following:
-
- a) Accompany it with the complete corresponding machine-readable
- source code, which must be distributed under the terms of Sections
- 1 and 2 above on a medium customarily used for software interchange; or,
-
- b) Accompany it with a written offer, valid for at least three
- years, to give any third party, for a charge no more than your
- cost of physically performing source distribution, a complete
- machine-readable copy of the corresponding source code, to be
- distributed under the terms of Sections 1 and 2 above on a medium
- customarily used for software interchange; or,
-
- c) Accompany it with the information you received as to the offer
- to distribute corresponding source code. (This alternative is
- allowed only for noncommercial distribution and only if you
- received the program in object code or executable form with such
- an offer, in accord with Subsection b above.)
-
-The source code for a work means the preferred form of the work for
-making modifications to it. For an executable work, complete source
-code means all the source code for all modules it contains, plus any
-associated interface definition files, plus the scripts used to
-control compilation and installation of the executable. However, as a
-special exception, the source code distributed need not include
-anything that is normally distributed (in either source or binary
-form) with the major components (compiler, kernel, and so on) of the
-operating system on which the executable runs, unless that component
-itself accompanies the executable.
-
-If distribution of executable or object code is made by offering
-access to copy from a designated place, then offering equivalent
-access to copy the source code from the same place counts as
-distribution of the source code, even though third parties are not
-compelled to copy the source along with the object code.
-
- 4. You may not copy, modify, sublicense, or distribute the Program
-except as expressly provided under this License. Any attempt
-otherwise to copy, modify, sublicense or distribute the Program is
-void, and will automatically terminate your rights under this License.
-However, parties who have received copies, or rights, from you under
-this License will not have their licenses terminated so long as such
-parties remain in full compliance.
-
- 5. You are not required to accept this License, since you have not
-signed it. However, nothing else grants you permission to modify or
-distribute the Program or its derivative works. These actions are
-prohibited by law if you do not accept this License. Therefore, by
-modifying or distributing the Program (or any work based on the
-Program), you indicate your acceptance of this License to do so, and
-all its terms and conditions for copying, distributing or modifying
-the Program or works based on it.
-
- 6. Each time you redistribute the Program (or any work based on the
-Program), the recipient automatically receives a license from the
-original licensor to copy, distribute or modify the Program subject to
-these terms and conditions. You may not impose any further
-restrictions on the recipients' exercise of the rights granted herein.
-You are not responsible for enforcing compliance by third parties to
-this License.
-
- 7. If, as a consequence of a court judgment or allegation of patent
-infringement or for any other reason (not limited to patent issues),
-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
-distribute so as to satisfy simultaneously your obligations under this
-License and any other pertinent obligations, then as a consequence you
-may not distribute the Program at all. For example, if a patent
-license would not permit royalty-free redistribution of the Program by
-all those who receive copies directly or indirectly through you, then
-the only way you could satisfy both it and this License would be to
-refrain entirely from distribution of the Program.
-
-If any portion of this section is held invalid or unenforceable under
-any particular circumstance, the balance of the section is intended to
-apply and the section as a whole is intended to apply in other
-circumstances.
-
-It is not the purpose of this section to induce you to infringe any
-patents or other property right claims or to contest validity of any
-such claims; this section has the sole purpose of protecting the
-integrity of the free software distribution system, which is
-implemented by public license practices. Many people have made
-generous contributions to the wide range of software distributed
-through that system in reliance on consistent application of that
-system; it is up to the author/donor to decide if he or she is willing
-to distribute software through any other system and a licensee cannot
-impose that choice.
-
-This section is intended to make thoroughly clear what is believed to
-be a consequence of the rest of this License.
-
- 8. If the distribution and/or use of the Program is restricted in
-certain countries either by patents or by copyrighted interfaces, the
-original copyright holder who places the Program under this License
-may add an explicit geographical distribution limitation excluding
-those countries, so that distribution is permitted only in or among
-countries not thus excluded. In such case, this License incorporates
-the limitation as if written in the body of this License.
-
- 9. The Free Software Foundation may publish revised and/or new versions
-of the 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 a version number of this License which applies to it and "any
-later version", you have the option of following the terms and conditions
-either of that version or of any later version published by the Free
-Software Foundation. If the Program does not specify a version number of
-this License, you may choose any version ever published by the Free Software
-Foundation.
-
- 10. If you wish to incorporate parts of the Program into other free
-programs whose distribution conditions are different, write to the author
-to ask for permission. For software which is copyrighted by the Free
-Software Foundation, write to the Free Software Foundation; we sometimes
-make exceptions for this. Our decision will be guided by the two goals
-of preserving the free status of all derivatives of our free software and
-of promoting the sharing and reuse of software generally.
-
- NO WARRANTY
-
- 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, 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.
-
- 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
-WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
-REDISTRIBUTE 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.
-
- 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
-convey the exclusion of warranty; and each file should have at least
-the "copyright" line and a pointer to where the full notice is found.
-
- {description}
- Copyright (C) {year} {fullname}
-
- 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.
-
-Also add information on how to contact you by electronic and paper mail.
-
-If the program is interactive, make it output a short notice like this
-when it starts in an interactive mode:
-
- Gnomovision version 69, Copyright (C) year name of author
- Gnomovision 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, the commands you use may
-be called something other than `show w' and `show c'; they could even be
-mouse-clicks or menu items--whatever suits your program.
-
-You should also get your employer (if you work as a programmer) or your
-school, if any, to sign a "copyright disclaimer" for the program, if
-necessary. Here is a sample; alter the names:
-
- Yoyodyne, Inc., hereby disclaims all copyright interest in the program
- `Gnomovision' (which makes passes at compilers) written by James Hacker.
-
- {signature of Ty Coon}, 1 April 1989
- Ty Coon, President of Vice
-
-This 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.
diff --git a/packages/rich-minority/README.org
b/packages/rich-minority/README.org
deleted file mode 100644
index acac5bd..0000000
--- a/packages/rich-minority/README.org
+++ /dev/null
@@ -1,50 +0,0 @@
-#+OPTIONS: tags:nil
-#+OPTIONS: toc:nil num:nil
-
-* rich-minority-mode
-
-Emacs package for hiding and/or highlighting the list of minor-modes
-in the mode-line.
-
-** Usage
-
-To activate the enrichment of your minor-modes list, call =M-x
rich-minority-mode=, or add this to your init file:
-
-#+begin_src emacs-lisp
-(rich-minority-mode 1)
-#+end_src
-
-By default, this has a couple of small effects (provided as examples)
-it is up to you to customize it to your liking with the following
-three variables:
-
-- ~rm-blacklist~ :: List of minor mode names that will be hidden
- from the minor-modes list. Use this to hide *only* a few modes that
- are always active and don’t really contribute information.
-- ~rm-whitelist~ :: List of minor mode names that are allowed on
- the minor-modes list. Use this to hide *all but* a few modes.
-- ~rm-text-properties~ :: List text properties to apply to each
- minor-mode lighter. For instance, by default we highlight =Ovwrt=
- with a red face, so you always know if you’re in =overwrite-mode=.
-
-** Comparison to Diminish
-Diminish is an established player in the mode-line world, who also
-handles the minor-modes list. What can rich-minority /offer in contrast/?
-
-- rich-minority is more versatile:
- 1. It accepts *regexps*, instead of having to specify each minor-mode
individually;
- 2. It also offers a *whitelist* behaviour, in addition to the blacklist;
- 3. It supports *highlighting* specific minor-modes with completely arbitrary
text properties.
-- rich-minority takes a cleaner, functional approach. It doesn’t hack
- into the =minor-mode-alist= variable.
-
-What is rich-minority /missing/?
-
-It just doesn’t have a quick and simple replacement functionality yet.
-However, you can set the =display= property of a minor-mode to
-whatever string you want and that will function as a replacement.
-
-** Installation
-
-This package is available from GNU Elpa and Melpa, you may install it
-by calling =M-x list-packages=.
diff --git a/packages/rich-minority/rich-minority.el
b/packages/rich-minority/rich-minority.el
deleted file mode 100644
index 71bb159..0000000
--- a/packages/rich-minority/rich-minority.el
+++ /dev/null
@@ -1,283 +0,0 @@
-;;; rich-minority.el --- Clean-up and Beautify the list of minor-modes.
-
-;; Copyright (C) 2014, 2015 Free Software Foundation, Inc.
-
-;; Author: Artur Malabarba <emacs@endlessparentheses.com>
-;; URL: https://github.com/Malabarba/rich-minority
-;; Package-Requires: ((cl-lib "0.5"))
-;; Version: 1.0.1
-;; Keywords: mode-line faces
-
-;;; Commentary:
-;;
-;; Emacs package for hiding and/or highlighting the list of minor-modes
-;; in the mode-line.
-;;
-;;
-;; Usage
-;; ─────
-;;
-;; To activate the enrichment of your minor-modes list, call `M-x
-;; rich-minority-mode', or add this to your init file:
-;;
-;; ┌────
-;; │ (rich-minority-mode 1)
-;; └────
-;;
-;; By default, this has a couple of small effects (provided as examples)
-;; it is up to you to customize it to your liking with the following
-;; three variables:
-;;
-;; `rm-blacklist': List of minor mode names that will be hidden from the
-;; minor-modes list. Use this to hide *only* a few modes
-;; that are always active and don’t really contribute
-;; information.
-;; `rm-whitelist': List of minor mode names that are allowed on the
-;; minor-modes list. Use this to hide *all but* a few
-;; modes.
-;; `rm-text-properties': List text properties to apply to each minor-mode
-;; lighter. For instance, by default we highlight
-;; `Ovwrt' with a red face, so you always know if
-;; you’re in `overwrite-mode'.
-;;
-;;
-;; Comparison to Diminish
-;; ──────────────────────
-;;
-;; Diminish is an established player in the mode-line world, who also
-;; handles the minor-modes list. What can rich-minority /offer in
-;; contrast/?
-;;
-;; • rich-minority is more versatile:
-;; 1. It accepts *regexps*, instead of having to specify each
-;; minor-mode individually;
-;; 2. It also offers a *whitelist* behaviour, in addition to the
-;; blacklist;
-;; 3. It supports *highlighting* specific minor-modes with completely
-;; arbitrary text properties.
-;; • rich-minority takes a cleaner, functional approach. It doesn’t hack
-;; into the `minor-mode-alist' variable.
-;;
-;; What is rich-minority /missing/?
-;;
-;; 1. It doesn’t have a quick and simple replacement functionality yet.
-;; Although you can set the `display' property of a minor-mode to
-;; whatever string you want and that will function as a replacement.
-;; 2. Its source comments lack [Will Mengarini’s poetry]. :-)
-;;
-;;
-;; [Will Mengarini’s poetry] http://www.eskimo.com/~seldon/diminish.el
-;;
-;;
-;; Installation
-;; ────────────
-;;
-;; This package is available fom Melpa, you may install it by calling
-;; `M-x package-install'.
-
-
-;;; Code:
-(require 'cl-lib)
-
-(declare-function lm-version "lisp-mnt")
-(defun rm-bug-report ()
- "Opens github issues page in a web browser. Please send any bugs you find.
-Please include your Emacs and rich-minority versions."
- (interactive)
- (require 'lisp-mnt)
- (message "Your rm-version is: %s, and your emacs version is: %s.\nPlease
include this in your report!"
- (lm-version "rich-minority.el") emacs-version)
- (browse-url "https://github.com/Malabarba/rich-minority/issues/new";))
-(defun rm-customize ()
- "Open the customization menu in the `rich-minority' group."
- (interactive)
- (customize-group 'rich-minority t))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Customization variables.
-(defcustom rm-blacklist '(" hl-p")
- "List of minor modes you want to hide from the mode-line.
-
-Has three possible values:
-
-- nil: All minor modes are shown in the mode-line (but see also
- `rm-whitelist').
-
-- List of strings: Represents a list of minor mode names that
- will be hidden from the minor-modes list.
-
-- A string: If this variable is set to a single string, this
- string must be a regexp. This regexp will be compared to each
- minor-mode lighter, and those which match are hidden from the
- minor-mode list.
-
-If you'd like to use a list of regexps, simply use something like the
following:
- (setq rm-blacklist (mapconcat \\='identity list-of-regexps \"\\\\|\"))
-
-Don't forget to start each string with a blank space, as most
-minor-mode lighters start with a space."
- :type '(choice (repeat string)
- (regexp :tag "Regular expression."))
- :group 'rich-minority
- :package-version '(rich-minority . "0.1.1"))
-(define-obsolete-variable-alias 'rm-excluded-modes 'rm-blacklist "0.1.1")
-(define-obsolete-variable-alias 'rm-hidden-modes 'rm-blacklist "0.1.1")
-
-(defcustom rm-whitelist nil
- "List of minor modes you want to include in the mode-line.
-
-- nil: All minor modes are shown in the mode-line (but see also
- `rm-blacklist').
-
-- List of strings: Represents a list of minor mode names that are
- allowed on the minor-modes list. Any minor-mode whose lighter
- is not in this list will NOT be displayed.
-
-- A string: If this variable is set to a single string, this
- string must be a regexp. This regexp will be compared to each
- minor-mode lighter, and only those which match are displayed on
- the minor-mode list.
-
-If you'd like to use a list of regexps, simply use something like the
following:
- (setq rm-whitelist (mapconcat \\='identity list-of-regexps \"\\\\|\"))
-
-Don't forget to start each string with a blank space, as most
-minor-mode lighters start with a space."
- :type '(choice (repeat string)
- (regexp :tag "Regular expression."))
- :group 'rich-minority
- :package-version '(rich-minority . "0.1.1"))
-(define-obsolete-variable-alias 'rm-included-modes 'rm-whitelist "0.1.1")
-
-(defcustom rm-text-properties
- '(("\\` Ovwrt\\'" 'face 'font-lock-warning-face))
- "Alist of text properties to be applied to minor-mode lighters.
-The car of each element must be a regexp, and the cdr must be a
-list of text properties.
-
- (REGEXP PROPERTY-NAME PROPERTY-VALUE ...)
-
-If the regexp matches a minor mode lighter, the text properties
-are applied to it. They are tested in order, and search stops at
-the first match.
-
-These properties take priority over those defined in
-`rm-base-text-properties'."
- :type '(repeat (cons regexp (repeat sexp)))
- :group 'rich-minority
- :package-version '(rich-minority . "0.1"))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Functions and Defvars
-(defconst rm--help-echo-bottom
- "Mouse-1: Mode Menu.\nMouse-2: Mode Help.\nMouse-3: Toggle Minor Modes.")
-
-(defvar-local rm--help-echo nil
- "Used to set the help-echo string dynamically.")
-
-;;;###autoload
-(defun rm--mode-list-as-string-list ()
- "Return `minor-mode-list' as a simple list of strings."
- (let ((full-list (delete "" (mapcar #'format-mode-line minor-mode-alist))))
- (setq rm--help-echo
- (format "Full list:\n %s\n\n%s"
- (mapconcat 'identity full-list "\n ")
- rm--help-echo-bottom))
- (mapcar #'rm--propertize
- (rm--remove-hidden-modes full-list))))
-
-(defcustom rm-base-text-properties
- '('help-echo 'rm--help-echo
- 'mouse-face 'mode-line-highlight
- 'local-map mode-line-minor-mode-keymap)
- "List of text propeties to apply to every minor mode."
- :type '(repeat sexp)
- :group 'rich-minority
- :package-version '(rich-minority . "0.1"))
-
-(defun rm--propertize (mode)
- "Propertize the string MODE according to `rm-text-properties'."
- (if (null (stringp mode))
- `(:propertize ,mode ,@rm-base-text-properties)
- (let ((al rm-text-properties)
- done prop)
- (while (and (null done) al)
- (setq done (pop al))
- (if (string-match (car done) mode)
- (setq prop (cdr done))
- (setq done nil)))
- (eval `(propertize ,mode ,@prop ,@rm-base-text-properties)))))
-
-(defun rm--remove-hidden-modes (li)
- "Remove from LI elements that match `rm-blacklist' or don't match
`rm-whitelist'."
- (let ((pred (if (listp rm-blacklist) #'member #'rm--string-match))
- (out li))
- (when rm-blacklist
- (setq out
- (remove nil
- (mapcar
- (lambda (x) (unless (and (stringp x)
- (funcall pred x rm-blacklist))
- x))
- out))))
- (when rm-whitelist
- (setq pred (if (listp rm-whitelist) #'member #'rm--string-match))
- (setq out
- (remove nil
- (mapcar
- (lambda (x) (unless (and (stringp x)
- (null (funcall pred x rm-whitelist)))
- x))
- out))))
- out))
-
-(defun rm--string-match (string regexp)
- "Like `string-match', but arg STRING comes before REGEXP."
- (string-match regexp string))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; minor-mode
-(defvar rm--mode-line-construct
- '(:eval (rm--mode-list-as-string-list))
- "Construct used to replace `minor-mode-alist'.")
-
-(defvar rm--warning-absent-element
- "Couldn't find %S inside `mode-line-modes'. If you didn't change it
yourself, please file a bug report with M-x rm-bug-report"
- "Warning message used when something wasn't found.")
-
-(defvar rm--backup-construct nil
- "Construct containing `minor-mode-alist' which we removed from the
mode-line.")
-
-;;;###autoload
-(define-minor-mode rich-minority-mode nil nil " $"
- :global t
- (if rich-minority-mode
- (let ((place (or (member 'minor-mode-alist mode-line-modes)
- (cl-member-if
- (lambda (x) (and (listp x)
- (equal (car x) :propertize)
- (equal (cadr x) '("" minor-mode-alist))))
- mode-line-modes))))
- (if place
- (progn
- (setq rm--backup-construct (car place))
- (setcar place rm--mode-line-construct))
- (setq rich-minority-mode nil)
- (if (member 'sml/pos-id-separator mode-line-format)
- (message "You don't need to activate rich-minority-mode if
you're using smart-mode-line")
- (warn rm--warning-absent-element 'minor-mode-alist))))
- (let ((place (member rm--mode-line-construct mode-line-modes)))
- (if place
- (setcar place rm--backup-construct)
- (warn rm--warning-absent-element rm--mode-line-construct)))))
-
-(provide 'rich-minority)
-
-;;; rich-minority.el ends here
-
-;; Local Variables:
-;; nameless-current-name: "rm"
-;; End:
diff --git a/packages/sotlisp/.elpaignore b/packages/sotlisp/.elpaignore
deleted file mode 100644
index 74a9dde..0000000
--- a/packages/sotlisp/.elpaignore
+++ /dev/null
@@ -1,4 +0,0 @@
-.travis.yml
-.gitignore
-Makefile
-test/
diff --git a/packages/sotlisp/.gitignore b/packages/sotlisp/.gitignore
deleted file mode 100644
index c531d98..0000000
--- a/packages/sotlisp/.gitignore
+++ /dev/null
@@ -1 +0,0 @@
-*.elc
diff --git a/packages/sotlisp/README.md b/packages/sotlisp/README.md
deleted file mode 100644
index a08172b..0000000
--- a/packages/sotlisp/README.md
+++ /dev/null
@@ -1,59 +0,0 @@
-# speed-of-thought-lisp
-Write emacs-lisp at the speed of thought.
-
-This defines a new global minor-mode `speed-of-thought-mode`, which
-activates locally on any supported buffer. Currently, only
-`emacs-lisp-mode` buffers are supported.
-
-The mode is quite simple, and is composed of two parts:
-
-## Abbrevs
-
-A large number of abbrevs which expand function
-initials to their name. A few examples:
-
-- `wcb` -> `with-current-buffer`
-- `i` -> `insert`
-- `r` -> `require '`
-- `a` -> `and`
-
-However, these are defined in a way such that they ONLY expand in a
-place where you would use a function, so hitting SPC after `(r`
-expands to `(require '`, but hitting SPC after `(delete-region r` will
-NOT expand the `r`, because that's obviously not a function.
-Furtheromre, `#'r` will expand to `#'require` (note how it ommits that
-extra quote, since it would be useless here).
-
-## Commands
-
-It also defines 4 commands, which really fit into this "follow the
-thought-flow" way of writing. The bindings are as follows, I
-understand these don't fully adhere to conventions, and I'd
-appreaciate suggestions on better bindings.
-
-- `M-RET` :: Break line, and insert "()" with point in the middle.
-- `C-RET` :: Do `forward-up-list', then do M-RET.
-
-Hitting RET followed by a `(' was one of the most common key sequences
-for me while writing elisp, so giving it a quick-to-hit key was a
-significant improvement.
-
-- `C-c f` :: Find function under point. If it is not defined, create a
-definition for it below the current function and leave point inside.
-- `C-c v` :: Same, but for variable.
-
-With these commands, you just write your code as you think of it. Once
-you hit a "stop-point" of sorts in your tought flow, you hit `C-c f/v`
-on any undefined functions/variables, write their definitions, and hit
-`C-u C-SPC` to go back to the main function.
-
-## Small Example
-
-With the above (assuming you use something like paredit or
-electric-pair-mode), if you write:
-
- ( w t b M-RET i SPC text
-
-You get
-
- (with-temp-buffer (insert text))
diff --git a/packages/sotlisp/sotlisp.el b/packages/sotlisp/sotlisp.el
deleted file mode 100644
index 792fe1d..0000000
--- a/packages/sotlisp/sotlisp.el
+++ /dev/null
@@ -1,717 +0,0 @@
-;;; sotlisp.el --- Write lisp at the speed of thought. -*- lexical-binding:
t; -*-
-
-;; Copyright (C) 2014, 2015 Free Software Foundation, Inc.
-
-;; Author: Artur Malabarba <emacs@endlessparentheses.com>
-;; URL: https://github.com/Malabarba/speed-of-thought-lisp
-;; Keywords: convenience, lisp
-;; Package-Requires: ((emacs "24.1"))
-;; Version: 1.6.2
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;;
-;; This defines a new global minor-mode `speed-of-thought-mode', which
-;; activates locally on any supported buffer. Currently, only
-;; `emacs-lisp-mode' buffers are supported.
-;;
-;; The mode is quite simple, and is composed of two parts:
-;;
-;;; Abbrevs
-;;
-;; A large number of abbrevs which expand function
-;; initials to their name. A few examples:
-;;
-;; - wcb -> with-current-buffer
-;; - i -> insert
-;; - r -> require '
-;; - a -> and
-;;
-;; However, these are defined in a way such that they ONLY expand in a
-;; place where you would use a function, so hitting SPC after "(r"
-;; expands to "(require '", but hitting SPC after "(delete-region r"
-;; will NOT expand the `r', because that's obviously not a function.
-;; Furtheromre, "#'r" will expand to "#'require" (note how it ommits
-;; that extra quote, since it would be useless here).
-;;
-;;; Commands
-;;
-;; It also defines 4 commands, which really fit into this "follow the
-;; thought-flow" way of writing. The bindings are as follows, I
-;; understand these don't fully adhere to conventions, and I'd
-;; appreciate suggestions on better bindings.
-;;
-;; - M-RET :: Break line, and insert "()" with point in the middle.
-;; - C-RET :: Do `forward-up-list', then do M-RET.
-;;
-;; Hitting RET followed by a `(' was one of the most common key sequences
-;; for me while writing elisp, so giving it a quick-to-hit key was a
-;; significant improvement.
-;;
-;; - C-c f :: Find function under point. If it is not defined, create a
-;; definition for it below the current function and leave point inside.
-;; - C-c v :: Same, but for variable.
-;;
-;; With these commands, you just write your code as you think of it. Once
-;; you hit a "stop-point" of sorts in your tought flow, you hit `C-c f/v`
-;; on any undefined functions/variables, write their definitions, and hit
-;; `C-u C-SPC` to go back to the main function.
-;;
-;;; Small Example
-;;
-;; With the above (assuming you use something like paredit or
-;; electric-pair-mode), if you write:
-;;
-;; ( w t b M-RET i SPC text
-;;
-;; You get
-;;
-;; (with-temp-buffer (insert text))
-
-;;; Code:
-(require 'skeleton)
-
-;;; Predicates
-(defun sotlisp--auto-paired-p ()
- "Non-nil if this buffer auto-inserts parentheses."
- (or (bound-and-true-p electric-pair-mode)
- (bound-and-true-p paredit-mode)
- (bound-and-true-p smartparens-mode)))
-
-(defun sotlisp--looking-back (regexp)
- (string-match
- (concat regexp "\\'")
- (buffer-substring (line-beginning-position) (point))))
-
-(defun sotlisp--function-form-p ()
- "Non-nil if point is at the start of a sexp.
-Specially, avoids matching inside argument lists."
- (and (eq (char-before) ?\()
- (not (sotlisp--looking-back
"(\\(defun\\s-+.*\\|\\(lambda\\|dolist\\|dotimes\\)\\s-+\\)("))
- (save-excursion
- (forward-char -1)
- (condition-case nil
- (progn
- (backward-up-list)
- (forward-sexp -1)
- (not
- (looking-at-p (rx (* (or (syntax word) (syntax symbol) "-"))
- "let" symbol-end))))
- (error t)))
- (not (string-match (rx (syntax symbol)) (string last-command-event)))))
-
-(defun sotlisp--function-quote-p ()
- "Non-nil if point is at a sharp-quote."
- (ignore-errors
- (save-excursion
- (forward-char -2)
- (looking-at-p "#'"))))
-
-(defun sotlisp--code-p ()
- (save-excursion
- (let ((r (point)))
- (beginning-of-defun)
- (let ((pps (parse-partial-sexp (point) r)))
- (not (or (elt pps 3)
- (elt pps 4)))))))
-
-(defun sotlisp--function-p ()
- "Non-nil if point is at reasonable place for a function name.
-Returns non-nil if, after moving backwards by a sexp, either
-`sotlisp--function-form-p' or `sotlisp--function-quote-p' return
-non-nil."
- (save-excursion
- (ignore-errors
- (skip-chars-backward (rx alnum))
- (and (sotlisp--code-p)
- (or (sotlisp--function-form-p)
- (sotlisp--function-quote-p))))))
-
-(defun sotlisp--whitespace-p ()
- "Non-nil if current `self-insert'ed char is whitespace."
- (sotlisp--whitespace-char-p last-command-event))
-(make-obsolete 'sotlisp--whitespace-p 'sotlisp--whitespace-char-p "1.2")
-
-(defun sotlisp--whitespace-char-p (char)
- "Non-nil if CHAR is has whitespace syntax."
- (ignore-errors
- (string-match (rx space) (string char))))
-
-
-;;; Expansion logic
-(defvar sotlisp--needs-moving nil
- "Will `sotlisp--move-to-$' move point after insertion?")
-
-(defun sotlisp--move-to-$ ()
- "Move backwards until `$' and delete it.
-Point is left where the `$' char was. Does nothing if variable
-`sotlisp-mode' is nil."
- (when (bound-and-true-p speed-of-thought-mode)
- (when sotlisp--needs-moving
- (setq sotlisp--needs-moving nil)
- (skip-chars-backward "^\\$")
- (delete-char -1))))
-
-(add-hook 'post-command-hook #'sotlisp--move-to-$ 'append)
-
-(defun sotlisp--maybe-skip-closing-paren ()
- "Move past `)' if variable `electric-pair-mode' is enabled."
- (when (and (char-after ?\))
- (sotlisp--auto-paired-p))
- (forward-char 1)))
-
-(defun sotlisp--post-expansion-cleanup ()
- "Do some processing conditioned on the expansion done.
-If the command that triggered the expansion was a whitespace
-char, perform the steps below and return t.
-
-If the expansion ended in a $, delete it and call
-`sotlisp--maybe-skip-closing-paren'.
-If it ended in a space and there's a space ahead, delete the
-space ahead."
- ;; Inform `expand-abbrev' that `self-insert-command' should not
- ;; trigger, by returning non-nil on SPC.
- (when (sotlisp--whitespace-char-p last-command-event)
- ;; And maybe move out of closing paren if expansion ends with $.
- (if (eq (char-before) ?$)
- (progn (delete-char -1)
- (setq sotlisp--needs-moving nil)
- (sotlisp--maybe-skip-closing-paren))
- (when (and (sotlisp--whitespace-char-p (char-after))
- (sotlisp--whitespace-char-p (char-before)))
- (delete-char 1)))
- t))
-
-(defvar sotlisp--function-table (make-hash-table :test #'equal)
- "Table where function abbrev expansions are stored.")
-
-(defun sotlisp--expand-function ()
- "Expand the function abbrev before point.
-See `sotlisp-define-function-abbrev'."
- (let ((r (point)))
- (skip-chars-backward (rx alnum))
- (let* ((name (buffer-substring (point) r))
- (expansion (gethash name sotlisp--function-table)))
- (cond
- ((not expansion) (progn (goto-char r) nil))
- ((consp expansion)
- (delete-region (point) r)
- (let ((skeleton-end-newline nil))
- (skeleton-insert (cons "" expansion)))
- t)
- ((stringp expansion)
- (delete-region (point) r)
- (if (sotlisp--function-quote-p)
- ;; After #' use the simple expansion.
- (insert (sotlisp--simplify-function-expansion expansion))
- ;; Inside a form, use the full expansion.
- (insert expansion)
- (when (string-match "\\$" expansion)
- (setq sotlisp--needs-moving t)))
- ;; Must be last.
- (sotlisp--post-expansion-cleanup))))))
-
-(put 'sotlisp--expand-function 'no-self-insert t)
-
-(defun sotlisp--simplify-function-expansion (expansion)
- "Take a substring of EXPANSION up to first space.
-The space char is not included. Any \"$\" are also removed."
- (replace-regexp-in-string
- "\\$" ""
- (substring expansion 0 (string-match " " expansion))))
-
-
-;;; Abbrev definitions
-(defconst sotlisp--default-function-abbrevs
- '(
- ("a" . "and ")
- ("ah" . "add-hook '")
- ("atl" . "add-to-list '")
- ("bb" . "bury-buffer")
- ("bc" . "forward-char -1")
- ("bfn" . "buffer-file-name")
- ("bl" . "buffer-list$")
- ("blp" . "buffer-live-p ")
- ("bn" . "buffer-name")
- ("bod" . "beginning-of-defun")
- ("bol" . "forward-line 0$")
- ("bp" . "boundp '")
- ("bs" . "buffer-string$")
- ("bsn" . "buffer-substring-no-properties")
- ("bss" . "buffer-substring ")
- ("bw" . "forward-word -1")
- ("c" . "concat ")
- ("ca" . "char-after$")
- ("cb" . "current-buffer$")
- ("cc" . "condition-case er\n$\n(error nil)")
- ("ci" . "call-interactively ")
- ("cip" . "called-interactively-p 'any")
- ("csv" . "customize-save-variable '")
- ("d" . "delete-char 1")
- ("dc" . "delete-char 1")
- ("dcu" . "defcustom $ t\n \"\"\n :type 'boolean")
- ("df" . "defun $ ()\n \"\"\n ")
- ("dfa" . "defface $ \n '((t))\n \"\"\n ")
- ("dfc" . "defcustom $ t\n \"\"\n :type 'boolean")
- ("dff" . "defface $ \n '((t))\n \"\"\n ")
- ("dfv" . "defvar $ t\n \"\"")
- ("dk" . "define-key ")
- ("dl" . "dolist (it $)")
- ("dt" . "dotimes (it $)")
- ("dmp" . "derived-mode-p '")
- ("dm" . "defmacro $ ()\n \"\"\n ")
- ("dr" . "delete-region ")
- ("dv" . "defvar $ t\n \"\"")
- ("e" . "error \"$\"")
- ("ef" . "executable-find ")
- ("efn" . "expand-file-name ")
- ("eol" . "end-of-line")
- ("f" . "format \"$\"")
- ("fb" . "fboundp '")
- ("fbp" . "fboundp '")
- ("fc" . "forward-char 1")
- ("ff" . "find-file ")
- ("fl" . "forward-line 1")
- ("fp" . "functionp ")
- ("frp" . "file-readable-p ")
- ("fs" . "forward-sexp 1")
- ("fu" . "funcall ")
- ("fw" . "forward-word 1")
- ("g" . "goto-char ")
- ("gc" . "goto-char ")
- ("gsk" . "global-set-key ")
- ("i" . "insert ")
- ("ie" . "ignore-errors ")
- ("ii" . "interactive")
- ("il" . "if-let (($))")
- ("ir" . "indent-region ")
- ("jcl" . "justify-current-line ")
- ("jl" . "delete-indentation")
- ("jos" . "just-one-space")
- ("jr" . "json-read$")
- ("jtr" . "jump-to-register ")
- ("k" . ("kbd " (format "%S" (key-description (read-key-sequence-vector
"Key: ")))))
- ("kb" . "kill-buffer")
- ("kn" . "kill-new ")
- ("kp" . "keywordp ")
- ("l" . "lambda ($)")
- ("la" . ("looking-at \"" - "\""))
- ("lap" . "looking-at-p \"$\"")
- ("lb" . "looking-back \"$\"")
- ("lbp" . "line-beginning-position")
- ("lep" . "line-end-position")
- ("let" . "let (($))")
- ("lp" . "listp ")
- ("m" . "message \"$%s\"")
- ("mb" . "match-beginning 0")
- ("mc" . "mapcar ")
- ("mct" . "mapconcat ")
- ("me" . "match-end 0")
- ("ms" . "match-string 0")
- ("msn" . "match-string-no-properties 0")
- ("msnp" . "match-string-no-properties 0")
- ("msp" . "match-string-no-properties 0")
- ("mt" . "mapconcat ")
- ("n" . "not ")
- ("nai" . "newline-and-indent$")
- ("nl" . "forward-line 1")
- ("np" . "numberp ")
- ("ntr" . "narrow-to-region ")
- ("ow" . "other-window 1")
- ("p" . "point$")
- ("pm" . "point-marker$")
- ("pa" . "point-max$")
- ("pg" . "plist-get ")
- ("pi" . "point-min$")
- ("pz" . "propertize ")
- ("r" . "require '")
- ("ra" . "use-region-p$")
- ("rap" . "use-region-p$")
- ("rb" . "region-beginning")
- ("re" . "region-end")
- ("rh" . "remove-hook '")
- ("rm" . "replace-match \"$\"")
- ("ro" . "regexp-opt ")
- ("rq" . "regexp-quote ")
- ("rris" . "replace-regexp-in-string ")
- ("rrs" . "replace-regexp-in-string ")
- ("rs" . "while (search-forward $ nil t)\n(replace-match \"\") nil t)")
- ("rsb" . "re-search-backward \"$\" nil 'noerror")
- ("rsf" . "re-search-forward \"$\" nil 'noerror")
- ("s" . "setq ")
- ("sb" . "search-backward $ nil 'noerror")
- ("sbr" . "search-backward-regexp $ nil 'noerror")
- ("scb" . "skip-chars-backward \"$\\r\\n[:blank:]\"")
- ("scf" . "skip-chars-forward \"$\\r\\n[:blank:]\"")
- ("se" . "save-excursion")
- ("sf" . "search-forward $ nil 'noerror")
- ("sfr" . "search-forward-regexp $ nil 'noerror")
- ("sic" . "self-insert-command")
- ("sl" . "setq-local ")
- ("sm" . "string-match \"$\"")
- ("smd" . "save-match-data")
- ("sn" . "symbol-name ")
- ("sp" . "stringp ")
- ("sq" . "string= ")
- ("sr" . "save-restriction")
- ("ss" . "substring ")
- ("ssn" . "substring-no-properties ")
- ("ssnp" . "substring-no-properties ")
- ("stb" . "switch-to-buffer ")
- ("sw" . "selected-window$")
- ("syp" . "symbolp ")
- ("tap" . "thing-at-point 'symbol")
- ("tf" . "thread-first ")
- ("tl" . "thread-last ")
- ("u" . "unless ")
- ("ul" . "up-list")
- ("up" . "unwind-protect\n(progn $)")
- ("urp" . "use-region-p$")
- ("w" . "when ")
- ("wcb" . "with-current-buffer ")
- ("wf" . "write-file ")
- ("wh" . "while ")
- ("wl" . "when-let (($))")
- ("we" . "window-end")
- ("ws" . "window-start")
- ("wsw" . "with-selected-window ")
- ("wtb" . "with-temp-buffer")
- ("wtf" . "with-temp-file ")
- )
- "Alist of (ABBREV . EXPANSION) used by `sotlisp'.")
-
-(defun sotlisp-define-function-abbrev (name expansion)
- "Define a function abbrev expanding NAME to EXPANSION.
-This abbrev will only be expanded in places where a function name is
-sensible. Roughly, this is right after a `(' or a `#\\=''.
-
-If EXPANSION is any string, it doesn't have to be the just the
-name of a function. In particular:
- - if it contains a `$', this char will not be inserted and
- point will be moved to its position after expansion.
- - if it contains a space, only a substring of it up to the
-first space is inserted when expanding after a `#\\='' (this is done
-by defining two different abbrevs).
-
-For instance, if one defines
- (sotlisp-define-function-abbrev \"d\" \"delete-char 1\")
-
-then triggering `expand-abbrev' after \"d\" expands in the
-following way:
- (d => (delete-char 1
- #\\='d => #\\='delete-char"
- (define-abbrev emacs-lisp-mode-abbrev-table
- name t #'sotlisp--expand-function
- ;; Don't override user abbrevs
- :system t
- ;; Only expand in function places.
- :enable-function #'sotlisp--function-p)
- (puthash name expansion sotlisp--function-table))
-
-(defun sotlisp-erase-all-abbrevs ()
- "Undefine all abbrevs defined by `sotlisp'."
- (interactive)
- (maphash (lambda (x _) (define-abbrev emacs-lisp-mode-abbrev-table x nil))
- sotlisp--function-table))
-
-(defun sotlisp-define-all-abbrevs ()
- "Define all abbrevs in `sotlisp--default-function-abbrevs'."
- (interactive)
- (mapc (lambda (x) (sotlisp-define-function-abbrev (car x) (cdr x)))
- sotlisp--default-function-abbrevs))
-
-
-;;; The global minor-mode
-(defvar speed-of-thought-turn-on-hook '()
- "Hook run once when `speed-of-thought-mode' is enabled.
-Note that `speed-of-thought-mode' is global, so this is not run
-on every buffer.
-
-See `sotlisp-turn-on-everywhere' for an example of what a
-function in this hook should do.")
-
-(defvar speed-of-thought-turn-off-hook '()
- "Hook run once when `speed-of-thought-mode' is disabled.
-Note that `speed-of-thought-mode' is global, so this is not run
-on every buffer.
-
-See `sotlisp-turn-on-everywhere' for an example of what a
-function in this hook should do.")
-
-;;;###autoload
-(define-minor-mode speed-of-thought-mode
- nil nil nil nil
- :global t
- (run-hooks (if speed-of-thought-mode
- 'speed-of-thought-turn-on-hook
- 'speed-of-thought-turn-off-hook)))
-
-;;;###autoload
-(defun speed-of-thought-hook-in (on off)
- "Add functions ON and OFF to `speed-of-thought-mode' hooks.
-If `speed-of-thought-mode' is already on, call ON."
- (add-hook 'speed-of-thought-turn-on-hook on)
- (add-hook 'speed-of-thought-turn-off-hook off)
- (when speed-of-thought-mode (funcall on)))
-
-
-;;; The local minor-mode
-(define-minor-mode sotlisp-mode
- nil nil " SoT"
- `(([M-return] . sotlisp-newline-and-parentheses)
- ([C-return] . sotlisp-downlist-newline-and-parentheses)
- (,(kbd "C-M-;") . ,(if (fboundp 'comment-or-uncomment-sexp)
- #'comment-or-uncomment-sexp
- #'sotlisp-comment-or-uncomment-sexp))
- ("\C-cf" . sotlisp-find-or-define-function)
- ("\C-cv" . sotlisp-find-or-define-variable))
- (if sotlisp-mode
- (abbrev-mode 1)
- (kill-local-variable 'abbrev-mode)))
-
-(defun sotlisp-turn-on-everywhere ()
- "Call-once function to turn on sotlisp everywhere.
-Calls `sotlisp-mode' on all `emacs-lisp-mode' buffers, and sets
-up a hook and abbrevs."
- (add-hook 'emacs-lisp-mode-hook #'sotlisp-mode)
- (sotlisp-define-all-abbrevs)
- (mapc (lambda (b)
- (with-current-buffer b
- (when (derived-mode-p 'emacs-lisp-mode)
- (sotlisp-mode 1))))
- (buffer-list)))
-
-(defun sotlisp-turn-off-everywhere ()
- "Call-once function to turn off sotlisp everywhere.
-Removes `sotlisp-mode' from all `emacs-lisp-mode' buffers, and
-removes hooks and abbrevs."
- (remove-hook 'emacs-lisp-mode-hook #'sotlisp-mode)
- (sotlisp-erase-all-abbrevs)
- (mapc (lambda (b)
- (with-current-buffer b
- (when (derived-mode-p 'emacs-lisp-mode)
- (sotlisp-mode -1))))
- (buffer-list)))
-
-(speed-of-thought-hook-in #'sotlisp-turn-on-everywhere
#'sotlisp-turn-off-everywhere)
-
-
-;;; Commands
-(defun sotlisp-newline-and-parentheses ()
- "`newline-and-indent' then insert a pair of parentheses."
- (interactive)
- (point)
- (ignore-errors (expand-abbrev))
- (newline-and-indent)
- (insert "()")
- (forward-char -1))
-
-(defun sotlisp-downlist-newline-and-parentheses ()
- "`up-list', `newline-and-indent', then insert a parentheses pair."
- (interactive)
- (ignore-errors (expand-abbrev))
- (up-list)
- (newline-and-indent)
- (insert "()")
- (forward-char -1))
-
-(defun sotlisp--find-in-buffer (r s)
- "Find the string (concat R (regexp-quote S)) somewhere in this buffer."
- (let ((l (save-excursion
- (goto-char (point-min))
- (save-match-data
- (when (search-forward-regexp (concat r (regexp-quote s) "\\_>")
- nil :noerror)
- (match-beginning 0))))))
- (when l
- (push-mark)
- (goto-char l)
- l)))
-
-(defun sotlisp--beginning-of-defun ()
- "`push-mark' and move above this defun."
- (push-mark)
- (beginning-of-defun)
- (forward-line -1)
- (unless (looking-at "^;;;###autoload\\s-*\n")
- (forward-line 1)))
-
-(defun sotlisp--function-at-point ()
- "Return name of `function-called-at-point'."
- (if (save-excursion
- (ignore-errors (forward-sexp -1)
- (looking-at-p "#'")))
- (thing-at-point 'symbol)
- (let ((fcap (function-called-at-point)))
- (if fcap (symbol-name fcap)
- (thing-at-point 'symbol)))))
-
-(defun sotlisp-find-or-define-function (&optional prefix)
- "If symbol under point is a defined function, go to it, otherwise define it.
-Essentially `find-function' on steroids.
-
-If you write in your code the name of a function you haven't
-defined yet, just place point on its name and hit
\\[sotlisp-find-or-define-function]
-and a defun will be inserted with point inside it. After that,
-you can just hit `pop-mark' to go back to where you were.
-With a PREFIX argument, creates a `defmacro' instead.
-
-If the function under point is already defined this just calls
-`find-function', with one exception:
- if there's a defun (or equivalent) for this function in the
- current buffer, we go to that even if it's not where the
- global definition comes from (this is useful if you're
- writing an Emacs package that also happens to be installed
- through package.el).
-
-With a prefix argument, defines a `defmacro' instead of a `defun'."
- (interactive "P")
- (let ((name (sotlisp--function-at-point)))
- (unless (and name (sotlisp--find-in-buffer "(def\\(un\\|macro\\|alias\\) "
name))
- (let ((name-s (intern-soft name)))
- (if (fboundp name-s)
- (find-function name-s)
- (sotlisp--beginning-of-defun)
- (insert "(def" (if prefix "macro" "un")
- " " name " (")
- (save-excursion (insert ")\n \"\"\n )\n\n")))))))
-
-(defun sotlisp-find-or-define-variable (&optional prefix)
- "If symbol under point is a defined variable, go to it, otherwise define it.
-Essentially `find-variable' on steroids.
-
-If you write in your code the name of a variable you haven't
-defined yet, place point on its name and hit
\\[sotlisp-find-or-define-variable]
-and a `defcustom' will be created with point inside. After that,
-you can just `pop-mark' to go back to where you were. With a
-PREFIX argument, creates a `defvar' instead.
-
-If the variable under point is already defined this just calls
-`find-variable', with one exception:
- if there's a defvar (or equivalent) for this variable in the
- current buffer, we go to that even if it's not where the
- global definition comes from (this is useful if you're
- writing an Emacs package that also happens to be installed
- through package.el).
-
-With a prefix argument, defines a `defvar' instead of a `defcustom'."
- (interactive "P")
- (let ((name (symbol-name (variable-at-point t))))
- (unless (sotlisp--find-in-buffer "(def\\(custom\\|const\\|var\\) " name)
- (unless (and (symbolp (variable-at-point))
- (ignore-errors (find-variable (variable-at-point)) t))
- (let ((name (thing-at-point 'symbol)))
- (sotlisp--beginning-of-defun)
- (insert "(def" (if prefix "var" "custom")
- " " name " t")
- (save-excursion
- (insert "\n \"\""
- (if prefix "" "\n :type 'boolean")
- ")\n\n")))))))
-
-
-;;; Comment sexp
-(defun sotlisp-uncomment-sexp (&optional n)
- "Uncomment a sexp around point."
- (interactive "P")
- (let* ((initial-point (point-marker))
- (inhibit-field-text-motion t)
- (p)
- (end (save-excursion
- (when (elt (syntax-ppss) 4)
- (re-search-backward comment-start-skip
- (line-beginning-position)
- t))
- (setq p (point-marker))
- (comment-forward (point-max))
- (point-marker)))
- (beg (save-excursion
- (forward-line 0)
- (while (and (not (bobp))
- (= end (save-excursion
- (comment-forward (point-max))
- (point))))
- (forward-line -1))
- (goto-char (line-end-position))
- (re-search-backward comment-start-skip
- (line-beginning-position)
- t)
- (ignore-errors
- (while (looking-at comment-start-skip)
- (forward-char -1))
- (unless (looking-at "[\n\r[:blank]]")
- (forward-char 1)))
- (point-marker))))
- (unless (= beg end)
- (uncomment-region beg end)
- (goto-char p)
- ;; Indentify the "top-level" sexp inside the comment.
- (ignore-errors
- (while (>= (point) beg)
- (backward-prefix-chars)
- (skip-chars-backward "\r\n[:blank:]")
- (setq p (point-marker))
- (backward-up-list)))
- ;; Re-comment everything before it.
- (ignore-errors
- (comment-region beg p))
- ;; And everything after it.
- (goto-char p)
- (forward-sexp (or n 1))
- (skip-chars-forward "\r\n[:blank:]")
- (if (< (point) end)
- (ignore-errors
- (comment-region (point) end))
- ;; If this is a closing delimiter, pull it up.
- (goto-char end)
- (skip-chars-forward "\r\n[:blank:]")
- (when (eq 5 (car (syntax-after (point))))
- (delete-indentation))))
- ;; Without a prefix, it's more useful to leave point where
- ;; it was.
- (unless n
- (goto-char initial-point))))
-
-(defun sotlisp--comment-sexp-raw ()
- "Comment the sexp at point or ahead of point."
- (pcase (or (bounds-of-thing-at-point 'sexp)
- (save-excursion
- (skip-chars-forward "\r\n[:blank:]")
- (bounds-of-thing-at-point 'sexp)))
- (`(,l . ,r)
- (goto-char r)
- (skip-chars-forward "\r\n[:blank:]")
- (save-excursion
- (comment-region l r))
- (skip-chars-forward "\r\n[:blank:]"))))
-
-(defun sotlisp-comment-or-uncomment-sexp (&optional n)
- "Comment the sexp at point and move past it.
-If already inside (or before) a comment, uncomment instead.
-With a prefix argument N, (un)comment that many sexps."
- (interactive "P")
- (if (or (elt (syntax-ppss) 4)
- (< (save-excursion
- (skip-chars-forward "\r\n[:blank:]")
- (point))
- (save-excursion
- (comment-forward 1)
- (point))))
- (sotlisp-uncomment-sexp n)
- (dotimes (_ (or n 1))
- (sotlisp--comment-sexp-raw))))
-
-(provide 'sotlisp)
-;;; sotlisp.el ends here
diff --git a/packages/spinner/README.org b/packages/spinner/README.org
deleted file mode 100644
index 4fb4a4a..0000000
--- a/packages/spinner/README.org
+++ /dev/null
@@ -1,76 +0,0 @@
-#+TITLE: spinner.el
-
-Add spinners and progress-bars to the mode-line for ongoing operations.
-
-[[file:some-spinners.gif]]
-
-[[file:all-spinners.gif]]
-
-* Usage
-
-First of all, don’t forget to add ~(spinner "VERSION")~ to your package’s
dependencies.
-
-** Major-modes
-1. Just call ~(spinner-start)~ and a spinner will be added to the mode-line.
-2. Call ~(spinner-stop)~ on the same buffer when you want to remove it.
-
-The default spinner is a line drawing that rotates. You can pass an
-argument to ~spinner-start~ to specify which spinner you want. All
-possibilities are listed in the ~spinner-types~ variable, but here are
-a few examples for you to try:
-
-- ~(spinner-start 'vertical-breathing 10)~
-- ~(spinner-start 'minibox)~
-- ~(spinner-start 'moon)~
-- ~(spinner-start 'triangle)~
-
-You can also define your own as a vector of strings (see the examples
-in ~spinner-types~).
-
-** Minor-modes
-Minor-modes can create a spinner with ~spinner-create~ and then add it
-to their mode-line lighter. They can then start the spinner by setting
-a variable and calling ~spinner-start-timer~. Finally, they can stop
-the spinner (and the timer) by just setting the same variable to nil.
-
-Here’s an example for a minor-mode named ~foo~. Assuming that
-~foo--lighter~ is used as the mode-line lighter, the following code
-will add an *inactive* global spinner to the mode-line.
-#+begin_src emacs-lisp
-(defvar foo--spinner (spinner-create 'rotating-line))
-(defconst foo--lighter
- '(" foo" (:eval (spinner-print foo--spinner))))
-#+end_src
-
-1. To activate the spinner, just call ~(spinner-start foo--spinner)~.
- It will show up on the mode-line and start animating.
-2. To get rid of it, call ~(spinner-stop foo--spinner)~. It will then
- disappear again.
-
-Some minor-modes will need spinners to be buffer-local. To achieve
-that, just make the ~foo--spinner~ variable buffer-local and use the
-third argument of the ~spinner-create~ function. The snippet below is an
example.
-
-#+begin_src emacs-lisp
-(defvar-local foo--spinner nil)
-(defconst foo--lighter
- '(" foo" (:eval (spinner-print foo--spinner))))
-(defun foo--start-spinner ()
- "Create and start a spinner on this buffer."
- (unless foo--spinner
- (setq foo--spinner (spinner-create 'moon t)))
- (spinner-start foo--spinner))
-#+end_src
-
-1. To activate the spinner, just call ~(foo--start-spinner)~.
-2. To get rid of it, call ~(spinner-stop foo--spinner)~.
-
-This will use the ~moon~ spinner, but you can use any of the names
-defined in the ~spinner-types~ variable or even define your own.
-
-* Extra options
-
-Both ~spinner-start~ and ~spinner-create~ take extra options to configure the
spinner, these are:
-
-- ~FPS~: The number of frames to display per second. Defaults to
~spinner-frames-per-second~.
-- ~DELAY~: After startin a spinner, it still won’t be displayed for this many
seconds.
diff --git a/packages/spinner/all-spinners.gif
b/packages/spinner/all-spinners.gif
deleted file mode 100644
index 5540b68..0000000
Binary files a/packages/spinner/all-spinners.gif and /dev/null differ
diff --git a/packages/spinner/some-spinners.gif
b/packages/spinner/some-spinners.gif
deleted file mode 100644
index a8028e7..0000000
Binary files a/packages/spinner/some-spinners.gif and /dev/null differ
diff --git a/packages/spinner/spinner.el b/packages/spinner/spinner.el
deleted file mode 100644
index da75a8f..0000000
--- a/packages/spinner/spinner.el
+++ /dev/null
@@ -1,334 +0,0 @@
-;;; spinner.el --- Add spinners and progress-bars to the mode-line for ongoing
operations -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2015 Free Software Foundation, Inc.
-
-;; Author: Artur Malabarba <emacs@endlessparentheses.com>
-;; Version: 1.7.3
-;; URL: https://github.com/Malabarba/spinner.el
-;; Keywords: processes mode-line
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;;
-;; 1 Usage
-;; ═══════
-;;
-;; First of all, don’t forget to add `(spinner "VERSION")' to your
-;; package’s dependencies.
-;;
-;;
-;; 1.1 Major-modes
-;; ───────────────
-;;
-;; 1. Just call `(spinner-start)' and a spinner will be added to the
-;; mode-line.
-;; 2. Call `(spinner-stop)' on the same buffer when you want to remove
-;; it.
-;;
-;; The default spinner is a line drawing that rotates. You can pass an
-;; argument to `spinner-start' to specify which spinner you want. All
-;; possibilities are listed in the `spinner-types' variable, but here are
-;; a few examples for you to try:
-;;
-;; • `(spinner-start 'vertical-breathing 10)'
-;; • `(spinner-start 'minibox)'
-;; • `(spinner-start 'moon)'
-;; • `(spinner-start 'triangle)'
-;;
-;; You can also define your own as a vector of strings (see the examples
-;; in `spinner-types').
-;;
-;;
-;; 1.2 Minor-modes
-;; ───────────────
-;;
-;; Minor-modes can create a spinner with `spinner-create' and then add it
-;; to their mode-line lighter. They can then start the spinner by setting
-;; a variable and calling `spinner-start-timer'. Finally, they can stop
-;; the spinner (and the timer) by just setting the same variable to nil.
-;;
-;; Here’s an example for a minor-mode named `foo'. Assuming that
-;; `foo--lighter' is used as the mode-line lighter, the following code
-;; will add an *inactive* global spinner to the mode-line.
-;; ┌────
-;; │ (defvar foo--spinner (spinner-create 'rotating-line))
-;; │ (defconst foo--lighter
-;; │ '(" foo" (:eval (spinner-print foo--spinner))))
-;; └────
-;;
-;; 1. To activate the spinner, just call `(spinner-start foo--spinner)'.
-;; It will show up on the mode-line and start animating.
-;; 2. To get rid of it, call `(spinner-stop foo--spinner)'. It will then
-;; disappear again.
-;;
-;; Some minor-modes will need spinners to be buffer-local. To achieve
-;; that, just make the `foo--spinner' variable buffer-local and use the
-;; third argument of the `spinner-create' function. The snippet below is an
-;; example.
-;;
-;; ┌────
-;; │ (defvar-local foo--spinner nil)
-;; │ (defconst foo--lighter
-;; │ '(" foo" (:eval (spinner-print foo--spinner))))
-;; │ (defun foo--start-spinner ()
-;; │ "Create and start a spinner on this buffer."
-;; │ (unless foo--spinner
-;; │ (setq foo--spinner (spinner-create 'moon t)))
-;; │ (spinner-start foo--spinner))
-;; └────
-;;
-;; 1. To activate the spinner, just call `(foo--start-spinner)'.
-;; 2. To get rid of it, call `(spinner-stop foo--spinner)'.
-;;
-;; This will use the `moon' spinner, but you can use any of the names
-;; defined in the `spinner-types' variable or even define your own.
-
-
-;;; Code:
-(eval-when-compile
- (require 'cl))
-
-(defconst spinner-types
- '((3-line-clock . ["┤" "┘" "┴" "└" "├" "┌" "┬" "┐"])
- (2-line-clock . ["┘" "└" "┌" "┐"])
- (flipping-line . ["_" "\\" "|" "/"])
- (rotating-line . ["-" "\\" "|" "/"])
- (progress-bar . ["[ ]" "[= ]" "[== ]" "[=== ]" "[====]" "[ ===]" "[
==]" "[ =]"])
- (progress-bar-filled . ["| |" "|█ |" "|██ |" "|███ |" "|████|" "|
███|" "| ██|" "| █|"])
- (vertical-breathing . ["▁" "▂" "▃" "▄" "▅" "▆" "▇" "█" "▇" "▆" "▅" "▄" "▃"
"▂" "▁" " "])
- (vertical-rising . ["▁" "▄" "█" "▀" "▔"])
- (horizontal-breathing . [" " "▏" "▎" "▍" "▌" "▋" "▊" "▉" "▉" "▊" "▋" "▌"
"▍" "▎" "▏"])
- (horizontal-breathing-long
- . [" " "▎ " "▌ " "▊ " "█ " "█▎" "█▌" "█▊" "██" "█▊" "█▌" "█▎" "█ " "▊ "
"▋ " "▌ " "▍ " "▎ " "▏ "])
- (horizontal-moving . [" " "▌ " "█ " "▐▌" " █" " ▐"])
- (minibox . ["▖" "▘" "▝" "▗"])
- (triangle . ["◢" "◣" "◤" "◥"])
- (box-in-box . ["◰" "◳" "◲" "◱"])
- (box-in-circle . ["◴" "◷" "◶" "◵"])
- (half-circle . ["◐" "◓" "◑" "◒"])
- (moon . ["🌑" "🌘" "🌖" "🌕" "🌔" "🌒"]))
- "Predefined alist of spinners.
-Each car is a symbol identifying the spinner, and each cdr is a
-vector, the spinner itself.")
-
-(defun spinner-make-progress-bar (width &optional char)
- "Return a vector of strings of the given WIDTH.
-The vector is a valid spinner type and is similar to the
-`progress-bar' spinner, except without the sorrounding brackets.
-CHAR is the character to use for the moving bar (defaults to =)."
- (let ((whole-string (concat (make-string (1- width) ?\s)
- (make-string 4 (or char ?=))
- (make-string width ?\s))))
- (apply #'vector (mapcar (lambda (n) (substring whole-string n (+ n width)))
- (number-sequence (+ width 3) 0 -1)))))
-
-(defvar spinner-current nil
- "Spinner curently being displayed on the `mode-line-process'.")
-(make-variable-buffer-local 'spinner-current)
-
-(defconst spinner--mode-line-construct
- '(:eval (spinner-print spinner-current))
- "Construct used to display a spinner in `mode-line-process'.")
-(put 'spinner--mode-line-construct 'risky-local-variable t)
-
-(defvar spinner-frames-per-second 10
- "Default speed at which spinners spin, in frames per second.
-Each spinner can override this value.")
-
-
-;;; The spinner object.
-(defun spinner--type-to-frames (type)
- "Return a vector of frames corresponding to TYPE.
-The list of possible built-in spinner types is given by the
-`spinner-types' variable, but you can also use your own (see
-below).
-
-If TYPE is nil, the frames of this spinner are given by the first
-element of `spinner-types'.
-If TYPE is a symbol, it specifies an element of `spinner-types'.
-If TYPE is `random', use a random element of `spinner-types'.
-If TYPE is a list, it should be a list of symbols, and a random
-one is chosen as the spinner type.
-If TYPE is a vector, it should be a vector of strings and these
-are used as the spinner's frames. This allows you to make your
-own spinner animations."
- (cond
- ((vectorp type) type)
- ((not type) (cdr (car spinner-types)))
- ((eq type 'random)
- (cdr (elt spinner-types
- (random (length spinner-types)))))
- ((listp type)
- (cdr (assq (elt type (random (length type)))
- spinner-types)))
- ((symbolp type) (cdr (assq type spinner-types)))
- (t (error "Unknown spinner type: %s" type))))
-
-(defstruct (spinner
- (:copier nil)
- (:conc-name spinner--)
- (:constructor make-spinner (&optional type buffer-local
frames-per-second delay-before-start)))
- (frames (spinner--type-to-frames type))
- (counter 0)
- (fps (or frames-per-second spinner-frames-per-second))
- (timer (timer-create))
- (active-p nil)
- (buffer (when buffer-local
- (if (bufferp buffer-local)
- buffer-local
- (current-buffer))))
- (delay (or delay-before-start 0)))
-
-;;;###autoload
-(defun spinner-create (&optional type buffer-local fps delay)
- "Create a spinner of the given TYPE.
-The possible TYPEs are described in `spinner--type-to-frames'.
-
-FPS, if given, is the number of desired frames per second.
-Default is `spinner-frames-per-second'.
-
-If BUFFER-LOCAL is non-nil, the spinner will be automatically
-deactivated if the buffer is killed. If BUFFER-LOCAL is a
-buffer, use that instead of current buffer.
-
-When started, in order to function properly, the spinner runs a
-timer which periodically calls `force-mode-line-update' in the
-curent buffer. If BUFFER-LOCAL was set at creation time, then
-`force-mode-line-update' is called in that buffer instead. When
-the spinner is stopped, the timer is deactivated.
-
-DELAY, if given, is the number of seconds to wait after starting
-the spinner before actually displaying it. It is safe to cancel
-the spinner before this time, in which case it won't display at
-all."
- (make-spinner type buffer-local fps delay))
-
-(defun spinner-print (spinner)
- "Return a string of the current frame of SPINNER.
-If SPINNER is nil, just return nil.
-Designed to be used in the mode-line with:
- (:eval (spinner-print some-spinner))"
- (when (and spinner (spinner--active-p spinner))
- (let ((frame (spinner--counter spinner)))
- (when (>= frame 0)
- (elt (spinner--frames spinner) frame)))))
-
-(defun spinner--timer-function (spinner)
- "Function called to update SPINNER.
-If SPINNER is no longer active, or if its buffer has been killed,
-stop the SPINNER's timer."
- (let ((buffer (spinner--buffer spinner)))
- (if (or (not (spinner--active-p spinner))
- (and buffer (not (buffer-live-p buffer))))
- (spinner-stop spinner)
- ;; Increment
- (callf (lambda (x) (if (< x 0)
- (1+ x)
- (% (1+ x) (length (spinner--frames spinner)))))
- (spinner--counter spinner))
- ;; Update mode-line.
- (if (buffer-live-p buffer)
- (with-current-buffer buffer
- (force-mode-line-update))
- (force-mode-line-update)))))
-
-(defun spinner--start-timer (spinner)
- "Start a SPINNER's timer."
- (let ((old-timer (spinner--timer spinner)))
- (when (timerp old-timer)
- (cancel-timer old-timer))
-
- (setf (spinner--active-p spinner) t)
-
- (unless (ignore-errors (> (spinner--fps spinner) 0))
- (error "A spinner's FPS must be a positive number"))
- (setf (spinner--counter spinner) (round (- (* (or (spinner--delay spinner)
0)
- (spinner--fps spinner)))))
- ;; Create timer.
- (let* ((repeat (/ 1.0 (spinner--fps spinner)))
- (time (timer-next-integral-multiple-of-time (current-time) repeat))
- ;; Create the timer as a lex variable so it can cancel itself.
- (timer (spinner--timer spinner)))
- (timer-set-time timer time repeat)
- (timer-set-function timer #'spinner--timer-function (list spinner))
- (timer-activate timer)
- ;; Return a stopping function.
- (lambda () (spinner-stop spinner)))))
-
-
-;;; The main functions
-;;;###autoload
-(defun spinner-start (&optional type-or-object fps delay)
- "Start a mode-line spinner of given TYPE-OR-OBJECT.
-If TYPE-OR-OBJECT is an object created with `make-spinner',
-simply activate it. This method is designed for minor modes, so
-they can use the spinner as part of their lighter by doing:
- \\='(:eval (spinner-print THE-SPINNER))
-To stop this spinner, call `spinner-stop' on it.
-
-If TYPE-OR-OBJECT is anything else, a buffer-local spinner is
-created with this type, and it is displayed in the
-`mode-line-process' of the buffer it was created it. Both
-TYPE-OR-OBJECT and FPS are passed to `make-spinner' (which see).
-To stop this spinner, call `spinner-stop' in the same buffer.
-
-Either way, the return value is a function which can be called
-anywhere to stop this spinner. You can also call `spinner-stop'
-in the same buffer where the spinner was created.
-
-FPS, if given, is the number of desired frames per second.
-Default is `spinner-frames-per-second'.
-
-DELAY, if given, is the number of seconds to wait until actually
-displaying the spinner. It is safe to cancel the spinner before
-this time, in which case it won't display at all."
- (unless (spinner-p type-or-object)
- ;; Choose type.
- (if (spinner-p spinner-current)
- (setf (spinner--frames spinner-current) (spinner--type-to-frames
type-or-object))
- (setq spinner-current (make-spinner type-or-object (current-buffer) fps
delay)))
- (setq type-or-object spinner-current)
- ;; Maybe add to mode-line.
- (unless (memq 'spinner--mode-line-construct mode-line-process)
- (setq mode-line-process
- (list (or mode-line-process "")
- 'spinner--mode-line-construct))))
-
- ;; Create timer.
- (when fps (setf (spinner--fps type-or-object) fps))
- (when delay (setf (spinner--delay type-or-object) delay))
- (spinner--start-timer type-or-object))
-
-(defun spinner-start-print (spinner)
- "Like `spinner-print', but also start SPINNER if it's not active."
- (unless (spinner--active-p spinner)
- (spinner-start spinner))
- (spinner-print spinner))
-
-(defun spinner-stop (&optional spinner)
- "Stop SPINNER, defaulting to the current buffer's spinner.
-It is always safe to call this function, even if there is no
-active spinner."
- (let ((spinner (or spinner spinner-current)))
- (when (spinner-p spinner)
- (let ((timer (spinner--timer spinner)))
- (when (timerp timer)
- (cancel-timer timer)))
- (setf (spinner--active-p spinner) nil)
- (force-mode-line-update))))
-
-(provide 'spinner)
-
-;;; spinner.el ends here
diff --git a/packages/temp-buffer-browse/Makefile
b/packages/temp-buffer-browse/Makefile
deleted file mode 100644
index 02fbd33..0000000
--- a/packages/temp-buffer-browse/Makefile
+++ /dev/null
@@ -1,12 +0,0 @@
-.PHONY: all clean
-
-ELCFILES = $(addsuffix .elc, $(basename $(wildcard *.el)))
-
-all: $(ELCFILES)
-
-%.elc : %.el
- @echo Compiling $<
- @emacs -batch -q -no-site-file -f batch-byte-compile $<
-
-clean:
- @rm -f *.elc
diff --git a/packages/temp-buffer-browse/README.rst
b/packages/temp-buffer-browse/README.rst
deleted file mode 100644
index 2b96bcd..0000000
--- a/packages/temp-buffer-browse/README.rst
+++ /dev/null
@@ -1,20 +0,0 @@
-=========================
- Temp Buffer Browse Mode
-=========================
-
-Allow keys ``SPC``, ``DEL`` and ``RET`` immediately following a temp
-buffer popup to scroll up, scroll down and close the temp buffer
-window, respectively.
-
-This package is part of `GNU ELPA <http://elpa.gnu.org>`_
-(``M-x list-packages``).
-
-Patches, feature requests and bug reports are welcome. Thanks.
-
-To use
-~~~~~~
-
-::
-
- (require 'temp-buffer-browse)
- (temp-buffer-browse-mode 1)
diff --git a/packages/temp-buffer-browse/temp-buffer-browse.el
b/packages/temp-buffer-browse/temp-buffer-browse.el
deleted file mode 100644
index 0a63ac2..0000000
--- a/packages/temp-buffer-browse/temp-buffer-browse.el
+++ /dev/null
@@ -1,175 +0,0 @@
-;;; temp-buffer-browse.el --- temp buffer browse mode -*- lexical-binding: t;
-*-
-
-;; Copyright (C) 2013-2016 Free Software Foundation, Inc.
-
-;; Author: Leo Liu <sdl.web@gmail.com>
-;; Version: 1.5
-;; Package-Requires: ((emacs "24"))
-;; Keywords: convenience
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Allow keys `SPC', `DEL' and `RET' following a temp buffer popup to
-;; scroll up, scroll down and close the temp buffer window,
-;; respectively.
-
-;;; Code:
-
-;; fringe not preloaded for tty emacs
-(eval-when-compile (require 'fringe))
-
-(eval-and-compile
- (cond
- ((fboundp 'set-transient-map) nil)
- ((fboundp 'set-temporary-overlay-map) ; new in 24.3
- (defalias 'set-transient-map 'set-temporary-overlay-map))
- (t
- (defun set-transient-map (map &optional keep-pred)
- (let* ((clearfunsym (make-symbol "clear-temporary-overlay-map"))
- (overlaysym (make-symbol "t"))
- (alist (list (cons overlaysym map)))
- (clearfun
- `(lambda ()
- (unless ,(cond ((null keep-pred) nil)
- ((eq t keep-pred)
- `(eq this-command
- (lookup-key ',map
- (this-command-keys-vector))))
- (t `(funcall ',keep-pred)))
- (set ',overlaysym nil) ;Just in case.
- (remove-hook 'pre-command-hook ',clearfunsym)
- (setq emulation-mode-map-alists
- (delq ',alist emulation-mode-map-alists))))))
- (set overlaysym overlaysym)
- (fset clearfunsym clearfun)
- (add-hook 'pre-command-hook clearfunsym)
- (push alist emulation-mode-map-alists))))))
-
-(defcustom temp-buffer-browse-fringe-bitmap 'centered-vertical-bar
- "Fringe bitmap to use in the temp buffer window."
- :type `(restricted-sexp :match-alternatives
- (,(lambda (s) (and (symbolp s) (fringe-bitmap-p
s)))))
- :group 'help)
-
-(defvar temp-buffer-browse--window nil)
-
-;; See http://debbugs.gnu.org/15497
-(when (and (fboundp 'define-fringe-bitmap) ;only defined in GUI.
- (not (fringe-bitmap-p 'centered-vertical-bar)))
- (define-fringe-bitmap 'centered-vertical-bar [24] nil nil '(top t)))
-
-(defvar temp-buffer-browse-map
- (let ((map (make-sparse-keymap))
- (quit (lambda ()
- (interactive)
- (when (window-live-p temp-buffer-browse--window)
- (quit-window nil temp-buffer-browse--window))))
- (up (lambda ()
- (interactive)
- (when (window-live-p temp-buffer-browse--window)
- (with-selected-window temp-buffer-browse--window
- (condition-case nil
- (scroll-up)
- (end-of-buffer (quit-window)))))))
- (down (lambda ()
- (interactive)
- (when (window-live-p temp-buffer-browse--window)
- (with-selected-window temp-buffer-browse--window
- (scroll-up '-))))))
- (define-key map "\C-m" quit)
- (define-key map [return] quit)
- (define-key map " " up)
- (define-key map (kbd "DEL") down)
- (define-key map [delete] down)
- (define-key map [backspace] down)
- map))
-
-(defvar temp-buffer-browse--last-exit #'ignore
- "The \"exit-function\" of the last call to `set-transient-map'.")
-
-;;;###autoload
-(defun temp-buffer-browse-activate ()
- "Activate temporary key bindings for current window.
-Specifically set up keys `SPC', `DEL' and `RET' to scroll up,
-scroll down and close the temp buffer window, respectively."
- (unless (derived-mode-p 'completion-list-mode)
- (setq temp-buffer-browse--window (selected-window))
- ;; When re-using existing window don't call
- ;; `fit-window-to-buffer'. See also (info "(elisp)Window
- ;; Parameters").
- (when (and (window-full-width-p)
- (memq (cadr (window-parameter nil 'quit-restore))
- '(window frame)))
- (fit-window-to-buffer nil (floor (frame-height) 2))
- ;; In case buffer contents are inserted asynchronously such as
- ;; in `slime-inspector-mode'.
- (add-hook 'after-change-functions
- (let ((time (float-time)))
- (lambda (&rest _)
- (when (> (float-time) (+ 0.05 time))
- (fit-window-to-buffer nil (floor (frame-height) 2))
- (setq time (float-time)))))
- nil 'local))
- (let ((o (make-overlay (point-min) (point-max))))
- (overlay-put o 'evaporate t)
- (overlay-put o 'window t)
- (overlay-put o 'line-prefix
- (propertize
- "|" 'display
- (unless (zerop (or (frame-parameter nil 'left-fringe) 0))
- `(left-fringe ,temp-buffer-browse-fringe-bitmap warning))
- 'face 'warning))
- ;; NOTE: breaks `adaptive-wrap-prefix-mode' because overlay's
- ;; wrap-prefix overrides text property's. Overlay's cannot have
- ;; negative priority.
- (unless (bound-and-true-p adaptive-wrap-prefix-mode)
- (overlay-put o 'wrap-prefix (overlay-get o 'line-prefix)))
- ;; Workaround for bug http://debbugs.gnu.org/24149.
- (funcall temp-buffer-browse--last-exit)
- (setq temp-buffer-browse--last-exit
- (set-transient-map
- temp-buffer-browse-map
- (lambda ()
- ;; If uncaught any error will make the keymap active
- ;; forever.
- (condition-case err
- (or (and (window-live-p temp-buffer-browse--window)
- (not (member (this-command-keys) '("\C-m"
[return])))
- (eq this-command (lookup-key temp-buffer-browse-map
- (this-command-keys))))
- (ignore (setq temp-buffer-browse--last-exit #'ignore)
- (overlay-put o 'line-prefix nil)
- (overlay-put o 'wrap-prefix nil)))
- (error (message "%s:%s" this-command (error-message-string
err))
- nil))))))))
-
-;;;###autoload
-(define-minor-mode temp-buffer-browse-mode nil
- :lighter ""
- :global t
- ;; Work around http://debbugs.gnu.org/16038
- (let ((activate (lambda ()
- (unless (derived-mode-p 'fundamental-mode)
- (temp-buffer-browse-activate)))))
- (if temp-buffer-browse-mode
- (progn
- (add-hook 'temp-buffer-show-hook 'temp-buffer-browse-activate t)
- (add-hook 'temp-buffer-window-show-hook activate t))
- (remove-hook 'temp-buffer-show-hook 'temp-buffer-browse-activate)
- (remove-hook 'temp-buffer-window-show-hook activate))))
-
-(provide 'temp-buffer-browse)
-;;; temp-buffer-browse.el ends here
diff --git a/packages/test-simple/.gitignore b/packages/test-simple/.gitignore
deleted file mode 100644
index 637d268..0000000
--- a/packages/test-simple/.gitignore
+++ /dev/null
@@ -1,15 +0,0 @@
-*elc
-*~
-/Makefile
-/Makefile.in
-/aclocal.m4
-/autom4te.cache
-/config.log
-/config.status
-/configure
-/elc-stamp
-/install-sh
-/missing
-/script
-/README
-/.cask/
diff --git a/packages/test-simple/.travis.yml b/packages/test-simple/.travis.yml
deleted file mode 100644
index 743fe94..0000000
--- a/packages/test-simple/.travis.yml
+++ /dev/null
@@ -1,14 +0,0 @@
-language: emacs
-
-env:
- - EMACS=emacs24
-
-install:
- - if [ "$EMACS" = 'emacs24' ]; then
- sudo add-apt-repository -y ppa:cassou/emacs &&
- sudo apt-get -qq update &&
- sudo apt-get -qq -f install &&
- sudo apt-get -qq install emacs24 emacs24-el;
- fi
-# run the tests
-script: /bin/sh ./autogen.sh && make check
diff --git a/packages/test-simple/AUTHORS b/packages/test-simple/AUTHORS
deleted file mode 100644
index 772a532..0000000
--- a/packages/test-simple/AUTHORS
+++ /dev/null
@@ -1,2 +0,0 @@
-Rocky Bernstein (rocky@gnu.org) adapted from Phil Hagelberg's behave.el
-
diff --git a/packages/test-simple/COPYING b/packages/test-simple/COPYING
deleted file mode 100644
index 94a9ed0..0000000
--- a/packages/test-simple/COPYING
+++ /dev/null
@@ -1,674 +0,0 @@
- GNU GENERAL PUBLIC LICENSE
- Version 3, 29 June 2007
-
- Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
- 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.
-
- <one line to give the program's name and a brief idea of what it does.>
- Copyright (C) <year> <name of author>
-
- This program is free software: you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
-
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-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:
-
- <program> Copyright (C) <year> <name of author>
- 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
-<http://www.gnu.org/licenses/>.
-
- 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
-<http://www.gnu.org/philosophy/why-not-lgpl.html>.
diff --git a/packages/test-simple/Cask b/packages/test-simple/Cask
deleted file mode 100644
index ee870dc..0000000
--- a/packages/test-simple/Cask
+++ /dev/null
@@ -1,4 +0,0 @@
-(source gnu)
-(source melpa)
-
-(package-file "test-simple.el")
diff --git a/packages/test-simple/INSTALL b/packages/test-simple/INSTALL
deleted file mode 100644
index 20f7800..0000000
--- a/packages/test-simple/INSTALL
+++ /dev/null
@@ -1,18 +0,0 @@
-This package is now installable from inside Emacs and melpa.
-
-We have an old-style GNU autoconf configuration as well and an install
-script to pick that up from git sources. For this, you will need:
-
- * Emacs, of course. Version 23 or better
- * _autoconf_ and _autoreconf_ to build the configure script. Usually
_autoreconf_ comes with an "autoconf" package
- * GNU Make -- or even better "remake":http//bashdb.sf.net/remake
-
-If you are feeling lucky, you can try running the install script from the
github repository:
-
- $ bash < <( curl
https://raw.github.com/rocky/emacs-test-simple/master/install-from-git.sh )
-
-Otherwise:
-
- git clone http://github.com/rocky/emacs-test-simple
- cd emacs-test-simple
- ./configure && make && [sudo] make install
diff --git a/packages/test-simple/Makefile.am b/packages/test-simple/Makefile.am
deleted file mode 100644
index 4343b3a..0000000
--- a/packages/test-simple/Makefile.am
+++ /dev/null
@@ -1,65 +0,0 @@
-# Note: This makefile include remake-style target comments.
-# These comments before the targets start with #:
-# remake --tasks to shows the targets and the comments
-
-GIT2CL ?= git2cl
-RUBY ?= ruby
-
-lisp_files := $(wildcard *.el)
-lisp_LISP = $(lisp_files)
-test_files := $(wildcard test/*.el)
-
-EXTRA_DIST = $(lisp_files) $(test_files) README THANKS README.md
-
-CHECK_FILES = $(notdir $(test_files:.el=.run))
-
-
-check: $(test-files)
- $(MAKE) -C test check
-
-README: README.textile
- ln -s README.md README
-
-PHONY=check check_copyrights clean dist distclean test check-short check-terse
install-short
-
-if MAINTAINER_MODE
-
-ChangeLog:
- git log --pretty --numstat --summary | $(GIT2CL) > $@
-
-ACLOCAL_AMFLAGS=-I .
-
-endif
-
-#: Run all tests
-test: check
-
-#: Run all tests with reduced versbosity
-check-short:
- $(MAKE) -C test check 2>&1 | ruby make-check-filter.rb
-
-#: Run tests showing only the failure lines; See also check-short
-check-terse:
- $(MAKE) check 2>&1 | $(RUBY) make-check-filter.rb | grep failure
-
-#: Run "make install" with reduced verbosity
-install-short:
- $(MAKE) install 2>&1 | $(RUBY) make-check-filter.rb
-
-CR_EXCEPTIONS=copyright_exceptions
-#: Check for GNU Copyrights.
-check_copyrights:
- @echo "Compute exceptions >$(CR_EXCEPTIONS)~"
- @export LANG=C; \
- find . -name '.git' -prune -o -name '*.el' -print0 | \
- xargs -0 grep -L 'Free Software Foundation, Inc' | \
- grep -v '\(\.dir-locals\|.-\(pkg\|autoloads\)\)\.el$$'; \
- find . -name '.git' -prune -o -name '*.el' -print | \
- while read f; do \
- fquoted="$$(echo $$f|tr '|' '_')"; \
- sed -n -e '/[Cc]opyright.*, *[1-9][-0-9]*,\?$$/N' \
- -e '/Free Software Foundation/d' \
- -e "s|^\\(.*[Cc]opyright\\)|$$fquoted:\\1|p" \
- "$$f"; \
- done | sort >$(CR_EXCEPTIONS)~
- diff -u "$(CR_EXCEPTIONS)" "$(CR_EXCEPTIONS)~"
diff --git a/packages/test-simple/NEWS b/packages/test-simple/NEWS
deleted file mode 100644
index f35d826..0000000
--- a/packages/test-simple/NEWS
+++ /dev/null
@@ -1,5 +0,0 @@
-1.0
-Initial Melpa release
-
-0.2
-Initial Release
diff --git a/packages/test-simple/README.md b/packages/test-simple/README.md
deleted file mode 100644
index 431e054..0000000
--- a/packages/test-simple/README.md
+++ /dev/null
@@ -1,86 +0,0 @@
-[](https://travis-ci.org/rocky/emacs-test-simple)
-
-*test-simple.el* is :
-
-* Simple -- no need for context macros, enclosing specifications, or required
test tags. But if you want, you still can add custom assert failure messages or
add notes before a group of tests.
-* Accomodates both interactive and non-interactive use:
- * For interactive use one can use `eval-last-sexp`, `eval-region`, and
`eval-buffer`
- * For non-interactive use run as: `emacs --batch --no-site-file --no-splash
--load <test-lisp-code.el>`
-
-I use this in my [Debugger front end](https://github.com/rocky/emacs-dbgr).
-
-Here is an example found in the [examples
directory](https://github.com/rocky/emacs-test-simple/tree/master/test).
-
-In file `gcd.el`:
-
- (defun gcd(a b)
- "Greatest Common Divisor of A and B"
- ;; Make a < b
- (if (> a b)
- (let ((c a))
- (setq a b)
- (setq b c)))
- (cond
- ((< a 0) nil)
- ((or (= 0 (- b a)) (= a 1)) a)
- (t (gcd (- b a) a))
- )
- )
-
-
-In file `test-gcd.el` in the same directory:
-
- (require 'test-simple)
- (test-simple-start) ;; Zero counters and start the stop watch.
-
- ;; Use (load-file) below because we want to always to read the source.
- ;; Also, we don't want no stinking compiled source.
- (assert-t (load-file "./gcd.el")
- "Can't load gcd.el - are you in the right directory?" )
-
- (note "degenerate cases")
-
- (assert-nil (gcd 5 -1) "using positive numbers")
- (assert-nil (gcd -4 1) "using positive numbers, switched order")
- (assert-raises error (gcd "a" 32)
- "Passing a string value should raise an error")
-
- (note "GCD computations")
- (assert-equal 1 (gcd 3 5) "gcd(3,5)")
- (assert-equal 8 (gcd 8 32) "gcd(8,32)")
-
- (end-tests) ;; Stop the clock and print a summary
-
-Edit (with Emacs of course) `test-gcd.el` and run `M-x eval-current-buffer`
-
-You should see in buffer `*test-simple*`:
-
- test-gcd.el
- ......
- 0 failures in 6 assertions (0.002646 seconds)
-
-Now let's try from a command line:
-
- $ emacs --batch --no-site-file --no-splash --load test-gcd.el
- Loading /src/external-vcs/emacs-test-simple/example/gcd.el (source)...
- *scratch*
- ......
- 0 failures in 6 assertions (0.000723 seconds)
-
-You can run noninteractive tests inside Emacs by `test-simple-run`.
-Add the following at a test file:
-
- ;;;; (test-simple-run "emacs -batch -L %s -l %s" (file-name-directory
(locate-library "test-simple.elc")) buffer-file-name)
-
-Press C-x C-e at the `test-simple-run` line to run this test file.
-Then press C-x C-z, which is customizable by `test-simple-runner-key`, to run
it more.
-If you have installed `bpr` package, use it by default because it only pops up
window when the running program exits abnormally.
-
-`test-simple-run` can be called interactively.
-In this case, the command line is set above as the simplest case.
-But you run test with dependency, you must use the sexp comment form.
-
- ;;;; (test-simple-run "emacs -batch -L %s -L %s -l %s"
(file-name-directory (locate-library "test-simple.elc")) (file-name-directory
(locate-library "foo")) buffer-file-name)
-
-*Author:* Rocky Bernstein <rocky@gnu.org> <br>
-[](https://coderwall.com/rocky)
diff --git a/packages/test-simple/THANKS b/packages/test-simple/THANKS
deleted file mode 100644
index a0e7ef1..0000000
--- a/packages/test-simple/THANKS
+++ /dev/null
@@ -1,2 +0,0 @@
-Lars Andersen (expez) - Getting this packaged and put on to Melpa.
-rubyikitch: Greatly improved noninteractive testing.
diff --git a/packages/test-simple/autogen.sh b/packages/test-simple/autogen.sh
deleted file mode 100755
index 5f00302..0000000
--- a/packages/test-simple/autogen.sh
+++ /dev/null
@@ -1,7 +0,0 @@
-#!/bin/sh
-cp README.md README
-autoreconf -vi && \
-autoconf && {
- echo "Running configure with --enable-maintainer-mode $@"
- ./configure --enable-maintainer-mode $@
-}
diff --git a/packages/test-simple/common.mk b/packages/test-simple/common.mk
deleted file mode 100644
index 26b6325..0000000
--- a/packages/test-simple/common.mk
+++ /dev/null
@@ -1,5 +0,0 @@
-short:
- $(MAKE) 2>&1 >/dev/null | ruby $(top_srcdir)/make-check-filter.rb
-
-%.short:
- $(MAKE) $(@:.short=) 2>&1 >/dev/null
diff --git a/packages/test-simple/compute-lispdir.sh
b/packages/test-simple/compute-lispdir.sh
deleted file mode 100755
index dba43c9..0000000
--- a/packages/test-simple/compute-lispdir.sh
+++ /dev/null
@@ -1,46 +0,0 @@
-#!/bin/bash
-# Figures out a reasonable --prefix
-typeset -i rc=0
-typeset -i DEBUG=${DEBUG:-0}
-EMACS_PROG=${EMACS_PROG:-emacs}
-list=$($EMACS_PROG --batch --no-splash --eval '(message (substring (format
"%s" load-path) 1 -1))' 2>&1)
-rc=$?
-if (( rc != 0 )) ; then
- echo >&2 "Something went running $EMACS_PROG"
- exit $rc
-$cmd
-fi
-for dir in $list ; do
- if [[ -d $dir ]] ; then
- case $dir in
- */emacs/site-lisp)
- ((DEBUG)) && echo "site lisp: $dir"
- echo "$dir"
- exit 0
- ;;
- esac
- fi
-done
-for dir in $list ; do
- if [[ -d $dir ]] ; then
- case $dir in
- */emacs/2[34]\.[0-9]/site-lisp)
- ((DEBUG)) && echo "versioned site lisp: $dir"
- echo "$dir"
- exit 0
- ;;
- esac
- fi
-done
-for dir in $list ; do
- if [[ -d $dir ]] ; then
- case $dir in
- */emacs/2[34]\.[0-9]/site-lisp)
- ((DEBUG)) && echo "versioned site lisp: $dir"
- echo "$dir"
- exit 0
- ;;
- esac
- fi
-done
-exit 0
diff --git a/packages/test-simple/configure.ac
b/packages/test-simple/configure.ac
deleted file mode 100644
index ae0cbee..0000000
--- a/packages/test-simple/configure.ac
+++ /dev/null
@@ -1,44 +0,0 @@
-dnl FIXME: pick up from test-simple.el
-AC_INIT(emacs-test-simple, 1.0,)
-AC_CONFIG_SRCDIR(test-simple.el)
-AM_INIT_AUTOMAKE([foreign])
-AM_MAINTAINER_MODE
-
-AC_PATH_PROG([EMACS], [emacs], [emacs])
-AC_MSG_NOTICE("Checking emacs version and prerequiste packages")
-$EMACS -batch -q -no-site-file -eval \
- '(if (<= emacs-major-version 22)
- (progn
- (error "You need GNU Emacs 23 or better.")
- (kill-emacs 1)
- )
- )'
-if test $? -ne 0 ; then
- AC_MSG_ERROR([Can't continue until above error is corrected.])
-fi
-
-##################################################################
-# See if --with-lispdir was set. If not, set it to a reasonable default
-# based on where bash thinks bashdb is supposed to be installed.
-##################################################################
-
-AM_MISSING_PROG(GIT2CL, git2cl, $missing_dir)
-
-# Check whether --with-lispdir was given.
-if test "${with_lispdir+set}" = set -o "${prefix+set}" = set; then :
-else
- my_lispdir=$(EMACS_PROG=$EMACS $SH_PROG $(dirname $0)/compute-lispdir.sh)
- if test "${my_lispdir+set}" = set; then :
- with_lispdir=$my_lispdir
- echo "'compute-lispdir.sh' lispdir install directory override:
'$with_lispdir'"
- fi
-fi
-
-##
-## Find out where to install the debugger emacs lisp files
-##
-AM_PATH_LISPDIR
-AM_CONDITIONAL(INSTALL_EMACS_LISP, test "x$lispdir" != "x")
-
-AC_CONFIG_FILES([Makefile test/Makefile])
-AC_OUTPUT
diff --git a/packages/test-simple/copyright_exceptions
b/packages/test-simple/copyright_exceptions
deleted file mode 100644
index e69de29..0000000
diff --git a/packages/test-simple/elisp-comp b/packages/test-simple/elisp-comp
deleted file mode 100755
index ecc6b15..0000000
--- a/packages/test-simple/elisp-comp
+++ /dev/null
@@ -1,94 +0,0 @@
-#!/bin/sh
-# Copyright (C) 1995, 2000, 2003, 2004, 2005, 2009, 2010 Free Software
-# Foundation, Inc.
-
-scriptversion=2010-02-06.18; # UTC
-
-# Franc,ois Pinard <pinard@iro.umontreal.ca>, 1995.
-#
-# 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, or (at your option)
-# any later version.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-# As a special exception to the GNU General Public License, if you
-# distribute this file as part of a program that contains a
-# configuration script generated by Autoconf, you may include it under
-# the same distribution terms that you use for the rest of that program.
-
-# This file is maintained in Automake, please report
-# bugs to <bug-automake@gnu.org> or send patches to
-# <automake-patches@gnu.org>.
-
-case $1 in
- '')
- echo "$0: No files. Try \`$0 --help' for more information." 1>&2
- exit 1;
- ;;
- -h | --h*)
- cat <<\EOF
-Usage: elisp-comp [--help] [--version] FILES...
-
-This script byte-compiles all `.el' files listed as FILES using GNU
-Emacs, and put the resulting `.elc' files into the current directory,
-so disregarding the original directories used in `.el' arguments.
-
-This script manages in such a way that all Emacs LISP files to
-be compiled are made visible between themselves, in the event
-they require or load-library one another.
-
-Report bugs to <bug-automake@gnu.org>.
-EOF
- exit $?
- ;;
- -v | --v*)
- echo "elisp-comp $scriptversion"
- exit $?
- ;;
-esac
-
-if test -z "$EMACS" || test "$EMACS" = "t"; then
- # Value of "t" means we are running in a shell under Emacs.
- # Just assume Emacs is called "emacs".
- EMACS=emacs
-fi
-
-tempdir=elc.$$
-
-# Cleanup the temporary directory on exit.
-trap 'ret=$?; rm -rf "$tempdir" && exit $ret' 0
-do_exit='(exit $ret); exit $ret'
-trap "ret=129; $do_exit" 1
-trap "ret=130; $do_exit" 2
-trap "ret=141; $do_exit" 13
-trap "ret=143; $do_exit" 15
-
-mkdir $tempdir
-cp "$@" $tempdir
-
-(
- cd $tempdir
- echo "(setq load-path (cons nil load-path))" > script
- $EMACS -batch -q -l script -f batch-byte-compile *.el || exit $?
- mv *.elc ..
-) || exit $?
-
-(exit 0); exit 0
-
-# Local Variables:
-# mode: shell-script
-# sh-indentation: 2
-# eval: (add-hook 'write-file-hooks 'time-stamp)
-# time-stamp-start: "scriptversion="
-# time-stamp-format: "%:y-%02m-%02d.%02H"
-# time-stamp-time-zone: "UTC"
-# time-stamp-end: "; # UTC"
-# End:
diff --git a/packages/test-simple/example/gcd-tests.el
b/packages/test-simple/example/gcd-tests.el
deleted file mode 100644
index b4e58d6..0000000
--- a/packages/test-simple/example/gcd-tests.el
+++ /dev/null
@@ -1,42 +0,0 @@
-;;; gcd-tests.el
-;; Copyright (C) 2015 Free Software Foundation, Inc
-
-;; Author: Rocky Bernstein <rocky@gnu.org>
-;; URL: http://github.com/rocky/emacs-test-simple
-;; Keywords: unit-test
-;; Version: 1.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 the Free Software Foundation, either version 3 of the
-;; License, or (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see
-;; <http://www.gnu.org/licenses/>.
-;;;; (test-simple-run "emacs -batch -L %s -l %s" (file-name-directory
(locate-library "test-simple.elc")) buffer-file-name)
-(require 'test-simple)
-
-(test-simple-start)
-
-(assert-t (load-file "./gcd.el")
- "Can't load gcd.el - are you in the right directory?" )
-
-(note "degenereate cases")
-
-(assert-nil (gcd 5 -1) "using positive numbers")
-(assert-nil (gcd -4 1) "using positive numbers, switched order")
-
-(note "GCD computations")
-(assert-equal 1 (gcd 3 5) "gcd(3,5)")
-(assert-equal 8 (gcd 8 32) "gcd(8,32)")
-
-(assert-raises error (gcd "a" 32)
- "Passing a string value should raise an error")
-
-(end-tests)
diff --git a/packages/test-simple/example/gcd.el
b/packages/test-simple/example/gcd.el
deleted file mode 100644
index ed587be..0000000
--- a/packages/test-simple/example/gcd.el
+++ /dev/null
@@ -1,34 +0,0 @@
-;;; test-simple.el --- Simple Unit Test Framework for Emacs Lisp
-;; Copyright (C) 2015 Free Software Foundation, Inc
-
-;; Author: Rocky Bernstein <rocky@gnu.org>
-;; URL: http://github.com/rocky/emacs-test-simple
-;; Keywords: unit-test
-;; Version: 1.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 the Free Software Foundation, either version 3 of the
-;; License, or (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see
-;; <http://www.gnu.org/licenses/>.
-(defun gcd(a b)
- "Greatest Common Divisor of A and B"
- ;; Make a < b
- (if (> a b)
- (let ((c a))
- (setq a b)
- (setq b c)))
- (cond
- ((< a 0) nil)
- ((or (= 0 (- b a)) (= a 1)) a)
- (t (gcd (- b a) a))
- )
-)
diff --git a/packages/test-simple/install-from-git.sh
b/packages/test-simple/install-from-git.sh
deleted file mode 100755
index 6034983..0000000
--- a/packages/test-simple/install-from-git.sh
+++ /dev/null
@@ -1,94 +0,0 @@
-#!/bin/bash
-# This installs all emcs-test-simple and its prerequisites. If you are lucky
-# you can just run this:
-#
-# bash ./install-from-git.sh
-#
-# However we do provide for some customization...
-#
-# 1. GIT PROTOCOL
-# ===============
-#
-# If your "git clone" can't handle the "http" protocol, you might be
-# able to use the "git" protocol. To do this set the GIT_PROTOCOL
-# variable like this:
-#
-# GIT_PROTOCOL=git sh ./install-from-git.sh
-#
-# 2. configure options (e.g --prefix)
-# ====================================
-
-# If you want to customize configuration parameters, for example,
-# choose where to install, you can pass configure options to this
-# script. For example:# can pass configure options.
-#
-# sh ./install-from-git.sh --prefix=/tmp
-#
-# 3. TO "sudo" or not to "sudo"?
-# ==============================
-# If you are running as root on a *Nix-like box, then there's no problem.
-#
-# If you are not running as root, "sudo" might be invoked to install
-# code. On systems that don't have a "sudo" command but need
-# filesystem permission, then you get by with setting SUDO_CMD to "su root-c"
-# For example:
-#
-# SUDO_CMD='su root -c' sh ./install-from-git.sh
-#
-# If you have sufficient filesystem permission (which is often the
-# case on Windows or cygwin) then you might not need or want sudo. So
-# here, set SUDO_CMD to a blank:
-#
-# SUDO_CMD=' ' sh ./install-from-git.sh
-#
-#
-# To finish here is an invocation using all 3 above options:
-# GIT_PROTOCOL='git' SUDO_CMD=' ' sh ./install-from-git.sh --prefix=/tmp
-
-GIT_PROTOCOL=${GIT_PROTOCOL:-http}
-
-run_cmd() {
- echo "--- Running command: $@"
- $@
- rc=$?
- echo "--- $@ exit status is $?"
- return $rc
-}
-
-if (( $(id -u) != 0)) ; then
- if [[ -z "$SUDO_CMD" ]] ; then
- need_sudo='sudo'
- if which $need_sudo >/dev/null 2>&1 ; then
- try_cmd=''
- else
- need_sudo='su root -c'
- try_cmd='su'
- fi
- else
- need_sudo="$SUDO_CMD"
- fi
-else
- need_sudo=''
- try_cmd=''
-fi
-
-for program in git make $try_cmd ; do
- if ! which $program >/dev/null 2>&1 ; then
- echo "Cant find program $program in $PATH"
- exit 1
- fi
-done
-
-for pkg in emacs-test-simple ; do
- echo '******************************************'
- echo Trying to install ${pkg}...
- echo '******************************************'
- run_cmd git clone ${GIT_PROTOCOL}://github.com/rocky/${pkg}.git
- (cd $pkg && \
- run_cmd $SHELL ./autogen.sh && \
- run_cmd ./configure $@ && \
- run_cmd make && \
- run_cmd make check && \
- run_cmd $need_sudo make install
- )
-done
diff --git a/packages/test-simple/make-check-filter.rb
b/packages/test-simple/make-check-filter.rb
deleted file mode 100755
index daee7c9..0000000
--- a/packages/test-simple/make-check-filter.rb
+++ /dev/null
@@ -1,21 +0,0 @@
-#!/usr/bin/env ruby
-# Use this to cut out the crud from make check.
-# Use like this:
-# make check 2>&1 | ruby ../make-check-filter.rb
-# See Makefile.am
-pats = ["^(?:Loading",
- 'make\[',
- "Making check in",
- '\(cd \.\.',
- "make -C",
- "Test-Unit",
- "Fontifying",
- '\s*$'
- ].join('|') + ')'
-# puts pats
-skip_re = /#{pats}/
-
-while gets()
- next if $_ =~ skip_re
- puts $_
-end
diff --git a/packages/test-simple/test-simple.el
b/packages/test-simple/test-simple.el
deleted file mode 100644
index 9fd0e7b..0000000
--- a/packages/test-simple/test-simple.el
+++ /dev/null
@@ -1,386 +0,0 @@
-;;; test-simple.el --- Simple Unit Test Framework for Emacs Lisp -*-
lexical-binding: t -*-
-;; Rewritten from Phil Hagelberg's behave.el by rocky
-
-;; Copyright (C) 2015, 2016, 2017 Free Software Foundation, Inc
-
-;; Author: Rocky Bernstein <rocky@gnu.org>
-;; URL: http://github.com/rocky/emacs-test-simple
-;; Keywords: unit-test
-;; Package-Requires: ((cl-lib "0"))
-;; Version: 1.3.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 the Free Software Foundation, either version 3 of the
-;; License, or (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see
-;; <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; test-simple.el is:
-;;
-;; * Simple. No need for
-;; - context macros,
-;; - enclosing specifications,
-;; - required test tags.
-;;
-;; But if you want, you still can enclose tests in a local scope,
-;; add customized assert failure messages, or add summary messages
-;; before a group of tests.
-;;
-;; * Accommodates both interactive and non-interactive use.
-;; - For interactive use, one can use `eval-last-sexp', `eval-region',
-;; and `eval-buffer'. One can `edebug' the code.
-;; - For non-interactive use, run:
-;; emacs --batch --no-site-file --no-splash --load <test-lisp-code.el>
-;;
-;; Here is an example using gcd.el found in the examples directory.
-;;
-;; (require 'test-simple)
-;; (test-simple-start) ;; Zero counters and start the stop watch.
-;;
-;; ;; Use (load-file) below because we want to always to read the source.
-;; ;; Also, we don't want no stinking compiled source.
-;; (assert-t (load-file "./gcd.el")
-;; "Can't load gcd.el - are you in the right directory?" )
-;;
-;; (note "degenerate cases")
-;;
-;; (assert-nil (gcd 5 -1) "using positive numbers")
-;; (assert-nil (gcd -4 1) "using positive numbers, switched order")
-;; (assert-raises error (gcd "a" 32)
-;; "Passing a string value should raise an error")
-;;
-;; (note "GCD computations")
-;; (assert-equal 1 (gcd 3 5) "gcd(3,5)")
-;; (assert-equal 8 (gcd 8 32) "gcd(8,32)")
-;; (end-tests) ;; Stop the clock and print a summary
-;;
-;; Edit (with Emacs of course) gcd-tests.el and run M-x eval-current-buffer
-;;
-;; You should see in buffer *test-simple*:
-;;
-;; gcd-tests.el
-;; ......
-;; 0 failures in 6 assertions (0.002646 seconds)
-;;
-;; Now let us try from a command line:
-;;
-;; $ emacs --batch --no-site-file --no-splash --load gcd-tests.el
-;; Loading /src/external-vcs/emacs-test-simple/example/gcd.el (source)...
-;; *scratch*
-;; ......
-;; 0 failures in 6 assertions (0.000723 seconds)
-
-;;; To do:
-
-;; FIXME: Namespace is all messed up!
-;; Main issues: more expect predicates
-
-(require 'time-date)
-
-;;; Code:
-
-;; Press C-x C-e at the end of the next line configure the program in GNU emacs
-;; for building via "make" to get set up.
-;; (compile (format "EMACSLOADPATH=:%s ./autogen.sh" "."))
-;; After that you can run:
-;; (compile "make check")
-
-(require 'cl-lib)
-
-(defgroup test-simple nil
- "Simple Unit Test Framework for Emacs Lisp"
- :group 'lisp)
-
-(defcustom test-simple-runner-interface (if (fboundp 'bpr-spawn)
- 'bpr-spawn
- 'compile)
- "Function with one string argument when running tests non-interactively.
-Command line started with `emacs --batch' is passed as the argument.
-
-`bpr-spawn', which is in bpr package, is preferable because of no window popup.
-If bpr is not installed, fall back to `compile'."
- :type 'function
- :group 'test-simple)
-
-(defcustom test-simple-runner-key "C-x C-z"
- "Key to run non-interactive test after defining command line by
`test-simple-run'."
- :type 'string
- :group 'test-simple)
-
-(defvar test-simple-debug-on-error nil
- "If non-nil raise an error on the first failure.")
-
-(defvar test-simple-verbosity 0
- "The greater the number the more verbose output.")
-
-(cl-defstruct test-info
- description ;; description of last group of tests
- (assert-count 0) ;; total number of assertions run
- (failure-count 0) ;; total number of failures seen
- (start-time (current-time)) ;; Time run started
- )
-
-(defvar test-simple-info (make-test-info)
- "Variable to store testing information for a buffer.")
-
-(defun note (description &optional test-info)
- "Add a name to a group of tests."
- (if (getenv "USE_TAP")
- (test-simple-msg (format "# %s" description) 't)
- (if (> test-simple-verbosity 0)
- (test-simple-msg (concat "\n" description) 't))
- (unless test-info
- (setq test-info test-simple-info))
- (setf (test-info-description test-info) description)
- ))
-
-;;;###autoload
-(defmacro test-simple-start (&optional test-start-msg)
- `(test-simple-clear nil
- (or ,test-start-msg
- (if (and (functionp '__FILE__) (__FILE__))
- (file-name-nondirectory (__FILE__))
- (buffer-name)))
- ))
-
-;;;###autoload
-(defun test-simple-clear (&optional test-info test-start-msg)
- "Initialize and reset everything to run tests.
-You should run this before running any assertions. Running more than once
-clears out information from the previous run."
-
- (interactive)
-
- (unless test-info
- (setq test-info test-simple-info))
-
- (setf (test-info-description test-info) "none set")
- (setf (test-info-start-time test-info) (current-time))
- (setf (test-info-assert-count test-info) 0)
- (setf (test-info-failure-count test-info) 0)
-
- (with-current-buffer (get-buffer-create "*test-simple*")
- (let ((old-read-only inhibit-read-only))
- (setq inhibit-read-only 't)
- (delete-region (point-min) (point-max))
- (if test-start-msg (insert (format "%s\n" test-start-msg)))
- (setq inhibit-read-only old-read-only)))
- (unless noninteractive
- (message "Test-Simple: test information cleared")))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Assertion tests
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defmacro assert-raises (error-condition body &optional fail-message)
- (let ((fail-message (or fail-message
- (format "assert-raises did not get expected %s"
- error-condition))))
- (list 'condition-case nil
- (list 'progn body
- (list 'assert-t nil fail-message))
- (list error-condition '(assert-t t)))))
-
-(defun assert-op (op expected actual &optional fail-message test-info)
- "Expectation is that ACTUAL should be equal to EXPECTED."
- (unless test-info (setq test-info test-simple-info))
- (cl-incf (test-info-assert-count test-info))
- (if (not (funcall op actual expected))
- (let* ((fail-message
- (if fail-message
- (format "Message: %s" fail-message)
- ""))
- (expect-message
- (format "\n Expected: %S\n Got: %S" expected actual))
- (test-info-mess
- (if (boundp 'test-info)
- (test-info-description test-info)
- "unset")))
- (test-simple--add-failure (format "assert-%s" op) test-info-mess
- (concat fail-message expect-message)))
- (test-simple--ok-msg fail-message)))
-
-(defun assert-equal (expected actual &optional fail-message test-info)
- "Expectation is that ACTUAL should be equal to EXPECTED."
- (assert-op 'equal expected actual fail-message test-info))
-
-(defun assert-eq (expected actual &optional fail-message test-info)
- "Expectation is that ACTUAL should be EQ to EXPECTED."
- (assert-op 'eql expected actual fail-message test-info))
-
-(defun assert-eql (expected actual &optional fail-message test-info)
- "Expectation is that ACTUAL should be EQL to EXPECTED."
- (assert-op 'eql expected actual fail-message test-info))
-
-(defun assert-matches (expected-regexp actual &optional fail-message test-info)
- "Expectation is that ACTUAL should match EXPECTED-REGEXP."
- (unless test-info (setq test-info test-simple-info))
- (cl-incf (test-info-assert-count test-info))
- (if (not (string-match expected-regexp actual))
- (let* ((fail-message
- (if fail-message
- (format "\n\tMessage: %s" fail-message)
- ""))
- (expect-message
- (format "\tExpected Regexp: %s\n\tGot: %s"
- expected-regexp actual))
- (test-info-mess
- (if (boundp 'test-info)
- (test-info-description test-info)
- "unset")))
- (test-simple--add-failure "assert-equal" test-info-mess
- (concat expect-message fail-message)))
- (progn (test-simple-msg ".") t)))
-
-(defun assert-t (actual &optional fail-message test-info)
- "expectation is that ACTUAL is not nil."
- (assert-nil (not actual) fail-message test-info))
-
-(defun assert-nil (actual &optional fail-message test-info)
- "expectation is that ACTUAL is nil. FAIL-MESSAGE is an optional
-additional message to be displayed."
- (unless test-info (setq test-info test-simple-info))
- (cl-incf (test-info-assert-count test-info))
- (if actual
- (let* ((fail-message
- (if fail-message
- (format "\n\tMessage: %s" fail-message)
- ""))
- (test-info-mess
- (if (boundp 'test-simple-info)
- (test-info-description test-simple-info)
- "unset")))
- (test-simple--add-failure "assert-nil" test-info-mess
- fail-message test-info))
- (test-simple--ok-msg fail-message)))
-
-(defun test-simple--add-failure (type test-info-msg fail-msg
- &optional test-info)
- (unless test-info (setq test-info test-simple-info))
- (cl-incf (test-info-failure-count test-info))
- (let ((failure-msg
- (format "\nDescription: %s, type %s\n%s" test-info-msg type fail-msg))
- )
- (save-excursion
- (test-simple--not-ok-msg fail-msg)
- (test-simple-msg failure-msg 't)
- (unless noninteractive
- (if test-simple-debug-on-error
- (signal 'test-simple-assert-failed failure-msg)
- ;;(message failure-msg)
- )))))
-
-(defun end-tests (&optional test-info)
- "Give a tally of the tests run."
- (interactive)
- (unless test-info (setq test-info test-simple-info))
- (test-simple-describe-failures test-info)
- (cond (noninteractive
- (set-buffer "*test-simple*")
- (cond ((getenv "USE_TAP")
- (princ (format "%s\n" (buffer-string)))
- )
- (t ;; non-TAP goes to stderr (backwards compatibility)
- (message "%s" (buffer-substring (point-min) (point-max)))
- )))
- (t ;; interactive
- (switch-to-buffer-other-window "*test-simple*")
- )))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Reporting
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defun test-simple-msg(msg &optional newline)
- (switch-to-buffer "*test-simple*")
- (let ((inhibit-read-only t))
- (insert msg)
- (if newline (insert "\n"))
- (switch-to-buffer nil)
- ))
-
-(defun test-simple--ok-msg (fail-message &optional test-info)
- (unless test-info (setq test-info test-simple-info))
- (let ((msg (if (getenv "USE_TAP")
- (if (equal fail-message "")
- (format "ok %d\n" (test-info-assert-count test-info))
- (format "ok %d - %s\n"
- (test-info-assert-count test-info)
- fail-message))
- ".")))
- (test-simple-msg msg))
- 't)
-
-(defun test-simple--not-ok-msg (_fail-message &optional test-info)
- (unless test-info (setq test-info test-simple-info))
- (let ((msg (if (getenv "USE_TAP")
- (format "not ok %d\n" (test-info-assert-count test-info))
- "F")))
- (test-simple-msg msg))
- nil)
-
-(defun test-simple-summary-line(info)
- (let*
- ((failures (test-info-failure-count info))
- (asserts (test-info-assert-count info))
- (problems (concat (number-to-string failures) " failure"
- (unless (= 1 failures) "s")))
- (tests (concat (number-to-string asserts) " assertion"
- (unless (= 1 asserts) "s")))
- (elapsed-time (time-since (test-info-start-time info)))
- )
- (if (getenv "USE_TAP")
- (format "1..%d" asserts)
- (format "\n%s in %s (%g seconds)" problems tests
- (float-time elapsed-time))
- )))
-
-(defun test-simple-describe-failures(&optional test-info)
- (unless test-info (setq test-info test-simple-info))
- (goto-char (point-max))
- (test-simple-msg (test-simple-summary-line test-info)))
-
-;;;###autoload
-(defun test-simple-run (&rest command-line-formats)
- "Register command line to run tests non-interactively and bind key to run
test.
-After calling this function, you can run test by key specified by
`test-simple-runner-key'.
-
-It is preferable to write at the first line of test files as a comment, e.g,
-;;;; (test-simple-run \"emacs -batch -L %s -l %s\" (file-name-directory
(locate-library \"test-simple.elc\")) buffer-file-name)
-
-Calling this function interactively, COMMAND-LINE-FORMATS is set above."
- (interactive)
- (setq command-line-formats
- (or command-line-formats
- (list "emacs -batch -L %s -l %s"
- (file-name-directory (locate-library "test-simple.elc"))
- buffer-file-name)))
- (let ((func (lambda ()
- (interactive)
- (funcall test-simple-runner-interface
- (apply 'format command-line-formats)))))
- (global-set-key (kbd test-simple-runner-key) func)
- (funcall func)))
-
-(defun test-simple-noninteractive-kill-emacs-hook ()
- "Emacs exits abnormally when noninteractive test fails."
- (when (and noninteractive test-simple-info
- (<= 1 (test-info-failure-count test-simple-info)))
- (let (kill-emacs-hook)
- (kill-emacs 1))))
-(when noninteractive
- (add-hook 'kill-emacs-hook 'test-simple-noninteractive-kill-emacs-hook))
-
-
-(provide 'test-simple)
-;;; test-simple.el ends here
diff --git a/packages/test-simple/test/.gitignore
b/packages/test-simple/test/.gitignore
deleted file mode 100644
index b336cc7..0000000
--- a/packages/test-simple/test/.gitignore
+++ /dev/null
@@ -1,2 +0,0 @@
-/Makefile
-/Makefile.in
diff --git a/packages/test-simple/test/Makefile.am
b/packages/test-simple/test/Makefile.am
deleted file mode 100644
index cd86850..0000000
--- a/packages/test-simple/test/Makefile.am
+++ /dev/null
@@ -1,29 +0,0 @@
-include $(top_srcdir)/common.mk
-
-PHONY=check test all
-EXTRA_DIST=gcd.py gcd.rb
-
-all:
-
-#: same thing as "check"
-test: check
-
-test_files := $(wildcard test-*.el)
-
-CHECK_FILES = $(notdir $(test_files:.el=.run))
-
-#: Run all tests
-check: $(CHECK_FILES)
-
-#: Run all tests with minimum verbosity
-check-short:
- $(MAKE) check 2>&1 | ruby ../make-check-filter.rb
-
-test-%.run:
- (cd $(top_srcdir)/test && $(EMACS) --batch --no-site-file --no-splash
--load $(@:.run=.el))
-
-# Whatever it is you want to do, it should be forwarded to the
-# to top-level directories
-%:
- $(MAKE) -C .. $@
-
diff --git a/packages/test-simple/test/test-basic.el
b/packages/test-simple/test/test-basic.el
deleted file mode 100644
index be14140..0000000
--- a/packages/test-simple/test/test-basic.el
+++ /dev/null
@@ -1,29 +0,0 @@
-;;; test-simple.el --- Simple Unit Test Framework for Emacs Lisp
-;; Copyright (C) 2015 Free Software Foundation, Inc
-;; Author: Rocky Bernstein <rocky@gnu.org>
-;; This program is free software: you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation, either version 3 of the
-;; License, or (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see
-;; <http://www.gnu.org/licenses/>.
-(require 'cl-lib)
-(load-file "../test-simple.el")
-(test-simple-start "test-simple.el")
-
-(note "basic-tests")
-(assert-t (memq 'test-simple features) "'test-simple provided")
-
-(assert-nil nil "assert-nil failure test")
-(assert-nil nil "Knights of ni")
-(assert-equal 5 (+ 1 4) "assert-equal")
-(assert-raises error (error "you should not see this") "assert-raises")
-
-(end-tests)
diff --git a/packages/test-simple/test/test-fns.el
b/packages/test-simple/test/test-fns.el
deleted file mode 100644
index cad655e..0000000
--- a/packages/test-simple/test/test-fns.el
+++ /dev/null
@@ -1,39 +0,0 @@
-;;; test-simple.el --- Simple Unit Test Framework for Emacs Lisp
-;; Copyright (C) 2015 Free Software Foundation, Inc
-;; Author: Rocky Bernstein <rocky@gnu.org>
-;; This program is free software: you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation, either version 3 of the
-;; License, or (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see
-;; <http://www.gnu.org/licenses/>.
-(require 'cl-lib)
-(load-file "../test-simple.el")
-(test-simple-clear)
-
-(setq test-info (make-test-info))
-(test-simple-clear test-info)
-
-(note "Initializing test information")
-(assert-equal 0 (test-info-assert-count test-info) "Count zeroed")
-(assert-equal 0 (test-info-failure-count test-info) "Failure zeroed")
-
-(note "Summary information")
-(assert-matches "0 failures in 0 assertions" (test-simple-summary-line
test-info)
- "initial summary")
-(cl-incf (test-info-assert-count test-info))
-(cl-incf (test-info-failure-count test-info))
-(assert-matches "1 failure in 1 assertion" (test-simple-summary-line test-info)
- "handling singular correctly")
-(cl-incf (test-info-assert-count test-info))
-(assert-matches "1 failure in 2 assertions" (test-simple-summary-line
test-info)
- "back to plural for two assertions")
-
-(end-tests)
diff --git a/packages/test-simple/test/test-no-clear.el
b/packages/test-simple/test/test-no-clear.el
deleted file mode 100644
index 748baa0..0000000
--- a/packages/test-simple/test/test-no-clear.el
+++ /dev/null
@@ -1,27 +0,0 @@
-;;; test-simple.el --- Simple Unit Test Framework for Emacs Lisp
-;; Copyright (C) 2015 Free Software Foundation, Inc
-;; Author: Rocky Bernstein <rocky@gnu.org>
-;; This program is free software: you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation, either version 3 of the
-;; License, or (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see
-;; <http://www.gnu.org/licenses/>.
-(require 'cl-lib)
-(load-file "../test-simple.el")
-;; We don't do this or test-simple-start
-;; (test-simple-clear)
-
-(note "no-test-start")
-(assert-t (memq 'test-simple features) "'test-simple provided")
-
-(assert-nil nil)
-
-(end-tests)
diff --git a/packages/vdiff/.github/workflows/test.yml
b/packages/vdiff/.github/workflows/test.yml
deleted file mode 100644
index 7c77b01..0000000
--- a/packages/vdiff/.github/workflows/test.yml
+++ /dev/null
@@ -1,30 +0,0 @@
-name: evil-vdiff-test
-on:
- pull_request:
- push:
- branches:
- - master
-
-jobs:
- build:
- runs-on: ubuntu-latest
- strategy:
- matrix:
- emacs_version:
- - 25.1
- - 25.2
- - 25.3
- - 26.1
- - 26.2
- - 26.3
- - snapshot
- steps:
-
- - uses: actions/checkout@v2
- - uses: actions/setup-python@v1
- - uses: purcell/setup-emacs@master
- with:
- version: ${{ matrix.emacs_version }}
- - uses: conao3/setup-cask@master
- - name: Run tests
- run: make test
diff --git a/packages/vdiff/.gitignore b/packages/vdiff/.gitignore
deleted file mode 100644
index e684078..0000000
--- a/packages/vdiff/.gitignore
+++ /dev/null
@@ -1,5 +0,0 @@
-*.elc
-/vdiff-test.el
-/vdiff-test2.el
-/test*
-.cask/
diff --git a/packages/vdiff/Cask b/packages/vdiff/Cask
deleted file mode 100644
index f3d27cf..0000000
--- a/packages/vdiff/Cask
+++ /dev/null
@@ -1,7 +0,0 @@
-(source gnu)
-
-(package-file "vdiff.el")
-
-(development
- (depends-on "ert")
- (depends-on "hydra"))
diff --git a/packages/vdiff/LICENSE b/packages/vdiff/LICENSE
deleted file mode 100644
index 9cecc1d..0000000
--- a/packages/vdiff/LICENSE
+++ /dev/null
@@ -1,674 +0,0 @@
- GNU GENERAL PUBLIC LICENSE
- Version 3, 29 June 2007
-
- Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
- 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.
-
- {one line to give the program's name and a brief idea of what it does.}
- Copyright (C) {year} {name of author}
-
- This program is free software: you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
-
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-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:
-
- {project} Copyright (C) {year} {fullname}
- 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
-<http://www.gnu.org/licenses/>.
-
- 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
-<http://www.gnu.org/philosophy/why-not-lgpl.html>.
diff --git a/packages/vdiff/Makefile b/packages/vdiff/Makefile
deleted file mode 100644
index 6504277..0000000
--- a/packages/vdiff/Makefile
+++ /dev/null
@@ -1,19 +0,0 @@
-.PHONY : test
-
-EMACS ?= emacs
-CASK ?= cask
-
-LOADPATH = -L .
-
-ELPA_DIR = \
- .cask/$(shell $(EMACS) -Q --batch --eval '(princ emacs-version)')/elpa
-
-test: elpa
- $(CASK) exec $(EMACS) -Q -batch $(LOADPATH) \
- -l vdiff-test.el -f ert-run-tests-batch-and-exit
-
-elpa: $(ELPA_DIR)
-$(ELPA_DIR): Cask
- $(CASK) install
- mkdir -p $(ELPA_DIR)
- touch $@
diff --git a/packages/vdiff/README.org b/packages/vdiff/README.org
deleted file mode 100644
index 9fe6523..0000000
--- a/packages/vdiff/README.org
+++ /dev/null
@@ -1,215 +0,0 @@
-[[https://melpa.org/#/vdiff][file:https://melpa.org/packages/vdiff-badge.svg]]
[[evil-vdiff-test][https://github.com/justbur/emacs-vdiff/workflows/evil-vdiff-test/badge.svg]]
-
-* vdiff
-
-A tool like vimdiff for Emacs
-
-** Table of Contents :TOC:
-- [[#vdiff][vdiff]]
- - [[#introduction][Introduction]]
- - [[#recent-significant-changes][Recent (Significant) Changes]]
- - [[#screenshot][Screenshot]]
- - [[#installation-and-usage][Installation and Usage]]
- - [[#hydra][Hydra]]
- - [[#further-customization][Further customization]]
-
-** Introduction
-
- vdiff compares two or three buffers on the basis of the output from the diff
- tool. The buffers are kept synchronized so that as you move through one of
- the buffers the top of the active buffer aligns with the corresponding top
of
- the other buffer(s). This is similar to how ediff works, but in ediff you
use
- a third "control buffer" to move through the diffed buffers. The key
- difference is that in vdiff you are meant to actively edit one of the
buffers
- and the display will update automatically for the other buffer. Similar to
- ediff, vdiff provides commands to "send" and "receive" hunks from one buffer
- to the other as well as commands to traverse the diff hunks, which are
useful
- if you are trying to merge changes. In contrast to ediff, vdiff also
provides
- folding capabilities to fold sections of the buffers that don't contain
- changes. This folding occurs automatically. Finally, you are encouraged to
- bind a key to `vdiff-hydra/body', which will use hydra.el (in ELPA) to
create
- a convenient transient keymap containing most of the useful vdiff commands.
-
- This functionality is all inspired by (but not equivalent to) the vimdiff
- tool from vim.
-
- Contributions and suggestions are very welcome.
-
-** Recent (Significant) Changes
- - [2019-02-26] If the region is active when changes are sent to other
- buffers, only lines in the intersection of the region and any hunks are
- sent. This allows sending individual lines, similar to how individual
lines
- can be staged in magit.
- - [2018-04-17] Add option to use various git diff algorithms. See
- =vdiff-diff-algorithm= for options.
- - [2017-05-17] Split =vdiff-magit.el= into
[[https://github.com/justbur/emacs-vdiff-magit][separate repository]].
- - [2017-02-01] Added magit integration functions in =vdiff-magit.el=.
- - [2016-07-25] Added three-way diff support. See =vdiff-buffers3= and
=vdiff-files3=.
-
-** Screenshot
-
-*** Basic two file diff with refined hunks
-[[./img/leuven.png]]
-
-*** Three file diff with targets for sending changes
-[[./img/leuven3.png]]
-
-** Installation and Usage
-
-vdiff is available in MELPA, which is the recommended way to install it and
keep
-it up to date. To install it you may do =M-x package-install RET vdiff RET=.
-
-To start a vdiff session, the main entry points are
-
-| Command | Description
|
-|------------------------+-------------------------------------------------------------------|
-| =vdiff-buffers= | Diff two open buffers
|
-| =vdiff-files= | Diff two files
|
-| =vdiff-buffers3= | Diff three open buffers
|
-| =vdiff-files3= | Diff three files
|
-| =vdiff-current-file= | Like =ediff-current-file= (Diff buffer with disk
version of file) |
-| =vdiff-merge-conflict= | Use vdiff to resolve merge conflicts in current
file |
-
-After installing you can bind the commands to your preferred key prefix like
this
-
-#+BEGIN_SRC emacs-lisp
-(require 'vdiff)
-(define-key vdiff-mode-map (kbd "C-c") vdiff-mode-prefix-map)
-#+END_SRC
-
-which will bind most of the commands under the =C-c= prefix when vdiff-mode is
-active. Of course you can pick whatever prefix you prefer. With the =C-c=
prefix
-the commands would be
-
-*** Basics
-
-| Key | Command | Description |
-|---------+-------------------------+------------------------------------|
-| =C-c g= | =vdiff-switch-buffer= | Switch buffers at matching line |
-| =C-c n= | =vdiff-next-hunk= | Move to next hunk in buffer |
-| =C-c p= | =vdiff-previous-hunk= | Move to previous hunk in buffer |
-| =C-c h= | =vdiff-hydra/body= | Enter vdiff-hydra |
-
-*** Viewing and Transmitting Changes Between Buffers
-
-| Key | Command | Description
|
-|---------+------------------------------------+-------------------------------------|
-| =C-c r= | =vdiff-receive-changes= | Receive change from other
buffer |
-| =C-c R= | =vdiff-receive-changes-and-step= | Same as =C-c r= then =C-c n=
|
-| =C-c s= | =vdiff-send-changes= | Send this change(s) to other
buffer |
-| =C-c S= | =vdiff-send-changes-and-step= | Same as =C-c s= then =C-c n=
|
-| =C-c f= | =vdiff-refine-this-hunk= | Highlight changed words in
hunk |
-| =C-c x= | =vdiff-remove-refinements-in-hunk= | Remove refinement
highlighting |
-| (none) | =vdiff-refine-this-hunk-symbol= | Refine based on symbols
|
-| (none) | =vdiff-refine-this-hunk-word= | Refine based on words
|
-| =C-c F= | =vdiff-refine-all-hunks= | Highlight changed words
|
-| (none) | =vdiff-refine-all-hunks-symbol= | Refine all based on symbols
|
-| (none) | =vdiff-refine-all-hunks-word= | Refine all based on words
|
-
-*** Folds
-
-| Key | Command | Description
|
-|---------+------------------------------------+-------------------------------------|
-| =C-c N= | =vdiff-next-fold= | Move to next fold in buffer
|
-| =C-c P= | =vdiff-previous-fold= | Move to previous fold in
buffer |
-| =C-c c= | =vdiff-close-fold= | Close fold at point or in
region |
-| =C-c C= | =vdiff-close-all-folds= | Close all folds in buffer
|
-| =C-c t= | =vdiff-close-other-folds= | Close all other folds in
buffer |
-| =C-c o= | =vdiff-open-fold= | Open fold at point or in
region |
-| =C-c O= | =vdiff-open-all-folds= | Open all folds in buffer
|
-
-*** Ignoring case and whitespace
-
-| Key | Command | Description |
-|-----------+---------------------------+-------------------------|
-| =C-c i c= | =vdiff-toggle-case= | Toggle ignoring of case |
-| =C-c i w= | =vdiff-toggle-whitespace= | Toggle ignoring of case |
-
-*** Saving, Updating and Exiting
-
-| Key | Command | Description |
-|---------+-------------------------+------------------------------|
-| =C-c w= | =vdiff-save-buffers= | Save both buffers |
-| =C-c u= | =vdiff-refresh= | Force diff refresh |
-| (none) | =vdiff-restore-windows= | Restore window configuration |
-| =C-c q= | =vdiff-quit= | Quit vdiff |
-
-Evil-mode users might prefer something like the following to use a comma as a
-prefix in normal state.
-
-#+BEGIN_SRC emacs-lisp
-(require 'vdiff)
-(require 'evil)
-(evil-define-key 'normal vdiff-mode-map "," vdiff-mode-prefix-map)
-#+END_SRC
-
-vimdiff-like binding are provided by
[[https://github.com/emacs-evil/evil-collection][evil-collection]]'s
[[https://github.com/emacs-evil/evil-collection/blob/master/evil-collection-vdiff.el][evil-collection-vdiff.el]]
-
-** Hydra
-
-Using the [[https://github.com/abo-abo/hydra][hydra package]], =vdiff-hydra=
allows quick movement and changes to be
-made in the buffer. By default it lives on the =h= command in the prefix
-map. Bind =vdiff-hydra/body= directly to customize this key binding.
-
-[[file:img/hydra.png]]
-
-
-** Further customization
-
-The current customization options and their defaults are
-
-#+BEGIN_SRC emacs-lisp
- ;; Whether to lock scrolling by default when starting vdiff
- (setq vdiff-lock-scrolling t)
-
- ;; diff program/algorithm to use. Allows choice of diff or git diff along
with
- ;; the various algorithms provided by these commands. See
- ;; `vdiff-diff-algorithms' for the associated command line arguments.
- (setq vdiff-diff-algorithm 'diff)
-
- ;; diff3 command to use. Specify as a list where the car is the command to
use
- ;; and the remaining elements are the arguments to the command.
- (setq vdiff-diff3-command '("diff3"))
-
- ;; Don't use folding in vdiff buffers if non-nil.
- (setq vdiff-disable-folding nil)
-
- ;; Unchanged lines to leave unfolded around a fold
- (setq vdiff-fold-padding 6)
-
- ;; Minimum number of lines to fold
- (setq vdiff-min-fold-size 4)
-
- ;; If non-nil, allow closing new folds around point after updates.
- (setq vdiff-may-close-fold-on-point t)
-
- ;; Function that returns the string printed for a closed fold. The arguments
- ;; passed are the number of lines folded, the text on the first line, and the
- ;; width of the buffer.
- (setq vdiff-fold-string-function 'vdiff-fold-string-default)
-
- ;; Default syntax table class code to use for identifying "words" in
- ;; `vdiff-refine-this-change'. Some useful options are
- ;;
- ;; "w" (default) words
- ;; "w_" symbols (words plus symbol constituents)
- ;;
- ;; For more information see
- ;;
https://www.gnu.org/software/emacs/manual/html_node/elisp/Syntax-Class-Table.html
- (setq vdiff-default-refinement-syntax-code "w")
-
- ;; If non-nil, automatically refine all hunks.
- (setq vdiff-auto-refine nil)
-
- ;; How to represent subtractions (i.e., deleted lines). The
- ;; default is full which means add the same number of (fake) lines
- ;; as those that were removed. The choice single means add only one
- ;; fake line. The choice fringe means don't add lines but do
- ;; indicate the subtraction location in the fringe.
- (setq vdiff-subtraction-style 'full)
-
- ;; Character to use for filling subtraction lines. See also
- ;; `vdiff-subtraction-style'.
- (setq vdiff-subtraction-fill-char ?-)
-#+END_SRC
-
diff --git a/packages/vdiff/img/hydra.png b/packages/vdiff/img/hydra.png
deleted file mode 100644
index f826eb2..0000000
Binary files a/packages/vdiff/img/hydra.png and /dev/null differ
diff --git a/packages/vdiff/img/leuven.png b/packages/vdiff/img/leuven.png
deleted file mode 100644
index 1fc413e..0000000
Binary files a/packages/vdiff/img/leuven.png and /dev/null differ
diff --git a/packages/vdiff/img/leuven3.png b/packages/vdiff/img/leuven3.png
deleted file mode 100644
index fae54ec..0000000
Binary files a/packages/vdiff/img/leuven3.png and /dev/null differ
diff --git a/packages/vdiff/img/wide-screen.png
b/packages/vdiff/img/wide-screen.png
deleted file mode 100644
index 67e9125..0000000
Binary files a/packages/vdiff/img/wide-screen.png and /dev/null differ
diff --git a/packages/vdiff/vdiff-test.el b/packages/vdiff/vdiff-test.el
deleted file mode 100644
index c5ea48c..0000000
--- a/packages/vdiff/vdiff-test.el
+++ /dev/null
@@ -1,210 +0,0 @@
-;;; vdiff-test.el --- tests for vdiff.el -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2018 Free Software Foundation, Inc.
-
-;; Author: Justin Burkett <justin@burkett.cc>
-;; Maintainer: Justin Burkett <justin@burkett.cc>
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Code:
-
-(require 'ert)
-(require 'vdiff)
-
-(defmacro vdiff-test-with-buffers
- (a-string b-string operation final-a-string final-b-string &optional
after-quit)
- `(let ((buffer-a (get-buffer-create "vdiff-tests-buffer-a"))
- (buffer-b (get-buffer-create "vdiff-tests-buffer-b"))
- (vdiff--testing-mode t))
- (unwind-protect
- (progn
- (with-current-buffer buffer-a
- (erase-buffer)
- ;; this seems necessary for batch mode
- (transient-mark-mode 1)
- (insert ,(replace-regexp-in-string "|" "\n" a-string)))
- (with-current-buffer buffer-b
- (erase-buffer)
- ;; this seems necessary for batch mode
- (transient-mark-mode 1)
- (insert ,(replace-regexp-in-string "|" "\n" b-string)))
- (vdiff-buffers buffer-a buffer-b)
- ,operation
- (with-current-buffer buffer-a
- (should (string= (buffer-string)
- ,(replace-regexp-in-string "|" "\n"
final-a-string))))
- (with-current-buffer buffer-b
- (should (string= (buffer-string)
- ,(replace-regexp-in-string "|" "\n"
final-b-string)))))
- (with-current-buffer buffer-a
- (vdiff-quit))
- ,after-quit
- (kill-buffer buffer-a)
- (kill-buffer buffer-b))))
-
-(ert-deftest vdiff-test-parsing ()
- "Test parsing of unified diff format."
- (with-temp-buffer
- (insert "--- test1.txt 2018-04-13 11:11:41.000000000 -0400
-+++ test2.txt 2018-04-13 11:11:46.000000000 -0400
-@@ -1,3 +1,6 @@
-+
-+
-+
- 1
- 2
- 3
-@@ -9,6 +12,8 @@
- 9
- 10
- 11
-+11
-+11
- 12
- 13
- 14
-@@ -16,7 +21,8 @@
- 16
- 17
- 18
--19
--20
-+18
-+29
- 21
- 22
-+23
-")
- (should (equal (vdiff--parse-diff-u (current-buffer))
- '(((1) (1 . 3)) ((12) (15 . 16)) ((19 . 20) (24 . 25))
((23) (28 . 28)))))))
-
-(ert-deftest vdiff-test-setup ()
- "Test setting up `vdiff-mode'."
- ;; Setup does not change buffers
- (vdiff-test-with-buffers
- "1|2|3|4|5|6|7|8|9|10|"
- "1|2|4|4|5|6|8|8|9|10|"
- nil
- "1|2|3|4|5|6|7|8|9|10|"
- "1|2|4|4|5|6|8|8|9|10|"))
-
-(ert-deftest vdiff-test-movement ()
- "Test movement in buffers."
- (vdiff-test-with-buffers
- "1|2|3|4|5|6|7|8|9|10|"
- "1|2|4|4|5|6|8|8|9|10|"
- (with-current-buffer buffer-a
- (goto-char (point-min))
- (call-interactively 'vdiff-next-hunk)
- (call-interactively 'vdiff-next-hunk)
- (should (looking-at-p "7")))
- "1|2|3|4|5|6|7|8|9|10|"
- "1|2|4|4|5|6|8|8|9|10|"))
-
-(ert-deftest vdiff-test-transmiting ()
- "Test transmitting changes."
- ;; Test sending first change
- (vdiff-test-with-buffers
- "1|2|3|4|5|6|7|8|9|10|"
- "1|2|4|4|5|6|8|8|9|10|"
- (with-current-buffer buffer-a
- (goto-char (point-min))
- (call-interactively 'vdiff-next-hunk)
- (call-interactively 'vdiff-send-changes))
- "1|2|3|4|5|6|7|8|9|10|"
- "1|2|3|4|5|6|8|8|9|10|")
- ;; Test sending everything
- (vdiff-test-with-buffers
- "1|2|3|4|5|6|7|8|9|10|"
- "1|2|4|4|5|6|8|8|9|10|"
- (with-current-buffer buffer-a
- (vdiff-send-changes (point-min) (point-max)))
- "1|2|3|4|5|6|7|8|9|10|"
- "1|2|3|4|5|6|7|8|9|10|"))
-
-(ert-deftest vdiff-test-receiving ()
- "Test receiving changes."
- ;; Test receiving first change
- (vdiff-test-with-buffers
- "1|2|3|4|5|6|7|8|9|10|"
- "1|2|4|4|5|6|8|8|9|10|"
- (with-current-buffer buffer-b
- (goto-char (point-min))
- (call-interactively 'vdiff-next-hunk)
- (call-interactively 'vdiff-receive-changes))
- "1|2|3|4|5|6|7|8|9|10|"
- "1|2|3|4|5|6|8|8|9|10|")
- ;; Test receiving everything
- (vdiff-test-with-buffers
- "1|2|3|4|5|6|7|8|9|10|"
- "1|2|4|4|5|6|8|8|9|10|"
- (with-current-buffer buffer-b
- (vdiff-receive-changes (point-min) (point-max)))
- "1|2|3|4|5|6|7|8|9|10|"
- "1|2|3|4|5|6|7|8|9|10|"))
-
-
-(ert-deftest vdiff-test-selective-transmiting ()
- "Test transmitting changes when region is active."
- ;; Test sending first line of first change
- (vdiff-test-with-buffers
- "1|2|3|4|5|6|7|8|9|10|"
- "1|x|x|x|5|6|8|8|9|10|"
- (with-current-buffer buffer-a
- (goto-char (point-min))
- (forward-line)
- (set-mark (point))
- (forward-line)
- (call-interactively 'vdiff-send-changes))
- "1|2|3|4|5|6|7|8|9|10|"
- "1|2|x|x|5|6|8|8|9|10|")
- ;; Test sending second line of first change
- (vdiff-test-with-buffers
- "1|2|3|4|5|6|7|8|9|10|"
- "1|x|x|x|5|6|8|8|9|10|"
- (with-current-buffer buffer-a
- (goto-char (point-min))
- (forward-line 2)
- (set-mark (point))
- (forward-line)
- (call-interactively 'vdiff-send-changes))
- "1|2|3|4|5|6|7|8|9|10|"
- "1|x|3|x|5|6|8|8|9|10|")
- ;; Test sending first line of first change when region begins before
- (vdiff-test-with-buffers
- "1|2|3|4|5|6|7|8|9|10|"
- "1|x|x|x|5|6|8|8|9|10|"
- (with-current-buffer buffer-a
- (goto-char (point-min))
- (set-mark (point))
- (forward-line 2)
- (call-interactively 'vdiff-send-changes))
- "1|2|3|4|5|6|7|8|9|10|"
- "1|2|x|x|5|6|8|8|9|10|")
- ;; Test sending last two lines of first change when region ends after
- (vdiff-test-with-buffers
- "1|2|3|4|5|6|7|8|9|10|"
- "1|x|x|x|5|6|8|8|9|10|"
- (with-current-buffer buffer-a
- (goto-char (point-min))
- (forward-line 2)
- (set-mark (point))
- (forward-line 3)
- (call-interactively 'vdiff-send-changes))
- "1|2|3|4|5|6|7|8|9|10|"
- "1|x|3|4|5|6|8|8|9|10|"))
-
-(provide 'vdiff-test)
-;;; vdiff-test.el ends here
diff --git a/packages/vdiff/vdiff.el b/packages/vdiff/vdiff.el
deleted file mode 100644
index c90c1eb..0000000
--- a/packages/vdiff/vdiff.el
+++ /dev/null
@@ -1,2415 +0,0 @@
-;;; vdiff.el --- A diff tool similar to vimdiff -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2017-2018 Free Software Foundation, Inc.
-
-;; Author: Justin Burkett <justin@burkett.cc>
-;; Maintainer: Justin Burkett <justin@burkett.cc>
-;; URL: https://github.com/justbur/emacs-vdiff
-;; Version: 0.2.4
-;; Keywords: diff
-;; Package-Requires: ((emacs "24.4") (hydra "0.13.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
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; News:
-
-;; Version 0.2
-;; * First ELPA Release
-
-;;; Commentary:
-
-;; A tool like vimdiff for Emacs
-
-;; vdiff compares two or three buffers on the basis of the output from the diff
-;; tool. The buffers are kept synchronized so that as you move through one of
-;; the buffers the top of the active buffer aligns with the corresponding top
of
-;; the other buffer(s). This is similar to how ediff works, but in ediff you
use
-;; a third "control buffer" to move through the diffed buffers. The key
-;; difference is that in vdiff you are meant to actively edit one of the
buffers
-;; and the display will update automatically for the other buffer. Similar to
-;; ediff, vdiff provides commands to "send" and "receive" hunks from one buffer
-;; to the other as well as commands to traverse the diff hunks, which are
useful
-;; if you are trying to merge changes. In contrast to ediff, vdiff also
provides
-;; folding capabilities to fold sections of the buffers that don't contain
-;; changes. This folding occurs automatically. Finally, you are encouraged to
-;; bind a key to `vdiff-hydra/body', which will use hydra.el (in ELPA) to
create
-;; a convenient transient keymap containing most of the useful vdiff commands.
-
-;; This functionality is all inspired by (but not equivalent to) the vimdiff
-;; tool from vim.
-
-;; See https://github.com/justbur/emacs-vdiff for more information
-
-;;; Code:
-
-(require 'cl-lib)
-(eval-when-compile (require 'subr-x))
-(require 'diff-mode)
-(require 'hydra)
-(require 'smerge-mode)
-
-(defvar vdiff-mode)
-(defvar vdiff-3way-mode)
-(defvar vdiff-debug nil)
-
-(defgroup vdiff nil
- "Diff tool that is like vimdiff"
- :tag "Vdiff"
- :group 'tools)
-
-(defcustom vdiff-lock-scrolling t
- "Whether to lock scrolling by default when starting
-`vdiff-mode'."
- :type 'boolean)
-
-(defcustom vdiff-truncate-lines t
- "If non-nil, use `toggle-truncate-lines' in vdiff buffers."
- :type 'boolean)
-
-(defcustom vdiff-diff-algorithms
- '((diff . "diff -u")
- (diff-minimal . "diff -u --minimal")
- (git-diff . "git --no-pager diff --no-index --no-color")
- (git-diff-myers . "git --no-pager diff --myers --no-index --no-color")
- (git-diff-minimal . "git --no-pager diff --minimal --no-index --no-color")
- (git-diff-patience . "git --no-pager diff --patience --no-index
--no-color")
- (git-diff-histogram . "git --no-pager diff --histogram --no-index
--no-color")
- (custom . "diff -u"))
- "An alist containing choices of diff algorithms to be selected
-by setting `vdiff-diff-algorithm'. If you want to use a custom
-command, set `vidff-diff-algorithm' to `custom' and customize the
-`custom' key in this alist."
- :type '(alist :key-type symbol :value-type string))
-
-(defcustom vdiff-diff-algorithm 'diff
- "Choice of algorithm for generating diffs. The choices are
-`diff', `diff-minimal', `git-diff',`git-diff-myers',
-`git-diff-minimal', `git-diff-patience', `git-diff-histogram' and
-`custom'. See `vdiff-diff-algorithms' for the associated
-commands."
- :type '(choice (const :tag "diff -u" diff-u)
- (const :tag "git diff" git-diff)
- (const :tag "git diff --myers" git-diff-myers)
- (const :tag "git diff --minimal" git-diff-minimal)
- (const :tag "git diff --patience" git-diff-patience)
- (const :tag "git diff --histogram" git-diff-histogram)
- (const :tag "custom" custom)))
-
-(defcustom vdiff-diff3-command '("diff3")
- "diff3 command to use. Specify as a list where the car is the command to use
-and the remaining elements are the arguments to the command."
- :type '(repeat string))
-
-(make-obsolete-variable 'vdiff-diff-program 'vdiff-diff-algorithm "2018-04-17")
-(make-obsolete-variable 'vdiff-diff3-program 'vdiff-diff3-command "2018-04-17")
-(make-obsolete-variable 'vdiff-diff-extra-args "See `vdiff-diff-algorithms'."
"2018-04-17")
-(make-obsolete-variable 'vdiff-diff3-extra-args 'vdiff-diff3-command
"2018-04-17")
-
-(defcustom vdiff-disable-folding nil
- "If non-nil, disable folding in vdiff buffers."
- :type 'boolean)
-
-(defcustom vdiff-fold-padding 6
- "Unchanged lines to leave unfolded around a fold"
- :type 'integer)
-
-(defcustom vdiff-min-fold-size 4
- "Minimum number of lines to fold"
- :type 'integer)
-
-(defcustom vdiff-may-close-fold-on-point t
- "If non-nil, allow closing new folds around point after updates."
- :type 'boolean)
-
-(defcustom vdiff-fold-string-function #'vdiff-fold-string-default
- "Function that returns the string printed for a closed
-fold. The arguments passed are the number of lines folded, the
-text on the first line, and the width of the buffer."
- :type 'function)
-
-(defcustom vdiff-default-refinement-syntax-code "w"
- "Default syntax table class code to use for identifying
-\"words\" in \`vdiff-refine-this-hunk'. Some useful options are
-
-\"w\" (default) words
-\"w_\" symbols \(words plus symbol constituents\)
-
-For more information see
-https://www.gnu.org/software/emacs/manual/html_node/elisp/Syntax-Class-Table.html";
- :type 'string)
-
-(defcustom vdiff-auto-refine nil
- "If non-nil, automatically refine all hunks."
- :type 'boolean)
-
-(defcustom vdiff-only-highlight-refinements nil
- "If non-nil, apply faces to refined words but not hunks."
- :type 'boolean)
-
-(defcustom vdiff-subtraction-style 'full
- "How to represent subtractions (i.e., deleted lines). The
-default is full which means add the same number of (fake) lines
-as those that were removed. The choice single means add only one
-fake line. The choice fringe means don't add lines but do
-indicate the subtraction location in the fringe."
- :type '(radio (const :tag "Add same number of fake lines" full)
- (const :tag "Add single line" single)
- (const :tag "Add no lines but use fringe" fringe)))
-
-(defcustom vdiff-subtraction-fill-char ?-
- "Character to use for filling subtraction lines. See also
-`vdiff-subtraction-style'."
- :type 'integer)
-
-(defcustom vdiff-use-ancestor-as-merge-buffer nil
- "When in a merge conflict file and text from the ancestor file
-is included, `vdiff-merge-conflict' will use the ancestor file as
-the merge buffer (or target buffer) that will be saved when the
-merge is finished. The default is to show the original file with
-conflicts as the merge buffer."
- :type 'boolean)
-
-(defface vdiff-addition-face
- '((t :inherit diff-added))
- "Face for additions")
-
-(defface vdiff-change-face
- '((t :inherit diff-changed))
- "Face for changes")
-
-(defface vdiff-closed-fold-face
- '((t :inherit region))
- "Face for closed folds")
-
-(defface vdiff-open-fold-face
- '((t))
- "Face for open folds")
-
-(defface vdiff-subtraction-face
- '((t :inherit diff-removed))
- "Face for subtractions")
-
-(defface vdiff-subtraction-fringe-face
- '((t :inherit vdiff-subtraction-face))
- "Face for subtraction fringe indicators")
-
-(defface vdiff-refine-changed
- '((t :inherit diff-refine-changed))
- "Face for word changes within a change hunk")
-
-(defface vdiff-refine-added
- '((t :inherit diff-refine-added))
- "Face for word changes within an addition hunk")
-
-(defface vdiff-target-face
- '((t :inverse-video t :inherit warning))
- "Face for selecting hunk targets.")
-
-(defvar vdiff--force-sync-commands '(next-line
- previous-line
- beginning-of-buffer
- end-of-buffer)
- "Commands that trigger sync in other buffer. There should not
-be a need to include commands that scroll the buffer here,
-because those are handled differently.")
-
-(defvar vdiff--diff-code-regexp
- "^\\([0-9]+\\),?\\([0-9]+\\)?\\([adc]\\)\\([0-9]+\\),?\\([0-9]+\\)?")
-(defvar vdiff--diff3-code-regexp
- "^\\([1-3]\\):\\([0-9]+\\),?\\([0-9]+\\)?\\([adc]\\)")
-(defvar vdiff--inhibit-window-switch nil)
-(defvar vdiff--inhibit-diff-update nil)
-(defvar vdiff--in-scroll-hook nil)
-(defvar vdiff--cleanup-hook nil)
-;; (defvar vdiff--in-post-command-hook nil)
-(defvar vdiff--setting-vscroll nil)
-(defvar vdiff--after-change-timer nil)
-(defvar vdiff--after-change-refresh-delay 1)
-(defvar vdiff--new-command nil)
-(defvar vdiff--last-command nil)
-(defvar vdiff--case-options
- '(("Don't ignore case" . "")
- ("Ignore case (-i)" . "-i")))
-(defvar vdiff--whitespace-options
- '(("Don't ignore whitespace" . "")
- ("Ignore all whitespace (-w)" . "-w")
- ("Ignore space changes (-b)" . "-b")
- ("Ignore blank lines (-B)" . "-B")))
-(defvar vdiff--testing-mode nil
- "Configure for testing in batch mode.")
-
-;; Sessions
-(defvar vdiff--temp-session nil
- "Temporarily stores new vdiff session globally.")
-(defvar-local vdiff--session nil
- "Holds reference to local vdiff session in each vdiff buffer.")
-(cl-defstruct vdiff-session
- ;; buffers
- buffers
- process-buffer
- word-diff-output-buffer
- ;; data
- diff-data
- line-maps
- folds
- all-folds-open
- diff-stale
- ;; other
- window-config
- case-args
- whitespace-args
- ;; Quit hooks
- on-quit
- prior-window-config
- kill-buffers-on-quit)
-
-
-;; * Utilities
-
-(defsubst vdiff-diff-command ()
- (let ((cmd-cons (assoc vdiff-diff-algorithm vdiff-diff-algorithms)))
- (if (stringp (cdr-safe cmd-cons))
- (split-string (cdr cmd-cons) " ")
- '("diff" "-u"))))
-
-(defun vdiff--maybe-int (str)
- "Return an int>=0 from STR."
- (let ((num (or (and (numberp str) str)
- (and str (string-to-number str)))))
- (when (and (numberp num)
- (>= num 0))
- num)))
-
-(defun vdiff--non-nil-list (&rest args)
- "Make ARGS into list and remove nils."
- (delq nil (apply #'list args)))
-
-(defun vdiff--buffer-a-p ()
- (when (and
- vdiff--session
- (eq (current-buffer)
- (car (vdiff-session-buffers vdiff--session))))
- (current-buffer)))
-
-(defun vdiff--buffer-b-p ()
- (when (and
- vdiff--session
- (eq (current-buffer)
- (cadr (vdiff-session-buffers vdiff--session))))
- (current-buffer)))
-
-(defun vdiff--buffer-c-p ()
- (when (and
- vdiff--session
- (eq (current-buffer)
- (nth 2 (vdiff-session-buffers vdiff--session))))
- (current-buffer)))
-
-(defun vdiff--buffer-p ()
- "Non-nil if in any vdiff buffer"
- (cond ((vdiff--buffer-a-p) 'a)
- ((vdiff--buffer-b-p) 'b)
- ((vdiff--buffer-c-p) 'c)))
-
-(defun vdiff--unselected-buffers ()
- (cl-remove-if
- (lambda (buf) (or (eq buf (current-buffer))
- (not (buffer-live-p buf))))
- (vdiff-session-buffers vdiff--session)))
-
-(defun vdiff--unselected-windows ()
- (mapcar (lambda (buf) (get-buffer-window buf 0))
- (vdiff--unselected-buffers)))
-
-(defun vdiff--all-windows ()
- (remq nil
- (mapcar (lambda (buf) (get-buffer-window buf 0))
- (vdiff-session-buffers vdiff--session))))
-
-(defun vdiff--all-overlays (ovr)
- (overlay-get ovr 'vdiff-hunk-overlays))
-
-(defun vdiff--other-overlays (ovr)
- (remq ovr (vdiff--all-overlays ovr)))
-
-(defun vdiff--overlay-marker (ovr)
- (let ((current (eq (current-buffer) (overlay-buffer ovr))))
- (propertize
- (format "%s%s\n"
- (1+
- (cl-position
- (overlay-buffer ovr)
- (vdiff-session-buffers vdiff--session)))
- (if current " (to all) " ""))
- 'face 'vdiff-target-face)))
-
-(defun vdiff--add-overlay-marker (ovr)
- (overlay-put ovr 'before-string
- (concat (vdiff--overlay-marker ovr)
- (overlay-get ovr 'before-string))))
-
-(defun vdiff--remove-overlay-marker (ovr)
- (overlay-put ovr 'before-string
- (substring
- (overlay-get ovr 'before-string)
- (length (vdiff--overlay-marker ovr)))))
-
-(defun vdiff--read-3way-target (ovr &optional just-one)
- "Read a target overlay when sending or receiving a hunk from
-one buffer to another. Only applies in 3-way diffs."
- (when vdiff-3way-mode
- (let* ((all-ovrs (vdiff--all-overlays ovr))
- (other-ovrs (remq ovr all-ovrs))
- (this-idx (cl-position ovr all-ovrs))
- (marked-ovrs (if just-one other-ovrs all-ovrs))
- target)
- (unwind-protect
- (progn
- (mapc #'vdiff--add-overlay-marker marked-ovrs)
- (setq target (1- (string-to-number
- (char-to-string
- (read-char "Select target: ")))))
- (cond ((or (not (member target (list 0 1 2)))
- (and just-one (= target this-idx)))
- (user-error "Invalid target"))
- ((= target this-idx)
- (message "all others %s %s" target this-idx)
- other-ovrs)
- (t
- (message "just %s" (nth target all-ovrs))
- (list (nth target all-ovrs)))))
- (mapc #'vdiff--remove-overlay-marker marked-ovrs)))))
-
-(defun vdiff--target-overlays (this-ovr &optional just-one)
- (when (and (overlayp this-ovr)
- (overlay-get this-ovr 'vdiff))
- (let ((3way-target (vdiff--read-3way-target this-ovr just-one))
- (other-ovrs (vdiff--other-overlays this-ovr)))
- (cond ((and vdiff-3way-mode
- 3way-target)
- (cl-remove-if
- (lambda (ovr)
- (or (eq ovr this-ovr)
- (null (member ovr 3way-target))))
- other-ovrs))
- (vdiff-3way-mode
- (user-error "vdiff: No target overlay"))
- (t
- (remq this-ovr other-ovrs))))))
-
-(defun vdiff--move-to-line (n)
- (goto-char (point-min))
- (forward-line (1- n)))
-
-(defun vdiff--overlay-at-pos (&optional pos noerror)
- "Return first vdiff overlay found at POS which defaults to
-point.
-
-If NOERROR is non-nil, don't signal an error when no overlay is
-found."
- (let ((pos (or pos (point)))
- ovr)
- (setq ovr
- (catch 'yes
- (dolist (ovr (overlays-at pos))
- (when (overlay-get ovr 'vdiff-type)
- (throw 'yes ovr)))))
- (if (or ovr noerror)
- ovr
- (user-error "No vdiff overlay found here."))))
-
-(defun vdiff--hunk-at-point-p ()
- "Non-nil if point is in hunk overlay.
-
-Returns overlay."
- (let ((ovr (vdiff--overlay-at-pos nil t)))
- (and (overlayp ovr)
- (overlay-get ovr 'vdiff-type)
- (not (eq (overlay-get ovr 'vdiff-type) 'fold))
- ovr)))
-
-(defun vdiff--fold-at-point-p ()
- "Non-nil if point is in fold overlay.
-
-Returns overlay."
- (let ((ovr (vdiff--overlay-at-pos nil t)))
- (and (overlayp ovr)
- (overlay-get ovr 'vdiff-type)
- (eq (overlay-get ovr 'vdiff-type) 'fold)
- ovr)))
-
-(defun vdiff--overlays-in-region (beg end)
- "Return any vdiff overlays found within BEG and END."
- (let (ovrs)
- (dolist (ovr (overlays-in beg end))
- (when (overlay-get ovr 'vdiff-type)
- (push ovr ovrs)))
- (nreverse ovrs)))
-
-(defun vdiff--maybe-exit-overlay (&optional up no-fold)
- "Move point out of any vdiff overlays. Move down unless UP is
-non-nil. Ignore folds if NO-FOLD is non-nil."
- (let* ((ovr (vdiff--overlay-at-pos nil t))
- (type (when ovr (overlay-get ovr 'vdiff-type))))
- (when (and type
- (or (not no-fold)
- (not (eq type 'fold))))
- (goto-char
- (if up
- (1- (overlay-start ovr))
- (1+ (overlay-end ovr)))))))
-
-(defmacro vdiff--with-all-buffers (&rest body)
- "Execute BODY in all vdiff buffers."
- `(dolist (buf (vdiff-session-buffers vdiff--session))
- (when (buffer-live-p buf)
- (with-current-buffer buf
- ,@body))))
-
-;; * Toggles
-
-(defun vdiff-toggle-case (command-line-arg)
- "Toggle ignoring of case in diff command."
- (interactive
- (list (cdr-safe
- (assoc-string
- (completing-read "Case options: "
- vdiff--case-options)
- vdiff--case-options))))
- (setf (vdiff-session-case-args vdiff--session)
- command-line-arg)
- (when vdiff-mode
- (vdiff-refresh)))
-
-(defun vdiff-toggle-whitespace (command-line-arg)
- "Toggle ignoring of whitespace in diff command."
- (interactive
- (list (cdr-safe
- (assoc-string
- (completing-read "Whitespace options: "
- vdiff--whitespace-options)
- vdiff--whitespace-options))))
- (setf (vdiff-session-whitespace-args vdiff--session)
- command-line-arg)
- (when vdiff-mode
- (vdiff-refresh)))
-
-;; * Main overlay refresh routine
-
-(defun vdiff-refresh (&optional post-refresh-function)
- "Refresh diff information.
-
-POST-REFRESH-FUNCTION is called when the process finishes."
- (interactive)
- (when (vdiff--buffer-p)
- (let* ((tmp-a (make-temp-file "vdiff-a-"))
- (tmp-b (make-temp-file "vdiff-b-"))
- (tmp-c (when vdiff-3way-mode
- (make-temp-file "vdiff-c-")))
- (base-cmd (if vdiff-3way-mode
- vdiff-diff3-command
- (vdiff-diff-command)))
- (ses vdiff--session)
- (cmd (append
- base-cmd
- (vdiff-session-whitespace-args ses)
- (unless (string= (car base-cmd) "git")
- (vdiff-session-case-args ses))
- (list "--" tmp-a tmp-b)
- (when tmp-c
- (list tmp-c))))
- (buffers (vdiff-session-buffers ses))
- (proc-buf (vdiff-session-process-buffer ses))
- (proc (get-buffer-process proc-buf)))
- (setq vdiff--last-command cmd)
- (with-current-buffer (car buffers)
- (write-region nil nil tmp-a nil 'quietly)
- ;; ensure tmp file ends in newline
- (when (or (= (point-min) (point-max))
- (/= (char-before (point-max)) ?\n))
- (message "vdiff: Warning %s does not end in a newline."
- (if buffer-file-name buffer-file-name (buffer-name)))
- (write-region "\n" nil tmp-a t 'quietly)))
- (with-current-buffer (cadr buffers)
- (write-region nil nil tmp-b nil 'quietly)
- ;; ensure tmp file ends in newline
- (when (or (= (point-min) (point-max))
- (/= (char-before (point-max)) ?\n))
- (message "vdiff: Warning %s does not end in a newline."
- (if buffer-file-name buffer-file-name (buffer-name)))
- (write-region "\n" nil tmp-b t 'quietly)))
- (when vdiff-3way-mode
- (with-current-buffer (nth 2 buffers)
- (write-region nil nil tmp-c nil 'quietly)
- ;; ensure tmp file ends in newline
- (when (or (= (point-min) (point-max))
- (/= (char-before (point-max)) ?\n))
- (message "vdiff: Warning %s does not end in a newline."
- (if buffer-file-name buffer-file-name (buffer-name)))
- (write-region "\n" nil tmp-c t 'quietly))))
- (when proc
- (kill-process proc))
- (with-current-buffer (get-buffer-create proc-buf)
- (erase-buffer))
- (if vdiff--testing-mode
- (progn
- (apply #'call-process (car cmd) nil (list proc-buf) nil (cdr cmd))
- (vdiff--diff-refresh-sync-sentinel
- proc-buf ses vdiff-3way-mode tmp-a tmp-b
- tmp-c post-refresh-function))
- (setq proc
- (make-process
- :name "*vdiff*"
- :buffer proc-buf
- :command cmd))
- (when vdiff-3way-mode
- (process-put proc 'vdiff-3way t))
- (process-put proc 'vdiff-session ses)
- (process-put proc 'vdiff-tmp-a tmp-a)
- (process-put proc 'vdiff-tmp-b tmp-b)
- (process-put proc 'vdiff-post-refresh-function post-refresh-function)
- (when tmp-c
- (process-put proc 'vdiff-tmp-c tmp-c))
- (set-process-sentinel proc #'vdiff--diff-refresh-async-sentinel)))))
-
-(defun vdiff--encode-range (insert beg &optional end)
- "Normalize BEG and END of range. INSERT indicates that this is
-an addition when compared to other vdiff buffers."
- (let* ((beg (vdiff--maybe-int beg))
- (end (vdiff--maybe-int end)))
- (cond ((and end insert)
- (error "vdiff: multi-line range for a or d code"))
- (insert
- (cons (1+ beg) nil))
- (t
- (cons beg (or end beg))))))
-
-(defun vdiff--parse-diff (buf)
- "Parse diff output in BUF and return list of hunks."
- (let (res)
- (with-current-buffer buf
- (goto-char (point-min))
- (while (re-search-forward vdiff--diff-code-regexp nil t)
- (let* ((code (match-string 3)))
- (push
- (cl-case (string-to-char code)
- (?a (list (vdiff--encode-range
- t (match-string 1))
- (vdiff--encode-range
- nil (match-string 4) (match-string 5))))
- (?d (list (vdiff--encode-range
- nil (match-string 1) (match-string 2))
- (vdiff--encode-range
- t (match-string 4))))
- (?c (list (vdiff--encode-range
- nil (match-string 1) (match-string 2))
- (vdiff--encode-range
- nil (match-string 4) (match-string 5))))
- (t (error "vdiff: Unexpected code in parse-diff")))
- res))))
- (nreverse res)))
-
-(defsubst vdiff--inc-lines (lines)
- (forward-line)
- (let ((a (car lines))
- (b (cdr lines)))
- (cond ((or (looking-at-p " ") (eobp)) (cons (1+ a) (1+ b)))
- ((looking-at-p "+") (cons a (1+ b)))
- ((looking-at-p "-") (cons (1+ a) b)))))
-
-(defun vdiff--parse-diff-u (buf)
- "Parse diff -u output in BUF and return list of hunks."
- (let ((header-regexp "^@@ -\\([0-9]+\\),[0-9]+ \\+\\([0-9]+\\),[0-9]+ @@")
- res)
- (with-current-buffer buf
- (goto-char (point-min))
- (while (re-search-forward header-regexp nil t)
- (forward-line)
- (let* ((start-line-a (string-to-number (match-string 1)))
- (start-line-b (string-to-number (match-string 2)))
- (lines (cons start-line-a start-line-b)))
- ;; Adjust starting line in case it's not actually a line of one of
the
- ;; files
- (when (looking-at-p "+")
- (setcar lines (1- (car lines))))
- (when (looking-at-p "-")
- (setcdr lines (1- (cdr lines))))
- (while (and (not (looking-at-p "@"))
- (not (eobp)))
- (cond ((looking-at-p "+")
- ;; addition
- (let ((beg-b (cdr lines)))
- (while (looking-at-p "+")
- (setq lines (vdiff--inc-lines lines)))
- (when vdiff-debug
- (cl-assert (or (looking-at-p " ") (eobp))))
- (push
- (list (cons (car lines) nil)
- (cons beg-b (1- (cdr lines))))
- res)))
- ((looking-at-p "-")
- ;; subtraction or change
- (let ((beg-a (car lines)))
- (while (looking-at-p "-")
- (setq lines (vdiff--inc-lines lines)))
- (if (or (looking-at-p " ") (eobp))
- ;; subtraction
- (push
- (list (cons beg-a (1- (car lines)))
- (cons (cdr lines) nil))
- res)
- (when vdiff-debug
- (cl-assert (or (looking-at-p "+") (eobp))))
- (let ((beg-b (cdr lines)))
- (while (looking-at-p "+")
- (setq lines (vdiff--inc-lines lines)))
- (when vdiff-debug
- (cl-assert (or (looking-at-p " ") (eobp))))
- (push
- (list (cons beg-a (1- (car lines)))
- (cons beg-b (1- (cdr lines))))
- res)))))
- (t
- (setq lines (vdiff--inc-lines lines))))))))
- (nreverse res)))
-
-(defun vdiff--parse-diff3 (buf)
- "Parse diff3 output in BUF and return list of hunks."
- (catch 'final-res
- (let (res)
- (with-current-buffer buf
- (goto-char (point-min))
- (let (a-el b-el c-el)
- (while t
- (cond ((looking-at vdiff--diff3-code-regexp)
- (let* ((file (string-to-number
- (match-string-no-properties 1)))
- (code (match-string-no-properties 4))
- (range (vdiff--encode-range
- (string= code "a")
- (match-string-no-properties 2)
- (match-string-no-properties 3))))
- (cl-case file
- (1 (setq a-el range))
- (2 (setq b-el range))
- (3 (setq c-el range)))))
- ((and a-el
- (looking-at-p "^===="))
- (push (list a-el b-el c-el) res)
- (setq a-el nil)
- (setq b-el nil)
- (setq c-el nil))
- ((eobp)
- (when (or a-el b-el)
- (push (list a-el b-el c-el) res))
- (throw 'final-res (nreverse res))))
- (forward-line 1)))))))
-
-(defun vdiff--diff-refresh-finish
- (session tmp-a tmp-b &optional tmp-c post-function)
- "Final step in diff refresh."
- (vdiff--refresh-overlays session)
- (vdiff--refresh-line-maps session)
- (let ((vdiff--session session))
- (when vdiff-auto-refine
- (vdiff-refine-all-hunks))
- (when post-function
- (funcall post-function)))
- (delete-file tmp-a)
- (delete-file tmp-b)
- (when tmp-c
- (delete-file tmp-c))
- (setf (vdiff-session-diff-stale session) nil))
-
-(defun vdiff--diff-refresh-sync-sentinel
- (buffer session vdiff-3way tmp-a tmp-b &optional tmp-c post-function)
- "This is the sentinel for `vdiff-refresh' when
-`vdiff--testing-mode' is non-nil."
- (unless vdiff--inhibit-diff-update
- (setf (vdiff-session-diff-data session)
- (funcall (if vdiff-3way
- #'vdiff--parse-diff3
- #'vdiff--parse-diff-u) buffer))
- (vdiff--diff-refresh-finish
- session tmp-a tmp-b tmp-c post-function)))
-
-(defun vdiff--diff-refresh-async-sentinel (proc event)
- "This is the sentinel for `vdiff-refresh'. It does the job of
-parsing the diff output and triggering the overlay updates."
- (unless vdiff--inhibit-diff-update
- (let ((parse-func (if (process-get proc 'vdiff-3way)
- #'vdiff--parse-diff3
- #'vdiff--parse-diff-u))
- (session (process-get proc 'vdiff-session))
- finished)
- (cond
- ;; Was getting different exit code conventions depending on the
- ;; version of diff used
- ((or (string= "finished\n" event)
- (string= "exited abnormally with code 1\n" event))
- (setf (vdiff-session-diff-data session)
- (funcall parse-func (process-buffer proc)))
- (setq finished t))
- ((string-match-p "exited abnormally with code" event)
- (setf (vdiff-session-diff-data session) nil)
- (setq finished t)
- (message "vdiff process error: %s" event)))
- (when finished
- (vdiff--diff-refresh-finish
- session
- (process-get proc 'vdiff-tmp-a)
- (process-get proc 'vdiff-tmp-b)
- (process-get proc 'vdiff-tmp-c)
- (process-get proc 'vdiff-post-refresh-function))))))
-
-(defun vdiff--remove-all-overlays ()
- "Remove all vdiff overlays in both vdiff buffers."
- (when (vdiff--buffer-p)
- (vdiff--with-all-buffers
- (remove-overlays (point-min) (point-max) 'vdiff t))))
-
-(defun vdiff-save-buffers ()
- "Save all vdiff buffers."
- (interactive)
- (vdiff--with-all-buffers (save-buffer)))
-
-;; * Word diffs
-
-(defun vdiff--overlay-to-words (&optional ovr syntax-code)
- "Convert OVR to string of \"words\", one per line."
- (let* ((ovr (or ovr (vdiff--overlay-at-pos)))
- (word-syn (or syntax-code
- vdiff-default-refinement-syntax-code))
- (not-word-syn (concat "^" word-syn))
- last-word-end buf-syntax ovr-text)
- (with-current-buffer (overlay-buffer ovr)
- (setq buf-syntax (syntax-table))
- (setq ovr-text (buffer-substring-no-properties
- (overlay-start ovr)
- (overlay-end ovr))))
- (with-temp-buffer
- (set-syntax-table buf-syntax)
- (insert ovr-text)
- (goto-char (point-min))
- (skip-syntax-forward not-word-syn)
- (delete-region (point-min) (point))
- (while (not (eobp))
- (skip-syntax-forward word-syn)
- (insert "\n")
- (setq last-word-end (point))
- (skip-syntax-forward not-word-syn)
- (delete-region last-word-end (point)))
- (buffer-string))))
-
-(defun vdiff--diff-words (this-ovr other-ovr &optional syntax-code)
- "Diff \"words\" between THIS-OVR and OTHER-OVR"
- (when (and (eq (overlay-get this-ovr 'vdiff-type) 'change)
- (overlayp other-ovr))
- (let* ((a-words (vdiff--overlay-to-words this-ovr syntax-code))
- (b-words (vdiff--overlay-to-words other-ovr syntax-code))
- (tmp-file-a (make-temp-file "vdiff-word-a-"))
- (tmp-file-b (make-temp-file "vdiff-word-b-"))
- (out-buffer (get-buffer-create
- (vdiff-session-word-diff-output-buffer
- vdiff--session)))
- (a-result '())
- (b-result '()))
- (write-region a-words nil tmp-file-a nil 'quietly)
- (write-region b-words nil tmp-file-b nil 'quietly)
- (with-current-buffer out-buffer (erase-buffer))
- (let ((exit-code (apply #'call-process
- (car (vdiff-diff-command))
- nil out-buffer nil tmp-file-a tmp-file-b
- (cdr (vdiff-diff-command)))))
- (delete-file tmp-file-a)
- (delete-file tmp-file-b)
- (when (= exit-code 1)
- (with-current-buffer out-buffer
- (goto-char (point-min))
- (while (re-search-forward vdiff--diff-code-regexp nil t)
- (let ((a-change (list (string-to-number (match-string 1))))
- (b-change (list (string-to-number (match-string 4)))))
- (forward-line 1)
- (while (and (not (eobp))
- (not (looking-at-p vdiff--diff-code-regexp)))
- (cond ((looking-at-p "^<")
- (push (buffer-substring-no-properties
- (+ 2 (point)) (line-end-position))
- a-change))
- ((looking-at-p "^>")
- (push (buffer-substring-no-properties
- (+ 2 (point)) (line-end-position))
- b-change)))
- (forward-line 1))
- (when (cdr a-change)
- (push (nreverse a-change) a-result))
- (when (cdr b-change)
- (push (nreverse b-change) b-result))))
- (cons (nreverse a-result) (nreverse b-result))))))))
-
-(defun vdiff-refine-this-hunk (&optional syntax-code ovr)
- "Highlight word differences in current hunk.
-
-This uses `vdiff-default-refinement-syntax-code' for the
-definition of a \"word\", unless one is provided using
-SYNTAX-CODE."
- (interactive (list vdiff-default-refinement-syntax-code
- (vdiff--overlay-at-pos)))
- (let* ((ovr (or ovr (vdiff--overlay-at-pos)))
- (target-ovr (car (vdiff--target-overlays ovr)))
- (word-syn (or syntax-code
- vdiff-default-refinement-syntax-code))
- (not-word-syn (concat "^" word-syn))
- (type (overlay-get ovr 'vdiff-type))
- (face (if (eq type 'addition)
- 'vdiff-refine-added
- 'vdiff-refine-changed))
- instructions ovr-ins)
- (if (fboundp 'smerge-refine-regions)
- (when (and ovr target-ovr)
- (smerge-refine-regions
- (with-current-buffer (overlay-buffer ovr)
- (copy-marker (overlay-start ovr)))
- (overlay-end ovr)
- (with-current-buffer (overlay-buffer target-ovr)
- (copy-marker (overlay-start target-ovr)))
- (overlay-end target-ovr)
- `((face . ,face)
- (vdiff . t)
- (vdiff-refinement . t))))
- (when (and ovr
- target-ovr
- (consp (setq instructions
- (vdiff--diff-words ovr target-ovr))))
- (dolist (curr-ovr (vdiff--all-overlays ovr))
- (setq ovr-ins (if (eq curr-ovr ovr)
- (car instructions)
- (cdr instructions)))
- (with-current-buffer (overlay-buffer curr-ovr)
- (save-excursion
- (let ((current-word-n 1))
- (goto-char (overlay-start curr-ovr))
- (skip-syntax-forward not-word-syn)
- (dolist (ins ovr-ins)
- (dotimes (_ (- (car ins) current-word-n))
- (skip-syntax-forward word-syn)
- (skip-syntax-forward not-word-syn))
- (setq current-word-n (car ins))
- (let* ((words (cdr ins))
- (word-ovr
- (make-overlay
- (point)
- (progn
- (dotimes (_ (length words))
- (skip-syntax-forward not-word-syn)
- (skip-syntax-forward word-syn))
- (point)))))
- (cl-incf current-word-n (length words))
- (overlay-put word-ovr 'vdiff t)
- (overlay-put word-ovr 'face face)
- (overlay-put word-ovr 'vdiff-refinement t)
- (skip-syntax-forward not-word-syn)))))))))
- (when vdiff-only-highlight-refinements
- (when ovr
- (overlay-put ovr 'face nil))
- (when target-ovr
- (overlay-put target-ovr 'face nil)))))
-
-;; Not working yet
-;; (defun vdiff-refine-this-hunk-whitespace (ovr)
-;; "Highlight whitespace differences in current hunk."
-;; (interactive (list (vdiff--overlay-at-pos)))
-;; (vdiff-refine-this-hunk "-" ovr))
-
-(defun vdiff-refine-this-hunk-symbol (ovr)
- "Highlight symbol differences in current hunk."
- (interactive (list (vdiff--overlay-at-pos)))
- (vdiff-refine-this-hunk "w_" ovr))
-
-(defun vdiff-refine-this-hunk-word (ovr)
- "Highlight word differences in current hunk."
- (interactive (list (vdiff--overlay-at-pos)))
- (vdiff-refine-this-hunk "w" ovr))
-
-(defun vdiff-remove-refinements-in-hunk (ovr)
- "Remove any refinement overlays in the hunk overlay OVR."
- (interactive (list (vdiff--overlay-at-pos)))
- (dolist (chg-ovr (vdiff--all-overlays ovr))
- (with-current-buffer (overlay-buffer chg-ovr)
- (dolist (sub-ovr (overlays-in
- (overlay-start chg-ovr)
- (overlay-end chg-ovr)))
- (when (overlay-get sub-ovr 'vdiff-refinement)
- (delete-overlay sub-ovr))))
- (when vdiff-only-highlight-refinements
- (cl-case (overlay-get chg-ovr 'vdiff-type)
- (addition (overlay-put chg-ovr 'face 'vdiff-addition-face))
- (change (overlay-put chg-ovr 'face 'vdiff-change-face))))))
-
-(defun vdiff-refine-all-hunks (&optional syntax-code)
- "Highlight word differences in all hunks.
-
-This uses `vdiff-default-refinement-syntax-code' for the
-definition of a \"word\", unless one is provided using
-SYNTAX-CODE.
-See `vdiff-default-refinement-syntax-code' to change the definition
-of a \"word\"."
- (interactive)
- ;; Doesn't work for diff3 yet
- (when (vdiff--buffer-p)
- (dolist (ovr (overlays-in (point-min) (point-max)))
- (vdiff-refine-this-hunk syntax-code ovr))))
-
-;; Not working yet
-;; (defun vdiff-refine-all-hunks-whitespace ()
-;; "Highlight whitespace differences in all hunks."
-;; (interactive)
-;; (vdiff-refine-all-hunks "-"))
-
-(defun vdiff-refine-all-hunks-symbol ()
- "Highlight symbol differences in all hunks."
- (interactive)
- (vdiff-refine-all-hunks "w_"))
-
-(defun vdiff-refine-all-hunks-word ()
- "Highlight word differences in all hunks."
- (interactive)
- (vdiff-refine-all-hunks "w"))
-
-;; * Bitmaps
-
-;; emacs-nox users don't have this function. There's probably a better solution
-;; here, but this seems to work.
-(unless (fboundp 'define-fringe-bitmap)
- (defun define-fringe-bitmap (&rest _)
- nil))
-
-(define-fringe-bitmap
- 'vdiff--vertical-bar
- (make-vector (frame-char-height) #b00100000)
- nil 8 'center)
-
-(define-fringe-bitmap
- 'vdiff--top-left-angle
- (vconcat
- [#b00111111]
- (make-vector (1- (frame-char-height))
- #b00100000))
- nil 8 'bottom)
-
-(define-fringe-bitmap
- 'vdiff--bottom-left-angle
- (vconcat
- (make-vector (1- (frame-char-height))
- #b00100000)
- [#b00111111])
- nil 8 'top)
-
-(define-fringe-bitmap
- 'vdiff--insertion-arrow
- [#b00111111
- #b00011111
- #b00001111
- #b00011111
- #b00111011
- #b01110001
- #b11100000
- #b11000000
- #b10001111]
- nil 8 'top)
-
-;; * Add overlays
-
-(defun vdiff--make-subtraction-string (n-lines)
- "Make string to fill in space for lines missing in a buffer."
- (let* ((width (- (window-text-width
- (get-buffer-window (current-buffer) 0)) 2))
- (win-height (window-height
- (get-buffer-window (current-buffer) 0)))
- (max-lines (floor (* 0.7 win-height)))
- (truncate (> n-lines max-lines))
- (trunc-n-lines
- (cond ((eq 'single vdiff-subtraction-style) 1)
- (truncate max-lines)
- (t n-lines)))
- (truncate-prefix-len 2)
- string truncate-message)
- (dotimes (_ trunc-n-lines)
- (push (make-string width vdiff-subtraction-fill-char) string))
- (when truncate
- (setq truncate-message (format " +%d lines " (- n-lines trunc-n-lines)))
- (push (concat (make-string truncate-prefix-len
vdiff-subtraction-fill-char)
- truncate-message
- (make-string (- width truncate-prefix-len
- (length truncate-message))
- vdiff-subtraction-fill-char))
- string)
- (setq string (nreverse string)))
- (if (eq vdiff-subtraction-style 'fringe)
- (propertize
- " "
- 'display '(left-fringe vdiff--insertion-arrow
- vdiff-subtraction-fringe-face))
- (propertize
- (concat (mapconcat #'identity string "\n") "\n")
- 'face 'vdiff-subtraction-face))))
-
-(defun vdiff--add-subtraction-overlay (n-lines)
- (let* ((ovr (make-overlay (point) (1+ (point)))))
- (overlay-put ovr 'before-string (vdiff--make-subtraction-string n-lines))
- (overlay-put ovr 'vdiff-type 'subtraction)
- (overlay-put ovr 'vdiff t)
- ovr))
-
-(defun vdiff--add-hunk-overlay
- (n-lines &optional addition n-subtraction-lines)
- (let ((beg (point))
- (end (save-excursion
- (forward-line n-lines)
- (point))))
- (let ((ovr (make-overlay beg end))
- (type (if addition 'addition 'change))
- (face (if addition 'vdiff-addition-face 'vdiff-change-face)))
- (overlay-put ovr 'vdiff-type type)
- (overlay-put ovr 'face face)
- (overlay-put ovr 'vdiff t)
- (when (and n-subtraction-lines
- (> n-subtraction-lines 0))
- (overlay-put ovr 'after-string
- (vdiff--make-subtraction-string n-subtraction-lines)))
- ovr)))
-
-(defun vdiff-fold-string-default (n-lines first-line-text width)
- "Produces default format line for closed folds. See
-`vdiff-fold-string-function'."
- (let ((first-line-text (string-trim-left first-line-text))
- (start (format "+--%d lines: " n-lines))
- (width (1- width)))
- (if (> (+ 1 (length first-line-text) (length start)) width)
- (concat start
- (substring-no-properties
- first-line-text 0 (- width (length start)))
- "\n")
- (concat start
- first-line-text
- (make-string
- (- width (length start) (length first-line-text))
- ?-)
- "\n"))))
-
-(defun vdiff--make-fold (buffer range)
- (with-current-buffer buffer
- (let* ((beg-line (car range))
- (end-line (cdr range))
- (fold-start (vdiff--pos-at-line-beginning beg-line))
- (first-line-text
- (buffer-substring-no-properties
- fold-start (save-excursion
- (goto-char fold-start)
- (line-end-position))))
- (fold-end
- (vdiff--pos-at-line-beginning end-line))
- (ovr (make-overlay fold-start fold-end))
- (text
- (propertize (funcall vdiff-fold-string-function
- (- end-line beg-line)
- first-line-text
- (window-width
- (get-buffer-window buffer 0)))
- 'face 'vdiff-closed-fold-face)))
- (overlay-put ovr 'face 'vdiff-open-fold-face)
- (overlay-put ovr 'vdiff-fold-text text)
- (overlay-put ovr 'vdiff-type 'fold)
- (overlay-put ovr 'vdiff t)
- ovr)))
-
-(defun vdiff--narrow-fold-range (range)
- (cons (+ vdiff-fold-padding (car range))
- (1+ (- (cdr range) vdiff-fold-padding))))
-
-(defun vdiff--point-in-fold-p (fold)
- (and (eq (current-buffer) (overlay-buffer fold))
- (>= (point) (overlay-start fold))
- (<= (point) (overlay-end fold))))
-
-(defun vdiff--add-folds (a-buffer b-buffer c-buffer folds)
- (let ((ses vdiff--session))
- (dolist (fold folds)
- (let* ((a-range (vdiff--narrow-fold-range (nth 0 fold)))
- (b-range (vdiff--narrow-fold-range (nth 1 fold)))
- (c-range (when c-buffer
- (vdiff--narrow-fold-range (nth 2 fold))))
- (fold-sig (list a-range b-range c-range)))
- (cond
- ;; ((gethash fold-sig (vdiff-session-folds ses) nil)
- ;; ;; Restore any overlays on same ranges
- ;; (let* ((old-folds (gethash fold-sig
- ;; (vdiff-session-folds ses)))
- ;; (a-fold (car old-folds))
- ;; (b-fold (cadr old-folds))
- ;; (c-fold (nth 2 old-folds))
- ;; (a-beg (vdiff--pos-at-line-beginning
- ;; (car a-range) a-buffer))
- ;; (a-end (vdiff--pos-at-line-beginning
- ;; (cdr a-range) a-buffer))
- ;; (b-beg (vdiff--pos-at-line-beginning
- ;; (car b-range) b-buffer))
- ;; (b-end (vdiff--pos-at-line-beginning
- ;; (cdr b-range) b-buffer))
- ;; c-beg c-end)
- ;; (move-overlay a-fold a-beg a-end a-buffer)
- ;; (move-overlay b-fold b-beg b-end b-buffer)
- ;; (when c-fold
- ;; (setq c-beg (vdiff--pos-at-line-beginning
- ;; (car c-range) c-buffer))
- ;; (setq c-end (vdiff--pos-at-line-beginning
- ;; (cdr c-range) c-buffer))
- ;; (move-overlay c-fold c-beg c-end c-buffer))
- ;; (puthash fold-sig
- ;; (vdiff--non-nil-list a-fold b-fold c-fold)
- ;; (vdiff-session-folds ses))))
- ((> (1+ (- (cdr a-range) (car a-range))) vdiff-min-fold-size)
- ;; Ranges include padding
- (let ((a-fold (vdiff--make-fold a-buffer a-range))
- (b-fold (vdiff--make-fold b-buffer b-range))
- (c-fold (when c-buffer
- (vdiff--make-fold c-buffer c-range))))
- (dolist (fold (list a-fold b-fold c-fold))
- (when fold
- (cond ((or (vdiff-session-all-folds-open vdiff--session)
- (and (not vdiff-may-close-fold-on-point)
- (or (vdiff--point-in-fold-p a-fold)
- (vdiff--point-in-fold-p b-fold)
- (and c-fold
- (vdiff--point-in-fold-p c-fold)))))
- (vdiff--set-open-fold-props fold))
- (t
- (vdiff--set-closed-fold-props fold)))))
- (overlay-put a-fold 'vdiff-other-folds
- (vdiff--non-nil-list b-fold c-fold))
- (overlay-put b-fold 'vdiff-other-folds
- (vdiff--non-nil-list a-fold c-fold))
- (when c-fold
- (overlay-put c-fold 'vdiff-other-folds (list a-fold b-fold)))
- (puthash fold-sig (vdiff--non-nil-list a-fold b-fold c-fold)
- (vdiff-session-folds ses)))))))))
-
-(defun vdiff--remove-fold-overlays (_)
- (clrhash (vdiff-session-folds vdiff--session)))
-
-(defun vdiff--add-diff-overlay (this-len other-len-1 other-len-2)
- (let ((max-other-len (max (if other-len-1 other-len-1 0)
- (if other-len-2 other-len-2 0))))
- (cond ((and (null other-len-1) (null other-len-2))
- (vdiff--add-hunk-overlay this-len t))
- ((null this-len)
- (vdiff--add-subtraction-overlay max-other-len))
- (t
- (vdiff--add-hunk-overlay this-len nil
- (- max-other-len this-len))))))
-
-(defun vdiff--refresh-overlays (session)
- "Delete and recreate overlays in both buffers."
- (when (vdiff--buffer-p)
- (vdiff--remove-all-overlays)
- (let ((a-buffer (car (vdiff-session-buffers session)))
- (b-buffer (cadr (vdiff-session-buffers session)))
- (c-buffer (nth 2 (vdiff-session-buffers session)))
- (a-line 1)
- (b-line 1)
- (c-line 1)
- (a-last-post 1)
- (b-last-post 1)
- (c-last-post 1)
- (vdiff--inhibit-diff-update t)
- folds)
- (save-excursion
- (with-current-buffer a-buffer
- (widen)
- (goto-char (point-min)))
- (with-current-buffer b-buffer
- (widen)
- (goto-char (point-min)))
- (when c-buffer
- (with-current-buffer c-buffer
- (widen)
- (goto-char (point-min))))
- (dolist (hunk (vdiff-session-diff-data session))
- (let* ((a-range (nth 0 hunk))
- (b-range (nth 1 hunk))
- (c-range (nth 2 hunk))
- (a-beg (car a-range))
- (a-end (cdr a-range))
- (a-post (if a-end (1+ a-end) a-beg))
- (a-len (when a-end (1+ (- a-end a-beg))))
- (b-beg (car b-range))
- (b-end (cdr b-range))
- (b-post (if b-end (1+ b-end) b-beg))
- (b-len (when b-end (1+ (- b-end b-beg))))
- c-beg c-end c-post c-len)
- (when c-buffer
- (setq c-beg (car c-range))
- (setq c-end (cdr c-range))
- (setq c-post (if c-end (1+ c-end) c-beg))
- (setq c-len (when c-end (1+ (- c-end c-beg)))))
-
- (push (list (cons a-last-post (1- a-beg))
- (cons b-last-post (1- b-beg))
- (when c-beg
- (cons c-last-post (1- c-beg))))
- folds)
- (setq a-last-post a-post)
- (setq b-last-post b-post)
- (when c-buffer
- (setq c-last-post c-post))
-
- (let (ovr-a ovr-b ovr-c)
- (with-current-buffer a-buffer
- (forward-line (- a-beg a-line))
- (setq a-line a-beg)
- (setq ovr-a (vdiff--add-diff-overlay a-len b-len c-len)))
- (with-current-buffer b-buffer
- (forward-line (- b-beg b-line))
- (setq b-line b-beg)
- (setq ovr-b (vdiff--add-diff-overlay b-len a-len c-len)))
- (when c-buffer
- (with-current-buffer c-buffer
- (forward-line (- c-beg c-line))
- (setq c-line c-beg)
- (setq ovr-c (vdiff--add-diff-overlay c-len a-len b-len))))
- (let ((ovr-group (vdiff--non-nil-list ovr-a ovr-b ovr-c)))
- (overlay-put ovr-a 'vdiff-a t)
- (overlay-put ovr-a 'vdiff-hunk-overlays ovr-group)
- (overlay-put ovr-b 'vdiff-b t)
- (overlay-put ovr-b 'vdiff-hunk-overlays ovr-group)
- (when c-buffer
- (overlay-put ovr-c 'vdiff-c t)
- (overlay-put ovr-c 'vdiff-hunk-overlays ovr-group))))))
- (push (list (cons a-last-post
- (with-current-buffer a-buffer
- (line-number-at-pos (point-max))))
- (cons b-last-post
- (with-current-buffer b-buffer
- (line-number-at-pos (point-max))))
- (when c-buffer
- (cons c-last-post
- (with-current-buffer c-buffer
- (line-number-at-pos (point-max))))))
- folds))
- (unless vdiff-disable-folding
- (vdiff--add-folds a-buffer b-buffer c-buffer folds)))))
-
-;; * Send/Receive changes
-
-(defun vdiff--region-or-close-overlay ()
- "Return region bounds if active. Otherwise check if there is an
-overlay at point and return it if there is. If this fails check a
-line above. Always search to the end of the current line as
-well. This only returns bounds for `interactive'."
- (if (use-region-p)
- (prog1
- (list (region-beginning) (region-end) t)
- (deactivate-mark))
- (list (if (or (= (line-number-at-pos) 1)
- (vdiff--overlay-at-pos
- (line-beginning-position) t))
- (line-beginning-position)
- (save-excursion
- (forward-line -1)
- (line-beginning-position)))
- (save-excursion
- (forward-line 1)
- (point))
- nil)))
-
-(defun vdiff-send-changes
- (beg end &optional region receive targets dont-refresh)
- "Send changes in this hunk to another vdiff buffer. If the
-region is active, send all changes found in the region. Otherwise
-use the hunk under point or on the immediately preceding line."
- (interactive (vdiff--region-or-close-overlay))
- (let* ((vdiff--inhibit-diff-update t)
- target-ovrs)
- (dolist (ovr (overlays-in beg end))
- (cond ((and receive
- (setq target-ovrs
- (or targets (vdiff--target-overlays ovr t))))
- (let ((pos (overlay-start (car target-ovrs))))
- (with-current-buffer (overlay-buffer (car target-ovrs))
- (vdiff-send-changes pos (1+ pos) nil nil nil t))))
- ((eq (overlay-get ovr 'vdiff-type) 'addition)
- (vdiff--transmit-addition
- ovr targets (when region beg) (when region end)))
- ((eq (overlay-get ovr 'vdiff-type) 'change)
- (vdiff--transmit-change
- ovr targets (when region beg) (when region end)))
- ((eq (overlay-get ovr 'vdiff-type) 'subtraction)
- (vdiff--transmit-subtraction ovr targets))))
- (unless dont-refresh
- (vdiff-refresh #'vdiff--scroll-function))))
-
-(defun vdiff-send-changes-and-step ()
- "Use `vdiff-send-changes' then `vdiff-next-hunk'."
- (interactive)
- (call-interactively 'vdiff-send-changes)
- (call-interactively 'vdiff-next-hunk))
-
-(defun vdiff-receive-changes (beg end &optional _)
- "Receive the changes corresponding to this position from
-another vdiff buffer. This is equivalent to jumping to the
-corresponding buffer and sending from there. If the region is
-active, receive all corresponding changes found in the
-region. Otherwise use the changes under point or on the
-immediately preceding line."
- (interactive (vdiff--region-or-close-overlay))
- (vdiff-send-changes beg end nil t nil t)
- (vdiff-refresh #'vdiff--scroll-function))
-
-(defun vdiff-receive-changes-and-step ()
- "Use `vdiff-receive-changes' then `vdiff-next-hunk'."
- (interactive)
- (call-interactively 'vdiff-receive-changes)
- (call-interactively 'vdiff-next-hunk))
-
-(defun vdiff--maybe-beginning-of-line (beg min)
- (let ((beg (when (number-or-marker-p beg)
- (save-excursion
- (goto-char beg)
- (line-beginning-position)))))
- (if (and beg (> beg min)) beg min)))
-
-(defun vdiff--maybe-end-of-line (end max)
- (let ((end (when (number-or-marker-p end)
- (save-excursion
- (goto-char end)
- (when (and (char-before)
- (/= (char-before) ?\n))
- (forward-line))
- (point)))))
- (if (and end (< end max)) end max)))
-
-(defun vdiff--transmit-addition (ovr &optional targets beg end)
- "Send text in OVR to corresponding overlay in other buffer."
- (if (not (overlayp ovr))
- (message "No change found")
- (let* ((target-ovrs (or targets (vdiff--target-overlays ovr)))
- (beg (vdiff--maybe-beginning-of-line beg (overlay-start ovr)))
- (end (vdiff--maybe-end-of-line end (overlay-end ovr)))
- (text (buffer-substring-no-properties beg end)))
- (dolist (target target-ovrs)
- (with-current-buffer (overlay-buffer target)
- (save-excursion
- (goto-char (overlay-start target))
- (insert text))
- (delete-overlay target)))
- (delete-overlay ovr))))
-
-(defun vdiff--transmit-change (ovr &optional targets beg end)
- "Send text in OVR to corresponding overlay in other buffer."
- (if (not (overlayp ovr))
- (message "No change found")
- (let* ((target-ovrs (or targets (vdiff--target-overlays ovr)))
- (region (not (null beg)))
- (beg (vdiff--maybe-beginning-of-line beg (overlay-start ovr)))
- (beg-line (when region (line-number-at-pos beg)))
- (end (vdiff--maybe-end-of-line end (overlay-end ovr)))
- (end-line (when region (line-number-at-pos end)))
- (from-buffer (vdiff--buffer-p))
- (text (buffer-substring-no-properties beg end)))
- (dolist (target target-ovrs)
- (with-current-buffer (overlay-buffer target)
- (let* ((target-buffer (vdiff--buffer-p))
- (min-line (line-number-at-pos (overlay-start ovr)))
- (target-beg-line
- (when beg-line
- (max min-line
- (car (vdiff--translate-line
- beg-line from-buffer target-buffer)))))
- (max-line (line-number-at-pos (overlay-end ovr)))
- (target-end-line
- (when end-line
- (min max-line
- (car (vdiff--translate-line
- end-line from-buffer target-buffer))))))
- (save-excursion
- (if target-beg-line
- (vdiff--move-to-line target-beg-line)
- (goto-char (overlay-start target)))
- (delete-region (point)
- (save-excursion
- (if target-end-line
- (vdiff--move-to-line target-end-line)
- (goto-char (overlay-end target)))
- (point)))
- (insert text)))
- (delete-overlay target)))
- (delete-overlay ovr))))
-
-(defun vdiff--transmit-subtraction (ovr &optional targets)
- "Same idea as `vdiff--transmit-change' except we are
-just deleting text in another buffer."
- (if (not (overlayp ovr))
- (message "No change found")
- (let* ((target-ovrs (or targets
- (vdiff--target-overlays ovr))))
- (dolist (target target-ovrs)
- (with-current-buffer (overlay-buffer target)
- (delete-region (overlay-start target)
- (overlay-end target))
- (delete-overlay target))))))
-
-;; * Scrolling and line syncing
-
-(defun vdiff--2way-entries (a-prior a-end a-post b-prior b-end b-post)
- ;; a-prior 0 0 b-prior
- ;; l-beg 1 + 1 b-beg
- ;; l-beg 2 + 2 b-end
- ;; 3 + -
- ;; 4 + -
- ;; l-end 5 + -
- ;; a-post 6 3 b-post
- (let* (a-entries b-entries)
- (dotimes (offset (1+ (max (- a-post a-prior)
- (- b-post b-prior))))
- (let ((a-line (+ a-prior offset))
- (b-line (+ b-prior offset)))
- (cond ((= offset 0)
- (push (list a-line b-line 0) a-entries)
- (push (list b-line a-line 0) b-entries))
- ((and a-end b-end
- (<= b-line b-end)
- (<= a-line a-end))
- (push (list a-line b-line 0) a-entries)
- (push (list b-line a-line 0) b-entries))
- ((and (or (null a-end) (> a-line a-end))
- (<= b-line b-post))
- (push (list b-line a-post (- a-line (or a-end a-prior) 1))
b-entries))
- ((and (or (null b-end) (> b-line b-end))
- (<= a-line a-post))
- (push (list a-line b-post (- b-line (or b-end b-prior) 1))
a-entries)))))
- (push (list (1+ a-post) (1+ b-post) 0) a-entries)
- (push (list (1+ b-post) (1+ a-post) 0) b-entries)
- (cons (nreverse a-entries) (nreverse b-entries))))
-
-(defun vdiff--set-cons (vars expr)
- (setf (car vars) (car expr))
- (setf (cdr vars) (cdr expr)))
-
-(defun vdiff--refresh-line-maps (session)
- "Sync information in `vdiff--line-map' with
-`vdiff--diff-data'."
- (when (vdiff--buffer-p)
- (let ((vdiff--inhibit-diff-update t)
- (a-b (list (list 0 0 0)))
- (b-a (list (list 0 0 0)))
- (a-c (list (list 0 0 0)))
- (c-a (list (list 0 0 0)))
- (b-c (list (list 0 0 0)))
- (c-b (list (list 0 0 0))))
- (dolist (hunk (vdiff-session-diff-data session))
- (let* ((a-lines (nth 0 hunk))
- (a-beg (car a-lines))
- (a-prior (1- a-beg))
- (a-end (cdr a-lines))
- (a-post (if a-end (1+ a-end) a-beg))
- (b-lines (nth 1 hunk))
- (b-beg (car b-lines))
- (b-prior (1- b-beg))
- (b-end (cdr b-lines))
- (b-post (if b-end (1+ b-end) b-beg))
- (c-lines (nth 2 hunk)))
- (let ((new-a-b
- (vdiff--2way-entries a-prior a-end a-post b-prior b-end
b-post)))
- (setq a-b (nconc a-b (car new-a-b)))
- (setq b-a (nconc b-a (cdr new-a-b)))
- (when c-lines
- (let* ((c-beg (car c-lines))
- (c-prior (1- c-beg))
- (c-end (cdr c-lines))
- (c-post (if c-end (1+ c-end) c-beg))
- (new-a-c
- (vdiff--2way-entries a-prior a-end a-post c-prior c-end
c-post))
- (new-b-c
- (vdiff--2way-entries b-prior b-end b-post c-prior c-end
c-post)))
- (setq a-c (nconc a-c (car new-a-c)))
- (setq c-a (nconc c-a (cdr new-a-c)))
- (setq b-c (nconc b-c (car new-b-c)))
- (setq c-b (nconc c-b (cdr new-b-c))))))))
- (setf (vdiff-session-line-maps session)
- (if vdiff-3way-mode
- (list (list 'a (cons 'b a-b) (cons 'c a-c))
- (list 'b (cons 'a b-a) (cons 'c b-c))
- (list 'c (cons 'a c-a) (cons 'b c-b)))
- (list (list 'a (cons 'b a-b))
- (list 'b (cons 'a b-a))))))))
-
-(defun vdiff--translate-line (line &optional from-buffer to-buffer)
- "Translate LINE in buffer A to corresponding line in buffer
-B. Go from buffer B to A if B-to-A is non nil."
- (interactive (list (line-number-at-pos)))
- (let* ((from-buffer (or from-buffer (vdiff--buffer-p)))
- (maps
- (cdr
- (assq from-buffer (vdiff-session-line-maps vdiff--session))))
- last-entry res-1 res-2 res)
- (dolist (map maps)
- (setq last-entry
- (catch 'closest
- (let (prev-entry)
- (dolist (entry (cdr map))
- (let ((map-line (car entry)))
- (cond ((< map-line line)
- (setq prev-entry entry))
- ((= map-line line)
- (throw 'closest entry))
- (t
- (throw 'closest prev-entry)))))
- (throw 'closest prev-entry))))
- (unless last-entry
- (setq last-entry (list line line))
- (message "Error in line translation %s %s" line from-buffer))
- (if res-1
- (setq res-2 (list (car map)
- (+ (- line (car last-entry)) (cadr last-entry))
- (nth 2 last-entry)))
- (setq res-1 (list (car map)
- (+ (- line (car last-entry)) (cadr last-entry))
- (nth 2 last-entry)))))
- (when (called-interactively-p 'interactive)
- (message "This line: %s (%s); Other line %s (%s); vscroll-state %s;
entry %s"
- line from-buffer res-1 (car res-1) (cdr res-1) last-entry))
- (setq res (cons res-1 res-2))
- (if to-buffer
- (cdr (assq to-buffer res))
- res)))
-
-(defun vdiff-switch-buffer (line)
- "Jump to the line in another vdiff buffer that corresponds to
-the current one."
- (interactive (list (line-number-at-pos)))
- (let ((from-buffer (vdiff--buffer-p)))
- (select-window (car (vdiff--unselected-windows)))
- (let ((target-line
- (car
- (vdiff--translate-line line from-buffer (vdiff--buffer-p)))))
- (when target-line
- (vdiff--move-to-line target-line)))))
-
-(defun vdiff-restore-windows ()
- "Restore initial window configuration."
- (interactive)
- (set-window-configuration
- (vdiff-session-window-config vdiff--session)))
-
-(defun vdiff--pos-at-line-beginning (line &optional buffer)
- "Return position at beginning of LINE in BUFFER (or current
-buffer)."
- (with-current-buffer (or buffer (current-buffer))
- (save-excursion
- (vdiff--move-to-line line)
- (line-beginning-position))))
-
-(defun vdiff--set-vscroll-and-force-update (window &optional vscroll)
- (run-at-time
- nil nil
- (lambda ()
- (unless vdiff--setting-vscroll
- (let ((vdiff--setting-vscroll t))
- (when (and (windowp window)
- (window-live-p window))
- (when (and vscroll
- (eq vdiff-subtraction-style 'full))
- (set-window-vscroll window vscroll))
- (force-window-update window)))))))
-
-(defun vdiff--flag-new-command ()
- (setq vdiff--new-command t))
-
-(defun vdiff--other-win-scroll-data (_window window-start &optional buf-c)
- ;; need other-win, start-pos, pos and scroll-amt
- (let* ((other-buf (nth (if buf-c 1 0) (vdiff--unselected-buffers)))
- (other-win (nth (if buf-c 1 0) (vdiff--unselected-windows)))
- (start-line (line-number-at-pos window-start))
- (start-trans (vdiff--translate-line start-line))
- (start-trans (if buf-c (cddr start-trans) (cdar start-trans)))
- (trans (vdiff--translate-line
- (+ (count-lines window-start (point))
- start-line)))
- (trans (if buf-c (cddr trans) (cdar trans))))
- (when (and start-trans trans)
- (list other-win
- (vdiff--pos-at-line-beginning (car start-trans) other-buf)
- (vdiff--pos-at-line-beginning (car trans) other-buf)
- (cadr start-trans)))))
-
-(defun vdiff--scroll-function (&optional window window-start)
- "Sync scrolling of all vdiff windows."
- (unless vdiff--testing-mode
- (let* ((window (or window (selected-window)))
- (update-window-start (null window-start))
- (window-start (or window-start (progn
- ;; redisplay updates window-start
in
- ;; the case where the scroll
- ;; function is called manually
- (redisplay)
- (window-start)))))
- (when (and (eq window (selected-window))
- (cl-every #'window-live-p (vdiff--all-windows))
- (vdiff--buffer-p)
- (not vdiff--in-scroll-hook)
- vdiff--new-command)
- (setq vdiff--new-command nil)
- (let* ((2-scroll-data (vdiff--other-win-scroll-data
- window window-start))
- (2-win (nth 0 2-scroll-data))
- (2-start-pos (nth 1 2-scroll-data))
- (2-pos (nth 2 2-scroll-data))
- (2-scroll (nth 3 2-scroll-data))
- ;; 1 is short for this; 2 is the first other and 3 is the second
- (vdiff--in-scroll-hook t))
- (when (and 2-pos 2-start-pos)
- (set-window-point 2-win 2-pos)
- ;; For some reason without this unless the vscroll gets eff'd
- (unless (= (progn
- (when update-window-start
- (redisplay))
- (window-start 2-win))
- 2-start-pos)
- (set-window-start 2-win 2-start-pos))
- (vdiff--set-vscroll-and-force-update 2-win 2-scroll))
- (when vdiff-3way-mode
- (let*
- ((3-scroll-data (vdiff--other-win-scroll-data
- window window-start t))
- (3-win (nth 0 3-scroll-data))
- (3-start-pos (nth 1 3-scroll-data))
- (3-pos (nth 2 3-scroll-data))
- (3-scroll (nth 3 3-scroll-data)))
- (when (and 3-start-pos 3-pos)
- (set-window-point 3-win 3-pos)
- (set-window-start 3-win 3-start-pos)
- (vdiff--set-vscroll-and-force-update 3-win 3-scroll)))))))))
-
-;; (defun vdiff--post-command-hook ()
-;; "Sync scroll for `vdiff--force-sync-commands'."
-;; ;; Use real-this-command because evil-next-line and evil-previous-line
pretend
-;; ;; they are next-line and previous-line
-;; (when (and (memq this-command vdiff--force-sync-commands)
-;; (not vdiff--in-post-command-hook)
-;; (vdiff--buffer-p))
-;; (let ((vdiff--in-post-command-hook t))
-;; (when (and (sit-for 0.05)
-;; (eq vdiff-subtraction-style 'full))
-;; (vdiff--scroll-function)))))
-
-(defun vdiff--after-change-function (&rest _)
- (when (vdiff--buffer-p)
- (unless (vdiff-session-diff-stale vdiff--session)
- (setf (vdiff-session-diff-stale vdiff--session) t)
- (when (timerp vdiff--after-change-timer)
- (cancel-timer vdiff--after-change-timer))
- (setq vdiff--after-change-timer
- (run-with-idle-timer
- vdiff--after-change-refresh-delay
- nil (lambda ()
- (let ((vdiff-may-close-fold-on-point nil))
- (vdiff-refresh))))))))
-
-(defun vdiff--set-open-fold-props (ovr)
- "Set overlay properties to open fold OVR."
- (overlay-put ovr 'vdiff-fold-open t)
- (overlay-put ovr 'display nil)
- (overlay-put ovr 'intangible nil)
- (overlay-put ovr 'before-string
- (propertize
- " " 'display '(left-fringe vdiff--top-left-angle)))
- (overlay-put ovr 'line-prefix
- (propertize
- " " 'display '(left-fringe vdiff--vertical-bar)))
- (overlay-put ovr 'after-string
- (propertize
- " " 'display '(left-fringe vdiff--bottom-left-angle))))
-
-(defun vdiff--set-closed-fold-props (ovr)
- "Set overlay properties to close fold OVR."
- (when (vdiff--point-in-fold-p ovr)
- (goto-char (overlay-start ovr)))
- (overlay-put ovr 'vdiff-fold-open nil)
- (overlay-put ovr 'before-string nil)
- (overlay-put ovr 'line-prefix nil)
- (overlay-put ovr 'after-string nil)
- (overlay-put ovr 'intangible t)
- (overlay-put ovr 'display (overlay-get ovr 'vdiff-fold-text)))
-
-(defun vdiff--open-fold (ovr)
- "Opens fold overlay OVR."
- (vdiff--set-open-fold-props ovr)
- (dolist (other-fold (overlay-get ovr 'vdiff-other-folds))
- (vdiff--set-open-fold-props other-fold)))
-
-(defun vdiff--close-fold (ovr)
- "Closes fold overlay OVR."
- (setf (vdiff-session-all-folds-open vdiff--session) nil)
- (vdiff--set-closed-fold-props ovr)
- (dolist (other-fold (overlay-get ovr 'vdiff-other-folds))
- (vdiff--set-closed-fold-props other-fold)))
-
-(defun vdiff-open-fold (beg end &optional _)
- "Open folds between BEG and END, as well as corresponding ones
-in other vdiff buffer. If called interactively, either open fold
-at point or on prior line. If the region is active open all folds
-in the region."
- (interactive (vdiff--region-or-close-overlay))
- (dolist (ovr (overlays-in beg end))
- (when (eq (overlay-get ovr 'vdiff-type) 'fold)
- (vdiff--open-fold ovr)))
- (vdiff--scroll-function))
-
-(defun vdiff-close-fold (beg end &optional _)
- "Close folds between BEG and END, as well as corresponding ones
-in other vdiff buffer. If called interactively, either close fold
-at point or on prior line. If the region is active close all
-folds in the region."
- (interactive (vdiff--region-or-close-overlay))
- (dolist (ovr (overlays-in beg end))
- (when (eq (overlay-get ovr 'vdiff-type) 'fold)
- (vdiff--close-fold ovr)))
- (vdiff--scroll-function))
-
-(defun vdiff-toggle-fold (beg end &optional _)
- "Toggles folds between BEG and END, as well as corresponding
-ones in other vdiff buffer. If called interactively, either
-toggle fold at point or on prior line. If the region is active
-toggle all folds in region."
- (interactive (vdiff--region-or-close-overlay))
- (dolist (ovr (overlays-in beg end))
- (when (eq (overlay-get ovr 'vdiff-type) 'fold)
- (if (overlay-get ovr 'vdiff-fold-open)
- (vdiff--close-fold ovr)
- (vdiff--open-fold ovr))))
- (vdiff--scroll-function))
-
-(defun vdiff-open-all-folds ()
- "Open all folds in both buffers"
- (interactive)
- (save-excursion
- (setf (vdiff-session-all-folds-open vdiff--session) t)
- (vdiff-open-fold (point-min) (point-max))))
-
-(defun vdiff-close-all-folds ()
- "Close all folds in both buffers"
- (interactive)
- (save-excursion
- (setf (vdiff-session-all-folds-open vdiff--session) nil)
- (vdiff-close-fold (point-min) (point-max))))
-
-(defun vdiff-close-other-folds ()
- "Close all other folds in both buffers"
- (interactive)
- (dolist (ovr (overlays-in (point-min) (point-max)))
- (when (and (eq (overlay-get ovr 'vdiff-type) 'fold)
- (not (vdiff--point-in-fold-p ovr)))
- (setf (vdiff-session-all-folds-open vdiff--session) nil)
- (vdiff--set-closed-fold-props ovr)
- (dolist (other-fold (overlay-get ovr 'vdiff-other-folds))
- (vdiff--set-closed-fold-props other-fold)))))
-
-(defun vdiff-toggle-all-folds ()
- "Toggle all folds in both buffers"
- (interactive)
- (save-excursion
- (vdiff-toggle-fold (point-min) (point-max))))
-
-;; * Movement
-
-(defun vdiff--nth-hunk (&optional n use-folds)
- "Return point at Nth hunk in buffer. Use folds instead of hunks
-with non-nil USE-FOLDS."
- (let* ((n (or n 1))
- (reverse (< n 0))
- pnt)
- (save-excursion
- (dotimes (_i (abs n))
- ;; Escape current overlay
- (vdiff--maybe-exit-overlay reverse)
- (setq pnt (point))
- ;; Find next overlay
- (while (not (or (and reverse (bobp))
- (and (not reverse) (eobp))
- (and use-folds
- (vdiff--fold-at-point-p))
- (and (not use-folds)
- (vdiff--hunk-at-point-p))))
- (setq pnt
- (goto-char (if reverse
- (previous-overlay-change pnt)
- (next-overlay-change pnt)))))))
- pnt))
-
-(defun vdiff--recenter ()
- "Wrapped version of `recenter'."
- (unless vdiff--testing-mode
- (recenter)))
-
-(defun vdiff-next-hunk (arg)
- "Jump to next change in this buffer."
- (interactive "p")
- (let ((count (or arg 1)))
- (goto-char (vdiff--nth-hunk count))
- (vdiff--recenter)))
-
-(defun vdiff-previous-hunk (arg)
- "Jump to previous change in this buffer."
- (interactive "p")
- (let ((count (or (- arg) -1)))
- (goto-char (vdiff--nth-hunk count))
- (vdiff--recenter)))
-
-(defun vdiff-next-fold (arg)
- "Jump to next fold in this buffer."
- (interactive "p")
- (let ((count (or arg 1)))
- (goto-char (vdiff--nth-hunk count t))
- (vdiff--recenter)))
-
-(defun vdiff-previous-fold (arg)
- "Jump to previous fold in this buffer."
- (interactive "p")
- (let ((count (or (- arg) -1)))
- (goto-char (vdiff--nth-hunk count t))
- (vdiff--recenter)))
-
-;; * Session
-
-(defun vdiff--init-session
- (buffer-a buffer-b
- &optional buffer-c on-quit prior-window-config kill-buffers-on-quit)
- (make-vdiff-session
- :buffers (vdiff--non-nil-list buffer-a buffer-b buffer-c)
- :process-buffer (generate-new-buffer-name " *vdiff* ")
- :word-diff-output-buffer (generate-new-buffer-name " *vdiff-word* ")
- :folds (make-hash-table :test 'equal :weakness 'value)
- :case-args ""
- :whitespace-args ""
- :prior-window-config prior-window-config
- :on-quit on-quit
- :kill-buffers-on-quit kill-buffers-on-quit))
-
-;; * Entry points
-
-;;;###autoload
-(defun vdiff-files (file-a file-b &optional rotate on-quit)
- "Start a vdiff session. If called interactively, you will be
-asked to select two files. ROTATE adjusts the buffer's
-initial layout. A prefix argument can be used to set this
-variable interactively. ON-QUIT is a function to run on exiting
-the vdiff session. It is called with the two vdiff buffers as
-arguments."
- (interactive
- (let* ((file-a (read-file-name "File 1: "))
- (default-directory
- (file-name-directory file-a)))
- (list
- file-a
- (read-file-name
- (format "[File 1 %s] File 2: "
- (file-name-nondirectory file-a)))
- current-prefix-arg)))
- (vdiff-buffers (find-file-noselect file-a)
- (find-file-noselect file-b)
- rotate on-quit))
-
-(defun vdiff-temp-files ()
- "Start a vidff session for two new temp files.
-
-This might be useful if you want to paste compare text pasted
-from another source."
- (interactive)
- (let ((file-a (make-temp-file "vdiff-"))
- (file-b (make-temp-file "vdiff-")))
- (write-region "\n" nil file-a)
- (write-region "\n" nil file-b)
- (vdiff-files file-a file-b)))
-
-(defcustom vdiff-2way-layout-function 'vdiff-2way-layout-function-default
- "Function to layout windows in 2way diffs.
-
-Should take the arguments (BUFFER-A BUFFER-B &optional ROTATE),
-where rotate switches from vertical to rotate (or vice
-versa)."
- :group 'vdiff
- :type 'function)
-
-(defun vdiff-2way-layout-function-default (buffer-a buffer-b &optional rotate)
- (delete-other-windows)
- (switch-to-buffer buffer-a)
- (set-window-buffer
- (if rotate
- (split-window-vertically)
- (split-window-horizontally))
- buffer-b))
-
-;;;###autoload
-(defun vdiff-buffers
- (buffer-a buffer-b
- &optional rotate on-quit restore-windows-on-quit kill-buffers-on-quit)
- "Start a vdiff session. If called interactively, you will be
-asked to select two buffers. ROTATE adjusts the buffer's
-initial layout. A prefix argument can be used to set this
-variable interactively. ON-QUIT is a function to run on exiting
-the vdiff session. It is called with the two vdiff buffers as
-arguments. The last two options, RESTORE-WINDOWS-ON-QUIT and
-KILL-BUFFERS-ON-QUIT restore the previous window configuration
-and kill the vdiff buffers after quitting vdiff. Note that if you
-are going to kill the buffers you should probably be using a
-function for ON-QUIT to do something useful with the result."
- (interactive
- (let* ((buffer-a
- (get-buffer
- (read-buffer
- "Buffer 1: " (current-buffer)))))
- (list
- buffer-a
- (get-buffer
- (read-buffer
- (format "[Buffer 1 %s] Buffer 2: " buffer-a)
- (window-buffer (next-window (selected-window) nil 0))))
- current-prefix-arg)))
- (let ((prior-window-config (when restore-windows-on-quit
- (current-window-configuration)))
- (buffer-a (get-buffer buffer-a))
- (buffer-b (get-buffer buffer-b)))
- (cond
- (vdiff--testing-mode
- (set-buffer buffer-a))
- ((functionp vdiff-2way-layout-function)
- (funcall vdiff-2way-layout-function buffer-a buffer-b rotate))
- (t
- (delete-other-windows)
- (switch-to-buffer buffer-a)
- (set-window-buffer
- (if rotate
- (split-window-vertically)
- (split-window-horizontally))
- buffer-b)))
- (setq vdiff--temp-session
- (vdiff--init-session
- buffer-a buffer-b nil
- on-quit prior-window-config kill-buffers-on-quit))
- (dolist (buf (list buffer-a buffer-b))
- (with-current-buffer buf
- (vdiff-mode -1)
- (vdiff-3way-mode -1)
- (vdiff-mode 1)))
- (setq vdiff--temp-session nil)
- (vdiff-refresh #'vdiff--scroll-function)))
-
-(defcustom vdiff-3way-layout-function 'vdiff-3way-layout-function-default
- "Function to layout windows in 3way diffs.
-
-Should take the arguments (BUFFER-A BUFFER-B BUFFER-C)."
- :group 'vdiff
- :type 'function)
-
-(defun vdiff-3way-layout-function-default (buffer-a buffer-b buffer-c)
- (delete-other-windows)
- (switch-to-buffer buffer-a)
- (set-window-buffer (split-window-vertically) buffer-c)
- (set-window-buffer (split-window-horizontally) buffer-b))
-
-;;;###autoload
-(defun vdiff-buffers3
- (buffer-a buffer-b buffer-c
- &optional on-quit restore-windows-on-quit kill-buffers-on-quit)
- "Start a vdiff session. If called interactively, you will be
-asked to select two buffers. ON-QUIT is a function to run on
-exiting the vdiff session. It is called with the three vdiff
-buffers as arguments. The last two options, RESTORE-WINDOWS-ON-QUIT and
-KILL-BUFFERS-ON-QUIT restore the previous window configuration
-and kill the vdiff buffers after quitting vdiff. Note that if you
-are going to kill the buffers you should probably be using a
-function for ON-QUIT to do something useful with the result."
- (interactive
- (let* ((buffer-a
- (get-buffer
- (read-buffer
- "Buffer 1: " (current-buffer))))
- (buffer-b
- (get-buffer
- (read-buffer
- (format "[2:%s] Buffer 3: " buffer-a)
- (window-buffer (next-window (selected-window))))))
- (buffer-c
- (get-buffer
- (read-buffer
- (format "[1:%s 2:%s] Buffer 3: " buffer-a buffer-b)
- (window-buffer (next-window (selected-window)))))))
- (list buffer-a buffer-b buffer-c)))
- (let ((prior-window-config (when restore-windows-on-quit
- (current-window-configuration)))
- (buffer-a (get-buffer buffer-a))
- (buffer-b (get-buffer buffer-b))
- (buffer-c (get-buffer buffer-c)))
- (if vdiff--testing-mode
- (set-buffer buffer-a)
- (funcall vdiff-3way-layout-function buffer-a buffer-b buffer-c))
- (setq vdiff--temp-session
- (vdiff--init-session
- buffer-a buffer-b buffer-c
- on-quit prior-window-config kill-buffers-on-quit))
- (dolist (buf (list buffer-a buffer-b buffer-c))
- (with-current-buffer buf
- (vdiff-mode -1)
- (vdiff-3way-mode -1)
- (vdiff-3way-mode 1)))
- (setq vdiff--temp-session nil)
- (vdiff-refresh #'vdiff--scroll-function)))
-
-;;;###autoload
-(defun vdiff-merge-conflict (file &optional restore-windows-on-quit)
- "Start vdiff session using merge conflicts marked in FILE."
- (interactive (list buffer-file-name))
- (with-current-buffer (find-file-noselect file)
- (require 'smerge-mode)
- (let* ((smerge-buffer (current-buffer))
- (mode major-mode)
- (filename (file-name-directory (or buffer-file-name "-")))
- (mine (generate-new-buffer
- (concat "*" filename " "
- (smerge--get-marker smerge-begin-re "MINE")
- "*")))
- (other (generate-new-buffer
- (concat "*" filename " "
- (smerge--get-marker smerge-end-re "OTHER")
- "*")))
- (ancestor (generate-new-buffer
- (concat "*" filename " "
- (smerge--get-marker smerge-end-re "ANCESTOR")
- "*")))
- ancestor-used merge-buffer)
- (with-current-buffer mine
- (buffer-disable-undo)
- (insert-buffer-substring smerge-buffer)
- (goto-char (point-min))
- (while (smerge-find-conflict)
- (smerge-keep-n 1))
- (buffer-enable-undo)
- (set-buffer-modified-p nil)
- (funcall mode))
-
- (with-current-buffer ancestor
- (buffer-disable-undo)
- (insert-buffer-substring smerge-buffer)
- (goto-char (point-min))
- (while (smerge-find-conflict)
- (when (match-beginning 2)
- (setq ancestor-used t)
- (smerge-keep-n 2)))
- (buffer-enable-undo)
- (set-buffer-modified-p nil)
- (funcall mode))
-
- (with-current-buffer other
- (buffer-disable-undo)
- (insert-buffer-substring smerge-buffer)
- (goto-char (point-min))
- (while (smerge-find-conflict)
- (smerge-keep-n 3))
- (buffer-enable-undo)
- (set-buffer-modified-p nil)
- (funcall mode))
-
- (setq merge-buffer
- (if (and ancestor-used vdiff-use-ancestor-as-merge-buffer)
- ancestor
- smerge-buffer))
-
- (vdiff-buffers3
- mine other merge-buffer
- `(lambda (mine other merge-buffer)
- (with-current-buffer ,smerge-buffer
- (when (yes-or-no-p (format "Conflict resolution finished; save %s?"
- buffer-file-name))
- (when ,(and ancestor-used vdiff-use-ancestor-as-merge-buffer)
- (erase-buffer)
- (insert-buffer-substring merge-buffer))
- (save-buffer)))
- (when (buffer-live-p mine) (kill-buffer mine))
- (when (buffer-live-p ,ancestor) (kill-buffer ,ancestor))
- (when (buffer-live-p other) (kill-buffer other)))
- restore-windows-on-quit))))
-
-;;;###autoload
-(defun vdiff-files3 (file-a file-b file-c &optional on-quit)
- "Start a vdiff session with 3 files. If called interactively,
-you will be asked to select two files."
- (interactive
- (let* ((file-a (read-file-name "File 1: "))
- (default-directory
- (file-name-directory file-a))
- (file-b
- (read-file-name
- (format "[1:%s] File 2: "
- (file-name-nondirectory file-a))))
- (file-c
- (read-file-name
- (format "[1:%s 2:%s] File 3: "
- (file-name-nondirectory file-a)
- (file-name-nondirectory file-b)))))
- (list file-a file-b file-c)))
- (vdiff-buffers3 (find-file-noselect file-a)
- (find-file-noselect file-b)
- (find-file-noselect file-c)
- on-quit))
-
-;;;###autoload
-(defun vdiff-current-file ()
- "Start vdiff between current buffer and its file on disk.
-This command can be used instead of `revert-buffer'. If there is
-nothing to revert then this command fails."
- (interactive)
- ;; Taken from `ediff-current-file'
- (unless (or (not (eq revert-buffer-function #'revert-buffer--default))
- (not (eq revert-buffer-insert-file-contents-function
- #'revert-buffer-insert-file-contents--default-function))
- (and buffer-file-number
- (or (buffer-modified-p)
- (not (verify-visited-file-modtime
- (current-buffer))))))
- (error "Nothing to revert"))
- (let* ((auto-save-p (and (recent-auto-save-p)
- buffer-auto-save-file-name
- (file-readable-p buffer-auto-save-file-name)
- (y-or-n-p
- "Buffer has been auto-saved recently. Compare
with auto-save file? ")))
- (file-name (if auto-save-p
- buffer-auto-save-file-name
- buffer-file-name))
- (revert-buf-name (concat "FILE=" file-name))
- (revert-buf (get-buffer revert-buf-name))
- (current-major major-mode))
- (unless file-name
- (error "Buffer does not seem to be associated with any file"))
- (when revert-buf
- (kill-buffer revert-buf)
- (setq revert-buf nil))
- (setq revert-buf (get-buffer-create revert-buf-name))
- (with-current-buffer revert-buf
- (insert-file-contents file-name)
- ;; Assume same modes:
- (funcall current-major))
- (vdiff-buffers revert-buf (current-buffer)
- nil
- (lambda (rbuf _)
- (when (buffer-live-p rbuf)
- (kill-buffer rbuf)))
- t)))
-
-;; (defvar vdiff-quit-hook nil)
-
-(defun vdiff-quit ()
- "Quit `vdiff-mode' and clean up."
- (interactive)
- (if (null vdiff--session)
- (user-error "Not in a vdiff buffer")
- (let ((ses vdiff--session))
- (when (functionp (vdiff-session-on-quit ses))
- (apply (vdiff-session-on-quit ses)
- (vdiff-session-buffers ses)))
- (dolist (buf (list (vdiff-session-process-buffer
- ses)
- (vdiff-session-word-diff-output-buffer
- ses)))
- (when (process-live-p (get-buffer-process buf))
- (kill-process (get-buffer-process buf)))
- (when (buffer-live-p buf) (kill-buffer buf)))
- (dolist (buf (vdiff-session-buffers ses))
- (when (buffer-live-p buf)
- (with-current-buffer buf
- (if vdiff-3way-mode
- (vdiff-3way-mode -1)
- (vdiff-mode -1)))
- (when (vdiff-session-kill-buffers-on-quit ses)
- (kill-buffer buf))))
- ;; (run-hooks 'vdiff-quit-hook)
- (when (and (not vdiff--testing-mode)
- (vdiff-session-prior-window-config ses))
- (set-window-configuration
- (vdiff-session-prior-window-config ses))))
- (setq vdiff--session nil)
- (message "vdiff exited")))
-
-(defvar vdiff-mode-map (make-sparse-keymap))
-
-(defvar vdiff-3way-mode-map (make-sparse-keymap))
-
-(defvar vdiff-mode-prefix-map
- (let ((map (make-sparse-keymap)))
- (define-key map "c" 'vdiff-close-fold)
- (define-key map "C" 'vdiff-close-all-folds)
- (define-key map "f" 'vdiff-refine-this-hunk)
- (define-key map "F" 'vdiff-refine-all-hunks)
- (define-key map "g" 'vdiff-switch-buffer)
- (define-key map "h" 'vdiff-hydra/body)
- (define-key map "ic" 'vdiff-toggle-case)
- (define-key map "iw" 'vdiff-toggle-whitespace)
- (define-key map "n" 'vdiff-next-hunk)
- (define-key map "N" 'vdiff-next-fold)
- (define-key map "o" 'vdiff-open-fold)
- (define-key map "O" 'vdiff-open-all-folds)
- (define-key map "p" 'vdiff-previous-hunk)
- (define-key map "P" 'vdiff-previous-fold)
- (define-key map "q" 'vdiff-quit)
- (define-key map "r" 'vdiff-receive-changes)
- (define-key map "R" 'vdiff-receive-changes-and-step)
- (define-key map "s" 'vdiff-send-changes)
- (define-key map "S" 'vdiff-send-changes-and-step)
- (define-key map "x" 'vdiff-remove-refinements-in-hunk)
- (define-key map "t" 'vdiff-close-other-folds)
- (define-key map "u" 'vdiff-refresh)
- (define-key map "w" 'vdiff-save-buffers)
- map))
-
-(defvar vdiff-scroll-lock-mode)
-
-(defun vdiff--buffer-init ()
- ;; this is a buffer-local var
- (unless vdiff--temp-session
- (user-error "Incorrect initialization of vdiff session. \
-See README for entry points into a vdiff session."))
- (setq vdiff--session vdiff--temp-session)
- (unless vdiff--testing-mode
- (setq cursor-in-non-selected-windows nil)
- (add-hook 'after-save-hook #'vdiff-refresh nil t)
- (add-hook 'after-change-functions #'vdiff--after-change-function nil t)
- (add-hook 'pre-command-hook #'vdiff--flag-new-command nil t)
- (setf (vdiff-session-window-config vdiff--session)
- (current-window-configuration))
- (when vdiff-lock-scrolling
- (add-hook 'window-scroll-functions #'vdiff--scroll-function nil t))
- (when (and vdiff-truncate-lines (null truncate-lines))
- (let (message-log-max)
- (add-hook 'vdiff--cleanup-hook
- (lambda () (toggle-truncate-lines 0)) nil t)
- (toggle-truncate-lines 1)))))
-
-(defun vdiff--buffer-cleanup ()
- (vdiff--remove-all-overlays)
- (unless vdiff--testing-mode
- (setq cursor-in-non-selected-windows t)
- (remove-hook 'after-save-hook #'vdiff-refresh t)
- (remove-hook 'after-change-functions #'vdiff--after-change-function t)
- (remove-hook 'pre-command-hook #'vdiff--flag-new-command t))
- (remove-hook 'window-scroll-functions #'vdiff--scroll-function t)
- (run-hooks 'vdiff--cleanup-hook))
-
-(define-minor-mode vdiff-mode
- "Minor mode active in a vdiff session involving two
-buffers. This sets up key bindings in `vdiff-mode-map' and adds
-hooks to refresh diff on changes. This will be enabled
-automatically after calling commands like `vdiff-files' or
-`vdiff-buffers'."
- nil " vdiff" 'vdiff-mode-map
- (if vdiff-mode
- (vdiff--buffer-init)
- (vdiff--buffer-cleanup)))
-
-(define-minor-mode vdiff-3way-mode
- "Minor mode active in a vdiff session involving three
-buffers. This sets up key bindings in `vdiff-3way-mode-map' and
-adds hooks to refresh diff on changes. This will be enabled
-automatically after calling commands like `vdiff-files3' or
-`vdiff-buffers3'."
- nil " vdiff3" 'vdiff-3way-mode-map
- (if vdiff-3way-mode
- (vdiff--buffer-init)
- (vdiff--buffer-cleanup)))
-
-(define-minor-mode vdiff-scroll-lock-mode
- "Lock scrolling between vdiff buffers. This minor mode will be
-enabled automatically if `vdiff-lock-scrolling' is non-nil."
- nil nil nil
- (cond (vdiff-scroll-lock-mode
- (unless (or vdiff-mode vdiff-3way-mode)
- (user-error "Must enable vdiff-mode first"))
- (vdiff--with-all-buffers
- (add-hook 'window-scroll-functions #'vdiff--scroll-function nil t))
- (message "Scrolling locked"))
- (t
- (vdiff--with-all-buffers
- (remove-hook 'window-scroll-functions #'vdiff--scroll-function t))
- (message "Scrolling unlocked"))))
-
-(defun vdiff--current-case ()
- (if (string= "" (vdiff-session-case-args vdiff--session))
- "off"
- "on (-i)"))
-
-(defun vdiff--current-whitespace ()
- (pcase (vdiff-session-whitespace-args vdiff--session)
- ("" "off")
- ("-w" "all (-w)")
- ("-b" "space changes (-b)")
- ("-B" "blank lines (-B)")))
-
-(defhydra vdiff-toggle-hydra (nil nil :hint nil)
- (concat (propertize
- "\
- Toggles"
- 'face 'header-line)
- "
- _c_ ignore case (current: %s(vdiff--current-case))
- _w_ ignore whitespace (current: %s(vdiff--current-whitespace))
- _q_ back to main hydra")
-
- ("c" vdiff-toggle-case)
- ("w" vdiff-toggle-whitespace)
- ("q" vdiff-hydra/body :exit t))
-
-(defhydra vdiff-hydra (nil nil :hint nil :foreign-keys run)
- (concat (propertize
- "\
- Navigation^^^^ Refine^^ Transmit^^^^ Folds^^^^
Other^^^^ "
- 'face 'header-line)
- "
- _n_/_N_ next hunk/fold _f_ this _s_/_S_ send (+step) _o_/_O_ open
(all) _i_ ^ ^ toggles
- _p_/_P_ prev hunk/fold _F_ all _r_/_R_ receive (+step) _c_/_C_ close
(all) _u_ ^ ^ update diff
- _g_^ ^ switch buffers _x_ clear ^ ^ ^ ^ _t_ ^ ^ close
other _w_ ^ ^ save buffers
- ^ ^^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^
_q_/_Q_ quit hydra/vdiff
- ignore case: %s(vdiff--current-case) | ignore whitespace:
%s(vdiff--current-whitespace)")
- ("n" vdiff-next-hunk)
- ("p" vdiff-previous-hunk)
- ("N" vdiff-next-fold)
- ("P" vdiff-previous-fold)
- ("g" vdiff-switch-buffer)
- ("s" vdiff-send-changes)
- ("S" vdiff-send-changes-and-step)
- ("r" vdiff-receive-changes)
- ("R" vdiff-receive-changes-and-step)
- ("o" vdiff-open-fold)
- ("O" vdiff-open-all-folds)
- ("c" vdiff-close-fold)
- ("C" vdiff-close-all-folds)
- ("t" vdiff-close-other-folds)
- ("u" vdiff-refresh)
- ("w" vdiff-save-buffers)
- ("f" vdiff-refine-this-hunk)
- ("F" vdiff-refine-all-hunks)
- ("x" vdiff-remove-refinements-in-hunk)
- ("i" vdiff-toggle-hydra/body :exit t)
- ("q" nil :exit t)
- ("Q" vdiff-quit :exit t))
-
-(provide 'vdiff)
-;;; vdiff.el ends here
diff --git a/packages/yasnippet/.gitignore b/packages/yasnippet/.gitignore
deleted file mode 100644
index c433a57..0000000
--- a/packages/yasnippet/.gitignore
+++ /dev/null
@@ -1,10 +0,0 @@
-authors.txt
-doc/gh-pages
-doc/*.html
-pkg/
-extras/imported/**
-!extras/imported/*/.yas-setup.el
-.yas-compiled-snippets.el
-*.elc
-ert-x.*
-ert.*
diff --git a/packages/yasnippet/.gitmodules b/packages/yasnippet/.gitmodules
deleted file mode 100644
index e69de29..0000000
diff --git a/packages/yasnippet/.travis.yml b/packages/yasnippet/.travis.yml
deleted file mode 100644
index 9a999ec..0000000
--- a/packages/yasnippet/.travis.yml
+++ /dev/null
@@ -1,46 +0,0 @@
-language: generic
-sudo: false
-git:
- submodules: false
-
-env:
- global:
- - Wlexical=t
- - Werror=t
- - tests_Werror=t # For yasnippet-tests.el
- matrix:
- - EMACS_VERSION=23.4
- # 24.3 gives a bunch of 'value returned from (car value-N) is
- # unused' warnings.
- - EMACS_VERSION=24.3 tests_Werror=nil
- - EMACS_VERSION=24.5
- - EMACS_VERSION=25.3
- - EMACS_VERSION=26-prerelease
-
-
-install:
- - curl -LO
https://github.com/npostavs/emacs-travis/releases/download/bins/emacs-bin-${EMACS_VERSION}.tar.gz
- - tar -xaf emacs-bin-${EMACS_VERSION}.tar.gz -C /
- # Configure $PATH: Emacs installed to /tmp/emacs
- - export PATH=/tmp/emacs/bin:${PATH}
- - if ! emacs -Q --batch --eval "(require 'cl-lib)" ; then
- curl -Lo cl-lib.el http://elpa.gnu.org/packages/cl-lib-0.6.1.el ;
- export warnings="'(not cl-functions)" ;
- fi
- - if ! emacs -Q --batch --eval "(require 'ert)" ; then
- curl -LO
https://raw.githubusercontent.com/ohler/ert/c619b56c5bc6a866e33787489545b87d79973205/lisp/emacs-lisp/ert.el
&&
- curl -LO
https://raw.githubusercontent.com/ohler/ert/c619b56c5bc6a866e33787489545b87d79973205/lisp/emacs-lisp/ert-x.el
;
- fi
- - emacs --version
-
-script:
- - rake yasnippet.elc
- - rake yasnippet-debug.elc
- - rake yasnippet-tests.elc Werror=$tests_Werror
- - rake tests
-
-notifications:
- email:
- # Default is change, but that includes a new branch's 1st success.
- on_success: never
- on_failure: always # The default.
diff --git a/packages/yasnippet/CONTRIBUTING.md
b/packages/yasnippet/CONTRIBUTING.md
deleted file mode 100644
index bf3b2d3..0000000
--- a/packages/yasnippet/CONTRIBUTING.md
+++ /dev/null
@@ -1,37 +0,0 @@
-# Submitting Bug Reports or Patches
-
-As a GNU ELPA package, bugs or patches may be submitted to the main
-Emacs bug list, bug-gnu-emacs@gnu.org. Alternatively, you may use the
-[Github issue tracker][issues].
-
-Please read [Important note regarding bug reporting][bugnote].
-
-# Contributing to Yasnippet
-
-## Copyright Assignment
-
-Yasnippet is part of GNU ELPA, so it falls under the same copyright
-assignment policy as the rest of Emacs (see "Copyright Assignment" in
-https://www.gnu.org/software/emacs/CONTRIBUTE). A copyright assignment
-for Emacs also covers Yasnippet.
-
-## Commit message format
-
-The commit message format roughly follows Emacs conventions. There is
-no separate Changelog file.
-
- Capitalize the first sentence, no period at the end
-
- Please make sure the summary line can be understood without having
- to lookup bug numbers. It may be followed by a paragraph with a
- longer explanation. The changelog style entry goes at the end of
- the message.
- * foo.el (a-function): Terse summary of per-function changes. Use
- double spacing between sentences (set `sentence-end-double-space'
- to t).
-
-For trivial changes, a message consisting of just the changelog entry
-(e.g., `* foo.el (a-function): Fix docstring typo.`) is fine.
-
-[bugnote]:
https://github.com/joaotavora/yasnippet#important-note-regarding-bug-reporting
-[issues]: https://github.com/joaotavora/yasnippet/issues
diff --git a/packages/yasnippet/NEWS b/packages/yasnippet/NEWS
deleted file mode 100644
index 35d514f..0000000
--- a/packages/yasnippet/NEWS
+++ /dev/null
@@ -1,565 +0,0 @@
-Yasnippet NEWS -- history of user-visible changes.
-
-Copyright (C) 2017-2019 Free Software Foundation, Inc.
-See the end of the file for license conditions.
-
-* 0.14.0 (Dec 22, 2019)
-
-** Changes
-
-*** New 'yas-auto-next' macro, automatically moves to next field.
-See Github #937.
-
-*** Yasnippet now officially requires Emacs 23 or greater.
-See Github #940.
-
-*** Snippets for 'fundamental-mode' are available in all modes.
-See Github #949, and #936.
-
-*** New function for snippets, 'yas-completing-read'.
-See Github #934.
-
-*** New function 'yas-maybe-expand-abbrev-key-filter'.
-This can be used for making conditional keybindings for snippets.
-Promoted from 'yas--maybe-expand-key-filter'. See Github #943.
-
-*** DEL can now be used to clear fields, similar <delete>.
-It is bound to the new conditional command 'yas-maybe-clear-field', which may
-be bound to other keys as well. See Github #960 and #957.
-
-*** Snippet field movement commands may now trigger eldoc.
-See Github #952.
-
-*** New variable 'yas-keymap-disable-hook'.
-Can be used (e.g., for company-mode) to temporarily disable
-'yas-keymap' bindings, or any binding made by the new function
-'yas-filtered-definition'. See Github #987.
-
-*** New variable 'yas-inhibit-overlay-modification-protection'.
-This allows a snippet to remain active, even if some commands make
-modifications outside the expected area (i.e., the active snippet
-field).
-
-*** 'yas-minor-mode' is no longer enabled in temp buffers.
-That is, buffers whose name starts with a space. This setting may be
-undone by removing 'yas-temp-buffer-p' from
-'yas-dont-activate-functions'. See Github #985.
-
-*** Accept unescaped '{', for LSP compatibility.
-See Github #979.
-
-** Fixed bugs
-
-*** 'yas-not-string-or-comment-condition' no longer relies on 'this-command'.
-This lets it work correctly with conditional key-bindings. See Github
-#973, #991.
-
-*** Fix snippet expansion in org src buffers.
-Note that this still doesn't work in text-mode blocks.
-See Github #976, #989.
-
-*** Fix snippet insertion for keyless snippets.
-See Github #1014.
-
-*** Fix errors with company-mode completion within snippet fields.
-See Github #995.
-
-*** Fix errors with cc-mode.
-See Github #962.
-
-*** Fix problems with lsp-mode.
-**** Improve performance in overlay heavy buffers (Github #926).
-**** Fix double call of 'before/after-change-functions' (Github #966).
-
-*** Fix errors with nested snippet expansion.
-See Github #961, #1002.
-
-*** Stop yas-field-highlight-face inheriting from bogus 'quote' face.
-
-
-* 0.13.0 (May 13, 2018)
-
-** Changes
-
-*** Snippets for Yasnippet must now be installed separately. The
-submodule linking to yasnippet-snippets was removed, as were the
-"classic" snippets that came with the GNU ELPA package. The latter
-can now be installed via the 'yasnippet-classic-snippets' package from
-GNU ELPA.
-See Github #848, #858, #834, #775.
-
-*** 'snippet-mode' no longer derives from 'text-mode'.
-It will derive from 'prog-mode' where available (Emacs 24.1 and newer)
-or 'fundamental-mode' otherwise. See Github #826.
-
-*** The default value of 'yas-key-syntaxes' is changed
-Longer snippet abbrev keys are now preferred over shorter ones.
-See Github #805.
-
-*** New snippets are now created for the current major mode by default
-Previously, extra activated modes could be guessed first.
-See Github #875.
-
-*** Yasnippet supports 'unload-feature' via 'yasnippet-unload-function'
-See Github #753, #891.
-
-*** New command 'yas-skip-and-clear-field' conditionally bound to 'C-d'
-replaces obsoleted 'yas-skip-and-clear-or-delete-char'. The new
-function may be bound to any key via the conditional binding value
-'yas-maybe-skip-and-clear-field', instead of hardcoding the
-'delete-char' fallback action. See Github #408, #892.
-
-*** 'yas-lookup-snippet' now returns a struct
-This allows 'yas-expand-snippet' to take looked up snippet's
-environment into account. 'yas-expand-snippet' handles both
-structured snippets, and plain text snippet bodies.
-See Github #897.
-
-** Fixed bugs
-
-*** Avoid crashing due to Emacs Bug#30931
-This prevents yasnippet's routines from triggering the bug, although
-it is still possible to trigger it independently.
-
-*** Don't enable undo when it's disabled
-
-*** yas-also-auto-indent-first-line is once again respected
-Yasnippet was behaving as if it was always t for single line snippets.
-See Github #912.
-
-*** Fixed handling of fixed indent with fields at beginning of line
-See Github #906, #908.
-
-*** Fixed incorrect snippets leaving "bad memory"
-and possibly corrupting future expansions.
-See Github #800.
-
-*** 'global-whitespace-mode' now functions in new snippet buffers.
-To fix this, the buffer name for new snippet buffers is now '+new
-snippet+' instead of '*new snippet*'. See Github #842.
-
-*** Nest snippet expansion may clear default field text
-See Github #844.
-
-*** Fixed undo list corruption snippet expand+indent.
-See Github #869.
-
-*** The '# --' marker in snippets now allows trailing whitespace.
-See Github #862.
-
-*** Fixed handling of nested simple $n fields
-See Github #824, #894.
-
-
-* 0.12.2 (Aug 28, 2017)
-
-** The new option 'yas-also-auto-indent-empty-lines' allows restoring
-the old indent behavior. See Github #850, #710, #685, #679.
-
-** Keybinding triggered snippets once again deactivate the mark.
-See Github #840.
-
-
-* 0.12.1 (Jul 23, 2017)
-
-This is a quick bugfix release.
-
-** Compilation errors in yasnippet-tests.el and yasnippet-debug.el are fixed.
-
-** A snippet-local setting of 'yas-indent-line' is now respected
-during indentation triggered by auto-fill as well. See Github #838.
-
-
-* 0.12.0 (Jul 17, 2017)
-
-** Changes and New Features
-
-*** Snippets can now expand in strings & comments by default again.
-'yas-buffer-local-condition' is now a defcustom See Github #774.
-
-*** 'yas-after-exit-snippet-hook' can now be bound in 'expand-env' of
-snippets. See Github #28, #702, #779, #786.
-
-*** Snippets under directories in 'yas-snippet-dirs' are now in
-snippet-mode automatically.
-
-*** Snippets can now be expanded in org source blocks, if
-'org-src-tab-acts-natively' and 'org-src-fontify-natively' are set.
-See Github #761.
-
-*** 'yas-fallback-behavior' is now obsolete, 'yas-expand' is now bound
-conditionally with an extended menu item, 'yas-maybe-expand'.
-Therefore users wanting to bind 'yas-expand' to a different key, SPC
-for example, should do
-
- (define-key yas-minor-mode-map (kbd "SPC") yas-maybe-expand)
-
-See Github #760, #808.
-
-*** The documentation build output is now reproducible. The timestamp
-now depends on the commit date, or the environment variable
-SOURCE_DATE_EPOCH is that is set.
-
-*** 'yas-indent-line' and 'expand-env' are now respected during mirror
-updates. See Github #743.
-
-*** New function 'yas-active-snippets'. Renamed from
-'yas--snippets-at-point', which remains as an obsolete alias. See
-Github #727.
-
-*** New custom option 'yas-overlay-priority'. This is can be used to
-give the snippet navigation keymaps higher priority than keymaps from
-overlays created by other packages, like 'auto-complete'. See Github
-#828.
-
-** Fixed bugs
-
-*** Snippets having ${0:soon-to-be-deleted} with no other fields now
-correctly put the field 0 text in the active region after exiting.
-See Github #653.
-
-*** Fix undo of snippet insertion which also triggers indentation.
-See Github #821.
-
-*** Fixed a bug causing whitespace loss between mirrors.
-
-*** Fixed several bugs causing problems when combining Yasnippet with
-other modes and packages, like 'auto-fill-mode', 'c++-mode',
-'rust-mode', and 'lentic'.
-
-**** Fix another bug with auto-fill-mode.
-See Github #784, #794.
-
-**** Fix a bug in parsing of snippet fields for modes that use the
-'syntax-table' text property, 'c++-mode' is one example of this. See
-Github #815.
-
-**** 'syntax-propertize-function' is now restored before indenting the
-snippet. This improves compatibility with modes which rely on it for
-indentation, like 'rust-mode'. See Github #782, #818.
-
-**** Avoid trying to delete a snippet which is already deleted. This
-prevents an error when using 'rust-mode's 'rust-format-buffer'
-command.
-
-**** Ensure inhibit-modification-hooks is nil while modifying buffer.
-This fixes problems for packages relying on modification hooks, like
-'lentic'. See Github #756, #712.
-
-
-* 0.11.0 (Oct 26, 2016)
-** Changes and New Features
-
-*** Modifying buffer in backquoted expressions is deprecated!
-Backquoted expressions should only return a string that will be
-inserted. Snippets which modify the buffer as a side-effect will now
-trigger a warning.
-
-*** The verbosity levels for messages have been adjusted.
-While the default verbosity level was increased by 1 (it was only
-lower before due to a bug), several messages now only print at the
-level 4, so the overall effect should be less messages by default.
-
-*** Saving and loading snippets has been streamlined. Saving the
-snippet to a file will now automatically load it. Additionally, the
-buffer will be renamed from "*new snippet*" to whatever the snippet is
-named. See also Github #718, #733, and #734.
-
-*** `yas-escape-text' no longer signals an error when given nil.
-
-*** `yas-describe-tables' is split into simpler commands.
-**** `yas-describe-tables' takes a prefix arg to show non-active tables.
-**** New command `yas-describe-tables-by-namehash' shows table by namehash.
-
-*** Use the region contents as the snippet body of new snippets.
-
-*** The dependency on `cl' is removed.
-Yasnippet now only requires `cl-lib'.
-
-** Fixed Bugs
-
-*** Fix field navigation (tabbing) in the backwards direction.
-See Github #722
-
-*** Add support for deprecated yas/ symbols in `yas-define-menu'.
-It was left out by accident. This support is conditional on
-`yas-alias-to-yas/prefix-p', just like other obsolete yas/ bindings.
-
-*** Fix overriding of snippet by a new snippet with same uuid.
-See Github #714.
-
-*** Fix handling of snippets with 2 mirros on the same line.
-See Github #712.
-
-
-* 0.10.0 (June 11th, 2016)
-
-** Changes and New Features
-
-*** Yasnippet now prints far fewer message by default.
-See Github #682, #683.
-
-*** `yas-wrap-around-region' can be set to a register.
-The register's content will be used. This is like the old `cua'
-option, but can be used with any register and doesn't require enabling
-cua-mode.
-
-*** Clearing of snippet fields is now decided by the command's effect.
-The `delete-selection' property is no longer consulted. See Github #662.
-
-*** Empty lines in snippet expansion are no longer indented.
-See Github #679.
-
-*** All lines from mirror output are now indented.
-See Github #665.
-
-*** New variable yas-alias-to-yas/prefix-p
-See Github #696, #699.
-
-*** New function yas-next-field-will-exit-p
-See Github #561.
-
-*** `snippet-mode' is now autoloaded.
-
-** Fixed Bugs
-
-*** Fix incompatibility with Emacs 25 and haskell-mode.
-This should also help other modes with a non-nil syntax-propertize
-function. See Github #687.
-
-*** Text property changes no longer disable snippets.
-This prevents cc-mode based modes from causing premature exit of
-snippets. See Github #677.
-
-*** Fields are now transformed correctly after `yas-next-field'.
-See Github #381.
-
-*** The $> construct is now escaped correctly, and documented.
-See Github #640.
-
-*** Avoid corruption of snippet content when loading from files.
-See Github #707 and Emacs bug #23659.
-
-*** `yas-wrap-around-region' now works for snippets with fields
-farther down the buffer than $0. See Github #636.
-
-*** The active region is deleted when using `yas-expand'.
-This makes it consistent with `yas-insert-snippet'. See Github #523.
-
-*** Fix mirror+autofill interaction.
-See Github #643 and http://emacs.stackexchange.com/q/19206/5296.
-
-*** Snippet insertion no longer adds irrelevant strings to kill ring.
-See Github #675.
-
-
-* 0.9.1 (April 3rd, 2016)
-
-** Changes and New Features
-
-*** Noam Postavsky is now the official yasnippet maintainer.
-
-*** `yas-visit-snippet-file' now works for compiled snippets (see Github #597).
-
-*** New function `yas-lookup-snippet' (see Github #595, #596).
-
-*** .emacs.d/snippets directory is now created automatically.
-If that value is present in `yas-snippet-dirs' (see Github #648).
-
-*** Default value for `yas-snippet-dirs' now uses `user-emacs-directory'
-instead of hardcoding "~/emacs.d" (see Github #632).
-
-*** `yas-visit-snippet-file' no longer overrides `yas-prompt-functions',
-see Github #576.
-
-*** The defaults for prompting have changed.
-`yas-x-prompt' is no longer present in the default value of
-`yas-prompt-functions'.
-
-The new function `yas-maybe-ido-prompt' (which performs ido prompting
-if `ido-mode' is enabled) replaces `yas-ido-prompt' (which always
-performs ido prompting). Previously the behaviour was dependent on
-the Emacs version being used.
-
-*** The default value of `yas-buffer-local-condition' now works for
`yas-insert-snippet' too.
-See Github #305.
-
-*** The default value of `yas-new-snippet-default' no longer inserts
`require-final-newline: nil'.
-It was redundant, since `mode: snippet' already accomplishes the same.
-`binding: ${4:direct-keybinding}}' is also removed, as it is hardly
-ever wanted.
-
-*** Snippet fields are only cleared by commands with `delete-selection'
property,
-See Github #515, #644.
-
-*** `yas-initialize' (and backward compat alias `yas/initialize') are restored,
-but marked obsolete, use (yas-global-mode +1) instead. See Github
-#546, #569.
-
-*** `yas-key-syntaxes' is much more powerful and accepts functions.
-Enables use cases when discovering keys based on buffer syntax is not
-good enough. See issue #497.
-
-*** Documentation rewritten in org-mode and updated.
-A tremendous effort by Noam Postavsky. Hopefully easier to maintain
-and navigate. Available at <http://joaotavora.github.io/yasnippet>.
-
-*** Snippets are now maintained in their own repo.
-Snippets live in Andrea Crotti's
-<https://github.com/andreacrotti/yasnippet-snippets>. See README.md
-for more details.
-
-*** Textmate snippet importer moved to separate `yasmate' repo.
-URL is <https://github.com/joaotavora/yasmate>. See README.md for
-more details.
-
-*** `yas-snippet-dirs' now allows symbols as aliases to directories.
-The added level of indirection should allow more esoteric
-configurations (see Github #495).
-
-*** `yas-reload-all' can now jit-load when called interactively.
-
-*** New `yas-after-reload-hook' run after `yas-reload-all'.
-See <https://github.com/pezra/rspec-mode/pull/75> for the discussion
-leading up to this change.
-
-*** New functions `yas-activate-extra-mode' and `yas-deactivate-extra-mode'.
-These are preferable to setting `yas-extra-modes' directly in the mode
-hook (see issue #420 for more information).
-
-*** New variable `yas-new-snippet-default'.
-The default snippet suggested on `yas-new-snippet' can now be
-customized.
-
-** Fixed bugs
-
-*** `yas-expand' now sets `this-command' when falling back to another command.
-Previously it was setting `this-original-command', which does not
-match the documented semantics. See Github #587.
-
-*** Github #537: Be lenient to extensions operating on snippet fields.
-
-*** Github #619: Parents of extra modes are now activated too.
-
-*** Github #549: `yas-verbosity' is now applied to `load' calls too.
-
-*** Github #607; avoid obscure Emacs bug triggered by overlays in *Messages*
buffer.
-It was triggered by yasnippet+flycheck+highlight-parentheses. See
-also <http://debbugs.gnu.org/cgi/bugreport.cgi?bug=21824>
-
-*** Github #617; fix x prompt when snippet inserts many lines.
-
-*** Github #618; avoid breakage if `scan-sexp' modifies match data.
-Which it does in Emacs 25.
-
-*** Github #562: Deleting inner numberless snippet caused an error.
-
-*** Github #418, #536: Fix navigation to zero-length fields at snippet end.
-
-*** Github #527, #525 and #526: Attempt to prevent "fallback loops"
-when interactiing with other extensions that use similar fallback
-mechanisms.
-
-
-* 0.8.0 (August 2012)
-
-** Changes and New Features
-
-*** All YASnippet symbols now prefixed with `yas-'. Keep old `yas/' versions
as aliases.
-
-*** Yasnippet is now Free Software Foundation's copyright.
-
-*** `yas-dont-activate' can be a list of functions.
-
-*** Snippets are loaded just-in-time .
-Thanks to Matthew Fidler for a lot of input with the implementation.
-
-*** yasnippet-bundle.el is no longer available.
-Use `yas-compile-directory' instead if you need the speed advantage.
-
-*** New functions `yas-compile-directory' and `yas-recompile-all'.
-This feature is still undocumented. Generate a
-.yas-compiled-snippets.el file in the directory passed where snippets
-are compiled into emacs-lisp code.
-
-*** New `yas-verbosity' variable.
-
-*** Interactively calling `yas-exit-snippet' exits most recently inserted
snippet.
-
-*** Using filenames as snippet triggers is deprecated.
-
-*** Default value of `yas-show-menu-p' is `abbreviate'.
-
-*** `yas-visit-snippet' ignores `yas-prompt-functions'.
-
-*** `yas-buffer-local-condition' restricted to trigger-key expansions by
default.
-
-*** `yas-load-snippet-buffer' (`C-c C-c') in `snippet-mode' has been much
improved.
-
-*** New variable `yas-expand-only-for-last-commands', thanks Erik Postma.
-
-*** New variable `yas-extra-modes' aliases old `yas/mode-symbol'.
-
-*** New `yas-describe-tables' command.
-
-*** New `yas-define-condition-cache' macro.
-This defines an optimised function for placing in a `# condition:'
-directive that will run at most once per snippet-expansion attempt.
-
-*** Mirrors can occur inside fields.
-
-*** New `# type: command' directive.
-This feature is still largely undocumented.
-
-*** A hidden .yas-setup.el is loaded if found in a snippet directory.
-
-*** `yas-wrap-around-region' can now also be `cua' (undocumented feature).
-
-*** Make menu groups automatically using new .yas-make-groups file.
-
-*** Per-snippet keybindings using `# keybinding:' directive.
-
-*** More friendly `yas-expand-snippet' calling convention.
-This breaks backward compatibility.
-
-*** The `# env:' directive is now `# expand-env:'.
-
-*** Setup multiple parent modes using new .yas-parents file.
-
-** Fixed bugs
-
-*** Github #281: jit-load snippets in the correct order.
-
-*** Github #245: primary field transformations work inside nested fields.
-
-*** Github #242: stop using the deprecated `assoc' library.
-
-*** Github #233: show direct snippet keybindings in the menu.
-
-*** Github #194, Googlecode 192: Compatibility with `fci-mode'.
-
-*** Github #147, Googlecode 145: Snippets comments were getting inserted.
-
-*** Github #141, Googlecode 139: searching buffer in embedded elisp works
slightly better.
-Issue is still open for analysis, though
-
-*** Github #95, Googlecode 193: no more stack overflow in org-mode.
-
-
-----------------------------------------------------------------------
-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.
-
-
-Local variables:
-coding: utf-8
-mode: outline
-paragraph-separate: "[ ]*$"
-end:
diff --git a/packages/yasnippet/README b/packages/yasnippet/README
deleted file mode 100644
index 2dd107b..0000000
--- a/packages/yasnippet/README
+++ /dev/null
@@ -1,28 +0,0 @@
-YASnippet is a code template system for Emacs. To enable it in all
-buffers, add the following line to your init file:
-
- (yas-global-mode 1)
-
-Alternatively, you can enable `yas-minor-mode' in individual buffers.
-When YASnippet is active, the following commands can be used:
-
-TAB (`yas-expand')
- Attempt to expand a snippet before point. For example, typing TAB
- after `if' may expand a snippet beginning with `if', if one exists.
- If no snippet expansion is possible, run the usual binding of TAB.
-
-`C-c & C-s' (`yas-insert-snippet')
- Prompts for a snippet, and inserts it.
-
-`C-c & C-n' (`yas-new-snippet')
- Opens a *new snippet* buffer where you can define a new snippet.
- Typing C-c C-c in this buffer saves and invokes the definition.
- The variable `yas-snippet-dirs' determines where snippet
- definitions are stored.
-
-`C-c & C-v' (`yas-visit-snippet-file')
- Prompt for, and visit an existing snippet definition.
-
-For more information and detailed usage, refer to the project page:
-
- http://github.com/capitaomorte/yasnippet
diff --git a/packages/yasnippet/README.mdown b/packages/yasnippet/README.mdown
deleted file mode 100644
index b30d520..0000000
--- a/packages/yasnippet/README.mdown
+++ /dev/null
@@ -1,165 +0,0 @@
-[](https://travis-ci.org/joaotavora/yasnippet)
-
-# Intro
-
-**YASnippet** is a template system for Emacs. It allows you to
-type an abbreviation and automatically expand it into function
-templates. Bundled language templates include: C, C++, C#, Perl,
-Python, Ruby, SQL, LaTeX, HTML, CSS and more. The snippet syntax
-is inspired from [TextMate's][textmate-snippets] syntax, you can
-even [import](#import) most TextMate templates to
-YASnippet. Watch [a demo on YouTube][youtube-demo].
-
-[textmate-snippets]: http://manual.macromates.com/en/snippets
-[youtube-demo]: http://www.youtube.com/watch?v=ZCGmZK4V7Sg
-
-# Installation
-
-## Install the most recent version
-
-Clone this repository somewhere
-
- $ cd ~/.emacs.d/plugins
- $ git clone --recursive https://github.com/joaotavora/yasnippet
-
-Add the following in your `.emacs` file:
-
- (add-to-list 'load-path
- "~/.emacs.d/plugins/yasnippet")
- (require 'yasnippet)
- (yas-global-mode 1)
-
-Add your own snippets to `~/.emacs.d/snippets` by placing files there or
invoking `yas-new-snippet`.
-
-## Install with `package-install`
-
-In a recent emacs `M-x list-packages` is the recommended way to list and
install packages.
-[MELPA][melpa] keeps a very recent snapshot of YASnippet, see
http://melpa.org/#installing.
-
-## Install with el-get
-
-El-get is a nice way to get the most recent version, too. See
-https://github.com/dimitri/el-get for instructions.
-
-## Use `yas-minor-mode` on a per-buffer basis
-
-To use YASnippet as a non-global minor mode, don't call
-`yas-global-mode`; instead call `yas-reload-all` to load the snippet
-tables and then call `yas-minor-mode` from the hooks of major-modes
-where you want YASnippet enabled.
-
- (yas-reload-all)
- (add-hook 'prog-mode-hook #'yas-minor-mode)
-
-# Where are the snippets?
-
-<a name="import"></a>
-
-YASnippet no longer bundles snippets directly, but it's very easy to
-get some!
-
-1. [yasnippet-snippets] - a snippet collection package maintained by
- [AndreaCrotti](https://github.com/AndreaCrotti).
-
- It can be installed with `M-x package-install RET
- yasnippet-snippets` if you have added MELPA to your package
- sources.
-
-2. [yasmate] a tool which is dedicated to converting textmate bundles
- into yasnippet snippets.
-
- To use these snippets you have to run the tool first, so
- [see its doc][yasmate]), and then point the `yas-snippet-dirs`
- variable to the `.../yasmate/snippets` subdir.
-
- If you have a working ruby environment, you can probably get lucky
- directly with `rake convert-bundles`.
-
-3. [textmate-to-yas.el]
-
- This is another textmate bundle converting tool using Elisp
- instead of Ruby.
-
-Naturally, you can point `yas-snippet-dirs` to good snippet collections out
-there. If you have created snippets for a mode, or multiple modes,
-consider creating a repository to host them, then tell users that it
-should be added like this to `yas-snippet-dirs`:
-
- (setq yas-snippet-dirs
- '("~/.emacs.d/snippets" ;; personal snippets
- "/path/to/some/collection/" ;; foo-mode and bar-mode
snippet collection
- "/path/to/yasnippet/yasmate/snippets" ;; the yasmate collection
- ))
-
- (yas-global-mode 1) ;; or M-x yas-reload-all if you've started YASnippet
already.
-
-# Manual, issues etc
-
-There's comprehensive [documentation][docs] on using and customising
-YASnippet.
-
-There's a [list of support issues][support-issues], with solutions to
-common problems and practical snippet examples.
-
-The [Github issue tracker][issues] is where most YASnippet-related
-discussion happens. Nevertheless, since YASnippet is a part of Emacs,
-you may alternatively report bugs to the main Emacs bug list,
-bug-gnu-emacs@gnu.org, putting "yasnippet" somewhere in the subject.
-
-## Important note regarding bug reporting
-
-Your bug reports are very valuable.
-
-The most important thing when reporting bugs is making sure that we have
-a way to reproduce the problem exactly like it happened to you.
-
-To do this, we need to rule out interference from external factors
-like other Emacs extensions or your own customisations.
-
-Here's an example report that "sandboxes" an Emacs session just for
-reproducing a bug.
-
-```
-$ emacs --version
-Emacs 24.3
-$ cd /tmp/
-$ git clone https://github.com/joaotavora/yasnippet.git yasnippet-bug
-$ cd yasnippet-bug
-$ git log -1 --oneline
-6053db0 Closes #527: Unbreak case where yas-fallback-behaviour is a list
-$ HOME=$PWD emacs -L . # This "sandboxes" your emacs, melpa configuration, etc
-
-(require 'yasnippet)
-(yas-global-mode 1)
-
-When I open a foo-mode file I don't see foo-mode under the "YASnippet" menu!
-OR
-When loading yasnippet I see "Error: failed to frobnicate"!
-```
-
-Using `emacs -Q` or temporarily moving your `.emacs` init file to the side
-is another way to achieve good reproducibility.
-
-Here's a
-[another example](https://github.com/joaotavora/yasnippet/issues/318)
-of a bug report. It has everything needed for a successful analysis
-and speedy resolution.
-
-Also, don't forget to state the Emacs version (use `M-x emacs-version`) and
-the yasnippet version you are using (if using the latest from github,
-do `git log -1` in the dir).
-
-Any more info is welcome, but don't just paste a backtrace or an error
-message string you got, unless we ask for it.
-
-Finally, thank you very much for using YASnippet!
-
-[docs]: http://joaotavora.github.io/yasnippet/
-[issues]: https://github.com/joaotavora/yasnippet/issues
-[support-issues]:
https://github.com/joaotavora/yasnippet/issues?q=label%3Asupport
-[googlecode tracker]: http://code.google.com/p/yasnippet/issues/list
-[forum]: http://groups.google.com/group/smart-snippet
-[melpa]: http://melpa.milkbox.net/
-[yasmate]: http://github.com/joaotavora/yasmate
-[textmate-to-yas.el]: https://github.com/mattfidler/textmate-to-yas.el
-[yasnippet-snippets]: http://github.com/AndreaCrotti/yasnippet-snippets
diff --git a/packages/yasnippet/Rakefile b/packages/yasnippet/Rakefile
deleted file mode 100644
index c63d269..0000000
--- a/packages/yasnippet/Rakefile
+++ /dev/null
@@ -1,130 +0,0 @@
-# -*- Ruby -*-
-
-require 'fileutils'
-
-$EMACS = ENV["EMACS"]
-if not $EMACS or $EMACS == 't'
- $EMACS = "emacs"
-end
-
-def find_version
- File.read("yasnippet.el", :encoding => "UTF-8") =~ /;; Package-version:
*([0-9.]+?) *$/
- $version = $1
-end
-find_version
-FileUtils.mkdir_p('pkg')
-
-desc "run tests in batch mode"
-task :tests do
- sh "#{$EMACS} -Q -L . -l yasnippet-tests.el" +
- " --batch -f ert-run-tests-batch-and-exit"
-end
-
-desc "run test in interactive mode"
-task :itests do
- sh "#{$EMACS} -Q -L . -l yasnippet-tests.el" +
- " --eval \"(call-interactively 'ert)\""
-end
-
-desc "create a release package"
-task :package do
- release_dir = "pkg/yasnippet-#{$version}"
- FileUtils.mkdir_p(release_dir)
- files = ['snippets', 'yasnippet.el']
- FileUtils.cp_r files, release_dir
- File.open(File.join(release_dir,'yasnippet-pkg.el'), 'w') do |file|
- file.puts <<END
-(define-package "yasnippet"
- "#{$version}"
- "A template system for Emacs")
-END
- end
- sh "git clean -f snippets"
- FileUtils.cd 'pkg' do
- sh "tar cf yasnippet-#{$version}.tar yasnippet-#{$version}"
- end
-end
-
-desc "create a release package and upload it to google code"
-task :release => [:package, 'doc:archive'] do
- raise "Not implemented for github yet!"
-end
-
-# rake doc[../htmlize]
-#
-# To do this interactively, load doc/yas-doc-helper, open one of the
-# org files, and do `C-c C-e P'.
-desc "Generate document"
-task :doc, [:htmlize] do |t, args|
- load_path = '-L .'
- if args[:htmlize]
- load_path += " -L #{args[:htmlize]}"
- end
- sh "#{$EMACS} -Q #{load_path} --batch -l doc/yas-doc-helper.el" +
- " -f yas--generate-html-batch"
-end
-
-namespace :doc do
- task :archive do
- release_dir = "pkg/yasnippet-#{$version}"
- FileUtils.mkdir_p(release_dir)
- sh "tar cjf pkg/yasnippet-doc-#{$version}.tar.bz2 " +
- "--exclude=doc/.svn --exclude=doc/images/.svn doc/*.html doc/images"
- end
-
- task :upload do
- if File.exists? 'doc/gh-pages'
- Dir.chdir 'doc/gh-pages' do
- sh "git checkout gh-pages"
- end
- Dir.glob("doc/*.{html,css}").each do |file|
- FileUtils.cp file, 'doc/gh-pages'
- end
- Dir.glob("doc/images/*").each do |file|
- FileUtils.cp file, 'doc/gh-pages/images'
- end
- Dir.glob("doc/stylesheets/*.css").each do |file|
- FileUtils.cp file, 'doc/gh-pages/stylesheets'
- end
- curRev = `git describe`.chomp()
- expRev = IO.read('doc/html-revision').chomp()
- if curRev != expRev
- raise ("The HTML rev: #{expRev},\n" +
- "current rev: #{curRev}!\n")
- end
- Dir.chdir 'doc/gh-pages' do
- sh "git commit -a -m 'Automatic documentation update.\n\n" +
- "From #{curRev.chomp()}'"
- sh "git push"
- end
- end
- end
-end
-
-desc "Compile yasnippet.el into yasnippet.elc"
-
-rule '.elc' => '.el' do |t|
- cmdline = $EMACS + ' --batch -L .'
- if ENV['warnings']
- cmdline += " --eval \"(setq byte-compile-warnings #{ENV['warnings']})\""
- end
- if ENV['Werror']
- cmdline += " --eval \"(setq byte-compile-error-on-warn #{ENV['Werror']})\""
- end
- if ENV['Wlexical']
- cmdline += " --eval \"(setq byte-compile-force-lexical-warnings
#{ENV['Wlexical']})\""
- end
- cmdline +=" -f batch-byte-compile #{t.source}"
-
- sh cmdline
-end
-task :compile => FileList["yasnippet.el"].ext('elc')
-task :compile_all => FileList["*.el"].ext('elc')
-
-task :default => :doc
-
-desc "use yasmate to convert textmate bundles"
-task :convert_bundles do
- cd "yasmate"
- sh "rake convert_bundles"
- end
diff --git a/packages/yasnippet/doc/.nosearch b/packages/yasnippet/doc/.nosearch
deleted file mode 100644
index e69de29..0000000
diff --git a/packages/yasnippet/doc/faq.org b/packages/yasnippet/doc/faq.org
deleted file mode 100644
index 6cff4d8..0000000
--- a/packages/yasnippet/doc/faq.org
+++ /dev/null
@@ -1,87 +0,0 @@
-#+SETUPFILE: org-setup.inc
-
-#+TITLE: Frequently Asked Questions
-
-- *Note*: In addition to the questions and answers presented here,
- you might also with to visit the list of
[[https://github.com/joaotavora/yasnippet/issues?q=label%3Asupport][solved
support issues]] in
- the Github issue tracker. It might be more up-to-date than this
- list.
-
-* Why are my snippet abbrev keys triggering when I don't want them too?
-Expansion of abbrev keys is controlled by
[[sym:yas-key-syntaxes][=yas-key-syntaxes=]]. Try
-removing entries which correspond to the abbrev key character syntax.
-For example, if you have a snippet with abbrev key "bar", that you
-don't want to trigger when point follows the text =foo_bar=, remove
-the ="w"= entry (since "bar" has only word syntax characters).
-
-* Why aren't my snippet abbrev keys triggering when I want them too?
-See previous question, but in reverse.
-
-* Why is there an extra newline?
-
-If there is a newline at the end of a snippet definition file,
-YASnippet will add a newline when expanding that snippet. When editing
-or saving a snippet file, please be careful not to accidentally add a
-terminal newline.
-
-Note that some editors will automatically add a newline for you. In
-Emacs, if you set =require-final-newline= to =t=, it will add the
-final newline automatically.
-
-* Why doesn't TAB navigation work with flyspell
-
-This is [[https://debbugs.gnu.org/26672][Emacs Bug#26672]], so you should
upgrade to version 25.3 or
-better. Otherwise, a workaround is to inhibit flyspell overlays while
-the snippet is active:
-
-#+BEGIN_SRC emacs-lisp
- (add-hook 'flyspell-incorrect-hook
- #'(lambda (&rest _)
- (and yas-active-field-overlay
- (overlay-buffer yas-active-field-overlay))))
-#+END_SRC
-
-* How do I use alternative keys, i.e. not TAB?
-
-Edit the keymaps [[sym:yas-minor-mode-map][=yas-minor-mode-map=]] and
[[sym:yas-keymap][=yas-keymap=]] as you would
-any other keymap, but use
[[sym:yas-filtered-definition][=yas-filtered-definition=]] on the definition
-if you want to respect
[[sym:yas-keymap-disable-hook][=yas-keymap-disable-hook=]]:
-
-#+begin_src emacs-lisp :exports code
- (define-key yas-minor-mode-map (kbd "<tab>") nil)
- (define-key yas-minor-mode-map (kbd "TAB") nil)
- (define-key yas-minor-mode-map (kbd "<the new key>") yas-maybe-expand)
-
- ;;keys for navigation
- (define-key yas-keymap [(tab)] nil)
- (define-key yas-keymap (kbd "TAB") nil)
- (define-key yas-keymap [(shift tab)] nil)
- (define-key yas-keymap [backtab] nil)
- (define-key yas-keymap (kbd "<new-next-field-key>")
- (yas-filtered-definition 'yas-next-field-or-maybe-expand))
- (define-key yas-keymap (kbd "<new-prev-field-key>")
- (yas-filtered-definition 'yas-prev-field))
-#+end_src
-
-* How do I define an abbrev key containing characters not supported by the
filesystem?
-
-- *Note*: This question applies if you're still defining snippets
- whose key /is/ the filename. This is behavior still provided by
- version 0.6 for backward compatibilty, but is somewhat
- deprecated...
-
-For example, you want to define a snippet by the key =<= which is not a
-valid character for filename on Windows. This means you can't use the
-filename as a trigger key in this case.
-
-You should rather use the =# key:= directive to specify the key of the
-defined snippet explicitly and name your snippet with an arbitrary valid
-filename, =lt.YASnippet= for example, using =<= for the =# key:=
-directive:
-
-#+BEGIN_SRC snippet
- # key: <
- # name: <...></...>
- # --
- <${1:div}>$0</$1>
-#+END_SRC
diff --git a/packages/yasnippet/doc/images/bg-content-left.png
b/packages/yasnippet/doc/images/bg-content-left.png
deleted file mode 100644
index a64b346..0000000
Binary files a/packages/yasnippet/doc/images/bg-content-left.png and /dev/null
differ
diff --git a/packages/yasnippet/doc/images/bg-content-right.png
b/packages/yasnippet/doc/images/bg-content-right.png
deleted file mode 100644
index f07ebb5..0000000
Binary files a/packages/yasnippet/doc/images/bg-content-right.png and /dev/null
differ
diff --git a/packages/yasnippet/doc/images/bg-content.png
b/packages/yasnippet/doc/images/bg-content.png
deleted file mode 100644
index d55828e..0000000
Binary files a/packages/yasnippet/doc/images/bg-content.png and /dev/null differ
diff --git a/packages/yasnippet/doc/images/bg-navigation-item-hover.png
b/packages/yasnippet/doc/images/bg-navigation-item-hover.png
deleted file mode 100644
index c783d71..0000000
Binary files a/packages/yasnippet/doc/images/bg-navigation-item-hover.png and
/dev/null differ
diff --git a/packages/yasnippet/doc/images/bg-navigation-item.png
b/packages/yasnippet/doc/images/bg-navigation-item.png
deleted file mode 100644
index d2452ac..0000000
Binary files a/packages/yasnippet/doc/images/bg-navigation-item.png and
/dev/null differ
diff --git a/packages/yasnippet/doc/images/bg-navigation.png
b/packages/yasnippet/doc/images/bg-navigation.png
deleted file mode 100644
index 18b9559..0000000
Binary files a/packages/yasnippet/doc/images/bg-navigation.png and /dev/null
differ
diff --git a/packages/yasnippet/doc/images/body.png
b/packages/yasnippet/doc/images/body.png
deleted file mode 100644
index b361e7b..0000000
Binary files a/packages/yasnippet/doc/images/body.png and /dev/null differ
diff --git a/packages/yasnippet/doc/images/customization-group.png
b/packages/yasnippet/doc/images/customization-group.png
deleted file mode 100644
index b10827f..0000000
Binary files a/packages/yasnippet/doc/images/customization-group.png and
/dev/null differ
diff --git a/packages/yasnippet/doc/images/dropdown-menu.png
b/packages/yasnippet/doc/images/dropdown-menu.png
deleted file mode 100644
index 57d482e..0000000
Binary files a/packages/yasnippet/doc/images/dropdown-menu.png and /dev/null
differ
diff --git a/packages/yasnippet/doc/images/external.png
b/packages/yasnippet/doc/images/external.png
deleted file mode 100644
index 419c06f..0000000
Binary files a/packages/yasnippet/doc/images/external.png and /dev/null differ
diff --git a/packages/yasnippet/doc/images/ido-menu.png
b/packages/yasnippet/doc/images/ido-menu.png
deleted file mode 100644
index df392c5..0000000
Binary files a/packages/yasnippet/doc/images/ido-menu.png and /dev/null differ
diff --git a/packages/yasnippet/doc/images/menu-1.png
b/packages/yasnippet/doc/images/menu-1.png
deleted file mode 100644
index d2e6a51..0000000
Binary files a/packages/yasnippet/doc/images/menu-1.png and /dev/null differ
diff --git a/packages/yasnippet/doc/images/menu-2.png
b/packages/yasnippet/doc/images/menu-2.png
deleted file mode 100644
index abb8a72..0000000
Binary files a/packages/yasnippet/doc/images/menu-2.png and /dev/null differ
diff --git a/packages/yasnippet/doc/images/menu-groups.png
b/packages/yasnippet/doc/images/menu-groups.png
deleted file mode 100644
index fcedda8..0000000
Binary files a/packages/yasnippet/doc/images/menu-groups.png and /dev/null
differ
diff --git a/packages/yasnippet/doc/images/menu-parent.png
b/packages/yasnippet/doc/images/menu-parent.png
deleted file mode 100644
index f0fa10c..0000000
Binary files a/packages/yasnippet/doc/images/menu-parent.png and /dev/null
differ
diff --git a/packages/yasnippet/doc/images/minor-mode-indicator.png
b/packages/yasnippet/doc/images/minor-mode-indicator.png
deleted file mode 100644
index 3743455..0000000
Binary files a/packages/yasnippet/doc/images/minor-mode-indicator.png and
/dev/null differ
diff --git a/packages/yasnippet/doc/images/x-menu.png
b/packages/yasnippet/doc/images/x-menu.png
deleted file mode 100644
index 3bc9a15..0000000
Binary files a/packages/yasnippet/doc/images/x-menu.png and /dev/null differ
diff --git a/packages/yasnippet/doc/index.org b/packages/yasnippet/doc/index.org
deleted file mode 100644
index c5e0be3..0000000
--- a/packages/yasnippet/doc/index.org
+++ /dev/null
@@ -1,47 +0,0 @@
-#+SETUPFILE: org-setup.inc
-#+TITLE: Yet another snippet extension
-
-The YASnippet documentation has been split into separate parts:
-
-0. [[https://github.com/joaotavora/yasnippet/blob/master/README.mdown][README]]
-
- Contains an introduction, installation instructions and other important
- notes.
-
-1. [[file:snippet-organization.org][Organizing Snippets]]
-
- Describes ways to organize your snippets in the hard disk.
-
-2. [[file:snippet-expansion.org][Expanding Snippets]]
-
- Describes how YASnippet chooses snippets for expansion at point.
-
- Maybe, you'll want some snippets to be expanded in a particular mode,
- or only under certain conditions, or be prompted using =ido=, etc...
-
-3. [[file:snippet-development.org][Writing Snippets]]
-
- Describes the YASnippet definition syntax, which is very close (but
- not equivalent) to Textmate's. Includes a section about converting
- TextMate snippets.
-
-4. [[file:snippet-menu.org][The YASnippet menu]]
-
- Explains how to use the YASnippet menu to explore, learn and modify
- snippets.
-
-5. [[file:faq.org][Frequently asked questions]]
-
- Answers to frequently asked questions.
-
-6. [[file:snippet-reference.org][YASnippet Symbol Reference]]
-
- An automatically generated listing of all YASnippet commands,
- (customization) variables, and functions.
-
-
-# Local Variables:
-# mode: org
-# fill-column: 80
-# coding: utf-8
-# End:
diff --git a/packages/yasnippet/doc/nav-menu.html.inc
b/packages/yasnippet/doc/nav-menu.html.inc
deleted file mode 100644
index 3e74cf8..0000000
--- a/packages/yasnippet/doc/nav-menu.html.inc
+++ /dev/null
@@ -1,16 +0,0 @@
-<nav>
- <ul class="center">
- <li> <a href="index.html">Overview</a>
- <li> <a
href="https://github.com/joaotavora/yasnippet/blob/master/README.mdown";>
- Intro and Tutorial</a>
- <li class="center border">Snippet
- <ul class="nopad">
- <li> <a href="snippet-organization.html">Organization</a>
- <li> <a href="snippet-expansion.html">Expansion</a>
- <li> <a href="snippet-development.html">Development</a>
- <li> <a href="snippet-menu.html">Menu</a>
- </ul>
- <li> <a href="faq.html">FAQ</a>
- <li> <a href="snippet-reference.html">Reference</a>
- </ul>
-</nav>
diff --git a/packages/yasnippet/doc/org-setup.inc
b/packages/yasnippet/doc/org-setup.inc
deleted file mode 100644
index 60b9382..0000000
--- a/packages/yasnippet/doc/org-setup.inc
+++ /dev/null
@@ -1,11 +0,0 @@
-# -*- mode: org -*-
-
-#+STARTUP: showall
-
-#+LINK: sym file:snippet-reference.org::#%s
-
-#+OPTIONS: author:nil num:nil timestamp:nil
-#+AUTHOR:
-# org < 8.0 use +STYLE, after use +HTML_HEAD
-#+STYLE: <link rel="stylesheet" type="text/css" href="stylesheets/manual.css"
/>
-#+HTML_HEAD: <link rel="stylesheet" type="text/css"
href="stylesheets/manual.css" />
diff --git a/packages/yasnippet/doc/snippet-development.org
b/packages/yasnippet/doc/snippet-development.org
deleted file mode 100644
index 806f82e..0000000
--- a/packages/yasnippet/doc/snippet-development.org
+++ /dev/null
@@ -1,474 +0,0 @@
-#+SETUPFILE: org-setup.inc
-
-#+TITLE: Writing snippets
-
-* Snippet development
-
-** Quickly finding snippets
-
-There are some ways you can quickly find a snippet file or create a new one:
-
-- =M-x yas-new-snippet=, key binding: =C-c & C-n=
-
- Creates a new buffer with a template for making a new snippet. The
- buffer is in =snippet-mode= (see [[snippet-mode][below]]). When you are
done editing
- the new snippet, use [[yas-load-snippet-buffer-and-close][=C-c C-c=]] to
save it.
-
-- =M-x yas-visit-snippet-file=, key binding: =C-c & C-v=
-
- Prompts you for possible snippet expansions like
- [[sym:yas-insert-snippet][=yas-insert-snippet=]], but instead of expanding
it, takes you directly
- to the snippet definition's file, if it exists.
-
-Once you find this file it will be set to =snippet-mode= (see
[[snippet-mode][ahead]])
-and you can start editing your snippet.
-
-** Using the =snippet-mode= major mode <<snippet-mode>>
-
-There is a major mode =snippet-mode= to edit snippets. You can set the
-buffer to this mode with =M-x snippet-mode=. It provides reasonably
-useful syntax highlighting.
-
-Three commands are defined in this mode:
-
-- =M-x yas-load-snippet-buffer=, key binding: =C-c C-l=
-
- Prompts for a snippet table (with a default based on snippet's
- major mode) and loads the snippet currently being edited.
-
-- =M-x yas-load-snippet-buffer-and-close=, key binding: =C-c C-c=
- <<yas-load-snippet-buffer-and-close>>
-
- Like =yas-load-snippet-buffer=, but also saves the snippet and
- calls =quit-window=. The destination is decided based on the
- chosen snippet table and snippet collection directly (defaulting to
- the first directory in =yas-snippet-dirs= (see
[[file:snippet-organization.org][Organizing Snippets]]
- for more detail on how snippets are organized).
-
-- =M-x yas-tryout-snippet=, key binding: =C-c C-t=
-
- When editing a snippet, this opens a new empty buffer, sets it to
- the appropriate major mode and inserts the snippet there, so you
- can see what it looks like.
-
-There are also /snippets for writing snippets/: =vars=, =$f= and =$m=
-:-).
-
-* File content
-
-A file defining a snippet generally contains the template to be
-expanded.
-
-Optionally, if the file contains a line of =# --=, the lines above it
-count as comments, some of which can be /directives/ (or meta data).
-Snippet directives look like =# property: value= and tweak certain
-snippet properties described below. If no =# --= is found, the whole
-file is considered the snippet template.
-
-Here's a typical example:
-
-#+BEGIN_SRC snippet
- # contributor: pluskid <pluskid@gmail.com>
- # name: __...__
- # --
- __${init}__
-#+END_SRC
-
-Here's a list of currently supported directives:
-
-** =# key:= snippet abbrev
-
-This is the probably the most important directive, it's the
-abbreviation you type to expand a snippet just before hitting the key
-that runs [[sym:yas-expand][=yas-expand=]]. If you don't specify this,
-the snippet will not be expandable through the trigger mechanism.
-
-** =# name:= snippet name
-
-This is a one-line description of the snippet. It will be displayed in
-the menu. It's a good idea to select a descriptive name for a snippet --
-especially distinguishable among similar snippets.
-
-If you omit this name, it will default to the file name the snippet
-was loaded from.
-
-** =# condition:= snippet condition
-
-This is a piece of Emacs Lisp code. If a snippet has a condition, then
-it will only be expanded when the condition code evaluate to some
-non-nil value.
-
-See also [[sym:yas-buffer-local-condition][=yas-buffer-local-condition=]] in
-[[./snippet-expansion.org][Expanding snippets]]
-
-** =# group:= snippet menu grouping
-
-When expanding/visiting snippets from the menu-bar menu, snippets for a
-given mode can be grouped into sub-menus. This is useful if one has too
-many snippets for a mode which will make the menu too long.
-
-The =# group:= property only affect menu construction (See
-[[./snippet-menu.org][the YASnippet menu]]) and the same effect can be
-achieved by grouping snippets into sub-directories and using the
-=.yas-make-groups= special file (for this see
-[[./snippet-organization.org][Organizing Snippets]]
-
-Refer to the bundled snippets for =ruby-mode= for examples of the
-=# group:= directive. Group can also be nested, e.g.
-=control structure.loops= indicates that the snippet is under the =loops=
-group which is under the =control structure= group.
-
-** =# expand-env:= expand environment
-
-This is another piece of Emacs Lisp code in the form of a =let= /varlist
-form/, i.e. a list of lists assigning values to variables. It can be
-used to override variable values while the snippet is being expanded.
-
-Interesting variables to override are
[[sym:yas-wrap-around-region][=yas-wrap-around-region=]] and
-[[sym:yas-indent-line][=yas-indent-line=]] (see
[[./snippet-expansion.org][Expanding Snippets]]).
-
-As an example, you might normally have
[[sym:yas-indent-line][=yas-indent-line=]] set to '=auto=
-and [[sym:yas-wrap-around-region][=yas-wrap-around-region=]] set to =t=, but
for this particularly
-brilliant piece of ASCII art these values would mess up your hard work.
-You can then use:
-
-#+BEGIN_SRC snippet
- # name: ASCII home
- # expand-env: ((yas-indent-line 'fixed) (yas-wrap-around-region 'nil))
- # --
- welcome to my
- X humble
- / \ home,
- / \ $0
- / \
- /-------\
- | |
- | +-+ |
- | | | |
- +--+-+--+
-#+END_SRC
-
-** =# binding:= direct keybinding
-
-You can use this directive to expand a snippet directly from a normal
-Emacs keybinding. The keybinding will be registered in the Emacs keymap
-named after the major mode the snippet is active for.
-
-Additionally a variable [[sym:yas-prefix][=yas-prefix=]] is set to the prefix
argument
-you normally use for a command. This allows for small variations on the
-same snippet, for example in this =html-mode= snippet.
-
-#+BEGIN_SRC snippet
- # name: <p>...</p>
- # binding: C-c C-c C-m
- # --
- <p>`(when yas-prefix "\n")`$0`(when yas-prefix "\n")`</p>
-#+END_SRC
-
-This binding will be recorded in the keymap =html-mode-map=. To expand a
-paragraph tag newlines, just press =C-u C-c C-c C-m=. Omitting the =C-u=
-will expand the paragraph tag without newlines.
-
-** =# type:= =snippet= or =command=
-
-If the =type= directive is set to =command=, the body of the snippet
-is interpreted as Lisp code to be evaluated when the snippet is
-triggered.
-
-If it's =snippet= (the default when there is no =type= directive), the
-snippet body will be parsed according to the [[Template Syntax]],
-described below.
-
-** =# uuid:= unique identifier
-
-This provides to a way to identify a snippet, independent of its name.
-Loading a second snippet file with the same uuid would replace the
-previous snippet.
-
-** =# contributor:= snippet author
-
-This is optional and has no effect whatsoever on snippet functionality,
-but it looks nice.
-
-* Template Syntax
-
-The syntax of the snippet template is simple but powerful, very similar
-to TextMate's.
-
-** Plain Text
-
-Arbitrary text can be included as the content of a template. They are
-usually interpreted as plain text, except =$= and =`=. You need to
-use =\= to escape them: =\$= and =\`=. The =\= itself may also needed to be
-escaped as =\\= sometimes.
-
-** Embedded Emacs Lisp code
-
-Emacs Lisp code can be embedded inside the template, written inside
-back-quotes (=`=). The Lisp forms are evaluated when the snippet is
-being expanded. The evaluation is done in the same buffer as the
-snippet being expanded.
-
-Here's an example for =c-mode= to calculate the header file guard
-dynamically:
-
-#+BEGIN_SRC snippet
- #ifndef ${1:_`(upcase (file-name-nondirectory (file-name-sans-extension
(buffer-file-name))))`_H_}
- #define $1
-
- $0
-
- #endif /* $1 */
-#+END_SRC
-
-From version 0.6, snippet expansions are run with some special
-Emacs Lisp variables bound. One of these is
[[sym:yas-selected-text][=yas-selected-text=]]. You can
-therefore define a snippet like:
-
-#+BEGIN_SRC snippet
- for ($1;$2;$3) {
- `yas-selected-text`$0
- }
-#+END_SRC
-
-to "wrap" the selected region inside your recently inserted snippet.
-Alternatively, you can also customize the variable
-[[sym:yas-wrap-around-region][=yas-wrap-around-region=]] to =t= which will do
this automatically.
-
-*** Note: backquote expressions should not modify the buffer
-
-Please note that the Lisp forms in backquotes should *not* modify the
-buffer, doing so will trigger a warning. For example, instead of
-doing
-
-#+BEGIN_SRC snippet
- Timestamp: `(insert (current-time-string))`
-#+END_SRC
-
-do this:
-#+BEGIN_SRC snippet
- Timestamp: `(current-time-string)`
-#+END_SRC
-
-The warning may be suppressed with the following code in your init file:
-#+BEGIN_SRC emacs-lisp
- (add-to-list 'warning-suppress-types '(yasnippet backquote-change))
-#+END_SRC
-
-
-** Tab stop fields
-
-Tab stops are fields that you can navigate back and forth by =TAB= and
-=S-TAB=. They are written by =$= followed with a number. =$0= has the
-special meaning of the /exit point/ of a snippet. That is the last place
-to go when you've traveled all the fields. Here's a typical example:
-
-#+BEGIN_SRC snippet
- <div$1>
- $0
- </div>
-#+END_SRC
-** Placeholder fields
-
-Tab stops can have default values -- a.k.a placeholders. The syntax is
-like this:
-
-#+BEGIN_SRC snippet
- ${N:default value}
-#+END_SRC
-
-They act as the default value for a tab stop. But when you first
-type at a tab stop, the default value will be replaced by your typing.
-The number can be omitted if you don't want to create
[[mirrors-fields][mirrors]] or
-[[mirror-transformations][transformations]] for this field.
-
-** Mirrors <<mirrors-fields>>
-
-We refer to tab stops with placeholders as a /field/. A field can
-have mirrors. *All* mirrors get updated whenever you update any field
-text. Here's an example:
-
-#+BEGIN_SRC snippet
- \begin{${1:enumerate}}
- $0
- \end{$1}
-#+END_SRC
-
-When you type "document" at =${1:enumerate}=, the word "document" will
-also be inserted at =\end{$1}=. The best explanation is to see the
-screencast([[http://www.youtube.com/watch?v=vOj7btx3ATg][YouTube]] or
[[http://yasnippet.googlecode.com/files/yasnippet.avi][avi video]]).
-
-The tab stops with the same number to the field act as its mirrors. If
-none of the tab stops have an initial value, the first one is selected as
-the field and the others are its mirrors.
-
-** Mirrors with transformations <<mirror-transformations>>
-
-If the value of an =${n:=-construct starts with and contains =$(=,
-then it is interpreted as a mirror for field =n= with a
-transformation. The mirror's text content is calculated according to
-this transformation, which is Emacs Lisp code that gets evaluated in
-an environment where the variable [[sym:yas-text][=yas-text=]] is bound to the
text
-content (string) contained in the field =n=. Here's an example for
-Objective-C:
-
-#+BEGIN_SRC snippet
- - (${1:id})${2:foo}
- {
- return $2;
- }
-
- - (void)set${2:$(capitalize yas-text)}:($1)aValue
- {
- [$2 autorelease];
- $2 = [aValue retain];
- }
- $0
-#+END_SRC
-
-Look at =${2:$(capitalize yas-text)}=, it is a mirror with
-transformation instead of a field. The actual field is at the first
-line: =${2:foo}=. When you type text in =${2:foo}=, the transformation
-will be evaluated and the result will be placed there as the
-transformed text. So in this example, if you type "baz" in the field,
-the transformed text will be "Baz". This example is also available in
-the screencast.
-
-Another example is for =rst-mode=. In reStructuredText, the document
-title can be some text surrounded by "===" below and above. The "==="
-should be at least as long as the text. So
-
-#+BEGIN_SRC rst
- =====
- Title
- =====
-#+END_SRC
-
-is a valid title but
-
-#+BEGIN_SRC rst
- ===
- Title
- ===
-#+END_SRC
-
-is not. Here's an snippet for rst title:
-
-#+BEGIN_SRC snippet
- ${1:$(make-string (string-width yas-text) ?\=)}
- ${1:Title}
- ${1:$(make-string (string-width yas-text) ?\=)}
-
- $0
-#+END_SRC
-
-Note that a mirror with a transform is not restricted to the text of
-the field it is mirroring. By making use of
[[sym:yas-field-value][=yas-field-value=]], a
-mirror can look at any of the snippet's field (as mentioned above, all
-mirrors are updated when any field is updated). Here is an example
-which shows a "live" result of calling format:
-
-#+BEGIN_SRC snippet
-(format "${1:formatted %s}" "${2:value}")
-=> "${1:$(ignore-errors (format (yas-field-value 1) (yas-field-value 2)))}"
-#+END_SRC
-
-To keep the example simple, it uses =ignore-errors= to suppress errors
-due to incomplete format codes.
-
-** Fields with transformations
-
-From version 0.6 on, you can also have Lisp transformation inside
-fields. These work mostly like mirror transformations. However, they
-are evaluated when you first enter the field, after each change you
-make to the field and also just before you exit the field.
-
-The syntax is also a tiny bit different, so that the parser can
-distinguish between fields and mirrors. In the following example
-
-: #define "${1:mydefine$(upcase yas-text)}"
-
-=mydefine= gets automatically upcased to =MYDEFINE= once you enter the
-field. As you type text, it gets filtered through the transformation
-every time.
-
-Note that to tell this kind of expression from a mirror with a
-transformation, YASnippet needs extra text between the =:= and the
-transformation's =$=. If you don't want this extra-text, you can use two
-=$='s instead.
-
-: #define "${1:$$(upcase yas-text)}"
-
-Please note that as soon as a transformation takes place, it changes the
-value of the field and sets it its internal modification state to
-=true=. As a consequence, the auto-deletion behaviour of normal fields
-does not take place. This is by design.
-
-** Choosing fields value from a list and other tricks
-
-As mentioned, the field transformation is invoked just after you enter
-the field, and with some useful variables bound, notably
-[[sym:yas-modified-p][=yas-modified-p=]] and
[[sym:yas-moving-away-p][=yas-moving-away-p=]]. Because of this feature you
-can place a transformation in the primary field that lets you select
-default values for it.
-
-For example, the [[sym:yas-choose-value][=yas-completing-read=]] function is
version of
-=completing-read= which checks these variables. For example, asking
-the user for the initial value of a field:
-
-#+BEGIN_SRC snippet
- <div align="${2:$$(yas-completing-read "Alignment? " '("right" "center"
"left"))}">
- $0
- </div>
-#+END_SRC
-
-See the definition of [[sym:yas-choose-value][=yas-completing-read=]] to see
how it was written
-using the two variables. If you're really lazy :) and can't spare a
-tab keypress, you can automatically move to the next field (or exit)
-after choosing the value with [[sym:yas-auto-next][=yas-auto-next=]]. The
snippet above
-becomes:
-
-#+BEGIN_SRC snippet
- <div align="${2:$$(yas-auto-next
- (yas-completing-read
- "Alignment? "
- '("right" "center" "left")))}">
- $0
- </div>
-#+END_SRC
-
-Here's another use, for =LaTeX-mode=, which calls reftex-label just as you
-enter snippet field 2. This one makes use of
[[sym:yas-modified-p][=yas-modified-p=]] directly.
-
-#+BEGIN_SRC snippet
- \section{${1:"Titel der Tour"}}%
- \index{$1}%
- \label{{2:"waiting for reftex-label call..."$(unless yas-modified-p
(reftex-label nil 'dont-insert))}}%
-#+END_SRC
-
-The function [[sym:yas-verify-value][=yas-verify-value=]] has another neat
trick, and makes use
-of [[sym:yas-moving-away-p][=yas-moving-away-p=]]. Try it and see! Also, check
out this
[[http://groups.google.com/group/smart-snippet/browse_thread/thread/282a90a118e1b662][thread]]
-
-** Nested placeholder fields
-
-From version 0.6 on, you can also have nested placeholders of the type:
-
-#+BEGIN_SRC snippet
- <div${1: id="${2:some_id}"}>$0</div>
-#+END_SRC
-
-This allows you to choose if you want to give this =div= an =id=
-attribute. If you tab forward after expanding, it will let you change
-"some\_id" to whatever you like. Alternatively, you can just press =C-d=
-(which executes
[[sym:yas-skip-and-clear-or-delete-char][=yas-skip-and-clear-or-delete-char=]])
and go straight to
-the exit marker.
-
-By the way, =C-d= will only clear the field if you cursor is at the
-beginning of the field /and/ it hasn't been changed yet. Otherwise, it
-performs the normal Emacs =delete-char= command.
-
-** Indentation markers
-
-If [[sym:yas-indent-line][=yas-indent-line=]] is *not* set to '=auto=, it's
still possible to
-indent specific lines by adding an indentation marker, =$>=, somewhere
-on the line.
diff --git a/packages/yasnippet/doc/snippet-expansion.org
b/packages/yasnippet/doc/snippet-expansion.org
deleted file mode 100644
index 0a00981..0000000
--- a/packages/yasnippet/doc/snippet-expansion.org
+++ /dev/null
@@ -1,283 +0,0 @@
-#+SETUPFILE: org-setup.inc
-
-#+TITLE: Expanding snippets
-
- This section describes how YASnippet chooses snippets for expansion at point.
-
- Maybe, you'll want some snippets to be expanded in a particular
- mode, or only under certain conditions, or be prompted using
-
-* Triggering expansion
-
- You can use YASnippet to expand snippets in different ways:
-
- - When [[sym:yas-minor-mode][=yas-minor-mode=]] is active:
- - Type the snippet's *trigger key* then calling
[[sym:yas-expand][=yas-expand=]]
- (bound to =TAB= by default).
-
- - Use the snippet's *keybinding*.
-
- - By expanding directly from the "YASnippet" menu in the menu-bar
-
- - Using hippie-expand
-
- - Call [[sym:yas-insert-snippet][=yas-insert-snippet=]] (use =M-x
yas-insert-snippet= or its
- keybinding =C-c & C-s=).
-
- - Use m2m's excellent auto-complete
- TODO: example for this
-
- - Expanding from emacs-lisp code
-
-** Trigger key
-
-[[sym:yas-expand][=yas-expand=]] tries to expand a /snippet abbrev/ (also
known as
-/snippet key/) before point. YASnippet also provides a /conditional
-binding/ for this command: the variable [[sym:yas-expand][=yas-maybe-expand=]]
contains a
-special value which, when bound in a keymap, tells Emacs to call
-[[sym:yas-expand][=yas-expand=]] if and only if there is a snippet abbrev
before point.
-If there is no snippet to expand, Emacs will behave as if
[[sym:yas-expand][=yas-expand=]]
-is unbound and so will run whatever command is bound to that key
-normally.
-
-When [[sym:yas-minor-mode][=yas-minor-mode=]] is enabled, it binds
[[sym:yas-maybe-expand][=yas-maybe-expand=]] to =TAB=
-and =<tab>= by default, however, you can freely remove those bindings:
-
-#+begin_src emacs-lisp :exports code
- (define-key yas-minor-mode-map (kbd "<tab>") nil)
- (define-key yas-minor-mode-map (kbd "TAB") nil)
-#+end_src
-
-And set your own:
-
-#+begin_src emacs-lisp :exports code
- ;; Bind `SPC' to `yas-expand' when snippet expansion available (it
- ;; will still call `self-insert-command' otherwise).
- (define-key yas-minor-mode-map (kbd "SPC") yas-maybe-expand)
- ;; Bind `C-c y' to `yas-expand' ONLY.
- (define-key yas-minor-mode-map (kbd "C-c y") #'yas-expand)
-#+end_src
-
-
-To enable the YASnippet minor mode in all buffers globally use the
-command [[sym:yas-global-mode][=yas-global-mode=]]. This will enable a
modeline indicator,
-=yas=:
-
-[[./images/minor-mode-indicator.png]]
-
-When you use [[sym:yas-global-mode][=yas-global-mode=]] you can also
selectively disable
-YASnippet in some buffers by calling [[sym:yas-minor-mode][=yas-minor-mode=]]
with a negative
-argument in the buffer's mode hook.
-
-*** Fallback behaviour
-
-YASnippet used to support a more complicated way of sharing
-keybindings before [[sym:yas-expand][=yas-maybe-expand=]] was added. This is
now
-obsolete.
-
-** Insert at point
-
-The command [[sym:yas-insert-snippet][=yas-insert-snippet=]] lets you insert
snippets at point
-/for your current major mode/. It prompts you for the snippet key
-first, and then for a snippet template if more than one template
-exists for the same key.
-
-The list presented contains the snippets that can be inserted at point,
-according to the condition system. If you want to see all applicable
-snippets for the major mode, prefix this command with =C-u=.
-
-The prompting methods used are again controlled by
-[[sym:yas-prompt-functions][=yas-prompt-functions=]].
-
-*** Inserting region or register contents into snippet
-
-It's often useful to inject already written text in the middle of a
-snippet. The variable
[[sym:yas-wrap-around-region][=yas-wrap-around-region=]] when to t substitute
-the region contents into the =$0= placeholder of a snippet expanded by
-[[sym:yas-insert-snippet][=yas-insert-snippet=]]. Setting it to a character
value (e.g. =?0=)
-will insert the contents of corresponding register.
-
-Older (versions 0.9.1 and below) of Yasnippet, supported a setting of
-=cua= that is equivalent to =?0= but only worked with =cua-mode=
-turned on. This setting is still supported for backwards
-compatibility, but is now entirely equivalent to =?0=.
-
-** Snippet keybinding
-
-See the section of the =# binding:= directive in
-[[./snippet-development.org][Writing Snippets]].
-
-** Expanding from the menu
-
-See [[./snippet-menu.org][the YASnippet Menu]].
-
-** Expanding with =hippie-expand=
-
-To integrate with =hippie-expand=, just put
-[[sym:yas-hippie-try-expand][=yas-hippie-try-expand=]] in
-=hippie-expand-try-functions-list=. This probably makes more sense
-when placed at the top of the list, but it can be put anywhere you
-prefer.
-
-** Expanding from emacs-lisp code
-
-Sometimes you might want to expand a snippet directly from your own
-elisp code. You should call [[sym:yas-expand-snippet][=yas-expand-snippet=]]
instead of
-[[sym:yas-expand][=yas-expand=]] in this case.
[[sym:yas-expand-snippet][=yas-expand-snippet=]] takes a string in
-snippet template syntax, if you want to expand an existing snippet you
-can use [[sym:yas-lookup-snippet][=yas-lookup-snippet=]] to find its contents
by name.
-
-As with expanding from the menubar, the condition system and multiple
-candidates doesn't affect expansion (the condition system does affect
-[[sym:yas-lookup-snippet][=yas-lookup-snippet=]] though). In fact, expanding
from the YASnippet
-menu has the same effect of evaluating the follow code:
-
-#+BEGIN_SRC emacs-lisp
- (yas-expand-snippet template)
-#+END_SRC
-
-See the internal documentation on
[[sym:yas-expand-snippet][=yas-expand-snippet=]] and
-[[sym:yas-lookup-snippet][=yas-lookup-snippet=]] for more information.
-
-* Controlling expansion
-
-** Eligible snippets
-
-YASnippet does quite a bit of filtering to find out which snippets are
-eligible for expanding at the current cursor position.
-
-In particular, the following things matter:
-
-- Currently loaded snippets tables
-
- These are loaded from a directory hierarchy in your file system. See
- [[./snippet-organization.org][Organizing Snippets]]. They are named
- after major modes like =html-mode=, =ruby-mode=, etc...
-
-- Major mode of the current buffer
-
- If the currrent major mode matches one of the loaded snippet tables,
- then all that table's snippets are considered for expansion. Use
- =M-x describe-variable RET major-mode RET= to find out which major
- mode you are in currently.
-
-- Parent tables
-
- Snippet tables defined as the parent of some other eligible table
- are also considered. This works recursively, i.e., parents of
- parents of eligible tables are also considered. As a special case,
- if a mode doesn't have a parent, then =fundamental-mode= is
- considered to be its parent.
-
-- Buffer-local list of extra modes
-
- Use [[sym:yas-activate-extra-mode][=yas-activate-extra-mode=]] to
- consider snippet tables whose name does not correspond to a major
- mode. Typically, you call this from a minor mode hook, for example:
-
-#+BEGIN_SRC emacs-lisp
- ;; When entering rinari-minor-mode, consider also the snippets in the
- ;; snippet table "rails-mode"
- (add-hook 'rinari-minor-mode-hook
- #'(lambda ()
- (yas-activate-extra-mode 'rails-mode)))
-#+END_SRC
-
-- Buffer-local
[[sym:yas-buffer-local-condition][=yas-buffer-local-condition=]] variable
-
- This variable provides finer grained control over what snippets can
- be expanded in the current buffer. For example, the constant
-
[[sym:yas-not-string-or-comment-condition][=yas-not-string-or-comment-condition=]]
has a value that disables
- snippet expansion inside comments or string literals. See
[[condition-system][the
- condition system]] for more info.
-
-** The condition system <<condition-system>>
-
-Consider this scenario: you are an old Emacs hacker. You like the
-abbrev-way and bind [[sym:yas-expand][=yas-expand=]] to =SPC=. However, you
don't want
-=if= to be expanded as a snippet when you are typing in a comment
-block or a string (e.g. in =python-mode=).
-
-If you use the =# condition := directive (see
[[./snippet-development.org][Writing Snippets]]) you
-could just specify the condition for =if= to be =(not
-(python-syntax-comment-or-string-p))=. But how about =while=, =for=,
-etc? Writing the same condition for all the snippets is just boring.
-So you can instead set
[[sym:yas-buffer-local-condition][=yas-buffer-local-condition=]] to =(not
-(python-syntax-comment-or-string-p))= in =python-mode-hook=.
-
-Then, what if you really want some particular snippet to expand even
-inside a comment? Set
[[sym:yas-buffer-local-condition][=yas-buffer-local-condition=]] like this
-
-#+BEGIN_SRC emacs-lisp
- (add-hook 'python-mode-hook
- (lambda ()
- (setq yas-buffer-local-condition
- '(if (python-syntax-comment-or-string-p)
- '(require-snippet-condition . force-in-comment)
- t))))
-#+END_SRC
-
-... and for a snippet that you want to expand in comments, specify a
-condition which evaluates to the symbol =force-in-comment=. Then it
-can be expanded as you expected, while other snippets like =if= still
-can't expanded in comments.
-
-For the full set of possible conditions, see the documentation for
-[[sym:yas-buffer-local-condition][=yas-buffer-local-condition=]].
-
-** Multiples snippet with the same key
-
-The rules outlined [[Eligible%20snippets][above]] can return more than
-one snippet to be expanded at point.
-
-When there are multiple candidates, YASnippet will let you select one.
-The UI for selecting multiple candidate can be customized through
-[[sym:yas-prompt-functions][=yas-prompt-functions=]] , which defines your
preferred methods of being
-prompted for snippets.
-
-You can customize it with
-=M-x customize-variable RET yas-prompt-functions RET=. Alternatively you
-can put in your emacs-file:
-
-#+BEGIN_SRC emacs-lisp
- (setq yas-prompt-functions '(yas-x-prompt yas-dropdown-prompt))
-#+END_SRC
-
-Currently there are some alternatives solution with YASnippet.
-
-*** Use the X window system
-
-[[./images/x-menu.png]]
-
-The function [[sym:yas-x-prompt][=yas-x-prompt=]] can be used to show a popup
menu for you to
-select. This menu will be part of you native window system widget, which
-means:
-
-- It usually looks beautiful. E.g. when you compile Emacs with gtk
- support, this menu will be rendered with your gtk theme.
-- Your window system may or may not allow to you use =C-n=, =C-p= to
- navigate this menu.
-- This function can't be used when in a terminal.
-
-*** Minibuffer prompting
-
-[[./images/ido-menu.png]]
-
-You can use functions [[sym:yas-completing-prompt][=yas-completing-prompt=]]
for the classic emacs
-completion method or [[sym:yas-ido-prompt][=yas-ido-prompt=]] for a much nicer
looking method.
-The best way is to try it. This works in a terminal.
-
-*** Use =dropdown-menu.el=
-
-[[./images/dropdown-menu.png]]
-
-The function [[sym:yas-dropdown-prompt][=yas-dropdown-prompt=]] can also be
placed in the
-[[sym:yas-prompt-functions][=yas-prompt-functions=]] list.
-
-This works in both window system and terminal and is customizable, you
-can use =C-n=, =C-p= to navigate, =q= to quit and even press =6= as a
-shortcut to select the 6th candidate.
-
-*** Roll your own
-
-See the documentation on variable
[[sym:yas-prompt-functions][=yas-prompt-functions=]]
diff --git a/packages/yasnippet/doc/snippet-menu.org
b/packages/yasnippet/doc/snippet-menu.org
deleted file mode 100644
index fee3a19..0000000
--- a/packages/yasnippet/doc/snippet-menu.org
+++ /dev/null
@@ -1,68 +0,0 @@
-#+SETUPFILE: org-setup.inc
-
-#+TITLE: YASnippet menu
-
-When [[sym:yas-minor-mode][=yas-minor-mode=]] is active, YASnippet will setup
a menu just after
-the "Buffers" menu in the menubar.
-
-In this menu, you can find
-
-- The currently loaded snippet definitions, organized by major mode,
- and optional grouping.
-
-- A rundown of the most common commands, (followed by their
- keybindings) including commands to load directories and reload all
- snippet definitions.
-
-- A series of submenus for customizing and exploring YASnippet
- behavior.
-
-[[./images/menu-1.png]]
-
-* Loading snippets from menu
-
-Invoking "Load snippets..." from the menu invokes
[[sym:yas-load-directory][=yas-load-directory=]]
-and prompts you for a snippet directory hierarchy to load.
-
-Also useful is the "Reload everything" item to invoke
[[sym:yas-reload-all][=yas-reload-all=]]
-which uncondionally reloads all the snippets directories defined in
-[[sym:yas-snippet-dirs][=yas-snippet-dirs=]] and rebuilds the menus.
-
-* Snippet menu behavior
-
-YASnippet will list in this section all the loaded snippet definitions
-organized by snippet table name.
-
-You can use this section to explore currently loaded snippets. If you
-click on one of them, the default behavior is to expand it,
-unconditionally, inside the current buffer.
-
-You can however, customize variable
[[sym:yas-visit-from-menu][=yas-visit-from-menu=]] to be =t=
-which will take you to the snippet definition file when you select it
-from the menu.
-
-If you want the menu show only snippet tables whose name corresponds to
-a "real" major mode. You do this by setting
[[sym:yas-use-menu][=yas-use-menu=]] to
-'=real-modes=.
-
-Finally, to have the menu show only the tables for the currently active
-mode, set [[sym:yas-use-menu][=yas-use-menu=]] to =abbreviate=.
-
-These customizations can also be found in the menu itself, under the
-"Snippet menu behavior" submenu.
-
-* Controlling indenting
-
-The "Indenting" submenu contains options to control the values of
-[[sym:yas-indent-line][=yas-indent-line=]] and
[[sym:yas-also-auto-indent-first-line][=yas-also-auto-indent-first-line=]]. See
-[[./snippet-development.org][Writing snippets]].
-
-* Prompting method
-
-The "Prompting method" submenu contains options to control the value of
-[[sym:yas-prompt-functions][=yas-prompt-functions=]]. See
[[./snippet-expansion.org][Expanding snippets]].
-
-* Misc
-
-The "Misc" submenu contains options to control the values of more
-variables.
diff --git a/packages/yasnippet/doc/snippet-organization.org
b/packages/yasnippet/doc/snippet-organization.org
deleted file mode 100644
index 6b8feef..0000000
--- a/packages/yasnippet/doc/snippet-organization.org
+++ /dev/null
@@ -1,132 +0,0 @@
-#+SETUPFILE: org-setup.inc
-
-#+TITLE: Organizing snippets
-
-* Basic structure
-
- Snippet collections can be stored in plain text files. They are
- arranged by sub-directories naming *snippet tables*. These mostly
- name Emacs major mode names.
-
- #+begin_example
- .
- |-- c-mode
- | `-- printf
- |-- java-mode
- | `-- println
- `-- text-mode
- |-- email
- `-- time
- #+end_example
-
- The collections are loaded into *snippet tables* which the
- triggering mechanism (see [[file:snippet-expansion.org][Expanding
Snippets]]) looks up and
- (hopefully) causes the right snippet to be expanded for you.
-
-* Setting up =yas-snippet-dirs=
-
- The emacs variable [[sym:yas-snippet-dirs][=yas-snippet-dirs=]] tells
YASnippet
- which collections to consider. It's used when you activate
- [[sym:yas-global-mode][=yas-global-mode=]] or call
- [[sym:yas-reload-all][=yas-reload-all=]] interactively.
-
- The default considers:
-
- - a personal collection that lives in =~/.emacs.d/snippets=
- - the bundled collection, taken as a relative path to =yasnippet.el=
location
-
- When you come across other snippet collections, do the following to try them
- out:
-
- #+begin_src emacs-lisp :exports code
- ;; Develop in ~/emacs.d/mysnippets, but also
- ;; try out snippets in ~/Downloads/interesting-snippets
- (setq yas-snippet-dirs '("~/emacs.d/mysnippets"
- "~/Downloads/interesting-snippets"))
-
- ;; OR, keeping YASnippet defaults try out ~/Downloads/interesting-snippets
- (setq yas-snippet-dirs (append yas-snippet-dirs
- '("~/Downloads/interesting-snippets")))
- #+end_src
-
- Collections appearing earlier in the list override snippets with same names
- appearing in collections later in the list.
[[sym:yas-new-snippet][=yas-new-snippet=]] always stores
- snippets in the first collection.
-
-* The =.yas-parents= file
-
- It's very useful to have certain modes share snippets between
- themselves. To do this, choose a mode subdirectory and place a
- =.yas-parents= containing a whitespace-separated list of other mode
- names. When you reload those modes become parents of the original
- mode.
-
- #+begin_example
- .
- |-- c-mode
- | |-- .yas-parents # contains "cc-mode text-mode"
- | `-- printf
- |-- cc-mode
- | |-- for
- | `-- while
- |-- java-mode
- | |-- .yas-parents # contains "cc-mode text-mode"
- | `-- println
- `-- text-mode
- |-- email
- `-- time
- #+end_example
-
-
-* TODO The =.yas-make-groups= file
-
- If you place an empty plain text file =.yas-make-groups= inside one
- of the mode directories, the names of these sub-directories are
- considered groups of snippets and [[file:snippet-menu.org][the menu]] is
organized much more
- cleanly:
-
- [[./images/menu-groups.png]]
-
- Another way to achieve this is to place a =# group:= directive
- inside the snippet definition. See [[./snippet-development.org][Writing
Snippets]].
-
- #+begin_example
- $ tree ruby-mode/
- ruby-mode/
- |-- .yas-make-groups
- |-- collections
- | |-- each
- | `-- ...
- |-- control structure
- | |-- forin
- | `-- ...
- |-- definitions
- | `-- ...
- `-- general
- `-- ...
- #+end_example
-
- Yet another way to create a nice snippet menu is to write into
- =.yas-make-groups= a menu definition. TODO
-
-* The =.yas-setup.el= file
-
- If there is file named =.yas-setup.el= in a mode's snippet
- subdirectory, it is loaded along with the snippets. Utility
- functions used by the snippets can be put here.
-
-* The =.yas-compiled-snippet.el= file
-
- You may compile a top-level snippet directory with the
- =yas-compile-directory= function, which will create a
- =.yas-compiled-snippets.el= file under each mode subdirectory,
- which contains definitions for all snippets in the subdirectory.
- Compilation helps improve loading time.
-
- Alternatively, you may compile all directories in the list
- =yas-snippet-dirs= with the =yas-recompile-all= function.
-
-* The =.yas-skip= file
-
- A =.yas-skip= file in a mode's snippet subdirectory tells YASnippet
- not to load snippets from there.
diff --git a/packages/yasnippet/doc/snippet-reference.org
b/packages/yasnippet/doc/snippet-reference.org
deleted file mode 100644
index a38fca5..0000000
--- a/packages/yasnippet/doc/snippet-reference.org
+++ /dev/null
@@ -1,12 +0,0 @@
-#+SETUPFILE: org-setup.inc
-
-#+TITLE: Reference
-
-#+BEGIN_SRC emacs-lisp :exports results :results value raw
-(yas--document-symbols 1 `("Interactive functions" . ,#'interactive-form)
- `("Customization variables" . ,#'(lambda (sym)
- (and (boundp sym)
- (get sym
'standard-value))))
- `("Useful functions" . ,#'fboundp)
- `("Useful variables" . ,#'boundp))
-#+END_SRC
diff --git a/packages/yasnippet/doc/stylesheets/manual.css
b/packages/yasnippet/doc/stylesheets/manual.css
deleted file mode 100644
index 74bfe16..0000000
--- a/packages/yasnippet/doc/stylesheets/manual.css
+++ /dev/null
@@ -1,70 +0,0 @@
-.center { margin-left: auto; margin-right: auto; text-align: center; }
-.current {
- font-weight: bold;
- background-color: #E0E8F0;
-}
-
-body { background-color: #E4F0F4 }
-div#content {
- max-width: 20cm;
- margin-left: auto;
- margin-right: auto;
-}
-
-nav li {
- vertical-align: top;
-
- display: inline;
- list-style-type: none;
- padding: 0.5em;
-}
-nav > ul > li {
- display: inline-block;
-}
-.nopad {
- padding: 0;
-}
-li.border {
- border: solid;
- border-width: 1px;
-}
-
-pre, code{ background-color: #F3F5F7; }
-code {
- /*
http://neugierig.org/software/chromium/notes/2009/09/monospace-fonts-workaround.html
*/
- font-family: WorkAroundWebKitAndMozilla, monospace;
- white-space: nowrap;
-}
-
-/* Styles for htmlize.el fontification. */
-
-.org-comment { color: #005000; } /* font-lock-comment-face */
-.org-keyword { font-weight: bold; } /* font-lock-keyword-face */
-.org-string { color: #8b0000; } /* font-lock-string-face */
-.org-warning { color: #ff8c00;
- font-weight: bold; } /* warning */
-.org-warning-1 { color: #ff0000;
- font-weight: bold; } /* font-lock-warning-face */
-.org-preprocessor { color: #483d8b; } /* font-lock-preprocessor-face */
-.org-constant { color: #008b8b; } /* font-lock-constant-face */
-.org-function-name { color: #0000ff; } /* font-lock-function-name-face */
-.org-type { color: #228b22; } /* font-lock-type-face */
-.org-variable-name { color: #a0522d; } /* font-lock-variable-name-face */
-
-.org-rst-adornment { color: #a020f0; } /* rst-adornment */
-.org-rst-block { color: #a020f0; } /* rst-block */
-.org-rst-comment { color: #b22222; } /* rst-comment */
-.org-rst-definition { color: #0000ff; } /* rst-definition */
-.org-rst-directive { color: #483d8b; } /* rst-directive */
-.org-rst-emphasis1 { font-style: italic; } /* rst-emphasis1 */
-.org-rst-emphasis2 { font-weight: bold; } /* rst-emphasis2 */
-.org-rst-external { color: #228b22; } /* rst-external */
-.org-rst-level-1 { background-color: #d9d9d9; } /* rst-level-1 */
-.org-rst-level-2 { background-color: #c7c7c7; } /* rst-level-2 */
-.org-rst-level-3 { background-color: #b5b5b5; } /* rst-level-3 */
-.org-rst-level-4 { background-color: #a3a3a3; } /* rst-level-4 */
-.org-rst-level-5 { background-color: #919191; } /* rst-level-5 */
-.org-rst-level-6 { background-color: #7f7f7f; } /* rst-level-6 */
-.org-rst-literal { color: #8b2252; } /* rst-literal */
-.org-rst-reference { color: #a0522d; } /* rst-reference */
-.org-rst-transition { color: #a020f0; } /* rst-transition */
diff --git a/packages/yasnippet/doc/yas-doc-helper.el
b/packages/yasnippet/doc/yas-doc-helper.el
deleted file mode 100644
index f48628f..0000000
--- a/packages/yasnippet/doc/yas-doc-helper.el
+++ /dev/null
@@ -1,223 +0,0 @@
-;;; yas-doc-helper.el --- Help generate documentation for YASnippet
-
-;; Copyright (C) 2012, 2013 Free Software Foundation, Inc.
-
-;; Author: João Távora <joaotavora@gmail.com>
-;; Keywords: convenience
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Some functions to help generate YASnippet docs
-
-;;; Code:
-
-(eval-when-compile
- (require 'cl))
-(require 'org)
-(or (require 'org-publish nil t)
- (require 'ox-publish))
-(require 'yasnippet) ; docstrings must be loaded
-
-(defun yas--org-raw-html (tag content &optional attrs)
- ;; in version 8.0 org-mode changed the export syntax, see
- ;; http://orgmode.org/worg/org-8.0.html#sec-8-1
- (format (if (version< org-version "8.0.0")
- "@<%s>%s@</%s>" ; old: @<tag>
- "@@html:<%s>@@%s@@html:</%s>@@") ; new: @@html:<tag>@@
- (concat tag (if attrs " ") attrs)
- content tag))
-
-(defun yas--document-symbol (symbol level)
- (let* ((stars (make-string level ?*))
- (args (and (fboundp symbol)
- (mapcar #'symbol-name (help-function-arglist symbol t))))
- (heading (cond ((fboundp symbol)
- (format
- "%s %s (%s)\n" stars (yas--org-raw-html "code"
symbol "class='function'")
- (mapconcat (lambda (a)
- (format (if (string-prefix-p "&" a)
- "/%s/" "=%s=")
- a))
- args " ")))
- (t
- (format "%s %s\n" stars
- (yas--org-raw-html "code" symbol
"class='variable'")))))
- (after-heading (format ":PROPERTIES:\n:CUSTOM_ID: %s\n:END:" symbol))
- (text-quoting-style 'grave)
- (body (or (cond ((fboundp symbol)
- (let ((doc-synth (car-safe (get symbol
'function-documentation))))
- (if (functionp doc-synth)
- (funcall doc-synth nil)
- (documentation symbol t))))
- ((boundp symbol)
- (documentation-property symbol
'variable-documentation t))
- (t
- (format "*WARNING*: no symbol named =%s=" symbol)))
- (format "*WARNING*: no doc for symbol =%s=" symbol)))
- (case-fold-search nil))
- ;; Do some transformations on the body:
- ;; ARGxxx becomes @<code>arg@</code>xxx
- ;; FOO becomes /foo/
- ;; `bar' becomes [[#bar][=bar=]]
- ;; (...) becomes #+BEGIN_SRC elisp (...) #+END_SRC
- ;; Info node `(some-manual) Node Name' becomes
- ;;
[[https://www.gnu.org/software/emacs/manual/html_node/some-manual/Node-Name.html]
- ;; [(some-manual) Node Name]]
- ;;
- ;; This is fairly fragile, though it seems to be working for
- ;; now...
- (setq body (replace-regexp-in-string
- "\\<\\([A-Z][-A-Z0-9]+\\)\\(\\sw+\\)?\\>"
- #'(lambda (match)
- (let* ((match1 (match-string 1 match))
- (prefix (downcase match1))
- (suffix (match-string 2 match))
- (fmt (cond
- ((member prefix args)
- (yas--org-raw-html "code" "%s"))
- ((null suffix) "/%s/"))))
- (if fmt (format fmt prefix)
- match1)))
- body t t 1)
- body (replace-regexp-in-string
- "\\\\{[^}]+}"
- (lambda (match)
- (concat "#+BEGIN_EXAMPLE\n"
- (substitute-command-keys match)
- "#+END_EXAMPLE\n"))
- body t t)
- body (substitute-command-keys body)
- body (replace-regexp-in-string
- "Info node `(\\([-a-z]+\\)) \\([A-Za-z0-9 ]+\\)'"
- (lambda (match)
- (let* ((manual (match-string 1 match))
- (node (match-string 2 match))
- (html-node (replace-regexp-in-string " " "-" node t
t)))
- (format "Info node\
- [[https://www.gnu.org/software/emacs/manual/html_node/%s/%s.html][(%s) %s]]"
- manual html-node manual node)))
- body t t)
- body (replace-regexp-in-string
- "`\\([-a-z]+\\)'"
- #'(lambda (match)
- (let* ((name (downcase (match-string 1 match)))
- (sym (intern-soft name)))
- (if (memq sym yas--exported-syms)
- (format "[[#%s][=%s=]]" name name)
- (format "=%s=" name))))
- body t t)
- body (replace-regexp-in-string
- "\n\n +(.+\\(?:\n +.+\\)*"
- (lambda (match)
- (concat "\n#+BEGIN_SRC elisp\n"
- match
- "\n#+END_SRC\n"))
- body t t))
- ;; output the paragraph
- (concat heading after-heading "\n" body)))
-
-(defun yas--document-symbols (level &rest names-and-predicates)
- (let ((sym-lists (make-vector (length names-and-predicates) nil))
- (stars (make-string level ?*)))
- (loop for sym in yas--exported-syms
- do (loop for test in (mapcar #'cdr names-and-predicates)
- for i from 0
- do (when (funcall test sym)
- (push sym (aref sym-lists i))
- (return))))
- (loop for slist across sym-lists
- for name in (mapcar #'car names-and-predicates)
- concat (format "\n%s %s\n" stars name)
- concat (mapconcat (lambda (sym)
- (yas--document-symbol sym (1+ level)))
- slist "\n\n"))))
-
-(defun yas--internal-link-snippet ()
- (interactive)
- (yas-expand-snippet "[[#$1][=${1:`yas/selected-text`}=]]"))
-
-(define-key org-mode-map [M-f8] 'yas--internal-link-snippet)
-
-;; This lets all the org files be exported to HTML with
-;; `org-publish-current-project' (C-c C-e P).
-
-(defun yas--make-preamble (props)
- "Return contents of nav-menu-html.inc.
-But replace link to \"current\" page with a span element."
- (with-temp-buffer
- (let ((dir (file-name-directory (plist-get props :input-file))))
- (insert-file-contents (expand-file-name "nav-menu.html.inc" dir))
- (goto-char (point-min))
- (search-forward (concat "<a href=\""
- (file-name-nondirectory
- (plist-get props :output-file))
- "\">"))
- (replace-match "<span class='current'>")
- (search-forward "</a>")
- (replace-match "</span>")
- (buffer-string))))
-
-(let* ((dir (if load-file-name (file-name-directory load-file-name)
- default-directory))
- (src-epoch (getenv "SOURCE_DATE_EPOCH"))
- ;; Presence of SOURCE_DATE_EPOCH indicates a reproducible
- ;; build, don't depend on git.
- (rev (unless src-epoch
- (ignore-errors
- (car (process-lines "git" "describe" "--dirty")))))
- (date (format-time-string
- "(%Y-%m-%d %H:%M:%S)"
- (seconds-to-time
- (string-to-number
- (or (if rev (car (process-lines "git" "show" "--format=%ct"))
- src-epoch)
- "0")))
- t))
- (proj-plist
- `(,@(when (fboundp 'org-html-publish-to-html)
- '(:publishing-function org-html-publish-to-html))
- :base-directory ,dir :publishing-directory ,dir
- :html-preamble yas--make-preamble
- ;;:with-broken-links mark
- :html-postamble
- ,(concat "<hr><p class='creator'>Generated by %c from "
- (or rev yas--version) " " date "</p>\n"
- "<p class='xhtml-validation'>%v</p>\n")))
- (project (assoc "yasnippet" org-publish-project-alist)))
- (when rev ;; Rakefile :doc:upload uses "html-revision".
- (with-temp-file (expand-file-name "html-revision" dir)
- (princ rev (current-buffer))))
- (if project
- (setcdr project proj-plist)
- (push `("yasnippet" . ,proj-plist)
- org-publish-project-alist)))
-
-(defun yas--generate-html-batch ()
- (let ((org-publish-use-timestamps-flag nil)
- (org-export-copy-to-kill-ring nil)
- (org-confirm-babel-evaluate nil)
- (make-backup-files nil)
- (org-html-htmlize-output-type 'css))
- (org-publish "yasnippet" 'force)))
-
-
-
-(provide 'yas-doc-helper)
-;; Local Variables:
-;; indent-tabs-mode: nil
-;; coding: utf-8
-;; End:
-;;; yas-doc-helper.el ends here
diff --git a/packages/yasnippet/yasnippet-debug.el
b/packages/yasnippet/yasnippet-debug.el
deleted file mode 100644
index d33e8a5..0000000
--- a/packages/yasnippet/yasnippet-debug.el
+++ /dev/null
@@ -1,359 +0,0 @@
-;;; yasnippet-debug.el --- debug functions for yasnippet -*- lexical-binding:
t -*-
-
-;; Copyright (C) 2010, 2013-2014, 2017-2018 Free Software Foundation, Inc.
-
-;; Author: João Távora
-;; Keywords: emulations, convenience
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Some debug functions. When loaded from the command line, provides
-;; quick way to test out snippets in a fresh Emacs instance.
-;;
-;; emacs -Q -l yasnippet-debug [-v[v]]
-;; [-M:<modename>] [-M.<filext>] [-S:[<snippet-file|name>]]
-;; [-- <more-arguments-passed-to-Emacs>...]
-;;
-;; See the source in `yas-debug-process-command-line' for meaning of
-;; args.
-;;
-;;; Code:
-
-(defconst yas--loaddir
- (file-name-directory (or load-file-name buffer-file-name))
- "Directory that yasnippet was loaded from.")
-
-(require 'yasnippet (if (boundp 'yas--loaddir)
- ;; Don't require '-L <path>' when debugging.
- (expand-file-name "yasnippet" yas--loaddir)))
-(require 'cl-lib)
-(eval-when-compile
- (unless (fboundp 'cl-flet)
- (defalias 'cl-flet 'flet)))
-(require 'color nil t)
-(require 'edebug)
-(eval-when-compile
- (require 'subr-x nil t)
- (cond ((fboundp 'when-let*) nil) ; Introduced in 26.
- ((fboundp 'when-let) ; Introduced in 25.1,
- (defalias 'when-let* 'when-let)) ; deprecated in 26.
- (t (defmacro when-let* (key-vals &rest body)
- (declare (indent 1) (debug ((symbolp form) body)))
- (let ((key-val (pop key-vals)))
- (if key-val
- `(let ((,(car key-val) ,(cadr key-val)))
- (if ,(car key-val)
- (when-let* ,key-vals
- ,@body)))
- `(progn ,@body)))))))
-
-(defvar yas-debug-live-indicators
- (make-hash-table :test #'eq))
-
-(defun yas-debug-live-colors ()
- (let ((colors ()))
- (maphash (lambda (_k v) (push (nth 1 (car v)) colors))
yas-debug-live-indicators)
- colors))
-
-(defvar yas-debug-recently-live-indicators)
-
-(defun yas-debug-get-live-indicator (location)
- (require 'color)
- (when (boundp 'yas-debug-recently-live-indicators)
- (push location yas-debug-recently-live-indicators))
- (let (beg end)
- (if (markerp location)
- (setq beg (setq end (marker-position location)))
- (setq beg (yas-debug-ov-fom-start location)
- end (yas-debug-ov-fom-end location)))
- (or (when-let* ((color-ov (gethash location yas-debug-live-indicators)))
- (if (and beg end) (move-overlay (cdr color-ov) beg end)
- (delete-overlay (cdr color-ov)))
- color-ov)
- (let* ((live-colors (yas-debug-live-colors))
- (color
- (cl-loop with best-color = nil with max-dist = -1
- for color = (format "#%06X" (random #x1000000))
- for comp = (if (fboundp 'color-complement)
- (apply #'color-rgb-to-hex
(color-complement color))
- color)
- if (< (color-distance color (face-foreground
'default))
- (color-distance comp (face-foreground
'default)))
- do (setq color comp)
- for dist = (cl-loop for c in live-colors
- minimize (color-distance c color))
- if (or (not live-colors) (> dist max-dist))
- do (setq best-color color) (setq max-dist dist)
- repeat (if live-colors 100 1)
- finally return `(:background ,best-color)))
- (ov (make-overlay beg end)))
- (if (markerp location)
- (overlay-put ov 'before-string (propertize "↓" 'face color))
- (overlay-put ov 'before-string (propertize "↘" 'face color))
- (overlay-put ov 'after-string (propertize "↙" 'face color)))
- (puthash location (cons color ov) yas-debug-live-indicators)))))
-
-(defun yas-debug-live-marker (marker)
- (let* ((color-ov (yas-debug-get-live-indicator marker))
- (color (car color-ov))
- (ov (cdr color-ov))
- (decorator (overlay-get ov 'before-string))
- (str (format "at %d" (+ marker))))
- (if (markerp marker)
- (propertize str
- 'cursor-sensor-functions
- `(,(lambda (_window _oldpos dir)
- (overlay-put
- ov 'before-string
- (propertize decorator
- 'face (if (eq dir 'entered)
- 'mode-line-highlight color)))))
- 'face color)
- str)))
-
-(defun yas-debug-ov-fom-start (ovfom)
- (cond ((overlayp ovfom) (overlay-start ovfom))
- ((integerp ovfom) ovfom)
- (t (yas--fom-start ovfom))))
-(defun yas-debug-ov-fom-end (ovfom)
- (cond ((overlayp ovfom) (overlay-end ovfom))
- ((integerp ovfom) ovfom)
- (t (yas--fom-end ovfom))))
-
-(defun yas-debug-live-range (range)
- (let* ((color-ov (yas-debug-get-live-indicator range))
- (color (car color-ov))
- (ov (cdr color-ov))
- (decorator-beg (overlay-get ov 'before-string))
- (decorator-end (overlay-get ov 'after-string))
- (beg (yas-debug-ov-fom-start range))
- (end (yas-debug-ov-fom-end range)))
- (if (and beg end (or (overlayp range)
- (and (not (integerp beg))
- (not (integerp end)))))
- (propertize (format "from %d to %d" (+ beg) (+ end))
- 'cursor-sensor-functions
- `(,(lambda (_window _oldpos dir)
- (let ((face (if (eq dir 'entered)
- 'mode-line-highlight color)))
- (overlay-put ov 'before-string
- (propertize decorator-beg 'face face))
- (overlay-put ov 'after-string
- (propertize decorator-end 'face
face)))))
- 'face color)
- "<dead>")))
-
-(defmacro yas-debug-with-tracebuf (outbuf &rest body)
- (declare (indent 1) (debug (sexp body)))
- (let ((tracebuf-var (make-symbol "tracebuf")))
- `(let ((,tracebuf-var (or ,outbuf (get-buffer-create "*YASnippet
trace*"))))
- (unless (eq ,tracebuf-var (current-buffer))
- (cl-flet ((printf (fmt &rest args)
- (with-current-buffer ,tracebuf-var
- (insert (apply #'format fmt args)))))
- (unless ,outbuf
- (with-current-buffer ,tracebuf-var
- (erase-buffer)
- (when (fboundp 'cursor-sensor-mode)
- (cursor-sensor-mode +1))
- (setq truncate-lines t)))
- (setq ,outbuf ,tracebuf-var)
- (save-restriction
- (widen)
- ,@body))))))
-
-
-(defun yas-debug-snippet (snippet &optional outbuf)
- (yas-debug-with-tracebuf outbuf
- (when-let* ((overlay (yas--snippet-control-overlay snippet)))
- (printf "\tsid: %d control overlay %s\n"
- (yas--snippet-id snippet)
- (yas-debug-live-range overlay)))
- (when-let* ((active-field (yas--snippet-active-field snippet)))
- (unless (consp (yas--field-start active-field))
- (printf "\tactive field: #%d %s %s covering \"%s\"\n"
- (or (yas--field-number active-field) -1)
- (if (yas--field-modified-p active-field) "**" "--")
- (yas-debug-live-range active-field)
- (buffer-substring-no-properties (yas--field-start
active-field) (yas--field-end active-field)))))
- (when-let* ((exit (yas--snippet-exit snippet)))
- (printf "\tsnippet-exit: %s next: %s\n"
- (yas-debug-live-marker (yas--exit-marker exit))
- (yas--exit-next exit)))
- (dolist (field (yas--snippet-fields snippet))
- (unless (consp (yas--field-start field))
- (printf "\tfield: %d %s %s covering \"%s\" next: %s%s\n"
- (or (yas--field-number field) -1)
- (if (yas--field-modified-p field) "**" "--")
- (yas-debug-live-range field)
- (buffer-substring-no-properties (yas--field-start field)
(yas--field-end field))
- (yas--debug-format-fom-concise (yas--field-next field))
- (if (yas--field-parent-field field)
- (format " parent: %s"
- (yas--debug-format-fom-concise
- (yas--field-parent-field field)))
- "")))
- (dolist (mirror (yas--field-mirrors field))
- (unless (consp (yas--mirror-start mirror))
- (printf "\t\tmirror: %s covering \"%s\" next: %s\n"
- (yas-debug-live-range mirror)
- (buffer-substring-no-properties (yas--mirror-start mirror)
(yas--mirror-end mirror))
- (yas--debug-format-fom-concise (yas--mirror-next
mirror))))))))
-
-(defvar yas-debug-target-buffer nil)
-(defvar yas-debug-target-snippets nil nil)
-(make-variable-buffer-local 'yas-debug-target-snippets)
-
-(defvar yas-debug-undo nil)
-
-(defun yas-toggle-debug-undo (value)
- (interactive (list (not yas-debug-undo)))
- (setq yas-debug-undo value)
- (yas--message 3 "debug undo %sabled" (if yas-debug-undo "en" "dis")))
-
-(defadvice yas--snippet-parse-create (before yas-debug-target-snippet
(snippet))
- (add-to-list 'yas-debug-target-snippets snippet))
-
-(defadvice yas--commit-snippet (after yas-debug-untarget-snippet (snippet))
- (setq yas-debug-target-snippets
- (remq snippet yas-debug-target-snippets))
- (maphash (lambda (k color-ov)
- (delete-overlay (cdr color-ov)))
- yas-debug-live-indicators)
- (clrhash yas-debug-live-indicators))
-
-(defun yas-debug-snippets (&optional outbuf hook)
- "Print debug information on active snippets to buffer OUTBUF.
-If OUTBUF is nil, use a buffer named \"*YASsnippet trace*\".
-If HOOK is non-nil, install `yas-debug-snippets' in
-`post-command-hook' to update the information on every command
-after this one. If it is `snippet-navigation' then install hook
-buffer-locally, otherwise install it globally. If HOOK is
-`edebug-create', also instrument the function
-`yas--snippet-parse-create' with `edebug' and show its source."
- (interactive (list nil t))
- (condition-case err
- (yas-debug-with-tracebuf outbuf
- (unless (buffer-live-p yas-debug-target-buffer)
- (setq yas-debug-target-buffer nil))
- (with-current-buffer (or yas-debug-target-buffer (current-buffer))
- (when yas-debug-target-snippets
- (setq yas-debug-target-snippets
- (cl-delete-if-not #'yas--snippet-p
yas-debug-target-snippets)))
- (let ((yas-debug-recently-live-indicators nil))
- (printf "(length yas--snippets-snippets) => %d\n"
- (length yas--active-snippets))
- (dolist (snippet (or yas-debug-target-snippets
- (yas-active-snippets)))
- (printf "snippet %d\n" (yas--snippet-id snippet))
- (yas-debug-snippet snippet outbuf))
- (maphash (lambda (loc color-ov)
- (unless (memq loc yas-debug-recently-live-indicators)
- (delete-overlay (cdr color-ov))
- (remhash loc yas-debug-live-indicators)))
- yas-debug-live-indicators))
- (when (and yas-debug-undo (listp buffer-undo-list))
- (printf "Undo list has %s elements:\n" (length buffer-undo-list))
- (cl-loop for undo-elem in buffer-undo-list
- do (printf "%S\n" undo-elem))))
- (when hook
- (setq yas-debug-target-buffer (current-buffer))
- (ad-enable-advice 'yas--snippet-parse-create 'before
'yas-debug-target-snippet)
- (ad-activate 'yas--snippet-parse-create)
- (ad-enable-advice 'yas--commit-snippet 'after
'yas-debug-untarget-snippet)
- (ad-activate 'yas--commit-snippet)
- (add-hook 'post-command-hook #'yas-debug-snippets
- nil (eq hook 'snippet-navigation))
- ;; Window management is slapped together, it does what I
- ;; want when the caller has a single window open. Good
- ;; enough for now.
- (when (eq hook 'edebug-create)
- (edebug-instrument-function 'yas--snippet-parse-create)
- (let ((buf-point (find-function-noselect
'yas--snippet-parse-create)))
- (with-current-buffer (car buf-point)
- (goto-char (cdr buf-point)))))
- outbuf))
- ((debug error) (signal (car err) (cdr err)))))
-
-(defun yas-debug-snippet-create ()
- (yas-debug-snippets nil 'create))
-
-(defun yas--debug-format-fom-concise (fom)
- (when fom
- (cond ((yas--field-p fom)
- (format "field %s from %d to %d"
- (yas--field-number fom)
- (+ (yas--field-start fom))
- (+ (yas--field-end fom))))
- ((yas--mirror-p fom)
- (format "mirror from %d to %d"
- (+ (yas--mirror-start fom))
- (+ (yas--mirror-end fom))))
- (t
- (format "snippet exit at %d"
- (+ (yas--fom-start fom)))))))
-
-(defun yas-debug-process-command-line (&optional options)
- "Implement command line processing."
- (setq yas-verbosity 99)
- (setq yas-triggers-in-field t)
- (setq debug-on-error t)
- (let* ((snippet-mode 'fundamental-mode)
- (snippet-key nil))
- (unless options
- (setq options (cl-loop for opt = (pop command-line-args-left)
- while (and opt (not (equal opt "--"))
- (string-prefix-p "-" opt))
- collect opt)))
- (when-let* ((mode (cl-member "-M:" options :test #'string-prefix-p)))
- (setq snippet-mode (intern (concat (substring (car mode) 3) "-mode"))))
- (when-let* ((mode (cl-member "-M." options :test #'string-prefix-p)))
- (setq snippet-mode
- (cdr (cl-assoc (substring (car mode) 2) auto-mode-alist
- :test (lambda (ext regexp) (string-match-p regexp
ext))))))
- (switch-to-buffer (get-buffer-create "*yas test*"))
- (funcall snippet-mode)
- (when-let* ((snippet-file (cl-member "-S:" options :test
#'string-prefix-p)))
- (setq snippet-file (substring (car snippet-file) 3))
- (if (file-exists-p snippet-file)
- (with-temp-buffer
- (insert-file-contents snippet-file)
- (let ((snippet-deflist (yas--parse-template snippet-file)))
- (yas-define-snippets snippet-mode (list snippet-deflist))
- (setq snippet-key (car snippet-deflist))))
- (yas-reload-all)
- (let ((template (yas--lookup-snippet-1 snippet-file snippet-mode)))
- (if template
- (setq snippet-key (yas--template-key template))
- (error "No such snippet `%s'" snippet-file)))))
- (display-buffer (find-file-noselect
- (expand-file-name "yasnippet.el" yas--loaddir)))
- (when-let* ((verbosity (car (or (member "-v" options) (member "-vv"
options)))))
- (set-window-buffer
- (split-window) (yas-debug-snippets
- nil (if (equal verbosity "-vv") 'edebug-create t))))
- (yas-minor-mode +1)
- (when snippet-key (insert snippet-key))))
-
-(when command-line-args-left
- (yas-debug-process-command-line))
-
-(provide 'yasnippet-debug)
-;; Local Variables:
-;; indent-tabs-mode: nil
-;; autoload-compute-prefixes: nil
-;; End:
-;;; yasnippet-debug.el ends here
diff --git a/packages/yasnippet/yasnippet-tests.el
b/packages/yasnippet/yasnippet-tests.el
deleted file mode 100644
index f7ca2bb..0000000
--- a/packages/yasnippet/yasnippet-tests.el
+++ /dev/null
@@ -1,1744 +0,0 @@
-;;; yasnippet-tests.el --- some yasnippet tests -*- lexical-binding: t -*-
-
-;; Copyright (C) 2012-2015, 2017-2018 Free Software Foundation, Inc.
-
-;; Author: Jo�o T�vora <joaot@siscog.pt>
-;; Keywords: emulations, convenience
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Test basic snippet mechanics and the loading system
-
-;; To test this in emacs22 mac osx:
-;; curl -L -O
https://github.com/mirrors/emacs/raw/master/lisp/emacs-lisp/ert.el
-;; curl -L -O
https://github.com/mirrors/emacs/raw/master/lisp/emacs-lisp/ert-x.el
-;; /usr/bin/emacs -nw -Q -L . -l yasnippet-tests.el --batch -e ert
-
-;;; Code:
-
-(require 'yasnippet)
-(require 'ert)
-(require 'ert-x)
-(require 'cl-lib)
-(require 'org)
-
-
-;;; Helper macros and function
-
-(defmacro yas-with-snippet-dirs (dirs &rest body)
- (declare (indent defun) (debug t))
- `(yas-call-with-snippet-dirs
- ,dirs #'(lambda () ,@body)))
-
-(defun yas-should-expand (keys-and-expansions)
- (dolist (key-and-expansion keys-and-expansions)
- (yas-exit-all-snippets)
- (erase-buffer)
- (insert (car key-and-expansion))
- (ert-simulate-command '(yas-expand))
- (unless (string= (yas--buffer-contents) (cdr key-and-expansion))
- (ert-fail (format "\"%s\" should have expanded to \"%s\" but got \"%s\""
- (car key-and-expansion)
- (cdr key-and-expansion)
- (yas--buffer-contents)))))
- (yas-exit-all-snippets))
-
-(defun yas--collect-menu-items (menu-keymap)
- (let ((yas--menu-items ()))
- (map-keymap (lambda (_binding definition)
- (when (eq (car-safe definition) 'menu-item)
- (push definition yas--menu-items)))
- menu-keymap)
- yas--menu-items))
-
-(defun yas-should-not-expand (keys)
- (dolist (key keys)
- (yas-exit-all-snippets)
- (erase-buffer)
- (insert key)
- (ert-simulate-command '(yas-expand))
- (unless (string= (yas--buffer-contents) key)
- (ert-fail (format "\"%s\" should have stayed put, but instead expanded
to \"%s\""
- key
- (yas--buffer-contents))))))
-
-(defun yas-mock-insert (string)
- (dotimes (i (length string))
- (let ((last-command-event (aref string i)))
- (ert-simulate-command '(self-insert-command 1)))))
-
-(defun yas-mock-yank (string)
- (let ((interprogram-paste-function (lambda () string)))
- (ert-simulate-command '(yank nil))))
-
-(defun yas--key-binding (key)
- "Like `key-binding', but override `this-command-keys-vector'.
-This lets `yas--maybe-expand-from-keymap-filter' work as expected."
- (cl-letf (((symbol-function 'this-command-keys-vector)
- (lambda () (cl-coerce key 'vector))))
- (key-binding key)))
-
-(defun yas-make-file-or-dirs (ass)
- (let ((file-or-dir-name (car ass))
- (content (cdr ass)))
- (cond ((listp content)
- (make-directory file-or-dir-name 'parents)
- (let ((default-directory (concat default-directory "/"
file-or-dir-name)))
- (mapc #'yas-make-file-or-dirs content)))
- ((stringp content)
- (with-temp-buffer
- (insert content)
- (write-region nil nil file-or-dir-name nil 'nomessage)))
- (t
- (message "[yas] oops don't know this content")))))
-
-
-(defun yas-variables ()
- (let ((syms))
- (mapatoms #'(lambda (sym)
- (if (and (string-match "^yas-[^/]" (symbol-name sym))
- (boundp sym))
- (push sym syms))))
- syms))
-
-(defun yas-call-with-saving-variables (fn)
- (let* ((vars (yas-variables))
- (saved-values (mapcar #'symbol-value vars)))
- (unwind-protect
- (funcall fn)
- (cl-loop for var in vars
- for saved in saved-values
- do (set var saved)))))
-
-(defun yas-call-with-snippet-dirs (dirs fn)
- (let* ((default-directory (make-temp-file "yasnippet-fixture" t))
- (yas-snippet-dirs (mapcar (lambda (d) (expand-file-name (car d)))
dirs)))
- (with-temp-message ""
- (unwind-protect
- (progn
- (mapc #'yas-make-file-or-dirs dirs)
- (funcall fn))
- (when (>= emacs-major-version 24)
- (delete-directory default-directory 'recursive))))))
-
-;;; Older emacsen
-;;;
-(unless (fboundp 'special-mode)
- ;; FIXME: Why provide this default definition here?!?
- (defalias 'special-mode 'fundamental))
-
-(unless (fboundp 'string-suffix-p)
- ;; introduced in Emacs 24.4
- (defun string-suffix-p (suffix string &optional ignore-case)
- "Return non-nil if SUFFIX is a suffix of STRING.
-If IGNORE-CASE is non-nil, the comparison is done without paying
-attention to case differences."
- (let ((start-pos (- (length string) (length suffix))))
- (and (>= start-pos 0)
- (eq t (compare-strings suffix nil nil
- string start-pos nil ignore-case))))))
-
-
-;;; Snippet mechanics
-
-(defun yas--buffer-contents ()
- (buffer-substring-no-properties (point-min) (point-max)))
-
-(ert-deftest field-navigation ()
- (with-temp-buffer
- (yas-minor-mode 1)
- (yas-expand-snippet "${1:brother} from ${2:another} ${3:mother}")
- (should (string= (yas--buffer-contents)
- "brother from another mother"))
- (should (looking-at "brother"))
- (ert-simulate-command '(yas-next-field-or-maybe-expand))
- (should (looking-at "another"))
- (ert-simulate-command '(yas-next-field-or-maybe-expand))
- (should (looking-at "mother"))
- (ert-simulate-command '(yas-prev-field))
- (should (looking-at "another"))
- (ert-simulate-command '(yas-prev-field))
- (should (looking-at "brother"))))
-
-(ert-deftest simple-mirror ()
- (with-temp-buffer
- (yas-minor-mode 1)
- (yas-expand-snippet "${1:brother} from another $1")
- (should (string= (yas--buffer-contents)
- "brother from another brother"))
- (yas-mock-insert "bla")
- (should (string= (yas--buffer-contents)
- "bla from another bla"))))
-
-(ert-deftest mirror-with-transformation ()
- (with-temp-buffer
- (yas-minor-mode 1)
- (yas-expand-snippet "${1:brother} from another ${1:$(upcase yas-text)}")
- (should (string= (yas--buffer-contents)
- "brother from another BROTHER"))
- (yas-mock-insert "bla")
- (should (string= (yas--buffer-contents)
- "bla from another BLA"))))
-
-(ert-deftest yas-mirror-many-fields ()
- (with-temp-buffer
- (yas-minor-mode 1)
- (yas-expand-snippet "${1:brother} and ${2:brother} are${1:$(if (string=
(yas-field-value 1) (yas-field-value 2)) \" \" \" not \")}the same word")
- (should (string= (yas--buffer-contents)
- "brother and brother are the same word"))
- (yas-mock-insert "bla")
- (should (string= (yas--buffer-contents)
- "bla and brother are not the same word"))
- (ert-simulate-command '(yas-next-field-or-maybe-expand))
- (yas-mock-insert "bla")
- (should (string= (yas--buffer-contents)
- "bla and bla are the same word"))))
-
-(ert-deftest mirror-with-transformation-and-autofill ()
- "Test interaction of autofill with mirror transforms"
- (let ((words "one two three four five")
- filled-words)
- (with-temp-buffer
- (c-mode) ; In `c-mode' filling comments works by narrowing.
- (yas-minor-mode +1)
- (setq fill-column 10)
- (auto-fill-mode +1)
- (yas-expand-snippet "/* $0\n */")
- (yas-mock-insert words)
- (setq filled-words (delete-and-extract-region (point-min) (point-max)))
- (yas-expand-snippet "/* $1\n */\n$2$2")
- (should (string= (yas--buffer-contents)
- "/* \n */\n"))
- (yas-mock-insert words)
- (should (string= (yas--buffer-contents)
- (concat filled-words "\n"))))))
-
-(ert-deftest auto-fill-with-multiparagraph ()
- "Test auto-fill protection on snippet spanning multiple paragraphs"
- (with-temp-buffer
- (yas-minor-mode +1)
- (auto-fill-mode +1)
- (yas-expand-snippet "foo$1\n\n$2bar")
- (yas-mock-insert " ")
- (ert-simulate-command '(yas-next-field-or-maybe-expand))
- (should (looking-at "bar"))))
-
-(ert-deftest primary-field-transformation ()
- (with-temp-buffer
- (yas-minor-mode 1)
- (let ((snippet "${1:$$(upcase yas-text)}${1:$(concat \"bar\" yas-text)}"))
- (yas-expand-snippet snippet)
- (should (string= (yas--buffer-contents) "bar"))
- (yas-mock-insert "foo")
- (should (string= (yas--buffer-contents) "FOObarFOO")))))
-
-(ert-deftest nested-placeholders-kill-superfield ()
- (with-temp-buffer
- (yas-minor-mode 1)
- (yas-expand-snippet "brother from ${2:another ${3:mother}}!")
- (should (string= (yas--buffer-contents)
- "brother from another mother!"))
- (yas-mock-insert "bla")
- (should (string= (yas--buffer-contents)
- "brother from bla!"))))
-
-(ert-deftest nested-placeholders-use-subfield ()
- (with-temp-buffer
- (yas-minor-mode 1)
- (yas-expand-snippet "brother from ${2:another ${3:mother}}!")
- (ert-simulate-command '(yas-next-field-or-maybe-expand))
- (yas-mock-insert "bla")
- (should (string= (yas--buffer-contents)
- "brother from another bla!"))))
-
-(ert-deftest mirrors-adjacent-to-fields-with-nested-mirrors ()
- (with-temp-buffer
- (yas-minor-mode 1)
- (yas-expand-snippet "<%= f.submit \"${1:Submit}\"${2:$(and (yas-text) \",
:disable_with => '\")}${2:$1ing...}${2:$(and (yas-text) \"'\")} %>")
- (should (string= (yas--buffer-contents)
- "<%= f.submit \"Submit\", :disable_with => 'Submiting...'
%>"))
- (yas-mock-insert "Send")
- (should (string= (yas--buffer-contents)
- "<%= f.submit \"Send\", :disable_with => 'Sending...'
%>"))))
-
-(ert-deftest deep-nested-mirroring-issue-351 ()
- (with-temp-buffer
- (yas-minor-mode 1)
- (yas-expand-snippet "${1:FOOOOOOO}${2:$1}${3:$2}${4:$3}")
- (yas-mock-insert "abc")
- (should (string= (yas--buffer-contents) "abcabcabcabc"))))
-
-(ert-deftest delete-numberless-inner-snippet-issue-562 ()
- (with-temp-buffer
- (yas-minor-mode 1)
- (yas-expand-snippet "${3:${test}bla}$0${2:ble}")
- (ert-simulate-command '(yas-next-field-or-maybe-expand))
- (should (looking-at "testblable"))
- (ert-simulate-command '(yas-next-field-or-maybe-expand))
- (ert-simulate-command '(yas-skip-and-clear-field))
- (should (looking-at "ble"))
- (should (null (yas-active-snippets)))))
-
-(ert-deftest delete-nested-simple-field-issue-824 ()
- "Test deleting a field with a nested simple field in it."
- (with-temp-buffer
- (yas-minor-mode 1)
- (yas-expand-snippet "${3:so-$4and}$0${2:-so}")
- (ert-simulate-command '(yas-next-field-or-maybe-expand))
- (should (looking-at "so-and-so"))
- (ert-simulate-command '(yas-skip-and-clear-or-delete-char))
- (should (looking-at "-so"))
- (should (null (yas-active-snippets)))))
-
-(ert-deftest ignore-trailing-whitespace ()
- (should (equal
- (with-temp-buffer
- (insert "# key: foo\n# --\nfoo")
- (yas--parse-template))
- (with-temp-buffer
- (insert "# key: foo \n# --\nfoo")
- (yas--parse-template)))))
-
-;; (ert-deftest in-snippet-undo ()
-;; (with-temp-buffer
-;; (yas-minor-mode 1)
-;; (yas-expand-snippet "brother from ${2:another ${3:mother}}!")
-;; (ert-simulate-command '(yas-next-field-or-maybe-expand))
-;; (yas-mock-insert "bla")
-;; (ert-simulate-command '(undo))
-;; (should (string= (yas--buffer-contents)
-;; "brother from another mother!"))))
-
-(ert-deftest undo-redo ()
- "Check redoing of snippet undo."
- (yas-with-snippet-dirs '((".emacs.d/snippets"
- ("emacs-lisp-mode" ("x" . "${1:one},and done"))))
- (with-temp-buffer
- (emacs-lisp-mode)
- (yas-reload-all)
- (yas-minor-mode 1)
- (yas-expand-snippet "x$0")
- (let ((pre-expand-string (buffer-string)))
- (setq buffer-undo-list nil)
- (ert-simulate-command '(yas-expand))
- (push nil buffer-undo-list)
- (ert-simulate-command '(yas-next-field)) ; $1 -> exit snippet.
- (should (string-match-p "\\`one,and done" (buffer-string)))
- (push nil buffer-undo-list)
- (ert-simulate-command '(undo)) ; Revive snippet.
- (ert-simulate-command '(undo)) ; Undo expansion.
- (should (string= (buffer-string) pre-expand-string))
- (ert-simulate-command '(move-end-of-line 1))
- (push nil buffer-undo-list)
- (ert-simulate-command '(undo)) ; Redo (re-expand snippet).
- (should (string-match-p "\\`one,and done" (buffer-string)))))))
-
-(ert-deftest undo-revive-and-do-again ()
- "Check undo-revived snippet is properly ended."
- ;; See https://github.com/joaotavora/yasnippet/issues/1006.
- (yas-with-snippet-dirs '((".emacs.d/snippets"
- ("emacs-lisp-mode" ("x" . "${1:one},and done"))))
- (with-temp-buffer
- (emacs-lisp-mode)
- (yas-reload-all)
- (yas-minor-mode 1)
- (yas-expand-snippet "x$0")
- (setq buffer-undo-list nil)
- (ert-simulate-command '(yas-expand))
- (push nil buffer-undo-list)
- (ert-simulate-command '(yas-next-field)) ; $1 -> exit snippet.
- (should (string-match-p "\\`one,and done" (buffer-string)))
- (push nil buffer-undo-list)
- (ert-simulate-command '(undo)) ; Revive snippet.
- (yas-mock-insert "abc")
- (ert-simulate-command '(yas-next-field)) ; $1 -> exit snippet again.
- (should (string-match-p "\\`abc,and done" (buffer-string)))
- ;; We should have exited snippet and cleaned up any overlays.
- (should-not (cl-some (lambda (o) (overlay-get o 'yas--snippet))
- (overlays-in (point-min) (point-max)))))))
-
-
-(defun yas-test-expand-and-undo (mode snippet-entry initial-contents)
- (yas-with-snippet-dirs
- `((".emacs.d/snippets" (,(symbol-name mode) ,snippet-entry)))
- (with-temp-buffer
- (funcall mode)
- (yas-reload-all)
- (yas-minor-mode 1)
- (yas-expand-snippet initial-contents)
- (let ((pre-expand-string (buffer-string)))
- (setq buffer-undo-list ())
- (ert-simulate-command '(yas-expand))
- ;; Need undo barrier, I think command loop puts it normally.
- (push nil buffer-undo-list)
- (ert-simulate-command '(undo))
- (should (string= (buffer-string) pre-expand-string))))))
-
-(ert-deftest undo-indentation-1 ()
- "Check undoing works when only line of snippet is indented."
- (let ((yas-also-auto-indent-first-line t))
- (yas-test-expand-and-undo
- 'emacs-lisp-mode '("s" . "(setq $0)") "(let\n(while s$0")))
-
-(ert-deftest undo-indentation-2 ()
- "Check undoing works when only line of snippet is indented."
- (let ((yas-also-auto-indent-first-line t)
- (indent-tabs-mode nil))
- (yas-test-expand-and-undo
- 'emacs-lisp-mode '("t" . "; TODO") "t$0")))
-
-(ert-deftest undo-indentation-multiline-1 ()
- "Check undoing works when 1st line of multi-line snippet is indented."
- (let ((yas-also-auto-indent-first-line t)
- (indent-tabs-mode nil))
- (yas-test-expand-and-undo
- 'js-mode '("if" . "if ($1) {\n\n}\n")
- "if$0\nabc = 123456789 + abcdef;")))
-
-
-(ert-deftest undo-indentation-multiline-2 ()
- "Check undoing works when 2nd line of multi-line snippet is indented."
- (let ((yas-also-auto-indent-first-line t)
- (indent-tabs-mode nil))
- (yas-test-expand-and-undo
- 'js-mode '("if" . "if (true) {\n${1:foo};\n}\n")
- "if$0\nabc = 123456789 + abcdef;")))
-
-(ert-deftest dont-clear-on-partial-deletion-issue-515 ()
- "Ensure fields are not cleared when user doesn't really mean to."
- (with-temp-buffer
- (yas-minor-mode 1)
- (yas-expand-snippet "my ${1:kid brother} from another ${2:mother}")
-
- (ert-simulate-command '(kill-word 1))
- (ert-simulate-command '(delete-char 1))
-
- (should (string= (yas--buffer-contents)
- "my brother from another mother"))
- (should (looking-at "brother"))
-
- (ert-simulate-command '(yas-next-field))
- (should (looking-at "mother"))
- (ert-simulate-command '(yas-prev-field))
- (should (looking-at "brother"))))
-
-(ert-deftest do-clear-on-yank-issue-515 ()
- "A yank should clear an unmodified field."
- (with-temp-buffer
- (yas-minor-mode 1)
- (yas-expand-snippet "my ${1:kid brother} from another ${2:mother}")
- (yas-mock-yank "little sibling")
- (should (string= (yas--buffer-contents)
- "my little sibling from another mother"))
- (ert-simulate-command '(yas-next-field))
- (ert-simulate-command '(yas-prev-field))
- (should (looking-at "little sibling"))))
-
-(ert-deftest basic-indentation ()
- (with-temp-buffer
- (ruby-mode)
- (yas-minor-mode 1)
- (set (make-local-variable 'yas-indent-line) 'auto)
- (set (make-local-variable 'yas-also-auto-indent-first-line) t)
- (yas-expand-snippet "def ${1:method}${2:(${3:args})}\n$0\nend")
- ;; Note that empty line is not indented.
- (should (string= "def method(args)
-
-end" (buffer-string)))
- (cl-loop repeat 3 do (ert-simulate-command '(yas-next-field)))
- (yas-mock-insert (make-string (random 5) ?\ )) ; purposedly mess up
indentation
- (yas-expand-snippet "class << ${self}\n $0\nend")
- (ert-simulate-command '(yas-next-field))
- (should (string= "def method(args)
- class << self
-
- end
-end" (buffer-string)))
- (should (= 4 (current-column)))))
-
-(ert-deftest yas-also-indent-empty-lines ()
- "Respect `yas-also-indent-empty-lines' setting."
- (with-temp-buffer
- (ruby-mode)
- (yas-minor-mode 1)
- (set (make-local-variable 'yas-indent-line) 'auto)
- (set (make-local-variable 'yas-also-auto-indent-first-line) t)
- (set (make-local-variable 'yas-also-indent-empty-lines) t)
- (yas-expand-snippet "def foo\n\nend")
- (should (string= "def foo\n \nend" (buffer-string)))
- ;; Test that it keeps working without setting
- ;; `yas-also-auto-indent-first-line'.
- (setq yas-also-auto-indent-first-line nil)
- (erase-buffer)
- (yas-expand-snippet "def foo\n\nend")
- (should (string= "def foo\n \nend" (buffer-string)))))
-
-(ert-deftest yas-indent-first-line ()
- (with-temp-buffer
- (ruby-mode)
- (yas-minor-mode 1)
- (set (make-local-variable 'yas-indent-line) 'auto)
- (set (make-local-variable 'yas-also-auto-indent-first-line) nil)
- (set (make-local-variable 'yas-also-indent-empty-lines) nil)
- (yas-expand-snippet "def foo\n$0\nend\n")
- ;; First (and only) line should not indent.
- (yas-expand-snippet "#not indented")
- (should (equal "def foo\n#not indented\nend\n" (buffer-string)))))
-
-(ert-deftest yas-indent-first-line-fixed ()
- (with-temp-buffer
- (ruby-mode)
- (yas-minor-mode 1)
- (set (make-local-variable 'yas-indent-line) 'fixed)
- (set (make-local-variable 'yas-also-auto-indent-first-line) nil)
- (set (make-local-variable 'yas-also-indent-empty-lines) nil)
- (yas-expand-snippet " def foo\n $0\n end\n")
- ;; First (and only) line should not indent.
- (yas-expand-snippet "#not more indented")
- (should (equal " def foo\n #not more indented\n end\n"
(buffer-string)))))
-
-(ert-deftest indentation-markers ()
- "Test a snippet with indentation markers (`$<')."
- (with-temp-buffer
- (ruby-mode)
- (yas-minor-mode 1)
- (set (make-local-variable 'yas-indent-line) nil)
- (yas-expand-snippet "def ${1:method}${2:(${3:args})}\n$>Indent\nNo
indent\\$>\nend")
- (should (string= "def method(args)
- Indent
-No indent$>
-end" (buffer-string)))))
-
-(ert-deftest single-line-multi-mirror-indentation ()
- "Make sure not to indent with multiple mirrors per line."
- ;; See also Github issue #712.
- (with-temp-buffer
- (text-mode)
- (yas-minor-mode 1)
- (yas-expand-snippet "${1:XXXXX} --------
-$1 ---------------- $1 ----
-$1 ------------------------")
- (should (string= (yas--buffer-contents) "XXXXX --------
-XXXXX ---------------- XXXXX ----
-XXXXX ------------------------"))))
-
-(ert-deftest single-line-multi-mirror-indentation-2 ()
- "Like `single-line-multi-mirror-indentation' but 2 mirrors interleaved."
- ;; See also Github issue #768.
- (with-temp-buffer
- (c-mode)
- (yas-minor-mode 1)
- (yas-expand-snippet "${1:one} ${2:two};\n$1 $2_;\n$2 $1_;\n")
- (should (string= (yas--buffer-contents)
- "one two;\none two_;\ntwo one_;\n"))))
-
-(ert-deftest indent-org-property ()
- "Handling of `org-mode' property indentation, see `org-property-format'."
- ;; This is an interesting case because `org-indent-line' calls
- ;; `replace-match' for properties.
- (with-temp-buffer
- (org-mode)
- (yas-minor-mode +1)
- (yas-expand-snippet "* Test ${1:test}\n:PROPERTIES:\n:ID: $1-after\n:END:")
- (yas-mock-insert "foo bar")
- (ert-simulate-command '(yas-next-field))
- (goto-char (point-min))
- (let ((expected (with-temp-buffer
- (insert (format (concat "* Test foo bar\n"
- " " org-property-format "\n"
- " " org-property-format "\n"
- " " org-property-format)
- ":PROPERTIES:" ""
- ":ID:" "foo bar-after"
- ":END:" ""))
- (delete-trailing-whitespace)
- (buffer-string))))
- ;; Some org-mode versions leave trailing whitespace, some don't.
- (delete-trailing-whitespace)
- (should (equal expected (buffer-string))))))
-
-(ert-deftest indent-cc-mode ()
- "Handling of cc-mode's indentation."
- ;; This is an interesting case because cc-mode deletes all the
- ;; indentation before recreating it.
- (with-temp-buffer
- (c++-mode)
- (yas-minor-mode +1)
- (yas-expand-snippet "\
-int foo()
-{
- if ($1) {
- delete $1;
- $1 = 0;
- }
-}")
- (yas-mock-insert "var")
- (should (string= "\
-int foo()
-{
- if (var) {
- delete var;
- var = 0;
- }
-}" (buffer-string)))))
-
-(ert-deftest indent-cc-mode-2 ()
- "Handling of cc-mode's preprocessor indentation."
- (with-temp-buffer
- (c-mode)
- (yas-minor-mode +1)
- (yas-expand-snippet "\
-#ifndef `\"FOO\"`
-#define FOO
-#endif
-")
- (should (string= "\
-#ifndef FOO
-#define FOO
-#endif
-" (buffer-substring-no-properties (point-min) (point-max))))))
-
-(ert-deftest indent-snippet-mode ()
- "Handling of snippet-mode indentation."
- ;; This is an interesting case because newlines match [[:space:]] in
- ;; snippet-mode.
- (with-temp-buffer
- (snippet-mode)
- (yas-minor-mode +1)
- (yas-expand-snippet "# -*- mode: snippet -*-\n# name: $1\n# key: $1\n#
--\n")
- (yas-mock-insert "foo")
- (should (string= "# -*- mode: snippet -*-\n# name: foo\n# key: foo\n# --\n"
- (buffer-string)))))
-
-(ert-deftest indent-mirrors-on-update ()
- "Check that mirrors are always kept indented."
- (with-temp-buffer
- (ruby-mode)
- (yas-minor-mode 1)
- (yas-expand-snippet "def $1\n$1\nend")
- (yas-mock-insert "xxx")
- ;; Assuming 2 space indent.
- (should (string= "def xxx\n xxx\nend" (buffer-string)))))
-
-(defun yas-test-delete-and-insert-command (beg end new)
- "Simulate a completion command (similar to company-mode)."
- (interactive "r\ns")
- ;; Simulate a completion command (like what company-mode does)
- ;; which deletes the "xxx" and then replaces it with something
- ;; else.
- (delete-region beg end)
- (insert new))
-
-(ert-deftest indent-mirrors-on-complex-update ()
- "Don't get messed up by command that deletes and then inserts."
- (with-temp-buffer
- (ruby-mode)
- (yas-minor-mode 1)
- (yas-expand-snippet "def foo\n ${1:slice} = append($1)\nend")
- (yas-mock-insert "xxx")
- (ert-simulate-command `(yas-test-delete-and-insert-command
- ,(- (point) 3) ,(point) ,"yyy"))
- ;; Assuming 2 space indent.
- (should (string= "def foo\n yyy = append(yyy)\nend" (buffer-string)))))
-
-
-
-(ert-deftest snippet-with-multiline-mirrors-issue-665 ()
- "In issue 665, a multi-line mirror is attempted."
- (with-temp-buffer
- (ruby-mode)
- (yas-minor-mode 1)
- (yas-expand-snippet "def initialize(${1:params})\n$2${1:$(
-mapconcat #'(lambda (arg)
- (format \"@%s = %s\" arg arg))
- (split-string yas-text \", \")
- \"\n\")}\nend")
- (yas-mock-insert "bla, ble, bli")
- (ert-simulate-command '(yas-next-field))
- (let ((expected (mapconcat #'identity
- '("@bla = bla"
- ;; assume ruby is always indented to 2 spaces
- " @ble = ble"
- " @bli = bli")
- "\n")))
- (should (looking-at expected))
- (yas-mock-insert "blo")
- (ert-simulate-command '(yas-prev-field))
- (ert-simulate-command '(yas-next-field))
- (should (looking-at (concat "blo" expected))))))
-
-(defmacro yas-saving-variables (&rest body)
- (declare (debug t))
- `(yas-call-with-saving-variables #'(lambda () ,@body)))
-
-(ert-deftest auto-next-field ()
- "Automatically exit a field after evaluating its transform."
- (with-temp-buffer
- (yas-saving-variables
- (yas-with-snippet-dirs
- `((".emacs.d/snippets"
- ("ruby-mode" ("snip" . ,(concat "foo ${1:$$"
- (prin1-to-string '(yas-auto-next
- (yas-choose-value
- "bar" "foo")))
- "} ${2:$$"
- (prin1-to-string '(yas-auto-next
- (yas-choose-value
- "too" "foo")))
- "} baz ${3:quinn} quinn")))))
- (yas-reload-all)
- (ruby-mode)
- (yas-minor-mode 1)
- (set (make-local-variable 'yas-prompt-functions) `(yas-no-prompt))
- (yas-mock-insert "snip")
- (ert-simulate-command '(yas-expand))
- (yas-mock-insert "quux")
- (should (equal "foo bar too baz quux quinn" (buffer-string)))))))
-
-
-;;; Snippet expansion and character escaping
-;;; Thanks to @zw963 (Billy) for the testing
-;;;
-(ert-deftest escape-dollar ()
- (with-temp-buffer
- (yas-minor-mode 1)
- (yas-expand-snippet "bla\\${1:bla}ble")
- (should (string= (yas--buffer-contents) "bla${1:bla}ble"))))
-
-(ert-deftest escape-closing-brace ()
- (with-temp-buffer
- (yas-minor-mode 1)
- (yas-expand-snippet "bla${1:bla\\}}ble")
- (should (string= (yas--buffer-contents) "blabla}ble"))
- (should (string= (yas-field-value 1) "bla}"))))
-
-(ert-deftest escape-backslashes ()
- (with-temp-buffer
- (yas-minor-mode 1)
- (yas-expand-snippet "bla\\ble")
- (should (string= (yas--buffer-contents) "bla\\ble"))))
-
-(ert-deftest escape-backquotes ()
- (with-temp-buffer
- (yas-minor-mode 1)
- (yas-expand-snippet "bla`(upcase \"foo\\`bar\")`ble")
- (should (string= (yas--buffer-contents) "blaFOO`BARble"))))
-
-(ert-deftest escape-some-elisp-with-strings ()
- "elisp with strings and unbalance parens inside it"
- (with-temp-buffer
- (yas-minor-mode 1)
- ;; The rules here is: to output a literal `"' you need to escape
- ;; it with one backslash. You don't need to escape them in
- ;; embedded elisp.
- (yas-expand-snippet "soon \\\"`(concat (upcase \"(my arms\")\"\\\" were
all around her\")`")
- (should (string= (yas--buffer-contents) "soon \"(MY ARMS\" were all around
her"))))
-
-(ert-deftest escape-some-elisp-with-backslashes ()
- (with-temp-buffer
- (yas-minor-mode 1)
- ;; And the rule here is: to output a literal `\' inside a string
- ;; inside embedded elisp you need a total of six `\'
- (yas-expand-snippet "bla`(upcase \"hey\\\\\\yo\")`ble")
- (should (string= (yas--buffer-contents) "blaHEY\\YOble"))))
-
-(ert-deftest be-careful-when-escaping-in-yas-selected-text ()
- (with-temp-buffer
- (yas-minor-mode 1)
- (let ((yas-selected-text "He\\\\o world!"))
- (yas-expand-snippet "Look ma! `(yas-selected-text)`")
- (should (string= (yas--buffer-contents) "Look ma! He\\\\o world!")))
- (yas-exit-all-snippets)
- (erase-buffer)
- (let ((yas-selected-text "He\"o world!"))
- (yas-expand-snippet "Look ma! `(yas-selected-text)`")
- (should (string= (yas--buffer-contents) "Look ma! He\"o world!")))
- (yas-exit-all-snippets)
- (erase-buffer)
- (let ((yas-selected-text "He\"\)\\o world!"))
- (yas-expand-snippet "Look ma! `(yas-selected-text)`")
- (should (string= (yas--buffer-contents) "Look ma! He\"\)\\o world!")))
- (yas-exit-all-snippets)
- (erase-buffer)))
-
-(ert-deftest be-careful-when-escaping-in-yas-selected-text-2 ()
- (with-temp-buffer
- (yas-minor-mode 1)
- (let ((yas-selected-text "He)}o world!"))
- (yas-expand-snippet "Look ma! ${1:`(yas-selected-text)`} OK?")
- (should (string= (yas--buffer-contents) "Look ma! He)}o world! OK?")))))
-
-(ert-deftest escaping-for-lsp-style-snippet-syntax ()
- "See Github #979."
- (should
- (string= (with-temp-buffer
- (yas-minor-mode 1)
- (yas-expand-snippet
- "Printf(${1:format string}, ${2:args ...interface{\\}})${0}")
- (yas--buffer-contents))
- (with-temp-buffer
- (yas-minor-mode 1)
- (yas-expand-snippet
- "Printf(${1:format string}, ${2:args ...interface\\{\\}})${0}")
- (yas--buffer-contents)))))
-
-(ert-deftest insert-snippet-with-backslashes-in-active-field ()
- ;; This test case fails if `yas--inhibit-overlay-hooks' is not bound
- ;; in `yas-expand-snippet' (see Github #844).
- (with-temp-buffer
- (yas-minor-mode 1)
- (yas-expand-snippet "${1:$$(if (not yas-modified-p) \"a\")}")
- (yas-expand-snippet "\\\\alpha")))
-
-(ert-deftest expand-with-unused-yas-selected-text ()
- (with-temp-buffer
- (yas-with-snippet-dirs
- '((".emacs.d/snippets"
- ("emacs-lisp-mode"
- ("foo" . "expanded `yas-selected-text`foo"))))
- (yas-reload-all)
- (emacs-lisp-mode)
- (yas-minor-mode +1)
- (insert "foo")
- (ert-simulate-command '(yas-expand))
- (should (equal (buffer-string) "expanded foo")))))
-
-(ert-deftest yas-expand-command-snippet ()
- (with-temp-buffer
- (yas-with-snippet-dirs
- '((".emacs.d/snippets"
- ("emacs-lisp-mode"
- ("foo" . "\
-# type: command
-# --
-\(insert \"expanded foo\")"))))
- (yas-reload-all)
- (emacs-lisp-mode)
- (yas-minor-mode +1)
- (insert "foo")
- (ert-simulate-command '(yas-expand))
- (should (equal (buffer-string) "expanded foo")))))
-
-(ert-deftest example-for-issue-271 ()
- (with-temp-buffer
- (yas-minor-mode 1)
- (let ((yas-selected-text "aaa")
- (snippet "if ${1:condition}\n`yas-selected-text`\nelse\n$3\nend"))
- (yas-expand-snippet snippet)
- (yas-next-field)
- (yas-mock-insert "bbb")
- (should (string= (yas--buffer-contents) "if
condition\naaa\nelse\nbbb\nend")))))
-
-(ert-deftest yas-no-memory-of-bad-snippet ()
- "Expanding an incorrect snippet should not influence future expansions."
- ;; See https://github.com/joaotavora/yasnippet/issues/800.
- (with-temp-buffer
- (yas-minor-mode 1)
- (should-error (yas-expand-snippet "```foo\n\n```"))
- (erase-buffer) ; Bad snippet may leave wrong text.
- ;; But expanding the corrected snippet should work fine.
- (yas-expand-snippet "\\`\\`\\`foo\n\n\\`\\`\\`")
- (should (equal (buffer-string) "```foo\n\n```"))))
-
-(defmacro yas--with-font-locked-temp-buffer (&rest body)
- "Like `with-temp-buffer', but ensure `font-lock-mode'."
- (declare (indent 0) (debug t))
- (let ((temp-buffer (make-symbol "temp-buffer")))
- ;; NOTE: buffer name must not start with a space, otherwise
- ;; `font-lock-mode' doesn't turn on.
- `(let ((,temp-buffer (generate-new-buffer "*yas-temp*")))
- (with-current-buffer ,temp-buffer
- ;; pretend we're interactive so `font-lock-mode' turns on
- (let ((noninteractive nil)
- ;; turn on font locking after major mode change
- (change-major-mode-after-body-hook #'font-lock-mode))
- (unwind-protect
- (progn (require 'font-lock)
- ;; turn on font locking before major mode change
- (font-lock-mode +1)
- ,@body)
- (and (buffer-name ,temp-buffer)
- (kill-buffer ,temp-buffer))))))))
-
-(ert-deftest example-for-issue-474 ()
- (yas--with-font-locked-temp-buffer
- (c-mode)
- (yas-minor-mode 1)
- (insert "#include <foo>\n")
- (let ((yas-good-grace nil)) (yas-expand-snippet "`\"TODO: \"`"))
- (should (string= (yas--buffer-contents) "#include <foo>\nTODO: "))))
-
-(ert-deftest example-for-issue-404 ()
- (yas--with-font-locked-temp-buffer
- (c++-mode)
- (yas-minor-mode 1)
- (insert "#include <foo>\n")
- (let ((yas-good-grace nil)) (yas-expand-snippet "main"))
- (should (string= (yas--buffer-contents) "#include <foo>\nmain"))))
-
-(ert-deftest example-for-issue-404-c-mode ()
- (yas--with-font-locked-temp-buffer
- (c-mode)
- (yas-minor-mode 1)
- (insert "#include <foo>\n")
- (let ((yas-good-grace nil)) (yas-expand-snippet "main"))
- (should (string= (yas--buffer-contents) "#include <foo>\nmain"))))
-
-(ert-deftest middle-of-buffer-snippet-insertion ()
- (with-temp-buffer
- (yas-minor-mode 1)
- (insert "beginning")
- (save-excursion (insert "end"))
- (yas-expand-snippet "-middle-")
- (should (string= (yas--buffer-contents) "beginning-middle-end"))))
-
-(ert-deftest another-example-for-issue-271 ()
- ;; expect this to fail in batch mode since `region-active-p' doesn't
- ;; used by `yas-expand-snippet' doesn't make sense in that context.
- ;;
- :expected-result (if noninteractive
- :failed
- :passed)
- (with-temp-buffer
- (yas-minor-mode 1)
- (let ((snippet "\\${${1:1}:`yas-selected-text`}"))
- (insert "aaabbbccc")
- (set-mark 4)
- (goto-char 7)
- (yas-expand-snippet snippet)
- (should (string= (yas--buffer-contents) "aaa${1:bbb}ccc")))))
-
-(ert-deftest string-match-with-subregexp-in-embedded-elisp ()
- (with-temp-buffer
- (yas-minor-mode 1)
- ;; the rule here is: To use regexps in embedded `(elisp)` expressions,
write
- ;; it like you would normal elisp, i.e. no need to escape the backslashes.
- (let ((snippet "`(if (string-match \"foo\\\\(ba+r\\\\)foo\"
\"foobaaaaaaaaaarfoo\")
- \"ok\"
- \"fail\")`"))
- (yas-expand-snippet snippet))
- (should (string= (yas--buffer-contents) "ok"))))
-
-(ert-deftest string-match-with-subregexp-in-mirror-transformations ()
- (with-temp-buffer
- (yas-minor-mode 1)
- ;; the rule here is: To use regexps in embedded `(elisp)` expressions,
- ;; escape backslashes once, i.e. to use \\( \\) constructs, write \\\\(
\\\\).
- (let ((snippet "$1${1:$(if (string-match \"foo\\\\\\\\(ba+r\\\\\\\\)baz\"
yas-text)
- \"ok\"
- \"fail\")}"))
- (yas-expand-snippet snippet)
- (should (string= (yas--buffer-contents) "fail"))
- (yas-mock-insert "foobaaar")
- (should (string= (yas--buffer-contents) "foobaaarfail"))
- (yas-mock-insert "baz")
- (should (string= (yas--buffer-contents) "foobaaarbazok")))))
-
-
-;;; Misc tests
-;;;
-(ert-deftest protection-overlay-no-cheating ()
- "Protection overlays at the very end of the buffer are dealt
- with by cheatingly inserting a newline!
-
-TODO: correct this bug!"
- :expected-result :failed
- (with-temp-buffer
- (yas-minor-mode 1)
- (yas-expand-snippet "${2:brother} from another ${1:mother}")
- (should (string= (yas--buffer-contents)
- "brother from another mother") ;; no newline should be
here!
- )))
-
-(defvar yas-tests--ran-exit-hook nil)
-
-(ert-deftest snippet-exit-hooks ()
- (with-temp-buffer
- (yas-saving-variables
- (let ((yas-tests--ran-exit-hook nil)
- (yas-triggers-in-field t))
- (yas-with-snippet-dirs
- '((".emacs.d/snippets"
- ("emacs-lisp-mode"
- ("foo" . "\
-# expand-env: ((yas-after-exit-snippet-hook (lambda () (setq
yas-tests--ran-exit-hook t))))
-# --
-FOO ${1:f1} ${2:f2}")
- ("sub" . "\
-# expand-env: ((yas-after-exit-snippet-hook (lambda () (setq
yas-tests--ran-exit-hook 'sub))))
-# --
-SUB"))))
- (yas-reload-all)
- (emacs-lisp-mode)
- (yas-minor-mode +1)
- (insert "foo")
- (ert-simulate-command '(yas-expand))
- (should-not yas-tests--ran-exit-hook)
- (yas-mock-insert "sub")
- (ert-simulate-command '(yas-expand))
- (ert-simulate-command '(yas-next-field))
- (should-not yas-tests--ran-exit-hook)
- (ert-simulate-command '(yas-next-field))
- (should (eq yas-tests--ran-exit-hook t)))))))
-
-(ert-deftest snippet-exit-hooks-bindings ()
- "Check that `yas-after-exit-snippet-hook' is handled correctly
-in the case of a buffer-local variable and being overwritten by
-the expand-env field."
- (with-temp-buffer
- (yas-saving-variables
- (let ((yas-tests--ran-exit-hook nil)
- (yas-triggers-in-field t)
- (yas-after-exit-snippet-hook nil))
- (yas-with-snippet-dirs
- '((".emacs.d/snippets"
- ("emacs-lisp-mode"
- ("foo" . "foobar\n")
- ("baz" . "\
-# expand-env: ((yas-after-exit-snippet-hook (lambda () (setq
yas-tests--ran-exit-hook 'letenv))))
-# --
-foobaz\n"))))
- (yas-reload-all)
- (emacs-lisp-mode)
- (yas-minor-mode +1)
- (add-hook 'yas-after-exit-snippet-hook (lambda () (push 'global
yas-tests--ran-exit-hook)))
- (add-hook 'yas-after-exit-snippet-hook (lambda () (push 'local
yas-tests--ran-exit-hook)) nil t)
- (insert "baz")
- (ert-simulate-command '(yas-expand))
- (should (eq 'letenv yas-tests--ran-exit-hook))
- (insert "foo")
- (ert-simulate-command '(yas-expand))
- (should (eq 'global (nth 0 yas-tests--ran-exit-hook)))
- (should (eq 'local (nth 1 yas-tests--ran-exit-hook))))))))
-
-(ert-deftest snippet-mirror-bindings ()
- "Check that variables defined with the expand-env field are
-accessible from mirror transformations."
- (with-temp-buffer
- (yas-saving-variables
- (let ((yas-triggers-in-field t)
- (yas-good-grace nil))
- (yas-with-snippet-dirs
- '((".emacs.d/snippets"
- ("emacs-lisp-mode"
- ("baz" . "\
-# expand-env: ((func #'upcase))
-# --
-hello ${1:$(when (stringp yas-text) (funcall func yas-text))} foo${1:$$(concat
\"baz\")}$0"))))
- (yas-reload-all)
- (emacs-lisp-mode)
- (yas-minor-mode +1)
- (insert "baz")
- (ert-simulate-command '(yas-expand))
- (should (string= (yas--buffer-contents) "hello BAZ foobaz\n")))))))
-
-(defvar yas--barbaz)
-(defvar yas--foobarbaz)
-
-;; See issue #497. To understand this test, follow the example of the
-;; `yas-key-syntaxes' docstring.
-;;
-(ert-deftest complicated-yas-key-syntaxes ()
- (with-temp-buffer
- (yas-saving-variables
- (yas-with-snippet-dirs
- '((".emacs.d/snippets"
- ("emacs-lisp-mode"
- ("foo-barbaz" . "# condition: yas--foobarbaz\n# --\nOKfoo-barbazOK")
- ("barbaz" . "# condition: yas--barbaz\n# --\nOKbarbazOK")
- ("baz" . "OKbazOK")
- ("'quote" . "OKquoteOK"))))
- (yas-reload-all)
- (emacs-lisp-mode)
- (yas-minor-mode +1)
- (let ((yas-key-syntaxes '("w" "w_")))
- (let ((yas--barbaz t))
- (yas-should-expand '(("foo-barbaz" . "foo-OKbarbazOK")
- ("barbaz" . "OKbarbazOK"))))
- (let ((yas--foobarbaz t))
- (yas-should-expand '(("foo-barbaz" . "OKfoo-barbazOK"))))
- (let ((yas-key-syntaxes
- (cons #'(lambda (_start-point)
- (unless (eq ?- (char-before))
- (backward-char)
- 'again))
- yas-key-syntaxes))
- (yas--foobarbaz t))
- (yas-should-expand '(("foo-barbaz" . "foo-barOKbazOK")))))
- (let ((yas-key-syntaxes '(yas-try-key-from-whitespace)))
- (yas-should-expand '(("xxx\n'quote" . "xxx\nOKquoteOK")
- ("xxx 'quote" . "xxx OKquoteOK"))))
- (let ((yas-key-syntaxes '(yas-shortest-key-until-whitespace))
- (yas--foobarbaz t) (yas--barbaz t))
- (yas-should-expand '(("foo-barbaz" . "foo-barOKbazOK")))
- (setq yas-key-syntaxes '(yas-longest-key-from-whitespace))
- (yas-should-expand '(("foo-barbaz" . "OKfoo-barbazOK")
- ("foo " . "foo "))))))))
-
-(ert-deftest nested-snippet-expansion-1 ()
- (with-temp-buffer
- (yas-minor-mode +1)
- (let ((yas-triggers-in-field t))
- (yas-expand-snippet "Parent $1 Snippet")
- (yas-expand-snippet "(Child $1 $2 Snippet)")
- (let ((snippets (yas-active-snippets)))
- (should (= (length snippets) 2))
- (should (= (length (yas--snippet-fields (nth 0 snippets))) 2))
- (should (= (length (yas--snippet-fields (nth 1 snippets))) 1))))))
-
-(ert-deftest nested-snippet-expansion-2 ()
- (let ((yas-triggers-in-field t))
- (yas-with-snippet-dirs
- '((".emacs.d/snippets"
- ("text-mode"
- ("nest" . "one($1:$1) two($2).$0"))))
- (yas-reload-all)
- (text-mode)
- (yas-minor-mode +1)
- (insert "nest")
- (ert-simulate-command '(yas-expand))
- (yas-mock-insert "nest")
- (ert-simulate-command '(yas-expand))
- (yas-mock-insert "x")
- (ert-simulate-command '(yas-next-field-or-maybe-expand))
- (yas-mock-insert "y")
- (ert-simulate-command '(yas-next-field-or-maybe-expand))
- (ert-simulate-command '(yas-next-field-or-maybe-expand))
- (yas-mock-insert "z")
- (ert-simulate-command '(yas-next-field-or-maybe-expand))
- (should (string= (buffer-string)
- "one(one(x:x) two(y).:one(x:x) two(y).) two(z).")))))
-
-(ert-deftest nested-snippet-expansion-3 ()
- (let ((yas-triggers-in-field t))
- (yas-with-snippet-dirs
- '((".emacs.d/snippets"
- ("text-mode"
- ("rt" . "\
-\\sqrt${1:$(if (string-equal \"\" yas/text) \"\" \"[\")}${1:}${1:$(if
(string-equal \"\" yas/text) \"\" \"]\")}{$2}$0"))))
- (yas-reload-all)
- (text-mode)
- (yas-minor-mode +1)
- (insert "rt")
- (ert-simulate-command '(yas-expand))
- (yas-mock-insert "3")
- (ert-simulate-command '(yas-next-field-or-maybe-expand))
- (yas-mock-insert "rt")
- (ert-simulate-command '(yas-next-field-or-maybe-expand))
- (yas-mock-insert "5")
- (ert-simulate-command '(yas-next-field-or-maybe-expand))
- (yas-mock-insert "2")
- (ert-simulate-command '(yas-next-field-or-maybe-expand))
- (ert-simulate-command '(yas-next-field-or-maybe-expand))
- (should (string= (buffer-string) "\\sqrt[3]{\\sqrt[5]{2}}")))))
-
-(ert-deftest nested-snippet-expansion-4 ()
- "See Github #959."
- (let ((yas-triggers-in-field t))
- (yas-with-snippet-dirs
- '((".emacs.d/snippets"
- ("text-mode"
- ("ch" . "<-${1:ch}"))))
- (yas-reload-all)
- (text-mode)
- (yas-minor-mode +1)
- (yas-expand-snippet "ch$0\n")
- (ert-simulate-command '(yas-expand))
- (ert-simulate-command '(forward-char 2))
- (ert-simulate-command '(yas-expand))
- (yas-mock-insert "abc")
- (ert-simulate-command '(yas-next-field-or-maybe-expand))
- (yas-mock-insert "def")
- (ert-simulate-command '(yas-next-field-or-maybe-expand))
- (should (string= (buffer-string) "<-<-abcdef\n")))))
-
-(ert-deftest nested-snippet-expansion-5-nested-delete ()
- "See Github #996."
- (let ((yas-triggers-in-field t))
- (yas-with-snippet-dirs
- '((".emacs.d/snippets"
- ("text-mode"
- ("sel" . "${1:ch}")
- ("ch" . "<-${1:ch}"))))
- (yas-reload-all)
- (text-mode)
- (yas-minor-mode +1)
- (insert "sel")
- (ert-simulate-command '(yas-expand))
- (ert-simulate-command '(forward-word 1))
- (ert-simulate-command '(yas-expand))
- (ert-simulate-command '(forward-word 1))
- ;; The (cl-assert (memq pfield (yas--snippet-fields psnippet)))
- ;; in `yas--on-field-overlay-modification' failed here.
- (ert-simulate-command '(delete-backward-char 1))
- (should (string= (buffer-string) "<-c\n")))))
-
-
-;;; Loading
-;;;
-
-(defmacro yas-with-overriden-buffer-list (&rest body)
- (declare (debug t))
- (let ((saved-sym (make-symbol "yas--buffer-list")))
- `(let ((,saved-sym (symbol-function 'buffer-list)))
- (cl-letf (((symbol-function 'buffer-list)
- (lambda ()
- (cl-remove-if (lambda (buf)
- (with-current-buffer buf
- (eq major-mode 'lisp-interaction-mode)))
- (funcall ,saved-sym)))))
- ,@body))))
-
-
-(defmacro yas-with-some-interesting-snippet-dirs (&rest body)
- (declare (debug t))
- `(yas-saving-variables
- (yas-with-overriden-buffer-list
- (yas-with-snippet-dirs
- '((".emacs.d/snippets"
- ("c-mode"
- (".yas-parents" . "cc-mode")
- ("printf" . "printf($1);")) ;; notice the overriding for issue #281
- ("emacs-lisp-mode" ("ert-deftest" . "(ert-deftest ${1:name} () $0)"))
- ("lisp-interaction-mode" (".yas-parents" . "emacs-lisp-mode")))
- ("library/snippets"
- ("c-mode"
- (".yas-parents" . "c++-mode")
- ("printf" . "printf"))
- ("cc-mode" ("def" . "# define"))
- ("emacs-lisp-mode" ("dolist" . "(dolist)"))
- ("lisp-interaction-mode" ("sc" . "brother from another mother"))))
- ,@body))))
-
-(ert-deftest snippet-lookup ()
- "Test `yas-lookup-snippet'."
- (yas-with-some-interesting-snippet-dirs
- (yas-reload-all 'no-jit)
- (should (equal (yas--template-content (yas-lookup-snippet "printf" 'c-mode))
- "printf($1);"))
- (should (equal (yas--template-content (yas-lookup-snippet "def" 'c-mode))
- "# define"))
- (should-not (yas-lookup-snippet "no such snippet" nil 'noerror))
- (should-not (yas-lookup-snippet "printf" 'emacs-lisp-mode 'noerror))))
-
-(ert-deftest yas-lookup-snippet-with-env ()
- (with-temp-buffer
- (yas-with-snippet-dirs
- '((".emacs.d/snippets"
- ("emacs-lisp-mode"
- ("foo" . "\
-# expand-env: ((foo \"bar\"))
-# --
-`foo`"))))
- (yas-reload-all)
- (emacs-lisp-mode)
- (yas-minor-mode +1)
- (yas-expand-snippet (yas-lookup-snippet "foo"))
- (should (equal (buffer-string) "bar")))))
-
-(ert-deftest basic-jit-loading ()
- "Test basic loading and expansion of snippets"
- (yas-with-some-interesting-snippet-dirs
- (yas-reload-all)
- (yas--basic-jit-loading-1)))
-
-(ert-deftest basic-jit-loading-with-compiled-snippets ()
- "Test basic loading and expansion of compiled snippets"
- (yas-with-some-interesting-snippet-dirs
- (yas-reload-all)
- (yas-recompile-all)
- (cl-letf (((symbol-function 'yas--load-directory-2)
- (lambda (&rest _dummies)
- (ert-fail "yas--load-directory-2 shouldn't be called when
snippets have been compiled"))))
- (yas-reload-all)
- (yas--basic-jit-loading-1))))
-
-(ert-deftest snippet-load-uuid ()
- "Test snippets with same uuid override old ones."
- (yas-saving-variables
- (yas-define-snippets
- 'text-mode
- '(("1" "one" "one" nil nil nil nil "C-c 1" "uuid-1")
- ("2" "two" "two" nil nil nil nil nil "uuid-2")))
- (with-temp-buffer
- (text-mode)
- (yas-minor-mode +1)
- (should (equal (yas--template-content (yas-lookup-snippet "one"))
- "one"))
- (should (eq (yas--key-binding "\C-c1") 'yas-expand-from-keymap))
- (yas-define-snippets
- 'text-mode '(("_1" "one!" "won" nil nil nil nil nil "uuid-1")))
- (should (null (yas-lookup-snippet "one" nil 'noerror)))
- (should (null (yas--key-binding "\C-c1")))
- (should (equal (yas--template-content(yas-lookup-snippet "won"))
- "one!")))))
-
-(ert-deftest snippet-save ()
- "Make sure snippets can be saved correctly."
- (yas-saving-variables
- (yas-with-snippet-dirs
- '((".emacs.d/snippets"
- ("text-mode")))
- (cl-letf (((symbol-function 'y-or-n-p) (lambda (&rest _) t))
- ((symbol-function 'read-file-name)
- (lambda (_prompt &optional _dir _default _mustmatch initial
_predicate)
- (expand-file-name initial)))
- ((symbol-function 'completing-read)
- (lambda (_prompt collection &rest _)
- (or (car collection) ""))))
- (with-temp-buffer
- (text-mode)
- (yas-minor-mode +1)
- (save-current-buffer
- (yas-new-snippet t)
- (with-current-buffer yas-new-snippet-buffer-name
- (snippet-mode)
- (insert "# name: foo\n# key: bar\n# --\nsnippet foo")
- (call-interactively 'yas-load-snippet-buffer-and-close)))
- (save-current-buffer
- (yas-new-snippet t)
- (with-current-buffer yas-new-snippet-buffer-name
- (snippet-mode)
- (insert "# name: bar\n# key: bar\n# --\nsnippet bar")
- (call-interactively 'yas-load-snippet-buffer-and-close)))
- (should (file-readable-p
- (expand-file-name "foo" (car yas-snippet-dirs))))
- (should (file-readable-p
- (expand-file-name "bar" (car yas-snippet-dirs)))))))))
-
-(ert-deftest visiting-compiled-snippets ()
- "Test snippet visiting for compiled snippets."
- (yas-with-some-interesting-snippet-dirs
- (yas-recompile-all)
- (yas-reload-all 'no-jit) ; must be loaded for `yas-lookup-snippet' to work.
- (cl-letf (((symbol-function 'find-file-noselect)
- (lambda (filename &rest _)
- (throw 'yas-snippet-file filename))))
- (should (string-suffix-p
- "cc-mode/def"
- (catch 'yas-snippet-file
- (yas--visit-snippet-file-1
- (yas--lookup-snippet-1 "def" 'cc-mode))))))))
-
-(ert-deftest loading-with-cyclic-parenthood ()
- "Test loading when cyclic parenthood is setup."
- (yas-saving-variables
- (yas-with-snippet-dirs '((".emacs.d/snippets"
- ("c-mode"
- (".yas-parents" . "cc-mode"))
- ("cc-mode"
- (".yas-parents" . "yet-another-c-mode
and-that-one"))
- ("yet-another-c-mode"
- (".yas-parents" . "c-mode and-also-this-one
lisp-interaction-mode"))))
- (yas-reload-all)
- (with-temp-buffer
- (let* ((major-mode 'c-mode)
- (expected `(fundamental-mode
- c-mode
- cc-mode
- yet-another-c-mode
- and-also-this-one
- and-that-one
- ;; prog-mode doesn't exist in emacs 23.4
- ,@(if (fboundp 'prog-mode)
- '(prog-mode))
- emacs-lisp-mode
- lisp-interaction-mode))
- (observed (yas--modes-to-activate)))
- (should (equal major-mode (car observed)))
- (should (equal (sort expected #'string<) (sort observed
#'string<))))))))
-
-(ert-deftest extra-modes-parenthood ()
- "Test activation of parents of `yas--extra-modes'."
- (yas-saving-variables
- (yas-with-snippet-dirs '((".emacs.d/snippets"
- ("c-mode"
- (".yas-parents" . "cc-mode"))
- ("yet-another-c-mode"
- (".yas-parents" . "c-mode and-also-this-one
lisp-interaction-mode"))))
- (yas-reload-all)
- (with-temp-buffer
- (yas-activate-extra-mode 'c-mode)
- (yas-activate-extra-mode 'yet-another-c-mode)
- (yas-activate-extra-mode 'and-that-one)
- (let* ((expected-first `(and-that-one
- yet-another-c-mode
- c-mode
- ,major-mode))
- (expected-rest `(cc-mode
- ;; prog-mode doesn't exist in emacs 23.4
- ,@(if (fboundp 'prog-mode)
- '(prog-mode))
- emacs-lisp-mode
- and-also-this-one
- lisp-interaction-mode))
- (observed (yas--modes-to-activate)))
- (should (equal expected-first
- (cl-subseq observed 0 (length expected-first))))
- (should (equal (sort expected-rest #'string<)
- (sort (cl-subseq observed (length expected-first))
#'string<))))))))
-
-(defalias 'yas--phony-c-mode 'c-mode)
-
-(ert-deftest issue-492-and-494 ()
- (define-derived-mode yas--test-mode yas--phony-c-mode "Just a test mode")
- (yas-with-snippet-dirs '((".emacs.d/snippets"
- ("yas--test-mode")))
- (yas-reload-all)
- (with-temp-buffer
- (let* ((major-mode 'yas--test-mode)
- (expected `(fundamental-mode
- c-mode
- ,@(if (fboundp 'prog-mode)
- '(prog-mode))
- yas--phony-c-mode
- yas--test-mode))
- (observed (yas--modes-to-activate)))
- (should (null (cl-set-exclusive-or expected
observed)))
- (should (= (length expected)
- (length observed)))))))
-
-(define-derived-mode yas--test-mode c-mode "Just a test mode")
-(define-derived-mode yas--another-test-mode c-mode "Another test mode")
-
-(ert-deftest issue-504-tricky-jit ()
- (yas-with-snippet-dirs
- '((".emacs.d/snippets"
- ("yas--another-test-mode"
- (".yas-parents" . "yas--test-mode"))
- ("yas--test-mode")))
- (let ((b (with-current-buffer (generate-new-buffer "*yas-test*")
- (yas--another-test-mode)
- (current-buffer))))
- (unwind-protect
- (progn
- (yas-reload-all)
- (should (= 0 (hash-table-count yas--scheduled-jit-loads))))
- (kill-buffer b)))))
-
-(defun yas--basic-jit-loading-1 ()
- (with-temp-buffer
- (should (= 4 (hash-table-count yas--scheduled-jit-loads)))
- (should (= 0 (hash-table-count yas--tables)))
- (lisp-interaction-mode)
- (yas-minor-mode 1)
- (should (= 2 (hash-table-count yas--scheduled-jit-loads)))
- (should (= 2 (hash-table-count yas--tables)))
- (should (= 1 (hash-table-count (yas--table-uuidhash (gethash
'lisp-interaction-mode yas--tables)))))
- (should (= 2 (hash-table-count (yas--table-uuidhash (gethash
'emacs-lisp-mode yas--tables)))))
- (yas-should-expand '(("sc" . "brother from another mother")
- ("dolist" . "(dolist)")
- ("ert-deftest" . "(ert-deftest name () )")))
- (c-mode)
- (yas-minor-mode 1)
- (should (= 0 (hash-table-count yas--scheduled-jit-loads)))
- (should (= 4 (hash-table-count yas--tables)))
- (should (= 1 (hash-table-count (yas--table-uuidhash (gethash 'c-mode
yas--tables)))))
- (should (= 1 (hash-table-count (yas--table-uuidhash (gethash 'cc-mode
yas--tables)))))
- (yas-should-expand '(("printf" . "printf();")
- ("def" . "# define")))
- (yas-should-not-expand '("sc" "dolist" "ert-deftest"))))
-
-
-;;; Unloading
-(ert-deftest yas-unload ()
- "Test unloading and reloading."
- (with-temp-buffer
- (let ((status (call-process
- (concat invocation-directory invocation-name)
- nil '(t t) nil
- "-Q" "--batch" "-L" yas--loaddir "-l" "yasnippet"
- "--eval"
- (prin1-to-string
- '(condition-case err
- (progn
- (yas-minor-mode +1)
- (unload-feature 'yasnippet)
- ;; Unloading leaves `yas-minor-mode' bound,
- ;; harmless, though perhaps surprising.
- (when (bound-and-true-p yas-minor-mode)
- (error "`yas-minor-mode' still enabled"))
- (when (fboundp 'yas-minor-mode)
- (error "`yas-minor-mode' still fboundp"))
- (require 'yasnippet)
- (unless (fboundp 'yas-minor-mode)
- (error "Failed to reload")))
- (error (message "%S" (error-message-string err))
- (kill-emacs 1)))))))
- (ert-info ((buffer-string)) (should (eq status 0))))))
-
-
-;;; Menu
-;;;
-(defmacro yas-with-even-more-interesting-snippet-dirs (&rest body)
- (declare (debug t))
- `(yas-saving-variables
- (yas-with-snippet-dirs
- `((".emacs.d/snippets"
- ("c-mode"
- (".yas-make-groups" . "")
- ("printf" . "printf($1);")
- ("foo-group-a"
- ("fnprintf" . "fprintf($1);")
- ("snprintf" . "snprintf($1);"))
- ("foo-group-b"
- ("strcmp" . "strecmp($1);")
- ("strcasecmp" . "strcasecmp($1);")))
- ("lisp-interaction-mode"
- ("ert-deftest" . "# group: barbar\n# --\n(ert-deftest ${1:name} ()
$0)"))
- ("fancy-mode"
- ("a-guy" . "# uuid: 999\n# --\nyo!")
- ("a-sir" . "# uuid: 12345\n# --\nindeed!")
- ("a-lady" . "# uuid: 54321\n# --\noh-la-la!")
- ("a-beggar" . "# uuid: 0101\n# --\narrrgh!")
- ("an-outcast" . "# uuid: 666\n# --\narrrgh!")
- (".yas-setup.el" . , (pp-to-string
- '(yas-define-menu 'fancy-mode
- '((yas-ignore-item "0101")
- (yas-item "999")
- (yas-submenu "sirs"
- ((yas-item
"12345")))
- (yas-submenu "ladies"
- ((yas-item
"54321"))))
- '("666")))))))
- ,@body)))
-
-(ert-deftest test-yas-define-menu ()
- (let ((yas-use-menu t))
- (yas-with-even-more-interesting-snippet-dirs
- (yas-reload-all 'no-jit)
- (let ((menu-items (yas--collect-menu-items
- (gethash 'fancy-mode yas--menu-table))))
- (should (eql 4 (length menu-items)))
- (dolist (item '("a-guy" "a-beggar"))
- (should (cl-find item menu-items :key #'cl-second :test #'string=)))
- (should-not (cl-find "an-outcast" menu-items :key #'cl-second :test
#'string=))
- (dolist (submenu '("sirs" "ladies"))
- (should (keymapp
- (cl-third
- (cl-find submenu menu-items :key #'cl-second :test
#'string=)))))))))
-
-(ert-deftest test-group-menus ()
- "Test group-based menus using .yas-make-groups and the group directive"
- (let ((yas-use-menu t))
- (yas-with-even-more-interesting-snippet-dirs
- (yas-reload-all 'no-jit)
- ;; first the subdir-based groups
- ;;
- (let ((menu (cdr (gethash 'c-mode yas--menu-table))))
- (should (eql 3 (length menu)))
- (dolist (item '("printf" "foo-group-a" "foo-group-b"))
- (should (cl-find item menu :key #'cl-third :test #'string=)))
- (dolist (submenu '("foo-group-a" "foo-group-b"))
- (should (keymapp
- (cl-fourth
- (cl-find submenu menu :key #'cl-third :test #'string=))))))
- ;; now group directives
- ;;
- (let ((menu (cdr (gethash 'lisp-interaction-mode yas--menu-table))))
- (should (eql 1 (length menu)))
- (should (cl-find "barbar" menu :key #'cl-third :test #'string=))
- (should (keymapp
- (cl-fourth
- (cl-find "barbar" menu :key #'cl-third :test #'string=))))))))
-
-(ert-deftest test-group-menus-twisted ()
- "Same as similarly named test, but be mean.
-
-TODO: be meaner"
- (let ((yas-use-menu t))
- (yas-with-even-more-interesting-snippet-dirs
- ;; add a group directive conflicting with the subdir and watch
- ;; behaviour
- (with-temp-buffer
- (insert "# group: foo-group-c\n# --\nstrecmp($1)")
- (write-region nil nil (concat (car (yas-snippet-dirs))
- "/c-mode/foo-group-b/strcmp")))
- (yas-reload-all 'no-jit)
- (let ((menu (cdr (gethash 'c-mode yas--menu-table))))
- (should (eql 4 (length menu)))
- (dolist (item '("printf" "foo-group-a" "foo-group-b" "foo-group-c"))
- (should (cl-find item menu :key #'cl-third :test #'string=)))
- (dolist (submenu '("foo-group-a" "foo-group-b" "foo-group-c"))
- (should (keymapp
- (cl-fourth
- (cl-find submenu menu :key #'cl-third :test #'string=))))))
- ;; delete the .yas-make-groups file and watch behaviour
- ;;
- (delete-file (concat (car (yas-snippet-dirs))
- "/c-mode/.yas-make-groups"))
- (yas-reload-all 'no-jit)
- (let ((menu (cdr (gethash 'c-mode yas--menu-table))))
- (should (eql 5 (length menu))))
- ;; Change a group directive and reload
- ;;
- (let ((menu (cdr (gethash 'lisp-interaction-mode yas--menu-table))))
- (should (cl-find "barbar" menu :key #'cl-third :test #'string=)))
-
- (with-temp-buffer
- (insert "# group: foofoo\n# --\n(ert-deftest ${1:name} () $0)")
- (write-region nil nil (concat (car (yas-snippet-dirs))
- "/lisp-interaction-mode/ert-deftest")))
- (yas-reload-all 'no-jit)
- (let ((menu (cdr (gethash 'lisp-interaction-mode yas--menu-table))))
- (should (eql 1 (length menu)))
- (should (cl-find "foofoo" menu :key #'cl-third :test #'string=))
- (should (keymapp
- (cl-fourth
- (cl-find "foofoo" menu :key #'cl-third :test #'string=))))))))
-
-
-;;; The infamous and problematic tab keybinding
-;;;
-(ert-deftest test-yas-tab-binding ()
- (yas-saving-variables
- (yas-with-snippet-dirs
- '((".emacs.d/snippets"
- ("fundamental-mode"
- ("foo" . "foobar"))))
- (yas-reload-all)
- (with-temp-buffer
- (yas-minor-mode -1)
- (insert "foo")
- (should (not (eq (key-binding (yas--read-keybinding "<tab>"))
'yas-expand)))
- (yas-minor-mode 1)
- (should (eq (key-binding (yas--read-keybinding "<tab>")) 'yas-expand))
- (yas-expand-snippet "$1 $2 $3")
- (should (eq (key-binding [(tab)]) 'yas-next-field-or-maybe-expand))
- (should (eq (key-binding (kbd "TAB")) 'yas-next-field-or-maybe-expand))
- (should (eq (key-binding [(shift tab)]) 'yas-prev-field))
- (should (eq (key-binding [backtab]) 'yas-prev-field))))))
-
-(ert-deftest test-rebindings ()
- (let* ((yas-minor-mode-map (copy-keymap yas-minor-mode-map))
- (minor-mode-map-alist
- (cons `(yas-minor-mode . ,yas-minor-mode-map)
- (cl-remove 'yas-minor-mode minor-mode-map-alist
- :test #'eq :key #'car))))
- (define-key yas-minor-mode-map [tab] nil)
- (define-key yas-minor-mode-map (kbd "TAB") nil)
- (define-key yas-minor-mode-map (kbd "SPC") 'yas-expand)
- (with-temp-buffer
- (yas-minor-mode 1)
- (should-not (eq (key-binding (kbd "TAB")) 'yas-expand))
- (should (eq (key-binding (kbd "SPC")) 'yas-expand))
- (yas-reload-all)
- (should-not (eq (key-binding (kbd "TAB")) 'yas-expand))
- (should (eq (key-binding (kbd "SPC")) 'yas-expand)))))
-
-(ert-deftest test-yas-in-org ()
- (yas-saving-variables
- (yas-with-snippet-dirs
- '((".emacs.d/snippets"
- ("org-mode"
- ("foo" . "foobar"))))
- (yas-reload-all)
- (with-temp-buffer
- (org-mode)
- (yas-minor-mode 1)
- (insert "foo")
- (should (eq (key-binding [(tab)]) 'yas-expand))
- (should (eq (key-binding (kbd "TAB")) 'yas-expand))))))
-
-(ert-deftest yas-org-native-tab-in-source-block-text ()
- "Test expansion of snippets in org source blocks."
- ;; org 9+ no longer runs fontification for text-mode, so our hacks
- ;; don't work. Note that old ert doesn't have skipping, so we have
- ;; to expect failure instead.
- :expected-result (if (and (fboundp 'org-in-src-block-p)
- (version< (org-version) "9"))
- :passed :failed)
- (let ((text-mode-hook #'yas-minor-mode))
- (do-yas-org-native-tab-in-source-block "text")))
-
-(ert-deftest yas-org-native-tab-in-source-block-emacs-lisp ()
- "Test expansion of snippets in org source blocks."
- :expected-result (if (fboundp 'org-in-src-block-p)
- :passed :failed)
- (let ((emacs-lisp-mode-hook #'yas-minor-mode)
- ;; This makes the test a bit less comprehensive, but it's
- ;; needed to avoid bumping into Emacs Bug#35264.
- (org-src-preserve-indentation t))
- (do-yas-org-native-tab-in-source-block "emacs-lisp")))
-
-(defun do-yas-org-native-tab-in-source-block (mode)
- (yas-saving-variables
- (yas-with-snippet-dirs
- `((".emacs.d/snippets"
- (,(concat mode "-mode")
- ("T" . "${1:one} $1\n${2:two} $2\n<<$0>> done!"))))
- ;; Binding both text and prog mode hook should cover everything.
- (let ((org-src-tab-acts-natively t)
- ;; Org 8.x requires this in order for
- ;; `org-src-tab-acts-natively' to have effect.
- (org-src-fontify-natively t))
- (yas-reload-all)
- ;; Org relies on font-lock to identify source blocks.
- (yas--with-font-locked-temp-buffer
- (org-mode)
- (yas-minor-mode 1)
- (insert "#+BEGIN_SRC " mode "\nT\n#+END_SRC")
- (if (fboundp 'font-lock-ensure)
- (font-lock-ensure)
- (jit-lock-fontify-now))
- (re-search-backward "^T$") (goto-char (match-end 0))
- (should (org-in-src-block-p))
- (ert-simulate-command `(,(key-binding (kbd "TAB"))))
- (ert-simulate-command `(,(key-binding (kbd "TAB"))))
- (ert-simulate-command `(,(key-binding (kbd "TAB"))))
- ;; Check snippet exit location.
- (should (looking-at ">> done!"))
- (goto-char (point-min))
- (forward-line)
- ;; Check snippet expansion, ignore leading whitespace due to
- ;; `org-edit-src-content-indentation'.
- (should (looking-at "\
-\[[:space:]]*one one
-\[[:space:]]*two two
-\[[:space:]]*<<>> done!")))))))
-
-
-(ert-deftest test-yas-activate-extra-modes ()
- "Given a symbol, `yas-activate-extra-mode' should be able to
-add the snippets associated with the given mode."
- (with-temp-buffer
- (yas-saving-variables
- (yas-with-snippet-dirs
- '((".emacs.d/snippets"
- ("markdown-mode"
- ("_" . "_Text_ "))
- ("emacs-lisp-mode"
- ("car" . "(car )"))))
- (yas-reload-all)
- (emacs-lisp-mode)
- (yas-minor-mode +1)
- (yas-activate-extra-mode 'markdown-mode)
- (should (eq 'markdown-mode (car yas--extra-modes)))
- (yas-should-expand '(("_" . "_Text_ ")))
- (yas-should-expand '(("car" . "(car )")))
- (yas-deactivate-extra-mode 'markdown-mode)
- (should-not (eq 'markdown-mode (car yas--extra-modes)))
- (yas-should-not-expand '("_"))
- (yas-should-expand '(("car" . "(car )")))))))
-
-
-
-(provide 'yasnippet-tests)
-;; Local Variables:
-;; indent-tabs-mode: nil
-;; autoload-compute-prefixes: nil
-;; End:
-;;; yasnippet-tests.el ends here
diff --git a/packages/yasnippet/yasnippet.el b/packages/yasnippet/yasnippet.el
deleted file mode 100644
index e0b5537..0000000
--- a/packages/yasnippet/yasnippet.el
+++ /dev/null
@@ -1,5289 +0,0 @@
-;;; yasnippet.el --- Yet another snippet extension for Emacs
-
-;; Copyright (C) 2008-2019 Free Software Foundation, Inc.
-;; Authors: pluskid <pluskid@gmail.com>,
-;; João Távora <joaotavora@gmail.com>,
-;; Noam Postavsky <npostavs@gmail.com>
-;; Maintainer: Noam Postavsky <npostavs@gmail.com>
-;; Version: 0.14.0
-;; X-URL: http://github.com/joaotavora/yasnippet
-;; Keywords: convenience, emulation
-;; URL: http://github.com/joaotavora/yasnippet
-;; Package-Requires: ((cl-lib "0.5"))
-;; EmacsWiki: YaSnippetMode
-
-;; This program is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;;
-;; Basic steps to setup:
-;;
-;; (add-to-list 'load-path
-;; "~/path-to-yasnippet")
-;; (require 'yasnippet)
-;; (yas-global-mode 1)
-;;
-;;
-;; Interesting variables are:
-;;
-;; `yas-snippet-dirs'
-;;
-;; The directory where user-created snippets are to be
-;; stored. Can also be a list of directories. In that case,
-;; when used for bulk (re)loading of snippets (at startup or
-;; via `yas-reload-all'), directories appearing earlier in
-;; the list override other dir's snippets. Also, the first
-;; directory is taken as the default for storing the user's
-;; new snippets.
-;;
-;; The deprecated `yas/root-directory' aliases this variable
-;; for backward-compatibility.
-;;
-;;
-;; Major commands are:
-;;
-;; M-x yas-expand
-;;
-;; Try to expand snippets before point. In `yas-minor-mode',
-;; this is normally bound to TAB, but you can customize it in
-;; `yas-minor-mode-map'.
-;;
-;; M-x yas-load-directory
-;;
-;; Prompts you for a directory hierarchy of snippets to load.
-;;
-;; M-x yas-activate-extra-mode
-;;
-;; Prompts you for an extra mode to add snippets for in the
-;; current buffer.
-;;
-;; M-x yas-insert-snippet
-;;
-;; Prompts you for possible snippet expansion if that is
-;; possible according to buffer-local and snippet-local
-;; expansion conditions. With prefix argument, ignore these
-;; conditions.
-;;
-;; M-x yas-visit-snippet-file
-;;
-;; Prompts you for possible snippet expansions like
-;; `yas-insert-snippet', but instead of expanding it, takes
-;; you directly to the snippet definition's file, if it
-;; exists.
-;;
-;; M-x yas-new-snippet
-;;
-;; Lets you create a new snippet file in the correct
-;; subdirectory of `yas-snippet-dirs', according to the
-;; active major mode.
-;;
-;; M-x yas-load-snippet-buffer
-;;
-;; When editing a snippet, this loads the snippet. This is
-;; bound to "C-c C-c" while in the `snippet-mode' editing
-;; mode.
-;;
-;; M-x yas-tryout-snippet
-;;
-;; When editing a snippet, this opens a new empty buffer,
-;; sets it to the appropriate major mode and inserts the
-;; snippet there, so you can see what it looks like. This is
-;; bound to "C-c C-t" while in `snippet-mode'.
-;;
-;; M-x yas-describe-tables
-;;
-;; Lists known snippets in a separate buffer. User is
-;; prompted as to whether only the currently active tables
-;; are to be displayed, or all the tables for all major
-;; modes.
-;;
-;; If you have `dropdown-list' installed, you can optionally use it
-;; as the preferred "prompting method", putting in your .emacs file,
-;; for example:
-;;
-;; (require 'dropdown-list)
-;; (setq yas-prompt-functions '(yas-dropdown-prompt
-;; yas-ido-prompt
-;; yas-completing-prompt))
-;;
-;; Also check out the customization group
-;;
-;; M-x customize-group RET yasnippet RET
-;;
-;; If you use the customization group to set variables
-;; `yas-snippet-dirs' or `yas-global-mode', make sure the path to
-;; "yasnippet.el" is present in the `load-path' *before* the
-;; `custom-set-variables' is executed in your .emacs file.
-;;
-;; For more information and detailed usage, refer to the project page:
-;; http://github.com/joaotavora/yasnippet
-
-;;; Code:
-
-(require 'cl-lib)
-(require 'eldoc) ; Needed for 24.
-(declare-function cl-progv-after "cl-extra") ; Needed for 23.4.
-(require 'easymenu)
-(require 'help-mode)
-
-(defvar yas--editing-template)
-(defvar yas--guessed-modes)
-(defvar yas--indent-original-column)
-(defvar yas--scheduled-jit-loads)
-(defvar yas-keymap)
-(defvar yas-selected-text)
-(defvar yas-verbosity)
-(defvar yas--current-template)
-
-
-;;; User customizable variables
-
-(defgroup yasnippet nil
- "Yet Another Snippet extension"
- :prefix "yas-"
- :group 'editing)
-
-(defconst yas--loaddir
- (file-name-directory (or load-file-name buffer-file-name))
- "Directory that yasnippet was loaded from.")
-
-(defconst yas-installed-snippets-dir (expand-file-name "snippets"
yas--loaddir))
-(make-obsolete-variable 'yas-installed-snippets-dir "\
-Yasnippet no longer comes with installed snippets" "0.14")
-
-(defconst yas--default-user-snippets-dir
- (expand-file-name "snippets" user-emacs-directory))
-
-(defcustom yas-snippet-dirs (list yas--default-user-snippets-dir)
- "List of top-level snippet directories.
-
-Each element, a string or a symbol whose value is a string,
-designates a top-level directory where per-mode snippet
-directories can be found.
-
-Elements appearing earlier in the list override later elements'
-snippets.
-
-The first directory is taken as the default for storing snippet's
-created with `yas-new-snippet'. "
- :type '(choice (directory :tag "Single directory")
- (repeat :tag "List of directories"
- (choice (directory) (variable))))
- :set #'(lambda (symbol new)
- (let ((old (and (boundp symbol)
- (symbol-value symbol))))
- (set-default symbol new)
- (unless (or (not (fboundp 'yas-reload-all))
- (equal old new))
- (yas-reload-all)))))
-
-(defun yas-snippet-dirs ()
- "Return variable `yas-snippet-dirs' as list of strings."
- (cl-loop for e in (if (listp yas-snippet-dirs)
- yas-snippet-dirs
- (list yas-snippet-dirs))
- collect
- (cond ((stringp e) e)
- ((and (symbolp e)
- (boundp e)
- (stringp (symbol-value e)))
- (symbol-value e))
- (t
- (error "[yas] invalid element %s in `yas-snippet-dirs'"
e)))))
-
-(defcustom yas-new-snippet-default "\
-# -*- mode: snippet -*-
-# name: $1
-# key: ${2:${1:$(yas--key-from-desc yas-text)}}
-# --
-$0`(yas-escape-text yas-selected-text)`"
- "Default snippet to use when creating a new snippet.
-If nil, don't use any snippet."
- :type 'string)
-
-(defcustom yas-prompt-functions '(yas-dropdown-prompt
- yas-completing-prompt
- yas-maybe-ido-prompt
- yas-no-prompt)
- "Functions to prompt for keys, templates, etc interactively.
-
-These functions are called with the following arguments:
-
-- PROMPT: A string to prompt the user
-
-- CHOICES: a list of strings or objects.
-
-- optional DISPLAY-FN : A function that, when applied to each of
-the objects in CHOICES will return a string.
-
-The return value of any function you put here should be one of
-the objects in CHOICES, properly formatted with DISPLAY-FN (if
-that is passed).
-
-- To signal that your particular style of prompting is
-unavailable at the moment, you can also have the function return
-nil.
-
-- To signal that the user quit the prompting process, you can
-signal `quit' with
-
- (signal \\='quit \"user quit!\")"
- :type '(repeat function))
-
-(defcustom yas-indent-line 'auto
- "Controls indenting applied to a recent snippet expansion.
-
-The following values are possible:
-
-- `fixed' Indent the snippet to the current column;
-
-- `auto' Indent each line of the snippet with `indent-according-to-mode'
-
-Every other value means don't apply any snippet-side indentation
-after expansion (the manual per-line \"$>\" indentation still
-applies)."
- :type '(choice (const :tag "Nothing" nothing)
- (const :tag "Fixed" fixed)
- (const :tag "Auto" auto)))
-
-(defcustom yas-also-auto-indent-first-line nil
- "Non-nil means also auto indent first line according to mode.
-
-Naturally this is only valid when `yas-indent-line' is `auto'."
- :type 'boolean)
-
-(defcustom yas-also-indent-empty-lines nil
- "Non-nil means also indent empty lines according to mode."
- :type 'boolean)
-
-(defcustom yas-snippet-revival t
- "Non-nil means re-activate snippet fields after undo/redo."
- :type 'boolean)
-
-(defcustom yas-triggers-in-field nil
- "If non-nil, allow stacked expansions (snippets inside snippets).
-
-Otherwise `yas-next-field-or-maybe-expand' just moves on to the
-next field"
- :type 'boolean)
-
-(defcustom yas-fallback-behavior 'return-nil
- "This option is obsolete.
-Now that the conditional keybinding `yas-maybe-expand' is
-available, there's no more need for it."
- :type '(choice (const :tag "Call previous command" call-other-command)
- (const :tag "Do nothing" return-nil)))
-
-(make-obsolete-variable
- 'yas-fallback-behavior
- "For `call-other-command' behavior bind to the conditional
-command value `yas-maybe-expand', for `return-nil' behavior bind
-directly to `yas-expand'."
- "0.12")
-
-(defcustom yas-choose-keys-first nil
- "If non-nil, prompt for snippet key first, then for template.
-
-Otherwise prompts for all possible snippet names.
-
-This affects `yas-insert-snippet' and `yas-visit-snippet-file'."
- :type 'boolean)
-
-(defcustom yas-choose-tables-first nil
- "If non-nil, and multiple eligible snippet tables, prompts user for tables
first.
-
-Otherwise, user chooses between the merging together of all
-eligible tables.
-
-This affects `yas-insert-snippet', `yas-visit-snippet-file'"
- :type 'boolean)
-
-(defcustom yas-use-menu 'abbreviate
- "Display a YASnippet menu in the menu bar.
-
-When non-nil, submenus for each snippet table will be listed
-under the menu \"Yasnippet\".
-
-- If set to `abbreviate', only the current major-mode
-menu and the modes set in `yas--extra-modes' are listed.
-
-- If set to `full', every submenu is listed
-
-- If set to nil, hide the menu.
-
-Any other non-nil value, every submenu is listed."
- :type '(choice (const :tag "Full" full)
- (const :tag "Abbreviate" abbreviate)
- (const :tag "No menu" nil)))
-
-(defcustom yas-trigger-symbol (or (and (eq window-system 'mac)
- (ignore-errors
- (char-to-string ?\x21E5))) ;; little
->| sign
- " =>")
- "The text that will be used in menu to represent the trigger."
- :type 'string)
-
-(defcustom yas-wrap-around-region nil
- "What to insert for snippet's $0 field.
-
-If set to a character, insert contents of corresponding register.
-If non-nil insert region contents. This can be overridden on a
-per-snippet basis. A value of `cua' is considered equivalent to
-`?0' for backwards compatibility."
- :type '(choice (character :tag "Insert from register")
- (const t :tag "Insert region contents")
- (const nil :tag "Don't insert anything")
- (const cua))) ; backwards compat
-
-(defcustom yas-good-grace t
- "If non-nil, don't raise errors in elisp evaluation.
-
-This affects both the inline elisp in snippets and the hook
-variables such as `yas-after-exit-snippet-hook'.
-
-If this variable's value is `inline', an error string \"[yas]
-error\" is returned instead of raising the error. If this
-variable's value is `hooks', a message is output to according to
-`yas-verbosity-level'. If this variable's value is t, both are
-active."
- :type 'boolean)
-
-(defcustom yas-visit-from-menu nil
- "If non-nil visit snippets's files from menu, instead of expanding them.
-
-This can only work when snippets are loaded from files."
- :type 'boolean)
-
-(defcustom yas-expand-only-for-last-commands nil
- "List of `last-command' values to restrict tab-triggering to, or nil.
-
-Leave this set at nil (the default) to be able to trigger an
-expansion simply by placing the cursor after a valid tab trigger,
-using whichever commands.
-
-Optionally, set this to something like (self-insert-command) if
-you to wish restrict expansion to only happen when the last
-letter of the snippet tab trigger was typed immediately before
-the trigger key itself."
- :type '(repeat function))
-
-(defcustom yas-alias-to-yas/prefix-p t
- "If non-nil make aliases for the old style yas/ prefixed symbols.
-It must be set to nil before loading yasnippet to take effect."
- :type 'boolean)
-
-;; Only two faces, and one of them shouldn't even be used...
-;;
-(defface yas-field-highlight-face
- '((t (:inherit region)))
- "The face used to highlight the currently active field of a snippet")
-
-(defface yas--field-debug-face
- '()
- "The face used for debugging some overlays normally hidden")
-
-
-;;; User-visible variables
-
-(defconst yas-maybe-skip-and-clear-field
- '(menu-item "" yas-skip-and-clear-field
- :filter yas--maybe-clear-field-filter)
- "A conditional key definition.
-This can be used as a key definition in keymaps to bind a key to
-`yas-skip-and-clear-field' only when at the beginning of an
-unmodified snippet field.")
-
-(defconst yas-maybe-clear-field
- '(menu-item "" yas-clear-field
- :filter yas--maybe-clear-field-filter)
- "A conditional key definition.
-This can be used as a key definition in keymaps to bind a key to
-`yas-clear-field' only when at the beginning of an
-unmodified snippet field.")
-
-(defun yas-filtered-definition (def)
- "Return a condition key definition.
-The condition will respect the value of `yas-keymap-disable-hook'."
- `(menu-item "" ,def
- :filter ,(lambda (cmd) (unless (run-hook-with-args-until-success
- 'yas-keymap-disable-hook)
- cmd))))
-
-(defvar yas-keymap
- (let ((map (make-sparse-keymap)))
- (define-key map [(tab)] (yas-filtered-definition
'yas-next-field-or-maybe-expand))
- (define-key map (kbd "TAB") (yas-filtered-definition
'yas-next-field-or-maybe-expand))
- (define-key map [(shift tab)] (yas-filtered-definition 'yas-prev-field))
- (define-key map [backtab] (yas-filtered-definition 'yas-prev-field))
- (define-key map (kbd "C-g") (yas-filtered-definition 'yas-abort-snippet))
- ;; Yes, filters can be chained!
- (define-key map (kbd "C-d") (yas-filtered-definition
yas-maybe-skip-and-clear-field))
- (define-key map (kbd "DEL") (yas-filtered-definition
yas-maybe-clear-field))
- map)
- "The active keymap while a snippet expansion is in progress.")
-
-(defvar yas-key-syntaxes (list #'yas-try-key-from-whitespace
- "w_.()" "w_." "w_" "w")
- "Syntaxes and functions to help look for trigger keys before point.
-
-Each element in this list specifies how to skip buffer positions
-backwards and look for the start of a trigger key.
-
-Each element can be either a string or a function receiving the
-original point as an argument. A string element is simply passed
-to `skip-syntax-backward' whereas a function element is called
-with no arguments and should also place point before the original
-position.
-
-The string between the resulting buffer position and the original
-point is matched against the trigger keys in the active snippet
-tables.
-
-If no expandable snippets are found, the next element is the list
-is tried, unless a function element returned the symbol `again',
-in which case it is called again from the previous position and
-may once more reposition point.
-
-For example, if `yas-key-syntaxes' has the value (\"w\" \"w_\"),
-trigger keys composed exclusively of \"word\"-syntax characters
-are looked for first. Failing that, longer keys composed of
-\"word\" or \"symbol\" syntax are looked for. Therefore,
-triggering after
-
-foo-barbaz
-
-will, according to the \"w\" element first try \"barbaz\". If
-that isn't a trigger key, \"foo-barbaz\" is tried, respecting the
-second \"w_\" element. Notice that even if \"baz\" is a trigger
-key for an active snippet, it won't be expanded, unless a
-function is added to `yas-key-syntaxes' that eventually places
-point between \"bar\" and \"baz\".
-
-See also Info node `(elisp) Syntax Descriptors'.")
-
-(defvar yas-after-exit-snippet-hook
- '()
- "Hooks to run after a snippet exited.
-
-The hooks will be run in an environment where some variables bound to
-proper values:
-
-`yas-snippet-beg' : The beginning of the region of the snippet.
-
-`yas-snippet-end' : Similar to beg.
-
-Attention: These hooks are not run when exiting nested/stacked snippet
expansion!")
-
-(defvar yas-before-expand-snippet-hook
- '()
- "Hooks to run just before expanding a snippet.")
-
-(defconst yas-not-string-or-comment-condition
- '(if (let ((ppss (syntax-ppss)))
- (or (nth 3 ppss) (nth 4 ppss)))
- '(require-snippet-condition . force-in-comment)
- t)
- "Disables snippet expansion in strings and comments.
-To use, set `yas-buffer-local-condition' to this value.")
-
-(defcustom yas-buffer-local-condition t
- "Snippet expanding condition.
-
-This variable is a Lisp form which is evaluated every time a
-snippet expansion is attempted:
-
- * If it evaluates to nil, no snippets can be expanded.
-
- * If it evaluates to the a cons (require-snippet-condition
- . REQUIREMENT)
-
- * Snippets bearing no \"# condition:\" directive are not
- considered
-
- * Snippets bearing conditions that evaluate to nil (or
- produce an error) won't be considered.
-
- * If the snippet has a condition that evaluates to non-nil
- RESULT:
-
- * If REQUIREMENT is t, the snippet is considered
-
- * If REQUIREMENT is `eq' RESULT, the snippet is
- considered
-
- * Otherwise, the snippet is not considered.
-
- * If it evaluates to the symbol `always', all snippets are
- considered for expansion, regardless of any conditions.
-
- * If it evaluates to t or some other non-nil value
-
- * Snippet bearing no conditions, or conditions that
- evaluate to non-nil, are considered for expansion.
-
- * Otherwise, the snippet is not considered.
-
-Here's an example preventing snippets from being expanded from
-inside comments, in `python-mode' only, with the exception of
-snippets returning the symbol `force-in-comment' in their
-conditions.
-
- (add-hook \\='python-mode-hook
- (lambda ()
- (setq yas-buffer-local-condition
- \\='(if (python-syntax-comment-or-string-p)
- \\='(require-snippet-condition . force-in-comment)
- t))))"
- :type
- `(choice
- (const :tag "Disable snippet expansion inside strings and comments"
- ,yas-not-string-or-comment-condition)
- (const :tag "Expand all snippets regardless of conditions" always)
- (const :tag "Expand snippets unless their condition is nil" t)
- (const :tag "Disable all snippet expansion" nil)
- sexp))
-
-(defcustom yas-keymap-disable-hook nil
- "The `yas-keymap' bindings are disabled if any function in this list returns
non-nil.
-This is useful to control whether snippet navigation bindings
-override bindings from other packages (e.g., `company-mode')."
- :type 'hook)
-
-(defcustom yas-overlay-priority 100
- "Priority to use for yasnippets overlays.
-This is useful to control whether snippet navigation bindings
-override `keymap' overlay property bindings from other packages."
- :type 'integer)
-
-(defcustom yas-inhibit-overlay-modification-protection nil
- "If nil, changing text outside the active field aborts the snippet.
-This protection is intended to prevent yasnippet from ending up
-in an inconsistent state. However, some packages (e.g., the
-company completion package) may trigger this protection when it
-is not needed. In that case, setting this variable to non-nil
-can be useful."
- ;; See also `yas--on-protection-overlay-modification'.
- :type 'boolean)
-
-
-;;; Internal variables
-
-(defconst yas--version "0.14.0")
-
-(defvar yas--menu-table (make-hash-table)
- "A hash table of MAJOR-MODE symbols to menu keymaps.")
-
-(defvar yas--escaped-characters
- '(?\\ ?` ?\" ?' ?$ ?} ?{ ?\( ?\))
- "List of characters which *might* need to be escaped.")
-
-(defconst yas--field-regexp
- "${\\([0-9]+:\\)?\\([^}]*\\)}"
- "A regexp to *almost* recognize a field.")
-
-(defconst yas--multi-dollar-lisp-expression-regexp
- "$+[ \t\n]*\\(([^)]*)\\)"
- "A regexp to *almost* recognize a \"$(...)\" expression.")
-
-(defconst yas--backquote-lisp-expression-regexp
- "`\\([^`]*\\)`"
- "A regexp to recognize a \"\\=`lisp-expression\\=`\" expression." )
-
-(defconst yas--transform-mirror-regexp
- "${\\(?:\\([0-9]+\\):\\)?$\\([ \t\n]*([^}]*\\)"
- "A regexp to *almost* recognize a mirror with a transform.")
-
-(defconst yas--simple-mirror-regexp
- "$\\([0-9]+\\)"
- "A regexp to recognize a simple mirror.")
-
-(defvar yas--snippet-id-seed 0
- "Contains the next id for a snippet.")
-
-(defvar yas--original-auto-fill-function nil
- "The original value of `auto-fill-function'.")
-(make-variable-buffer-local 'yas--original-auto-fill-function)
-
-(defvar yas--watch-auto-fill-backtrace nil)
-
-(defun yas--watch-auto-fill (sym newval op _where)
- (when (and (or (and (eq sym 'yas--original-auto-fill-function)
- (null newval)
- (eq auto-fill-function 'yas--auto-fill))
- (and (eq sym 'auto-fill-function)
- (eq newval 'yas--auto-fill)
- (null yas--original-auto-fill-function)))
- (null yas--watch-auto-fill-backtrace)
- (fboundp 'backtrace-frames) ; Suppress compiler warning.
- ;; If we're about to change `auto-fill-function' too,
- ;; it's okay (probably).
- (not (and (eq op 'makunbound)
- (not (eq (default-value 'auto-fill-function)
'yas--auto-fill))
- (cl-member 'kill-all-local-variables
- (backtrace-frames 'yas--watch-auto-fill)
- :key (lambda (frame) (nth 1 frame))))))
- (setq yas--watch-auto-fill-backtrace
- (backtrace-frames 'yas--watch-auto-fill))))
-
-;; Try to get more info on #873/919 (this only works for Emacs 26+).
-(when (fboundp 'add-variable-watcher)
- (add-variable-watcher 'yas--original-auto-fill-function
- #'yas--watch-auto-fill)
- (add-variable-watcher 'auto-fill-function
- #'yas--watch-auto-fill))
-
-(defun yas--snippet-next-id ()
- (let ((id yas--snippet-id-seed))
- (cl-incf yas--snippet-id-seed)
- id))
-
-
-;;; Minor mode stuff
-
-(defvar yas--minor-mode-menu nil
- "Holds the YASnippet menu.")
-
-(defvar yas--condition-cache-timestamp nil)
-
-(defun yas-maybe-expand-abbrev-key-filter (cmd)
- "Return CMD if there is an expandable snippet at point.
-This function is useful as a `:filter' to a conditional key
-definition."
- (when (let ((yas--condition-cache-timestamp (current-time)))
- (yas--templates-for-key-at-point))
- cmd))
-
-(define-obsolete-function-alias 'yas--maybe-expand-key-filter
- #'yas-maybe-expand-abbrev-key-filter "0.14")
-
-(defconst yas-maybe-expand
- '(menu-item "" yas-expand :filter yas-maybe-expand-abbrev-key-filter)
- "A conditional key definition.
-This can be used as a key definition in keymaps to bind a key to
-`yas-expand' only when there is a snippet available to be
-expanded.")
-
-(defvar yas-minor-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map [(tab)] yas-maybe-expand)
- (define-key map (kbd "TAB") yas-maybe-expand)
- (define-key map "\C-c&\C-s" 'yas-insert-snippet)
- (define-key map "\C-c&\C-n" 'yas-new-snippet)
- (define-key map "\C-c&\C-v" 'yas-visit-snippet-file)
- map)
- "The keymap used when `yas-minor-mode' is active.")
-
-(easy-menu-define yas--minor-mode-menu
- yas-minor-mode-map
- "Menu used when `yas-minor-mode' is active."
- '("YASnippet" :visible yas-use-menu
- "----"
- ["Expand trigger" yas-expand
- :help "Possibly expand tab trigger before point"]
- ["Insert at point..." yas-insert-snippet
- :help "Prompt for an expandable snippet and expand it at point"]
- ["New snippet..." yas-new-snippet
- :help "Create a new snippet in an appropriate directory"]
- ["Visit snippet file..." yas-visit-snippet-file
- :help "Prompt for an expandable snippet and find its file"]
- "----"
- ("Snippet menu behaviour"
- ["Visit snippets" (setq yas-visit-from-menu t)
- :help "Visit snippets from the menu"
- :active t :style radio :selected yas-visit-from-menu]
- ["Expand snippets" (setq yas-visit-from-menu nil)
- :help "Expand snippets from the menu"
- :active t :style radio :selected (not yas-visit-from-menu)]
- "----"
- ["Show all known modes" (setq yas-use-menu 'full)
- :help "Show one snippet submenu for each loaded table"
- :active t :style radio :selected (eq yas-use-menu 'full)]
- ["Abbreviate according to current mode" (setq yas-use-menu 'abbreviate)
- :help "Show only snippet submenus for the current active modes"
- :active t :style radio :selected (eq yas-use-menu 'abbreviate)])
- ("Indenting"
- ["Auto" (setq yas-indent-line 'auto)
- :help "Indent each line of the snippet with `indent-according-to-mode'"
- :active t :style radio :selected (eq yas-indent-line 'auto)]
- ["Fixed" (setq yas-indent-line 'fixed)
- :help "Indent the snippet to the current column"
- :active t :style radio :selected (eq yas-indent-line 'fixed)]
- ["None" (setq yas-indent-line 'none)
- :help "Don't apply any particular snippet indentation after expansion"
- :active t :style radio :selected (not (member yas-indent-line '(fixed
auto)))]
- "----"
- ["Also auto indent first line" (setq yas-also-auto-indent-first-line
- (not
yas-also-auto-indent-first-line))
- :help "When auto-indenting also, auto indent the first line menu"
- :active (eq yas-indent-line 'auto)
- :style toggle :selected yas-also-auto-indent-first-line]
- )
- ("Prompting method"
- ["System X-widget" (setq yas-prompt-functions
- (cons #'yas-x-prompt
- (remove #'yas-x-prompt
- yas-prompt-functions)))
- :help "Use your windowing system's (gtk, mac, windows, etc...) default
menu"
- :active t :style radio :selected (eq (car yas-prompt-functions)
- #'yas-x-prompt)]
- ["Dropdown-list" (setq yas-prompt-functions
- (cons #'yas-dropdown-prompt
- (remove #'yas-dropdown-prompt
- yas-prompt-functions)))
- :help "Use a special dropdown list"
- :active t :style radio :selected (eq (car yas-prompt-functions)
- #'yas-dropdown-prompt)]
- ["Ido" (setq yas-prompt-functions
- (cons #'yas-ido-prompt
- (remove #'yas-ido-prompt
- yas-prompt-functions)))
- :help "Use an ido-style minibuffer prompt"
- :active t :style radio :selected (eq (car yas-prompt-functions)
- #'yas-ido-prompt)]
- ["Completing read" (setq yas-prompt-functions
- (cons #'yas-completing-prompt
- (remove #'yas-completing-prompt
- yas-prompt-functions)))
- :help "Use a normal minibuffer prompt"
- :active t :style radio :selected (eq (car yas-prompt-functions)
- #'yas-completing-prompt)]
- )
- ("Misc"
- ["Wrap region in exit marker"
- (setq yas-wrap-around-region
- (not yas-wrap-around-region))
- :help "If non-nil automatically wrap the selected text in the $0 snippet
exit"
- :style toggle :selected yas-wrap-around-region]
- ["Allow stacked expansions "
- (setq yas-triggers-in-field
- (not yas-triggers-in-field))
- :help "If non-nil allow snippets to be triggered inside other snippet
fields"
- :style toggle :selected yas-triggers-in-field]
- ["Revive snippets on undo "
- (setq yas-snippet-revival
- (not yas-snippet-revival))
- :help "If non-nil allow snippets to become active again after undo"
- :style toggle :selected yas-snippet-revival]
- ["Good grace "
- (setq yas-good-grace
- (not yas-good-grace))
- :help "If non-nil don't raise errors in bad embedded elisp in snippets"
- :style toggle :selected yas-good-grace]
- )
- "----"
- ["Load snippets..." yas-load-directory
- :help "Load snippets from a specific directory"]
- ["Reload everything" yas-reload-all
- :help "Cleanup stuff, reload snippets, rebuild menus"]
- ["About" yas-about
- :help "Display some information about YASnippet"]))
-
-(define-obsolete-variable-alias 'yas-extra-modes 'yas--extra-modes "0.9.1")
-(defvar yas--extra-modes nil
- "An internal list of modes for which to also lookup snippets.
-
-This variable probably makes more sense as buffer-local, so
-ensure your use `make-local-variable' when you set it.")
-
-(defvar yas--tables (make-hash-table)
- "A hash table of mode symbols to `yas--table' objects.")
-
-(defvar yas--parents (make-hash-table)
- "A hash table of mode symbols do lists of direct parent mode symbols.
-
-This list is populated when reading the \".yas-parents\" files
-found when traversing snippet directories with
-`yas-load-directory'.
-
-There might be additional parenting information stored in the
-`derived-mode-parent' property of some mode symbols, but that is
-not recorded here.")
-
-(defvar yas--direct-keymaps (list)
- "Keymap alist supporting direct snippet keybindings.
-
-This variable is placed in `emulation-mode-map-alists'.
-
-Its elements looks like (TABLE-NAME . KEYMAP). They're
-instantiated on `yas-reload-all' but KEYMAP is added to only when
-loading snippets. `yas--direct-TABLE-NAME' is then a variable
-set buffer-locally when entering `yas-minor-mode'. KEYMAP binds
-all defined direct keybindings to `yas-maybe-expand-from-keymap'
-which decides on the snippet to expand.")
-
-(defun yas-direct-keymaps-reload ()
- "Force reload the direct keybinding for active snippet tables."
- (interactive)
- (setq yas--direct-keymaps nil)
- (maphash #'(lambda (name table)
- (push (cons (intern (format "yas--direct-%s" name))
- (yas--table-direct-keymap table))
- yas--direct-keymaps))
- yas--tables))
-
-(defun yas--modes-to-activate (&optional mode)
- "Compute list of mode symbols that are active for `yas-expand' and friends."
- (defvar yas--dfs) ;We rely on dynbind. We could use `letrec' instead!
- (let* ((explored (if mode (list mode) ; Building up list in reverse.
- (cons major-mode (reverse yas--extra-modes))))
- (yas--dfs
- (lambda (mode)
- (cl-loop for neighbour
- in (cl-list* (or (get mode 'derived-mode-parent)
- ;; Consider `fundamental-mode'
- ;; as ultimate ancestor.
- 'fundamental-mode)
- ;; NOTE: `fboundp' check is redundant
- ;; since Emacs 24.4.
- (and (fboundp mode) (symbol-function mode))
- (gethash mode yas--parents))
- when (and neighbour
- (not (memq neighbour explored))
- (symbolp neighbour))
- do (push neighbour explored)
- (funcall yas--dfs neighbour)))))
- (mapc yas--dfs explored)
- (nreverse explored)))
-
-(defvar yas-minor-mode-hook nil
- "Hook run when `yas-minor-mode' is turned on.")
-
-(defun yas--auto-fill-wrapper ()
- (when (and auto-fill-function
- (not (eq auto-fill-function #'yas--auto-fill)))
- (setq yas--original-auto-fill-function auto-fill-function)
- (setq auto-fill-function #'yas--auto-fill)))
-
-;;;###autoload
-(define-minor-mode yas-minor-mode
- "Toggle YASnippet mode.
-
-When YASnippet mode is enabled, `yas-expand', normally bound to
-the TAB key, expands snippets of code depending on the major
-mode.
-
-With no argument, this command toggles the mode.
-positive prefix argument turns on the mode.
-Negative prefix argument turns off the mode.
-
-Key bindings:
-\\{yas-minor-mode-map}"
- :lighter " yas" ;; The indicator for the mode line.
- (cond ((and yas-minor-mode (featurep 'yasnippet))
- ;; Install the direct keymaps in `emulation-mode-map-alists'
- ;; (we use `add-hook' even though it's not technically a hook,
- ;; but it works). Then define variables named after modes to
- ;; index `yas--direct-keymaps'.
- ;;
- ;; Also install the post-command-hook.
- ;;
- (cl-pushnew 'yas--direct-keymaps emulation-mode-map-alists)
- (add-hook 'post-command-hook #'yas--post-command-handler nil t)
- ;; Set the `yas--direct-%s' vars for direct keymap expansion
- ;;
- (dolist (mode (yas--modes-to-activate))
- (let ((name (intern (format "yas--direct-%s" mode))))
- (set-default name nil)
- (set (make-local-variable name) t)))
- ;; Perform JIT loads
- (yas--load-pending-jits)
- ;; Install auto-fill handler.
- (yas--auto-fill-wrapper) ; Now...
- (add-hook 'auto-fill-mode-hook #'yas--auto-fill-wrapper)) ; or later.
- (t
- ;; Uninstall the direct keymaps, post-command hook, and
- ;; auto-fill handler.
- (remove-hook 'post-command-hook #'yas--post-command-handler t)
- (remove-hook 'auto-fill-mode-hook #'yas--auto-fill-wrapper)
- (when (local-variable-p 'yas--original-auto-fill-function)
- (setq auto-fill-function yas--original-auto-fill-function))
- (setq emulation-mode-map-alists
- (remove 'yas--direct-keymaps emulation-mode-map-alists)))))
-
-(defun yas-activate-extra-mode (mode)
- "Activates the snippets for the given `mode' in the buffer.
-
-The function can be called in the hook of a minor mode to
-activate snippets associated with that mode."
- (interactive
- (let (modes
- symbol)
- (maphash (lambda (k _)
- (setq modes (cons (list k) modes)))
- yas--parents)
- (setq symbol (completing-read
- "Activate mode: " modes nil t))
- (list
- (when (not (string= "" symbol))
- (intern symbol)))))
- (when mode
- (add-to-list (make-local-variable 'yas--extra-modes) mode)
- (yas--load-pending-jits)))
-
-(defun yas-deactivate-extra-mode (mode)
- "Deactivates the snippets for the given `mode' in the buffer."
- (interactive
- (list (intern
- (completing-read
- "Deactivate mode: " (mapcar #'list yas--extra-modes) nil t))))
- (set (make-local-variable 'yas--extra-modes)
- (remove mode
- yas--extra-modes)))
-
-(defun yas-temp-buffer-p (&optional buffer)
- (eq (aref (buffer-name buffer) 0) ?\s))
-
-(define-obsolete-variable-alias 'yas-dont-activate
- 'yas-dont-activate-functions "0.9.2")
-(defvar yas-dont-activate-functions (list #'minibufferp #'yas-temp-buffer-p)
- "Special hook to control which buffers `yas-global-mode' affects.
-Functions are called with no argument, and should return non-nil to prevent
-`yas-global-mode' from enabling yasnippet in this buffer.
-
-In Emacsen < 24, this variable is buffer-local. Because
-`yas-minor-mode-on' is called by `yas-global-mode' after
-executing the buffer's major mode hook, setting this variable
-there is an effective way to define exceptions to the \"global\"
-activation behaviour.
-
-In Emacsen >= 24, only the global value is used. To define
-per-mode exceptions to the \"global\" activation behaviour, call
-`yas-minor-mode' with a negative argument directily in the major
-mode's hook.")
-(unless (> emacs-major-version 23)
- (with-no-warnings
- (make-variable-buffer-local 'yas-dont-activate)))
-
-
-(defun yas-minor-mode-on ()
- "Turn on YASnippet minor mode.
-
-Honour `yas-dont-activate-functions', which see."
- (interactive)
- (unless (or
- ;; The old behavior used for Emacs<24 was to set
- ;; `yas-dont-activate-functions' to t buffer-locally.
- (not (or (listp yas-dont-activate-functions)
- (functionp yas-dont-activate-functions)))
- (run-hook-with-args-until-success 'yas-dont-activate-functions))
- (yas-minor-mode 1)))
-
-;;;###autoload
-(define-globalized-minor-mode yas-global-mode yas-minor-mode yas-minor-mode-on)
-
-(defun yas--global-mode-reload-with-jit-maybe ()
- "Run `yas-reload-all' when `yas-global-mode' is on."
- (when yas-global-mode (yas-reload-all)))
-
-(add-hook 'yas-global-mode-hook #'yas--global-mode-reload-with-jit-maybe)
-
-
-;;; Major mode stuff
-
-(defvar yas--font-lock-keywords
- (append '(("^#.*$" . font-lock-comment-face))
- (with-temp-buffer
- (let ((prog-mode-hook nil)
- (emacs-lisp-mode-hook nil))
- (ignore-errors (emacs-lisp-mode)))
- (font-lock-set-defaults)
- (if (eq t (car-safe font-lock-keywords))
- ;; They're "compiled", so extract the source.
- (cadr font-lock-keywords)
- font-lock-keywords))
- '(("\\$\\([0-9]+\\)"
- (0 font-lock-keyword-face)
- (1 font-lock-string-face t))
- ("\\${\\([0-9]+\\):?"
- (0 font-lock-keyword-face)
- (1 font-lock-warning-face t))
- ("\\(\\$(\\)" 1 font-lock-preprocessor-face)
- ("}"
- (0 font-lock-keyword-face)))))
-
-(defvar snippet-mode-map
- (let ((map (make-sparse-keymap)))
- (easy-menu-define nil
- map
- "Menu used when snippet-mode is active."
- (cons "Snippet"
- (mapcar #'(lambda (ent)
- (when (nth 2 ent)
- (define-key map (nth 2 ent) (nth 1 ent)))
- (vector (nth 0 ent) (nth 1 ent) t))
- '(("Load this snippet" yas-load-snippet-buffer "\C-c\C-l")
- ("Load and quit window"
yas-load-snippet-buffer-and-close "\C-c\C-c")
- ("Try out this snippet" yas-tryout-snippet
"\C-c\C-t")))))
- map)
- "The keymap used when `snippet-mode' is active.")
-
-
-
-;;;###autoload(autoload 'snippet-mode "yasnippet" "A mode for editing
yasnippets" t nil)
-(eval-and-compile
- (if (fboundp 'prog-mode)
- ;; `prog-mode' is new in 24.1.
- (define-derived-mode snippet-mode prog-mode "Snippet"
- "A mode for editing yasnippets"
- (setq font-lock-defaults '(yas--font-lock-keywords))
- (set (make-local-variable 'require-final-newline) nil)
- (set (make-local-variable 'comment-start) "#")
- (set (make-local-variable 'comment-start-skip) "#+[\t ]*")
- (add-hook 'after-save-hook #'yas-maybe-load-snippet-buffer nil t))
- (define-derived-mode snippet-mode fundamental-mode "Snippet"
- "A mode for editing yasnippets"
- (setq font-lock-defaults '(yas--font-lock-keywords))
- (set (make-local-variable 'require-final-newline) nil)
- (set (make-local-variable 'comment-start) "#")
- (set (make-local-variable 'comment-start-skip) "#+[\t ]*")
- (add-hook 'after-save-hook #'yas-maybe-load-snippet-buffer nil t))))
-
-(defun yas-snippet-mode-buffer-p ()
- "Return non-nil if current buffer should be in `snippet-mode'.
-Meaning it's visiting a file under one of the mode directories in
-`yas-snippet-dirs'."
- (when buffer-file-name
- (cl-member buffer-file-name (yas-snippet-dirs)
- :test #'file-in-directory-p)))
-
-;; We're abusing `magic-fallback-mode-alist' here because
-;; `auto-mode-alist' doesn't support function matchers.
-(add-to-list 'magic-fallback-mode-alist
- `(yas-snippet-mode-buffer-p . snippet-mode))
-
-
-;;; Internal structs for template management
-
-(cl-defstruct (yas--template
- (:constructor yas--make-template)
- ;; Handles `yas-define-snippets' format, plus the
- ;; initial TABLE argument.
- (:constructor
- yas--define-snippets-2
- (table
- key content
- &optional xname condition group
- expand-env load-file xkeybinding xuuid save-file
- &aux
- (name (or xname
- ;; A little redundant: we always get a name
- ;; from `yas--parse-template' except when
- ;; there isn't a file.
- (and load-file (file-name-nondirectory load-file))
- (and save-file (file-name-nondirectory save-file))
- key))
- (keybinding (yas--read-keybinding xkeybinding))
- (uuid (or xuuid name))
- (old (gethash uuid (yas--table-uuidhash table)))
- (menu-binding-pair
- (and old (yas--template-menu-binding-pair old)))
- (perm-group
- (and old (yas--template-perm-group old))))))
- "A template for a snippet."
- key
- content
- name
- condition
- expand-env
- load-file
- save-file
- keybinding
- uuid
- menu-binding-pair
- group ;; as dictated by the #group: directive or .yas-make-groups
- perm-group ;; as dictated by `yas-define-menu'
- table
- )
-
-(cl-defstruct (yas--table (:constructor yas--make-snippet-table (name)))
- "A table to store snippets for a particular mode.
-
-Has the following fields:
-
-`yas--table-name'
-
- A symbol name normally corresponding to a major mode, but can
- also be a pseudo major-mode to be used in
- `yas-activate-extra-mode', for example.
-
-`yas--table-hash'
-
- A hash table (KEY . NAMEHASH), known as the \"keyhash\". KEY is
- a string or a vector, where the former is the snippet's trigger
- and the latter means it's a direct keybinding. NAMEHASH is yet
- another hash of (NAME . TEMPLATE) where NAME is the snippet's
- name and TEMPLATE is a `yas--template' object.
-
-`yas--table-direct-keymap'
-
- A keymap for the snippets in this table that have direct
- keybindings. This is kept in sync with the keyhash, i.e., all
- the elements of the keyhash that are vectors appear here as
- bindings to `yas-maybe-expand-from-keymap'.
-
-`yas--table-uuidhash'
-
- A hash table mapping snippets uuid's to the same `yas--template'
- objects. A snippet uuid defaults to the snippet's name."
- name
- (hash (make-hash-table :test 'equal))
- (uuidhash (make-hash-table :test 'equal))
- (parents nil)
- (direct-keymap (make-sparse-keymap)))
-
-(defun yas--get-template-by-uuid (mode uuid)
- "Find the snippet template in MODE by its UUID."
- (let* ((table (gethash mode yas--tables mode)))
- (when table
- (gethash uuid (yas--table-uuidhash table)))))
-
-;; Apropos storing/updating in TABLE, this works in two steps:
-;;
-;; 1. `yas--remove-template-by-uuid' removes any
-;; keyhash-namehash-template mappings from TABLE, grabbing the
-;; snippet by its uuid. Also removes mappings from TABLE's
-;; `yas--table-direct-keymap' (FIXME: and should probably take care
-;; of potentially stale menu bindings right?.)
-;;
-;; 2. `yas--add-template' adds this all over again.
-;;
-;; Create a new or add to an existing keyhash-namehash mapping.
-;;
-;; For reference on understanding this, consider three snippet
-;; definitions:
-;;
-;; A: # name: The Foo
-;; # key: foo
-;; # binding: C-c M-l
-;;
-;; B: # name: Mrs Foo
-;; # key: foo
-;;
-;; C: # name: The Bar
-;; # binding: C-c M-l
-;;
-;; D: # name: Baz
-;; # key: baz
-;;
-;; keyhash namehashes(3) yas--template structs(4)
-;; -----------------------------------------------------
-;; __________
-;; / \
-;; "foo" ---> "The Foo" ---> [yas--template A] |
-;; "Mrs Foo" ---> [yas--template B] |
-;; |
-;; [C-c M-l] ---> "The Foo" -------------------------/
-;; "The Bar" ---> [yas--template C]
-;;
-;; "baz" ---> "Baz" ---> [yas--template D]
-;;
-;; Additionally, since uuid defaults to the name, we have a
-;; `yas--table-uuidhash' for TABLE
-;;
-;; uuidhash yas--template structs
-;; -------------------------------
-;; "The Foo" ---> [yas--template A]
-;; "Mrs Foo" ---> [yas--template B]
-;; "The Bar" ---> [yas--template C]
-;; "Baz" ---> [yas--template D]
-;;
-;; FIXME: the more I look at this data-structure the more I think I'm
-;; stupid. There has to be an easier way (but beware lots of code
-;; depends on this).
-;;
-(defun yas--remove-template-by-uuid (table uuid)
- "Remove from TABLE a template identified by UUID."
- (let ((template (gethash uuid (yas--table-uuidhash table))))
- (when template
- (let* ((name (yas--template-name template))
- (empty-keys nil))
- ;; Remove the name from each of the targeted namehashes
- ;;
- (maphash #'(lambda (k v)
- (let ((template (gethash name v)))
- (when (and template
- (equal uuid (yas--template-uuid template)))
- (remhash name v)
- (when (zerop (hash-table-count v))
- (push k empty-keys)))))
- (yas--table-hash table))
- ;; Remove the namehash themselves if they've become empty
- ;;
- (dolist (key empty-keys)
- (when (vectorp key)
- (define-key (yas--table-direct-keymap table) key nil))
- (remhash key (yas--table-hash table)))
-
- ;; Finally, remove the uuid from the uuidhash
- ;;
- (remhash uuid (yas--table-uuidhash table))))))
-
-(defconst yas-maybe-expand-from-keymap
- '(menu-item "" yas-expand-from-keymap
- :filter yas--maybe-expand-from-keymap-filter))
-
-(defun yas--add-template (table template)
- "Store in TABLE the snippet template TEMPLATE.
-
-KEY can be a string (trigger key) of a vector (direct
-keybinding)."
- (let ((name (yas--template-name template))
- (key (yas--template-key template))
- (keybinding (yas--template-keybinding template))
- (_menu-binding-pair (yas--template-menu-binding-pair-get-create
template)))
- (dolist (k (remove nil (list key keybinding)))
- (puthash name
- template
- (or (gethash k
- (yas--table-hash table))
- (puthash k
- (make-hash-table :test 'equal)
- (yas--table-hash table))))
- (when (vectorp k)
- (define-key (yas--table-direct-keymap table) k
yas-maybe-expand-from-keymap)))
-
- ;; Update TABLE's `yas--table-uuidhash'
- (puthash (yas--template-uuid template)
- template
- (yas--table-uuidhash table))))
-
-(defun yas--update-template (table template)
- "Add or update TEMPLATE in TABLE.
-
-Also takes care of adding and updating to the associated menu.
-Return TEMPLATE."
- ;; Remove from table by uuid
- ;;
- (yas--remove-template-by-uuid table (yas--template-uuid template))
- ;; Add to table again
- ;;
- (yas--add-template table template)
- ;; Take care of the menu
- ;;
- (yas--update-template-menu table template)
- template)
-
-(defun yas--update-template-menu (table template)
- "Update every menu-related for TEMPLATE."
- (let ((menu-binding-pair (yas--template-menu-binding-pair-get-create
template))
- (key (yas--template-key template))
- (keybinding (yas--template-keybinding template)))
- ;; The snippet might have changed name or keys, so update
- ;; user-visible strings
- ;;
- (unless (eq (cdr menu-binding-pair) :none)
- ;; the menu item name
- ;;
- (setf (cl-cadar menu-binding-pair) (yas--template-name template))
- ;; the :keys information (also visible to the user)
- (setf (cl-getf (cdr (car menu-binding-pair)) :keys)
- (or (and keybinding (key-description keybinding))
- (and key (concat key yas-trigger-symbol))))))
- (unless (yas--template-menu-managed-by-yas-define-menu template)
- (let ((menu-keymap
- (yas--menu-keymap-get-create (yas--table-mode table)
- (mapcar #'yas--table-mode
- (yas--table-parents table))))
- (group (yas--template-group template)))
- ;; Remove from menu keymap
- ;;
- (cl-assert menu-keymap)
- (yas--delete-from-keymap menu-keymap (yas--template-uuid template))
-
- ;; Add necessary subgroups as necessary.
- ;;
- (dolist (subgroup group)
- (let ((subgroup-keymap (lookup-key menu-keymap (vector (make-symbol
subgroup)))))
- (unless (and subgroup-keymap
- (keymapp subgroup-keymap))
- (setq subgroup-keymap (make-sparse-keymap))
- (define-key menu-keymap (vector (make-symbol subgroup))
- `(menu-item ,subgroup ,subgroup-keymap)))
- (setq menu-keymap subgroup-keymap)))
-
- ;; Add this entry to the keymap
- ;;
- (define-key menu-keymap
- (vector (make-symbol (yas--template-uuid template)))
- (car (yas--template-menu-binding-pair template))))))
-
-(defun yas--namehash-templates-alist (namehash)
- "Return NAMEHASH as an alist."
- (let (alist)
- (maphash #'(lambda (k v)
- (push (cons k v) alist))
- namehash)
- alist))
-
-(defun yas--fetch (table key)
- "Fetch templates in TABLE by KEY.
-
-Return a list of cons (NAME . TEMPLATE) where NAME is a
-string and TEMPLATE is a `yas--template' structure."
- (let* ((keyhash (yas--table-hash table))
- (namehash (and keyhash (gethash key keyhash))))
- (when namehash
- (yas--filter-templates-by-condition (yas--namehash-templates-alist
namehash)))))
-
-
-;;; Filtering/condition logic
-
-(defun yas--eval-condition (condition)
- (condition-case err
- (save-excursion
- (save-restriction
- (save-match-data
- (eval condition))))
- (error (progn
- (yas--message 1 "Error in condition evaluation: %s"
(error-message-string err))
- nil))))
-
-
-(defun yas--filter-templates-by-condition (templates)
- "Filter the templates using the applicable condition.
-
-TEMPLATES is a list of cons (NAME . TEMPLATE) where NAME is a
-string and TEMPLATE is a `yas--template' structure.
-
-This function implements the rules described in
-`yas-buffer-local-condition'. See that variables documentation."
- (let ((requirement (yas--require-template-specific-condition-p)))
- (if (eq requirement 'always)
- templates
- (cl-remove-if-not (lambda (pair)
- (yas--template-can-expand-p
- (yas--template-condition (cdr pair)) requirement))
- templates))))
-
-(defun yas--require-template-specific-condition-p ()
- "Decide if this buffer requests/requires snippet-specific
-conditions to filter out potential expansions."
- (if (eq 'always yas-buffer-local-condition)
- 'always
- (let ((local-condition (or (and (consp yas-buffer-local-condition)
- (yas--eval-condition
yas-buffer-local-condition))
- yas-buffer-local-condition)))
- (when local-condition
- (if (eq local-condition t)
- t
- (and (consp local-condition)
- (eq 'require-snippet-condition (car local-condition))
- (symbolp (cdr local-condition))
- (cdr local-condition)))))))
-
-(defun yas--template-can-expand-p (condition requirement)
- "Evaluate CONDITION and REQUIREMENT and return a boolean."
- (let* ((result (or (null condition)
- (yas--eval-condition condition))))
- (cond ((eq requirement t)
- result)
- (t
- (eq requirement result)))))
-
-(defun yas--table-templates (table)
- (when table
- (let ((acc (list)))
- (maphash #'(lambda (_key namehash)
- (maphash #'(lambda (name template)
- (push (cons name template) acc))
- namehash))
- (yas--table-hash table))
- (maphash #'(lambda (uuid template)
- (push (cons uuid template) acc))
- (yas--table-uuidhash table))
- (yas--filter-templates-by-condition acc))))
-
-(defun yas--templates-for-key-at-point ()
- "Find `yas--template' objects for any trigger keys preceding point.
-Returns (TEMPLATES START END). This function respects
-`yas-key-syntaxes', which see."
- (save-excursion
- (let ((original (point))
- (methods yas-key-syntaxes)
- (templates)
- (method))
- (while (and methods
- (not templates))
- (unless (eq method (car methods))
- ;; TRICKY: `eq'-ness test means we can only be here if
- ;; `method' is a function that returned `again', and hence
- ;; don't revert back to original position as per
- ;; `yas-key-syntaxes'.
- (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 ((possible-key (buffer-substring-no-properties (point) original)))
- (save-excursion
- (goto-char original)
- (setq templates
- (cl-mapcan (lambda (table)
- (yas--fetch table possible-key))
- (yas--get-snippet-tables))))))
- (when templates
- (list templates (point) original)))))
-
-(defun yas--table-all-keys (table)
- "Get trigger keys of all active snippets in TABLE."
- (let ((acc))
- (maphash #'(lambda (key namehash)
- (when (yas--filter-templates-by-condition
(yas--namehash-templates-alist namehash))
- (push key acc)))
- (yas--table-hash table))
- acc))
-
-(defun yas--table-mode (table)
- (intern (yas--table-name table)))
-
-
-;;; Internal functions and macros:
-
-(defun yas--remove-misc-free-from-undo (old-undo-list)
- "Tries to work around Emacs Bug#30931.
-Helper function for `yas--save-restriction-and-widen'."
- ;; If Bug#30931 is unfixed, we get (#<Lisp_Misc_Free> . INTEGER)
- ;; entries in the undo list. If we call `type-of' on the
- ;; Lisp_Misc_Free object then Emacs aborts, so try to find it by
- ;; checking that its type is none of the expected ones.
- (when (consp buffer-undo-list)
- (let* ((prev buffer-undo-list)
- (undo-list prev))
- (while (and (consp undo-list)
- ;; Only check new entries.
- (not (eq undo-list old-undo-list)))
- (let ((entry (pop undo-list)))
- (when (consp entry)
- (let ((head (car entry)))
- (unless (or (stringp head)
- (markerp head)
- (integerp head)
- (symbolp head)
- (not (integerp (cdr entry))))
- ;; (message "removing misc free %S" entry)
- (setcdr prev undo-list)))))
- (setq prev undo-list)))))
-
-(defmacro yas--save-restriction-and-widen (&rest body)
- "Equivalent to (save-restriction (widen) BODY).
-Also tries to work around Emacs Bug#30931."
- (declare (debug (body)) (indent 0))
- ;; Disable garbage collection, since it could cause an abort.
- `(let ((gc-cons-threshold most-positive-fixnum)
- (old-undo-list buffer-undo-list))
- (prog1 (save-restriction
- (widen)
- ,@body)
- (yas--remove-misc-free-from-undo old-undo-list))))
-
-(defun yas--eval-for-string (form)
- "Evaluate FORM and convert the result to string."
- (let ((debug-on-error (and (not (memq yas-good-grace '(t inline)))
- debug-on-error)))
- (condition-case oops
- (save-excursion
- (yas--save-restriction-and-widen
- (save-match-data
- (let ((result (eval form)))
- (when result
- (format "%s" result))))))
- ((debug error) (cdr oops)))))
-
-(defun yas--eval-for-effect (form)
- (yas--safely-call-fun (apply-partially #'eval form)))
-
-(defun yas--read-lisp (string &optional nil-on-error)
- "Read STRING as a elisp expression and return it.
-
-In case STRING in an invalid expression and NIL-ON-ERROR is nil,
-return an expression that when evaluated will issue an error."
- (condition-case err
- (read string)
- (error (and (not nil-on-error)
- `(error (error-message-string ,err))))))
-
-(defun yas--read-keybinding (keybinding)
- "Read KEYBINDING as a snippet keybinding, return a vector."
- (when (and keybinding
- (not (string-match "keybinding" keybinding)))
- (condition-case err
- (let ((res (or (and (string-match "^\\[.*\\]$" keybinding)
- (read keybinding))
- (read-kbd-macro keybinding 'need-vector))))
- res)
- (error
- (yas--message 2 "warning: keybinding \"%s\" invalid since %s."
- keybinding (error-message-string err))
- nil))))
-
-(defun yas--table-get-create (mode)
- "Get or create the snippet table corresponding to MODE."
- (let ((table (gethash mode
- yas--tables)))
- (unless table
- (setq table (yas--make-snippet-table (symbol-name mode)))
- (puthash mode table yas--tables)
- (push (cons (intern (format "yas--direct-%s" mode))
- (yas--table-direct-keymap table))
- yas--direct-keymaps))
- table))
-
-(defun yas--get-snippet-tables (&optional mode)
- "Get snippet tables for MODE.
-
-MODE defaults to the current buffer's `major-mode'.
-
-Return a list of `yas--table' objects. The list of modes to
-consider is returned by `yas--modes-to-activate'"
- (remove nil
- (mapcar #'(lambda (name)
- (gethash name yas--tables))
- (yas--modes-to-activate mode))))
-
-(defun yas--menu-keymap-get-create (mode &optional parents)
- "Get or create the menu keymap for MODE and its PARENTS.
-
-This may very well create a plethora of menu keymaps and arrange
-them all in `yas--menu-table'"
- (let* ((menu-keymap (or (gethash mode yas--menu-table)
- (puthash mode (make-sparse-keymap)
yas--menu-table))))
- (mapc #'yas--menu-keymap-get-create parents)
- (define-key yas--minor-mode-menu (vector mode)
- `(menu-item ,(symbol-name mode) ,menu-keymap
- :visible (yas--show-menu-p ',mode)))
- menu-keymap))
-
-
-;;; Template-related and snippet loading functions
-
-(defun yas--parse-template (&optional file)
- "Parse the template in the current buffer.
-
-Optional FILE is the absolute file name of the file being
-parsed.
-
-Optional GROUP is the group where the template is to go,
-otherwise we attempt to calculate it from FILE.
-
-Return a snippet-definition, i.e. a list
-
- (KEY TEMPLATE NAME CONDITION GROUP VARS LOAD-FILE KEYBINDING UUID)
-
-If the buffer contains a line of \"# --\" then the contents above
-this line are ignored. Directives can set most of these with the syntax:
-
-# directive-name : directive-value
-
-Here's a list of currently recognized directives:
-
- * type
- * name
- * contributor
- * condition
- * group
- * key
- * expand-env
- * binding
- * uuid"
- (goto-char (point-min))
- (let* ((type 'snippet)
- (name (and file
- (file-name-nondirectory file)))
- (key nil)
- template
- bound
- condition
- (group (and file
- (yas--calculate-group file)))
- expand-env
- binding
- uuid)
- (if (re-search-forward "^# --\\s-*\n" nil t)
- (progn (setq template
- (buffer-substring-no-properties (point)
- (point-max)))
- (setq bound (point))
- (goto-char (point-min))
- (while (re-search-forward "^# *\\([^ ]+?\\) *:
*\\(.*?\\)[[:space:]]*$" bound t)
- (when (string= "uuid" (match-string-no-properties 1))
- (setq uuid (match-string-no-properties 2)))
- (when (string= "type" (match-string-no-properties 1))
- (setq type (if (string= "command"
(match-string-no-properties 2))
- 'command
- 'snippet)))
- (when (string= "key" (match-string-no-properties 1))
- (setq key (match-string-no-properties 2)))
- (when (string= "name" (match-string-no-properties 1))
- (setq name (match-string-no-properties 2)))
- (when (string= "condition" (match-string-no-properties 1))
- (setq condition (yas--read-lisp (match-string-no-properties
2))))
- (when (string= "group" (match-string-no-properties 1))
- (setq group (match-string-no-properties 2)))
- (when (string= "expand-env" (match-string-no-properties 1))
- (setq expand-env (yas--read-lisp
(match-string-no-properties 2)
- 'nil-on-error)))
- (when (string= "binding" (match-string-no-properties 1))
- (setq binding (match-string-no-properties 2)))))
- (setq template
- (buffer-substring-no-properties (point-min) (point-max))))
- (unless (or key binding)
- (setq key (and file (file-name-nondirectory file))))
- (when (eq type 'command)
- (setq template (yas--read-lisp (concat "(progn" template ")"))))
- (when group
- (setq group (split-string group "\\.")))
- (list key template name condition group expand-env file binding uuid)))
-
-(defun yas--calculate-group (file)
- "Calculate the group for snippet file path FILE."
- (let* ((dominating-dir (locate-dominating-file file
- ".yas-make-groups"))
- (extra-path (and dominating-dir
- (file-relative-name file dominating-dir)))
- (extra-dir (and extra-path
- (file-name-directory extra-path)))
- (group (and extra-dir
- (replace-regexp-in-string "/"
- "."
- (directory-file-name
extra-dir)))))
- group))
-
-(defun yas--subdirs (directory &optional filep)
- "Return subdirs or files of DIRECTORY according to FILEP."
- (cl-remove-if (lambda (file)
- (or (string-match "\\`\\."
- (file-name-nondirectory file))
- (string-match "\\`#.*#\\'"
- (file-name-nondirectory file))
- (string-match "~\\'"
- (file-name-nondirectory file))
- (if filep
- (file-directory-p file)
- (not (file-directory-p file)))))
- (directory-files directory t)))
-
-(defun yas--make-menu-binding (template)
- (let ((mode (yas--table-mode (yas--template-table template))))
- `(lambda () (interactive) (yas--expand-or-visit-from-menu ',mode
,(yas--template-uuid template)))))
-
-(defun yas--expand-or-visit-from-menu (mode uuid)
- (let* ((table (yas--table-get-create mode))
- (yas--current-template (and table
- (gethash uuid (yas--table-uuidhash
table)))))
- (when yas--current-template
- (if yas-visit-from-menu
- (yas--visit-snippet-file-1 yas--current-template)
- (let ((where (if (region-active-p)
- (cons (region-beginning) (region-end))
- (cons (point) (point)))))
- (yas-expand-snippet yas--current-template
- (car where) (cdr where)))))))
-
-(defun yas--key-from-desc (text)
- "Return a yasnippet key from a description string TEXT."
- (replace-regexp-in-string "\\(\\w+\\).*" "\\1" text))
-
-
-;;; Popping up for keys and templates
-
-(defun yas--prompt-for-template (templates &optional prompt)
- "Interactively choose a template from the list TEMPLATES.
-
-TEMPLATES is a list of `yas--template'.
-
-Optional PROMPT sets the prompt to use."
- (when templates
- (setq templates
- (sort templates #'(lambda (t1 t2)
- (< (length (yas--template-name t1))
- (length (yas--template-name t2))))))
- (cl-some (lambda (fn)
- (funcall fn (or prompt "Choose a snippet: ")
- templates
- #'yas--template-name))
- yas-prompt-functions)))
-
-(defun yas--prompt-for-keys (keys &optional prompt)
- "Interactively choose a template key from the list KEYS.
-
-Optional PROMPT sets the prompt to use."
- (when keys
- (cl-some (lambda (fn)
- (funcall fn (or prompt "Choose a snippet key: ") keys))
- yas-prompt-functions)))
-
-(defun yas--prompt-for-table (tables &optional prompt)
- "Interactively choose a table from the list TABLES.
-
-Optional PROMPT sets the prompt to use."
- (when tables
- (cl-some (lambda (fn)
- (funcall fn (or prompt "Choose a snippet table: ")
- tables
- #'yas--table-name))
- yas-prompt-functions)))
-
-(defun yas-x-prompt (prompt choices &optional display-fn)
- "Display choices in a x-window prompt."
- (when (and window-system choices)
- ;; Let window position be recalculated to ensure that
- ;; `posn-at-point' returns non-nil.
- (redisplay)
- (or
- (x-popup-menu
- (if (fboundp 'posn-at-point)
- (let ((x-y (posn-x-y (posn-at-point (point)))))
- (list (list (+ (car x-y) 10)
- (+ (cdr x-y) 20))
- (selected-window)))
- t)
- `(,prompt ("title"
- ,@(cl-mapcar (lambda (c d) `(,(concat " " d) . ,c))
- choices
- (if display-fn (mapcar display-fn choices)
- choices)))))
- (keyboard-quit))))
-
-(defun yas-maybe-ido-prompt (prompt choices &optional display-fn)
- (when (bound-and-true-p ido-mode)
- (yas-ido-prompt prompt choices display-fn)))
-
-(defun yas-ido-prompt (prompt choices &optional display-fn)
- (require 'ido)
- (yas-completing-prompt prompt choices display-fn #'ido-completing-read))
-
-(defun yas-dropdown-prompt (_prompt choices &optional display-fn)
- (when (fboundp 'dropdown-list)
- (let* ((formatted-choices
- (if display-fn (mapcar display-fn choices) choices))
- (n (dropdown-list formatted-choices)))
- (if n (nth n choices)
- (keyboard-quit)))))
-
-(defun yas-completing-prompt (prompt choices &optional display-fn
completion-fn)
- (let* ((formatted-choices
- (if display-fn (mapcar display-fn choices) choices))
- (chosen (funcall (or completion-fn #'completing-read)
- prompt formatted-choices
- nil 'require-match nil nil)))
- (if (eq choices formatted-choices)
- chosen
- (nth (or (cl-position chosen formatted-choices :test #'string=) 0)
- choices))))
-
-(defun yas-no-prompt (_prompt choices &optional _display-fn)
- (cl-first choices))
-
-
-;;; Defining snippets
-;; This consists of creating and registering `yas--template' objects in the
-;; correct tables.
-;;
-
-(defvar yas--creating-compiled-snippets nil)
-
-(defun yas--define-snippets-1 (snippet snippet-table)
- "Helper for `yas-define-snippets'."
- ;; Update the appropriate table. Also takes care of adding the
- ;; key indicators in the templates menu entry, if any.
- (yas--update-template
- snippet-table (apply #'yas--define-snippets-2 snippet-table snippet)))
-
-(defun yas-define-snippets (mode snippets)
- "Define SNIPPETS for MODE.
-
-SNIPPETS is a list of snippet definitions, each taking the
-following form
-
- (KEY TEMPLATE NAME CONDITION GROUP EXPAND-ENV LOAD-FILE KEYBINDING UUID
SAVE-FILE)
-
-Within these, only KEY and TEMPLATE are actually mandatory.
-
-TEMPLATE might be a Lisp form or a string, depending on whether
-this is a snippet or a snippet-command.
-
-CONDITION, EXPAND-ENV and KEYBINDING are Lisp forms, they have
-been `yas--read-lisp'-ed and will eventually be
-`yas--eval-for-string'-ed.
-
-The remaining elements are strings.
-
-FILE is probably of very little use if you're programatically
-defining snippets.
-
-UUID is the snippet's \"unique-id\". Loading a second snippet
-file with the same uuid would replace the previous snippet.
-
-You can use `yas--parse-template' to return such lists based on
-the current buffers contents."
- (if yas--creating-compiled-snippets
- (let ((print-length nil))
- (insert ";;; Snippet definitions:\n;;;\n")
- (dolist (snippet snippets)
- ;; Fill in missing elements with nil.
- (setq snippet (append snippet (make-list (- 10 (length snippet))
nil)))
- ;; Move LOAD-FILE to SAVE-FILE because we will load from the
- ;; compiled file, not LOAD-FILE.
- (let ((load-file (nth 6 snippet)))
- (setcar (nthcdr 6 snippet) nil)
- (setcar (nthcdr 9 snippet) load-file)))
- (insert (pp-to-string
- `(yas-define-snippets ',mode ',snippets)))
- (insert "\n\n"))
- ;; Normal case.
- (let ((snippet-table (yas--table-get-create mode))
- (template nil))
- (dolist (snippet snippets)
- (setq template (yas--define-snippets-1 snippet
- snippet-table)))
- template)))
-
-
-;;; Loading snippets from files
-
-(defun yas--template-get-file (template)
- "Return TEMPLATE's LOAD-FILE or SAVE-FILE."
- (or (yas--template-load-file template)
- (let ((file (yas--template-save-file template)))
- (when file
- (yas--message 3 "%s has no load file, using save file, %s, instead."
- (yas--template-name template) file))
- file)))
-
-(defun yas--load-yas-setup-file (file)
- (if (not yas--creating-compiled-snippets)
- ;; Normal case.
- (load file 'noerror (<= yas-verbosity 4))
- (let ((elfile (concat file ".el")))
- (when (file-exists-p elfile)
- (insert ";;; contents of the .yas-setup.el support file:\n;;;\n")
- (insert-file-contents elfile)
- (goto-char (point-max))))))
-
-(defun yas--define-parents (mode parents)
- "Add PARENTS to the list of MODE's parents."
- (puthash mode (cl-remove-duplicates
- (append parents
- (gethash mode yas--parents)))
- yas--parents))
-
-(defun yas-load-directory (top-level-dir &optional use-jit interactive)
- "Load snippets in directory hierarchy TOP-LEVEL-DIR.
-
-Below TOP-LEVEL-DIR each directory should be a mode name.
-
-With prefix argument USE-JIT do jit-loading of snippets."
- (interactive
- (list (read-directory-name "Select the root directory: " nil nil t)
- current-prefix-arg t))
- (unless yas-snippet-dirs
- (setq yas-snippet-dirs top-level-dir))
- (let ((impatient-buffers))
- (dolist (dir (yas--subdirs top-level-dir))
- (let* ((major-mode-and-parents (yas--compute-major-mode-and-parents
- (concat dir "/dummy")))
- (mode-sym (car major-mode-and-parents))
- (parents (cdr major-mode-and-parents)))
- ;; Attention: The parents and the menus are already defined
- ;; here, even if the snippets are later jit-loaded.
- ;;
- ;; * We need to know the parents at this point since entering a
- ;; given mode should jit load for its parents
- ;; immediately. This could be reviewed, the parents could be
- ;; discovered just-in-time-as well
- ;;
- ;; * We need to create the menus here to support the `full'
- ;; option to `yas-use-menu' (all known snippet menus are shown to
the user)
- ;;
- (yas--define-parents mode-sym parents)
- (yas--menu-keymap-get-create mode-sym)
- (let ((fun (apply-partially #'yas--load-directory-1 dir mode-sym)))
- (if use-jit
- (yas--schedule-jit mode-sym fun)
- (funcall fun)))
- ;; Look for buffers that are already in `mode-sym', and so
- ;; need the new snippets immediately...
- ;;
- (when use-jit
- (cl-loop for buffer in (buffer-list)
- do (with-current-buffer buffer
- (when (eq major-mode mode-sym)
- (yas--message 4 "Discovered there was already %s in
%s" buffer mode-sym)
- (push buffer impatient-buffers)))))))
- ;; ...after TOP-LEVEL-DIR has been completely loaded, call
- ;; `yas--load-pending-jits' in these impatient buffers.
- ;;
- (cl-loop for buffer in impatient-buffers
- do (with-current-buffer buffer (yas--load-pending-jits))))
- (when interactive
- (yas--message 3 "Loaded snippets from %s." top-level-dir)))
-
-(defun yas--load-directory-1 (directory mode-sym)
- "Recursively load snippet templates from DIRECTORY."
- (if yas--creating-compiled-snippets
- (let ((output-file (expand-file-name ".yas-compiled-snippets.el"
- directory)))
- (with-temp-file output-file
- (insert (format ";;; Compiled snippets and support files for `%s'\n"
- mode-sym))
- (yas--load-directory-2 directory mode-sym)
- (insert (format ";;; Do not edit! File generated at %s\n"
- (current-time-string)))))
- ;; Normal case.
- (unless (file-exists-p (expand-file-name ".yas-skip" directory))
- (unless (and (load (expand-file-name ".yas-compiled-snippets" directory)
'noerror (<= yas-verbosity 3))
- (progn (yas--message 4 "Loaded compiled snippets from %s"
directory) t))
- (yas--message 4 "Loading snippet files from %s" directory)
- (yas--load-directory-2 directory mode-sym)))))
-
-(defun yas--load-directory-2 (directory mode-sym)
- ;; Load .yas-setup.el files wherever we find them
- ;;
- (yas--load-yas-setup-file (expand-file-name ".yas-setup" directory))
- (let* ((default-directory directory)
- (snippet-defs nil))
- ;; load the snippet files
- ;;
- (with-temp-buffer
- (dolist (file (yas--subdirs directory 'no-subdirs-just-files))
- (when (file-readable-p file)
- ;; Erase the buffer instead of passing non-nil REPLACE to
- ;; `insert-file-contents' (avoids Emacs bug #23659).
- (erase-buffer)
- (insert-file-contents file)
- (push (yas--parse-template file)
- snippet-defs))))
- (when snippet-defs
- (yas-define-snippets mode-sym
- snippet-defs))
- ;; now recurse to a lower level
- ;;
- (dolist (subdir (yas--subdirs directory))
- (yas--load-directory-2 subdir
- mode-sym))))
-
-(defun yas--load-snippet-dirs (&optional nojit)
- "Reload the directories listed in `yas-snippet-dirs' or
-prompt the user to select one."
- (let (errors)
- (if (null yas-snippet-dirs)
- (call-interactively 'yas-load-directory)
- (when (member yas--default-user-snippets-dir yas-snippet-dirs)
- (make-directory yas--default-user-snippets-dir t))
- (dolist (directory (reverse (yas-snippet-dirs)))
- (cond ((file-directory-p directory)
- (yas-load-directory directory (not nojit))
- (if nojit
- (yas--message 4 "Loaded %s" directory)
- (yas--message 4 "Prepared just-in-time loading for %s"
directory)))
- (t
- (push (yas--message 1 "Check your `yas-snippet-dirs': %s is not
a directory" directory) errors)))))
- errors))
-
-(defun yas-reload-all (&optional no-jit interactive)
- "Reload all snippets and rebuild the YASnippet menu.
-
-When NO-JIT is non-nil force immediate reload of all known
-snippets under `yas-snippet-dirs', otherwise use just-in-time
-loading.
-
-When called interactively, use just-in-time loading when given a
-prefix argument."
- (interactive (list (not current-prefix-arg) t))
- (catch 'abort
- (let ((errors)
- (snippet-editing-buffers
- (cl-remove-if-not (lambda (buffer)
- (with-current-buffer buffer
- yas--editing-template))
- (buffer-list))))
- ;; Warn if there are buffers visiting snippets, since reloading will
break
- ;; any on-line editing of those buffers.
- ;;
- (when snippet-editing-buffers
- (if interactive
- (if (y-or-n-p "Some buffers editing live snippets, close them
and proceed with reload? ")
- (mapc #'kill-buffer snippet-editing-buffers)
- (yas--message 1 "Aborted reload...")
- (throw 'abort nil))
- ;; in a non-interactive use, at least set
- ;; `yas--editing-template' to nil, make it guess it next time
around
- (mapc #'(lambda (buffer)
- (with-current-buffer buffer
- (kill-local-variable 'yas--editing-template)))
- (buffer-list))))
-
- ;; Empty all snippet tables and parenting info
- ;;
- (setq yas--tables (make-hash-table))
- (setq yas--parents (make-hash-table))
-
- ;; Before killing `yas--menu-table' use its keys to cleanup the
- ;; mode menu parts of `yas--minor-mode-menu' (thus also cleaning
- ;; up `yas-minor-mode-map', which points to it)
- ;;
- (maphash #'(lambda (menu-symbol _keymap)
- (define-key yas--minor-mode-menu (vector menu-symbol) nil))
- yas--menu-table)
- ;; Now empty `yas--menu-table' as well
- (setq yas--menu-table (make-hash-table))
-
- ;; Cancel all pending 'yas--scheduled-jit-loads'
- ;;
- (setq yas--scheduled-jit-loads (make-hash-table))
-
- ;; Reload the directories listed in `yas-snippet-dirs' or prompt
- ;; the user to select one.
- ;;
- (setq errors (yas--load-snippet-dirs no-jit))
- ;; Reload the direct keybindings
- ;;
- (yas-direct-keymaps-reload)
-
- (run-hooks 'yas-after-reload-hook)
- (let ((no-snippets
- (cl-every (lambda (table) (= (hash-table-count table) 0))
- (list yas--scheduled-jit-loads
- yas--parents yas--tables))))
- (yas--message (if (or no-snippets errors) 2 3)
- (if no-jit "Snippets loaded %s."
- "Prepared just-in-time loading of snippets %s.")
- (cond (errors
- "with some errors. Check *Messages*")
- (no-snippets
- "(but no snippets found)")
- (t
- "successfully")))))))
-
-(defvar yas-after-reload-hook nil
- "Hooks run after `yas-reload-all'.")
-
-(defun yas--load-pending-jits ()
- (dolist (mode (yas--modes-to-activate))
- (let ((funs (reverse (gethash mode yas--scheduled-jit-loads))))
- ;; must reverse to maintain coherence with `yas-snippet-dirs'
- (dolist (fun funs)
- (yas--message 4 "Loading for `%s', just-in-time: %s!" mode fun)
- (funcall fun))
- (remhash mode yas--scheduled-jit-loads))))
-
-(defun yas-escape-text (text)
- "Escape TEXT for snippet."
- (when text
- (replace-regexp-in-string "[\\$]" "\\\\\\&" text)))
-
-
-;;; Snippet compilation function
-
-(defun yas-compile-directory (top-level-dir)
- "Create .yas-compiled-snippets.el files under subdirs of TOP-LEVEL-DIR.
-
-This works by stubbing a few functions, then calling
-`yas-load-directory'."
- (interactive "DTop level snippet directory?")
- (let ((yas--creating-compiled-snippets t))
- (yas-load-directory top-level-dir nil)))
-
-(defun yas-recompile-all ()
- "Compile every dir in `yas-snippet-dirs'."
- (interactive)
- (mapc #'yas-compile-directory (yas-snippet-dirs)))
-
-
-;;; JIT loading
-;;;
-
-(defvar yas--scheduled-jit-loads (make-hash-table)
- "Alist of mode-symbols to forms to be evaled when `yas-minor-mode' kicks
in.")
-
-(defun yas--schedule-jit (mode fun)
- (push fun (gethash mode yas--scheduled-jit-loads)))
-
-
-
-;;; Some user level functions
-
-(defun yas-about ()
- (interactive)
- (message "yasnippet (version %s) -- pluskid/joaotavora/npostavs"
- (or (ignore-errors (car (let ((default-directory yas--loaddir))
- (process-lines "git" "describe"
- "--tags" "--dirty"))))
- (when (and (featurep 'package)
- (fboundp 'package-desc-version)
- (fboundp 'package-version-join))
- (defvar package-alist)
- (ignore-errors
- (let* ((yas-pkg (cdr (assq 'yasnippet package-alist)))
- (version (package-version-join
- (package-desc-version (car yas-pkg)))))
- ;; Special case for MELPA's bogus version numbers.
- (if (string-match
"\\`20..[01][0-9][0-3][0-9][.][0-9]\\{3,4\\}\\'"
- version)
- (concat yas--version "-snapshot" version)
- version))))
- yas--version)))
-
-
-;;; Apropos snippet menu:
-;;
-;; The snippet menu keymaps are stored by mode in hash table called
-;; `yas--menu-table'. They are linked to the main menu in
-;; `yas--menu-keymap-get-create' and are initially created empty,
-;; reflecting the table hierarchy.
-;;
-;; They can be populated in two mutually exclusive ways: (1) by
-;; reading `yas--template-group', which in turn is populated by the "#
-;; group:" directives of the snippets or the ".yas-make-groups" file
-;; or (2) by using a separate `yas-define-menu' call, which declares a
-;; menu structure based on snippets uuids.
-;;
-;; Both situations are handled in `yas--update-template-menu', which
-;; uses the predicate `yas--template-menu-managed-by-yas-define-menu'
-;; that can tell between the two situations.
-;;
-;; Note:
-;;
-;; * if `yas-define-menu' is used it must run before
-;; `yas-define-snippets' and the UUIDS must match, otherwise we get
-;; duplicate entries. The `yas--template' objects are created in
-;; `yas-define-menu', holding nothing but the menu entry,
-;; represented by a pair of ((menu-item NAME :keys KEYS) TYPE) and
-;; stored in `yas--template-menu-binding-pair'. The (menu-item ...)
-;; part is then stored in the menu keymap itself which make the item
-;; appear to the user. These limitations could probably be revised.
-;;
-;; * The `yas--template-perm-group' slot is only used in
-;; `yas-describe-tables'.
-;;
-(defun yas--template-menu-binding-pair-get-create (template &optional type)
- "Get TEMPLATE's menu binding or assign it a new one.
-
-TYPE may be `:stay', signaling this menu binding should be
-static in the menu."
- (or (yas--template-menu-binding-pair template)
- (let (;; (key (yas--template-key template))
- ;; (keybinding (yas--template-keybinding template))
- )
- (setf (yas--template-menu-binding-pair template)
- (cons `(menu-item ,(or (yas--template-name template)
- (yas--template-uuid template))
- ,(yas--make-menu-binding template)
- :keys ,nil)
- type)))))
-(defun yas--template-menu-managed-by-yas-define-menu (template)
- "Non-nil if TEMPLATE's menu entry was included in a `yas-define-menu' call."
- (cdr (yas--template-menu-binding-pair template)))
-
-
-(defun yas--show-menu-p (mode)
- (cond ((eq yas-use-menu 'abbreviate)
- (cl-find mode
- (mapcar #'yas--table-mode
- (yas--get-snippet-tables))))
- (yas-use-menu t)))
-
-(defun yas--delete-from-keymap (keymap uuid)
- "Recursively delete items with UUID from KEYMAP and its submenus."
-
- ;; XXX: This used to skip any submenus named \"parent mode\"
- ;;
- ;; First of all, recursively enter submenus, i.e. the tree is
- ;; searched depth first so that stale submenus can be found in the
- ;; higher passes.
- ;;
- (mapc #'(lambda (item)
- (when (and (consp (cdr-safe item))
- (keymapp (nth 2 (cdr item))))
- (yas--delete-from-keymap (nth 2 (cdr item)) uuid)))
- (cdr keymap))
- ;; Set the uuid entry to nil
- ;;
- (define-key keymap (vector (make-symbol uuid)) nil)
- ;; Destructively modify keymap
- ;;
- (setcdr keymap (cl-delete-if (lambda (item)
- (cond ((not (listp item)) nil)
- ((null (cdr item)))
- ((and (keymapp (nth 2 (cdr item)))
- (null (cdr (nth 2 (cdr
item))))))))
- (cdr keymap))))
-
-(defun yas-define-menu (mode menu &optional omit-items)
- "Define a snippet menu for MODE according to MENU, omitting OMIT-ITEMS.
-
-MENU is a list, its elements can be:
-
-- (yas-item UUID) : Creates an entry the snippet identified with
- UUID. The menu entry for a snippet thus identified is
- permanent, i.e. it will never move (be reordered) in the menu.
-
-- (yas-separator) : Creates a separator
-
-- (yas-submenu NAME SUBMENU) : Creates a submenu with NAME,
- SUBMENU has the same form as MENU. NAME is also added to the
- list of groups of the snippets defined thereafter.
-
-OMIT-ITEMS is a list of snippet uuids that will always be
-omitted from MODE's menu, even if they're manually loaded."
- (let* ((table (yas--table-get-create mode))
- (hash (yas--table-uuidhash table)))
- (yas--define-menu-1 table
- (yas--menu-keymap-get-create mode)
- menu
- hash)
- (dolist (uuid omit-items)
- (let ((template (or (gethash uuid hash)
- (puthash uuid
- (yas--make-template :table table
- :uuid uuid)
- hash))))
- (setf (yas--template-menu-binding-pair template) (cons nil :none))))))
-
-(defun yas--define-menu-1 (table menu-keymap menu uuidhash &optional
group-list)
- "Helper for `yas-define-menu'."
- (cl-loop
- for (type name submenu) in (reverse menu)
- collect (cond
- ((or (eq type 'yas-item)
- (and yas-alias-to-yas/prefix-p
- (eq type 'yas/item)))
- (let ((template (or (gethash name uuidhash)
- (puthash name
- (yas--make-template
- :table table
- :perm-group group-list
- :uuid name)
- uuidhash))))
- (car (yas--template-menu-binding-pair-get-create
- template :stay))))
- ((or (eq type 'yas-submenu)
- (and yas-alias-to-yas/prefix-p
- (eq type 'yas/submenu)))
- (let ((subkeymap (make-sparse-keymap)))
- (yas--define-menu-1 table subkeymap submenu uuidhash
- (append group-list (list name)))
- `(menu-item ,name ,subkeymap)))
- ((or (eq type 'yas-separator)
- (and yas-alias-to-yas/prefix-p
- (eq type 'yas/separator)))
- '(menu-item "----"))
- (t (yas--message 1 "Don't know anything about menu entry %s" type)
- nil))
- into menu-entries
- finally do (push (apply #'vector menu-entries) (cdr menu-keymap))))
-
-(defun yas--define (mode key template &optional name condition group)
- "Define a snippet. Expanding KEY into TEMPLATE.
-
-NAME is a description to this template. Also update the menu if
-`yas-use-menu' is t. CONDITION is the condition attached to
-this snippet. If you attach a condition to a snippet, then it
-will only be expanded when the condition evaluated to non-nil."
- (yas-define-snippets mode
- (list (list key template name condition group))))
-
-(defun yas-hippie-try-expand (first-time?)
- "Integrate with hippie expand.
-
-Just put this function in `hippie-expand-try-functions-list'."
- (when yas-minor-mode
- (if (not first-time?)
- (let ((yas-fallback-behavior 'return-nil))
- (yas-expand))
- (undo 1)
- nil)))
-
-
-;;; Apropos condition-cache:
-;;;
-;;;
-;;;
-;;;
-(defmacro yas-define-condition-cache (func doc &rest body)
- "Define a function FUNC with doc DOC and body BODY.
-BODY is executed at most once every snippet expansion attempt, to check
-expansion conditions.
-
-It doesn't make any sense to call FUNC programatically."
- `(defun ,func () ,(if (and doc
- (stringp doc))
- (concat doc
-"\n\nFor use in snippets' conditions. Within each
-snippet-expansion routine like `yas-expand', computes actual
-value for the first time then always returns a cached value.")
- (setq body (cons doc body))
- nil)
- (let ((timestamp-and-value (get ',func 'yas--condition-cache)))
- (if (equal (car timestamp-and-value) yas--condition-cache-timestamp)
- (cdr timestamp-and-value)
- (let ((new-value (progn
- ,@body
- )))
- (put ',func 'yas--condition-cache (cons
yas--condition-cache-timestamp new-value))
- new-value)))))
-
-(defalias 'yas-expand 'yas-expand-from-trigger-key)
-(defun yas-expand-from-trigger-key (&optional field)
- "Expand a snippet before point.
-
-If no snippet expansion is possible, fall back to the behaviour
-defined in `yas-fallback-behavior'.
-
-Optional argument FIELD is for non-interactive use and is an
-object satisfying `yas--field-p' to restrict the expansion to."
- (interactive)
- (setq yas--condition-cache-timestamp (current-time))
- (let (templates-and-pos)
- (unless (and yas-expand-only-for-last-commands
- (not (member last-command yas-expand-only-for-last-commands)))
- (setq templates-and-pos (if field
- (save-restriction
- (narrow-to-region (yas--field-start field)
- (yas--field-end field))
- (yas--templates-for-key-at-point))
- (yas--templates-for-key-at-point))))
- (if templates-and-pos
- (yas--expand-or-prompt-for-template
- (nth 0 templates-and-pos)
- ;; Delete snippet key and active region when expanding.
- (min (if (use-region-p) (region-beginning) most-positive-fixnum)
- (nth 1 templates-and-pos))
- (max (if (use-region-p) (region-end) most-negative-fixnum)
- (nth 2 templates-and-pos)))
- (yas--fallback))))
-
-(defun yas--maybe-expand-from-keymap-filter (cmd)
- "Check whether a snippet may be expanded.
-If there are expandable snippets, return CMD (this is useful for
-conditional keybindings) or the list of expandable snippet
-template objects if CMD is nil (this is useful as a more general predicate)."
- (let* ((yas--condition-cache-timestamp (current-time))
- (vec (cl-subseq (this-command-keys-vector)
- (if current-prefix-arg
- (length (this-command-keys))
- 0)))
- (templates (cl-mapcan (lambda (table)
- (yas--fetch table vec))
- (yas--get-snippet-tables))))
- (if templates (or cmd templates))))
-
-(defun yas-expand-from-keymap ()
- "Directly expand some snippets, searching `yas--direct-keymaps'."
- (interactive)
- (setq yas--condition-cache-timestamp (current-time))
- (let* ((templates (yas--maybe-expand-from-keymap-filter nil)))
- (when templates
- (yas--expand-or-prompt-for-template templates))))
-
-(defun yas--expand-or-prompt-for-template (templates &optional start end)
- "Expand one of TEMPLATES from START to END.
-
-Prompt the user if TEMPLATES has more than one element, else
-expand immediately. Common gateway for
-`yas-expand-from-trigger-key' and `yas-expand-from-keymap'."
- (let ((yas--current-template
- (or (and (cl-rest templates) ;; more than one
- (yas--prompt-for-template (mapcar #'cdr templates)))
- (cdar templates))))
- (when yas--current-template
- (yas-expand-snippet yas--current-template start end))))
-
-;; Apropos the trigger key and the fallback binding:
-;;
-;; When `yas-minor-mode-map' binds <tab>, that correctly overrides
-;; org-mode's <tab>, for example and searching for fallbacks correctly
-;; returns `org-cycle'. However, most other modes bind "TAB". TODO,
-;; improve this explanation.
-;;
-(defun yas--fallback ()
- "Fallback after expansion has failed.
-
-Common gateway for `yas-expand-from-trigger-key' and
-`yas-expand-from-keymap'."
- (cond ((eq yas-fallback-behavior 'return-nil)
- ;; return nil
- nil)
- ((eq yas-fallback-behavior 'yas--fallback)
- (error (concat "yasnippet fallback loop!\n"
- "This can happen when you bind `yas-expand' "
- "outside of the `yas-minor-mode-map'.")))
- ((eq yas-fallback-behavior 'call-other-command)
- (let* ((yas-fallback-behavior 'yas--fallback)
- ;; Also bind `yas-minor-mode' to prevent fallback
- ;; loops when other extensions use mechanisms similar
- ;; to `yas--keybinding-beyond-yasnippet'. (github #525
- ;; and #526)
- ;;
- (yas-minor-mode nil)
- (beyond-yasnippet (yas--keybinding-beyond-yasnippet)))
- (yas--message 4 "Falling back to %s" beyond-yasnippet)
- (cl-assert (or (null beyond-yasnippet) (commandp beyond-yasnippet)))
- (setq this-command beyond-yasnippet)
- (when beyond-yasnippet
- (call-interactively beyond-yasnippet))))
- ((and (listp yas-fallback-behavior)
- (cdr yas-fallback-behavior)
- (eq 'apply (car yas-fallback-behavior)))
- (let ((command-or-fn (cadr yas-fallback-behavior))
- (args (cddr yas-fallback-behavior))
- (yas-fallback-behavior 'yas--fallback)
- (yas-minor-mode nil))
- (if args
- (apply command-or-fn args)
- (when (commandp command-or-fn)
- (setq this-command command-or-fn)
- (call-interactively command-or-fn)))))
- (t
- ;; also return nil if all the other fallbacks have failed
- nil)))
-
-(defun yas--keybinding-beyond-yasnippet ()
- "Get current keys's binding as if YASsnippet didn't exist."
- (let* ((yas-minor-mode nil)
- (yas--direct-keymaps nil)
- (keys (this-single-command-keys)))
- (or (key-binding keys t)
- (key-binding (yas--fallback-translate-input keys) t))))
-
-(defun yas--fallback-translate-input (keys)
- "Emulate `read-key-sequence', at least what I think it does.
-
-Keys should be an untranslated key vector. Returns a translated
-vector of keys. FIXME not thoroughly tested."
- (let ((retval [])
- (i 0))
- (while (< i (length keys))
- (let ((j i)
- (translated local-function-key-map))
- (while (and (< j (length keys))
- translated
- (keymapp translated))
- (setq translated (cdr (assoc (aref keys j) (remove 'keymap
translated)))
- j (1+ j)))
- (setq retval (vconcat retval (cond ((symbolp translated)
- `[,translated])
- ((vectorp translated)
- translated)
- (t
- (substring keys i j)))))
- (setq i j)))
- retval))
-
-
-;;; Utils for snippet development:
-
-(defun yas--all-templates (tables)
- "Get `yas--template' objects in TABLES, applicable for buffer and point.
-
-Honours `yas-choose-tables-first', `yas-choose-keys-first' and
-`yas-buffer-local-condition'"
- (when yas-choose-tables-first
- (setq tables (list (yas--prompt-for-table tables))))
- (mapcar #'cdr
- (if yas-choose-keys-first
- (let ((key (yas--prompt-for-keys
- (cl-mapcan #'yas--table-all-keys tables))))
- (when key
- (cl-mapcan (lambda (table)
- (yas--fetch table key))
- tables)))
- (cl-remove-duplicates (cl-mapcan #'yas--table-templates tables)
- :test #'equal))))
-
-(defun yas--lookup-snippet-1 (name mode)
- "Get the snippet called NAME in MODE's tables."
- (let ((yas-choose-tables-first nil) ; avoid prompts
- (yas-choose-keys-first nil))
- (cl-find name (yas--all-templates
- (yas--get-snippet-tables mode))
- :key #'yas--template-name :test #'string=)))
-
-(defun yas-lookup-snippet (name &optional mode noerror)
- "Get the snippet named NAME in MODE's tables.
-
-MODE defaults to the current buffer's `major-mode'. If NOERROR
-is non-nil, then don't signal an error if there isn't any snippet
-called NAME.
-
-Honours `yas-buffer-local-condition'."
- (cond
- ((yas--lookup-snippet-1 name mode))
- (noerror nil)
- (t (error "No snippet named: %s" name))))
-
-(defun yas-insert-snippet (&optional no-condition)
- "Choose a snippet to expand, pop-up a list of choices according
-to `yas-prompt-functions'.
-
-With prefix argument NO-CONDITION, bypass filtering of snippets
-by condition."
- (interactive "P")
- (setq yas--condition-cache-timestamp (current-time))
- (let* ((yas-buffer-local-condition (or (and no-condition
- 'always)
- yas-buffer-local-condition))
- (templates (yas--all-templates (yas--get-snippet-tables)))
- (yas--current-template (and templates
- (or (and (cl-rest templates) ;; more than
one template for same key
- (yas--prompt-for-template
templates))
- (car templates))))
- (where (if (region-active-p)
- (cons (region-beginning) (region-end))
- (cons (point) (point)))))
- (if yas--current-template
- (yas-expand-snippet yas--current-template (car where) (cdr where))
- (yas--message 1 "No snippets can be inserted here!"))))
-
-(defun yas-visit-snippet-file ()
- "Choose a snippet to edit, selection like `yas-insert-snippet'.
-
-Only success if selected snippet was loaded from a file. Put the
-visited file in `snippet-mode'."
- (interactive)
- (let* ((yas-buffer-local-condition 'always)
- (templates (yas--all-templates (yas--get-snippet-tables)))
- (template (and templates
- (or (yas--prompt-for-template templates
- "Choose a snippet
template to edit: ")
- (car templates)))))
-
- (if template
- (yas--visit-snippet-file-1 template)
- (message "No snippets tables active!"))))
-
-(defun yas--visit-snippet-file-1 (template)
- "Helper for `yas-visit-snippet-file'."
- (let ((file (yas--template-get-file template)))
- (cond ((and file (file-readable-p file))
- (find-file-other-window file)
- (snippet-mode)
- (set (make-local-variable 'yas--editing-template) template))
- (file
- (message "Original file %s no longer exists!" file))
- (t
- (switch-to-buffer (format "*%s*"(yas--template-name template)))
- (let ((type 'snippet))
- (when (listp (yas--template-content template))
- (insert (format "# type: command\n"))
- (setq type 'command))
- (insert (format "# key: %s\n" (yas--template-key template)))
- (insert (format "# name: %s\n" (yas--template-name template)))
- (when (yas--template-keybinding template)
- (insert (format "# binding: %s\n" (yas--template-keybinding
template))))
- (when (yas--template-expand-env template)
- (insert (format "# expand-env: %s\n" (yas--template-expand-env
template))))
- (when (yas--template-condition template)
- (insert (format "# condition: %s\n" (yas--template-condition
template))))
- (insert "# --\n")
- (insert (if (eq type 'command)
- (pp-to-string (yas--template-content template))
- (yas--template-content template))))
- (snippet-mode)
- (set (make-local-variable 'yas--editing-template) template)
- (set (make-local-variable 'default-directory)
- (car (cdr (car (yas--guess-snippet-directories
(yas--template-table template))))))))))
-
-(defun yas--guess-snippet-directories-1 (table)
- "Guess possible snippet subdirectories for TABLE."
- (cons (file-name-as-directory (yas--table-name table))
- (cl-mapcan #'yas--guess-snippet-directories-1
- (yas--table-parents table))))
-
-(defun yas--guess-snippet-directories (&optional table)
- "Try to guess suitable directories based on the current active
-tables (or optional TABLE).
-
-Returns a list of elements (TABLE . DIRS) where TABLE is a
-`yas--table' object and DIRS is a list of all possible directories
-where snippets of table might exist."
- (let ((main-dir (car (or (yas-snippet-dirs)
- (setq yas-snippet-dirs
- (list yas--default-user-snippets-dir)))))
- (tables (if table (list table)
- (yas--get-snippet-tables))))
- ;; HACK! the snippet table created here is actually registered!
- (unless table
- ;; The major mode is probably the best guess, put it first.
- (let ((major-mode-table (yas--table-get-create major-mode)))
- (cl-callf2 delq major-mode-table tables)
- (push major-mode-table tables)))
-
- (mapcar #'(lambda (table)
- (cons table
- (mapcar #'(lambda (subdir)
- (expand-file-name subdir main-dir))
- (yas--guess-snippet-directories-1 table))))
- tables)))
-
-(defun yas--make-directory-maybe (table-and-dirs &optional main-table-string)
- "Return a dir inside TABLE-AND-DIRS, prompts for creation if none exists."
- (or (cl-some (lambda (dir) (when (file-directory-p dir) dir))
- (cdr table-and-dirs))
- (let ((candidate (cl-first (cdr table-and-dirs))))
- (unless (file-writable-p (file-name-directory candidate))
- (error (yas--format "%s is not writable." candidate)))
- (if (y-or-n-p (format "Guessed directory (%s) for%s%s table \"%s\"
does not exist! Create? "
- candidate
- (if (gethash (yas--table-mode (car
table-and-dirs))
- yas--tables)
- ""
- " brand new")
- (or main-table-string
- "")
- (yas--table-name (car table-and-dirs))))
- (progn
- (make-directory candidate 'also-make-parents)
- ;; create the .yas-parents file here...
- candidate)))))
-
-;; NOTE: Using the traditional "*new snippet*" stops whitespace mode
-;; from activating (it doesn't like the leading "*").
-(defconst yas-new-snippet-buffer-name "+new-snippet+")
-
-(defun yas-new-snippet (&optional no-template)
- "Pops a new buffer for writing a snippet.
-
-Expands a snippet-writing snippet, unless the optional prefix arg
-NO-TEMPLATE is non-nil."
- (interactive "P")
- (let ((guessed-directories (yas--guess-snippet-directories))
- (yas-selected-text (or yas-selected-text
- (and (region-active-p)
- (buffer-substring-no-properties
- (region-beginning) (region-end))))))
-
- (switch-to-buffer yas-new-snippet-buffer-name)
- (erase-buffer)
- (kill-all-local-variables)
- (snippet-mode)
- (yas-minor-mode 1)
- (set (make-local-variable 'yas--guessed-modes)
- (mapcar (lambda (d) (yas--table-mode (car d)))
- guessed-directories))
- (set (make-local-variable 'default-directory)
- (car (cdr (car guessed-directories))))
- (if (and (not no-template) yas-new-snippet-default)
- (yas-expand-snippet yas-new-snippet-default))))
-
-(defun yas--compute-major-mode-and-parents (file)
- "Given FILE, find the nearest snippet directory for a given mode.
-
-Returns a list (MODE-SYM PARENTS), the mode's symbol and a list
-representing one or more of the mode's parents.
-
-Note that MODE-SYM need not be the symbol of a real major mode,
-neither do the elements of PARENTS."
- (let* ((file-dir (and file
- (directory-file-name
- (or (cl-some (lambda (special)
- (locate-dominating-file file special))
- '(".yas-setup.el"
- ".yas-make-groups"
- ".yas-parents"))
- (directory-file-name (file-name-directory
file))))))
- (parents-file-name (concat file-dir "/.yas-parents"))
- (major-mode-name (and file-dir
- (file-name-nondirectory file-dir)))
- (major-mode-sym (or (and major-mode-name
- (intern major-mode-name))))
- (parents (when (file-readable-p parents-file-name)
- (mapcar #'intern
- (split-string
- (with-temp-buffer
- (insert-file-contents parents-file-name)
- (buffer-substring-no-properties (point-min)
-
(point-max))))))))
- (when major-mode-sym
- (cons major-mode-sym (remove major-mode-sym parents)))))
-
-(defvar yas--editing-template nil
- "Supporting variable for `yas-load-snippet-buffer' and
`yas--visit-snippet'.")
-
-(defvar yas--current-template nil
- "Holds the current template being expanded into a snippet.")
-
-(defvar yas--guessed-modes nil
- "List of guessed modes supporting `yas-load-snippet-buffer'.")
-
-(defun yas--read-table ()
- "Ask user for a snippet table, help with some guessing."
- (let ((prompt (if (and (featurep 'ido)
- ido-mode)
- 'ido-completing-read 'completing-read)))
- (unless yas--guessed-modes
- (set (make-local-variable 'yas--guessed-modes)
- (or (yas--compute-major-mode-and-parents buffer-file-name))))
- (intern
- (funcall prompt (format "Choose or enter a table (yas guesses %s): "
- (if yas--guessed-modes
- (cl-first yas--guessed-modes)
- "nothing"))
- (mapcar #'symbol-name yas--guessed-modes)
- nil
- nil
- nil
- nil
- (if (cl-first yas--guessed-modes)
- (symbol-name (cl-first yas--guessed-modes)))))))
-
-(defun yas-load-snippet-buffer (table &optional interactive)
- "Parse and load current buffer's snippet definition into TABLE.
-TABLE is a symbol name passed to `yas--table-get-create'. When
-called interactively, prompt for the table name.
-Return the `yas--template' object created"
- (interactive (list (yas--read-table) t))
- (cond
- ;; We have `yas--editing-template', this buffer's content comes from a
- ;; template which is already loaded and neatly positioned,...
- ;;
- (yas--editing-template
- (yas--define-snippets-1 (yas--parse-template (yas--template-load-file
yas--editing-template))
- (yas--template-table yas--editing-template)))
- ;; Try to use `yas--guessed-modes'. If we don't have that use the
- ;; value from `yas--compute-major-mode-and-parents'
- ;;
- (t
- (unless yas--guessed-modes
- (set (make-local-variable 'yas--guessed-modes) (or
(yas--compute-major-mode-and-parents buffer-file-name))))
- (let* ((table (yas--table-get-create table)))
- (set (make-local-variable 'yas--editing-template)
- (yas--define-snippets-1 (yas--parse-template buffer-file-name)
- table)))))
- (when interactive
- (yas--message 3 "Snippet \"%s\" loaded for %s."
- (yas--template-name yas--editing-template)
- (yas--table-name (yas--template-table
yas--editing-template))))
- yas--editing-template)
-
-(defun yas-maybe-load-snippet-buffer ()
- "Added to `after-save-hook' in `snippet-mode'."
- (let* ((mode (intern (file-name-sans-extension
- (file-name-nondirectory
- (directory-file-name default-directory)))))
- (current-snippet
- (apply #'yas--define-snippets-2 (yas--table-get-create mode)
- (yas--parse-template buffer-file-name)))
- (uuid (yas--template-uuid current-snippet)))
- (unless (equal current-snippet
- (if uuid (yas--get-template-by-uuid mode uuid)
- (yas--lookup-snippet-1
- (yas--template-name current-snippet) mode)))
- (yas-load-snippet-buffer mode t))))
-
-(defun yas-load-snippet-buffer-and-close (table &optional kill)
- "Load and save the snippet, then `quit-window' if saved.
-Loading is performed by `yas-load-snippet-buffer'. If the
-snippet is new, ask the user whether (and where) to save it. If
-the snippet already has a file, just save it.
-
-The prefix argument KILL is passed to `quit-window'.
-
-Don't use this from a Lisp program, call `yas-load-snippet-buffer'
-and `kill-buffer' instead."
- (interactive (list (yas--read-table) current-prefix-arg))
- (let ((template (yas-load-snippet-buffer table t)))
- (when (and (buffer-modified-p)
- (y-or-n-p
- (format "[yas] Loaded for %s. Also save snippet buffer?"
- (yas--table-name (yas--template-table template)))))
- (let ((default-directory (car (cdr (car (yas--guess-snippet-directories
- (yas--template-table
template))))))
- (default-file-name (yas--template-name template)))
- (unless (or buffer-file-name (not default-file-name))
- (setq buffer-file-name
- (read-file-name "File to save snippet in: "
- nil nil nil default-file-name))
- (rename-buffer (file-name-nondirectory buffer-file-name) t))
- (save-buffer)))
- (quit-window kill)))
-
-(declare-function yas-debug-snippets "yasnippet-debug")
-
-(defun yas-tryout-snippet (&optional debug)
- "Test current buffer's snippet template in other buffer.
-DEBUG is for debugging the YASnippet engine itself."
- (interactive "P")
- (let* ((major-mode-and-parent (yas--compute-major-mode-and-parents
buffer-file-name))
- (parsed (yas--parse-template))
- (test-mode (or (and (car major-mode-and-parent)
- (fboundp (car major-mode-and-parent))
- (car major-mode-and-parent))
- (cl-first yas--guessed-modes)
- (intern (read-from-minibuffer (yas--format "Please
input a mode: ")))))
- (yas--current-template
- (and parsed
- (fboundp test-mode)
- (yas--make-template :table nil ;; no tables for ephemeral
snippets
- :key (nth 0 parsed)
- :content (nth 1 parsed)
- :name (nth 2 parsed)
- :expand-env (nth 5 parsed)))))
- (cond (yas--current-template
- (let ((buffer-name
- (format "*testing snippet: %s*"
- (yas--template-name yas--current-template))))
- (kill-buffer (get-buffer-create buffer-name))
- (switch-to-buffer (get-buffer-create buffer-name))
- (setq buffer-undo-list nil)
- (condition-case nil (funcall test-mode) (error nil))
- (yas-minor-mode 1)
- (setq buffer-read-only nil)
- (yas-expand-snippet yas--current-template
- (point-min) (point-max))
- (when (and debug
- (require 'yasnippet-debug nil t))
- (yas-debug-snippets "*YASnippet trace*" 'snippet-navigation)
- (display-buffer "*YASnippet trace*"))))
- (t
- (yas--message 1 "Cannot test snippet for unknown major mode")))))
-
-(defun yas-active-keys ()
- "Return all active trigger keys for current buffer and point."
- (cl-remove-duplicates
- (cl-remove-if-not #'stringp (cl-mapcan #'yas--table-all-keys
- (yas--get-snippet-tables)))
- :test #'string=))
-
-(defun yas--template-fine-group (template)
- (car (last (or (yas--template-group template)
- (yas--template-perm-group template)))))
-
-(defun yas-describe-table-by-namehash ()
- "Display snippet tables by NAMEHASH."
- (interactive)
- (with-current-buffer (get-buffer-create "*YASnippet Tables by NAMEHASH*")
- (let ((inhibit-read-only t))
- (erase-buffer)
- (insert "YASnippet tables by NAMEHASH: \n")
- (maphash
- (lambda (_mode table)
- (insert (format "\nSnippet table `%s':\n\n" (yas--table-name table)))
- (maphash
- (lambda (key _v)
- (insert (format " key %s maps snippets: %s\n" key
- (let ((names))
- (maphash #'(lambda (k _v)
- (push k names))
- (gethash key (yas--table-hash table)))
- names))))
- (yas--table-hash table)))
- yas--tables))
- (view-mode +1)
- (goto-char 1)
- (display-buffer (current-buffer))))
-
-(defun yas-describe-tables (&optional with-nonactive)
- "Display snippets for each table."
- (interactive "P")
- (let ((original-buffer (current-buffer))
- (tables (yas--get-snippet-tables)))
- (with-current-buffer (get-buffer-create "*YASnippet Tables*")
- (let ((inhibit-read-only t))
- (when with-nonactive
- (maphash #'(lambda (_k v)
- (cl-pushnew v tables))
- yas--tables))
- (erase-buffer)
- (insert "YASnippet tables:\n")
- (dolist (table tables)
- (yas--describe-pretty-table table original-buffer))
- (yas--create-snippet-xrefs))
- (help-mode)
- (goto-char 1)
- (display-buffer (current-buffer)))))
-
-(defun yas--describe-pretty-table (table &optional original-buffer)
- (insert (format "\nSnippet table `%s'"
- (yas--table-name table)))
- (if (yas--table-parents table)
- (insert (format " parents: %s\n"
- (mapcar #'yas--table-name
- (yas--table-parents table))))
- (insert "\n"))
- (insert (make-string 100 ?-) "\n")
- (insert "group state name
key binding\n")
- (let ((groups-hash (make-hash-table :test #'equal)))
- (maphash #'(lambda (_k v)
- (let ((group (or (yas--template-fine-group v)
- "(top level)")))
- (when (yas--template-name v)
- (puthash group
- (cons v (gethash group groups-hash))
- groups-hash))))
- (yas--table-uuidhash table))
- (maphash
- #'(lambda (group templates)
- (setq group (truncate-string-to-width group 25 0 ? "..."))
- (insert (make-string 100 ?-) "\n")
- (dolist (p templates)
- (let* ((name (truncate-string-to-width (propertize (format
"\\\\snippet `%s'" (yas--template-name p))
- 'yasnippet p)
- 50 0 ? "..."))
- (group (prog1 group
- (setq group (make-string (length group) ? ))))
- (condition-string (let ((condition (yas--template-condition
p)))
- (if (and condition
- original-buffer)
- (with-current-buffer original-buffer
- (if (yas--eval-condition condition)
- "(y)"
- "(s)"))
- "(a)")))
- (key-description-string (key-description
(yas--template-keybinding p)))
- (template-key-padding (if (string= key-description-string
"") nil ? )))
- (insert group " "
- condition-string " "
- name (if (string-match "\\.\\.\\.$" name)
- "'" " ")
- " "
- (truncate-string-to-width (or (yas--template-key p) "")
- 15 0 template-key-padding "...")
- (or template-key-padding "")
- (truncate-string-to-width key-description-string
- 15 0 nil "...")
- "\n"))))
- groups-hash)))
-
-
-
-;;; User convenience functions, for using in `yas-key-syntaxes'
-
-(defun yas-try-key-from-whitespace (_start-point)
- "As `yas-key-syntaxes' element, look for whitespace delimited key.
-
-A newline will be considered whitespace even if the mode syntax
-marks it as something else (typically comment ender)."
- (skip-chars-backward "^[:space:]\n"))
-
-(defun yas-shortest-key-until-whitespace (_start-point)
- "Like `yas-longest-key-from-whitespace' but take the shortest key."
- (when (/= (skip-chars-backward "^[:space:]\n" (1- (point))) 0)
- 'again))
-
-(defun yas-longest-key-from-whitespace (start-point)
- "As `yas-key-syntaxes' element, look for longest key between point and
whitespace.
-
-A newline will be considered whitespace even if the mode syntax
-marks it as something else (typically comment ender)."
- (if (= (point) start-point)
- (yas-try-key-from-whitespace start-point)
- (forward-char))
- (unless (<= start-point (1+ (point)))
- 'again))
-
-
-
-;;; User convenience functions, for using in snippet definitions
-
-(defvar yas-modified-p nil
- "Non-nil if field has been modified by user or transformation.")
-
-(defvar yas-moving-away-p nil
- "Non-nil if user is about to exit field.")
-
-(defvar yas-text nil
- "Contains current field text.")
-
-(defun yas-substr (str pattern &optional subexp)
- "Search PATTERN in STR and return SUBEXPth match.
-
-If found, the content of subexp group SUBEXP (default 0) is
- returned, or else the original STR will be returned."
- (let ((grp (or subexp 0)))
- (save-match-data
- (if (string-match pattern str)
- (match-string-no-properties grp str)
- str))))
-
-(defun yas-choose-value (&rest possibilities)
- "Prompt for a string in POSSIBILITIES and return it.
-
-The last element of POSSIBILITIES may be a list of strings."
- (unless (or yas-moving-away-p
- yas-modified-p)
- (let* ((last-link (last possibilities))
- (last-elem (car last-link)))
- (when (listp last-elem)
- (setcar last-link (car last-elem))
- (setcdr last-link (cdr last-elem))))
- (cl-some (lambda (fn)
- (funcall fn "Choose: " possibilities))
- yas-prompt-functions)))
-
-(defun yas-completing-read (&rest args)
- "A snippet-aware version of `completing-read'.
-This can be used to query the user for the initial value of a
-snippet field. The arguments are the same as `completing-read'.
-
-\(fn PROMPT COLLECTION &optional PREDICATE REQUIRE-MATCH INITIAL-INPUT HIST
DEF INHERIT-INPUT-METHOD)"
- (unless (or yas-moving-away-p
- yas-modified-p)
- (apply #'completing-read args)))
-
-(defun yas--auto-next ()
- "Helper for `yas-auto-next'."
- (cl-loop
- do (progn (remove-hook 'post-command-hook #'yas--auto-next t)
- (yas-next-field))
- ;; The transform in the next field may have requested auto-next as
- ;; well. Call it ourselves, since the command loop itself won't
- ;; recheck the value of post-command-hook while running it.
- while (memq #'yas--auto-next post-command-hook)))
-
-(defmacro yas-auto-next (&rest body)
- "Automatically advance to next field after eval'ing BODY."
- (declare (indent 0) (debug t))
- `(unless yas-moving-away-p
- (prog1 ,@body
- (add-hook 'post-command-hook #'yas--auto-next nil t))))
-
-(defun yas-key-to-value (alist)
- (unless (or yas-moving-away-p
- yas-modified-p)
- (let ((key (read-key-sequence "")))
- (when (stringp key)
- (or (cdr (cl-find key alist :key #'car :test #'string=))
- key)))))
-
-(defun yas-throw (text)
- "Signal `yas-exception' with TEXT as the reason."
- (signal 'yas-exception (list text)))
-(put 'yas-exception 'error-conditions '(error yas-exception))
-(put 'yas-exception 'error-message "[yas] Exception")
-
-(defun yas-verify-value (possibilities)
- "Verify that the current field value is in POSSIBILITIES.
-Otherwise signal `yas-exception'."
- (when (and yas-moving-away-p (not (member yas-text possibilities)))
- (yas-throw (format "Field only allows %s" possibilities))))
-
-(defun yas-field-value (number)
- "Get the string for field with NUMBER.
-
-Use this in primary and mirror transformations to get the text of
-other fields."
- (let* ((snippet (car (yas-active-snippets)))
- (field (and snippet
- (yas--snippet-find-field snippet number))))
- (when field
- (yas--field-text-for-display field))))
-
-(defun yas-text ()
- "Return `yas-text' if that exists and is non-empty, else nil."
- (if (and yas-text
- (not (string= "" yas-text)))
- yas-text))
-
-(defun yas-selected-text ()
- "Return `yas-selected-text' if that exists and is non-empty, else nil."
- (if (and yas-selected-text
- (not (string= "" yas-selected-text)))
- yas-selected-text))
-
-(defun yas--get-field-once (number &optional transform-fn)
- (unless yas-modified-p
- (if transform-fn
- (funcall transform-fn (yas-field-value number))
- (yas-field-value number))))
-
-(defun yas-default-from-field (number)
- (unless yas-modified-p
- (yas-field-value number)))
-
-(defun yas-inside-string ()
- "Return non-nil if the point is inside a string according to font-lock."
- (equal 'font-lock-string-face (get-char-property (1- (point)) 'face)))
-
-(defun yas-unimplemented (&optional missing-feature)
- (if yas--current-template
- (if (y-or-n-p (format "This snippet is unimplemented (missing %s) Visit
the snippet definition? "
- (or missing-feature
- "something")))
- (yas--visit-snippet-file-1 yas--current-template))
- (message "No implementation. Missing %s" (or missing-feature
"something"))))
-
-
-;;; Snippet expansion and field management
-
-(defvar yas--active-field-overlay nil
- "Overlays the currently active field.")
-
-(defvar yas--active-snippets nil
- "List of currently active snippets")
-(make-variable-buffer-local 'yas--active-snippets)
-
-(defvar yas--field-protection-overlays nil
- "Two overlays protect the current active field.")
-
-(defvar yas-selected-text nil
- "The selected region deleted on the last snippet expansion.")
-
-(defvar yas--start-column nil
- "The column where the snippet expansion started.")
-
-(make-variable-buffer-local 'yas--active-field-overlay)
-(make-variable-buffer-local 'yas--field-protection-overlays)
-(put 'yas--active-field-overlay 'permanent-local t)
-(put 'yas--field-protection-overlays 'permanent-local t)
-
-(cl-defstruct (yas--snippet (:constructor yas--make-snippet (expand-env)))
- "A snippet.
-
-..."
- expand-env
- (fields '())
- (exit nil)
- (id (yas--snippet-next-id) :read-only t)
- (control-overlay nil)
- active-field
- ;; stacked expansion: the `previous-active-field' slot saves the
- ;; active field where the child expansion took place
- previous-active-field
- force-exit)
-
-(cl-defstruct (yas--field (:constructor yas--make-field (number start end
parent-field)))
- "A field.
-
-NUMBER is the field number.
-START and END are mostly buffer markers, but see \"apropos markers-to-points\".
-PARENT-FIELD is a `yas--field' this field is nested under, or nil.
-MIRRORS is a list of `yas--mirror's
-TRANSFORM is a lisp form.
-MODIFIED-P is a boolean set to true once user inputs text.
-NEXT is another `yas--field' or `yas--mirror' or `yas--exit'.
-"
- number
- start end
- parent-field
- (mirrors '())
- (transform nil)
- (modified-p nil)
- next)
-
-
-(cl-defstruct (yas--mirror (:constructor yas--make-mirror (start end
transform)))
- "A mirror.
-
-START and END are mostly buffer markers, but see \"apropos markers-to-points\".
-TRANSFORM is a lisp form.
-PARENT-FIELD is a `yas--field' this mirror is nested under, or nil.
-NEXT is another `yas--field' or `yas--mirror' or `yas--exit'
-DEPTH is a count of how many nested mirrors can affect this mirror"
- start end
- (transform nil)
- parent-field
- next
- depth)
-
-(cl-defstruct (yas--exit (:constructor yas--make-exit (marker)))
- marker
- next)
-
-(defmacro yas--letenv (env &rest body)
- "Evaluate BODY with bindings from ENV.
-ENV is a lisp expression that evaluates to list of elements with
-the form (VAR FORM), where VAR is a symbol and FORM is a lisp
-expression that evaluates to its value."
- (declare (debug (form body)) (indent 1))
- (let ((envvar (make-symbol "envvar")))
- `(let ((,envvar ,env))
- (cl-progv
- (mapcar #'car ,envvar)
- (mapcar (lambda (v-f) (eval (cadr v-f))) ,envvar)
- ,@body))))
-
-(defun yas--snippet-map-markers (fun snippet)
- "Apply FUN to all marker (sub)fields in SNIPPET.
-Update each field with the result of calling FUN."
- (dolist (field (yas--snippet-fields snippet))
- (setf (yas--field-start field) (funcall fun (yas--field-start field)))
- (setf (yas--field-end field) (funcall fun (yas--field-end field)))
- (dolist (mirror (yas--field-mirrors field))
- (setf (yas--mirror-start mirror) (funcall fun (yas--mirror-start
mirror)))
- (setf (yas--mirror-end mirror) (funcall fun (yas--mirror-end
mirror)))))
- (let ((snippet-exit (yas--snippet-exit snippet)))
- (when snippet-exit
- (setf (yas--exit-marker snippet-exit)
- (funcall fun (yas--exit-marker snippet-exit))))))
-
-(defun yas--snippet-live-p (snippet)
- "Return non-nil if SNIPPET hasn't been committed."
- (catch 'live
- (yas--snippet-map-markers (lambda (m)
- (if (markerp m) m
- (throw 'live nil)))
- snippet)
- t))
-
-(defun yas--apply-transform (field-or-mirror field &optional empty-on-nil-p)
- "Calculate transformed string for FIELD-OR-MIRROR from FIELD.
-
-If there is no transform for ht field, return nil.
-
-If there is a transform but it returns nil, return the empty
-string iff EMPTY-ON-NIL-P is true."
- (let* ((yas-text (yas--field-text-for-display field))
- (yas-modified-p (yas--field-modified-p field))
- (transform (if (yas--mirror-p field-or-mirror)
- (yas--mirror-transform field-or-mirror)
- (yas--field-transform field-or-mirror)))
- (start-point (if (yas--mirror-p field-or-mirror)
- (yas--mirror-start field-or-mirror)
- (yas--field-start field-or-mirror)))
- (transformed (and transform
- (save-excursion
- (goto-char start-point)
- (let ((ret (yas--eval-for-string transform)))
- (or ret (and empty-on-nil-p "")))))))
- transformed))
-
-(defsubst yas--replace-all (from to &optional text)
- "Replace all occurrences from FROM to TO.
-
-With optional string TEXT do it in that string."
- (if text
- (replace-regexp-in-string (regexp-quote from) to text t t)
- (goto-char (point-min))
- (while (search-forward from nil t)
- (replace-match to t t text))))
-
-(defun yas--snippet-find-field (snippet number)
- (cl-find-if (lambda (field)
- (eq number (yas--field-number field)))
- (yas--snippet-fields snippet)))
-
-(defun yas--snippet-sort-fields (snippet)
- "Sort the fields of SNIPPET in navigation order."
- (setf (yas--snippet-fields snippet)
- (sort (yas--snippet-fields snippet)
- #'yas--snippet-field-compare)))
-
-(defun yas--snippet-field-compare (field1 field2)
- "Compare FIELD1 and FIELD2.
-
-The field with a number is sorted first. If they both have a
-number, compare through the number. If neither have, compare
-through the field's start point"
- (let ((n1 (yas--field-number field1))
- (n2 (yas--field-number field2)))
- (if n1
- (if n2
- (or (zerop n2) (and (not (zerop n1))
- (< n1 n2)))
- (not (zerop n1)))
- (if n2
- (zerop n2)
- (< (yas--field-start field1)
- (yas--field-start field2))))))
-
-(defun yas--field-probably-deleted-p (snippet field)
- "Guess if SNIPPET's FIELD should be skipped."
- (and
- ;; field must be zero length
- ;;
- (zerop (- (yas--field-start field) (yas--field-end field)))
- ;; field must have been modified
- ;;
- (yas--field-modified-p field)
- ;; either:
- (or
- ;; 1) it's a nested field
- ;;
- (yas--field-parent-field field)
- ;; 2) ends just before the snippet end
- ;;
- (and (eq field (car (last (yas--snippet-fields snippet))))
- (= (yas--field-start field) (overlay-end
(yas--snippet-control-overlay snippet)))))
- ;; the field numbered 0, just before the exit marker, should
- ;; never be skipped
- ;;
- (not (and (yas--field-number field)
- (zerop (yas--field-number field))))))
-
-(defun yas-active-snippets (&optional beg end)
- "Return a sorted list of active snippets.
-The most recently-inserted snippets are returned first.
-
-Only snippets overlapping the region BEG ... END are returned.
-Overlapping has the same meaning as described in `overlays-in'.
-If END is omitted, it defaults to (1+ BEG). If BEG is omitted,
-it defaults to point. A non-nil, non-buffer position BEG is
-equivalent to a range covering the whole buffer."
- (unless beg
- (setq beg (point)))
- (cond ((not (or (integerp beg) (markerp beg)))
- (setq beg (point-min) end (point-max)))
- ((not end)
- (setq end (1+ beg))))
- (if (and (eq beg (point-min))
- (eq end (point-max)))
- yas--active-snippets
- ;; Note: don't use `mapcar' here, since it would allocate in
- ;; proportion to the amount of overlays, even though the list of
- ;; active snippets should be very small.
- (let ((snippets nil))
- (dolist (ov (overlays-in beg end))
- (let ((snippet (overlay-get ov 'yas--snippet)))
- ;; Snippets have multiple overlays, so check for dups.
- (when (and snippet (not (memq snippet snippets)))
- (push snippet snippets))))
- (cl-sort snippets #'>= :key #'yas--snippet-id))))
-
-(define-obsolete-function-alias 'yas--snippets-at-point
- 'yas-active-snippets "0.12")
-
-(defun yas-next-field-or-maybe-expand ()
- "Try to expand a snippet at a key before point.
-
-Otherwise delegate to `yas-next-field'."
- (interactive)
- (if yas-triggers-in-field
- (let ((yas-fallback-behavior 'return-nil)
- (active-field (overlay-get yas--active-field-overlay 'yas--field)))
- (when active-field
- (unless (yas-expand-from-trigger-key active-field)
- (yas-next-field))))
- (yas-next-field)))
-
-(defun yas-next-field-will-exit-p (&optional arg)
- "Return non-nil if (yas-next-field ARG) would exit the current snippet."
- (let ((snippet (car (yas-active-snippets)))
- (active (overlay-get yas--active-field-overlay 'yas--field)))
- (when snippet
- (not (yas--find-next-field arg snippet active)))))
-
-(defun yas--find-next-field (n snippet active)
- "Return the Nth field after the ACTIVE one in SNIPPET."
- (let ((live-fields (cl-remove-if
- (lambda (field)
- (and (not (eq field active))
- (yas--field-probably-deleted-p snippet field)))
- (yas--snippet-fields snippet))))
- (nth (abs n) (memq active (if (>= n 0) live-fields (reverse
live-fields))))))
-
-(defun yas-next-field (&optional arg)
- "Navigate to the ARGth next field.
-
-If there's none, exit the snippet."
- (interactive)
- (unless arg (setq arg 1))
- (let* ((active-field (overlay-get yas--active-field-overlay 'yas--field))
- (snippet (car (yas-active-snippets (yas--field-start active-field)
- (yas--field-end active-field))))
- (target-field (yas--find-next-field arg snippet active-field)))
- (yas--letenv (yas--snippet-expand-env snippet)
- ;; Apply transform to active field.
- (when active-field
- (let ((yas-moving-away-p t))
- (when (yas--field-update-display active-field)
- (yas--update-mirrors snippet))))
- ;; Now actually move...
- (if target-field
- (yas--move-to-field snippet target-field)
- (yas-exit-snippet snippet)))))
-
-(defun yas--place-overlays (snippet field)
- "Correctly place overlays for SNIPPET's FIELD."
- (yas--make-move-field-protection-overlays snippet field)
- ;; Only move active field overlays if this is field is from the
- ;; innermost snippet.
- (when (eq snippet (car (yas-active-snippets (1- (yas--field-start field))
- (1+ (yas--field-end field)))))
- (yas--make-move-active-field-overlay snippet field)))
-
-(defun yas--move-to-field (snippet field)
- "Update SNIPPET to move to field FIELD.
-
-Also create some protection overlays"
- (goto-char (yas--field-start field))
- (yas--place-overlays snippet field)
- (overlay-put yas--active-field-overlay 'yas--snippet snippet)
- (overlay-put yas--active-field-overlay 'yas--field field)
- (let ((number (yas--field-number field)))
- ;; check for the special ${0: ...} field
- (if (and number (zerop number))
- (progn
- (set-mark (yas--field-end field))
- (setf (yas--snippet-force-exit snippet)
- (or (yas--field-transform field)
- t)))
- ;; make this field active
- (setf (yas--snippet-active-field snippet) field)
- ;; primary field transform: first call to snippet transform
- (unless (yas--field-modified-p field)
- (if (yas--field-update-display field)
- (yas--update-mirrors snippet)
- (setf (yas--field-modified-p field) nil))))))
-
-(defun yas-prev-field ()
- "Navigate to prev field. If there's none, exit the snippet."
- (interactive)
- (yas-next-field -1))
-
-(defun yas-abort-snippet (&optional snippet)
- (interactive)
- (let ((snippet (or snippet
- (car (yas-active-snippets)))))
- (when snippet
- (setf (yas--snippet-force-exit snippet) t))))
-
-(defun yas-exit-snippet (snippet)
- "Goto exit-marker of SNIPPET."
- (interactive (list (cl-first (yas-active-snippets))))
- (when snippet
- (setf (yas--snippet-force-exit snippet) t)
- (goto-char (if (yas--snippet-exit snippet)
- (yas--exit-marker (yas--snippet-exit snippet))
- (overlay-end (yas--snippet-control-overlay snippet))))))
-
-(defun yas-exit-all-snippets ()
- "Exit all snippets."
- (interactive)
- (mapc #'(lambda (snippet)
- (yas-exit-snippet snippet)
- (yas--check-commit-snippet))
- (yas-active-snippets 'all)))
-
-
-;;; Some low level snippet-routines:
-
-(defvar yas--inhibit-overlay-hooks nil
- "Bind this temporarily to non-nil to prevent running
`yas--on-*-modification'.")
-
-(defvar yas-snippet-beg nil "Beginning position of the last snippet
committed.")
-(defvar yas-snippet-end nil "End position of the last snippet committed.")
-
-(defun yas--commit-snippet (snippet)
- "Commit SNIPPET, but leave point as it is.
-
-This renders the snippet as ordinary text."
-
- (let ((control-overlay (yas--snippet-control-overlay snippet)))
- ;;
- ;; Save the end of the moribund snippet in case we need to revive it
- ;; its original expansion.
- ;;
- (when (and control-overlay
- (overlay-buffer control-overlay))
- (setq yas-snippet-beg (overlay-start control-overlay))
- (setq yas-snippet-end (overlay-end control-overlay))
- (delete-overlay control-overlay)
- (setf (yas--snippet-control-overlay snippet) nil))
-
- (let ((yas--inhibit-overlay-hooks t))
- (when yas--active-field-overlay
- (delete-overlay yas--active-field-overlay))
- (when yas--field-protection-overlays
- (mapc #'delete-overlay yas--field-protection-overlays)))
-
- ;; stacked expansion: if the original expansion took place from a
- ;; field, make sure we advance it here at least to
- ;; `yas-snippet-end'...
- ;;
- (let ((previous-field (yas--snippet-previous-active-field snippet)))
- (when (and yas-snippet-end previous-field)
- (yas--advance-end-maybe previous-field yas-snippet-end)))
-
- ;; Convert all markers to points,
- ;;
- (yas--markers-to-points snippet)
-
- ;; It's no longer an active snippet.
- (cl-callf2 delq snippet yas--active-snippets)
-
- ;; Take care of snippet revival on undo.
- (if (and yas-snippet-revival (listp buffer-undo-list))
- (push `(apply yas--snippet-revive ,yas-snippet-beg ,yas-snippet-end
,snippet)
- buffer-undo-list)
- ;; Dismember the snippet... this is useful if we get called
- ;; again from `yas--take-care-of-redo'....
- (setf (yas--snippet-fields snippet) nil)))
-
- (yas--message 4 "Snippet %s exited." (yas--snippet-id snippet)))
-
-(defvar yas--snippets-to-move nil)
-(make-variable-buffer-local 'yas--snippets-to-move)
-
-(defun yas--prepare-snippets-for-move (beg end buf pos)
- "Gather snippets in BEG..END for moving to POS in BUF."
- (let ((to-move nil)
- (snippets (yas-active-snippets beg end))
- (dst-base-line (with-current-buffer buf
- (count-lines (point-min) pos))))
- (when snippets
- (dolist (snippet snippets)
- (yas--snippet-map-markers
- (lambda (m)
- (prog1 (cons m (yas--snapshot-line-location m))
- (set-marker m nil)))
- snippet)
- (let ((ctrl-ov (yas--snapshot-overlay-line-location
- (yas--snippet-control-overlay snippet))))
- (push (list ctrl-ov dst-base-line snippet) to-move)
- (delete-overlay (car ctrl-ov))))
- (with-current-buffer buf
- (cl-callf2 nconc to-move yas--snippets-to-move)))))
-
-(defun yas--on-buffer-kill ()
- ;; Org mode uses temp buffers for fontification and "native tab",
- ;; move all the snippets to the original org-mode buffer when it's
- ;; killed.
- (let ((org-marker nil)
- (org-buffer nil))
- (when (and yas-minor-mode
- (or (bound-and-true-p org-edit-src-from-org-mode)
- (bound-and-true-p org-src--from-org-mode))
- (markerp
- (setq org-marker
- (or (bound-and-true-p org-edit-src-beg-marker)
- (bound-and-true-p org-src--beg-marker))))
- ;; If the org source buffer is killed before the temp
- ;; fontification one, org-marker might point nowhere.
- (setq org-buffer (marker-buffer org-marker)))
- (yas--prepare-snippets-for-move
- (point-min) (point-max)
- org-buffer org-marker))))
-
-(add-hook 'kill-buffer-hook #'yas--on-buffer-kill)
-
-(defun yas--finish-moving-snippets ()
- "Finish job started in `yas--prepare-snippets-for-move'."
- (cl-loop for (ctrl-ov base-line snippet) in yas--snippets-to-move
- for base-pos = (progn (goto-char (point-min))
- (forward-line base-line) (point))
- do (yas--snippet-map-markers
- (lambda (saved-location)
- (let ((m (pop saved-location)))
- (set-marker m (yas--goto-saved-line-location
- base-pos saved-location))
- m))
- snippet)
- (goto-char base-pos)
- (yas--restore-overlay-line-location base-pos ctrl-ov)
- (yas--maybe-move-to-active-field snippet)
- (push snippet yas--active-snippets))
- (setq yas--snippets-to-move nil))
-
-(defun yas--safely-call-fun (fun)
- "Call FUN and catch any errors."
- (condition-case error
- (funcall fun)
- ((debug error)
- (yas--message 2 "Error running %s: %s" fun
- (error-message-string error)))))
-
-(defun yas--safely-run-hook (hook)
- "Call HOOK's functions.
-HOOK should be a symbol, a hook variable, as in `run-hooks'."
- (let ((debug-on-error (and (not (memq yas-good-grace '(t hooks)))
- debug-on-error)))
- (yas--safely-call-fun (apply-partially #'run-hooks hook))))
-
-(defun yas--check-commit-snippet ()
- "Check if point exited the currently active field of the snippet.
-
-If so cleans up the whole snippet up."
- (let* ((snippet-exit-transform nil)
- (exited-snippets-p nil)
- ;; Record the custom snippet `yas-after-exit-snippet-hook'
- ;; set in the expand-env field.
- (snippet-exit-hook yas-after-exit-snippet-hook))
- (dolist (snippet yas--active-snippets)
- (let ((active-field (yas--snippet-active-field snippet)))
- (yas--letenv (yas--snippet-expand-env snippet)
- ;; Note: the `force-exit' field could be a transform in case of
- ;; ${0: ...}, see `yas--move-to-field'.
- (setq snippet-exit-transform (yas--snippet-force-exit snippet))
- (cond ((or snippet-exit-transform
- (not (and active-field (yas--field-contains-point-p
active-field))))
- (setf (yas--snippet-force-exit snippet) nil)
- (setq snippet-exit-hook yas-after-exit-snippet-hook)
- (yas--commit-snippet snippet)
- (setq exited-snippets-p t))
- ((and active-field
- (or (not yas--active-field-overlay)
- (not (overlay-buffer yas--active-field-overlay))))
- ;;
- ;; stacked expansion: this case is mainly for recent
- ;; snippet exits that place us back int the field of
- ;; another snippet
- ;;
- (save-excursion
- (yas--move-to-field snippet active-field)
- (yas--update-mirrors snippet)))
- (t
- nil)))))
- (unless (or yas--active-snippets (not exited-snippets-p))
- (when snippet-exit-transform
- (yas--eval-for-effect snippet-exit-transform))
- (let ((yas-after-exit-snippet-hook snippet-exit-hook))
- (yas--safely-run-hook 'yas-after-exit-snippet-hook)))))
-
-;; Apropos markers-to-points:
-;;
-;; This was found useful for performance reasons, so that an excessive
-;; number of live markers aren't kept around in the
-;; `buffer-undo-list'. We don't reuse the original marker object
-;; because that leaves an unreadable object in the history list and
-;; undo-tree persistence has trouble with that.
-;;
-;; This shouldn't bring horrible problems with undo/redo, but you
-;; never know.
-;;
-(defun yas--markers-to-points (snippet)
- "Save all markers of SNIPPET as positions."
- (yas--snippet-map-markers (lambda (m)
- (prog1 (marker-position m)
- (set-marker m nil)))
- snippet))
-
-(defun yas--points-to-markers (snippet)
- "Restore SNIPPET's marker positions, saved by `yas--markers-to-points'."
- (yas--snippet-map-markers #'copy-marker snippet))
-
-(defun yas--maybe-move-to-active-field (snippet)
- "Try to move to SNIPPET's active (or first) field and return it if found."
- (let ((target-field (or (yas--snippet-active-field snippet)
- (car (yas--snippet-fields snippet)))))
- (when target-field
- (yas--move-to-field snippet target-field)
- target-field)))
-
-(defun yas--field-contains-point-p (field &optional point)
- (let ((point (or point
- (point))))
- (and (>= point (yas--field-start field))
- (<= point (yas--field-end field)))))
-
-(defun yas--field-text-for-display (field)
- "Return the propertized display text for field FIELD."
- (buffer-substring (yas--field-start field) (yas--field-end field)))
-
-(defun yas--undo-in-progress ()
- "True if some kind of undo is in progress."
- (or undo-in-progress
- (eq this-command 'undo)
- (eq this-command 'redo)))
-
-(defun yas--make-control-overlay (snippet start end)
- "Create the control overlay that surrounds the snippet and
-holds the keymap."
- (let ((overlay (make-overlay start
- end
- nil
- nil
- t)))
- (overlay-put overlay 'keymap yas-keymap)
- (overlay-put overlay 'priority yas-overlay-priority)
- (overlay-put overlay 'yas--snippet snippet)
- overlay))
-
-(defun yas-current-field ()
- "Return the currently active field."
- (and yas--active-field-overlay
- (overlay-buffer yas--active-field-overlay)
- (overlay-get yas--active-field-overlay 'yas--field)))
-
-(defun yas--maybe-clear-field-filter (cmd)
- "Return CMD if at start of unmodified snippet field.
-Use as a `:filter' argument for a conditional keybinding."
- (let ((field (yas-current-field)))
- (when (and field
- (not (yas--field-modified-p field))
- (eq (point) (marker-position (yas--field-start field))))
- cmd)))
-
-(defun yas-skip-and-clear-field (&optional field)
- "Clears unmodified FIELD if at field start, skips to next tab."
- (interactive)
- (yas--skip-and-clear (or field (yas-current-field)))
- (yas-next-field 1))
-
-(defun yas-clear-field (&optional field)
- "Clears unmodified FIELD if at field start."
- (interactive)
- (yas--skip-and-clear (or field (yas-current-field))))
-
-(defun yas-skip-and-clear-or-delete-char (&optional field)
- "Clears unmodified field if at field start, skips to next tab.
-
-Otherwise deletes a character normally by calling `delete-char'."
- (interactive)
- (declare (obsolete "Bind to `yas-maybe-skip-and-clear-field' instead."
"0.13"))
- (cond ((yas--maybe-clear-field-filter t)
- (yas--skip-and-clear (or field (yas-current-field)))
- (yas-next-field 1))
- (t (call-interactively 'delete-char))))
-
-(defun yas--skip-and-clear (field &optional from)
- "Deletes the region of FIELD and sets it's modified state to t.
-If given, FROM indicates position to start at instead of FIELD's beginning."
- ;; Just before skipping-and-clearing the field, mark its children
- ;; fields as modified, too. If the children have mirrors-in-fields
- ;; this prevents them from updating erroneously (we're skipping and
- ;; deleting!).
- ;;
- (yas--mark-this-and-children-modified field)
- (unless (= (yas--field-start field) (yas--field-end field))
- (delete-region (or from (yas--field-start field)) (yas--field-end field))))
-
-(defun yas--mark-this-and-children-modified (field)
- (setf (yas--field-modified-p field) t)
- (let ((fom (yas--field-next field)))
- (while (and fom
- (yas--fom-parent-field fom))
- (when (and (eq (yas--fom-parent-field fom) field)
- (yas--field-p fom))
- (yas--mark-this-and-children-modified fom))
- (setq fom (yas--fom-next fom)))))
-
-(defun yas--make-move-active-field-overlay (snippet field)
- "Place the active field overlay in SNIPPET's FIELD.
-
-Move the overlay, or create it if it does not exit."
- (if (and yas--active-field-overlay
- (overlay-buffer yas--active-field-overlay))
- (move-overlay yas--active-field-overlay
- (yas--field-start field)
- (yas--field-end field))
- (setq yas--active-field-overlay
- (make-overlay (yas--field-start field)
- (yas--field-end field)
- nil nil t))
- (overlay-put yas--active-field-overlay 'priority yas-overlay-priority)
- (overlay-put yas--active-field-overlay 'face 'yas-field-highlight-face)
- (overlay-put yas--active-field-overlay 'yas--snippet snippet)
- (overlay-put yas--active-field-overlay 'modification-hooks
'(yas--on-field-overlay-modification))
- (overlay-put yas--active-field-overlay 'insert-in-front-hooks
- '(yas--on-field-overlay-modification))
- (overlay-put yas--active-field-overlay 'insert-behind-hooks
- '(yas--on-field-overlay-modification))))
-
-(defun yas--skip-and-clear-field-p (field beg _end length)
- "Tell if newly modified FIELD should be cleared and skipped.
-BEG, END and LENGTH like overlay modification hooks."
- (and (= length 0) ; A 0 pre-change length indicates insertion.
- (= beg (yas--field-start field)) ; Insertion at field start?
- (not (yas--field-modified-p field))))
-
-
-(defun yas--merge-and-drop-dups (list1 list2 cmp key)
- ;; `delete-consecutive-dups' + `cl-merge'.
- (funcall (if (fboundp 'delete-consecutive-dups)
- #'delete-consecutive-dups ; 24.4
- #'delete-dups)
- (cl-merge 'list list1 list2 cmp :key key)))
-
-(defvar yas--before-change-modified-snippets nil)
-(make-variable-buffer-local 'yas--before-change-modified-snippets)
-
-(defun yas--gather-active-snippets (overlay beg end then-delete)
- ;; Add active snippets in BEG..END into an OVERLAY keyed entry of
- ;; `yas--before-change-modified-snippets'. Return accumulated list.
- ;; If THEN-DELETE is non-nil, delete the entry.
- (let ((new (yas-active-snippets beg end))
- (old (assq overlay yas--before-change-modified-snippets)))
- (prog1 (cond ((and new old)
- (setf (cdr old)
- (yas--merge-and-drop-dups
- (cdr old) new
- ;; Sort like `yas-active-snippets'.
- #'>= #'yas--snippet-id)))
- (new (unless then-delete
- ;; Don't add new entry if we're about to
- ;; remove it anyway.
- (push (cons overlay new)
- yas--before-change-modified-snippets))
- new)
- (old (cdr old))
- (t nil))
- (when then-delete
- (cl-callf2 delq old yas--before-change-modified-snippets)))))
-
-(defvar yas--todo-snippet-indent nil nil)
-(make-variable-buffer-local 'yas--todo-snippet-indent)
-
-(defun yas--on-field-overlay-modification (overlay after? beg end &optional
length)
- "Clears the field and updates mirrors, conditionally.
-
-Only clears the field if it hasn't been modified and point is at
-field start. This hook does nothing if an undo is in progress."
- (unless (or yas--inhibit-overlay-hooks
- (not (overlayp yas--active-field-overlay)) ; Avoid Emacs bug
#21824.
- ;; If a single change hits multiple overlays of the same
- ;; snippet, then we delete the snippet the first time,
- ;; and then subsequent calls get a deleted overlay.
- ;; Don't delete the snippet again!
- (not (overlay-buffer overlay))
- (yas--undo-in-progress))
- (let* ((inhibit-modification-hooks nil)
- (yas--inhibit-overlay-hooks t)
- (field (overlay-get overlay 'yas--field))
- (snippet (overlay-get yas--active-field-overlay 'yas--snippet)))
- (if (yas--snippet-live-p snippet)
- (if after?
- (save-match-data
- (yas--letenv (yas--snippet-expand-env snippet)
- (when (yas--skip-and-clear-field-p field beg end length)
- ;; We delete text starting from the END of insertion.
- (yas--skip-and-clear field end))
- (setf (yas--field-modified-p field) t)
- ;; Adjust any pending active fields in case of stacked
- ;; expansion.
- (let ((pfield field)
- (psnippets (yas--gather-active-snippets
- overlay beg end t)))
- (while (and pfield psnippets)
- (let ((psnippet (pop psnippets)))
- (cl-assert (memq pfield (yas--snippet-fields
psnippet)))
- (yas--advance-end-maybe pfield (overlay-end overlay))
- (setq pfield (yas--snippet-previous-active-field
psnippet)))))
- ;; Update fields now, but delay auto indentation until
- ;; post-command. We don't want to run indentation on
- ;; the intermediate state where field text might be
- ;; removed (and hence the field could be deleted along
- ;; with leading indentation).
- (let ((yas-indent-line nil))
- (save-excursion
- (yas--field-update-display field))
- (yas--update-mirrors snippet))
- (unless (or (not (eq yas-indent-line 'auto))
- (memq snippet yas--todo-snippet-indent))
- (push snippet yas--todo-snippet-indent))))
- ;; Remember active snippets to use for after the change.
- (yas--gather-active-snippets overlay beg end nil))
- (lwarn '(yasnippet zombie) :warning "Killing zombie snippet!")
- (delete-overlay overlay)))))
-
-(defun yas--do-todo-snippet-indent ()
- ;; Do pending indentation of snippet fields, called from
- ;; `yas--post-command-handler'.
- (when yas--todo-snippet-indent
- (save-excursion
- (cl-loop for snippet in yas--todo-snippet-indent
- do (yas--indent-mirrors-of-snippet
- snippet (yas--snippet-field-mirrors snippet)))
- (setq yas--todo-snippet-indent nil))))
-
-(defun yas--auto-fill ()
- ;; Preserve snippet markers during auto-fill.
- (let* ((orig-point (point))
- (end (progn (forward-paragraph) (point)))
- (beg (progn (backward-paragraph) (point)))
- (snippets (yas-active-snippets beg end))
- (remarkers nil)
- (reoverlays nil))
- (dolist (snippet snippets)
- (dolist (m (yas--collect-snippet-markers snippet))
- (when (and (<= beg m) (<= m end))
- (push (cons m (yas--snapshot-location m beg end)) remarkers)))
- (push (yas--snapshot-overlay-location
- (yas--snippet-control-overlay snippet) beg end)
- reoverlays))
- (goto-char orig-point)
- (let ((yas--inhibit-overlay-hooks t))
- (if yas--original-auto-fill-function
- (funcall yas--original-auto-fill-function)
- ;; Shouldn't happen, gather more info about it (see #873/919).
- (let ((yas--fill-fun-values `((t ,(default-value
'yas--original-auto-fill-function))))
- (fill-fun-values `((t ,(default-value 'auto-fill-function))))
- ;; Listing 2 buffers with the same value is enough
- (print-length 3))
- (save-current-buffer
- (dolist (buf (let ((bufs (buffer-list)))
- ;; List the current buffer first.
- (setq bufs (cons (current-buffer)
- (remq (current-buffer) bufs)))))
- (set-buffer buf)
- (let* ((yf-cell (assq yas--original-auto-fill-function
- yas--fill-fun-values))
- (af-cell (assq auto-fill-function fill-fun-values)))
- (when (local-variable-p 'yas--original-auto-fill-function)
- (if yf-cell (setcdr yf-cell (cons buf (cdr yf-cell)))
- (push (list yas--original-auto-fill-function buf)
yas--fill-fun-values)))
- (when (local-variable-p 'auto-fill-function)
- (if af-cell (setcdr af-cell (cons buf (cdr af-cell)))
- (push (list auto-fill-function buf) fill-fun-values))))))
- (lwarn '(yasnippet auto-fill bug) :error
- "`yas--original-auto-fill-function' unexpectedly nil in %S!
Disabling auto-fill.
- %S
- `auto-fill-function': %S\n%s"
- (current-buffer) yas--fill-fun-values fill-fun-values
- (if (fboundp 'backtrace--print-frame)
- (with-output-to-string
- (mapc (lambda (frame)
- (apply #'backtrace--print-frame frame))
- yas--watch-auto-fill-backtrace))
- ""))
- ;; Try to avoid repeated triggering of this bug.
- (auto-fill-mode -1)
- ;; Don't pop up more than once in a session (still log though).
- (defvar warning-suppress-types) ; `warnings' is autoloaded by
`lwarn'.
- (add-to-list 'warning-suppress-types '(yasnippet auto-fill bug)))))
- (save-excursion
- (setq end (progn (forward-paragraph) (point)))
- (setq beg (progn (backward-paragraph) (point))))
- (save-excursion
- (save-restriction
- (narrow-to-region beg end)
- (dolist (remarker remarkers)
- (set-marker (car remarker)
- (yas--goto-saved-location (cdr remarker))))
- (mapc #'yas--restore-overlay-location reoverlays))
- (mapc (lambda (snippet)
- (yas--letenv (yas--snippet-expand-env snippet)
- (yas--update-mirrors snippet)))
- snippets))))
-
-
-;;; Apropos protection overlays:
-;;
-;; These exist for nasty users who will try to delete parts of the
-;; snippet outside the active field. Actual protection happens in
-;; `yas--on-protection-overlay-modification'.
-;;
-;; As of github #537 this no longer inhibits the command by issuing an
-;; error: all the snippets at point, including nested snippets, are
-;; automatically commited and the current command can proceed.
-;;
-(defun yas--make-move-field-protection-overlays (snippet field)
- "Place protection overlays surrounding SNIPPET's FIELD.
-
-Move the overlays, or create them if they do not exit."
- (let ((start (yas--field-start field))
- (end (yas--field-end field)))
- ;; First check if the (1+ end) is contained in the buffer,
- ;; otherwise we'll have to do a bit of cheating and silently
- ;; insert a newline. the `(1+ (buffer-size))' should prevent this
- ;; when using stacked expansion
- ;;
- (when (< (buffer-size) end)
- (save-excursion
- (let ((yas--inhibit-overlay-hooks t))
- (goto-char (point-max))
- (newline))))
- ;; go on to normal overlay creation/moving
- ;;
- (cond ((and yas--field-protection-overlays
- (cl-every #'overlay-buffer yas--field-protection-overlays))
- (move-overlay (nth 0 yas--field-protection-overlays)
- (1- start) start)
- (move-overlay (nth 1 yas--field-protection-overlays) end (1+ end)))
- (t
- (setq yas--field-protection-overlays
- (list (make-overlay (1- start) start nil t nil)
- (make-overlay end (1+ end) nil t nil)))
- (dolist (ov yas--field-protection-overlays)
- (overlay-put ov 'face 'yas--field-debug-face)
- (overlay-put ov 'yas--snippet snippet)
- ;; (overlay-put ov 'evaporate t)
- (overlay-put ov 'modification-hooks
'(yas--on-protection-overlay-modification)))))))
-
-(defun yas--on-protection-overlay-modification (_overlay after? beg end
&optional length)
- "Commit the snippet if the protection overlay is being killed."
- (unless (or yas--inhibit-overlay-hooks
- yas-inhibit-overlay-modification-protection
- (not after?)
- (= length (- end beg)) ; deletion or insertion
- (yas--undo-in-progress))
- (let ((snippets (yas-active-snippets)))
- (yas--message 2 "Committing snippets. Action would destroy a protection
overlay.")
- (cl-loop for snippet in snippets
- do (yas--commit-snippet snippet)))))
-
-(add-to-list 'debug-ignored-errors "^Exit the snippet first!$")
-
-
-;;; Snippet expansion and "stacked" expansion:
-;;
-;; Stacked expansion is when you try to expand a snippet when already
-;; inside a snippet expansion.
-;;
-;; The parent snippet does not run its fields modification hooks
-;; (`yas--on-field-overlay-modification' and
-;; `yas--on-protection-overlay-modification') while the child snippet
-;; is active. This means, among other things, that the mirrors of the
-;; parent snippet are not updated, this only happening when one exits
-;; the child snippet.
-;;
-;; Unfortunately, this also puts some ugly (and not fully-tested)
-;; bits of code in `yas-expand-snippet' and
-;; `yas--commit-snippet'. I've tried to mark them with "stacked
-;; expansion:".
-;;
-;; This was thought to be safer in an undo/redo perspective, but
-;; maybe the correct implementation is to make the globals
-;; `yas--active-field-overlay' and `yas--field-protection-overlays' be
-;; snippet-local and be active even while the child snippet is
-;; running. This would mean a lot of overlay modification hooks
-;; running, but if managed correctly (including overlay priorities)
-;; they should account for all situations...
-
-(defun yas-expand-snippet (snippet &optional start end expand-env)
- "Expand SNIPPET at current point.
-
-Text between START and END will be deleted before inserting
-template. EXPAND-ENV is a list of (SYM VALUE) let-style dynamic
-bindings considered when expanding the snippet. If omitted, use
-SNIPPET's expand-env field.
-
-SNIPPET may be a snippet structure (e.g., as returned by
-`yas-lookup-snippet'), or just a snippet body (which is a string
-for normal snippets, and a list for command snippets)."
- (cl-assert (and yas-minor-mode
- (memq 'yas--post-command-handler post-command-hook))
- nil
- "[yas] `yas-expand-snippet' needs properly setup
`yas-minor-mode'")
- (run-hooks 'yas-before-expand-snippet-hook)
-
- (let* ((clear-field
- (let ((field (and yas--active-field-overlay
- (overlay-buffer yas--active-field-overlay)
- (overlay-get yas--active-field-overlay
'yas--field))))
- (and field (yas--skip-and-clear-field-p
- field (point) (point) 0)
- field)))
- (start (cond (start)
- ((region-active-p)
- (region-beginning))
- (clear-field
- (yas--field-start clear-field))
- (t (point))))
- (end (cond (end)
- ((region-active-p)
- (region-end))
- (clear-field
- (yas--field-end clear-field))
- (t (point))))
- (to-delete (and (> end start)
- (buffer-substring-no-properties start end)))
- (yas-selected-text
- (cond (yas-selected-text)
- ((and (region-active-p)
- (not clear-field))
- to-delete))))
- (goto-char start)
- (setq yas--indent-original-column (current-column))
- ;; Delete the region to delete, this *does* get undo-recorded.
- (when to-delete
- (delete-region start end))
-
- (let ((content (if (yas--template-p snippet)
- (yas--template-content snippet)
- snippet)))
- (when (and (not expand-env) (yas--template-p snippet))
- (setq expand-env (yas--template-expand-env snippet)))
- (cond ((listp content)
- ;; x) This is a snippet-command.
- (yas--eval-for-effect content))
- (t
- ;; x) This is a snippet-snippet :-)
- (setq yas--start-column (current-column))
- ;; Stacked expansion: also shoosh the overlay modification hooks.
- (let ((yas--inhibit-overlay-hooks t))
- (setq snippet
- (yas--snippet-create content expand-env start (point))))
-
- ;; Stacked-expansion: This checks for stacked expansion, save the
- ;; `yas--previous-active-field' and advance its boundary.
- (let ((existing-field (and yas--active-field-overlay
- (overlay-buffer
yas--active-field-overlay)
- (overlay-get yas--active-field-overlay
'yas--field))))
- (when existing-field
- (setf (yas--snippet-previous-active-field snippet)
existing-field)
- (yas--advance-end-maybe existing-field (overlay-end
yas--active-field-overlay))))
-
- ;; Exit the snippet immediately if no fields.
- (unless (yas--snippet-fields snippet)
- (yas-exit-snippet snippet))
-
- ;; Now, schedule a move to the first field.
- (let ((first-field (car (yas--snippet-fields snippet))))
- (when first-field
- (sit-for 0) ;; fix issue 125
- (yas--letenv (yas--snippet-expand-env snippet)
- (yas--move-to-field snippet first-field))
- (when (and (eq (yas--field-number first-field) 0)
- (> (length (yas--field-text-for-display
- first-field))
- 0))
- ;; Keep region for ${0:exit text}.
- (setq deactivate-mark nil))))
- (yas--message 4 "snippet %d expanded." (yas--snippet-id snippet))
- t)))))
-
-(defun yas--take-care-of-redo (snippet)
- "Commits SNIPPET, which in turn pushes an undo action for reviving it.
-
-Meant to exit in the `buffer-undo-list'."
- ;; slightly optimize: this action is only needed for snippets with
- ;; at least one field
- (when (yas--snippet-fields snippet)
- (yas--commit-snippet snippet)))
-
-(defun yas--snippet-revive (beg end snippet)
- "Revives SNIPPET and creates a control overlay from BEG to END.
-
-BEG and END are, we hope, the original snippets boundaries.
-All the markers/points exiting existing inside SNIPPET should point
-to their correct locations *at the time the snippet is revived*.
-
-After revival, push the `yas--take-care-of-redo' in the
-`buffer-undo-list'"
- ;; Reconvert all the points to markers
- (yas--points-to-markers snippet)
- ;; When at least one editable field existed in the zombie snippet,
- ;; try to revive the whole thing...
- (when (yas--maybe-move-to-active-field snippet)
- (setf (yas--snippet-control-overlay snippet) (yas--make-control-overlay
snippet beg end))
- (overlay-put (yas--snippet-control-overlay snippet) 'yas--snippet snippet)
- (push snippet yas--active-snippets)
- (when (listp buffer-undo-list)
- (push `(apply yas--take-care-of-redo ,snippet)
- buffer-undo-list))))
-
-(defun yas--snippet-create (content expand-env begin end)
- "Create a snippet from a template inserted at BEGIN to END.
-
-Returns the newly created snippet."
- (save-restriction
- (let ((snippet (yas--make-snippet expand-env)))
- (yas--letenv expand-env
- ;; Put a single undo action for the expanded snippet's
- ;; content.
- (let ((buffer-undo-list t)
- (inhibit-modification-hooks t))
- ;; Some versions of cc-mode fail when inserting snippet
- ;; content in a narrowed buffer, so make sure to insert
- ;; before narrowing. Furthermore, call before and after
- ;; change functions manually, otherwise cc-mode's cache can
- ;; get messed up.
- (goto-char begin)
- (run-hook-with-args 'before-change-functions begin begin)
- (insert content)
- (setq end (+ end (length content)))
- (narrow-to-region begin end)
- (goto-char (point-min))
- (yas--snippet-parse-create snippet)
- (run-hook-with-args 'after-change-functions (point-min) (point-max)
0))
- (when (listp buffer-undo-list)
- (push (cons (point-min) (point-max))
- buffer-undo-list))
-
- ;; Indent, collecting undo information normally.
- (yas--indent snippet)
-
- ;; Follow up with `yas--take-care-of-redo' on the newly
- ;; inserted snippet boundaries.
- (when (listp buffer-undo-list)
- (push `(apply yas--take-care-of-redo ,snippet)
- buffer-undo-list))
-
- ;; Sort and link each field
- (yas--snippet-sort-fields snippet)
-
- ;; Create keymap overlay for snippet
- (setf (yas--snippet-control-overlay snippet)
- (yas--make-control-overlay snippet (point-min) (point-max)))
-
- ;; Move to end
- (goto-char (point-max))
-
- (push snippet yas--active-snippets)
- snippet))))
-
-
-;;; Apropos adjacencies and "fom's":
-;;
-;; Once the $-constructs bits like "$n" and "${:n" are deleted in the
-;; recently expanded snippet, we might actually have many fields,
-;; mirrors (and the snippet exit) in the very same position in the
-;; buffer. Therefore we need to single-link the
-;; fields-or-mirrors-or-exit (which I have abbreviated to "fom")
-;; according to their original positions in the buffer.
-;;
-;; Then we have operation `yas--advance-end-maybe' and
-;; `yas--advance-start-maybe', which conditionally push the starts and
-;; ends of these foms down the chain.
-;;
-;; This allows for like the printf with the magic ",":
-;;
-;; printf ("${1:%s}\\n"${1:$(if (string-match "%" text) "," "\);")} \
-;; $2${1:$(if (string-match "%" text) "\);" "")}$0
-;;
-(defun yas--fom-start (fom)
- (cond ((yas--field-p fom)
- (yas--field-start fom))
- ((yas--mirror-p fom)
- (yas--mirror-start fom))
- (t
- (yas--exit-marker fom))))
-
-(defun yas--fom-end (fom)
- (cond ((yas--field-p fom)
- (yas--field-end fom))
- ((yas--mirror-p fom)
- (yas--mirror-end fom))
- (t
- (yas--exit-marker fom))))
-
-(defun yas--fom-next (fom)
- (cond ((yas--field-p fom)
- (yas--field-next fom))
- ((yas--mirror-p fom)
- (yas--mirror-next fom))
- (t
- (yas--exit-next fom))))
-
-(defun yas--fom-parent-field (fom)
- (cond ((yas--field-p fom)
- (yas--field-parent-field fom))
- ((yas--mirror-p fom)
- (yas--mirror-parent-field fom))
- (t
- nil)))
-
-(defun yas--calculate-adjacencies (snippet)
- "Calculate adjacencies for fields or mirrors of SNIPPET.
-
-This is according to their relative positions in the buffer, and
-has to be called before the $-constructs are deleted."
- (let* ((fom-set-next-fom
- (lambda (fom nextfom)
- (cond ((yas--field-p fom)
- (setf (yas--field-next fom) nextfom))
- ((yas--mirror-p fom)
- (setf (yas--mirror-next fom) nextfom))
- (t
- (setf (yas--exit-next fom) nextfom)))))
- (compare-fom-begs
- (lambda (fom1 fom2)
- (if (= (yas--fom-start fom2) (yas--fom-start fom1))
- (yas--mirror-p fom2)
- (>= (yas--fom-start fom2) (yas--fom-start fom1)))))
- (link-foms fom-set-next-fom))
- ;; make some yas--field, yas--mirror and yas--exit soup
- (let ((soup))
- (when (yas--snippet-exit snippet)
- (push (yas--snippet-exit snippet) soup))
- (dolist (field (yas--snippet-fields snippet))
- (push field soup)
- (dolist (mirror (yas--field-mirrors field))
- (push mirror soup)))
- (setq soup
- (sort soup compare-fom-begs))
- (when soup
- (cl-reduce link-foms soup)))))
-
-(defun yas--calculate-simple-fom-parentage (snippet fom)
- "Discover if FOM is parented by some field in SNIPPET.
-
-Use the tightest containing field if more than one field contains
-the mirror. Intended to be called *before* the dollar-regions are
-deleted."
- (let ((min (point-min))
- (max (point-max)))
- (dolist (field (remq fom (yas--snippet-fields snippet)))
- (when (and (<= (yas--field-start field) (yas--fom-start fom))
- (<= (yas--fom-end fom) (yas--field-end field))
- (< min (yas--field-start field))
- (< (yas--field-end field) max))
- (setq min (yas--field-start field)
- max (yas--field-end field))
- (cond ((yas--field-p fom)
- (setf (yas--field-parent-field fom) field))
- ((yas--mirror-p fom)
- (setf (yas--mirror-parent-field fom) field))
- (t ; it's an exit, so noop
- nil ))))))
-
-(defun yas--advance-end-maybe (fom newend)
- "Maybe advance FOM's end to NEWEND if it needs it.
-
-If it does, also:
-
-* call `yas--advance-start-maybe' on FOM's next fom.
-
-* in case FOM is field call `yas--advance-end-maybe' on its parent
- field
-
-Also, if FOM is an exit-marker, always call
-`yas--advance-start-maybe' on its next fom. This is because
-exit-marker have identical start and end markers."
- (cond ((and fom (< (yas--fom-end fom) newend))
- (set-marker (yas--fom-end fom) newend)
- (yas--advance-start-maybe (yas--fom-next fom) newend)
- (yas--advance-end-of-parents-maybe (yas--fom-parent-field fom)
newend))
- ((yas--exit-p fom)
- (yas--advance-start-maybe (yas--fom-next fom) newend))))
-
-(defun yas--advance-start-maybe (fom newstart)
- "Maybe advance FOM's start to NEWSTART if it needs it.
-
-If it does, also call `yas--advance-end-maybe' on FOM."
- (when (and fom (< (yas--fom-start fom) newstart))
- (set-marker (yas--fom-start fom) newstart)
- (yas--advance-end-maybe fom newstart)))
-
-(defun yas--advance-end-of-parents-maybe (field newend)
- "Like `yas--advance-end-maybe' but for parent fields.
-
-Only works for fields and doesn't care about the start of the
-next FOM. Works its way up recursively for parents of parents."
- (when (and field
- (< (yas--field-end field) newend))
- (set-marker (yas--field-end field) newend)
- (yas--advance-end-of-parents-maybe (yas--field-parent-field field)
newend)))
-
-(defvar yas--dollar-regions nil
- "When expanding the snippet the \"parse-create\" functions add
-cons cells to this var.")
-
-(defvar yas--indent-markers nil
- "List of markers for manual indentation.")
-
-(defun yas--snippet-parse-create (snippet)
- "Parse a recently inserted snippet template, creating all
-necessary fields, mirrors and exit points.
-
-Meant to be called in a narrowed buffer, does various passes"
- (let ((saved-quotes nil)
- (parse-start (point)))
- ;; Avoid major-mode's syntax propertizing function, since we
- ;; change the syntax-table while calling `scan-sexps'.
- (let ((syntax-propertize-function nil))
- (setq yas--dollar-regions nil) ; Reset the yas--dollar-regions.
- (yas--protect-escapes nil '(?`)) ; Protect just the backquotes.
- (goto-char parse-start)
- (setq saved-quotes (yas--save-backquotes)) ; `expressions`.
- (yas--protect-escapes) ; Protect escaped characters.
- (goto-char parse-start)
- (yas--indent-parse-create) ; Parse indent markers: `$>'.
- (goto-char parse-start)
- (yas--field-parse-create snippet) ; Parse fields with {}.
- (goto-char parse-start)
- (yas--simple-fom-create snippet) ; Parse simple mirrors & fields.
- (goto-char parse-start)
- (yas--transform-mirror-parse-create snippet) ; Parse mirror transforms.
- ;; Invalidate any syntax-propertizing done while
- ;; `syntax-propertize-function' was nil.
- (syntax-ppss-flush-cache parse-start))
- ;; Set "next" links of fields & mirrors.
- (yas--calculate-adjacencies snippet)
- (yas--save-restriction-and-widen ; Delete $-constructs.
- (yas--delete-regions yas--dollar-regions))
- ;; Make sure to do this insertion *after* deleting the dollar
- ;; regions, otherwise we invalidate the calculated positions of
- ;; all the fields following $0.
- (let ((exit (yas--snippet-exit snippet)))
- (goto-char (if exit (yas--exit-marker exit) (point-max))))
- (when (eq yas-wrap-around-region 'cua)
- (setq yas-wrap-around-region ?0))
- (cond ((and yas-wrap-around-region yas-selected-text)
- (insert yas-selected-text))
- ((and (characterp yas-wrap-around-region)
- (get-register yas-wrap-around-region))
- (insert (prog1 (get-register yas-wrap-around-region)
- (set-register yas-wrap-around-region nil)))))
- (yas--restore-backquotes saved-quotes) ; Restore `expression` values.
- (goto-char parse-start)
- (yas--restore-escapes) ; Restore escapes.
- (yas--update-mirrors snippet) ; Update mirrors for the first time.
- (goto-char parse-start)))
-
-;; HACK: Some implementations of `indent-line-function' (called via
-;; `indent-according-to-mode') delete text before they insert (like
-;; cc-mode), some make complicated regexp replacements (looking at
-;; you, org-mode). To find place where the marker "should" go after
-;; indentation, we create a regexp based on what the line looks like
-;; before, putting a capture group where the marker is. The regexp
-;; matches any whitespace with [[:space:]]* to allow for the
-;; indentation changing whitespace. Additionally, we try to preserve
-;; the amount of whitespace *following* the marker, because
-;; indentation generally affects whitespace at the beginning, not the
-;; end.
-;;
-;; Two other cases where we apply a similar strategy:
-;;
-;; 1. Handling `auto-fill-mode', in this case we need to use the
-;; current paragraph instead of line.
-;;
-;; 2. Moving snippets from an `org-src' temp buffer into the main org
-;; buffer, in this case we need to count the relative line number
-;; (because org may add indentation on each line making character
-;; positions unreliable).
-;;
-;; Data formats:
-;; (LOCATION) = (REGEXP WS-COUNT)
-;; MARKER -> (MARKER . (LOCATION))
-;; OVERLAY -> (OVERLAY LOCATION-BEG LOCATION-END)
-;;
-;; For `org-src' temp buffer, add a line number to format:
-;; (LINE-LOCATION) = (LINE . (LOCATION))
-;; MARKER@LINE -> (MARKER . (LINE-LOCATION))
-;; OVERLAY@LINE -> (OVERLAY LINE-LOCATION-BEG LINE-LOCATION-END)
-;;
-;; This is all best-effort heuristic stuff, but it should cover 99% of
-;; use-cases.
-
-(defun yas--snapshot-location (position &optional beg end)
- "Returns info for restoring POSITIONS's location after indent.
-The returned value is a list of the form (REGEXP WS-COUNT).
-POSITION may be either a marker or just a buffer position. The
-REGEXP matches text between BEG..END which default to the current
-line if omitted."
- (goto-char position)
- (unless beg (setq beg (line-beginning-position)))
- (unless end (setq end (line-end-position)))
- (let ((before (split-string (buffer-substring-no-properties beg position)
- "[[:space:]\n]+" t))
- (after (split-string (buffer-substring-no-properties position end)
- "[[:space:]\n]+" t)))
- (list (concat "[[:space:]\n]*"
- (mapconcat (lambda (s)
- (if (eq s position) "\\(\\)"
- (regexp-quote s)))
- (nconc before (list position) after)
- "[[:space:]\n]*"))
- (progn (skip-chars-forward "[:space:]\n" end)
- (- (point) position)))))
-
-(defun yas--snapshot-line-location (position &optional beg end)
- "Like `yas--snapshot-location', but return also line number.
-Returned format is (LINE REGEXP WS-COUNT)."
- (goto-char position)
- (cons (count-lines (point-min) (line-beginning-position))
- (yas--snapshot-location position beg end)))
-
-(defun yas--snapshot-overlay-location (overlay beg end)
- "Like `yas--snapshot-location' for overlays.
-The returned format is (OVERLAY (RE WS) (RE WS)). Either of
-the (RE WS) lists may be nil if the start or end, respectively,
-of the overlay is outside the range BEG .. END."
- (let ((obeg (overlay-start overlay))
- (oend (overlay-end overlay)))
- (list overlay
- (when (and (<= beg obeg) (< obeg end))
- (yas--snapshot-location obeg beg end))
- (when (and (<= beg oend) (< oend end))
- (yas--snapshot-location oend beg end)))))
-
-(defun yas--snapshot-overlay-line-location (overlay)
- "Return info for restoring OVERLAY's line based location.
-The returned format is (OVERLAY (LINE RE WS) (LINE RE WS))."
- (list overlay
- (yas--snapshot-line-location (overlay-start overlay))
- (yas--snapshot-line-location (overlay-end overlay))))
-
-(defun yas--goto-saved-location (re-count)
- "Move to and return point saved by `yas--snapshot-location'.
-Buffer must be narrowed to BEG..END used to create the snapshot info."
- (let ((regexp (pop re-count))
- (ws-count (pop re-count)))
- (goto-char (point-min))
- (if (not (looking-at regexp))
- (lwarn '(yasnippet re-marker) :warning
- "Couldn't find: %S" regexp)
- (goto-char (match-beginning 1))
- (skip-chars-forward "[:space:]\n")
- (skip-chars-backward "[:space:]\n" (- (point) ws-count)))
- (point)))
-
-(defun yas--restore-overlay-location (ov-locations)
- "Restores marker based on info from `yas--snapshot-overlay-location'.
-Buffer must be narrowed to BEG..END used to create the snapshot info."
- (cl-destructuring-bind (overlay loc-beg loc-end) ov-locations
- (move-overlay overlay
- (if (not loc-beg) (overlay-start overlay)
- (yas--goto-saved-location loc-beg))
- (if (not loc-end) (overlay-end overlay)
- (yas--goto-saved-location loc-end)))))
-
-(defun yas--goto-saved-line-location (base-pos l-re-count)
- "Move to and return point saved by `yas--snapshot-line-location'.
-Additionally requires BASE-POS to tell where the line numbers are
-relative to."
- (goto-char base-pos)
- (forward-line (pop l-re-count))
- (save-restriction
- (narrow-to-region (line-beginning-position)
- (line-end-position))
- (yas--goto-saved-location l-re-count)))
-
-(defun yas--restore-overlay-line-location (base-pos ov-locations)
- "Restores marker based on info from `yas--snapshot-overlay-line-location'."
- (cl-destructuring-bind (overlay beg-l-r-w end-l-r-w)
- ov-locations
- (move-overlay overlay
- (yas--goto-saved-line-location base-pos beg-l-r-w)
- (yas--goto-saved-line-location base-pos end-l-r-w))))
-
-(defun yas--indent-region (from to snippet)
- "Indent the lines between FROM and TO with `indent-according-to-mode'.
-The SNIPPET's markers are preserved."
- (save-excursion
- (yas--save-restriction-and-widen
- (let* ((snippet-markers (yas--collect-snippet-markers snippet))
- (to (set-marker (make-marker) to)))
- (goto-char from)
- (cl-loop for bol = (line-beginning-position)
- for eol = (line-end-position)
- if (or yas-also-indent-empty-lines
- (/= bol eol))
- do
- ;; Indent each non-empty line.
- (let ((remarkers nil))
- (dolist (m snippet-markers)
- (when (and (<= bol m) (<= m eol))
- (push (cons m (yas--snapshot-location m bol eol))
- remarkers)))
- (unwind-protect
- (progn (back-to-indentation)
- (indent-according-to-mode))
- (save-restriction
- (narrow-to-region bol (line-end-position))
- (dolist (remarker remarkers)
- (set-marker (car remarker)
- (yas--goto-saved-location (cdr
remarker)))))))
- while (and (zerop (forward-line 1))
- (< (point) to)))))))
-
-(defvar yas--indent-original-column nil)
-(defun yas--indent (snippet)
- ;; Indent lines that had indent markers (`$>') on them.
- (save-excursion
- (dolist (marker yas--indent-markers)
- (unless (eq yas-indent-line 'auto)
- (goto-char marker)
- (yas--indent-region (line-beginning-position)
- (line-end-position)
- snippet))
- ;; Finished with this marker.
- (set-marker marker nil))
- (setq yas--indent-markers nil))
- ;; Now do stuff for `fixed' and `auto'.
- (save-excursion
- ;; We need to be at end of line, so that `forward-line' will only
- ;; report 0 if it actually moves over a newline.
- (end-of-line)
- (cond ((eq yas-indent-line 'fixed)
- (when (= (forward-line 1) 0)
- (let ((indent-line-function
- (lambda ()
- ;; We need to be at beginning of line in order to
- ;; indent existing whitespace correctly.
- (beginning-of-line)
- (indent-to-column yas--indent-original-column))))
- (yas--indent-region (line-beginning-position)
- (point-max)
- snippet))))
- ((eq yas-indent-line 'auto)
- (when (or yas-also-auto-indent-first-line
- (= (forward-line 1) 0))
- (yas--indent-region (line-beginning-position)
- (point-max)
- snippet))))))
-
-(defun yas--collect-snippet-markers (snippet)
- "Make a list of all the markers used by SNIPPET."
- (let (markers)
- (yas--snippet-map-markers (lambda (m) (push m markers) m) snippet)
- markers))
-
-(defun yas--escape-string (escaped)
- (concat "YASESCAPE" (format "%d" escaped) "PROTECTGUARD"))
-
-(defun yas--protect-escapes (&optional text escaped)
- "Protect all escaped characters with their numeric ASCII value.
-
-With optional string TEXT do it in string instead of buffer."
- (let ((changed-text text)
- (text-provided-p text))
- (mapc #'(lambda (escaped)
- (setq changed-text
- (yas--replace-all (concat "\\" (char-to-string escaped))
- (yas--escape-string escaped)
- (when text-provided-p changed-text))))
- (or escaped yas--escaped-characters))
- changed-text))
-
-(defun yas--restore-escapes (&optional text escaped)
- "Restore all escaped characters from their numeric ASCII value.
-
-With optional string TEXT do it in string instead of the buffer."
- (let ((changed-text text)
- (text-provided-p text))
- (mapc #'(lambda (escaped)
- (setq changed-text
- (yas--replace-all (yas--escape-string escaped)
- (char-to-string escaped)
- (when text-provided-p changed-text))))
- (or escaped yas--escaped-characters))
- changed-text))
-
-(defun yas--save-backquotes ()
- "Save all \"\\=`(lisp-expression)\\=`\"-style expressions.
-Return a list of (MARKER . STRING) entires for each backquoted
-Lisp expression."
- (let* ((saved-quotes nil)
- (yas--snippet-buffer (current-buffer))
- (yas--change-detected nil)
- (detect-change (lambda (_beg _end)
- (when (eq (current-buffer) yas--snippet-buffer)
- (setq yas--change-detected t)))))
- (while (re-search-forward yas--backquote-lisp-expression-regexp nil t)
- (let ((current-string (match-string-no-properties 1)) transformed)
- (yas--save-restriction-and-widen
- (delete-region (match-beginning 0) (match-end 0)))
- (let ((before-change-functions
- (cons detect-change before-change-functions)))
- (setq transformed (yas--eval-for-string (yas--read-lisp
- (yas--restore-escapes
- current-string '(?`))))))
- (goto-char (match-beginning 0))
- (when transformed
- (let ((marker (make-marker)))
- (yas--save-restriction-and-widen
- (insert "Y") ;; quite horrendous, I love it :)
- (set-marker marker (point))
- (insert "Y"))
- (push (cons marker transformed) saved-quotes)))))
- (when yas--change-detected
- (lwarn '(yasnippet backquote-change) :warning
- "`%s' modified buffer in a backquote expression.
- To hide this warning, add (yasnippet backquote-change) to
`warning-suppress-types'."
- (if yas--current-template
- (yas--template-name yas--current-template)
- "Snippet")))
- saved-quotes))
-
-(defun yas--restore-backquotes (saved-quotes)
- "Replace markers in SAVED-QUOTES with their values.
-SAVED-QUOTES is the in format returned by `yas--save-backquotes'."
- (cl-loop for (marker . string) in saved-quotes do
- (save-excursion
- (goto-char marker)
- (yas--save-restriction-and-widen
- (delete-char -1)
- (insert string)
- (delete-char 1))
- (set-marker marker nil))))
-
-(defun yas--scan-sexps (from count)
- (ignore-errors
- (save-match-data ; `scan-sexps' may modify match data.
- ;; Parse using the syntax table corresponding to the yasnippet syntax.
- (with-syntax-table (standard-syntax-table)
- ;; And ignore syntax-table properties that may have been placed by the
- ;; major mode since these aren't related to the yasnippet syntax.
- (let ((parse-sexp-lookup-properties nil))
- (scan-sexps from count))))))
-
-(defun yas--make-marker (pos)
- "Create a marker at POS with nil `marker-insertion-type'."
- (let ((marker (set-marker (make-marker) pos)))
- (set-marker-insertion-type marker nil)
- marker))
-
-(defun yas--indent-parse-create ()
- "Parse the \"$>\" indentation markers just inserted."
- (setq yas--indent-markers ())
- (while (search-forward "$>" nil t)
- (delete-region (match-beginning 0) (match-end 0))
- ;; Mark the beginning of the line.
- (push (yas--make-marker (line-beginning-position))
- yas--indent-markers))
- (setq yas--indent-markers (nreverse yas--indent-markers)))
-
-(defun yas--field-parse-create (snippet &optional parent-field)
- "Parse most field expressions in SNIPPET, except for the simple one \"$n\".
-
-The following count as a field:
-
-* \"${n: text}\", for a numbered field with default text, as long as N is not
0;
-
-* \"${n: text$(expression)}, the same with a Lisp expression;
- this is caught with the curiously named
`yas--multi-dollar-lisp-expression-regexp'
-
-* the same as above but unnumbered, (no N:) and number is calculated
automatically.
-
-When multiple expressions are found, only the last one counts."
- ;;
- (save-excursion
- (while (re-search-forward yas--field-regexp nil t)
- (let* ((brace-scan (yas--scan-sexps (1+ (match-beginning 0)) 1))
- ;; if the `brace-scan' didn't reach a brace, we have a
- ;; snippet with invalid escaping, probably a closing
- ;; brace escaped with two backslashes (github#979). But
- ;; be lenient, because we can.
- (real-match-end-0 (if (eq ?} (char-before brace-scan))
- brace-scan
- (point)))
- (number (and (match-string-no-properties 1)
- (string-to-number (match-string-no-properties 1))))
- (brand-new-field (and real-match-end-0
- ;; break if on "$(" immediately
- ;; after the ":", this will be
- ;; caught as a mirror with
- ;; transform later.
- (not (string-match-p "\\`\\$[ \t\n]*("
-
(match-string-no-properties 2)))
- ;; allow ${0: some exit text}
- ;; (not (and number (zerop number)))
- (yas--make-field number
- (yas--make-marker
(match-beginning 2))
- (yas--make-marker (1-
real-match-end-0))
- parent-field))))
- (when brand-new-field
- (goto-char real-match-end-0)
- (push (cons (1- real-match-end-0) real-match-end-0)
- yas--dollar-regions)
- (push (cons (match-beginning 0) (match-beginning 2))
- yas--dollar-regions)
- (push brand-new-field (yas--snippet-fields snippet))
- (save-excursion
- (save-restriction
- (narrow-to-region (yas--field-start brand-new-field)
(yas--field-end brand-new-field))
- (goto-char (point-min))
- (yas--field-parse-create snippet brand-new-field)))))))
- ;; if we entered from a parent field, now search for the
- ;; `yas--multi-dollar-lisp-expression-regexp'. This is used for
- ;; primary field transformations
- ;;
- (when parent-field
- (save-excursion
- (while (re-search-forward yas--multi-dollar-lisp-expression-regexp nil t)
- (let* ((real-match-end-1 (yas--scan-sexps (match-beginning 1) 1)))
- ;; commit the primary field transformation if:
- ;;
- ;; 1. we don't find it in yas--dollar-regions (a subnested
- ;; field) might have already caught it.
- ;;
- ;; 2. we really make sure we have either two '$' or some
- ;; text and a '$' after the colon ':'. This is a FIXME: work
- ;; my regular expressions and end these ugly hacks.
- ;;
- (when (and real-match-end-1
- (not (member (cons (match-beginning 0)
- real-match-end-1)
- yas--dollar-regions))
- (not (eq ?:
- (char-before (1- (match-beginning 1))))))
- (let ((lisp-expression-string (buffer-substring-no-properties
(match-beginning 1)
-
real-match-end-1)))
- (setf (yas--field-transform parent-field)
- (yas--read-lisp (yas--restore-escapes
lisp-expression-string))))
- (push (cons (match-beginning 0) real-match-end-1)
- yas--dollar-regions)))))))
-
-(defun yas--transform-mirror-parse-create (snippet)
- "Parse the \"${n:$(lisp-expression)}\" mirror transformations in SNIPPET."
- (while (re-search-forward yas--transform-mirror-regexp nil t)
- (let* ((real-match-end-0 (yas--scan-sexps (1+ (match-beginning 0)) 1))
- (number (string-to-number (match-string-no-properties 1)))
- (field (and number
- (not (zerop number))
- (yas--snippet-find-field snippet number)))
- (brand-new-mirror
- (and real-match-end-0
- field
- (yas--make-mirror (yas--make-marker (match-beginning 0))
- (yas--make-marker (match-beginning 0))
- (yas--read-lisp
- (yas--restore-escapes
- (buffer-substring-no-properties
(match-beginning 2)
- (1-
real-match-end-0))))))))
- (when brand-new-mirror
- (push brand-new-mirror
- (yas--field-mirrors field))
- (yas--calculate-simple-fom-parentage snippet brand-new-mirror)
- (push (cons (match-beginning 0) real-match-end-0)
yas--dollar-regions)))))
-
-(defun yas--simple-fom-create (snippet)
- "Parse the simple \"$n\" fields/mirrors/exitmarkers in SNIPPET."
- (while (re-search-forward yas--simple-mirror-regexp nil t)
- (let ((number (string-to-number (match-string-no-properties 1))))
- (cond ((zerop number)
- (setf (yas--snippet-exit snippet)
- (yas--make-exit (yas--make-marker (match-end 0))))
- (push (cons (match-beginning 0) (yas--exit-marker
(yas--snippet-exit snippet)))
- yas--dollar-regions))
- (t
- (let ((field (yas--snippet-find-field snippet number))
- (fom))
- (if field
- (push
- (setq fom (yas--make-mirror
- (yas--make-marker (match-beginning 0))
- (yas--make-marker (match-beginning 0))
- nil))
- (yas--field-mirrors field))
- (push
- (setq fom (yas--make-field number
- (yas--make-marker
(match-beginning 0))
- (yas--make-marker
(match-beginning 0))
- nil))
- (yas--snippet-fields snippet)))
- (yas--calculate-simple-fom-parentage snippet fom))
- (push (cons (match-beginning 0) (match-end 0))
- yas--dollar-regions))))))
-
-(defun yas--delete-regions (regions)
- "Sort disjuct REGIONS by start point, then delete from the back."
- (mapc #'(lambda (reg)
- (delete-region (car reg) (cdr reg)))
- (sort regions
- #'(lambda (r1 r2)
- (>= (car r1) (car r2))))))
-
-(defun yas--calculate-mirror-depth (mirror &optional traversed)
- (let* ((parent (yas--mirror-parent-field mirror))
- (parents-mirrors (and parent
- (yas--field-mirrors parent))))
- (or (yas--mirror-depth mirror)
- (setf (yas--mirror-depth mirror)
- (cond ((memq mirror traversed) 0)
- ((and parent parents-mirrors)
- (1+ (cl-reduce
- #'max parents-mirrors
- :key (lambda (m)
- (yas--calculate-mirror-depth
- m (cons mirror traversed))))))
- (parent 1)
- (t 0))))))
-
-(defun yas--snippet-field-mirrors (snippet)
- ;; Make a list of (FIELD . MIRROR).
- (cl-sort
- (cl-mapcan (lambda (field)
- (mapcar (lambda (mirror)
- (cons field mirror))
- (yas--field-mirrors field)))
- (yas--snippet-fields snippet))
- ;; Then sort this list so that entries with mirrors with
- ;; parent fields appear before. This was important for
- ;; fixing #290, and also handles the case where a mirror in
- ;; a field causes another mirror to need reupdating.
- #'> :key (lambda (fm) (yas--calculate-mirror-depth (cdr fm)))))
-
-(defun yas--indent-mirrors-of-snippet (snippet &optional f-ms)
- ;; Indent mirrors of SNIPPET. F-MS is the return value of
- ;; (yas--snippet-field-mirrors SNIPPET).
- (when (eq yas-indent-line 'auto)
- (let ((yas--inhibit-overlay-hooks t))
- (cl-loop for (beg . end) in
- (cl-sort (mapcar (lambda (f-m)
- (let ((mirror (cdr f-m)))
- (cons (yas--mirror-start mirror)
- (yas--mirror-end mirror))))
- (or f-ms
- (yas--snippet-field-mirrors snippet)))
- #'< :key #'car)
- do (yas--indent-region beg end snippet)))))
-
-(defun yas--update-mirrors (snippet)
- "Update all the mirrors of SNIPPET."
- (yas--save-restriction-and-widen
- (save-excursion
- (let ((f-ms (yas--snippet-field-mirrors snippet)))
- (cl-loop
- for (field . mirror) in f-ms
- ;; Before updating a mirror with a parent-field, maybe advance
- ;; its start (#290).
- do (let ((parent-field (yas--mirror-parent-field mirror)))
- (when parent-field
- (yas--advance-start-maybe mirror (yas--fom-start
parent-field))))
- ;; Update this mirror.
- do (yas--mirror-update-display mirror field)
- ;; `yas--place-overlays' is needed since the active field and
- ;; protected overlays might have been changed because of insertions
- ;; in `yas--mirror-update-display'.
- do (let ((active-field (yas--snippet-active-field snippet)))
- (when active-field (yas--place-overlays snippet active-field))))
- ;; Delay indenting until we're done all mirrors. We must do
- ;; this to avoid losing whitespace between fields that are
- ;; still empty (i.e., they will be non-empty after updating).
- (yas--indent-mirrors-of-snippet snippet f-ms)))))
-
-(defun yas--mirror-update-display (mirror field)
- "Update MIRROR according to FIELD (and mirror transform)."
-
- (let* ((mirror-parent-field (yas--mirror-parent-field mirror))
- (reflection (and (not (and mirror-parent-field
- (yas--field-modified-p
mirror-parent-field)))
- (or (yas--apply-transform mirror field 'empty-on-nil)
- (yas--field-text-for-display field)))))
- (when (and reflection
- (not (string= reflection (buffer-substring-no-properties
(yas--mirror-start mirror)
-
(yas--mirror-end mirror)))))
- (goto-char (yas--mirror-start mirror))
- (let ((yas--inhibit-overlay-hooks t))
- (insert reflection))
- (if (> (yas--mirror-end mirror) (point))
- (delete-region (point) (yas--mirror-end mirror))
- (set-marker (yas--mirror-end mirror) (point))
- (yas--advance-start-maybe (yas--mirror-next mirror) (point))
- ;; super-special advance
- (yas--advance-end-of-parents-maybe mirror-parent-field (point))))))
-
-(defun yas--field-update-display (field)
- "Much like `yas--mirror-update-display', but for fields."
- (when (yas--field-transform field)
- (let ((transformed (and (not (eq (yas--field-number field) 0))
- (yas--apply-transform field field))))
- (when (and transformed
- (not (string= transformed (buffer-substring-no-properties
(yas--field-start field)
-
(yas--field-end field)))))
- (setf (yas--field-modified-p field) t)
- (goto-char (yas--field-start field))
- (let ((yas--inhibit-overlay-hooks t))
- (insert transformed)
- (if (> (yas--field-end field) (point))
- (delete-region (point) (yas--field-end field))
- (set-marker (yas--field-end field) (point))
- (yas--advance-start-maybe (yas--field-next field) (point)))
- t)))))
-
-
-;;; Post-command hook:
-;;
-(defun yas--post-command-handler ()
- "Handles various yasnippet conditions after each command."
- (when (and yas--watch-auto-fill-backtrace
- (fboundp 'backtrace--print-frame)
- (null yas--original-auto-fill-function)
- (eq auto-fill-function 'yas--auto-fill))
- (lwarn '(yasnippet auto-fill bug) :error
- "`yas--original-auto-fill-function' unexpectedly nil! Please report
this backtrace\n%S"
- (with-output-to-string
- (mapc #'backtrace--print-frame
- yas--watch-auto-fill-backtrace)))
- ;; Don't pop up more than once in a session (still log though).
- (defvar warning-suppress-types) ; `warnings' is autoloaded by `lwarn'.
- (add-to-list 'warning-suppress-types '(yasnippet auto-fill bug)))
- (yas--do-todo-snippet-indent)
- (condition-case err
- (progn (yas--finish-moving-snippets)
- (cond ((eq 'undo this-command)
- ;;
- ;; After undo revival the correct field is sometimes not
- ;; restored correctly, this condition handles that
- ;;
- (let* ((snippet (car (yas-active-snippets)))
- (target-field
- (and snippet
- (cl-find-if-not
- (lambda (field)
- (yas--field-probably-deleted-p snippet
field))
- (remq nil
- (cons (yas--snippet-active-field
snippet)
- (yas--snippet-fields
snippet)))))))
- (when target-field
- (yas--move-to-field snippet target-field))))
- ((not (yas--undo-in-progress))
- ;; When not in an undo, check if we must commit the snippet
- ;; (user exited it).
- (yas--check-commit-snippet))))
- ((debug error) (signal (car err) (cdr err)))))
-
-;;; Fancy docs:
-;;
-;; The docstrings for some functions are generated dynamically
-;; depending on the context.
-;;
-(put 'yas-expand 'function-documentation
- '(yas--expand-from-trigger-key-doc t))
-(defun yas--expand-from-trigger-key-doc (context)
- "A doc synthesizer for `yas--expand-from-trigger-key-doc'."
- (let* ((yas-fallback-behavior (and context yas-fallback-behavior))
- (fallback-description
- (cond ((eq yas-fallback-behavior 'call-other-command)
- (let* ((fallback (yas--keybinding-beyond-yasnippet)))
- (or (and fallback
- (format "call command `%s'."
- (pp-to-string fallback)))
- "do nothing (`yas-expand' doesn't
override\nanything).")))
- ((eq yas-fallback-behavior 'return-nil)
- "do nothing.")
- (t "defer to `yas-fallback-behavior' (which see)."))))
- (concat "Expand a snippet before point. If no snippet
-expansion is possible, "
- fallback-description
- "\n\nOptional argument FIELD is for non-interactive use and is an
-object satisfying `yas--field-p' to restrict the expansion to.")))
-
-(put 'yas-expand-from-keymap 'function-documentation
- '(yas--expand-from-keymap-doc t))
-(defun yas--expand-from-keymap-doc (context)
- "A doc synthesizer for `yas--expand-from-keymap-doc'."
- (add-hook 'temp-buffer-show-hook #'yas--snippet-description-finish-runonce)
- (concat "Expand/run snippets from keymaps, possibly falling back to original
binding.\n"
- (when (and context (eq this-command 'describe-key))
- (let* ((vec (this-single-command-keys))
- (templates (cl-mapcan (lambda (table)
- (yas--fetch table vec))
- (yas--get-snippet-tables)))
- (yas--direct-keymaps nil)
- (fallback (key-binding vec)))
- (concat "In this case, "
- (when templates
- (concat "these snippets are bound to this key:\n"
- (yas--template-pretty-list templates)
- "\n\nIf none of these expands, "))
- (or (and fallback
- (format "fallback `%s' will be called."
(pp-to-string fallback)))
- "no fallback keybinding is called."))))))
-
-(defun yas--template-pretty-list (templates)
- (let ((acc)
- (yas-buffer-local-condition 'always))
- (dolist (plate templates)
- (setq acc (concat acc "\n*) "
- (propertize (concat "\\\\snippet `" (car plate) "'")
- 'yasnippet (cdr plate)))))
- acc))
-
-(define-button-type 'help-snippet-def
- :supertype 'help-xref
- 'help-function (lambda (template) (yas--visit-snippet-file-1 template))
- 'help-echo (purecopy "mouse-2, RET: find snippets's definition"))
-
-(defun yas--snippet-description-finish-runonce ()
- "Final adjustments for the help buffer when snippets are concerned."
- (yas--create-snippet-xrefs)
- (remove-hook 'temp-buffer-show-hook
- #'yas--snippet-description-finish-runonce))
-
-(defun yas--create-snippet-xrefs ()
- (save-excursion
- (goto-char (point-min))
- (while (search-forward-regexp "\\\\\\\\snippet[ \s\t]+`\\([^']+\\)'" nil t)
- (let ((template (get-text-property (match-beginning 1)
- 'yasnippet)))
- (when template
- (help-xref-button 1 'help-snippet-def template)
- (delete-region (match-end 1) (match-end 0))
- (delete-region (match-beginning 0) (match-beginning 1)))))))
-
-;;; Eldoc configuration.
-(eldoc-add-command 'yas-next-field-or-maybe-expand
- 'yas-next-field 'yas-prev-field
- 'yas-expand 'yas-expand-from-keymap
- 'yas-expand-from-trigger-key)
-
-;;; Utils
-
-(defvar yas-verbosity 3
- "Log level for `yas--message' 4 means trace most anything, 0 means nothing.")
-
-(defun yas--message (level message &rest args)
- "When LEVEL is at or below `yas-verbosity', log MESSAGE and ARGS."
- (when (>= yas-verbosity level)
- (message "%s" (apply #'yas--format message args))))
-
-(defun yas--warning (format-control &rest format-args)
- (let ((msg (apply #'format format-control format-args)))
- (display-warning 'yasnippet msg :warning)
- (yas--message 1 msg)))
-
-(defun yas--format (format-control &rest format-args)
- (apply #'format (concat "[yas] " format-control) format-args))
-
-
-;;; Unloading
-
-(defvar unload-function-defs-list) ; loadhist.el
-
-(defun yasnippet-unload-function ()
- "Disable minor modes when calling `unload-feature'."
- ;; Disable `yas-minor-mode' everywhere it's enabled.
- (yas-global-mode -1)
- (save-current-buffer
- (dolist (buffer (buffer-list))
- (set-buffer buffer)
- (when yas-minor-mode
- (yas-minor-mode -1))))
- ;; Remove symbol properties of all our functions, this avoids
- ;; Bug#25088 in Emacs 25.1, where the compiler macro on
- ;; `cl-defstruct' created functions hang around in the symbol plist
- ;; and cause errors when loading again (we don't *need* to clean
- ;; *all* symbol plists, but it's easier than being precise).
- (dolist (def unload-function-defs-list)
- (when (eq (car-safe def) 'defun)
- (setplist (cdr def) nil)))
- ;; Return nil so that `unload-feature' will take of undefining
- ;; functions, and changing any buffers using `snippet-mode'.
- nil)
-
-
-;;; Backward compatibility to yasnippet <= 0.7
-
-(defun yas-initialize ()
- "For backward compatibility, enable `yas-minor-mode' globally."
- (declare (obsolete "Use (yas-global-mode 1) instead." "0.8"))
- (yas-global-mode 1))
-
-(defvar yas--backported-syms '(;; `defcustom's
- ;;
- yas-snippet-dirs
- yas-prompt-functions
- yas-indent-line
- yas-also-auto-indent-first-line
- yas-snippet-revival
- yas-triggers-in-field
- yas-fallback-behavior
- yas-choose-keys-first
- yas-choose-tables-first
- yas-use-menu
- yas-trigger-symbol
- yas-wrap-around-region
- yas-good-grace
- yas-visit-from-menu
- yas-expand-only-for-last-commands
- yas-field-highlight-face
-
- ;; these vars can be customized as well
- ;;
- yas-keymap
- yas-verbosity
- yas-extra-modes
- yas-key-syntaxes
- yas-after-exit-snippet-hook
- yas-before-expand-snippet-hook
- yas-buffer-local-condition
- yas-dont-activate
-
- ;; prompting functions
- ;;
- yas-x-prompt
- yas-ido-prompt
- yas-no-prompt
- yas-completing-prompt
- yas-dropdown-prompt
-
- ;; interactive functions
- ;;
- yas-expand
- yas-minor-mode
- yas-global-mode
- yas-direct-keymaps-reload
- yas-minor-mode-on
- yas-load-directory
- yas-reload-all
- yas-compile-directory
- yas-recompile-all
- yas-about
- yas-expand-from-trigger-key
- yas-expand-from-keymap
- yas-insert-snippet
- yas-visit-snippet-file
- yas-new-snippet
- yas-load-snippet-buffer
- yas-tryout-snippet
- yas-describe-tables
- yas-next-field-or-maybe-expand
- yas-next-field
- yas-prev-field
- yas-abort-snippet
- yas-exit-snippet
- yas-exit-all-snippets
- yas-skip-and-clear-or-delete-char
- yas-initialize
-
- ;; symbols that I "exported" for use
- ;; in snippets and hookage
- ;;
- yas-expand-snippet
- yas-define-snippets
- yas-define-menu
- yas-snippet-beg
- yas-snippet-end
- yas-modified-p
- yas-moving-away-p
- yas-substr
- yas-choose-value
- yas-key-to-value
- yas-throw
- yas-verify-value
- yas-field-value
- yas-text
- yas-selected-text
- yas-default-from-field
- yas-inside-string
- yas-unimplemented
- yas-define-condition-cache
- yas-hippie-try-expand
-
- ;; debug definitions
- ;; yas-debug-snippet-vars
- ;; yas-exterminate-package
- ;; yas-debug-test
-
- ;; testing definitions
- ;; yas-should-expand
- ;; yas-should-not-expand
- ;; yas-mock-insert
- ;; yas-make-file-or-dirs
- ;; yas-variables
- ;; yas-saving-variables
- ;; yas-call-with-snippet-dirs
- ;; yas-with-snippet-dirs
-)
- "Backported yasnippet symbols.
-
-They are mapped to \"yas/*\" variants.")
-
-(when yas-alias-to-yas/prefix-p
- (dolist (sym yas--backported-syms)
- (let ((backported (intern (replace-regexp-in-string "\\`yas-" "yas/"
(symbol-name sym)))))
- (when (boundp sym)
- (make-obsolete-variable backported sym "yasnippet 0.8")
- (defvaralias backported sym))
- (when (fboundp sym)
- (make-obsolete backported sym "yasnippet 0.8")
- (defalias backported sym))))
- (make-obsolete 'yas/root-directory 'yas-snippet-dirs "yasnippet 0.8")
- (defvaralias 'yas/root-directory 'yas-snippet-dirs))
-
-(defvar yas--exported-syms
- (let (exported)
- (mapatoms (lambda (atom)
- (if (and (or (and (boundp atom)
- (not (get atom 'byte-obsolete-variable)))
- (and (fboundp atom)
- (not (get atom 'byte-obsolete-info))))
- (string-match-p "\\`yas-[^-]" (symbol-name atom)))
- (push atom exported))))
- exported)
- "Exported yasnippet symbols.
-
-i.e. the ones with \"yas-\" single dash prefix. I will try to
-keep them in future yasnippet versions and other elisp libraries
-can more or less safely rely upon them.")
-
-
-(provide 'yasnippet)
-;; Local Variables:
-;; coding: utf-8
-;; indent-tabs-mode: nil
-;; End:
-;;; yasnippet.el ends here
diff --git a/packages/ztree/README.md b/packages/ztree/README.md
deleted file mode 100644
index dc1907a..0000000
--- a/packages/ztree/README.md
+++ /dev/null
@@ -1,108 +0,0 @@
-# ztree
-Ztree is a project dedicated to implementation of several text-tree
applications inside [GNU Emacs](http://www.gnu.org/software/emacs/). It
consists of 2 subprojects: **ztree-diff** and **ztree-dir** (the basis of
**ztree-diff**). Available in [GNU ELPA](https://elpa.gnu.org/) and
[MELPA](http://melpa.org/#/).
-
-## Installation
-
-### Using ELPA
-Press `M-x` in GNU Emacs and write `list-packages`. Find the `ztree` in the
list of packages and press `i` to select this package, `x` to install the
package.
-
-### Using MELPA
-Add to your `.emacs` or `.emacs.d/init.el` following lines:
-
-```scheme
-(setq package-archives '(("gnu" . "http://elpa.gnu.org/packages/";)
- ("melpa" . "http://melpa.milkbox.net/packages/";)))
-```
-
-Follow the installation instructions for the GNU ELPA above.
-
-### Manual
-Add the following to your .emacs file:
-
-```scheme
-(push (substitute-in-file-name "path-to-ztree-directory") load-path)
-(require 'ztree)
-```
-
-## ztree-diff
-**ztree-diff** is a directory-diff tool for Emacs inspired by commercial tools
like Beyond Compare or Araxis Merge. It supports showing the difference between
two directories; calling **Ediff** for not matching files, copying between
directories, deleting file/directories, hiding/showing equal files/directories.
-
-The comparison itself performed with the external **GNU diff** tool, so make
sure to have one in the executable path. Verified on OSX and Linux.
-
-If one wants to have a stand-alone application, consider the
(WIP)[zdircmp](https://github.com/fourier/zdircmp) project based on
**ztree-diff**.
-
-Call the `ztree-diff` interactive function:
-
-```
-M-x ztree-diff
-```
-Then you need to specify the left and right directories to compare.
-
-### Hotkeys supported
- * Open/close directories with double-click, `RET` or `Space` keys.
- * To jump to the parent directory, hit the `Backspace` key.
- * To toggle open/closed state of the subtree of the current directory, hit
the `x` key.
- * `RET` on different files starts the **Ediff** (or open file if one absent
or the same)
- * `Space` show the simple diff window for the current file instead of
**Ediff** (or view file if one absent or the same)
- * `TAB` to fast switch between panels
- * `h` key to toggle show/hide identical files/directories
- * `H` key to toggle show/hide hidden/ignored files/directories
- * `C` key to copy current file or directory to the left or right panel
- * `D` key to delete current file or directory
- * `v` key to quick view the current file
- * `r` initiates the rescan/refresh of current file or subdirectory
- * `F5` forces the full rescan.
-
-### Customizations
-By default all files starting with dot (like `.gitignore`) are not shown and
excluded from the difference status for directories. One can add an additional
regexps to the list `ztree-diff-filter-list`.
-
-One also could turn on unicode characters to draw the tree with instead of
normal ASCII-characters. This is controlled by the `ztree-draw-unicode-lines`
variable.
-
-### Screenshots
-
-
-
-
-
-## ztree-dir
-
-**ztree-dir** is a simple text-mode directory tree for Emacs. See screenshots
below for the GUI and the terminal versions of the **ztree-dir**.
-
-Call the `ztree-dir` interactive function:
-
-```
-M-x ztree-dir
-```
-
-### Hotkeys supported
-* Open/close directories with double-click, `RET` or `Space` keys.
-* To jump to the parent directory, hit the `Backspace` key.
-* To toggle open/closed state of the subtree of the current directory, hit the
`x` key.
-* To visit a file, press `Space` key.
-* To open file in other window, use `RET` key.
-
-### Customizations
-Set the `ztree-dir-move-focus` variable to `t` in order to move focus to the
other window when the `RET` key is pressed; the default behavior is to keep
focus in `ztree-dir` window.
-
-
-
-
-
-
-
-## Contributions
-You can contribute to **ztree** in one of the following ways.
-- Submit a bug report
-- Submit a feature request
-- Submit a simple pull request (with changes < 15 lines)
-
-### Copyright issues
-Since **ztree** is a part of [GNU ELPA](https://elpa.gnu.org/), it is
copyrighted by the [Free Software Foundation, Inc.](http://www.fsf.org/).
Therefore in order to submit nontrivial changes (with total amount of lines >
15), one needs to to grant the right to include your works in GNU Emacs to the
FSF.
-
-For this you need to complete
[this](https://raw.githubusercontent.com/fourier/ztree/contributions/request-assign.txt)
form, and send it to [assign@gnu.org](mailto:assign@gnu.org). The FSF will
send you the assignment contract that both you and the FSF will sign.
-
-For more information one can read
[here](http://www.gnu.org/licenses/why-assign.html) to understand why it is
needed.
-
-As soon as the paperwork is done one can contribute to **ztree** with bigger
pull requests.
-Note what pull requests without paperwork done will not be accepted, so please
notify the [maintainer](mailto:alexey.veretennikov@gmail.com) if everything is
in place.
-
diff --git a/packages/ztree/ztree-diff-model.el
b/packages/ztree/ztree-diff-model.el
deleted file mode 100644
index 6f4c951..0000000
--- a/packages/ztree/ztree-diff-model.el
+++ /dev/null
@@ -1,386 +0,0 @@
-;;; ztree-diff-model.el --- diff model for directory trees -*-
lexical-binding: t; -*-
-
-;; Copyright (C) 2013-2016 Free Software Foundation, Inc.
-;;
-;; Author: Alexey Veretennikov <alexey.veretennikov@gmail.com>
-;;
-;; Created: 2013-11-11
-;;
-;; Keywords: files tools
-;; URL: https://github.com/fourier/ztree
-;; Compatibility: GNU Emacs 24.x
-;;
-;; 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 <http://www.gnu.org/licenses/>.
-;;
-;;; Commentary:
-
-;; Diff model
-
-;;; Code:
-(require 'ztree-util)
-(eval-when-compile (require 'cl-lib))
-
-(defvar-local ztree-diff-model-ignore-fun nil
- "Function which determines if the node should be excluded from comparison.")
-
-(defvar-local ztree-diff-model-progress-fun nil
- "Function which should be called whenever the progress indications is
updated.")
-
-
-(defun ztree-diff-model-update-progress ()
- "Update the progress."
- (when ztree-diff-model-progress-fun
- (funcall ztree-diff-model-progress-fun)))
-
-;; Create a record ztree-diff-node with defined fields and getters/setters
-;; here:
-;; parent - parent node
-;; left-path is the full path on the left side of the diff window,
-;; right-path is the full path of the right side,
-;; short-name - is the file or directory name
-;; children - list of nodes - files or directories if the node is a directory
-;; different = {nil, 'same, 'new, 'diff, 'ignore} - means comparison status
-(cl-defstruct (ztree-diff-node
- (:constructor)
- (:constructor ztree-diff-node-create
- (parent left-path right-path
- different
- &aux
- (short-name (ztree-file-short-name
- (or left-path right-path)))
- (right-short-name
- (if (and left-path right-path)
- (ztree-file-short-name right-path)
- short-name)))))
- parent left-path right-path short-name right-short-name children different)
-
-(defun ztree-diff-model-ignore-p (node)
- "Determine if the NODE should be excluded from comparison results."
- (when ztree-diff-model-ignore-fun
- (funcall ztree-diff-model-ignore-fun node)))
-
-(defun ztree-diff-node-to-string (node)
- "Construct the string with contents of the NODE given."
- (let ((string-or-nil #'(lambda (x) (if x
- (cond ((stringp x) x)
- ((eq x 'new) "new")
- ((eq x 'diff) "different")
- ((eq x 'ignore) "ignored")
- ((eq x 'same) "same")
- (t (ztree-diff-node-short-name
x)))
- "(empty)")))
- (children (ztree-diff-node-children node))
- (ch-str ""))
- (dolist (x children)
- (setq ch-str (concat ch-str "\n * " (ztree-diff-node-short-name x)
- ": "
- (funcall string-or-nil (ztree-diff-node-different
x)))))
- (concat "Node: " (ztree-diff-node-short-name node)
- "\n"
- " * Parent: " (funcall string-or-nil (ztree-diff-node-parent node))
- "\n"
- " * Status: " (funcall string-or-nil (ztree-diff-node-different
node))
- "\n"
- " * Left path: " (funcall string-or-nil (ztree-diff-node-left-path
node))
- "\n"
- " * Right path: " (funcall string-or-nil
(ztree-diff-node-right-path node))
- "\n"
- " * Children: " ch-str
- "\n")))
-
-
-(defun ztree-diff-node-short-name-wrapper (node &optional right-side)
- "Return the short name of the NODE given.
-If the RIGHT-SIDE is true, take the right leaf"
- (if (not right-side)
- (ztree-diff-node-short-name node)
- (ztree-diff-node-right-short-name node)))
-
-
-(defun ztree-diff-node-is-directory (node)
- "Determines if the NODE is a directory."
- (let ((left (ztree-diff-node-left-path node))
- (right (ztree-diff-node-right-path node)))
- (if left
- (file-directory-p left)
- (file-directory-p right))))
-
-(defun ztree-diff-node-side (node)
- "Determine the side there the file is present for NODE.
-Return BOTH if the file present on both sides;
-LEFT if only on the left side and
-RIGHT if only on the right side."
- (let ((left (ztree-diff-node-left-path node))
- (right (ztree-diff-node-right-path node)))
- (if (and left right) 'both
- (if left 'left 'right))))
-
-
-(defun ztree-diff-node-equal (node1 node2)
- "Determines if NODE1 and NODE2 are equal."
- (and (string-equal (ztree-diff-node-short-name node1)
- (ztree-diff-node-short-name node2))
- (string-equal (ztree-diff-node-left-path node1)
- (ztree-diff-node-left-path node2))
- (string-equal (ztree-diff-node-right-path node1)
- (ztree-diff-node-right-path node1))))
-
-(defun ztree-diff-model-files-equal (file1 file2)
- "Compare files FILE1 and FILE2 using external diff.
-Returns t if equal."
- (unless (ztree-same-host-p file1 file2)
- (error "Compared files are not on the same host"))
- (let* ((file1-untrampified (ztree-untrampify-filename file1))
- (file2-untrampified (ztree-untrampify-filename file2)))
- (if (or
- (/= (nth 7 (file-attributes file1))
- (nth 7 (file-attributes file2)))
- (/= 0 (process-file diff-command nil nil nil "-q"
- file1-untrampified
- file2-untrampified)))
- 'diff
- 'same)))
-
-(defun ztree-directory-files (dir)
- "Return the list of full paths of files in a directory DIR.
-Filters out . and .."
- (ztree-filter #'(lambda (file) (let ((simple-name (ztree-file-short-name
file)))
- (not (or (string-equal simple-name ".")
- (string-equal simple-name "..")))))
- (directory-files dir 'full)))
-
-(defun ztree-diff-model-partial-rescan (node)
- "Rescan the NODE.
-The node is a either a file or directory with both
-left and right parts existing."
- ;; if a directory - recreate
- (if (ztree-diff-node-is-directory node)
- (ztree-diff-node-recreate node)
- ;; if a file, change a status
- (setf (ztree-diff-node-different node)
- (if (or (ztree-diff-model-ignore-p node) ; if should be ignored
- (eql (ztree-diff-node-different node) 'ignore) ; was ignored
- (eql (ztree-diff-node-different ; or parent was ignored
- (ztree-diff-node-parent node))
- 'ignore))
- 'ignore
- (ztree-diff-model-files-equal (ztree-diff-node-left-path node)
- (ztree-diff-node-right-path node)))))
- ;; update all parents statuses
- (ztree-diff-node-update-all-parents-diff node))
-
-(defun ztree-diff-model-subtree (parent path side diff)
- "Create a subtree with given PARENT for the given PATH.
-Argument SIDE either `left' or `right' side.
-Argument DIFF different status to be assigned to all created nodes."
- (let ((files (ztree-directory-files path))
- (result nil))
- (dolist (file files)
- (if (file-directory-p file)
- (let* ((node (ztree-diff-node-create
- parent
- (when (eq side 'left) file)
- (when (eq side 'right) file)
- diff))
- (children (ztree-diff-model-subtree node file side diff)))
- (setf (ztree-diff-node-children node) children)
- (push node result))
- (push (ztree-diff-node-create
- parent
- (when (eq side 'left) file)
- (when (eq side 'right) file)
- diff)
- result)))
- result))
-
-(defun ztree-diff-node-update-diff-from-children (node)
- "Set the diff status for the NODE based on its children."
- (unless (eql (ztree-diff-node-different node) 'ignore)
- (let ((diff (cl-reduce #'ztree-diff-model-update-diff
- (ztree-diff-node-children node)
- :initial-value 'same
- :key 'ztree-diff-node-different)))
- (setf (ztree-diff-node-different node) diff))))
-
-(defun ztree-diff-node-update-all-parents-diff (node)
- "Recursively update all parents diff status for the NODE."
- (let ((parent node))
- (while (setq parent (ztree-diff-node-parent parent))
- (ztree-diff-node-update-diff-from-children parent))))
-
-
-(defun ztree-diff-model-update-diff (old new)
- "Get the diff status depending if OLD or NEW is not nil.
-If the OLD is `ignore', do not change anything"
- ;; if the old whole directory is ignored, ignore children's status
- (cond ((eql old 'ignore) 'ignore)
- ;; if the new status is ignored, use old
- ((eql new 'ignore) old)
- ;; if the old or new status is different, return different
- ((or (eql old 'diff)
- (eql new 'diff)) 'diff)
- ;; if new is 'new, return new
- ((eql new 'new) 'new)
- ;; all other cases return old
- (t old)))
-
-(defun ztree-diff-node-update-diff-from-parent (node)
- "Recursively update diff status of all children of NODE.
-This function will traverse through all children recursively
-setting status from the NODE, unless they have an ignore status"
- (let ((status (ztree-diff-node-different node))
- (children (ztree-diff-node-children node)))
- ;; if the parent has ignore status, force all kids this status
- ;; otherwise only update status when the child status is not ignore
- (mapc (lambda (child)
- (when (or (eql status 'ignore)
- (not
- (or (eql status 'ignore)
- (eql (ztree-diff-node-different child) 'ignore))))
- (setf (ztree-diff-node-different child) status)
- (ztree-diff-node-update-diff-from-parent child)))
- children)))
-
-
-
-(defun ztree-diff-model-find-in-files (list shortname is-dir)
- "Find in LIST of files the file with name SHORTNAME.
-If IS-DIR searching for directories; assume files otherwise"
- (ztree-find list
- (lambda (x) (and (string-equal (ztree-file-short-name x)
- shortname)
- (eq is-dir (file-directory-p x))))))
-
-
-(defun ztree-diff-model-should-ignore (node)
- "Determine if the NODE and its children should be ignored.
-If no parent - never ignore;
-if in ignore list - ignore
-if parent has ignored status - ignore"
- (let ((parent (ztree-diff-node-parent node)))
- (and parent
- (or (eql (ztree-diff-node-different parent) 'ignore)
- (ztree-diff-model-ignore-p node)))))
-
-
-(defun ztree-diff-node-recreate (node)
- "Traverse 2 paths defined in the NODE updating its children and status."
- (let* ((list1 (ztree-directory-files (ztree-diff-node-left-path node))) ;;
left list of liles
- (list2 (ztree-directory-files (ztree-diff-node-right-path node))) ;;
right list of files
- (should-ignore (ztree-diff-model-should-ignore node))
- ;; status automatically assigned to children of the node
- (children-status (if should-ignore 'ignore 'new))
- (children nil)) ;; list of children
- ;; update waiting status
- (ztree-diff-model-update-progress)
- ;; update node status ignore status either inhereted from the
- ;; parent or the own
- (when should-ignore
- (setf (ztree-diff-node-different node) 'ignore))
- ;; first - adding all entries from left directory
- (dolist (file1 list1)
- ;; for every entry in the first directory
- ;; we are creating the node
- (let* ((simple-name (ztree-file-short-name file1))
- (isdir (file-directory-p file1))
- ;; find if the file is in the second directory and the type
- ;; is the same - i.e. both are directories or both are files
- (file2 (ztree-diff-model-find-in-files list2 simple-name isdir))
- ;; create a child. The current node is a parent
- ;; new by default - will be overriden below if necessary
- (child
- (ztree-diff-node-create node file1 file2 children-status)))
- ;; update child own ignore status
- (when (ztree-diff-model-should-ignore child)
- (setf (ztree-diff-node-different child) 'ignore))
- ;; if exists on a right side with the same type,
- ;; remove from the list of files on the right side
- (when file2
- (setf list2 (cl-delete file2 list2 :test #'string-equal)))
- (cond
- ;; when exist just on a left side and is a directory, add all
- ((and isdir (not file2))
- (setf (ztree-diff-node-children child)
- (ztree-diff-model-subtree child
- file1
- 'left
- (ztree-diff-node-different child))))
- ;; if 1) exists on both sides and 2) it is a file
- ;; and 3) not ignored file
- ((and file2 (not isdir) (not (eql (ztree-diff-node-different child)
'ignore)))
- (setf (ztree-diff-node-different child)
- (ztree-diff-model-files-equal file1 file2)))
- ;; if exists on both sides and it is a directory, traverse further
- ((and file2 isdir)
- (ztree-diff-node-recreate child)))
- ;; push the created node to the children list
- (push child children)))
- ;; second - adding entries from the right directory which are not present
- ;; in the left directory
- (dolist (file2 list2)
- ;; for every entry in the second directory
- ;; we are creating the node
- (let* ((isdir (file-directory-p file2))
- ;; create the child to be added to the results list
- (child
- (ztree-diff-node-create node nil file2 children-status)))
- ;; update ignore status of the child
- (when (ztree-diff-model-should-ignore child)
- (setf (ztree-diff-node-different child) 'ignore))
- ;; if it is a directory, set the whole subtree to children
- (when isdir
- (setf (ztree-diff-node-children child)
- (ztree-diff-model-subtree child
- file2
- 'right
- (ztree-diff-node-different child))))
- ;; push the created node to the result list
- (push child children)))
- ;; finally set different status based on all children
- ;; depending if the node should participate in overall result
- (unless should-ignore
- (setf (ztree-diff-node-different node)
- (cl-reduce #'ztree-diff-model-update-diff
- children
- :initial-value 'same
- :key 'ztree-diff-node-different)))
- ;; and set children
- (setf (ztree-diff-node-children node) children)))
-
-
-(defun ztree-diff-model-update-node (node)
- "Refresh the NODE."
- (ztree-diff-node-recreate node))
-
-
-
-(defun ztree-diff-model-set-ignore-fun (ignore-p)
- "Set the buffer-local ignore function to IGNORE-P.
-Ignore function is a function of one argument (ztree-diff-node)
-which returns t if the node should be ignored (like files starting
-with dot etc)."
- (setf ztree-diff-model-ignore-fun ignore-p))
-
-
-(defun ztree-diff-model-set-progress-fun (progress-fun)
- "Setter for the buffer-local PROGRESS-FUN callback.
-This callback is called to indicate the ongoing activity.
-Callback is a function without arguments."
- (setf ztree-diff-model-progress-fun progress-fun))
-
-(provide 'ztree-diff-model)
-
-;;; ztree-diff-model.el ends here
diff --git a/packages/ztree/ztree-diff.el b/packages/ztree/ztree-diff.el
deleted file mode 100644
index a4bd012..0000000
--- a/packages/ztree/ztree-diff.el
+++ /dev/null
@@ -1,561 +0,0 @@
-;;; ztree-diff.el --- Text mode diff for directory trees -*- lexical-binding:
t; -*-
-
-;; Copyright (C) 2013-2016 Free Software Foundation, Inc.
-;;
-;; Author: Alexey Veretennikov <alexey.veretennikov@gmail.com>
-;;
-;; Created: 2013-11-11
-;;
-;; Keywords: files tools
-;; URL: https://github.com/fourier/ztree
-;; Compatibility: GNU Emacs 24.x
-;;
-;; 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 <http://www.gnu.org/licenses/>.
-;;
-;;; Commentary:
-
-;;; Code:
-(require 'ztree-view)
-(require 'ztree-diff-model)
-
-(defconst ztree-diff-hidden-files-regexp "^\\."
- "Hidden files regexp.
-By default all filest starting with dot `.', including . and ..")
-
-(defface ztreep-diff-header-face
- '((((type tty pc) (class color)) :foreground "lightblue" :weight bold)
- (((background dark)) (:height 1.2 :foreground "lightblue" :weight bold))
- (t :height 1.2 :foreground "darkblue" :weight bold))
- "*Face used for the header in Ztree Diff buffer."
- :group 'Ztree-diff :group 'font-lock-highlighting-faces)
-(defvar ztreep-diff-header-face 'ztreep-diff-header-face)
-
-(defface ztreep-diff-header-small-face
- '((((type tty pc) (class color)) :foreground "lightblue" :weight bold)
- (((background dark)) (:foreground "lightblue" :weight bold))
- (t :weight bold :foreground "darkblue"))
- "*Face used for the header in Ztree Diff buffer."
- :group 'Ztree-diff :group 'font-lock-highlighting-faces)
-(defvar ztreep-diff-header-small-face 'ztreep-diff-header-small-face)
-
-(defface ztreep-diff-model-diff-face
- '((t (:foreground "red")))
- "*Face used for different files in Ztree-diff."
- :group 'Ztree-diff :group 'font-lock-highlighting-faces)
-(defvar ztreep-diff-model-diff-face 'ztreep-diff-model-diff-face)
-
-(defface ztreep-diff-model-add-face
- '((t (:foreground "blue")))
- "*Face used for added files in Ztree-diff."
- :group 'Ztree-diff :group 'font-lock-highlighting-faces)
-(defvar ztreep-diff-model-add-face 'ztreep-diff-model-add-face)
-
-(defface ztreep-diff-model-ignored-face
- '((((type tty pc) (class color) (min-colors 256)) :foreground "#2f2f2f")
- (((type tty pc) (class color) (min-colors 8)) :foreground "white")
- (t (:foreground "#7f7f7f" :strike-through t)))
- "*Face used for non-modified files in Ztree-diff."
- :group 'Ztree-diff :group 'font-lock-highlighting-faces)
-(defvar ztreep-diff-model-ignored-face 'ztreep-diff-model-ignored-face)
-
-(defface ztreep-diff-model-normal-face
- '((((type tty pc) (class color) (min-colors 8)) :foreground "white")
- (t (:foreground "#7f7f7f")))
- "*Face used for non-modified files in Ztree-diff."
- :group 'Ztree-diff :group 'font-lock-highlighting-faces)
-(defvar ztreep-diff-model-normal-face 'ztreep-diff-model-normal-face)
-
-
-(defvar-local ztree-diff-filter-list (list ztree-diff-hidden-files-regexp)
- "List of regexp file names to filter out.
-By default paths starting with dot (like .git) are ignored")
-
-(defvar-local ztree-diff-dirs-pair nil
- "Pair of the directories stored. Used to perform the full rescan.")
-
-(defvar-local ztree-diff-show-equal-files t
- "Show or not equal files/directories on both sides.")
-
-(defvar-local ztree-diff-show-filtered-files nil
- "Show or not files from the filtered list.")
-
-(defvar-local ztree-diff-wait-message nil
- "Message showing while constructing the diff tree.")
-
-
-;;;###autoload
-(define-minor-mode ztreediff-mode
- "A minor mode for displaying the difference of the directory trees in text
mode."
- ;; initial value
- nil
- ;; modeline name
- " Diff"
- ;; The minor mode keymap
- `(
- (,(kbd "C") . ztree-diff-copy)
- (,(kbd "h") . ztree-diff-toggle-show-equal-files)
- (,(kbd "H") . ztree-diff-toggle-show-filtered-files)
- (,(kbd "D") . ztree-diff-delete-file)
- (,(kbd "v") . ztree-diff-view-file)
- (,(kbd "d") . ztree-diff-simple-diff-files)
- (,(kbd "r") . ztree-diff-partial-rescan)
- (,(kbd "R") . ztree-diff-full-rescan)
- ([f5] . ztree-diff-full-rescan)))
-
-
-(defun ztree-diff-node-face (node)
- "Return the face for the NODE depending on diff status."
- (let ((diff (ztree-diff-node-different node)))
- (cond ((eq diff 'ignore) ztreep-diff-model-ignored-face)
- ((eq diff 'diff) ztreep-diff-model-diff-face)
- ((eq diff 'new) ztreep-diff-model-add-face)
- ((eq diff 'same) ztreep-diff-model-normal-face))))
-
-(defun ztree-diff-insert-buffer-header ()
- "Insert the header to the ztree buffer."
- (ztree-insert-with-face "Differences tree" ztreep-diff-header-face)
- (insert "\n")
- (when ztree-diff-dirs-pair
- (ztree-insert-with-face (concat "Left: " (car ztree-diff-dirs-pair))
- ztreep-diff-header-small-face)
- (insert "\n")
- (ztree-insert-with-face (concat "Right: " (cdr ztree-diff-dirs-pair))
- ztreep-diff-header-small-face)
- (insert "\n"))
- (ztree-insert-with-face "Legend:" ztreep-diff-header-small-face)
- (insert "\n")
- (ztree-insert-with-face " Normal file " ztreep-diff-model-normal-face)
- (ztree-insert-with-face "- same on both sides" ztreep-diff-header-small-face)
- (insert "\n")
- (ztree-insert-with-face " Orphan file " ztreep-diff-model-add-face)
- (ztree-insert-with-face "- does not exist on other side"
ztreep-diff-header-small-face)
- (insert "\n")
- (ztree-insert-with-face " Mismatch file " ztreep-diff-model-diff-face)
- (ztree-insert-with-face "- different from other side"
ztreep-diff-header-small-face)
- (insert "\n ")
- (ztree-insert-with-face "Ignored file" ztreep-diff-model-ignored-face)
- (ztree-insert-with-face " - ignored from comparison"
ztreep-diff-header-small-face)
- (insert "\n")
-
- (ztree-insert-with-face "==============" ztreep-diff-header-face)
- (insert "\n"))
-
-(defun ztree-diff-full-rescan ()
- "Force full rescan of the directory trees."
- (interactive)
- (when (and ztree-diff-dirs-pair
- (yes-or-no-p (format "Force full rescan?")))
- (ztree-diff (car ztree-diff-dirs-pair) (cdr ztree-diff-dirs-pair))))
-
-
-
-(defun ztree-diff-existing-common (node)
- "Return the NODE if both left and right sides exist."
- (let ((left (ztree-diff-node-left-path node))
- (right (ztree-diff-node-right-path node)))
- (if (and left right
- (file-exists-p left)
- (file-exists-p right))
- node
- nil)))
-
-(defun ztree-diff-existing-common-parent (node)
- "Return the first node in up in hierarchy of the NODE which has both sides."
- (let ((common (ztree-diff-existing-common node)))
- (if common
- common
- (ztree-diff-existing-common-parent (ztree-diff-node-parent node)))))
-
-(defun ztree-diff-do-partial-rescan (node)
- "Partly rescan the NODE."
- (let* ((common (ztree-diff-existing-common-parent node))
- (parent (ztree-diff-node-parent common)))
- (if (not parent)
- (when ztree-diff-dirs-pair
- (ztree-diff (car ztree-diff-dirs-pair) (cdr ztree-diff-dirs-pair)))
- (ztree-diff-update-wait-message
- (concat "Updating " (ztree-diff-node-short-name common) " ..."))
- (ztree-diff-model-partial-rescan common)
- (message "Done")
- (ztree-refresh-buffer (line-number-at-pos)))))
-
-
-(defun ztree-diff-partial-rescan ()
- "Perform partial rescan on the current node."
- (interactive)
- (let ((found (ztree-find-node-at-point)))
- (when found
- (ztree-diff-do-partial-rescan (car found)))))
-
-
-(defun ztree-diff-simple-diff (node)
- "Create a simple diff buffer for files from left and right panels.
-Argument NODE node containing paths to files to call a diff on."
- (let* ((node-left (ztree-diff-node-left-path node))
- (node-right (ztree-diff-node-right-path node)))
- (when (and
- node-left
- node-right
- (not (file-directory-p node-left)))
- ;; show the diff window on the bottom
- ;; to not to crush tree appearance
- (let ((split-width-threshold nil))
- (diff node-left node-right)))))
-
-
-(defun ztree-diff-simple-diff-files ()
- "Create a simple diff buffer for files from left and right panels."
- (interactive)
- (let ((found (ztree-find-node-at-point)))
- (when found
- (let ((node (car found)))
- (ztree-diff-simple-diff node)))))
-
-(defun ztree-diff-node-action (node hard)
- "Perform action on NODE:
-1 if both left and right sides present:
- 1.1 if they are differend
- 1.1.1 if HARD ediff
- 1.1.2 simple diff otherwiste
- 1.2 if they are the same - view left
-2 if left or right present - view left or rigth"
- (let ((left (ztree-diff-node-left-path node))
- (right (ztree-diff-node-right-path node))
- ;; FIXME: The GNU convention is to only use "path" for lists of
- ;; directories as in load-path.
- (open-f #'(lambda (path) (if hard (find-file path)
- (let ((split-width-threshold nil))
- (view-file-other-window path))))))
- (cond ((and left right)
- (if (eql (ztree-diff-node-different node) 'same)
- (funcall open-f left)
- (if hard
- (ediff left right)
- (ztree-diff-simple-diff node))))
- (left (funcall open-f left))
- (right (funcall open-f right))
- (t nil))))
-
-
-
-(defun ztree-diff-copy-file (node source-path destination-path copy-to-right)
- "Update the NODE status and copy the file.
-File copied from SOURCE-PATH to DESTINATION-PATH.
-COPY-TO-RIGHT specifies which side of the NODE to update."
- (let ((target-path (concat
- (file-name-as-directory destination-path)
- (file-name-nondirectory
- (directory-file-name source-path)))))
- (let ((err (condition-case error-trap
- (progn
- ;; don't ask for overwrite
- ;; keep time stamp
- (copy-file source-path target-path t t)
- nil)
- (error error-trap))))
- ;; error message if failed
- (if err (message (concat "Error: " (nth 2 err)))
- ;; otherwise:
- ;; assuming all went ok when left and right nodes are the same
- ;; set both as not different if they were not ignored
- (unless (eq (ztree-diff-node-different node) 'ignore)
- (setf (ztree-diff-node-different node) 'same))
- ;; update left/right paths
- (if copy-to-right
- (setf (ztree-diff-node-right-path node) target-path)
- (setf (ztree-diff-node-left-path node) target-path))
- (ztree-diff-node-update-all-parents-diff node)
- (ztree-refresh-buffer (line-number-at-pos))))))
-
-
-(defun ztree-diff-copy-dir (node source-path destination-path copy-to-right)
- "Update the NODE status and copy the directory.
-Directory copied from SOURCE-PATH to DESTINATION-PATH.
-COPY-TO-RIGHT specifies which side of the NODE to update."
- (let* ((src-path (file-name-as-directory source-path))
- (target-path (file-name-as-directory destination-path))
- (target-full-path (concat
- target-path
- (file-name-nondirectory
- (directory-file-name source-path)))))
- (let ((err (condition-case error-trap
- (progn
- ;; keep time stamp
- ;; ask for overwrite
- (copy-directory src-path target-path t t)
- nil)
- (error error-trap))))
- ;; error message if failed
- (if err
- (progn
- (message (concat "Error: " (nth 1 err)))
- ;; and do rescan of the node
- (ztree-diff-do-partial-rescan node))
- ;; if everything is ok, update statuses
- (message target-full-path)
- (if copy-to-right
- (setf (ztree-diff-node-right-path node) target-full-path)
- (setf (ztree-diff-node-left-path node) target-full-path))
- (ztree-diff-update-wait-message
- (concat "Updating " (ztree-diff-node-short-name node) " ..."))
- ;; TODO: do not rescan the node. Use some logic like in delete
- (ztree-diff-model-update-node node)
- (message "Done.")
- (ztree-diff-node-update-all-parents-diff node)
- (ztree-refresh-buffer (line-number-at-pos))))))
-
-
-(defun ztree-diff-copy ()
- "Copy the file under the cursor to other side."
- (interactive)
- (let ((found (ztree-find-node-at-point)))
- (when found
- (let* ((node (car found))
- (side (cdr found))
- (node-side (ztree-diff-node-side node))
- (copy-to-right t) ; copy from left to right
- (node-left (ztree-diff-node-left-path node))
- (node-right (ztree-diff-node-right-path node))
- (source-path nil)
- (destination-path nil)
- (parent (ztree-diff-node-parent node)))
- (when parent ; do not copy the root node
- ;; determine a side to copy from/to
- ;; algorithm:
- ;; 1) if both side are present, use the side
- ;; variable
- (setq copy-to-right (if (eq node-side 'both)
- (eq side 'left)
- ;; 2) if one of sides is absent, copy from
- ;; the side where the file is present
- (eq node-side 'left)))
- ;; 3) in both cases determine if the destination
- ;; directory is in place
- (setq source-path (if copy-to-right node-left node-right)
- destination-path (if copy-to-right
- (ztree-diff-node-right-path parent)
- (ztree-diff-node-left-path parent)))
- (when (and source-path destination-path
- (yes-or-no-p (format "Copy [%s]%s to [%s]%s/ ?"
- (if copy-to-right "LEFT" "RIGHT")
- (ztree-diff-node-short-name node)
- (if copy-to-right "RIGHT" "LEFT")
- destination-path)))
- (if (file-directory-p source-path)
- (ztree-diff-copy-dir node
- source-path
- destination-path
- copy-to-right)
- (ztree-diff-copy-file node
- source-path
- destination-path
- copy-to-right))))))))
-
-(defun ztree-diff-view-file ()
- "View file at point, depending on side."
- (interactive)
- (let ((found (ztree-find-node-at-point)))
- (when found
- (let* ((node (car found))
- (side (cdr found))
- (node-side (ztree-diff-node-side node))
- (node-left (ztree-diff-node-left-path node))
- (node-right (ztree-diff-node-right-path node)))
- (when (or (eq node-side 'both)
- (eq side node-side))
- (cond ((and (eq side 'left)
- node-left)
- (view-file node-left))
- ((and (eq side 'right)
- node-right)
- (view-file node-right))))))))
-
-
-(defun ztree-diff-delete-file ()
- "Delete the file under the cursor."
- (interactive)
- (let ((found (ztree-find-node-at-point)))
- (when found
- (let* ((node (car found))
- (side (cdr found))
- (node-side (ztree-diff-node-side node))
- (parent (ztree-diff-node-parent node))
- ;; algorithm for determining what to delete similar to copy:
- ;; 1. if the file is present on both sides, delete
- ;; from the side currently selected
- ;; 2. if one of sides is absent, delete
- ;; from the side where the file is present
- (delete-from-left
- (or (eql node-side 'left)
- (and (eql node-side 'both)
- (eql side 'left))))
- (remove-path (if delete-from-left
- (ztree-diff-node-left-path node)
- (ztree-diff-node-right-path node))))
- (when (and parent ; do not delete the root node
- (yes-or-no-p (format "Delete the file [%s]%s ?"
- (if delete-from-left "LEFT" "RIGHT")
- remove-path)))
- (let* ((delete-command
- (if (file-directory-p remove-path)
- #'delete-directory
- #'delete-file))
- (children (ztree-diff-node-children parent))
- (err
- (condition-case error-trap
- (progn
- (funcall delete-command remove-path t)
- nil)
- (error error-trap))))
- (if err
- (progn
- (message (concat "Error: " (nth 2 err)))
- ;; when error happened while deleting the
- ;; directory, rescan the node
- ;; and update the parents with a new status
- ;; of this node
- (when (file-directory-p remove-path)
- (ztree-diff-model-partial-rescan node)))
- ;; if everything ok
- ;; if was only on one side
- ;; remove the node from children
- (if (or (and (eql node-side 'left)
- delete-from-left)
- (and (eql node-side 'right)
- (not delete-from-left)))
- (setf (ztree-diff-node-children parent)
- (ztree-filter
- (lambda (x) (not (ztree-diff-node-equal x node)))
- children))
- ;; otherwise update only one side
- (mapc (if delete-from-left
- (lambda (x) (setf (ztree-diff-node-left-path x) nil))
- (lambda (x) (setf (ztree-diff-node-right-path x) nil)))
- (cons node (ztree-diff-node-children node)))
- ;; and update diff status
- ;; if was ignored keep the old status
- (unless (eql (ztree-diff-node-different node) 'ignore)
- (setf (ztree-diff-node-different node) 'new))
- ;; finally update all children statuses
- (ztree-diff-node-update-diff-from-parent node)))
- (ztree-diff-node-update-all-parents-diff node)
- (ztree-refresh-buffer (line-number-at-pos))))))))
-
-
-
-(defun ztree-diff-node-ignore-p (node)
- "Determine if the NODE is in filter list.
-If the node is in the filter list it shall not be visible,
-unless it is a parent node."
- (let ((name (ztree-diff-node-short-name node)))
- ;; ignore then
- ;; not a root and is in filter list
- (and (ztree-diff-node-parent node)
- (ztree-find ztree-diff-filter-list #'(lambda (rx) (string-match rx
name))))))
-
-
-(defun ztree-node-is-visible (node)
- "Determine if the NODE should be visible."
- (let ((diff (ztree-diff-node-different node)))
- ;; visible then
- ;; either it is a root. root have no parent
- (or (not (ztree-diff-node-parent node)) ; parent is always visible
- ;; or the files are different or orphan
- (or (eql diff 'new)
- (eql diff 'diff))
- ;; or it is ignored but we show ignored for now
- (and (eql diff 'ignore)
- ztree-diff-show-filtered-files)
- ;; or they are same but we show same for now
- (and (eql diff 'same)
- ztree-diff-show-equal-files))))
-
-(defun ztree-diff-toggle-show-equal-files ()
- "Toggle visibility of the equal files."
- (interactive)
- (setq ztree-diff-show-equal-files (not ztree-diff-show-equal-files))
- (message (concat (if ztree-diff-show-equal-files "Show" "Hide") " equal
files"))
- (ztree-refresh-buffer))
-
-(defun ztree-diff-toggle-show-filtered-files ()
- "Toggle visibility of the filtered files."
- (interactive)
- (setq ztree-diff-show-filtered-files (not ztree-diff-show-filtered-files))
- (message (concat (if ztree-diff-show-filtered-files "Show" "Hide") "
filtered files"))
- (ztree-refresh-buffer))
-
-
-(defun ztree-diff-update-wait-message (&optional msg)
- "Update the wait message MSG with one more `.' progress indication."
- (if msg
- (setq ztree-diff-wait-message msg)
- (when ztree-diff-wait-message
- (setq ztree-diff-wait-message (concat ztree-diff-wait-message "."))))
- (message ztree-diff-wait-message))
-
-;;;###autoload
-(defun ztree-diff (dir1 dir2)
- "Create an interactive buffer with the directory tree of the path given.
-Argument DIR1 left directory.
-Argument DIR2 right directory."
- (interactive "DLeft directory \nDRight directory ")
- (unless (and dir1 (file-directory-p dir1))
- (error "Path %s is not a directory" dir1))
- (unless (file-exists-p dir1)
- (error "Path %s does not exist" dir1))
- (unless (and dir2 (file-directory-p dir2))
- (error "Path %s is not a directory" dir2))
- (unless (file-exists-p dir2)
- (error "Path %s does not exist" dir2))
- (unless (ztree-same-host-p dir1 dir2)
- (error "Compared directories are not on the same host"))
- (let* ((model
- (ztree-diff-node-create nil dir1 dir2 nil))
- (buf-name (concat "*"
- (ztree-diff-node-short-name model)
- " <--> "
- (ztree-diff-node-right-short-name model)
- "*")))
- ;; after this command we are in a new buffer,
- ;; so all buffer-local vars are valid
- (ztree-view buf-name
- model
- 'ztree-node-is-visible
- 'ztree-diff-insert-buffer-header
- 'ztree-diff-node-short-name-wrapper
- 'ztree-diff-node-is-directory
- 'ztree-diff-node-equal
- 'ztree-diff-node-children
- 'ztree-diff-node-face
- 'ztree-diff-node-action
- 'ztree-diff-node-side)
- (ztreediff-mode)
- (ztree-diff-model-set-ignore-fun #'ztree-diff-node-ignore-p)
- (ztree-diff-model-set-progress-fun #'ztree-diff-update-wait-message)
- (setq ztree-diff-dirs-pair (cons dir1 dir2))
- (ztree-diff-update-wait-message (concat "Comparing " dir1 " and " dir2 "
..."))
- (ztree-diff-node-recreate model)
- (message "Done.")
-
- (ztree-refresh-buffer)))
-
-
-
-
-
-
-(provide 'ztree-diff)
-;;; ztree-diff.el ends here
diff --git a/packages/ztree/ztree-dir.el b/packages/ztree/ztree-dir.el
deleted file mode 100644
index dada7d0..0000000
--- a/packages/ztree/ztree-dir.el
+++ /dev/null
@@ -1,204 +0,0 @@
-;;; ztree-dir.el --- Text mode directory tree -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2013-2016 Free Software Foundation, Inc.
-;;
-;; Author: Alexey Veretennikov <alexey.veretennikov@gmail.com>
-;;
-;; Created: 2013-11-11
-;;
-;; Keywords: files tools
-;; URL: https://github.com/fourier/ztree
-;; Compatibility: GNU Emacs 24.x
-;;
-;; 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 <http://www.gnu.org/licenses/>.
-;;
-;;; Commentary:
-;;
-;; Add the following to your .emacs file:
-;;
-;; (push (substitute-in-file-name "path-to-ztree-directory") load-path)
-;; (require 'ztree-dir)
-;;
-;; Call the ztree interactive function:
-;; M-x ztree-dir
-;; Open/close directories with double-click, Enter or Space keys
-;;
-;;; Issues:
-;;
-;;; TODO:
-;; 1) Add some file-handling and marking abilities
-;;
-;;; Code:
-
-(require 'ztree-util)
-(require 'ztree-view)
-(require 'cl-lib)
-
-;;
-;; Constants
-;;
-
-(defconst ztree-hidden-files-regexp "^\\."
- "Hidden files regexp.
-By default all filest starting with dot `.', including . and ..")
-
-;;
-;; Configurable variables
-;;
-
-(defvar ztree-dir-move-focus nil
- "Defines if move focus to opened window on hard-action command (RETURN) on a
file.")
-
-(defvar-local ztree-dir-filter-list (list ztree-hidden-files-regexp)
- "List of regexp file names to filter out.
-By default paths starting with dot (like .git) are ignored.
-One could add own filters in the following way:
-
-(setq-default ztree-dir-filter-list (cons \"^.*\\.pyc\" ztree-dir-filter-list))
-")
-
-(defvar-local ztree-dir-show-filtered-files nil
- "Show or not files from the filtered list.")
-
-
-;;
-;; Faces
-;;
-
-(defface ztreep-header-face
- '((((type tty pc) (class color)) :foreground "lightblue" :weight bold)
- (((background dark)) (:height 1.2 :foreground "lightblue" :weight bold))
- (t :height 1.2 :foreground "darkblue" :weight bold))
- "*Face used for the header in Ztree buffer."
- :group 'Ztree :group 'font-lock-highlighting-faces)
-(defvar ztreep-header-face 'ztreep-header-face)
-
-
-(define-minor-mode ztreedir-mode
- "A minor mode for displaying the directory trees in text mode."
- ;; initial value
- nil
- ;; modeline name
- " Dir"
- ;; The minor mode keymap
- `(
- (,(kbd "H") . ztree-dir-toggle-show-filtered-files)
- (,(kbd ">") . ztree-dir-narrow-to-dir)
- (,(kbd "<") . ztree-dir-widen-to-parent)))
-
-
-
-
-;;
-;; File bindings to the directory tree control
-;;
-
-(defun ztree-insert-buffer-header ()
- "Insert the header to the ztree buffer."
- (let ((start (point)))
- (insert "Directory tree")
- (insert "\n")
- (insert "==============")
- (set-text-properties start (point) '(face ztreep-header-face)))
- (insert "\n"))
-
-(defun ztree-file-not-hidden (filename)
- "Determines if the file with FILENAME should be visible."
- (let ((name (ztree-file-short-name filename)))
- (and (not (or (string= name ".") (string= name "..")))
- (or
- ztree-dir-show-filtered-files
- (not (cl-find-if (lambda (rx) (string-match rx name))
ztree-dir-filter-list))))))
-
-
-(defun ztree-find-file (node hard)
- "Find the file at NODE.
-
-If HARD is non-nil, the file is opened in another window.
-Otherwise, the ztree window is used to find the file."
- (when (and (stringp node) (file-readable-p node))
- (cond ((and hard ztree-dir-move-focus)
- (find-file-other-window node))
- (hard
- (save-selected-window (find-file-other-window node)))
- (t
- (find-file node)))))
-
-
-(defun ztree-dir-toggle-show-filtered-files ()
- "Toggle visibility of the filtered files."
- (interactive)
- (setq ztree-dir-show-filtered-files (not ztree-dir-show-filtered-files))
- (message (concat (if ztree-dir-show-filtered-files "Show" "Hide") " filtered
files"))
- (ztree-refresh-buffer))
-
-
-(defun ztree-dir-directory-files (path)
- "Return the list of files/directories for the given PATH."
- ;; remove . and .. from the list of files to avoid infinite
- ;; recursion
- (cl-remove-if (lambda (x) (string-match-p "/\\.\\.?$" x))
- (directory-files path 'full)))
-
-
-(defun ztree-dir-narrow-to-dir ()
- "Interactive command to narrow the current directory buffer.
-The buffer is narrowed to the directory under the cursor.
-If the cursor is on a file, the buffer is narrowed to the parent directory."
- (interactive)
- (let* ((line (line-number-at-pos))
- (node (ztree-find-node-in-line line))
- (parent (ztree-get-parent-for-line line)))
- (if (file-directory-p node)
- (ztree-change-start-node node)
- (when parent
- (ztree-change-start-node (ztree-find-node-in-line parent))))))
-
-
-(defun ztree-dir-widen-to-parent ()
- "Interactive command to widen the current directory buffer to parent.
-The buffer is widened to the parent of the directory of the current buffer.
-This allows to jump to the parent directory if this directory is one level
-up of the opened."
- (interactive)
- (let* ((node ztree-start-node)
- (parent (file-name-directory (directory-file-name node))))
- (when parent
- (ztree-change-start-node parent))))
-
-
-;;;###autoload
-(defun ztree-dir (path)
- "Create an interactive buffer with the directory tree of the PATH given."
- (interactive "DDirectory: ")
- (when (and (file-exists-p path) (file-directory-p path))
- (let ((buf-name (concat "*Directory " path " tree*")))
- (ztree-view buf-name
- (expand-file-name (substitute-in-file-name path))
- #'ztree-file-not-hidden
- #'ztree-insert-buffer-header
- #'ztree-file-short-name
- #'file-directory-p
- #'string-equal
- #'ztree-dir-directory-files
- nil ; face
- #'ztree-find-file) ; action
- (ztreedir-mode))))
-
-
-
-(provide 'ztree-dir)
-;;; ztree-dir.el ends here
diff --git a/packages/ztree/ztree-util.el b/packages/ztree/ztree-util.el
deleted file mode 100644
index 5ac764b..0000000
--- a/packages/ztree/ztree-util.el
+++ /dev/null
@@ -1,98 +0,0 @@
-;;; ztree-util.el --- Auxiliary utilities for the ztree package -*-
lexical-binding: t; -*-
-
-;; Copyright (C) 2013-2016 Free Software Foundation, Inc.
-;;
-;; Author: Alexey Veretennikov <alexey.veretennikov@gmail.com>
-;;
-;; Created: 2013-11-11
-;;
-;; Keywords: files tools
-;; URL: https://github.com/fourier/ztree
-;; Compatibility: GNU Emacs 24.x
-;;
-;; 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 <http://www.gnu.org/licenses/>.
-;;
-;;; Commentary:
-
-;;; Code:
-(defun ztree-find (where which)
- "Find element of the list WHERE matching predicate WHICH."
- (catch 'found
- (dolist (elt where)
- (when (funcall which elt)
- (throw 'found elt)))
- nil))
-
-(defun ztree-filter (condp lst)
- "Filter out elements not satisfying predicate CONDP in the list LST.
-Taken from http://www.emacswiki.org/emacs/ElispCookbook#toc39";
- (delq nil
- (mapcar (lambda (x) (and (funcall condp x) x)) lst)))
-
-
-(defun ztree-printable-string (string)
- "Strip newline character from file names, like `Icon\n'.
-Argument STRING string to process.'."
- (replace-regexp-in-string "\n" "" string))
-
-
-(defun ztree-file-short-name (file)
- "By given FILE name return base file/directory name.
-Taken from http://lists.gnu.org/archive/html/emacs-devel/2011-01/msg01238.html";
- (let* ((dir (directory-file-name file))
- (simple-dir (file-name-nondirectory dir)))
- ;; check if the root directory
- (if (string= "" simple-dir)
- dir
- (ztree-printable-string simple-dir))))
-
-
-(defun ztree-car-atom (value)
- "Return VALUE if value is an atom, otherwise (car value) or nil.
-Used since `car-safe' returns nil for atoms"
- (if (atom value) value (car value)))
-
-
-(defun ztree-insert-with-face (text face)
- "Insert TEXT with the FACE provided."
- (let ((start (point)))
- (insert text)
- (put-text-property start (point) 'face face)))
-
-(defun ztree-untrampify-filename (file)
- "Return FILE as the local file name."
- (or (file-remote-p file 'localname) file))
-
-(defun ztree-quotify-string (str)
- "Surround STR with quotes."
- (concat "\"" str "\""))
-
-(defun ztree-same-host-p (file1 file2)
- "Return t if FILE1 and FILE2 are on the same host."
- (let ((file1-remote (file-remote-p file1))
- (file2-remote (file-remote-p file2)))
- (string-equal file1-remote file2-remote)))
-
-
-(defun ztree-scroll-to-line (line)
- "Recommended way to set the cursor to specified LINE."
- (goto-char (point-min))
- (forward-line (1- line)))
-
-
-(provide 'ztree-util)
-
-;;; ztree-util.el ends here
diff --git a/packages/ztree/ztree-view.el b/packages/ztree/ztree-view.el
deleted file mode 100644
index f8083cd..0000000
--- a/packages/ztree/ztree-view.el
+++ /dev/null
@@ -1,671 +0,0 @@
-;;; ztree-view.el --- Text mode tree view (buffer) -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
-;;
-;; Author: Alexey Veretennikov <alexey.veretennikov@gmail.com>
-;;
-;; Created: 2013-11-11
-;;
-;; Keywords: files tools
-;; URL: https://github.com/fourier/ztree
-;; Compatibility: GNU Emacs 24.x
-;;
-;; 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 <http://www.gnu.org/licenses/>.
-;;
-;;; Commentary:
-;;
-;; Add the following to your .emacs file:
-;;
-;; (push (substitute-in-file-name "path-to-ztree-directory") load-path)
-;; (require 'ztree-view)
-;;
-;; Call the ztree interactive function:
-;; Use the following function: ztree-view
-;;
-;;; Issues:
-;;
-;;; TODO:
-;;
-;;
-;;; Code:
-
-(require 'ztree-util)
-
-;;
-;; Globals
-;;
-
-(defvar ztree-draw-unicode-lines nil
- "If set forces ztree to draw lines with unicode characters.")
-
-(defvar-local ztree-expanded-nodes-list nil
- "A list of Expanded nodes (i.e. directories) entries.")
-
-(defvar-local ztree-start-node nil
- "Start node(i.e. directory) for the window.")
-
-(defvar-local ztree-line-to-node-table nil
- "List of tuples with full node(i.e. file/directory name and the line.")
-
-(defvar-local ztree-start-line nil
- "Index of the start line - the root.")
-
-(defvar-local ztree-parent-lines-array nil
- "Array of parent lines.
-The ith value of the array is the parent line for line i.
-If ith value is i - it is the root line")
-
-(defvar-local ztree-count-subsequent-bs nil
- "Counter for the subsequent BS keys (to identify double BS).")
-
-(defvar-local ztree-line-tree-properties nil
- "Hash with key - line number, value - property (`left', `right', `both').
-Used for 2-side trees, to determine if the node exists on left or right
-or both sides")
-
-(defvar-local ztree-tree-header-fun nil
- "Function inserting the header into the tree buffer.
-MUST inster newline at the end!")
-
-(defvar-local ztree-node-short-name-fun nil
- "Function which creates a pretty-printable short string from the node.")
-
-(defvar-local ztree-node-is-expandable-fun nil
- "Function which determines if the node is expandable.
-For example if the node is a directory")
-
-(defvar-local ztree-node-equal-fun nil
- "Function which determines if the 2 nodes are equal.")
-
-(defvar-local ztree-node-contents-fun nil
- "Function returning list of node contents.")
-
-(defvar-local ztree-node-side-fun nil
- "Function returning position of the node: `left', `right' or `both'.
-If not defined (by default) - using single screen tree, otherwise
-the buffer is split to 2 trees")
-
-(defvar-local ztree-node-face-fun nil
- "Function returning face for the node.")
-
-(defvar-local ztree-node-action-fun nil
- "Function called when Enter/Space pressed on the node.")
-
-(defvar-local ztree-node-showp-fun nil
- "Function called to decide if the node should be visible.")
-
-
-;;
-;; Major mode definitions
-;;
-
-(defvar ztree-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map (kbd "\r") 'ztree-perform-action)
- (define-key map (kbd "SPC") 'ztree-perform-soft-action)
- (define-key map [double-mouse-1] 'ztree-perform-action)
- (define-key map (kbd "TAB") 'ztree-jump-side)
- (define-key map (kbd "g") 'ztree-refresh-buffer)
- (define-key map (kbd "x") 'ztree-toggle-expand-subtree)
- (if window-system
- (define-key map (kbd "<backspace>") 'ztree-move-up-in-tree)
- (define-key map "\177" 'ztree-move-up-in-tree))
- map)
- "Keymap for `ztree-mode'.")
-
-
-(defface ztreep-node-face
- '((((background dark)) (:foreground "#ffffff"))
- (((type nil)) (:inherit 'font-lock-function-name-face))
- (t (:foreground "Blue")))
- "*Face used for expandable entries(directories etc) in Ztree buffer."
- :group 'Ztree :group 'font-lock-highlighting-faces)
-(defvar ztreep-node-face 'ztreep-node-face)
-
-(defface ztreep-leaf-face
- '((((background dark)) (:foreground "cyan1"))
- (((type nil)) (:inherit 'font-lock-variable-name-face))
- (t (:foreground "darkblue")))
- "*Face used for not expandable nodes(leafs, i.e. files) in Ztree buffer."
- :group 'Ztree :group 'font-lock-highlighting-faces)
-(defvar ztreep-leaf-face 'ztreep-leaf-face)
-
-(defface ztreep-arrow-face
- '((((background dark)) (:foreground "#7f7f7f"))
- (t (:foreground "#8d8d8d")))
- "*Face used for arrows in Ztree buffer."
- :group 'Ztree :group 'font-lock-highlighting-faces)
-(defvar ztreep-arrow-face 'ztreep-arrow-face)
-
-(defface ztreep-expand-sign-face
- '((((background dark)) (:foreground "#7f7fff"))
- (t (:foreground "#8d8d8d")))
- "*Face used for expand sign [+] in Ztree buffer."
- :group 'Ztree :group 'font-lock-highlighting-faces)
-(defvar ztreep-expand-sign-face 'ztreep-expand-sign-face)
-
-
-;;;###autoload
-(define-derived-mode ztree-mode special-mode "Ztree"
- "A major mode for displaying the directory tree in text mode."
- ;; only spaces
- (setq indent-tabs-mode nil)
- (setq buffer-read-only t))
-
-
-(defun ztree-find-node-in-line (line)
- "Return the node for the LINE specified.
-Search through the array of node-line pairs."
- (gethash line ztree-line-to-node-table))
-
-(defun ztree-find-node-at-point ()
- "Find the node at point.
-Returns cons pair (node, side) for the current point
-or nil if there is no node"
- (let ((center (/ (window-width) 2))
- (node (ztree-find-node-in-line (line-number-at-pos))))
- (when node
- (cons node (if (> (current-column) center) 'right 'left)))))
-
-
-(defun ztree-is-expanded-node (node)
- "Find if the NODE is in the list of expanded nodes."
- (ztree-find ztree-expanded-nodes-list
- #'(lambda (x) (funcall ztree-node-equal-fun x node))))
-
-
-(defun ztree-set-parent-for-line (line parent)
- "For given LINE set the PARENT in the global array."
- (aset ztree-parent-lines-array (- line ztree-start-line) parent))
-
-
-(defun ztree-get-parent-for-line (line)
- "For given LINE return a parent."
- (when (and (>= line ztree-start-line)
- (< line (+ (length ztree-parent-lines-array) ztree-start-line)))
- (aref ztree-parent-lines-array (- line ztree-start-line))))
-
-
-(defun ztree-do-toggle-expand-subtree-iter (node state)
- "Iteration in expanding subtree.
-Argument NODE current node.
-Argument STATE node state."
- (when (funcall ztree-node-is-expandable-fun node)
- (let ((children (funcall ztree-node-contents-fun node)))
- (ztree-do-toggle-expand-state node state)
- (dolist (child children)
- (ztree-do-toggle-expand-subtree-iter child state)))))
-
-
-(defun ztree-do-toggle-expand-subtree ()
- "Implements the subtree expand."
- (let* ((line (line-number-at-pos))
- (node (ztree-find-node-in-line line))
- ;; save the current window start position
- (current-pos (window-start)))
- ;; only for expandable nodes
- (when (funcall ztree-node-is-expandable-fun node)
- ;; get the current expand state and invert it
- (let ((do-expand (not (ztree-is-expanded-node node))))
- (ztree-do-toggle-expand-subtree-iter node do-expand))
- ;; refresh buffer and scroll back to the saved line
- (ztree-refresh-buffer line)
- ;; restore window start position
- (set-window-start (selected-window) current-pos))))
-
-
-(defun ztree-do-perform-action (hard)
- "Toggle expand/collapsed state for nodes or perform an action.
-HARD specifies (t or nil) if the hard action, binded on RET,
-should be performed on node."
- (let* ((line (line-number-at-pos))
- (node (ztree-find-node-in-line line)))
- (when node
- (if (funcall ztree-node-is-expandable-fun node)
- ;; only for expandable nodes
- (ztree-toggle-expand-state node)
- ;; perform action
- (when ztree-node-action-fun
- (funcall ztree-node-action-fun node hard)))
- ;; save the current window start position
- (let ((current-pos (window-start)))
- ;; refresh buffer and scroll back to the saved line
- (ztree-refresh-buffer line)
- ;; restore window start position
- (set-window-start (selected-window) current-pos)))))
-
-
-(defun ztree-perform-action ()
- "Toggle expand/collapsed state for nodes or perform the action.
-Performs the hard action, binded on RET, on node."
- (interactive)
- (ztree-do-perform-action t))
-
-(defun ztree-perform-soft-action ()
- "Toggle expand/collapsed state for nodes or perform the action.
-Performs the soft action, binded on Space, on node."
- (interactive)
- (ztree-do-perform-action nil))
-
-
-(defun ztree-toggle-expand-subtree()
- "Toggle Expanded/Collapsed state on all nodes of the subtree"
- (interactive)
- (ztree-do-toggle-expand-subtree))
-
-(defun ztree-do-toggle-expand-state (node do-expand)
- "Set the expanded state of the NODE to DO-EXPAND."
- (if (not do-expand)
- (setq ztree-expanded-nodes-list
- (ztree-filter
- #'(lambda (x) (not (funcall ztree-node-equal-fun node x)))
- ztree-expanded-nodes-list))
- (push node ztree-expanded-nodes-list)))
-
-
-(defun ztree-toggle-expand-state (node)
- "Toggle expanded/collapsed state for NODE."
- (ztree-do-toggle-expand-state node (not (ztree-is-expanded-node node))))
-
-
-(defun ztree-move-up-in-tree ()
- "Action on Backspace key.
-Jump to the line of a parent node. If previous key was Backspace
-then close the node."
- (interactive)
- (when ztree-parent-lines-array
- (let* ((line (line-number-at-pos (point)))
- (parent (ztree-get-parent-for-line line)))
- (when parent
- (if (and (equal last-command 'ztree-move-up-in-tree)
- (not ztree-count-subsequent-bs))
- (let ((node (ztree-find-node-in-line line)))
- (when (ztree-is-expanded-node node)
- (ztree-toggle-expand-state node))
- (setq ztree-count-subsequent-bs t)
- (ztree-refresh-buffer line))
- (progn (setq ztree-count-subsequent-bs nil)
- (ztree-scroll-to-line parent)))))))
-
-
-(defun ztree-get-splitted-node-contens (node)
- "Return pair of 2 elements: list of expandable nodes and list of leafs.
-Argument NODE node which contents will be returned."
- (let ((nodes (funcall ztree-node-contents-fun node))
- (comp #'(lambda (x y)
- (string< (funcall ztree-node-short-name-fun x)
- (funcall ztree-node-short-name-fun y)))))
- (cons (sort (ztree-filter
- #'(lambda (f) (funcall ztree-node-is-expandable-fun f))
- nodes)
- comp)
- (sort (ztree-filter
- #'(lambda (f) (not (funcall ztree-node-is-expandable-fun f)))
- nodes)
- comp))))
-
-
-(defun ztree-draw-char (c x y &optional face)
- "Draw char C at the position (1-based) (X Y).
-Optional argument FACE face to use to draw a character."
- (save-excursion
- (ztree-scroll-to-line y)
- (beginning-of-line)
- (goto-char (+ x (-(point) 1)))
- (delete-char 1)
- (insert-char c 1)
- (put-text-property (1- (point)) (point) 'font-lock-face (if face face
'ztreep-arrow-face))))
-
-(defun ztree-vertical-line-char ()
- "Return the character used to draw vertical line."
- (if ztree-draw-unicode-lines #x2502 ?\|))
-
-(defun ztree-horizontal-line-char ()
- "Return the character used to draw vertical line."
- (if ztree-draw-unicode-lines #x2500 ?\-))
-
-(defun ztree-left-bottom-corner-char ()
- "Return the character used to draw vertical line."
- (if ztree-draw-unicode-lines #x2514 ?\`))
-
-(defun ztree-left-intersection-char ()
- "Return left intersection character.
-It is just vertical bar when unicode disabled"
- (if ztree-draw-unicode-lines #x251C ?\|))
-
-(defun ztree-draw-vertical-line (y1 y2 x &optional face)
- "Draw a vertical line of `|' characters from Y1 row to Y2 in X column.
-Optional argument FACE face to draw line with."
- (let ((ver-line-char (ztree-vertical-line-char))
- (count (abs (- y1 y2))))
- (if (> y1 y2)
- (progn
- (dotimes (y count)
- (ztree-draw-char ver-line-char x (+ y2 y) face))
- (ztree-draw-char ver-line-char x (+ y2 count) face))
- (progn
- (dotimes (y count)
- (ztree-draw-char ver-line-char x (+ y1 y) face))
- (ztree-draw-char ver-line-char x (+ y1 count) face)))))
-
-(defun ztree-draw-vertical-rounded-line (y1 y2 x &optional face)
- "Draw a vertical line of `|' characters finishing with `\\=`' character.
-Draws the line from Y1 row to Y2 in X column.
-Optional argument FACE facet to draw the line with."
- (let ((ver-line-char (ztree-vertical-line-char))
- (corner-char (ztree-left-bottom-corner-char))
- (count (abs (- y1 y2))))
- (if (> y1 y2)
- (progn
- (dotimes (y count)
- (ztree-draw-char ver-line-char x (+ y2 y) face))
- (ztree-draw-char corner-char x (+ y2 count) face))
- (progn
- (dotimes (y count)
- (ztree-draw-char ver-line-char x (+ y1 y) face))
- (ztree-draw-char corner-char x (+ y1 count) face)))))
-
-
-(defun ztree-draw-horizontal-line (x1 x2 y)
- "Draw the horizontal line from column X1 to X2 in the row Y."
- (let ((hor-line-char (ztree-horizontal-line-char)))
- (if (> x1 x2)
- (dotimes (x (1+ (- x1 x2)))
- (ztree-draw-char hor-line-char (+ x2 x) y))
- (dotimes (x (1+ (- x2 x1)))
- (ztree-draw-char hor-line-char (+ x1 x) y)))))
-
-
-(defun ztree-draw-tree (tree depth start-offset)
- "Draw the TREE of lines with parents.
-Argument DEPTH current depth.
-Argument START-OFFSET column to start drawing from."
- (if (atom tree)
- nil
- (let* ((root (car tree))
- (children (cdr tree))
- (offset (+ start-offset (* depth 4)))
- (line-start (+ 3 offset))
- (line-end-leaf (+ 7 offset))
- (line-end-node (+ 4 offset))
- (corner-char (ztree-left-bottom-corner-char))
- (intersection-char (ztree-left-intersection-char))
- ;; determine if the line is visible. It is always the case
- ;; for 1-sided trees; however for 2 sided trees
- ;; it depends on which side is the actual element
- ;; and which tree (left with offset 0 or right with offset > 0
- ;; we are drawing
- (visible #'(lambda (line) ()
- (if (not ztree-node-side-fun) t
- (let ((side
- (gethash line ztree-line-tree-properties)))
- (cond ((eq side 'left) (= start-offset 0))
- ((eq side 'right) (> start-offset 0))
- (t t)))))))
- (when children
- ;; draw the line to the last child
- ;; since we push'd children to the list, it's the first visible line
- ;; from the children list
- (let ((last-child (ztree-find children
- #'(lambda (x)
- (funcall visible (ztree-car-atom
x)))))
- (x-offset (+ 2 offset)))
- (when last-child
- (ztree-draw-vertical-line (1+ root)
- (ztree-car-atom last-child)
- x-offset))
- ;; draw recursively
- (dolist (child children)
- (ztree-draw-tree child (1+ depth) start-offset)
- (let ((end (if (listp child) line-end-node line-end-leaf))
- (row (ztree-car-atom child)))
- (when (funcall visible (ztree-car-atom child))
- (ztree-draw-char intersection-char (1- line-start) row)
- (ztree-draw-horizontal-line line-start
- end
- row))))
- ;; finally draw the corner at the end of vertical line
- (when last-child
- (ztree-draw-char corner-char
- x-offset
- (ztree-car-atom last-child))))))))
-
-(defun ztree-fill-parent-array (tree)
- "Set the root lines array.
-Argument TREE nodes tree to create an array of lines from."
- (let ((root (car tree))
- (children (cdr tree)))
- (dolist (child children)
- (ztree-set-parent-for-line (ztree-car-atom child) root)
- (when (listp child)
- (ztree-fill-parent-array child)))))
-
-
-(defun ztree-insert-node-contents (path)
- "Insert node contents with initial depth 0.
-`ztree-insert-node-contents-1' return the tree of line
-numbers to determine who is parent line of the
-particular line. This tree is used to draw the
-graph.
-Argument PATH start node."
- (let ((tree (ztree-insert-node-contents-1 path 0))
- ;; number of 'rows' in tree is last line minus start line
- (num-of-items (- (line-number-at-pos (point)) ztree-start-line)))
- ;; create a parents array to store parents of lines
- ;; parents array used for navigation with the BS
- (setq ztree-parent-lines-array (make-vector num-of-items 0))
- ;; set the root node in lines parents array
- (ztree-set-parent-for-line ztree-start-line ztree-start-line)
- ;; fill the parent arrray from the tree
- (ztree-fill-parent-array tree)
- ;; draw the tree starting with depth 0 and offset 0
- (ztree-draw-tree tree 0 0)
- ;; for the 2-sided tree we need to draw the vertical line
- ;; and an additional tree
- (if ztree-node-side-fun ; 2-sided tree
- (let ((width (window-width)))
- ;; draw the vertical line in the middle of the window
- (ztree-draw-vertical-line ztree-start-line
- (1- (+ num-of-items ztree-start-line))
- (/ width 2)
- 'vertical-border)
- (ztree-draw-tree tree 0 (1+ (/ width 2)))))))
-
-
-(defun ztree-insert-node-contents-1 (node depth)
- "Recursively insert contents of the NODE with current DEPTH."
- (let* ((expanded (ztree-is-expanded-node node))
- ;; insert node entry with defined depth
- (root-line (ztree-insert-entry node depth expanded))
- ;; children list is the list of lines which are children
- ;; of the root line
- (children nil))
- (when expanded ;; if expanded we need to add all subnodes
- (let* ((contents (ztree-get-splitted-node-contens node))
- ;; contents is the list of 2 elements:
- (nodes (car contents)) ; expandable entries - nodes
- (leafs (cdr contents))) ; leafs - which doesn't have subleafs
- ;; iterate through all expandable entries to insert them first
- (dolist (node nodes)
- ;; if it is not in the filter list
- (when (funcall ztree-node-showp-fun node)
- ;; insert node on the next depth level
- ;; and push the returning result (in form (root children))
- ;; to the children list
- (push (ztree-insert-node-contents-1 node (1+ depth))
- children)))
- ;; now iterate through all the leafs
- (dolist (leaf leafs)
- ;; if not in filter list
- (when (funcall ztree-node-showp-fun leaf)
- ;; insert the leaf and add it to children
- (push (ztree-insert-entry leaf (1+ depth) nil)
- children)))))
- ;; result value is the list - head is the root line,
- ;; rest are children
- (cons root-line children)))
-
-(defun ztree-insert-entry (node depth expanded)
- "Inselt the NODE to the current line with specified DEPTH and EXPANDED
state."
- (let ((line (line-number-at-pos))
- (expandable (funcall ztree-node-is-expandable-fun node))
- (short-name (funcall ztree-node-short-name-fun node)))
- (if ztree-node-side-fun ; 2-sided tree
- (let ((right-short-name (funcall ztree-node-short-name-fun node t))
- (side (funcall ztree-node-side-fun node))
- (width (window-width)))
- (when (eq side 'left) (setq right-short-name ""))
- (when (eq side 'right) (setq short-name ""))
- (ztree-insert-single-entry short-name depth
- expandable expanded 0
- (when ztree-node-face-fun
- (funcall ztree-node-face-fun node)))
- (ztree-insert-single-entry right-short-name depth
- expandable expanded (1+ (/ width 2))
- (when ztree-node-face-fun
- (funcall ztree-node-face-fun node)))
- (puthash line side ztree-line-tree-properties))
- (ztree-insert-single-entry short-name depth expandable expanded 0))
- (puthash line node ztree-line-to-node-table)
- (insert "\n")
- line))
-
-(defun ztree-insert-single-entry (short-name depth
- expandable expanded
- offset
- &optional face)
- "Writes a SHORT-NAME in a proper position with the type given.
-Writes a string with given DEPTH, prefixed with [ ] if EXPANDABLE
-and [-] or [+] depending on if it is EXPANDED from the specified OFFSET.
-Optional argument FACE face to write text with."
- (let ((node-sign #'(lambda (exp)
- (let ((sign (concat "[" (if exp "-" "+") "]")))
- (insert (propertize sign
- 'font-lock-face
- ztreep-expand-sign-face)))))
- ;; face to use. if FACE is not null, use it, otherwise
- ;; deside from the node type
- (entry-face (cond (face face)
- (expandable 'ztreep-node-face)
- (t ztreep-leaf-face))))
- ;; move-to-column in contrast to insert reuses the last property
- ;; so need to clear it
- (let ((start-pos (point)))
- (move-to-column offset t)
- (remove-text-properties start-pos (point) '(font-lock-face nil)))
- (delete-region (point) (line-end-position))
- ;; every indentation level is 4 characters
- (when (> depth 0)
- (insert-char ?\s (* 4 depth))) ; insert 4 spaces
- (when (> (length short-name) 0)
- (let ((start-pos (point)))
- (if expandable
- (funcall node-sign expanded)) ; for expandable nodes insert
"[+/-]"
- ;; indentation for leafs 4 spaces from the node name
- (insert-char ?\s (- 4 (- (point) start-pos))))
- (insert (propertize short-name 'font-lock-face entry-face)))))
-
-
-
-(defun ztree-jump-side ()
- "Jump to another side for 2-sided trees."
- (interactive)
- (when ztree-node-side-fun ; 2-sided tree
- (let ((center (/ (window-width) 2)))
- (cond ((< (current-column) center)
- (move-to-column (1+ center)))
- ((> (current-column) center)
- (move-to-column 1))
- (t nil)))))
-
-
-
-(defun ztree-refresh-buffer (&optional line)
- "Refresh the buffer.
-Optional argument LINE scroll to the line given."
- (interactive)
- (when (and (equal major-mode 'ztree-mode)
- (boundp 'ztree-start-node))
- (setq ztree-line-to-node-table (make-hash-table))
- ;; create a hash table of node properties for line
- ;; used in 2-side tree mode
- (when ztree-node-side-fun
- (setq ztree-line-tree-properties (make-hash-table)))
- (let ((inhibit-read-only t))
- (erase-buffer)
- (funcall ztree-tree-header-fun)
- (setq ztree-start-line (line-number-at-pos (point)))
- (ztree-insert-node-contents ztree-start-node))
- (ztree-scroll-to-line (if line line ztree-start-line))))
-
-
-(defun ztree-change-start-node (node)
- "Refresh the buffer setting the new root NODE.
-This will reuse all other settings for the current ztree buffer, but
-change the root node to the node specified."
- (setq ztree-start-node node
- ztree-expanded-nodes-list (list ztree-start-node))
- (ztree-refresh-buffer))
-
-
-(defun ztree-view (
- buffer-name
- start-node
- filter-fun
- header-fun
- short-name-fun
- expandable-p
- equal-fun
- children-fun
- face-fun
- action-fun
- &optional
- node-side-fun
- )
- "Create a ztree view buffer configured with parameters given.
-Argument BUFFER-NAME Name of the buffer created.
-Argument START-NODE Starting node - the root of the tree.
-Argument FILTER-FUN Function which will define if the node should not be
-visible.
-Argument HEADER-FUN Function which inserts the header into the buffer
-before drawing the tree.
-Argument SHORT-NAME-FUN Function which return the short name for a node given.
-Argument EXPANDABLE-P Function to determine if the node is expandable.
-Argument EQUAL-FUN An equality function for nodes.
-Argument CHILDREN-FUN Function to get children from the node.
-Argument FACE-FUN Function to determine face of the node.
-Argument ACTION-FUN an action to perform when the Return is pressed.
-Optional argument NODE-SIDE-FUN Determines the side of the node."
- (let ((buf (get-buffer-create buffer-name)))
- (switch-to-buffer buf)
- (ztree-mode)
- ;; configure ztree-view
- (setq ztree-start-node start-node)
- (setq ztree-expanded-nodes-list (list ztree-start-node))
- (setq ztree-node-showp-fun filter-fun)
- (setq ztree-tree-header-fun header-fun)
- (setq ztree-node-short-name-fun short-name-fun)
- (setq ztree-node-is-expandable-fun expandable-p)
- (setq ztree-node-equal-fun equal-fun)
- (setq ztree-node-contents-fun children-fun)
- (setq ztree-node-face-fun face-fun)
- (setq ztree-node-action-fun action-fun)
- (setq ztree-node-side-fun node-side-fun)
- (ztree-refresh-buffer)))
-
-
-(provide 'ztree-view)
-;;; ztree-view.el ends here
diff --git a/packages/ztree/ztree.el b/packages/ztree/ztree.el
deleted file mode 100644
index d615f64..0000000
--- a/packages/ztree/ztree.el
+++ /dev/null
@@ -1,37 +0,0 @@
-;;; ztree.el --- Text mode directory tree -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2013-2016 Free Software Foundation, Inc.
-;;
-;; Author: Alexey Veretennikov <alexey.veretennikov@gmail.com>
-;; Created: 2013-11-11
-;; Version: 1.0.5
-;; Package-Requires: ((cl-lib "0"))
-;; Keywords: files tools
-;; URL: https://github.com/fourier/ztree
-;; Compatibility: GNU Emacs 24.x
-;;
-;; 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 <http://www.gnu.org/licenses/>.
-;;
-;;; Commentary:
-;;
-;;
-;;; Code:
-
-(require 'ztree-dir)
-(require 'ztree-diff)
-
-(provide 'ztree)
-;;; ztree.el ends here
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [elpa] master ed956a5: * externals-list: Move some :subtrees to :external.,
Stefan Monnier <=