[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] master 5f9c47b 3/4: Merge branch 'master' of git.sv.gnu.org:/srv/
|
From: |
Rocky Bernstein |
|
Subject: |
[elpa] master 5f9c47b 3/4: Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs/elpa |
|
Date: |
Thu, 03 Mar 2016 08:37:00 +0000 |
branch: master
commit 5f9c47b477664ac7e056cb2a3b65e16fcc48776d
Merge: e693132 b0aeb9e
Author: rocky <address@hidden>
Commit: rocky <address@hidden>
Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs/elpa
---
.gitignore | 14 +
GNUmakefile | 83 +-
README | 146 +-
admin/archive-contents.el | 250 +-
admin/ert-support.el | 54 +
admin/update-archive.sh | 9 +-
copyright_exceptions | 2 +
externals-list | 42 +-
html/index.html | 34 +-
packages/ace-window/Cask | 8 +
packages/ace-window/Makefile | 15 +-
packages/ace-window/README.md | 42 +
packages/ace-window/ace-window.el | 293 +-
packages/ace-window/avy-jump.el | 259 -
packages/ace-window/avy.el | 117 -
packages/ack/ack.el | 19 +-
packages/ack/pcmpl-ack.el | 39 +-
packages/ada-mode/NEWS | 64 +
packages/ada-mode/README | 4 +-
packages/ada-mode/ada-build.el | 32 +-
packages/ada-mode/ada-fix-error.el | 69 +-
packages/ada-mode/ada-gnat-compile.el | 69 +-
packages/ada-mode/ada-gnat-xref.el | 48 +-
packages/ada-mode/ada-grammar-wy.el | 3111 ++++----
packages/ada-mode/ada-imenu.el | 6 +-
packages/ada-mode/ada-indent-user-options.el | 60 +-
packages/ada-mode/ada-mode-compat-23.4.el | 41 -
packages/ada-mode/ada-mode-compat-24.2.el | 18 +-
packages/ada-mode/ada-mode.el | 412 +-
packages/ada-mode/ada-mode.info | 144 +-
packages/ada-mode/ada-mode.texi | 72 +-
packages/ada-mode/ada-prj.el | 2 +-
packages/ada-mode/ada-skel.el | 16 +-
packages/ada-mode/ada-stmt.el | 2 +-
packages/ada-mode/ada-wisi-opentoken.el | 6 +-
packages/ada-mode/ada-wisi.el | 203 +-
packages/ada-mode/ada-xref.el | 3 +-
packages/ada-mode/gnat-core.el | 42 +-
packages/ada-mode/gnat-inspect.el | 572 --
packages/ada-mode/gpr-grammar-wy.el | 331 +-
packages/ada-mode/gpr-mode.el | 57 +-
packages/ada-mode/gpr-mode.info | 2 +-
packages/ada-mode/gpr-query.el | 157 +-
packages/ada-mode/gpr-skel.el | 17 +-
packages/ada-mode/gpr-wisi.el | 10 +-
packages/aggressive-indent/README.md | 15 +-
packages/aggressive-indent/aggressive-indent.el | 329 +-
packages/ahungry-theme/ahungry-theme.el | 99 +-
packages/ampc/ampc.el | 3123 ++++++++
packages/ampc/ampc_tagger.cpp | 218 +
packages/arbitools/arbitools.el | 217 +
packages/async/README.md | 145 +
packages/async/async-bytecomp.el | 177 +
packages/async/async-test.el | 140 +
packages/async/async.el | 303 +
packages/async/dired-async.el | 290 +
packages/async/smtpmail-async.el | 73 +
packages/avy/.dir-locals.el | 5 +
packages/avy/Makefile | 20 +
packages/avy/README.md | 112 +
packages/{ace-window => avy}/avy-test.el | 0
packages/avy/avy.el | 1329 ++++
packages/avy/doc/Changelog.org | 325 +
.../hydra-init.el => avy/targets/avy-init.el} | 19 +-
packages/beacon/COPYING | 674 ++
packages/beacon/Readme.org | 41 +
packages/beacon/beacon.el | 459 ++
packages/beacon/example-beacon.gif | Bin 0 -> 2578269 bytes
packages/bug-hunter/README.org | 92 +
packages/bug-hunter/bug-hunter.el | 354 +-
packages/company-math/.dir-locals.el | 3 +
packages/company-math/company-math.el | 169 +
packages/company-math/img/latex-symbols.png | Bin 0 -> 3355 bytes
packages/company-math/img/unicode-symbols.png | Bin 0 -> 3333 bytes
packages/company-math/readme.md | 68 +
packages/company-statistics/README.org | 2 +-
.../company-statistics/company-statistics-tests.el | 120 +-
packages/company-statistics/company-statistics.el | 143 +-
packages/context-coloring/.gitignore | 3 +-
packages/context-coloring/.travis.yml | 28 +-
packages/context-coloring/Cask | 8 +
packages/context-coloring/LICENSE | 674 ++
packages/context-coloring/Makefile | 39 +-
packages/context-coloring/README.md | 205 +-
.../benchmark/context-coloring-benchmark.el | 212 +-
.../benchmark/fixtures}/.nosearch | 0
.../context-coloring/benchmark/fixtures/faces.el | 2764 +++++++
.../context-coloring/benchmark/fixtures/lisp.el | 930 +++
.../context-coloring/benchmark/fixtures/simple.el | 7901 ++++++++++++++++++++
.../context-coloring/benchmark/fixtures/subr.el | 4800 ++++++++++++
packages/context-coloring/context-coloring.el | 1966 +++--
packages/context-coloring/scopifier.png | Bin 2609 -> 0 bytes
packages/context-coloring/scripts/dependencies | 2 -
.../scripts/download-dependencies.el | 61 -
packages/context-coloring/test/binaries/outta-date | 5 -
.../test/context-coloring-coverage.el | 155 +
.../context-coloring/test/context-coloring-test.el | 1583 +++--
.../test/fixtures/.nosearch} | 0
.../context-coloring/test/fixtures/block-scopes.js | 10 +
packages/context-coloring/test/fixtures/changed.el | 5 +
packages/context-coloring/test/fixtures/comment.el | 3 +
packages/context-coloring/test/fixtures/cond.el | 8 +
.../test/fixtures/condition-case.el | 10 +
.../context-coloring/test/fixtures/defadvice.el | 3 +
packages/context-coloring/test/fixtures/defun.el | 8 +
packages/context-coloring/test/fixtures/dolist.el | 3 +
.../test/fixtures/empty} | 0
.../test/fixtures/empty-varlist.el | 6 +
packages/context-coloring/test/fixtures/global.js | 2 +-
packages/context-coloring/test/fixtures/ignored.el | 2 +
.../test/fixtures/initial-level.js | 2 +
.../context-coloring/test/fixtures/iteration.el | 2 +
packages/context-coloring/test/fixtures/lambda.el | 3 +
.../context-coloring/test/fixtures/let-star.el | 11 +
packages/context-coloring/test/fixtures/let.el | 13 +
.../test/fixtures/macroexp-let2.el | 6 +
packages/context-coloring/test/fixtures/quote.el | 15 +
packages/context-coloring/test/fixtures/sexp.el | 4 +
packages/context-coloring/test/fixtures/splice.el | 2 +
packages/context-coloring/test/fixtures/string.el | 2 +
.../test/fixtures/unbalanced-parenthesis.el | 2 +
.../test/fixtures/unterminated-comment.js | 6 +
.../test/fixtures/varlist-spacing.el | 8 +
packages/csv-mode/csv-mode.el | 69 +-
packages/dbus-codegen/dbus-codegen.el | 6 +-
packages/debbugs/Debbugs.wsdl | 2 +-
packages/debbugs/README | 6 +
packages/debbugs/debbugs-browse.el | 68 +
packages/debbugs/debbugs-gnu.el | 696 ++-
packages/debbugs/debbugs-org.el | 144 +-
packages/debbugs/debbugs-ug.info | 594 ++
packages/debbugs/debbugs-ug.texi | 597 ++
packages/debbugs/debbugs.el | 470 +-
packages/debbugs/debbugs.info | 557 ++
packages/debbugs/debbugs.texi | 16 +-
packages/debbugs/dir | 23 +
packages/diff-hl/README.md | 22 +-
packages/diff-hl/diff-hl-dired.el | 24 +-
packages/diff-hl/diff-hl-flydiff.el | 172 +
packages/diff-hl/diff-hl-margin.el | 18 +-
packages/diff-hl/diff-hl.el | 1105 ++--
packages/dts-mode/README.mkd | 12 +
packages/dts-mode/dts-mode.el | 177 +
packages/ediprolog/ediprolog.el | 15 +-
packages/el-search/el-search.el | 1011 +++
packages/excorporate/README | 20 +
packages/excorporate/dir | 18 +
packages/excorporate/excorporate-calendar.el | 46 +
packages/excorporate/excorporate-calfw.el.txt | 128 +
packages/excorporate/excorporate-org.el | 141 +
packages/excorporate/excorporate.el | 786 ++
packages/excorporate/excorporate.info | 150 +
packages/excorporate/excorporate.texi | 146 +
.../f90-interface-browser/f90-interface-browser.el | 89 +-
packages/fsm/fsm.el | 436 ++
packages/ggtags/README.rst | 36 +-
packages/ggtags/ggtags.el | 140 +-
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/gnorb/NEWS | 10 +
packages/gnorb/README.org | 29 +-
packages/gnorb/gnorb-bbdb.el | 83 +-
packages/gnorb/gnorb-gnus.el | 287 +-
packages/gnorb/gnorb-org.el | 63 +-
packages/gnorb/gnorb-registry.el | 134 +-
packages/gnorb/gnorb-utils.el | 201 +-
packages/gnorb/gnorb.el | 10 +-
packages/gnorb/gnorb.info | 199 +-
packages/gnorb/gnorb.org | 108 +-
packages/gnorb/gnorb.texi | 132 +-
packages/gnorb/nngnorb.el | 36 +-
packages/html5-schema/.htaccess | 10 +
packages/html5-schema/LICENSE | 23 +
packages/html5-schema/applications.rnc | 405 +
packages/html5-schema/aria.rnc | 1251 ++++
packages/html5-schema/assertions.sch | 1235 +++
packages/html5-schema/block.rnc | 250 +
packages/html5-schema/common.rnc | 526 ++
packages/html5-schema/core-scripting.rnc | 386 +
packages/html5-schema/data.rnc | 94 +
packages/html5-schema/embed.rnc | 586 ++
packages/html5-schema/form-datatypes.rnc | 63 +
packages/html5-schema/html5-schema.el | 67 +
packages/html5-schema/html5.rnc | 56 +
packages/html5-schema/html5exclusions.rnc | 63 +
packages/html5-schema/locating-rules.xml | 9 +
packages/html5-schema/media.rnc | 210 +
packages/html5-schema/meta.rnc | 424 ++
packages/html5-schema/microdata.rnc | 101 +
packages/html5-schema/phrase.rnc | 400 +
packages/html5-schema/rdfa.rnc | 285 +
packages/html5-schema/revision.rnc | 54 +
packages/html5-schema/ruby.rnc | 81 +
packages/html5-schema/sectional.rnc | 172 +
packages/html5-schema/structural.rnc | 135 +
packages/html5-schema/tables.rnc | 244 +
packages/html5-schema/web-components.rnc | 43 +
packages/html5-schema/web-forms-scripting.rnc | 27 +
packages/html5-schema/web-forms.rnc | 607 ++
packages/html5-schema/web-forms2-scripting.rnc | 9 +
packages/html5-schema/web-forms2.rnc | 789 ++
packages/html5-schema/xhtml5.rnc | 40 +
packages/hydra/.dir-locals.el | 6 +
packages/hydra/.travis.yml | 6 +-
packages/hydra/Makefile | 8 +-
packages/hydra/README.md | 68 +-
packages/hydra/hydra-examples.el | 2 +
packages/hydra/hydra-ox.el | 2 +
packages/hydra/hydra-test.el | 1680 +++--
packages/hydra/hydra.el | 1027 ++--
packages/hydra/lv.el | 63 +-
packages/hydra/{ => targets}/hydra-init.el | 4 +-
packages/ioccur/ioccur.el | 4 +-
packages/iterators/iterators.el | 61 +-
packages/javaimp/javaimp.el | 128 +-
packages/js2-mode/Makefile | 2 +-
packages/js2-mode/NEWS.md | 24 +
packages/js2-mode/js2-mode.el | 1659 +++--
packages/js2-mode/js2-old-indent.el | 489 ++
packages/js2-mode/tests/indent.el | 46 +-
packages/js2-mode/tests/navigation.el | 60 +
packages/js2-mode/tests/parser.el | 276 +-
packages/landmark/landmark.el | 1685 +++++
packages/let-alist/let-alist.el | 142 -
packages/lex/lex.el | 10 +-
packages/load-relative/ChangeLog | 7 +-
packages/load-relative/load-relative.el | 42 +-
packages/loccur/README.md | 50 +
packages/loccur/loccur.el | 323 +
packages/math-symbol-lists/.dir-locals.el | 3 +
packages/math-symbol-lists/.gitignore | 5 +
packages/math-symbol-lists/math-symbol-lists.el | 3102 ++++++++
packages/math-symbol-lists/readme.md | 4 +
packages/metar/metar.el | 73 +-
packages/midi-kbd/midi-kbd.el | 283 +
packages/minibuffer-line/minibuffer-line.el | 78 +
packages/multishell/.gitignore | 2 +
packages/multishell/LICENSE | 674 ++
packages/multishell/README.md | 57 +
packages/multishell/getting-to-a-shell.md | 41 +
packages/multishell/multishell-list.el | 312 +
packages/multishell/multishell.el | 812 ++
packages/nameless/LICENSE | 340 +
packages/nameless/README.org | 129 +
packages/nameless/example-nameless.png | Bin 0 -> 70945 bytes
packages/nameless/nameless.el | 291 +
packages/names/TheNittyGritty.org | 35 +
packages/names/UsageExample.org | 5 +-
packages/names/names-dev.el | 51 +-
packages/names/names.el | 225 +-
packages/nlinum/nlinum.el | 42 +-
packages/omn-mode/omn-mode.el | 240 -
packages/on-screen/.gitignore | 1 +
packages/on-screen/on-screen.el | 665 ++
packages/other-frame-window/other-frame-window.el | 345 +
packages/package-fixes/package-fixes.el | 148 +
packages/pinentry/pinentry.el | 397 +
packages/rainbow-mode/rainbow-mode.el | 19 +-
packages/register-list/register-list.el | 19 +-
packages/rich-minority/LICENSE | 339 +
packages/rich-minority/README.org | 50 +
packages/rich-minority/rich-minority.el | 283 +
packages/rnc-mode/rnc-mode.el | 153 +
packages/sed-mode/sed-mode.el | 140 +
packages/seq/seq.el | 208 +-
packages/seq/tests/seq-tests.el | 92 +-
packages/shell-quasiquote/shell-quasiquote.el | 123 +
packages/sisu-mode/sisu-mode.el | 562 +-
packages/sm-c-mode/GNUmakefile | 28 +
packages/sm-c-mode/sm-c-mode-test.c | 97 +
packages/sm-c-mode/sm-c-mode.el | 917 +++
packages/sotlisp/sotlisp.el | 260 +-
packages/spinner/README.org | 64 +-
packages/spinner/all-spinners.gif | Bin 0 -> 18314 bytes
.../spinner/{spinner.gif => some-spinners.gif} | Bin 1932043 -> 1932043
bytes
packages/spinner/spinner.el | 361 +-
packages/stream/stream.el | 326 +
packages/stream/tests/stream-tests.el | 216 +
packages/svg-clock/svg-clock.el | 4 +-
packages/swiper/Makefile | 4 +-
packages/swiper/README.md | 37 +-
packages/swiper/colir.el | 102 +
packages/swiper/counsel.el | 1247 +++-
packages/swiper/doc/Changelog.org | 616 ++
packages/swiper/doc/ivy.org | 476 ++
packages/swiper/doc/ivy.texi | 591 ++
packages/swiper/doc/style.css | 107 +
packages/swiper/ivy-hydra.el | 90 +
packages/swiper/ivy-test.el | 87 +-
packages/swiper/ivy.el | 2480 ++++++-
packages/swiper/swiper.el | 622 ++-
packages/test-simple/test-simple.el | 93 +-
packages/tiny/Makefile | 15 +-
packages/tiny/tiny-test.el | 2 +
packages/tiny/tiny.el | 33 +-
packages/tramp-theme/README | 11 +
packages/tramp-theme/tramp-theme.el | 172 +
packages/transcribe/transcribe.el | 268 +
packages/url-http-ntlm/url-http-ntlm.el | 316 +
packages/wcheck-mode/README.md | 15 +-
packages/wcheck-mode/wcheck-mode.el | 51 +-
packages/wconf/.gitignore | 1 +
packages/wconf/README.org | 108 +
packages/wconf/wconf.el | 343 +
packages/websocket/websocket.el | 170 +-
packages/wisi/NEWS | 21 +
packages/wisi/README | 2 +-
packages/wisi/wisi-compat-24.2.el | 7 +-
packages/wisi/wisi-compile.el | 216 +-
packages/wisi/wisi-parse.el | 47 +-
packages/wisi/wisi.el | 202 +-
packages/yasnippet/CONTRIBUTING.md | 2 +
packages/yasnippet/README.mdown | 51 +-
packages/yasnippet/doc/{ => }/doc/.nosearch | 0
packages/yasnippet/doc/{ => }/doc/faq.org | 0
packages/yasnippet/doc/{ => }/doc/index.org | 0
.../yasnippet/doc/{ => }/doc/nav-menu.html.inc | 0
packages/yasnippet/doc/{ => }/doc/org-setup.inc | 0
.../doc/{ => }/doc/snippet-development.org | 0
.../yasnippet/doc/{ => }/doc/snippet-expansion.org | 18 +-
packages/yasnippet/doc/{ => }/doc/snippet-menu.org | 5 +-
.../doc/{ => }/doc/snippet-organization.org | 18 +-
.../yasnippet/doc/{ => }/doc/snippet-reference.org | 0
.../doc/{ => }/doc/stylesheets/manual.css | 0
packages/yasnippet/doc/yas-doc-helper.el | 2 +-
packages/yasnippet/yasnippet-debug.el | 9 +-
packages/yasnippet/yasnippet-tests.el | 114 +-
packages/yasnippet/yasnippet.el | 388 +-
packages/ztree/README.md | 108 +
packages/ztree/ztree-diff-model.el | 394 +
packages/ztree/ztree-diff.el | 559 ++
packages/ztree/ztree-dir.el | 171 +
packages/ztree/ztree-util.el | 70 +
packages/ztree/ztree-view.el | 667 ++
.../ada-mode-compat-24.2.el => ztree/ztree.el} | 42 +-
341 files changed, 77331 insertions(+), 11458 deletions(-)
diff --git a/.gitignore b/.gitignore
index 1c86c55..43c9d2b 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,17 +1,31 @@
*.elc
*.orig
+.dir-locals?.el
*~
\#*\#
ChangeLog
core
+/emacs
packages/*/*-autoloads.el
packages/*/*-pkg.el
# External packages with their own .git tree.
packages/auctex
packages/chess
+packages/dash/
packages/dismal
packages/ergoemacs-mode
+packages/exwm
+packages/ntlm
+packages/omn-mode/
packages/pabbrev
+packages/python
packages/rudel
+packages/soap-client
packages/w3
+packages/xelb
+
+# Testing file
+/archive
+*.log
+*.buildlog
\ No newline at end of file
diff --git a/GNUmakefile b/GNUmakefile
index e35b82d..d23d523 100644
--- a/GNUmakefile
+++ b/GNUmakefile
@@ -1,4 +1,5 @@
# Makefile for GNU Emacs Lisp Package Archive.
+#
EMACS=emacs --batch
@@ -13,18 +14,20 @@ CR_EXCEPTIONS=copyright_exceptions
.PHONY: check_copyrights
check_copyrights:
@echo "Compute exceptions >$(CR_EXCEPTIONS)~"
- @export LANG=C; \
- (cd packages; \
- 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"; \
+ @export LC_ALL=C; \
+ (cd packages && \
+ find . -name '.git' -prune -o \
+ -name 'test' -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' -type f -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)~"
@@ -38,14 +41,21 @@ archive-tmp: packages
mkdir -p $(ARCHIVE_TMP)
cp -a packages/. $(ARCHIVE_TMP)/packages
+# Use && after the cd commands, not ;, to ensure the build fails
+# immediately if the directory $(ARCHIVE_TMP)/packages does not exist.
+# For process-archive this is crucial; otherwise batch-make-archive in
+# archive-contents.el will interpret directories in the current
+# directory as unreleased packages, and recursively delete them,
+# including .git. Prior to using &&, running "make process-archive"
+# could silently delete all local git history!
process-archive:
# FIXME, we could probably speed this up significantly with
# rules like "%.tar: ../%/ChangeLog" so we only rebuild the packages
# that have indeed changed.
- cd $(ARCHIVE_TMP)/packages; \
+ cd $(ARCHIVE_TMP)/packages && \
$(EMACS) -l $(CURDIR)/admin/archive-contents.el \
-f batch-make-archive
- @cd $(ARCHIVE_TMP)/packages; \
+ @cd $(ARCHIVE_TMP)/packages && \
for pt in *; do \
if [ -f "$${pt}/.elpaignore" ]; then \
ignore="$${pt}/.elpaignore"; \
@@ -54,7 +64,7 @@ process-archive:
fi; \
if [ -d $$pt ]; then \
echo "Creating tarball $${pt}.tar" && \
- tar -cf $${pt}.tar $$pt --exclude-vcs -X "$$ignore"; \
+ tar -chf $${pt}.tar $$pt --exclude-vcs -X "$$ignore"; \
rm -rf $${pt}; \
fi; \
done
@@ -74,7 +84,7 @@ archive-full: archive-tmp org-fetch
# FIXME: Turn it into an `external', which will require adding the notion of
# "snapshot" packages.
org-fetch: archive-tmp
- cd $(ARCHIVE_TMP)/packages; \
+ cd $(ARCHIVE_TMP)/packages && \
pkgname=`curl -s http://orgmode.org/elpa/|perl -ne 'push @f, $$1 if
m/(org-\d{8})\.tar/; END { @f = sort @f; print "$$f[-1]\n"}'`; \
wget -q http://orgmode.org/elpa/$${pkgname}.tar -O $${pkgname}.tar; \
if [ -f $${pkgname}.tar ]; then \
@@ -108,19 +118,20 @@ autoloads := $(foreach pkg, $(pkgs), $(pkg)/$(notdir
$(pkg))-autoloads.el)
# FIXME: In 99% of the cases, autoloads can be generated in any order.
# But the `names' package is an exception because it sets up an advice that
# changes the way autload.el operates, and that advice is needed when creating
-# the autoloads file of packages that use `names', such as `aggressive-indent'.
+# the autoloads file of packages that use `names'.
# The right solution is to check the Package-Requires and create the autoloads
-# files in topological order, but for now we'll just do it the ad-hoc way
+# files in topological order, but for now we can just do it the ad-hoc way and
# add hand-made dependencies between autoloads files, and explicitly
-# load the names-autoloads file when building autoloads files.
+# load the names-autoloads file when building autoloads files. An example entry
+# is commented below, this is what should be done if a package depends on
Names.
-packages/aggressive-indent/aggressive-indent-autoloads.el: \
- packages/names/names-autoloads.el
+# packages/aggressive-indent/aggressive-indent-autoloads.el: \
+# packages/names/names-autoloads.el
$(foreach al, $(autoloads), $(eval $(call RULE-srcdeps, $(al))))
%-autoloads.el:
@echo 'Generating autoloads for $@'
- @cd $(dir $@); \
+ @cd $(dir $@) && \
$(EMACS) -l $(CURDIR)/admin/archive-contents.el \
--eval "(archive--refresh-pkg-file)" \
--eval "(require 'package)" \
@@ -180,3 +191,31 @@ all-in-place: $(extra_elcs) $(autoloads) $(pkg_descs)
externals:
$(EMACS) -l admin/archive-contents.el \
-f archive-add/remove/update-externals
+
+
+
+
+################### Testing ###############
+
+PACKAGE_DIRS = $(shell find packages -maxdepth 1 -type d)
+PACKAGES=$(subst /,,$(subst packages,,$(PACKAGE_DIRS)))
+
+TOP =$(shell pwd)
+
+define test_template
+$(1)-test:
+ cd packages/$(1);\
+ $(EMACS) -l $(TOP)/admin/ert-support.el \
+ --eval "(ert-support-test-package \"$(TOP)\" '$(1))" \
+
+$(1)-test-log:
+ $(MAKE) $(1)-test > packages/$(1)/$(1).log 2>&1 || { stat=ERROR; }
+endef
+
+$(foreach package,$(PACKAGES),$(eval $(call test_template,$(package))))
+
+PACKAGES_TESTS=$(addsuffix -test-log,$(PACKAGES))
+PACKAGES_LOG=$(foreach package,$(PACKAGES),packages/$(package)/$(package).log)
+
+check: $(PACKAGES_TESTS)
+ $(EMACS) -l ert -f ert-summarize-tests-batch-and-exit $(PACKAGES_LOG)
diff --git a/README b/README
index a688040..7c5cd36 100644
--- a/README
+++ b/README
@@ -1,8 +1,8 @@
-Copyright (C) 2010-2011, 2014 Free Software Foundation, Inc.
+Copyright (C) 2010-2011, 2014, 2015 Free Software Foundation, Inc.
See the end of the file for license conditions.
-This branch contains the sources, deployment scripts, and auxilliary
+This branch contains the sources, deployment scripts, and auxiliary
files for the Emacs Lisp package archive (elpa.gnu.org).
This file explains the branch layout, how to add and edit packages,
@@ -34,18 +34,69 @@ safely work on the next version here without worrying about
the unstable
code making it to GNU ELPA, and simply update the "version" when you want to
release the new code.
-** To add a package:
+** To add a package: (submission, submit)
-*** Add a simple (1-file) package as packages/NAME/NAME.el.
+Adding a basic package is very simple. There are thorough
+instructional, but the gist is that you:
-The file needs to follow the usual coding conventions (most importantly
-start with ";;; <file> --- <description>") and have a "Version:" and
-"Maintainer:" pseudo-header.
+1. Notify address@hidden
+2. Place all files inside `packages/<pkg-name>/'.
+3. `git add', `git commit' and `git push'.
-*** Add a multi-file package as a directory, packages/NAME.
+If you don't have push access to the repository, someone will do steps
+2 and 3 for you.
-It needs to have a file named packages/NAME/NAME.el which follows the same
-rules as above.
+*** Notify address@hidden
+
+There is no approval process for GNU Elpa packages. Still,
+you must send an email to emacs-devel for several reasons:
+
+- Notifying other developers;
+- Making sure the package doesn't break FSF rules;
+- Checking if the package is not reinventing the wheel;
+- Ensuring that first-time developers are doing it right.
+
+Before doing anything, please ensure your package follows the
+conventions described in the `** Format' section. Then, send an email
+to the list with the subject:
+ [ELPA] New package: <pkg-name>
+
+Start your message with an explanation about the package. A
+copy-paste of the package's Summary and Commentary is perfectly fine
+here, but you can write more or less than that if you'd like.
+
+At the bottom of the message contents include the changes you're going
+to make (the patch). For a single-file package this can be the
+package file itself instead of the patch. If you prefer (and if you
+have push access), you can push your changes to a branch called
+`scratch/<pkg-name>', and mention the branch in your message.
+
+After 48h, or once any issues have been addressed, someone will push
+your changes for you. You should probably also subscribe to
address@hidden, since that's where we discuss about GNU Elpa, and
+to address@hidden, since that's where people will report bugs
+about your package.
+
+*** Add a simple (1-file) package as packages/<pkg-name>/<pkg-name>.el.
+
+The file needs to follow the usual coding conventions (most
+importantly start with ";;; <file> --- <description>") and have a
+"Version:" and "Maintainer:" pseudo-header (see the "Format"
+subsection below).
+
+For some examples, see
+ (info "(elisp) Simple Packages")
+
+*** Add a multi-file package as a directory, packages/<pkg-name>.
+
+It needs to have a file named packages/<pkg-name>/<pkg-name>.el which follows
the
+same rules as above.
+
+It additionally follows the same guidelines described in
+ (info "(elisp) Multi-file Packages")
+with the exception that it is not a tar package (it's a plain
+directory) and it must not contain a "<pkg-name>-pkg.el" file (this
+will be created for you).
*** Commit your changes the usual way ("git add", "git commit", etc).
@@ -60,8 +111,8 @@ header changes.
Each package should follow the ELPA packaging conventions, but there are
some differences due to the way the deployment script creates the packages
and the web-pages from this source code:
-- Multi-file packages put the package metadata in the main <pkg>.el file
- in the format used for single-file packages: the <pkg>-pkg.el file is
+- Multi-file packages put the package metadata in the main <pkg-name>.el file
+ in the format used for single-file packages: the <pkg-name>-pkg.el file is
auto-generated from it.
- Every package should have both a "Version:" *and* a "Maintainer:".
- the "URL:" header can be used to specify the home page
@@ -78,20 +129,70 @@ and the web-pages from this source code:
** External branches
-Some packages are maintained in external branches. These should be
-appropriately listed in the `externals-list' file.
-There are two different cases: subtrees and externals.
+The above instructions are enough to add regular packages, those that
+are maintained primarily here in the repository. The instructions
+below are for those maintainers who prefer to use a dedicated
+repository or branch for the package.
+
+There are two ways to do that: subtrees and externals.
+
+Either way, such packages should always be listed in the
+`externals-list' file.
+
+In both cases, a copy of the code is kept in the `elpa' repository
+(not necessarily in the master branch) and should be sync'd with the
+upstream every once in a while. This copy may include local changes,
+although these should be kept to a minimum.
+
+If know you don't want a local package, but don't know which of these
+two options you prefer, then use a subtree.
+
+*** Subtrees
+
+In the `subtree' case, the copy of the code is kept here in the master
+branch, inside its corresponding `packages/<pkg-name>' directory just
+as if it were a local package.
+
+In fact, a subtree package is essentially indistinguishable from a
+local package. The only difference is that, instead of developing it
+here, you do it in some remote repository and pull in the changes.
+
+Instead of manually creating the directory, you should be able to use:
+
+ git subtree add --prefix=packages/<pkg-name> <remote-repo> <remote-branch>
+
+Later, when you make some changes to the remote and want to publish
+them here, simply do:
+
+ git subtree pull --prefix=packages/<pkg-name> <remote-repo> <remote-branch>
+
+On older git versions "git subtree" might not be available. You can
+try "git merge -s subtree", or just update git.
+
+- <remote-repo> is the remote's URL. If you've previously used "git
+ remote add", then this can be the remote's name.
+- <remote-branch> is the branch you want to pull (probably "master").
+
+If you want the local code to be slightly different from the remote,
+simply commit further changes to it here. Of course, this may trigger
+merge conflicts when you do a "subtree pull" in the future, so it's
+best to avoid these local changes.
+
+If someone makes changes to your package here on elpa.git and you want
+to push them to your remote, it's easiest to just copy these changes
+over to the remote repo. Trying to push a subtree with git is likely
+to induce headache.
+
+**** When you're adding and pulling, DO NOT --SQUASH!!
-In both cases, a copy of the code is kept in the `elpa' repository and
-should be sync'd with the upstream every once in a while. This copy may
-include local changes, tho ideally these should be kept to a minimum.
+Don't worry about flooding elpa.git's commit log with your package's
+commit messages. Your package is part of elpa.git. Squashing doesn't
+help and only gets in the way.
-In the `subtree' case, the copy of the code is kept here in the
-corresponding `packages/<pkg>' directory. You should be able to "git
-merge -s subtree" from the upstream branch.
+*** Externals
In the `external' case, the copy of the code is not kept here but in the
-`externals/<pkg>' branch in the `elpa' repository.
+`externals/<pkg-name>' branch in the `elpa' repository.
You can check out all the external packages into the `packages' directory
with the command:
@@ -136,6 +237,7 @@ packages/ directory. You can then add that directory, e.g.
with:
** To deploy the package repository as a remotely-accessible archive:
git clone .../elpa
+ (cd elpa; git clone .../emacs) #If you want to generate :core packages.
mkdir build
cd build
(cd ../elpa; git log --format=%H | tail -n 1) >.changelog-witness
diff --git a/admin/archive-contents.el b/admin/archive-contents.el
index c53f4ba..8f054ad 100755
--- a/admin/archive-contents.el
+++ b/admin/archive-contents.el
@@ -1,6 +1,6 @@
;;; archive-contents.el --- Auto-generate an Emacs Lisp package archive. -*-
lexical-binding:t -*-
-;; Copyright (C) 2011-2014 Free Software Foundation, Inc
+;; Copyright (C) 2011-2015 Free Software Foundation, Inc
;; Author: Stefan Monnier <address@hidden>
@@ -179,7 +179,6 @@ PKG is the name of the package and DIR is the directory
where it is."
(error "Can't parse first line of %s" mainfile)
;; Grab the other fields, which are not mandatory.
(let* ((description (match-string 1))
- (pv )
(version
(or (lm-header "package-version")
(lm-header "version")
@@ -207,8 +206,9 @@ PKG is the name of the package and DIR is the directory
where it is."
"Deploy the contents of DIR into the archive as a simple package.
Rename DIR/PKG.el to PKG-VERS.el, delete DIR, and return the descriptor."
;; Write DIR/foo.el to foo-VERS.el and delete DIR
- (rename-file (expand-file-name (concat pkg ".el") dir)
- (concat pkg "-" vers ".el"))
+ (let ((src (expand-file-name (concat pkg ".el") dir)))
+ (funcall (if (file-symlink-p src) #'copy-file #'rename-file)
+ src (concat pkg "-" vers ".el")))
;; Add the content of the ChangeLog.
(let ((cl (expand-file-name "ChangeLog" dir)))
(with-current-buffer (find-file-noselect (concat pkg "-" vers ".el"))
@@ -420,7 +420,7 @@ Rename DIR/ to PKG-VERS/, and return the descriptor."
(replace-regexp-in-string "<" "<"
(replace-regexp-in-string "&" "&" txt)))
-(defun archive--insert-repolinks (name srcdir mainsrcfile url)
+(defun archive--insert-repolinks (name srcdir _mainsrcfile url)
(when url
(insert (format "<p>Home page: <a href=%S>%s</a></p>\n"
url (archive--quote url)))
@@ -531,6 +531,7 @@ Rename DIR/ to PKG-VERS/, and return the descriptor."
(cond
((member file '("." ".." "elpa.rss" "index.html" "archive-contents")))
((string-match "\\.html\\'" file))
+ ((string-match "\\.sig\\'" file))
((string-match "-readme\\.txt\\'" file)
(let ((name (substring file 0 (match-beginning 0))))
(puthash name (gethash name packages) packages)))
@@ -558,54 +559,201 @@ Rename DIR/ to PKG-VERS/, and return the descriptor."
;;; Maintain external packages.
(defconst archive--elpa-git-url "git://git.sv.gnu.org/emacs/elpa")
+(defconst archive--emacs-git-url "git://git.sv.gnu.org/emacs.git")
+
+(defun archive--sync-emacs-repo ()
+ "Sync Emacs repository, if applicable.
+Return non-nil if there's an \"emacs\" repository present."
+ ;; Support for :core packages is important for elpa.gnu.org, but for other
+ ;; cases such as "in-place installation", it's rather secondary since
+ ;; those users can just as well use a development version of Emacs to get
+ ;; those packages.
+ ;; So make the handling of :core packages depend on whether or not the user
+ ;; has setup a clone of Emacs under the "emacs" subdirectory.
+ (let ((emacs-repo-root (expand-file-name "emacs")))
+ (if (not (file-directory-p emacs-repo-root))
+ (progn (message "No \"emacs\" subdir: will skip :core packages")
+ nil)
+ (let ((default-directory emacs-repo-root))
+ (message "Running git pull in %S" default-directory)
+ (call-process "git" nil t nil "pull")
+ t))))
+
+(defun archive--find-non-trivial-file (dir)
+ (catch 'found-important-file
+ (dolist (file (directory-files-recursively dir ".*"))
+ (unless (or (member file '("." ".."))
+ (string-match "\\.elc\\'" file)
+ (string-match "-autoloads.el\\'" file)
+ (string-match "-pkg.el\\'" file)
+ (file-symlink-p file))
+ (throw 'found-important-file file)))
+ nil))
+
+(defun archive--cleanup-packages (externals-list with-core)
+ "Remove subdirectories of `packages/' that do not correspond to known
packages.
+This is any subdirectory inside `packages/' that's not under
+version control nor listed in EXTERNALS-LIST.
+If WITH-CORE is non-nil, it means we manage :core packages as well."
+ (let ((default-directory (expand-file-name "packages/")))
+ (dolist (dir (directory-files "."))
+ (cond
+ ((or (not (file-directory-p dir)) (file-symlink-p dir))
+ ;; We only add/remove plain directories in elpa/packages (not
+ ;; symlinks).
+ nil)
+ ((member dir '("." "..")) nil)
+ ((assoc dir externals-list) nil)
+ ((file-directory-p (expand-file-name (format "%s/.git" dir)))
+ (let ((status
+ (with-temp-buffer
+ (let ((default-directory (file-name-as-directory
+ (expand-file-name dir))))
+ (call-process "git" nil t nil "status" "--porcelain")
+ (buffer-string)))))
+ (if (zerop (length status))
+ (progn (delete-directory dir 'recursive t)
+ (message "Deleted all of %s" dir))
+ (message "Keeping leftover unclean %s:\n%s" dir status))))
+ ;; Check if `dir' is under version control.
+ ((and with-core
+ (not (zerop (call-process "git" nil nil nil
+ "ls-files" "--error-unmatch" dir))))
+ ;; Not under version control. Check if it only contains
+ ;; symlinks and generated files, in which case it is probably
+ ;; a leftover :core package that can safely be deleted.
+ ;; (let ((file (archive--find-non-trivial-file dir)))
+ ;; (if file
+ ;; (message "Keeping %s for non-trivial file \"%s\"" dir file)
+ ;; (progn
+ ;; (message "Deleted untracked package %s" dir)
+ ;; (delete-directory dir 'recursive t))))
+ )))))
+
+(defun archive--external-package-sync (name)
+ "Sync external package named NAME."
+ (let ((default-directory (expand-file-name "packages/")))
+ (cond ((not (file-exists-p name))
+ (let* ((branch (concat "externals/" name))
+ (output
+ (with-temp-buffer
+ ;; FIXME: Use git-new-workdir!
+ (call-process "git" nil t nil "clone"
+ "--reference" ".." "--single-branch"
+ "--branch" branch
+ archive--elpa-git-url name)
+ (buffer-string))))
+ (message "Cloning branch %s:\n%s" name output)))
+ ((not (file-directory-p (concat name "/.git")))
+ (message "%s is in the way of an external, please remove!" name))
+ (t
+ (let ((default-directory (file-name-as-directory
+ (expand-file-name name))))
+ (with-temp-buffer
+ (message "Running git pull in %S" default-directory)
+ (call-process "git" nil t nil "pull")
+ (message "Updated %s:%s" name (buffer-string))))))))
+
+(defun archive--core-package-empty-dest-p (dest)
+ "Return non-nil if DEST is an empty variant."
+ (member dest (list "" "." nil)))
+
+(defun archive--core-package-link-file
+ (source dest emacs-repo-root package-root exclude-regexp)
+ "Link file from SOURCE to DEST ensuring subdirectories."
+ (unless (string-match-p exclude-regexp source)
+ (let* ((absolute-package-file-name
+ (expand-file-name dest package-root))
+ (absolute-core-file-name
+ (expand-file-name source emacs-repo-root))
+ (directory (file-name-directory absolute-package-file-name)))
+ (unless (file-directory-p directory)
+ (make-directory directory t))
+ (condition-case nil
+ (make-symbolic-link absolute-core-file-name
+ absolute-package-file-name t)
+ (file-error
+ (copy-file absolute-core-file-name absolute-package-file-name))))
+ (message " %s -> %s" source (if (archive--core-package-empty-dest-p dest)
+ (file-name-nondirectory source)
+ dest))))
+
+(defun archive--core-package-link-directory
+ (source dest emacs-repo-root package-root exclude-regexp)
+ "Link directory files from SOURCE to DEST ensuring subdirectories."
+ (let ((stack (list source))
+ (base source)
+ (absolute-source))
+ (while stack
+ (setq source (pop stack)
+ absolute-source (expand-file-name source emacs-repo-root))
+ (if (file-directory-p absolute-source)
+ (dolist (file (directory-files absolute-source))
+ (unless (member file (list "." ".."))
+ (push (concat (file-name-as-directory source) file) stack)))
+ (let* ((base (file-name-as-directory base))
+ (source-sans-base (substring source (length base)))
+ (package-file-name
+ (if (archive--core-package-empty-dest-p dest)
+ ;; Link to root with its original filename.
+ source-sans-base
+ (concat
+ ;; Prepend the destination, allowing for directory rename.
+ (file-name-as-directory dest) source-sans-base))))
+ (archive--core-package-link-file
+ source package-file-name
+ emacs-repo-root package-root exclude-regexp))))))
+
+(defun archive--core-package-sync (definition)
+ "Sync core package from DEFINITION."
+ (pcase-let*
+ ((`(,name . (:core ,file-patterns :excludes ,excludes)) definition)
+ (emacs-repo-root (expand-file-name "emacs"))
+ (package-root (expand-file-name name "packages"))
+ (default-directory package-root)
+ (exclude-regexp
+ (mapconcat #'identity
+ (mapcar #'wildcard-to-regexp
+ (append '("*.elc" "*~") excludes nil))
+ "\\|"))
+ (file-patterns
+ (mapcar
+ (lambda (file-pattern)
+ (pcase file-pattern
+ ((pred (stringp)) (cons file-pattern ""))
+ (`(,file ,dest . ,_) (cons file dest))
+ (_ (error "Unrecognized file format for package %s: %S"
+ name file-pattern))))
+ (if (stringp file-patterns)
+ ;; Files may be just a string, normalize.
+ (list file-patterns)
+ file-patterns))))
+ (message "Linking files for package: %s" name)
+ (when (file-directory-p package-root)
+ (delete-directory package-root t))
+ (make-directory package-root t)
+ (dolist (file-pattern file-patterns)
+ (pcase-let* ((`(,file . ,dest) file-pattern))
+ (if (file-directory-p (expand-file-name file emacs-repo-root))
+ (archive--core-package-link-directory
+ file dest emacs-repo-root package-root exclude-regexp)
+ (archive--core-package-link-file
+ file dest emacs-repo-root package-root exclude-regexp))))))
(defun archive-add/remove/update-externals ()
- (let ((exts (with-current-buffer (find-file-noselect "externals-list")
- (goto-char (point-min))
- (read (current-buffer)))))
- (let ((default-directory (expand-file-name "packages/")))
- ;; Remove "old/odd" externals.
- (dolist (dir (directory-files "."))
- (cond
- ((member dir '("." "..")) nil)
- ((assoc dir exts) nil)
- ((file-directory-p (expand-file-name (format "%s/.git" dir)))
- (let ((status
- (with-temp-buffer
- (let ((default-directory (file-name-as-directory
- (expand-file-name dir))))
- (call-process "git" nil t nil "status" "--porcelain")
- (buffer-string)))))
- (if (zerop (length status))
- (progn (delete-directory dir 'recursive t)
- (message "Deleted all of %s" dir))
- (message "Keeping leftover unclean %s:\n%s" dir status))))))
- (pcase-dolist (`(,dir ,kind ,_url) exts)
- (cond
- ((eq kind :subtree) nil) ;Nothing to do.
- ((not (eq kind :external))
- (message "Unknown external package kind `%S' for %s" kind dir))
- ((not (file-exists-p dir))
- (let* ((branch (concat "externals/" dir))
- (output
- (with-temp-buffer
- ;; FIXME: Use git-new-workdir!
- (call-process "git" nil t nil "clone"
- "--reference" ".." "--single-branch"
- "--branch" branch
- archive--elpa-git-url dir)
- (buffer-string))))
- (message "Cloning branch %s:\n%s" dir output)))
- ((not (file-directory-p (concat dir "/.git")))
- (message "%s is in the way of an external, please remove!" dir))
- (t
- (let ((default-directory (file-name-as-directory
- (expand-file-name dir))))
- (with-temp-buffer
- (message "Running git pull in %S" default-directory)
- (call-process "git" nil t nil "pull")
- (message "Updated %s:%s" dir (buffer-string))))
- ))))))
+ "Remove non-package directories and fetch external packages."
+ (let ((externals-list
+ (with-current-buffer (find-file-noselect "externals-list")
+ (read (buffer-string)))))
+ (let ((with-core (archive--sync-emacs-repo)))
+ (archive--cleanup-packages externals-list with-core)
+ (pcase-dolist ((and definition `(,name ,kind ,_url)) externals-list)
+ (pcase kind
+ (`:subtree nil) ;Nothing to do.
+ (`:external (archive--external-package-sync name))
+ (`:core (when with-core (archive--core-package-sync definition)))
+ (_ (message "Unknown external package kind `%S' for %s"
+ kind name)))))))
(provide 'archive-contents)
;;; archive-contents.el ends here
diff --git a/admin/ert-support.el b/admin/ert-support.el
new file mode 100644
index 0000000..93d1af8
--- /dev/null
+++ b/admin/ert-support.el
@@ -0,0 +1,54 @@
+;; The contents of this file are subject to the GPL License, Version 3.0.
+
+;; Copyright (C) 2016, Free Software Foundation, Inc.
+
+;; 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 ert-support-package-install (top-directory package)
+ ;; blitz default value and set up from elpa.
+ (setq package-archives
+ `(("local-elpa" . ,(concat top-directory "/archive/packages"))))
+ (setq package-user-dir
+ (make-temp-file "elpa-test" t))
+ (package-initialize)
+ (package-refresh-contents)
+ (package-install package))
+
+(defun ert-support-test-find-tests (package-directory package)
+ (or
+ (directory-files package-directory nil ".*-test.el$")
+ (directory-files package-directory nil ".*-tests.el$")
+ (let ((dir-test
+ (concat package-directory "/test")))
+ (when (file-exists-p dir-test)
+ (directory-files dir-test)))
+ (let ((dir-tests
+ (concat package-directory "/tests")))
+ (when (file-exists-p dir-tests)
+ (directory-files dir-tests)))))
+
+(defun ert-support-load-tests (package-directory package)
+ (mapc
+ (lambda(file)
+ (message "Loading test file... %s" (concat package-directory file))
+ (load-file (concat package-directory file)))
+ (ert-support-test-find-tests package-directory package)))
+
+(defun ert-support-test-package (top-directory package)
+ (ert-support-package-install top-directory package)
+ (ert-support-load-tests
+ (concat top-directory "/packages/" (symbol-name package) "/")
+ package)
+
+ (ert-run-tests-batch-and-exit t))
diff --git a/admin/update-archive.sh b/admin/update-archive.sh
index 464a007..7b03d7d 100755
--- a/admin/update-archive.sh
+++ b/admin/update-archive.sh
@@ -96,9 +96,10 @@ latest="emacs-packages-latest.tgz"
(cd ../
mkdir -p staging/packages
# Not sure why we have `staging-old', but let's keep it for now.
+ mkdir -p staging-old
rsync -av --inplace --delete staging/. staging-old/.
# Move new files into place but don't throw out old package versions.
- for f in build/archive/packages/*; do
+ for f in $buildir/archive/packages/*; do
# PKG-VER
pv=$(basename "$f")
dst="staging/packages/$pv"
@@ -118,10 +119,10 @@ latest="emacs-packages-latest.tgz"
fi ;;
esac
done
- mv build/archive/"$latest" staging/
- rm -rf build/archive)
+ mv $buildir/archive/"$latest" staging/
+ rm -rf $buildid/archive)
# Make the HTML and readme.txt files.
(cd ../staging/packages
- emacs --batch -l ../../build/admin/archive-contents.el \
+ emacs --batch -l $buildir/admin/archive-contents.el \
--eval '(batch-html-make-index)')
diff --git a/copyright_exceptions b/copyright_exceptions
index 95f1b54..272d7ac 100644
--- a/copyright_exceptions
+++ b/copyright_exceptions
@@ -60,9 +60,11 @@
./auctex/style/virtex.el
./auctex/tex-fold.el: ("(C)" ("copyright"))
./auctex/tex-info.el: '("copyright" nil)
+./debbugs/debbugs-gnu.el: (insert " Copyright-paperwork-exempt: yes"))
./ergoemacs-mode/ergoemacs-advices.el: emacs-copyright
./ergoemacs-mode/ergoemacs-themes.el: ,(lambda ()
emacs-copyright)
./gnugo/gnugo.el: (CP "Copyright" game simpletext)
+./math-symbol-lists/math-symbol-lists.el: "columnsep" "columnseprule"
"columnwidth" "contentsline" "copyright"
./muse/htmlize-hack.el
./rudel/rudel-loaddefs.el
./uni-confusables/gen-confusables.el:;; Copyright (C) 1991-2009, 2010 Unicode,
Inc.
diff --git a/externals-list b/externals-list
index 96bb13b..acf8dbb 100644
--- a/externals-list
+++ b/externals-list
@@ -1,45 +1,78 @@
;; -*- emacs-lisp -*-
;; List of packages that are maintained externally.
-;; The list is made of elements of the form (NAME KIND URL).
+;; The list is made of elements of the form (NAME KIND URL OPTS...).
;;
;; Where NAME is the name of the package;
;;
;; KIND can be one of:
;; :subtree = a "git subtree" in the `master' branch.
;; :external = kept in a separate `externals/<name>' branch.
+;; :core = part of GNU Emacs repository.
;;
-;; And URL is the URL of the remote git repository that we want to track.
-;; It can be nil, in which case we don't track anything (useless for
-;; :subtree, but not for :external).
+
+;; For KIND :external URL is the URL of the remote git repository that we want
+;; to track, while in the case of :subtree URL is useless. For packages of
KIND
+;; :core URL must be a list of:
+;; STRING = A file-name to copy from Emacs repo.
+;; (STRING STRING) = A file-name to copy renamed from Emacs repo.
+
+;; For packages consisting of a single file, a plain string is also allowed.
+;; All file-names must be relative to the Emacs repository root and the package
+;; directory. When a file-name points to a directory all its files are copied
+;; recursively into the package root or specified destination. A special
+;; :excludes key can be provided to specify files to exclude when copying
+;; directories, wildcards are supported, "*.elc" and "*~" are always excluded.
+;; Exclude matches must be against the full file-name, substring matches don't
+;; work unless wildcards are used (e.g. use "etc/*" instead of "etc/").
;; The FIXMEs indicate that the branch can't be merged as is because it needs
;; some manual intervention (typically, because the two branches have
;; diverged).
(("ack" :subtree "https://github.com/leoliu/ack-el";)
+ ("aggressive-indent" :subtree
"https://github.com/Malabarba/aggressive-indent-mode";)
("auctex" :external "git://git.sv.gnu.org/auctex.git")
+ ("bug-hunter" :subtree "https://github.com/Malabarba/elisp-bug-hunter";)
;;FIXME:("cedet" :external "??")
("chess" :external nil) ;; Was
https://github.com/jwiegley/emacs-chess.git
("coffee-mode" :subtree
"https://github.com/defunkt/coffee-mode";)
("company" :subtree
"https://github.com/company-mode/company-mode.git";)
+ ("company-math" :subtree "https://github.com/vspinu/company-math.git";)
("context-coloring" :subtree
"https://github.com/jacksonrayhamilton/context-coloring.git";)
("darkroom" :subtree
"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";)
("diff-hl" :subtree "https://github.com/dgutov/diff-hl.git";)
("dismal" :external nil)
+ ("dts-mode" :subtree "https://github.com/bgamari/dts-mode.git";)
("easy-kill" :subtree "https://github.com/leoliu/easy-kill";)
("eldoc-eval" :subtree
"https://github.com/thierryvolpiatto/eldoc-eval.git";)
("enwc" :subtree
"bzr::bzr://bzr.savannah.nongnu.org/enwc/trunk")
("ergoemacs-mode" :external
"https://github.com/ergoemacs/ergoemacs-mode.git";)
+ ("exwm" :external "https://github.com/ch11ng/exwm.git";)
("f90-interface-browser" :subtree "https://github.com/wence-/f90-iface";)
("ggtags" :subtree "https://github.com/leoliu/ggtags";)
+ ("gnome-c-style" :subtree "https://github.com/ueno/gnome-c-style.git";)
("gnorb" :subtree "https://github.com/girzel/gnorb";)
("ioccur" :subtree
"https://github.com/thierryvolpiatto/ioccur.git";)
("js2-mode" :subtree "https://github.com/mooz/js2-mode.git";)
+ ("let-alist" :core "lisp/emacs-lisp/let-alist.el")
+ ("math-symbol-lists" :subtree
"https://github.com/vspinu/math-symbol-lists.git";)
+ ("nameless" :subtree "https://github.com/Malabarba/Nameless";)
+ ("names" :subtree "http://github.com/Malabarba/names";)
+ ("omn-mode" :external nil)
+ ("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";)
+ ("pinentry" :subtree "https://github.com/ueno/pinentry-el.git";)
+ ("python" :core "lisp/progmodes/python.el")
;;FIXME:("org" :external ??) ;; Need to introduce snapshots!!
+ ("rich-minority" :subtree "https://github.com/Malabarba/rich-minority";)
("rudel" :external nil) ;; Was
bzr::bzr://rudel.bzr.sourceforge.net/bzrroot/rudel/trunk
+ ("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";)
("temp-buffer-browse" :subtree
"https://github.com/leoliu/temp-buffer-browse";)
("test-simple" :subtree "https://github.com/rocky/emacs-test-simple";)
;;FIXME:("vlf" :subtree ??)
@@ -47,5 +80,6 @@
("wcheck-mode" :subtree
"https://github.com/tlikonen/wcheck-mode.git";)
("web-server" :subtree
"https://github.com/eschulte/emacs-web-server.git";)
("websocket" :subtree
"https://github.com/ahyatt/emacs-websocket.git";)
+ ("xelb" :external "https://github.com/ch11ng/xelb.git";)
("yasnippet" :subtree
"https://github.com/capitaomorte/yasnippet.git";)
)
diff --git a/html/index.html b/html/index.html
index e730d80..4afe884 100644
--- a/html/index.html
+++ b/html/index.html
@@ -1,29 +1,39 @@
-<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
- "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd";>
-<html xmlns="http://www.w3.org/1999/xhtml"; xml:lang="en" lang="en">
+<!doctype html public "-//W3C//DTD HTML 4.0 Transitional//EN">
+<html>
<head>
- <title>GNU Emacs Lisp Package Archive - GNU Project - Free Software
Foundation</title>
- <link rel="icon" type="image/png" href="gnu-head-mini.png" />
- <link rel="stylesheet" type="text/css" href="layout.css" />
+ <title>GNU Emacs Lisp Package Archive</title>
+ <link rel="icon" type="image/png" href="gnu-head-mini.png">
+ <link rel="stylesheet" type="text/css" href="layout.css">
</head>
<body>
<h1>GNU Emacs Lisp Package Archive</h1>
<p>
-This is the default package repository for
+This is the default package repository for
<a href="http://www.gnu.org/software/emacs/";>GNU Emacs</a>.
</p>
<p>
-To use it, type <kbd>M-x list-packages</kbd> in Emacs.
-(This requires Emacs version 24.1 or higher.)
+To use it, type <tt>M-x list-packages</tt> in Emacs.
+(This requires Emacs version 24.1 or higher.) <br/>
+Since you'll probably want to use your installed packages, it's also
+<a
href="https://www.gnu.org/software/emacs/manual/html_node/emacs/Package-Installation.html#Package-Installation";>recommended</a>
+that you add <code>(package-initialize)</code> somewhere
+in your <code>~/.emacs</code> file.
</p>
+<p>Or you can just browse the <a href="packages/">list of packages</a>.</p>
+
<p>
-You can grab the <a href="emacs-packages-latest.tgz">latest package
-snapshot</a> or look at the <a href="/packages">package list</a>
-directly.
+Packages are managed through the
+<a href="http://git.savannah.gnu.org/cgit/emacs/elpa.git";>GNU ELPA
repository</a>
+(see the <a href="https://savannah.gnu.org/projects/emacs";>GNU Emacs project
page</a>
+for clone instructions). <br>
+To contribute new packages refer to the
+<a
href="http://git.savannah.gnu.org/cgit/emacs/elpa.git/plain/README";>README</a>.
</p>
+
+<!-- <p> You can grab the <a href="emacs-packages-latest.tgz">latest package
snapshot</a>. -->
</body>
</html>
diff --git a/packages/ace-window/Cask b/packages/ace-window/Cask
new file mode 100644
index 0000000..5526c3c
--- /dev/null
+++ b/packages/ace-window/Cask
@@ -0,0 +1,8 @@
+(source gnu)
+(source melpa)
+
+(package-file "ace-window.el")
+
+(development
+ (depends-on "avy"))
+
diff --git a/packages/ace-window/Makefile b/packages/ace-window/Makefile
index 4f0a640..8dff696 100644
--- a/packages/ace-window/Makefile
+++ b/packages/ace-window/Makefile
@@ -1,14 +1,15 @@
-EMACS = emacs
-# EMACS = emacs-24.3
+emacs ?= emacs
+CASK = ~/.cask/bin/cask
-LOAD = -l avy.el -l avy-test.el
+.PHONY: all clean
-.PHONY: all test clean
+all: compile
-all: test
+cask:
+ $(shell EMACS=$(emacs) $(CASK) --verbose --debug)
-test:
- $(EMACS) -batch $(LOAD) -f ert-run-tests-batch-and-exit
+compile:
+ $(CASK) exec $(emacs) -batch --eval "(byte-compile-file
\"ace-window.el\")"
clean:
rm -f *.elc
diff --git a/packages/ace-window/README.md b/packages/ace-window/README.md
index 1b2f808..d70548a 100644
--- a/packages/ace-window/README.md
+++ b/packages/ace-window/README.md
@@ -44,6 +44,20 @@ always be `1`.
- You can delete the selected window by calling `ace-window` with a double
prefix argument, i.e. <kbd>C-u C-u</kbd>.
+## Change the action midway
+
+You can also start by calling `ace-window` and then decide to switch the
action to `delete` or `swap` etc. By default the bindings are:
+
+- <kbd>x</kbd> - delete window
+- <kbd>m</kbd> - swap (move) window
+- <kbd>v</kbd> - split window vertically
+- <kbd>b</kbd> - split window horizontally
+- <kbd>n</kbd> - select the previous window
+- <kbd>i</kbd> - maximize window (select which window)
+- <kbd>o</kbd> - maximize current window
+
+In order for it to work, these keys *must not* be in `aw-keys` and you have to
have `aw-dispatch-always` set to `t`.
+
## Customization
Aside from binding `ace-window`:
@@ -76,3 +90,31 @@ where to look, i.e. the top-left corners of each window.
So you can turn off the gray background with:
(setq aw-background nil)
+
+### `aw-dispatch-always`
+
+When non-nil, `ace-window` will issue a `read-char` even for one window.
+This will make `ace-window` act differently from `other-window` for one
+or two windows. This is useful to change the action midway
+and execute other action other than the *jump* default.
+By default is set to `nil`
+
+### `aw-dispatch-alist`
+
+This is the list of actions that you can trigger from `ace-window` other than
the
+*jump* default.
+By default is:
+
+ (defvar aw-dispatch-alist
+ '((?x aw-delete-window " Ace - Delete Window")
+ (?m aw-swap-window " Ace - Swap Window")
+ (?n aw-flip-window)
+ (?v aw-split-window-vert " Ace - Split Vert Window")
+ (?b aw-split-window-horz " Ace - Split Horz Window")
+ (?i delete-other-windows " Ace - Maximize Window")
+ (?o delete-other-windows))
+ "List of actions for `aw-dispatch-default'.")
+
+If the pair key-action is followed by a string, then `ace-window` will be
+invoked again to be able to select on which window you want to select the
+action. Otherwise the current window is selected.
diff --git a/packages/ace-window/ace-window.el
b/packages/ace-window/ace-window.el
index 5aa389d..a1c12ed 100644
--- a/packages/ace-window/ace-window.el
+++ b/packages/ace-window/ace-window.el
@@ -5,7 +5,8 @@
;; Author: Oleh Krehel <address@hidden>
;; Maintainer: Oleh Krehel <address@hidden>
;; URL: https://github.com/abo-abo/ace-window
-;; Version: 0.8.0
+;; Version: 0.9.0
+;; Package-Requires: ((avy "0.2.0"))
;; Keywords: window, location
;; This file is part of GNU Emacs.
@@ -26,7 +27,7 @@
;;; Commentary:
;;
;; The main function, `ace-window' is meant to replace `other-window'.
-;; If fact, when there are only two windows present, `other-window' is
+;; In fact, when there are only two windows present, `other-window' is
;; called. If there are more, each window will have its first
;; character highlighted. Pressing that character will switch to that
;; window.
@@ -41,7 +42,7 @@
;;
;; (setq aw-keys '(?a ?s ?d ?f ?g ?h ?j ?k ?l))
;;
-;; This way they're all on the home row, although the intuitive
+;; This way they are all on the home row, although the intuitive
;; ordering is lost.
;;
;; If you don't want the gray background that makes the red selection
@@ -49,6 +50,9 @@
;;
;; (setq aw-background nil)
;;
+;; If you want to know the selection characters ahead of time, you can
+;; turn on `ace-window-display-mode'.
+;;
;; When prefixed with one `universal-argument', instead of switching
;; to selected window, the selected window is swapped with current one.
;;
@@ -83,6 +87,10 @@
Use M-0 `ace-window' to toggle this value."
:type 'boolean)
+(defcustom aw-ignore-current nil
+ "When t, `ace-window' will ignore `selected-window'."
+ :type 'boolean)
+
(defcustom aw-background t
"When t, `ace-window' will dim out all buffers temporarily when used.'."
:type 'boolean)
@@ -93,6 +101,12 @@ Use M-0 `ace-window' to toggle this value."
(const :tag "single char" 'char)
(const :tag "full path" 'path)))
+(defcustom aw-dispatch-always nil
+ "When non-nil, `ace-window' will issue a `read-char' even for one window.
+This will make `ace-window' act different from `other-window' for
+ one or two windows."
+ :type 'boolean)
+
(defface aw-leading-char-face
'((((class color)) (:foreground "red"))
(((background dark)) (:foreground "gray100"))
@@ -111,24 +125,22 @@ Use M-0 `ace-window' to toggle this value."
;;* Implementation
(defun aw-ignored-p (window)
"Return t if WINDOW should be ignored."
- (and aw-ignore-on
- (member (buffer-name (window-buffer window))
- aw-ignored-buffers)))
+ (or (and aw-ignore-on
+ (member (buffer-name (window-buffer window))
+ aw-ignored-buffers))
+ (and aw-ignore-current
+ (equal window (selected-window)))))
(defun aw-window-list ()
"Return the list of interesting windows."
(sort
(cl-remove-if
(lambda (w)
- (let ((f (window-frame w))
- (b (window-buffer w)))
+ (let ((f (window-frame w)))
(or (not (and (frame-live-p f)
(frame-visible-p f)))
(string= "initial_terminal" (terminal-name f))
- (aw-ignored-p w)
- (with-current-buffer b
- (and buffer-read-only
- (= 0 (buffer-size b)))))))
+ (aw-ignored-p w))))
(cl-case aw-scope
(global
(cl-mapcan #'window-list (frame-list)))
@@ -138,9 +150,6 @@ Use M-0 `ace-window' to toggle this value."
(error "Invalid `aw-scope': %S" aw-scope))))
'aw-window<))
-(defvar aw-overlays-lead nil
- "Hold overlays for leading chars.")
-
(defvar aw-overlays-back nil
"Hold overlays for when `aw-background' is t.")
@@ -152,51 +161,63 @@ Use M-0 `ace-window' to toggle this value."
(nconc minor-mode-alist
(list '(ace-window-mode ace-window-mode))))
+(defvar aw-empty-buffers-list nil
+ "Store the read-only empty buffers which had to be modified.
+Modify them back eventually.")
+
(defun aw--done ()
"Clean up mode line and overlays."
;; mode line
- (setq ace-window-mode nil)
- (force-mode-line-update)
+ (aw-set-mode-line nil)
;; background
(mapc #'delete-overlay aw-overlays-back)
(setq aw-overlays-back nil)
- (aw--remove-leading-chars))
+ (avy--remove-leading-chars)
+ (dolist (b aw-empty-buffers-list)
+ (with-current-buffer b
+ (when (string= (buffer-string) " ")
+ (let ((inhibit-read-only t))
+ (delete-region (point-min) (point-max))))))
+ (setq aw-empty-buffers-list nil))
(defun aw--lead-overlay (path leaf)
"Create an overlay using PATH at LEAF.
LEAF is (PT . WND)."
- (let* ((pt (car leaf))
- (wnd (cdr leaf))
- (ol (make-overlay pt (1+ pt) (window-buffer wnd)))
- (old-str (with-selected-window wnd
- (buffer-substring pt (1+ pt))))
- (new-str
- (concat
- (cl-case aw-leading-char-style
- (char
- (apply #'string (last path)))
- (path
- (apply #'string (reverse path)))
- (t
- (error "Bad `aw-leading-char-style': %S"
- aw-leading-char-style)))
- (cond ((string-equal old-str "\t")
- (make-string (1- tab-width) ?\ ))
- ((string-equal old-str "\n")
- "\n")
+ (let ((wnd (cdr leaf)))
+ (with-selected-window wnd
+ (when (= 0 (buffer-size))
+ (push (current-buffer) aw-empty-buffers-list)
+ (let ((inhibit-read-only t))
+ (insert " ")))
+ (let* ((pt (car leaf))
+ (ol (make-overlay pt (1+ pt) (window-buffer wnd)))
+ (old-str (or
+ (ignore-errors
+ (with-selected-window wnd
+ (buffer-substring pt (1+ pt))))
+ ""))
+ (new-str
+ (concat
+ (cl-case aw-leading-char-style
+ (char
+ (apply #'string (last path)))
+ (path
+ (apply #'string (reverse path)))
(t
- (make-string
- (max 0 (1- (string-width old-str)))
- ?\ ))))))
- (overlay-put ol 'face 'aw-leading-char-face)
- (overlay-put ol 'window wnd)
- (overlay-put ol 'display new-str)
- (push ol aw-overlays-lead)))
-
-(defun aw--remove-leading-chars ()
- "Remove leading char overlays."
- (mapc #'delete-overlay aw-overlays-lead)
- (setq aw-overlays-lead nil))
+ (error "Bad `aw-leading-char-style': %S"
+ aw-leading-char-style)))
+ (cond ((string-equal old-str "\t")
+ (make-string (1- tab-width) ?\ ))
+ ((string-equal old-str "\n")
+ "\n")
+ (t
+ (make-string
+ (max 0 (1- (string-width old-str)))
+ ?\ ))))))
+ (overlay-put ol 'face 'aw-leading-char-face)
+ (overlay-put ol 'window wnd)
+ (overlay-put ol 'display new-str)
+ (push ol avy--overlays-lead)))))
(defun aw--make-backgrounds (wnd-list)
"Create a dim background overlay for each window on WND-LIST."
@@ -211,91 +232,122 @@ LEAF is (PT . WND)."
ol))
wnd-list))))
-(defvar aw--flip-keys nil
- "Pre-processed `aw-flip-keys'.")
-
-(defcustom aw-flip-keys '("n")
- "Keys which should select the last window."
- :set (lambda (sym val)
- (set sym val)
- (setq aw--flip-keys
- (mapcar (lambda (x) (aref (kbd x) 0)) val))))
-
-(defun aw-select (mode-line)
+(define-obsolete-variable-alias
+ 'aw-flip-keys 'aw--flip-keys "0.1.0"
+ "Use `aw-dispatch-alist' instead.")
+
+(defvar aw-dispatch-function 'aw-dispatch-default
+ "Function to call when a character not in `aw-keys' is pressed.")
+
+(defvar aw-action nil
+ "Function to call at the end of `aw-select'.")
+
+(defun aw-set-mode-line (str)
+ "Set mode line indicator to STR."
+ (setq ace-window-mode str)
+ (force-mode-line-update))
+
+(defvar aw-dispatch-alist
+ '((?x aw-delete-window " Ace - Delete Window")
+ (?m aw-swap-window " Ace - Swap Window")
+ (?n aw-flip-window)
+ (?v aw-split-window-vert " Ace - Split Vert Window")
+ (?b aw-split-window-horz " Ace - Split Horz Window")
+ (?i delete-other-windows " Ace - Maximize Window")
+ (?o delete-other-windows))
+ "List of actions for `aw-dispatch-default'.")
+
+(defun aw-dispatch-default (char)
+ "Perform an action depending on CHAR."
+ (let ((val (cdr (assoc char aw-dispatch-alist))))
+ (if val
+ (if (and (car val) (cadr val))
+ (prog1 (setq aw-action (car val))
+ (aw-set-mode-line (cadr val)))
+ (funcall (car val))
+ (throw 'done 'exit))
+ (avy-handler-default char))))
+
+(defun aw-select (mode-line &optional action)
"Return a selected other window.
Amend MODE-LINE to the mode line for the duration of the selection."
+ (setq aw-action action)
(let ((start-window (selected-window))
(next-window-scope (cl-case aw-scope
('global 'visible)
('frame 'frame)))
(wnd-list (aw-window-list))
- final-window)
- (cl-case (length wnd-list)
- (0
- start-window)
- (1
- (car wnd-list))
- (2
- (setq final-window (next-window nil nil next-window-scope))
- (while (and (aw-ignored-p final-window)
- (not (equal final-window start-window)))
- (setq final-window (next-window final-window nil next-window-scope)))
- final-window)
- (t
- (let ((candidate-list
- (mapcar (lambda (wnd)
- ;; can't jump if the buffer is empty
- (with-current-buffer (window-buffer wnd)
- (when (= 0 (buffer-size))
- (insert " ")))
- (cons (aw-offset wnd) wnd))
- wnd-list)))
- (aw--make-backgrounds wnd-list)
- (setq ace-window-mode mode-line)
- (force-mode-line-update)
- ;; turn off helm transient map
- (remove-hook 'post-command-hook 'helm--maybe-update-keymap)
- (unwind-protect
- (condition-case err
- (or (cdr (avy-read (avy-tree candidate-list aw-keys)
- #'aw--lead-overlay
- #'aw--remove-leading-chars))
- start-window)
- (error
- (if (memq (nth 2 err) aw--flip-keys)
- (aw--pop-window)
- (signal (car err) (cdr err)))))
- (aw--done)))))))
+ window)
+ (setq window
+ (cond ((<= (length wnd-list) 1)
+ (when aw-dispatch-always
+ (setq aw-action
+ (unwind-protect
+ (catch 'done
+ (funcall aw-dispatch-function (read-char)))
+ (aw--done)))
+ (when (eq aw-action 'exit)
+ (setq aw-action nil)))
+ (or (car wnd-list) start-window))
+ ((and (= (length wnd-list) 2)
+ (not aw-dispatch-always)
+ (not aw-ignore-current))
+ (let ((wnd (next-window nil nil next-window-scope)))
+ (while (and (aw-ignored-p wnd)
+ (not (equal wnd start-window)))
+ (setq wnd (next-window wnd nil next-window-scope)))
+ wnd))
+ (t
+ (let ((candidate-list
+ (mapcar (lambda (wnd)
+ (cons (aw-offset wnd) wnd))
+ wnd-list)))
+ (aw--make-backgrounds wnd-list)
+ (aw-set-mode-line mode-line)
+ ;; turn off helm transient map
+ (remove-hook 'post-command-hook 'helm--maybe-update-keymap)
+ (unwind-protect
+ (let* ((avy-handler-function aw-dispatch-function)
+ (res (avy-read (avy-tree candidate-list aw-keys)
+ #'aw--lead-overlay
+ #'avy--remove-leading-chars)))
+ (if (eq res 'exit)
+ (setq aw-action nil)
+ (or (cdr res)
+ start-window)))
+ (aw--done))))))
+ (if aw-action
+ (funcall aw-action window)
+ window)))
;;* Interactive
;;;###autoload
(defun ace-select-window ()
"Ace select window."
(interactive)
- (aw-switch-to-window
- (aw-select " Ace - Window")))
+ (aw-select " Ace - Window"
+ #'aw-switch-to-window))
;;;###autoload
(defun ace-delete-window ()
"Ace delete window."
(interactive)
- (aw-delete-window
- (aw-select " Ace - Delete Window")))
+ (aw-select " Ace - Delete Window"
+ #'aw-delete-window))
;;;###autoload
(defun ace-swap-window ()
"Ace swap window."
(interactive)
- (aw-swap-window
- (aw-select " Ace - Swap Window")))
+ (aw-select " Ace - Swap Window"
+ #'aw-swap-window))
;;;###autoload
(defun ace-maximize-window ()
"Ace maximize window."
(interactive)
- (select-window
- (aw-select " Ace - Maximize Window"))
- (delete-other-windows))
+ (aw-select " Ace - Maximize Window"
+ #'delete-other-windows))
;;;###autoload
(defun ace-window (arg)
@@ -355,10 +407,15 @@ Windows are numbered top down, left to right."
"Return the removed top of `aw--window-ring'."
(let (res)
(condition-case nil
- (while (not (window-live-p
- (setq res (ring-remove aw--window-ring 0)))))
+ (while (or (not (window-live-p
+ (setq res (ring-remove aw--window-ring 0))))
+ (equal res (selected-window))))
(error
- (error "No previous windows stored")))
+ (if (= (length (aw-window-list)) 2)
+ (progn
+ (other-window 1)
+ (setq res (selected-window)))
+ (error "No previous windows stored"))))
res))
(defun aw-switch-to-window (window)
@@ -390,6 +447,10 @@ Windows are numbered top down, left to right."
(delete-window window)
(error "Got a dead window %S" window)))))
+(defcustom aw-swap-invert nil
+ "When non-nil, the other of the two swapped windows gets the point."
+ :type 'boolean)
+
(defun aw-swap-window (window)
"Swap buffers of current window and WINDOW."
(cl-labels ((swap-windows (window1 window2)
@@ -407,7 +468,19 @@ Windows are numbered top down, left to right."
(when (and (window-live-p window)
(not (eq window this-window)))
(aw--push-window this-window)
- (swap-windows this-window window)))))
+ (if aw-swap-invert
+ (swap-windows window this-window)
+ (swap-windows this-window window))))))
+
+(defun aw-split-window-vert (window)
+ "Split WINDOW vertically."
+ (select-window window)
+ (split-window-vertically))
+
+(defun aw-split-window-horz (window)
+ "Split WINDOW horizontally."
+ (select-window window)
+ (split-window-horizontally))
(defun aw-offset (window)
"Return point in WINDOW that's closest to top left corner.
diff --git a/packages/ace-window/avy-jump.el b/packages/ace-window/avy-jump.el
deleted file mode 100644
index b83f7a8..0000000
--- a/packages/ace-window/avy-jump.el
+++ /dev/null
@@ -1,259 +0,0 @@
-;;; avy-jump.el --- jump to things tree-style
-
-;; Copyright (C) 2015 Free Software Foundation, Inc.
-
-;; Author: Oleh Krehel
-
-;; 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, 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.
-
-;; For a full copy of the GNU General Public License
-;; see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;;
-;; This package offers various commands for navigating to things using `avy'.
-;; They are in the "Commands" outline.
-
-;;; Code:
-;;* Requires
-(require 'avy)
-(require 'ace-window)
-
-;;* Customization
-(defgroup avy-jump nil
- "Jump to things tree-style."
- :group 'convenience
- :prefix "avi-")
-
-(defcustom avi-keys '(?a ?s ?d ?f ?g ?h ?j ?k ?l)
- "Keys for jumping.")
-
-(defcustom avi-background nil
- "When non-nil, a gray background will be added during the selection."
- :type 'boolean)
-
-(defface avi-lead-face
- '((t (:foreground "white" :background "#e52b50")))
- "Face used for the leading chars.")
-
-;;* Internals
-(defun avi--goto (x)
- "Goto X.
-X is (POS . WND)
-POS is either a position or (BEG . END)."
- (if (null x)
- (message "zero candidates")
- (select-window (cdr x))
- (let ((pt (car x)))
- (when (consp pt)
- (setq pt (car pt)))
- (goto-char pt))))
-
-(defun avi--process (candidates overlay-fn)
- "Select one of CANDIDATES using `avy-read'."
- (unwind-protect
- (let ((aw-background avi-background))
- (cl-case (length candidates)
- (0
- nil)
- (1
- (car candidates))
- (t
- (aw--make-backgrounds (list (selected-window)))
- (avy-read (avy-tree candidates avi-keys)
- overlay-fn
- #'aw--remove-leading-chars))))
- (aw--done)))
-
-(defun avi--regex-candidates (regex &optional wnd beg end)
- "Return all elements that match REGEX in WND.
-Each element of the list is ((BEG . END) . WND)."
- (setq wnd (or wnd (selected-window)))
- (let ((we (or end (window-end (selected-window) t)))
- candidates)
- (save-window-excursion
- (select-window wnd)
- (save-excursion
- (goto-char (or beg (window-start)))
- (while (re-search-forward regex we t)
- (push (cons (cons (match-beginning 0)
- (match-end 0))
- wnd) candidates)))
- (nreverse candidates))))
-
-(defun avi--overlay (str pt wnd)
- "Create an overlay with STR at PT in WND."
- (let ((ol (make-overlay pt (1+ pt) (window-buffer wnd)))
- (old-str (with-selected-window wnd
- (buffer-substring pt (1+ pt)))))
- (when avi-background
- (setq old-str (propertize
- old-str 'face 'aw-background-face)))
- (overlay-put ol 'window wnd)
- (overlay-put ol 'display (concat str old-str))
- (push ol aw-overlays-lead)))
-
-(defun avi--overlay-pre (path leaf)
- "Create an overlay with STR at LEAF.
-PATH is a list of keys from tree root to LEAF.
-LEAF is ((BEG . END) . WND)."
- (avi--overlay
- (propertize (apply #'string (reverse path))
- 'face 'avi-lead-face)
- (if (consp (car leaf))
- (caar leaf)
- (car leaf))
- (cdr leaf)))
-
-(defun avi--overlay-post (path leaf)
- "Create an overlay with STR at LEAF.
-PATH is a list of keys from tree root to LEAF.
-LEAF is ((BEG . END) . WND)."
- (avi--overlay
- (propertize (apply #'string (reverse path))
- 'face 'avi-lead-face)
- (if (consp (car leaf))
- (cdar leaf)
- (car leaf))
- (cdr leaf)))
-
-;;* Commands
-;;;###autoload
-(defun avi-goto-char ()
- "Read one char and jump to it in current window."
- (interactive)
- (avi--goto
- (avi--process
- (avi--regex-candidates
- (string (read-char "char: "))
- (selected-window))
- #'avi--overlay-post)))
-
-;;;###autoload
-(defun avi-goto-char-2 ()
- "Read two chars and jump to them in current window."
- (interactive)
- (avi--goto
- (avi--process
- (avi--regex-candidates
- (string
- (read-char "char 1: ")
- (read-char "char 2: "))
- (selected-window))
- #'avi--overlay-post)))
-
-;;;###autoload
-(defun avi-isearch ()
- "Jump to one of the current isearch candidates."
- (interactive)
- (let* ((candidates
- (avi--regex-candidates isearch-string))
- (avi-background nil)
- (candidate
- (avi--process candidates #'avi--overlay-post)))
- (isearch-done)
- (avi--goto candidate)))
-
-;;;###autoload
-(defun avi-goto-word-0 ()
- "Jump to a word start in current window."
- (interactive)
- (let* ((avi-keys (number-sequence ?a ?z))
- (candidates (avi--regex-candidates "\\b\\sw")))
- (avi--goto
- (avi--process candidates #'avi--overlay-pre))))
-
-;;;###autoload
-(defun avi-goto-word-1 ()
- "Jump to a word start in current window.
-Read one char with which the word should start."
- (interactive)
- (let ((candidates (avi--regex-candidates
- (concat
- "\\b"
- (string (read-char "char: "))))))
- (avi--goto
- (avi--process candidates #'avi--overlay-pre))))
-
-(defun avi--line ()
- "Select line in current window."
- (let ((avi-background nil)
- candidates)
- (save-excursion
- (save-restriction
- (narrow-to-region (window-start) (window-end (selected-window) t))
- (goto-char (point-min))
- (while (< (point) (point-max))
- (push (cons (point) (selected-window))
- candidates)
- (forward-line 1))))
- (avi--process (nreverse candidates) #'avi--overlay-pre)))
-
-;;;###autoload
-(defun avi-goto-line ()
- "Jump to a line start in current buffer."
- (interactive)
- (avi--goto (avi--line)))
-
-;;;###autoload
-(defun avi-copy-line (arg)
- "Copy a selected line above the current line.
-ARG lines can be used."
- (interactive "p")
- (let ((start (car (avi--line))))
- (move-beginning-of-line nil)
- (save-excursion
- (insert
- (buffer-substring-no-properties
- start
- (save-excursion
- (goto-char start)
- (move-end-of-line arg)
- (point)))
- "\n"))))
-
-;;;###autoload
-(defun avi-move-line (arg)
- "Move a selected line above the current line.
-ARG lines can be used."
- (interactive "p")
- (let ((start (car (avi--line))))
- (move-beginning-of-line nil)
- (save-excursion
- (save-excursion
- (goto-char start)
- (move-end-of-line arg)
- (kill-region start (point)))
- (insert
- (current-kill 0)))))
-
-;;;###autoload
-(defun avi-copy-region ()
- "Select two lines and copy the text between them here."
- (interactive)
- (let ((beg (car (avi--line)))
- (end (car (avi--line)))
- (pad (if (bolp) "" "\n")))
- (move-beginning-of-line nil)
- (save-excursion
- (insert
- (buffer-substring-no-properties
- beg
- (save-excursion
- (goto-char end)
- (line-end-position)))
- pad))))
-
-(provide 'avy-jump)
-
-;;; avy-jump.el ends here
diff --git a/packages/ace-window/avy.el b/packages/ace-window/avy.el
deleted file mode 100644
index 2f7d086..0000000
--- a/packages/ace-window/avy.el
+++ /dev/null
@@ -1,117 +0,0 @@
-;;; avy.el --- set-based completion -*- lexical-binding: t -*-
-
-;; Copyright (C) 2015 Free Software Foundation, Inc.
-
-;; Author: Oleh Krehel
-
-;; 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, 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.
-
-;; For a full copy of the GNU General Public License
-;; see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;;
-;; Given a LIST and KEYS, `avy-tree' will build a balanced tree of
-;; degree B, where B is the length of KEYS.
-;;
-;; The corresponding member of KEYS is placed in each internal node of
-;; the tree. The leafs are the members of LIST. They can be obtained
-;; in the original order by traversing the tree depth-first.
-
-;;; Code:
-
-(defmacro avy-multipop (lst n)
- "Remove LST's first N elements and return them."
- `(if (<= (length ,lst) ,n)
- (prog1 ,lst
- (setq ,lst nil))
- (prog1 ,lst
- (setcdr
- (nthcdr (1- ,n) (prog1 ,lst (setq ,lst (nthcdr ,n ,lst))))
- nil))))
-
-(defun avy-tree (lst keys)
- "Coerce LST into a balanced tree.
-The degree of the tree is the length of KEYS.
-KEYS are placed appropriately on internal nodes."
- (let ((len (length keys)))
- (cl-labels
- ((rd (ls)
- (let ((ln (length ls)))
- (if (< ln len)
- (cl-pairlis keys
- (mapcar (lambda (x) (cons 'leaf x)) ls))
- (let ((ks (copy-sequence keys))
- res)
- (dolist (s (avy-subdiv ln len))
- (push (cons (pop ks)
- (if (eq s 1)
- (cons 'leaf (pop ls))
- (rd (avy-multipop ls s))))
- res))
- (nreverse res))))))
- (rd lst))))
-
-(defun avy-subdiv (n b)
- "Distribute N in B terms in a balanced way."
- (let* ((p (1- (floor (log n b))))
- (x1 (expt b p))
- (x2 (* b x1))
- (delta (- n x2))
- (n2 (/ delta (- x2 x1)))
- (n1 (- b n2 1)))
- (append
- (make-list n1 x1)
- (list
- (- n (* n1 x1) (* n2 x2)))
- (make-list n2 x2))))
-
-(defun avy-traverse (tree walker &optional recur-key)
- "Traverse TREE generated by `avy-tree'.
-WALKER is a function that takes KEYS and LEAF.
-
-RECUR-KEY is used in recursion.
-
-LEAF is a member of LST argument of `avy-tree'.
-
-KEYS is the path from the root of `avy-tree' to LEAF."
- (dolist (br tree)
- (let ((key (cons (car br) recur-key)))
- (if (eq (cadr br) 'leaf)
- (funcall walker key (cddr br))
- (avy-traverse (cdr br) walker key)))))
-
-(defun avy-read (tree display-fn cleanup-fn)
- "Select a leaf from TREE using consecutive `read-char'.
-
-DISPLAY-FN should take CHAR and LEAF and signify that LEAFs
-associated with CHAR will be selected if CHAR is pressed. This is
-commonly done by adding a CHAR overlay at LEAF position.
-
-CLEANUP-FN should take no arguments and remove the effects of
-multiple DISPLAY-FN invokations."
- (catch 'done
- (while tree
- (avy-traverse tree display-fn)
- (let ((char (read-char))
- branch)
- (funcall cleanup-fn)
- (if (setq branch (assoc char tree))
- (if (eq (car (setq tree (cdr branch))) 'leaf)
- (throw 'done (cdr tree)))
- (signal 'user-error (list "No such candidate" char))
- (throw 'done nil))))))
-
-(provide 'avy)
-
-;;; avy.el ends here
diff --git a/packages/ack/ack.el b/packages/ack/ack.el
index c1f5328..11c1f93 100644
--- a/packages/ack/ack.el
+++ b/packages/ack/ack.el
@@ -1,9 +1,9 @@
-;;; ack.el --- Interface to ack-like source code search tools -*-
lexical-binding: t; -*-
+;;; ack.el --- interface to ack-like tools -*- lexical-binding: t;
-*-
-;; Copyright (C) 2012-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2015 Free Software Foundation, Inc.
;; Author: Leo Liu <address@hidden>
-;; Version: 1.3
+;; Version: 1.5
;; Keywords: tools, processes, convenience
;; Created: 2012-03-24
;; URL: https://github.com/leoliu/ack-el
@@ -50,6 +50,13 @@
;; 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:
@@ -140,6 +147,9 @@ Used by `ack-guess-project-root'."
(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'."
@@ -378,7 +388,8 @@ minibuffer:
;; make use of `compilation-arguments'.
(with-current-buffer (compilation-start command-args 'ack-mode)
(when ack-buffer-name-function
- (rename-buffer (funcall ack-buffer-name-function "ack"))))))
+ (rename-buffer (funcall ack-buffer-name-function "ack")))
+ (current-buffer))))
(provide 'ack)
;;; ack.el ends here
diff --git a/packages/ack/pcmpl-ack.el b/packages/ack/pcmpl-ack.el
index 3029367..315eb04 100644
--- a/packages/ack/pcmpl-ack.el
+++ b/packages/ack/pcmpl-ack.el
@@ -1,6 +1,6 @@
-;;; pcmpl-ack.el --- completion for ack -*- lexical-binding: t; -*-
+;;; pcmpl-ack.el --- completion for ack and ag -*- lexical-binding: t;
-*-
-;; Copyright (C) 2012-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2015 Free Software Foundation, Inc.
;; Author: Leo Liu <address@hidden>
;; Keywords: tools, processes, convenience
@@ -27,6 +27,7 @@
;;
;; Install:
;; (autoload 'pcomplete/ack "pcmpl-ack")
+;; (autoload 'pcomplete/ag "pcmpl-ack")
;;
;; Usage:
;; - To complete short options type '-' first
@@ -137,5 +138,39 @@ long options."
;;;###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/ada-mode/NEWS b/packages/ada-mode/NEWS
old mode 100755
new mode 100644
index 581677a..960584e
--- a/packages/ada-mode/NEWS
+++ b/packages/ada-mode/NEWS
@@ -7,6 +7,70 @@ Please send Emacs Ada mode bug reports to address@hidden, with
'ada-mode' in the subject. If possible, use M-x report-emacs-bug.
+* Ada mode 5.1.9
+20 Jan 2016
+
+** New option ada-indent-comment-gnat matches the GNAT style check for
+ comments in all cases (previously, there were some cases where the
+ comment indent algorithm did not match the GNAT check).
+
+** New menu command "Show source file search path"; displays
+ compilation-search-path in a buffer.
+
+** Adding missing grammar statements to allow removing parens around
+ conditional and quantified expressions.
+
+** Key binding for ada-case-create-partial-exception in ada-mode
+ changed to C-c C-M-y; this is easier to type, and matches the key
+ binding in gpr-mode.
+
+** ada-case-keyword changed to accept the symbols 'lower-case,
+ 'upper-case instead of the functions downcase-word, upcase-word.
+
+** ada-case-identifier changed to accept the symbols 'mixed-case,
+ 'lower-case, 'upper-case instead of the functions 'ada-mixed-case,
+ 'ada-lower-case, 'ada-upper-case.
+
+** ada-fix-add-context-clause now sorts "limited with" and "private
+ with" clauses after other clauses.
+
+** ada-align now aligns '=>' in case expressions.
+
+** ada-align-paramlist now handles access function parameters:
+
+ procedure Choose
+ (X, Y, Z : Integer;
+ Preference : access function (A, B : Integer) return Boolean);
+
+** ada-next-statement-keyword now moves to matching close paren if on
+ open paren, ada-prev-statement-keyword moves from close paren to
+ open paren.
+
+** New hook ada-prj-parse-hook, run from ada-parse-prj-file.
+
+** GPR mode now does case adjust similar to Ada mode.
+
+** gpr parser handles nested case statements without blowing up.
+
+** gpr parser handles package renames
+
+** fix other bugs
+
+* Ada mode 5.1.8
+10 Apr 2015
+
+** requires OpenToken 6.0
+
+** ada-align handle identifiers that start with Ada keywords
+
+** functions for ada-case-identifier now take three args: start, end,
+ force-case
+
+** parsing is not required by find-other-file if the current buffer is
+ larger than wisi-size-threshold
+
+** fix misc bugs
+
* Ada mode 5.1.7
18 Nov 2014
diff --git a/packages/ada-mode/README b/packages/ada-mode/README
index af4f89e..df7a48c 100644
--- a/packages/ada-mode/README
+++ b/packages/ada-mode/README
@@ -1,4 +1,4 @@
-Emacs Ada mode version 5.1.7
+Emacs Ada mode version 5.1.9
Ada mode requires Emacs 24.2 or greater
@@ -22,7 +22,7 @@ Unzip to a convenient place (we will use ~/ada-mode in the
following).
In a shell:
$ cd ~/ada-mode/build/wisi
-$ byte-compile
+$ make byte-compile
Edit your ~/.emacs, add:
diff --git a/packages/ada-mode/ada-build.el b/packages/ada-mode/ada-build.el
index 6166836..0553454 100644
--- a/packages/ada-mode/ada-build.el
+++ b/packages/ada-mode/ada-build.el
@@ -1,7 +1,7 @@
-;;; ada-build.el --- extensions to ada-mode for compiling and running
-;;; Ada projects without 'make' or similar tool
+;; ada-build.el --- Extensions to ada-mode for compiling and running -*-
lexical-binding:t -*-
+;; Ada projects without 'make' or similar tool
;;
-;;; Copyright (C) 1994, 1995, 1997 - 2014 Free Software Foundation, Inc.
+;; Copyright (C) 1994, 1995, 1997 - 2015 Free Software Foundation, Inc.
;;
;; Author: Stephen Leake <address@hidden>
;; Maintainer: Stephen Leake <address@hidden>
@@ -34,9 +34,7 @@
;; compiling and running capabilities in Ada mode 4.01, done in 2013 by
;; Stephen Leake <address@hidden>.
-(when (and (= emacs-major-version 24)
- (= emacs-minor-version 2))
- (require 'ada-mode-compat-24.2))
+(require 'ada-mode-compat-24.2)
(require 'ada-mode)
@@ -52,35 +50,33 @@
(const prompt-default)
(const prompt-exist)
(const error))
- :group 'ada-build
- :safe 'symbolp)
+ :safe #'symbolp)
(defcustom ada-build-confirm-command nil
"If non-nil, prompt for confirmation/edit of each command before it is run."
:type 'boolean
- :group 'ada-build
- :safe 'booleanp)
+ :safe #'booleanp)
(defcustom ada-build-check-cmd
(concat "${cross_prefix}gnatmake -u -c -gnatc ${gnatmake_opt}
${full_current} -cargs -I${src_dir} ${comp_opt}")
"Default command to syntax check a single file.
Overridden by project variable 'check_cmd'."
- :type 'string
- :group 'ada-build)
+ :type 'string)
(defcustom ada-build-make-cmd
(concat "${cross_prefix}gnatmake -P${gpr_file} -o ${main} ${main}
${gnatmake_opt} "
"-cargs -I${src_dir} ${comp_opt} -bargs ${bind_opt} -largs
${link_opt}")
"Default command to compile the application.
Overridden by project variable 'make_cmd'."
- :type 'string
- :group 'ada-build)
+ :type 'string)
+;; FIXME: make this more intelligent to work on Windows cmd shell?
+;; either detect Windows and drop "./", or expand to full path at
+;; runtime.
(defcustom ada-build-run-cmd "./${main}"
"Default command to run the application, in a spawned shell.
Overridden by project variable 'run_cmd'."
- :type 'string
- :group 'ada-build)
+ :type 'string)
;;;; code
@@ -95,8 +91,8 @@ a list, the prefix is prepended to each list element. For
example, if src_dir contains 'dir_1 dir_2', '-I${src_dir}'
expands to '-Idir_1 -Idir_2'.
-As a special case, ${full_current} is replaced by the name
-including the directory and extension."
+As a special case, ${full_current} is replaced by the current
+buffer file name including the directory and extension."
(while (string-match "\\(-[^-$ ]+\\)?\\${\\([^}]+\\)}" cmd-string)
(let ((prefix (match-string 1 cmd-string))
diff --git a/packages/ada-mode/ada-fix-error.el
b/packages/ada-mode/ada-fix-error.el
index 33d202f..6ec0fd7 100644
--- a/packages/ada-mode/ada-fix-error.el
+++ b/packages/ada-mode/ada-fix-error.el
@@ -1,7 +1,7 @@
-;;; ada-fix-error.el --- utilities for automatically fixing
+;;; ada-fix-error.el --- utilities for automatically fixing -*-
lexical-binding:t -*-
;; errors reported by the compiler.
-;; Copyright (C) 1999-2009, 2012-2014 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2009, 2012-2015 Free Software Foundation, Inc.
;; Author : Stephen Leake <address@hidden>
;; Maintainer : Stephen Leake <address@hidden>
@@ -63,6 +63,57 @@ compilation unit.")
(ada-case-adjust-identifier)
(delete-char 1)))
+(defun ada-fix-sort-context-pred (a b)
+ "Predicate for `sort-subr'; sorts \"limited with\", \"private with\" last.
+Returns non-nil if a should preceed b in buffer."
+ ;; a, b are buffer ranges in the current buffer
+ (cl-flet
+ ((starts-with
+ (pat reg)
+ (string= pat (buffer-substring-no-properties (car reg)
+ (min (point-max)
+ (+(car reg) (length
pat)))))))
+ (cond
+ ((and
+ (starts-with "limited with" a)
+ (starts-with "private with" b))
+ t)
+
+ ((and
+ (starts-with "limited with" a)
+ (not (starts-with "limited with" b)))
+ nil)
+
+ ((and
+ (not (starts-with "limited with" a))
+ (starts-with "limited with" b))
+ t)
+
+ ((and
+ (starts-with "private with" a)
+ (not (starts-with "private with" b)))
+ nil)
+
+ ((and
+ (not (starts-with "private with" a))
+ (starts-with "private with" b))
+ t)
+
+ (t
+ (> 0 (compare-buffer-substrings
+ nil (car a) (cdr a)
+ nil (car b) (cdr b))) )
+ )))
+
+(defun ada-fix-sort-context-clause (beg end)
+ "Sort context clauses in range BEG END."
+ (save-excursion
+ (save-restriction
+ (narrow-to-region beg end)
+ (goto-char (point-min))
+ (sort-subr nil 'forward-line 'end-of-line nil nil
'ada-fix-sort-context-pred)
+ )))
+
(defun ada-fix-add-with-clause (package-name)
"Add a with_clause for PACKAGE_NAME.
If ada-fix-sort-context-clause, sort the context clauses using
@@ -78,8 +129,7 @@ sort-lines."
(when (and (< (car context-clause) (cdr context-clause))
ada-fix-sort-context-clause)
- ;; FIXME (later): this puts "limited with", "private with" at top of
list; prefer at bottom
- (sort-lines nil (car context-clause) (point)))
+ (ada-fix-sort-context-clause (car context-clause) (point)))
))
(defun ada-fix-extend-with-clause (child-name)
@@ -142,11 +192,8 @@ fixed, leaving point at fix. Otherwise, they should
preserve
point and return nil.")
(defun ada-get-compilation-message ()
- "Get compilation message at point.
-Compatible with Emacs 23.4 and 24.x."
- (cl-case emacs-major-version
- (23 (get-text-property (line-beginning-position) 'message))
- (24 (get-text-property (line-beginning-position) 'compilation-message))))
+ "Get compilation message at line beginning."
+ (get-text-property (line-beginning-position) 'compilation-message))
(defun ada-fix-compiler-error ()
"Attempt to fix the current compiler error. Leave point at fixed code."
@@ -158,7 +205,9 @@ Compatible with Emacs 23.4 and 24.x."
(with-current-buffer compilation-last-buffer
(when (not (ada-get-compilation-message))
- ;; not clear why this can happens, but it does
+ (beep)
+ (message "FIXME: ada-fix-compiler-error")
+ ;; not clear why this can happen, but it has
(compilation-next-error 1))
(let ((comp-buf-pt (point))
(success
diff --git a/packages/ada-mode/ada-gnat-compile.el
b/packages/ada-mode/ada-gnat-compile.el
index 510bef1..ee4b12a 100644
--- a/packages/ada-mode/ada-gnat-compile.el
+++ b/packages/ada-mode/ada-gnat-compile.el
@@ -1,12 +1,12 @@
-;; Ada mode compiling functionality provided by the 'gnat'
-;; tool.
+;; ada-gnat-compile.el --- Ada mode compiling functionality provided by 'gnat'
-*- lexical-binding:t -*-
+;; Includes related functions, such as gnatprep support.
;;
;; These tools are all Ada-specific; use Makefiles for multi-language
;; GNAT compilation tools.
;;
;; GNAT is provided by AdaCore; see http://libre.adacore.com/
;;
-;;; Copyright (C) 2012 - 2014 Free Software Foundation, Inc.
+;;; Copyright (C) 2012 - 2015 Free Software Foundation, Inc.
;;
;; Author: Stephen Leake <address@hidden>
;; Maintainer: Stephen Leake <address@hidden>
@@ -165,7 +165,7 @@ Prompt user if more than one."
(completing-read "correct spelling: " choices))
)))
-(defun ada-gnat-fix-error (msg source-buffer source-window)
+(defun ada-gnat-fix-error (_msg source-buffer _source-window)
"For `ada-gnat-fix-error-hook'."
(let ((start-pos (point))
message-column
@@ -192,8 +192,7 @@ Prompt user if more than one."
;; Then style errors.
((looking-at (concat ada-gnat-quoted-name-regexp " is not visible"))
- (let ((ident (match-string 1))
- (done nil)
+ (let ((done nil)
(file-line-struct (progn (beginning-of-line)
(ada-get-compilation-message)))
pos choices unit-name)
;; next line may contain a reference to where ident is
@@ -348,24 +347,23 @@ Prompt user if more than one."
t)))
((looking-at (concat "expected \\(private \\)?type "
ada-gnat-quoted-name-regexp))
- (let ((type (match-string 2)))
- (forward-line 1)
- (move-to-column message-column)
- (cond
- ((looking-at "found type access")
- (pop-to-buffer source-buffer)
- (if (looking-at "'Access")
- (kill-word 1)
- (forward-word 1)
- (insert ".all"))
- t)
- ((looking-at "found type .*_Access_Type")
- ;; assume just need '.all'
- (pop-to-buffer source-buffer)
+ (forward-line 1)
+ (move-to-column message-column)
+ (cond
+ ((looking-at "found type access")
+ (pop-to-buffer source-buffer)
+ (if (looking-at "'Access")
+ (kill-word 1)
(forward-word 1)
- (insert ".all")
- t)
- )))
+ (insert ".all"))
+ t)
+ ((looking-at "found type .*_Access_Type")
+ ;; assume just need '.all'
+ (pop-to-buffer source-buffer)
+ (forward-word 1)
+ (insert ".all")
+ t)
+ ))
((looking-at "extra \".\" ignored")
(set-buffer source-buffer)
@@ -382,7 +380,9 @@ Prompt user if more than one."
;; also 'possible missing "with Ada.Text_IO; use Ada.Text_IO"' -
ignoring the 'use'
(let ((package-name (match-string-no-properties 1)))
(pop-to-buffer source-buffer)
- ;; FIXME (later): should check if prefix is already with'd, extend
it
+ ;; Could check if prefix is already with'd, extend
+ ;; it. But no one has reported that case yet; this
+ ;; message only occurs for predefined Ada packages.
(ada-fix-add-with-clause package-name))
t)
@@ -470,8 +470,7 @@ Prompt user if more than one."
t)
((looking-at (concat "warning: formal parameter "
ada-gnat-quoted-name-regexp " is not modified"))
- (let ((param (match-string 1))
- (mode-regexp "\"\\([in out]+\\)\"")
+ (let ((mode-regexp "\"\\([in out]+\\)\"")
new-mode
old-mode)
(forward-line 1)
@@ -581,13 +580,20 @@ Prompt user if more than one."
(defun ada-gnat-compile-select-prj ()
(setq ada-fix-error-hook 'ada-gnat-fix-error-hook)
- (setq ada-prj-show-path 'gnat-prj-show-path)
+ (setq ada-prj-show-prj-path 'gnat-prj-show-prj-path)
(add-to-list 'completion-ignored-extensions ".ali") ;; gnat library files
(add-hook 'ada-syntax-propertize-hook 'ada-gnat-syntax-propertize)
+ (add-hook 'ada-syntax-propertize-hook 'gnatprep-syntax-propertize)
+ ;; There is no common convention for a file extension for gnatprep files.
+ ;;
;; find error locations in .gpr files
(setq compilation-search-path (append compilation-search-path (ada-prj-get
'prj_dir)))
+ ;; must be after indentation engine setup, because that resets the
+ ;; indent function list.
+ (add-hook 'ada-mode-hook 'gnatprep-setup t)
+
(add-hook 'compilation-filter-hook 'ada-gnat-compilation-filter)
;; ada-mode.el project file parser sets this to other compilers used
@@ -598,10 +604,13 @@ Prompt user if more than one."
(defun ada-gnat-compile-deselect-prj ()
(setq ada-fix-error-hook nil)
(setq completion-ignored-extensions (delete ".ali"
completion-ignored-extensions))
+ (setq ada-syntax-propertize-hook (delq 'gnatprep-syntax-propertize
ada-syntax-propertize-hook))
(setq ada-syntax-propertize-hook (delq 'ada-gnat-syntax-propertize
ada-syntax-propertize-hook))
;; don't need to delete from compilation-search-path; completely rewritten
in ada-select-prj-file
+ (setq ada-mode-hook (delq 'gnatprep-setup ada-mode-hook))
+
(setq compilation-filter-hook (delete 'ada-gnat-compilation-filter
compilation-filter-hook))
(setq compilation-error-regexp-alist (delete 'gnat
compilation-error-regexp-alist))
)
@@ -616,6 +625,10 @@ Prompt user if more than one."
(add-to-list 'ada-prj-parse-one-compiler (cons 'gnat
'gnat-prj-parse-emacs-one))
(add-to-list 'ada-prj-parse-final-compiler (cons 'gnat
'gnat-prj-parse-emacs-final))
+ (font-lock-add-keywords 'ada-mode
+ ;; gnatprep preprocessor line
+ (list (list "^[ \t]*\\(#.*\n\\)" '(1 font-lock-preprocessor-face t))))
+
(add-hook 'ada-gnat-fix-error-hook 'ada-gnat-fix-error))
(provide 'ada-gnat-compile)
@@ -637,7 +650,7 @@ Prompt user if more than one."
;; foo.c:2 : `TRUE' undeclared here (not in a function)
"^\\(\\(.:\\)?[^ :\n]+\\):\\([0-9]+\\)\\s-?:?\\([0-9]+\\)?" 1 3 4))
-(unless (default-value ada-compiler)
+(unless (default-value 'ada-compiler)
(set-default 'ada-compiler 'gnat))
;; end of file
diff --git a/packages/ada-mode/ada-gnat-xref.el
b/packages/ada-mode/ada-gnat-xref.el
index 76d7f19..53553b3 100644
--- a/packages/ada-mode/ada-gnat-xref.el
+++ b/packages/ada-mode/ada-gnat-xref.el
@@ -1,12 +1,11 @@
-;; Ada mode cross-reference functionality provided by the 'gnat xref'
-;; tool. Includes related functions, such as gnatprep support.
+;;; ada-gnat-xref.el --- Ada mode cross-reference functionality provided by
'gnat xref' -*- lexical-binding:t -*-
;;
;; These tools are all Ada-specific; see gpr-query for multi-language
;; GNAT cross-reference tools.
;;
;; GNAT is provided by AdaCore; see http://libre.adacore.com/
;;
-;;; Copyright (C) 2012 - 2014 Free Software Foundation, Inc.
+;;; Copyright (C) 2012 - 2015 Free Software Foundation, Inc.
;;
;; Author: Stephen Leake <address@hidden>
;; Maintainer: Stephen Leake <address@hidden>
@@ -57,7 +56,6 @@
(switches (concat
"-a"
(when (ada-prj-get 'gpr_ext) (concat "--ext=" (ada-prj-get
'gpr_ext)))))
- status
(result nil))
(with-current-buffer (gnat-run-buffer)
(gnat-run-gnat "find" (list switches arg))
@@ -121,18 +119,14 @@
;; error in *.gpr; ignore here.
(forward-line 1)
;; else process line
- (let ((found-file (match-string 1))
- (found-line (string-to-number (match-string 2)))
- (found-col (string-to-number (match-string 3))))
-
- (skip-syntax-forward "^ ")
- (skip-syntax-forward " ")
- (if (looking-at (concat "derived from .* ("
ada-gnat-file-line-col-regexp ")"))
- ;; found other item
- (setq result (list (match-string 1)
- (string-to-number (match-string 2))
- (1- (string-to-number (match-string 3)))))
- (forward-line 1)))
+ (skip-syntax-forward "^ ")
+ (skip-syntax-forward " ")
+ (if (looking-at (concat "derived from .* ("
ada-gnat-file-line-col-regexp ")"))
+ ;; found other item
+ (setq result (list (match-string 1)
+ (string-to-number (match-string 2))
+ (1- (string-to-number (match-string 3)))))
+ (forward-line 1))
)
(when (eobp)
(error "gnat find did not return parent types"))
@@ -164,7 +158,7 @@
(compilation-start cmd
'compilation-mode
- (lambda (mode-name) (concat mode-name "-gnatfind")))
+ (lambda (name) (concat name "-gnatfind")))
))))
;;;;; setup
@@ -174,12 +168,6 @@
(setq ada-ada-name-from-file-name 'ada-gnat-ada-name-from-file-name)
(setq ada-make-package-body 'ada-gnat-make-package-body)
- (add-hook 'ada-syntax-propertize-hook 'gnatprep-syntax-propertize)
-
- ;; must be after indentation engine setup, because that resets the
- ;; indent function list.
- (add-hook 'ada-mode-hook 'ada-gnat-xref-setup t)
-
(setq ada-xref-other-function 'ada-gnat-xref-other)
(setq ada-xref-parent-function 'ada-gnat-xref-parents)
(setq ada-xref-all-function 'ada-gnat-xref-all)
@@ -187,8 +175,6 @@
;; gnatmake -gnatD generates files with .dg extensions. But we don't
;; need to navigate between them.
- ;;
- ;; There is no common convention for a file extension for gnatprep files.
(add-to-list 'completion-ignored-extensions ".ali") ;; gnat library files,
used for cross reference
(add-to-list 'compilation-error-regexp-alist 'gnat)
@@ -199,9 +185,6 @@
(setq ada-ada-name-from-file-name nil)
(setq ada-make-package-body nil)
- (setq ada-syntax-propertize-hook (delq 'gnatprep-syntax-propertize
ada-syntax-propertize-hook))
- (setq ada-mode-hook (delq 'ada-gnat-xref-setup ada-mode-hook))
-
(setq ada-xref-other-function nil)
(setq ada-xref-parent-function nil)
(setq ada-xref-all-function nil)
@@ -211,11 +194,6 @@
(setq compilation-error-regexp-alist (delete 'gnat
compilation-error-regexp-alist))
)
-(defun ada-gnat-xref-setup ()
- (when (boundp 'wisi-indent-calculate-functions)
- (add-to-list 'wisi-indent-calculate-functions 'gnatprep-indent))
- )
-
(defun ada-gnat-xref ()
"Set Ada mode global vars to use 'gnat xref'"
(add-to-list 'ada-prj-file-ext-extra "gpr")
@@ -225,10 +203,6 @@
;; no parse-*-xref yet
- (font-lock-add-keywords 'ada-mode
- ;; gnatprep preprocessor line
- (list (list "^[ \t]*\\(#.*\n\\)" '(1 font-lock-preprocessor-face t))))
-
(add-hook 'ada-gnat-fix-error-hook 'ada-gnat-fix-error))
(ada-gnat-xref)
diff --git a/packages/ada-mode/ada-grammar-wy.el
b/packages/ada-mode/ada-grammar-wy.el
index c3be4ce..10cd525 100644
--- a/packages/ada-mode/ada-grammar-wy.el
+++ b/packages/ada-mode/ada-grammar-wy.el
@@ -1,6 +1,6 @@
-;;; ada-grammar-wy.el --- Generated parser support file
+;;; ada-grammar-wy.el --- Generated parser support file -*- lexical-binding:t
-*-
-;; Copyright (C) 2013 Free Software Foundation, Inc.
+;; Copyright (C) 2013 - 2015 Free Software Foundation, Inc.
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
@@ -197,11 +197,15 @@
(progn
(wisi-statement-action [4 name-paren])
(wisi-containing-action 4 5)
- (wisi-motion-action [4 [5 return-1 RETURN return-2 RETURN]]))))
+ (wisi-motion-action [4 [5 return-with-params RETURN
return-without-params RETURN]]))))
(actual_parameter_part
((LEFT_PAREN association_list RIGHT_PAREN )
(progn
(wisi-statement-action [1 open-paren 3 close-paren])
+ (wisi-containing-action 1 2)))
+ ((LEFT_PAREN conditional_quantified_expression RIGHT_PAREN )
+ (progn
+ (wisi-statement-action [1 open-paren 3 close-paren])
(wisi-containing-action 1 2))))
(actual_parameter_part_opt
(())
@@ -217,11 +221,7 @@
(wisi-containing-action 1 2)
(wisi-containing-action 1 3)
(wisi-containing-action 3 4)))
- ((LEFT_PAREN case_expression RIGHT_PAREN )
- (progn
- (wisi-statement-action [1 open-paren 3 close-paren])
- (wisi-containing-action 1 2)))
- ((LEFT_PAREN if_expression RIGHT_PAREN )
+ ((LEFT_PAREN conditional_quantified_expression RIGHT_PAREN )
(progn
(wisi-statement-action [1 open-paren 3 close-paren])
(wisi-containing-action 1 2)))
@@ -340,6 +340,7 @@
((WHEN discrete_choice_list EQUAL_GREATER expression )
(progn
(wisi-statement-action [1 block-middle 3 statement-other])
+ (wisi-containing-action 1 3)
(wisi-containing-action 3 4))))
(case_expression_alternative_list
((case_expression_alternative ))
@@ -359,6 +360,7 @@
(progn
(wisi-statement-action [1 block-middle 3 statement-other])
(wisi-containing-action 1 2)
+ (wisi-containing-action 1 3)
(wisi-containing-action 3 4))))
(case_statement_alternative_list
((case_statement_alternative ))
@@ -449,6 +451,10 @@
(wisi-statement-action [1 block-start 3 block-middle 5 block-end 7
statement-end])
(wisi-containing-action 1 2)
(wisi-containing-action 3 4))))
+ (conditional_quantified_expression
+ ((if_expression ))
+ ((case_expression ))
+ ((quantified_expression )))
(constant_opt
(())
((CONSTANT )))
@@ -617,7 +623,8 @@
((FOR name USE aggregate SEMICOLON )
(progn
(wisi-statement-action [1 statement-start 3 statement-other 5
statement-end])
- (wisi-containing-action 3 4))))
+ (wisi-containing-action 3 4)
+ (wisi-face-action [2 font-lock-type-face]))))
(enumeration_type_definition
((LEFT_PAREN enumeration_literal_list RIGHT_PAREN )
(progn
@@ -637,11 +644,13 @@
(progn
(wisi-statement-action [1 block-middle 5 statement-other])
(wisi-containing-action 1 4)
+ (wisi-containing-action 1 5)
(wisi-containing-action 5 6)))
((WHEN exception_choice_list EQUAL_GREATER sequence_of_statements_opt )
(progn
(wisi-statement-action [1 block-middle 3 statement-other])
(wisi-containing-action 1 2)
+ (wisi-containing-action 1 3)
(wisi-containing-action 3 4))))
(exception_handler_list
((exception_handler ))
@@ -669,11 +678,14 @@
(expression_function_declaration
((overriding_indicator_opt function_specification IS paren_expression
aspect_specification_opt SEMICOLON )
(progn
- (wisi-statement-action [1 statement-start 2 statement-other 6
statement-end])
- (wisi-containing-action 2 4)
+ (wisi-statement-action [1 statement-start 2 block-middle 3
statement-other 6 statement-end])
+ (wisi-containing-action 3 4)
(wisi-containing-action 2 5))))
(extended_return_object_declaration
- ((IDENTIFIER COLON aliased_opt constant_opt return_subtype_indication
COLON_EQUAL expression ))
+ ((IDENTIFIER COLON aliased_opt constant_opt return_subtype_indication
COLON_EQUAL expression )
+ (progn
+ (wisi-statement-action [1 statement-start 6 statement-other])
+ (wisi-containing-action 6 7)))
((IDENTIFIER COLON aliased_opt constant_opt return_subtype_indication
)))
(extended_return_object_declaration_opt
(())
@@ -804,7 +816,7 @@
(wisi-statement-action [1 statement-other 2 name])
(wisi-containing-action 1 2)
(wisi-containing-action 1 3)
- (wisi-motion-action [1 [3 return-1 RETURN return-2 RETURN]])
+ (wisi-motion-action [1 [3 return-with-params RETURN
return-without-params RETURN]])
(wisi-face-action [2 font-lock-function-name-face]))))
(general_access_modifier_opt
(())
@@ -828,7 +840,8 @@
((formal_type_declaration ))
((formal_subprogram_declaration ))
((formal_package_declaration ))
- ((pragma )))
+ ((pragma ))
+ ((use_clause )))
(generic_instantiation
((PACKAGE name IS NEW name aspect_specification_opt SEMICOLON )
(progn
@@ -1065,13 +1078,12 @@
((IDENTIFIER )
(wisi-statement-action [1 name]))
((CHARACTER_LITERAL ))
- ((name LEFT_PAREN range RIGHT_PAREN )
+ ((name LEFT_PAREN range_list RIGHT_PAREN )
(progn
(wisi-statement-action [1 name-paren 2 open-paren 4 close-paren])
(wisi-containing-action 1 2)
(wisi-containing-action 2 3)))
- ((selected_component )
- (wisi-extend-action 1))
+ ((selected_component ))
((attribute_reference ))
((name actual_parameter_part )
(progn
@@ -1168,6 +1180,7 @@
(wisi-containing-action 3 4)
(wisi-containing-action 5 6)
(wisi-containing-action 7 8)
+ (wisi-containing-action 9 10)
(wisi-motion-action [1 5 7 [8 block-middle EXCEPTION block-middle
WHEN] 9])
(wisi-face-action [3 font-lock-function-name-face 10
font-lock-function-name-face])))
((PACKAGE BODY name aspect_specification_opt IS declarative_part_opt
END name_opt SEMICOLON )
@@ -1176,6 +1189,7 @@
(wisi-containing-action 1 3)
(wisi-containing-action 3 4)
(wisi-containing-action 5 6)
+ (wisi-containing-action 7 8)
(wisi-motion-action [1 5 7])
(wisi-face-action [3 font-lock-function-name-face 8
font-lock-function-name-face]))))
(package_body_stub
@@ -1205,7 +1219,7 @@
(wisi-containing-action 6 7)
(wisi-motion-action [1 4 6 8])
(wisi-face-action [2 font-lock-function-name-face 9
font-lock-function-name-face])))
- ((PACKAGE name aspect_specification_opt IS declarative_part_opt END
name )
+ ((PACKAGE name aspect_specification_opt IS declarative_part_opt END
name_opt )
(progn
(wisi-statement-action [1 statement-start 2 name 4 block-start 6
block-end])
(wisi-containing-action 1 2)
@@ -1216,20 +1230,20 @@
(parameter_and_result_profile
((formal_part RETURN null_exclusion_opt name_opt )
(progn
- (wisi-statement-action [2 return-1])
+ (wisi-statement-action [2 return-with-params])
(wisi-containing-action 2 4)
(wisi-face-action [4 font-lock-type-face])))
- ((RETURN name_opt )
+ ((RETURN null_exclusion_opt name_opt )
(progn
- (wisi-statement-action [1 return-2])
- (wisi-face-action [2 font-lock-type-face])))
+ (wisi-statement-action [1 return-without-params])
+ (wisi-face-action [3 font-lock-type-face])))
((formal_part RETURN access_definition )
(progn
- (wisi-statement-action [2 return-1])
+ (wisi-statement-action [2 return-with-params])
(wisi-containing-action 2 3)))
((RETURN access_definition )
(progn
- (wisi-statement-action [1 return-2])
+ (wisi-statement-action [1 return-without-params])
(wisi-containing-action 1 2))))
(parameter_profile_opt
(())
@@ -1252,11 +1266,7 @@
(progn
(wisi-statement-action [1 open-paren 3 close-paren])
(wisi-containing-action 1 2)))
- ((LEFT_PAREN case_expression RIGHT_PAREN )
- (progn
- (wisi-statement-action [1 open-paren 3 close-paren])
- (wisi-containing-action 1 2)))
- ((LEFT_PAREN if_expression RIGHT_PAREN )
+ ((LEFT_PAREN conditional_quantified_expression RIGHT_PAREN )
(progn
(wisi-statement-action [1 open-paren 3 close-paren])
(wisi-containing-action 1 2))))
@@ -1273,6 +1283,7 @@
(pragma_argument_association
((IDENTIFIER EQUAL_GREATER expression ))
((expression ))
+ ((conditional_quantified_expression ))
((IDENTIFIER TICK IDENTIFIER EQUAL_GREATER expression )))
(pragma_argument_association_list
((pragma_argument_association ))
@@ -1284,33 +1295,22 @@
((aggregate ))
((name ))
((NEW name )
- (wisi-face-action [2 font-lock-type-face] t))
- ((LEFT_PAREN if_expression RIGHT_PAREN )
- (progn
- (wisi-statement-action [1 open-paren 3 close-paren])
- (wisi-containing-action 1 2)))
- ((LEFT_PAREN case_expression RIGHT_PAREN )
- (progn
- (wisi-statement-action [1 open-paren 3 close-paren])
- (wisi-containing-action 1 2)))
- ((LEFT_PAREN quantified_expression RIGHT_PAREN )
- (progn
- (wisi-statement-action [1 open-paren 3 close-paren])
- (wisi-containing-action 1 2))))
+ (wisi-face-action [2 font-lock-type-face] t)))
(private_extension_declaration
((TYPE IDENTIFIER discriminant_part_opt IS
abstract_limited_synchronized_opt NEW subtype_indication and_interface_list_opt
WITH PRIVATE aspect_specification_opt SEMICOLON )
(progn
- (wisi-statement-action [1 statement-start 2 name 6 statement-other 12
statement-end])
+ (wisi-statement-action [1 statement-start 2 name 4 statement-other 6
statement-other 12 statement-end])
(wisi-containing-action 1 3)
(wisi-containing-action 6 7)
(wisi-containing-action 6 8)
- (wisi-containing-action 2 11)
+ (wisi-containing-action 4 11)
(wisi-face-action [2 font-lock-type-face]))))
(private_type_declaration
((TYPE IDENTIFIER discriminant_part_opt IS abstract_tagged_limited_opt
PRIVATE aspect_specification_opt SEMICOLON )
(progn
- (wisi-statement-action [1 statement-start 2 name 8 statement-end])
- (wisi-containing-action 1 7)
+ (wisi-statement-action [1 statement-start 2 name 4 statement-other 8
statement-end])
+ (wisi-containing-action 1 3)
+ (wisi-containing-action 4 7)
(wisi-face-action [2 font-lock-type-face]))))
(procedure_call_statement
((name SEMICOLON )
@@ -1357,6 +1357,8 @@
((subprogram_declaration ))
((subprogram_body ))
((entry_body ))
+ ((expression_function_declaration ))
+ ((null_procedure_declaration ))
((aspect_clause )))
(protected_operation_item_list
((protected_operation_item ))
@@ -1370,15 +1372,15 @@
(protected_type_declaration
((PROTECTED TYPE IDENTIFIER discriminant_part_opt
aspect_specification_opt IS NEW interface_list WITH protected_definition
SEMICOLON )
(progn
- (wisi-statement-action [1 statement-start 3 name 6 block-start 11
statement-end])
- (wisi-containing-action 1 3)
+ (wisi-statement-action [1 statement-start 3 name 6 block-middle 9
block-middle 11 statement-end])
+ (wisi-containing-action 1 4)
(wisi-containing-action 3 5)
- (wisi-containing-action 9 10)
+ (wisi-containing-action 6 10)
(wisi-face-action [3 font-lock-type-face])))
((PROTECTED TYPE IDENTIFIER discriminant_part_opt
aspect_specification_opt IS protected_definition SEMICOLON )
(progn
- (wisi-statement-action [1 statement-start 3 name 6 block-start 8
statement-end])
- (wisi-containing-action 1 3)
+ (wisi-statement-action [1 statement-start 3 name 6 block-middle 8
statement-end])
+ (wisi-containing-action 1 4)
(wisi-containing-action 3 5)
(wisi-containing-action 6 7)
(wisi-face-action [3 font-lock-type-face]))))
@@ -1415,6 +1417,12 @@
(wisi-containing-action 4 5)))
((name TICK RANGE ))
((simple_expression DOT_DOT simple_expression )))
+ (range_list
+ ((range ))
+ ((range_list COMMA range )
+ (progn
+ (wisi-statement-action [2 list-break])
+ (wisi-containing-action 2 3))))
(real_range_specification_opt
(())
((RANGE simple_expression DOT_DOT simple_expression )))
@@ -1428,7 +1436,8 @@
((FOR name USE record_rep SEMICOLON )
(progn
(wisi-statement-action [1 statement-start 3 statement-other 5
statement-end])
- (wisi-containing-action 3 4))))
+ (wisi-containing-action 3 4)
+ (wisi-face-action [2 font-lock-type-face]))))
(record_rep
((RECORD mod_clause_opt component_clause_list END RECORD )
(progn
@@ -1482,7 +1491,8 @@
((subtype_indication ))
((access_definition )))
(selected_component
- ((name DOT IDENTIFIER ))
+ ((name DOT IDENTIFIER )
+ (wisi-extend-action 1 3))
((name DOT CHARACTER_LITERAL ))
((name DOT STRING_LITERAL ))
((name DOT ALL )))
@@ -1503,6 +1513,7 @@
(progn
(wisi-statement-action [1 block-start 3 statement-other])
(wisi-containing-action 1 2)
+ (wisi-containing-action 1 3)
(wisi-containing-action 3 4)
(wisi-containing-action 3 5)))
((accept_statement sequence_of_statements_opt ))
@@ -1510,12 +1521,14 @@
(progn
(wisi-statement-action [1 block-start 3 statement-other])
(wisi-containing-action 1 2)
+ (wisi-containing-action 1 3)
(wisi-containing-action 3 4)))
((delay_alternative ))
((WHEN expression EQUAL_GREATER TERMINATE SEMICOLON )
(progn
(wisi-statement-action [1 block-start 3 statement-other 4
statement-start 5 statement-end])
- (wisi-containing-action 1 2)))
+ (wisi-containing-action 1 2)
+ (wisi-containing-action 1 3)))
((TERMINATE SEMICOLON )
(wisi-statement-action [1 statement-start 2 statement-end])))
(select_alternative_list
@@ -1566,14 +1579,15 @@
(single_protected_declaration
((PROTECTED IDENTIFIER aspect_specification_opt IS NEW interface_list
WITH protected_definition SEMICOLON )
(progn
- (wisi-statement-action [1 block-start 2 name 7 block-middle 9
statement-end])
+ (wisi-statement-action [1 statement-start 2 name 4 block-middle 7
block-middle 9 statement-end])
(wisi-containing-action 1 2)
(wisi-containing-action 2 3)
+ (wisi-containing-action 4 6)
(wisi-containing-action 7 8)
(wisi-face-action [2 font-lock-type-face])))
((PROTECTED IDENTIFIER aspect_specification_opt IS protected_definition
SEMICOLON )
(progn
- (wisi-statement-action [1 block-start 2 name 4 block-middle 6
statement-end])
+ (wisi-statement-action [1 statement-start 2 name 4 block-middle 6
statement-end])
(wisi-containing-action 1 2)
(wisi-containing-action 2 3)
(wisi-containing-action 4 5)
@@ -1581,21 +1595,22 @@
(single_task_declaration
((TASK IDENTIFIER aspect_specification_opt IS NEW interface_list WITH
task_definition SEMICOLON )
(progn
- (wisi-statement-action [1 block-start 2 name 7 block-middle 9
statement-end])
+ (wisi-statement-action [1 statement-start 2 name 4 block-middle 7
block-middle 9 statement-end])
(wisi-containing-action 1 2)
(wisi-containing-action 2 3)
+ (wisi-containing-action 4 6)
(wisi-containing-action 7 8)
(wisi-face-action [2 font-lock-type-face])))
((TASK IDENTIFIER aspect_specification_opt IS task_definition SEMICOLON
)
(progn
- (wisi-statement-action [1 block-start 2 name 4 block-middle 6
statement-end])
+ (wisi-statement-action [1 statement-start 2 name 4 block-middle 6
statement-end])
(wisi-containing-action 1 2)
(wisi-containing-action 2 3)
(wisi-containing-action 4 5)
(wisi-face-action [2 font-lock-type-face])))
((TASK IDENTIFIER aspect_specification_opt SEMICOLON )
(progn
- (wisi-statement-action [1 statement-start 4 statement-end])
+ (wisi-statement-action [1 statement-start 2 name 4 statement-end])
(wisi-containing-action 1 2)
(wisi-containing-action 2 3)
(wisi-face-action [2 font-lock-type-face]))))
@@ -1693,19 +1708,22 @@
(task_type_declaration
((TASK TYPE IDENTIFIER discriminant_part_opt aspect_specification_opt
IS NEW interface_list WITH task_definition SEMICOLON )
(progn
- (wisi-statement-action [1 statement-start 3 name 10 statement-other 11
statement-end])
+ (wisi-statement-action [1 statement-start 3 name 6 block-middle 9
block-middle 11 statement-end])
+ (wisi-containing-action 1 4)
(wisi-containing-action 3 5)
- (wisi-containing-action 9 10)
- (wisi-face-action [2 font-lock-type-face])))
+ (wisi-containing-action 6 10)
+ (wisi-face-action [3 font-lock-type-face])))
((TASK TYPE IDENTIFIER discriminant_part_opt aspect_specification_opt
IS task_definition SEMICOLON )
(progn
- (wisi-statement-action [1 statement-start 3 name 6 block-start 8
statement-end])
+ (wisi-statement-action [1 statement-start 3 name 6 block-middle 8
statement-end])
+ (wisi-containing-action 1 4)
(wisi-containing-action 3 5)
(wisi-containing-action 6 7)
(wisi-face-action [3 font-lock-type-face])))
((TASK TYPE IDENTIFIER discriminant_part_opt aspect_specification_opt
SEMICOLON )
(progn
(wisi-statement-action [1 statement-start 3 name 6 statement-end])
+ (wisi-containing-action 1 4)
(wisi-containing-action 3 5)
(wisi-face-action [3 font-lock-type-face]))))
(term
@@ -1754,6 +1772,7 @@
(progn
(wisi-statement-action [1 block-middle 3 statement-other])
(wisi-containing-action 1 2)
+ (wisi-containing-action 1 3)
(wisi-containing-action 3 4))))
(unary_adding_operator
((PLUS ))
@@ -1797,7 +1816,7 @@
(wisi-face-list-action [2 font-lock-function-name-face])))))
[((default . error) (SEPARATE . 10) (USE . 11) (LIMITED . 3) (PRIVATE
. 8) (WITH . 12) (PRAGMA . 7) (NOT . 4) (OVERRIDING . 5) (FUNCTION .
(overriding_indicator_opt . 2)) (PROCEDURE . (overriding_indicator_opt . 2))
(PACKAGE . 6) (GENERIC . 2))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
- ((default . error) (FUNCTION . ( 73 (generic_formal_part . 1)))
(PROCEDURE . ( 75 (generic_formal_part . 1))) (PACKAGE . ( 74
(generic_formal_part . 1))) (PRAGMA . 7) (WITH . 77) (TYPE . 76) (IDENTIFIER
. 72))
+ ((default . error) (FUNCTION . ( 72 (generic_formal_part . 1)))
(PROCEDURE . ( 74 (generic_formal_part . 1))) (PACKAGE . ( 73
(generic_formal_part . 1))) (USE . 11) (PRAGMA . 7) (WITH . 76) (TYPE . 75)
(IDENTIFIER . 77))
((default . error) (WITH . 71) (PRIVATE . 70))
((default . error) (OVERRIDING . 69))
((default . error) (FUNCTION . (overriding_indicator_opt . 1))
(PROCEDURE . (overriding_indicator_opt . 1)) (ENTRY . (overriding_indicator_opt
. 1)))
@@ -1811,13 +1830,13 @@
((default . error) ($EOI . (compilation_unit_list . 0)) (FUNCTION .
(compilation_unit_list . 0)) (GENERIC . (compilation_unit_list . 0)) (LIMITED .
(compilation_unit_list . 0)) (NOT . (compilation_unit_list . 0)) (OVERRIDING .
(compilation_unit_list . 0)) (PACKAGE . (compilation_unit_list . 0)) (PRAGMA .
(compilation_unit_list . 0)) (PRIVATE . (compilation_unit_list . 0)) (PROCEDURE
. (compilation_unit_list . 0)) (SEPARATE . (compilation_unit_list . 0)) (USE .
(compilation_unit_lis [...]
((default . error) ($EOI . 46) (SEPARATE . 10) (USE . 11) (LIMITED .
3) (PRIVATE . 8) (WITH . 12) (PRAGMA . 7) (NOT . 4) (OVERRIDING . 5)
(FUNCTION . (overriding_indicator_opt . 2)) (PROCEDURE .
(overriding_indicator_opt . 2)) (PACKAGE . 6) (GENERIC . 2))
((default . error) (WITH . (compilation_unit . 0)) (USE .
(compilation_unit . 0)) (SEPARATE . (compilation_unit . 0)) (PROCEDURE .
(compilation_unit . 0)) (PRIVATE . (compilation_unit . 0)) (PRAGMA .
(compilation_unit . 0)) (PACKAGE . (compilation_unit . 0)) (OVERRIDING .
(compilation_unit . 0)) (NOT . (compilation_unit . 0)) (LIMITED .
(compilation_unit . 0)) (GENERIC . (compilation_unit . 0)) (FUNCTION .
(compilation_unit . 0)) ($EOI . (compilation_unit . 0)))
- ((default . error) (RENAMES . (subprogram_specification . 1)) (IS .
(subprogram_specification . 1)) (WITH . (subprogram_specification . 1))
(SEMICOLON . (subprogram_specification . 1)))
+ ((default . error) (RENAMES . (subprogram_specification . 1)) (SEMICOLON
. (subprogram_specification . 1)) (WITH . (subprogram_specification . 1)) (IS .
(subprogram_specification . 1)))
((default . error) (WITH . (library_unit_declaration . 2)) (USE .
(library_unit_declaration . 2)) (SEPARATE . (library_unit_declaration . 2))
(PROCEDURE . (library_unit_declaration . 2)) (PRIVATE .
(library_unit_declaration . 2)) (PRAGMA . (library_unit_declaration . 2))
(PACKAGE . (library_unit_declaration . 2)) (OVERRIDING .
(library_unit_declaration . 2)) (NOT . (library_unit_declaration . 2)) (LIMITED
. (library_unit_declaration . 2)) (GENERIC . (library_unit_declaration . 2))
[...]
((default . error) (PACKAGE . 43) (FUNCTION . 1) (PROCEDURE . 9))
((default . error) (WITH . (library_unit_declaration . 3)) (USE .
(library_unit_declaration . 3)) (SEPARATE . (library_unit_declaration . 3))
(PROCEDURE . (library_unit_declaration . 3)) (PRIVATE .
(library_unit_declaration . 3)) (PRAGMA . (library_unit_declaration . 3))
(PACKAGE . (library_unit_declaration . 3)) (OVERRIDING .
(library_unit_declaration . 3)) (NOT . (library_unit_declaration . 3)) (LIMITED
. (library_unit_declaration . 3)) (GENERIC . (library_unit_declaration . 3))
[...]
- ((default . error) ($EOI . (generic_declaration . 1)) (LIMITED .
(generic_declaration . 1)) (SEPARATE . (generic_declaration . 1)) (WITH .
(generic_declaration . 1)) (PRIVATE . (generic_declaration . 1)) (END .
(generic_declaration . 1)) (BEGIN . (generic_declaration . 1)) (IDENTIFIER .
(generic_declaration . 1)) (ENTRY . (generic_declaration . 1)) (FOR .
(generic_declaration . 1)) (FUNCTION . (generic_declaration . 1)) (GENERIC .
(generic_declaration . 1)) (NOT . (generic_declarat [...]
+ ((default . error) ($EOI . (generic_declaration . 1)) (LIMITED .
(generic_declaration . 1)) (SEPARATE . (generic_declaration . 1)) (WITH .
(generic_declaration . 1)) (PRIVATE . (generic_declaration . 1)) (END .
(generic_declaration . 1)) (BEGIN . (generic_declaration . 1)) (ENTRY .
(generic_declaration . 1)) (FOR . (generic_declaration . 1)) (FUNCTION .
(generic_declaration . 1)) (GENERIC . (generic_declaration . 1)) (NOT .
(generic_declaration . 1)) (OVERRIDING . (generic_declarat [...]
((default . error) (WITH . (library_unit_renaming_declaration . 1)) (USE
. (library_unit_renaming_declaration . 1)) (SEPARATE .
(library_unit_renaming_declaration . 1)) (PROCEDURE .
(library_unit_renaming_declaration . 1)) (PRIVATE .
(library_unit_renaming_declaration . 1)) (PRAGMA .
(library_unit_renaming_declaration . 1)) (PACKAGE .
(library_unit_renaming_declaration . 1)) (OVERRIDING .
(library_unit_renaming_declaration . 1)) (NOT .
(library_unit_renaming_declaration . 1)) (LIMI [...]
- ((default . error) ($EOI . (generic_declaration . 0)) (LIMITED .
(generic_declaration . 0)) (SEPARATE . (generic_declaration . 0)) (WITH .
(generic_declaration . 0)) (PRIVATE . (generic_declaration . 0)) (END .
(generic_declaration . 0)) (BEGIN . (generic_declaration . 0)) (IDENTIFIER .
(generic_declaration . 0)) (ENTRY . (generic_declaration . 0)) (FOR .
(generic_declaration . 0)) (FUNCTION . (generic_declaration . 0)) (GENERIC .
(generic_declaration . 0)) (NOT . (generic_declarat [...]
+ ((default . error) ($EOI . (generic_declaration . 0)) (LIMITED .
(generic_declaration . 0)) (SEPARATE . (generic_declaration . 0)) (WITH .
(generic_declaration . 0)) (PRIVATE . (generic_declaration . 0)) (END .
(generic_declaration . 0)) (BEGIN . (generic_declaration . 0)) (ENTRY .
(generic_declaration . 0)) (FOR . (generic_declaration . 0)) (FUNCTION .
(generic_declaration . 0)) (GENERIC . (generic_declaration . 0)) (NOT .
(generic_declaration . 0)) (OVERRIDING . (generic_declarat [...]
((default . error) (WITH . (compilation_unit . 1)) (USE .
(compilation_unit . 1)) (SEPARATE . (compilation_unit . 1)) (PROCEDURE .
(compilation_unit . 1)) (PRIVATE . (compilation_unit . 1)) (PRAGMA .
(compilation_unit . 1)) (PACKAGE . (compilation_unit . 1)) (OVERRIDING .
(compilation_unit . 1)) (NOT . (compilation_unit . 1)) (LIMITED .
(compilation_unit . 1)) (GENERIC . (compilation_unit . 1)) (FUNCTION .
(compilation_unit . 1)) ($EOI . (compilation_unit . 1)))
((default . error) ($EOI . (library_item . 1)) (FUNCTION . (library_item
. 1)) (GENERIC . (library_item . 1)) (LIMITED . (library_item . 1)) (NOT .
(library_item . 1)) (OVERRIDING . (library_item . 1)) (PACKAGE . (library_item
. 1)) (PRAGMA . (library_item . 1)) (PRIVATE . (library_item . 1)) (PROCEDURE .
(library_item . 1)) (SEPARATE . (library_item . 1)) (USE . (library_item . 1))
(WITH . (library_item . 1)))
((default . error) ($EOI . (library_item . 4)) (FUNCTION . (library_item
. 4)) (GENERIC . (library_item . 4)) (LIMITED . (library_item . 4)) (NOT .
(library_item . 4)) (OVERRIDING . (library_item . 4)) (PACKAGE . (library_item
. 4)) (PRAGMA . (library_item . 4)) (PRIVATE . (library_item . 4)) (PROCEDURE .
(library_item . 4)) (SEPARATE . (library_item . 4)) (USE . (library_item . 4))
(WITH . (library_item . 4)))
@@ -1827,1311 +1846,1313 @@
((default . error) (WITH . (library_unit_renaming_declaration . 0)) (USE
. (library_unit_renaming_declaration . 0)) (SEPARATE .
(library_unit_renaming_declaration . 0)) (PROCEDURE .
(library_unit_renaming_declaration . 0)) (PRIVATE .
(library_unit_renaming_declaration . 0)) (PRAGMA .
(library_unit_renaming_declaration . 0)) (PACKAGE .
(library_unit_renaming_declaration . 0)) (OVERRIDING .
(library_unit_renaming_declaration . 0)) (NOT .
(library_unit_renaming_declaration . 0)) (LIMI [...]
((default . error) (SEMICOLON . 39))
((default . error) ($EOI . (context_item . 0)) (FUNCTION . (context_item
. 0)) (GENERIC . (context_item . 0)) (LIMITED . (context_item . 0)) (NOT .
(context_item . 0)) (OVERRIDING . (context_item . 0)) (PACKAGE . (context_item
. 0)) (PRAGMA . (context_item . 0)) (PRIVATE . (context_item . 0)) (PROCEDURE .
(context_item . 0)) (SEPARATE . (context_item . 0)) (USE . (context_item . 0))
(WITH . (context_item . 0)))
- ((default . error) (RENAMES . (subprogram_specification . 0)) (IS .
(subprogram_specification . 0)) (WITH . (subprogram_specification . 0))
(SEMICOLON . (subprogram_specification . 0)))
+ ((default . error) (RENAMES . (subprogram_specification . 0)) (SEMICOLON
. (subprogram_specification . 0)) (WITH . (subprogram_specification . 0)) (IS .
(subprogram_specification . 0)))
((default . error) ($EOI . (library_item . 2)) (FUNCTION . (library_item
. 2)) (GENERIC . (library_item . 2)) (LIMITED . (library_item . 2)) (NOT .
(library_item . 2)) (OVERRIDING . (library_item . 2)) (PACKAGE . (library_item
. 2)) (PRAGMA . (library_item . 2)) (PRIVATE . (library_item . 2)) (PROCEDURE .
(library_item . 2)) (SEPARATE . (library_item . 2)) (USE . (library_item . 2))
(WITH . (library_item . 2)))
((default . error) (WITH . (library_unit_declaration . 0)) (USE .
(library_unit_declaration . 0)) (SEPARATE . (library_unit_declaration . 0))
(PROCEDURE . (library_unit_declaration . 0)) (PRIVATE .
(library_unit_declaration . 0)) (PRAGMA . (library_unit_declaration . 0))
(PACKAGE . (library_unit_declaration . 0)) (OVERRIDING .
(library_unit_declaration . 0)) (NOT . (library_unit_declaration . 0)) (LIMITED
. (library_unit_declaration . 0)) (GENERIC . (library_unit_declaration . 0))
[...]
((default . error) (WITH . (library_unit_renaming_declaration . 2)) (USE
. (library_unit_renaming_declaration . 2)) (SEPARATE .
(library_unit_renaming_declaration . 2)) (PROCEDURE .
(library_unit_renaming_declaration . 2)) (PRIVATE .
(library_unit_renaming_declaration . 2)) (PRAGMA .
(library_unit_renaming_declaration . 2)) (PACKAGE .
(library_unit_renaming_declaration . 2)) (OVERRIDING .
(library_unit_renaming_declaration . 2)) (NOT .
(library_unit_renaming_declaration . 2)) (LIMI [...]
((default . error) (WITH . (compilation_unit . 2)) (USE .
(compilation_unit . 2)) (SEPARATE . (compilation_unit . 2)) (PROCEDURE .
(compilation_unit . 2)) (PRIVATE . (compilation_unit . 2)) (PRAGMA .
(compilation_unit . 2)) (PACKAGE . (compilation_unit . 2)) (OVERRIDING .
(compilation_unit . 2)) (NOT . (compilation_unit . 2)) (LIMITED .
(compilation_unit . 2)) (GENERIC . (compilation_unit . 2)) (FUNCTION .
(compilation_unit . 2)) ($EOI . (compilation_unit . 2)))
((default . error) ($EOI . (context_item . 2)) (FUNCTION . (context_item
. 2)) (GENERIC . (context_item . 2)) (LIMITED . (context_item . 2)) (NOT .
(context_item . 2)) (OVERRIDING . (context_item . 2)) (PACKAGE . (context_item
. 2)) (PRAGMA . (context_item . 2)) (PRIVATE . (context_item . 2)) (PROCEDURE .
(context_item . 2)) (SEPARATE . (context_item . 2)) (USE . (context_item . 2))
(WITH . (context_item . 2)))
((default . error) ($EOI . (context_item . 1)) (FUNCTION . (context_item
. 1)) (GENERIC . (context_item . 1)) (LIMITED . (context_item . 1)) (NOT .
(context_item . 1)) (OVERRIDING . (context_item . 1)) (PACKAGE . (context_item
. 1)) (PRAGMA . (context_item . 1)) (PRIVATE . (context_item . 1)) (PROCEDURE .
(context_item . 1)) (SEPARATE . (context_item . 1)) (USE . (context_item . 1))
(WITH . (context_item . 1)))
- ((default . error) (USE . (package_declaration . 0)) (TYPE .
(package_declaration . 0)) (TASK . (package_declaration . 0)) (SUBTYPE .
(package_declaration . 0)) (PROTECTED . (package_declaration . 0)) (PROCEDURE .
(package_declaration . 0)) (PRAGMA . (package_declaration . 0)) (PACKAGE .
(package_declaration . 0)) (OVERRIDING . (package_declaration . 0)) (NOT .
(package_declaration . 0)) (GENERIC . (package_declaration . 0)) (FUNCTION .
(package_declaration . 0)) (FOR . (package_de [...]
+ ((default . error) (IDENTIFIER . (package_declaration . 0)) (USE .
(package_declaration . 0)) (TYPE . (package_declaration . 0)) (TASK .
(package_declaration . 0)) (SUBTYPE . (package_declaration . 0)) (PROTECTED .
(package_declaration . 0)) (PROCEDURE . (package_declaration . 0)) (PRAGMA .
(package_declaration . 0)) (PACKAGE . (package_declaration . 0)) (OVERRIDING .
(package_declaration . 0)) (NOT . (package_declaration . 0)) (GENERIC .
(package_declaration . 0)) (FUNCTION . (pac [...]
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
- ((default . error) (RENAMES . 127) (SEMICOLON .
(aspect_specification_opt . 0)) (IS . (aspect_specification_opt . 0)) (WITH .
108))
+ ((default . error) (RENAMES . 128) (SEMICOLON .
(aspect_specification_opt . 0)) (IS . (aspect_specification_opt . 0)) (WITH .
109))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
- ((default . error) (SEMICOLON . 125))
- ((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
108))
- ((default . error) ($EOI . accept) (XOR . accept) (WITH . accept) (WHILE
. accept) (WHEN . accept) (USE . accept) (UNTIL . accept) (TYPE . accept) (THEN
. accept) (TERMINATE . accept) (TASK . accept) (TAGGED . accept) (SYNCHRONIZED
. accept) (SUBTYPE . accept) (SOME . accept) (SELECT . accept) (SEPARATE .
accept) (RIGHT_PAREN . accept) (REVERSE . accept) (RETURN . accept) (REQUEUE .
accept) (RENAMES . accept) (REM . accept) (RECORD . accept) (RANGE . accept)
(RAISE . accept) (PROTE [...]
+ ((default . error) (SEMICOLON . 126))
+ ((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
109))
+ ((default . error) ($EOI . accept) (CHARACTER_LITERAL . accept)
(STRING_LITERAL . accept) (IDENTIFIER . accept) (NUMERIC_LITERAL . accept)
(TICK . accept) (STAR_STAR . accept) (STAR . accept) (SLASH_EQUAL . accept)
(SLASH . accept) (SEMICOLON . accept) (PLUS . accept) (MINUS . accept)
(LESS_LESS . accept) (LESS_EQUAL . accept) (LESS . accept) (GREATER_GREATER .
accept) (GREATER_EQUAL . accept) (GREATER . accept) (EQUAL_GREATER . accept)
(EQUAL . accept) (DOT_DOT . accept) (DOT . ac [...]
((default . error) (WITH . (compilation_unit_list . 1)) (USE .
(compilation_unit_list . 1)) (SEPARATE . (compilation_unit_list . 1))
(PROCEDURE . (compilation_unit_list . 1)) (PRIVATE . (compilation_unit_list .
1)) (PRAGMA . (compilation_unit_list . 1)) (PACKAGE . (compilation_unit_list .
1)) (OVERRIDING . (compilation_unit_list . 1)) (NOT . (compilation_unit_list .
1)) (LIMITED . (compilation_unit_list . 1)) (GENERIC . (compilation_unit_list .
1)) (FUNCTION . (compilation_unit_lis [...]
- ((default . error) (USE . (name . 0)) (DO . (name . 0)) (ELSIF . (name .
0)) (RENAMES . (name . 0)) (ELSE . (name . 0)) (LESS_LESS . (name . 0))
(IDENTIFIER . (name . 0)) (STRING_LITERAL . (name . 0)) (CHARACTER_LITERAL .
(name . 0)) (ACCEPT . (name . 0)) (ABORT . (name . 0)) (BEGIN . (name . 0))
(CASE . (name . 0)) (DECLARE . (name . 0)) (DELAY . (name . 0)) (EXIT . (name .
0)) (FOR . (name . 0)) (GOTO . (name . 0)) (IF . (name . 0)) (LOOP . (name .
0)) (NULL . (name . 0)) (PRAGMA [...]
- ((default . error) (USE . (name . 7)) (DO . (name . 7)) (ELSIF . (name .
7)) (RENAMES . (name . 7)) (ELSE . (name . 7)) (LESS_LESS . (name . 7))
(IDENTIFIER . (name . 7)) (STRING_LITERAL . (name . 7)) (CHARACTER_LITERAL .
(name . 7)) (ACCEPT . (name . 7)) (ABORT . (name . 7)) (BEGIN . (name . 7))
(CASE . (name . 7)) (DECLARE . (name . 7)) (DELAY . (name . 7)) (EXIT . (name .
7)) (FOR . (name . 7)) (GOTO . (name . 7)) (IF . (name . 7)) (LOOP . (name .
7)) (NULL . (name . 7)) (PRAGMA [...]
- ((default . error) (DO . (name . 1)) (USE . (name . 1)) (ELSIF . (name .
1)) (COMMA . (name . 1)) (RENAMES . (name . 1)) (ELSE . (name . 1)) (LESS_LESS
. (name . 1)) (IDENTIFIER . (name . 1)) (STRING_LITERAL . (name . 1))
(CHARACTER_LITERAL . (name . 1)) (ACCEPT . (name . 1)) (ABORT . (name . 1))
(BEGIN . (name . 1)) (CASE . (name . 1)) (DECLARE . (name . 1)) (DELAY . (name
. 1)) (EXIT . (name . 1)) (FOR . (name . 1)) (GOTO . (name . 1)) (IF . (name .
1)) (LOOP . (name . 1)) (NULL [...]
- ((default . error) (USE . (name . 4)) (DO . (name . 4)) (ELSIF . (name .
4)) (RENAMES . (name . 4)) (ELSE . (name . 4)) (LESS_LESS . (name . 4))
(IDENTIFIER . (name . 4)) (STRING_LITERAL . (name . 4)) (CHARACTER_LITERAL .
(name . 4)) (ACCEPT . (name . 4)) (ABORT . (name . 4)) (BEGIN . (name . 4))
(CASE . (name . 4)) (DECLARE . (name . 4)) (DELAY . (name . 4)) (EXIT . (name .
4)) (FOR . (name . 4)) (GOTO . (name . 4)) (IF . (name . 4)) (LOOP . (name .
4)) (NULL . (name . 4)) (PRAGMA [...]
- ((default . error) (COMMA . 119) (SEMICOLON . 123))
- ((default . error) (DOT . 87) (SEMICOLON . (name_list . 0)) (COMMA .
(name_list . 0)) (TICK . 88) (LEFT_PAREN . 106))
- ((default . error) (DO . (name . 6)) (USE . (name . 6)) (ELSIF . (name .
6)) (RENAMES . (name . 6)) (ELSE . (name . 6)) (LESS_LESS . (name . 6))
(IDENTIFIER . (name . 6)) (STRING_LITERAL . (name . 6)) (CHARACTER_LITERAL .
(name . 6)) (ACCEPT . (name . 6)) (ABORT . (name . 6)) (BEGIN . (name . 6))
(CASE . (name . 6)) (DECLARE . (name . 6)) (DELAY . (name . 6)) (EXIT . (name .
6)) (FOR . (name . 6)) (GOTO . (name . 6)) (IF . (name . 6)) (LOOP . (name .
6)) (NULL . (name . 6)) (PRAGMA [...]
- ((default . error) (DO . (name . 3)) (USE . (name . 3)) (ELSIF . (name .
3)) (RENAMES . (name . 3)) (ELSE . (name . 3)) (LESS_LESS . (name . 3))
(IDENTIFIER . (name . 3)) (STRING_LITERAL . (name . 3)) (CHARACTER_LITERAL .
(name . 3)) (ACCEPT . (name . 3)) (ABORT . (name . 3)) (BEGIN . (name . 3))
(CASE . (name . 3)) (DECLARE . (name . 3)) (DELAY . (name . 3)) (EXIT . (name .
3)) (FOR . (name . 3)) (GOTO . (name . 3)) (IF . (name . 3)) (LOOP . (name .
3)) (NULL . (name . 3)) (PRAGMA [...]
- ((default . error) (TYPE . 122))
+ ((default . error) (USE . (name . 0)) (DO . (name . 0)) (ELSIF . (name .
0)) (RENAMES . (name . 0)) (OF . (name . 0)) (ELSE . (name . 0)) (ACCEPT .
(name . 0)) (ABORT . (name . 0)) (BEGIN . (name . 0)) (CASE . (name . 0))
(DECLARE . (name . 0)) (DELAY . (name . 0)) (EXIT . (name . 0)) (FOR . (name .
0)) (GOTO . (name . 0)) (IF . (name . 0)) (LOOP . (name . 0)) (NULL . (name .
0)) (PRAGMA . (name . 0)) (RAISE . (name . 0)) (REQUEUE . (name . 0)) (RETURN .
(name . 0)) (SELECT . (name [...]
+ ((default . error) (USE . (name . 7)) (DO . (name . 7)) (ELSIF . (name .
7)) (RENAMES . (name . 7)) (OF . (name . 7)) (ELSE . (name . 7)) (ACCEPT .
(name . 7)) (ABORT . (name . 7)) (BEGIN . (name . 7)) (CASE . (name . 7))
(DECLARE . (name . 7)) (DELAY . (name . 7)) (EXIT . (name . 7)) (FOR . (name .
7)) (GOTO . (name . 7)) (IF . (name . 7)) (LOOP . (name . 7)) (NULL . (name .
7)) (PRAGMA . (name . 7)) (RAISE . (name . 7)) (REQUEUE . (name . 7)) (RETURN .
(name . 7)) (SELECT . (name [...]
+ ((default . error) (DO . (name . 1)) (USE . (name . 1)) (ELSIF . (name .
1)) (COMMA . (name . 1)) (RENAMES . (name . 1)) (OF . (name . 1)) (ELSE . (name
. 1)) (ACCEPT . (name . 1)) (ABORT . (name . 1)) (BEGIN . (name . 1)) (CASE .
(name . 1)) (DECLARE . (name . 1)) (DELAY . (name . 1)) (EXIT . (name . 1))
(FOR . (name . 1)) (GOTO . (name . 1)) (IF . (name . 1)) (LOOP . (name . 1))
(NULL . (name . 1)) (PRAGMA . (name . 1)) (RAISE . (name . 1)) (REQUEUE . (name
. 1)) (RETURN . (name [...]
+ ((default . error) (USE . (name . 4)) (DO . (name . 4)) (ELSIF . (name .
4)) (RENAMES . (name . 4)) (OF . (name . 4)) (ELSE . (name . 4)) (ACCEPT .
(name . 4)) (ABORT . (name . 4)) (BEGIN . (name . 4)) (CASE . (name . 4))
(DECLARE . (name . 4)) (DELAY . (name . 4)) (EXIT . (name . 4)) (FOR . (name .
4)) (GOTO . (name . 4)) (IF . (name . 4)) (LOOP . (name . 4)) (NULL . (name .
4)) (PRAGMA . (name . 4)) (RAISE . (name . 4)) (REQUEUE . (name . 4)) (RETURN .
(name . 4)) (SELECT . (name [...]
+ ((default . error) (COMMA . 120) (SEMICOLON . 124))
+ ((default . error) (DOT . 90) (SEMICOLON . (name_list . 0)) (COMMA .
(name_list . 0)) (TICK . 91) (LEFT_PAREN . 107))
+ ((default . error) (DO . (name . 6)) (USE . (name . 6)) (ELSIF . (name .
6)) (RENAMES . (name . 6)) (OF . (name . 6)) (ELSE . (name . 6)) (ACCEPT .
(name . 6)) (ABORT . (name . 6)) (BEGIN . (name . 6)) (CASE . (name . 6))
(DECLARE . (name . 6)) (DELAY . (name . 6)) (EXIT . (name . 6)) (FOR . (name .
6)) (GOTO . (name . 6)) (IF . (name . 6)) (LOOP . (name . 6)) (NULL . (name .
6)) (PRAGMA . (name . 6)) (RAISE . (name . 6)) (REQUEUE . (name . 6)) (RETURN .
(name . 6)) (SELECT . (name [...]
+ ((default . error) (DO . (name . 3)) (USE . (name . 3)) (ELSIF . (name .
3)) (RENAMES . (name . 3)) (OF . (name . 3)) (ELSE . (name . 3)) (ACCEPT .
(name . 3)) (ABORT . (name . 3)) (BEGIN . (name . 3)) (CASE . (name . 3))
(DECLARE . (name . 3)) (DELAY . (name . 3)) (EXIT . (name . 3)) (FOR . (name .
3)) (GOTO . (name . 3)) (IF . (name . 3)) (LOOP . (name . 3)) (NULL . (name .
3)) (PRAGMA . (name . 3)) (RAISE . (name . 3)) (REQUEUE . (name . 3)) (RETURN .
(name . 3)) (SELECT . (name [...]
+ ((default . error) (TYPE . 123))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
- ((default . error) (COMMA . 119) (SEMICOLON . 120))
+ ((default . error) (COMMA . 120) (SEMICOLON . 121))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
- ((default . error) (DOT . 87) (TICK . 88) (IS . (parameter_profile_opt
. 0)) (SEMICOLON . (parameter_profile_opt . 0)) (WITH . (parameter_profile_opt
. 0)) (LEFT_PAREN . 89))
- ((default . error) (FUNCTION . (generic_formal_part . 1)) (PROCEDURE .
(generic_formal_part . 1)) (PACKAGE . (generic_formal_part . 1)) (PRAGMA . 7)
(WITH . 77) (TYPE . 76) (IDENTIFIER . 72))
+ ((default . error) (DOT . 90) (TICK . 91) (IS . (parameter_profile_opt
. 0)) (SEMICOLON . (parameter_profile_opt . 0)) (WITH . (parameter_profile_opt
. 0)) (LEFT_PAREN . 88))
+ ((default . error) (FUNCTION . (generic_formal_part . 1)) (PROCEDURE .
(generic_formal_part . 1)) (PACKAGE . (generic_formal_part . 1)) (USE . 11)
(PRAGMA . 7) (WITH . 76) (TYPE . 75) (IDENTIFIER . 77))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
((default . error) (WITH . (library_item . 0)) (USE . (library_item .
0)) (SEPARATE . (library_item . 0)) (PROCEDURE . (library_item . 0)) (PRIVATE .
(library_item . 0)) (PRAGMA . (library_item . 0)) (PACKAGE . (library_item .
0)) (OVERRIDING . (library_item . 0)) (NOT . (library_item . 0)) (LIMITED .
(library_item . 0)) (GENERIC . (library_item . 0)) (FUNCTION . (library_item .
0)) ($EOI . (library_item . 0)))
((default . error) (FUNCTION . 40) (PROCEDURE . 41))
- ((default . error) (LEFT_PAREN . 112) (SEMICOLON . 111))
+ ((default . error) (LEFT_PAREN . 112) (SEMICOLON . 113))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
- ((default . error) (RENAMES . 107) (DOT . 87) (TICK . 88) (IS . ( 105
(aspect_specification_opt . 0))) (WITH . 108) (LEFT_PAREN . 106))
+ ((default . error) (RENAMES . 108) (DOT . 90) (TICK . 91) (IS . ( 106
(aspect_specification_opt . 0))) (WITH . 109) (LEFT_PAREN . 107))
((default . error) (ENTRY . (overriding_indicator_opt . 0)) (PROCEDURE .
(overriding_indicator_opt . 0)) (FUNCTION . (overriding_indicator_opt . 0)))
- ((default . error) (WITH . 104))
+ ((default . error) (WITH . 105))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
- ((default . error) (COLON . (identifier_list . 0)) (COMMA .
(identifier_list . 0)))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
- ((default . error) (IDENTIFIER . 99))
- ((default . error) (PACKAGE . 97) (FUNCTION . 1) (PROCEDURE . 9))
- ((default . error) (PACKAGE . (generic_formal_parameter_declaration .
0)) (PROCEDURE . (generic_formal_parameter_declaration . 0)) (FUNCTION .
(generic_formal_parameter_declaration . 0)) (WITH .
(generic_formal_parameter_declaration . 0)) (TYPE .
(generic_formal_parameter_declaration . 0)) (PRAGMA .
(generic_formal_parameter_declaration . 0)) (IDENTIFIER .
(generic_formal_parameter_declaration . 0)))
- ((default . error) (PACKAGE . (generic_formal_parameter_declaration .
2)) (PROCEDURE . (generic_formal_parameter_declaration . 2)) (FUNCTION .
(generic_formal_parameter_declaration . 2)) (WITH .
(generic_formal_parameter_declaration . 2)) (TYPE .
(generic_formal_parameter_declaration . 2)) (PRAGMA .
(generic_formal_parameter_declaration . 2)) (IDENTIFIER .
(generic_formal_parameter_declaration . 2)))
- ((default . error) (PACKAGE . (generic_formal_parameter_declaration .
1)) (PROCEDURE . (generic_formal_parameter_declaration . 1)) (FUNCTION .
(generic_formal_parameter_declaration . 1)) (WITH .
(generic_formal_parameter_declaration . 1)) (TYPE .
(generic_formal_parameter_declaration . 1)) (PRAGMA .
(generic_formal_parameter_declaration . 1)) (IDENTIFIER .
(generic_formal_parameter_declaration . 1)))
- ((default . error) (PACKAGE . (generic_formal_parameter_declaration .
3)) (PROCEDURE . (generic_formal_parameter_declaration . 3)) (FUNCTION .
(generic_formal_parameter_declaration . 3)) (WITH .
(generic_formal_parameter_declaration . 3)) (TYPE .
(generic_formal_parameter_declaration . 3)) (PRAGMA .
(generic_formal_parameter_declaration . 3)) (IDENTIFIER .
(generic_formal_parameter_declaration . 3)))
- ((default . error) (PACKAGE . (generic_formal_part . 0)) (PROCEDURE .
(generic_formal_part . 0)) (FUNCTION . (generic_formal_part . 0)) (PRAGMA . 7)
(WITH . 77) (TYPE . 76) (IDENTIFIER . 72))
- ((default . error) (PACKAGE . (generic_formal_parameter_declarations .
0)) (PROCEDURE . (generic_formal_parameter_declarations . 0)) (FUNCTION .
(generic_formal_parameter_declarations . 0)) (IDENTIFIER .
(generic_formal_parameter_declarations . 0)) (PRAGMA .
(generic_formal_parameter_declarations . 0)) (TYPE .
(generic_formal_parameter_declarations . 0)) (WITH .
(generic_formal_parameter_declarations . 0)))
- ((default . error) (COMMA . 95) (COLON . 94))
- ((default . error) (PACKAGE . (generic_formal_parameter_declaration .
4)) (PROCEDURE . (generic_formal_parameter_declaration . 4)) (FUNCTION .
(generic_formal_parameter_declaration . 4)) (WITH .
(generic_formal_parameter_declaration . 4)) (TYPE .
(generic_formal_parameter_declaration . 4)) (PRAGMA .
(generic_formal_parameter_declaration . 4)) (IDENTIFIER .
(generic_formal_parameter_declaration . 4)))
- ((default . error) (DOT . 87) (TICK . 88) (RETURN . 90) (LEFT_PAREN .
89))
- ((default . error) (IDENTIFIER . 228) (CHARACTER_LITERAL . 230)
(STRING_LITERAL . 229) (ALL . 231))
- ((default . error) (LEFT_PAREN . 223) (ACCESS . 220) (DELTA . 221)
(DIGITS . 222) (MOD . 224) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
- ((default . error) (STRING_LITERAL . 49) (CHARACTER_LITERAL . 173)
(RIGHT_PAREN . ((association_opt . 0) (expression_opt . 0))) (COMMA .
((association_opt . 0) (expression_opt . 0))) (EQUAL_GREATER .
(discrete_choice_list . 0)) (BAR . (discrete_choice_list . 0)) (PLUS . 144)
(MINUS . 143) (IDENTIFIER . 216) (OTHERS . 175) (ABS . 147) (NOT . 174)
(NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149) (RAISE . 152) (LEFT_PAREN
. 148))
- ((default . error) (WITH . (name_opt . 0)) (SEMICOLON . (name_opt . 0))
(IS . (name_opt . 0)) (RENAMES . (name_opt . 0)) (COLON_EQUAL . (name_opt . 0))
(RIGHT_PAREN . (name_opt . 0)) (DO . (name_opt . 0)) (ACCESS .
(null_exclusion_opt . 0)) (NOT . 211) (IDENTIFIER . 48) (CHARACTER_LITERAL .
50) (STRING_LITERAL . 49))
- ((default . error) (DO . (name . 5)) (OF . (name . 5)) (WHILE . (name .
5)) (SELECT . (name . 5)) (REQUEUE . (name . 5)) (RAISE . (name . 5)) (PRAGMA .
(name . 5)) (NULL . (name . 5)) (LOOP . (name . 5)) (IF . (name . 5)) (GOTO .
(name . 5)) (FOR . (name . 5)) (EXIT . (name . 5)) (DELAY . (name . 5))
(DECLARE . (name . 5)) (CASE . (name . 5)) (BEGIN . (name . 5)) (ABORT . (name
. 5)) (ACCEPT . (name . 5)) (CHARACTER_LITERAL . (name . 5)) (STRING_LITERAL .
(name . 5)) (IDENTIFIER . [...]
- ((default . error) (RETURN . 210))
+ ((default . error) (IDENTIFIER . 100))
+ ((default . error) (PACKAGE . 98) (FUNCTION . 1) (PROCEDURE . 9))
+ ((default . error) (COLON . (identifier_list . 0)) (COMMA .
(identifier_list . 0)))
+ ((default . error) (PACKAGE . (generic_formal_parameter_declaration .
0)) (PROCEDURE . (generic_formal_parameter_declaration . 0)) (FUNCTION .
(generic_formal_parameter_declaration . 0)) (IDENTIFIER .
(generic_formal_parameter_declaration . 0)) (WITH .
(generic_formal_parameter_declaration . 0)) (USE .
(generic_formal_parameter_declaration . 0)) (TYPE .
(generic_formal_parameter_declaration . 0)) (PRAGMA .
(generic_formal_parameter_declaration . 0)))
+ ((default . error) (PACKAGE . (generic_formal_parameter_declaration .
2)) (PROCEDURE . (generic_formal_parameter_declaration . 2)) (FUNCTION .
(generic_formal_parameter_declaration . 2)) (IDENTIFIER .
(generic_formal_parameter_declaration . 2)) (WITH .
(generic_formal_parameter_declaration . 2)) (USE .
(generic_formal_parameter_declaration . 2)) (TYPE .
(generic_formal_parameter_declaration . 2)) (PRAGMA .
(generic_formal_parameter_declaration . 2)))
+ ((default . error) (PACKAGE . (generic_formal_parameter_declaration .
1)) (PROCEDURE . (generic_formal_parameter_declaration . 1)) (FUNCTION .
(generic_formal_parameter_declaration . 1)) (IDENTIFIER .
(generic_formal_parameter_declaration . 1)) (WITH .
(generic_formal_parameter_declaration . 1)) (USE .
(generic_formal_parameter_declaration . 1)) (TYPE .
(generic_formal_parameter_declaration . 1)) (PRAGMA .
(generic_formal_parameter_declaration . 1)))
+ ((default . error) (PACKAGE . (generic_formal_parameter_declaration .
3)) (PROCEDURE . (generic_formal_parameter_declaration . 3)) (FUNCTION .
(generic_formal_parameter_declaration . 3)) (IDENTIFIER .
(generic_formal_parameter_declaration . 3)) (WITH .
(generic_formal_parameter_declaration . 3)) (USE .
(generic_formal_parameter_declaration . 3)) (TYPE .
(generic_formal_parameter_declaration . 3)) (PRAGMA .
(generic_formal_parameter_declaration . 3)))
+ ((default . error) (PACKAGE . (generic_formal_part . 0)) (PROCEDURE .
(generic_formal_part . 0)) (FUNCTION . (generic_formal_part . 0)) (USE . 11)
(PRAGMA . 7) (WITH . 76) (TYPE . 75) (IDENTIFIER . 77))
+ ((default . error) (PACKAGE . (generic_formal_parameter_declarations .
0)) (PROCEDURE . (generic_formal_parameter_declarations . 0)) (FUNCTION .
(generic_formal_parameter_declarations . 0)) (PRAGMA .
(generic_formal_parameter_declarations . 0)) (TYPE .
(generic_formal_parameter_declarations . 0)) (USE .
(generic_formal_parameter_declarations . 0)) (WITH .
(generic_formal_parameter_declarations . 0)) (IDENTIFIER .
(generic_formal_parameter_declarations . 0)))
+ ((default . error) (COMMA . 96) (COLON . 95))
+ ((default . error) (PACKAGE . (generic_formal_parameter_declaration .
4)) (PROCEDURE . (generic_formal_parameter_declaration . 4)) (FUNCTION .
(generic_formal_parameter_declaration . 4)) (IDENTIFIER .
(generic_formal_parameter_declaration . 4)) (WITH .
(generic_formal_parameter_declaration . 4)) (USE .
(generic_formal_parameter_declaration . 4)) (TYPE .
(generic_formal_parameter_declaration . 4)) (PRAGMA .
(generic_formal_parameter_declaration . 4)))
+ ((default . error) (PACKAGE . (generic_formal_parameter_declaration .
5)) (PROCEDURE . (generic_formal_parameter_declaration . 5)) (FUNCTION .
(generic_formal_parameter_declaration . 5)) (IDENTIFIER .
(generic_formal_parameter_declaration . 5)) (WITH .
(generic_formal_parameter_declaration . 5)) (USE .
(generic_formal_parameter_declaration . 5)) (TYPE .
(generic_formal_parameter_declaration . 5)) (PRAGMA .
(generic_formal_parameter_declaration . 5)))
+ ((default . error) (DOT . 90) (TICK . 91) (RETURN . 89) (LEFT_PAREN .
88))
+ ((default . error) (FOR . 146) (CASE . 145) (IF . 147) (RIGHT_PAREN .
((expression_opt . 0) (association_opt . 0))) (COMMA . ((expression_opt . 0)
(association_opt . 0))) (EQUAL_GREATER . (discrete_choice_list . 0)) (BAR .
(discrete_choice_list . 0)) (CHARACTER_LITERAL . 183) (STRING_LITERAL . 49)
(IDENTIFIER . 235) (PLUS . 154) (MINUS . 153) (OTHERS . 182) (ABS . 144)
(NOT . 181) (RAISE . 152) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149)
(LEFT_PAREN . 148))
+ ((default . error) (IDENTIFIER . (null_exclusion_opt . 0))
(STRING_LITERAL . (null_exclusion_opt . 0)) (CHARACTER_LITERAL .
(null_exclusion_opt . 0)) (DO . (null_exclusion_opt . 0)) (COLON_EQUAL .
(null_exclusion_opt . 0)) (RIGHT_PAREN . (null_exclusion_opt . 0)) (RENAMES .
(null_exclusion_opt . 0)) (IS . (null_exclusion_opt . 0)) (SEMICOLON .
(null_exclusion_opt . 0)) (WITH . (null_exclusion_opt . 0)) (ACCESS .
(null_exclusion_opt . 0)) (NOT . 232))
+ ((default . error) (IDENTIFIER . 229) (CHARACTER_LITERAL . 231)
(STRING_LITERAL . 230) (ALL . 228))
+ ((default . error) (LEFT_PAREN . 148) (ACCESS . 221) (DELTA . 222)
(DIGITS . 223) (MOD . 224) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
+ ((default . error) (DO . (name . 5)) (OF . (name . 5))
(CHARACTER_LITERAL . (name . 5)) (STRING_LITERAL . (name . 5)) (IDENTIFIER .
(name . 5)) (LESS_LESS . (name . 5)) (WHILE . (name . 5)) (SELECT . (name . 5))
(REQUEUE . (name . 5)) (RAISE . (name . 5)) (PRAGMA . (name . 5)) (NULL . (name
. 5)) (LOOP . (name . 5)) (IF . (name . 5)) (GOTO . (name . 5)) (FOR . (name .
5)) (EXIT . (name . 5)) (DELAY . (name . 5)) (DECLARE . (name . 5)) (CASE .
(name . 5)) (BEGIN . (name . 5)) (ABORT [...]
+ ((default . error) (RETURN . 220))
((default . error) (RENAMES . (function_specification . 0)) (IS .
(function_specification . 0)) (SEMICOLON . (function_specification . 0)) (WITH
. (function_specification . 0)))
- ((default . error) (ACCESS . (mode_opt . 0)) (NOT . (mode_opt . 0))
(IDENTIFIER . (mode_opt . 0)) (STRING_LITERAL . (mode_opt . 0))
(CHARACTER_LITERAL . (mode_opt . 0)) (IN . 207) (OUT . 208))
- ((default . error) (IDENTIFIER . 206))
- ((default . error) (WITH . (generic_formal_parameter_declarations . 1))
(TYPE . (generic_formal_parameter_declarations . 1)) (PRAGMA .
(generic_formal_parameter_declarations . 1)) (IDENTIFIER .
(generic_formal_parameter_declarations . 1)) (FUNCTION .
(generic_formal_parameter_declarations . 1)) (PROCEDURE .
(generic_formal_parameter_declarations . 1)) (PACKAGE .
(generic_formal_parameter_declarations . 1)))
+ ((default . error) (ACCESS . (mode_opt . 0)) (NOT . (mode_opt . 0))
(IDENTIFIER . (mode_opt . 0)) (STRING_LITERAL . (mode_opt . 0))
(CHARACTER_LITERAL . (mode_opt . 0)) (IN . 217) (OUT . 218))
+ ((default . error) (IDENTIFIER . 216))
+ ((default . error) (IDENTIFIER . (generic_formal_parameter_declarations
. 1)) (WITH . (generic_formal_parameter_declarations . 1)) (USE .
(generic_formal_parameter_declarations . 1)) (TYPE .
(generic_formal_parameter_declarations . 1)) (PRAGMA .
(generic_formal_parameter_declarations . 1)) (FUNCTION .
(generic_formal_parameter_declarations . 1)) (PROCEDURE .
(generic_formal_parameter_declarations . 1)) (PACKAGE .
(generic_formal_parameter_declarations . 1)))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
- ((default . error) (IS . 203) (SEMICOLON . (aspect_specification_opt .
0)) (WITH . 108))
- ((default . error) (WITH . (discriminant_part_opt . 0)) (SEMICOLON .
(discriminant_part_opt . 0)) (IS . (discriminant_part_opt . 0)) (LEFT_PAREN .
201))
- ((default . error) (DOT . 87) (TICK . 88) (RENAMES . 200) (LEFT_PAREN
. 106))
- ((default . error) (DOT . 87) (TICK . 88) (RENAMES . 199) (LEFT_PAREN
. 106))
- ((default . error) (DOT . 87) (TICK . 88) (RENAMES . 198) (LEFT_PAREN
. 106))
- ((default . error) (COMMA . 119) (SEMICOLON . 197))
+ ((default . error) (IS . 213) (SEMICOLON . (aspect_specification_opt .
0)) (WITH . 109))
+ ((default . error) (WITH . (discriminant_part_opt . 0)) (SEMICOLON .
(discriminant_part_opt . 0)) (IS . (discriminant_part_opt . 0)) (LEFT_PAREN .
211))
+ ((default . error) (DOT . 90) (TICK . 91) (RENAMES . 210) (LEFT_PAREN
. 107))
+ ((default . error) (DOT . 90) (TICK . 91) (RENAMES . 209) (LEFT_PAREN
. 107))
+ ((default . error) (DOT . 90) (TICK . 91) (RENAMES . 208) (LEFT_PAREN
. 107))
+ ((default . error) (COMMA . 120) (SEMICOLON . 207))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
- ((default . error) (NEW . 195))
- ((default . error) (IDENTIFIER . 48) (STRING_LITERAL . 49)
(CHARACTER_LITERAL . 173) (RIGHT_PAREN . ((association_opt . 0)
(expression_opt . 0))) (COMMA . ((association_opt . 0) (expression_opt . 0)))
(EQUAL_GREATER . (discrete_choice_list . 0)) (BAR . (discrete_choice_list . 0))
(PLUS . 144) (MINUS . 143) (OTHERS . 175) (ABS . 147) (NOT . 174)
(NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149) (RAISE . 152) (LEFT_PAREN
. 148))
+ ((default . error) (NEW . 205))
+ ((default . error) (FOR . 146) (CASE . 145) (IF . 147) (RIGHT_PAREN .
((expression_opt . 0) (association_opt . 0))) (COMMA . ((expression_opt . 0)
(association_opt . 0))) (EQUAL_GREATER . (discrete_choice_list . 0)) (BAR .
(discrete_choice_list . 0)) (IDENTIFIER . 48) (CHARACTER_LITERAL . 183)
(STRING_LITERAL . 49) (PLUS . 154) (MINUS . 153) (OTHERS . 182) (ABS .
144) (NOT . 181) (RAISE . 152) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW .
149) (LEFT_PAREN . 148))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
- ((default . error) (SEMICOLON . ((association_opt . 0) (expression_opt .
0))) (IS . ((association_opt . 0) (expression_opt . 0))) (COMMA .
((association_opt . 0) (expression_opt . 0))) (EQUAL_GREATER .
(discrete_choice_list . 0)) (BAR . (discrete_choice_list . 0)) (OTHERS . 175)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 173) (STRING_LITERAL . 49) (RAISE .
152) (PLUS . 144) (MINUS . 143) (ABS . 147) (NOT . 174) (NUMERIC_LITERAL .
145) (NULL . 151) (NEW . 149) (LEFT_PAREN . 148))
- ((default . error) (IS . 172))
- ((default . error) (DOT . 87) (TICK . 88) (IS .
(aspect_specification_opt . 0)) (WITH . 108) (LEFT_PAREN . 106))
- ((default . error) (OR . (pragma . 1)) (THEN . (pragma . 1)) (WHEN .
(pragma . 1)) (EXCEPTION . (pragma . 1)) (LESS_LESS . (pragma . 1))
(STRING_LITERAL . (pragma . 1)) (CHARACTER_LITERAL . (pragma . 1)) (ACCEPT .
(pragma . 1)) (ABORT . (pragma . 1)) (CASE . (pragma . 1)) (DECLARE . (pragma .
1)) (DELAY . (pragma . 1)) (EXIT . (pragma . 1)) (GOTO . (pragma . 1)) (IF .
(pragma . 1)) (LOOP . (pragma . 1)) (NULL . (pragma . 1)) (RAISE . (pragma .
1)) (REQUEUE . (pragma . 1)) (RETURN . [...]
- ((default . error) (RAISE . 152) (PLUS . 144) (MINUS . 143) (ABS .
147) (NOT . 150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149)
(IDENTIFIER . 146) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49)
(LEFT_PAREN . 148))
- ((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
108))
- ((default . error) (COMMA . 119) (SEMICOLON . 141))
- ((default . error) (DOT . 87) (TICK . 88) (IS . ( 105
(aspect_specification_opt . 0))) (WITH . 108) (LEFT_PAREN . 106))
- ((default . error) (RIGHT_PAREN . (parameter_profile_opt . 1))
(COLON_EQUAL . (parameter_profile_opt . 1)) (RENAMES . (parameter_profile_opt .
1)) (IS . (parameter_profile_opt . 1)) (DO . (parameter_profile_opt . 1)) (WITH
. (parameter_profile_opt . 1)) (SEMICOLON . (parameter_profile_opt . 1)) (WHEN
. (parameter_profile_opt . 1)))
+ ((default . error) (SEMICOLON . ((expression_opt . 0) (association_opt .
0))) (IS . ((expression_opt . 0) (association_opt . 0))) (COMMA .
((expression_opt . 0) (association_opt . 0))) (EQUAL_GREATER .
(discrete_choice_list . 0)) (BAR . (discrete_choice_list . 0)) (OTHERS . 182)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 183) (STRING_LITERAL . 49) (RAISE .
152) (PLUS . 154) (MINUS . 153) (ABS . 144) (NOT . 181) (NUMERIC_LITERAL .
155) (NULL . 151) (NEW . 149) (LEFT_PAREN . 148))
+ ((default . error) (IS . 180))
+ ((default . error) (DOT . 90) (TICK . 91) (IS .
(aspect_specification_opt . 0)) (WITH . 109) (LEFT_PAREN . 107))
+ ((default . error) (FOR . 146) (CASE . 145) (IF . 147) (RAISE . 152)
(PLUS . 154) (MINUS . 153) (ABS . 144) (NOT . 150) (NUMERIC_LITERAL . 155)
(NULL . 151) (NEW . 149) (IDENTIFIER . 156) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49) (LEFT_PAREN . 148))
+ ((default . error) (OR . (pragma . 1)) (THEN . (pragma . 1)) (WHEN .
(pragma . 1)) (EXCEPTION . (pragma . 1)) (ACCEPT . (pragma . 1)) (ABORT .
(pragma . 1)) (CASE . (pragma . 1)) (DECLARE . (pragma . 1)) (DELAY . (pragma .
1)) (EXIT . (pragma . 1)) (GOTO . (pragma . 1)) (IF . (pragma . 1)) (LOOP .
(pragma . 1)) (NULL . (pragma . 1)) (RAISE . (pragma . 1)) (REQUEUE . (pragma .
1)) (RETURN . (pragma . 1)) (SELECT . (pragma . 1)) (WHILE . (pragma . 1))
(LESS_LESS . (pragma . 1)) (STRI [...]
+ ((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
109))
+ ((default . error) (COMMA . 120) (SEMICOLON . 142))
+ ((default . error) (DOT . 90) (TICK . 91) (IS . ( 106
(aspect_specification_opt . 0))) (WITH . 109) (LEFT_PAREN . 107))
+ ((default . error) (COLON_EQUAL . (parameter_profile_opt . 1))
(RIGHT_PAREN . (parameter_profile_opt . 1)) (RENAMES . (parameter_profile_opt .
1)) (IS . (parameter_profile_opt . 1)) (DO . (parameter_profile_opt . 1)) (WITH
. (parameter_profile_opt . 1)) (SEMICOLON . (parameter_profile_opt . 1)) (WHEN
. (parameter_profile_opt . 1)))
((default . error) (RENAMES . (procedure_specification . 0)) (IS .
(procedure_specification . 0)) (SEMICOLON . (procedure_specification . 0))
(WITH . (procedure_specification . 0)))
- ((default . error) (DOT . 87) (TICK . 88) (RIGHT_PAREN . 140)
(LEFT_PAREN . 106))
+ ((default . error) (DOT . 90) (TICK . 91) (RIGHT_PAREN . 141)
(LEFT_PAREN . 107))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
- ((default . error) (WITH . (use_clause . 0)) (SEPARATE . (use_clause .
0)) (LIMITED . (use_clause . 0)) ($EOI . (use_clause . 0)) (PRIVATE .
(use_clause . 0)) (END . (use_clause . 0)) (BEGIN . (use_clause . 0))
(IDENTIFIER . (use_clause . 0)) (ENTRY . (use_clause . 0)) (FOR . (use_clause .
0)) (FUNCTION . (use_clause . 0)) (GENERIC . (use_clause . 0)) (NOT .
(use_clause . 0)) (OVERRIDING . (use_clause . 0)) (PACKAGE . (use_clause . 0))
(PRAGMA . (use_clause . 0)) (PROCEDURE . (use_ [...]
- ((default . error) (COMMA . 119) (SEMICOLON . 138))
+ ((default . error) (SEPARATE . (use_clause . 0)) (LIMITED . (use_clause
. 0)) ($EOI . (use_clause . 0)) (WITH . (use_clause . 0)) (PRIVATE .
(use_clause . 0)) (END . (use_clause . 0)) (BEGIN . (use_clause . 0)) (ENTRY .
(use_clause . 0)) (FOR . (use_clause . 0)) (FUNCTION . (use_clause . 0))
(GENERIC . (use_clause . 0)) (NOT . (use_clause . 0)) (OVERRIDING . (use_clause
. 0)) (PACKAGE . (use_clause . 0)) (PRAGMA . (use_clause . 0)) (PROCEDURE .
(use_clause . 0)) (PROTECTED . (use_c [...]
+ ((default . error) (COMMA . 120) (SEMICOLON . 139))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
((default . error) (WITH . (with_clause . 3)) (USE . (with_clause . 3))
(SEPARATE . (with_clause . 3)) (PROCEDURE . (with_clause . 3)) (PRIVATE .
(with_clause . 3)) (PRAGMA . (with_clause . 3)) (PACKAGE . (with_clause . 3))
(OVERRIDING . (with_clause . 3)) (NOT . (with_clause . 3)) (LIMITED .
(with_clause . 3)) (GENERIC . (with_clause . 3)) (FUNCTION . (with_clause . 3))
($EOI . (with_clause . 3)))
- ((default . error) (SEMICOLON . 136))
- ((default . error) (WITH . (generic_package_declaration . 0)) (SEPARATE
. (generic_package_declaration . 0)) (LIMITED . (generic_package_declaration .
0)) ($EOI . (generic_package_declaration . 0)) (END .
(generic_package_declaration . 0)) (PRIVATE . (generic_package_declaration .
0)) (USE . (generic_package_declaration . 0)) (TYPE .
(generic_package_declaration . 0)) (TASK . (generic_package_declaration . 0))
(SUBTYPE . (generic_package_declaration . 0)) (PROTECTED . (generic_pack [...]
- ((default . error) (DOT . 87) (TICK . 88) (IS .
(aspect_specification_opt . 0)) (WITH . 108) (LEFT_PAREN . 106))
+ ((default . error) (SEMICOLON . 137))
+ ((default . error) (WITH . (generic_package_declaration . 0)) (SEPARATE
. (generic_package_declaration . 0)) (LIMITED . (generic_package_declaration .
0)) ($EOI . (generic_package_declaration . 0)) (END .
(generic_package_declaration . 0)) (PRIVATE . (generic_package_declaration .
0)) (IDENTIFIER . (generic_package_declaration . 0)) (USE .
(generic_package_declaration . 0)) (TYPE . (generic_package_declaration . 0))
(TASK . (generic_package_declaration . 0)) (SUBTYPE . (generic_pac [...]
+ ((default . error) (DOT . 90) (TICK . 91) (IS .
(aspect_specification_opt . 0)) (WITH . 109) (LEFT_PAREN . 107))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
- ((default . error) (SEMICOLON . 133) (IS . 134))
- ((default . error) (DOT . 87) (TICK . 88) (IS . ( 132
(parameter_profile_opt . 0))) (SEMICOLON . (parameter_profile_opt . 0)) (WITH .
(parameter_profile_opt . 0)) (RENAMES . (parameter_profile_opt . 0))
(LEFT_PAREN . 89))
- ((default . error) (DOT . 87) (TICK . 88) (IS . 131) (RETURN . 90)
(LEFT_PAREN . 89))
- ((default . error) (NEW . 390))
- ((default . error) (NEW . 389))
- ((default . error) (TYPE . (subprogram_declaration . 0)) (TASK .
(subprogram_declaration . 0)) (SUBTYPE . (subprogram_declaration . 0))
(PROTECTED . (subprogram_declaration . 0)) (FOR . (subprogram_declaration . 0))
(ENTRY . (subprogram_declaration . 0)) (IDENTIFIER . (subprogram_declaration .
0)) (BEGIN . (subprogram_declaration . 0)) (END . (subprogram_declaration . 0))
(WITH . (subprogram_declaration . 0)) (USE . (subprogram_declaration . 0))
(SEPARATE . (subprogram_declaration [...]
- ((default . error) (BEGIN . (declarative_part_opt . 0)) (USE . 11)
(SUBTYPE . 299) (PRAGMA . 7) (NOT . 4) (OVERRIDING . 5) (FUNCTION .
(overriding_indicator_opt . 2)) (PROCEDURE . (overriding_indicator_opt . 2))
(ENTRY . (overriding_indicator_opt . 2)) (FOR . 296) (IDENTIFIER . 295) (TYPE
. 301) (GENERIC . 2) (PROTECTED . 298) (TASK . 300) (PACKAGE . 297))
- ((default . error) (DOT . 87) (TICK . 88) (SEMICOLON .
(aspect_specification_opt . 0)) (WITH . 108) (LEFT_PAREN . 106))
- ((default . error) (BEGIN . (generic_subprogram_declaration . 0))
(IDENTIFIER . (generic_subprogram_declaration . 0)) (ENTRY .
(generic_subprogram_declaration . 0)) (FOR . (generic_subprogram_declaration .
0)) (FUNCTION . (generic_subprogram_declaration . 0)) (GENERIC .
(generic_subprogram_declaration . 0)) (NOT . (generic_subprogram_declaration .
0)) (OVERRIDING . (generic_subprogram_declaration . 0)) (PACKAGE .
(generic_subprogram_declaration . 0)) (PRAGMA . (generic_subprogram_d [...]
- ((default . error) (COMMA . 119) (SEMICOLON . 386))
- ((default . error) (USE . (use_clause . 2)) (TYPE . (use_clause . 2))
(TASK . (use_clause . 2)) (SUBTYPE . (use_clause . 2)) (PROTECTED . (use_clause
. 2)) (PROCEDURE . (use_clause . 2)) (PRAGMA . (use_clause . 2)) (PACKAGE .
(use_clause . 2)) (OVERRIDING . (use_clause . 2)) (NOT . (use_clause . 2))
(GENERIC . (use_clause . 2)) (FUNCTION . (use_clause . 2)) (FOR . (use_clause .
2)) (ENTRY . (use_clause . 2)) (IDENTIFIER . (use_clause . 2)) (BEGIN .
(use_clause . 2)) (END . (use_cla [...]
- ((default . error) (DOT . 87) (TICK . 88) (SEMICOLON . (name_list .
1)) (COMMA . (name_list . 1)) (LEFT_PAREN . 106))
- ((default . error) (PROTECTED . 382) (TASK . 383) (PACKAGE . 381)
(NOT . 4) (OVERRIDING . 5) (FUNCTION . (overriding_indicator_opt . 2))
(PROCEDURE . (overriding_indicator_opt . 2)))
+ ((default . error) (SEMICOLON . 135) (IS . 134))
+ ((default . error) (DOT . 90) (TICK . 91) (IS . ( 133
(parameter_profile_opt . 0))) (SEMICOLON . (parameter_profile_opt . 0)) (WITH .
(parameter_profile_opt . 0)) (RENAMES . (parameter_profile_opt . 0))
(LEFT_PAREN . 88))
+ ((default . error) (DOT . 90) (TICK . 91) (IS . 132) (RETURN . 89)
(LEFT_PAREN . 88))
+ ((default . error) (NEW . 399))
+ ((default . error) (NEW . 398))
+ ((default . error) (BEGIN . (declarative_part_opt . 0)) (USE . 11)
(SUBTYPE . 302) (PRAGMA . 7) (NOT . 4) (OVERRIDING . 5) (FUNCTION .
(overriding_indicator_opt . 2)) (PROCEDURE . (overriding_indicator_opt . 2))
(ENTRY . (overriding_indicator_opt . 2)) (FOR . 299) (IDENTIFIER . 305) (TYPE
. 304) (GENERIC . 2) (PROTECTED . 301) (TASK . 303) (PACKAGE . 300))
+ ((default . error) (IDENTIFIER . (subprogram_declaration . 0)) (TYPE .
(subprogram_declaration . 0)) (TASK . (subprogram_declaration . 0)) (SUBTYPE .
(subprogram_declaration . 0)) (PROTECTED . (subprogram_declaration . 0)) (FOR .
(subprogram_declaration . 0)) (ENTRY . (subprogram_declaration . 0)) (BEGIN .
(subprogram_declaration . 0)) (END . (subprogram_declaration . 0)) (WITH .
(subprogram_declaration . 0)) (USE . (subprogram_declaration . 0)) (SEPARATE .
(subprogram_declaration [...]
+ ((default . error) (DOT . 90) (TICK . 91) (SEMICOLON .
(aspect_specification_opt . 0)) (WITH . 109) (LEFT_PAREN . 107))
+ ((default . error) (BEGIN . (generic_subprogram_declaration . 0)) (ENTRY
. (generic_subprogram_declaration . 0)) (FOR . (generic_subprogram_declaration
. 0)) (FUNCTION . (generic_subprogram_declaration . 0)) (GENERIC .
(generic_subprogram_declaration . 0)) (NOT . (generic_subprogram_declaration .
0)) (OVERRIDING . (generic_subprogram_declaration . 0)) (PACKAGE .
(generic_subprogram_declaration . 0)) (PRAGMA . (generic_subprogram_declaration
. 0)) (PROCEDURE . (generic_subprogram_de [...]
+ ((default . error) (COMMA . 120) (SEMICOLON . 395))
+ ((default . error) (IDENTIFIER . (use_clause . 2)) (USE . (use_clause .
2)) (TYPE . (use_clause . 2)) (TASK . (use_clause . 2)) (SUBTYPE . (use_clause
. 2)) (PROTECTED . (use_clause . 2)) (PROCEDURE . (use_clause . 2)) (PRAGMA .
(use_clause . 2)) (PACKAGE . (use_clause . 2)) (OVERRIDING . (use_clause . 2))
(NOT . (use_clause . 2)) (GENERIC . (use_clause . 2)) (FUNCTION . (use_clause .
2)) (FOR . (use_clause . 2)) (ENTRY . (use_clause . 2)) (BEGIN . (use_clause .
2)) (END . (use_cla [...]
+ ((default . error) (DOT . 90) (TICK . 91) (SEMICOLON . (name_list .
1)) (COMMA . (name_list . 1)) (LEFT_PAREN . 107))
+ ((default . error) (PROTECTED . 391) (TASK . 392) (PACKAGE . 390)
(NOT . 4) (OVERRIDING . 5) (FUNCTION . (overriding_indicator_opt . 2))
(PROCEDURE . (overriding_indicator_opt . 2)))
((default . error) ($EOI . (with_clause . 2)) (FUNCTION . (with_clause .
2)) (GENERIC . (with_clause . 2)) (LIMITED . (with_clause . 2)) (NOT .
(with_clause . 2)) (OVERRIDING . (with_clause . 2)) (PACKAGE . (with_clause .
2)) (PRAGMA . (with_clause . 2)) (PRIVATE . (with_clause . 2)) (PROCEDURE .
(with_clause . 2)) (SEPARATE . (with_clause . 2)) (USE . (with_clause . 2))
(WITH . (with_clause . 2)))
- ((default . error) (SEMICOLON . 133))
- ((default . error) (NUMERIC_LITERAL . (unary_adding_operator . 1))
(IDENTIFIER . (unary_adding_operator . 1)) (STRING_LITERAL .
(unary_adding_operator . 1)) (CHARACTER_LITERAL . (unary_adding_operator . 1))
(ABS . (unary_adding_operator . 1)) (LEFT_PAREN . (unary_adding_operator . 1))
(NEW . (unary_adding_operator . 1)) (NOT . (unary_adding_operator . 1)) (NULL .
(unary_adding_operator . 1)))
- ((default . error) (NUMERIC_LITERAL . (unary_adding_operator . 0))
(IDENTIFIER . (unary_adding_operator . 0)) (STRING_LITERAL .
(unary_adding_operator . 0)) (CHARACTER_LITERAL . (unary_adding_operator . 0))
(ABS . (unary_adding_operator . 0)) (LEFT_PAREN . (unary_adding_operator . 0))
(NEW . (unary_adding_operator . 0)) (NOT . (unary_adding_operator . 0)) (NULL .
(unary_adding_operator . 0)))
- ((default . error) (OF . (primary . 0)) (COLON_EQUAL . (primary . 0))
(DO . (primary . 0)) (LOOP . (primary . 0)) (ELSIF . (primary . 0)) (ELSE .
(primary . 0)) (DIGITS . (primary . 0)) (RIGHT_PAREN . (primary . 0)) (COMMA .
(primary . 0)) (RANGE . (primary . 0)) (THEN . (primary . 0)) (WITH . (primary
. 0)) (BAR . (primary . 0)) (EQUAL_GREATER . (primary . 0)) (IS . (primary .
0)) (IN . (primary . 0)) (NOT . (primary . 0)) (EQUAL . (primary . 0)) (GREATER
. (primary . 0)) (GREATER [...]
- ((default . error) (EQUAL_GREATER . 379) (RIGHT_PAREN . (name . 0))
(COMMA . (name . 0)) (STAR_STAR . (name . 0)) (REM . (name . 0)) (MOD . (name .
0)) (STAR . (name . 0)) (SLASH . (name . 0)) (SLASH_EQUAL . (name . 0))
(LESS_EQUAL . (name . 0)) (LESS . (name . 0)) (GREATER_EQUAL . (name . 0))
(GREATER . (name . 0)) (EQUAL . (name . 0)) (NOT . (name . 0)) (IN . (name .
0)) (AMPERSAND . (name . 0)) (MINUS . (name . 0)) (PLUS . (name . 0))
(LEFT_PAREN . (name . 0)) (AND . (name . 0) [...]
- ((default . error) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
- ((default . error) (CASE . 232) (IF . 233) (FOR . 374) (RIGHT_PAREN .
((association_opt . 0) (expression_opt . 0))) (COMMA . ((association_opt . 0)
(expression_opt . 0))) (EQUAL_GREATER . (discrete_choice_list . 0)) (BAR .
(discrete_choice_list . 0)) (RAISE . 152) (PLUS . 144) (MINUS . 143) (OTHERS
. 175) (ABS . 147) (NOT . 174) (IDENTIFIER . 48) (CHARACTER_LITERAL . 173)
(STRING_LITERAL . 49) (NUMERIC_LITERAL . 145) (NULL . 234) (NEW . 149)
(LEFT_PAREN . 148))
+ ((default . error) (SEMICOLON . 135))
+ ((default . error) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
+ ((default . error) (RAISE . 152) (PLUS . 154) (MINUS . 153) (ABS .
144) (NOT . 150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
+ ((default . error) (ALL . 385) (SOME . 386))
+ ((default . error) (RAISE . 152) (PLUS . 154) (MINUS . 153) (ABS .
144) (NOT . 150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
+ ((default . error) (FOR . 146) (CASE . 145) (IF . 147) (RIGHT_PAREN .
((expression_opt . 0) (association_opt . 0))) (COMMA . ((expression_opt . 0)
(association_opt . 0))) (EQUAL_GREATER . (discrete_choice_list . 0)) (BAR .
(discrete_choice_list . 0)) (RAISE . 152) (PLUS . 154) (MINUS . 153) (OTHERS
. 182) (ABS . 144) (NOT . 181) (IDENTIFIER . 48) (CHARACTER_LITERAL . 183)
(STRING_LITERAL . 49) (NUMERIC_LITERAL . 155) (NULL . 380) (NEW . 149)
(LEFT_PAREN . 148))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
- ((default . error) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
- ((default . error) (OF . (primary . 1)) (COLON_EQUAL . (primary . 1))
(DO . (primary . 1)) (LOOP . (primary . 1)) (ELSIF . (primary . 1)) (ELSE .
(primary . 1)) (DIGITS . (primary . 1)) (RIGHT_PAREN . (primary . 1)) (COMMA .
(primary . 1)) (RANGE . (primary . 1)) (THEN . (primary . 1)) (WITH . (primary
. 1)) (BAR . (primary . 1)) (EQUAL_GREATER . (primary . 1)) (IS . (primary .
1)) (IN . (primary . 1)) (NOT . (primary . 1)) (EQUAL . (primary . 1)) (GREATER
. (primary . 1)) (GREATER [...]
+ ((default . error) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
+ ((default . error) (OF . (primary . 1)) (COLON_EQUAL . (primary . 1))
(DO . (primary . 1)) (LOOP . (primary . 1)) (ELSIF . (primary . 1)) (ELSE .
(primary . 1)) (DIGITS . (primary . 1)) (RIGHT_PAREN . (primary . 1)) (COMMA .
(primary . 1)) (RANGE . (primary . 1)) (THEN . (primary . 1)) (WITH . (primary
. 1)) (BAR . (primary . 1)) (EQUAL_GREATER . (primary . 1)) (IS . (primary .
1)) (IN . (primary . 1)) (NOT . (primary . 1)) (EQUAL . (primary . 1)) (GREATER
. (primary . 1)) (GREATER [...]
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
- ((default . error) (OF . (primary . 2)) (COLON_EQUAL . (primary . 2))
(DO . (primary . 2)) (LOOP . (primary . 2)) (ELSIF . (primary . 2)) (ELSE .
(primary . 2)) (DIGITS . (primary . 2)) (RIGHT_PAREN . (primary . 2)) (COMMA .
(primary . 2)) (RANGE . (primary . 2)) (THEN . (primary . 2)) (WITH . (primary
. 2)) (BAR . (primary . 2)) (EQUAL_GREATER . (primary . 2)) (IS . (primary .
2)) (IN . (primary . 2)) (NOT . (primary . 2)) (EQUAL . (primary . 2)) (GREATER
. (primary . 2)) (GREATER [...]
+ ((default . error) (ABS . (unary_adding_operator . 1)) (LEFT_PAREN .
(unary_adding_operator . 1)) (NEW . (unary_adding_operator . 1)) (NOT .
(unary_adding_operator . 1)) (NULL . (unary_adding_operator . 1))
(NUMERIC_LITERAL . (unary_adding_operator . 1)) (IDENTIFIER .
(unary_adding_operator . 1)) (STRING_LITERAL . (unary_adding_operator . 1))
(CHARACTER_LITERAL . (unary_adding_operator . 1)))
+ ((default . error) (ABS . (unary_adding_operator . 0)) (LEFT_PAREN .
(unary_adding_operator . 0)) (NEW . (unary_adding_operator . 0)) (NOT .
(unary_adding_operator . 0)) (NULL . (unary_adding_operator . 0))
(NUMERIC_LITERAL . (unary_adding_operator . 0)) (IDENTIFIER .
(unary_adding_operator . 0)) (STRING_LITERAL . (unary_adding_operator . 0))
(CHARACTER_LITERAL . (unary_adding_operator . 0)))
+ ((default . error) (OF . (primary . 0)) (COLON_EQUAL . (primary . 0))
(DO . (primary . 0)) (LOOP . (primary . 0)) (ELSIF . (primary . 0)) (ELSE .
(primary . 0)) (DIGITS . (primary . 0)) (RIGHT_PAREN . (primary . 0)) (COMMA .
(primary . 0)) (RANGE . (primary . 0)) (THEN . (primary . 0)) (WITH . (primary
. 0)) (BAR . (primary . 0)) (EQUAL_GREATER . (primary . 0)) (IS . (primary .
0)) (IN . (primary . 0)) (NOT . (primary . 0)) (EQUAL . (primary . 0)) (GREATER
. (primary . 0)) (GREATER [...]
+ ((default . error) (EQUAL_GREATER . 376) (RIGHT_PAREN . (name . 0))
(COMMA . (name . 0)) (STAR_STAR . (name . 0)) (STAR . (name . 0)) (SLASH .
(name . 0)) (REM . (name . 0)) (MOD . (name . 0)) (SLASH_EQUAL . (name . 0))
(LESS_EQUAL . (name . 0)) (LESS . (name . 0)) (GREATER_EQUAL . (name . 0))
(GREATER . (name . 0)) (EQUAL . (name . 0)) (NOT . (name . 0)) (IN . (name .
0)) (AMPERSAND . (name . 0)) (MINUS . (name . 0)) (PLUS . (name . 0))
(LEFT_PAREN . (name . 0)) (AND . (name . 0) [...]
+ ((default . error) (OF . (primary . 2)) (COLON_EQUAL . (primary . 2))
(DO . (primary . 2)) (LOOP . (primary . 2)) (ELSIF . (primary . 2)) (ELSE .
(primary . 2)) (DIGITS . (primary . 2)) (RIGHT_PAREN . (primary . 2)) (COMMA .
(primary . 2)) (RANGE . (primary . 2)) (THEN . (primary . 2)) (WITH . (primary
. 2)) (BAR . (primary . 2)) (EQUAL_GREATER . (primary . 2)) (IS . (primary .
2)) (IN . (primary . 2)) (NOT . (primary . 2)) (EQUAL . (primary . 2)) (GREATER
. (primary . 2)) (GREATER [...]
+ ((default . error) (COMMA . (conditional_quantified_expression . 1))
(RIGHT_PAREN . (conditional_quantified_expression . 1)))
+ ((default . error) (COMMA . (pragma_argument_association . 2))
(RIGHT_PAREN . (pragma_argument_association . 2)))
((default . error) (COMMA . (pragma_argument_association . 1))
(RIGHT_PAREN . (pragma_argument_association . 1)))
- ((default . error) (OF . (term . 0)) (COLON_EQUAL . (term . 0)) (DO .
(term . 0)) (LOOP . (term . 0)) (ELSIF . (term . 0)) (ELSE . (term . 0))
(DIGITS . (term . 0)) (RIGHT_PAREN . (term . 0)) (COMMA . (term . 0)) (RANGE .
(term . 0)) (THEN . (term . 0)) (WITH . (term . 0)) (BAR . (term . 0))
(EQUAL_GREATER . (term . 0)) (IS . (term . 0)) (IN . (term . 0)) (NOT . (term .
0)) (EQUAL . (term . 0)) (GREATER . (term . 0)) (GREATER_EQUAL . (term . 0))
(LESS . (term . 0)) (LESS_EQUAL . (t [...]
- ((default . error) (DOT . 87) (OF . (primary . 3)) (COLON_EQUAL .
(primary . 3)) (DO . (primary . 3)) (LOOP . (primary . 3)) (BAR . (primary .
3)) (COMMA . (primary . 3)) (ELSIF . (primary . 3)) (ELSE . (primary . 3))
(EQUAL_GREATER . (primary . 3)) (RIGHT_PAREN . (primary . 3)) (DIGITS .
(primary . 3)) (RANGE . (primary . 3)) (THEN . (primary . 3)) (DOT_DOT .
(primary . 3)) (WITH . (primary . 3)) (IS . (primary . 3)) (IN . (primary . 3))
(NOT . (primary . 3)) (EQUAL . (primary . [...]
+ ((default . error) (OF . (term . 0)) (COLON_EQUAL . (term . 0)) (DO .
(term . 0)) (LOOP . (term . 0)) (ELSIF . (term . 0)) (ELSE . (term . 0))
(DIGITS . (term . 0)) (RIGHT_PAREN . (term . 0)) (COMMA . (term . 0)) (RANGE .
(term . 0)) (THEN . (term . 0)) (WITH . (term . 0)) (BAR . (term . 0))
(EQUAL_GREATER . (term . 0)) (IS . (term . 0)) (IN . (term . 0)) (NOT . (term .
0)) (EQUAL . (term . 0)) (GREATER . (term . 0)) (GREATER_EQUAL . (term . 0))
(LESS . (term . 0)) (LESS_EQUAL . (t [...]
+ ((default . error) (COMMA . (conditional_quantified_expression . 0))
(RIGHT_PAREN . (conditional_quantified_expression . 0)))
+ ((default . error) (DOT . 90) (OF . (primary . 3)) (COLON_EQUAL .
(primary . 3)) (DO . (primary . 3)) (LOOP . (primary . 3)) (BAR . (primary .
3)) (COMMA . (primary . 3)) (ELSIF . (primary . 3)) (ELSE . (primary . 3))
(EQUAL_GREATER . (primary . 3)) (RIGHT_PAREN . (primary . 3)) (DIGITS .
(primary . 3)) (RANGE . (primary . 3)) (THEN . (primary . 3)) (DOT_DOT .
(primary . 3)) (WITH . (primary . 3)) (IS . (primary . 3)) (IN . (primary . 3))
(NOT . (primary . 3)) (EQUAL . (primary . [...]
((default . error) (RIGHT_PAREN . (pragma_argument_association_list .
0)) (COMMA . (pragma_argument_association_list . 0)))
- ((default . error) (COMMA . 370) (RIGHT_PAREN . 371))
- ((default . error) (OF . (factor . 1)) (COLON_EQUAL . (factor . 1)) (DO
. (factor . 1)) (LOOP . (factor . 1)) (ELSIF . (factor . 1)) (ELSE . (factor .
1)) (DIGITS . (factor . 1)) (COMMA . (factor . 1)) (RIGHT_PAREN . (factor . 1))
(RANGE . (factor . 1)) (THEN . (factor . 1)) (WITH . (factor . 1)) (BAR .
(factor . 1)) (EQUAL_GREATER . (factor . 1)) (IS . (factor . 1)) (SLASH_EQUAL .
(factor . 1)) (LESS_EQUAL . (factor . 1)) (LESS . (factor . 1)) (GREATER_EQUAL
. (factor . 1)) (GREAT [...]
+ ((default . error) (COMMA . 375) (RIGHT_PAREN . 374))
+ ((default . error) (OF . (factor . 1)) (COLON_EQUAL . (factor . 1)) (DO
. (factor . 1)) (LOOP . (factor . 1)) (ELSIF . (factor . 1)) (ELSE . (factor .
1)) (DIGITS . (factor . 1)) (COMMA . (factor . 1)) (RIGHT_PAREN . (factor . 1))
(RANGE . (factor . 1)) (THEN . (factor . 1)) (WITH . (factor . 1)) (BAR .
(factor . 1)) (EQUAL_GREATER . (factor . 1)) (IS . (factor . 1)) (SLASH_EQUAL .
(factor . 1)) (LESS_EQUAL . (factor . 1)) (LESS . (factor . 1)) (GREATER_EQUAL
. (factor . 1)) (GREAT [...]
+ ((default . error) (COMMA . (conditional_quantified_expression . 2))
(RIGHT_PAREN . (conditional_quantified_expression . 2)))
((default . error) (DO . (relation . 4)) (LOOP . (relation . 4)) (ELSIF
. (relation . 4)) (ELSE . (relation . 4)) (EQUAL_GREATER . (relation . 4))
(DIGITS . (relation . 4)) (RIGHT_PAREN . (relation . 4)) (COMMA . (relation .
4)) (RANGE . (relation . 4)) (THEN . (relation . 4)) (SEMICOLON . (relation .
4)) (WITH . (relation . 4)) (IS . (relation . 4)) (AND . (relation . 4)) (OR .
(relation . 4)) (XOR . (relation . 4)))
- ((default . error) (DO . (expression . 1)) (LOOP . (expression . 1))
(XOR . (expression . 1)) (OR . (expression . 1)) (AND . ( 368 (expression .
1))) (ELSIF . (expression . 1)) (ELSE . (expression . 1)) (EQUAL_GREATER .
(expression . 1)) (DIGITS . (expression . 1)) (COMMA . (expression . 1))
(RIGHT_PAREN . (expression . 1)) (RANGE . (expression . 1)) (THEN . (expression
. 1)) (WITH . (expression . 1)) (SEMICOLON . (expression . 1)) (IS .
(expression . 1)))
- ((default . error) (DO . (expression . 2)) (LOOP . (expression . 2))
(XOR . (expression . 2)) (OR . (expression . 2)) (AND . ( 367 (expression .
2))) (ELSIF . (expression . 2)) (ELSE . (expression . 2)) (EQUAL_GREATER .
(expression . 2)) (DIGITS . (expression . 2)) (COMMA . (expression . 2))
(RIGHT_PAREN . (expression . 2)) (RANGE . (expression . 2)) (THEN . (expression
. 2)) (WITH . (expression . 2)) (SEMICOLON . (expression . 2)) (IS .
(expression . 2)))
- ((default . error) (DO . (expression . 3)) (LOOP . (expression . 3))
(XOR . (expression . 3)) (OR . ( 366 (expression . 3))) (AND . (expression .
3)) (ELSIF . (expression . 3)) (ELSE . (expression . 3)) (EQUAL_GREATER .
(expression . 3)) (DIGITS . (expression . 3)) (COMMA . (expression . 3))
(RIGHT_PAREN . (expression . 3)) (RANGE . (expression . 3)) (THEN . (expression
. 3)) (WITH . (expression . 3)) (SEMICOLON . (expression . 3)) (IS .
(expression . 3)))
- ((default . error) (DO . (expression . 4)) (LOOP . (expression . 4))
(XOR . (expression . 4)) (OR . ( 365 (expression . 4))) (AND . (expression .
4)) (ELSIF . (expression . 4)) (ELSE . (expression . 4)) (EQUAL_GREATER .
(expression . 4)) (DIGITS . (expression . 4)) (COMMA . (expression . 4))
(RIGHT_PAREN . (expression . 4)) (RANGE . (expression . 4)) (THEN . (expression
. 4)) (WITH . (expression . 4)) (SEMICOLON . (expression . 4)) (IS .
(expression . 4)))
- ((default . error) (DO . (expression . 5)) (LOOP . (expression . 5))
(XOR . ( 364 (expression . 5))) (OR . (expression . 5)) (AND . (expression .
5)) (ELSIF . (expression . 5)) (ELSE . (expression . 5)) (EQUAL_GREATER .
(expression . 5)) (DIGITS . (expression . 5)) (COMMA . (expression . 5))
(RIGHT_PAREN . (expression . 5)) (RANGE . (expression . 5)) (THEN . (expression
. 5)) (WITH . (expression . 5)) (SEMICOLON . (expression . 5)) (IS .
(expression . 5)))
- ((default . error) (DO . (expression . 0)) (LOOP . (expression . 0))
(XOR . ( 363 (expression . 0))) (OR . ( 362 (expression . 0))) (AND . ( 361
(expression . 0))) (ELSIF . (expression . 0)) (ELSE . (expression . 0))
(EQUAL_GREATER . (expression . 0)) (DIGITS . (expression . 0)) (COMMA .
(expression . 0)) (RIGHT_PAREN . (expression . 0)) (RANGE . (expression . 0))
(THEN . (expression . 0)) (WITH . (expression . 0)) (SEMICOLON . (expression .
0)) (IS . (expression . 0)))
- ((default . error) (IN . 278) (NOT . 279) (DO . (relation . 0)) (LOOP
. (relation . 0)) (COMMA . (relation . 0)) (ELSIF . (relation . 0)) (ELSE .
(relation . 0)) (EQUAL_GREATER . (relation . 0)) (RIGHT_PAREN . (relation . 0))
(DIGITS . (relation . 0)) (RANGE . (relation . 0)) (THEN . (relation . 0))
(SEMICOLON . (relation . 0)) (WITH . (relation . 0)) (IS . (relation . 0)) (AND
. (relation . 0)) (OR . (relation . 0)) (XOR . (relation . 0)) (EQUAL . 272)
(SLASH_EQUAL . 277) (LES [...]
- ((default . error) (OF . (term_list . 0)) (COLON_EQUAL . (term_list .
0)) (DO . (term_list . 0)) (LOOP . (term_list . 0)) (ELSIF . (term_list . 0))
(ELSE . (term_list . 0)) (DIGITS . (term_list . 0)) (COMMA . (term_list . 0))
(RIGHT_PAREN . (term_list . 0)) (RANGE . (term_list . 0)) (THEN . (term_list .
0)) (WITH . (term_list . 0)) (BAR . (term_list . 0)) (EQUAL_GREATER .
(term_list . 0)) (IS . (term_list . 0)) (SLASH_EQUAL . (term_list . 0))
(LESS_EQUAL . (term_list . 0)) (LESS . [...]
- ((default . error) (OF . (simple_expression . 1)) (COLON_EQUAL .
(simple_expression . 1)) (DO . (simple_expression . 1)) (LOOP .
(simple_expression . 1)) (ELSIF . (simple_expression . 1)) (ELSE .
(simple_expression . 1)) (DIGITS . (simple_expression . 1)) (RIGHT_PAREN .
(simple_expression . 1)) (COMMA . (simple_expression . 1)) (RANGE .
(simple_expression . 1)) (THEN . (simple_expression . 1)) (WITH .
(simple_expression . 1)) (BAR . (simple_expression . 1)) (EQUAL_GREATER .
(simple [...]
- ((default . error) (ABS . 147) (NOT . 150) (NUMERIC_LITERAL . 145)
(NULL . 151) (NEW . 149) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49) (LEFT_PAREN . 148))
- ((default . error) (IS . 349))
- ((default . error) (END . (declarative_part_opt . 0)) (PRIVATE .
(declarative_part_opt . 0)) (USE . 11) (SUBTYPE . 299) (PRAGMA . 7) (NOT .
4) (OVERRIDING . 5) (FUNCTION . (overriding_indicator_opt . 2)) (PROCEDURE .
(overriding_indicator_opt . 2)) (ENTRY . (overriding_indicator_opt . 2)) (FOR .
296) (IDENTIFIER . 295) (TYPE . 301) (GENERIC . 2) (PROTECTED . 298) (TASK
. 300) (PACKAGE . 297))
- ((default . error) (SEMICOLON . (name . 1)) (IS . (name . 1)) (WITH .
(name . 1)) (RANGE . (name . 1)) (TICK . (name . 1)) (LEFT_PAREN . (name . 1))
(DOT . (name . 1)) (PLUS . (name . 1)) (MINUS . (name . 1)) (AMPERSAND . (name
. 1)) (DOT_DOT . (name . 1)) (IN . (name . 1)) (NOT . (name . 1)) (EQUAL .
(name . 1)) (GREATER . (name . 1)) (GREATER_EQUAL . (name . 1)) (LESS . (name .
1)) (LESS_EQUAL . (name . 1)) (SLASH_EQUAL . (name . 1)) (RIGHT_PAREN . (name .
1)) (COMMA . (name . 1) [...]
- ((default . error) (NUMERIC_LITERAL . 145) (NULL . 292) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
+ ((default . error) (DO . (expression . 1)) (LOOP . (expression . 1))
(XOR . (expression . 1)) (OR . (expression . 1)) (AND . ( 372 (expression .
1))) (ELSIF . (expression . 1)) (ELSE . (expression . 1)) (EQUAL_GREATER .
(expression . 1)) (DIGITS . (expression . 1)) (COMMA . (expression . 1))
(RIGHT_PAREN . (expression . 1)) (RANGE . (expression . 1)) (THEN . (expression
. 1)) (WITH . (expression . 1)) (SEMICOLON . (expression . 1)) (IS .
(expression . 1)))
+ ((default . error) (DO . (expression . 2)) (LOOP . (expression . 2))
(XOR . (expression . 2)) (OR . (expression . 2)) (AND . ( 371 (expression .
2))) (ELSIF . (expression . 2)) (ELSE . (expression . 2)) (EQUAL_GREATER .
(expression . 2)) (DIGITS . (expression . 2)) (COMMA . (expression . 2))
(RIGHT_PAREN . (expression . 2)) (RANGE . (expression . 2)) (THEN . (expression
. 2)) (WITH . (expression . 2)) (SEMICOLON . (expression . 2)) (IS .
(expression . 2)))
+ ((default . error) (DO . (expression . 3)) (LOOP . (expression . 3))
(XOR . (expression . 3)) (OR . ( 370 (expression . 3))) (AND . (expression .
3)) (ELSIF . (expression . 3)) (ELSE . (expression . 3)) (EQUAL_GREATER .
(expression . 3)) (DIGITS . (expression . 3)) (COMMA . (expression . 3))
(RIGHT_PAREN . (expression . 3)) (RANGE . (expression . 3)) (THEN . (expression
. 3)) (WITH . (expression . 3)) (SEMICOLON . (expression . 3)) (IS .
(expression . 3)))
+ ((default . error) (DO . (expression . 4)) (LOOP . (expression . 4))
(XOR . (expression . 4)) (OR . ( 369 (expression . 4))) (AND . (expression .
4)) (ELSIF . (expression . 4)) (ELSE . (expression . 4)) (EQUAL_GREATER .
(expression . 4)) (DIGITS . (expression . 4)) (COMMA . (expression . 4))
(RIGHT_PAREN . (expression . 4)) (RANGE . (expression . 4)) (THEN . (expression
. 4)) (WITH . (expression . 4)) (SEMICOLON . (expression . 4)) (IS .
(expression . 4)))
+ ((default . error) (DO . (expression . 5)) (LOOP . (expression . 5))
(XOR . ( 368 (expression . 5))) (OR . (expression . 5)) (AND . (expression .
5)) (ELSIF . (expression . 5)) (ELSE . (expression . 5)) (EQUAL_GREATER .
(expression . 5)) (DIGITS . (expression . 5)) (COMMA . (expression . 5))
(RIGHT_PAREN . (expression . 5)) (RANGE . (expression . 5)) (THEN . (expression
. 5)) (WITH . (expression . 5)) (SEMICOLON . (expression . 5)) (IS .
(expression . 5)))
+ ((default . error) (DO . (expression . 0)) (LOOP . (expression . 0))
(XOR . ( 367 (expression . 0))) (OR . ( 366 (expression . 0))) (AND . ( 365
(expression . 0))) (ELSIF . (expression . 0)) (ELSE . (expression . 0))
(EQUAL_GREATER . (expression . 0)) (DIGITS . (expression . 0)) (COMMA .
(expression . 0)) (RIGHT_PAREN . (expression . 0)) (RANGE . (expression . 0))
(THEN . (expression . 0)) (WITH . (expression . 0)) (SEMICOLON . (expression .
0)) (IS . (expression . 0)))
+ ((default . error) (IN . 275) (NOT . 276) (DO . (relation . 0)) (LOOP
. (relation . 0)) (COMMA . (relation . 0)) (ELSIF . (relation . 0)) (ELSE .
(relation . 0)) (EQUAL_GREATER . (relation . 0)) (RIGHT_PAREN . (relation . 0))
(DIGITS . (relation . 0)) (RANGE . (relation . 0)) (THEN . (relation . 0))
(SEMICOLON . (relation . 0)) (WITH . (relation . 0)) (IS . (relation . 0)) (AND
. (relation . 0)) (OR . (relation . 0)) (XOR . (relation . 0)) (EQUAL . 278)
(SLASH_EQUAL . 283) (LES [...]
+ ((default . error) (OF . (term_list . 0)) (COLON_EQUAL . (term_list .
0)) (DO . (term_list . 0)) (LOOP . (term_list . 0)) (ELSIF . (term_list . 0))
(ELSE . (term_list . 0)) (DIGITS . (term_list . 0)) (COMMA . (term_list . 0))
(RIGHT_PAREN . (term_list . 0)) (RANGE . (term_list . 0)) (THEN . (term_list .
0)) (WITH . (term_list . 0)) (BAR . (term_list . 0)) (EQUAL_GREATER .
(term_list . 0)) (IS . (term_list . 0)) (SLASH_EQUAL . (term_list . 0))
(LESS_EQUAL . (term_list . 0)) (LESS . [...]
+ ((default . error) (OF . (simple_expression . 1)) (COLON_EQUAL .
(simple_expression . 1)) (DO . (simple_expression . 1)) (LOOP .
(simple_expression . 1)) (ELSIF . (simple_expression . 1)) (ELSE .
(simple_expression . 1)) (DIGITS . (simple_expression . 1)) (RIGHT_PAREN .
(simple_expression . 1)) (COMMA . (simple_expression . 1)) (RANGE .
(simple_expression . 1)) (THEN . (simple_expression . 1)) (WITH .
(simple_expression . 1)) (BAR . (simple_expression . 1)) (EQUAL_GREATER .
(simple [...]
+ ((default . error) (ABS . 144) (NOT . 150) (NUMERIC_LITERAL . 155)
(NULL . 151) (NEW . 149) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49) (LEFT_PAREN . 148))
+ ((default . error) (IS . 353))
+ ((default . error) (END . (declarative_part_opt . 0)) (PRIVATE .
(declarative_part_opt . 0)) (USE . 11) (SUBTYPE . 302) (PRAGMA . 7) (NOT .
4) (OVERRIDING . 5) (FUNCTION . (overriding_indicator_opt . 2)) (PROCEDURE .
(overriding_indicator_opt . 2)) (ENTRY . (overriding_indicator_opt . 2)) (FOR .
299) (IDENTIFIER . 305) (TYPE . 304) (GENERIC . 2) (PROTECTED . 301) (TASK
. 303) (PACKAGE . 300))
+ ((default . error) (NUMERIC_LITERAL . 155) (NULL . 297) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
((default . error) (BAR . (discrete_choice . 3)) (EQUAL_GREATER .
(discrete_choice . 3)))
+ ((default . error) (SEMICOLON . (name . 1)) (IS . (name . 1)) (WITH .
(name . 1)) (RANGE . (name . 1)) (TICK . (name . 1)) (LEFT_PAREN . (name . 1))
(DOT . (name . 1)) (PLUS . (name . 1)) (MINUS . (name . 1)) (AMPERSAND . (name
. 1)) (DOT_DOT . (name . 1)) (IN . (name . 1)) (NOT . (name . 1)) (EQUAL .
(name . 1)) (GREATER . (name . 1)) (GREATER_EQUAL . (name . 1)) (LESS . (name .
1)) (LESS_EQUAL . (name . 1)) (SLASH_EQUAL . (name . 1)) (RIGHT_PAREN . (name .
1)) (COMMA . (name . 1) [...]
((default . error) (SEMICOLON . (association_list . 0)) (IS .
(association_list . 0)) (RIGHT_PAREN . (association_list . 0)) (COMMA .
(association_list . 0)))
- ((default . error) (COMMA . 268) (SEMICOLON . (aspect_specification_opt
. 1)) (IS . (aspect_specification_opt . 1)))
+ ((default . error) (COMMA . 273) (SEMICOLON . (aspect_specification_opt
. 1)) (IS . (aspect_specification_opt . 1)))
((default . error) (BAR . (discrete_choice . 0)) (EQUAL_GREATER .
(discrete_choice . 0)))
- ((default . error) (AND . 291) (EQUAL_GREATER . (choice_expression .
1)) (BAR . (choice_expression . 1)))
- ((default . error) (OR . 290) (EQUAL_GREATER . (choice_expression . 2))
(BAR . (choice_expression . 2)))
- ((default . error) (XOR . 289) (EQUAL_GREATER . (choice_expression .
3)) (BAR . (choice_expression . 3)))
- ((default . error) (AND . 288) (EQUAL_GREATER . (choice_expression .
4)) (BAR . (choice_expression . 4)))
- ((default . error) (OR . 287) (EQUAL_GREATER . (choice_expression . 5))
(BAR . (choice_expression . 5)))
- ((default . error) (XOR . 286) (OR . 285) (AND . 284) (EQUAL_GREATER
. (choice_expression . 0)) (BAR . (choice_expression . 0)))
+ ((default . error) (AND . 295) (EQUAL_GREATER . (choice_expression .
1)) (BAR . (choice_expression . 1)))
+ ((default . error) (OR . 294) (EQUAL_GREATER . (choice_expression . 2))
(BAR . (choice_expression . 2)))
+ ((default . error) (XOR . 293) (EQUAL_GREATER . (choice_expression .
3)) (BAR . (choice_expression . 3)))
+ ((default . error) (AND . 292) (EQUAL_GREATER . (choice_expression .
4)) (BAR . (choice_expression . 4)))
+ ((default . error) (OR . 291) (EQUAL_GREATER . (choice_expression . 5))
(BAR . (choice_expression . 5)))
+ ((default . error) (XOR . 290) (OR . 289) (AND . 288) (EQUAL_GREATER
. (choice_expression . 0)) (BAR . (choice_expression . 0)))
((default . error) (EQUAL_GREATER . (discrete_choice_list . 1)) (BAR .
(discrete_choice_list . 1)))
- ((default . error) (BAR . 282) (EQUAL_GREATER . 283))
+ ((default . error) (BAR . 286) (EQUAL_GREATER . 287))
((default . error) (LOOP . (expression_opt . 1)) (RIGHT_PAREN .
(expression_opt . 1)) (COMMA . (expression_opt . 1)) (SEMICOLON .
(expression_opt . 1)) (THEN . (expression_opt . 1)) (IS . (expression_opt . 1)))
((default . error) (SEMICOLON . (association_opt . 5)) (IS .
(association_opt . 5)) (COMMA . (association_opt . 5)) (RIGHT_PAREN .
(association_opt . 5)))
- ((default . error) (DOT . 87) (DO . (primary . 3)) (LOOP . (primary .
3)) (ELSIF . (primary . 3)) (ELSE . (primary . 3)) (DIGITS . (primary . 3))
(RANGE . (primary . 3)) (THEN . (primary . 3)) (SEMICOLON . (primary . 3)) (IS
. (primary . 3)) (WITH . (primary . 3)) (IN . (primary . 3)) (NOT . (primary .
3)) (RIGHT_PAREN . (primary . 3)) (COMMA . (primary . 3)) (PLUS . (primary .
3)) (MINUS . (primary . 3)) (AMPERSAND . (primary . 3)) (DOT_DOT . (primary .
3)) (SLASH . (primary . 3) [...]
+ ((default . error) (DOT . 90) (DO . (primary . 3)) (LOOP . (primary .
3)) (ELSIF . (primary . 3)) (ELSE . (primary . 3)) (DIGITS . (primary . 3))
(RANGE . (primary . 3)) (THEN . (primary . 3)) (SEMICOLON . (primary . 3)) (IS
. (primary . 3)) (WITH . (primary . 3)) (IN . (primary . 3)) (NOT . (primary .
3)) (RIGHT_PAREN . (primary . 3)) (COMMA . (primary . 3)) (PLUS . (primary .
3)) (MINUS . (primary . 3)) (AMPERSAND . (primary . 3)) (DOT_DOT . (primary .
3)) (MOD . (primary . 3)) [...]
((default . error) (BAR . (discrete_choice . 2)) (EQUAL_GREATER .
(discrete_choice . 2)))
- ((default . error) (IN . 278) (NOT . 279) (SEMICOLON . (relation . 0))
(IS . (relation . 0)) (WITH . (relation . 0)) (RIGHT_PAREN . (relation . 0))
(COMMA . (relation . 0)) (DOT_DOT . 271) (BAR . (choice_relation . 1))
(EQUAL_GREATER . (choice_relation . 1)) (AND . ((relation . 0) (choice_relation
. 1))) (OR . ((relation . 0) (choice_relation . 1))) (XOR . ((relation . 0)
(choice_relation . 1))) (EQUAL . 272) (SLASH_EQUAL . 277) (LESS . 275)
(LESS_EQUAL . 276) (GREATER . 27 [...]
- ((default . error) (DOT . 87) (TICK . 88) (SEMICOLON .
(aspect_specification_opt . 0)) (WITH . 108) (LEFT_PAREN . 106))
- ((default . error) (COMMA . 268) (RIGHT_PAREN . 269))
- ((default . error) (BAR . (discrete_choice . 2)) (EQUAL_GREATER .
(discrete_choice . 2)) (RIGHT_PAREN . 267))
+ ((default . error) (IN . 275) (NOT . 276) (SEMICOLON . (relation . 0))
(IS . (relation . 0)) (WITH . (relation . 0)) (RIGHT_PAREN . (relation . 0))
(COMMA . (relation . 0)) (DOT_DOT . 277) (BAR . (choice_relation . 1))
(EQUAL_GREATER . (choice_relation . 1)) (AND . ((choice_relation . 1) (relation
. 0))) (OR . ((choice_relation . 1) (relation . 0))) (XOR . ((choice_relation .
1) (relation . 0))) (EQUAL . 278) (SLASH_EQUAL . 283) (LESS . 281)
(LESS_EQUAL . 282) (GREATER . 27 [...]
+ ((default . error) (DOT . 90) (TICK . 91) (SEMICOLON .
(aspect_specification_opt . 0)) (WITH . 109) (LEFT_PAREN . 107))
+ ((default . error) (COMMA . 273) (RIGHT_PAREN . 272))
+ ((default . error) (RIGHT_PAREN . 271))
+ ((default . error) (BAR . (discrete_choice . 2)) (EQUAL_GREATER .
(discrete_choice . 2)) (RIGHT_PAREN . (range_list . 0)) (COMMA . (range_list .
0)))
+ ((default . error) (COMMA . 270) (RIGHT_PAREN . 269))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
- ((default . error) (COMMA . 119) (SEMICOLON . 265))
+ ((default . error) (COMMA . 120) (SEMICOLON . 267))
((default . error) ($EOI . (with_clause . 1)) (FUNCTION . (with_clause .
1)) (GENERIC . (with_clause . 1)) (LIMITED . (with_clause . 1)) (NOT .
(with_clause . 1)) (OVERRIDING . (with_clause . 1)) (PACKAGE . (with_clause .
1)) (PRAGMA . (with_clause . 1)) (PRIVATE . (with_clause . 1)) (PROCEDURE .
(with_clause . 1)) (SEPARATE . (with_clause . 1)) (USE . (with_clause . 1))
(WITH . (with_clause . 1)))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
- ((default . error) (BOX . 258) (SEMICOLON .
(discriminant_specification_opt . 0)) (RIGHT_PAREN .
(discriminant_specification_opt . 0)) (IDENTIFIER . 72))
- ((default . error) (IS . 256) (SEMICOLON . (aspect_specification_opt .
0)) (WITH . 108))
- ((default . error) (ABSTRACT . 252) (BOX . 251) (NULL . 253)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49))
- ((default . error) (SEMICOLON . 250))
- ((default . error) (DOT . 87) (TICK . 88) (IS . 249) (LEFT_PAREN .
106))
+ ((default . error) (BOX . 260) (SEMICOLON .
(discriminant_specification_opt . 0)) (RIGHT_PAREN .
(discriminant_specification_opt . 0)) (IDENTIFIER . 77))
+ ((default . error) (IS . 258) (SEMICOLON . (aspect_specification_opt .
0)) (WITH . 109))
+ ((default . error) (ABSTRACT . 253) (BOX . 255) (NULL . 254)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49))
+ ((default . error) (SEMICOLON . 252))
+ ((default . error) (DOT . 90) (TICK . 91) (IS . 251) (LEFT_PAREN .
107))
((default . error) (COLON . (identifier_list . 1)) (COMMA .
(identifier_list . 1)))
- ((default . error) (OUT . 248) (ACCESS . (mode_opt . 1)) (NOT .
(mode_opt . 1)) (IDENTIFIER . (mode_opt . 1)) (STRING_LITERAL . (mode_opt . 1))
(CHARACTER_LITERAL . (mode_opt . 1)))
+ ((default . error) (OUT . 250) (ACCESS . (mode_opt . 1)) (NOT .
(mode_opt . 1)) (IDENTIFIER . (mode_opt . 1)) (STRING_LITERAL . (mode_opt . 1))
(CHARACTER_LITERAL . (mode_opt . 1)))
((default . error) (ACCESS . (mode_opt . 3)) (NOT . (mode_opt . 3))
(IDENTIFIER . (mode_opt . 3)) (STRING_LITERAL . (mode_opt . 3))
(CHARACTER_LITERAL . (mode_opt . 3)))
- ((default . error) (IDENTIFIER . (null_exclusion_opt . 0))
(STRING_LITERAL . (null_exclusion_opt . 0)) (CHARACTER_LITERAL .
(null_exclusion_opt . 0)) (ACCESS . (null_exclusion_opt . 0)) (NOT . 211))
- ((default . error) (IDENTIFIER . (null_exclusion_opt . 0))
(STRING_LITERAL . (null_exclusion_opt . 0)) (CHARACTER_LITERAL .
(null_exclusion_opt . 0)) (RIGHT_PAREN . (null_exclusion_opt . 0)) (DO .
(null_exclusion_opt . 0)) (RENAMES . (null_exclusion_opt . 0)) (COLON_EQUAL .
(null_exclusion_opt . 0)) (WITH . (null_exclusion_opt . 0)) (SEMICOLON .
(null_exclusion_opt . 0)) (IS . (null_exclusion_opt . 0)) (ACCESS .
(null_exclusion_opt . 0)) (NOT . 211))
- ((default . error) (NULL . 243))
- ((default . error) (RIGHT_PAREN . (parameter_and_result_profile . 3))
(DO . (parameter_and_result_profile . 3)) (RENAMES .
(parameter_and_result_profile . 3)) (COLON_EQUAL .
(parameter_and_result_profile . 3)) (WITH . (parameter_and_result_profile . 3))
(SEMICOLON . (parameter_and_result_profile . 3)) (IS .
(parameter_and_result_profile . 3)))
- ((default . error) (DOT . 87) (RIGHT_PAREN . (name_opt . 1)) (DO .
(name_opt . 1)) (RENAMES . (name_opt . 1)) (COLON_EQUAL . (name_opt . 1)) (WITH
. (name_opt . 1)) (IS . (name_opt . 1)) (SEMICOLON . (name_opt . 1)) (TICK .
88) (LEFT_PAREN . 106))
- ((default . error) (RIGHT_PAREN . (parameter_and_result_profile . 1))
(DO . (parameter_and_result_profile . 1)) (RENAMES .
(parameter_and_result_profile . 1)) (COLON_EQUAL .
(parameter_and_result_profile . 1)) (WITH . (parameter_and_result_profile . 1))
(SEMICOLON . (parameter_and_result_profile . 1)) (IS .
(parameter_and_result_profile . 1)))
- ((default . error) (ACCESS . 242))
- ((default . error) (IN . (name . 0)) (NOT . (name . 0)) (EQUAL . (name .
0)) (GREATER . (name . 0)) (GREATER_EQUAL . (name . 0)) (LESS . (name . 0))
(LESS_EQUAL . (name . 0)) (SLASH_EQUAL . (name . 0)) (BAR . (name . 0))
(EQUAL_GREATER . (name . 0)) (AND . (name . 0)) (OR . (name . 0)) (XOR . (name
. 0)) (RIGHT_PAREN . (name . 0)) (LEFT_PAREN . (name . 0)) (RANGE . (name . 0))
(TICK . (name . 0)) (DOT . (name . 0)) (PLUS . (name . 0)) (MINUS . (name . 0))
(AMPERSAND . (name . 0)) ( [...]
- ((default . error) (COLON . 241) (COMMA . 95))
+ ((default . error) (IDENTIFIER . (null_exclusion_opt . 0))
(STRING_LITERAL . (null_exclusion_opt . 0)) (CHARACTER_LITERAL .
(null_exclusion_opt . 0)) (ACCESS . (null_exclusion_opt . 0)) (NOT . 232))
+ ((default . error) (IDENTIFIER . (null_exclusion_opt . 0))
(STRING_LITERAL . (null_exclusion_opt . 0)) (CHARACTER_LITERAL .
(null_exclusion_opt . 0)) (DO . (null_exclusion_opt . 0)) (RIGHT_PAREN .
(null_exclusion_opt . 0)) (COLON_EQUAL . (null_exclusion_opt . 0)) (RENAMES .
(null_exclusion_opt . 0)) (WITH . (null_exclusion_opt . 0)) (SEMICOLON .
(null_exclusion_opt . 0)) (IS . (null_exclusion_opt . 0)) (ACCESS .
(null_exclusion_opt . 0)) (NOT . 232))
+ ((default . error) (DO . (attribute_designator . 1)) (ELSIF .
(attribute_designator . 1)) (ELSE . (attribute_designator . 1)) (DIGITS .
(attribute_designator . 1)) (RANGE . (attribute_designator . 1)) (THEN .
(attribute_designator . 1)) (USE . (attribute_designator . 1)) (COLON_EQUAL .
(attribute_designator . 1)) (CHARACTER_LITERAL . (attribute_designator . 1))
(STRING_LITERAL . (attribute_designator . 1)) (IDENTIFIER .
(attribute_designator . 1)) (LESS_LESS . (attribute_designator [...]
+ ((default . error) (DO . (attribute_designator . 2)) (ELSIF .
(attribute_designator . 2)) (ELSE . (attribute_designator . 2)) (DIGITS .
(attribute_designator . 2)) (RANGE . (attribute_designator . 2)) (THEN .
(attribute_designator . 2)) (USE . (attribute_designator . 2)) (COLON_EQUAL .
(attribute_designator . 2)) (CHARACTER_LITERAL . (attribute_designator . 2))
(STRING_LITERAL . (attribute_designator . 2)) (IDENTIFIER .
(attribute_designator . 2)) (LESS_LESS . (attribute_designator [...]
+ ((default . error) (DO . (attribute_designator . 3)) (ELSIF .
(attribute_designator . 3)) (ELSE . (attribute_designator . 3)) (DIGITS .
(attribute_designator . 3)) (RANGE . (attribute_designator . 3)) (THEN .
(attribute_designator . 3)) (USE . (attribute_designator . 3)) (COLON_EQUAL .
(attribute_designator . 3)) (CHARACTER_LITERAL . (attribute_designator . 3))
(STRING_LITERAL . (attribute_designator . 3)) (IDENTIFIER .
(attribute_designator . 3)) (LESS_LESS . (attribute_designator [...]
+ ((default . error) (DO . (attribute_designator . 4)) (ELSIF .
(attribute_designator . 4)) (ELSE . (attribute_designator . 4)) (DIGITS .
(attribute_designator . 4)) (RANGE . (attribute_designator . 4)) (THEN .
(attribute_designator . 4)) (USE . (attribute_designator . 4)) (COLON_EQUAL .
(attribute_designator . 4)) (CHARACTER_LITERAL . (attribute_designator . 4))
(STRING_LITERAL . (attribute_designator . 4)) (IDENTIFIER .
(attribute_designator . 4)) (LESS_LESS . (attribute_designator [...]
+ ((default . error) (DO . (qualified_expression . 0)) (ELSIF .
(qualified_expression . 0)) (ELSE . (qualified_expression . 0)) (DIGITS .
(qualified_expression . 0)) (RANGE . (qualified_expression . 0)) (THEN .
(qualified_expression . 0)) (USE . (qualified_expression . 0)) (COLON_EQUAL .
(qualified_expression . 0)) (CHARACTER_LITERAL . (qualified_expression . 0))
(STRING_LITERAL . (qualified_expression . 0)) (IDENTIFIER .
(qualified_expression . 0)) (LESS_LESS . (qualified_expression [...]
+ ((default . error) (DO . (attribute_reference . 0)) (ELSIF .
(attribute_reference . 0)) (ELSE . (attribute_reference . 0)) (DIGITS .
(attribute_reference . 0)) (RANGE . (attribute_reference . 0)) (THEN .
(attribute_reference . 0)) (USE . (attribute_reference . 0)) (COLON_EQUAL .
(attribute_reference . 0)) (CHARACTER_LITERAL . (attribute_reference . 0))
(STRING_LITERAL . (attribute_reference . 0)) (IDENTIFIER . (attribute_reference
. 0)) (LESS_LESS . (attribute_reference . 0)) (WHIL [...]
+ ((default . error) (DO . (attribute_designator . 0)) (ELSIF .
(attribute_designator . 0)) (ELSE . (attribute_designator . 0)) (DIGITS .
(attribute_designator . 0)) (RANGE . (attribute_designator . 0)) (THEN .
(attribute_designator . 0)) (USE . (attribute_designator . 0)) (COLON_EQUAL .
(attribute_designator . 0)) (CHARACTER_LITERAL . (attribute_designator . 0))
(STRING_LITERAL . (attribute_designator . 0)) (IDENTIFIER .
(attribute_designator . 0)) (LESS_LESS . (attribute_designator [...]
+ ((default . error) (DO . (selected_component . 3)) (RIGHT_PAREN .
(selected_component . 3)) (BAR . (selected_component . 3)) (ELSIF .
(selected_component . 3)) (ELSE . (selected_component . 3)) (EQUAL_GREATER .
(selected_component . 3)) (DIGITS . (selected_component . 3)) (RANGE .
(selected_component . 3)) (THEN . (selected_component . 3)) (DOT_DOT .
(selected_component . 3)) (IN . (selected_component . 3)) (NOT .
(selected_component . 3)) (EQUAL . (selected_component . 3)) (GREATE [...]
+ ((default . error) (DO . (selected_component . 0)) (RIGHT_PAREN .
(selected_component . 0)) (BAR . (selected_component . 0)) (ELSIF .
(selected_component . 0)) (ELSE . (selected_component . 0)) (EQUAL_GREATER .
(selected_component . 0)) (DIGITS . (selected_component . 0)) (RANGE .
(selected_component . 0)) (THEN . (selected_component . 0)) (DOT_DOT .
(selected_component . 0)) (IN . (selected_component . 0)) (NOT .
(selected_component . 0)) (EQUAL . (selected_component . 0)) (GREATE [...]
+ ((default . error) (DO . (selected_component . 2)) (RIGHT_PAREN .
(selected_component . 2)) (BAR . (selected_component . 2)) (ELSIF .
(selected_component . 2)) (ELSE . (selected_component . 2)) (EQUAL_GREATER .
(selected_component . 2)) (DIGITS . (selected_component . 2)) (RANGE .
(selected_component . 2)) (THEN . (selected_component . 2)) (DOT_DOT .
(selected_component . 2)) (IN . (selected_component . 2)) (NOT .
(selected_component . 2)) (EQUAL . (selected_component . 2)) (GREATE [...]
+ ((default . error) (DO . (selected_component . 1)) (RIGHT_PAREN .
(selected_component . 1)) (BAR . (selected_component . 1)) (ELSIF .
(selected_component . 1)) (ELSE . (selected_component . 1)) (EQUAL_GREATER .
(selected_component . 1)) (DIGITS . (selected_component . 1)) (RANGE .
(selected_component . 1)) (THEN . (selected_component . 1)) (DOT_DOT .
(selected_component . 1)) (IN . (selected_component . 1)) (NOT .
(selected_component . 1)) (EQUAL . (selected_component . 1)) (GREATE [...]
+ ((default . error) (NULL . 245))
+ ((default . error) (DO . (parameter_and_result_profile . 3))
(RIGHT_PAREN . (parameter_and_result_profile . 3)) (COLON_EQUAL .
(parameter_and_result_profile . 3)) (RENAMES . (parameter_and_result_profile .
3)) (WITH . (parameter_and_result_profile . 3)) (SEMICOLON .
(parameter_and_result_profile . 3)) (IS . (parameter_and_result_profile . 3)))
+ ((default . error) (ACCESS . 242) (IS . (name_opt . 0)) (SEMICOLON .
(name_opt . 0)) (WITH . (name_opt . 0)) (RENAMES . (name_opt . 0)) (COLON_EQUAL
. (name_opt . 0)) (RIGHT_PAREN . (name_opt . 0)) (DO . (name_opt . 0))
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49))
+ ((default . error) (IN . (name . 0)) (NOT . (name . 0)) (EQUAL . (name .
0)) (GREATER . (name . 0)) (GREATER_EQUAL . (name . 0)) (LESS . (name . 0))
(LESS_EQUAL . (name . 0)) (SLASH_EQUAL . (name . 0)) (BAR . (name . 0))
(EQUAL_GREATER . (name . 0)) (AND . (name . 0)) (OR . (name . 0)) (XOR . (name
. 0)) (RIGHT_PAREN . (name . 0)) (LEFT_PAREN . (name . 0)) (RANGE . (name . 0))
(TICK . (name . 0)) (DOT . (name . 0)) (PLUS . (name . 0)) (MINUS . (name . 0))
(AMPERSAND . (name . 0)) ( [...]
+ ((default . error) (COLON . 241) (COMMA . 96))
((default . error) (RIGHT_PAREN . (parameter_specification_list . 0))
(SEMICOLON . (parameter_specification_list . 0)))
- ((default . error) (SEMICOLON . 239) (RIGHT_PAREN . 240))
- ((default . error) (DO . (attribute_designator . 1)) (ELSIF .
(attribute_designator . 1)) (ELSE . (attribute_designator . 1)) (DIGITS .
(attribute_designator . 1)) (RANGE . (attribute_designator . 1)) (THEN .
(attribute_designator . 1)) (USE . (attribute_designator . 1)) (COLON_EQUAL .
(attribute_designator . 1)) (WHILE . (attribute_designator . 1)) (SELECT .
(attribute_designator . 1)) (REQUEUE . (attribute_designator . 1)) (RAISE .
(attribute_designator . 1)) (PRAGMA . (attribute [...]
- ((default . error) (DO . (attribute_designator . 2)) (ELSIF .
(attribute_designator . 2)) (ELSE . (attribute_designator . 2)) (DIGITS .
(attribute_designator . 2)) (RANGE . (attribute_designator . 2)) (THEN .
(attribute_designator . 2)) (USE . (attribute_designator . 2)) (COLON_EQUAL .
(attribute_designator . 2)) (WHILE . (attribute_designator . 2)) (SELECT .
(attribute_designator . 2)) (REQUEUE . (attribute_designator . 2)) (RAISE .
(attribute_designator . 2)) (PRAGMA . (attribute [...]
- ((default . error) (DO . (attribute_designator . 3)) (ELSIF .
(attribute_designator . 3)) (ELSE . (attribute_designator . 3)) (DIGITS .
(attribute_designator . 3)) (RANGE . (attribute_designator . 3)) (THEN .
(attribute_designator . 3)) (USE . (attribute_designator . 3)) (COLON_EQUAL .
(attribute_designator . 3)) (WHILE . (attribute_designator . 3)) (SELECT .
(attribute_designator . 3)) (REQUEUE . (attribute_designator . 3)) (RAISE .
(attribute_designator . 3)) (PRAGMA . (attribute [...]
- ((default . error) (CASE . 232) (IF . 233) (RIGHT_PAREN .
((association_opt . 0) (expression_opt . 0))) (COMMA . ((association_opt . 0)
(expression_opt . 0))) (EQUAL_GREATER . (discrete_choice_list . 0)) (BAR .
(discrete_choice_list . 0)) (RAISE . 152) (PLUS . 144) (MINUS . 143) (OTHERS
. 175) (ABS . 147) (NOT . 174) (IDENTIFIER . 48) (CHARACTER_LITERAL . 173)
(STRING_LITERAL . 49) (NUMERIC_LITERAL . 145) (NULL . 234) (NEW . 149)
(LEFT_PAREN . 148))
- ((default . error) (DO . (attribute_designator . 4)) (ELSIF .
(attribute_designator . 4)) (ELSE . (attribute_designator . 4)) (DIGITS .
(attribute_designator . 4)) (RANGE . (attribute_designator . 4)) (THEN .
(attribute_designator . 4)) (USE . (attribute_designator . 4)) (COLON_EQUAL .
(attribute_designator . 4)) (WHILE . (attribute_designator . 4)) (SELECT .
(attribute_designator . 4)) (REQUEUE . (attribute_designator . 4)) (RAISE .
(attribute_designator . 4)) (PRAGMA . (attribute [...]
- ((default . error) (DO . (qualified_expression . 0)) (ELSIF .
(qualified_expression . 0)) (ELSE . (qualified_expression . 0)) (DIGITS .
(qualified_expression . 0)) (RANGE . (qualified_expression . 0)) (THEN .
(qualified_expression . 0)) (USE . (qualified_expression . 0)) (COLON_EQUAL .
(qualified_expression . 0)) (WHILE . (qualified_expression . 0)) (SELECT .
(qualified_expression . 0)) (REQUEUE . (qualified_expression . 0)) (RAISE .
(qualified_expression . 0)) (PRAGMA . (qualified [...]
- ((default . error) (DO . (attribute_reference . 0)) (ELSIF .
(attribute_reference . 0)) (ELSE . (attribute_reference . 0)) (DIGITS .
(attribute_reference . 0)) (RANGE . (attribute_reference . 0)) (THEN .
(attribute_reference . 0)) (USE . (attribute_reference . 0)) (COLON_EQUAL .
(attribute_reference . 0)) (WHILE . (attribute_reference . 0)) (SELECT .
(attribute_reference . 0)) (REQUEUE . (attribute_reference . 0)) (RAISE .
(attribute_reference . 0)) (PRAGMA . (attribute_reference . [...]
- ((default . error) (DO . (attribute_designator . 0)) (ELSIF .
(attribute_designator . 0)) (ELSE . (attribute_designator . 0)) (DIGITS .
(attribute_designator . 0)) (RANGE . (attribute_designator . 0)) (THEN .
(attribute_designator . 0)) (USE . (attribute_designator . 0)) (COLON_EQUAL .
(attribute_designator . 0)) (WHILE . (attribute_designator . 0)) (SELECT .
(attribute_designator . 0)) (REQUEUE . (attribute_designator . 0)) (RAISE .
(attribute_designator . 0)) (PRAGMA . (attribute [...]
- ((default . error) (DO . (selected_component . 0)) (RIGHT_PAREN .
(selected_component . 0)) (BAR . (selected_component . 0)) (ELSIF .
(selected_component . 0)) (ELSE . (selected_component . 0)) (EQUAL_GREATER .
(selected_component . 0)) (DIGITS . (selected_component . 0)) (RANGE .
(selected_component . 0)) (THEN . (selected_component . 0)) (DOT_DOT .
(selected_component . 0)) (IN . (selected_component . 0)) (NOT .
(selected_component . 0)) (EQUAL . (selected_component . 0)) (GREATE [...]
- ((default . error) (DO . (selected_component . 2)) (RIGHT_PAREN .
(selected_component . 2)) (BAR . (selected_component . 2)) (ELSIF .
(selected_component . 2)) (ELSE . (selected_component . 2)) (EQUAL_GREATER .
(selected_component . 2)) (DIGITS . (selected_component . 2)) (RANGE .
(selected_component . 2)) (THEN . (selected_component . 2)) (DOT_DOT .
(selected_component . 2)) (IN . (selected_component . 2)) (NOT .
(selected_component . 2)) (EQUAL . (selected_component . 2)) (GREATE [...]
- ((default . error) (DO . (selected_component . 1)) (RIGHT_PAREN .
(selected_component . 1)) (BAR . (selected_component . 1)) (ELSIF .
(selected_component . 1)) (ELSE . (selected_component . 1)) (EQUAL_GREATER .
(selected_component . 1)) (DIGITS . (selected_component . 1)) (RANGE .
(selected_component . 1)) (THEN . (selected_component . 1)) (DOT_DOT .
(selected_component . 1)) (IN . (selected_component . 1)) (NOT .
(selected_component . 1)) (EQUAL . (selected_component . 1)) (GREATE [...]
- ((default . error) (DO . (selected_component . 3)) (RIGHT_PAREN .
(selected_component . 3)) (BAR . (selected_component . 3)) (ELSIF .
(selected_component . 3)) (ELSE . (selected_component . 3)) (EQUAL_GREATER .
(selected_component . 3)) (DIGITS . (selected_component . 3)) (RANGE .
(selected_component . 3)) (THEN . (selected_component . 3)) (DOT_DOT .
(selected_component . 3)) (IN . (selected_component . 3)) (NOT .
(selected_component . 3)) (EQUAL . (selected_component . 3)) (GREATE [...]
- ((default . error) (RAISE . 152) (PLUS . 144) (MINUS . 143) (ABS .
147) (NOT . 150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
- ((default . error) (RAISE . 152) (PLUS . 144) (MINUS . 143) (ABS .
147) (NOT . 150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
- ((default . error) (DOT_DOT . (primary . 1)) (RIGHT_PAREN . (primary .
1)) (COMMA . (primary . 1)) (BAR . (primary . 1)) (EQUAL_GREATER . (primary .
1)) (PLUS . (primary . 1)) (MINUS . (primary . 1)) (AMPERSAND . (primary . 1))
(IN . (primary . 1)) (NOT . (primary . 1)) (EQUAL . (primary . 1)) (GREATER .
(primary . 1)) (GREATER_EQUAL . (primary . 1)) (LESS . (primary . 1))
(LESS_EQUAL . (primary . 1)) (SLASH_EQUAL . (primary . 1)) (WITH . (primary .
1)) (SLASH . (primary . 1)) (STA [...]
- ((default . error) (COMMA . 268) (RIGHT_PAREN . 523))
- ((default . error) (RIGHT_PAREN . 522))
- ((default . error) (RIGHT_PAREN . (expression_opt . 1)) (COMMA .
(expression_opt . 1)) (WITH . 521))
- ((default . error) (RIGHT_PAREN . 520))
- ((default . error) (IDENTIFIER . 72))
- ((default . error) (RIGHT_PAREN . (formal_part . 0)) (COLON_EQUAL .
(formal_part . 0)) (DO . (formal_part . 0)) (WHEN . (formal_part . 0)) (RENAMES
. (formal_part . 0)) (IS . (formal_part . 0)) (SEMICOLON . (formal_part . 0))
(WITH . (formal_part . 0)) (RETURN . (formal_part . 0)))
- ((default . error) (ACCESS . (aliased_opt . 0)) (NOT . (aliased_opt .
0)) (IN . (aliased_opt . 0)) (OUT . (aliased_opt . 0)) (IDENTIFIER .
(aliased_opt . 0)) (STRING_LITERAL . (aliased_opt . 0)) (CHARACTER_LITERAL .
(aliased_opt . 0)) (ALIASED . 517))
- ((default . error) (FUNCTION . (protected_opt . 0)) (PROCEDURE .
(protected_opt . 0)) (PROTECTED . 514) (IDENTIFIER .
(general_access_modifier_opt . 0)) (STRING_LITERAL .
(general_access_modifier_opt . 0)) (CHARACTER_LITERAL .
(general_access_modifier_opt . 0)) (ALL . 512) (CONSTANT . 513))
- ((default . error) (RIGHT_PAREN . (null_exclusion_opt . 1)) (DO .
(null_exclusion_opt . 1)) (RENAMES . (null_exclusion_opt . 1)) (COLON_EQUAL .
(null_exclusion_opt . 1)) (ACCESS . (null_exclusion_opt . 1))
(CHARACTER_LITERAL . (null_exclusion_opt . 1)) (STRING_LITERAL .
(null_exclusion_opt . 1)) (IDENTIFIER . (null_exclusion_opt . 1)) (WITH .
(null_exclusion_opt . 1)) (SEMICOLON . (null_exclusion_opt . 1)) (IS .
(null_exclusion_opt . 1)))
- ((default . error) (DO . (parameter_and_result_profile . 2))
(RIGHT_PAREN . (parameter_and_result_profile . 2)) (COLON_EQUAL .
(parameter_and_result_profile . 2)) (RENAMES . (parameter_and_result_profile .
2)) (IS . (parameter_and_result_profile . 2)) (SEMICOLON .
(parameter_and_result_profile . 2)) (WITH . (parameter_and_result_profile . 2)))
- ((default . error) (ACCESS . 242) (WITH . (name_opt . 0)) (SEMICOLON .
(name_opt . 0)) (IS . (name_opt . 0)) (RENAMES . (name_opt . 0)) (COLON_EQUAL .
(name_opt . 0)) (RIGHT_PAREN . (name_opt . 0)) (DO . (name_opt . 0))
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49))
- ((default . error) (COLON_EQUAL . 509) (SEMICOLON .
(aspect_specification_opt . 0)) (WITH . 108))
+ ((default . error) (SEMICOLON . 240) (RIGHT_PAREN . 239))
+ ((default . error) (COLON_EQUAL . (formal_part . 0)) (RIGHT_PAREN .
(formal_part . 0)) (DO . (formal_part . 0)) (WHEN . (formal_part . 0)) (RENAMES
. (formal_part . 0)) (IS . (formal_part . 0)) (SEMICOLON . (formal_part . 0))
(WITH . (formal_part . 0)) (RETURN . (formal_part . 0)))
+ ((default . error) (IDENTIFIER . 77))
+ ((default . error) (ACCESS . (aliased_opt . 0)) (NOT . (aliased_opt .
0)) (IN . (aliased_opt . 0)) (OUT . (aliased_opt . 0)) (IDENTIFIER .
(aliased_opt . 0)) (STRING_LITERAL . (aliased_opt . 0)) (CHARACTER_LITERAL .
(aliased_opt . 0)) (ALIASED . 531))
+ ((default . error) (FUNCTION . (protected_opt . 0)) (PROCEDURE .
(protected_opt . 0)) (PROTECTED . 528) (IDENTIFIER .
(general_access_modifier_opt . 0)) (STRING_LITERAL .
(general_access_modifier_opt . 0)) (CHARACTER_LITERAL .
(general_access_modifier_opt . 0)) (ALL . 526) (CONSTANT . 527))
+ ((default . error) (DOT . 90) (DO . (name_opt . 1)) (COLON_EQUAL .
(name_opt . 1)) (RIGHT_PAREN . (name_opt . 1)) (RENAMES . (name_opt . 1)) (IS .
(name_opt . 1)) (WITH . (name_opt . 1)) (SEMICOLON . (name_opt . 1)) (TICK .
91) (LEFT_PAREN . 107))
+ ((default . error) (DO . (parameter_and_result_profile . 1))
(COLON_EQUAL . (parameter_and_result_profile . 1)) (RIGHT_PAREN .
(parameter_and_result_profile . 1)) (RENAMES . (parameter_and_result_profile .
1)) (IS . (parameter_and_result_profile . 1)) (SEMICOLON .
(parameter_and_result_profile . 1)) (WITH . (parameter_and_result_profile . 1)))
+ ((default . error) (DO . (null_exclusion_opt . 1)) (COLON_EQUAL .
(null_exclusion_opt . 1)) (RIGHT_PAREN . (null_exclusion_opt . 1)) (RENAMES .
(null_exclusion_opt . 1)) (ACCESS . (null_exclusion_opt . 1))
(CHARACTER_LITERAL . (null_exclusion_opt . 1)) (STRING_LITERAL .
(null_exclusion_opt . 1)) (IDENTIFIER . (null_exclusion_opt . 1)) (IS .
(null_exclusion_opt . 1)) (SEMICOLON . (null_exclusion_opt . 1)) (WITH .
(null_exclusion_opt . 1)))
+ ((default . error) (DO . (parameter_and_result_profile . 2))
(COLON_EQUAL . (parameter_and_result_profile . 2)) (RIGHT_PAREN .
(parameter_and_result_profile . 2)) (RENAMES . (parameter_and_result_profile .
2)) (IS . (parameter_and_result_profile . 2)) (SEMICOLON .
(parameter_and_result_profile . 2)) (WITH . (parameter_and_result_profile . 2)))
+ ((default . error) (ACCESS . 242) (WITH . (name_opt . 0)) (SEMICOLON .
(name_opt . 0)) (IS . (name_opt . 0)) (RENAMES . (name_opt . 0)) (RIGHT_PAREN .
(name_opt . 0)) (COLON_EQUAL . (name_opt . 0)) (DO . (name_opt . 0))
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49))
+ ((default . error) (COLON_EQUAL . 523) (SEMICOLON .
(aspect_specification_opt . 0)) (WITH . 109))
((default . error) (ACCESS . 242) (IDENTIFIER . 48) (CHARACTER_LITERAL
. 50) (STRING_LITERAL . 49))
((default . error) (CHARACTER_LITERAL . (mode_opt . 2)) (STRING_LITERAL
. (mode_opt . 2)) (IDENTIFIER . (mode_opt . 2)) (NOT . (mode_opt . 2)) (ACCESS
. (mode_opt . 2)))
- ((default . error) (NEW . 507))
- ((default . error) (WITH . (formal_subprogram_declaration . 1)) (TYPE .
(formal_subprogram_declaration . 1)) (PRAGMA . (formal_subprogram_declaration .
1)) (IDENTIFIER . (formal_subprogram_declaration . 1)) (FUNCTION .
(formal_subprogram_declaration . 1)) (PROCEDURE .
(formal_subprogram_declaration . 1)) (PACKAGE . (formal_subprogram_declaration
. 1)))
- ((default . error) (WITH . (subprogram_default . 1)) (SEMICOLON .
(subprogram_default . 1)))
- ((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
108) (BOX . 251) (NULL . 253) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
+ ((default . error) (NEW . 521))
+ ((default . error) (IDENTIFIER . (formal_subprogram_declaration . 1))
(WITH . (formal_subprogram_declaration . 1)) (USE .
(formal_subprogram_declaration . 1)) (TYPE . (formal_subprogram_declaration .
1)) (PRAGMA . (formal_subprogram_declaration . 1)) (FUNCTION .
(formal_subprogram_declaration . 1)) (PROCEDURE .
(formal_subprogram_declaration . 1)) (PACKAGE . (formal_subprogram_declaration
. 1)))
+ ((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
109) (BOX . 255) (NULL . 254) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
((default . error) (WITH . (subprogram_default . 2)) (SEMICOLON .
(subprogram_default . 2)))
- ((default . error) (WITH . (subprogram_default . 0)) (SEMICOLON .
(subprogram_default . 0)) (DOT . 87) (TICK . 88) (LEFT_PAREN . 106))
- ((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
108))
- ((default . error) (LEFT_PAREN . 489) (RANGE . 493) (MOD . 491)
(DIGITS . 487) (DELTA . 486) (TASK . 496) (PROTECTED . 492) (INTERFACE .
488) (ARRAY . 485) (PRIVATE . (abstract_tagged_limited_opt . 0)) (TAGGED .
495) (NEW . (abstract_limited_synchronized_opt . 0)) (ABSTRACT . 484) (LIMITED
. 490) (SYNCHRONIZED . 494) (ACCESS . (null_exclusion_opt . 0)) (NOT . 211))
- ((default . error) (SEMICOLON . 483))
- ((default . error) (RIGHT_PAREN . 482))
+ ((default . error) (WITH . (subprogram_default . 1)) (SEMICOLON .
(subprogram_default . 1)))
+ ((default . error) (WITH . (subprogram_default . 0)) (SEMICOLON .
(subprogram_default . 0)) (DOT . 90) (TICK . 91) (LEFT_PAREN . 107))
+ ((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
109))
+ ((default . error) (LEFT_PAREN . 502) (RANGE . 506) (MOD . 504)
(DIGITS . 500) (DELTA . 499) (TASK . 509) (PROTECTED . 505) (INTERFACE .
501) (ARRAY . 498) (PRIVATE . (abstract_tagged_limited_opt . 0)) (TAGGED .
508) (NEW . (abstract_limited_synchronized_opt . 0)) (ABSTRACT . 497) (LIMITED
. 503) (SYNCHRONIZED . 507) (ACCESS . (null_exclusion_opt . 0)) (NOT . 232))
+ ((default . error) (SEMICOLON . 496))
+ ((default . error) (RIGHT_PAREN . 495))
((default . error) (RIGHT_PAREN . (discriminant_specification_list . 0))
(SEMICOLON . (discriminant_specification_list . 0)))
- ((default . error) (SEMICOLON . 480) (RIGHT_PAREN . 481))
- ((default . error) (COMMA . 95) (COLON . 479))
- ((default . error) (DOT . 87) (TICK . 88) (SEMICOLON .
(aspect_specification_opt . 0)) (WITH . 108) (LEFT_PAREN . 106))
- ((default . error) (DOT . 87) (TICK . 88) (SEMICOLON .
(aspect_specification_opt . 0)) (WITH . 108) (LEFT_PAREN . 106))
- ((default . error) (DOT . 87) (TICK . 88) (SEMICOLON .
(aspect_specification_opt . 0)) (WITH . 108) (LEFT_PAREN . 106))
+ ((default . error) (SEMICOLON . 494) (RIGHT_PAREN . 493))
+ ((default . error) (COMMA . 96) (COLON . 492))
+ ((default . error) (DOT . 90) (TICK . 91) (SEMICOLON .
(aspect_specification_opt . 0)) (WITH . 109) (LEFT_PAREN . 107))
+ ((default . error) (DOT . 90) (TICK . 91) (SEMICOLON .
(aspect_specification_opt . 0)) (WITH . 109) (LEFT_PAREN . 107))
+ ((default . error) (DOT . 90) (TICK . 91) (SEMICOLON .
(aspect_specification_opt . 0)) (WITH . 109) (LEFT_PAREN . 107))
((default . error) (WITH . (with_clause . 0)) (USE . (with_clause . 0))
(SEPARATE . (with_clause . 0)) (PROCEDURE . (with_clause . 0)) (PRIVATE .
(with_clause . 0)) (PRAGMA . (with_clause . 0)) (PACKAGE . (with_clause . 0))
(OVERRIDING . (with_clause . 0)) (NOT . (with_clause . 0)) (LIMITED .
(with_clause . 0)) (GENERIC . (with_clause . 0)) (FUNCTION . (with_clause . 0))
($EOI . (with_clause . 0)))
- ((default . error) (DOT . 87) (TICK . 88) (SEMICOLON .
(aspect_specification_opt . 0)) (WITH . 108) (LEFT_PAREN . 106))
- ((default . error) (DO . (name . 2)) (WHILE . (name . 2)) (SELECT .
(name . 2)) (REQUEUE . (name . 2)) (RAISE . (name . 2)) (PRAGMA . (name . 2))
(NULL . (name . 2)) (LOOP . (name . 2)) (IF . (name . 2)) (GOTO . (name . 2))
(FOR . (name . 2)) (EXIT . (name . 2)) (DELAY . (name . 2)) (DECLARE . (name .
2)) (CASE . (name . 2)) (BEGIN . (name . 2)) (ABORT . (name . 2)) (ACCEPT .
(name . 2)) (CHARACTER_LITERAL . (name . 2)) (STRING_LITERAL . (name . 2))
(IDENTIFIER . (name . 2)) (LESS_ [...]
- ((default . error) (RIGHT_PAREN . ((association_opt . 0) (expression_opt
. 0))) (COMMA . ((association_opt . 0) (expression_opt . 0))) (IS .
((association_opt . 0) (expression_opt . 0))) (SEMICOLON . ((association_opt .
0) (expression_opt . 0))) (EQUAL_GREATER . (discrete_choice_list . 0)) (BAR .
(discrete_choice_list . 0)) (OTHERS . 175) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 173) (STRING_LITERAL . 49) (RAISE . 152) (PLUS . 144)
(MINUS . 143) (ABS . 147) (NOT . 174) (NUME [...]
- ((default . error) (STAR_STAR . (actual_parameter_part . 0)) (REM .
(actual_parameter_part . 0)) (MOD . (actual_parameter_part . 0)) (STAR .
(actual_parameter_part . 0)) (SLASH . (actual_parameter_part . 0)) (DOT_DOT .
(actual_parameter_part . 0)) (AMPERSAND . (actual_parameter_part . 0)) (MINUS .
(actual_parameter_part . 0)) (PLUS . (actual_parameter_part . 0)) (RIGHT_PAREN
. (actual_parameter_part . 0)) (RANGE . (actual_parameter_part . 0))
(COLON_EQUAL . (actual_parameter_part . [...]
- ((default . error) (SEMICOLON . 473))
- ((default . error) (PLUS . 144) (MINUS . 143) (ABS . 147) (NOT .
150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN . 148))
- ((default . error) (MINUS . (relational_operator . 0)) (PLUS .
(relational_operator . 0)) (NUMERIC_LITERAL . (relational_operator . 0))
(IDENTIFIER . (relational_operator . 0)) (STRING_LITERAL . (relational_operator
. 0)) (CHARACTER_LITERAL . (relational_operator . 0)) (ABS .
(relational_operator . 0)) (LEFT_PAREN . (relational_operator . 0)) (NEW .
(relational_operator . 0)) (NOT . (relational_operator . 0)) (NULL .
(relational_operator . 0)))
- ((default . error) (MINUS . (relational_operator . 4)) (PLUS .
(relational_operator . 4)) (NUMERIC_LITERAL . (relational_operator . 4))
(IDENTIFIER . (relational_operator . 4)) (STRING_LITERAL . (relational_operator
. 4)) (CHARACTER_LITERAL . (relational_operator . 4)) (ABS .
(relational_operator . 4)) (LEFT_PAREN . (relational_operator . 4)) (NEW .
(relational_operator . 4)) (NOT . (relational_operator . 4)) (NULL .
(relational_operator . 4)))
- ((default . error) (MINUS . (relational_operator . 5)) (PLUS .
(relational_operator . 5)) (NUMERIC_LITERAL . (relational_operator . 5))
(IDENTIFIER . (relational_operator . 5)) (STRING_LITERAL . (relational_operator
. 5)) (CHARACTER_LITERAL . (relational_operator . 5)) (ABS .
(relational_operator . 5)) (LEFT_PAREN . (relational_operator . 5)) (NEW .
(relational_operator . 5)) (NOT . (relational_operator . 5)) (NULL .
(relational_operator . 5)))
- ((default . error) (MINUS . (relational_operator . 2)) (PLUS .
(relational_operator . 2)) (NUMERIC_LITERAL . (relational_operator . 2))
(IDENTIFIER . (relational_operator . 2)) (STRING_LITERAL . (relational_operator
. 2)) (CHARACTER_LITERAL . (relational_operator . 2)) (ABS .
(relational_operator . 2)) (LEFT_PAREN . (relational_operator . 2)) (NEW .
(relational_operator . 2)) (NOT . (relational_operator . 2)) (NULL .
(relational_operator . 2)))
- ((default . error) (MINUS . (relational_operator . 3)) (PLUS .
(relational_operator . 3)) (NUMERIC_LITERAL . (relational_operator . 3))
(IDENTIFIER . (relational_operator . 3)) (STRING_LITERAL . (relational_operator
. 3)) (CHARACTER_LITERAL . (relational_operator . 3)) (ABS .
(relational_operator . 3)) (LEFT_PAREN . (relational_operator . 3)) (NEW .
(relational_operator . 3)) (NOT . (relational_operator . 3)) (NULL .
(relational_operator . 3)))
- ((default . error) (MINUS . (relational_operator . 1)) (PLUS .
(relational_operator . 1)) (NUMERIC_LITERAL . (relational_operator . 1))
(IDENTIFIER . (relational_operator . 1)) (STRING_LITERAL . (relational_operator
. 1)) (CHARACTER_LITERAL . (relational_operator . 1)) (ABS .
(relational_operator . 1)) (LEFT_PAREN . (relational_operator . 1)) (NEW .
(relational_operator . 1)) (NOT . (relational_operator . 1)) (NULL .
(relational_operator . 1)))
- ((default . error) (PLUS . 144) (MINUS . 143) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (ABS . 147) (NOT . 150)
(NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149) (LEFT_PAREN . 148))
- ((default . error) (IN . 467))
- ((default . error) (PLUS . 144) (MINUS . 143) (ABS . 147) (NOT .
150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN . 148))
- ((default . error) (RANGE . 465) (LEFT_PAREN . 223) (ACCESS . 220)
(DELTA . 221) (DIGITS . 222) (MOD . 224) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49))
- ((default . error) (OTHERS . 175) (IDENTIFIER . 48) (CHARACTER_LITERAL
. 50) (STRING_LITERAL . 49) (PLUS . 144) (MINUS . 143) (ABS . 147) (NOT .
174) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149) (LEFT_PAREN . 148))
- ((default . error) (BOX . 461) (RAISE . 152) (PLUS . 144) (MINUS .
143) (ABS . 147) (NOT . 150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW .
149) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49)
(LEFT_PAREN . 148))
- ((default . error) (THEN . 459) (PLUS . 144) (MINUS . 143) (ABS .
147) (NOT . 150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
- ((default . error) (ELSE . 457) (PLUS . 144) (MINUS . 143) (ABS .
147) (NOT . 150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
- ((default . error) (PLUS . 144) (MINUS . 143) (ABS . 147) (NOT .
150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN . 148))
- ((default . error) (ELSE . 455))
- ((default . error) (THEN . 454))
- ((default . error) (PLUS . 144) (MINUS . 143) (ABS . 147) (NOT .
150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN . 148))
- ((default . error) (PLUS . 144) (MINUS . 143) (ABS . 147) (NOT .
150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN . 148))
- ((default . error) (PLUS . 144) (MINUS . 143) (ABS . 147) (NOT .
150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN . 148))
- ((default . error) (XOR . (primary . 1)) (OR . (primary . 1)) (AND .
(primary . 1)) (SLASH_EQUAL . (primary . 1)) (LESS_EQUAL . (primary . 1)) (LESS
. (primary . 1)) (GREATER_EQUAL . (primary . 1)) (GREATER . (primary . 1))
(EQUAL . (primary . 1)) (EQUAL_GREATER . (primary . 1)) (BAR . (primary . 1))
(PLUS . (primary . 1)) (MINUS . (primary . 1)) (AMPERSAND . (primary . 1))
(DOT_DOT . (primary . 1)) (SLASH . (primary . 1)) (STAR . (primary . 1)) (MOD .
(primary . 1)) (REM . (primar [...]
- ((default . error) (COLON_EQUAL . (factor . 3)) (OF . (factor . 3))
(LOOP . (factor . 3)) (DO . (factor . 3)) (PLUS . (factor . 3)) (MINUS .
(factor . 3)) (AMPERSAND . (factor . 3)) (SEMICOLON . (factor . 3)) (SLASH .
(factor . 3)) (STAR . (factor . 3)) (MOD . (factor . 3)) (REM . (factor . 3))
(XOR . (factor . 3)) (OR . (factor . 3)) (AND . (factor . 3)) (IN . (factor .
3)) (NOT . (factor . 3)) (EQUAL . (factor . 3)) (GREATER . (factor . 3))
(GREATER_EQUAL . (factor . 3)) (LESS . [...]
- ((default . error) (BOX . 447) (RAISE . 152) (PLUS . 144) (MINUS .
143) (ABS . 147) (NOT . 150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW .
149) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49)
(LEFT_PAREN . 148))
- ((default . error) (COLON . ( 446 (identifier_list . 0))) (COMMA .
(identifier_list . 0)))
- ((default . error) (IDENTIFIER . 441) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 442))
- ((default . error) (BODY . 440) (IDENTIFIER . 48) (CHARACTER_LITERAL .
50) (STRING_LITERAL . 49))
- ((default . error) (IDENTIFIER . 437) (TYPE . 439) (BODY . 438))
- ((default . error) (IDENTIFIER . 436))
- ((default . error) (TYPE . 435) (BODY . 434) (IDENTIFIER . 433))
- ((default . error) (IDENTIFIER . 432))
- ((default . error) (END . (declaration . 0)) (PRIVATE . (declaration .
0)) (USE . (declaration . 0)) (TYPE . (declaration . 0)) (TASK . (declaration .
0)) (SUBTYPE . (declaration . 0)) (PROTECTED . (declaration . 0)) (PROCEDURE .
(declaration . 0)) (PRAGMA . (declaration . 0)) (PACKAGE . (declaration . 0))
(OVERRIDING . (declaration . 0)) (NOT . (declaration . 0)) (GENERIC .
(declaration . 0)) (FUNCTION . (declaration . 0)) (FOR . (declaration . 0))
(ENTRY . (declaration . 0)) (IDE [...]
- ((default . error) (END . (declaration . 1)) (PRIVATE . (declaration .
1)) (USE . (declaration . 1)) (TYPE . (declaration . 1)) (TASK . (declaration .
1)) (SUBTYPE . (declaration . 1)) (PROTECTED . (declaration . 1)) (PROCEDURE .
(declaration . 1)) (PRAGMA . (declaration . 1)) (PACKAGE . (declaration . 1))
(OVERRIDING . (declaration . 1)) (NOT . (declaration . 1)) (GENERIC .
(declaration . 1)) (FUNCTION . (declaration . 1)) (FOR . (declaration . 1))
(ENTRY . (declaration . 1)) (IDE [...]
- ((default . error) (WHEN . (aspect_clause . 3)) (PRIVATE .
(aspect_clause . 3)) (END . (aspect_clause . 3)) (CASE . (aspect_clause . 3))
(BEGIN . (aspect_clause . 3)) (IDENTIFIER . (aspect_clause . 3)) (ENTRY .
(aspect_clause . 3)) (FOR . (aspect_clause . 3)) (FUNCTION . (aspect_clause .
3)) (GENERIC . (aspect_clause . 3)) (NOT . (aspect_clause . 3)) (OVERRIDING .
(aspect_clause . 3)) (PACKAGE . (aspect_clause . 3)) (PRAGMA . (aspect_clause .
3)) (PROCEDURE . (aspect_clause . 3)) ( [...]
- ((default . error) (END . (declaration . 2)) (PRIVATE . (declaration .
2)) (USE . (declaration . 2)) (TYPE . (declaration . 2)) (TASK . (declaration .
2)) (SUBTYPE . (declaration . 2)) (PROTECTED . (declaration . 2)) (PROCEDURE .
(declaration . 2)) (PRAGMA . (declaration . 2)) (PACKAGE . (declaration . 2))
(OVERRIDING . (declaration . 2)) (NOT . (declaration . 2)) (GENERIC .
(declaration . 2)) (FUNCTION . (declaration . 2)) (FOR . (declaration . 2))
(ENTRY . (declaration . 2)) (IDE [...]
- ((default . error) (PRIVATE . (body . 1)) (END . (body . 1)) (BEGIN .
(body . 1)) (IDENTIFIER . (body . 1)) (ENTRY . (body . 1)) (FOR . (body . 1))
(FUNCTION . (body . 1)) (GENERIC . (body . 1)) (NOT . (body . 1)) (OVERRIDING .
(body . 1)) (PACKAGE . (body . 1)) (PRAGMA . (body . 1)) (PROCEDURE . (body .
1)) (PROTECTED . (body . 1)) (SUBTYPE . (body . 1)) (TASK . (body . 1)) (TYPE .
(body . 1)) (USE . (body . 1)))
- ((default . error) (PRIVATE . (declarations . 0)) (END . (declarations .
0)) (BEGIN . (declarations . 0)) (IDENTIFIER . (declarations . 0)) (ENTRY .
(declarations . 0)) (FOR . (declarations . 0)) (FUNCTION . (declarations . 0))
(GENERIC . (declarations . 0)) (NOT . (declarations . 0)) (OVERRIDING .
(declarations . 0)) (PACKAGE . (declarations . 0)) (PRAGMA . (declarations .
0)) (PROCEDURE . (declarations . 0)) (PROTECTED . (declarations . 0)) (SUBTYPE
. (declarations . 0)) (TASK . [...]
- ((default . error) (END . (declarative_part_opt . 1)) (PRIVATE .
(declarative_part_opt . 1)) (BEGIN . (declarative_part_opt . 1)) (USE . 11)
(SUBTYPE . 299) (PRAGMA . 7) (NOT . 4) (OVERRIDING . 5) (FUNCTION .
(overriding_indicator_opt . 2)) (PROCEDURE . (overriding_indicator_opt . 2))
(ENTRY . (overriding_indicator_opt . 2)) (FOR . 296) (IDENTIFIER . 295) (TYPE
. 301) (GENERIC . 2) (PROTECTED . 298) (TASK . 300) (PACKAGE . 297))
- ((default . error) (END . 429) (PRIVATE . 430))
- ((default . error) (END . (declaration . 3)) (PRIVATE . (declaration .
3)) (USE . (declaration . 3)) (TYPE . (declaration . 3)) (TASK . (declaration .
3)) (SUBTYPE . (declaration . 3)) (PROTECTED . (declaration . 3)) (PROCEDURE .
(declaration . 3)) (PRAGMA . (declaration . 3)) (PACKAGE . (declaration . 3))
(OVERRIDING . (declaration . 3)) (NOT . (declaration . 3)) (GENERIC .
(declaration . 3)) (FUNCTION . (declaration . 3)) (FOR . (declaration . 3))
(ENTRY . (declaration . 3)) (IDE [...]
- ((default . error) (WHEN . (aspect_clause . 1)) (PRIVATE .
(aspect_clause . 1)) (END . (aspect_clause . 1)) (CASE . (aspect_clause . 1))
(BEGIN . (aspect_clause . 1)) (IDENTIFIER . (aspect_clause . 1)) (ENTRY .
(aspect_clause . 1)) (FOR . (aspect_clause . 1)) (FUNCTION . (aspect_clause .
1)) (GENERIC . (aspect_clause . 1)) (NOT . (aspect_clause . 1)) (OVERRIDING .
(aspect_clause . 1)) (PACKAGE . (aspect_clause . 1)) (PRAGMA . (aspect_clause .
1)) (PROCEDURE . (aspect_clause . 1)) ( [...]
- ((default . error) (END . (declaration . 4)) (PRIVATE . (declaration .
4)) (USE . (declaration . 4)) (TYPE . (declaration . 4)) (TASK . (declaration .
4)) (SUBTYPE . (declaration . 4)) (PROTECTED . (declaration . 4)) (PROCEDURE .
(declaration . 4)) (PRAGMA . (declaration . 4)) (PACKAGE . (declaration . 4))
(OVERRIDING . (declaration . 4)) (NOT . (declaration . 4)) (GENERIC .
(declaration . 4)) (FUNCTION . (declaration . 4)) (FOR . (declaration . 4))
(ENTRY . (declaration . 4)) (IDE [...]
- ((default . error) (END . (declaration . 5)) (PRIVATE . (declaration .
5)) (USE . (declaration . 5)) (TYPE . (declaration . 5)) (TASK . (declaration .
5)) (SUBTYPE . (declaration . 5)) (PROTECTED . (declaration . 5)) (PROCEDURE .
(declaration . 5)) (PRAGMA . (declaration . 5)) (PACKAGE . (declaration . 5))
(OVERRIDING . (declaration . 5)) (NOT . (declaration . 5)) (GENERIC .
(declaration . 5)) (FUNCTION . (declaration . 5)) (FOR . (declaration . 5))
(ENTRY . (declaration . 5)) (IDE [...]
- ((default . error) (PRIVATE . (type_declaration . 0)) (END .
(type_declaration . 0)) (BEGIN . (type_declaration . 0)) (IDENTIFIER .
(type_declaration . 0)) (ENTRY . (type_declaration . 0)) (FOR .
(type_declaration . 0)) (FUNCTION . (type_declaration . 0)) (GENERIC .
(type_declaration . 0)) (NOT . (type_declaration . 0)) (OVERRIDING .
(type_declaration . 0)) (PACKAGE . (type_declaration . 0)) (PRAGMA .
(type_declaration . 0)) (PROCEDURE . (type_declaration . 0)) (PROTECTED .
(type_d [...]
- ((default . error) (END . (declaration . 6)) (PRIVATE . (declaration .
6)) (USE . (declaration . 6)) (TYPE . (declaration . 6)) (TASK . (declaration .
6)) (SUBTYPE . (declaration . 6)) (PROTECTED . (declaration . 6)) (PROCEDURE .
(declaration . 6)) (PRAGMA . (declaration . 6)) (PACKAGE . (declaration . 6))
(OVERRIDING . (declaration . 6)) (NOT . (declaration . 6)) (GENERIC .
(declaration . 6)) (FUNCTION . (declaration . 6)) (FOR . (declaration . 6))
(ENTRY . (declaration . 6)) (IDE [...]
- ((default . error) (END . (declaration . 7)) (PRIVATE . (declaration .
7)) (USE . (declaration . 7)) (TYPE . (declaration . 7)) (TASK . (declaration .
7)) (SUBTYPE . (declaration . 7)) (PROTECTED . (declaration . 7)) (PROCEDURE .
(declaration . 7)) (PRAGMA . (declaration . 7)) (PACKAGE . (declaration . 7))
(OVERRIDING . (declaration . 7)) (NOT . (declaration . 7)) (GENERIC .
(declaration . 7)) (FUNCTION . (declaration . 7)) (FOR . (declaration . 7))
(ENTRY . (declaration . 7)) (IDE [...]
- ((default . error) (PRIVATE . (renaming_declaration . 3)) (END .
(renaming_declaration . 3)) (BEGIN . (renaming_declaration . 3)) (IDENTIFIER .
(renaming_declaration . 3)) (ENTRY . (renaming_declaration . 3)) (FOR .
(renaming_declaration . 3)) (FUNCTION . (renaming_declaration . 3)) (GENERIC .
(renaming_declaration . 3)) (NOT . (renaming_declaration . 3)) (OVERRIDING .
(renaming_declaration . 3)) (PACKAGE . (renaming_declaration . 3)) (PRAGMA .
(renaming_declaration . 3)) (PROCEDUR [...]
- ((default . error) (COMMA . 95) (COLON . 428))
- ((default . error) (PRIVATE . (type_declaration . 1)) (END .
(type_declaration . 1)) (BEGIN . (type_declaration . 1)) (IDENTIFIER .
(type_declaration . 1)) (ENTRY . (type_declaration . 1)) (FOR .
(type_declaration . 1)) (FUNCTION . (type_declaration . 1)) (GENERIC .
(type_declaration . 1)) (NOT . (type_declaration . 1)) (OVERRIDING .
(type_declaration . 1)) (PACKAGE . (type_declaration . 1)) (PRAGMA .
(type_declaration . 1)) (PROCEDURE . (type_declaration . 1)) (PROTECTED .
(type_d [...]
- ((default . error) (END . (declaration . 8)) (PRIVATE . (declaration .
8)) (USE . (declaration . 8)) (TYPE . (declaration . 8)) (TASK . (declaration .
8)) (SUBTYPE . (declaration . 8)) (PROTECTED . (declaration . 8)) (PROCEDURE .
(declaration . 8)) (PRAGMA . (declaration . 8)) (PACKAGE . (declaration . 8))
(OVERRIDING . (declaration . 8)) (NOT . (declaration . 8)) (GENERIC .
(declaration . 8)) (FUNCTION . (declaration . 8)) (FOR . (declaration . 8))
(ENTRY . (declaration . 8)) (IDE [...]
- ((default . error) (END . (declaration . 10)) (PRIVATE . (declaration .
10)) (USE . (declaration . 10)) (TYPE . (declaration . 10)) (TASK .
(declaration . 10)) (SUBTYPE . (declaration . 10)) (PROTECTED . (declaration .
10)) (PROCEDURE . (declaration . 10)) (PRAGMA . (declaration . 10)) (PACKAGE .
(declaration . 10)) (OVERRIDING . (declaration . 10)) (NOT . (declaration .
10)) (GENERIC . (declaration . 10)) (FUNCTION . (declaration . 10)) (FOR .
(declaration . 10)) (ENTRY . (declara [...]
- ((default . error) (PRIVATE . (renaming_declaration . 0)) (END .
(renaming_declaration . 0)) (BEGIN . (renaming_declaration . 0)) (IDENTIFIER .
(renaming_declaration . 0)) (ENTRY . (renaming_declaration . 0)) (FOR .
(renaming_declaration . 0)) (FUNCTION . (renaming_declaration . 0)) (GENERIC .
(renaming_declaration . 0)) (NOT . (renaming_declaration . 0)) (OVERRIDING .
(renaming_declaration . 0)) (PACKAGE . (renaming_declaration . 0)) (PRAGMA .
(renaming_declaration . 0)) (PROCEDUR [...]
- ((default . error) (ENTRY . 424) (FUNCTION . 40) (PROCEDURE . 41))
- ((default . error) ($EOI . (proper_body . 1)) (LIMITED . (proper_body .
1)) (SEPARATE . (proper_body . 1)) (WITH . (proper_body . 1)) (END .
(proper_body . 1)) (PRIVATE . (proper_body . 1)) (USE . (proper_body . 1))
(TYPE . (proper_body . 1)) (TASK . (proper_body . 1)) (SUBTYPE . (proper_body .
1)) (PROTECTED . (proper_body . 1)) (PROCEDURE . (proper_body . 1)) (PRAGMA .
(proper_body . 1)) (PACKAGE . (proper_body . 1)) (OVERRIDING . (proper_body .
1)) (NOT . (proper_body . 1)) (GEN [...]
- ((default . error) (END . (body_stub . 1)) (PRIVATE . (body_stub . 1))
(USE . (body_stub . 1)) (TYPE . (body_stub . 1)) (TASK . (body_stub . 1))
(SUBTYPE . (body_stub . 1)) (PROTECTED . (body_stub . 1)) (PROCEDURE .
(body_stub . 1)) (PRAGMA . (body_stub . 1)) (PACKAGE . (body_stub . 1))
(OVERRIDING . (body_stub . 1)) (NOT . (body_stub . 1)) (GENERIC . (body_stub .
1)) (FUNCTION . (body_stub . 1)) (FOR . (body_stub . 1)) (ENTRY . (body_stub .
1)) (IDENTIFIER . (body_stub . 1)) (BEGI [...]
- ((default . error) (END . (declaration . 11)) (PRIVATE . (declaration .
11)) (USE . (declaration . 11)) (TYPE . (declaration . 11)) (TASK .
(declaration . 11)) (SUBTYPE . (declaration . 11)) (PROTECTED . (declaration .
11)) (PROCEDURE . (declaration . 11)) (PRAGMA . (declaration . 11)) (PACKAGE .
(declaration . 11)) (OVERRIDING . (declaration . 11)) (NOT . (declaration .
11)) (GENERIC . (declaration . 11)) (FUNCTION . (declaration . 11)) (FOR .
(declaration . 11)) (ENTRY . (declara [...]
- ((default . error) (PRIVATE . (renaming_declaration . 1)) (END .
(renaming_declaration . 1)) (BEGIN . (renaming_declaration . 1)) (IDENTIFIER .
(renaming_declaration . 1)) (ENTRY . (renaming_declaration . 1)) (FOR .
(renaming_declaration . 1)) (FUNCTION . (renaming_declaration . 1)) (GENERIC .
(renaming_declaration . 1)) (NOT . (renaming_declaration . 1)) (OVERRIDING .
(renaming_declaration . 1)) (PACKAGE . (renaming_declaration . 1)) (PRAGMA .
(renaming_declaration . 1)) (PROCEDUR [...]
- ((default . error) (END . (declaration . 12)) (PRIVATE . (declaration .
12)) (USE . (declaration . 12)) (TYPE . (declaration . 12)) (TASK .
(declaration . 12)) (SUBTYPE . (declaration . 12)) (PROTECTED . (declaration .
12)) (PROCEDURE . (declaration . 12)) (PRAGMA . (declaration . 12)) (PACKAGE .
(declaration . 12)) (OVERRIDING . (declaration . 12)) (NOT . (declaration .
12)) (GENERIC . (declaration . 12)) (FUNCTION . (declaration . 12)) (FOR .
(declaration . 12)) (ENTRY . (declara [...]
- ((default . error) (PRIVATE . (type_declaration . 3)) (END .
(type_declaration . 3)) (BEGIN . (type_declaration . 3)) (IDENTIFIER .
(type_declaration . 3)) (ENTRY . (type_declaration . 3)) (FOR .
(type_declaration . 3)) (FUNCTION . (type_declaration . 3)) (GENERIC .
(type_declaration . 3)) (NOT . (type_declaration . 3)) (OVERRIDING .
(type_declaration . 3)) (PACKAGE . (type_declaration . 3)) (PRAGMA .
(type_declaration . 3)) (PROCEDURE . (type_declaration . 3)) (PROTECTED .
(type_d [...]
- ((default . error) (PRIVATE . (type_declaration . 2)) (END .
(type_declaration . 2)) (BEGIN . (type_declaration . 2)) (IDENTIFIER .
(type_declaration . 2)) (ENTRY . (type_declaration . 2)) (FOR .
(type_declaration . 2)) (FUNCTION . (type_declaration . 2)) (GENERIC .
(type_declaration . 2)) (NOT . (type_declaration . 2)) (OVERRIDING .
(type_declaration . 2)) (PACKAGE . (type_declaration . 2)) (PRAGMA .
(type_declaration . 2)) (PROCEDURE . (type_declaration . 2)) (PROTECTED .
(type_d [...]
- ((default . error) (PRIVATE . (body . 0)) (END . (body . 0)) (BEGIN .
(body . 0)) (IDENTIFIER . (body . 0)) (ENTRY . (body . 0)) (FOR . (body . 0))
(FUNCTION . (body . 0)) (GENERIC . (body . 0)) (NOT . (body . 0)) (OVERRIDING .
(body . 0)) (PACKAGE . (body . 0)) (PRAGMA . (body . 0)) (PROCEDURE . (body .
0)) (PROTECTED . (body . 0)) (SUBTYPE . (body . 0)) (TASK . (body . 0)) (TYPE .
(body . 0)) (USE . (body . 0)))
- ((default . error) ($EOI . (proper_body . 3)) (LIMITED . (proper_body .
3)) (SEPARATE . (proper_body . 3)) (WITH . (proper_body . 3)) (END .
(proper_body . 3)) (PRIVATE . (proper_body . 3)) (USE . (proper_body . 3))
(TYPE . (proper_body . 3)) (TASK . (proper_body . 3)) (SUBTYPE . (proper_body .
3)) (PROTECTED . (proper_body . 3)) (PROCEDURE . (proper_body . 3)) (PRAGMA .
(proper_body . 3)) (PACKAGE . (proper_body . 3)) (OVERRIDING . (proper_body .
3)) (NOT . (proper_body . 3)) (GEN [...]
- ((default . error) (END . (body_stub . 3)) (PRIVATE . (body_stub . 3))
(USE . (body_stub . 3)) (TYPE . (body_stub . 3)) (TASK . (body_stub . 3))
(SUBTYPE . (body_stub . 3)) (PROTECTED . (body_stub . 3)) (PROCEDURE .
(body_stub . 3)) (PRAGMA . (body_stub . 3)) (PACKAGE . (body_stub . 3))
(OVERRIDING . (body_stub . 3)) (NOT . (body_stub . 3)) (GENERIC . (body_stub .
3)) (FUNCTION . (body_stub . 3)) (FOR . (body_stub . 3)) (ENTRY . (body_stub .
3)) (IDENTIFIER . (body_stub . 3)) (BEGI [...]
- ((default . error) (END . (full_type_declaration . 2)) (PRIVATE .
(full_type_declaration . 2)) (USE . (full_type_declaration . 2)) (TYPE .
(full_type_declaration . 2)) (TASK . (full_type_declaration . 2)) (SUBTYPE .
(full_type_declaration . 2)) (PROTECTED . (full_type_declaration . 2))
(PROCEDURE . (full_type_declaration . 2)) (PRAGMA . (full_type_declaration .
2)) (PACKAGE . (full_type_declaration . 2)) (OVERRIDING .
(full_type_declaration . 2)) (NOT . (full_type_declaration . 2)) [...]
- ((default . error) (WHEN . (aspect_clause . 2)) (PRIVATE .
(aspect_clause . 2)) (END . (aspect_clause . 2)) (CASE . (aspect_clause . 2))
(BEGIN . (aspect_clause . 2)) (IDENTIFIER . (aspect_clause . 2)) (ENTRY .
(aspect_clause . 2)) (FOR . (aspect_clause . 2)) (FUNCTION . (aspect_clause .
2)) (GENERIC . (aspect_clause . 2)) (NOT . (aspect_clause . 2)) (OVERRIDING .
(aspect_clause . 2)) (PACKAGE . (aspect_clause . 2)) (PRAGMA . (aspect_clause .
2)) (PROCEDURE . (aspect_clause . 2)) ( [...]
- ((default . error) (END . (declaration . 13)) (PRIVATE . (declaration .
13)) (USE . (declaration . 13)) (TYPE . (declaration . 13)) (TASK .
(declaration . 13)) (SUBTYPE . (declaration . 13)) (PROTECTED . (declaration .
13)) (PROCEDURE . (declaration . 13)) (PRAGMA . (declaration . 13)) (PACKAGE .
(declaration . 13)) (OVERRIDING . (declaration . 13)) (NOT . (declaration .
13)) (GENERIC . (declaration . 13)) (FUNCTION . (declaration . 13)) (FOR .
(declaration . 13)) (ENTRY . (declara [...]
- ((default . error) (PRIVATE . (object_declaration . 7)) (END .
(object_declaration . 7)) (BEGIN . (object_declaration . 7)) (IDENTIFIER .
(object_declaration . 7)) (ENTRY . (object_declaration . 7)) (FOR .
(object_declaration . 7)) (FUNCTION . (object_declaration . 7)) (GENERIC .
(object_declaration . 7)) (NOT . (object_declaration . 7)) (OVERRIDING .
(object_declaration . 7)) (PACKAGE . (object_declaration . 7)) (PRAGMA .
(object_declaration . 7)) (PROCEDURE . (object_declaration [...]
- ((default . error) (PRIVATE . (object_declaration . 6)) (END .
(object_declaration . 6)) (BEGIN . (object_declaration . 6)) (IDENTIFIER .
(object_declaration . 6)) (ENTRY . (object_declaration . 6)) (FOR .
(object_declaration . 6)) (FUNCTION . (object_declaration . 6)) (GENERIC .
(object_declaration . 6)) (NOT . (object_declaration . 6)) (OVERRIDING .
(object_declaration . 6)) (PACKAGE . (object_declaration . 6)) (PRAGMA .
(object_declaration . 6)) (PROCEDURE . (object_declaration [...]
- ((default . error) ($EOI . (proper_body . 0)) (LIMITED . (proper_body .
0)) (SEPARATE . (proper_body . 0)) (WITH . (proper_body . 0)) (END .
(proper_body . 0)) (PRIVATE . (proper_body . 0)) (USE . (proper_body . 0))
(TYPE . (proper_body . 0)) (TASK . (proper_body . 0)) (SUBTYPE . (proper_body .
0)) (PROTECTED . (proper_body . 0)) (PROCEDURE . (proper_body . 0)) (PRAGMA .
(proper_body . 0)) (PACKAGE . (proper_body . 0)) (OVERRIDING . (proper_body .
0)) (NOT . (proper_body . 0)) (GEN [...]
- ((default . error) (END . (body_stub . 0)) (PRIVATE . (body_stub . 0))
(USE . (body_stub . 0)) (TYPE . (body_stub . 0)) (TASK . (body_stub . 0))
(SUBTYPE . (body_stub . 0)) (PROTECTED . (body_stub . 0)) (PROCEDURE .
(body_stub . 0)) (PRAGMA . (body_stub . 0)) (PACKAGE . (body_stub . 0))
(OVERRIDING . (body_stub . 0)) (NOT . (body_stub . 0)) (GENERIC . (body_stub .
0)) (FUNCTION . (body_stub . 0)) (FOR . (body_stub . 0)) (ENTRY . (body_stub .
0)) (IDENTIFIER . (body_stub . 0)) (BEGI [...]
- ((default . error) (END . (declaration . 14)) (PRIVATE . (declaration .
14)) (USE . (declaration . 14)) (TYPE . (declaration . 14)) (TASK .
(declaration . 14)) (SUBTYPE . (declaration . 14)) (PROTECTED . (declaration .
14)) (PROCEDURE . (declaration . 14)) (PRAGMA . (declaration . 14)) (PACKAGE .
(declaration . 14)) (OVERRIDING . (declaration . 14)) (NOT . (declaration .
14)) (GENERIC . (declaration . 14)) (FUNCTION . (declaration . 14)) (FOR .
(declaration . 14)) (ENTRY . (declara [...]
- ((default . error) (PRIVATE . (renaming_declaration . 2)) (END .
(renaming_declaration . 2)) (BEGIN . (renaming_declaration . 2)) (IDENTIFIER .
(renaming_declaration . 2)) (ENTRY . (renaming_declaration . 2)) (FOR .
(renaming_declaration . 2)) (FUNCTION . (renaming_declaration . 2)) (GENERIC .
(renaming_declaration . 2)) (NOT . (renaming_declaration . 2)) (OVERRIDING .
(renaming_declaration . 2)) (PACKAGE . (renaming_declaration . 2)) (PRAGMA .
(renaming_declaration . 2)) (PROCEDUR [...]
- ((default . error) (END . (declaration . 15)) (PRIVATE . (declaration .
15)) (USE . (declaration . 15)) (TYPE . (declaration . 15)) (TASK .
(declaration . 15)) (SUBTYPE . (declaration . 15)) (PROTECTED . (declaration .
15)) (PROCEDURE . (declaration . 15)) (PRAGMA . (declaration . 15)) (PACKAGE .
(declaration . 15)) (OVERRIDING . (declaration . 15)) (NOT . (declaration .
15)) (GENERIC . (declaration . 15)) (FUNCTION . (declaration . 15)) (FOR .
(declaration . 15)) (ENTRY . (declara [...]
- ((default . error) ($EOI . (proper_body . 2)) (LIMITED . (proper_body .
2)) (SEPARATE . (proper_body . 2)) (WITH . (proper_body . 2)) (END .
(proper_body . 2)) (PRIVATE . (proper_body . 2)) (USE . (proper_body . 2))
(TYPE . (proper_body . 2)) (TASK . (proper_body . 2)) (SUBTYPE . (proper_body .
2)) (PROTECTED . (proper_body . 2)) (PROCEDURE . (proper_body . 2)) (PRAGMA .
(proper_body . 2)) (PACKAGE . (proper_body . 2)) (OVERRIDING . (proper_body .
2)) (NOT . (proper_body . 2)) (GEN [...]
- ((default . error) (END . (body_stub . 2)) (PRIVATE . (body_stub . 2))
(USE . (body_stub . 2)) (TYPE . (body_stub . 2)) (TASK . (body_stub . 2))
(SUBTYPE . (body_stub . 2)) (PROTECTED . (body_stub . 2)) (PROCEDURE .
(body_stub . 2)) (PRAGMA . (body_stub . 2)) (PACKAGE . (body_stub . 2))
(OVERRIDING . (body_stub . 2)) (NOT . (body_stub . 2)) (GENERIC . (body_stub .
2)) (FUNCTION . (body_stub . 2)) (FOR . (body_stub . 2)) (ENTRY . (body_stub .
2)) (IDENTIFIER . (body_stub . 2)) (BEGI [...]
- ((default . error) (END . (full_type_declaration . 1)) (PRIVATE .
(full_type_declaration . 1)) (USE . (full_type_declaration . 1)) (TYPE .
(full_type_declaration . 1)) (TASK . (full_type_declaration . 1)) (SUBTYPE .
(full_type_declaration . 1)) (PROTECTED . (full_type_declaration . 1))
(PROCEDURE . (full_type_declaration . 1)) (PRAGMA . (full_type_declaration .
1)) (PACKAGE . (full_type_declaration . 1)) (OVERRIDING .
(full_type_declaration . 1)) (NOT . (full_type_declaration . 1)) [...]
- ((default . error) (END . (declaration . 16)) (PRIVATE . (declaration .
16)) (USE . (declaration . 16)) (TYPE . (declaration . 16)) (TASK .
(declaration . 16)) (SUBTYPE . (declaration . 16)) (PROTECTED . (declaration .
16)) (PROCEDURE . (declaration . 16)) (PRAGMA . (declaration . 16)) (PACKAGE .
(declaration . 16)) (OVERRIDING . (declaration . 16)) (NOT . (declaration .
16)) (GENERIC . (declaration . 16)) (FUNCTION . (declaration . 16)) (FOR .
(declaration . 16)) (ENTRY . (declara [...]
- ((default . error) (END . (declaration . 17)) (PRIVATE . (declaration .
17)) (USE . (declaration . 17)) (TYPE . (declaration . 17)) (TASK .
(declaration . 17)) (SUBTYPE . (declaration . 17)) (PROTECTED . (declaration .
17)) (PROCEDURE . (declaration . 17)) (PRAGMA . (declaration . 17)) (PACKAGE .
(declaration . 17)) (OVERRIDING . (declaration . 17)) (NOT . (declaration .
17)) (GENERIC . (declaration . 17)) (FUNCTION . (declaration . 17)) (FOR .
(declaration . 17)) (ENTRY . (declara [...]
- ((default . error) (BEGIN . (declarative_part_opt . 0)) (END .
(declarative_part_opt . 0)) (USE . 11) (SUBTYPE . 299) (PRAGMA . 7) (NOT .
4) (OVERRIDING . 5) (FUNCTION . (overriding_indicator_opt . 2)) (PROCEDURE .
(overriding_indicator_opt . 2)) (ENTRY . (overriding_indicator_opt . 2)) (FOR .
296) (IDENTIFIER . 295) (TYPE . 301) (GENERIC . 2) (PROTECTED . 298) (TASK
. 300) (PACKAGE . 297))
- ((default . error) (COLON_EQUAL . (simple_expression . 0)) (OF .
(simple_expression . 0)) (LOOP . (simple_expression . 0)) (DO .
(simple_expression . 0)) (DOT_DOT . (simple_expression . 0)) (SEMICOLON .
(simple_expression . 0)) (XOR . (simple_expression . 0)) (OR .
(simple_expression . 0)) (AND . (simple_expression . 0)) (SLASH_EQUAL .
(simple_expression . 0)) (LESS_EQUAL . (simple_expression . 0)) (LESS .
(simple_expression . 0)) (GREATER_EQUAL . (simple_expression . 0)) (GREATER
[...]
- ((default . error) (NUMERIC_LITERAL . (binary_adding_operator . 2))
(IDENTIFIER . (binary_adding_operator . 2)) (STRING_LITERAL .
(binary_adding_operator . 2)) (CHARACTER_LITERAL . (binary_adding_operator .
2)) (ABS . (binary_adding_operator . 2)) (LEFT_PAREN . (binary_adding_operator
. 2)) (NEW . (binary_adding_operator . 2)) (NOT . (binary_adding_operator . 2))
(NULL . (binary_adding_operator . 2)))
- ((default . error) (NUMERIC_LITERAL . (binary_adding_operator . 1))
(IDENTIFIER . (binary_adding_operator . 1)) (STRING_LITERAL .
(binary_adding_operator . 1)) (CHARACTER_LITERAL . (binary_adding_operator .
1)) (ABS . (binary_adding_operator . 1)) (LEFT_PAREN . (binary_adding_operator
. 1)) (NEW . (binary_adding_operator . 1)) (NOT . (binary_adding_operator . 1))
(NULL . (binary_adding_operator . 1)))
- ((default . error) (NUMERIC_LITERAL . (binary_adding_operator . 0))
(IDENTIFIER . (binary_adding_operator . 0)) (STRING_LITERAL .
(binary_adding_operator . 0)) (CHARACTER_LITERAL . (binary_adding_operator .
0)) (ABS . (binary_adding_operator . 0)) (LEFT_PAREN . (binary_adding_operator
. 0)) (NEW . (binary_adding_operator . 0)) (NOT . (binary_adding_operator . 0))
(NULL . (binary_adding_operator . 0)))
- ((default . error) (ABS . 147) (NOT . 150) (NUMERIC_LITERAL . 145)
(NULL . 151) (NEW . 149) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49) (LEFT_PAREN . 148))
- ((default . error) (NUMERIC_LITERAL . (multiplying_operator . 1))
(IDENTIFIER . (multiplying_operator . 1)) (STRING_LITERAL .
(multiplying_operator . 1)) (CHARACTER_LITERAL . (multiplying_operator . 1))
(ABS . (multiplying_operator . 1)) (LEFT_PAREN . (multiplying_operator . 1))
(NEW . (multiplying_operator . 1)) (NOT . (multiplying_operator . 1)) (NULL .
(multiplying_operator . 1)))
- ((default . error) (NUMERIC_LITERAL . (multiplying_operator . 0))
(IDENTIFIER . (multiplying_operator . 0)) (STRING_LITERAL .
(multiplying_operator . 0)) (CHARACTER_LITERAL . (multiplying_operator . 0))
(ABS . (multiplying_operator . 0)) (LEFT_PAREN . (multiplying_operator . 0))
(NEW . (multiplying_operator . 0)) (NOT . (multiplying_operator . 0)) (NULL .
(multiplying_operator . 0)))
- ((default . error) (NUMERIC_LITERAL . (multiplying_operator . 2))
(IDENTIFIER . (multiplying_operator . 2)) (STRING_LITERAL .
(multiplying_operator . 2)) (CHARACTER_LITERAL . (multiplying_operator . 2))
(ABS . (multiplying_operator . 2)) (LEFT_PAREN . (multiplying_operator . 2))
(NEW . (multiplying_operator . 2)) (NOT . (multiplying_operator . 2)) (NULL .
(multiplying_operator . 2)))
- ((default . error) (NUMERIC_LITERAL . (multiplying_operator . 3))
(IDENTIFIER . (multiplying_operator . 3)) (STRING_LITERAL .
(multiplying_operator . 3)) (CHARACTER_LITERAL . (multiplying_operator . 3))
(ABS . (multiplying_operator . 3)) (LEFT_PAREN . (multiplying_operator . 3))
(NEW . (multiplying_operator . 3)) (NOT . (multiplying_operator . 3)) (NULL .
(multiplying_operator . 3)))
- ((default . error) (ABS . 147) (NOT . 150) (NUMERIC_LITERAL . 145)
(NULL . 151) (NEW . 149) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49) (LEFT_PAREN . 148))
- ((default . error) (PLUS . 144) (MINUS . 143) (ABS . 147) (NOT .
150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN . 148))
- ((default . error) (THEN . 418) (RAISE . 152) (PLUS . 144) (MINUS .
143) (ABS . 147) (NOT . 150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW .
149) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49)
(LEFT_PAREN . 148))
- ((default . error) (ELSE . 416) (RAISE . 152) (PLUS . 144) (MINUS .
143) (ABS . 147) (NOT . 150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW .
149) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49)
(LEFT_PAREN . 148))
- ((default . error) (RAISE . 152) (PLUS . 144) (MINUS . 143) (ABS .
147) (NOT . 150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
- ((default . error) (RAISE . 152) (PLUS . 144) (MINUS . 143) (ABS .
147) (NOT . 150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
- ((default . error) (ELSE . 413))
- ((default . error) (RAISE . 152) (PLUS . 144) (MINUS . 143) (ABS .
147) (NOT . 150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
- ((default . error) (THEN . 411))
- ((default . error) (RAISE . 152) (PLUS . 144) (MINUS . 143) (ABS .
147) (NOT . 150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
- ((default . error) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
- ((default . error) (RAISE . 152) (PLUS . 144) (MINUS . 143) (ABS .
147) (NOT . 150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149)
(IDENTIFIER . 146) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49)
(LEFT_PAREN . 148))
- ((default . error) (SEMICOLON . 407))
- ((default . error) (LOOP . (raise_expression . 0)) (DO .
(raise_expression . 0)) (XOR . (raise_expression . 0)) (OR . (raise_expression
. 0)) (AND . (raise_expression . 0)) (IS . (raise_expression . 0)) (SEMICOLON .
(raise_expression . 0)) (THEN . (raise_expression . 0)) (RANGE .
(raise_expression . 0)) (RIGHT_PAREN . (raise_expression . 0)) (COMMA .
(raise_expression . 0)) (DIGITS . (raise_expression . 0)) (EQUAL_GREATER .
(raise_expression . 0)) (ELSE . (raise_expression . 0)) (E [...]
- ((default . error) (DOT . 87) (TICK . 88) (COLON_EQUAL . (primary .
4)) (OF . (primary . 4)) (LOOP . (primary . 4)) (DO . (primary . 4)) (STAR_STAR
. (primary . 4)) (REM . (primary . 4)) (MOD . (primary . 4)) (STAR . (primary .
4)) (SLASH . (primary . 4)) (DOT_DOT . (primary . 4)) (AMPERSAND . (primary .
4)) (MINUS . (primary . 4)) (PLUS . (primary . 4)) (SEMICOLON . (primary . 4))
(XOR . (primary . 4)) (OR . (primary . 4)) (AND . (primary . 4)) (SLASH_EQUAL .
(primary . 4)) (LES [...]
- ((default . error) (ALL . 403) (SOME . 404))
- ((default . error) (RIGHT_PAREN . 402))
- ((default . error) (RIGHT_PAREN . 401))
- ((default . error) (RIGHT_PAREN . 400))
- ((default . error) (COLON_EQUAL . (factor . 2)) (OF . (factor . 2))
(LOOP . (factor . 2)) (DO . (factor . 2)) (PLUS . (factor . 2)) (MINUS .
(factor . 2)) (AMPERSAND . (factor . 2)) (DOT_DOT . (factor . 2)) (SLASH .
(factor . 2)) (STAR . (factor . 2)) (MOD . (factor . 2)) (REM . (factor . 2))
(SEMICOLON . (factor . 2)) (XOR . (factor . 2)) (OR . (factor . 2)) (AND .
(factor . 2)) (IN . (factor . 2)) (NOT . (factor . 2)) (EQUAL . (factor . 2))
(GREATER . (factor . 2)) (GREATER_EQUAL [...]
- ((default . error) (RAISE . 152) (PLUS . 144) (MINUS . 143) (ABS .
147) (NOT . 150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
- ((default . error) (IDENTIFIER . 398))
+ ((default . error) (DOT . 90) (TICK . 91) (SEMICOLON .
(aspect_specification_opt . 0)) (WITH . 109) (LEFT_PAREN . 107))
+ ((default . error) (DO . (name . 2)) (STAR_STAR . (name . 2)) (STAR .
(name . 2)) (SLASH . (name . 2)) (REM . (name . 2)) (MOD . (name . 2)) (DOT_DOT
. (name . 2)) (AMPERSAND . (name . 2)) (MINUS . (name . 2)) (PLUS . (name . 2))
(RIGHT_PAREN . (name . 2)) (XOR . (name . 2)) (OR . (name . 2)) (EQUAL_GREATER
. (name . 2)) (BAR . (name . 2)) (SLASH_EQUAL . (name . 2)) (LESS_EQUAL . (name
. 2)) (LESS . (name . 2)) (GREATER_EQUAL . (name . 2)) (GREATER . (name . 2))
(EQUAL . (name . 2) [...]
+ ((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49) (PLUS . 154) (MINUS . 153) (ABS . 144) (NOT . 150)
(NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149) (LEFT_PAREN . 148))
+ ((default . error) (STAR_STAR . (actual_parameter_part . 1)) (STAR .
(actual_parameter_part . 1)) (SLASH . (actual_parameter_part . 1)) (REM .
(actual_parameter_part . 1)) (MOD . (actual_parameter_part . 1)) (DOT_DOT .
(actual_parameter_part . 1)) (AMPERSAND . (actual_parameter_part . 1)) (MINUS .
(actual_parameter_part . 1)) (PLUS . (actual_parameter_part . 1)) (RIGHT_PAREN
. (actual_parameter_part . 1)) (XOR . (actual_parameter_part . 1)) (OR .
(actual_parameter_part . 1)) (EQUAL [...]
+ ((default . error) (STAR_STAR . (actual_parameter_part . 0)) (STAR .
(actual_parameter_part . 0)) (SLASH . (actual_parameter_part . 0)) (REM .
(actual_parameter_part . 0)) (MOD . (actual_parameter_part . 0)) (DOT_DOT .
(actual_parameter_part . 0)) (AMPERSAND . (actual_parameter_part . 0)) (MINUS .
(actual_parameter_part . 0)) (PLUS . (actual_parameter_part . 0)) (RIGHT_PAREN
. (actual_parameter_part . 0)) (XOR . (actual_parameter_part . 0)) (OR .
(actual_parameter_part . 0)) (EQUAL [...]
+ ((default . error) (RIGHT_PAREN . ((expression_opt . 0) (association_opt
. 0))) (COMMA . ((expression_opt . 0) (association_opt . 0))) (IS .
((expression_opt . 0) (association_opt . 0))) (SEMICOLON . ((expression_opt .
0) (association_opt . 0))) (EQUAL_GREATER . (discrete_choice_list . 0)) (BAR .
(discrete_choice_list . 0)) (OTHERS . 182) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 183) (STRING_LITERAL . 49) (RAISE . 152) (PLUS . 154)
(MINUS . 153) (ABS . 144) (NOT . 181) (NUME [...]
+ ((default . error) (SEMICOLON . 484))
+ ((default . error) (PLUS . 154) (MINUS . 153) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (ABS . 144) (NOT . 150)
(NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149) (LEFT_PAREN . 148))
+ ((default . error) (IN . 479))
+ ((default . error) (PLUS . 154) (MINUS . 153) (ABS . 144) (NOT .
150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN . 148))
+ ((default . error) (ABS . (relational_operator . 0)) (LEFT_PAREN .
(relational_operator . 0)) (NEW . (relational_operator . 0)) (NOT .
(relational_operator . 0)) (NULL . (relational_operator . 0)) (MINUS .
(relational_operator . 0)) (PLUS . (relational_operator . 0)) (NUMERIC_LITERAL
. (relational_operator . 0)) (IDENTIFIER . (relational_operator . 0))
(STRING_LITERAL . (relational_operator . 0)) (CHARACTER_LITERAL .
(relational_operator . 0)))
+ ((default . error) (ABS . (relational_operator . 4)) (LEFT_PAREN .
(relational_operator . 4)) (NEW . (relational_operator . 4)) (NOT .
(relational_operator . 4)) (NULL . (relational_operator . 4)) (MINUS .
(relational_operator . 4)) (PLUS . (relational_operator . 4)) (NUMERIC_LITERAL
. (relational_operator . 4)) (IDENTIFIER . (relational_operator . 4))
(STRING_LITERAL . (relational_operator . 4)) (CHARACTER_LITERAL .
(relational_operator . 4)))
+ ((default . error) (ABS . (relational_operator . 5)) (LEFT_PAREN .
(relational_operator . 5)) (NEW . (relational_operator . 5)) (NOT .
(relational_operator . 5)) (NULL . (relational_operator . 5)) (MINUS .
(relational_operator . 5)) (PLUS . (relational_operator . 5)) (NUMERIC_LITERAL
. (relational_operator . 5)) (IDENTIFIER . (relational_operator . 5))
(STRING_LITERAL . (relational_operator . 5)) (CHARACTER_LITERAL .
(relational_operator . 5)))
+ ((default . error) (ABS . (relational_operator . 2)) (LEFT_PAREN .
(relational_operator . 2)) (NEW . (relational_operator . 2)) (NOT .
(relational_operator . 2)) (NULL . (relational_operator . 2)) (MINUS .
(relational_operator . 2)) (PLUS . (relational_operator . 2)) (NUMERIC_LITERAL
. (relational_operator . 2)) (IDENTIFIER . (relational_operator . 2))
(STRING_LITERAL . (relational_operator . 2)) (CHARACTER_LITERAL .
(relational_operator . 2)))
+ ((default . error) (ABS . (relational_operator . 3)) (LEFT_PAREN .
(relational_operator . 3)) (NEW . (relational_operator . 3)) (NOT .
(relational_operator . 3)) (NULL . (relational_operator . 3)) (MINUS .
(relational_operator . 3)) (PLUS . (relational_operator . 3)) (NUMERIC_LITERAL
. (relational_operator . 3)) (IDENTIFIER . (relational_operator . 3))
(STRING_LITERAL . (relational_operator . 3)) (CHARACTER_LITERAL .
(relational_operator . 3)))
+ ((default . error) (ABS . (relational_operator . 1)) (LEFT_PAREN .
(relational_operator . 1)) (NEW . (relational_operator . 1)) (NOT .
(relational_operator . 1)) (NULL . (relational_operator . 1)) (MINUS .
(relational_operator . 1)) (PLUS . (relational_operator . 1)) (NUMERIC_LITERAL
. (relational_operator . 1)) (IDENTIFIER . (relational_operator . 1))
(STRING_LITERAL . (relational_operator . 1)) (CHARACTER_LITERAL .
(relational_operator . 1)))
+ ((default . error) (PLUS . 154) (MINUS . 153) (ABS . 144) (NOT .
150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN . 148))
+ ((default . error) (RANGE . 476) (LEFT_PAREN . 148) (ACCESS . 221)
(DELTA . 222) (DIGITS . 223) (MOD . 224) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49))
+ ((default . error) (OTHERS . 182) (IDENTIFIER . 48) (CHARACTER_LITERAL
. 50) (STRING_LITERAL . 49) (PLUS . 154) (MINUS . 153) (ABS . 144) (NOT .
181) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149) (LEFT_PAREN . 148))
+ ((default . error) (BOX . 472) (RAISE . 152) (PLUS . 154) (MINUS .
153) (ABS . 144) (NOT . 150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW .
149) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49)
(LEFT_PAREN . 148))
+ ((default . error) (THEN . 470) (PLUS . 154) (MINUS . 153) (ABS .
144) (NOT . 150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
+ ((default . error) (ELSE . 468) (PLUS . 154) (MINUS . 153) (ABS .
144) (NOT . 150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
+ ((default . error) (PLUS . 154) (MINUS . 153) (ABS . 144) (NOT .
150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN . 148))
+ ((default . error) (ELSE . 466))
+ ((default . error) (THEN . 465))
+ ((default . error) (PLUS . 154) (MINUS . 153) (ABS . 144) (NOT .
150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN . 148))
+ ((default . error) (PLUS . 154) (MINUS . 153) (ABS . 144) (NOT .
150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN . 148))
+ ((default . error) (PLUS . 154) (MINUS . 153) (ABS . 144) (NOT .
150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN . 148))
+ ((default . error) (BOX . 459) (RAISE . 152) (PLUS . 154) (MINUS .
153) (ABS . 144) (NOT . 150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW .
149) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49)
(LEFT_PAREN . 148))
+ ((default . error) (XOR . (primary . 1)) (OR . (primary . 1)) (AND .
(primary . 1)) (SLASH_EQUAL . (primary . 1)) (LESS_EQUAL . (primary . 1)) (LESS
. (primary . 1)) (GREATER_EQUAL . (primary . 1)) (GREATER . (primary . 1))
(EQUAL . (primary . 1)) (EQUAL_GREATER . (primary . 1)) (BAR . (primary . 1))
(PLUS . (primary . 1)) (MINUS . (primary . 1)) (AMPERSAND . (primary . 1))
(DOT_DOT . (primary . 1)) (MOD . (primary . 1)) (REM . (primary . 1)) (SLASH .
(primary . 1)) (STAR . (primar [...]
+ ((default . error) (COLON_EQUAL . (factor . 3)) (OF . (factor . 3))
(LOOP . (factor . 3)) (DO . (factor . 3)) (PLUS . (factor . 3)) (MINUS .
(factor . 3)) (AMPERSAND . (factor . 3)) (SEMICOLON . (factor . 3)) (MOD .
(factor . 3)) (REM . (factor . 3)) (SLASH . (factor . 3)) (STAR . (factor . 3))
(XOR . (factor . 3)) (OR . (factor . 3)) (AND . (factor . 3)) (IN . (factor .
3)) (NOT . (factor . 3)) (EQUAL . (factor . 3)) (GREATER . (factor . 3))
(GREATER_EQUAL . (factor . 3)) (LESS . [...]
+ ((default . error) (IDENTIFIER . 453) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 454))
+ ((default . error) (BODY . 452) (IDENTIFIER . 48) (CHARACTER_LITERAL .
50) (STRING_LITERAL . 49))
+ ((default . error) (IDENTIFIER . 451) (TYPE . 450) (BODY . 449))
+ ((default . error) (IDENTIFIER . 448))
+ ((default . error) (TYPE . 446) (BODY . 445) (IDENTIFIER . 447))
+ ((default . error) (IDENTIFIER . 444))
+ ((default . error) (COLON . ( 443 (identifier_list . 0))) (COMMA .
(identifier_list . 0)))
+ ((default . error) (END . (declaration . 0)) (PRIVATE . (declaration .
0)) (IDENTIFIER . (declaration . 0)) (USE . (declaration . 0)) (TYPE .
(declaration . 0)) (TASK . (declaration . 0)) (SUBTYPE . (declaration . 0))
(PROTECTED . (declaration . 0)) (PROCEDURE . (declaration . 0)) (PRAGMA .
(declaration . 0)) (PACKAGE . (declaration . 0)) (OVERRIDING . (declaration .
0)) (NOT . (declaration . 0)) (GENERIC . (declaration . 0)) (FUNCTION .
(declaration . 0)) (FOR . (declaration . 0)) [...]
+ ((default . error) (END . (declaration . 1)) (PRIVATE . (declaration .
1)) (IDENTIFIER . (declaration . 1)) (USE . (declaration . 1)) (TYPE .
(declaration . 1)) (TASK . (declaration . 1)) (SUBTYPE . (declaration . 1))
(PROTECTED . (declaration . 1)) (PROCEDURE . (declaration . 1)) (PRAGMA .
(declaration . 1)) (PACKAGE . (declaration . 1)) (OVERRIDING . (declaration .
1)) (NOT . (declaration . 1)) (GENERIC . (declaration . 1)) (FUNCTION .
(declaration . 1)) (FOR . (declaration . 1)) [...]
+ ((default . error) (WHEN . (aspect_clause . 3)) (PRIVATE .
(aspect_clause . 3)) (END . (aspect_clause . 3)) (CASE . (aspect_clause . 3))
(BEGIN . (aspect_clause . 3)) (ENTRY . (aspect_clause . 3)) (FOR .
(aspect_clause . 3)) (FUNCTION . (aspect_clause . 3)) (GENERIC . (aspect_clause
. 3)) (NOT . (aspect_clause . 3)) (OVERRIDING . (aspect_clause . 3)) (PACKAGE .
(aspect_clause . 3)) (PRAGMA . (aspect_clause . 3)) (PROCEDURE . (aspect_clause
. 3)) (PROTECTED . (aspect_clause . 3)) (S [...]
+ ((default . error) (END . (declaration . 2)) (PRIVATE . (declaration .
2)) (IDENTIFIER . (declaration . 2)) (USE . (declaration . 2)) (TYPE .
(declaration . 2)) (TASK . (declaration . 2)) (SUBTYPE . (declaration . 2))
(PROTECTED . (declaration . 2)) (PROCEDURE . (declaration . 2)) (PRAGMA .
(declaration . 2)) (PACKAGE . (declaration . 2)) (OVERRIDING . (declaration .
2)) (NOT . (declaration . 2)) (GENERIC . (declaration . 2)) (FUNCTION .
(declaration . 2)) (FOR . (declaration . 2)) [...]
+ ((default . error) (PRIVATE . (body . 1)) (END . (body . 1)) (BEGIN .
(body . 1)) (ENTRY . (body . 1)) (FOR . (body . 1)) (FUNCTION . (body . 1))
(GENERIC . (body . 1)) (NOT . (body . 1)) (OVERRIDING . (body . 1)) (PACKAGE .
(body . 1)) (PRAGMA . (body . 1)) (PROCEDURE . (body . 1)) (PROTECTED . (body .
1)) (SUBTYPE . (body . 1)) (TASK . (body . 1)) (TYPE . (body . 1)) (USE . (body
. 1)) (IDENTIFIER . (body . 1)))
+ ((default . error) (PRIVATE . (declarations . 0)) (END . (declarations .
0)) (BEGIN . (declarations . 0)) (ENTRY . (declarations . 0)) (FOR .
(declarations . 0)) (FUNCTION . (declarations . 0)) (GENERIC . (declarations .
0)) (NOT . (declarations . 0)) (OVERRIDING . (declarations . 0)) (PACKAGE .
(declarations . 0)) (PRAGMA . (declarations . 0)) (PROCEDURE . (declarations .
0)) (PROTECTED . (declarations . 0)) (SUBTYPE . (declarations . 0)) (TASK .
(declarations . 0)) (TYPE . (decla [...]
+ ((default . error) (END . (declarative_part_opt . 1)) (PRIVATE .
(declarative_part_opt . 1)) (BEGIN . (declarative_part_opt . 1)) (USE . 11)
(SUBTYPE . 302) (PRAGMA . 7) (NOT . 4) (OVERRIDING . 5) (FUNCTION .
(overriding_indicator_opt . 2)) (PROCEDURE . (overriding_indicator_opt . 2))
(ENTRY . (overriding_indicator_opt . 2)) (FOR . 299) (IDENTIFIER . 305) (TYPE
. 304) (GENERIC . 2) (PROTECTED . 301) (TASK . 303) (PACKAGE . 300))
+ ((default . error) (END . 440) (PRIVATE . 441))
+ ((default . error) (END . (declaration . 3)) (PRIVATE . (declaration .
3)) (IDENTIFIER . (declaration . 3)) (USE . (declaration . 3)) (TYPE .
(declaration . 3)) (TASK . (declaration . 3)) (SUBTYPE . (declaration . 3))
(PROTECTED . (declaration . 3)) (PROCEDURE . (declaration . 3)) (PRAGMA .
(declaration . 3)) (PACKAGE . (declaration . 3)) (OVERRIDING . (declaration .
3)) (NOT . (declaration . 3)) (GENERIC . (declaration . 3)) (FUNCTION .
(declaration . 3)) (FOR . (declaration . 3)) [...]
+ ((default . error) (WHEN . (aspect_clause . 1)) (PRIVATE .
(aspect_clause . 1)) (END . (aspect_clause . 1)) (CASE . (aspect_clause . 1))
(BEGIN . (aspect_clause . 1)) (ENTRY . (aspect_clause . 1)) (FOR .
(aspect_clause . 1)) (FUNCTION . (aspect_clause . 1)) (GENERIC . (aspect_clause
. 1)) (NOT . (aspect_clause . 1)) (OVERRIDING . (aspect_clause . 1)) (PACKAGE .
(aspect_clause . 1)) (PRAGMA . (aspect_clause . 1)) (PROCEDURE . (aspect_clause
. 1)) (PROTECTED . (aspect_clause . 1)) (S [...]
+ ((default . error) (END . (declaration . 4)) (PRIVATE . (declaration .
4)) (IDENTIFIER . (declaration . 4)) (USE . (declaration . 4)) (TYPE .
(declaration . 4)) (TASK . (declaration . 4)) (SUBTYPE . (declaration . 4))
(PROTECTED . (declaration . 4)) (PROCEDURE . (declaration . 4)) (PRAGMA .
(declaration . 4)) (PACKAGE . (declaration . 4)) (OVERRIDING . (declaration .
4)) (NOT . (declaration . 4)) (GENERIC . (declaration . 4)) (FUNCTION .
(declaration . 4)) (FOR . (declaration . 4)) [...]
+ ((default . error) (END . (declaration . 5)) (PRIVATE . (declaration .
5)) (IDENTIFIER . (declaration . 5)) (USE . (declaration . 5)) (TYPE .
(declaration . 5)) (TASK . (declaration . 5)) (SUBTYPE . (declaration . 5))
(PROTECTED . (declaration . 5)) (PROCEDURE . (declaration . 5)) (PRAGMA .
(declaration . 5)) (PACKAGE . (declaration . 5)) (OVERRIDING . (declaration .
5)) (NOT . (declaration . 5)) (GENERIC . (declaration . 5)) (FUNCTION .
(declaration . 5)) (FOR . (declaration . 5)) [...]
+ ((default . error) (PRIVATE . (type_declaration . 0)) (END .
(type_declaration . 0)) (BEGIN . (type_declaration . 0)) (ENTRY .
(type_declaration . 0)) (FOR . (type_declaration . 0)) (FUNCTION .
(type_declaration . 0)) (GENERIC . (type_declaration . 0)) (NOT .
(type_declaration . 0)) (OVERRIDING . (type_declaration . 0)) (PACKAGE .
(type_declaration . 0)) (PRAGMA . (type_declaration . 0)) (PROCEDURE .
(type_declaration . 0)) (PROTECTED . (type_declaration . 0)) (SUBTYPE .
(type_decl [...]
+ ((default . error) (END . (declaration . 6)) (PRIVATE . (declaration .
6)) (IDENTIFIER . (declaration . 6)) (USE . (declaration . 6)) (TYPE .
(declaration . 6)) (TASK . (declaration . 6)) (SUBTYPE . (declaration . 6))
(PROTECTED . (declaration . 6)) (PROCEDURE . (declaration . 6)) (PRAGMA .
(declaration . 6)) (PACKAGE . (declaration . 6)) (OVERRIDING . (declaration .
6)) (NOT . (declaration . 6)) (GENERIC . (declaration . 6)) (FUNCTION .
(declaration . 6)) (FOR . (declaration . 6)) [...]
+ ((default . error) (END . (declaration . 7)) (PRIVATE . (declaration .
7)) (IDENTIFIER . (declaration . 7)) (USE . (declaration . 7)) (TYPE .
(declaration . 7)) (TASK . (declaration . 7)) (SUBTYPE . (declaration . 7))
(PROTECTED . (declaration . 7)) (PROCEDURE . (declaration . 7)) (PRAGMA .
(declaration . 7)) (PACKAGE . (declaration . 7)) (OVERRIDING . (declaration .
7)) (NOT . (declaration . 7)) (GENERIC . (declaration . 7)) (FUNCTION .
(declaration . 7)) (FOR . (declaration . 7)) [...]
+ ((default . error) (PRIVATE . (renaming_declaration . 3)) (END .
(renaming_declaration . 3)) (BEGIN . (renaming_declaration . 3)) (ENTRY .
(renaming_declaration . 3)) (FOR . (renaming_declaration . 3)) (FUNCTION .
(renaming_declaration . 3)) (GENERIC . (renaming_declaration . 3)) (NOT .
(renaming_declaration . 3)) (OVERRIDING . (renaming_declaration . 3)) (PACKAGE
. (renaming_declaration . 3)) (PRAGMA . (renaming_declaration . 3)) (PROCEDURE
. (renaming_declaration . 3)) (PROTECTED [...]
+ ((default . error) (COMMA . 96) (COLON . 439))
+ ((default . error) (PRIVATE . (type_declaration . 1)) (END .
(type_declaration . 1)) (BEGIN . (type_declaration . 1)) (ENTRY .
(type_declaration . 1)) (FOR . (type_declaration . 1)) (FUNCTION .
(type_declaration . 1)) (GENERIC . (type_declaration . 1)) (NOT .
(type_declaration . 1)) (OVERRIDING . (type_declaration . 1)) (PACKAGE .
(type_declaration . 1)) (PRAGMA . (type_declaration . 1)) (PROCEDURE .
(type_declaration . 1)) (PROTECTED . (type_declaration . 1)) (SUBTYPE .
(type_decl [...]
+ ((default . error) (END . (declaration . 8)) (PRIVATE . (declaration .
8)) (IDENTIFIER . (declaration . 8)) (USE . (declaration . 8)) (TYPE .
(declaration . 8)) (TASK . (declaration . 8)) (SUBTYPE . (declaration . 8))
(PROTECTED . (declaration . 8)) (PROCEDURE . (declaration . 8)) (PRAGMA .
(declaration . 8)) (PACKAGE . (declaration . 8)) (OVERRIDING . (declaration .
8)) (NOT . (declaration . 8)) (GENERIC . (declaration . 8)) (FUNCTION .
(declaration . 8)) (FOR . (declaration . 8)) [...]
+ ((default . error) (END . (declaration . 10)) (PRIVATE . (declaration .
10)) (IDENTIFIER . (declaration . 10)) (USE . (declaration . 10)) (TYPE .
(declaration . 10)) (TASK . (declaration . 10)) (SUBTYPE . (declaration . 10))
(PROTECTED . (declaration . 10)) (PROCEDURE . (declaration . 10)) (PRAGMA .
(declaration . 10)) (PACKAGE . (declaration . 10)) (OVERRIDING . (declaration .
10)) (NOT . (declaration . 10)) (GENERIC . (declaration . 10)) (FUNCTION .
(declaration . 10)) (FOR . (de [...]
+ ((default . error) (PRIVATE . (renaming_declaration . 0)) (END .
(renaming_declaration . 0)) (BEGIN . (renaming_declaration . 0)) (ENTRY .
(renaming_declaration . 0)) (FOR . (renaming_declaration . 0)) (FUNCTION .
(renaming_declaration . 0)) (GENERIC . (renaming_declaration . 0)) (NOT .
(renaming_declaration . 0)) (OVERRIDING . (renaming_declaration . 0)) (PACKAGE
. (renaming_declaration . 0)) (PRAGMA . (renaming_declaration . 0)) (PROCEDURE
. (renaming_declaration . 0)) (PROTECTED [...]
+ ((default . error) (ENTRY . 435) (FUNCTION . 40) (PROCEDURE . 41))
+ ((default . error) ($EOI . (proper_body . 1)) (LIMITED . (proper_body .
1)) (SEPARATE . (proper_body . 1)) (WITH . (proper_body . 1)) (END .
(proper_body . 1)) (PRIVATE . (proper_body . 1)) (IDENTIFIER . (proper_body .
1)) (USE . (proper_body . 1)) (TYPE . (proper_body . 1)) (TASK . (proper_body .
1)) (SUBTYPE . (proper_body . 1)) (PROTECTED . (proper_body . 1)) (PROCEDURE .
(proper_body . 1)) (PRAGMA . (proper_body . 1)) (PACKAGE . (proper_body . 1))
(OVERRIDING . (proper_body . 1 [...]
+ ((default . error) (END . (body_stub . 1)) (PRIVATE . (body_stub . 1))
(IDENTIFIER . (body_stub . 1)) (USE . (body_stub . 1)) (TYPE . (body_stub . 1))
(TASK . (body_stub . 1)) (SUBTYPE . (body_stub . 1)) (PROTECTED . (body_stub .
1)) (PROCEDURE . (body_stub . 1)) (PRAGMA . (body_stub . 1)) (PACKAGE .
(body_stub . 1)) (OVERRIDING . (body_stub . 1)) (NOT . (body_stub . 1))
(GENERIC . (body_stub . 1)) (FUNCTION . (body_stub . 1)) (FOR . (body_stub .
1)) (ENTRY . (body_stub . 1)) (BEGI [...]
+ ((default . error) (END . (declaration . 11)) (PRIVATE . (declaration .
11)) (IDENTIFIER . (declaration . 11)) (USE . (declaration . 11)) (TYPE .
(declaration . 11)) (TASK . (declaration . 11)) (SUBTYPE . (declaration . 11))
(PROTECTED . (declaration . 11)) (PROCEDURE . (declaration . 11)) (PRAGMA .
(declaration . 11)) (PACKAGE . (declaration . 11)) (OVERRIDING . (declaration .
11)) (NOT . (declaration . 11)) (GENERIC . (declaration . 11)) (FUNCTION .
(declaration . 11)) (FOR . (de [...]
+ ((default . error) (PRIVATE . (renaming_declaration . 1)) (END .
(renaming_declaration . 1)) (BEGIN . (renaming_declaration . 1)) (ENTRY .
(renaming_declaration . 1)) (FOR . (renaming_declaration . 1)) (FUNCTION .
(renaming_declaration . 1)) (GENERIC . (renaming_declaration . 1)) (NOT .
(renaming_declaration . 1)) (OVERRIDING . (renaming_declaration . 1)) (PACKAGE
. (renaming_declaration . 1)) (PRAGMA . (renaming_declaration . 1)) (PROCEDURE
. (renaming_declaration . 1)) (PROTECTED [...]
+ ((default . error) (END . (declaration . 12)) (PRIVATE . (declaration .
12)) (IDENTIFIER . (declaration . 12)) (USE . (declaration . 12)) (TYPE .
(declaration . 12)) (TASK . (declaration . 12)) (SUBTYPE . (declaration . 12))
(PROTECTED . (declaration . 12)) (PROCEDURE . (declaration . 12)) (PRAGMA .
(declaration . 12)) (PACKAGE . (declaration . 12)) (OVERRIDING . (declaration .
12)) (NOT . (declaration . 12)) (GENERIC . (declaration . 12)) (FUNCTION .
(declaration . 12)) (FOR . (de [...]
+ ((default . error) (PRIVATE . (type_declaration . 3)) (END .
(type_declaration . 3)) (BEGIN . (type_declaration . 3)) (ENTRY .
(type_declaration . 3)) (FOR . (type_declaration . 3)) (FUNCTION .
(type_declaration . 3)) (GENERIC . (type_declaration . 3)) (NOT .
(type_declaration . 3)) (OVERRIDING . (type_declaration . 3)) (PACKAGE .
(type_declaration . 3)) (PRAGMA . (type_declaration . 3)) (PROCEDURE .
(type_declaration . 3)) (PROTECTED . (type_declaration . 3)) (SUBTYPE .
(type_decl [...]
+ ((default . error) (PRIVATE . (type_declaration . 2)) (END .
(type_declaration . 2)) (BEGIN . (type_declaration . 2)) (ENTRY .
(type_declaration . 2)) (FOR . (type_declaration . 2)) (FUNCTION .
(type_declaration . 2)) (GENERIC . (type_declaration . 2)) (NOT .
(type_declaration . 2)) (OVERRIDING . (type_declaration . 2)) (PACKAGE .
(type_declaration . 2)) (PRAGMA . (type_declaration . 2)) (PROCEDURE .
(type_declaration . 2)) (PROTECTED . (type_declaration . 2)) (SUBTYPE .
(type_decl [...]
+ ((default . error) (PRIVATE . (body . 0)) (END . (body . 0)) (BEGIN .
(body . 0)) (ENTRY . (body . 0)) (FOR . (body . 0)) (FUNCTION . (body . 0))
(GENERIC . (body . 0)) (NOT . (body . 0)) (OVERRIDING . (body . 0)) (PACKAGE .
(body . 0)) (PRAGMA . (body . 0)) (PROCEDURE . (body . 0)) (PROTECTED . (body .
0)) (SUBTYPE . (body . 0)) (TASK . (body . 0)) (TYPE . (body . 0)) (USE . (body
. 0)) (IDENTIFIER . (body . 0)))
+ ((default . error) ($EOI . (proper_body . 3)) (LIMITED . (proper_body .
3)) (SEPARATE . (proper_body . 3)) (WITH . (proper_body . 3)) (END .
(proper_body . 3)) (PRIVATE . (proper_body . 3)) (IDENTIFIER . (proper_body .
3)) (USE . (proper_body . 3)) (TYPE . (proper_body . 3)) (TASK . (proper_body .
3)) (SUBTYPE . (proper_body . 3)) (PROTECTED . (proper_body . 3)) (PROCEDURE .
(proper_body . 3)) (PRAGMA . (proper_body . 3)) (PACKAGE . (proper_body . 3))
(OVERRIDING . (proper_body . 3 [...]
+ ((default . error) (END . (body_stub . 3)) (PRIVATE . (body_stub . 3))
(IDENTIFIER . (body_stub . 3)) (USE . (body_stub . 3)) (TYPE . (body_stub . 3))
(TASK . (body_stub . 3)) (SUBTYPE . (body_stub . 3)) (PROTECTED . (body_stub .
3)) (PROCEDURE . (body_stub . 3)) (PRAGMA . (body_stub . 3)) (PACKAGE .
(body_stub . 3)) (OVERRIDING . (body_stub . 3)) (NOT . (body_stub . 3))
(GENERIC . (body_stub . 3)) (FUNCTION . (body_stub . 3)) (FOR . (body_stub .
3)) (ENTRY . (body_stub . 3)) (BEGI [...]
+ ((default . error) (END . (full_type_declaration . 2)) (PRIVATE .
(full_type_declaration . 2)) (IDENTIFIER . (full_type_declaration . 2)) (USE .
(full_type_declaration . 2)) (TYPE . (full_type_declaration . 2)) (TASK .
(full_type_declaration . 2)) (SUBTYPE . (full_type_declaration . 2)) (PROTECTED
. (full_type_declaration . 2)) (PROCEDURE . (full_type_declaration . 2))
(PRAGMA . (full_type_declaration . 2)) (PACKAGE . (full_type_declaration . 2))
(OVERRIDING . (full_type_declaratio [...]
+ ((default . error) (WHEN . (aspect_clause . 2)) (PRIVATE .
(aspect_clause . 2)) (END . (aspect_clause . 2)) (CASE . (aspect_clause . 2))
(BEGIN . (aspect_clause . 2)) (ENTRY . (aspect_clause . 2)) (FOR .
(aspect_clause . 2)) (FUNCTION . (aspect_clause . 2)) (GENERIC . (aspect_clause
. 2)) (NOT . (aspect_clause . 2)) (OVERRIDING . (aspect_clause . 2)) (PACKAGE .
(aspect_clause . 2)) (PRAGMA . (aspect_clause . 2)) (PROCEDURE . (aspect_clause
. 2)) (PROTECTED . (aspect_clause . 2)) (S [...]
+ ((default . error) (END . (declaration . 13)) (PRIVATE . (declaration .
13)) (IDENTIFIER . (declaration . 13)) (USE . (declaration . 13)) (TYPE .
(declaration . 13)) (TASK . (declaration . 13)) (SUBTYPE . (declaration . 13))
(PROTECTED . (declaration . 13)) (PROCEDURE . (declaration . 13)) (PRAGMA .
(declaration . 13)) (PACKAGE . (declaration . 13)) (OVERRIDING . (declaration .
13)) (NOT . (declaration . 13)) (GENERIC . (declaration . 13)) (FUNCTION .
(declaration . 13)) (FOR . (de [...]
+ ((default . error) (PRIVATE . (object_declaration . 7)) (END .
(object_declaration . 7)) (BEGIN . (object_declaration . 7)) (ENTRY .
(object_declaration . 7)) (FOR . (object_declaration . 7)) (FUNCTION .
(object_declaration . 7)) (GENERIC . (object_declaration . 7)) (NOT .
(object_declaration . 7)) (OVERRIDING . (object_declaration . 7)) (PACKAGE .
(object_declaration . 7)) (PRAGMA . (object_declaration . 7)) (PROCEDURE .
(object_declaration . 7)) (PROTECTED . (object_declaration . [...]
+ ((default . error) (PRIVATE . (object_declaration . 6)) (END .
(object_declaration . 6)) (BEGIN . (object_declaration . 6)) (ENTRY .
(object_declaration . 6)) (FOR . (object_declaration . 6)) (FUNCTION .
(object_declaration . 6)) (GENERIC . (object_declaration . 6)) (NOT .
(object_declaration . 6)) (OVERRIDING . (object_declaration . 6)) (PACKAGE .
(object_declaration . 6)) (PRAGMA . (object_declaration . 6)) (PROCEDURE .
(object_declaration . 6)) (PROTECTED . (object_declaration . [...]
+ ((default . error) ($EOI . (proper_body . 0)) (LIMITED . (proper_body .
0)) (SEPARATE . (proper_body . 0)) (WITH . (proper_body . 0)) (END .
(proper_body . 0)) (PRIVATE . (proper_body . 0)) (IDENTIFIER . (proper_body .
0)) (USE . (proper_body . 0)) (TYPE . (proper_body . 0)) (TASK . (proper_body .
0)) (SUBTYPE . (proper_body . 0)) (PROTECTED . (proper_body . 0)) (PROCEDURE .
(proper_body . 0)) (PRAGMA . (proper_body . 0)) (PACKAGE . (proper_body . 0))
(OVERRIDING . (proper_body . 0 [...]
+ ((default . error) (END . (body_stub . 0)) (PRIVATE . (body_stub . 0))
(IDENTIFIER . (body_stub . 0)) (USE . (body_stub . 0)) (TYPE . (body_stub . 0))
(TASK . (body_stub . 0)) (SUBTYPE . (body_stub . 0)) (PROTECTED . (body_stub .
0)) (PROCEDURE . (body_stub . 0)) (PRAGMA . (body_stub . 0)) (PACKAGE .
(body_stub . 0)) (OVERRIDING . (body_stub . 0)) (NOT . (body_stub . 0))
(GENERIC . (body_stub . 0)) (FUNCTION . (body_stub . 0)) (FOR . (body_stub .
0)) (ENTRY . (body_stub . 0)) (BEGI [...]
+ ((default . error) (END . (declaration . 14)) (PRIVATE . (declaration .
14)) (IDENTIFIER . (declaration . 14)) (USE . (declaration . 14)) (TYPE .
(declaration . 14)) (TASK . (declaration . 14)) (SUBTYPE . (declaration . 14))
(PROTECTED . (declaration . 14)) (PROCEDURE . (declaration . 14)) (PRAGMA .
(declaration . 14)) (PACKAGE . (declaration . 14)) (OVERRIDING . (declaration .
14)) (NOT . (declaration . 14)) (GENERIC . (declaration . 14)) (FUNCTION .
(declaration . 14)) (FOR . (de [...]
+ ((default . error) (PRIVATE . (renaming_declaration . 2)) (END .
(renaming_declaration . 2)) (BEGIN . (renaming_declaration . 2)) (ENTRY .
(renaming_declaration . 2)) (FOR . (renaming_declaration . 2)) (FUNCTION .
(renaming_declaration . 2)) (GENERIC . (renaming_declaration . 2)) (NOT .
(renaming_declaration . 2)) (OVERRIDING . (renaming_declaration . 2)) (PACKAGE
. (renaming_declaration . 2)) (PRAGMA . (renaming_declaration . 2)) (PROCEDURE
. (renaming_declaration . 2)) (PROTECTED [...]
+ ((default . error) (END . (declaration . 15)) (PRIVATE . (declaration .
15)) (IDENTIFIER . (declaration . 15)) (USE . (declaration . 15)) (TYPE .
(declaration . 15)) (TASK . (declaration . 15)) (SUBTYPE . (declaration . 15))
(PROTECTED . (declaration . 15)) (PROCEDURE . (declaration . 15)) (PRAGMA .
(declaration . 15)) (PACKAGE . (declaration . 15)) (OVERRIDING . (declaration .
15)) (NOT . (declaration . 15)) (GENERIC . (declaration . 15)) (FUNCTION .
(declaration . 15)) (FOR . (de [...]
+ ((default . error) ($EOI . (proper_body . 2)) (LIMITED . (proper_body .
2)) (SEPARATE . (proper_body . 2)) (WITH . (proper_body . 2)) (END .
(proper_body . 2)) (PRIVATE . (proper_body . 2)) (IDENTIFIER . (proper_body .
2)) (USE . (proper_body . 2)) (TYPE . (proper_body . 2)) (TASK . (proper_body .
2)) (SUBTYPE . (proper_body . 2)) (PROTECTED . (proper_body . 2)) (PROCEDURE .
(proper_body . 2)) (PRAGMA . (proper_body . 2)) (PACKAGE . (proper_body . 2))
(OVERRIDING . (proper_body . 2 [...]
+ ((default . error) (END . (body_stub . 2)) (PRIVATE . (body_stub . 2))
(IDENTIFIER . (body_stub . 2)) (USE . (body_stub . 2)) (TYPE . (body_stub . 2))
(TASK . (body_stub . 2)) (SUBTYPE . (body_stub . 2)) (PROTECTED . (body_stub .
2)) (PROCEDURE . (body_stub . 2)) (PRAGMA . (body_stub . 2)) (PACKAGE .
(body_stub . 2)) (OVERRIDING . (body_stub . 2)) (NOT . (body_stub . 2))
(GENERIC . (body_stub . 2)) (FUNCTION . (body_stub . 2)) (FOR . (body_stub .
2)) (ENTRY . (body_stub . 2)) (BEGI [...]
+ ((default . error) (END . (full_type_declaration . 1)) (PRIVATE .
(full_type_declaration . 1)) (IDENTIFIER . (full_type_declaration . 1)) (USE .
(full_type_declaration . 1)) (TYPE . (full_type_declaration . 1)) (TASK .
(full_type_declaration . 1)) (SUBTYPE . (full_type_declaration . 1)) (PROTECTED
. (full_type_declaration . 1)) (PROCEDURE . (full_type_declaration . 1))
(PRAGMA . (full_type_declaration . 1)) (PACKAGE . (full_type_declaration . 1))
(OVERRIDING . (full_type_declaratio [...]
+ ((default . error) (END . (declaration . 16)) (PRIVATE . (declaration .
16)) (IDENTIFIER . (declaration . 16)) (USE . (declaration . 16)) (TYPE .
(declaration . 16)) (TASK . (declaration . 16)) (SUBTYPE . (declaration . 16))
(PROTECTED . (declaration . 16)) (PROCEDURE . (declaration . 16)) (PRAGMA .
(declaration . 16)) (PACKAGE . (declaration . 16)) (OVERRIDING . (declaration .
16)) (NOT . (declaration . 16)) (GENERIC . (declaration . 16)) (FUNCTION .
(declaration . 16)) (FOR . (de [...]
+ ((default . error) (END . (declaration . 17)) (PRIVATE . (declaration .
17)) (IDENTIFIER . (declaration . 17)) (USE . (declaration . 17)) (TYPE .
(declaration . 17)) (TASK . (declaration . 17)) (SUBTYPE . (declaration . 17))
(PROTECTED . (declaration . 17)) (PROCEDURE . (declaration . 17)) (PRAGMA .
(declaration . 17)) (PACKAGE . (declaration . 17)) (OVERRIDING . (declaration .
17)) (NOT . (declaration . 17)) (GENERIC . (declaration . 17)) (FUNCTION .
(declaration . 17)) (FOR . (de [...]
+ ((default . error) (BEGIN . (declarative_part_opt . 0)) (END .
(declarative_part_opt . 0)) (USE . 11) (SUBTYPE . 302) (PRAGMA . 7) (NOT .
4) (OVERRIDING . 5) (FUNCTION . (overriding_indicator_opt . 2)) (PROCEDURE .
(overriding_indicator_opt . 2)) (ENTRY . (overriding_indicator_opt . 2)) (FOR .
299) (IDENTIFIER . 305) (TYPE . 304) (GENERIC . 2) (PROTECTED . 301) (TASK
. 303) (PACKAGE . 300))
+ ((default . error) (COLON_EQUAL . (simple_expression . 0)) (OF .
(simple_expression . 0)) (LOOP . (simple_expression . 0)) (DO .
(simple_expression . 0)) (DOT_DOT . (simple_expression . 0)) (SEMICOLON .
(simple_expression . 0)) (XOR . (simple_expression . 0)) (OR .
(simple_expression . 0)) (AND . (simple_expression . 0)) (SLASH_EQUAL .
(simple_expression . 0)) (LESS_EQUAL . (simple_expression . 0)) (LESS .
(simple_expression . 0)) (GREATER_EQUAL . (simple_expression . 0)) (GREATER
[...]
+ ((default . error) (ABS . (binary_adding_operator . 2)) (LEFT_PAREN .
(binary_adding_operator . 2)) (NEW . (binary_adding_operator . 2)) (NOT .
(binary_adding_operator . 2)) (NULL . (binary_adding_operator . 2))
(NUMERIC_LITERAL . (binary_adding_operator . 2)) (IDENTIFIER .
(binary_adding_operator . 2)) (STRING_LITERAL . (binary_adding_operator . 2))
(CHARACTER_LITERAL . (binary_adding_operator . 2)))
+ ((default . error) (ABS . (binary_adding_operator . 1)) (LEFT_PAREN .
(binary_adding_operator . 1)) (NEW . (binary_adding_operator . 1)) (NOT .
(binary_adding_operator . 1)) (NULL . (binary_adding_operator . 1))
(NUMERIC_LITERAL . (binary_adding_operator . 1)) (IDENTIFIER .
(binary_adding_operator . 1)) (STRING_LITERAL . (binary_adding_operator . 1))
(CHARACTER_LITERAL . (binary_adding_operator . 1)))
+ ((default . error) (ABS . (binary_adding_operator . 0)) (LEFT_PAREN .
(binary_adding_operator . 0)) (NEW . (binary_adding_operator . 0)) (NOT .
(binary_adding_operator . 0)) (NULL . (binary_adding_operator . 0))
(NUMERIC_LITERAL . (binary_adding_operator . 0)) (IDENTIFIER .
(binary_adding_operator . 0)) (STRING_LITERAL . (binary_adding_operator . 0))
(CHARACTER_LITERAL . (binary_adding_operator . 0)))
+ ((default . error) (ABS . 144) (NOT . 150) (NUMERIC_LITERAL . 155)
(NULL . 151) (NEW . 149) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49) (LEFT_PAREN . 148))
+ ((default . error) (ABS . (multiplying_operator . 2)) (LEFT_PAREN .
(multiplying_operator . 2)) (NEW . (multiplying_operator . 2)) (NOT .
(multiplying_operator . 2)) (NULL . (multiplying_operator . 2))
(NUMERIC_LITERAL . (multiplying_operator . 2)) (IDENTIFIER .
(multiplying_operator . 2)) (STRING_LITERAL . (multiplying_operator . 2))
(CHARACTER_LITERAL . (multiplying_operator . 2)))
+ ((default . error) (ABS . (multiplying_operator . 3)) (LEFT_PAREN .
(multiplying_operator . 3)) (NEW . (multiplying_operator . 3)) (NOT .
(multiplying_operator . 3)) (NULL . (multiplying_operator . 3))
(NUMERIC_LITERAL . (multiplying_operator . 3)) (IDENTIFIER .
(multiplying_operator . 3)) (STRING_LITERAL . (multiplying_operator . 3))
(CHARACTER_LITERAL . (multiplying_operator . 3)))
+ ((default . error) (ABS . (multiplying_operator . 1)) (LEFT_PAREN .
(multiplying_operator . 1)) (NEW . (multiplying_operator . 1)) (NOT .
(multiplying_operator . 1)) (NULL . (multiplying_operator . 1))
(NUMERIC_LITERAL . (multiplying_operator . 1)) (IDENTIFIER .
(multiplying_operator . 1)) (STRING_LITERAL . (multiplying_operator . 1))
(CHARACTER_LITERAL . (multiplying_operator . 1)))
+ ((default . error) (ABS . (multiplying_operator . 0)) (LEFT_PAREN .
(multiplying_operator . 0)) (NEW . (multiplying_operator . 0)) (NOT .
(multiplying_operator . 0)) (NULL . (multiplying_operator . 0))
(NUMERIC_LITERAL . (multiplying_operator . 0)) (IDENTIFIER .
(multiplying_operator . 0)) (STRING_LITERAL . (multiplying_operator . 0))
(CHARACTER_LITERAL . (multiplying_operator . 0)))
+ ((default . error) (ABS . 144) (NOT . 150) (NUMERIC_LITERAL . 155)
(NULL . 151) (NEW . 149) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49) (LEFT_PAREN . 148))
+ ((default . error) (PLUS . 154) (MINUS . 153) (ABS . 144) (NOT .
150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN . 148))
+ ((default . error) (THEN . 429) (RAISE . 152) (PLUS . 154) (MINUS .
153) (ABS . 144) (NOT . 150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW .
149) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49)
(LEFT_PAREN . 148))
+ ((default . error) (ELSE . 427) (RAISE . 152) (PLUS . 154) (MINUS .
153) (ABS . 144) (NOT . 150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW .
149) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49)
(LEFT_PAREN . 148))
+ ((default . error) (RAISE . 152) (PLUS . 154) (MINUS . 153) (ABS .
144) (NOT . 150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
+ ((default . error) (RAISE . 152) (PLUS . 154) (MINUS . 153) (ABS .
144) (NOT . 150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
+ ((default . error) (ELSE . 424))
+ ((default . error) (RAISE . 152) (PLUS . 154) (MINUS . 153) (ABS .
144) (NOT . 150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
+ ((default . error) (THEN . 422))
+ ((default . error) (RAISE . 152) (PLUS . 154) (MINUS . 153) (ABS .
144) (NOT . 150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
+ ((default . error) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
+ ((default . error) (SEMICOLON . 419))
+ ((default . error) (FOR . 146) (CASE . 145) (IF . 147) (RAISE . 152)
(PLUS . 154) (MINUS . 153) (ABS . 144) (NOT . 150) (NUMERIC_LITERAL . 155)
(NULL . 151) (NEW . 149) (IDENTIFIER . 156) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49) (LEFT_PAREN . 148))
+ ((default . error) (RAISE . 152) (PLUS . 154) (MINUS . 153) (ABS .
144) (NOT . 150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
+ ((default . error) (IDENTIFIER . 416))
+ ((default . error) (LOOP . (raise_expression . 0)) (DO .
(raise_expression . 0)) (XOR . (raise_expression . 0)) (OR . (raise_expression
. 0)) (AND . (raise_expression . 0)) (IS . (raise_expression . 0)) (SEMICOLON .
(raise_expression . 0)) (THEN . (raise_expression . 0)) (RANGE .
(raise_expression . 0)) (RIGHT_PAREN . (raise_expression . 0)) (COMMA .
(raise_expression . 0)) (DIGITS . (raise_expression . 0)) (EQUAL_GREATER .
(raise_expression . 0)) (ELSE . (raise_expression . 0)) (E [...]
+ ((default . error) (DOT . 90) (TICK . 91) (COLON_EQUAL . (primary .
4)) (OF . (primary . 4)) (LOOP . (primary . 4)) (DO . (primary . 4)) (STAR_STAR
. (primary . 4)) (STAR . (primary . 4)) (SLASH . (primary . 4)) (REM . (primary
. 4)) (MOD . (primary . 4)) (DOT_DOT . (primary . 4)) (AMPERSAND . (primary .
4)) (MINUS . (primary . 4)) (PLUS . (primary . 4)) (SEMICOLON . (primary . 4))
(XOR . (primary . 4)) (OR . (primary . 4)) (AND . (primary . 4)) (SLASH_EQUAL .
(primary . 4)) (LES [...]
+ ((default . error) (DOT_DOT . (primary . 1)) (RIGHT_PAREN . (primary .
1)) (COMMA . (primary . 1)) (BAR . (primary . 1)) (EQUAL_GREATER . (primary .
1)) (PLUS . (primary . 1)) (MINUS . (primary . 1)) (AMPERSAND . (primary . 1))
(IN . (primary . 1)) (NOT . (primary . 1)) (EQUAL . (primary . 1)) (GREATER .
(primary . 1)) (GREATER_EQUAL . (primary . 1)) (LESS . (primary . 1))
(LESS_EQUAL . (primary . 1)) (SLASH_EQUAL . (primary . 1)) (WITH . (primary .
1)) (MOD . (primary . 1)) (REM . [...]
+ ((default . error) (COMMA . 273) (RIGHT_PAREN . 413))
+ ((default . error) (RIGHT_PAREN . 412))
+ ((default . error) (RIGHT_PAREN . (expression_opt . 1)) (COMMA .
(expression_opt . 1)) (WITH . 411))
+ ((default . error) (THEN . 410))
+ ((default . error) (IDENTIFIER . (quantifier . 0)))
+ ((default . error) (IDENTIFIER . (quantifier . 1)))
+ ((default . error) (IDENTIFIER . 408))
+ ((default . error) (IS . 407))
+ ((default . error) (COLON_EQUAL . (factor . 2)) (OF . (factor . 2))
(LOOP . (factor . 2)) (DO . (factor . 2)) (PLUS . (factor . 2)) (MINUS .
(factor . 2)) (AMPERSAND . (factor . 2)) (DOT_DOT . (factor . 2)) (MOD .
(factor . 2)) (REM . (factor . 2)) (SLASH . (factor . 2)) (STAR . (factor . 2))
(SEMICOLON . (factor . 2)) (XOR . (factor . 2)) (OR . (factor . 2)) (AND .
(factor . 2)) (IN . (factor . 2)) (NOT . (factor . 2)) (EQUAL . (factor . 2))
(GREATER . (factor . 2)) (GREATER_EQUAL [...]
((default . error) (BODY . 67))
- ((default . error) (BODY . 397))
- ((default . error) (BODY . 396))
+ ((default . error) (BODY . 406))
+ ((default . error) (BODY . 405))
((default . error) (FUNCTION . 1) (PROCEDURE . 9))
((default . error) ($EOI . (subunit . 0)) (FUNCTION . (subunit . 0))
(GENERIC . (subunit . 0)) (LIMITED . (subunit . 0)) (NOT . (subunit . 0))
(OVERRIDING . (subunit . 0)) (PACKAGE . (subunit . 0)) (PRAGMA . (subunit . 0))
(PRIVATE . (subunit . 0)) (PROCEDURE . (subunit . 0)) (SEPARATE . (subunit .
0)) (USE . (subunit . 0)) (WITH . (subunit . 0)))
- ((default . error) (WITH . (use_clause . 1)) (SEPARATE . (use_clause .
1)) (LIMITED . (use_clause . 1)) ($EOI . (use_clause . 1)) (PRIVATE .
(use_clause . 1)) (END . (use_clause . 1)) (BEGIN . (use_clause . 1))
(IDENTIFIER . (use_clause . 1)) (ENTRY . (use_clause . 1)) (FOR . (use_clause .
1)) (FUNCTION . (use_clause . 1)) (GENERIC . (use_clause . 1)) (NOT .
(use_clause . 1)) (OVERRIDING . (use_clause . 1)) (PACKAGE . (use_clause . 1))
(PRAGMA . (use_clause . 1)) (PROCEDURE . (use_ [...]
- ((default . error) (SEMICOLON . 394))
- ((default . error) (BEGIN . 393))
+ ((default . error) (SEPARATE . (use_clause . 1)) (LIMITED . (use_clause
. 1)) ($EOI . (use_clause . 1)) (WITH . (use_clause . 1)) (PRIVATE .
(use_clause . 1)) (END . (use_clause . 1)) (BEGIN . (use_clause . 1)) (ENTRY .
(use_clause . 1)) (FOR . (use_clause . 1)) (FUNCTION . (use_clause . 1))
(GENERIC . (use_clause . 1)) (NOT . (use_clause . 1)) (OVERRIDING . (use_clause
. 1)) (PACKAGE . (use_clause . 1)) (PRAGMA . (use_clause . 1)) (PROCEDURE .
(use_clause . 1)) (PROTECTED . (use_c [...]
+ ((default . error) (SEMICOLON . 403))
+ ((default . error) (BEGIN . 402))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
- ((default . error) (DOT . 87) (TICK . 88) (SEMICOLON .
(aspect_specification_opt . 0)) (WITH . 108) (LEFT_PAREN . 106))
- ((default . error) (DOT . 87) (TICK . 88) (SEMICOLON .
(aspect_specification_opt . 0)) (WITH . 108) (LEFT_PAREN . 106))
- ((default . error) (END . (sequence_of_statements_opt . 0)) (EXCEPTION .
(sequence_of_statements_opt . 0)) (ACCEPT . (label_opt . 0)) (BEGIN .
(label_opt . 0)) (CASE . (label_opt . 0)) (DECLARE . (label_opt . 0)) (FOR .
(label_opt . 0)) (IF . (label_opt . 0)) (LOOP . (label_opt . 0)) (RETURN .
(label_opt . 0)) (SELECT . (label_opt . 0)) (WHILE . (label_opt . 0))
(STRING_LITERAL . (label_opt . 0)) (CHARACTER_LITERAL . (label_opt . 0)) (ABORT
. (label_opt . 0)) (DELAY . (label_opt . [...]
- ((default . error) (BEGIN . (subprogram_renaming_declaration . 0))
(IDENTIFIER . (subprogram_renaming_declaration . 0)) (ENTRY .
(subprogram_renaming_declaration . 0)) (FOR . (subprogram_renaming_declaration
. 0)) (PROTECTED . (subprogram_renaming_declaration . 0)) (SUBTYPE .
(subprogram_renaming_declaration . 0)) (TASK . (subprogram_renaming_declaration
. 0)) (TYPE . (subprogram_renaming_declaration . 0)) (END .
(subprogram_renaming_declaration . 0)) (WITH . (subprogram_renaming_d [...]
- ((default . error) (IS . (aspect_specification_opt . 0)) (WITH . 108))
- ((default . error) (IDENTIFIER . 617))
- ((default . error) (IDENTIFIER . 616))
- ((default . error) (EQUAL_GREATER . 615))
+ ((default . error) (DOT . 90) (TICK . 91) (SEMICOLON .
(aspect_specification_opt . 0)) (WITH . 109) (LEFT_PAREN . 107))
+ ((default . error) (DOT . 90) (TICK . 91) (SEMICOLON .
(aspect_specification_opt . 0)) (WITH . 109) (LEFT_PAREN . 107))
+ ((default . error) (END . (sequence_of_statements_opt . 0)) (EXCEPTION .
(sequence_of_statements_opt . 0)) (ACCEPT . (label_opt . 0)) (BEGIN .
(label_opt . 0)) (CASE . (label_opt . 0)) (DECLARE . (label_opt . 0)) (FOR .
(label_opt . 0)) (IF . (label_opt . 0)) (LOOP . (label_opt . 0)) (RETURN .
(label_opt . 0)) (SELECT . (label_opt . 0)) (WHILE . (label_opt . 0)) (ABORT .
(label_opt . 0)) (DELAY . (label_opt . 0)) (EXIT . (label_opt . 0)) (GOTO .
(label_opt . 0)) (NULL . (label_opt [...]
+ ((default . error) (BEGIN . (subprogram_renaming_declaration . 0))
(ENTRY . (subprogram_renaming_declaration . 0)) (FOR .
(subprogram_renaming_declaration . 0)) (PROTECTED .
(subprogram_renaming_declaration . 0)) (SUBTYPE .
(subprogram_renaming_declaration . 0)) (TASK . (subprogram_renaming_declaration
. 0)) (TYPE . (subprogram_renaming_declaration . 0)) (IDENTIFIER .
(subprogram_renaming_declaration . 0)) (END . (subprogram_renaming_declaration
. 0)) (WITH . (subprogram_renaming_d [...]
+ ((default . error) (IS . (aspect_specification_opt . 0)) (WITH . 109))
+ ((default . error) (IDENTIFIER . 628))
+ ((default . error) (IDENTIFIER . 627))
+ ((default . error) (WHEN . 624))
+ ((default . error) (OF . 622) (COLON . 623) (IN . 621))
+ ((default . error) (EQUAL_GREATER . 620))
+ ((default . error) (RAISE . 152) (PLUS . 154) (MINUS . 153) (ABS .
144) (NOT . 150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
+ ((default . error) (RIGHT_PAREN . ((expression_opt . 0) (association_opt
. 0))) (COMMA . ((expression_opt . 0) (association_opt . 0))) (EQUAL_GREATER .
(discrete_choice_list . 0)) (BAR . (discrete_choice_list . 0)) (OTHERS . 182)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 183) (STRING_LITERAL . 49) (RAISE .
152) (PLUS . 154) (MINUS . 153) (ABS . 144) (NOT . 181) (NUMERIC_LITERAL .
155) (NULL . 617) (NEW . 149) (LEFT_PAREN . 148))
+ ((default . error) (USE . (aggregate . 2)) (COLON_EQUAL . (aggregate .
2)) (CHARACTER_LITERAL . (aggregate . 2)) (STRING_LITERAL . (aggregate . 2))
(IDENTIFIER . (aggregate . 2)) (LESS_LESS . (aggregate . 2)) (WHILE .
(aggregate . 2)) (SELECT . (aggregate . 2)) (REQUEUE . (aggregate . 2)) (RAISE
. (aggregate . 2)) (PRAGMA . (aggregate . 2)) (NULL . (aggregate . 2)) (IF .
(aggregate . 2)) (GOTO . (aggregate . 2)) (FOR . (aggregate . 2)) (EXIT .
(aggregate . 2)) (DELAY . (aggregate . [...]
+ ((default . error) (USE . (aggregate . 0)) (COLON_EQUAL . (aggregate .
0)) (CHARACTER_LITERAL . (aggregate . 0)) (STRING_LITERAL . (aggregate . 0))
(IDENTIFIER . (aggregate . 0)) (LESS_LESS . (aggregate . 0)) (WHILE .
(aggregate . 0)) (SELECT . (aggregate . 0)) (REQUEUE . (aggregate . 0)) (RAISE
. (aggregate . 0)) (PRAGMA . (aggregate . 0)) (NULL . (aggregate . 0)) (IF .
(aggregate . 0)) (GOTO . (aggregate . 0)) (FOR . (aggregate . 0)) (EXIT .
(aggregate . 0)) (DELAY . (aggregate . [...]
+ ((default . error) (RIGHT_PAREN . 616))
+ ((default . error) (RAISE . 152) (PLUS . 154) (MINUS . 153) (ABS .
144) (NOT . 150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
+ ((default . error) (EQUAL_GREATER . 614))
((default . error) (COMMA . (pragma_argument_association . 0))
(RIGHT_PAREN . (pragma_argument_association . 0)))
- ((default . error) (OF . (primary . 7)) (COLON_EQUAL . (primary . 7))
(DO . (primary . 7)) (LOOP . (primary . 7)) (ELSIF . (primary . 7)) (ELSE .
(primary . 7)) (DIGITS . (primary . 7)) (RIGHT_PAREN . (primary . 7)) (COMMA .
(primary . 7)) (RANGE . (primary . 7)) (THEN . (primary . 7)) (WITH . (primary
. 7)) (BAR . (primary . 7)) (EQUAL_GREATER . (primary . 7)) (IS . (primary .
7)) (IN . (primary . 7)) (NOT . (primary . 7)) (EQUAL . (primary . 7)) (GREATER
. (primary . 7)) (GREATER [...]
- ((default . error) (OF . ((primary . 5) (aggregate . 3))) (COLON_EQUAL .
((primary . 5) (aggregate . 3))) (DO . ((primary . 5) (aggregate . 3))) (LOOP .
((primary . 5) (aggregate . 3))) (ELSIF . ((primary . 5) (aggregate . 3)))
(ELSE . ((primary . 5) (aggregate . 3))) (DIGITS . ((primary . 5) (aggregate .
3))) (COMMA . ((primary . 5) (aggregate . 3))) (RIGHT_PAREN . ((primary . 5)
(aggregate . 3))) (RANGE . ((primary . 5) (aggregate . 3))) (THEN . ((primary .
5) (aggregate . 3))) ( [...]
- ((default . error) (OF . ((primary . 6) (aggregate . 2))) (COLON_EQUAL .
((primary . 6) (aggregate . 2))) (DO . ((primary . 6) (aggregate . 2))) (LOOP .
((primary . 6) (aggregate . 2))) (ELSIF . ((primary . 6) (aggregate . 2)))
(ELSE . ((primary . 6) (aggregate . 2))) (DIGITS . ((primary . 6) (aggregate .
2))) (COMMA . ((primary . 6) (aggregate . 2))) (RIGHT_PAREN . ((primary . 6)
(aggregate . 2))) (RANGE . ((primary . 6) (aggregate . 2))) (THEN . ((primary .
6) (aggregate . 2))) ( [...]
- ((default . error) (IDENTIFIER . (quantifier . 0)))
- ((default . error) (IDENTIFIER . (quantifier . 1)))
- ((default . error) (IDENTIFIER . 613))
- ((default . error) (RAISE . 152) (PLUS . 144) (MINUS . 143) (ABS .
147) (NOT . 150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
- ((default . error) (WHEN . (pragma . 0)) (THEN . (pragma . 0)) (OR .
(pragma . 0)) (ELSIF . (pragma . 0)) (ELSE . (pragma . 0)) (WHILE . (pragma .
0)) (SELECT . (pragma . 0)) (RETURN . (pragma . 0)) (REQUEUE . (pragma . 0))
(RAISE . (pragma . 0)) (NULL . (pragma . 0)) (LOOP . (pragma . 0)) (IF .
(pragma . 0)) (GOTO . (pragma . 0)) (EXIT . (pragma . 0)) (DELAY . (pragma .
0)) (DECLARE . (pragma . 0)) (CASE . (pragma . 0)) (ABORT . (pragma . 0))
(ACCEPT . (pragma . 0)) (CHARACTER_LIT [...]
((default . error) (RIGHT_PAREN . (pragma_argument_association_list .
1)) (COMMA . (pragma_argument_association_list . 1)))
- ((default . error) (OF . (factor . 0)) (COLON_EQUAL . (factor . 0)) (DO
. (factor . 0)) (LOOP . (factor . 0)) (ELSIF . (factor . 0)) (ELSE . (factor .
0)) (DIGITS . (factor . 0)) (COMMA . (factor . 0)) (RIGHT_PAREN . (factor . 0))
(RANGE . (factor . 0)) (THEN . (factor . 0)) (WITH . (factor . 0)) (BAR .
(factor . 0)) (EQUAL_GREATER . (factor . 0)) (IS . (factor . 0)) (SLASH_EQUAL .
(factor . 0)) (LESS_EQUAL . (factor . 0)) (LESS . (factor . 0)) (GREATER_EQUAL
. (factor . 0)) (GREAT [...]
+ ((default . error) (WHEN . (pragma . 0)) (THEN . (pragma . 0)) (OR .
(pragma . 0)) (ELSIF . (pragma . 0)) (ELSE . (pragma . 0)) (CHARACTER_LITERAL .
(pragma . 0)) (STRING_LITERAL . (pragma . 0)) (LESS_LESS . (pragma . 0)) (WHILE
. (pragma . 0)) (SELECT . (pragma . 0)) (RETURN . (pragma . 0)) (REQUEUE .
(pragma . 0)) (RAISE . (pragma . 0)) (NULL . (pragma . 0)) (LOOP . (pragma .
0)) (IF . (pragma . 0)) (GOTO . (pragma . 0)) (EXIT . (pragma . 0)) (DELAY .
(pragma . 0)) (DECLARE . (pr [...]
+ ((default . error) (OF . (factor . 0)) (COLON_EQUAL . (factor . 0)) (DO
. (factor . 0)) (LOOP . (factor . 0)) (ELSIF . (factor . 0)) (ELSE . (factor .
0)) (DIGITS . (factor . 0)) (COMMA . (factor . 0)) (RIGHT_PAREN . (factor . 0))
(RANGE . (factor . 0)) (THEN . (factor . 0)) (WITH . (factor . 0)) (BAR .
(factor . 0)) (EQUAL_GREATER . (factor . 0)) (IS . (factor . 0)) (SLASH_EQUAL .
(factor . 0)) (LESS_EQUAL . (factor . 0)) (LESS . (factor . 0)) (GREATER_EQUAL
. (factor . 0)) (GREAT [...]
((default . error) (DO . (relation_and_list . 1)) (LOOP .
(relation_and_list . 1)) (XOR . (relation_and_list . 1)) (OR .
(relation_and_list . 1)) (ELSIF . (relation_and_list . 1)) (ELSE .
(relation_and_list . 1)) (EQUAL_GREATER . (relation_and_list . 1)) (DIGITS .
(relation_and_list . 1)) (RIGHT_PAREN . (relation_and_list . 1)) (COMMA .
(relation_and_list . 1)) (RANGE . (relation_and_list . 1)) (THEN .
(relation_and_list . 1)) (SEMICOLON . (relation_and_list . 1)) (WITH .
(relation [...]
- ((default . error) (RAISE . 152) (PLUS . 144) (MINUS . 143) (ABS .
147) (NOT . 150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
+ ((default . error) (RAISE . 152) (PLUS . 154) (MINUS . 153) (ABS .
144) (NOT . 150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
((default . error) (DO . (relation_or_list . 1)) (LOOP .
(relation_or_list . 1)) (XOR . (relation_or_list . 1)) (AND . (relation_or_list
. 1)) (ELSIF . (relation_or_list . 1)) (ELSE . (relation_or_list . 1))
(EQUAL_GREATER . (relation_or_list . 1)) (DIGITS . (relation_or_list . 1))
(RIGHT_PAREN . (relation_or_list . 1)) (COMMA . (relation_or_list . 1)) (RANGE
. (relation_or_list . 1)) (THEN . (relation_or_list . 1)) (SEMICOLON .
(relation_or_list . 1)) (WITH . (relation_or_list . 1 [...]
- ((default . error) (RAISE . 152) (PLUS . 144) (MINUS . 143) (ABS .
147) (NOT . 150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
+ ((default . error) (RAISE . 152) (PLUS . 154) (MINUS . 153) (ABS .
144) (NOT . 150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
((default . error) (DO . (relation_xor_list . 1)) (LOOP .
(relation_xor_list . 1)) (OR . (relation_xor_list . 1)) (AND .
(relation_xor_list . 1)) (ELSIF . (relation_xor_list . 1)) (ELSE .
(relation_xor_list . 1)) (EQUAL_GREATER . (relation_xor_list . 1)) (DIGITS .
(relation_xor_list . 1)) (RIGHT_PAREN . (relation_xor_list . 1)) (COMMA .
(relation_xor_list . 1)) (RANGE . (relation_xor_list . 1)) (THEN .
(relation_xor_list . 1)) (SEMICOLON . (relation_xor_list . 1)) (WITH .
(relation [...]
((default . error) (DO . (relation_xor_list . 0)) (LOOP .
(relation_xor_list . 0)) (OR . (relation_xor_list . 0)) (AND .
(relation_xor_list . 0)) (ELSIF . (relation_xor_list . 0)) (ELSE .
(relation_xor_list . 0)) (EQUAL_GREATER . (relation_xor_list . 0)) (DIGITS .
(relation_xor_list . 0)) (RIGHT_PAREN . (relation_xor_list . 0)) (COMMA .
(relation_xor_list . 0)) (RANGE . (relation_xor_list . 0)) (THEN .
(relation_xor_list . 0)) (SEMICOLON . (relation_xor_list . 0)) (WITH .
(relation [...]
- ((default . error) (RAISE . 152) (PLUS . 144) (MINUS . 143) (ABS .
147) (NOT . 150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
+ ((default . error) (RAISE . 152) (PLUS . 154) (MINUS . 153) (ABS .
144) (NOT . 150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
((default . error) (DO . (relation_or_list . 0)) (LOOP .
(relation_or_list . 0)) (XOR . (relation_or_list . 0)) (AND . (relation_or_list
. 0)) (ELSIF . (relation_or_list . 0)) (ELSE . (relation_or_list . 0))
(EQUAL_GREATER . (relation_or_list . 0)) (DIGITS . (relation_or_list . 0))
(RIGHT_PAREN . (relation_or_list . 0)) (COMMA . (relation_or_list . 0)) (RANGE
. (relation_or_list . 0)) (THEN . (relation_or_list . 0)) (SEMICOLON .
(relation_or_list . 0)) (WITH . (relation_or_list . 0 [...]
- ((default . error) (RAISE . 152) (PLUS . 144) (MINUS . 143) (ABS .
147) (NOT . 150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
+ ((default . error) (RAISE . 152) (PLUS . 154) (MINUS . 153) (ABS .
144) (NOT . 150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
((default . error) (DO . (relation_and_list . 0)) (LOOP .
(relation_and_list . 0)) (XOR . (relation_and_list . 0)) (OR .
(relation_and_list . 0)) (ELSIF . (relation_and_list . 0)) (ELSE .
(relation_and_list . 0)) (EQUAL_GREATER . (relation_and_list . 0)) (DIGITS .
(relation_and_list . 0)) (RIGHT_PAREN . (relation_and_list . 0)) (COMMA .
(relation_and_list . 0)) (RANGE . (relation_and_list . 0)) (THEN .
(relation_and_list . 0)) (SEMICOLON . (relation_and_list . 0)) (WITH .
(relation [...]
((default . error) (DO . (relation . 1)) (LOOP . (relation . 1)) (COMMA
. (relation . 1)) (ELSIF . (relation . 1)) (ELSE . (relation . 1))
(EQUAL_GREATER . (relation . 1)) (RIGHT_PAREN . (relation . 1)) (DIGITS .
(relation . 1)) (RANGE . (relation . 1)) (THEN . (relation . 1)) (SEMICOLON .
(relation . 1)) (WITH . (relation . 1)) (IS . (relation . 1)) (AND . (relation
. 1)) (OR . (relation . 1)) (XOR . (relation . 1)))
- ((default . error) (OF . (term . 1)) (COLON_EQUAL . (term . 1)) (DO .
(term . 1)) (LOOP . (term . 1)) (ELSIF . (term . 1)) (ELSE . (term . 1))
(DIGITS . (term . 1)) (RIGHT_PAREN . (term . 1)) (COMMA . (term . 1)) (RANGE .
(term . 1)) (THEN . (term . 1)) (WITH . (term . 1)) (BAR . (term . 1))
(EQUAL_GREATER . (term . 1)) (IS . (term . 1)) (IN . (term . 1)) (NOT . (term .
1)) (EQUAL . (term . 1)) (GREATER . (term . 1)) (GREATER_EQUAL . (term . 1))
(LESS . (term . 1)) (LESS_EQUAL . (t [...]
- ((default . error) (OF . (term_list . 1)) (COLON_EQUAL . (term_list .
1)) (DO . (term_list . 1)) (LOOP . (term_list . 1)) (ELSIF . (term_list . 1))
(ELSE . (term_list . 1)) (DIGITS . (term_list . 1)) (COMMA . (term_list . 1))
(RIGHT_PAREN . (term_list . 1)) (RANGE . (term_list . 1)) (THEN . (term_list .
1)) (WITH . (term_list . 1)) (BAR . (term_list . 1)) (EQUAL_GREATER .
(term_list . 1)) (IS . (term_list . 1)) (SLASH_EQUAL . (term_list . 1))
(LESS_EQUAL . (term_list . 1)) (LESS . [...]
- ((default . error) (BEGIN . 606) (END . 607))
- ((default . error) (IDENTIFIER . 605))
- ((default . error) (IS . ( 604 (subprogram_specification . 1))) (WITH .
(subprogram_specification . 1)) (SEMICOLON . (subprogram_specification . 1))
(RENAMES . (subprogram_specification . 1)))
- ((default . error) (IS . ( 603 (subprogram_specification . 0))) (WITH .
(subprogram_specification . 0)) (SEMICOLON . (subprogram_specification . 0))
(RENAMES . (subprogram_specification . 0)))
- ((default . error) (RENAMES . 127) (SEMICOLON .
(aspect_specification_opt . 0)) (IS . ( 602 (aspect_specification_opt . 0)))
(WITH . 108))
- ((default . error) (EXCEPTION . 600) (CONSTANT . ( 599 (aliased_opt .
0))) (ARRAY . (aliased_opt . 0)) (ACCESS . (aliased_opt . 0)) (NOT .
(aliased_opt . 0)) (IDENTIFIER . (aliased_opt . 0)) (STRING_LITERAL .
(aliased_opt . 0)) (CHARACTER_LITERAL . (aliased_opt . 0)) (ALIASED . 517))
- ((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
- ((default . error) (END . (declarative_part_opt . 0)) (USE . 11)
(SUBTYPE . 299) (PRAGMA . 7) (NOT . 4) (OVERRIDING . 5) (FUNCTION .
(overriding_indicator_opt . 2)) (PROCEDURE . (overriding_indicator_opt . 2))
(ENTRY . (overriding_indicator_opt . 2)) (FOR . 296) (IDENTIFIER . 295) (TYPE
. 301) (GENERIC . 2) (PROTECTED . 298) (TASK . 300) (PACKAGE . 297))
- ((default . error) (USE . (declarations . 1)) (TYPE . (declarations .
1)) (TASK . (declarations . 1)) (SUBTYPE . (declarations . 1)) (PROTECTED .
(declarations . 1)) (PROCEDURE . (declarations . 1)) (PRAGMA . (declarations .
1)) (PACKAGE . (declarations . 1)) (OVERRIDING . (declarations . 1)) (NOT .
(declarations . 1)) (GENERIC . (declarations . 1)) (FUNCTION . (declarations .
1)) (FOR . (declarations . 1)) (ENTRY . (declarations . 1)) (IDENTIFIER .
(declarations . 1)) (BEGIN . (de [...]
- ((default . error) (IS . (discriminant_part_opt . 0)) (SEMICOLON .
(discriminant_part_opt . 0)) (LEFT_PAREN . 201))
- ((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (IS .
(aspect_specification_opt . 0)) (WITH . 108))
+ ((default . error) (OF . (term . 1)) (COLON_EQUAL . (term . 1)) (DO .
(term . 1)) (LOOP . (term . 1)) (ELSIF . (term . 1)) (ELSE . (term . 1))
(DIGITS . (term . 1)) (RIGHT_PAREN . (term . 1)) (COMMA . (term . 1)) (RANGE .
(term . 1)) (THEN . (term . 1)) (WITH . (term . 1)) (BAR . (term . 1))
(EQUAL_GREATER . (term . 1)) (IS . (term . 1)) (IN . (term . 1)) (NOT . (term .
1)) (EQUAL . (term . 1)) (GREATER . (term . 1)) (GREATER_EQUAL . (term . 1))
(LESS . (term . 1)) (LESS_EQUAL . (t [...]
+ ((default . error) (OF . (term_list . 1)) (COLON_EQUAL . (term_list .
1)) (DO . (term_list . 1)) (LOOP . (term_list . 1)) (ELSIF . (term_list . 1))
(ELSE . (term_list . 1)) (DIGITS . (term_list . 1)) (COMMA . (term_list . 1))
(RIGHT_PAREN . (term_list . 1)) (RANGE . (term_list . 1)) (THEN . (term_list .
1)) (WITH . (term_list . 1)) (BAR . (term_list . 1)) (EQUAL_GREATER .
(term_list . 1)) (IS . (term_list . 1)) (SLASH_EQUAL . (term_list . 1))
(LESS_EQUAL . (term_list . 1)) (LESS . [...]
+ ((default . error) (BEGIN . 608) (END . 609))
+ ((default . error) (IDENTIFIER . 607))
+ ((default . error) (RENAMES . (subprogram_specification . 1)) (IS . (
606 (subprogram_specification . 1))) (WITH . (subprogram_specification . 1))
(SEMICOLON . (subprogram_specification . 1)))
+ ((default . error) (RENAMES . (subprogram_specification . 0)) (IS . (
605 (subprogram_specification . 0))) (WITH . (subprogram_specification . 0))
(SEMICOLON . (subprogram_specification . 0)))
+ ((default . error) (RENAMES . 128) (SEMICOLON .
(aspect_specification_opt . 0)) (IS . ( 604 (aspect_specification_opt . 0)))
(WITH . 109))
+ ((default . error) (EXCEPTION . 602) (CONSTANT . ( 601 (aliased_opt .
0))) (ARRAY . (aliased_opt . 0)) (ACCESS . (aliased_opt . 0)) (NOT .
(aliased_opt . 0)) (IDENTIFIER . (aliased_opt . 0)) (STRING_LITERAL .
(aliased_opt . 0)) (CHARACTER_LITERAL . (aliased_opt . 0)) (ALIASED . 531))
+ ((default . error) (SEMICOLON . (name_opt . 0)) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49))
+ ((default . error) (END . (declarative_part_opt . 0)) (USE . 11)
(SUBTYPE . 302) (PRAGMA . 7) (NOT . 4) (OVERRIDING . 5) (FUNCTION .
(overriding_indicator_opt . 2)) (PROCEDURE . (overriding_indicator_opt . 2))
(ENTRY . (overriding_indicator_opt . 2)) (FOR . 299) (IDENTIFIER . 305) (TYPE
. 304) (GENERIC . 2) (PROTECTED . 301) (TASK . 303) (PACKAGE . 300))
+ ((default . error) (IDENTIFIER . (declarations . 1)) (USE .
(declarations . 1)) (TYPE . (declarations . 1)) (TASK . (declarations . 1))
(SUBTYPE . (declarations . 1)) (PROTECTED . (declarations . 1)) (PROCEDURE .
(declarations . 1)) (PRAGMA . (declarations . 1)) (PACKAGE . (declarations .
1)) (OVERRIDING . (declarations . 1)) (NOT . (declarations . 1)) (GENERIC .
(declarations . 1)) (FUNCTION . (declarations . 1)) (FOR . (declarations . 1))
(ENTRY . (declarations . 1)) (BEGIN . (de [...]
+ ((default . error) (EXCEPTION . 596) (IDENTIFIER . (null_exclusion_opt
. 0)) (STRING_LITERAL . (null_exclusion_opt . 0)) (CHARACTER_LITERAL .
(null_exclusion_opt . 0)) (ACCESS . (null_exclusion_opt . 0)) (NOT . 232))
+ ((default . error) (IS . (discriminant_part_opt . 0)) (SEMICOLON .
(discriminant_part_opt . 0)) (LEFT_PAREN . 211))
((default . error) (IDENTIFIER . 594))
((default . error) (IDENTIFIER . 593))
- ((default . error) (IS . 592))
- ((default . error) (IS . (aspect_specification_opt . 0)) (WITH . 108))
+ ((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (IS .
(aspect_specification_opt . 0)) (WITH . 109))
+ ((default . error) (IS . 591))
((default . error) (IDENTIFIER . 590))
((default . error) (IDENTIFIER . 589))
+ ((default . error) (IS . (aspect_specification_opt . 0)) (WITH . 109))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
- ((default . error) (USE . ((direct_name . 0) (name . 0))) (LEFT_PAREN .
(name . 0)) (DOT . (name . 0)) (TICK . (name . 0)))
- ((default . error) (USE . ((direct_name . 1) (name . 7))) (LEFT_PAREN .
(name . 7)) (DOT . (name . 7)) (TICK . (name . 7)))
- ((default . error) (USE . ( 587 (name . 4))) (LEFT_PAREN . (name . 4))
(DOT . (name . 4)) (TICK . (name . 4)))
- ((default . error) (USE . 586))
- ((default . error) (DOT . 87) (TICK . 88) (USE . 585) (LEFT_PAREN .
106))
- ((default . error) (EXCEPTION . 582) (IDENTIFIER . (null_exclusion_opt
. 0)) (STRING_LITERAL . (null_exclusion_opt . 0)) (CHARACTER_LITERAL .
(null_exclusion_opt . 0)) (ACCESS . (null_exclusion_opt . 0)) (NOT . 211))
+ ((default . error) (USE . ((name . 0) (direct_name . 0))) (LEFT_PAREN .
(name . 0)) (DOT . (name . 0)) (TICK . (name . 0)))
+ ((default . error) (USE . ((name . 7) (direct_name . 1))) (LEFT_PAREN .
(name . 7)) (DOT . (name . 7)) (TICK . (name . 7)))
+ ((default . error) (USE . ( 586 (name . 4))) (LEFT_PAREN . (name . 4))
(DOT . (name . 4)) (TICK . (name . 4)))
+ ((default . error) (USE . 585))
+ ((default . error) (DOT . 90) (TICK . 91) (USE . 584) (LEFT_PAREN .
107))
+ ((default . error) (DOT . 90) (TICK . 91) (BAR . (discrete_choice .
1)) (EQUAL_GREATER . (discrete_choice . 1)) (LEFT_PAREN . 107))
((default . error) (SEMICOLON . (association_opt . 2)) (IS .
(association_opt . 2)) (COMMA . (association_opt . 2)) (RIGHT_PAREN .
(association_opt . 2)))
((default . error) (SEMICOLON . (association_opt . 1)) (IS .
(association_opt . 1)) (COMMA . (association_opt . 1)) (RIGHT_PAREN .
(association_opt . 1)))
- ((default . error) (DOT . 87) (TICK . 88) (BAR . (discrete_choice .
1)) (EQUAL_GREATER . (discrete_choice . 1)) (LEFT_PAREN . 106))
((default . error) (BAR . (choice_relation_and_list . 1)) (EQUAL_GREATER
. (choice_relation_and_list . 1)) (AND . (choice_relation_and_list . 1)))
- ((default . error) (XOR . (choice_relation . 1)) (OR . (choice_relation
. 1)) (BAR . (choice_relation . 1)) (EQUAL_GREATER . (choice_relation . 1))
(AND . (choice_relation . 1)) (EQUAL . 272) (SLASH_EQUAL . 277) (LESS . 275)
(LESS_EQUAL . 276) (GREATER . 273) (GREATER_EQUAL . 274))
+ ((default . error) (XOR . (choice_relation . 1)) (OR . (choice_relation
. 1)) (BAR . (choice_relation . 1)) (EQUAL_GREATER . (choice_relation . 1))
(AND . (choice_relation . 1)) (EQUAL . 278) (SLASH_EQUAL . 283) (LESS . 281)
(LESS_EQUAL . 282) (GREATER . 279) (GREATER_EQUAL . 280))
((default . error) (BAR . (choice_relation_or_list . 1)) (EQUAL_GREATER
. (choice_relation_or_list . 1)) (OR . (choice_relation_or_list . 1)))
((default . error) (BAR . (choice_relation_xor_list . 1)) (EQUAL_GREATER
. (choice_relation_xor_list . 1)) (XOR . (choice_relation_xor_list . 1)))
- ((default . error) (PLUS . 144) (MINUS . 143) (ABS . 147) (NOT .
150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN . 148))
- ((default . error) (PLUS . 144) (MINUS . 143) (ABS . 147) (NOT .
150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN . 148))
+ ((default . error) (PLUS . 154) (MINUS . 153) (ABS . 144) (NOT .
150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN . 148))
+ ((default . error) (PLUS . 154) (MINUS . 153) (ABS . 144) (NOT .
150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN . 148))
((default . error) (BAR . (choice_relation_xor_list . 0)) (EQUAL_GREATER
. (choice_relation_xor_list . 0)) (XOR . (choice_relation_xor_list . 0)))
- ((default . error) (PLUS . 144) (MINUS . 143) (ABS . 147) (NOT .
150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN . 148))
+ ((default . error) (PLUS . 154) (MINUS . 153) (ABS . 144) (NOT .
150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN . 148))
((default . error) (BAR . (choice_relation_or_list . 0)) (EQUAL_GREATER
. (choice_relation_or_list . 0)) (OR . (choice_relation_or_list . 0)))
- ((default . error) (PLUS . 144) (MINUS . 143) (ABS . 147) (NOT .
150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN . 148))
+ ((default . error) (PLUS . 154) (MINUS . 153) (ABS . 144) (NOT .
150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN . 148))
((default . error) (BAR . (choice_relation_and_list . 0)) (EQUAL_GREATER
. (choice_relation_and_list . 0)) (AND . (choice_relation_and_list . 0)))
((default . error) (SEMICOLON . (association_opt . 4)) (IS .
(association_opt . 4)) (COMMA . (association_opt . 4)) (RIGHT_PAREN .
(association_opt . 4)))
((default . error) (SEMICOLON . (association_opt . 3)) (IS .
(association_opt . 3)) (COMMA . (association_opt . 3)) (RIGHT_PAREN .
(association_opt . 3)))
((default . error) (EQUAL_GREATER . (discrete_choice_list . 2)) (BAR .
(discrete_choice_list . 2)))
- ((default . error) (DOT_DOT . 271) (BAR . (choice_relation . 1))
(EQUAL_GREATER . (choice_relation . 1)) (AND . (choice_relation . 1)) (OR .
(choice_relation . 1)) (XOR . (choice_relation . 1)) (EQUAL . 272)
(SLASH_EQUAL . 277) (LESS . 275) (LESS_EQUAL . 276) (GREATER . 273)
(GREATER_EQUAL . 274))
- ((default . error) (LOOP . (range . 1)) (DO . (range . 1)) (COMMA .
(range . 1)) (OF . (range . 1)) (COLON_EQUAL . (range . 1)) (ELSIF . (range .
1)) (ELSE . (range . 1)) (DIGITS . (range . 1)) (RANGE . (range . 1)) (THEN .
(range . 1)) (SEMICOLON . (range . 1)) (WITH . (range . 1)) (IS . (range . 1))
(AND . (range . 1)) (OR . (range . 1)) (XOR . (range . 1)) (RIGHT_PAREN .
(range . 1)) (EQUAL_GREATER . (range . 1)) (BAR . (range . 1)) (LEFT_PAREN .
576))
- ((default . error) (SEMICOLON . (relation . 1)) (IS . (relation . 1))
(WITH . (relation . 1)) (RIGHT_PAREN . (relation . 1)) (COMMA . (relation . 1))
(BAR . (choice_relation . 0)) (EQUAL_GREATER . (choice_relation . 0)) (AND .
((relation . 1) (choice_relation . 0))) (OR . ((relation . 1) (choice_relation
. 0))) (XOR . ((relation . 1) (choice_relation . 0))))
- ((default . error) (PLUS . 144) (MINUS . 143) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (ABS . 147) (NOT . 150)
(NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149) (LEFT_PAREN . 148))
- ((default . error) (BAR . 574) (DO . (relation . 3)) (LOOP . (relation
. 3)) (COMMA . (relation . 3)) (ELSIF . (relation . 3)) (ELSE . (relation . 3))
(EQUAL_GREATER . (relation . 3)) (RIGHT_PAREN . (relation . 3)) (DIGITS .
(relation . 3)) (RANGE . (relation . 3)) (THEN . (relation . 3)) (SEMICOLON .
(relation . 3)) (WITH . (relation . 3)) (IS . (relation . 3)) (AND . (relation
. 3)) (OR . (relation . 3)) (XOR . (relation . 3)))
+ ((default . error) (DOT_DOT . 277) (BAR . (choice_relation . 1))
(EQUAL_GREATER . (choice_relation . 1)) (AND . (choice_relation . 1)) (OR .
(choice_relation . 1)) (XOR . (choice_relation . 1)) (EQUAL . 278)
(SLASH_EQUAL . 283) (LESS . 281) (LESS_EQUAL . 282) (GREATER . 279)
(GREATER_EQUAL . 280))
+ ((default . error) (LOOP . (range . 1)) (DO . (range . 1)) (OF . (range
. 1)) (COLON_EQUAL . (range . 1)) (ELSIF . (range . 1)) (ELSE . (range . 1))
(DIGITS . (range . 1)) (RANGE . (range . 1)) (THEN . (range . 1)) (SEMICOLON .
(range . 1)) (WITH . (range . 1)) (IS . (range . 1)) (AND . (range . 1)) (OR .
(range . 1)) (XOR . (range . 1)) (COMMA . (range . 1)) (RIGHT_PAREN . (range .
1)) (EQUAL_GREATER . (range . 1)) (BAR . (range . 1)) (LEFT_PAREN . 578))
+ ((default . error) (SEMICOLON . (relation . 1)) (IS . (relation . 1))
(WITH . (relation . 1)) (RIGHT_PAREN . (relation . 1)) (COMMA . (relation . 1))
(BAR . (choice_relation . 0)) (EQUAL_GREATER . (choice_relation . 0)) (AND .
((choice_relation . 0) (relation . 1))) (OR . ((choice_relation . 0) (relation
. 1))) (XOR . ((choice_relation . 0) (relation . 1))))
+ ((default . error) (DO . (range . 2)) (LOOP . (range . 2)) (OF . (range
. 2)) (COLON_EQUAL . (range . 2)) (ELSIF . (range . 2)) (ELSE . (range . 2))
(DIGITS . (range . 2)) (RANGE . (range . 2)) (THEN . (range . 2)) (SEMICOLON .
(range . 2)) (WITH . (range . 2)) (IS . (range . 2)) (AND . (range . 2)) (OR .
(range . 2)) (XOR . (range . 2)) (COMMA . (range . 2)) (RIGHT_PAREN . (range .
2)) (EQUAL_GREATER . (range . 2)) (BAR . (range . 2)))
+ ((default . error) (PLUS . 154) (MINUS . 153) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (ABS . 144) (NOT . 150)
(NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149) (LEFT_PAREN . 148))
+ ((default . error) (BAR . 576) (DO . (relation . 3)) (LOOP . (relation
. 3)) (COMMA . (relation . 3)) (ELSIF . (relation . 3)) (ELSE . (relation . 3))
(EQUAL_GREATER . (relation . 3)) (RIGHT_PAREN . (relation . 3)) (DIGITS .
(relation . 3)) (RANGE . (relation . 3)) (THEN . (relation . 3)) (SEMICOLON .
(relation . 3)) (WITH . (relation . 3)) (IS . (relation . 3)) (AND . (relation
. 3)) (OR . (relation . 3)) (XOR . (relation . 3)))
((default . error) (DO . (membership_choice_list . 0)) (LOOP .
(membership_choice_list . 0)) (COMMA . (membership_choice_list . 0)) (ELSIF .
(membership_choice_list . 0)) (ELSE . (membership_choice_list . 0))
(EQUAL_GREATER . (membership_choice_list . 0)) (RIGHT_PAREN .
(membership_choice_list . 0)) (DIGITS . (membership_choice_list . 0)) (RANGE .
(membership_choice_list . 0)) (THEN . (membership_choice_list . 0)) (SEMICOLON
. (membership_choice_list . 0)) (WITH . (membership_choic [...]
((default . error) (DO . (membership_choice . 1)) (LOOP .
(membership_choice . 1)) (COMMA . (membership_choice . 1)) (ELSIF .
(membership_choice . 1)) (ELSE . (membership_choice . 1)) (EQUAL_GREATER .
(membership_choice . 1)) (RIGHT_PAREN . (membership_choice . 1)) (DIGITS .
(membership_choice . 1)) (RANGE . (membership_choice . 1)) (THEN .
(membership_choice . 1)) (SEMICOLON . (membership_choice . 1)) (WITH .
(membership_choice . 1)) (IS . (membership_choice . 1)) (AND . (membersh [...]
- ((default . error) (DOT_DOT . 271) (DO . (membership_choice . 0)) (LOOP
. (membership_choice . 0)) (COMMA . (membership_choice . 0)) (ELSIF .
(membership_choice . 0)) (ELSE . (membership_choice . 0)) (EQUAL_GREATER .
(membership_choice . 0)) (RIGHT_PAREN . (membership_choice . 0)) (DIGITS .
(membership_choice . 0)) (RANGE . (membership_choice . 0)) (THEN .
(membership_choice . 0)) (SEMICOLON . (membership_choice . 0)) (WITH .
(membership_choice . 0)) (IS . (membership_choice . 0)) [...]
- ((default . error) (DO . (range . 2)) (LOOP . (range . 2)) (OF . (range
. 2)) (COLON_EQUAL . (range . 2)) (ELSIF . (range . 2)) (ELSE . (range . 2))
(DIGITS . (range . 2)) (RANGE . (range . 2)) (THEN . (range . 2)) (SEMICOLON .
(range . 2)) (WITH . (range . 2)) (IS . (range . 2)) (AND . (range . 2)) (OR .
(range . 2)) (XOR . (range . 2)) (COMMA . (range . 2)) (RIGHT_PAREN . (range .
2)) (EQUAL_GREATER . (range . 2)) (BAR . (range . 2)))
- ((default . error) (BEGIN . (package_renaming_declaration . 0))
(IDENTIFIER . (package_renaming_declaration . 0)) (ENTRY .
(package_renaming_declaration . 0)) (FOR . (package_renaming_declaration . 0))
(PROTECTED . (package_renaming_declaration . 0)) (SUBTYPE .
(package_renaming_declaration . 0)) (TASK . (package_renaming_declaration . 0))
(TYPE . (package_renaming_declaration . 0)) (END .
(package_renaming_declaration . 0)) (WITH . (package_renaming_declaration . 0))
(USE . (packa [...]
+ ((default . error) (DOT_DOT . 277) (DO . (membership_choice . 0)) (LOOP
. (membership_choice . 0)) (COMMA . (membership_choice . 0)) (ELSIF .
(membership_choice . 0)) (ELSE . (membership_choice . 0)) (EQUAL_GREATER .
(membership_choice . 0)) (RIGHT_PAREN . (membership_choice . 0)) (DIGITS .
(membership_choice . 0)) (RANGE . (membership_choice . 0)) (THEN .
(membership_choice . 0)) (SEMICOLON . (membership_choice . 0)) (WITH .
(membership_choice . 0)) (IS . (membership_choice . 0)) [...]
+ ((default . error) (BEGIN . (package_renaming_declaration . 0)) (ENTRY .
(package_renaming_declaration . 0)) (FOR . (package_renaming_declaration . 0))
(PROTECTED . (package_renaming_declaration . 0)) (SUBTYPE .
(package_renaming_declaration . 0)) (TASK . (package_renaming_declaration . 0))
(TYPE . (package_renaming_declaration . 0)) (IDENTIFIER .
(package_renaming_declaration . 0)) (END . (package_renaming_declaration . 0))
(WITH . (package_renaming_declaration . 0)) (USE . (packa [...]
((default . error) (SEMICOLON . (association_list . 1)) (IS .
(association_list . 1)) (COMMA . (association_list . 1)) (RIGHT_PAREN .
(association_list . 1)))
+ ((default . error) (RIGHT_PAREN . (range_list . 1)) (COMMA . (range_list
. 1)))
+ ((default . error) (DOT_DOT . 277))
+ ((default . error) (SEMICOLON . 575))
+ ((default . error) (SEMICOLON . 574))
((default . error) (SEMICOLON . 573))
((default . error) (SEMICOLON . 572))
- ((default . error) (SEMICOLON . 571))
- ((default . error) (SEMICOLON . 570))
- ((default . error) (ACCESS . (null_exclusion_opt . 0)) (NOT . 565)
(IDENTIFIER . 564) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49))
- ((default . error) (RIGHT_PAREN . (discriminant_specification_opt . 0))
(SEMICOLON . (discriminant_specification_opt . 0)) (IDENTIFIER . 72))
+ ((default . error) (ACCESS . (null_exclusion_opt . 0)) (NOT . 566)
(IDENTIFIER . 567) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49))
((default . error) (IS . (discriminant_part_opt . 2)) (WITH .
(discriminant_part_opt . 2)) (SEMICOLON . (discriminant_part_opt . 2)))
+ ((default . error) (RIGHT_PAREN . (discriminant_specification_opt . 0))
(SEMICOLON . (discriminant_specification_opt . 0)) (IDENTIFIER . 77))
((default . error) (IS . (discriminant_part_opt . 1)) (WITH .
(discriminant_part_opt . 1)) (SEMICOLON . (discriminant_part_opt . 1)))
- ((default . error) (PACKAGE . (formal_type_declaration . 2)) (PROCEDURE
. (formal_type_declaration . 2)) (FUNCTION . (formal_type_declaration . 2))
(IDENTIFIER . (formal_type_declaration . 2)) (PRAGMA . (formal_type_declaration
. 2)) (TYPE . (formal_type_declaration . 2)) (WITH . (formal_type_declaration .
2)))
- ((default . error) (TAGGED . 562) (NEW .
(abstract_limited_synchronized_opt . 3)) (SYNCHRONIZED . 561) (LIMITED . 560))
- ((default . error) (LEFT_PAREN . 559))
- ((default . error) (BOX . 558))
- ((default . error) (BOX . 557))
+ ((default . error) (PACKAGE . (formal_type_declaration . 2)) (PROCEDURE
. (formal_type_declaration . 2)) (FUNCTION . (formal_type_declaration . 2))
(PRAGMA . (formal_type_declaration . 2)) (TYPE . (formal_type_declaration . 2))
(USE . (formal_type_declaration . 2)) (WITH . (formal_type_declaration . 2))
(IDENTIFIER . (formal_type_declaration . 2)))
+ ((default . error) (TAGGED . 564) (NEW .
(abstract_limited_synchronized_opt . 3)) (SYNCHRONIZED . 563) (LIMITED . 562))
+ ((default . error) (LEFT_PAREN . 561))
+ ((default . error) (BOX . 560))
+ ((default . error) (BOX . 559))
((default . error) (SEMICOLON . (interface_type_definition . 8)) (WITH .
(interface_type_definition . 8)))
+ ((default . error) (BOX . 558))
+ ((default . error) (INTERFACE . 557) (PRIVATE .
(abstract_tagged_limited_opt . 5)) (NEW . (abstract_limited_synchronized_opt .
4)))
((default . error) (BOX . 556))
- ((default . error) (INTERFACE . 555) (PRIVATE .
(abstract_tagged_limited_opt . 5)) (NEW . (abstract_limited_synchronized_opt .
4)))
+ ((default . error) (INTERFACE . 555))
((default . error) (BOX . 554))
- ((default . error) (INTERFACE . 553))
- ((default . error) (BOX . 552))
- ((default . error) (INTERFACE . 551) (NEW .
(abstract_limited_synchronized_opt . 5)))
- ((default . error) (PRIVATE . (abstract_tagged_limited_opt . 4))
(LIMITED . 549) (SEMICOLON . (aspect_specification_opt . 0)) (WITH . 108))
- ((default . error) (INTERFACE . 548))
- ((default . error) (NEW . 547))
- ((default . error) (PRIVATE . 546))
+ ((default . error) (INTERFACE . 553) (NEW .
(abstract_limited_synchronized_opt . 5)))
+ ((default . error) (PRIVATE . (abstract_tagged_limited_opt . 4))
(LIMITED . 551) (SEMICOLON . (aspect_specification_opt . 0)) (WITH . 109))
+ ((default . error) (INTERFACE . 550))
+ ((default . error) (NEW . 549))
+ ((default . error) (PRIVATE . 548))
((default . error) (WITH . (formal_type_definition . 9)) (SEMICOLON .
(formal_type_definition . 9)))
((default . error) (WITH . (formal_type_definition . 8)) (SEMICOLON .
(formal_type_definition . 8)))
- ((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
108))
+ ((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
109))
((default . error) (WITH . (formal_type_definition . 1)) (SEMICOLON .
(formal_type_definition . 1)))
((default . error) (WITH . (formal_type_definition . 10)) (SEMICOLON .
(formal_type_definition . 10)))
- ((default . error) (SEMICOLON . 544))
- ((default . error) (SEMICOLON . 543))
- ((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
108))
+ ((default . error) (ACCESS . 242))
+ ((default . error) (SEMICOLON . 546))
+ ((default . error) (SEMICOLON . 545))
+ ((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
109))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
- ((default . error) (DOT . 87) (TICK . 88) (COLON_EQUAL . 539)
(LEFT_PAREN . 106) (SEMICOLON . (aspect_specification_opt . 0)) (WITH . 108))
- ((default . error) (RAISE . 152) (PLUS . 144) (MINUS . 143) (ABS .
147) (NOT . 150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
- ((default . error) (SEMICOLON . 537))
- ((default . error) (RIGHT_PAREN . (parameter_and_result_profile . 0))
(DO . (parameter_and_result_profile . 0)) (RENAMES .
(parameter_and_result_profile . 0)) (COLON_EQUAL .
(parameter_and_result_profile . 0)) (WITH . (parameter_and_result_profile . 0))
(SEMICOLON . (parameter_and_result_profile . 0)) (IS .
(parameter_and_result_profile . 0)))
+ ((default . error) (DOT . 90) (TICK . 91) (COLON_EQUAL . 541)
(LEFT_PAREN . 107) (SEMICOLON . (aspect_specification_opt . 0)) (WITH . 109))
+ ((default . error) (RAISE . 152) (PLUS . 154) (MINUS . 153) (ABS .
144) (NOT . 150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
+ ((default . error) (SEMICOLON . 539))
+ ((default . error) (DO . (parameter_and_result_profile . 0))
(RIGHT_PAREN . (parameter_and_result_profile . 0)) (COLON_EQUAL .
(parameter_and_result_profile . 0)) (RENAMES . (parameter_and_result_profile .
0)) (WITH . (parameter_and_result_profile . 0)) (SEMICOLON .
(parameter_and_result_profile . 0)) (IS . (parameter_and_result_profile . 0)))
((default . error) (IDENTIFIER . (general_access_modifier_opt . 1))
(STRING_LITERAL . (general_access_modifier_opt . 1)) (CHARACTER_LITERAL .
(general_access_modifier_opt . 1)))
((default . error) (IDENTIFIER . (general_access_modifier_opt . 2))
(STRING_LITERAL . (general_access_modifier_opt . 2)) (CHARACTER_LITERAL .
(general_access_modifier_opt . 2)))
((default . error) (FUNCTION . (protected_opt . 1)) (PROCEDURE .
(protected_opt . 1)))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
- ((default . error) (FUNCTION . 534) (PROCEDURE . 535))
- ((default . error) (IN . (aliased_opt . 1)) (OUT . (aliased_opt . 1))
(ARRAY . (aliased_opt . 1)) (CONSTANT . (aliased_opt . 1)) (IDENTIFIER .
(aliased_opt . 1)) (STRING_LITERAL . (aliased_opt . 1)) (CHARACTER_LITERAL .
(aliased_opt . 1)) (ACCESS . (aliased_opt . 1)) (NOT . (aliased_opt . 1)))
- ((default . error) (IDENTIFIER . (mode_opt . 0)) (STRING_LITERAL .
(mode_opt . 0)) (CHARACTER_LITERAL . (mode_opt . 0)) (IN . 207) (OUT . 208)
(ACCESS . (null_exclusion_opt . 0)) (NOT . ((mode_opt . 0) 211)))
+ ((default . error) (FUNCTION . 536) (PROCEDURE . 537))
+ ((default . error) (IN . (aliased_opt . 1)) (OUT . (aliased_opt . 1))
(ARRAY . (aliased_opt . 1)) (CONSTANT . (aliased_opt . 1)) (ACCESS .
(aliased_opt . 1)) (NOT . (aliased_opt . 1)) (IDENTIFIER . (aliased_opt . 1))
(STRING_LITERAL . (aliased_opt . 1)) (CHARACTER_LITERAL . (aliased_opt . 1)))
+ ((default . error) (IDENTIFIER . (mode_opt . 0)) (STRING_LITERAL .
(mode_opt . 0)) (CHARACTER_LITERAL . (mode_opt . 0)) (IN . 217) (OUT . 218)
(ACCESS . (null_exclusion_opt . 0)) (NOT . ( 232 (mode_opt . 0))))
((default . error) (RIGHT_PAREN . (parameter_specification_list . 1))
(SEMICOLON . (parameter_specification_list . 1)))
- ((default . error) (DO . (aggregate . 3)) (ELSIF . (aggregate . 3))
(ELSE . (aggregate . 3)) (DIGITS . (aggregate . 3)) (RANGE . (aggregate . 3))
(THEN . (aggregate . 3)) (USE . (aggregate . 3)) (COLON_EQUAL . (aggregate .
3)) (WHILE . (aggregate . 3)) (SELECT . (aggregate . 3)) (REQUEUE . (aggregate
. 3)) (RAISE . (aggregate . 3)) (PRAGMA . (aggregate . 3)) (NULL . (aggregate .
3)) (LOOP . (aggregate . 3)) (IF . (aggregate . 3)) (GOTO . (aggregate . 3))
(FOR . (aggregate . 3)) (EX [...]
- ((default . error) (RIGHT_PAREN . ((association_opt . 0) (expression_opt
. 0))) (COMMA . ((association_opt . 0) (expression_opt . 0))) (EQUAL_GREATER .
(discrete_choice_list . 0)) (BAR . (discrete_choice_list . 0)) (OTHERS . 175)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 173) (STRING_LITERAL . 49) (RAISE .
152) (PLUS . 144) (MINUS . 143) (ABS . 147) (NOT . 174) (NUMERIC_LITERAL .
145) (NULL . 530) (NEW . 149) (LEFT_PAREN . 148))
- ((default . error) (DO . (aggregate . 2)) (ELSIF . (aggregate . 2))
(ELSE . (aggregate . 2)) (DIGITS . (aggregate . 2)) (RANGE . (aggregate . 2))
(THEN . (aggregate . 2)) (USE . (aggregate . 2)) (COLON_EQUAL . (aggregate .
2)) (WHILE . (aggregate . 2)) (SELECT . (aggregate . 2)) (REQUEUE . (aggregate
. 2)) (RAISE . (aggregate . 2)) (PRAGMA . (aggregate . 2)) (NULL . (aggregate .
2)) (LOOP . (aggregate . 2)) (IF . (aggregate . 2)) (GOTO . (aggregate . 2))
(FOR . (aggregate . 2)) (EX [...]
- ((default . error) (DO . (aggregate . 0)) (LOOP . (aggregate . 0)) (USE
. (aggregate . 0)) (COLON_EQUAL . (aggregate . 0)) (WHILE . (aggregate . 0))
(SELECT . (aggregate . 0)) (REQUEUE . (aggregate . 0)) (RAISE . (aggregate .
0)) (PRAGMA . (aggregate . 0)) (NULL . (aggregate . 0)) (IF . (aggregate . 0))
(GOTO . (aggregate . 0)) (FOR . (aggregate . 0)) (EXIT . (aggregate . 0))
(DELAY . (aggregate . 0)) (DECLARE . (aggregate . 0)) (CASE . (aggregate . 0))
(BEGIN . (aggregate . 0)) (A [...]
- ((default . error) (RIGHT_PAREN . 529))
- ((default . error) (THEN . 528))
- ((default . error) (IS . 527))
- ((default . error) (WHEN . 795))
- ((default . error) (RAISE . 152) (PLUS . 144) (MINUS . 143) (ABS .
147) (NOT . 150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
- ((default . error) (OF . (aggregate . 5)) (LESS_LESS . (aggregate . 5))
(IDENTIFIER . (aggregate . 5)) (STRING_LITERAL . (aggregate . 5))
(CHARACTER_LITERAL . (aggregate . 5)) (ACCEPT . (aggregate . 5)) (ABORT .
(aggregate . 5)) (BEGIN . (aggregate . 5)) (CASE . (aggregate . 5)) (DECLARE .
(aggregate . 5)) (DELAY . (aggregate . 5)) (EXIT . (aggregate . 5)) (FOR .
(aggregate . 5)) (GOTO . (aggregate . 5)) (IF . (aggregate . 5)) (NULL .
(aggregate . 5)) (PRAGMA . (aggregate . 5)) (RA [...]
- ((default . error) (PLUS . (primary . 1)) (MINUS . (primary . 1))
(AMPERSAND . (primary . 1)) (DOT_DOT . (primary . 1)) (IN . (primary . 1)) (NOT
. (primary . 1)) (EQUAL . (primary . 1)) (GREATER . (primary . 1))
(GREATER_EQUAL . (primary . 1)) (LESS . (primary . 1)) (LESS_EQUAL . (primary .
1)) (SLASH_EQUAL . (primary . 1)) (RIGHT_PAREN . (primary . 1)) (COMMA .
(primary . 1)) (SLASH . (primary . 1)) (STAR . (primary . 1)) (MOD . (primary .
1)) (REM . (primary . 1)) (STAR_STAR . ( [...]
- ((default . error) (COMMA . 268) (RIGHT_PAREN . 792))
- ((default . error) (COLON_EQUAL . 791) (RIGHT_PAREN .
(parameter_specification . 3)) (SEMICOLON . (parameter_specification . 3)))
- ((default . error) (IDENTIFIER . (null_exclusion_opt . 0))
(STRING_LITERAL . (null_exclusion_opt . 0)) (CHARACTER_LITERAL .
(null_exclusion_opt . 0)) (NOT . 211))
- ((default . error) (RETURN . 90) (LEFT_PAREN . 787))
- ((default . error) (IS . (parameter_profile_opt . 0)) (SEMICOLON .
(parameter_profile_opt . 0)) (WITH . (parameter_profile_opt . 0)) (COLON_EQUAL
. (parameter_profile_opt . 0)) (RENAMES . (parameter_profile_opt . 0)) (DO .
(parameter_profile_opt . 0)) (RIGHT_PAREN . (parameter_profile_opt . 0))
(LEFT_PAREN . 787))
- ((default . error) (DOT . 87) (TICK . 88) (RIGHT_PAREN .
(access_definition . 0)) (DO . (access_definition . 0)) (RENAMES .
(access_definition . 0)) (COLON_EQUAL . (access_definition . 0)) (WITH .
(access_definition . 0)) (SEMICOLON . (access_definition . 0)) (IS .
(access_definition . 0)) (LEFT_PAREN . 106))
- ((default . error) (WITH . (formal_object_declaration . 3)) (TYPE .
(formal_object_declaration . 3)) (PRAGMA . (formal_object_declaration . 3))
(IDENTIFIER . (formal_object_declaration . 3)) (FUNCTION .
(formal_object_declaration . 3)) (PROCEDURE . (formal_object_declaration . 3))
(PACKAGE . (formal_object_declaration . 3)))
- ((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
108))
- ((default . error) (RAISE . 152) (PLUS . 144) (MINUS . 143) (ABS .
147) (NOT . 150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
- ((default . error) (SEMICOLON . 784))
- ((default . error) (DOT . 87) (TICK . 88) (WITH .
(formal_package_actual_part . 1)) (SEMICOLON . (formal_package_actual_part .
1)) (LEFT_PAREN . 782))
- ((default . error) (SEMICOLON . 781))
- ((default . error) (WITH . (formal_subprogram_declaration . 3)) (TYPE .
(formal_subprogram_declaration . 3)) (PRAGMA . (formal_subprogram_declaration .
3)) (IDENTIFIER . (formal_subprogram_declaration . 3)) (FUNCTION .
(formal_subprogram_declaration . 3)) (PROCEDURE .
(formal_subprogram_declaration . 3)) (PACKAGE . (formal_subprogram_declaration
. 3)))
- ((default . error) (WITH . (formal_subprogram_declaration . 0)) (TYPE .
(formal_subprogram_declaration . 0)) (PRAGMA . (formal_subprogram_declaration .
0)) (IDENTIFIER . (formal_subprogram_declaration . 0)) (FUNCTION .
(formal_subprogram_declaration . 0)) (PROCEDURE .
(formal_subprogram_declaration . 0)) (PACKAGE . (formal_subprogram_declaration
. 0)))
- ((default . error) (SEMICOLON . 780))
+ ((default . error) (COLON_EQUAL . 812) (RIGHT_PAREN .
(parameter_specification . 3)) (SEMICOLON . (parameter_specification . 3)))
+ ((default . error) (IDENTIFIER . (null_exclusion_opt . 0))
(STRING_LITERAL . (null_exclusion_opt . 0)) (CHARACTER_LITERAL .
(null_exclusion_opt . 0)) (NOT . 232))
+ ((default . error) (RETURN . 89) (LEFT_PAREN . 808))
+ ((default . error) (WITH . (parameter_profile_opt . 0)) (SEMICOLON .
(parameter_profile_opt . 0)) (IS . (parameter_profile_opt . 0)) (COLON_EQUAL .
(parameter_profile_opt . 0)) (RIGHT_PAREN . (parameter_profile_opt . 0))
(RENAMES . (parameter_profile_opt . 0)) (DO . (parameter_profile_opt . 0))
(LEFT_PAREN . 808))
+ ((default . error) (DOT . 90) (TICK . 91) (DO . (access_definition .
0)) (RENAMES . (access_definition . 0)) (RIGHT_PAREN . (access_definition . 0))
(COLON_EQUAL . (access_definition . 0)) (IS . (access_definition . 0))
(SEMICOLON . (access_definition . 0)) (WITH . (access_definition . 0))
(LEFT_PAREN . 107))
+ ((default . error) (IDENTIFIER . (formal_object_declaration . 3)) (WITH
. (formal_object_declaration . 3)) (USE . (formal_object_declaration . 3))
(TYPE . (formal_object_declaration . 3)) (PRAGMA . (formal_object_declaration .
3)) (FUNCTION . (formal_object_declaration . 3)) (PROCEDURE .
(formal_object_declaration . 3)) (PACKAGE . (formal_object_declaration . 3)))
+ ((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
109))
+ ((default . error) (RAISE . 152) (PLUS . 154) (MINUS . 153) (ABS .
144) (NOT . 150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
+ ((default . error) (SEMICOLON . 805))
+ ((default . error) (DOT . 90) (TICK . 91) (WITH .
(formal_package_actual_part . 1)) (SEMICOLON . (formal_package_actual_part .
1)) (LEFT_PAREN . 803))
+ ((default . error) (SEMICOLON . 802))
+ ((default . error) (IDENTIFIER . (formal_subprogram_declaration . 3))
(WITH . (formal_subprogram_declaration . 3)) (USE .
(formal_subprogram_declaration . 3)) (TYPE . (formal_subprogram_declaration .
3)) (PRAGMA . (formal_subprogram_declaration . 3)) (FUNCTION .
(formal_subprogram_declaration . 3)) (PROCEDURE .
(formal_subprogram_declaration . 3)) (PACKAGE . (formal_subprogram_declaration
. 3)))
+ ((default . error) (IDENTIFIER . (formal_subprogram_declaration . 0))
(WITH . (formal_subprogram_declaration . 0)) (USE .
(formal_subprogram_declaration . 0)) (TYPE . (formal_subprogram_declaration .
0)) (PRAGMA . (formal_subprogram_declaration . 0)) (FUNCTION .
(formal_subprogram_declaration . 0)) (PROCEDURE .
(formal_subprogram_declaration . 0)) (PACKAGE . (formal_subprogram_declaration
. 0)))
+ ((default . error) (SEMICOLON . 801))
((default . error) (SEMICOLON . (formal_type_definition . 0)) (WITH .
(formal_type_definition . 0)))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
- ((default . error) (AND . 778) (WITH . (interface_type_definition . 5))
(SEMICOLON . (interface_type_definition . 5)))
+ ((default . error) (AND . 799) (WITH . (interface_type_definition . 5))
(SEMICOLON . (interface_type_definition . 5)))
((default . error) (RECORD . (abstract_tagged_limited_opt . 3)) (NULL .
(abstract_tagged_limited_opt . 3)) (PRIVATE . (abstract_tagged_limited_opt .
3)))
- ((default . error) (SEMICOLON . 777))
- ((default . error) (AND . 776) (WITH . (interface_type_definition . 7))
(SEMICOLON . (interface_type_definition . 7)))
+ ((default . error) (SEMICOLON . 798))
+ ((default . error) (AND . 797) (WITH . (interface_type_definition . 7))
(SEMICOLON . (interface_type_definition . 7)))
((default . error) (SEMICOLON . (formal_type_definition . 3)) (WITH .
(formal_type_definition . 3)))
- ((default . error) (AND . 775) (WITH . (interface_type_definition . 6))
(SEMICOLON . (interface_type_definition . 6)))
+ ((default . error) (AND . 796) (WITH . (interface_type_definition . 6))
(SEMICOLON . (interface_type_definition . 6)))
((default . error) (SEMICOLON . (formal_type_definition . 4)) (WITH .
(formal_type_definition . 4)))
- ((default . error) (AND . 774) (WITH . (interface_type_definition . 4))
(SEMICOLON . (interface_type_definition . 4)))
- ((default . error) (RIGHT_PAREN . 773))
+ ((default . error) (AND . 795) (WITH . (interface_type_definition . 4))
(SEMICOLON . (interface_type_definition . 4)))
+ ((default . error) (RIGHT_PAREN . 794))
((default . error) (SEMICOLON . (formal_type_definition . 5)) (WITH .
(formal_type_definition . 5)))
- ((default . error) (SEMICOLON . (formal_type_definition . 6)) (WITH .
(formal_type_definition . 6)) (DIGITS . 772))
- ((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49) (PLUS . 144) (MINUS . 143) (ABS . 147) (NOT . 763)
(NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149) (LEFT_PAREN . 148))
+ ((default . error) (SEMICOLON . (formal_type_definition . 6)) (WITH .
(formal_type_definition . 6)) (DIGITS . 793))
+ ((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49) (PLUS . 154) (MINUS . 153) (ABS . 144) (NOT . 734)
(NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149) (LEFT_PAREN . 148))
((default . error) (NEW . (abstract_limited_synchronized_opt . 1)))
((default . error) (NEW . (abstract_limited_synchronized_opt . 2)))
- ((default . error) (LIMITED . 762) (RECORD .
(abstract_tagged_limited_opt . 2)) (NULL . (abstract_tagged_limited_opt . 2))
(PRIVATE . (abstract_tagged_limited_opt . 2)))
+ ((default . error) (LIMITED . 787) (RECORD .
(abstract_tagged_limited_opt . 2)) (NULL . (abstract_tagged_limited_opt . 2))
(PRIVATE . (abstract_tagged_limited_opt . 2)))
((default . error) (RIGHT_PAREN . (discriminant_specification_list . 1))
(SEMICOLON . (discriminant_specification_list . 1)))
+ ((default . error) (NULL . 786))
((default . error) (SEMICOLON . (null_exclusion_opt_name_type . 0))
(RIGHT_PAREN . (null_exclusion_opt_name_type . 0)) (COLON_EQUAL .
(null_exclusion_opt_name_type . 0)) (DOT . (name . 0)) (LEFT_PAREN . (name .
0)) (TICK . (name . 0)))
- ((default . error) (NULL . 761))
- ((default . error) (SEMICOLON . (discriminant_specification_opt . 4))
(RIGHT_PAREN . (discriminant_specification_opt . 4)) (COLON_EQUAL . 760))
- ((default . error) (DOT . 87) (TICK . 88) (LEFT_PAREN . 106))
- ((default . error) (SEMICOLON . (discriminant_specification_opt . 2))
(RIGHT_PAREN . (discriminant_specification_opt . 2)) (COLON_EQUAL . 759))
+ ((default . error) (SEMICOLON . (discriminant_specification_opt . 4))
(RIGHT_PAREN . (discriminant_specification_opt . 4)) (COLON_EQUAL . 785))
+ ((default . error) (DOT . 90) (TICK . 91) (LEFT_PAREN . 107))
+ ((default . error) (SEMICOLON . (discriminant_specification_opt . 2))
(RIGHT_PAREN . (discriminant_specification_opt . 2)) (COLON_EQUAL . 784))
((default . error) (SEMICOLON . (null_exclusion_opt_name_type . 1))
(RIGHT_PAREN . (null_exclusion_opt_name_type . 1)) (COLON_EQUAL .
(null_exclusion_opt_name_type . 1)) (DOT . (name . 3)) (LEFT_PAREN . (name .
3)) (TICK . (name . 3)))
- ((default . error) ($EOI . (generic_renaming_declaration . 1)) (LIMITED
. (generic_renaming_declaration . 1)) (SEPARATE . (generic_renaming_declaration
. 1)) (WITH . (generic_renaming_declaration . 1)) (END .
(generic_renaming_declaration . 1)) (PRIVATE . (generic_renaming_declaration .
1)) (USE . (generic_renaming_declaration . 1)) (TYPE .
(generic_renaming_declaration . 1)) (TASK . (generic_renaming_declaration . 1))
(SUBTYPE . (generic_renaming_declaration . 1)) (PROTECTED . (ge [...]
- ((default . error) ($EOI . (generic_renaming_declaration . 0)) (LIMITED
. (generic_renaming_declaration . 0)) (SEPARATE . (generic_renaming_declaration
. 0)) (WITH . (generic_renaming_declaration . 0)) (END .
(generic_renaming_declaration . 0)) (PRIVATE . (generic_renaming_declaration .
0)) (USE . (generic_renaming_declaration . 0)) (TYPE .
(generic_renaming_declaration . 0)) (TASK . (generic_renaming_declaration . 0))
(SUBTYPE . (generic_renaming_declaration . 0)) (PROTECTED . (ge [...]
- ((default . error) ($EOI . (generic_renaming_declaration . 2)) (LIMITED
. (generic_renaming_declaration . 2)) (SEPARATE . (generic_renaming_declaration
. 2)) (WITH . (generic_renaming_declaration . 2)) (END .
(generic_renaming_declaration . 2)) (PRIVATE . (generic_renaming_declaration .
2)) (USE . (generic_renaming_declaration . 2)) (TYPE .
(generic_renaming_declaration . 2)) (TASK . (generic_renaming_declaration . 2))
(SUBTYPE . (generic_renaming_declaration . 2)) (PROTECTED . (ge [...]
- ((default . error) (END . (generic_instantiation . 0)) (BEGIN .
(generic_instantiation . 0)) (IDENTIFIER . (generic_instantiation . 0)) (ENTRY
. (generic_instantiation . 0)) (FOR . (generic_instantiation . 0)) (PROTECTED .
(generic_instantiation . 0)) (SUBTYPE . (generic_instantiation . 0)) (TASK .
(generic_instantiation . 0)) (TYPE . (generic_instantiation . 0)) ($EOI .
(generic_instantiation . 0)) (FUNCTION . (generic_instantiation . 0)) (GENERIC
. (generic_instantiation . 0)) (L [...]
- ((default . error) (PLUS . 144) (MINUS . 143) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (ABS . 147) (NOT . 150)
(NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149) (LEFT_PAREN . 148))
- ((default . error) (BAR . 574) (LOOP . (relation . 2)) (DO . (relation
. 2)) (XOR . (relation . 2)) (OR . (relation . 2)) (AND . (relation . 2)) (IS .
(relation . 2)) (WITH . (relation . 2)) (SEMICOLON . (relation . 2)) (THEN .
(relation . 2)) (RANGE . (relation . 2)) (DIGITS . (relation . 2)) (RIGHT_PAREN
. (relation . 2)) (EQUAL_GREATER . (relation . 2)) (ELSE . (relation . 2))
(ELSIF . (relation . 2)) (COMMA . (relation . 2)))
- ((default . error) (RAISE . 152) (PLUS . 144) (MINUS . 143) (ABS .
147) (NOT . 150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
- ((default . error) (PLUS . 144) (MINUS . 143) (ABS . 147) (NOT .
150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN . 148))
+ ((default . error) ($EOI . (generic_renaming_declaration . 1)) (LIMITED
. (generic_renaming_declaration . 1)) (SEPARATE . (generic_renaming_declaration
. 1)) (WITH . (generic_renaming_declaration . 1)) (END .
(generic_renaming_declaration . 1)) (PRIVATE . (generic_renaming_declaration .
1)) (IDENTIFIER . (generic_renaming_declaration . 1)) (USE .
(generic_renaming_declaration . 1)) (TYPE . (generic_renaming_declaration . 1))
(TASK . (generic_renaming_declaration . 1)) (SUBTYPE . (g [...]
+ ((default . error) ($EOI . (generic_renaming_declaration . 0)) (LIMITED
. (generic_renaming_declaration . 0)) (SEPARATE . (generic_renaming_declaration
. 0)) (WITH . (generic_renaming_declaration . 0)) (END .
(generic_renaming_declaration . 0)) (PRIVATE . (generic_renaming_declaration .
0)) (IDENTIFIER . (generic_renaming_declaration . 0)) (USE .
(generic_renaming_declaration . 0)) (TYPE . (generic_renaming_declaration . 0))
(TASK . (generic_renaming_declaration . 0)) (SUBTYPE . (g [...]
+ ((default . error) ($EOI . (generic_renaming_declaration . 2)) (LIMITED
. (generic_renaming_declaration . 2)) (SEPARATE . (generic_renaming_declaration
. 2)) (WITH . (generic_renaming_declaration . 2)) (END .
(generic_renaming_declaration . 2)) (PRIVATE . (generic_renaming_declaration .
2)) (IDENTIFIER . (generic_renaming_declaration . 2)) (USE .
(generic_renaming_declaration . 2)) (TYPE . (generic_renaming_declaration . 2))
(TASK . (generic_renaming_declaration . 2)) (SUBTYPE . (g [...]
+ ((default . error) (END . (generic_instantiation . 0)) (BEGIN .
(generic_instantiation . 0)) (ENTRY . (generic_instantiation . 0)) (FOR .
(generic_instantiation . 0)) (PROTECTED . (generic_instantiation . 0)) (SUBTYPE
. (generic_instantiation . 0)) (TASK . (generic_instantiation . 0)) (TYPE .
(generic_instantiation . 0)) (IDENTIFIER . (generic_instantiation . 0)) ($EOI .
(generic_instantiation . 0)) (FUNCTION . (generic_instantiation . 0)) (GENERIC
. (generic_instantiation . 0)) (L [...]
+ ((default . error) (PLUS . 154) (MINUS . 153) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (ABS . 144) (NOT . 150)
(NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149) (LEFT_PAREN . 148))
+ ((default . error) (BAR . 576) (LOOP . (relation . 2)) (DO . (relation
. 2)) (XOR . (relation . 2)) (OR . (relation . 2)) (AND . (relation . 2)) (IS .
(relation . 2)) (WITH . (relation . 2)) (SEMICOLON . (relation . 2)) (THEN .
(relation . 2)) (RANGE . (relation . 2)) (DIGITS . (relation . 2)) (RIGHT_PAREN
. (relation . 2)) (EQUAL_GREATER . (relation . 2)) (ELSE . (relation . 2))
(ELSIF . (relation . 2)) (COMMA . (relation . 2)))
+ ((default . error) (RAISE . 152) (PLUS . 154) (MINUS . 153) (ABS .
144) (NOT . 150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
+ ((default . error) (PLUS . 154) (MINUS . 153) (ABS . 144) (NOT .
150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN . 148))
((default . error) (AND . (choice_relation_and_then_list . 0))
(EQUAL_GREATER . (choice_relation_and_then_list . 0)) (BAR .
(choice_relation_and_then_list . 0)))
((default . error) (OR . (choice_relation_or_else_list . 0))
(EQUAL_GREATER . (choice_relation_or_else_list . 0)) (BAR .
(choice_relation_or_else_list . 0)))
((default . error) (OR . (choice_relation_or_else_list . 1))
(EQUAL_GREATER . (choice_relation_or_else_list . 1)) (BAR .
(choice_relation_or_else_list . 1)))
((default . error) (AND . (choice_relation_and_then_list . 1))
(EQUAL_GREATER . (choice_relation_and_then_list . 1)) (BAR .
(choice_relation_and_then_list . 1)))
- ((default . error) (RENAMES . 755))
- ((default . error) (RENAMES . 754))
+ ((default . error) (LEFT_PAREN . 148) (RECORD . 778))
+ ((default . error) (AT . 777))
+ ((default . error) (RAISE . 152) (PLUS . 154) (MINUS . 153) (ABS .
144) (NOT . 150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
+ ((default . error) (DOT . 90) (TICK . 91) (IS . ( 775
(aspect_specification_opt . 0))) (WITH . 109) (LEFT_PAREN . 107))
+ ((default . error) (IS . 774))
+ ((default . error) (WITH . (discriminant_part_opt . 0)) (IS .
(discriminant_part_opt . 0)) (LEFT_PAREN . 211))
+ ((default . error) (IS . ( 772 (aspect_specification_opt . 0))) (WITH .
109))
+ ((default . error) (NOT . 729) (IDENTIFIER . 48) (CHARACTER_LITERAL .
50) (STRING_LITERAL . 49))
+ ((default . error) (SEMICOLON . 770) (IS . 769))
+ ((default . error) (WITH . (discriminant_part_opt . 0)) (IS .
(discriminant_part_opt . 0)) (SEMICOLON . (discriminant_part_opt . 0))
(LEFT_PAREN . 211))
+ ((default . error) (IS . ( 767 (aspect_specification_opt . 0))) (WITH .
109))
+ ((default . error) (SEMICOLON . 766) (IS . 765))
+ ((default . error) (RENAMES . 764))
+ ((default . error) (RENAMES . 763))
((default . error) (ACCESS . 242) (IDENTIFIER . 48) (CHARACTER_LITERAL
. 50) (STRING_LITERAL . 49))
- ((default . error) (LEFT_PAREN . 223) (RECORD . 750))
- ((default . error) (AT . 749))
- ((default . error) (RAISE . 152) (PLUS . 144) (MINUS . 143) (ABS .
147) (NOT . 150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
- ((default . error) (DOT . 87) (TICK . 88) (IS . ( 747
(aspect_specification_opt . 0))) (WITH . 108) (LEFT_PAREN . 106))
- ((default . error) (WITH . (discriminant_part_opt . 0)) (IS .
(discriminant_part_opt . 0)) (LEFT_PAREN . 201))
- ((default . error) (IS . ( 745 (aspect_specification_opt . 0))) (WITH .
108))
- ((default . error) (IS . 744))
- ((default . error) (NOT . 741) (IDENTIFIER . 48) (CHARACTER_LITERAL .
50) (STRING_LITERAL . 49))
- ((default . error) (WITH . (discriminant_part_opt . 0)) (IS .
(discriminant_part_opt . 0)) (SEMICOLON . (discriminant_part_opt . 0))
(LEFT_PAREN . 201))
- ((default . error) (IS . ( 739 (aspect_specification_opt . 0))) (WITH .
108))
- ((default . error) (SEMICOLON . 737) (IS . 738))
- ((default . error) (SEMICOLON . 735) (IS . 736))
- ((default . error) (END . 734))
- ((default . error) (DOT . 87) (TICK . 88) (SEMICOLON .
(package_specification . 1)) (LEFT_PAREN . 106))
- ((default . error) (COLON_EQUAL . 733))
- ((default . error) (SEMICOLON . 732))
- ((default . error) (IDENTIFIER . (constant_opt . 0)) (STRING_LITERAL .
(constant_opt . 0)) (CHARACTER_LITERAL . (constant_opt . 0)) (NOT .
(constant_opt . 0)) (ACCESS . (constant_opt . 0)) (ARRAY . (constant_opt . 0))
(CONSTANT . 730))
- ((default . error) (SEPARATE . 729) (ABSTRACT . 728))
- ((default . error) (NULL . 727))
- ((default . error) (LEFT_PAREN . 725))
- ((default . error) (WITH . (parameter_profile_opt . 0)) (SEMICOLON .
(parameter_profile_opt . 0)) (LEFT_PAREN . 723))
- ((default . error) (END . (sequence_of_statements_opt . 0)) (EXCEPTION .
(sequence_of_statements_opt . 0)) (ACCEPT . (label_opt . 0)) (BEGIN .
(label_opt . 0)) (CASE . (label_opt . 0)) (DECLARE . (label_opt . 0)) (FOR .
(label_opt . 0)) (IF . (label_opt . 0)) (LOOP . (label_opt . 0)) (RETURN .
(label_opt . 0)) (SELECT . (label_opt . 0)) (WHILE . (label_opt . 0))
(STRING_LITERAL . (label_opt . 0)) (CHARACTER_LITERAL . (label_opt . 0)) (ABORT
. (label_opt . 0)) (DELAY . (label_opt . [...]
+ ((default . error) (END . 761))
+ ((default . error) (SEMICOLON . (package_specification . 1)))
+ ((default . error) (COLON_EQUAL . 760))
+ ((default . error) (SEMICOLON . 759))
+ ((default . error) (NOT . (constant_opt . 0)) (IDENTIFIER .
(constant_opt . 0)) (STRING_LITERAL . (constant_opt . 0)) (CHARACTER_LITERAL .
(constant_opt . 0)) (ACCESS . (constant_opt . 0)) (ARRAY . (constant_opt . 0))
(CONSTANT . 757))
+ ((default . error) (SEPARATE . 756) (ABSTRACT . 755))
+ ((default . error) (NULL . 754))
+ ((default . error) (LEFT_PAREN . 752))
+ ((default . error) (WITH . (parameter_profile_opt . 0)) (SEMICOLON .
(parameter_profile_opt . 0)) (LEFT_PAREN . 750))
+ ((default . error) (END . (sequence_of_statements_opt . 0)) (EXCEPTION .
(sequence_of_statements_opt . 0)) (ACCEPT . (label_opt . 0)) (BEGIN .
(label_opt . 0)) (CASE . (label_opt . 0)) (DECLARE . (label_opt . 0)) (FOR .
(label_opt . 0)) (IF . (label_opt . 0)) (LOOP . (label_opt . 0)) (RETURN .
(label_opt . 0)) (SELECT . (label_opt . 0)) (WHILE . (label_opt . 0)) (ABORT .
(label_opt . 0)) (DELAY . (label_opt . 0)) (EXIT . (label_opt . 0)) (GOTO .
(label_opt . 0)) (NULL . (label_opt [...]
((default . error) (SEMICOLON . (name_opt . 0)) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49))
((default . error) (OR . (relation_and_then_list . 0)) (XOR .
(relation_and_then_list . 0)) (LOOP . (relation_and_then_list . 0)) (DO .
(relation_and_then_list . 0)) (AND . (relation_and_then_list . 0)) (IS .
(relation_and_then_list . 0)) (WITH . (relation_and_then_list . 0)) (SEMICOLON
. (relation_and_then_list . 0)) (THEN . (relation_and_then_list . 0)) (RANGE .
(relation_and_then_list . 0)) (COMMA . (relation_and_then_list . 0))
(RIGHT_PAREN . (relation_and_then_list . 0)) (DIGI [...]
((default . error) (AND . (relation_or_else_list . 0)) (XOR .
(relation_or_else_list . 0)) (LOOP . (relation_or_else_list . 0)) (DO .
(relation_or_else_list . 0)) (OR . (relation_or_else_list . 0)) (IS .
(relation_or_else_list . 0)) (WITH . (relation_or_else_list . 0)) (SEMICOLON .
(relation_or_else_list . 0)) (THEN . (relation_or_else_list . 0)) (RANGE .
(relation_or_else_list . 0)) (COMMA . (relation_or_else_list . 0)) (RIGHT_PAREN
. (relation_or_else_list . 0)) (DIGITS . (relati [...]
((default . error) (AND . (relation_or_else_list . 1)) (XOR .
(relation_or_else_list . 1)) (LOOP . (relation_or_else_list . 1)) (DO .
(relation_or_else_list . 1)) (OR . (relation_or_else_list . 1)) (IS .
(relation_or_else_list . 1)) (WITH . (relation_or_else_list . 1)) (SEMICOLON .
(relation_or_else_list . 1)) (THEN . (relation_or_else_list . 1)) (RANGE .
(relation_or_else_list . 1)) (COMMA . (relation_or_else_list . 1)) (RIGHT_PAREN
. (relation_or_else_list . 1)) (DIGITS . (relati [...]
((default . error) (OR . (relation_and_then_list . 1)) (XOR .
(relation_and_then_list . 1)) (LOOP . (relation_and_then_list . 1)) (DO .
(relation_and_then_list . 1)) (AND . (relation_and_then_list . 1)) (IS .
(relation_and_then_list . 1)) (WITH . (relation_and_then_list . 1)) (SEMICOLON
. (relation_and_then_list . 1)) (THEN . (relation_and_then_list . 1)) (RANGE .
(relation_and_then_list . 1)) (COMMA . (relation_and_then_list . 1))
(RIGHT_PAREN . (relation_and_then_list . 1)) (DIGI [...]
+ ((default . error) (RAISE . 152) (PLUS . 154) (MINUS . 153) (ABS .
144) (NOT . 150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
((default . error) (LOOP . (raise_expression . 1)) (DO .
(raise_expression . 1)) (XOR . (raise_expression . 1)) (OR . (raise_expression
. 1)) (AND . (raise_expression . 1)) (IS . (raise_expression . 1)) (SEMICOLON .
(raise_expression . 1)) (WITH . (raise_expression . 1)) (THEN .
(raise_expression . 1)) (RANGE . (raise_expression . 1)) (RIGHT_PAREN .
(raise_expression . 1)) (COMMA . (raise_expression . 1)) (DIGITS .
(raise_expression . 1)) (EQUAL_GREATER . (raise_expression . 1)) (E [...]
- ((default . error) (OF . 720) (COLON . 718) (IN . 719))
- ((default . error) (EQUAL_GREATER . 717))
- ((default . error) (RAISE . 152) (PLUS . 144) (MINUS . 143) (ABS .
147) (NOT . 150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
- ((default . error) (IS . (aspect_specification_opt . 0)) (WITH . 108))
- ((default . error) (IS . (aspect_specification_opt . 0)) (WITH . 108))
+ ((default . error) (LOOP . (aggregate . 4)) (DO . (aggregate . 4)) (OF .
(aggregate . 4)) (ACCEPT . (aggregate . 4)) (ABORT . (aggregate . 4)) (BEGIN .
(aggregate . 4)) (CASE . (aggregate . 4)) (DECLARE . (aggregate . 4)) (DELAY .
(aggregate . 4)) (EXIT . (aggregate . 4)) (FOR . (aggregate . 4)) (GOTO .
(aggregate . 4)) (IF . (aggregate . 4)) (NULL . (aggregate . 4)) (PRAGMA .
(aggregate . 4)) (RAISE . (aggregate . 4)) (REQUEUE . (aggregate . 4)) (SELECT
. (aggregate . 4)) (WHILE . [...]
+ ((default . error) (PLUS . (primary . 1)) (MINUS . (primary . 1))
(AMPERSAND . (primary . 1)) (DOT_DOT . (primary . 1)) (IN . (primary . 1)) (NOT
. (primary . 1)) (EQUAL . (primary . 1)) (GREATER . (primary . 1))
(GREATER_EQUAL . (primary . 1)) (LESS . (primary . 1)) (LESS_EQUAL . (primary .
1)) (SLASH_EQUAL . (primary . 1)) (RIGHT_PAREN . (primary . 1)) (COMMA .
(primary . 1)) (MOD . (primary . 1)) (REM . (primary . 1)) (SLASH . (primary .
1)) (STAR . (primary . 1)) (STAR_STAR . ( [...]
+ ((default . error) (COMMA . 273) (RIGHT_PAREN . 745))
+ ((default . error) (ELSE . 741) (RIGHT_PAREN . (if_expression . 3))
(COMMA . (if_expression . 3)) (ELSIF . 742))
+ ((default . error) (RAISE . 152) (PLUS . 154) (MINUS . 153) (ABS .
144) (NOT . 150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
+ ((default . error) (REVERSE . 735) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (PLUS . 154) (MINUS . 153)
(ABS . 144) (NOT . 734) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149)
(LEFT_PAREN . 148))
+ ((default . error) (REVERSE . 732) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49))
+ ((default . error) (NOT . 729) (IDENTIFIER . 48) (CHARACTER_LITERAL .
50) (STRING_LITERAL . 49))
+ ((default . error) (EQUAL_GREATER . (discrete_choice_list . 0)) (BAR .
(discrete_choice_list . 0)) (OTHERS . 182) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (PLUS . 154) (MINUS . 153)
(ABS . 144) (NOT . 181) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149)
(LEFT_PAREN . 148))
+ ((default . error) (RIGHT_PAREN . (case_expression_alternative_list .
0)) (COMMA . (case_expression_alternative_list . 0)))
+ ((default . error) (RIGHT_PAREN . (case_expression . 0)) (COMMA . ( 727
(case_expression . 0))))
+ ((default . error) (IS . (aspect_specification_opt . 0)) (WITH . 109))
+ ((default . error) (IS . (aspect_specification_opt . 0)) (WITH . 109))
((default . error) (IS . 134))
- ((default . error) (IDENTIFIER . 713))
- ((default . error) (COLON . 712))
- ((default . error) (IDENTIFIER . 711))
+ ((default . error) (IDENTIFIER . 724))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
- ((default . error) (END . (sequence_of_statements_opt . 0)) (EXCEPTION .
(sequence_of_statements_opt . 0)) (ACCEPT . (label_opt . 0)) (BEGIN .
(label_opt . 0)) (CASE . (label_opt . 0)) (DECLARE . (label_opt . 0)) (FOR .
(label_opt . 0)) (IF . (label_opt . 0)) (LOOP . (label_opt . 0)) (RETURN .
(label_opt . 0)) (SELECT . (label_opt . 0)) (WHILE . (label_opt . 0))
(STRING_LITERAL . (label_opt . 0)) (CHARACTER_LITERAL . (label_opt . 0)) (ABORT
. (label_opt . 0)) (DELAY . (label_opt . [...]
- ((default . error) (IS . (expression_opt . 0)) (RAISE . 152) (PLUS .
144) (MINUS . 143) (ABS . 147) (NOT . 150) (NUMERIC_LITERAL . 145) (NULL .
151) (NEW . 149) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL
. 49) (LEFT_PAREN . 148))
- ((default . error) (BEGIN . (declarative_part_opt . 0)) (USE . 11)
(SUBTYPE . 299) (PRAGMA . 7) (NOT . 4) (OVERRIDING . 5) (FUNCTION .
(overriding_indicator_opt . 2)) (PROCEDURE . (overriding_indicator_opt . 2))
(ENTRY . (overriding_indicator_opt . 2)) (FOR . 296) (IDENTIFIER . 295) (TYPE
. 301) (GENERIC . 2) (PROTECTED . 298) (TASK . 300) (PACKAGE . 297))
- ((default . error) (UNTIL . 705) (RAISE . 152) (PLUS . 144) (MINUS .
143) (ABS . 147) (NOT . 150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW .
149) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49)
(LEFT_PAREN . 148))
- ((default . error) (WHEN . (identifier_opt . 0)) (SEMICOLON .
(identifier_opt . 0)) (IDENTIFIER . 703))
- ((default . error) (LOOP . (iterator_specification_opt . 0)) (IDENTIFIER
. 613))
- ((default . error) (IDENTIFIER . 700))
- ((default . error) (THEN . (expression_opt . 0)) (RAISE . 152) (PLUS .
144) (MINUS . 143) (ABS . 147) (NOT . 150) (NUMERIC_LITERAL . 145) (NULL .
151) (NEW . 149) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL
. 49) (LEFT_PAREN . 148))
- ((default . error) (END . (sequence_of_statements_opt . 0)) (ACCEPT .
(label_opt . 0)) (BEGIN . (label_opt . 0)) (CASE . (label_opt . 0)) (DECLARE .
(label_opt . 0)) (FOR . (label_opt . 0)) (IF . (label_opt . 0)) (LOOP .
(label_opt . 0)) (RETURN . (label_opt . 0)) (SELECT . (label_opt . 0)) (WHILE .
(label_opt . 0)) (STRING_LITERAL . (label_opt . 0)) (CHARACTER_LITERAL .
(label_opt . 0)) (ABORT . (label_opt . 0)) (DELAY . (label_opt . 0)) (EXIT .
(label_opt . 0)) (GOTO . (label_opt [...]
- ((default . error) (SEMICOLON . 697))
- ((default . error) (SEMICOLON . 695) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49))
+ ((default . error) (END . (sequence_of_statements_opt . 0)) (EXCEPTION .
(sequence_of_statements_opt . 0)) (ACCEPT . (label_opt . 0)) (BEGIN .
(label_opt . 0)) (CASE . (label_opt . 0)) (DECLARE . (label_opt . 0)) (FOR .
(label_opt . 0)) (IF . (label_opt . 0)) (LOOP . (label_opt . 0)) (RETURN .
(label_opt . 0)) (SELECT . (label_opt . 0)) (WHILE . (label_opt . 0)) (ABORT .
(label_opt . 0)) (DELAY . (label_opt . 0)) (EXIT . (label_opt . 0)) (GOTO .
(label_opt . 0)) (NULL . (label_opt [...]
+ ((default . error) (IS . (expression_opt . 0)) (RAISE . 152) (PLUS .
154) (MINUS . 153) (ABS . 144) (NOT . 150) (NUMERIC_LITERAL . 155) (NULL .
151) (NEW . 149) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL
. 49) (LEFT_PAREN . 148))
+ ((default . error) (BEGIN . (declarative_part_opt . 0)) (USE . 11)
(SUBTYPE . 302) (PRAGMA . 7) (NOT . 4) (OVERRIDING . 5) (FUNCTION .
(overriding_indicator_opt . 2)) (PROCEDURE . (overriding_indicator_opt . 2))
(ENTRY . (overriding_indicator_opt . 2)) (FOR . 299) (IDENTIFIER . 305) (TYPE
. 304) (GENERIC . 2) (PROTECTED . 301) (TASK . 303) (PACKAGE . 300))
+ ((default . error) (UNTIL . 718) (RAISE . 152) (PLUS . 154) (MINUS .
153) (ABS . 144) (NOT . 150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW .
149) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49)
(LEFT_PAREN . 148))
+ ((default . error) (WHEN . (identifier_opt . 0)) (SEMICOLON .
(identifier_opt . 0)) (IDENTIFIER . 716))
+ ((default . error) (LOOP . (iterator_specification_opt . 0)) (IDENTIFIER
. 408))
+ ((default . error) (IDENTIFIER . 713))
+ ((default . error) (THEN . (expression_opt . 0)) (RAISE . 152) (PLUS .
154) (MINUS . 153) (ABS . 144) (NOT . 150) (NUMERIC_LITERAL . 155) (NULL .
151) (NEW . 149) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL
. 49) (LEFT_PAREN . 148))
+ ((default . error) (END . (sequence_of_statements_opt . 0)) (ACCEPT .
(label_opt . 0)) (BEGIN . (label_opt . 0)) (CASE . (label_opt . 0)) (DECLARE .
(label_opt . 0)) (FOR . (label_opt . 0)) (IF . (label_opt . 0)) (LOOP .
(label_opt . 0)) (RETURN . (label_opt . 0)) (SELECT . (label_opt . 0)) (WHILE .
(label_opt . 0)) (ABORT . (label_opt . 0)) (DELAY . (label_opt . 0)) (EXIT .
(label_opt . 0)) (GOTO . (label_opt . 0)) (NULL . (label_opt . 0)) (PRAGMA .
(label_opt . 0)) (RAISE . (labe [...]
+ ((default . error) (SEMICOLON . 710))
+ ((default . error) (SEMICOLON . 708) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
- ((default . error) (SEMICOLON . 689) (DO .
(extended_return_object_declaration_opt . 0)) (RAISE . 152) (PLUS . 144)
(MINUS . 143) (ABS . 147) (NOT . 150) (NUMERIC_LITERAL . 145) (NULL . 151)
(NEW . 149) (IDENTIFIER . 690) (CHARACTER_LITERAL . 50) (STRING_LITERAL .
49) (LEFT_PAREN . 148))
- ((default . error) (ELSE . (select_alternative_list_opt . 0)) (END .
(select_alternative_list_opt . 0)) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49) (DELAY . 626) (WHEN . 678) (TERMINATE . 677) (ACCEPT
. 621))
- ((default . error) (LOOP . (expression_opt . 0)) (RAISE . 152) (PLUS .
144) (MINUS . 143) (ABS . 147) (NOT . 150) (NUMERIC_LITERAL . 145) (NULL .
151) (NEW . 149) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL
. 49) (LEFT_PAREN . 148))
- ((default . error) (OR . (compound_statement . 5)) (THEN .
(compound_statement . 5)) (WHEN . (compound_statement . 5)) (EXCEPTION .
(compound_statement . 5)) (END . (compound_statement . 5)) (LESS_LESS .
(compound_statement . 5)) (IDENTIFIER . (compound_statement . 5))
(STRING_LITERAL . (compound_statement . 5)) (CHARACTER_LITERAL .
(compound_statement . 5)) (ACCEPT . (compound_statement . 5)) (ABORT .
(compound_statement . 5)) (BEGIN . (compound_statement . 5)) (CASE .
(compound_s [...]
- ((default . error) (OR . (simple_statement . 1)) (THEN .
(simple_statement . 1)) (WHEN . (simple_statement . 1)) (EXCEPTION .
(simple_statement . 1)) (END . (simple_statement . 1)) (LESS_LESS .
(simple_statement . 1)) (IDENTIFIER . (simple_statement . 1)) (STRING_LITERAL .
(simple_statement . 1)) (CHARACTER_LITERAL . (simple_statement . 1)) (ACCEPT .
(simple_statement . 1)) (ABORT . (simple_statement . 1)) (BEGIN .
(simple_statement . 1)) (CASE . (simple_statement . 1)) (DECLARE . [...]
- ((default . error) (OR . (select_statement . 3)) (THEN .
(select_statement . 3)) (WHEN . (select_statement . 3)) (EXCEPTION .
(select_statement . 3)) (END . (select_statement . 3)) (LESS_LESS .
(select_statement . 3)) (IDENTIFIER . (select_statement . 3)) (STRING_LITERAL .
(select_statement . 3)) (CHARACTER_LITERAL . (select_statement . 3)) (ACCEPT .
(select_statement . 3)) (ABORT . (select_statement . 3)) (BEGIN .
(select_statement . 3)) (CASE . (select_statement . 3)) (DECLARE . [...]
- ((default . error) (OR . (compound_statement . 3)) (THEN .
(compound_statement . 3)) (WHEN . (compound_statement . 3)) (EXCEPTION .
(compound_statement . 3)) (END . (compound_statement . 3)) (LESS_LESS .
(compound_statement . 3)) (IDENTIFIER . (compound_statement . 3))
(STRING_LITERAL . (compound_statement . 3)) (CHARACTER_LITERAL .
(compound_statement . 3)) (ACCEPT . (compound_statement . 3)) (ABORT .
(compound_statement . 3)) (BEGIN . (compound_statement . 3)) (CASE .
(compound_s [...]
- ((default . error) (OR . (compound_statement . 1)) (THEN .
(compound_statement . 1)) (WHEN . (compound_statement . 1)) (EXCEPTION .
(compound_statement . 1)) (END . (compound_statement . 1)) (LESS_LESS .
(compound_statement . 1)) (IDENTIFIER . (compound_statement . 1))
(STRING_LITERAL . (compound_statement . 1)) (CHARACTER_LITERAL .
(compound_statement . 1)) (ACCEPT . (compound_statement . 1)) (ABORT .
(compound_statement . 1)) (BEGIN . (compound_statement . 1)) (CASE .
(compound_s [...]
- ((default . error) (OR . (select_statement . 2)) (THEN .
(select_statement . 2)) (WHEN . (select_statement . 2)) (EXCEPTION .
(select_statement . 2)) (END . (select_statement . 2)) (LESS_LESS .
(select_statement . 2)) (IDENTIFIER . (select_statement . 2)) (STRING_LITERAL .
(select_statement . 2)) (CHARACTER_LITERAL . (select_statement . 2)) (ACCEPT .
(select_statement . 2)) (ABORT . (select_statement . 2)) (BEGIN .
(select_statement . 2)) (CASE . (select_statement . 2)) (DECLARE . [...]
- ((default . error) (OR . (simple_statement . 7)) (THEN .
(simple_statement . 7)) (WHEN . (simple_statement . 7)) (EXCEPTION .
(simple_statement . 7)) (END . (simple_statement . 7)) (LESS_LESS .
(simple_statement . 7)) (IDENTIFIER . (simple_statement . 7)) (STRING_LITERAL .
(simple_statement . 7)) (CHARACTER_LITERAL . (simple_statement . 7)) (ACCEPT .
(simple_statement . 7)) (ABORT . (simple_statement . 7)) (BEGIN .
(simple_statement . 7)) (CASE . (simple_statement . 7)) (DECLARE . [...]
- ((default . error) (OR . (simple_statement . 2)) (THEN .
(simple_statement . 2)) (WHEN . (simple_statement . 2)) (EXCEPTION .
(simple_statement . 2)) (END . (simple_statement . 2)) (LESS_LESS .
(simple_statement . 2)) (IDENTIFIER . (simple_statement . 2)) (STRING_LITERAL .
(simple_statement . 2)) (CHARACTER_LITERAL . (simple_statement . 2)) (ACCEPT .
(simple_statement . 2)) (ABORT . (simple_statement . 2)) (BEGIN .
(simple_statement . 2)) (CASE . (simple_statement . 2)) (DECLARE . [...]
- ((default . error) (OR . (compound_statement . 4)) (THEN .
(compound_statement . 4)) (WHEN . (compound_statement . 4)) (EXCEPTION .
(compound_statement . 4)) (END . (compound_statement . 4)) (LESS_LESS .
(compound_statement . 4)) (IDENTIFIER . (compound_statement . 4))
(STRING_LITERAL . (compound_statement . 4)) (CHARACTER_LITERAL .
(compound_statement . 4)) (ACCEPT . (compound_statement . 4)) (ABORT .
(compound_statement . 4)) (BEGIN . (compound_statement . 4)) (CASE .
(compound_s [...]
- ((default . error) (END . 675))
- ((default . error) (OR . (compound_statement . 0)) (THEN .
(compound_statement . 0)) (WHEN . (compound_statement . 0)) (EXCEPTION .
(compound_statement . 0)) (END . (compound_statement . 0)) (LESS_LESS .
(compound_statement . 0)) (IDENTIFIER . (compound_statement . 0))
(STRING_LITERAL . (compound_statement . 0)) (CHARACTER_LITERAL .
(compound_statement . 0)) (ACCEPT . (compound_statement . 0)) (ABORT .
(compound_statement . 0)) (BEGIN . (compound_statement . 0)) (CASE .
(compound_s [...]
- ((default . error) (LOOP . 674))
- ((default . error) (NULL . 632) (GOTO . 629) (ABORT . 622) (ACCEPT .
621) (DECLARE . 625) (BEGIN . 623) (LOOP . 631) (CASE . 624) (IF . 630)
(PRAGMA . 7) (RAISE . 633) (DELAY . 626) (REQUEUE . 634) (RETURN . 635)
(EXIT . 627) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL .
49) (WHILE . 637) (FOR . 628) (SELECT . 636))
- ((default . error) (OR . (compound_statement . 2)) (THEN .
(compound_statement . 2)) (WHEN . (compound_statement . 2)) (EXCEPTION .
(compound_statement . 2)) (END . (compound_statement . 2)) (LESS_LESS .
(compound_statement . 2)) (IDENTIFIER . (compound_statement . 2))
(STRING_LITERAL . (compound_statement . 2)) (CHARACTER_LITERAL .
(compound_statement . 2)) (ACCEPT . (compound_statement . 2)) (ABORT .
(compound_statement . 2)) (BEGIN . (compound_statement . 2)) (CASE .
(compound_s [...]
- ((default . error) (DOT . 87) (SEMICOLON . 671) (TICK . 88)
(COLON_EQUAL . 670) (LEFT_PAREN . 106))
- ((default . error) (OR . (simple_statement . 10)) (THEN .
(simple_statement . 10)) (WHEN . (simple_statement . 10)) (EXCEPTION .
(simple_statement . 10)) (END . (simple_statement . 10)) (LESS_LESS .
(simple_statement . 10)) (IDENTIFIER . (simple_statement . 10)) (STRING_LITERAL
. (simple_statement . 10)) (CHARACTER_LITERAL . (simple_statement . 10))
(ACCEPT . (simple_statement . 10)) (ABORT . (simple_statement . 10)) (BEGIN .
(simple_statement . 10)) (CASE . (simple_statement . 10) [...]
- ((default . error) (OR . (simple_statement . 4)) (THEN .
(simple_statement . 4)) (WHEN . (simple_statement . 4)) (EXCEPTION .
(simple_statement . 4)) (END . (simple_statement . 4)) (LESS_LESS .
(simple_statement . 4)) (IDENTIFIER . (simple_statement . 4)) (STRING_LITERAL .
(simple_statement . 4)) (CHARACTER_LITERAL . (simple_statement . 4)) (ACCEPT .
(simple_statement . 4)) (ABORT . (simple_statement . 4)) (BEGIN .
(simple_statement . 4)) (CASE . (simple_statement . 4)) (DECLARE . [...]
- ((default . error) (OR . (simple_statement . 9)) (THEN .
(simple_statement . 9)) (WHEN . (simple_statement . 9)) (EXCEPTION .
(simple_statement . 9)) (END . (simple_statement . 9)) (LESS_LESS .
(simple_statement . 9)) (IDENTIFIER . (simple_statement . 9)) (STRING_LITERAL .
(simple_statement . 9)) (CHARACTER_LITERAL . (simple_statement . 9)) (ACCEPT .
(simple_statement . 9)) (ABORT . (simple_statement . 9)) (BEGIN .
(simple_statement . 9)) (CASE . (simple_statement . 9)) (DECLARE . [...]
- ((default . error) (OR . (simple_statement . 6)) (THEN .
(simple_statement . 6)) (WHEN . (simple_statement . 6)) (EXCEPTION .
(simple_statement . 6)) (END . (simple_statement . 6)) (LESS_LESS .
(simple_statement . 6)) (IDENTIFIER . (simple_statement . 6)) (STRING_LITERAL .
(simple_statement . 6)) (CHARACTER_LITERAL . (simple_statement . 6)) (ACCEPT .
(simple_statement . 6)) (ABORT . (simple_statement . 6)) (BEGIN .
(simple_statement . 6)) (CASE . (simple_statement . 6)) (DECLARE . [...]
- ((default . error) (OR . (select_statement . 0)) (THEN .
(select_statement . 0)) (WHEN . (select_statement . 0)) (EXCEPTION .
(select_statement . 0)) (END . (select_statement . 0)) (LESS_LESS .
(select_statement . 0)) (IDENTIFIER . (select_statement . 0)) (STRING_LITERAL .
(select_statement . 0)) (CHARACTER_LITERAL . (select_statement . 0)) (ACCEPT .
(select_statement . 0)) (ABORT . (select_statement . 0)) (BEGIN .
(select_statement . 0)) (CASE . (select_statement . 0)) (DECLARE . [...]
- ((default . error) (OR . (compound_statement . 6)) (THEN .
(compound_statement . 6)) (WHEN . (compound_statement . 6)) (EXCEPTION .
(compound_statement . 6)) (END . (compound_statement . 6)) (LESS_LESS .
(compound_statement . 6)) (IDENTIFIER . (compound_statement . 6))
(STRING_LITERAL . (compound_statement . 6)) (CHARACTER_LITERAL .
(compound_statement . 6)) (ACCEPT . (compound_statement . 6)) (ABORT .
(compound_statement . 6)) (BEGIN . (compound_statement . 6)) (CASE .
(compound_s [...]
- ((default . error) (WHEN . (sequence_of_statements_opt . 1)) (THEN .
(sequence_of_statements_opt . 1)) (OR . (sequence_of_statements_opt . 1))
(ELSIF . (sequence_of_statements_opt . 1)) (ELSE . (sequence_of_statements_opt
. 1)) (END . (sequence_of_statements_opt . 1)) (EXCEPTION .
(sequence_of_statements_opt . 1)) (ACCEPT . (label_opt . 0)) (BEGIN .
(label_opt . 0)) (CASE . (label_opt . 0)) (DECLARE . (label_opt . 0)) (FOR .
(label_opt . 0)) (IF . (label_opt . 0)) (LOOP . (label_op [...]
- ((default . error) (END . (handled_sequence_of_statements . 1))
(EXCEPTION . 668))
- ((default . error) (OR . (simple_statement . 5)) (THEN .
(simple_statement . 5)) (WHEN . (simple_statement . 5)) (EXCEPTION .
(simple_statement . 5)) (END . (simple_statement . 5)) (LESS_LESS .
(simple_statement . 5)) (IDENTIFIER . (simple_statement . 5)) (STRING_LITERAL .
(simple_statement . 5)) (CHARACTER_LITERAL . (simple_statement . 5)) (ACCEPT .
(simple_statement . 5)) (ABORT . (simple_statement . 5)) (BEGIN .
(simple_statement . 5)) (CASE . (simple_statement . 5)) (DECLARE . [...]
- ((default . error) (WHEN . (sequence_of_statements . 0)) (THEN .
(sequence_of_statements . 0)) (OR . (sequence_of_statements . 0)) (ELSIF .
(sequence_of_statements . 0)) (ELSE . (sequence_of_statements . 0)) (EXCEPTION
. (sequence_of_statements . 0)) (END . (sequence_of_statements . 0)) (LESS_LESS
. (sequence_of_statements . 0)) (IDENTIFIER . (sequence_of_statements . 0))
(STRING_LITERAL . (sequence_of_statements . 0)) (CHARACTER_LITERAL .
(sequence_of_statements . 0)) (ACCEPT . (s [...]
- ((default . error) (OR . (select_statement . 1)) (THEN .
(select_statement . 1)) (WHEN . (select_statement . 1)) (EXCEPTION .
(select_statement . 1)) (END . (select_statement . 1)) (LESS_LESS .
(select_statement . 1)) (IDENTIFIER . (select_statement . 1)) (STRING_LITERAL .
(select_statement . 1)) (CHARACTER_LITERAL . (select_statement . 1)) (ACCEPT .
(select_statement . 1)) (ABORT . (select_statement . 1)) (BEGIN .
(select_statement . 1)) (CASE . (select_statement . 1)) (DECLARE . [...]
- ((default . error) (SEMICOLON . 667))
- ((default . error) (SEMICOLON . 666))
- ((default . error) (TYPE . (generic_instantiation . 2)) (TASK .
(generic_instantiation . 2)) (SUBTYPE . (generic_instantiation . 2)) (PROTECTED
. (generic_instantiation . 2)) (FOR . (generic_instantiation . 2)) (ENTRY .
(generic_instantiation . 2)) (IDENTIFIER . (generic_instantiation . 2)) (BEGIN
. (generic_instantiation . 2)) (END . (generic_instantiation . 2)) (WITH .
(generic_instantiation . 2)) (USE . (generic_instantiation . 2)) (SEPARATE .
(generic_instantiation . 2)) (PROCE [...]
- ((default . error) (TYPE . (generic_instantiation . 1)) (TASK .
(generic_instantiation . 1)) (SUBTYPE . (generic_instantiation . 1)) (PROTECTED
. (generic_instantiation . 1)) (FOR . (generic_instantiation . 1)) (ENTRY .
(generic_instantiation . 1)) (IDENTIFIER . (generic_instantiation . 1)) (BEGIN
. (generic_instantiation . 1)) (END . (generic_instantiation . 1)) (WITH .
(generic_instantiation . 1)) (USE . (generic_instantiation . 1)) (SEPARATE .
(generic_instantiation . 1)) (PROCE [...]
- ((default . error) (END . (exception_handler_list_opt . 0)) (WHEN .
940))
- ((default . error) (OR . (sequence_of_statements . 1)) (THEN .
(sequence_of_statements . 1)) (WHEN . (sequence_of_statements . 1)) (WHILE .
(sequence_of_statements . 1)) (SELECT . (sequence_of_statements . 1)) (RETURN .
(sequence_of_statements . 1)) (REQUEUE . (sequence_of_statements . 1)) (RAISE .
(sequence_of_statements . 1)) (PRAGMA . (sequence_of_statements . 1)) (NULL .
(sequence_of_statements . 1)) (LOOP . (sequence_of_statements . 1)) (IF .
(sequence_of_statements . 1)) (GOT [...]
- ((default . error) (RAISE . 152) (PLUS . 144) (MINUS . 143) (ABS .
147) (NOT . 150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
- ((default . error) (WHEN . (procedure_call_statement . 0)) (OR .
(procedure_call_statement . 0)) (THEN . (procedure_call_statement . 0)) (ELSIF
. (procedure_call_statement . 0)) (ELSE . (procedure_call_statement . 0))
(WHILE . (procedure_call_statement . 0)) (SELECT . (procedure_call_statement .
0)) (RETURN . (procedure_call_statement . 0)) (REQUEUE .
(procedure_call_statement . 0)) (RAISE . (procedure_call_statement . 0))
(PRAGMA . (procedure_call_statement . 0)) (NULL . (procedur [...]
- ((default . error) (OR . (statement . 1)) (THEN . (statement . 1)) (WHEN
. (statement . 1)) (EXCEPTION . (statement . 1)) (END . (statement . 1))
(LESS_LESS . (statement . 1)) (IDENTIFIER . (statement . 1)) (STRING_LITERAL .
(statement . 1)) (CHARACTER_LITERAL . (statement . 1)) (ACCEPT . (statement .
1)) (ABORT . (statement . 1)) (BEGIN . (statement . 1)) (CASE . (statement .
1)) (DECLARE . (statement . 1)) (DELAY . (statement . 1)) (EXIT . (statement .
1)) (FOR . (statement . 1)) [...]
- ((default . error) (OR . (statement . 0)) (THEN . (statement . 0)) (WHEN
. (statement . 0)) (EXCEPTION . (statement . 0)) (END . (statement . 0))
(LESS_LESS . (statement . 0)) (IDENTIFIER . (statement . 0)) (STRING_LITERAL .
(statement . 0)) (CHARACTER_LITERAL . (statement . 0)) (ACCEPT . (statement .
0)) (ABORT . (statement . 0)) (BEGIN . (statement . 0)) (CASE . (statement .
0)) (DECLARE . (statement . 0)) (DELAY . (statement . 0)) (EXIT . (statement .
0)) (FOR . (statement . 0)) [...]
- ((default . error) (END . (sequence_of_statements_opt . 0)) (ACCEPT .
(label_opt . 0)) (BEGIN . (label_opt . 0)) (CASE . (label_opt . 0)) (DECLARE .
(label_opt . 0)) (FOR . (label_opt . 0)) (IF . (label_opt . 0)) (LOOP .
(label_opt . 0)) (RETURN . (label_opt . 0)) (SELECT . (label_opt . 0)) (WHILE .
(label_opt . 0)) (STRING_LITERAL . (label_opt . 0)) (CHARACTER_LITERAL .
(label_opt . 0)) (ABORT . (label_opt . 0)) (DELAY . (label_opt . 0)) (EXIT .
(label_opt . 0)) (GOTO . (label_opt [...]
+ ((default . error) (SEMICOLON . 702) (DO .
(extended_return_object_declaration_opt . 0)) (RAISE . 152) (PLUS . 154)
(MINUS . 153) (ABS . 144) (NOT . 150) (NUMERIC_LITERAL . 155) (NULL . 151)
(NEW . 149) (IDENTIFIER . 703) (CHARACTER_LITERAL . 50) (STRING_LITERAL .
49) (LEFT_PAREN . 148))
+ ((default . error) (ELSE . (select_alternative_list_opt . 0)) (END .
(select_alternative_list_opt . 0)) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49) (DELAY . 635) (WHEN . 691) (TERMINATE . 690) (ACCEPT
. 630))
+ ((default . error) (LOOP . (expression_opt . 0)) (RAISE . 152) (PLUS .
154) (MINUS . 153) (ABS . 144) (NOT . 150) (NUMERIC_LITERAL . 155) (NULL .
151) (NEW . 149) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL
. 49) (LEFT_PAREN . 148))
+ ((default . error) (IDENTIFIER . 688))
+ ((default . error) (COLON . 687))
+ ((default . error) (OR . (compound_statement . 5)) (THEN .
(compound_statement . 5)) (WHEN . (compound_statement . 5)) (EXCEPTION .
(compound_statement . 5)) (END . (compound_statement . 5)) (ACCEPT .
(compound_statement . 5)) (ABORT . (compound_statement . 5)) (BEGIN .
(compound_statement . 5)) (CASE . (compound_statement . 5)) (DECLARE .
(compound_statement . 5)) (DELAY . (compound_statement . 5)) (EXIT .
(compound_statement . 5)) (FOR . (compound_statement . 5)) (GOTO . (compoun
[...]
+ ((default . error) (OR . (simple_statement . 1)) (THEN .
(simple_statement . 1)) (WHEN . (simple_statement . 1)) (EXCEPTION .
(simple_statement . 1)) (END . (simple_statement . 1)) (ACCEPT .
(simple_statement . 1)) (ABORT . (simple_statement . 1)) (BEGIN .
(simple_statement . 1)) (CASE . (simple_statement . 1)) (DECLARE .
(simple_statement . 1)) (DELAY . (simple_statement . 1)) (EXIT .
(simple_statement . 1)) (FOR . (simple_statement . 1)) (GOTO .
(simple_statement . 1)) (IF . (sim [...]
+ ((default . error) (OR . (select_statement . 3)) (THEN .
(select_statement . 3)) (WHEN . (select_statement . 3)) (EXCEPTION .
(select_statement . 3)) (END . (select_statement . 3)) (ACCEPT .
(select_statement . 3)) (ABORT . (select_statement . 3)) (BEGIN .
(select_statement . 3)) (CASE . (select_statement . 3)) (DECLARE .
(select_statement . 3)) (DELAY . (select_statement . 3)) (EXIT .
(select_statement . 3)) (FOR . (select_statement . 3)) (GOTO .
(select_statement . 3)) (IF . (sel [...]
+ ((default . error) (OR . (compound_statement . 3)) (THEN .
(compound_statement . 3)) (WHEN . (compound_statement . 3)) (EXCEPTION .
(compound_statement . 3)) (END . (compound_statement . 3)) (ACCEPT .
(compound_statement . 3)) (ABORT . (compound_statement . 3)) (BEGIN .
(compound_statement . 3)) (CASE . (compound_statement . 3)) (DECLARE .
(compound_statement . 3)) (DELAY . (compound_statement . 3)) (EXIT .
(compound_statement . 3)) (FOR . (compound_statement . 3)) (GOTO . (compoun
[...]
+ ((default . error) (OR . (compound_statement . 1)) (THEN .
(compound_statement . 1)) (WHEN . (compound_statement . 1)) (EXCEPTION .
(compound_statement . 1)) (END . (compound_statement . 1)) (ACCEPT .
(compound_statement . 1)) (ABORT . (compound_statement . 1)) (BEGIN .
(compound_statement . 1)) (CASE . (compound_statement . 1)) (DECLARE .
(compound_statement . 1)) (DELAY . (compound_statement . 1)) (EXIT .
(compound_statement . 1)) (FOR . (compound_statement . 1)) (GOTO . (compoun
[...]
+ ((default . error) (OR . (select_statement . 2)) (THEN .
(select_statement . 2)) (WHEN . (select_statement . 2)) (EXCEPTION .
(select_statement . 2)) (END . (select_statement . 2)) (ACCEPT .
(select_statement . 2)) (ABORT . (select_statement . 2)) (BEGIN .
(select_statement . 2)) (CASE . (select_statement . 2)) (DECLARE .
(select_statement . 2)) (DELAY . (select_statement . 2)) (EXIT .
(select_statement . 2)) (FOR . (select_statement . 2)) (GOTO .
(select_statement . 2)) (IF . (sel [...]
+ ((default . error) (OR . (simple_statement . 7)) (THEN .
(simple_statement . 7)) (WHEN . (simple_statement . 7)) (EXCEPTION .
(simple_statement . 7)) (END . (simple_statement . 7)) (ACCEPT .
(simple_statement . 7)) (ABORT . (simple_statement . 7)) (BEGIN .
(simple_statement . 7)) (CASE . (simple_statement . 7)) (DECLARE .
(simple_statement . 7)) (DELAY . (simple_statement . 7)) (EXIT .
(simple_statement . 7)) (FOR . (simple_statement . 7)) (GOTO .
(simple_statement . 7)) (IF . (sim [...]
+ ((default . error) (OR . (simple_statement . 2)) (THEN .
(simple_statement . 2)) (WHEN . (simple_statement . 2)) (EXCEPTION .
(simple_statement . 2)) (END . (simple_statement . 2)) (ACCEPT .
(simple_statement . 2)) (ABORT . (simple_statement . 2)) (BEGIN .
(simple_statement . 2)) (CASE . (simple_statement . 2)) (DECLARE .
(simple_statement . 2)) (DELAY . (simple_statement . 2)) (EXIT .
(simple_statement . 2)) (FOR . (simple_statement . 2)) (GOTO .
(simple_statement . 2)) (IF . (sim [...]
+ ((default . error) (OR . (compound_statement . 4)) (THEN .
(compound_statement . 4)) (WHEN . (compound_statement . 4)) (EXCEPTION .
(compound_statement . 4)) (END . (compound_statement . 4)) (ACCEPT .
(compound_statement . 4)) (ABORT . (compound_statement . 4)) (BEGIN .
(compound_statement . 4)) (CASE . (compound_statement . 4)) (DECLARE .
(compound_statement . 4)) (DELAY . (compound_statement . 4)) (EXIT .
(compound_statement . 4)) (FOR . (compound_statement . 4)) (GOTO . (compoun
[...]
+ ((default . error) (END . 686))
+ ((default . error) (OR . (compound_statement . 0)) (THEN .
(compound_statement . 0)) (WHEN . (compound_statement . 0)) (EXCEPTION .
(compound_statement . 0)) (END . (compound_statement . 0)) (ACCEPT .
(compound_statement . 0)) (ABORT . (compound_statement . 0)) (BEGIN .
(compound_statement . 0)) (CASE . (compound_statement . 0)) (DECLARE .
(compound_statement . 0)) (DELAY . (compound_statement . 0)) (EXIT .
(compound_statement . 0)) (FOR . (compound_statement . 0)) (GOTO . (compoun
[...]
+ ((default . error) (LOOP . 685))
+ ((default . error) (NULL . 641) (GOTO . 638) (ABORT . 631) (ACCEPT .
630) (DECLARE . 634) (BEGIN . 632) (LOOP . 640) (CASE . 633) (IF . 639)
(PRAGMA . 7) (RAISE . 642) (DELAY . 635) (REQUEUE . 643) (RETURN . 644)
(EXIT . 636) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL .
49) (WHILE . 646) (FOR . 637) (SELECT . 645))
+ ((default . error) (OR . (compound_statement . 2)) (THEN .
(compound_statement . 2)) (WHEN . (compound_statement . 2)) (EXCEPTION .
(compound_statement . 2)) (END . (compound_statement . 2)) (ACCEPT .
(compound_statement . 2)) (ABORT . (compound_statement . 2)) (BEGIN .
(compound_statement . 2)) (CASE . (compound_statement . 2)) (DECLARE .
(compound_statement . 2)) (DELAY . (compound_statement . 2)) (EXIT .
(compound_statement . 2)) (FOR . (compound_statement . 2)) (GOTO . (compoun
[...]
+ ((default . error) (DOT . 90) (SEMICOLON . 682) (TICK . 91)
(COLON_EQUAL . 681) (LEFT_PAREN . 107))
+ ((default . error) (OR . (simple_statement . 10)) (THEN .
(simple_statement . 10)) (WHEN . (simple_statement . 10)) (EXCEPTION .
(simple_statement . 10)) (END . (simple_statement . 10)) (ACCEPT .
(simple_statement . 10)) (ABORT . (simple_statement . 10)) (BEGIN .
(simple_statement . 10)) (CASE . (simple_statement . 10)) (DECLARE .
(simple_statement . 10)) (DELAY . (simple_statement . 10)) (EXIT .
(simple_statement . 10)) (FOR . (simple_statement . 10)) (GOTO .
(simple_statement . 1 [...]
+ ((default . error) (OR . (simple_statement . 4)) (THEN .
(simple_statement . 4)) (WHEN . (simple_statement . 4)) (EXCEPTION .
(simple_statement . 4)) (END . (simple_statement . 4)) (ACCEPT .
(simple_statement . 4)) (ABORT . (simple_statement . 4)) (BEGIN .
(simple_statement . 4)) (CASE . (simple_statement . 4)) (DECLARE .
(simple_statement . 4)) (DELAY . (simple_statement . 4)) (EXIT .
(simple_statement . 4)) (FOR . (simple_statement . 4)) (GOTO .
(simple_statement . 4)) (IF . (sim [...]
+ ((default . error) (OR . (simple_statement . 9)) (THEN .
(simple_statement . 9)) (WHEN . (simple_statement . 9)) (EXCEPTION .
(simple_statement . 9)) (END . (simple_statement . 9)) (ACCEPT .
(simple_statement . 9)) (ABORT . (simple_statement . 9)) (BEGIN .
(simple_statement . 9)) (CASE . (simple_statement . 9)) (DECLARE .
(simple_statement . 9)) (DELAY . (simple_statement . 9)) (EXIT .
(simple_statement . 9)) (FOR . (simple_statement . 9)) (GOTO .
(simple_statement . 9)) (IF . (sim [...]
+ ((default . error) (OR . (simple_statement . 6)) (THEN .
(simple_statement . 6)) (WHEN . (simple_statement . 6)) (EXCEPTION .
(simple_statement . 6)) (END . (simple_statement . 6)) (ACCEPT .
(simple_statement . 6)) (ABORT . (simple_statement . 6)) (BEGIN .
(simple_statement . 6)) (CASE . (simple_statement . 6)) (DECLARE .
(simple_statement . 6)) (DELAY . (simple_statement . 6)) (EXIT .
(simple_statement . 6)) (FOR . (simple_statement . 6)) (GOTO .
(simple_statement . 6)) (IF . (sim [...]
+ ((default . error) (OR . (select_statement . 0)) (THEN .
(select_statement . 0)) (WHEN . (select_statement . 0)) (EXCEPTION .
(select_statement . 0)) (END . (select_statement . 0)) (ACCEPT .
(select_statement . 0)) (ABORT . (select_statement . 0)) (BEGIN .
(select_statement . 0)) (CASE . (select_statement . 0)) (DECLARE .
(select_statement . 0)) (DELAY . (select_statement . 0)) (EXIT .
(select_statement . 0)) (FOR . (select_statement . 0)) (GOTO .
(select_statement . 0)) (IF . (sel [...]
+ ((default . error) (OR . (compound_statement . 6)) (THEN .
(compound_statement . 6)) (WHEN . (compound_statement . 6)) (EXCEPTION .
(compound_statement . 6)) (END . (compound_statement . 6)) (ACCEPT .
(compound_statement . 6)) (ABORT . (compound_statement . 6)) (BEGIN .
(compound_statement . 6)) (CASE . (compound_statement . 6)) (DECLARE .
(compound_statement . 6)) (DELAY . (compound_statement . 6)) (EXIT .
(compound_statement . 6)) (FOR . (compound_statement . 6)) (GOTO . (compoun
[...]
+ ((default . error) (WHEN . (sequence_of_statements_opt . 1)) (THEN .
(sequence_of_statements_opt . 1)) (OR . (sequence_of_statements_opt . 1))
(ELSIF . (sequence_of_statements_opt . 1)) (ELSE . (sequence_of_statements_opt
. 1)) (END . (sequence_of_statements_opt . 1)) (EXCEPTION .
(sequence_of_statements_opt . 1)) (ACCEPT . (label_opt . 0)) (BEGIN .
(label_opt . 0)) (CASE . (label_opt . 0)) (DECLARE . (label_opt . 0)) (FOR .
(label_opt . 0)) (IF . (label_opt . 0)) (LOOP . (label_op [...]
+ ((default . error) (END . (handled_sequence_of_statements . 1))
(EXCEPTION . 679))
+ ((default . error) (OR . (simple_statement . 5)) (THEN .
(simple_statement . 5)) (WHEN . (simple_statement . 5)) (EXCEPTION .
(simple_statement . 5)) (END . (simple_statement . 5)) (ACCEPT .
(simple_statement . 5)) (ABORT . (simple_statement . 5)) (BEGIN .
(simple_statement . 5)) (CASE . (simple_statement . 5)) (DECLARE .
(simple_statement . 5)) (DELAY . (simple_statement . 5)) (EXIT .
(simple_statement . 5)) (FOR . (simple_statement . 5)) (GOTO .
(simple_statement . 5)) (IF . (sim [...]
+ ((default . error) (WHEN . (sequence_of_statements . 0)) (THEN .
(sequence_of_statements . 0)) (OR . (sequence_of_statements . 0)) (ELSIF .
(sequence_of_statements . 0)) (ELSE . (sequence_of_statements . 0)) (EXCEPTION
. (sequence_of_statements . 0)) (END . (sequence_of_statements . 0)) (ACCEPT .
(sequence_of_statements . 0)) (ABORT . (sequence_of_statements . 0)) (BEGIN .
(sequence_of_statements . 0)) (CASE . (sequence_of_statements . 0)) (DECLARE .
(sequence_of_statements . 0)) ( [...]
+ ((default . error) (OR . (select_statement . 1)) (THEN .
(select_statement . 1)) (WHEN . (select_statement . 1)) (EXCEPTION .
(select_statement . 1)) (END . (select_statement . 1)) (ACCEPT .
(select_statement . 1)) (ABORT . (select_statement . 1)) (BEGIN .
(select_statement . 1)) (CASE . (select_statement . 1)) (DECLARE .
(select_statement . 1)) (DELAY . (select_statement . 1)) (EXIT .
(select_statement . 1)) (FOR . (select_statement . 1)) (GOTO .
(select_statement . 1)) (IF . (sel [...]
+ ((default . error) (SEMICOLON . 678))
+ ((default . error) (SEMICOLON . 677))
+ ((default . error) (IDENTIFIER . (generic_instantiation . 2)) (TYPE .
(generic_instantiation . 2)) (TASK . (generic_instantiation . 2)) (SUBTYPE .
(generic_instantiation . 2)) (PROTECTED . (generic_instantiation . 2)) (FOR .
(generic_instantiation . 2)) (ENTRY . (generic_instantiation . 2)) (BEGIN .
(generic_instantiation . 2)) (END . (generic_instantiation . 2)) (WITH .
(generic_instantiation . 2)) (USE . (generic_instantiation . 2)) (SEPARATE .
(generic_instantiation . 2)) (PROCE [...]
+ ((default . error) (IDENTIFIER . (generic_instantiation . 1)) (TYPE .
(generic_instantiation . 1)) (TASK . (generic_instantiation . 1)) (SUBTYPE .
(generic_instantiation . 1)) (PROTECTED . (generic_instantiation . 1)) (FOR .
(generic_instantiation . 1)) (ENTRY . (generic_instantiation . 1)) (BEGIN .
(generic_instantiation . 1)) (END . (generic_instantiation . 1)) (WITH .
(generic_instantiation . 1)) (USE . (generic_instantiation . 1)) (SEPARATE .
(generic_instantiation . 1)) (PROCE [...]
+ ((default . error) (END . (exception_handler_list_opt . 0)) (WHEN .
950))
+ ((default . error) (OR . (sequence_of_statements . 1)) (THEN .
(sequence_of_statements . 1)) (WHEN . (sequence_of_statements . 1))
(CHARACTER_LITERAL . (sequence_of_statements . 1)) (STRING_LITERAL .
(sequence_of_statements . 1)) (IDENTIFIER . (sequence_of_statements . 1))
(LESS_LESS . (sequence_of_statements . 1)) (WHILE . (sequence_of_statements .
1)) (SELECT . (sequence_of_statements . 1)) (RETURN . (sequence_of_statements .
1)) (REQUEUE . (sequence_of_statements . 1)) (RAISE . [...]
+ ((default . error) (RAISE . 152) (PLUS . 154) (MINUS . 153) (ABS .
144) (NOT . 150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
+ ((default . error) (WHEN . (procedure_call_statement . 0)) (OR .
(procedure_call_statement . 0)) (THEN . (procedure_call_statement . 0)) (ELSIF
. (procedure_call_statement . 0)) (ELSE . (procedure_call_statement . 0))
(CHARACTER_LITERAL . (procedure_call_statement . 0)) (STRING_LITERAL .
(procedure_call_statement . 0)) (IDENTIFIER . (procedure_call_statement . 0))
(LESS_LESS . (procedure_call_statement . 0)) (WHILE . (procedure_call_statement
. 0)) (SELECT . (procedure_call_stateme [...]
+ ((default . error) (OR . (statement . 1)) (THEN . (statement . 1)) (WHEN
. (statement . 1)) (EXCEPTION . (statement . 1)) (END . (statement . 1))
(ACCEPT . (statement . 1)) (ABORT . (statement . 1)) (BEGIN . (statement . 1))
(CASE . (statement . 1)) (DECLARE . (statement . 1)) (DELAY . (statement . 1))
(EXIT . (statement . 1)) (FOR . (statement . 1)) (GOTO . (statement . 1)) (IF .
(statement . 1)) (LOOP . (statement . 1)) (NULL . (statement . 1)) (PRAGMA .
(statement . 1)) (RAISE . [...]
+ ((default . error) (OR . (statement . 0)) (THEN . (statement . 0)) (WHEN
. (statement . 0)) (EXCEPTION . (statement . 0)) (END . (statement . 0))
(ACCEPT . (statement . 0)) (ABORT . (statement . 0)) (BEGIN . (statement . 0))
(CASE . (statement . 0)) (DECLARE . (statement . 0)) (DELAY . (statement . 0))
(EXIT . (statement . 0)) (FOR . (statement . 0)) (GOTO . (statement . 0)) (IF .
(statement . 0)) (LOOP . (statement . 0)) (NULL . (statement . 0)) (PRAGMA .
(statement . 0)) (RAISE . [...]
+ ((default . error) (END . (sequence_of_statements_opt . 0)) (ACCEPT .
(label_opt . 0)) (BEGIN . (label_opt . 0)) (CASE . (label_opt . 0)) (DECLARE .
(label_opt . 0)) (FOR . (label_opt . 0)) (IF . (label_opt . 0)) (LOOP .
(label_opt . 0)) (RETURN . (label_opt . 0)) (SELECT . (label_opt . 0)) (WHILE .
(label_opt . 0)) (ABORT . (label_opt . 0)) (DELAY . (label_opt . 0)) (EXIT .
(label_opt . 0)) (GOTO . (label_opt . 0)) (NULL . (label_opt . 0)) (PRAGMA .
(label_opt . 0)) (RAISE . (labe [...]
((default . error) (SEMICOLON . (name_opt . 0)) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49))
+ ((default . error) (CHARACTER_LITERAL . (label_opt . 2)) (STRING_LITERAL
. (label_opt . 2)) (IDENTIFIER . (label_opt . 2)) (REQUEUE . (label_opt . 2))
(RAISE . (label_opt . 2)) (PRAGMA . (label_opt . 2)) (NULL . (label_opt . 2))
(GOTO . (label_opt . 2)) (EXIT . (label_opt . 2)) (DELAY . (label_opt . 2))
(ABORT . (label_opt . 2)) (WHILE . (label_opt . 2)) (SELECT . (label_opt . 2))
(RETURN . (label_opt . 2)) (LOOP . (label_opt . 2)) (IF . (label_opt . 2)) (FOR
. (label_opt . 2)) (DE [...]
+ ((default . error) (GREATER_GREATER . 946))
((default . error) (LOOP . (iteration_scheme . 0)))
- ((default . error) (SEMICOLON . 936))
- ((default . error) (RAISE . 152) (PLUS . 144) (MINUS . 143) (ABS .
147) (NOT . 150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
- ((default . error) (END . (sequence_of_statements_opt . 0)) (OR .
(sequence_of_statements_opt . 0)) (ELSE . (sequence_of_statements_opt . 0))
(ACCEPT . (label_opt . 0)) (BEGIN . (label_opt . 0)) (CASE . (label_opt . 0))
(DECLARE . (label_opt . 0)) (FOR . (label_opt . 0)) (IF . (label_opt . 0))
(LOOP . (label_opt . 0)) (RETURN . (label_opt . 0)) (SELECT . (label_opt . 0))
(WHILE . (label_opt . 0)) (STRING_LITERAL . (label_opt . 0)) (CHARACTER_LITERAL
. (label_opt . 0)) (ABORT . (lab [...]
+ ((default . error) (SEMICOLON . 945))
+ ((default . error) (RAISE . 152) (PLUS . 154) (MINUS . 153) (ABS .
144) (NOT . 150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
+ ((default . error) (END . (sequence_of_statements_opt . 0)) (OR .
(sequence_of_statements_opt . 0)) (ELSE . (sequence_of_statements_opt . 0))
(ACCEPT . (label_opt . 0)) (BEGIN . (label_opt . 0)) (CASE . (label_opt . 0))
(DECLARE . (label_opt . 0)) (FOR . (label_opt . 0)) (IF . (label_opt . 0))
(LOOP . (label_opt . 0)) (RETURN . (label_opt . 0)) (SELECT . (label_opt . 0))
(WHILE . (label_opt . 0)) (ABORT . (label_opt . 0)) (DELAY . (label_opt . 0))
(EXIT . (label_opt . 0)) (GOTO . ( [...]
((default . error) (ELSE . (select_alternative . 3)) (OR .
(select_alternative . 3)) (END . (select_alternative . 3)))
- ((default . error) (OR . (sequence_of_statements_opt . 0)) (END .
(sequence_of_statements_opt . 0)) (ELSE . (sequence_of_statements_opt . 0))
(THEN . (sequence_of_statements_opt . 0)) (ACCEPT . (label_opt . 0)) (BEGIN .
(label_opt . 0)) (CASE . (label_opt . 0)) (DECLARE . (label_opt . 0)) (FOR .
(label_opt . 0)) (IF . (label_opt . 0)) (LOOP . (label_opt . 0)) (RETURN .
(label_opt . 0)) (SELECT . (label_opt . 0)) (WHILE . (label_opt . 0))
(STRING_LITERAL . (label_opt . 0)) (CHARACTE [...]
- ((default . error) (ELSE . 931) (OR . 932))
- ((default . error) (DOT . 87) (SEMICOLON . 671) (TICK . 88) (OR .
(sequence_of_statements_opt . 0)) (ELSE . (sequence_of_statements_opt . 0))
(THEN . (sequence_of_statements_opt . 0)) (LEFT_PAREN . 106) (ACCEPT .
(label_opt . 0)) (BEGIN . (label_opt . 0)) (CASE . (label_opt . 0)) (DECLARE .
(label_opt . 0)) (FOR . (label_opt . 0)) (IF . (label_opt . 0)) (LOOP .
(label_opt . 0)) (RETURN . (label_opt . 0)) (SELECT . (label_opt . 0)) (WHILE .
(label_opt . 0)) (STRING_LITERAL . (la [...]
- ((default . error) (OR . (sequence_of_statements_opt . 0)) (ELSE .
(sequence_of_statements_opt . 0)) (THEN . (sequence_of_statements_opt . 0))
(ACCEPT . (label_opt . 0)) (BEGIN . (label_opt . 0)) (CASE . (label_opt . 0))
(DECLARE . (label_opt . 0)) (FOR . (label_opt . 0)) (IF . (label_opt . 0))
(LOOP . (label_opt . 0)) (RETURN . (label_opt . 0)) (SELECT . (label_opt . 0))
(WHILE . (label_opt . 0)) (STRING_LITERAL . (label_opt . 0)) (CHARACTER_LITERAL
. (label_opt . 0)) (ABORT . (la [...]
+ ((default . error) (OR . (sequence_of_statements_opt . 0)) (END .
(sequence_of_statements_opt . 0)) (ELSE . (sequence_of_statements_opt . 0))
(THEN . (sequence_of_statements_opt . 0)) (ACCEPT . (label_opt . 0)) (BEGIN .
(label_opt . 0)) (CASE . (label_opt . 0)) (DECLARE . (label_opt . 0)) (FOR .
(label_opt . 0)) (IF . (label_opt . 0)) (LOOP . (label_opt . 0)) (RETURN .
(label_opt . 0)) (SELECT . (label_opt . 0)) (WHILE . (label_opt . 0)) (ABORT .
(label_opt . 0)) (DELAY . (label_op [...]
+ ((default . error) (ELSE . 940) (OR . 941))
+ ((default . error) (DOT . 90) (SEMICOLON . 682) (TICK . 91) (OR .
(sequence_of_statements_opt . 0)) (ELSE . (sequence_of_statements_opt . 0))
(THEN . (sequence_of_statements_opt . 0)) (LEFT_PAREN . 107) (ACCEPT .
(label_opt . 0)) (BEGIN . (label_opt . 0)) (CASE . (label_opt . 0)) (DECLARE .
(label_opt . 0)) (FOR . (label_opt . 0)) (IF . (label_opt . 0)) (LOOP .
(label_opt . 0)) (RETURN . (label_opt . 0)) (SELECT . (label_opt . 0)) (WHILE .
(label_opt . 0)) (ABORT . (label_opt . [...]
+ ((default . error) (OR . (sequence_of_statements_opt . 0)) (ELSE .
(sequence_of_statements_opt . 0)) (THEN . (sequence_of_statements_opt . 0))
(ACCEPT . (label_opt . 0)) (BEGIN . (label_opt . 0)) (CASE . (label_opt . 0))
(DECLARE . (label_opt . 0)) (FOR . (label_opt . 0)) (IF . (label_opt . 0))
(LOOP . (label_opt . 0)) (RETURN . (label_opt . 0)) (SELECT . (label_opt . 0))
(WHILE . (label_opt . 0)) (ABORT . (label_opt . 0)) (DELAY . (label_opt . 0))
(EXIT . (label_opt . 0)) (GOTO . [...]
((default . error) (ELSE . (select_alternative_list . 0)) (END .
(select_alternative_list . 0)) (OR . (select_alternative_list . 0)))
- ((default . error) (ELSE . (select_alternative_list_opt . 1)) (END .
(select_alternative_list_opt . 1)) (OR . 928))
- ((default . error) (ELSE . 926) (END . 927))
- ((default . error) (THEN . 925))
- ((default . error) (WHEN . (simple_return_statement . 0)) (THEN .
(simple_return_statement . 0)) (OR . (simple_return_statement . 0)) (ELSIF .
(simple_return_statement . 0)) (ELSE . (simple_return_statement . 0)) (WHILE .
(simple_return_statement . 0)) (SELECT . (simple_return_statement . 0)) (RETURN
. (simple_return_statement . 0)) (REQUEUE . (simple_return_statement . 0))
(RAISE . (simple_return_statement . 0)) (PRAGMA . (simple_return_statement .
0)) (NULL . (simple_return_state [...]
- ((default . error) (COLON . 924) (STAR_STAR . (name . 0)) (REM . (name
. 0)) (MOD . (name . 0)) (STAR . (name . 0)) (SLASH . (name . 0)) (SEMICOLON .
(name . 0)) (SLASH_EQUAL . (name . 0)) (LESS_EQUAL . (name . 0)) (LESS . (name
. 0)) (GREATER_EQUAL . (name . 0)) (GREATER . (name . 0)) (EQUAL . (name . 0))
(NOT . (name . 0)) (IN . (name . 0)) (AMPERSAND . (name . 0)) (MINUS . (name .
0)) (PLUS . (name . 0)) (LEFT_PAREN . (name . 0)) (AND . (name . 0)) (OR .
(name . 0)) (XOR . (nam [...]
+ ((default . error) (ELSE . (select_alternative_list_opt . 1)) (END .
(select_alternative_list_opt . 1)) (OR . 937))
+ ((default . error) (ELSE . 935) (END . 936))
+ ((default . error) (THEN . 934))
+ ((default . error) (WHEN . (simple_return_statement . 0)) (THEN .
(simple_return_statement . 0)) (OR . (simple_return_statement . 0)) (ELSIF .
(simple_return_statement . 0)) (ELSE . (simple_return_statement . 0))
(CHARACTER_LITERAL . (simple_return_statement . 0)) (STRING_LITERAL .
(simple_return_statement . 0)) (IDENTIFIER . (simple_return_statement . 0))
(LESS_LESS . (simple_return_statement . 0)) (WHILE . (simple_return_statement .
0)) (SELECT . (simple_return_statement . 0)) (R [...]
+ ((default . error) (COLON . 933) (STAR_STAR . (name . 0)) (STAR . (name
. 0)) (SLASH . (name . 0)) (REM . (name . 0)) (MOD . (name . 0)) (SEMICOLON .
(name . 0)) (SLASH_EQUAL . (name . 0)) (LESS_EQUAL . (name . 0)) (LESS . (name
. 0)) (GREATER_EQUAL . (name . 0)) (GREATER . (name . 0)) (EQUAL . (name . 0))
(NOT . (name . 0)) (IN . (name . 0)) (AMPERSAND . (name . 0)) (MINUS . (name .
0)) (PLUS . (name . 0)) (LEFT_PAREN . (name . 0)) (AND . (name . 0)) (OR .
(name . 0)) (XOR . (nam [...]
+ ((default . error) (SEMICOLON . 932))
+ ((default . error) (DO . (extended_return_object_declaration_opt . 1))
(SEMICOLON . 931))
+ ((default . error) (DO . 930))
+ ((default . error) (WITH . 928) (DOT . 90) (TICK . 91) (SEMICOLON .
929) (LEFT_PAREN . 107))
+ ((default . error) (WHEN . (raise_statement . 0)) (THEN .
(raise_statement . 0)) (OR . (raise_statement . 0)) (ELSIF . (raise_statement .
0)) (ELSE . (raise_statement . 0)) (CHARACTER_LITERAL . (raise_statement . 0))
(STRING_LITERAL . (raise_statement . 0)) (IDENTIFIER . (raise_statement . 0))
(LESS_LESS . (raise_statement . 0)) (WHILE . (raise_statement . 0)) (SELECT .
(raise_statement . 0)) (RETURN . (raise_statement . 0)) (REQUEUE .
(raise_statement . 0)) (RAISE . (raise_stateme [...]
+ ((default . error) (WITH . 926) (DOT . 90) (TICK . 91) (SEMICOLON .
927) (LEFT_PAREN . 107))
+ ((default . error) (WHEN . (simple_statement . 0)) (THEN .
(simple_statement . 0)) (OR . (simple_statement . 0)) (ELSIF .
(simple_statement . 0)) (ELSE . (simple_statement . 0)) (CHARACTER_LITERAL .
(simple_statement . 0)) (STRING_LITERAL . (simple_statement . 0)) (IDENTIFIER .
(simple_statement . 0)) (LESS_LESS . (simple_statement . 0)) (WHILE .
(simple_statement . 0)) (SELECT . (simple_statement . 0)) (RETURN .
(simple_statement . 0)) (REQUEUE . (simple_statement . 0)) (RAISE . ( [...]
+ ((default . error) (END . 925))
+ ((default . error) (THEN . 924))
((default . error) (SEMICOLON . 923))
- ((default . error) (DO . (extended_return_object_declaration_opt . 1))
(SEMICOLON . 922))
- ((default . error) (DO . 921))
- ((default . error) (WITH . 920) (DOT . 87) (TICK . 88) (SEMICOLON .
919) (LEFT_PAREN . 106))
- ((default . error) (WHEN . (raise_statement . 0)) (THEN .
(raise_statement . 0)) (OR . (raise_statement . 0)) (ELSIF . (raise_statement .
0)) (ELSE . (raise_statement . 0)) (WHILE . (raise_statement . 0)) (SELECT .
(raise_statement . 0)) (RETURN . (raise_statement . 0)) (REQUEUE .
(raise_statement . 0)) (RAISE . (raise_statement . 0)) (PRAGMA .
(raise_statement . 0)) (NULL . (raise_statement . 0)) (LOOP . (raise_statement
. 0)) (IF . (raise_statement . 0)) (GOTO . (raise_statement [...]
- ((default . error) (WITH . 918) (DOT . 87) (TICK . 88) (SEMICOLON .
917) (LEFT_PAREN . 106))
- ((default . error) (WHEN . (simple_statement . 0)) (THEN .
(simple_statement . 0)) (OR . (simple_statement . 0)) (ELSIF .
(simple_statement . 0)) (ELSE . (simple_statement . 0)) (WHILE .
(simple_statement . 0)) (SELECT . (simple_statement . 0)) (RETURN .
(simple_statement . 0)) (REQUEUE . (simple_statement . 0)) (RAISE .
(simple_statement . 0)) (PRAGMA . (simple_statement . 0)) (NULL .
(simple_statement . 0)) (LOOP . (simple_statement . 0)) (IF . (simple_statement
. 0)) (GOTO . (si [...]
- ((default . error) (END . 916))
- ((default . error) (THEN . 915))
- ((default . error) (SEMICOLON . 914))
((default . error) (LOOP . (iterator_specification_opt . 1)))
((default . error) (LOOP . (iteration_scheme . 1)))
((default . error) (WHEN . (identifier_opt . 1)) (SEMICOLON .
(identifier_opt . 1)))
- ((default . error) (WHEN . 913) (SEMICOLON . 912))
- ((default . error) (RAISE . 152) (PLUS . 144) (MINUS . 143) (ABS .
147) (NOT . 150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
- ((default . error) (SEMICOLON . 910))
- ((default . error) (BEGIN . 909))
- ((default . error) (IS . 908))
- ((default . error) (END . 907))
- ((default . error) (DOT . 87) (TICK . 88) (SEMICOLON . 906)
(LEFT_PAREN . 106))
- ((default . error) (SEMICOLON . (actual_parameter_part_opt . 0)) (DO .
(actual_parameter_part_opt . 0)) (LEFT_PAREN . ((actual_parameter_part_opt . 0)
903)))
- ((default . error) (REQUEUE . (label_opt . 2)) (RAISE . (label_opt . 2))
(PRAGMA . (label_opt . 2)) (NULL . (label_opt . 2)) (GOTO . (label_opt . 2))
(EXIT . (label_opt . 2)) (DELAY . (label_opt . 2)) (ABORT . (label_opt . 2))
(CHARACTER_LITERAL . (label_opt . 2)) (STRING_LITERAL . (label_opt . 2))
(IDENTIFIER . (label_opt . 2)) (WHILE . (label_opt . 2)) (SELECT . (label_opt .
2)) (RETURN . (label_opt . 2)) (LOOP . (label_opt . 2)) (IF . (label_opt . 2))
(FOR . (label_opt . 2)) (DE [...]
- ((default . error) (GREATER_GREATER . 902))
- ((default . error) (IS . 901))
- ((default . error) (IS . 900))
- ((default . error) (COMMA . (pragma_argument_association . 2))
(RIGHT_PAREN . (pragma_argument_association . 2)))
- ((default . error) (RAISE . 152) (PLUS . 144) (MINUS . 143) (ABS .
147) (NOT . 150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
- ((default . error) (NOT . 741) (IDENTIFIER . 48) (CHARACTER_LITERAL .
50) (STRING_LITERAL . 49))
- ((default . error) (REVERSE . 896) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (PLUS . 144) (MINUS . 143)
(ABS . 147) (NOT . 763) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149)
(LEFT_PAREN . 148))
- ((default . error) (REVERSE . 894) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49))
- ((default . error) (SEMICOLON . 893))
- ((default . error) (END . 892))
- ((default . error) (IDENTIFIER . 216) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49) (PLUS . 144) (MINUS . 143) (ABS . 147) (NOT . 763)
(NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149) (LEFT_PAREN . 148))
- ((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
108))
- ((default . error) (CASE . 232) (IF . 233) (RAISE . 152) (PLUS .
144) (MINUS . 143) (ABS . 147) (NOT . 150) (NUMERIC_LITERAL . 145) (NULL .
151) (NEW . 149) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL
. 49) (LEFT_PAREN . 148))
- ((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
108))
- ((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
108))
- ((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
108))
- ((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
108))
- ((default . error) (ARRAY . (constant_opt . 1)) (IDENTIFIER .
(constant_opt . 1)) (STRING_LITERAL . (constant_opt . 1)) (CHARACTER_LITERAL .
(constant_opt . 1)) (ACCESS . (constant_opt . 1)) (NOT . (constant_opt . 1)))
- ((default . error) (ARRAY . 485) (IDENTIFIER . 48) (CHARACTER_LITERAL
. 50) (STRING_LITERAL . 49) (ACCESS . (null_exclusion_opt . 0)) (NOT . 878))
- ((default . error) (USE . (exception_declaration . 0)) (TYPE .
(exception_declaration . 0)) (TASK . (exception_declaration . 0)) (SUBTYPE .
(exception_declaration . 0)) (PROTECTED . (exception_declaration . 0))
(PROCEDURE . (exception_declaration . 0)) (PRAGMA . (exception_declaration .
0)) (PACKAGE . (exception_declaration . 0)) (OVERRIDING .
(exception_declaration . 0)) (NOT . (exception_declaration . 0)) (GENERIC .
(exception_declaration . 0)) (FUNCTION . (exception_declaration [...]
- ((default . error) (RAISE . 152) (PLUS . 144) (MINUS . 143) (ABS .
147) (NOT . 150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
+ ((default . error) (WHEN . 921) (SEMICOLON . 922))
+ ((default . error) (RAISE . 152) (PLUS . 154) (MINUS . 153) (ABS .
144) (NOT . 150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
+ ((default . error) (SEMICOLON . 919))
+ ((default . error) (BEGIN . 918))
+ ((default . error) (IS . 917))
+ ((default . error) (END . 916))
+ ((default . error) (DOT . 90) (TICK . 91) (SEMICOLON . 915)
(LEFT_PAREN . 107))
+ ((default . error) (SEMICOLON . (actual_parameter_part_opt . 0)) (DO .
(actual_parameter_part_opt . 0)) (LEFT_PAREN . ( 912 (actual_parameter_part_opt
. 0))))
+ ((default . error) (IS . 911))
+ ((default . error) (IS . 910))
+ ((default . error) (WHEN . 624))
+ ((default . error) (BAR . 286) (EQUAL_GREATER . 908))
+ ((default . error) (NULL . 907))
+ ((default . error) (DO . (subtype_indication . 3)) (OF .
(subtype_indication . 3)) (AND . (subtype_indication . 3)) (SEMICOLON .
(subtype_indication . 3)) (WITH . (subtype_indication . 3)) (COLON_EQUAL .
(subtype_indication . 3)) (DOT . 90) (TICK . 91) (RANGE . 902) (LEFT_PAREN .
827))
+ ((default . error) (OF . 906))
+ ((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
+ ((default . error) (DOT . 90) (TICK . 91) (LOOP .
(iterator_specification . 5)) (EQUAL_GREATER . (iterator_specification . 5))
(LEFT_PAREN . 107))
+ ((default . error) (NUMERIC_LITERAL . 155) (NULL . 904) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
+ ((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49) (PLUS . 154) (MINUS . 153) (ABS . 144) (NOT . 734)
(NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149) (LEFT_PAREN . 148))
+ ((default . error) (LOOP . (iterator_specification . 1)) (EQUAL_GREATER
. (iterator_specification . 1)))
+ ((default . error) (LOOP . (subtype_indication . 3)) (DOT . 90) (IN .
(primary . 3)) (NOT . (primary . 3)) (EQUAL . (primary . 3)) (GREATER .
(primary . 3)) (GREATER_EQUAL . (primary . 3)) (LESS . (primary . 3))
(LESS_EQUAL . (primary . 3)) (SLASH_EQUAL . (primary . 3)) (RIGHT_PAREN .
((primary . 3) (subtype_indication . 3))) (COMMA . ((primary . 3)
(subtype_indication . 3))) (BAR . (primary . 3)) (EQUAL_GREATER . ((primary .
3) (subtype_indication . 3))) (AND . (primary . 3)) (OR [...]
+ ((default . error) (LOOP . (discrete_subtype_definition . 1))
(EQUAL_GREATER . (discrete_subtype_definition . 1)) (COMMA .
(discrete_subtype_definition . 1)) (RIGHT_PAREN . (discrete_subtype_definition
. 1)))
+ ((default . error) (LOOP . (discrete_subtype_definition . 0))
(EQUAL_GREATER . (discrete_subtype_definition . 0)) (COMMA .
(discrete_subtype_definition . 0)) (RIGHT_PAREN . (discrete_subtype_definition
. 0)))
+ ((default . error) (COMMA . (quantified_expression . 0)) (RIGHT_PAREN .
(quantified_expression . 0)))
+ ((default . error) (RAISE . 152) (PLUS . 154) (MINUS . 153) (ABS .
144) (NOT . 150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
+ ((default . error) (RAISE . 152) (PLUS . 154) (MINUS . 153) (ABS .
144) (NOT . 150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
+ ((default . error) (COMMA . (elsif_expression_list . 0)) (RIGHT_PAREN .
(elsif_expression_list . 0)) (ELSE . (elsif_expression_list . 0)) (ELSIF .
(elsif_expression_list . 0)))
+ ((default . error) (COMMA . (if_expression . 1)) (RIGHT_PAREN .
(if_expression . 1)) (ELSE . 898) (ELSIF . 742))
+ ((default . error) (USE . (aggregate . 1)) (COLON_EQUAL . (aggregate .
1)) (CHARACTER_LITERAL . (aggregate . 1)) (STRING_LITERAL . (aggregate . 1))
(IDENTIFIER . (aggregate . 1)) (LESS_LESS . (aggregate . 1)) (WHILE .
(aggregate . 1)) (SELECT . (aggregate . 1)) (REQUEUE . (aggregate . 1)) (RAISE
. (aggregate . 1)) (PRAGMA . (aggregate . 1)) (NULL . (aggregate . 1)) (IF .
(aggregate . 1)) (GOTO . (aggregate . 1)) (FOR . (aggregate . 1)) (EXIT .
(aggregate . 1)) (DELAY . (aggregate . [...]
+ ((default . error) (RIGHT_PAREN . 897))
+ ((default . error) (COMMA . (pragma_argument_association . 3))
(RIGHT_PAREN . (pragma_argument_association . 3)))
+ ((default . error) (SEMICOLON . 896))
+ ((default . error) (END . 895))
+ ((default . error) (IDENTIFIER . 235) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49) (PLUS . 154) (MINUS . 153) (ABS . 144) (NOT . 734)
(NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149) (LEFT_PAREN . 148))
+ ((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
109))
+ ((default . error) (FOR . 146) (CASE . 145) (IF . 147) (RAISE . 152)
(PLUS . 154) (MINUS . 153) (ABS . 144) (NOT . 150) (NUMERIC_LITERAL . 155)
(NULL . 151) (NEW . 149) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49) (LEFT_PAREN . 148))
+ ((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
109))
+ ((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
109))
+ ((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
109))
+ ((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
109))
+ ((default . error) (ARRAY . (constant_opt . 1)) (ACCESS . (constant_opt
. 1)) (NOT . (constant_opt . 1)) (IDENTIFIER . (constant_opt . 1))
(STRING_LITERAL . (constant_opt . 1)) (CHARACTER_LITERAL . (constant_opt . 1)))
+ ((default . error) (ARRAY . 498) (IDENTIFIER . 48) (CHARACTER_LITERAL
. 50) (STRING_LITERAL . 49) (ACCESS . (null_exclusion_opt . 0)) (NOT . 883))
+ ((default . error) (IDENTIFIER . (exception_declaration . 0)) (USE .
(exception_declaration . 0)) (TYPE . (exception_declaration . 0)) (TASK .
(exception_declaration . 0)) (SUBTYPE . (exception_declaration . 0)) (PROTECTED
. (exception_declaration . 0)) (PROCEDURE . (exception_declaration . 0))
(PRAGMA . (exception_declaration . 0)) (PACKAGE . (exception_declaration . 0))
(OVERRIDING . (exception_declaration . 0)) (NOT . (exception_declaration . 0))
(GENERIC . (exception_declaratio [...]
+ ((default . error) (RAISE . 152) (PLUS . 154) (MINUS . 153) (ABS .
144) (NOT . 150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
((default . error) (SEMICOLON . (name_opt . 0)) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49))
- ((default . error) (BEGIN . (incomplete_type_declaration . 1))
(IDENTIFIER . (incomplete_type_declaration . 1)) (ENTRY .
(incomplete_type_declaration . 1)) (FOR . (incomplete_type_declaration . 1))
(FUNCTION . (incomplete_type_declaration . 1)) (GENERIC .
(incomplete_type_declaration . 1)) (NOT . (incomplete_type_declaration . 1))
(OVERRIDING . (incomplete_type_declaration . 1)) (PACKAGE .
(incomplete_type_declaration . 1)) (PRAGMA . (incomplete_type_declaration . 1))
(PROCEDURE . [...]
- ((default . error) (PRIVATE . (abstract_tagged_limited_opt . 0)) (NULL .
(abstract_tagged_limited_opt . 0)) (RECORD . (abstract_tagged_limited_opt . 0))
(TAGGED . 865) (RANGE . 863) (MOD . 861) (DIGITS . 858) (DELTA . 857)
(TASK . 496) (PROTECTED . 492) (SYNCHRONIZED . 494) (INTERFACE . 488)
(ARRAY . 485) (LEFT_PAREN . 859) (ACCESS . (null_exclusion_opt . 0)) (NOT .
211) (NEW . ((abstract_limited_synchronized_opt . 0) (abstract_limited_opt .
0))) (LIMITED . 860) (ABSTR [...]
- ((default . error) (BEGIN . (single_task_declaration . 2)) (IDENTIFIER .
(single_task_declaration . 2)) (ENTRY . (single_task_declaration . 2)) (FOR .
(single_task_declaration . 2)) (FUNCTION . (single_task_declaration . 2))
(GENERIC . (single_task_declaration . 2)) (NOT . (single_task_declaration . 2))
(OVERRIDING . (single_task_declaration . 2)) (PACKAGE .
(single_task_declaration . 2)) (PRAGMA . (single_task_declaration . 2))
(PROCEDURE . (single_task_declaration . 2)) (PROTECTE [...]
- ((default . error) (NEW . 853) (END . (declarative_part_opt . 0))
(PRIVATE . (declarative_part_opt . 0)) (USE . 11) (SUBTYPE . 299) (PRAGMA .
7) (NOT . 4) (OVERRIDING . 5) (FUNCTION . (overriding_indicator_opt . 2))
(PROCEDURE . (overriding_indicator_opt . 2)) (ENTRY . (overriding_indicator_opt
. 2)) (FOR . 296) (IDENTIFIER . 295) (TYPE . 301) (GENERIC . 2) (PROTECTED
. 298) (TASK . 300) (PACKAGE . 297))
- ((default . error) (SEPARATE . 852))
- ((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (IS .
(aspect_specification_opt . 0)) (WITH . 108))
- ((default . error) (NULL . 850))
- ((default . error) (DO . (subtype_indication . 3)) (OF .
(subtype_indication . 3)) (AND . (subtype_indication . 3)) (SEMICOLON .
(subtype_indication . 3)) (WITH . (subtype_indication . 3)) (COLON_EQUAL .
(subtype_indication . 3)) (DOT . 87) (TICK . 88) (RANGE . 849) (LEFT_PAREN .
819))
- ((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
108))
- ((default . error) (NEW . 845) (END . (declarative_part_opt . 0))
(PRIVATE . (declarative_part_opt . 0)) (USE . 11) (SUBTYPE . 299) (PRAGMA .
7) (NOT . 4) (OVERRIDING . 5) (FUNCTION . (overriding_indicator_opt . 2))
(PROCEDURE . (overriding_indicator_opt . 2)) (ENTRY . (overriding_indicator_opt
. 2)) (FOR . 296) (IDENTIFIER . 295) (TYPE . 301) (GENERIC . 2) (PROTECTED
. 298) (TASK . 300) (PACKAGE . 297))
- ((default . error) (SEPARATE . 844))
- ((default . error) (IS . (aspect_specification_opt . 0)) (WITH . 108))
- ((default . error) (SEPARATE . 842))
- ((default . error) (SEMICOLON . 841))
- ((default . error) (RAISE . 152) (PLUS . 144) (MINUS . 143) (ABS .
147) (NOT . 150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
- ((default . error) (IDENTIFIER . (mod_clause_opt . 0)) (AT . 838))
- ((default . error) (SEMICOLON . 837))
- ((default . error) (SEMICOLON . 836))
- ((default . error) (DOT . 87) (TICK . 88) (RENAMES . 835) (LEFT_PAREN
. 106))
+ ((default . error) (DOT . 90) (TICK . 91) (RENAMES . 880) (LEFT_PAREN
. 107))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
+ ((default . error) (PRIVATE . (abstract_tagged_limited_opt . 0)) (NULL .
(abstract_tagged_limited_opt . 0)) (RECORD . (abstract_tagged_limited_opt . 0))
(TAGGED . 867) (RANGE . 865) (MOD . 863) (DIGITS . 860) (DELTA . 859)
(TASK . 509) (PROTECTED . 505) (SYNCHRONIZED . 507) (INTERFACE . 501)
(ARRAY . 498) (LEFT_PAREN . 861) (ACCESS . (null_exclusion_opt . 0)) (NOT .
232) (NEW . ((abstract_limited_opt . 0) (abstract_limited_synchronized_opt .
0))) (LIMITED . 862) (ABSTR [...]
+ ((default . error) (BEGIN . (incomplete_type_declaration . 1)) (ENTRY .
(incomplete_type_declaration . 1)) (FOR . (incomplete_type_declaration . 1))
(FUNCTION . (incomplete_type_declaration . 1)) (GENERIC .
(incomplete_type_declaration . 1)) (NOT . (incomplete_type_declaration . 1))
(OVERRIDING . (incomplete_type_declaration . 1)) (PACKAGE .
(incomplete_type_declaration . 1)) (PRAGMA . (incomplete_type_declaration . 1))
(PROCEDURE . (incomplete_type_declaration . 1)) (PROTECTED . ( [...]
+ ((default . error) (SEPARATE . 857))
+ ((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (IS .
(aspect_specification_opt . 0)) (WITH . 109))
+ ((default . error) (NEW . 853) (END . (declarative_part_opt . 0))
(PRIVATE . (declarative_part_opt . 0)) (USE . 11) (SUBTYPE . 302) (PRAGMA .
7) (NOT . 4) (OVERRIDING . 5) (FUNCTION . (overriding_indicator_opt . 2))
(PROCEDURE . (overriding_indicator_opt . 2)) (ENTRY . (overriding_indicator_opt
. 2)) (FOR . 299) (IDENTIFIER . 305) (TYPE . 304) (GENERIC . 2) (PROTECTED
. 301) (TASK . 303) (PACKAGE . 300))
+ ((default . error) (BEGIN . (single_task_declaration . 2)) (ENTRY .
(single_task_declaration . 2)) (FOR . (single_task_declaration . 2)) (FUNCTION
. (single_task_declaration . 2)) (GENERIC . (single_task_declaration . 2)) (NOT
. (single_task_declaration . 2)) (OVERRIDING . (single_task_declaration . 2))
(PACKAGE . (single_task_declaration . 2)) (PRAGMA . (single_task_declaration .
2)) (PROCEDURE . (single_task_declaration . 2)) (PROTECTED .
(single_task_declaration . 2)) (SUBTYPE . [...]
+ ((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
109))
+ ((default . error) (SEPARATE . 851))
+ ((default . error) (IS . (aspect_specification_opt . 0)) (WITH . 109))
+ ((default . error) (NEW . 847) (END . (declarative_part_opt . 0))
(PRIVATE . (declarative_part_opt . 0)) (USE . 11) (SUBTYPE . 302) (PRAGMA .
7) (NOT . 4) (OVERRIDING . 5) (FUNCTION . (overriding_indicator_opt . 2))
(PROCEDURE . (overriding_indicator_opt . 2)) (ENTRY . (overriding_indicator_opt
. 2)) (FOR . 299) (IDENTIFIER . 305) (TYPE . 304) (GENERIC . 2) (PROTECTED
. 301) (TASK . 303) (PACKAGE . 300))
+ ((default . error) (SEPARATE . 846))
+ ((default . error) (SEMICOLON . 845))
+ ((default . error) (RAISE . 152) (PLUS . 154) (MINUS . 153) (ABS .
144) (NOT . 150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
+ ((default . error) (IDENTIFIER . (mod_clause_opt . 0)) (AT . 842))
+ ((default . error) (SEMICOLON . 841))
+ ((default . error) (SEMICOLON . 840))
((default . error) (XOR . (choice_relation . 0)) (OR . (choice_relation
. 0)) (BAR . (choice_relation . 0)) (EQUAL_GREATER . (choice_relation . 0))
(AND . (choice_relation . 0)))
- ((default . error) (RIGHT_PAREN . 832))
+ ((default . error) (RIGHT_PAREN . 839))
((default . error) (DO . (membership_choice_list . 1)) (LOOP .
(membership_choice_list . 1)) (COMMA . (membership_choice_list . 1)) (ELSIF .
(membership_choice_list . 1)) (ELSE . (membership_choice_list . 1))
(EQUAL_GREATER . (membership_choice_list . 1)) (RIGHT_PAREN .
(membership_choice_list . 1)) (DIGITS . (membership_choice_list . 1)) (RANGE .
(membership_choice_list . 1)) (THEN . (membership_choice_list . 1)) (SEMICOLON
. (membership_choice_list . 1)) (WITH . (membership_choic [...]
- ((default . error) (RAISE . 152) (PLUS . 144) (MINUS . 143) (ABS .
147) (NOT . 150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
- ((default . error) (RAISE . 152) (PLUS . 144) (MINUS . 143) (ABS .
147) (NOT . 150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
- ((default . error) (ACCESS . (null_exclusion_opt . 1)) (IDENTIFIER .
828) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49))
+ ((default . error) (RAISE . 152) (PLUS . 154) (MINUS . 153) (ABS .
144) (NOT . 150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
+ ((default . error) (RAISE . 152) (PLUS . 154) (MINUS . 153) (ABS .
144) (NOT . 150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
+ ((default . error) (ACCESS . (null_exclusion_opt . 1)) (IDENTIFIER .
835) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49))
((default . error) (NULL . (abstract_tagged_limited_opt . 1)) (RECORD .
(abstract_tagged_limited_opt . 1)) (PRIVATE . (abstract_tagged_limited_opt .
1)))
- ((default . error) (NUMERIC_LITERAL . 145) (NULL . 827) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
((default . error) (RIGHT_PAREN . (discrete_subtype_definition_list .
0)) (COMMA . (discrete_subtype_definition_list . 0)))
- ((default . error) (COMMA . 825) (RIGHT_PAREN . 826))
+ ((default . error) (COMMA . 834) (RIGHT_PAREN . 833))
((default . error) (RIGHT_PAREN . (index_subtype_definition_list . 0))
(COMMA . (index_subtype_definition_list . 0)))
- ((default . error) (COMMA . 823) (RIGHT_PAREN . 824))
- ((default . error) (RIGHT_PAREN . (subtype_indication . 3)) (COMMA .
(subtype_indication . 3)) (PLUS . (primary . 3)) (MINUS . (primary . 3))
(AMPERSAND . (primary . 3)) (DOT_DOT . (primary . 3)) (SLASH . (primary . 3))
(STAR . (primary . 3)) (MOD . (primary . 3)) (REM . (primary . 3)) (STAR_STAR .
(primary . 3)) (DOT . 87) (TICK . 281) (RANGE . 820) (LEFT_PAREN . 819))
- ((default . error) (LOOP . (discrete_subtype_definition . 1))
(EQUAL_GREATER . (discrete_subtype_definition . 1)) (COMMA .
(discrete_subtype_definition . 1)) (RIGHT_PAREN . (discrete_subtype_definition
. 1)))
- ((default . error) (DOT_DOT . 271))
- ((default . error) (LOOP . (discrete_subtype_definition . 0))
(EQUAL_GREATER . (discrete_subtype_definition . 0)) (COMMA .
(discrete_subtype_definition . 0)) (RIGHT_PAREN . (discrete_subtype_definition
. 0)))
- ((default . error) (BOX . 818))
+ ((default . error) (COMMA . 832) (RIGHT_PAREN . 831))
+ ((default . error) (RIGHT_PAREN . (subtype_indication . 3)) (COMMA .
(subtype_indication . 3)) (PLUS . (primary . 3)) (MINUS . (primary . 3))
(AMPERSAND . (primary . 3)) (DOT_DOT . (primary . 3)) (MOD . (primary . 3))
(REM . (primary . 3)) (SLASH . (primary . 3)) (STAR . (primary . 3)) (STAR_STAR
. (primary . 3)) (DOT . 90) (TICK . 285) (RANGE . 828) (LEFT_PAREN . 827))
+ ((default . error) (BOX . 826))
((default . error) (WITH . (formal_type_definition . 2)) (SEMICOLON .
(formal_type_definition . 2)))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
- ((default . error) (PACKAGE . (formal_type_declaration . 1)) (PROCEDURE
. (formal_type_declaration . 1)) (FUNCTION . (formal_type_declaration . 1))
(IDENTIFIER . (formal_type_declaration . 1)) (PRAGMA . (formal_type_declaration
. 1)) (TYPE . (formal_type_declaration . 1)) (WITH . (formal_type_declaration .
1)))
+ ((default . error) (PACKAGE . (formal_type_declaration . 1)) (PROCEDURE
. (formal_type_declaration . 1)) (FUNCTION . (formal_type_declaration . 1))
(PRAGMA . (formal_type_declaration . 1)) (TYPE . (formal_type_declaration . 1))
(USE . (formal_type_declaration . 1)) (WITH . (formal_type_declaration . 1))
(IDENTIFIER . (formal_type_declaration . 1)))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
- ((default . error) (DOT . 87) (TICK . 88) (WITH .
(and_interface_list_opt . 0)) (SEMICOLON . (and_interface_list_opt . 0)) (AND .
811) (LEFT_PAREN . 106))
- ((default . error) (PACKAGE . (formal_type_declaration . 0)) (PROCEDURE
. (formal_type_declaration . 0)) (FUNCTION . (formal_type_declaration . 0))
(IDENTIFIER . (formal_type_declaration . 0)) (PRAGMA . (formal_type_declaration
. 0)) (TYPE . (formal_type_declaration . 0)) (WITH . (formal_type_declaration .
0)))
- ((default . error) (PACKAGE . (formal_subprogram_declaration . 2))
(PROCEDURE . (formal_subprogram_declaration . 2)) (FUNCTION .
(formal_subprogram_declaration . 2)) (IDENTIFIER .
(formal_subprogram_declaration . 2)) (PRAGMA . (formal_subprogram_declaration .
2)) (TYPE . (formal_subprogram_declaration . 2)) (WITH .
(formal_subprogram_declaration . 2)))
- ((default . error) (BOX . 810) (IDENTIFIER . 48) (STRING_LITERAL .
49) (CHARACTER_LITERAL . 173) (RIGHT_PAREN . ((association_opt . 0)
(expression_opt . 0))) (COMMA . ((association_opt . 0) (expression_opt . 0)))
(EQUAL_GREATER . (discrete_choice_list . 0)) (BAR . (discrete_choice_list . 0))
(PLUS . 144) (MINUS . 143) (OTHERS . 175) (ABS . 147) (NOT . 174)
(NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149) (RAISE . 152) (LEFT_PAREN
. 148))
- ((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
108))
- ((default . error) (PACKAGE . (formal_object_declaration . 1))
(PROCEDURE . (formal_object_declaration . 1)) (FUNCTION .
(formal_object_declaration . 1)) (IDENTIFIER . (formal_object_declaration . 1))
(PRAGMA . (formal_object_declaration . 1)) (TYPE . (formal_object_declaration .
1)) (WITH . (formal_object_declaration . 1)))
- ((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
108))
- ((default . error) (SEMICOLON . 807))
- ((default . error) (IDENTIFIER . 72))
- ((default . error) (RENAMES . (access_definition . 1)) (DO .
(access_definition . 1)) (RIGHT_PAREN . (access_definition . 1)) (IS .
(access_definition . 1)) (SEMICOLON . (access_definition . 1)) (WITH .
(access_definition . 1)) (COLON_EQUAL . (access_definition . 1)))
- ((default . error) (RENAMES . (access_definition . 2)) (DO .
(access_definition . 2)) (RIGHT_PAREN . (access_definition . 2)) (IS .
(access_definition . 2)) (SEMICOLON . (access_definition . 2)) (WITH .
(access_definition . 2)) (COLON_EQUAL . (access_definition . 2)))
+ ((default . error) (DOT . 90) (TICK . 91) (WITH .
(and_interface_list_opt . 0)) (SEMICOLON . (and_interface_list_opt . 0)) (AND .
819) (LEFT_PAREN . 107))
+ ((default . error) (PACKAGE . (formal_type_declaration . 0)) (PROCEDURE
. (formal_type_declaration . 0)) (FUNCTION . (formal_type_declaration . 0))
(PRAGMA . (formal_type_declaration . 0)) (TYPE . (formal_type_declaration . 0))
(USE . (formal_type_declaration . 0)) (WITH . (formal_type_declaration . 0))
(IDENTIFIER . (formal_type_declaration . 0)))
+ ((default . error) (PACKAGE . (formal_subprogram_declaration . 2))
(PROCEDURE . (formal_subprogram_declaration . 2)) (FUNCTION .
(formal_subprogram_declaration . 2)) (PRAGMA . (formal_subprogram_declaration .
2)) (TYPE . (formal_subprogram_declaration . 2)) (USE .
(formal_subprogram_declaration . 2)) (WITH . (formal_subprogram_declaration .
2)) (IDENTIFIER . (formal_subprogram_declaration . 2)))
+ ((default . error) (BOX . 818) (FOR . 146) (CASE . 145) (IF . 147)
(RIGHT_PAREN . ((expression_opt . 0) (association_opt . 0))) (COMMA .
((expression_opt . 0) (association_opt . 0))) (EQUAL_GREATER .
(discrete_choice_list . 0)) (BAR . (discrete_choice_list . 0)) (IDENTIFIER .
48) (CHARACTER_LITERAL . 183) (STRING_LITERAL . 49) (PLUS . 154) (MINUS .
153) (OTHERS . 182) (ABS . 144) (NOT . 181) (RAISE . 152) (NUMERIC_LITERAL
. 155) (NULL . 151) (NEW . 149) (LEFT_PAREN [...]
+ ((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
109))
+ ((default . error) (PACKAGE . (formal_object_declaration . 1))
(PROCEDURE . (formal_object_declaration . 1)) (FUNCTION .
(formal_object_declaration . 1)) (PRAGMA . (formal_object_declaration . 1))
(TYPE . (formal_object_declaration . 1)) (USE . (formal_object_declaration .
1)) (WITH . (formal_object_declaration . 1)) (IDENTIFIER .
(formal_object_declaration . 1)))
+ ((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
109))
+ ((default . error) (SEMICOLON . 815))
+ ((default . error) (IDENTIFIER . 77))
+ ((default . error) (DO . (access_definition . 1)) (COLON_EQUAL .
(access_definition . 1)) (RIGHT_PAREN . (access_definition . 1)) (RENAMES .
(access_definition . 1)) (WITH . (access_definition . 1)) (SEMICOLON .
(access_definition . 1)) (IS . (access_definition . 1)))
+ ((default . error) (DO . (access_definition . 2)) (COLON_EQUAL .
(access_definition . 2)) (RIGHT_PAREN . (access_definition . 2)) (RENAMES .
(access_definition . 2)) (WITH . (access_definition . 2)) (SEMICOLON .
(access_definition . 2)) (IS . (access_definition . 2)))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
- ((default . error) (RAISE . 152) (PLUS . 144) (MINUS . 143) (ABS .
147) (NOT . 150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
- ((default . error) (DO . (aggregate . 1)) (LOOP . (aggregate . 1)) (USE
. (aggregate . 1)) (COLON_EQUAL . (aggregate . 1)) (WHILE . (aggregate . 1))
(SELECT . (aggregate . 1)) (REQUEUE . (aggregate . 1)) (RAISE . (aggregate .
1)) (PRAGMA . (aggregate . 1)) (NULL . (aggregate . 1)) (IF . (aggregate . 1))
(GOTO . (aggregate . 1)) (FOR . (aggregate . 1)) (EXIT . (aggregate . 1))
(DELAY . (aggregate . 1)) (DECLARE . (aggregate . 1)) (CASE . (aggregate . 1))
(BEGIN . (aggregate . 1)) (A [...]
- ((default . error) (RIGHT_PAREN . 804))
- ((default . error) (ELSE . 800) (RIGHT_PAREN . (if_expression . 3))
(ELSIF . 801))
- ((default . error) (EQUAL_GREATER . (discrete_choice_list . 0)) (BAR .
(discrete_choice_list . 0)) (OTHERS . 175) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (PLUS . 144) (MINUS . 143)
(ABS . 147) (NOT . 174) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149)
(LEFT_PAREN . 148))
- ((default . error) (RIGHT_PAREN . (case_expression_alternative_list .
0)) (COMMA . (case_expression_alternative_list . 0)))
- ((default . error) (COMMA . 798) (RIGHT_PAREN . (case_expression . 0)))
- ((default . error) (WHEN . 795))
- ((default . error) (BAR . 282) (EQUAL_GREATER . 1076))
- ((default . error) (RAISE . 152) (PLUS . 144) (MINUS . 143) (ABS .
147) (NOT . 150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
- ((default . error) (RAISE . 152) (PLUS . 144) (MINUS . 143) (ABS .
147) (NOT . 150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
- ((default . error) (RIGHT_PAREN . (elsif_expression_list . 0)) (ELSE .
(elsif_expression_list . 0)) (ELSIF . (elsif_expression_list . 0)))
- ((default . error) (RIGHT_PAREN . (if_expression . 1)) (ELSE . 1072)
(ELSIF . 801))
- ((default . error) (OF . (aggregate . 4)) (LESS_LESS . (aggregate . 4))
(IDENTIFIER . (aggregate . 4)) (STRING_LITERAL . (aggregate . 4))
(CHARACTER_LITERAL . (aggregate . 4)) (ACCEPT . (aggregate . 4)) (ABORT .
(aggregate . 4)) (BEGIN . (aggregate . 4)) (CASE . (aggregate . 4)) (DECLARE .
(aggregate . 4)) (DELAY . (aggregate . 4)) (EXIT . (aggregate . 4)) (FOR .
(aggregate . 4)) (GOTO . (aggregate . 4)) (IF . (aggregate . 4)) (NULL .
(aggregate . 4)) (PRAGMA . (aggregate . 4)) (RA [...]
+ ((default . error) (RAISE . 152) (PLUS . 154) (MINUS . 153) (ABS .
144) (NOT . 150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
((default . error) (RIGHT_PAREN . (parameter_specification . 2))
(SEMICOLON . (parameter_specification . 2)))
- ((default . error) (COLON_EQUAL . 1071) (DOT . 87) (TICK . 88)
(RIGHT_PAREN . (parameter_specification . 1)) (SEMICOLON .
(parameter_specification . 1)) (LEFT_PAREN . 106))
- ((default . error) (WITH . (formal_object_declaration . 2)) (TYPE .
(formal_object_declaration . 2)) (PRAGMA . (formal_object_declaration . 2))
(IDENTIFIER . (formal_object_declaration . 2)) (FUNCTION .
(formal_object_declaration . 2)) (PROCEDURE . (formal_object_declaration . 2))
(PACKAGE . (formal_object_declaration . 2)))
- ((default . error) (SEMICOLON . 1070))
- ((default . error) (SEMICOLON . 1069))
- ((default . error) (RIGHT_PAREN . 1068))
+ ((default . error) (COLON_EQUAL . 1084) (DOT . 90) (TICK . 91)
(RIGHT_PAREN . (parameter_specification . 1)) (SEMICOLON .
(parameter_specification . 1)) (LEFT_PAREN . 107))
+ ((default . error) (IDENTIFIER . (formal_object_declaration . 2)) (WITH
. (formal_object_declaration . 2)) (USE . (formal_object_declaration . 2))
(TYPE . (formal_object_declaration . 2)) (PRAGMA . (formal_object_declaration .
2)) (FUNCTION . (formal_object_declaration . 2)) (PROCEDURE .
(formal_object_declaration . 2)) (PACKAGE . (formal_object_declaration . 2)))
+ ((default . error) (SEMICOLON . 1083))
+ ((default . error) (SEMICOLON . 1082))
+ ((default . error) (RIGHT_PAREN . 1081))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
- ((default . error) (WITH . ( 1066 (formal_derived_type_definition . 1)))
(SEMICOLON . (formal_derived_type_definition . 1)))
- ((default . error) (AND . 1065) (WITH . (interface_type_definition .
1)) (SEMICOLON . (interface_type_definition . 1)))
- ((default . error) (DOT . 87) (SEMICOLON . (interface_list . 0)) (WITH
. (interface_list . 0)) (AND . (interface_list . 0)) (TICK . 88) (LEFT_PAREN .
106))
- ((default . error) (AND . 1065) (WITH . (interface_type_definition .
3)) (SEMICOLON . (interface_type_definition . 3)))
- ((default . error) (AND . 1065) (WITH . (interface_type_definition .
2)) (SEMICOLON . (interface_type_definition . 2)))
- ((default . error) (AND . 1065) (WITH . (interface_type_definition .
0)) (SEMICOLON . (interface_type_definition . 0)))
+ ((default . error) (WITH . ( 1079 (formal_derived_type_definition . 1)))
(SEMICOLON . (formal_derived_type_definition . 1)))
+ ((default . error) (AND . 1078) (WITH . (interface_type_definition .
1)) (SEMICOLON . (interface_type_definition . 1)))
+ ((default . error) (DOT . 90) (SEMICOLON . (interface_list . 0)) (WITH
. (interface_list . 0)) (AND . (interface_list . 0)) (TICK . 91) (LEFT_PAREN .
107))
+ ((default . error) (AND . 1078) (WITH . (interface_type_definition .
3)) (SEMICOLON . (interface_type_definition . 3)))
+ ((default . error) (AND . 1078) (WITH . (interface_type_definition .
2)) (SEMICOLON . (interface_type_definition . 2)))
+ ((default . error) (AND . 1078) (WITH . (interface_type_definition .
0)) (SEMICOLON . (interface_type_definition . 0)))
((default . error) (SEMICOLON . (formal_type_definition . 7)) (WITH .
(formal_type_definition . 7)))
- ((default . error) (IDENTIFIER . 48) (STRING_LITERAL . 49)
(CHARACTER_LITERAL . 173) (RIGHT_PAREN . ((association_opt . 0)
(expression_opt . 0))) (COMMA . ((association_opt . 0) (expression_opt . 0)))
(EQUAL_GREATER . (discrete_choice_list . 0)) (BAR . (discrete_choice_list . 0))
(PLUS . 144) (MINUS . 143) (OTHERS . 175) (ABS . 147) (NOT . 1062)
(NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149) (RAISE . 152) (LEFT_PAREN
. 148))
- ((default . error) (BOX . 1061) (IDENTIFIER . 48) (CHARACTER_LITERAL .
50) (STRING_LITERAL . 49) (PLUS . 144) (MINUS . 143) (ABS . 147) (NOT .
150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149) (LEFT_PAREN . 148))
- ((default . error) (LOOP . (subtype_indication . 2)) (DO .
(subtype_indication . 2)) (EQUAL_GREATER . (subtype_indication . 2)) (COMMA .
(subtype_indication . 2)) (RIGHT_PAREN . (subtype_indication . 2)) (COLON_EQUAL
. (subtype_indication . 2)) (WITH . (subtype_indication . 2)) (SEMICOLON .
(subtype_indication . 2)) (AND . (subtype_indication . 2)) (OF .
(subtype_indication . 2)))
- ((default . error) (LOOP . (constraint . 1)) (DO . (constraint . 1))
(EQUAL_GREATER . (constraint . 1)) (COMMA . (constraint . 1)) (RIGHT_PAREN .
(constraint . 1)) (COLON_EQUAL . (constraint . 1)) (WITH . (constraint . 1))
(SEMICOLON . (constraint . 1)) (AND . (constraint . 1)) (OF . (constraint . 1)))
+ ((default . error) (FOR . 146) (CASE . 145) (IF . 147) (RIGHT_PAREN .
((expression_opt . 0) (association_opt . 0))) (COMMA . ((expression_opt . 0)
(association_opt . 0))) (EQUAL_GREATER . (discrete_choice_list . 0)) (BAR .
(discrete_choice_list . 0)) (IDENTIFIER . 48) (CHARACTER_LITERAL . 183)
(STRING_LITERAL . 49) (PLUS . 154) (MINUS . 153) (OTHERS . 182) (ABS .
144) (NOT . 1075) (RAISE . 152) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW .
149) (LEFT_PAREN . 148))
+ ((default . error) (BOX . 1074) (IDENTIFIER . 48) (CHARACTER_LITERAL .
50) (STRING_LITERAL . 49) (PLUS . 154) (MINUS . 153) (ABS . 144) (NOT .
150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149) (LEFT_PAREN . 148))
+ ((default . error) (LOOP . (subtype_indication . 2)) (DO .
(subtype_indication . 2)) (RIGHT_PAREN . (subtype_indication . 2)) (COMMA .
(subtype_indication . 2)) (EQUAL_GREATER . (subtype_indication . 2))
(COLON_EQUAL . (subtype_indication . 2)) (WITH . (subtype_indication . 2))
(SEMICOLON . (subtype_indication . 2)) (AND . (subtype_indication . 2)) (OF .
(subtype_indication . 2)))
+ ((default . error) (LOOP . (constraint . 1)) (DO . (constraint . 1))
(RIGHT_PAREN . (constraint . 1)) (COMMA . (constraint . 1)) (EQUAL_GREATER .
(constraint . 1)) (COLON_EQUAL . (constraint . 1)) (WITH . (constraint . 1))
(SEMICOLON . (constraint . 1)) (AND . (constraint . 1)) (OF . (constraint . 1)))
+ ((default . error) (OF . 1073))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
- ((default . error) (OF . 1058))
- ((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49) (PLUS . 144) (MINUS . 143) (ABS . 147) (NOT . 763)
(NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149) (LEFT_PAREN . 148))
- ((default . error) (OF . 1056))
- ((default . error) (PLUS . (primary . 1)) (MINUS . (primary . 1))
(AMPERSAND . (primary . 1)) (DOT_DOT . (primary . 1)) (SLASH . (primary . 1))
(STAR . (primary . 1)) (MOD . (primary . 1)) (REM . (primary . 1)) (IDENTIFIER
. 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49))
+ ((default . error) (OF . 1070))
+ ((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49) (PLUS . 154) (MINUS . 153) (ABS . 144) (NOT . 734)
(NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149) (LEFT_PAREN . 148))
((default . error) (DOT . (name . 0)) (LEFT_PAREN . (name . 0)) (TICK .
(name . 0)) (SEMICOLON . (null_exclusion_opt_name_type . 2)) (RIGHT_PAREN .
(null_exclusion_opt_name_type . 2)) (COLON_EQUAL .
(null_exclusion_opt_name_type . 2)))
((default . error) (DOT . (name . 3)) (LEFT_PAREN . (name . 3)) (TICK .
(name . 3)) (SEMICOLON . (null_exclusion_opt_name_type . 3)) (RIGHT_PAREN .
(null_exclusion_opt_name_type . 3)) (COLON_EQUAL .
(null_exclusion_opt_name_type . 3)))
((default . error) (SEMICOLON . (discriminant_specification_opt . 3))
(RIGHT_PAREN . (discriminant_specification_opt . 3)))
((default . error) (SEMICOLON . (discriminant_specification_opt . 1))
(RIGHT_PAREN . (discriminant_specification_opt . 1)))
- ((default . error) (DO . (range . 0)) (LOOP . (range . 0)) (XOR . (range
. 0)) (OR . (range . 0)) (AND . (range . 0)) (IS . (range . 0)) (WITH . (range
. 0)) (SEMICOLON . (range . 0)) (THEN . (range . 0)) (RANGE . (range . 0))
(DIGITS . (range . 0)) (ELSE . (range . 0)) (ELSIF . (range . 0)) (COLON_EQUAL
. (range . 0)) (OF . (range . 0)) (COMMA . (range . 0)) (BAR . (range . 0))
(EQUAL_GREATER . (range . 0)) (RIGHT_PAREN . (range . 0)))
- ((default . error) (DOT . 87) (TICK . 88) (SEMICOLON .
(aspect_specification_opt . 0)) (WITH . 108) (LEFT_PAREN . 106))
- ((default . error) (DOT . 87) (TICK . 88) (SEMICOLON .
(aspect_specification_opt . 0)) (WITH . 108) (LEFT_PAREN . 106))
- ((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
- ((default . error) (WHEN . (record_representation_clause . 0)) (END .
(record_representation_clause . 0)) (PRIVATE . (record_representation_clause .
0)) (CASE . (record_representation_clause . 0)) (USE .
(record_representation_clause . 0)) (TYPE . (record_representation_clause . 0))
(TASK . (record_representation_clause . 0)) (SUBTYPE .
(record_representation_clause . 0)) (PROTECTED . (record_representation_clause
. 0)) (PROCEDURE . (record_representation_clause . 0)) (PRAGMA . (re [...]
- ((default . error) (WHEN . (enumeration_representation_clause . 0)) (END
. (enumeration_representation_clause . 0)) (PRIVATE .
(enumeration_representation_clause . 0)) (CASE .
(enumeration_representation_clause . 0)) (USE .
(enumeration_representation_clause . 0)) (TYPE .
(enumeration_representation_clause . 0)) (TASK .
(enumeration_representation_clause . 0)) (SUBTYPE .
(enumeration_representation_clause . 0)) (PROTECTED .
(enumeration_representation_clause . 0)) (PROCEDURE . (enu [...]
- ((default . error) (MOD . 1052))
- ((default . error) (IDENTIFIER . 1049))
- ((default . error) (SEMICOLON . 1048))
- ((default . error) (WHEN . (aspect_clause . 0)) (PRIVATE .
(aspect_clause . 0)) (END . (aspect_clause . 0)) (CASE . (aspect_clause . 0))
(BEGIN . (aspect_clause . 0)) (IDENTIFIER . (aspect_clause . 0)) (ENTRY .
(aspect_clause . 0)) (FOR . (aspect_clause . 0)) (FUNCTION . (aspect_clause .
0)) (GENERIC . (aspect_clause . 0)) (NOT . (aspect_clause . 0)) (OVERRIDING .
(aspect_clause . 0)) (PACKAGE . (aspect_clause . 0)) (PRAGMA . (aspect_clause .
0)) (PROCEDURE . (aspect_clause . 0)) ( [...]
- ((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
108))
- ((default . error) (IS . 1046))
- ((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
108))
- ((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
- ((default . error) (END . 1042) (PRIVATE . 1043))
- ((default . error) (SEMICOLON . 1041))
- ((default . error) (SEMICOLON . 1040))
- ((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49) (PLUS . 144) (MINUS . 143) (ABS . 147) (NOT . 150)
(NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149) (LEFT_PAREN . 148))
+ ((default . error) (DO . (range . 0)) (LOOP . (range . 0)) (XOR . (range
. 0)) (OR . (range . 0)) (AND . (range . 0)) (IS . (range . 0)) (WITH . (range
. 0)) (SEMICOLON . (range . 0)) (THEN . (range . 0)) (RANGE . (range . 0))
(DIGITS . (range . 0)) (ELSE . (range . 0)) (ELSIF . (range . 0)) (COLON_EQUAL
. (range . 0)) (OF . (range . 0)) (BAR . (range . 0)) (EQUAL_GREATER . (range .
0)) (RIGHT_PAREN . (range . 0)) (COMMA . (range . 0)))
+ ((default . error) (WHEN . (record_representation_clause . 0)) (END .
(record_representation_clause . 0)) (PRIVATE . (record_representation_clause .
0)) (CASE . (record_representation_clause . 0)) (IDENTIFIER .
(record_representation_clause . 0)) (USE . (record_representation_clause . 0))
(TYPE . (record_representation_clause . 0)) (TASK .
(record_representation_clause . 0)) (SUBTYPE . (record_representation_clause .
0)) (PROTECTED . (record_representation_clause . 0)) (PROCEDURE . [...]
+ ((default . error) (WHEN . (enumeration_representation_clause . 0)) (END
. (enumeration_representation_clause . 0)) (PRIVATE .
(enumeration_representation_clause . 0)) (CASE .
(enumeration_representation_clause . 0)) (IDENTIFIER .
(enumeration_representation_clause . 0)) (USE .
(enumeration_representation_clause . 0)) (TYPE .
(enumeration_representation_clause . 0)) (TASK .
(enumeration_representation_clause . 0)) (SUBTYPE .
(enumeration_representation_clause . 0)) (PROTECTED . (en [...]
+ ((default . error) (MOD . 1068))
+ ((default . error) (IDENTIFIER . 1065))
+ ((default . error) (SEMICOLON . 1064))
+ ((default . error) (WHEN . (aspect_clause . 0)) (PRIVATE .
(aspect_clause . 0)) (END . (aspect_clause . 0)) (CASE . (aspect_clause . 0))
(BEGIN . (aspect_clause . 0)) (ENTRY . (aspect_clause . 0)) (FOR .
(aspect_clause . 0)) (FUNCTION . (aspect_clause . 0)) (GENERIC . (aspect_clause
. 0)) (NOT . (aspect_clause . 0)) (OVERRIDING . (aspect_clause . 0)) (PACKAGE .
(aspect_clause . 0)) (PRAGMA . (aspect_clause . 0)) (PROCEDURE . (aspect_clause
. 0)) (PROTECTED . (aspect_clause . 0)) (S [...]
+ ((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
109))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
- ((default . error) (SEMICOLON . 1036) (IS . 1037))
- ((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
108))
+ ((default . error) (END . 1060) (PRIVATE . 1061))
+ ((default . error) (SEMICOLON . 1059))
+ ((default . error) (IS . 1058))
+ ((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
109))
+ ((default . error) (SEMICOLON . 1056))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
- ((default . error) (END . 1032) (PRIVATE . 1033))
- ((default . error) (SEMICOLON . 1031))
- ((default . error) (SYNCHRONIZED . 561) (TAGGED . 562) (NEW .
((abstract_limited_synchronized_opt . 3) (abstract_limited_opt . 3))) (LIMITED
. 1030))
- ((default . error) (RAISE . 152) (PLUS . 144) (MINUS . 143) (ABS .
147) (NOT . 150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
- ((default . error) (RAISE . 152) (PLUS . 144) (MINUS . 143) (ABS .
147) (NOT . 150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
- ((default . error) (IDENTIFIER . 1024) (CHARACTER_LITERAL . 1025))
- ((default . error) (INTERFACE . 555) (PRIVATE .
(abstract_tagged_limited_opt . 5)) (NULL . (abstract_tagged_limited_opt . 5))
(RECORD . (abstract_tagged_limited_opt . 5)) (NEW .
((abstract_limited_synchronized_opt . 4) (abstract_limited_opt . 2))))
- ((default . error) (RAISE . 152) (PLUS . 144) (MINUS . 143) (ABS .
147) (NOT . 150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
- ((default . error) (RECORD . 1022))
- ((default . error) (PLUS . 144) (MINUS . 143) (ABS . 147) (NOT .
150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN . 148))
- ((default . error) (END . (component_list_opt . 0)) (NULL . 1013) (CASE
. 1012) (IDENTIFIER . 72) (FOR . 296))
- ((default . error) (SEMICOLON . 1011) (PRIVATE .
(abstract_tagged_limited_opt . 4)) (NULL . (abstract_tagged_limited_opt . 4))
(RECORD . (abstract_tagged_limited_opt . 4)) (LIMITED . 549))
- ((default . error) (NEW . 1010))
- ((default . error) (NEW . 1009))
- ((default . error) (PRIVATE . 1007) (RECORD . 864) (NULL . 862))
+ ((default . error) (END . 1053) (PRIVATE . 1054))
+ ((default . error) (SEMICOLON . 1052))
+ ((default . error) (SEMICOLON . 1051) (IS . 1050))
+ ((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
109))
+ ((default . error) (SYNCHRONIZED . 563) (TAGGED . 564) (NEW .
((abstract_limited_opt . 3) (abstract_limited_synchronized_opt . 3))) (LIMITED
. 1048))
+ ((default . error) (RAISE . 152) (PLUS . 154) (MINUS . 153) (ABS .
144) (NOT . 150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
+ ((default . error) (RAISE . 152) (PLUS . 154) (MINUS . 153) (ABS .
144) (NOT . 150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
+ ((default . error) (IDENTIFIER . 1042) (CHARACTER_LITERAL . 1043))
+ ((default . error) (INTERFACE . 557) (PRIVATE .
(abstract_tagged_limited_opt . 5)) (NULL . (abstract_tagged_limited_opt . 5))
(RECORD . (abstract_tagged_limited_opt . 5)) (NEW . ((abstract_limited_opt . 2)
(abstract_limited_synchronized_opt . 4))))
+ ((default . error) (RAISE . 152) (PLUS . 154) (MINUS . 153) (ABS .
144) (NOT . 150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
+ ((default . error) (RECORD . 1040))
+ ((default . error) (PLUS . 154) (MINUS . 153) (ABS . 144) (NOT .
150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN . 148))
+ ((default . error) (END . (component_list_opt . 0)) (NULL . 1031) (CASE
. 1030) (IDENTIFIER . 77) (FOR . 299))
+ ((default . error) (SEMICOLON . 1029) (PRIVATE .
(abstract_tagged_limited_opt . 4)) (NULL . (abstract_tagged_limited_opt . 4))
(RECORD . (abstract_tagged_limited_opt . 4)) (LIMITED . 551))
+ ((default . error) (NEW . 1028))
+ ((default . error) (NEW . 1027))
+ ((default . error) (PRIVATE . 1025) (RECORD . 866) (NULL . 864))
((default . error) (WITH . (type_definition . 8)) (SEMICOLON .
(type_definition . 8)))
((default . error) (WITH . (type_definition . 6)) (SEMICOLON .
(type_definition . 6)))
((default . error) (WITH . (type_definition . 9)) (SEMICOLON .
(type_definition . 9)))
((default . error) (WITH . (type_definition . 0)) (SEMICOLON .
(type_definition . 0)))
((default . error) (WITH . (type_definition . 10)) (SEMICOLON .
(type_definition . 10)))
((default . error) (WITH . (type_definition . 7)) (SEMICOLON .
(type_definition . 7)))
- ((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
108))
+ ((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
109))
+ ((default . error) (DOT . 90) (TICK . 91) (SEMICOLON .
(aspect_specification_opt . 0)) (WITH . 109) (LEFT_PAREN . 107))
+ ((default . error) (DOT . 90) (TICK . 91) (SEMICOLON .
(aspect_specification_opt . 0)) (WITH . 109) (LEFT_PAREN . 107))
+ ((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
((default . error) (SEMICOLON . (package_specification . 0)))
- ((default . error) (SEMICOLON . 1005))
- ((default . error) (NULL . 1004))
- ((default . error) (COLON_EQUAL . 1002) (SEMICOLON .
(aspect_specification_opt . 0)) (WITH . 108))
- ((default . error) (COLON_EQUAL . 1000) (SEMICOLON .
(aspect_specification_opt . 0)) (WITH . 108))
- ((default . error) (COLON_EQUAL . 998) (SEMICOLON .
(aspect_specification_opt . 0)) (WITH . 108))
- ((default . error) (SEMICOLON . 997))
- ((default . error) (SEMICOLON . 996))
- ((default . error) (SEMICOLON . 995))
- ((default . error) (SEMICOLON . 994))
- ((default . error) (RIGHT_PAREN . 993))
- ((default . error) (RIGHT_PAREN . 992))
- ((default . error) (RIGHT_PAREN . 991))
- ((default . error) (SEMICOLON . 990))
- ((default . error) (RIGHT_PAREN . 989))
- ((default . error) (LOOP . (subtype_indication . 3)) (DOT . 87) (IN .
(primary . 3)) (NOT . (primary . 3)) (EQUAL . (primary . 3)) (GREATER .
(primary . 3)) (GREATER_EQUAL . (primary . 3)) (LESS . (primary . 3))
(LESS_EQUAL . (primary . 3)) (SLASH_EQUAL . (primary . 3)) (RIGHT_PAREN .
((subtype_indication . 3) (primary . 3))) (COMMA . ((subtype_indication . 3)
(primary . 3))) (BAR . (primary . 3)) (EQUAL_GREATER . ((subtype_indication .
3) (primary . 3))) (AND . (primary . 3)) (OR [...]
+ ((default . error) (SEMICOLON . 1020))
+ ((default . error) (NULL . 1019))
+ ((default . error) (COLON_EQUAL . 1017) (SEMICOLON .
(aspect_specification_opt . 0)) (WITH . 109))
+ ((default . error) (COLON_EQUAL . 1015) (SEMICOLON .
(aspect_specification_opt . 0)) (WITH . 109))
+ ((default . error) (COLON_EQUAL . 1013) (SEMICOLON .
(aspect_specification_opt . 0)) (WITH . 109))
+ ((default . error) (SEMICOLON . 1012))
+ ((default . error) (SEMICOLON . 1011))
+ ((default . error) (SEMICOLON . 1010))
+ ((default . error) (SEMICOLON . 1009))
+ ((default . error) (RIGHT_PAREN . 1008))
+ ((default . error) (RIGHT_PAREN . 1007))
+ ((default . error) (SEMICOLON . 1006))
+ ((default . error) (RIGHT_PAREN . 1005))
((default . error) (SEMICOLON . (name_opt . 0)) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49))
- ((default . error) (END . (package_body . 1)) (BEGIN . (package_body .
1)) (IDENTIFIER . (package_body . 1)) (ENTRY . (package_body . 1)) (FOR .
(package_body . 1)) (PROTECTED . (package_body . 1)) (SUBTYPE . (package_body .
1)) (TASK . (package_body . 1)) (TYPE . (package_body . 1)) (WITH .
(package_body . 1)) (USE . (package_body . 1)) (SEPARATE . (package_body . 1))
(PROCEDURE . (package_body . 1)) (PRIVATE . (package_body . 1)) (PRAGMA .
(package_body . 1)) (PACKAGE . (package_ [...]
+ ((default . error) (END . (package_body . 1)) (BEGIN . (package_body .
1)) (ENTRY . (package_body . 1)) (FOR . (package_body . 1)) (PROTECTED .
(package_body . 1)) (SUBTYPE . (package_body . 1)) (TASK . (package_body . 1))
(TYPE . (package_body . 1)) (IDENTIFIER . (package_body . 1)) (WITH .
(package_body . 1)) (USE . (package_body . 1)) (SEPARATE . (package_body . 1))
(PROCEDURE . (package_body . 1)) (PRIVATE . (package_body . 1)) (PRAGMA .
(package_body . 1)) (PACKAGE . (package_ [...]
+ ((default . error) (LOOP . (aggregate . 3)) (DO . (aggregate . 3)) (OF .
(aggregate . 3)) (ACCEPT . (aggregate . 3)) (ABORT . (aggregate . 3)) (BEGIN .
(aggregate . 3)) (CASE . (aggregate . 3)) (DECLARE . (aggregate . 3)) (DELAY .
(aggregate . 3)) (EXIT . (aggregate . 3)) (FOR . (aggregate . 3)) (GOTO .
(aggregate . 3)) (IF . (aggregate . 3)) (NULL . (aggregate . 3)) (PRAGMA .
(aggregate . 3)) (RAISE . (aggregate . 3)) (REQUEUE . (aggregate . 3)) (SELECT
. (aggregate . 3)) (WHILE . [...]
+ ((default . error) (RAISE . 152) (PLUS . 154) (MINUS . 153) (ABS .
144) (NOT . 150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
+ ((default . error) (ELSIF . (elsif_expression_list . 1)) (ELSE .
(elsif_expression_list . 1)) (RIGHT_PAREN . (elsif_expression_list . 1)) (COMMA
. (elsif_expression_list . 1)))
+ ((default . error) (THEN . 1002))
+ ((default . error) (RIGHT_PAREN . (if_expression . 2)) (COMMA .
(if_expression . 2)))
+ ((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49) (PLUS . 154) (MINUS . 153) (ABS . 144) (NOT . 150)
(NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149) (LEFT_PAREN . 148))
+ ((default . error) (LOOP . (iterator_specification . 0)) (EQUAL_GREATER
. (iterator_specification . 0)))
+ ((default . error) (PLUS . (primary . 1)) (MINUS . (primary . 1))
(AMPERSAND . (primary . 1)) (DOT_DOT . (primary . 1)) (MOD . (primary . 1))
(REM . (primary . 1)) (SLASH . (primary . 1)) (STAR . (primary . 1))
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49))
+ ((default . error) (DOT . 90) (TICK . 91) (LOOP .
(iterator_specification . 4)) (EQUAL_GREATER . (iterator_specification . 4))
(LEFT_PAREN . 107))
+ ((default . error) (REVERSE . 999) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
- ((default . error) (DOT . 87) (TICK . 88) (LOOP .
(iterator_specification . 5)) (EQUAL_GREATER . (iterator_specification . 5))
(LEFT_PAREN . 106))
- ((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49) (PLUS . 144) (MINUS . 143) (ABS . 147) (NOT . 763)
(NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149) (LEFT_PAREN . 148))
- ((default . error) (LOOP . (iterator_specification . 1)) (EQUAL_GREATER
. (iterator_specification . 1)))
- ((default . error) (OF . 985))
- ((default . error) (RIGHT_PAREN . (quantified_expression . 0)))
- ((default . error) (END . (protected_operation_item_list_opt . 0))
(ENTRY . 976) (NOT . 4) (OVERRIDING . 5) (FUNCTION .
(overriding_indicator_opt . 2)) (PROCEDURE . (overriding_indicator_opt . 2))
(FOR . 296))
- ((default . error) (BEGIN . (declarative_part_opt . 0)) (USE . 11)
(SUBTYPE . 299) (PRAGMA . 7) (NOT . 4) (OVERRIDING . 5) (FUNCTION .
(overriding_indicator_opt . 2)) (PROCEDURE . (overriding_indicator_opt . 2))
(ENTRY . (overriding_indicator_opt . 2)) (FOR . 296) (IDENTIFIER . 295) (TYPE
. 301) (GENERIC . 2) (PROTECTED . 298) (TASK . 300) (PACKAGE . 297))
- ((default . error) (ACCEPT . (label_opt . 1)) (BEGIN . (label_opt . 1))
(CASE . (label_opt . 1)) (DECLARE . (label_opt . 1)) (FOR . (label_opt . 1))
(IF . (label_opt . 1)) (LOOP . (label_opt . 1)) (RETURN . (label_opt . 1))
(SELECT . (label_opt . 1)) (WHILE . (label_opt . 1)) (IDENTIFIER . (label_opt .
1)) (STRING_LITERAL . (label_opt . 1)) (CHARACTER_LITERAL . (label_opt . 1))
(ABORT . (label_opt . 1)) (DELAY . (label_opt . 1)) (EXIT . (label_opt . 1))
(GOTO . (label_opt . 1)) (NU [...]
- ((default . error) (RIGHT_PAREN . ((association_opt . 0) (expression_opt
. 0))) (COMMA . ((association_opt . 0) (expression_opt . 0))) (EQUAL_GREATER .
(discrete_choice_list . 0)) (BAR . (discrete_choice_list . 0)) (OTHERS . 175)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 173) (STRING_LITERAL . 49) (RAISE .
152) (PLUS . 144) (MINUS . 143) (ABS . 147) (NOT . 174) (NUMERIC_LITERAL .
145) (NULL . 151) (NEW . 149) (LEFT_PAREN . 148))
+ ((default . error) (RAISE . 152) (PLUS . 154) (MINUS . 153) (ABS .
144) (NOT . 150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
+ ((default . error) (RIGHT_PAREN . (case_expression_alternative_list .
1)) (COMMA . (case_expression_alternative_list . 1)))
+ ((default . error) (END . (protected_operation_item_list_opt . 0))
(ENTRY . 986) (NOT . 4) (OVERRIDING . 5) (FUNCTION .
(overriding_indicator_opt . 2)) (PROCEDURE . (overriding_indicator_opt . 2))
(FOR . 299))
+ ((default . error) (BEGIN . (declarative_part_opt . 0)) (USE . 11)
(SUBTYPE . 302) (PRAGMA . 7) (NOT . 4) (OVERRIDING . 5) (FUNCTION .
(overriding_indicator_opt . 2)) (PROCEDURE . (overriding_indicator_opt . 2))
(ENTRY . (overriding_indicator_opt . 2)) (FOR . 299) (IDENTIFIER . 305) (TYPE
. 304) (GENERIC . 2) (PROTECTED . 301) (TASK . 303) (PACKAGE . 300))
+ ((default . error) (FOR . 146) (CASE . 145) (IF . 147) (RIGHT_PAREN .
((expression_opt . 0) (association_opt . 0))) (COMMA . ((expression_opt . 0)
(association_opt . 0))) (EQUAL_GREATER . (discrete_choice_list . 0)) (BAR .
(discrete_choice_list . 0)) (OTHERS . 182) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 183) (STRING_LITERAL . 49) (RAISE . 152) (PLUS . 154)
(MINUS . 153) (ABS . 144) (NOT . 181) (NUMERIC_LITERAL . 155) (NULL . 151)
(NEW . 149) (LEFT_PAREN . 148))
((default . error) (SEMICOLON . (actual_parameter_part_opt . 1))
(LEFT_PAREN . (actual_parameter_part_opt . 1)) (DO . (actual_parameter_part_opt
. 1)))
- ((default . error) (DO . (parameter_profile_opt . 0)) (SEMICOLON .
(parameter_profile_opt . 0)) (LEFT_PAREN . 787))
- ((default . error) (OR . (simple_statement . 8)) (THEN .
(simple_statement . 8)) (WHEN . (simple_statement . 8)) (EXCEPTION .
(simple_statement . 8)) (END . (simple_statement . 8)) (LESS_LESS .
(simple_statement . 8)) (IDENTIFIER . (simple_statement . 8)) (STRING_LITERAL .
(simple_statement . 8)) (CHARACTER_LITERAL . (simple_statement . 8)) (ACCEPT .
(simple_statement . 8)) (ABORT . (simple_statement . 8)) (BEGIN .
(simple_statement . 8)) (CASE . (simple_statement . 8)) (DECLARE . [...]
- ((default . error) (SEMICOLON . (identifier_opt . 0)) (IDENTIFIER .
703))
- ((default . error) (WHEN . 970))
- ((default . error) (END . (sequence_of_statements_opt . 0)) (EXCEPTION .
(sequence_of_statements_opt . 0)) (ACCEPT . (label_opt . 0)) (BEGIN .
(label_opt . 0)) (CASE . (label_opt . 0)) (DECLARE . (label_opt . 0)) (FOR .
(label_opt . 0)) (IF . (label_opt . 0)) (LOOP . (label_opt . 0)) (RETURN .
(label_opt . 0)) (SELECT . (label_opt . 0)) (WHILE . (label_opt . 0))
(STRING_LITERAL . (label_opt . 0)) (CHARACTER_LITERAL . (label_opt . 0)) (ABORT
. (label_opt . 0)) (DELAY . (label_opt . [...]
- ((default . error) (WHEN . (delay_statement . 1)) (EXCEPTION .
(delay_statement . 1)) (ELSIF . (delay_statement . 1)) (THEN . (delay_statement
. 1)) (ELSE . (delay_statement . 1)) (OR . (delay_statement . 1)) (END .
(delay_statement . 1)) (LESS_LESS . (delay_statement . 1)) (IDENTIFIER .
(delay_statement . 1)) (STRING_LITERAL . (delay_statement . 1))
(CHARACTER_LITERAL . (delay_statement . 1)) (ACCEPT . (delay_statement . 1))
(ABORT . (delay_statement . 1)) (BEGIN . (delay_statemen [...]
- ((default . error) (SEMICOLON . 968))
- ((default . error) (OR . (exit_statement . 1)) (THEN . (exit_statement .
1)) (WHEN . (exit_statement . 1)) (EXCEPTION . (exit_statement . 1)) (END .
(exit_statement . 1)) (LESS_LESS . (exit_statement . 1)) (IDENTIFIER .
(exit_statement . 1)) (STRING_LITERAL . (exit_statement . 1))
(CHARACTER_LITERAL . (exit_statement . 1)) (ACCEPT . (exit_statement . 1))
(ABORT . (exit_statement . 1)) (BEGIN . (exit_statement . 1)) (CASE .
(exit_statement . 1)) (DECLARE . (exit_statement . 1)) (DEL [...]
- ((default . error) (SEMICOLON . (expression_opt . 0)) (RAISE . 152)
(PLUS . 144) (MINUS . 143) (ABS . 147) (NOT . 150) (NUMERIC_LITERAL . 145)
(NULL . 151) (NEW . 149) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49) (LEFT_PAREN . 148))
- ((default . error) (OR . (simple_statement . 3)) (THEN .
(simple_statement . 3)) (WHEN . (simple_statement . 3)) (EXCEPTION .
(simple_statement . 3)) (END . (simple_statement . 3)) (LESS_LESS .
(simple_statement . 3)) (IDENTIFIER . (simple_statement . 3)) (STRING_LITERAL .
(simple_statement . 3)) (CHARACTER_LITERAL . (simple_statement . 3)) (ACCEPT .
(simple_statement . 3)) (ABORT . (simple_statement . 3)) (BEGIN .
(simple_statement . 3)) (CASE . (simple_statement . 3)) (DECLARE . [...]
- ((default . error) (ELSIF . (sequence_of_statements_opt . 0)) (ELSE .
(sequence_of_statements_opt . 0)) (END . (sequence_of_statements_opt . 0))
(ACCEPT . (label_opt . 0)) (BEGIN . (label_opt . 0)) (CASE . (label_opt . 0))
(DECLARE . (label_opt . 0)) (FOR . (label_opt . 0)) (IF . (label_opt . 0))
(LOOP . (label_opt . 0)) (RETURN . (label_opt . 0)) (SELECT . (label_opt . 0))
(WHILE . (label_opt . 0)) (STRING_LITERAL . (label_opt . 0)) (CHARACTER_LITERAL
. (label_opt . 0)) (ABORT . ( [...]
- ((default . error) (LOOP . 965))
- ((default . error) (OR . (raise_statement . 2)) (THEN . (raise_statement
. 2)) (WHEN . (raise_statement . 2)) (EXCEPTION . (raise_statement . 2)) (END .
(raise_statement . 2)) (LESS_LESS . (raise_statement . 2)) (IDENTIFIER .
(raise_statement . 2)) (STRING_LITERAL . (raise_statement . 2))
(CHARACTER_LITERAL . (raise_statement . 2)) (ACCEPT . (raise_statement . 2))
(ABORT . (raise_statement . 2)) (BEGIN . (raise_statement . 2)) (CASE .
(raise_statement . 2)) (DECLARE . (raise_statem [...]
- ((default . error) (RAISE . 152) (PLUS . 144) (MINUS . 143) (ABS .
147) (NOT . 150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
- ((default . error) (OR . (requeue_statement . 1)) (THEN .
(requeue_statement . 1)) (WHEN . (requeue_statement . 1)) (EXCEPTION .
(requeue_statement . 1)) (END . (requeue_statement . 1)) (LESS_LESS .
(requeue_statement . 1)) (IDENTIFIER . (requeue_statement . 1)) (STRING_LITERAL
. (requeue_statement . 1)) (CHARACTER_LITERAL . (requeue_statement . 1))
(ACCEPT . (requeue_statement . 1)) (ABORT . (requeue_statement . 1)) (BEGIN .
(requeue_statement . 1)) (CASE . (requeue_statement . 1) [...]
- ((default . error) (ABORT . 963))
- ((default . error) (END . (sequence_of_statements_opt . 0)) (EXCEPTION .
(sequence_of_statements_opt . 0)) (ACCEPT . (label_opt . 0)) (BEGIN .
(label_opt . 0)) (CASE . (label_opt . 0)) (DECLARE . (label_opt . 0)) (FOR .
(label_opt . 0)) (IF . (label_opt . 0)) (LOOP . (label_opt . 0)) (RETURN .
(label_opt . 0)) (SELECT . (label_opt . 0)) (WHILE . (label_opt . 0))
(STRING_LITERAL . (label_opt . 0)) (CHARACTER_LITERAL . (label_opt . 0)) (ABORT
. (label_opt . 0)) (DELAY . (label_opt . [...]
- ((default . error) (OR . (extended_return_statement . 1)) (THEN .
(extended_return_statement . 1)) (WHEN . (extended_return_statement . 1))
(EXCEPTION . (extended_return_statement . 1)) (END . (extended_return_statement
. 1)) (LESS_LESS . (extended_return_statement . 1)) (IDENTIFIER .
(extended_return_statement . 1)) (STRING_LITERAL . (extended_return_statement .
1)) (CHARACTER_LITERAL . (extended_return_statement . 1)) (ACCEPT .
(extended_return_statement . 1)) (ABORT . (extended_ [...]
- ((default . error) (OR . (simple_return_statement . 1)) (THEN .
(simple_return_statement . 1)) (WHEN . (simple_return_statement . 1))
(EXCEPTION . (simple_return_statement . 1)) (END . (simple_return_statement .
1)) (LESS_LESS . (simple_return_statement . 1)) (IDENTIFIER .
(simple_return_statement . 1)) (STRING_LITERAL . (simple_return_statement . 1))
(CHARACTER_LITERAL . (simple_return_statement . 1)) (ACCEPT .
(simple_return_statement . 1)) (ABORT . (simple_return_statement . 1)) [...]
- ((default . error) (CONSTANT . (aliased_opt . 0)) (IDENTIFIER .
(aliased_opt . 0)) (STRING_LITERAL . (aliased_opt . 0)) (CHARACTER_LITERAL .
(aliased_opt . 0)) (ACCESS . (aliased_opt . 0)) (NOT . (aliased_opt . 0))
(ALIASED . 517))
- ((default . error) (ABORT . 960))
- ((default . error) (END . (sequence_of_statements_opt . 0)) (ACCEPT .
(label_opt . 0)) (BEGIN . (label_opt . 0)) (CASE . (label_opt . 0)) (DECLARE .
(label_opt . 0)) (FOR . (label_opt . 0)) (IF . (label_opt . 0)) (LOOP .
(label_opt . 0)) (RETURN . (label_opt . 0)) (SELECT . (label_opt . 0)) (WHILE .
(label_opt . 0)) (STRING_LITERAL . (label_opt . 0)) (CHARACTER_LITERAL .
(label_opt . 0)) (ABORT . (label_opt . 0)) (DELAY . (label_opt . 0)) (EXIT .
(label_opt . 0)) (GOTO . (label_opt [...]
- ((default . error) (SELECT . 958))
- ((default . error) (WHEN . 678) (TERMINATE . 677) (ACCEPT . 621)
(DELAY . 626))
+ ((default . error) (DO . (parameter_profile_opt . 0)) (SEMICOLON .
(parameter_profile_opt . 0)) (LEFT_PAREN . 808))
+ ((default . error) (OR . (simple_statement . 8)) (THEN .
(simple_statement . 8)) (WHEN . (simple_statement . 8)) (EXCEPTION .
(simple_statement . 8)) (END . (simple_statement . 8)) (ACCEPT .
(simple_statement . 8)) (ABORT . (simple_statement . 8)) (BEGIN .
(simple_statement . 8)) (CASE . (simple_statement . 8)) (DECLARE .
(simple_statement . 8)) (DELAY . (simple_statement . 8)) (EXIT .
(simple_statement . 8)) (FOR . (simple_statement . 8)) (GOTO .
(simple_statement . 8)) (IF . (sim [...]
+ ((default . error) (SEMICOLON . (identifier_opt . 0)) (IDENTIFIER .
716))
+ ((default . error) (WHEN . 980))
+ ((default . error) (END . (sequence_of_statements_opt . 0)) (EXCEPTION .
(sequence_of_statements_opt . 0)) (ACCEPT . (label_opt . 0)) (BEGIN .
(label_opt . 0)) (CASE . (label_opt . 0)) (DECLARE . (label_opt . 0)) (FOR .
(label_opt . 0)) (IF . (label_opt . 0)) (LOOP . (label_opt . 0)) (RETURN .
(label_opt . 0)) (SELECT . (label_opt . 0)) (WHILE . (label_opt . 0)) (ABORT .
(label_opt . 0)) (DELAY . (label_opt . 0)) (EXIT . (label_opt . 0)) (GOTO .
(label_opt . 0)) (NULL . (label_opt [...]
+ ((default . error) (WHEN . (delay_statement . 1)) (EXCEPTION .
(delay_statement . 1)) (ELSIF . (delay_statement . 1)) (THEN . (delay_statement
. 1)) (ELSE . (delay_statement . 1)) (OR . (delay_statement . 1)) (END .
(delay_statement . 1)) (ACCEPT . (delay_statement . 1)) (ABORT .
(delay_statement . 1)) (BEGIN . (delay_statement . 1)) (CASE . (delay_statement
. 1)) (DECLARE . (delay_statement . 1)) (DELAY . (delay_statement . 1)) (EXIT .
(delay_statement . 1)) (FOR . (delay_statemen [...]
+ ((default . error) (SEMICOLON . 978))
+ ((default . error) (SEMICOLON . (expression_opt . 0)) (RAISE . 152)
(PLUS . 154) (MINUS . 153) (ABS . 144) (NOT . 150) (NUMERIC_LITERAL . 155)
(NULL . 151) (NEW . 149) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49) (LEFT_PAREN . 148))
+ ((default . error) (OR . (exit_statement . 1)) (THEN . (exit_statement .
1)) (WHEN . (exit_statement . 1)) (EXCEPTION . (exit_statement . 1)) (END .
(exit_statement . 1)) (ACCEPT . (exit_statement . 1)) (ABORT . (exit_statement
. 1)) (BEGIN . (exit_statement . 1)) (CASE . (exit_statement . 1)) (DECLARE .
(exit_statement . 1)) (DELAY . (exit_statement . 1)) (EXIT . (exit_statement .
1)) (FOR . (exit_statement . 1)) (GOTO . (exit_statement . 1)) (IF .
(exit_statement . 1)) (LOOP . (e [...]
+ ((default . error) (OR . (simple_statement . 3)) (THEN .
(simple_statement . 3)) (WHEN . (simple_statement . 3)) (EXCEPTION .
(simple_statement . 3)) (END . (simple_statement . 3)) (ACCEPT .
(simple_statement . 3)) (ABORT . (simple_statement . 3)) (BEGIN .
(simple_statement . 3)) (CASE . (simple_statement . 3)) (DECLARE .
(simple_statement . 3)) (DELAY . (simple_statement . 3)) (EXIT .
(simple_statement . 3)) (FOR . (simple_statement . 3)) (GOTO .
(simple_statement . 3)) (IF . (sim [...]
+ ((default . error) (ELSIF . (sequence_of_statements_opt . 0)) (ELSE .
(sequence_of_statements_opt . 0)) (END . (sequence_of_statements_opt . 0))
(ACCEPT . (label_opt . 0)) (BEGIN . (label_opt . 0)) (CASE . (label_opt . 0))
(DECLARE . (label_opt . 0)) (FOR . (label_opt . 0)) (IF . (label_opt . 0))
(LOOP . (label_opt . 0)) (RETURN . (label_opt . 0)) (SELECT . (label_opt . 0))
(WHILE . (label_opt . 0)) (ABORT . (label_opt . 0)) (DELAY . (label_opt . 0))
(EXIT . (label_opt . 0)) (GOTO [...]
+ ((default . error) (LOOP . 975))
+ ((default . error) (RAISE . 152) (PLUS . 154) (MINUS . 153) (ABS .
144) (NOT . 150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
+ ((default . error) (OR . (raise_statement . 2)) (THEN . (raise_statement
. 2)) (WHEN . (raise_statement . 2)) (EXCEPTION . (raise_statement . 2)) (END .
(raise_statement . 2)) (ACCEPT . (raise_statement . 2)) (ABORT .
(raise_statement . 2)) (BEGIN . (raise_statement . 2)) (CASE . (raise_statement
. 2)) (DECLARE . (raise_statement . 2)) (DELAY . (raise_statement . 2)) (EXIT .
(raise_statement . 2)) (FOR . (raise_statement . 2)) (GOTO . (raise_statement .
2)) (IF . (raise_statement . [...]
+ ((default . error) (ABORT . 973))
+ ((default . error) (OR . (requeue_statement . 1)) (THEN .
(requeue_statement . 1)) (WHEN . (requeue_statement . 1)) (EXCEPTION .
(requeue_statement . 1)) (END . (requeue_statement . 1)) (ACCEPT .
(requeue_statement . 1)) (ABORT . (requeue_statement . 1)) (BEGIN .
(requeue_statement . 1)) (CASE . (requeue_statement . 1)) (DECLARE .
(requeue_statement . 1)) (DELAY . (requeue_statement . 1)) (EXIT .
(requeue_statement . 1)) (FOR . (requeue_statement . 1)) (GOTO .
(requeue_statement . [...]
+ ((default . error) (END . (sequence_of_statements_opt . 0)) (EXCEPTION .
(sequence_of_statements_opt . 0)) (ACCEPT . (label_opt . 0)) (BEGIN .
(label_opt . 0)) (CASE . (label_opt . 0)) (DECLARE . (label_opt . 0)) (FOR .
(label_opt . 0)) (IF . (label_opt . 0)) (LOOP . (label_opt . 0)) (RETURN .
(label_opt . 0)) (SELECT . (label_opt . 0)) (WHILE . (label_opt . 0)) (ABORT .
(label_opt . 0)) (DELAY . (label_opt . 0)) (EXIT . (label_opt . 0)) (GOTO .
(label_opt . 0)) (NULL . (label_opt [...]
+ ((default . error) (OR . (extended_return_statement . 1)) (THEN .
(extended_return_statement . 1)) (WHEN . (extended_return_statement . 1))
(EXCEPTION . (extended_return_statement . 1)) (END . (extended_return_statement
. 1)) (ACCEPT . (extended_return_statement . 1)) (ABORT .
(extended_return_statement . 1)) (BEGIN . (extended_return_statement . 1))
(CASE . (extended_return_statement . 1)) (DECLARE . (extended_return_statement
. 1)) (DELAY . (extended_return_statement . 1)) (EXIT [...]
+ ((default . error) (OR . (simple_return_statement . 1)) (THEN .
(simple_return_statement . 1)) (WHEN . (simple_return_statement . 1))
(EXCEPTION . (simple_return_statement . 1)) (END . (simple_return_statement .
1)) (ACCEPT . (simple_return_statement . 1)) (ABORT . (simple_return_statement
. 1)) (BEGIN . (simple_return_statement . 1)) (CASE . (simple_return_statement
. 1)) (DECLARE . (simple_return_statement . 1)) (DELAY .
(simple_return_statement . 1)) (EXIT . (simple_return_state [...]
+ ((default . error) (CONSTANT . (aliased_opt . 0)) (ACCESS . (aliased_opt
. 0)) (NOT . (aliased_opt . 0)) (IDENTIFIER . (aliased_opt . 0))
(STRING_LITERAL . (aliased_opt . 0)) (CHARACTER_LITERAL . (aliased_opt . 0))
(ALIASED . 531))
+ ((default . error) (ABORT . 970))
+ ((default . error) (END . (sequence_of_statements_opt . 0)) (ACCEPT .
(label_opt . 0)) (BEGIN . (label_opt . 0)) (CASE . (label_opt . 0)) (DECLARE .
(label_opt . 0)) (FOR . (label_opt . 0)) (IF . (label_opt . 0)) (LOOP .
(label_opt . 0)) (RETURN . (label_opt . 0)) (SELECT . (label_opt . 0)) (WHILE .
(label_opt . 0)) (ABORT . (label_opt . 0)) (DELAY . (label_opt . 0)) (EXIT .
(label_opt . 0)) (GOTO . (label_opt . 0)) (NULL . (label_opt . 0)) (PRAGMA .
(label_opt . 0)) (RAISE . (labe [...]
+ ((default . error) (SELECT . 968))
+ ((default . error) (WHEN . 691) (TERMINATE . 690) (ACCEPT . 630)
(DELAY . 635))
((default . error) (OR . (entry_call_alternative . 0)) (ELSE .
(entry_call_alternative . 0)) (THEN . (triggering_alternative . 0)))
((default . error) (OR . (entry_call_alternative . 1)) (ELSE .
(entry_call_alternative . 1)) (THEN . (triggering_alternative . 1)))
- ((default . error) (END . (sequence_of_statements_opt . 0)) (ACCEPT .
(label_opt . 0)) (BEGIN . (label_opt . 0)) (CASE . (label_opt . 0)) (DECLARE .
(label_opt . 0)) (FOR . (label_opt . 0)) (IF . (label_opt . 0)) (LOOP .
(label_opt . 0)) (RETURN . (label_opt . 0)) (SELECT . (label_opt . 0)) (WHILE .
(label_opt . 0)) (STRING_LITERAL . (label_opt . 0)) (CHARACTER_LITERAL .
(label_opt . 0)) (ABORT . (label_opt . 0)) (DELAY . (label_opt . 0)) (EXIT .
(label_opt . 0)) (GOTO . (label_opt [...]
- ((default . error) (DELAY . 626))
+ ((default . error) (END . (sequence_of_statements_opt . 0)) (ACCEPT .
(label_opt . 0)) (BEGIN . (label_opt . 0)) (CASE . (label_opt . 0)) (DECLARE .
(label_opt . 0)) (FOR . (label_opt . 0)) (IF . (label_opt . 0)) (LOOP .
(label_opt . 0)) (RETURN . (label_opt . 0)) (SELECT . (label_opt . 0)) (WHILE .
(label_opt . 0)) (ABORT . (label_opt . 0)) (DELAY . (label_opt . 0)) (EXIT .
(label_opt . 0)) (GOTO . (label_opt . 0)) (NULL . (label_opt . 0)) (PRAGMA .
(label_opt . 0)) (RAISE . (labe [...]
+ ((default . error) (DELAY . 635))
((default . error) (OR . (delay_alternative . 0)) (END .
(delay_alternative . 0)) (ELSE . (delay_alternative . 0)) (THEN .
(triggering_alternative . 2)))
((default . error) (END . (select_alternative . 1)) (OR .
(select_alternative . 1)) (ELSE . (select_alternative . 1)))
- ((default . error) (EQUAL_GREATER . 953))
+ ((default . error) (EQUAL_GREATER . 963))
((default . error) (END . (select_alternative . 5)) (OR .
(select_alternative . 5)) (ELSE . (select_alternative . 5)))
- ((default . error) (SEMICOLON . 952))
- ((default . error) (END . 951))
- ((default . error) (SEMICOLON . 950))
- ((default . error) (OTHERS . 946) (IDENTIFIER . 945)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49))
+ ((default . error) (ACCEPT . (label_opt . 1)) (BEGIN . (label_opt . 1))
(CASE . (label_opt . 1)) (DECLARE . (label_opt . 1)) (FOR . (label_opt . 1))
(IF . (label_opt . 1)) (LOOP . (label_opt . 1)) (RETURN . (label_opt . 1))
(SELECT . (label_opt . 1)) (WHILE . (label_opt . 1)) (ABORT . (label_opt . 1))
(DELAY . (label_opt . 1)) (EXIT . (label_opt . 1)) (GOTO . (label_opt . 1))
(NULL . (label_opt . 1)) (PRAGMA . (label_opt . 1)) (RAISE . (label_opt . 1))
(REQUEUE . (label_opt . 1)) ( [...]
+ ((default . error) (SEMICOLON . 962))
+ ((default . error) (END . 961))
+ ((default . error) (SEMICOLON . 960))
+ ((default . error) (OTHERS . 955) (IDENTIFIER . 956)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49))
((default . error) (END . (exception_handler_list . 0)) (WHEN .
(exception_handler_list . 0)))
- ((default . error) (END . (exception_handler_list_opt . 1)) (WHEN .
940))
+ ((default . error) (END . (exception_handler_list_opt . 1)) (WHEN .
950))
((default . error) (END . (handled_sequence_of_statements . 0)))
((default . error) (WHEN . (exception_handler_list . 1)) (END .
(exception_handler_list . 1)))
- ((default . error) (COLON . 1178) (EQUAL_GREATER . (name . 0)) (BAR .
(name . 0)) (LEFT_PAREN . (name . 0)) (DOT . (name . 0)) (TICK . (name . 0)))
((default . error) (BAR . (exception_choice . 1)) (EQUAL_GREATER .
(exception_choice . 1)))
+ ((default . error) (COLON . 1182) (EQUAL_GREATER . (name . 0)) (BAR .
(name . 0)) (LEFT_PAREN . (name . 0)) (DOT . (name . 0)) (TICK . (name . 0)))
((default . error) (EQUAL_GREATER . (exception_choice_list . 0)) (BAR .
(exception_choice_list . 0)))
- ((default . error) (BAR . 1176) (EQUAL_GREATER . 1177))
- ((default . error) (DOT . 87) (BAR . (exception_choice . 0))
(EQUAL_GREATER . (exception_choice . 0)) (TICK . 88) (LEFT_PAREN . 106))
- ((default . error) (WHEN . (assignment_statement . 0)) (THEN .
(assignment_statement . 0)) (OR . (assignment_statement . 0)) (ELSIF .
(assignment_statement . 0)) (ELSE . (assignment_statement . 0)) (WHILE .
(assignment_statement . 0)) (SELECT . (assignment_statement . 0)) (RETURN .
(assignment_statement . 0)) (REQUEUE . (assignment_statement . 0)) (RAISE .
(assignment_statement . 0)) (PRAGMA . (assignment_statement . 0)) (NULL .
(assignment_statement . 0)) (LOOP . (assignment_state [...]
- ((default . error) (LOOP . 1175))
- ((default . error) (TYPE . (subprogram_body . 0)) (TASK .
(subprogram_body . 0)) (SUBTYPE . (subprogram_body . 0)) (PROTECTED .
(subprogram_body . 0)) (FOR . (subprogram_body . 0)) (ENTRY . (subprogram_body
. 0)) (IDENTIFIER . (subprogram_body . 0)) (BEGIN . (subprogram_body . 0)) (END
. (subprogram_body . 0)) ($EOI . (subprogram_body . 0)) (FUNCTION .
(subprogram_body . 0)) (GENERIC . (subprogram_body . 0)) (LIMITED .
(subprogram_body . 0)) (NOT . (subprogram_body . 0)) (OVERRIDIN [...]
- ((default . error) (TERMINATE . 1172) (ACCEPT . 621) (DELAY . 626))
- ((default . error) (END . 1171))
- ((default . error) (END . (sequence_of_statements_opt . 0)) (OR .
(sequence_of_statements_opt . 0)) (ELSE . (sequence_of_statements_opt . 0))
(ACCEPT . (label_opt . 0)) (BEGIN . (label_opt . 0)) (CASE . (label_opt . 0))
(DECLARE . (label_opt . 0)) (FOR . (label_opt . 0)) (IF . (label_opt . 0))
(LOOP . (label_opt . 0)) (RETURN . (label_opt . 0)) (SELECT . (label_opt . 0))
(WHILE . (label_opt . 0)) (STRING_LITERAL . (label_opt . 0)) (CHARACTER_LITERAL
. (label_opt . 0)) (ABORT . (lab [...]
- ((default . error) (END . 1169))
+ ((default . error) (BAR . 1180) (EQUAL_GREATER . 1181))
+ ((default . error) (DOT . 90) (BAR . (exception_choice . 0))
(EQUAL_GREATER . (exception_choice . 0)) (TICK . 91) (LEFT_PAREN . 107))
+ ((default . error) (WHEN . (assignment_statement . 0)) (THEN .
(assignment_statement . 0)) (OR . (assignment_statement . 0)) (ELSIF .
(assignment_statement . 0)) (ELSE . (assignment_statement . 0))
(CHARACTER_LITERAL . (assignment_statement . 0)) (STRING_LITERAL .
(assignment_statement . 0)) (IDENTIFIER . (assignment_statement . 0))
(LESS_LESS . (assignment_statement . 0)) (WHILE . (assignment_statement . 0))
(SELECT . (assignment_statement . 0)) (RETURN . (assignment_statement . 0 [...]
+ ((default . error) (LOOP . 1179))
+ ((default . error) (IDENTIFIER . (subprogram_body . 0)) (TYPE .
(subprogram_body . 0)) (TASK . (subprogram_body . 0)) (SUBTYPE .
(subprogram_body . 0)) (PROTECTED . (subprogram_body . 0)) (FOR .
(subprogram_body . 0)) (ENTRY . (subprogram_body . 0)) (BEGIN .
(subprogram_body . 0)) (END . (subprogram_body . 0)) ($EOI . (subprogram_body .
0)) (FUNCTION . (subprogram_body . 0)) (GENERIC . (subprogram_body . 0))
(LIMITED . (subprogram_body . 0)) (NOT . (subprogram_body . 0)) (OVERRIDIN [...]
+ ((default . error) (TERMINATE . 1176) (ACCEPT . 630) (DELAY . 635))
+ ((default . error) (END . 1175))
+ ((default . error) (END . (sequence_of_statements_opt . 0)) (OR .
(sequence_of_statements_opt . 0)) (ELSE . (sequence_of_statements_opt . 0))
(ACCEPT . (label_opt . 0)) (BEGIN . (label_opt . 0)) (CASE . (label_opt . 0))
(DECLARE . (label_opt . 0)) (FOR . (label_opt . 0)) (IF . (label_opt . 0))
(LOOP . (label_opt . 0)) (RETURN . (label_opt . 0)) (SELECT . (label_opt . 0))
(WHILE . (label_opt . 0)) (ABORT . (label_opt . 0)) (DELAY . (label_opt . 0))
(EXIT . (label_opt . 0)) (GOTO . ( [...]
+ ((default . error) (END . 1173))
((default . error) (ELSE . (select_alternative_list . 1)) (END .
(select_alternative_list . 1)) (OR . (select_alternative_list . 1)))
- ((default . error) (SEMICOLON . 1168))
- ((default . error) (END . 1167))
- ((default . error) (END . (sequence_of_statements_opt . 0)) (ACCEPT .
(label_opt . 0)) (BEGIN . (label_opt . 0)) (CASE . (label_opt . 0)) (DECLARE .
(label_opt . 0)) (FOR . (label_opt . 0)) (IF . (label_opt . 0)) (LOOP .
(label_opt . 0)) (RETURN . (label_opt . 0)) (SELECT . (label_opt . 0)) (WHILE .
(label_opt . 0)) (STRING_LITERAL . (label_opt . 0)) (CHARACTER_LITERAL .
(label_opt . 0)) (ABORT . (label_opt . 0)) (DELAY . (label_opt . 0)) (EXIT .
(label_opt . 0)) (GOTO . (label_opt [...]
- ((default . error) (IDENTIFIER . (constant_opt . 0)) (STRING_LITERAL .
(constant_opt . 0)) (CHARACTER_LITERAL . (constant_opt . 0)) (ACCESS .
(constant_opt . 0)) (NOT . (constant_opt . 0)) (CONSTANT . 730))
- ((default . error) (END . 1164))
- ((default . error) (SEMICOLON . 1163))
- ((default . error) (SEMICOLON . 1162))
- ((default . error) (SEMICOLON . (identifier_opt . 0)) (IDENTIFIER .
703))
- ((default . error) (ELSE . 1156) (END . 1158) (ELSIF . 1157))
- ((default . error) (SEMICOLON . 1155))
- ((default . error) (WHEN . (delay_statement . 0)) (ELSIF .
(delay_statement . 0)) (EXCEPTION . (delay_statement . 0)) (WHILE .
(delay_statement . 0)) (SELECT . (delay_statement . 0)) (RETURN .
(delay_statement . 0)) (REQUEUE . (delay_statement . 0)) (RAISE .
(delay_statement . 0)) (PRAGMA . (delay_statement . 0)) (NULL .
(delay_statement . 0)) (LOOP . (delay_statement . 0)) (IF . (delay_statement .
0)) (GOTO . (delay_statement . 0)) (FOR . (delay_statement . 0)) (EXIT .
(delay_stat [...]
- ((default . error) (END . 1154))
- ((default . error) (EQUAL_GREATER . (discrete_choice_list . 0)) (BAR .
(discrete_choice_list . 0)) (OTHERS . 175) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (PLUS . 144) (MINUS . 143)
(ABS . 147) (NOT . 174) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149)
(LEFT_PAREN . 148))
+ ((default . error) (SEMICOLON . 1172))
+ ((default . error) (END . 1171))
+ ((default . error) (END . (sequence_of_statements_opt . 0)) (ACCEPT .
(label_opt . 0)) (BEGIN . (label_opt . 0)) (CASE . (label_opt . 0)) (DECLARE .
(label_opt . 0)) (FOR . (label_opt . 0)) (IF . (label_opt . 0)) (LOOP .
(label_opt . 0)) (RETURN . (label_opt . 0)) (SELECT . (label_opt . 0)) (WHILE .
(label_opt . 0)) (ABORT . (label_opt . 0)) (DELAY . (label_opt . 0)) (EXIT .
(label_opt . 0)) (GOTO . (label_opt . 0)) (NULL . (label_opt . 0)) (PRAGMA .
(label_opt . 0)) (RAISE . (labe [...]
+ ((default . error) (ACCESS . (constant_opt . 0)) (NOT . (constant_opt .
0)) (IDENTIFIER . (constant_opt . 0)) (STRING_LITERAL . (constant_opt . 0))
(CHARACTER_LITERAL . (constant_opt . 0)) (CONSTANT . 757))
+ ((default . error) (END . 1168))
+ ((default . error) (SEMICOLON . 1167))
+ ((default . error) (SEMICOLON . 1166))
+ ((default . error) (SEMICOLON . (identifier_opt . 0)) (IDENTIFIER .
716))
+ ((default . error) (ELSE . 1160) (END . 1162) (ELSIF . 1161))
+ ((default . error) (SEMICOLON . 1159))
+ ((default . error) (WHEN . (delay_statement . 0)) (ELSIF .
(delay_statement . 0)) (EXCEPTION . (delay_statement . 0)) (CHARACTER_LITERAL .
(delay_statement . 0)) (STRING_LITERAL . (delay_statement . 0)) (IDENTIFIER .
(delay_statement . 0)) (LESS_LESS . (delay_statement . 0)) (WHILE .
(delay_statement . 0)) (SELECT . (delay_statement . 0)) (RETURN .
(delay_statement . 0)) (REQUEUE . (delay_statement . 0)) (RAISE .
(delay_statement . 0)) (PRAGMA . (delay_statement . 0)) (NULL . (dela [...]
+ ((default . error) (END . 1158))
+ ((default . error) (EQUAL_GREATER . (discrete_choice_list . 0)) (BAR .
(discrete_choice_list . 0)) (OTHERS . 182) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (PLUS . 154) (MINUS . 153)
(ABS . 144) (NOT . 181) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149)
(LEFT_PAREN . 148))
((default . error) (END . (case_statement_alternative_list . 0)) (WHEN .
(case_statement_alternative_list . 0)))
- ((default . error) (END . 1151) (WHEN . 970))
- ((default . error) (SEMICOLON . 1150))
- ((default . error) (DO . 1149) (SEMICOLON . 1148))
- ((default . error) (BEGIN . 1147))
- ((default . error) (IDENTIFIER . 1146))
- ((default . error) (PROCEDURE . (protected_operation_item . 3))
(OVERRIDING . (protected_operation_item . 3)) (NOT . (protected_operation_item
. 3)) (FUNCTION . (protected_operation_item . 3)) (FOR .
(protected_operation_item . 3)) (ENTRY . (protected_operation_item . 3)) (END .
(protected_operation_item . 3)))
+ ((default . error) (END . 1155) (WHEN . 980))
+ ((default . error) (SEMICOLON . 1154))
+ ((default . error) (DO . 1152) (SEMICOLON . 1153))
+ ((default . error) (BEGIN . 1151))
+ ((default . error) (IDENTIFIER . 1150))
+ ((default . error) (PROCEDURE . (protected_operation_item . 5))
(OVERRIDING . (protected_operation_item . 5)) (NOT . (protected_operation_item
. 5)) (FUNCTION . (protected_operation_item . 5)) (FOR .
(protected_operation_item . 5)) (ENTRY . (protected_operation_item . 5)) (END .
(protected_operation_item . 5)))
((default . error) (PROCEDURE . (protected_operation_item . 2))
(OVERRIDING . (protected_operation_item . 2)) (NOT . (protected_operation_item
. 2)) (FUNCTION . (protected_operation_item . 2)) (FOR .
(protected_operation_item . 2)) (ENTRY . (protected_operation_item . 2)) (END .
(protected_operation_item . 2)))
+ ((default . error) (PROCEDURE . (protected_operation_item . 3))
(OVERRIDING . (protected_operation_item . 3)) (NOT . (protected_operation_item
. 3)) (FUNCTION . (protected_operation_item . 3)) (FOR .
(protected_operation_item . 3)) (ENTRY . (protected_operation_item . 3)) (END .
(protected_operation_item . 3)))
+ ((default . error) (PROCEDURE . (protected_operation_item . 4))
(OVERRIDING . (protected_operation_item . 4)) (NOT . (protected_operation_item
. 4)) (FUNCTION . (protected_operation_item . 4)) (FOR .
(protected_operation_item . 4)) (ENTRY . (protected_operation_item . 4)) (END .
(protected_operation_item . 4)))
((default . error) (FUNCTION . 1) (PROCEDURE . 9))
((default . error) (END . (protected_operation_item_list . 0)) (ENTRY .
(protected_operation_item_list . 0)) (FOR . (protected_operation_item_list .
0)) (FUNCTION . (protected_operation_item_list . 0)) (NOT .
(protected_operation_item_list . 0)) (OVERRIDING .
(protected_operation_item_list . 0)) (PROCEDURE .
(protected_operation_item_list . 0)))
- ((default . error) (END . (protected_operation_item_list_opt . 1))
(ENTRY . 976) (NOT . 4) (OVERRIDING . 5) (FUNCTION .
(overriding_indicator_opt . 2)) (PROCEDURE . (overriding_indicator_opt . 2))
(FOR . 296))
- ((default . error) (END . 1143))
+ ((default . error) (END . (protected_operation_item_list_opt . 1))
(ENTRY . 986) (NOT . 4) (OVERRIDING . 5) (FUNCTION .
(overriding_indicator_opt . 2)) (PROCEDURE . (overriding_indicator_opt . 2))
(FOR . 299))
+ ((default . error) (END . 1147))
((default . error) (PROCEDURE . (protected_operation_item . 1))
(OVERRIDING . (protected_operation_item . 1)) (NOT . (protected_operation_item
. 1)) (FUNCTION . (protected_operation_item . 1)) (FOR .
(protected_operation_item . 1)) (ENTRY . (protected_operation_item . 1)) (END .
(protected_operation_item . 1)))
((default . error) (PROCEDURE . (protected_operation_item . 0))
(OVERRIDING . (protected_operation_item . 0)) (NOT . (protected_operation_item
. 0)) (FUNCTION . (protected_operation_item . 0)) (FOR .
(protected_operation_item . 0)) (ENTRY . (protected_operation_item . 0)) (END .
(protected_operation_item . 0)))
- ((default . error) (REVERSE . 1141) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49))
- ((default . error) (LOOP . (iterator_specification . 0)) (EQUAL_GREATER
. (iterator_specification . 0)))
- ((default . error) (DOT . 87) (TICK . 88) (LOOP .
(iterator_specification . 4)) (EQUAL_GREATER . (iterator_specification . 4))
(LEFT_PAREN . 106))
- ((default . error) (SEMICOLON . 1140))
- ((default . error) (WITH . (parameter_profile_opt . 0)) (SEMICOLON .
(parameter_profile_opt . 0)) (LEFT_PAREN . 787))
- ((default . error) (USE . (entry_declaration . 1)) (TYPE .
(entry_declaration . 1)) (TASK . (entry_declaration . 1)) (SUBTYPE .
(entry_declaration . 1)) (PROTECTED . (entry_declaration . 1)) (PROCEDURE .
(entry_declaration . 1)) (PRAGMA . (entry_declaration . 1)) (PACKAGE .
(entry_declaration . 1)) (OVERRIDING . (entry_declaration . 1)) (NOT .
(entry_declaration . 1)) (GENERIC . (entry_declaration . 1)) (FUNCTION .
(entry_declaration . 1)) (FOR . (entry_declaration . 1)) (ENTRY . ( [...]
- ((default . error) (WITH . (paren_expression . 2)) (SEMICOLON .
(paren_expression . 2)))
+ ((default . error) (COMMA . (case_expression_alternative . 0))
(RIGHT_PAREN . (case_expression_alternative . 0)))
+ ((default . error) (DO . (subtype_indication . 1)) (LOOP .
(subtype_indication . 1)) (COLON_EQUAL . (subtype_indication . 1)) (SEMICOLON .
(subtype_indication . 1)) (OF . (subtype_indication . 1)) (AND .
(subtype_indication . 1)) (WITH . (subtype_indication . 1)) (EQUAL_GREATER .
(subtype_indication . 1)) (COMMA . (subtype_indication . 1)) (RIGHT_PAREN .
(subtype_indication . 1)) (DOT . 90) (TICK . 91) (RANGE . 902) (LEFT_PAREN .
827))
+ ((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
+ ((default . error) (DOT . 90) (TICK . 91) (LOOP .
(iterator_specification . 3)) (EQUAL_GREATER . (iterator_specification . 3))
(LEFT_PAREN . 107))
+ ((default . error) (DO . (constraint . 0)) (LOOP . (constraint . 0)) (OF
. (constraint . 0)) (AND . (constraint . 0)) (SEMICOLON . (constraint . 0))
(WITH . (constraint . 0)) (COLON_EQUAL . (constraint . 0)) (EQUAL_GREATER .
(constraint . 0)) (RIGHT_PAREN . (constraint . 0)) (COMMA . (constraint . 0)))
+ ((default . error) (RAISE . 152) (PLUS . 154) (MINUS . 153) (ABS .
144) (NOT . 150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
+ ((default . error) (COMMA . (if_expression . 0)) (RIGHT_PAREN .
(if_expression . 0)))
+ ((default . error) (SEMICOLON . 1143))
+ ((default . error) (WITH . (parameter_profile_opt . 0)) (SEMICOLON .
(parameter_profile_opt . 0)) (LEFT_PAREN . 808))
+ ((default . error) (IDENTIFIER . (entry_declaration . 1)) (USE .
(entry_declaration . 1)) (TYPE . (entry_declaration . 1)) (TASK .
(entry_declaration . 1)) (SUBTYPE . (entry_declaration . 1)) (PROTECTED .
(entry_declaration . 1)) (PROCEDURE . (entry_declaration . 1)) (PRAGMA .
(entry_declaration . 1)) (PACKAGE . (entry_declaration . 1)) (OVERRIDING .
(entry_declaration . 1)) (NOT . (entry_declaration . 1)) (GENERIC .
(entry_declaration . 1)) (FUNCTION . (entry_declaration . 1)) (FO [...]
((default . error) (WITH . (paren_expression . 0)) (SEMICOLON .
(paren_expression . 0)))
((default . error) (WITH . (paren_expression . 1)) (SEMICOLON .
(paren_expression . 1)))
- ((default . error) (USE . (expression_function_declaration . 0)) (TYPE .
(expression_function_declaration . 0)) (TASK . (expression_function_declaration
. 0)) (SUBTYPE . (expression_function_declaration . 0)) (PROTECTED .
(expression_function_declaration . 0)) (PROCEDURE .
(expression_function_declaration . 0)) (PRAGMA .
(expression_function_declaration . 0)) (PACKAGE .
(expression_function_declaration . 0)) (OVERRIDING .
(expression_function_declaration . 0)) (NOT . (expression_fu [...]
- ((default . error) (USE . (null_procedure_declaration . 0)) (TYPE .
(null_procedure_declaration . 0)) (TASK . (null_procedure_declaration . 0))
(SUBTYPE . (null_procedure_declaration . 0)) (PROTECTED .
(null_procedure_declaration . 0)) (PROCEDURE . (null_procedure_declaration .
0)) (PRAGMA . (null_procedure_declaration . 0)) (PACKAGE .
(null_procedure_declaration . 0)) (OVERRIDING . (null_procedure_declaration .
0)) (NOT . (null_procedure_declaration . 0)) (GENERIC . (null_procedur [...]
- ((default . error) (USE . (abstract_subprogram_declaration . 0)) (TYPE .
(abstract_subprogram_declaration . 0)) (TASK . (abstract_subprogram_declaration
. 0)) (SUBTYPE . (abstract_subprogram_declaration . 0)) (PROTECTED .
(abstract_subprogram_declaration . 0)) (PROCEDURE .
(abstract_subprogram_declaration . 0)) (PRAGMA .
(abstract_subprogram_declaration . 0)) (PACKAGE .
(abstract_subprogram_declaration . 0)) (OVERRIDING .
(abstract_subprogram_declaration . 0)) (NOT . (abstract_subp [...]
- ((default . error) (USE . (subprogram_body_stub . 0)) (TYPE .
(subprogram_body_stub . 0)) (TASK . (subprogram_body_stub . 0)) (SUBTYPE .
(subprogram_body_stub . 0)) (PROTECTED . (subprogram_body_stub . 0)) (PROCEDURE
. (subprogram_body_stub . 0)) (PRAGMA . (subprogram_body_stub . 0)) (PACKAGE .
(subprogram_body_stub . 0)) (OVERRIDING . (subprogram_body_stub . 0)) (NOT .
(subprogram_body_stub . 0)) (GENERIC . (subprogram_body_stub . 0)) (FUNCTION .
(subprogram_body_stub . 0)) (FOR . [...]
- ((default . error) (RAISE . 152) (PLUS . 144) (MINUS . 143) (ABS .
147) (NOT . 150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
- ((default . error) (SEMICOLON . 1137))
- ((default . error) (RAISE . 152) (PLUS . 144) (MINUS . 143) (ABS .
147) (NOT . 150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
- ((default . error) (SEMICOLON . 1135))
- ((default . error) (RAISE . 152) (PLUS . 144) (MINUS . 143) (ABS .
147) (NOT . 150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
- ((default . error) (SEMICOLON . 1133))
+ ((default . error) (IDENTIFIER . (expression_function_declaration . 0))
(USE . (expression_function_declaration . 0)) (TYPE .
(expression_function_declaration . 0)) (TASK . (expression_function_declaration
. 0)) (SUBTYPE . (expression_function_declaration . 0)) (PROTECTED .
(expression_function_declaration . 0)) (PROCEDURE .
(expression_function_declaration . 0)) (PRAGMA .
(expression_function_declaration . 0)) (PACKAGE .
(expression_function_declaration . 0)) (OVERRIDING . (expres [...]
+ ((default . error) (IDENTIFIER . (null_procedure_declaration . 0)) (USE
. (null_procedure_declaration . 0)) (TYPE . (null_procedure_declaration . 0))
(TASK . (null_procedure_declaration . 0)) (SUBTYPE .
(null_procedure_declaration . 0)) (PROTECTED . (null_procedure_declaration .
0)) (PROCEDURE . (null_procedure_declaration . 0)) (PRAGMA .
(null_procedure_declaration . 0)) (PACKAGE . (null_procedure_declaration . 0))
(OVERRIDING . (null_procedure_declaration . 0)) (NOT . (null_proce [...]
+ ((default . error) (IDENTIFIER . (abstract_subprogram_declaration . 0))
(USE . (abstract_subprogram_declaration . 0)) (TYPE .
(abstract_subprogram_declaration . 0)) (TASK . (abstract_subprogram_declaration
. 0)) (SUBTYPE . (abstract_subprogram_declaration . 0)) (PROTECTED .
(abstract_subprogram_declaration . 0)) (PROCEDURE .
(abstract_subprogram_declaration . 0)) (PRAGMA .
(abstract_subprogram_declaration . 0)) (PACKAGE .
(abstract_subprogram_declaration . 0)) (OVERRIDING . (abstra [...]
+ ((default . error) (IDENTIFIER . (subprogram_body_stub . 0)) (USE .
(subprogram_body_stub . 0)) (TYPE . (subprogram_body_stub . 0)) (TASK .
(subprogram_body_stub . 0)) (SUBTYPE . (subprogram_body_stub . 0)) (PROTECTED .
(subprogram_body_stub . 0)) (PROCEDURE . (subprogram_body_stub . 0)) (PRAGMA .
(subprogram_body_stub . 0)) (PACKAGE . (subprogram_body_stub . 0)) (OVERRIDING
. (subprogram_body_stub . 0)) (NOT . (subprogram_body_stub . 0)) (GENERIC .
(subprogram_body_stub . 0)) (FUN [...]
+ ((default . error) (RAISE . 152) (PLUS . 154) (MINUS . 153) (ABS .
144) (NOT . 150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
+ ((default . error) (SEMICOLON . 1140))
+ ((default . error) (RAISE . 152) (PLUS . 154) (MINUS . 153) (ABS .
144) (NOT . 150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
+ ((default . error) (SEMICOLON . 1138))
+ ((default . error) (RAISE . 152) (PLUS . 154) (MINUS . 153) (ABS .
144) (NOT . 150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
+ ((default . error) (SEMICOLON . 1136))
((default . error) (ACCESS . (null_exclusion_opt . 1)) (IDENTIFIER .
48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49))
- ((default . error) (BEGIN . (declaration . 9)) (IDENTIFIER .
(declaration . 9)) (ENTRY . (declaration . 9)) (FOR . (declaration . 9))
(FUNCTION . (declaration . 9)) (GENERIC . (declaration . 9)) (NOT .
(declaration . 9)) (OVERRIDING . (declaration . 9)) (PACKAGE . (declaration .
9)) (PRAGMA . (declaration . 9)) (PROCEDURE . (declaration . 9)) (PROTECTED .
(declaration . 9)) (SUBTYPE . (declaration . 9)) (TASK . (declaration . 9))
(TYPE . (declaration . 9)) (USE . (declaration . 9)) [...]
+ ((default . error) (BEGIN . (declaration . 9)) (ENTRY . (declaration .
9)) (FOR . (declaration . 9)) (FUNCTION . (declaration . 9)) (GENERIC .
(declaration . 9)) (NOT . (declaration . 9)) (OVERRIDING . (declaration . 9))
(PACKAGE . (declaration . 9)) (PRAGMA . (declaration . 9)) (PROCEDURE .
(declaration . 9)) (PROTECTED . (declaration . 9)) (SUBTYPE . (declaration .
9)) (TASK . (declaration . 9)) (TYPE . (declaration . 9)) (USE . (declaration .
9)) (IDENTIFIER . (declaration . 9)) [...]
+ ((default . error) (DOT . 90) (TICK . 91) (SEMICOLON .
(aspect_specification_opt . 0)) (WITH . 109) (LEFT_PAREN . 107))
+ ((default . error) (SEMICOLON . 1134))
+ ((default . error) (SEMICOLON . 1133))
((default . error) (SEMICOLON . 1132))
- ((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
108))
+ ((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
109))
((default . error) (WITH . (record_type_definition . 0)) (SEMICOLON .
(record_type_definition . 0)))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
- ((default . error) (NOT . 741) (IDENTIFIER . 48) (CHARACTER_LITERAL .
50) (STRING_LITERAL . 49))
- ((default . error) (BEGIN . (incomplete_type_declaration . 0))
(IDENTIFIER . (incomplete_type_declaration . 0)) (ENTRY .
(incomplete_type_declaration . 0)) (FOR . (incomplete_type_declaration . 0))
(FUNCTION . (incomplete_type_declaration . 0)) (GENERIC .
(incomplete_type_declaration . 0)) (NOT . (incomplete_type_declaration . 0))
(OVERRIDING . (incomplete_type_declaration . 0)) (PACKAGE .
(incomplete_type_declaration . 0)) (PRAGMA . (incomplete_type_declaration . 0))
(PROCEDURE . [...]
+ ((default . error) (NOT . 729) (IDENTIFIER . 48) (CHARACTER_LITERAL .
50) (STRING_LITERAL . 49))
+ ((default . error) (BEGIN . (incomplete_type_declaration . 0)) (ENTRY .
(incomplete_type_declaration . 0)) (FOR . (incomplete_type_declaration . 0))
(FUNCTION . (incomplete_type_declaration . 0)) (GENERIC .
(incomplete_type_declaration . 0)) (NOT . (incomplete_type_declaration . 0))
(OVERRIDING . (incomplete_type_declaration . 0)) (PACKAGE .
(incomplete_type_declaration . 0)) (PRAGMA . (incomplete_type_declaration . 0))
(PROCEDURE . (incomplete_type_declaration . 0)) (PROTECTED . ( [...]
((default . error) (IS . (direct_name_opt . 0)) (IDENTIFIER . 1125)
(STRING_LITERAL . 1126))
((default . error) (SEMICOLON . 1124))
- ((default . error) (WHEN . (component_item . 1)) (END . (component_item
. 1)) (FOR . (component_item . 1)) (IDENTIFIER . (component_item . 1)) (CASE .
(component_item . 1)))
- ((default . error) (WHEN . (component_item . 0)) (END . (component_item
. 0)) (FOR . (component_item . 0)) (IDENTIFIER . (component_item . 0)) (CASE .
(component_item . 0)))
- ((default . error) (WHEN . (component_list . 0)) (END . (component_list
. 0)) (CASE . (component_list . 0)) (IDENTIFIER . (component_list . 0)) (FOR .
(component_list . 0)))
- ((default . error) (WHEN . (component_list_opt . 1)) (END .
(component_list_opt . 1)) (CASE . 1012) (IDENTIFIER . 72) (FOR . 296))
+ ((default . error) (WHEN . (component_item . 1)) (END . (component_item
. 1)) (IDENTIFIER . (component_item . 1)) (FOR . (component_item . 1)) (CASE .
(component_item . 1)))
+ ((default . error) (WHEN . (component_item . 0)) (END . (component_item
. 0)) (IDENTIFIER . (component_item . 0)) (FOR . (component_item . 0)) (CASE .
(component_item . 0)))
+ ((default . error) (WHEN . (component_list . 0)) (END . (component_list
. 0)) (CASE . (component_list . 0)) (FOR . (component_list . 0)) (IDENTIFIER .
(component_list . 0)))
+ ((default . error) (WHEN . (component_list_opt . 1)) (END .
(component_list_opt . 1)) (CASE . 1030) (IDENTIFIER . 77) (FOR . 299))
((default . error) (END . 1121))
- ((default . error) (COMMA . 95) (COLON . 1120))
- ((default . error) (WHEN . (component_list . 3)) (END . (component_list
. 3)) (CASE . (component_list . 3)) (IDENTIFIER . (component_list . 3)) (FOR .
(component_list . 3)))
+ ((default . error) (COMMA . 96) (COLON . 1120))
+ ((default . error) (WHEN . (component_list . 3)) (END . (component_list
. 3)) (CASE . (component_list . 3)) (FOR . (component_list . 3)) (IDENTIFIER .
(component_list . 3)))
((default . error) (DOT_DOT . 1119))
((default . error) (SEMICOLON . (record_definition . 1)) (WITH .
(record_definition . 1)))
((default . error) (SEMICOLON . (type_definition . 2)) (WITH .
(type_definition . 2)))
((default . error) (COMMA . (enumeration_literal . 0)) (RIGHT_PAREN .
(enumeration_literal . 0)))
((default . error) (COMMA . (enumeration_literal . 1)) (RIGHT_PAREN .
(enumeration_literal . 1)))
((default . error) (RIGHT_PAREN . (enumeration_literal_list . 0)) (COMMA
. (enumeration_literal_list . 0)))
- ((default . error) (COMMA . 1117) (RIGHT_PAREN . 1118))
+ ((default . error) (COMMA . 1118) (RIGHT_PAREN . 1117))
((default . error) (WITH . (real_range_specification_opt . 0))
(SEMICOLON . (real_range_specification_opt . 0)) (RANGE . 1114))
((default . error) (DIGITS . 1113) (WITH .
(real_range_specification_opt . 0)) (SEMICOLON . (real_range_specification_opt
. 0)) (RANGE . 1114))
- ((default . error) (NEW . ((abstract_limited_opt . 1)
(abstract_limited_synchronized_opt . 1))))
- ((default . error) (BEGIN . (single_task_declaration . 1)) (IDENTIFIER .
(single_task_declaration . 1)) (ENTRY . (single_task_declaration . 1)) (FOR .
(single_task_declaration . 1)) (FUNCTION . (single_task_declaration . 1))
(GENERIC . (single_task_declaration . 1)) (NOT . (single_task_declaration . 1))
(OVERRIDING . (single_task_declaration . 1)) (PACKAGE .
(single_task_declaration . 1)) (PRAGMA . (single_task_declaration . 1))
(PROCEDURE . (single_task_declaration . 1)) (PROTECTE [...]
- ((default . error) (SEMICOLON . (identifier_opt . 0)) (IDENTIFIER .
703))
- ((default . error) (END . (declarative_part_opt . 0)) (USE . 11)
(SUBTYPE . 299) (PRAGMA . 7) (NOT . 4) (OVERRIDING . 5) (FUNCTION .
(overriding_indicator_opt . 2)) (PROCEDURE . (overriding_indicator_opt . 2))
(ENTRY . (overriding_indicator_opt . 2)) (FOR . 296) (IDENTIFIER . 295) (TYPE
. 301) (GENERIC . 2) (PROTECTED . 298) (TASK . 300) (PACKAGE . 297))
- ((default . error) (AND . 1065) (WITH . 1110))
- ((default . error) (SEMICOLON . 1109))
- ((default . error) (USE . (task_type_declaration . 2)) (TYPE .
(task_type_declaration . 2)) (TASK . (task_type_declaration . 2)) (SUBTYPE .
(task_type_declaration . 2)) (PROTECTED . (task_type_declaration . 2))
(PROCEDURE . (task_type_declaration . 2)) (PRAGMA . (task_type_declaration .
2)) (PACKAGE . (task_type_declaration . 2)) (OVERRIDING .
(task_type_declaration . 2)) (NOT . (task_type_declaration . 2)) (GENERIC .
(task_type_declaration . 2)) (FUNCTION . (task_type_declaration [...]
- ((default . error) (NEW . 1107) (END . (declarative_part_opt . 0))
(PRIVATE . (declarative_part_opt . 0)) (USE . 11) (SUBTYPE . 299) (PRAGMA .
7) (NOT . 4) (OVERRIDING . 5) (FUNCTION . (overriding_indicator_opt . 2))
(PROCEDURE . (overriding_indicator_opt . 2)) (ENTRY . (overriding_indicator_opt
. 2)) (FOR . 296) (IDENTIFIER . 295) (TYPE . 301) (GENERIC . 2) (PROTECTED
. 298) (TASK . 300) (PACKAGE . 297))
- ((default . error) (DO . (subtype_indication . 1)) (LOOP .
(subtype_indication . 1)) (COLON_EQUAL . (subtype_indication . 1)) (SEMICOLON .
(subtype_indication . 1)) (OF . (subtype_indication . 1)) (AND .
(subtype_indication . 1)) (WITH . (subtype_indication . 1)) (EQUAL_GREATER .
(subtype_indication . 1)) (COMMA . (subtype_indication . 1)) (RIGHT_PAREN .
(subtype_indication . 1)) (DOT . 87) (TICK . 88) (RANGE . 849) (LEFT_PAREN .
819))
- ((default . error) (LOOP . (constraint . 0)) (EQUAL_GREATER .
(constraint . 0)) (DO . (constraint . 0)) (OF . (constraint . 0)) (AND .
(constraint . 0)) (SEMICOLON . (constraint . 0)) (WITH . (constraint . 0))
(COLON_EQUAL . (constraint . 0)) (RIGHT_PAREN . (constraint . 0)) (COMMA .
(constraint . 0)))
- ((default . error) (USE . (subtype_declaration . 0)) (TYPE .
(subtype_declaration . 0)) (TASK . (subtype_declaration . 0)) (SUBTYPE .
(subtype_declaration . 0)) (PROTECTED . (subtype_declaration . 0)) (PROCEDURE .
(subtype_declaration . 0)) (PRAGMA . (subtype_declaration . 0)) (PACKAGE .
(subtype_declaration . 0)) (OVERRIDING . (subtype_declaration . 0)) (NOT .
(subtype_declaration . 0)) (GENERIC . (subtype_declaration . 0)) (FUNCTION .
(subtype_declaration . 0)) (FOR . (subtype_de [...]
- ((default . error) (BEGIN . (single_protected_declaration . 1))
(IDENTIFIER . (single_protected_declaration . 1)) (ENTRY .
(single_protected_declaration . 1)) (FOR . (single_protected_declaration . 1))
(FUNCTION . (single_protected_declaration . 1)) (GENERIC .
(single_protected_declaration . 1)) (NOT . (single_protected_declaration . 1))
(OVERRIDING . (single_protected_declaration . 1)) (PACKAGE .
(single_protected_declaration . 1)) (PRAGMA . (single_protected_declaration .
1)) (PR [...]
- ((default . error) (SEMICOLON . (identifier_opt . 0)) (IDENTIFIER .
703))
- ((default . error) (END . (declarative_part_opt . 0)) (USE . 11)
(SUBTYPE . 299) (PRAGMA . 7) (NOT . 4) (OVERRIDING . 5) (FUNCTION .
(overriding_indicator_opt . 2)) (PROCEDURE . (overriding_indicator_opt . 2))
(ENTRY . (overriding_indicator_opt . 2)) (FOR . 296) (IDENTIFIER . 295) (TYPE
. 301) (GENERIC . 2) (PROTECTED . 298) (TASK . 300) (PACKAGE . 297))
- ((default . error) (AND . 1065) (WITH . 1103))
- ((default . error) (SEMICOLON . 1102))
- ((default . error) (NEW . 1100) (END . (declarative_part_opt . 0))
(PRIVATE . (declarative_part_opt . 0)) (USE . 11) (SUBTYPE . 299) (PRAGMA .
7) (NOT . 4) (OVERRIDING . 5) (FUNCTION . (overriding_indicator_opt . 2))
(PROCEDURE . (overriding_indicator_opt . 2)) (ENTRY . (overriding_indicator_opt
. 2)) (FOR . 296) (IDENTIFIER . 295) (TYPE . 301) (GENERIC . 2) (PROTECTED
. 298) (TASK . 300) (PACKAGE . 297))
- ((default . error) (SEMICOLON . 1099))
- ((default . error) (WHEN . (at_clause . 0)) (BEGIN . (at_clause . 0))
(IDENTIFIER . (at_clause . 0)) (ENTRY . (at_clause . 0)) (FOR . (at_clause .
0)) (FUNCTION . (at_clause . 0)) (GENERIC . (at_clause . 0)) (NOT . (at_clause
. 0)) (OVERRIDING . (at_clause . 0)) (PACKAGE . (at_clause . 0)) (PRAGMA .
(at_clause . 0)) (PROCEDURE . (at_clause . 0)) (PROTECTED . (at_clause . 0))
(SUBTYPE . (at_clause . 0)) (TASK . (at_clause . 0)) (TYPE . (at_clause . 0))
(USE . (at_clause . 0)) (CASE [...]
- ((default . error) (AT . 1098))
+ ((default . error) (NEW . ((abstract_limited_synchronized_opt . 1)
(abstract_limited_opt . 1))))
+ ((default . error) (SEMICOLON . 1112))
+ ((default . error) (NEW . 1110) (END . (declarative_part_opt . 0))
(PRIVATE . (declarative_part_opt . 0)) (USE . 11) (SUBTYPE . 302) (PRAGMA .
7) (NOT . 4) (OVERRIDING . 5) (FUNCTION . (overriding_indicator_opt . 2))
(PROCEDURE . (overriding_indicator_opt . 2)) (ENTRY . (overriding_indicator_opt
. 2)) (FOR . 299) (IDENTIFIER . 305) (TYPE . 304) (GENERIC . 2) (PROTECTED
. 301) (TASK . 303) (PACKAGE . 300))
+ ((default . error) (IDENTIFIER . (task_type_declaration . 2)) (USE .
(task_type_declaration . 2)) (TYPE . (task_type_declaration . 2)) (TASK .
(task_type_declaration . 2)) (SUBTYPE . (task_type_declaration . 2)) (PROTECTED
. (task_type_declaration . 2)) (PROCEDURE . (task_type_declaration . 2))
(PRAGMA . (task_type_declaration . 2)) (PACKAGE . (task_type_declaration . 2))
(OVERRIDING . (task_type_declaration . 2)) (NOT . (task_type_declaration . 2))
(GENERIC . (task_type_declaratio [...]
+ ((default . error) (BEGIN . (single_task_declaration . 1)) (ENTRY .
(single_task_declaration . 1)) (FOR . (single_task_declaration . 1)) (FUNCTION
. (single_task_declaration . 1)) (GENERIC . (single_task_declaration . 1)) (NOT
. (single_task_declaration . 1)) (OVERRIDING . (single_task_declaration . 1))
(PACKAGE . (single_task_declaration . 1)) (PRAGMA . (single_task_declaration .
1)) (PROCEDURE . (single_task_declaration . 1)) (PROTECTED .
(single_task_declaration . 1)) (SUBTYPE . [...]
+ ((default . error) (SEMICOLON . (identifier_opt . 0)) (IDENTIFIER .
716))
+ ((default . error) (END . (declarative_part_opt . 0)) (USE . 11)
(SUBTYPE . 302) (PRAGMA . 7) (NOT . 4) (OVERRIDING . 5) (FUNCTION .
(overriding_indicator_opt . 2)) (PROCEDURE . (overriding_indicator_opt . 2))
(ENTRY . (overriding_indicator_opt . 2)) (FOR . 299) (IDENTIFIER . 305) (TYPE
. 304) (GENERIC . 2) (PROTECTED . 301) (TASK . 303) (PACKAGE . 300))
+ ((default . error) (AND . 1078) (WITH . 1107))
+ ((default . error) (IDENTIFIER . (subtype_declaration . 0)) (USE .
(subtype_declaration . 0)) (TYPE . (subtype_declaration . 0)) (TASK .
(subtype_declaration . 0)) (SUBTYPE . (subtype_declaration . 0)) (PROTECTED .
(subtype_declaration . 0)) (PROCEDURE . (subtype_declaration . 0)) (PRAGMA .
(subtype_declaration . 0)) (PACKAGE . (subtype_declaration . 0)) (OVERRIDING .
(subtype_declaration . 0)) (NOT . (subtype_declaration . 0)) (GENERIC .
(subtype_declaration . 0)) (FUNCTION . (sub [...]
+ ((default . error) (SEMICOLON . 1106))
+ ((default . error) (NEW . 1104) (END . (declarative_part_opt . 0))
(PRIVATE . (declarative_part_opt . 0)) (USE . 11) (SUBTYPE . 302) (PRAGMA .
7) (NOT . 4) (OVERRIDING . 5) (FUNCTION . (overriding_indicator_opt . 2))
(PROCEDURE . (overriding_indicator_opt . 2)) (ENTRY . (overriding_indicator_opt
. 2)) (FOR . 299) (IDENTIFIER . 305) (TYPE . 304) (GENERIC . 2) (PROTECTED
. 301) (TASK . 303) (PACKAGE . 300))
+ ((default . error) (BEGIN . (single_protected_declaration . 1)) (ENTRY .
(single_protected_declaration . 1)) (FOR . (single_protected_declaration . 1))
(FUNCTION . (single_protected_declaration . 1)) (GENERIC .
(single_protected_declaration . 1)) (NOT . (single_protected_declaration . 1))
(OVERRIDING . (single_protected_declaration . 1)) (PACKAGE .
(single_protected_declaration . 1)) (PRAGMA . (single_protected_declaration .
1)) (PROCEDURE . (single_protected_declaration . 1)) (PRO [...]
+ ((default . error) (SEMICOLON . (identifier_opt . 0)) (IDENTIFIER .
716))
+ ((default . error) (END . (declarative_part_opt . 0)) (USE . 11)
(SUBTYPE . 302) (PRAGMA . 7) (NOT . 4) (OVERRIDING . 5) (FUNCTION .
(overriding_indicator_opt . 2)) (PROCEDURE . (overriding_indicator_opt . 2))
(ENTRY . (overriding_indicator_opt . 2)) (FOR . 299) (IDENTIFIER . 305) (TYPE
. 304) (GENERIC . 2) (PROTECTED . 301) (TASK . 303) (PACKAGE . 300))
+ ((default . error) (AND . 1078) (WITH . 1101))
+ ((default . error) (SEMICOLON . 1100))
+ ((default . error) (WHEN . (at_clause . 0)) (BEGIN . (at_clause . 0))
(ENTRY . (at_clause . 0)) (FOR . (at_clause . 0)) (FUNCTION . (at_clause . 0))
(GENERIC . (at_clause . 0)) (NOT . (at_clause . 0)) (OVERRIDING . (at_clause .
0)) (PACKAGE . (at_clause . 0)) (PRAGMA . (at_clause . 0)) (PROCEDURE .
(at_clause . 0)) (PROTECTED . (at_clause . 0)) (SUBTYPE . (at_clause . 0))
(TASK . (at_clause . 0)) (TYPE . (at_clause . 0)) (USE . (at_clause . 0))
(IDENTIFIER . (at_clause . 0)) (CASE [...]
+ ((default . error) (AT . 1099))
((default . error) (END . (component_clause_list . 0)) (IDENTIFIER .
(component_clause_list . 0)))
- ((default . error) (END . 1096) (IDENTIFIER . 1049))
- ((default . error) (RAISE . 152) (PLUS . 144) (MINUS . 143) (ABS .
147) (NOT . 150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
- ((default . error) (DOT . 87) (TICK . 88) (SEMICOLON .
(aspect_specification_opt . 0)) (WITH . 108) (LEFT_PAREN . 106))
- ((default . error) (SEMICOLON . 1093))
- ((default . error) (SEMICOLON . 1092))
- ((default . error) (ALIASED . 1087) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (ACCESS . (null_exclusion_opt
. 0)) (NOT . 878))
+ ((default . error) (END . 1097) (IDENTIFIER . 1065))
+ ((default . error) (RAISE . 152) (PLUS . 154) (MINUS . 153) (ABS .
144) (NOT . 150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
((default . error) (RIGHT_PAREN . (discrete_subtype_definition_list .
1)) (COMMA . (discrete_subtype_definition_list . 1)))
- ((default . error) (ALIASED . 1087) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (ACCESS . (null_exclusion_opt
. 0)) (NOT . 878))
+ ((default . error) (ALIASED . 1090) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (ACCESS . (null_exclusion_opt
. 0)) (NOT . 883))
((default . error) (RIGHT_PAREN . (index_subtype_definition_list . 1))
(COMMA . (index_subtype_definition_list . 1)))
- ((default . error) (DOT . 87) (RANGE . 1086) (TICK . 88) (LEFT_PAREN
. 106))
+ ((default . error) (DOT . 90) (RANGE . 1094) (TICK . 91) (LEFT_PAREN
. 107))
+ ((default . error) (ALIASED . 1090) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (ACCESS . (null_exclusion_opt
. 0)) (NOT . 883))
((default . error) (COMMA . (index_subtype_definition . 0)) (RIGHT_PAREN
. (index_subtype_definition . 0)))
- ((default . error) (NUMERIC_LITERAL . 145) (NULL . 1085) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
- ((default . error) (COMMA . 825) (RIGHT_PAREN . 1084))
- ((default . error) (COMMA . (discrete_subtype_definition . 1)) (BAR .
(discrete_choice . 2)) (EQUAL_GREATER . (discrete_choice . 2)) (RIGHT_PAREN .
((discrete_subtype_definition . 1) 267)))
+ ((default . error) (NUMERIC_LITERAL . 155) (NULL . 1089) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
+ ((default . error) (COMMA . 834) (RIGHT_PAREN . 1088))
+ ((default . error) (BAR . (discrete_choice . 2)) (EQUAL_GREATER .
(discrete_choice . 2)) (RIGHT_PAREN . ((range_list . 0)
(discrete_subtype_definition . 1))) (COMMA . ((range_list . 0)
(discrete_subtype_definition . 1))))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
- ((default . error) (PRIVATE . 1082))
- ((default . error) (AND . 1065) (WITH . (and_interface_list_opt . 1))
(SEMICOLON . (and_interface_list_opt . 1)))
+ ((default . error) (PRIVATE . 1086))
+ ((default . error) (AND . 1078) (WITH . (and_interface_list_opt . 1))
(SEMICOLON . (and_interface_list_opt . 1)))
((default . error) (WITH . (formal_package_actual_part . 0)) (SEMICOLON
. (formal_package_actual_part . 0)))
- ((default . error) (PACKAGE . (formal_package_declaration . 0))
(PROCEDURE . (formal_package_declaration . 0)) (FUNCTION .
(formal_package_declaration . 0)) (IDENTIFIER . (formal_package_declaration .
0)) (PRAGMA . (formal_package_declaration . 0)) (TYPE .
(formal_package_declaration . 0)) (WITH . (formal_package_declaration . 0)))
- ((default . error) (PACKAGE . (formal_object_declaration . 0))
(PROCEDURE . (formal_object_declaration . 0)) (FUNCTION .
(formal_object_declaration . 0)) (IDENTIFIER . (formal_object_declaration . 0))
(PRAGMA . (formal_object_declaration . 0)) (TYPE . (formal_object_declaration .
0)) (WITH . (formal_object_declaration . 0)))
- ((default . error) (RAISE . 152) (PLUS . 144) (MINUS . 143) (ABS .
147) (NOT . 150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
- ((default . error) (RAISE . 152) (PLUS . 144) (MINUS . 143) (ABS .
147) (NOT . 150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
- ((default . error) (ELSIF . (elsif_expression_list . 1)) (ELSE .
(elsif_expression_list . 1)) (RIGHT_PAREN . (elsif_expression_list . 1)))
- ((default . error) (THEN . 1079))
- ((default . error) (RIGHT_PAREN . (if_expression . 2)))
- ((default . error) (RAISE . 152) (PLUS . 144) (MINUS . 143) (ABS .
147) (NOT . 150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
- ((default . error) (RIGHT_PAREN . (case_expression_alternative_list .
1)) (COMMA . (case_expression_alternative_list . 1)))
- ((default . error) (COMMA . (case_expression_alternative . 0))
(RIGHT_PAREN . (case_expression_alternative . 0)))
- ((default . error) (RAISE . 152) (PLUS . 144) (MINUS . 143) (ABS .
147) (NOT . 150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
- ((default . error) (RIGHT_PAREN . (if_expression . 0)))
+ ((default . error) (PACKAGE . (formal_package_declaration . 0))
(PROCEDURE . (formal_package_declaration . 0)) (FUNCTION .
(formal_package_declaration . 0)) (PRAGMA . (formal_package_declaration . 0))
(TYPE . (formal_package_declaration . 0)) (USE . (formal_package_declaration .
0)) (WITH . (formal_package_declaration . 0)) (IDENTIFIER .
(formal_package_declaration . 0)))
+ ((default . error) (PACKAGE . (formal_object_declaration . 0))
(PROCEDURE . (formal_object_declaration . 0)) (FUNCTION .
(formal_object_declaration . 0)) (PRAGMA . (formal_object_declaration . 0))
(TYPE . (formal_object_declaration . 0)) (USE . (formal_object_declaration .
0)) (WITH . (formal_object_declaration . 0)) (IDENTIFIER .
(formal_object_declaration . 0)))
+ ((default . error) (RAISE . 152) (PLUS . 154) (MINUS . 153) (ABS .
144) (NOT . 150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
((default . error) (RIGHT_PAREN . (parameter_specification . 0))
(SEMICOLON . (parameter_specification . 0)))
((default . error) (WITH . (formal_derived_type_definition . 0))
(SEMICOLON . (formal_derived_type_definition . 0)))
- ((default . error) (DOT . 87) (TICK . 88) (WITH . (interface_list .
1)) (SEMICOLON . (interface_list . 1)) (AND . (interface_list . 1)) (LEFT_PAREN
. 106))
- ((default . error) (LOOP . (index_constraint . 0)) (DO .
(index_constraint . 0)) (EQUAL_GREATER . (index_constraint . 0)) (COMMA .
(index_constraint . 0)) (RIGHT_PAREN . (index_constraint . 0)) (COLON_EQUAL .
(index_constraint . 0)) (WITH . (index_constraint . 0)) (SEMICOLON .
(index_constraint . 0)) (AND . (index_constraint . 0)) (OF . (index_constraint
. 0)))
- ((default . error) (PLUS . (primary . 1)) (MINUS . (primary . 1))
(AMPERSAND . (primary . 1)) (DOT_DOT . (primary . 1)) (SLASH . (primary . 1))
(STAR . (primary . 1)) (MOD . (primary . 1)) (REM . (primary . 1)) (XOR .
(primary . 1)) (OR . (primary . 1)) (AND . (primary . 1)) (EQUAL_GREATER .
(primary . 1)) (BAR . (primary . 1)) (IN . (primary . 1)) (NOT . (primary . 1))
(EQUAL . (primary . 1)) (GREATER . (primary . 1)) (GREATER_EQUAL . (primary .
1)) (LESS . (primary . 1)) (LESS_EQ [...]
- ((default . error) (BOX . 1061))
- ((default . error) (ACCESS . (null_exclusion_opt . 0)) (NOT . 878)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49))
+ ((default . error) (DOT . 90) (TICK . 91) (WITH . (interface_list .
1)) (SEMICOLON . (interface_list . 1)) (AND . (interface_list . 1)) (LEFT_PAREN
. 107))
+ ((default . error) (LOOP . (index_constraint . 0)) (DO .
(index_constraint . 0)) (RIGHT_PAREN . (index_constraint . 0)) (COMMA .
(index_constraint . 0)) (EQUAL_GREATER . (index_constraint . 0)) (COLON_EQUAL .
(index_constraint . 0)) (WITH . (index_constraint . 0)) (SEMICOLON .
(index_constraint . 0)) (AND . (index_constraint . 0)) (OF . (index_constraint
. 0)))
+ ((default . error) (PLUS . (primary . 1)) (MINUS . (primary . 1))
(AMPERSAND . (primary . 1)) (DOT_DOT . (primary . 1)) (MOD . (primary . 1))
(REM . (primary . 1)) (SLASH . (primary . 1)) (STAR . (primary . 1)) (XOR .
(primary . 1)) (OR . (primary . 1)) (AND . (primary . 1)) (EQUAL_GREATER .
(primary . 1)) (BAR . (primary . 1)) (IN . (primary . 1)) (NOT . (primary . 1))
(EQUAL . (primary . 1)) (GREATER . (primary . 1)) (GREATER_EQUAL . (primary .
1)) (LESS . (primary . 1)) (LESS_EQ [...]
+ ((default . error) (ACCESS . (null_exclusion_opt . 0)) (NOT . 883)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49))
((default . error) (WITH . (component_definition . 3)) (SEMICOLON .
(component_definition . 3)) (COLON_EQUAL . (component_definition . 3)))
((default . error) (WITH . (array_type_definition . 0)) (SEMICOLON .
(array_type_definition . 0)) (COLON_EQUAL . (array_type_definition . 0)))
((default . error) (WITH . (component_definition . 1)) (SEMICOLON .
(component_definition . 1)) (COLON_EQUAL . (component_definition . 1)))
+ ((default . error) (BOX . 1074))
((default . error) (WITH . (array_type_definition . 1)) (SEMICOLON .
(array_type_definition . 1)) (COLON_EQUAL . (array_type_definition . 1)))
- ((default . error) (END . (object_renaming_declaration . 2)) (PRIVATE .
(object_renaming_declaration . 2)) (USE . (object_renaming_declaration . 2))
(TYPE . (object_renaming_declaration . 2)) (TASK . (object_renaming_declaration
. 2)) (SUBTYPE . (object_renaming_declaration . 2)) (PROTECTED .
(object_renaming_declaration . 2)) (PROCEDURE . (object_renaming_declaration .
2)) (PRAGMA . (object_renaming_declaration . 2)) (PACKAGE .
(object_renaming_declaration . 2)) (OVERRIDING . (obj [...]
- ((default . error) (END . (object_renaming_declaration . 1)) (PRIVATE .
(object_renaming_declaration . 1)) (USE . (object_renaming_declaration . 1))
(TYPE . (object_renaming_declaration . 1)) (TASK . (object_renaming_declaration
. 1)) (SUBTYPE . (object_renaming_declaration . 1)) (PROTECTED .
(object_renaming_declaration . 1)) (PROCEDURE . (object_renaming_declaration .
1)) (PRAGMA . (object_renaming_declaration . 1)) (PACKAGE .
(object_renaming_declaration . 1)) (OVERRIDING . (obj [...]
- ((default . error) (SEMICOLON . 1237))
- ((default . error) (SEMICOLON . 1236))
- ((default . error) (RECORD . 1235))
+ ((default . error) (SEMICOLON . 1240))
+ ((default . error) (RECORD . 1239))
((default . error) (IDENTIFIER . (component_clause_list . 1)) (END .
(component_clause_list . 1)))
- ((default . error) (PLUS . 144) (MINUS . 143) (ABS . 147) (NOT .
150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN . 148))
- ((default . error) (PRIVATE . (package_body_stub . 0)) (END .
(package_body_stub . 0)) (BEGIN . (package_body_stub . 0)) (IDENTIFIER .
(package_body_stub . 0)) (ENTRY . (package_body_stub . 0)) (FOR .
(package_body_stub . 0)) (FUNCTION . (package_body_stub . 0)) (GENERIC .
(package_body_stub . 0)) (NOT . (package_body_stub . 0)) (OVERRIDING .
(package_body_stub . 0)) (PACKAGE . (package_body_stub . 0)) (PRAGMA .
(package_body_stub . 0)) (PROCEDURE . (package_body_stub . 0)) (PROTEC [...]
- ((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
- ((default . error) (SEMICOLON . 1232))
- ((default . error) (PRIVATE . (protected_body_stub . 0)) (END .
(protected_body_stub . 0)) (BEGIN . (protected_body_stub . 0)) (IDENTIFIER .
(protected_body_stub . 0)) (ENTRY . (protected_body_stub . 0)) (FOR .
(protected_body_stub . 0)) (FUNCTION . (protected_body_stub . 0)) (GENERIC .
(protected_body_stub . 0)) (NOT . (protected_body_stub . 0)) (OVERRIDING .
(protected_body_stub . 0)) (PACKAGE . (protected_body_stub . 0)) (PRAGMA .
(protected_body_stub . 0)) (PROCEDURE . (protect [...]
- ((default . error) (END . (declarative_part_opt . 0)) (PRIVATE .
(declarative_part_opt . 0)) (USE . 11) (SUBTYPE . 299) (PRAGMA . 7) (NOT .
4) (OVERRIDING . 5) (FUNCTION . (overriding_indicator_opt . 2)) (PROCEDURE .
(overriding_indicator_opt . 2)) (ENTRY . (overriding_indicator_opt . 2)) (FOR .
296) (IDENTIFIER . 295) (TYPE . 301) (GENERIC . 2) (PROTECTED . 298) (TASK
. 300) (PACKAGE . 297))
- ((default . error) (END . 1230))
+ ((default . error) (PLUS . 154) (MINUS . 153) (ABS . 144) (NOT .
150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN . 148))
+ ((default . error) (PRIVATE . (package_body_stub . 0)) (END .
(package_body_stub . 0)) (BEGIN . (package_body_stub . 0)) (ENTRY .
(package_body_stub . 0)) (FOR . (package_body_stub . 0)) (FUNCTION .
(package_body_stub . 0)) (GENERIC . (package_body_stub . 0)) (NOT .
(package_body_stub . 0)) (OVERRIDING . (package_body_stub . 0)) (PACKAGE .
(package_body_stub . 0)) (PRAGMA . (package_body_stub . 0)) (PROCEDURE .
(package_body_stub . 0)) (PROTECTED . (package_body_stub . 0)) (SUBTYPE [...]
+ ((default . error) (END . (declarative_part_opt . 0)) (PRIVATE .
(declarative_part_opt . 0)) (USE . 11) (SUBTYPE . 302) (PRAGMA . 7) (NOT .
4) (OVERRIDING . 5) (FUNCTION . (overriding_indicator_opt . 2)) (PROCEDURE .
(overriding_indicator_opt . 2)) (ENTRY . (overriding_indicator_opt . 2)) (FOR .
299) (IDENTIFIER . 305) (TYPE . 304) (GENERIC . 2) (PROTECTED . 301) (TASK
. 303) (PACKAGE . 300))
+ ((default . error) (END . 1236))
((default . error) (SEMICOLON . (protected_definition . 1)))
- ((default . error) (LOOP . (subtype_indication . 0)) (DO .
(subtype_indication . 0)) (RIGHT_PAREN . (subtype_indication . 0)) (COMMA .
(subtype_indication . 0)) (EQUAL_GREATER . (subtype_indication . 0)) (WITH .
(subtype_indication . 0)) (AND . (subtype_indication . 0)) (OF .
(subtype_indication . 0)) (SEMICOLON . (subtype_indication . 0)) (COLON_EQUAL .
(subtype_indication . 0)))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
- ((default . error) (SEMICOLON . 1228))
- ((default . error) (PRIVATE . (task_body_stub . 0)) (END .
(task_body_stub . 0)) (BEGIN . (task_body_stub . 0)) (IDENTIFIER .
(task_body_stub . 0)) (ENTRY . (task_body_stub . 0)) (FOR . (task_body_stub .
0)) (FUNCTION . (task_body_stub . 0)) (GENERIC . (task_body_stub . 0)) (NOT .
(task_body_stub . 0)) (OVERRIDING . (task_body_stub . 0)) (PACKAGE .
(task_body_stub . 0)) (PRAGMA . (task_body_stub . 0)) (PROCEDURE .
(task_body_stub . 0)) (PROTECTED . (task_body_stub . 0)) (SUBTYPE . [...]
- ((default . error) (END . (declarative_part_opt . 0)) (PRIVATE .
(declarative_part_opt . 0)) (USE . 11) (SUBTYPE . 299) (PRAGMA . 7) (NOT .
4) (OVERRIDING . 5) (FUNCTION . (overriding_indicator_opt . 2)) (PROCEDURE .
(overriding_indicator_opt . 2)) (ENTRY . (overriding_indicator_opt . 2)) (FOR .
296) (IDENTIFIER . 295) (TYPE . 301) (GENERIC . 2) (PROTECTED . 298) (TASK
. 300) (PACKAGE . 297))
- ((default . error) (END . 1226))
+ ((default . error) (SEMICOLON . 1234))
+ ((default . error) (PRIVATE . (protected_body_stub . 0)) (END .
(protected_body_stub . 0)) (BEGIN . (protected_body_stub . 0)) (ENTRY .
(protected_body_stub . 0)) (FOR . (protected_body_stub . 0)) (FUNCTION .
(protected_body_stub . 0)) (GENERIC . (protected_body_stub . 0)) (NOT .
(protected_body_stub . 0)) (OVERRIDING . (protected_body_stub . 0)) (PACKAGE .
(protected_body_stub . 0)) (PRAGMA . (protected_body_stub . 0)) (PROCEDURE .
(protected_body_stub . 0)) (PROTECTED . (protecte [...]
+ ((default . error) (END . (declarative_part_opt . 0)) (PRIVATE .
(declarative_part_opt . 0)) (USE . 11) (SUBTYPE . 302) (PRAGMA . 7) (NOT .
4) (OVERRIDING . 5) (FUNCTION . (overriding_indicator_opt . 2)) (PROCEDURE .
(overriding_indicator_opt . 2)) (ENTRY . (overriding_indicator_opt . 2)) (FOR .
299) (IDENTIFIER . 305) (TYPE . 304) (GENERIC . 2) (PROTECTED . 301) (TASK
. 303) (PACKAGE . 300))
+ ((default . error) (END . 1232))
((default . error) (SEMICOLON . (task_definition . 1)))
- ((default . error) (RAISE . 152) (PLUS . 144) (MINUS . 143) (ABS .
147) (NOT . 150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
- ((default . error) (PLUS . 144) (MINUS . 143) (ABS . 147) (NOT .
150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN . 148))
+ ((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
+ ((default . error) (SEMICOLON . 1230))
+ ((default . error) (PRIVATE . (task_body_stub . 0)) (END .
(task_body_stub . 0)) (BEGIN . (task_body_stub . 0)) (ENTRY . (task_body_stub .
0)) (FOR . (task_body_stub . 0)) (FUNCTION . (task_body_stub . 0)) (GENERIC .
(task_body_stub . 0)) (NOT . (task_body_stub . 0)) (OVERRIDING .
(task_body_stub . 0)) (PACKAGE . (task_body_stub . 0)) (PRAGMA .
(task_body_stub . 0)) (PROCEDURE . (task_body_stub . 0)) (PROTECTED .
(task_body_stub . 0)) (SUBTYPE . (task_body_stub . 0)) (TASK . (task_ [...]
+ ((default . error) (RAISE . 152) (PLUS . 154) (MINUS . 153) (ABS .
144) (NOT . 150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
+ ((default . error) (PLUS . 154) (MINUS . 153) (ABS . 144) (NOT .
150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN . 148))
((default . error) (WITH . (type_definition . 4)) (SEMICOLON .
(type_definition . 4)))
((default . error) (WITH . (type_definition . 3)) (SEMICOLON .
(type_definition . 3)))
- ((default . error) (IDENTIFIER . 1024) (CHARACTER_LITERAL . 1025))
((default . error) (SEMICOLON . (enumeration_type_definition . 0)) (WITH
. (enumeration_type_definition . 0)))
- ((default . error) (PLUS . 144) (MINUS . 143) (ABS . 147) (NOT .
150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN . 148))
- ((default . error) (ALIASED . 1087) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (ACCESS . (null_exclusion_opt
. 0)) (NOT . 878))
- ((default . error) (RECORD . 1220))
- ((default . error) (WHEN . (component_list . 1)) (FOR . (component_list
. 1)) (IDENTIFIER . (component_list . 1)) (CASE . (component_list . 1)) (END .
(component_list . 1)))
- ((default . error) (WHEN . (component_list . 2)) (FOR . (component_list
. 2)) (IDENTIFIER . (component_list . 2)) (CASE . (component_list . 2)) (END .
(component_list . 2)))
- ((default . error) (WHEN . (component_list . 4)) (FOR . (component_list
. 4)) (IDENTIFIER . (component_list . 4)) (CASE . (component_list . 4)) (END .
(component_list . 4)))
+ ((default . error) (IDENTIFIER . 1042) (CHARACTER_LITERAL . 1043))
+ ((default . error) (PLUS . 154) (MINUS . 153) (ABS . 144) (NOT .
150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN . 148))
+ ((default . error) (ALIASED . 1090) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (ACCESS . (null_exclusion_opt
. 0)) (NOT . 883))
+ ((default . error) (RECORD . 1224))
+ ((default . error) (WHEN . (component_list . 1)) (IDENTIFIER .
(component_list . 1)) (FOR . (component_list . 1)) (CASE . (component_list .
1)) (END . (component_list . 1)))
+ ((default . error) (WHEN . (component_list . 2)) (IDENTIFIER .
(component_list . 2)) (FOR . (component_list . 2)) (CASE . (component_list .
2)) (END . (component_list . 2)))
+ ((default . error) (WHEN . (component_list . 4)) (IDENTIFIER .
(component_list . 4)) (FOR . (component_list . 4)) (CASE . (component_list .
4)) (END . (component_list . 4)))
((default . error) (IS . (direct_name . 0)))
((default . error) (IS . (direct_name . 1)))
((default . error) (IS . (direct_name_opt . 1)))
- ((default . error) (IS . 1219))
- ((default . error) (WITH . (and_interface_list_opt . 0)) (AND . 811))
- ((default . error) (DOT . 87) (TICK . 88) (AND . 811) (WITH .
((and_interface_list_opt . 0) (constraint_opt . 0))) (SEMICOLON .
(constraint_opt . 0)) (RANGE . 849) (LEFT_PAREN . 819))
- ((default . error) (SEMICOLON . 1214))
- ((default . error) (END . (full_type_declaration . 0)) (PRIVATE .
(full_type_declaration . 0)) (USE . (full_type_declaration . 0)) (TYPE .
(full_type_declaration . 0)) (TASK . (full_type_declaration . 0)) (SUBTYPE .
(full_type_declaration . 0)) (PROTECTED . (full_type_declaration . 0))
(PROCEDURE . (full_type_declaration . 0)) (PRAGMA . (full_type_declaration .
0)) (PACKAGE . (full_type_declaration . 0)) (OVERRIDING .
(full_type_declaration . 0)) (NOT . (full_type_declaration . 0)) [...]
- ((default . error) (PRIVATE . (object_declaration . 3)) (END .
(object_declaration . 3)) (BEGIN . (object_declaration . 3)) (IDENTIFIER .
(object_declaration . 3)) (ENTRY . (object_declaration . 3)) (FOR .
(object_declaration . 3)) (FUNCTION . (object_declaration . 3)) (GENERIC .
(object_declaration . 3)) (NOT . (object_declaration . 3)) (OVERRIDING .
(object_declaration . 3)) (PACKAGE . (object_declaration . 3)) (PRAGMA .
(object_declaration . 3)) (PROCEDURE . (object_declaration [...]
- ((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
108))
- ((default . error) (PRIVATE . (object_declaration . 5)) (END .
(object_declaration . 5)) (BEGIN . (object_declaration . 5)) (IDENTIFIER .
(object_declaration . 5)) (ENTRY . (object_declaration . 5)) (FOR .
(object_declaration . 5)) (FUNCTION . (object_declaration . 5)) (GENERIC .
(object_declaration . 5)) (NOT . (object_declaration . 5)) (OVERRIDING .
(object_declaration . 5)) (PACKAGE . (object_declaration . 5)) (PRAGMA .
(object_declaration . 5)) (PROCEDURE . (object_declaration [...]
- ((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
108))
- ((default . error) (PRIVATE . (object_declaration . 1)) (END .
(object_declaration . 1)) (BEGIN . (object_declaration . 1)) (IDENTIFIER .
(object_declaration . 1)) (ENTRY . (object_declaration . 1)) (FOR .
(object_declaration . 1)) (FUNCTION . (object_declaration . 1)) (GENERIC .
(object_declaration . 1)) (NOT . (object_declaration . 1)) (OVERRIDING .
(object_declaration . 1)) (PACKAGE . (object_declaration . 1)) (PRAGMA .
(object_declaration . 1)) (PROCEDURE . (object_declaration [...]
- ((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
108))
- ((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
108))
- ((default . error) (END . (package_body . 0)) (BEGIN . (package_body .
0)) (IDENTIFIER . (package_body . 0)) (ENTRY . (package_body . 0)) (FOR .
(package_body . 0)) (PROTECTED . (package_body . 0)) (SUBTYPE . (package_body .
0)) (TASK . (package_body . 0)) (TYPE . (package_body . 0)) (WITH .
(package_body . 0)) (USE . (package_body . 0)) (SEPARATE . (package_body . 0))
(PROCEDURE . (package_body . 0)) (PRIVATE . (package_body . 0)) (PRAGMA .
(package_body . 0)) (PACKAGE . (package_ [...]
- ((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
- ((default . error) (DOT . 87) (TICK . 88) (LOOP .
(iterator_specification . 3)) (EQUAL_GREATER . (iterator_specification . 3))
(LEFT_PAREN . 106))
- ((default . error) (SEMICOLON . (identifier_opt . 0)) (IDENTIFIER .
703))
+ ((default . error) (IS . 1223))
+ ((default . error) (WITH . (and_interface_list_opt . 0)) (AND . 819))
+ ((default . error) (DOT . 90) (TICK . 91) (AND . 819) (WITH .
((constraint_opt . 0) (and_interface_list_opt . 0))) (SEMICOLON .
(constraint_opt . 0)) (RANGE . 902) (LEFT_PAREN . 827))
+ ((default . error) (SEMICOLON . 1218))
+ ((default . error) (END . (full_type_declaration . 0)) (PRIVATE .
(full_type_declaration . 0)) (IDENTIFIER . (full_type_declaration . 0)) (USE .
(full_type_declaration . 0)) (TYPE . (full_type_declaration . 0)) (TASK .
(full_type_declaration . 0)) (SUBTYPE . (full_type_declaration . 0)) (PROTECTED
. (full_type_declaration . 0)) (PROCEDURE . (full_type_declaration . 0))
(PRAGMA . (full_type_declaration . 0)) (PACKAGE . (full_type_declaration . 0))
(OVERRIDING . (full_type_declaratio [...]
+ ((default . error) (END . (object_renaming_declaration . 2)) (PRIVATE .
(object_renaming_declaration . 2)) (IDENTIFIER . (object_renaming_declaration .
2)) (USE . (object_renaming_declaration . 2)) (TYPE .
(object_renaming_declaration . 2)) (TASK . (object_renaming_declaration . 2))
(SUBTYPE . (object_renaming_declaration . 2)) (PROTECTED .
(object_renaming_declaration . 2)) (PROCEDURE . (object_renaming_declaration .
2)) (PRAGMA . (object_renaming_declaration . 2)) (PACKAGE . (obj [...]
+ ((default . error) (END . (object_renaming_declaration . 1)) (PRIVATE .
(object_renaming_declaration . 1)) (IDENTIFIER . (object_renaming_declaration .
1)) (USE . (object_renaming_declaration . 1)) (TYPE .
(object_renaming_declaration . 1)) (TASK . (object_renaming_declaration . 1))
(SUBTYPE . (object_renaming_declaration . 1)) (PROTECTED .
(object_renaming_declaration . 1)) (PROCEDURE . (object_renaming_declaration .
1)) (PRAGMA . (object_renaming_declaration . 1)) (PACKAGE . (obj [...]
+ ((default . error) (SEMICOLON . 1217))
+ ((default . error) (PRIVATE . (object_declaration . 3)) (END .
(object_declaration . 3)) (BEGIN . (object_declaration . 3)) (ENTRY .
(object_declaration . 3)) (FOR . (object_declaration . 3)) (FUNCTION .
(object_declaration . 3)) (GENERIC . (object_declaration . 3)) (NOT .
(object_declaration . 3)) (OVERRIDING . (object_declaration . 3)) (PACKAGE .
(object_declaration . 3)) (PRAGMA . (object_declaration . 3)) (PROCEDURE .
(object_declaration . 3)) (PROTECTED . (object_declaration . [...]
+ ((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
109))
+ ((default . error) (PRIVATE . (object_declaration . 5)) (END .
(object_declaration . 5)) (BEGIN . (object_declaration . 5)) (ENTRY .
(object_declaration . 5)) (FOR . (object_declaration . 5)) (FUNCTION .
(object_declaration . 5)) (GENERIC . (object_declaration . 5)) (NOT .
(object_declaration . 5)) (OVERRIDING . (object_declaration . 5)) (PACKAGE .
(object_declaration . 5)) (PRAGMA . (object_declaration . 5)) (PROCEDURE .
(object_declaration . 5)) (PROTECTED . (object_declaration . [...]
+ ((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
109))
+ ((default . error) (PRIVATE . (object_declaration . 1)) (END .
(object_declaration . 1)) (BEGIN . (object_declaration . 1)) (ENTRY .
(object_declaration . 1)) (FOR . (object_declaration . 1)) (FUNCTION .
(object_declaration . 1)) (GENERIC . (object_declaration . 1)) (NOT .
(object_declaration . 1)) (OVERRIDING . (object_declaration . 1)) (PACKAGE .
(object_declaration . 1)) (PRAGMA . (object_declaration . 1)) (PROCEDURE .
(object_declaration . 1)) (PROTECTED . (object_declaration . [...]
+ ((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
109))
+ ((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
109))
+ ((default . error) (END . (package_body . 0)) (BEGIN . (package_body .
0)) (ENTRY . (package_body . 0)) (FOR . (package_body . 0)) (PROTECTED .
(package_body . 0)) (SUBTYPE . (package_body . 0)) (TASK . (package_body . 0))
(TYPE . (package_body . 0)) (IDENTIFIER . (package_body . 0)) (WITH .
(package_body . 0)) (USE . (package_body . 0)) (SEPARATE . (package_body . 0))
(PROCEDURE . (package_body . 0)) (PRIVATE . (package_body . 0)) (PRAGMA .
(package_body . 0)) (PACKAGE . (package_ [...]
+ ((default . error) (ELSE . (elsif_expression_item . 0)) (ELSIF .
(elsif_expression_item . 0)) (RIGHT_PAREN . (elsif_expression_item . 0)) (COMMA
. (elsif_expression_item . 0)))
+ ((default . error) (DOT . 90) (TICK . 91) (LOOP .
(iterator_specification . 2)) (EQUAL_GREATER . (iterator_specification . 2))
(LEFT_PAREN . 107))
+ ((default . error) (DO . (subtype_indication . 0)) (COLON_EQUAL .
(subtype_indication . 0)) (LOOP . (subtype_indication . 0)) (RIGHT_PAREN .
(subtype_indication . 0)) (COMMA . (subtype_indication . 0)) (EQUAL_GREATER .
(subtype_indication . 0)) (WITH . (subtype_indication . 0)) (AND .
(subtype_indication . 0)) (OF . (subtype_indication . 0)) (SEMICOLON .
(subtype_indication . 0)))
+ ((default . error) (SEMICOLON . (identifier_opt . 0)) (IDENTIFIER .
716))
((default . error) (PROCEDURE . (protected_operation_item_list . 1))
(OVERRIDING . (protected_operation_item_list . 1)) (NOT .
(protected_operation_item_list . 1)) (FUNCTION . (protected_operation_item_list
. 1)) (FOR . (protected_operation_item_list . 1)) (ENTRY .
(protected_operation_item_list . 1)) (END . (protected_operation_item_list .
1)))
- ((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (IS .
(aspect_specification_opt . 0)) (WITH . 108))
- ((default . error) (WHEN . (parameter_profile_opt . 0)) (LEFT_PAREN .
1205))
- ((default . error) (END . (sequence_of_statements_opt . 0)) (EXCEPTION .
(sequence_of_statements_opt . 0)) (ACCEPT . (label_opt . 0)) (BEGIN .
(label_opt . 0)) (CASE . (label_opt . 0)) (DECLARE . (label_opt . 0)) (FOR .
(label_opt . 0)) (IF . (label_opt . 0)) (LOOP . (label_opt . 0)) (RETURN .
(label_opt . 0)) (SELECT . (label_opt . 0)) (WHILE . (label_opt . 0))
(STRING_LITERAL . (label_opt . 0)) (CHARACTER_LITERAL . (label_opt . 0)) (ABORT
. (label_opt . 0)) (DELAY . (label_opt . [...]
- ((default . error) (THEN . (accept_statement . 1)) (WHEN .
(accept_statement . 1)) (EXCEPTION . (accept_statement . 1)) (ELSIF .
(accept_statement . 1)) (ELSE . (accept_statement . 1)) (OR . (accept_statement
. 1)) (END . (accept_statement . 1)) (LESS_LESS . (accept_statement . 1))
(IDENTIFIER . (accept_statement . 1)) (STRING_LITERAL . (accept_statement . 1))
(CHARACTER_LITERAL . (accept_statement . 1)) (ACCEPT . (accept_statement . 1))
(ABORT . (accept_statement . 1)) (BEGIN . (a [...]
- ((default . error) (END . (sequence_of_statements_opt . 0)) (EXCEPTION .
(sequence_of_statements_opt . 0)) (ACCEPT . (label_opt . 0)) (BEGIN .
(label_opt . 0)) (CASE . (label_opt . 0)) (DECLARE . (label_opt . 0)) (FOR .
(label_opt . 0)) (IF . (label_opt . 0)) (LOOP . (label_opt . 0)) (RETURN .
(label_opt . 0)) (SELECT . (label_opt . 0)) (WHILE . (label_opt . 0))
(STRING_LITERAL . (label_opt . 0)) (CHARACTER_LITERAL . (label_opt . 0)) (ABORT
. (label_opt . 0)) (DELAY . (label_opt . [...]
- ((default . error) (OR . (block_statement . 1)) (THEN . (block_statement
. 1)) (WHEN . (block_statement . 1)) (EXCEPTION . (block_statement . 1)) (END .
(block_statement . 1)) (LESS_LESS . (block_statement . 1)) (IDENTIFIER .
(block_statement . 1)) (STRING_LITERAL . (block_statement . 1))
(CHARACTER_LITERAL . (block_statement . 1)) (ACCEPT . (block_statement . 1))
(ABORT . (block_statement . 1)) (BEGIN . (block_statement . 1)) (CASE .
(block_statement . 1)) (DECLARE . (block_statem [...]
- ((default . error) (CASE . 1202))
+ ((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (IS .
(aspect_specification_opt . 0)) (WITH . 109))
+ ((default . error) (WHEN . (parameter_profile_opt . 0)) (LEFT_PAREN .
1209))
+ ((default . error) (END . (sequence_of_statements_opt . 0)) (EXCEPTION .
(sequence_of_statements_opt . 0)) (ACCEPT . (label_opt . 0)) (BEGIN .
(label_opt . 0)) (CASE . (label_opt . 0)) (DECLARE . (label_opt . 0)) (FOR .
(label_opt . 0)) (IF . (label_opt . 0)) (LOOP . (label_opt . 0)) (RETURN .
(label_opt . 0)) (SELECT . (label_opt . 0)) (WHILE . (label_opt . 0)) (ABORT .
(label_opt . 0)) (DELAY . (label_opt . 0)) (EXIT . (label_opt . 0)) (GOTO .
(label_opt . 0)) (NULL . (label_opt [...]
+ ((default . error) (END . (sequence_of_statements_opt . 0)) (EXCEPTION .
(sequence_of_statements_opt . 0)) (ACCEPT . (label_opt . 0)) (BEGIN .
(label_opt . 0)) (CASE . (label_opt . 0)) (DECLARE . (label_opt . 0)) (FOR .
(label_opt . 0)) (IF . (label_opt . 0)) (LOOP . (label_opt . 0)) (RETURN .
(label_opt . 0)) (SELECT . (label_opt . 0)) (WHILE . (label_opt . 0)) (ABORT .
(label_opt . 0)) (DELAY . (label_opt . 0)) (EXIT . (label_opt . 0)) (GOTO .
(label_opt . 0)) (NULL . (label_opt [...]
+ ((default . error) (THEN . (accept_statement . 1)) (WHEN .
(accept_statement . 1)) (EXCEPTION . (accept_statement . 1)) (ELSIF .
(accept_statement . 1)) (ELSE . (accept_statement . 1)) (OR . (accept_statement
. 1)) (END . (accept_statement . 1)) (ACCEPT . (accept_statement . 1)) (ABORT .
(accept_statement . 1)) (BEGIN . (accept_statement . 1)) (CASE .
(accept_statement . 1)) (DECLARE . (accept_statement . 1)) (DELAY .
(accept_statement . 1)) (EXIT . (accept_statement . 1)) (FOR . ( [...]
+ ((default . error) (OR . (block_statement . 1)) (THEN . (block_statement
. 1)) (WHEN . (block_statement . 1)) (EXCEPTION . (block_statement . 1)) (END .
(block_statement . 1)) (ACCEPT . (block_statement . 1)) (ABORT .
(block_statement . 1)) (BEGIN . (block_statement . 1)) (CASE . (block_statement
. 1)) (DECLARE . (block_statement . 1)) (DELAY . (block_statement . 1)) (EXIT .
(block_statement . 1)) (FOR . (block_statement . 1)) (GOTO . (block_statement .
1)) (IF . (block_statement . [...]
+ ((default . error) (CASE . 1206))
((default . error) (WHEN . (case_statement_alternative_list . 1)) (END .
(case_statement_alternative_list . 1)))
- ((default . error) (BAR . 282) (EQUAL_GREATER . 1201))
- ((default . error) (SEMICOLON . (identifier_opt . 0)) (IDENTIFIER .
703))
- ((default . error) (OR . (exit_statement . 0)) (THEN . (exit_statement .
0)) (WHEN . (exit_statement . 0)) (EXCEPTION . (exit_statement . 0)) (END .
(exit_statement . 0)) (LESS_LESS . (exit_statement . 0)) (IDENTIFIER .
(exit_statement . 0)) (STRING_LITERAL . (exit_statement . 0))
(CHARACTER_LITERAL . (exit_statement . 0)) (ACCEPT . (exit_statement . 0))
(ABORT . (exit_statement . 0)) (BEGIN . (exit_statement . 0)) (CASE .
(exit_statement . 0)) (DECLARE . (exit_statement . 0)) (DEL [...]
- ((default . error) (END . (sequence_of_statements_opt . 0)) (ACCEPT .
(label_opt . 0)) (BEGIN . (label_opt . 0)) (CASE . (label_opt . 0)) (DECLARE .
(label_opt . 0)) (FOR . (label_opt . 0)) (IF . (label_opt . 0)) (LOOP .
(label_opt . 0)) (RETURN . (label_opt . 0)) (SELECT . (label_opt . 0)) (WHILE .
(label_opt . 0)) (STRING_LITERAL . (label_opt . 0)) (CHARACTER_LITERAL .
(label_opt . 0)) (ABORT . (label_opt . 0)) (DELAY . (label_opt . 0)) (EXIT .
(label_opt . 0)) (GOTO . (label_opt [...]
- ((default . error) (THEN . (expression_opt . 0)) (RAISE . 152) (PLUS .
144) (MINUS . 143) (ABS . 147) (NOT . 150) (NUMERIC_LITERAL . 145) (NULL .
151) (NEW . 149) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL
. 49) (LEFT_PAREN . 148))
- ((default . error) (IF . 1197))
+ ((default . error) (BAR . 286) (EQUAL_GREATER . 1205))
+ ((default . error) (SEMICOLON . (identifier_opt . 0)) (IDENTIFIER .
716))
+ ((default . error) (OR . (exit_statement . 0)) (THEN . (exit_statement .
0)) (WHEN . (exit_statement . 0)) (EXCEPTION . (exit_statement . 0)) (END .
(exit_statement . 0)) (ACCEPT . (exit_statement . 0)) (ABORT . (exit_statement
. 0)) (BEGIN . (exit_statement . 0)) (CASE . (exit_statement . 0)) (DECLARE .
(exit_statement . 0)) (DELAY . (exit_statement . 0)) (EXIT . (exit_statement .
0)) (FOR . (exit_statement . 0)) (GOTO . (exit_statement . 0)) (IF .
(exit_statement . 0)) (LOOP . (e [...]
+ ((default . error) (END . (sequence_of_statements_opt . 0)) (ACCEPT .
(label_opt . 0)) (BEGIN . (label_opt . 0)) (CASE . (label_opt . 0)) (DECLARE .
(label_opt . 0)) (FOR . (label_opt . 0)) (IF . (label_opt . 0)) (LOOP .
(label_opt . 0)) (RETURN . (label_opt . 0)) (SELECT . (label_opt . 0)) (WHILE .
(label_opt . 0)) (ABORT . (label_opt . 0)) (DELAY . (label_opt . 0)) (EXIT .
(label_opt . 0)) (GOTO . (label_opt . 0)) (NULL . (label_opt . 0)) (PRAGMA .
(label_opt . 0)) (RAISE . (labe [...]
+ ((default . error) (THEN . (expression_opt . 0)) (RAISE . 152) (PLUS .
154) (MINUS . 153) (ABS . 144) (NOT . 150) (NUMERIC_LITERAL . 155) (NULL .
151) (NEW . 149) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL
. 49) (LEFT_PAREN . 148))
+ ((default . error) (IF . 1201))
((default . error) (END . (elsif_statement_list . 0)) (ELSE .
(elsif_statement_list . 0)) (ELSIF . (elsif_statement_list . 0)))
- ((default . error) (END . 1195) (ELSE . 1194) (ELSIF . 1157))
- ((default . error) (SEMICOLON . 1193))
- ((default . error) (OR . (raise_statement . 1)) (THEN . (raise_statement
. 1)) (WHEN . (raise_statement . 1)) (EXCEPTION . (raise_statement . 1)) (END .
(raise_statement . 1)) (LESS_LESS . (raise_statement . 1)) (IDENTIFIER .
(raise_statement . 1)) (STRING_LITERAL . (raise_statement . 1))
(CHARACTER_LITERAL . (raise_statement . 1)) (ACCEPT . (raise_statement . 1))
(ABORT . (raise_statement . 1)) (BEGIN . (raise_statement . 1)) (CASE .
(raise_statement . 1)) (DECLARE . (raise_statem [...]
- ((default . error) (OR . (requeue_statement . 0)) (THEN .
(requeue_statement . 0)) (WHEN . (requeue_statement . 0)) (EXCEPTION .
(requeue_statement . 0)) (END . (requeue_statement . 0)) (LESS_LESS .
(requeue_statement . 0)) (IDENTIFIER . (requeue_statement . 0)) (STRING_LITERAL
. (requeue_statement . 0)) (CHARACTER_LITERAL . (requeue_statement . 0))
(ACCEPT . (requeue_statement . 0)) (ABORT . (requeue_statement . 0)) (BEGIN .
(requeue_statement . 0)) (CASE . (requeue_statement . 0) [...]
- ((default . error) (RETURN . 1192))
- ((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49) (ACCESS . (null_exclusion_opt . 0)) (NOT . 878))
- ((default . error) (END . 1188))
- ((default . error) (SELECT . 1187))
- ((default . error) (OR . (selective_accept . 1)) (THEN .
(selective_accept . 1)) (WHEN . (selective_accept . 1)) (EXCEPTION .
(selective_accept . 1)) (END . (selective_accept . 1)) (LESS_LESS .
(selective_accept . 1)) (IDENTIFIER . (selective_accept . 1)) (STRING_LITERAL .
(selective_accept . 1)) (CHARACTER_LITERAL . (selective_accept . 1)) (ACCEPT .
(selective_accept . 1)) (ABORT . (selective_accept . 1)) (BEGIN .
(selective_accept . 1)) (CASE . (selective_accept . 1)) (DECLARE . [...]
- ((default . error) (SELECT . 1186))
+ ((default . error) (END . 1199) (ELSE . 1198) (ELSIF . 1161))
+ ((default . error) (SEMICOLON . 1197))
+ ((default . error) (OR . (raise_statement . 1)) (THEN . (raise_statement
. 1)) (WHEN . (raise_statement . 1)) (EXCEPTION . (raise_statement . 1)) (END .
(raise_statement . 1)) (ACCEPT . (raise_statement . 1)) (ABORT .
(raise_statement . 1)) (BEGIN . (raise_statement . 1)) (CASE . (raise_statement
. 1)) (DECLARE . (raise_statement . 1)) (DELAY . (raise_statement . 1)) (EXIT .
(raise_statement . 1)) (FOR . (raise_statement . 1)) (GOTO . (raise_statement .
1)) (IF . (raise_statement . [...]
+ ((default . error) (OR . (requeue_statement . 0)) (THEN .
(requeue_statement . 0)) (WHEN . (requeue_statement . 0)) (EXCEPTION .
(requeue_statement . 0)) (END . (requeue_statement . 0)) (ACCEPT .
(requeue_statement . 0)) (ABORT . (requeue_statement . 0)) (BEGIN .
(requeue_statement . 0)) (CASE . (requeue_statement . 0)) (DECLARE .
(requeue_statement . 0)) (DELAY . (requeue_statement . 0)) (EXIT .
(requeue_statement . 0)) (FOR . (requeue_statement . 0)) (GOTO .
(requeue_statement . [...]
+ ((default . error) (RETURN . 1196))
+ ((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49) (ACCESS . (null_exclusion_opt . 0)) (NOT . 883))
+ ((default . error) (END . 1192))
+ ((default . error) (SELECT . 1191))
+ ((default . error) (OR . (selective_accept . 1)) (THEN .
(selective_accept . 1)) (WHEN . (selective_accept . 1)) (EXCEPTION .
(selective_accept . 1)) (END . (selective_accept . 1)) (ACCEPT .
(selective_accept . 1)) (ABORT . (selective_accept . 1)) (BEGIN .
(selective_accept . 1)) (CASE . (selective_accept . 1)) (DECLARE .
(selective_accept . 1)) (DELAY . (selective_accept . 1)) (EXIT .
(selective_accept . 1)) (FOR . (selective_accept . 1)) (GOTO .
(selective_accept . 1)) (IF . (sel [...]
+ ((default . error) (SELECT . 1190))
((default . error) (END . (delay_alternative . 0)) (OR .
(delay_alternative . 0)) (ELSE . (delay_alternative . 0)))
- ((default . error) (SELECT . 1185))
- ((default . error) (SEMICOLON . 1184))
- ((default . error) (ELSE . (sequence_of_statements_opt . 0)) (OR .
(sequence_of_statements_opt . 0)) (END . (sequence_of_statements_opt . 0))
(ACCEPT . (label_opt . 0)) (BEGIN . (label_opt . 0)) (CASE . (label_opt . 0))
(DECLARE . (label_opt . 0)) (FOR . (label_opt . 0)) (IF . (label_opt . 0))
(LOOP . (label_opt . 0)) (RETURN . (label_opt . 0)) (SELECT . (label_opt . 0))
(WHILE . (label_opt . 0)) (STRING_LITERAL . (label_opt . 0)) (CHARACTER_LITERAL
. (label_opt . 0)) (ABORT . (lab [...]
+ ((default . error) (SELECT . 1189))
+ ((default . error) (SEMICOLON . 1188))
+ ((default . error) (ELSE . (sequence_of_statements_opt . 0)) (OR .
(sequence_of_statements_opt . 0)) (END . (sequence_of_statements_opt . 0))
(ACCEPT . (label_opt . 0)) (BEGIN . (label_opt . 0)) (CASE . (label_opt . 0))
(DECLARE . (label_opt . 0)) (FOR . (label_opt . 0)) (IF . (label_opt . 0))
(LOOP . (label_opt . 0)) (RETURN . (label_opt . 0)) (SELECT . (label_opt . 0))
(WHILE . (label_opt . 0)) (ABORT . (label_opt . 0)) (DELAY . (label_opt . 0))
(EXIT . (label_opt . 0)) (GOTO . ( [...]
((default . error) (END . (select_alternative . 2)) (OR .
(select_alternative . 2)) (ELSE . (select_alternative . 2)))
- ((default . error) (SEMICOLON . (identifier_opt . 0)) (IDENTIFIER .
703))
- ((default . error) (OTHERS . 946) (IDENTIFIER . 48) (CHARACTER_LITERAL
. 50) (STRING_LITERAL . 49))
- ((default . error) (WHEN . (sequence_of_statements_opt . 0)) (END .
(sequence_of_statements_opt . 0)) (ACCEPT . (label_opt . 0)) (BEGIN .
(label_opt . 0)) (CASE . (label_opt . 0)) (DECLARE . (label_opt . 0)) (FOR .
(label_opt . 0)) (IF . (label_opt . 0)) (LOOP . (label_opt . 0)) (RETURN .
(label_opt . 0)) (SELECT . (label_opt . 0)) (WHILE . (label_opt . 0))
(STRING_LITERAL . (label_opt . 0)) (CHARACTER_LITERAL . (label_opt . 0)) (ABORT
. (label_opt . 0)) (DELAY . (label_opt . 0)) ( [...]
- ((default . error) (OTHERS . 946) (IDENTIFIER . 48) (CHARACTER_LITERAL
. 50) (STRING_LITERAL . 49))
- ((default . error) (BAR . 1176) (EQUAL_GREATER . 1282))
+ ((default . error) (SEMICOLON . (identifier_opt . 0)) (IDENTIFIER .
716))
+ ((default . error) (OTHERS . 955) (IDENTIFIER . 48) (CHARACTER_LITERAL
. 50) (STRING_LITERAL . 49))
+ ((default . error) (WHEN . (sequence_of_statements_opt . 0)) (END .
(sequence_of_statements_opt . 0)) (ACCEPT . (label_opt . 0)) (BEGIN .
(label_opt . 0)) (CASE . (label_opt . 0)) (DECLARE . (label_opt . 0)) (FOR .
(label_opt . 0)) (IF . (label_opt . 0)) (LOOP . (label_opt . 0)) (RETURN .
(label_opt . 0)) (SELECT . (label_opt . 0)) (WHILE . (label_opt . 0)) (ABORT .
(label_opt . 0)) (DELAY . (label_opt . 0)) (EXIT . (label_opt . 0)) (GOTO .
(label_opt . 0)) (NULL . (label_opt . 0)) [...]
+ ((default . error) (OTHERS . 955) (IDENTIFIER . 48) (CHARACTER_LITERAL
. 50) (STRING_LITERAL . 49))
+ ((default . error) (BAR . 1180) (EQUAL_GREATER . 1284))
((default . error) (WHEN . (exception_handler . 1)) (END .
(exception_handler . 1)))
((default . error) (EQUAL_GREATER . (exception_choice_list . 1)) (BAR .
(exception_choice_list . 1)))
- ((default . error) (SEMICOLON . 1281))
+ ((default . error) (SEMICOLON . 1283))
((default . error) (ELSE . (select_alternative . 0)) (OR .
(select_alternative . 0)) (END . (select_alternative . 0)))
((default . error) (ELSE . (select_alternative . 4)) (OR .
(select_alternative . 4)) (END . (select_alternative . 4)))
+ ((default . error) (SEMICOLON . 1282))
+ ((default . error) (SEMICOLON . 1281))
((default . error) (SEMICOLON . 1280))
- ((default . error) (SEMICOLON . 1279))
- ((default . error) (SEMICOLON . 1278))
- ((default . error) (SELECT . 1277))
+ ((default . error) (SELECT . 1279))
((default . error) (DO . (return_subtype_indication . 1)) (SEMICOLON .
(return_subtype_indication . 1)) (COLON_EQUAL . (return_subtype_indication .
1)))
- ((default . error) (DO . (extended_return_object_declaration . 1))
(SEMICOLON . (extended_return_object_declaration . 1)) (COLON_EQUAL . 1276))
+ ((default . error) (DO . (extended_return_object_declaration . 1))
(SEMICOLON . (extended_return_object_declaration . 1)) (COLON_EQUAL . 1278))
((default . error) (DO . (return_subtype_indication . 0)) (SEMICOLON .
(return_subtype_indication . 0)) (COLON_EQUAL . (return_subtype_indication .
0)))
- ((default . error) (SEMICOLON . 1275))
- ((default . error) (WHEN . (loop_statement . 1)) (THEN . (loop_statement
. 1)) (OR . (loop_statement . 1)) (ELSIF . (loop_statement . 1)) (ELSE .
(loop_statement . 1)) (WHILE . (loop_statement . 1)) (SELECT . (loop_statement
. 1)) (RETURN . (loop_statement . 1)) (REQUEUE . (loop_statement . 1)) (RAISE .
(loop_statement . 1)) (PRAGMA . (loop_statement . 1)) (NULL . (loop_statement .
1)) (LOOP . (loop_statement . 1)) (IF . (loop_statement . 1)) (GOTO .
(loop_statement . 1)) (FOR . (l [...]
- ((default . error) (END . (sequence_of_statements_opt . 0)) (ACCEPT .
(label_opt . 0)) (BEGIN . (label_opt . 0)) (CASE . (label_opt . 0)) (DECLARE .
(label_opt . 0)) (FOR . (label_opt . 0)) (IF . (label_opt . 0)) (LOOP .
(label_opt . 0)) (RETURN . (label_opt . 0)) (SELECT . (label_opt . 0)) (WHILE .
(label_opt . 0)) (STRING_LITERAL . (label_opt . 0)) (CHARACTER_LITERAL .
(label_opt . 0)) (ABORT . (label_opt . 0)) (DELAY . (label_opt . 0)) (EXIT .
(label_opt . 0)) (GOTO . (label_opt [...]
- ((default . error) (IF . 1273))
+ ((default . error) (SEMICOLON . 1277))
+ ((default . error) (WHEN . (loop_statement . 1)) (THEN . (loop_statement
. 1)) (OR . (loop_statement . 1)) (ELSIF . (loop_statement . 1)) (ELSE .
(loop_statement . 1)) (CHARACTER_LITERAL . (loop_statement . 1))
(STRING_LITERAL . (loop_statement . 1)) (IDENTIFIER . (loop_statement . 1))
(LESS_LESS . (loop_statement . 1)) (WHILE . (loop_statement . 1)) (SELECT .
(loop_statement . 1)) (RETURN . (loop_statement . 1)) (REQUEUE .
(loop_statement . 1)) (RAISE . (loop_statement . 1)) (PRAG [...]
+ ((default . error) (END . (sequence_of_statements_opt . 0)) (ACCEPT .
(label_opt . 0)) (BEGIN . (label_opt . 0)) (CASE . (label_opt . 0)) (DECLARE .
(label_opt . 0)) (FOR . (label_opt . 0)) (IF . (label_opt . 0)) (LOOP .
(label_opt . 0)) (RETURN . (label_opt . 0)) (SELECT . (label_opt . 0)) (WHILE .
(label_opt . 0)) (ABORT . (label_opt . 0)) (DELAY . (label_opt . 0)) (EXIT .
(label_opt . 0)) (GOTO . (label_opt . 0)) (NULL . (label_opt . 0)) (PRAGMA .
(label_opt . 0)) (RAISE . (labe [...]
+ ((default . error) (IF . 1275))
((default . error) (ELSIF . (elsif_statement_list . 1)) (ELSE .
(elsif_statement_list . 1)) (END . (elsif_statement_list . 1)))
- ((default . error) (SEMICOLON . 1272))
- ((default . error) (THEN . 1271))
- ((default . error) (END . 1270))
+ ((default . error) (SEMICOLON . 1274))
+ ((default . error) (THEN . 1273))
+ ((default . error) (END . 1272))
+ ((default . error) (SEMICOLON . 1271))
+ ((default . error) (END . (sequence_of_statements_opt . 0)) (WHEN .
(sequence_of_statements_opt . 0)) (ACCEPT . (label_opt . 0)) (BEGIN .
(label_opt . 0)) (CASE . (label_opt . 0)) (DECLARE . (label_opt . 0)) (FOR .
(label_opt . 0)) (IF . (label_opt . 0)) (LOOP . (label_opt . 0)) (RETURN .
(label_opt . 0)) (SELECT . (label_opt . 0)) (WHILE . (label_opt . 0)) (ABORT .
(label_opt . 0)) (DELAY . (label_opt . 0)) (EXIT . (label_opt . 0)) (GOTO .
(label_opt . 0)) (NULL . (label_opt . 0)) [...]
((default . error) (SEMICOLON . 1269))
- ((default . error) (END . (sequence_of_statements_opt . 0)) (WHEN .
(sequence_of_statements_opt . 0)) (ACCEPT . (label_opt . 0)) (BEGIN .
(label_opt . 0)) (CASE . (label_opt . 0)) (DECLARE . (label_opt . 0)) (FOR .
(label_opt . 0)) (IF . (label_opt . 0)) (LOOP . (label_opt . 0)) (RETURN .
(label_opt . 0)) (SELECT . (label_opt . 0)) (WHILE . (label_opt . 0))
(STRING_LITERAL . (label_opt . 0)) (CHARACTER_LITERAL . (label_opt . 0)) (ABORT
. (label_opt . 0)) (DELAY . (label_opt . 0)) ( [...]
- ((default . error) (SEMICOLON . 1267))
- ((default . error) (END . 1266))
- ((default . error) (END . 1265))
- ((default . error) (FOR . 1264) (IDENTIFIER . 72))
- ((default . error) (WHEN . 1263))
+ ((default . error) (END . 1268))
+ ((default . error) (END . 1267))
+ ((default . error) (FOR . 1266) (IDENTIFIER . 77))
+ ((default . error) (WHEN . 1265))
((default . error) (WHEN . (entry_body_formal_part . 1)))
+ ((default . error) (SEMICOLON . 1264))
+ ((default . error) (SEMICOLON . 1263))
((default . error) (SEMICOLON . 1262))
- ((default . error) (DOT . 87) (TICK . 88) (LOOP .
(iterator_specification . 2)) (EQUAL_GREATER . (iterator_specification . 2))
(LEFT_PAREN . 106))
((default . error) (SEMICOLON . 1261))
((default . error) (SEMICOLON . 1260))
- ((default . error) (SEMICOLON . 1259))
- ((default . error) (SEMICOLON . 1258))
- ((default . error) (BEGIN . (private_type_declaration . 0)) (IDENTIFIER
. (private_type_declaration . 0)) (ENTRY . (private_type_declaration . 0)) (FOR
. (private_type_declaration . 0)) (FUNCTION . (private_type_declaration . 0))
(GENERIC . (private_type_declaration . 0)) (NOT . (private_type_declaration .
0)) (OVERRIDING . (private_type_declaration . 0)) (PACKAGE .
(private_type_declaration . 0)) (PRAGMA . (private_type_declaration . 0))
(PROCEDURE . (private_type_declaration . 0) [...]
- ((default . error) (WITH . 1257))
+ ((default . error) (BEGIN . (object_renaming_declaration . 0)) (ENTRY .
(object_renaming_declaration . 0)) (FOR . (object_renaming_declaration . 0))
(FUNCTION . (object_renaming_declaration . 0)) (GENERIC .
(object_renaming_declaration . 0)) (NOT . (object_renaming_declaration . 0))
(OVERRIDING . (object_renaming_declaration . 0)) (PACKAGE .
(object_renaming_declaration . 0)) (PRAGMA . (object_renaming_declaration . 0))
(PROCEDURE . (object_renaming_declaration . 0)) (PROTECTED . ( [...]
+ ((default . error) (BEGIN . (private_type_declaration . 0)) (ENTRY .
(private_type_declaration . 0)) (FOR . (private_type_declaration . 0))
(FUNCTION . (private_type_declaration . 0)) (GENERIC .
(private_type_declaration . 0)) (NOT . (private_type_declaration . 0))
(OVERRIDING . (private_type_declaration . 0)) (PACKAGE .
(private_type_declaration . 0)) (PRAGMA . (private_type_declaration . 0))
(PROCEDURE . (private_type_declaration . 0)) (PROTECTED .
(private_type_declaration . 0)) [...]
+ ((default . error) (WITH . 1259))
((default . error) (WITH . (constraint_opt . 1)) (SEMICOLON .
(constraint_opt . 1)))
((default . error) (WITH . (derived_type_definition . 1)) (SEMICOLON .
(derived_type_definition . 1)))
- ((default . error) (WITH . 1256))
- ((default . error) (WHEN . 1253))
+ ((default . error) (WITH . 1258))
+ ((default . error) (WHEN . 1255))
((default . error) (SEMICOLON . (record_definition . 0)) (WITH .
(record_definition . 0)))
- ((default . error) (COLON_EQUAL . 1251) (SEMICOLON .
(aspect_specification_opt . 0)) (WITH . 108))
+ ((default . error) (COLON_EQUAL . 1253) (SEMICOLON .
(aspect_specification_opt . 0)) (WITH . 109))
((default . error) (SEMICOLON . (type_definition . 1)) (WITH .
(type_definition . 1)))
((default . error) (RIGHT_PAREN . (enumeration_literal_list . 1)) (COMMA
. (enumeration_literal_list . 1)))
- ((default . error) (DOT_DOT . 1250))
+ ((default . error) (DOT_DOT . 1252))
((default . error) (WITH . (real_range_specification_opt . 0))
(SEMICOLON . (real_range_specification_opt . 0)) (RANGE . 1114))
- ((default . error) (SEMICOLON . (identifier_opt . 0)) (IDENTIFIER .
703))
- ((default . error) (SEMICOLON . 1247))
- ((default . error) (USE . (task_type_declaration . 1)) (TYPE .
(task_type_declaration . 1)) (TASK . (task_type_declaration . 1)) (SUBTYPE .
(task_type_declaration . 1)) (PROTECTED . (task_type_declaration . 1))
(PROCEDURE . (task_type_declaration . 1)) (PRAGMA . (task_type_declaration .
1)) (PACKAGE . (task_type_declaration . 1)) (OVERRIDING .
(task_type_declaration . 1)) (NOT . (task_type_declaration . 1)) (GENERIC .
(task_type_declaration . 1)) (FUNCTION . (task_type_declaration [...]
- ((default . error) (AND . 1065) (WITH . 1246))
- ((default . error) (SEMICOLON . (identifier_opt . 0)) (IDENTIFIER .
703))
- ((default . error) (SEMICOLON . 1244))
- ((default . error) (USE . (protected_type_declaration . 1)) (TYPE .
(protected_type_declaration . 1)) (TASK . (protected_type_declaration . 1))
(SUBTYPE . (protected_type_declaration . 1)) (PROTECTED .
(protected_type_declaration . 1)) (PROCEDURE . (protected_type_declaration .
1)) (PRAGMA . (protected_type_declaration . 1)) (PACKAGE .
(protected_type_declaration . 1)) (OVERRIDING . (protected_type_declaration .
1)) (NOT . (protected_type_declaration . 1)) (GENERIC . (protected_typ [...]
- ((default . error) (AND . 1065) (WITH . 1243))
- ((default . error) (RANGE . 1242))
+ ((default . error) (IDENTIFIER . (task_type_declaration . 1)) (USE .
(task_type_declaration . 1)) (TYPE . (task_type_declaration . 1)) (TASK .
(task_type_declaration . 1)) (SUBTYPE . (task_type_declaration . 1)) (PROTECTED
. (task_type_declaration . 1)) (PROCEDURE . (task_type_declaration . 1))
(PRAGMA . (task_type_declaration . 1)) (PACKAGE . (task_type_declaration . 1))
(OVERRIDING . (task_type_declaration . 1)) (NOT . (task_type_declaration . 1))
(GENERIC . (task_type_declaratio [...]
+ ((default . error) (AND . 1078) (WITH . 1250))
+ ((default . error) (SEMICOLON . (identifier_opt . 0)) (IDENTIFIER .
716))
+ ((default . error) (SEMICOLON . 1248))
+ ((default . error) (IDENTIFIER . (protected_type_declaration . 1)) (USE
. (protected_type_declaration . 1)) (TYPE . (protected_type_declaration . 1))
(TASK . (protected_type_declaration . 1)) (SUBTYPE .
(protected_type_declaration . 1)) (PROTECTED . (protected_type_declaration .
1)) (PROCEDURE . (protected_type_declaration . 1)) (PRAGMA .
(protected_type_declaration . 1)) (PACKAGE . (protected_type_declaration . 1))
(OVERRIDING . (protected_type_declaration . 1)) (NOT . (protected_ [...]
+ ((default . error) (AND . 1078) (WITH . 1247))
+ ((default . error) (SEMICOLON . (identifier_opt . 0)) (IDENTIFIER .
716))
+ ((default . error) (SEMICOLON . 1245))
+ ((default . error) (RANGE . 1244))
((default . error) (SEMICOLON . (record_rep . 0)))
((default . error) (IDENTIFIER . (mod_clause_opt . 1)))
- ((default . error) (BEGIN . (object_renaming_declaration . 0))
(IDENTIFIER . (object_renaming_declaration . 0)) (ENTRY .
(object_renaming_declaration . 0)) (FOR . (object_renaming_declaration . 0))
(FUNCTION . (object_renaming_declaration . 0)) (GENERIC .
(object_renaming_declaration . 0)) (NOT . (object_renaming_declaration . 0))
(OVERRIDING . (object_renaming_declaration . 0)) (PACKAGE .
(object_renaming_declaration . 0)) (PRAGMA . (object_renaming_declaration . 0))
(PROCEDURE . [...]
((default . error) (COLON_EQUAL . (component_definition . 2)) (SEMICOLON
. (component_definition . 2)) (WITH . (component_definition . 2)))
((default . error) (COLON_EQUAL . (component_definition . 0)) (SEMICOLON
. (component_definition . 0)) (WITH . (component_definition . 0)))
- ((default . error) (RIGHT_PAREN . (subtype_indication . 1)) (COMMA .
(subtype_indication . 1)) (DOT . 87) (TICK . 88) (BAR . (discrete_choice .
1)) (EQUAL_GREATER . (discrete_choice . 1)) (RANGE . 849) (LEFT_PAREN . 819))
- ((default . error) (ELSE . (elsif_expression_item . 0)) (ELSIF .
(elsif_expression_item . 0)) (RIGHT_PAREN . (elsif_expression_item . 0)))
- ((default . error) (PLUS . 144) (MINUS . 143) (ABS . 147) (NOT .
150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN . 148))
- ((default . error) (END . (declarative_part_opt . 0)) (PRIVATE .
(declarative_part_opt . 0)) (USE . 11) (SUBTYPE . 299) (PRAGMA . 7) (NOT .
4) (OVERRIDING . 5) (FUNCTION . (overriding_indicator_opt . 2)) (PROCEDURE .
(overriding_indicator_opt . 2)) (ENTRY . (overriding_indicator_opt . 2)) (FOR .
296) (IDENTIFIER . 295) (TYPE . 301) (GENERIC . 2) (PROTECTED . 298) (TASK
. 300) (PACKAGE . 297))
- ((default . error) (END . (single_protected_declaration . 0)) (PRIVATE .
(single_protected_declaration . 0)) (USE . (single_protected_declaration . 0))
(TYPE . (single_protected_declaration . 0)) (TASK .
(single_protected_declaration . 0)) (SUBTYPE . (single_protected_declaration .
0)) (PROTECTED . (single_protected_declaration . 0)) (PROCEDURE .
(single_protected_declaration . 0)) (PRAGMA . (single_protected_declaration .
0)) (PACKAGE . (single_protected_declaration . 0)) (OVERRID [...]
+ ((default . error) (RIGHT_PAREN . (subtype_indication . 1)) (COMMA .
(subtype_indication . 1)) (DOT . 90) (TICK . 91) (BAR . (discrete_choice .
1)) (EQUAL_GREATER . (discrete_choice . 1)) (RANGE . 902) (LEFT_PAREN . 827))
+ ((default . error) (PLUS . 154) (MINUS . 153) (ABS . 144) (NOT .
150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN . 148))
+ ((default . error) (END . (single_protected_declaration . 0)) (PRIVATE .
(single_protected_declaration . 0)) (IDENTIFIER . (single_protected_declaration
. 0)) (USE . (single_protected_declaration . 0)) (TYPE .
(single_protected_declaration . 0)) (TASK . (single_protected_declaration . 0))
(SUBTYPE . (single_protected_declaration . 0)) (PROTECTED .
(single_protected_declaration . 0)) (PROCEDURE . (single_protected_declaration
. 0)) (PRAGMA . (single_protected_declaration . 0)) (PACK [...]
((default . error) (SEMICOLON . (protected_definition . 0)))
- ((default . error) (END . (declarative_part_opt . 0)) (PRIVATE .
(declarative_part_opt . 0)) (USE . 11) (SUBTYPE . 299) (PRAGMA . 7) (NOT .
4) (OVERRIDING . 5) (FUNCTION . (overriding_indicator_opt . 2)) (PROCEDURE .
(overriding_indicator_opt . 2)) (ENTRY . (overriding_indicator_opt . 2)) (FOR .
296) (IDENTIFIER . 295) (TYPE . 301) (GENERIC . 2) (PROTECTED . 298) (TASK
. 300) (PACKAGE . 297))
- ((default . error) (END . (single_task_declaration . 0)) (PRIVATE .
(single_task_declaration . 0)) (USE . (single_task_declaration . 0)) (TYPE .
(single_task_declaration . 0)) (TASK . (single_task_declaration . 0)) (SUBTYPE
. (single_task_declaration . 0)) (PROTECTED . (single_task_declaration . 0))
(PROCEDURE . (single_task_declaration . 0)) (PRAGMA . (single_task_declaration
. 0)) (PACKAGE . (single_task_declaration . 0)) (OVERRIDING .
(single_task_declaration . 0)) (NOT . (singl [...]
+ ((default . error) (END . (declarative_part_opt . 0)) (PRIVATE .
(declarative_part_opt . 0)) (USE . 11) (SUBTYPE . 302) (PRAGMA . 7) (NOT .
4) (OVERRIDING . 5) (FUNCTION . (overriding_indicator_opt . 2)) (PROCEDURE .
(overriding_indicator_opt . 2)) (ENTRY . (overriding_indicator_opt . 2)) (FOR .
299) (IDENTIFIER . 305) (TYPE . 304) (GENERIC . 2) (PROTECTED . 301) (TASK
. 303) (PACKAGE . 300))
+ ((default . error) (END . (single_task_declaration . 0)) (PRIVATE .
(single_task_declaration . 0)) (IDENTIFIER . (single_task_declaration . 0))
(USE . (single_task_declaration . 0)) (TYPE . (single_task_declaration . 0))
(TASK . (single_task_declaration . 0)) (SUBTYPE . (single_task_declaration .
0)) (PROTECTED . (single_task_declaration . 0)) (PROCEDURE .
(single_task_declaration . 0)) (PRAGMA . (single_task_declaration . 0))
(PACKAGE . (single_task_declaration . 0)) (OVERRIDING . [...]
((default . error) (SEMICOLON . (task_definition . 0)))
+ ((default . error) (END . (declarative_part_opt . 0)) (PRIVATE .
(declarative_part_opt . 0)) (USE . 11) (SUBTYPE . 302) (PRAGMA . 7) (NOT .
4) (OVERRIDING . 5) (FUNCTION . (overriding_indicator_opt . 2)) (PROCEDURE .
(overriding_indicator_opt . 2)) (ENTRY . (overriding_indicator_opt . 2)) (FOR .
299) (IDENTIFIER . 305) (TYPE . 304) (GENERIC . 2) (PROTECTED . 301) (TASK
. 303) (PACKAGE . 300))
((default . error) (WITH . (type_definition . 5)) (SEMICOLON .
(type_definition . 5)))
- ((default . error) (PLUS . 144) (MINUS . 143) (ABS . 147) (NOT .
150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN . 148))
- ((default . error) (RAISE . 152) (PLUS . 144) (MINUS . 143) (ABS .
147) (NOT . 150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
- ((default . error) (SEMICOLON . 1299))
- ((default . error) (EQUAL_GREATER . (discrete_choice_list . 0)) (BAR .
(discrete_choice_list . 0)) (OTHERS . 175) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (PLUS . 144) (MINUS . 143)
(ABS . 147) (NOT . 174) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149)
(LEFT_PAREN . 148))
- ((default . error) (END . 1296) (WHEN . 1253))
+ ((default . error) (PLUS . 154) (MINUS . 153) (ABS . 144) (NOT .
150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN . 148))
+ ((default . error) (RAISE . 152) (PLUS . 154) (MINUS . 153) (ABS .
144) (NOT . 150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
+ ((default . error) (SEMICOLON . 1301))
+ ((default . error) (EQUAL_GREATER . (discrete_choice_list . 0)) (BAR .
(discrete_choice_list . 0)) (OTHERS . 182) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (PLUS . 154) (MINUS . 153)
(ABS . 144) (NOT . 181) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149)
(LEFT_PAREN . 148))
+ ((default . error) (END . 1298) (WHEN . 1255))
((default . error) (END . (variant_list . 0)) (WHEN . (variant_list .
0)))
- ((default . error) (PRIVATE . 1295))
- ((default . error) (RECORD . 864) (NULL . 862))
- ((default . error) (PRIVATE . (object_declaration . 2)) (END .
(object_declaration . 2)) (BEGIN . (object_declaration . 2)) (IDENTIFIER .
(object_declaration . 2)) (ENTRY . (object_declaration . 2)) (FOR .
(object_declaration . 2)) (FUNCTION . (object_declaration . 2)) (GENERIC .
(object_declaration . 2)) (NOT . (object_declaration . 2)) (OVERRIDING .
(object_declaration . 2)) (PACKAGE . (object_declaration . 2)) (PRAGMA .
(object_declaration . 2)) (PROCEDURE . (object_declaration [...]
- ((default . error) (PRIVATE . (object_declaration . 4)) (END .
(object_declaration . 4)) (BEGIN . (object_declaration . 4)) (IDENTIFIER .
(object_declaration . 4)) (ENTRY . (object_declaration . 4)) (FOR .
(object_declaration . 4)) (FUNCTION . (object_declaration . 4)) (GENERIC .
(object_declaration . 4)) (NOT . (object_declaration . 4)) (OVERRIDING .
(object_declaration . 4)) (PACKAGE . (object_declaration . 4)) (PRAGMA .
(object_declaration . 4)) (PROCEDURE . (object_declaration [...]
- ((default . error) (PRIVATE . (object_declaration . 0)) (END .
(object_declaration . 0)) (BEGIN . (object_declaration . 0)) (IDENTIFIER .
(object_declaration . 0)) (ENTRY . (object_declaration . 0)) (FOR .
(object_declaration . 0)) (FUNCTION . (object_declaration . 0)) (GENERIC .
(object_declaration . 0)) (NOT . (object_declaration . 0)) (OVERRIDING .
(object_declaration . 0)) (PACKAGE . (object_declaration . 0)) (PRAGMA .
(object_declaration . 0)) (PROCEDURE . (object_declaration [...]
- ((default . error) (PRIVATE . (entry_declaration . 0)) (END .
(entry_declaration . 0)) (BEGIN . (entry_declaration . 0)) (IDENTIFIER .
(entry_declaration . 0)) (ENTRY . (entry_declaration . 0)) (FOR .
(entry_declaration . 0)) (FUNCTION . (entry_declaration . 0)) (GENERIC .
(entry_declaration . 0)) (NOT . (entry_declaration . 0)) (OVERRIDING .
(entry_declaration . 0)) (PACKAGE . (entry_declaration . 0)) (PRAGMA .
(entry_declaration . 0)) (PROCEDURE . (entry_declaration . 0)) (PROTEC [...]
- ((default . error) (PRIVATE . (protected_body . 0)) (END .
(protected_body . 0)) (BEGIN . (protected_body . 0)) (IDENTIFIER .
(protected_body . 0)) (ENTRY . (protected_body . 0)) (FOR . (protected_body .
0)) (FUNCTION . (protected_body . 0)) (GENERIC . (protected_body . 0)) (NOT .
(protected_body . 0)) (OVERRIDING . (protected_body . 0)) (PACKAGE .
(protected_body . 0)) (PRAGMA . (protected_body . 0)) (PROCEDURE .
(protected_body . 0)) (PROTECTED . (protected_body . 0)) (SUBTYPE . [...]
- ((default . error) (IS . (expression_opt . 0)) (RAISE . 152) (PLUS .
144) (MINUS . 143) (ABS . 147) (NOT . 150) (NUMERIC_LITERAL . 145) (NULL .
151) (NEW . 149) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL
. 49) (LEFT_PAREN . 148))
- ((default . error) (IDENTIFIER . 1292))
- ((default . error) (SEMICOLON . (identifier_opt . 0)) (IDENTIFIER .
703))
- ((default . error) (SEMICOLON . (identifier_opt . 0)) (IDENTIFIER .
703))
- ((default . error) (OR . (case_statement . 0)) (THEN . (case_statement .
0)) (WHEN . (case_statement . 0)) (EXCEPTION . (case_statement . 0)) (END .
(case_statement . 0)) (LESS_LESS . (case_statement . 0)) (IDENTIFIER .
(case_statement . 0)) (STRING_LITERAL . (case_statement . 0))
(CHARACTER_LITERAL . (case_statement . 0)) (ACCEPT . (case_statement . 0))
(ABORT . (case_statement . 0)) (BEGIN . (case_statement . 0)) (CASE .
(case_statement . 0)) (DECLARE . (case_statement . 0)) (DEL [...]
+ ((default . error) (PRIVATE . 1297))
+ ((default . error) (RECORD . 866) (NULL . 864))
+ ((default . error) (PRIVATE . (object_declaration . 2)) (END .
(object_declaration . 2)) (BEGIN . (object_declaration . 2)) (ENTRY .
(object_declaration . 2)) (FOR . (object_declaration . 2)) (FUNCTION .
(object_declaration . 2)) (GENERIC . (object_declaration . 2)) (NOT .
(object_declaration . 2)) (OVERRIDING . (object_declaration . 2)) (PACKAGE .
(object_declaration . 2)) (PRAGMA . (object_declaration . 2)) (PROCEDURE .
(object_declaration . 2)) (PROTECTED . (object_declaration . [...]
+ ((default . error) (PRIVATE . (object_declaration . 4)) (END .
(object_declaration . 4)) (BEGIN . (object_declaration . 4)) (ENTRY .
(object_declaration . 4)) (FOR . (object_declaration . 4)) (FUNCTION .
(object_declaration . 4)) (GENERIC . (object_declaration . 4)) (NOT .
(object_declaration . 4)) (OVERRIDING . (object_declaration . 4)) (PACKAGE .
(object_declaration . 4)) (PRAGMA . (object_declaration . 4)) (PROCEDURE .
(object_declaration . 4)) (PROTECTED . (object_declaration . [...]
+ ((default . error) (PRIVATE . (object_declaration . 0)) (END .
(object_declaration . 0)) (BEGIN . (object_declaration . 0)) (ENTRY .
(object_declaration . 0)) (FOR . (object_declaration . 0)) (FUNCTION .
(object_declaration . 0)) (GENERIC . (object_declaration . 0)) (NOT .
(object_declaration . 0)) (OVERRIDING . (object_declaration . 0)) (PACKAGE .
(object_declaration . 0)) (PRAGMA . (object_declaration . 0)) (PROCEDURE .
(object_declaration . 0)) (PROTECTED . (object_declaration . [...]
+ ((default . error) (PRIVATE . (entry_declaration . 0)) (END .
(entry_declaration . 0)) (BEGIN . (entry_declaration . 0)) (ENTRY .
(entry_declaration . 0)) (FOR . (entry_declaration . 0)) (FUNCTION .
(entry_declaration . 0)) (GENERIC . (entry_declaration . 0)) (NOT .
(entry_declaration . 0)) (OVERRIDING . (entry_declaration . 0)) (PACKAGE .
(entry_declaration . 0)) (PRAGMA . (entry_declaration . 0)) (PROCEDURE .
(entry_declaration . 0)) (PROTECTED . (entry_declaration . 0)) (SUBTYPE [...]
+ ((default . error) (PRIVATE . (protected_body . 0)) (END .
(protected_body . 0)) (BEGIN . (protected_body . 0)) (ENTRY . (protected_body .
0)) (FOR . (protected_body . 0)) (FUNCTION . (protected_body . 0)) (GENERIC .
(protected_body . 0)) (NOT . (protected_body . 0)) (OVERRIDING .
(protected_body . 0)) (PACKAGE . (protected_body . 0)) (PRAGMA .
(protected_body . 0)) (PROCEDURE . (protected_body . 0)) (PROTECTED .
(protected_body . 0)) (SUBTYPE . (protected_body . 0)) (TASK . (prote [...]
+ ((default . error) (IS . (expression_opt . 0)) (RAISE . 152) (PLUS .
154) (MINUS . 153) (ABS . 144) (NOT . 150) (NUMERIC_LITERAL . 155) (NULL .
151) (NEW . 149) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL
. 49) (LEFT_PAREN . 148))
+ ((default . error) (IDENTIFIER . 1294))
+ ((default . error) (SEMICOLON . (identifier_opt . 0)) (IDENTIFIER .
716))
+ ((default . error) (SEMICOLON . (identifier_opt . 0)) (IDENTIFIER .
716))
+ ((default . error) (OR . (case_statement . 0)) (THEN . (case_statement .
0)) (WHEN . (case_statement . 0)) (EXCEPTION . (case_statement . 0)) (END .
(case_statement . 0)) (ACCEPT . (case_statement . 0)) (ABORT . (case_statement
. 0)) (BEGIN . (case_statement . 0)) (CASE . (case_statement . 0)) (DECLARE .
(case_statement . 0)) (DELAY . (case_statement . 0)) (EXIT . (case_statement .
0)) (FOR . (case_statement . 0)) (GOTO . (case_statement . 0)) (IF .
(case_statement . 0)) (LOOP . (c [...]
((default . error) (END . (case_statement_alternative . 0)) (WHEN .
(case_statement_alternative . 0)))
- ((default . error) (OR . (block_statement . 0)) (THEN . (block_statement
. 0)) (WHEN . (block_statement . 0)) (EXCEPTION . (block_statement . 0)) (END .
(block_statement . 0)) (LESS_LESS . (block_statement . 0)) (IDENTIFIER .
(block_statement . 0)) (STRING_LITERAL . (block_statement . 0))
(CHARACTER_LITERAL . (block_statement . 0)) (ACCEPT . (block_statement . 0))
(ABORT . (block_statement . 0)) (BEGIN . (block_statement . 0)) (CASE .
(block_statement . 0)) (DECLARE . (block_statem [...]
- ((default . error) (IF . 1289))
- ((default . error) (ELSE . (sequence_of_statements_opt . 0)) (ELSIF .
(sequence_of_statements_opt . 0)) (END . (sequence_of_statements_opt . 0))
(ACCEPT . (label_opt . 0)) (BEGIN . (label_opt . 0)) (CASE . (label_opt . 0))
(DECLARE . (label_opt . 0)) (FOR . (label_opt . 0)) (IF . (label_opt . 0))
(LOOP . (label_opt . 0)) (RETURN . (label_opt . 0)) (SELECT . (label_opt . 0))
(WHILE . (label_opt . 0)) (STRING_LITERAL . (label_opt . 0)) (CHARACTER_LITERAL
. (label_opt . 0)) (ABORT . ( [...]
- ((default . error) (OR . (if_statement . 3)) (THEN . (if_statement . 3))
(WHEN . (if_statement . 3)) (EXCEPTION . (if_statement . 3)) (END .
(if_statement . 3)) (LESS_LESS . (if_statement . 3)) (IDENTIFIER .
(if_statement . 3)) (STRING_LITERAL . (if_statement . 3)) (CHARACTER_LITERAL .
(if_statement . 3)) (ACCEPT . (if_statement . 3)) (ABORT . (if_statement . 3))
(BEGIN . (if_statement . 3)) (CASE . (if_statement . 3)) (DECLARE .
(if_statement . 3)) (DELAY . (if_statement . 3)) (EX [...]
- ((default . error) (SEMICOLON . 1287))
- ((default . error) (END . 1286))
- ((default . error) (OR . (extended_return_statement . 0)) (THEN .
(extended_return_statement . 0)) (WHEN . (extended_return_statement . 0))
(EXCEPTION . (extended_return_statement . 0)) (END . (extended_return_statement
. 0)) (LESS_LESS . (extended_return_statement . 0)) (IDENTIFIER .
(extended_return_statement . 0)) (STRING_LITERAL . (extended_return_statement .
0)) (CHARACTER_LITERAL . (extended_return_statement . 0)) (ACCEPT .
(extended_return_statement . 0)) (ABORT . (extended_ [...]
- ((default . error) (RAISE . 152) (PLUS . 144) (MINUS . 143) (ABS .
147) (NOT . 150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
- ((default . error) (SEMICOLON . 1284))
- ((default . error) (OR . (selective_accept . 0)) (THEN .
(selective_accept . 0)) (WHEN . (selective_accept . 0)) (EXCEPTION .
(selective_accept . 0)) (END . (selective_accept . 0)) (LESS_LESS .
(selective_accept . 0)) (IDENTIFIER . (selective_accept . 0)) (STRING_LITERAL .
(selective_accept . 0)) (CHARACTER_LITERAL . (selective_accept . 0)) (ACCEPT .
(selective_accept . 0)) (ABORT . (selective_accept . 0)) (BEGIN .
(selective_accept . 0)) (CASE . (selective_accept . 0)) (DECLARE . [...]
- ((default . error) (OR . (conditional_entry_call . 0)) (THEN .
(conditional_entry_call . 0)) (WHEN . (conditional_entry_call . 0)) (EXCEPTION
. (conditional_entry_call . 0)) (END . (conditional_entry_call . 0)) (LESS_LESS
. (conditional_entry_call . 0)) (IDENTIFIER . (conditional_entry_call . 0))
(STRING_LITERAL . (conditional_entry_call . 0)) (CHARACTER_LITERAL .
(conditional_entry_call . 0)) (ACCEPT . (conditional_entry_call . 0)) (ABORT .
(conditional_entry_call . 0)) (BEGIN . ( [...]
- ((default . error) (OR . (timed_entry_call . 0)) (THEN .
(timed_entry_call . 0)) (WHEN . (timed_entry_call . 0)) (EXCEPTION .
(timed_entry_call . 0)) (END . (timed_entry_call . 0)) (LESS_LESS .
(timed_entry_call . 0)) (IDENTIFIER . (timed_entry_call . 0)) (STRING_LITERAL .
(timed_entry_call . 0)) (CHARACTER_LITERAL . (timed_entry_call . 0)) (ACCEPT .
(timed_entry_call . 0)) (ABORT . (timed_entry_call . 0)) (BEGIN .
(timed_entry_call . 0)) (CASE . (timed_entry_call . 0)) (DECLARE . [...]
- ((default . error) (OR . (loop_statement . 0)) (THEN . (loop_statement .
0)) (WHEN . (loop_statement . 0)) (EXCEPTION . (loop_statement . 0)) (END .
(loop_statement . 0)) (LESS_LESS . (loop_statement . 0)) (IDENTIFIER .
(loop_statement . 0)) (STRING_LITERAL . (loop_statement . 0))
(CHARACTER_LITERAL . (loop_statement . 0)) (ACCEPT . (loop_statement . 0))
(ABORT . (loop_statement . 0)) (BEGIN . (loop_statement . 0)) (CASE .
(loop_statement . 0)) (DECLARE . (loop_statement . 0)) (DEL [...]
- ((default . error) (WHEN . (sequence_of_statements_opt . 0)) (END .
(sequence_of_statements_opt . 0)) (ACCEPT . (label_opt . 0)) (BEGIN .
(label_opt . 0)) (CASE . (label_opt . 0)) (DECLARE . (label_opt . 0)) (FOR .
(label_opt . 0)) (IF . (label_opt . 0)) (LOOP . (label_opt . 0)) (RETURN .
(label_opt . 0)) (SELECT . (label_opt . 0)) (WHILE . (label_opt . 0))
(STRING_LITERAL . (label_opt . 0)) (CHARACTER_LITERAL . (label_opt . 0)) (ABORT
. (label_opt . 0)) (DELAY . (label_opt . 0)) ( [...]
+ ((default . error) (OR . (block_statement . 0)) (THEN . (block_statement
. 0)) (WHEN . (block_statement . 0)) (EXCEPTION . (block_statement . 0)) (END .
(block_statement . 0)) (ACCEPT . (block_statement . 0)) (ABORT .
(block_statement . 0)) (BEGIN . (block_statement . 0)) (CASE . (block_statement
. 0)) (DECLARE . (block_statement . 0)) (DELAY . (block_statement . 0)) (EXIT .
(block_statement . 0)) (FOR . (block_statement . 0)) (GOTO . (block_statement .
0)) (IF . (block_statement . [...]
+ ((default . error) (IF . 1291))
+ ((default . error) (ELSE . (sequence_of_statements_opt . 0)) (ELSIF .
(sequence_of_statements_opt . 0)) (END . (sequence_of_statements_opt . 0))
(ACCEPT . (label_opt . 0)) (BEGIN . (label_opt . 0)) (CASE . (label_opt . 0))
(DECLARE . (label_opt . 0)) (FOR . (label_opt . 0)) (IF . (label_opt . 0))
(LOOP . (label_opt . 0)) (RETURN . (label_opt . 0)) (SELECT . (label_opt . 0))
(WHILE . (label_opt . 0)) (ABORT . (label_opt . 0)) (DELAY . (label_opt . 0))
(EXIT . (label_opt . 0)) (GOTO [...]
+ ((default . error) (OR . (if_statement . 3)) (THEN . (if_statement . 3))
(WHEN . (if_statement . 3)) (EXCEPTION . (if_statement . 3)) (END .
(if_statement . 3)) (ACCEPT . (if_statement . 3)) (ABORT . (if_statement . 3))
(BEGIN . (if_statement . 3)) (CASE . (if_statement . 3)) (DECLARE .
(if_statement . 3)) (DELAY . (if_statement . 3)) (EXIT . (if_statement . 3))
(FOR . (if_statement . 3)) (GOTO . (if_statement . 3)) (IF . (if_statement .
3)) (LOOP . (if_statement . 3)) (NULL . (if_ [...]
+ ((default . error) (SEMICOLON . 1289))
+ ((default . error) (END . 1288))
+ ((default . error) (OR . (extended_return_statement . 0)) (THEN .
(extended_return_statement . 0)) (WHEN . (extended_return_statement . 0))
(EXCEPTION . (extended_return_statement . 0)) (END . (extended_return_statement
. 0)) (ACCEPT . (extended_return_statement . 0)) (ABORT .
(extended_return_statement . 0)) (BEGIN . (extended_return_statement . 0))
(CASE . (extended_return_statement . 0)) (DECLARE . (extended_return_statement
. 0)) (DELAY . (extended_return_statement . 0)) (EXIT [...]
+ ((default . error) (RAISE . 152) (PLUS . 154) (MINUS . 153) (ABS .
144) (NOT . 150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
+ ((default . error) (SEMICOLON . 1286))
+ ((default . error) (OR . (selective_accept . 0)) (THEN .
(selective_accept . 0)) (WHEN . (selective_accept . 0)) (EXCEPTION .
(selective_accept . 0)) (END . (selective_accept . 0)) (ACCEPT .
(selective_accept . 0)) (ABORT . (selective_accept . 0)) (BEGIN .
(selective_accept . 0)) (CASE . (selective_accept . 0)) (DECLARE .
(selective_accept . 0)) (DELAY . (selective_accept . 0)) (EXIT .
(selective_accept . 0)) (FOR . (selective_accept . 0)) (GOTO .
(selective_accept . 0)) (IF . (sel [...]
+ ((default . error) (OR . (conditional_entry_call . 0)) (THEN .
(conditional_entry_call . 0)) (WHEN . (conditional_entry_call . 0)) (EXCEPTION
. (conditional_entry_call . 0)) (END . (conditional_entry_call . 0)) (ACCEPT .
(conditional_entry_call . 0)) (ABORT . (conditional_entry_call . 0)) (BEGIN .
(conditional_entry_call . 0)) (CASE . (conditional_entry_call . 0)) (DECLARE .
(conditional_entry_call . 0)) (DELAY . (conditional_entry_call . 0)) (EXIT .
(conditional_entry_call . 0)) ( [...]
+ ((default . error) (OR . (timed_entry_call . 0)) (THEN .
(timed_entry_call . 0)) (WHEN . (timed_entry_call . 0)) (EXCEPTION .
(timed_entry_call . 0)) (END . (timed_entry_call . 0)) (ACCEPT .
(timed_entry_call . 0)) (ABORT . (timed_entry_call . 0)) (BEGIN .
(timed_entry_call . 0)) (CASE . (timed_entry_call . 0)) (DECLARE .
(timed_entry_call . 0)) (DELAY . (timed_entry_call . 0)) (EXIT .
(timed_entry_call . 0)) (FOR . (timed_entry_call . 0)) (GOTO .
(timed_entry_call . 0)) (IF . (tim [...]
+ ((default . error) (OR . (loop_statement . 0)) (THEN . (loop_statement .
0)) (WHEN . (loop_statement . 0)) (EXCEPTION . (loop_statement . 0)) (END .
(loop_statement . 0)) (ACCEPT . (loop_statement . 0)) (ABORT . (loop_statement
. 0)) (BEGIN . (loop_statement . 0)) (CASE . (loop_statement . 0)) (DECLARE .
(loop_statement . 0)) (DELAY . (loop_statement . 0)) (EXIT . (loop_statement .
0)) (FOR . (loop_statement . 0)) (GOTO . (loop_statement . 0)) (IF .
(loop_statement . 0)) (LOOP . (l [...]
+ ((default . error) (WHEN . (sequence_of_statements_opt . 0)) (END .
(sequence_of_statements_opt . 0)) (ACCEPT . (label_opt . 0)) (BEGIN .
(label_opt . 0)) (CASE . (label_opt . 0)) (DECLARE . (label_opt . 0)) (FOR .
(label_opt . 0)) (IF . (label_opt . 0)) (LOOP . (label_opt . 0)) (RETURN .
(label_opt . 0)) (SELECT . (label_opt . 0)) (WHILE . (label_opt . 0)) (ABORT .
(label_opt . 0)) (DELAY . (label_opt . 0)) (EXIT . (label_opt . 0)) (GOTO .
(label_opt . 0)) (NULL . (label_opt . 0)) [...]
((default . error) (WHEN . (exception_handler . 0)) (END .
(exception_handler . 0)))
- ((default . error) (WHEN . (asynchronous_select . 0)) (THEN .
(asynchronous_select . 0)) (OR . (asynchronous_select . 0)) (ELSIF .
(asynchronous_select . 0)) (ELSE . (asynchronous_select . 0)) (WHILE .
(asynchronous_select . 0)) (SELECT . (asynchronous_select . 0)) (RETURN .
(asynchronous_select . 0)) (REQUEUE . (asynchronous_select . 0)) (RAISE .
(asynchronous_select . 0)) (PRAGMA . (asynchronous_select . 0)) (NULL .
(asynchronous_select . 0)) (LOOP . (asynchronous_select . 0)) (I [...]
+ ((default . error) (WHEN . (asynchronous_select . 0)) (THEN .
(asynchronous_select . 0)) (OR . (asynchronous_select . 0)) (ELSIF .
(asynchronous_select . 0)) (ELSE . (asynchronous_select . 0))
(CHARACTER_LITERAL . (asynchronous_select . 0)) (STRING_LITERAL .
(asynchronous_select . 0)) (IDENTIFIER . (asynchronous_select . 0)) (LESS_LESS
. (asynchronous_select . 0)) (WHILE . (asynchronous_select . 0)) (SELECT .
(asynchronous_select . 0)) (RETURN . (asynchronous_select . 0)) (REQUEUE [...]
((default . error) (DO . (extended_return_object_declaration . 0))
(SEMICOLON . (extended_return_object_declaration . 0)))
- ((default . error) (IF . 1317))
- ((default . error) (WHEN . (if_statement . 1)) (THEN . (if_statement .
1)) (OR . (if_statement . 1)) (ELSIF . (if_statement . 1)) (ELSE .
(if_statement . 1)) (WHILE . (if_statement . 1)) (SELECT . (if_statement . 1))
(RETURN . (if_statement . 1)) (REQUEUE . (if_statement . 1)) (RAISE .
(if_statement . 1)) (PRAGMA . (if_statement . 1)) (NULL . (if_statement . 1))
(LOOP . (if_statement . 1)) (IF . (if_statement . 1)) (GOTO . (if_statement .
1)) (FOR . (if_statement . 1)) (EXIT . (if_ [...]
+ ((default . error) (IF . 1319))
+ ((default . error) (WHEN . (if_statement . 1)) (THEN . (if_statement .
1)) (OR . (if_statement . 1)) (ELSIF . (if_statement . 1)) (ELSE .
(if_statement . 1)) (CHARACTER_LITERAL . (if_statement . 1)) (STRING_LITERAL .
(if_statement . 1)) (IDENTIFIER . (if_statement . 1)) (LESS_LESS .
(if_statement . 1)) (WHILE . (if_statement . 1)) (SELECT . (if_statement . 1))
(RETURN . (if_statement . 1)) (REQUEUE . (if_statement . 1)) (RAISE .
(if_statement . 1)) (PRAGMA . (if_statement . 1)) (NU [...]
((default . error) (ELSE . (elsif_statement_item . 0)) (ELSIF .
(elsif_statement_item . 0)) (END . (elsif_statement_item . 0)))
+ ((default . error) (SEMICOLON . 1318))
+ ((default . error) (SEMICOLON . 1317))
((default . error) (SEMICOLON . 1316))
- ((default . error) (SEMICOLON . 1315))
- ((default . error) (SEMICOLON . 1314))
- ((default . error) (IN . 1313))
- ((default . error) (IS . 1312))
+ ((default . error) (IN . 1315))
+ ((default . error) (IS . 1314))
((default . error) (WITH . (derived_type_definition . 0)) (SEMICOLON .
(derived_type_definition . 0)))
- ((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
108))
- ((default . error) (CASE . 1310))
+ ((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
109))
+ ((default . error) (CASE . 1312))
((default . error) (WHEN . (variant_list . 1)) (END . (variant_list .
1)))
- ((default . error) (BAR . 282) (EQUAL_GREATER . 1309))
- ((default . error) (WHEN . (component_declaration . 1)) (END .
(component_declaration . 1)) (CASE . (component_declaration . 1)) (IDENTIFIER .
(component_declaration . 1)) (FOR . (component_declaration . 1)))
- ((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
108))
+ ((default . error) (BAR . 286) (EQUAL_GREATER . 1311))
+ ((default . error) (WHEN . (component_declaration . 1)) (END .
(component_declaration . 1)) (CASE . (component_declaration . 1)) (FOR .
(component_declaration . 1)) (IDENTIFIER . (component_declaration . 1)))
+ ((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
109))
((default . error) (SEMICOLON . (real_range_specification_opt . 1))
(WITH . (real_range_specification_opt . 1)))
- ((default . error) (SEMICOLON . 1307))
- ((default . error) (SEMICOLON . 1306))
- ((default . error) (DOT_DOT . 1305))
- ((default . error) (PLUS . 144) (MINUS . 143) (ABS . 147) (NOT .
150) (NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN . 148))
- ((default . error) (PRIVATE . (protected_type_declaration . 0)) (END .
(protected_type_declaration . 0)) (BEGIN . (protected_type_declaration . 0))
(IDENTIFIER . (protected_type_declaration . 0)) (ENTRY .
(protected_type_declaration . 0)) (FOR . (protected_type_declaration . 0))
(FUNCTION . (protected_type_declaration . 0)) (GENERIC .
(protected_type_declaration . 0)) (NOT . (protected_type_declaration . 0))
(OVERRIDING . (protected_type_declaration . 0)) (PACKAGE . (protected_type [...]
- ((default . error) (PRIVATE . (task_type_declaration . 0)) (END .
(task_type_declaration . 0)) (BEGIN . (task_type_declaration . 0)) (IDENTIFIER
. (task_type_declaration . 0)) (ENTRY . (task_type_declaration . 0)) (FOR .
(task_type_declaration . 0)) (FUNCTION . (task_type_declaration . 0)) (GENERIC
. (task_type_declaration . 0)) (NOT . (task_type_declaration . 0)) (OVERRIDING
. (task_type_declaration . 0)) (PACKAGE . (task_type_declaration . 0)) (PRAGMA
. (task_type_declaration . 0 [...]
+ ((default . error) (SEMICOLON . 1309))
+ ((default . error) (SEMICOLON . 1308))
+ ((default . error) (DOT_DOT . 1307))
+ ((default . error) (PLUS . 154) (MINUS . 153) (ABS . 144) (NOT .
150) (NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN . 148))
+ ((default . error) (PRIVATE . (protected_type_declaration . 0)) (END .
(protected_type_declaration . 0)) (BEGIN . (protected_type_declaration . 0))
(ENTRY . (protected_type_declaration . 0)) (FOR . (protected_type_declaration .
0)) (FUNCTION . (protected_type_declaration . 0)) (GENERIC .
(protected_type_declaration . 0)) (NOT . (protected_type_declaration . 0))
(OVERRIDING . (protected_type_declaration . 0)) (PACKAGE .
(protected_type_declaration . 0)) (PRAGMA . (protected_type_dec [...]
+ ((default . error) (PRIVATE . (task_type_declaration . 0)) (END .
(task_type_declaration . 0)) (BEGIN . (task_type_declaration . 0)) (ENTRY .
(task_type_declaration . 0)) (FOR . (task_type_declaration . 0)) (FUNCTION .
(task_type_declaration . 0)) (GENERIC . (task_type_declaration . 0)) (NOT .
(task_type_declaration . 0)) (OVERRIDING . (task_type_declaration . 0))
(PACKAGE . (task_type_declaration . 0)) (PRAGMA . (task_type_declaration . 0))
(PROCEDURE . (task_type_declaration . 0) [...]
+ ((default . error) (SEMICOLON . 1326))
+ ((default . error) (END . (component_list_opt . 0)) (WHEN .
(component_list_opt . 0)) (NULL . 1031) (CASE . 1030) (IDENTIFIER . 77) (FOR
. 299))
((default . error) (SEMICOLON . 1324))
- ((default . error) (END . (component_list_opt . 0)) (WHEN .
(component_list_opt . 0)) (NULL . 1013) (CASE . 1012) (IDENTIFIER . 72) (FOR
. 296))
- ((default . error) (SEMICOLON . 1322))
- ((default . error) (SEMICOLON . 1321))
- ((default . error) (BEGIN . (declarative_part_opt . 0)) (USE . 11)
(SUBTYPE . 299) (PRAGMA . 7) (NOT . 4) (OVERRIDING . 5) (FUNCTION .
(overriding_indicator_opt . 2)) (PROCEDURE . (overriding_indicator_opt . 2))
(ENTRY . (overriding_indicator_opt . 2)) (FOR . 296) (IDENTIFIER . 295) (TYPE
. 301) (GENERIC . 2) (PROTECTED . 298) (TASK . 300) (PACKAGE . 297))
- ((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49) (PLUS . 144) (MINUS . 143) (ABS . 147) (NOT . 763)
(NUMERIC_LITERAL . 145) (NULL . 151) (NEW . 149) (LEFT_PAREN . 148))
- ((default . error) (PRIVATE . (task_body . 0)) (END . (task_body . 0))
(BEGIN . (task_body . 0)) (IDENTIFIER . (task_body . 0)) (ENTRY . (task_body .
0)) (FOR . (task_body . 0)) (FUNCTION . (task_body . 0)) (GENERIC . (task_body
. 0)) (NOT . (task_body . 0)) (OVERRIDING . (task_body . 0)) (PACKAGE .
(task_body . 0)) (PRAGMA . (task_body . 0)) (PROCEDURE . (task_body . 0))
(PROTECTED . (task_body . 0)) (SUBTYPE . (task_body . 0)) (TASK . (task_body .
0)) (TYPE . (task_body . 0)) (US [...]
- ((default . error) (THEN . (accept_statement . 0)) (WHEN .
(accept_statement . 0)) (EXCEPTION . (accept_statement . 0)) (ELSIF .
(accept_statement . 0)) (ELSE . (accept_statement . 0)) (OR . (accept_statement
. 0)) (END . (accept_statement . 0)) (LESS_LESS . (accept_statement . 0))
(IDENTIFIER . (accept_statement . 0)) (STRING_LITERAL . (accept_statement . 0))
(CHARACTER_LITERAL . (accept_statement . 0)) (ACCEPT . (accept_statement . 0))
(ABORT . (accept_statement . 0)) (BEGIN . (a [...]
- ((default . error) (OR . (if_statement . 2)) (THEN . (if_statement . 2))
(WHEN . (if_statement . 2)) (EXCEPTION . (if_statement . 2)) (END .
(if_statement . 2)) (LESS_LESS . (if_statement . 2)) (IDENTIFIER .
(if_statement . 2)) (STRING_LITERAL . (if_statement . 2)) (CHARACTER_LITERAL .
(if_statement . 2)) (ACCEPT . (if_statement . 2)) (ABORT . (if_statement . 2))
(BEGIN . (if_statement . 2)) (CASE . (if_statement . 2)) (DECLARE .
(if_statement . 2)) (DELAY . (if_statement . 2)) (EX [...]
- ((default . error) (SEMICOLON . 1318))
- ((default . error) (WHEN . (if_statement . 0)) (THEN . (if_statement .
0)) (OR . (if_statement . 0)) (ELSIF . (if_statement . 0)) (ELSE .
(if_statement . 0)) (WHILE . (if_statement . 0)) (SELECT . (if_statement . 0))
(RETURN . (if_statement . 0)) (REQUEUE . (if_statement . 0)) (RAISE .
(if_statement . 0)) (PRAGMA . (if_statement . 0)) (NULL . (if_statement . 0))
(LOOP . (if_statement . 0)) (IF . (if_statement . 0)) (GOTO . (if_statement .
0)) (FOR . (if_statement . 0)) (EXIT . (if_ [...]
- ((default . error) (RIGHT_PAREN . 1328))
- ((default . error) (BEGIN . 1327))
- ((default . error) (BEGIN . (private_extension_declaration . 0))
(IDENTIFIER . (private_extension_declaration . 0)) (ENTRY .
(private_extension_declaration . 0)) (FOR . (private_extension_declaration .
0)) (FUNCTION . (private_extension_declaration . 0)) (GENERIC .
(private_extension_declaration . 0)) (NOT . (private_extension_declaration .
0)) (OVERRIDING . (private_extension_declaration . 0)) (PACKAGE .
(private_extension_declaration . 0)) (PRAGMA . (private_extension_declaration
[...]
- ((default . error) (WHEN . (variant_part . 0)) (END . (variant_part .
0)) (CASE . (variant_part . 0)) (IDENTIFIER . (variant_part . 0)) (FOR .
(variant_part . 0)))
+ ((default . error) (SEMICOLON . 1323))
+ ((default . error) (BEGIN . (declarative_part_opt . 0)) (USE . 11)
(SUBTYPE . 302) (PRAGMA . 7) (NOT . 4) (OVERRIDING . 5) (FUNCTION .
(overriding_indicator_opt . 2)) (PROCEDURE . (overriding_indicator_opt . 2))
(ENTRY . (overriding_indicator_opt . 2)) (FOR . 299) (IDENTIFIER . 305) (TYPE
. 304) (GENERIC . 2) (PROTECTED . 301) (TASK . 303) (PACKAGE . 300))
+ ((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49) (PLUS . 154) (MINUS . 153) (ABS . 144) (NOT . 734)
(NUMERIC_LITERAL . 155) (NULL . 151) (NEW . 149) (LEFT_PAREN . 148))
+ ((default . error) (PRIVATE . (task_body . 0)) (END . (task_body . 0))
(BEGIN . (task_body . 0)) (ENTRY . (task_body . 0)) (FOR . (task_body . 0))
(FUNCTION . (task_body . 0)) (GENERIC . (task_body . 0)) (NOT . (task_body .
0)) (OVERRIDING . (task_body . 0)) (PACKAGE . (task_body . 0)) (PRAGMA .
(task_body . 0)) (PROCEDURE . (task_body . 0)) (PROTECTED . (task_body . 0))
(SUBTYPE . (task_body . 0)) (TASK . (task_body . 0)) (TYPE . (task_body . 0))
(USE . (task_body . 0)) (IDENTIFIE [...]
+ ((default . error) (THEN . (accept_statement . 0)) (WHEN .
(accept_statement . 0)) (EXCEPTION . (accept_statement . 0)) (ELSIF .
(accept_statement . 0)) (ELSE . (accept_statement . 0)) (OR . (accept_statement
. 0)) (END . (accept_statement . 0)) (ACCEPT . (accept_statement . 0)) (ABORT .
(accept_statement . 0)) (BEGIN . (accept_statement . 0)) (CASE .
(accept_statement . 0)) (DECLARE . (accept_statement . 0)) (DELAY .
(accept_statement . 0)) (EXIT . (accept_statement . 0)) (FOR . ( [...]
+ ((default . error) (OR . (if_statement . 2)) (THEN . (if_statement . 2))
(WHEN . (if_statement . 2)) (EXCEPTION . (if_statement . 2)) (END .
(if_statement . 2)) (ACCEPT . (if_statement . 2)) (ABORT . (if_statement . 2))
(BEGIN . (if_statement . 2)) (CASE . (if_statement . 2)) (DECLARE .
(if_statement . 2)) (DELAY . (if_statement . 2)) (EXIT . (if_statement . 2))
(FOR . (if_statement . 2)) (GOTO . (if_statement . 2)) (IF . (if_statement .
2)) (LOOP . (if_statement . 2)) (NULL . (if_ [...]
+ ((default . error) (SEMICOLON . 1320))
+ ((default . error) (WHEN . (if_statement . 0)) (THEN . (if_statement .
0)) (OR . (if_statement . 0)) (ELSIF . (if_statement . 0)) (ELSE .
(if_statement . 0)) (CHARACTER_LITERAL . (if_statement . 0)) (STRING_LITERAL .
(if_statement . 0)) (IDENTIFIER . (if_statement . 0)) (LESS_LESS .
(if_statement . 0)) (WHILE . (if_statement . 0)) (SELECT . (if_statement . 0))
(RETURN . (if_statement . 0)) (REQUEUE . (if_statement . 0)) (RAISE .
(if_statement . 0)) (PRAGMA . (if_statement . 0)) (NU [...]
+ ((default . error) (RIGHT_PAREN . 1330))
+ ((default . error) (BEGIN . 1329))
+ ((default . error) (BEGIN . (private_extension_declaration . 0)) (ENTRY
. (private_extension_declaration . 0)) (FOR . (private_extension_declaration .
0)) (FUNCTION . (private_extension_declaration . 0)) (GENERIC .
(private_extension_declaration . 0)) (NOT . (private_extension_declaration .
0)) (OVERRIDING . (private_extension_declaration . 0)) (PACKAGE .
(private_extension_declaration . 0)) (PRAGMA . (private_extension_declaration .
0)) (PROCEDURE . (private_extension_declaration [...]
+ ((default . error) (WHEN . (variant_part . 0)) (END . (variant_part .
0)) (CASE . (variant_part . 0)) (FOR . (variant_part . 0)) (IDENTIFIER .
(variant_part . 0)))
((default . error) (END . (variant . 0)) (WHEN . (variant . 0)))
- ((default . error) (WHEN . (component_declaration . 0)) (END .
(component_declaration . 0)) (CASE . (component_declaration . 0)) (IDENTIFIER .
(component_declaration . 0)) (FOR . (component_declaration . 0)))
- ((default . error) (SEMICOLON . 1326))
+ ((default . error) (WHEN . (component_declaration . 0)) (END .
(component_declaration . 0)) (CASE . (component_declaration . 0)) (FOR .
(component_declaration . 0)) (IDENTIFIER . (component_declaration . 0)))
+ ((default . error) (SEMICOLON . 1328))
((default . error) (END . (component_clause . 0)) (IDENTIFIER .
(component_clause . 0)))
- ((default . error) (END . (sequence_of_statements_opt . 0)) (EXCEPTION .
(sequence_of_statements_opt . 0)) (ACCEPT . (label_opt . 0)) (BEGIN .
(label_opt . 0)) (CASE . (label_opt . 0)) (DECLARE . (label_opt . 0)) (FOR .
(label_opt . 0)) (IF . (label_opt . 0)) (LOOP . (label_opt . 0)) (RETURN .
(label_opt . 0)) (SELECT . (label_opt . 0)) (WHILE . (label_opt . 0))
(STRING_LITERAL . (label_opt . 0)) (CHARACTER_LITERAL . (label_opt . 0)) (ABORT
. (label_opt . 0)) (DELAY . (label_opt . [...]
- ((default . error) (WHEN . (parameter_profile_opt . 0)) (LEFT_PAREN .
787))
+ ((default . error) (END . (sequence_of_statements_opt . 0)) (EXCEPTION .
(sequence_of_statements_opt . 0)) (ACCEPT . (label_opt . 0)) (BEGIN .
(label_opt . 0)) (CASE . (label_opt . 0)) (DECLARE . (label_opt . 0)) (FOR .
(label_opt . 0)) (IF . (label_opt . 0)) (LOOP . (label_opt . 0)) (RETURN .
(label_opt . 0)) (SELECT . (label_opt . 0)) (WHILE . (label_opt . 0)) (ABORT .
(label_opt . 0)) (DELAY . (label_opt . 0)) (EXIT . (label_opt . 0)) (GOTO .
(label_opt . 0)) (NULL . (label_opt [...]
+ ((default . error) (WHEN . (parameter_profile_opt . 0)) (LEFT_PAREN .
808))
((default . error) (WHEN . (entry_body_formal_part . 0)))
- ((default . error) (END . 1331))
- ((default . error) (SEMICOLON . (identifier_opt . 0)) (IDENTIFIER .
703))
- ((default . error) (SEMICOLON . 1333))
+ ((default . error) (END . 1333))
+ ((default . error) (SEMICOLON . (identifier_opt . 0)) (IDENTIFIER .
716))
+ ((default . error) (SEMICOLON . 1335))
((default . error) (PROCEDURE . (entry_body . 0)) (OVERRIDING .
(entry_body . 0)) (NOT . (entry_body . 0)) (FUNCTION . (entry_body . 0)) (FOR .
(entry_body . 0)) (ENTRY . (entry_body . 0)) (END . (entry_body . 0)))]
[((compilation_unit . 13)(compilation_unit_list . 14)(context_item .
15)(function_specification . 16)(generic_declaration . 17)(generic_formal_part
. 18)(generic_instantiation . 19)(generic_package_declaration .
20)(generic_renaming_declaration . 21)(generic_subprogram_declaration .
22)(library_item . 23)(library_unit_declaration .
24)(library_unit_renaming_declaration . 25)(overriding_indicator_opt .
26)(package_body . 27)(package_declaration . 28)(package_renaming_declaration .
29 [...]
- ((attribute_reference . 51)(name . 86)(qualified_expression .
54)(selected_component . 55))
- ((formal_object_declaration . 78)(formal_subprogram_declaration .
79)(formal_type_declaration . 80)(formal_package_declaration .
81)(generic_formal_parameter_declarations .
82)(generic_formal_parameter_declaration . 83)(identifier_list . 84)(pragma .
85))
+ ((attribute_reference . 51)(name . 87)(qualified_expression .
54)(selected_component . 55))
+ ((formal_object_declaration . 78)(formal_subprogram_declaration .
79)(formal_type_declaration . 80)(formal_package_declaration .
81)(generic_formal_parameter_declarations .
82)(generic_formal_parameter_declaration . 83)(identifier_list . 84)(pragma .
85)(use_clause . 86))
nil
nil
nil
@@ -3169,126 +3190,130 @@
nil
nil
nil
+ ((attribute_reference . 51)(name . 131)(qualified_expression .
54)(selected_component . 55))
((attribute_reference . 51)(name . 130)(qualified_expression .
54)(selected_component . 55))
- ((attribute_reference . 51)(name . 129)(qualified_expression .
54)(selected_component . 55))
- ((aspect_specification_opt . 128))
- ((attribute_reference . 51)(name . 126)(qualified_expression .
54)(selected_component . 55))
- nil
- ((aspect_specification_opt . 124))
+ ((aspect_specification_opt . 129))
+ ((attribute_reference . 51)(name . 127)(qualified_expression .
54)(selected_component . 55))
nil
+ ((aspect_specification_opt . 125))
nil
nil
nil
nil
nil
nil
- ((actual_parameter_part . 91))
nil
+ ((actual_parameter_part . 92))
nil
nil
- ((attribute_reference . 51)(name_list . 121)(name .
53)(qualified_expression . 54)(selected_component . 55))
nil
- ((attribute_reference . 51)(name . 118)(qualified_expression .
54)(selected_component . 55))
- ((actual_parameter_part . 91)(formal_part . 116)(parameter_profile_opt .
117))
- ((formal_object_declaration . 78)(formal_subprogram_declaration .
79)(formal_type_declaration . 80)(formal_package_declaration .
81)(generic_formal_parameter_declarations .
82)(generic_formal_parameter_declaration . 83)(identifier_list . 84)(pragma .
85))
- ((attribute_reference . 51)(name . 115)(qualified_expression .
54)(selected_component . 55))
- ((attribute_reference . 51)(name_list . 114)(name .
53)(qualified_expression . 54)(selected_component . 55))
+ ((attribute_reference . 51)(name_list . 122)(name .
53)(qualified_expression . 54)(selected_component . 55))
nil
- ((function_specification . 16)(procedure_specification .
32)(subprogram_specification . 113))
+ ((attribute_reference . 51)(name . 119)(qualified_expression .
54)(selected_component . 55))
+ ((actual_parameter_part . 92)(formal_part . 117)(parameter_profile_opt .
118))
+ ((formal_object_declaration . 78)(formal_subprogram_declaration .
79)(formal_type_declaration . 80)(formal_package_declaration .
81)(generic_formal_parameter_declarations .
82)(generic_formal_parameter_declaration . 83)(identifier_list . 84)(pragma .
85)(use_clause . 86))
+ ((attribute_reference . 51)(name . 116)(qualified_expression .
54)(selected_component . 55))
+ ((attribute_reference . 51)(name_list . 115)(name .
53)(qualified_expression . 54)(selected_component . 55))
nil
- ((attribute_reference . 51)(name . 110)(qualified_expression .
54)(selected_component . 55))
- ((actual_parameter_part . 91)(aspect_specification_opt . 109))
+ ((function_specification . 16)(procedure_specification .
32)(subprogram_specification . 114))
nil
+ ((attribute_reference . 51)(name . 111)(qualified_expression .
54)(selected_component . 55))
+ ((actual_parameter_part . 92)(aspect_specification_opt . 110))
nil
- ((attribute_reference . 51)(name_list . 103)(name .
53)(qualified_expression . 54)(selected_component . 55))
nil
+ ((attribute_reference . 51)(name_list . 104)(name .
53)(qualified_expression . 54)(selected_component . 55))
+ ((attribute_reference . 51)(name . 103)(qualified_expression .
54)(selected_component . 55))
((attribute_reference . 51)(name . 102)(qualified_expression .
54)(selected_component . 55))
((attribute_reference . 51)(name . 101)(qualified_expression .
54)(selected_component . 55))
- ((attribute_reference . 51)(name . 100)(qualified_expression .
54)(selected_component . 55))
nil
- ((function_specification . 16)(procedure_specification .
32)(subprogram_specification . 98))
+ ((function_specification . 16)(procedure_specification .
32)(subprogram_specification . 99))
+ nil
+ nil
nil
nil
nil
+ ((formal_object_declaration . 78)(formal_subprogram_declaration .
79)(formal_type_declaration . 80)(formal_package_declaration .
81)(generic_formal_parameter_declaration . 97)(identifier_list . 84)(pragma .
85)(use_clause . 86))
nil
- ((formal_object_declaration . 78)(formal_subprogram_declaration .
79)(formal_type_declaration . 80)(formal_package_declaration .
81)(generic_formal_parameter_declaration . 96)(identifier_list . 84)(pragma .
85))
nil
nil
nil
- ((actual_parameter_part . 91)(formal_part .
92)(parameter_and_result_profile . 93))
+ ((actual_parameter_part . 92)(formal_part .
93)(parameter_and_result_profile . 94))
+ ((aggregate . 157)(association_opt . 184)(association_list .
201)(attribute_reference . 51)(case_expression . 158)(choice_expression .
186)(choice_relation_and_list . 187)(choice_relation_or_list .
188)(choice_relation_xor_list . 189)(choice_relation_and_then_list .
190)(choice_relation_or_else_list . 191)(choice_relation .
192)(conditional_quantified_expression . 202)(discrete_choice .
193)(discrete_choice_list . 194)(expression . 195)(expression_opt . 196)(factor
. 161)(identifie [...]
+ ((access_definition . 233)(null_exclusion_opt . 234))
nil
((aggregate . 225)(attribute_reference . 51)(attribute_designator .
226)(name . 227)(qualified_expression . 54)(selected_component . 55))
- ((aggregate . 153)(association_opt . 176)(association_list .
193)(attribute_reference . 51)(choice_expression .
178)(choice_relation_and_list . 179)(choice_relation_or_list .
180)(choice_relation_xor_list . 181)(choice_relation_and_then_list .
182)(choice_relation_or_else_list . 183)(choice_relation . 184)(discrete_choice
. 185)(discrete_choice_list . 186)(expression . 187)(expression_opt .
188)(factor . 155)(identifier_list . 217)(name . 189)(parameter_specification .
218)(paramet [...]
- ((access_definition . 212)(attribute_reference . 51)(name .
213)(name_opt . 214)(null_exclusion_opt . 215)(qualified_expression .
54)(selected_component . 55))
nil
nil
nil
- ((mode_opt . 209))
+ ((mode_opt . 219))
nil
nil
- ((attribute_reference . 51)(name . 205)(qualified_expression .
54)(selected_component . 55))
- ((aspect_specification_opt . 204))
- ((discriminant_part_opt . 202))
- ((actual_parameter_part . 91))
- ((actual_parameter_part . 91))
- ((actual_parameter_part . 91))
+ ((attribute_reference . 51)(name . 215)(qualified_expression .
54)(selected_component . 55))
+ ((aspect_specification_opt . 214))
+ ((discriminant_part_opt . 212))
+ ((actual_parameter_part . 92))
+ ((actual_parameter_part . 92))
+ ((actual_parameter_part . 92))
nil
- ((attribute_reference . 51)(name_list . 196)(name .
53)(qualified_expression . 54)(selected_component . 55))
+ ((attribute_reference . 51)(name_list . 206)(name .
53)(qualified_expression . 54)(selected_component . 55))
nil
- ((aggregate . 153)(association_opt . 176)(association_list .
193)(attribute_reference . 51)(choice_expression .
178)(choice_relation_and_list . 179)(choice_relation_or_list .
180)(choice_relation_xor_list . 181)(choice_relation_and_then_list .
182)(choice_relation_or_else_list . 183)(choice_relation . 184)(discrete_choice
. 185)(discrete_choice_list . 186)(expression . 187)(expression_opt .
188)(factor . 155)(name . 189)(primary . 159)(qualified_expression .
54)(raise_expression . [...]
- ((attribute_reference . 51)(name . 192)(qualified_expression .
54)(selected_component . 55))
- ((aggregate . 153)(association_opt . 176)(association_list .
177)(attribute_reference . 51)(choice_expression .
178)(choice_relation_and_list . 179)(choice_relation_or_list .
180)(choice_relation_xor_list . 181)(choice_relation_and_then_list .
182)(choice_relation_or_else_list . 183)(choice_relation . 184)(discrete_choice
. 185)(discrete_choice_list . 186)(expression . 187)(expression_opt .
188)(factor . 155)(name . 189)(primary . 159)(qualified_expression .
54)(raise_expression . [...]
+ ((aggregate . 157)(association_opt . 184)(association_list .
201)(attribute_reference . 51)(case_expression . 158)(choice_expression .
186)(choice_relation_and_list . 187)(choice_relation_or_list .
188)(choice_relation_xor_list . 189)(choice_relation_and_then_list .
190)(choice_relation_or_else_list . 191)(choice_relation .
192)(conditional_quantified_expression . 202)(discrete_choice .
193)(discrete_choice_list . 194)(expression . 195)(expression_opt . 196)(factor
. 161)(if_expres [...]
+ ((attribute_reference . 51)(name . 200)(qualified_expression .
54)(selected_component . 55))
+ ((aggregate . 157)(association_opt . 184)(association_list .
185)(attribute_reference . 51)(choice_expression .
186)(choice_relation_and_list . 187)(choice_relation_or_list .
188)(choice_relation_xor_list . 189)(choice_relation_and_then_list .
190)(choice_relation_or_else_list . 191)(choice_relation . 192)(discrete_choice
. 193)(discrete_choice_list . 194)(expression . 195)(expression_opt .
196)(factor . 161)(name . 197)(primary . 166)(qualified_expression .
54)(raise_expression . [...]
nil
- ((actual_parameter_part . 91)(aspect_specification_opt . 171))
+ ((actual_parameter_part . 92)(aspect_specification_opt . 179))
+ ((aggregate . 157)(attribute_reference . 51)(case_expression .
158)(conditional_quantified_expression . 159)(expression . 160)(factor .
161)(if_expression . 162)(name . 163)(pragma_argument_association .
164)(pragma_argument_association_list . 165)(primary .
166)(qualified_expression . 54)(quantified_expression . 167)(raise_expression .
168)(relation_and_list . 169)(relation_and_then_list . 170)(relation_or_list .
171)(relation_or_else_list . 172)(relation_xor_list . 173)(relation [...]
nil
- ((aggregate . 153)(attribute_reference . 51)(expression . 154)(factor .
155)(name . 156)(pragma_argument_association .
157)(pragma_argument_association_list . 158)(primary .
159)(qualified_expression . 54)(raise_expression . 160)(relation_and_list .
161)(relation_and_then_list . 162)(relation_or_list .
163)(relation_or_else_list . 164)(relation_xor_list . 165)(relation .
166)(selected_component . 55)(simple_expression . 167)(term . 168)(term_list .
169)(unary_adding_operator . 170))
- ((aspect_specification_opt . 142))
+ ((aspect_specification_opt . 143))
nil
- ((actual_parameter_part . 91)(aspect_specification_opt . 109))
+ ((actual_parameter_part . 92)(aspect_specification_opt . 110))
nil
nil
- ((actual_parameter_part . 91))
- ((attribute_reference . 51)(name . 139)(qualified_expression .
54)(selected_component . 55))
+ ((actual_parameter_part . 92))
+ ((attribute_reference . 51)(name . 140)(qualified_expression .
54)(selected_component . 55))
nil
nil
- ((attribute_reference . 51)(name_list . 137)(name .
53)(qualified_expression . 54)(selected_component . 55))
+ ((attribute_reference . 51)(name_list . 138)(name .
53)(qualified_expression . 54)(selected_component . 55))
nil
nil
nil
- ((actual_parameter_part . 91)(aspect_specification_opt . 109))
- ((attribute_reference . 51)(name . 135)(qualified_expression .
54)(selected_component . 55))
+ ((actual_parameter_part . 92)(aspect_specification_opt . 110))
+ ((attribute_reference . 51)(name . 136)(qualified_expression .
54)(selected_component . 55))
nil
- ((actual_parameter_part . 91)(formal_part . 116)(parameter_profile_opt .
117))
- ((actual_parameter_part . 91)(formal_part .
92)(parameter_and_result_profile . 93))
+ ((actual_parameter_part . 92)(formal_part . 117)(parameter_profile_opt .
118))
+ ((actual_parameter_part . 92)(formal_part .
93)(parameter_and_result_profile . 94))
nil
nil
+ ((abstract_subprogram_declaration . 306)(aspect_clause . 307)(at_clause
. 308)(body . 309)(body_stub . 310)(declaration . 311)(declarations .
312)(declarative_part_opt . 397)(entry_declaration .
314)(enumeration_representation_clause . 315)(exception_declaration .
316)(expression_function_declaration . 317)(full_type_declaration .
318)(function_specification . 16)(generic_declaration .
319)(generic_formal_part . 18)(generic_instantiation .
320)(generic_package_declaration . 20)(gen [...]
nil
- ((abstract_subprogram_declaration . 302)(aspect_clause . 303)(at_clause
. 304)(body . 305)(body_stub . 306)(declaration . 307)(declarations .
308)(declarative_part_opt . 388)(entry_declaration .
310)(enumeration_representation_clause . 311)(exception_declaration .
312)(expression_function_declaration . 313)(full_type_declaration .
314)(function_specification . 16)(generic_declaration .
315)(generic_formal_part . 18)(generic_instantiation .
316)(generic_package_declaration . 20)(gen [...]
- ((actual_parameter_part . 91)(aspect_specification_opt . 387))
+ ((actual_parameter_part . 92)(aspect_specification_opt . 396))
nil
nil
nil
- ((actual_parameter_part . 91))
- ((function_specification . 16)(overriding_indicator_opt .
384)(package_body . 324)(procedure_specification . 32)(proper_body .
385)(protected_body . 332)(subprogram_body . 339)(task_body . 344))
+ ((actual_parameter_part . 92))
+ ((function_specification . 16)(overriding_indicator_opt .
393)(package_body . 328)(procedure_specification . 32)(proper_body .
394)(protected_body . 336)(subprogram_body . 343)(task_body . 348))
nil
nil
+ ((aggregate . 157)(attribute_reference . 51)(name . 163)(primary .
389)(qualified_expression . 54)(selected_component . 55))
+ ((aggregate . 157)(attribute_reference . 51)(expression . 388)(factor .
161)(name . 163)(primary . 166)(qualified_expression . 54)(raise_expression .
168)(relation_and_list . 169)(relation_and_then_list . 170)(relation_or_list .
171)(relation_or_else_list . 172)(relation_xor_list . 173)(relation .
174)(selected_component . 55)(simple_expression . 175)(term . 176)(term_list .
177)(unary_adding_operator . 178))
+ ((quantifier . 387))
+ ((aggregate . 157)(attribute_reference . 51)(expression . 384)(factor .
161)(name . 163)(primary . 166)(qualified_expression . 54)(raise_expression .
168)(relation_and_list . 169)(relation_and_then_list . 170)(relation_or_list .
171)(relation_or_else_list . 172)(relation_xor_list . 173)(relation .
174)(selected_component . 55)(simple_expression . 175)(term . 176)(term_list .
177)(unary_adding_operator . 178))
+ ((aggregate . 157)(association_opt . 184)(association_list .
381)(attribute_reference . 51)(case_expression . 158)(choice_expression .
186)(choice_relation_and_list . 187)(choice_relation_or_list .
188)(choice_relation_xor_list . 189)(choice_relation_and_then_list .
190)(choice_relation_or_else_list . 191)(choice_relation .
192)(conditional_quantified_expression . 382)(discrete_choice .
193)(discrete_choice_list . 194)(expression . 383)(expression_opt . 196)(factor
. 161)(if_expres [...]
+ ((attribute_reference . 51)(name . 379)(qualified_expression .
54)(selected_component . 55))
+ ((aggregate . 157)(attribute_reference . 51)(name . 163)(primary .
298)(qualified_expression . 54)(selected_component . 55))
nil
+ ((attribute_reference . 51)(name . 378)(qualified_expression .
54)(selected_component . 55))
nil
nil
nil
- ((aggregate . 153)(attribute_reference . 51)(name . 156)(primary .
378)(qualified_expression . 54)(selected_component . 55))
- ((aggregate . 153)(association_opt . 176)(association_list .
235)(attribute_reference . 51)(case_expression . 375)(choice_expression .
178)(choice_relation_and_list . 179)(choice_relation_or_list .
180)(choice_relation_xor_list . 181)(choice_relation_and_then_list .
182)(choice_relation_or_else_list . 183)(choice_relation . 184)(discrete_choice
. 185)(discrete_choice_list . 186)(expression . 237)(expression_opt .
188)(factor . 155)(if_expression . 376)(name . 189)(primary . 159)(qu [...]
- ((attribute_reference . 51)(name . 373)(qualified_expression .
54)(selected_component . 55))
- ((aggregate . 153)(attribute_reference . 51)(name . 156)(primary .
293)(qualified_expression . 54)(selected_component . 55))
nil
- ((attribute_reference . 51)(name . 372)(qualified_expression .
54)(selected_component . 55))
nil
nil
nil
- ((actual_parameter_part . 91))
nil
nil
nil
+ ((actual_parameter_part . 92))
nil
nil
nil
@@ -3296,17 +3321,17 @@
nil
nil
nil
- ((relational_operator . 360))
- ((multiplying_operator . 359))
- ((binary_adding_operator . 354))
- ((aggregate . 153)(attribute_reference . 51)(factor . 155)(name .
156)(primary . 159)(qualified_expression . 54)(selected_component . 55)(term .
168)(term_list . 350))
nil
- ((abstract_subprogram_declaration . 302)(aspect_clause . 303)(at_clause
. 304)(body . 305)(body_stub . 306)(declaration . 307)(declarations .
308)(declarative_part_opt . 309)(entry_declaration .
310)(enumeration_representation_clause . 311)(exception_declaration .
312)(expression_function_declaration . 313)(full_type_declaration .
314)(function_specification . 16)(generic_declaration .
315)(generic_formal_part . 18)(generic_instantiation .
316)(generic_package_declaration . 20)(gen [...]
nil
- ((aggregate . 153)(attribute_reference . 51)(name . 156)(primary .
293)(qualified_expression . 54)(selected_component . 55))
nil
nil
+ ((relational_operator . 364))
+ ((multiplying_operator . 363))
+ ((binary_adding_operator . 358))
+ ((aggregate . 157)(attribute_reference . 51)(factor . 161)(name .
163)(primary . 166)(qualified_expression . 54)(selected_component . 55)(term .
176)(term_list . 354))
nil
+ ((abstract_subprogram_declaration . 306)(aspect_clause . 307)(at_clause
. 308)(body . 309)(body_stub . 310)(declaration . 311)(declarations .
312)(declarative_part_opt . 313)(entry_declaration .
314)(enumeration_representation_clause . 315)(exception_declaration .
316)(expression_function_declaration . 317)(full_type_declaration .
318)(function_specification . 16)(generic_declaration .
319)(generic_formal_part . 18)(generic_instantiation .
320)(generic_package_declaration . 20)(gen [...]
+ ((aggregate . 157)(attribute_reference . 51)(name . 163)(primary .
298)(qualified_expression . 54)(selected_component . 55))
nil
nil
nil
@@ -3318,114 +3343,113 @@
nil
nil
nil
- ((actual_parameter_part . 91))
nil
- ((relational_operator . 280))
- ((actual_parameter_part . 91)(aspect_specification_opt . 270))
nil
nil
- ((attribute_reference . 51)(name . 266)(qualified_expression .
54)(selected_component . 55))
nil
+ ((actual_parameter_part . 92))
nil
- ((attribute_reference . 51)(name . 264)(qualified_expression .
54)(selected_component . 55))
- ((attribute_reference . 51)(name . 263)(qualified_expression .
54)(selected_component . 55))
- ((attribute_reference . 51)(name . 262)(qualified_expression .
54)(selected_component . 55))
- ((discriminant_specification_opt . 259)(discriminant_specification_list
. 260)(identifier_list . 261))
- ((aspect_specification_opt . 257))
- ((attribute_reference . 51)(name . 254)(qualified_expression .
54)(selected_component . 55)(subprogram_default . 255))
+ ((relational_operator . 284))
+ ((actual_parameter_part . 92)(aspect_specification_opt . 274))
nil
- ((actual_parameter_part . 91))
nil
nil
nil
- ((access_definition . 246)(null_exclusion_opt . 247))
- ((access_definition . 244)(null_exclusion_opt . 245))
+ ((attribute_reference . 51)(name . 268)(qualified_expression .
54)(selected_component . 55))
+ nil
nil
+ ((attribute_reference . 51)(name . 266)(qualified_expression .
54)(selected_component . 55))
+ ((attribute_reference . 51)(name . 265)(qualified_expression .
54)(selected_component . 55))
+ ((attribute_reference . 51)(name . 264)(qualified_expression .
54)(selected_component . 55))
+ ((discriminant_specification_opt . 261)(discriminant_specification_list
. 262)(identifier_list . 263))
+ ((aspect_specification_opt . 259))
+ ((attribute_reference . 51)(name . 256)(qualified_expression .
54)(selected_component . 55)(subprogram_default . 257))
nil
- ((actual_parameter_part . 91))
+ ((actual_parameter_part . 92))
nil
nil
nil
+ ((access_definition . 248)(null_exclusion_opt . 249))
+ ((access_definition . 246)(null_exclusion_opt . 247))
nil
nil
nil
nil
nil
nil
- ((aggregate . 153)(association_opt . 176)(association_list .
235)(attribute_reference . 51)(case_expression . 236)(choice_expression .
178)(choice_relation_and_list . 179)(choice_relation_or_list .
180)(choice_relation_xor_list . 181)(choice_relation_and_then_list .
182)(choice_relation_or_else_list . 183)(choice_relation . 184)(discrete_choice
. 185)(discrete_choice_list . 186)(expression . 237)(expression_opt .
188)(factor . 155)(if_expression . 238)(name . 189)(primary . 159)(qu [...]
+ ((actual_parameter_part . 92))
nil
nil
nil
- ((actual_parameter_part . 91))
nil
nil
nil
+ ((attribute_reference . 51)(name . 243)(name_opt .
244)(qualified_expression . 54)(selected_component . 55))
nil
- ((aggregate . 153)(attribute_reference . 51)(expression . 526)(factor .
155)(name . 156)(primary . 159)(qualified_expression . 54)(raise_expression .
160)(relation_and_list . 161)(relation_and_then_list . 162)(relation_or_list .
163)(relation_or_else_list . 164)(relation_xor_list . 165)(relation .
166)(selected_component . 55)(simple_expression . 167)(term . 168)(term_list .
169)(unary_adding_operator . 170))
- ((aggregate . 153)(attribute_reference . 51)(expression . 525)(factor .
155)(name . 156)(primary . 159)(qualified_expression . 54)(raise_expression .
160)(relation_and_list . 161)(relation_and_then_list . 162)(relation_or_list .
163)(relation_or_else_list . 164)(relation_xor_list . 165)(relation .
166)(selected_component . 55)(simple_expression . 167)(term . 168)(term_list .
169)(unary_adding_operator . 170))
nil
nil
nil
nil
+ ((identifier_list . 236)(parameter_specification . 533))
+ ((aliased_opt . 532))
+ ((general_access_modifier_opt . 529)(protected_opt . 530))
+ ((actual_parameter_part . 92))
nil
- ((identifier_list . 217)(parameter_specification . 519))
nil
- ((aliased_opt . 518))
- ((general_access_modifier_opt . 515)(protected_opt . 516))
nil
+ ((attribute_reference . 51)(name . 243)(name_opt .
525)(qualified_expression . 54)(selected_component . 55))
+ ((aspect_specification_opt . 524))
+ ((attribute_reference . 51)(name . 522)(qualified_expression .
54)(selected_component . 55))
nil
- ((attribute_reference . 51)(name . 213)(name_opt .
511)(qualified_expression . 54)(selected_component . 55))
- ((aspect_specification_opt . 510))
- ((attribute_reference . 51)(name . 508)(qualified_expression .
54)(selected_component . 55))
nil
nil
+ ((aspect_specification_opt . 519)(attribute_reference . 51)(name .
256)(qualified_expression . 54)(selected_component . 55)(subprogram_default .
520))
nil
nil
- ((aspect_specification_opt . 505)(attribute_reference . 51)(name .
254)(qualified_expression . 54)(selected_component . 55)(subprogram_default .
506))
+ ((actual_parameter_part . 92))
+ ((aspect_specification_opt . 518))
+ ((abstract_limited_synchronized_opt . 510)(abstract_tagged_limited_opt .
511)(access_definition . 512)(array_type_definition .
513)(formal_type_definition . 514)(formal_derived_type_definition .
515)(interface_type_definition . 516)(null_exclusion_opt . 517))
nil
- ((actual_parameter_part . 91))
- ((aspect_specification_opt . 504))
- ((abstract_limited_synchronized_opt . 497)(abstract_tagged_limited_opt .
498)(access_definition . 499)(array_type_definition .
500)(formal_type_definition . 501)(formal_derived_type_definition .
502)(interface_type_definition . 503)(null_exclusion_opt . 215))
nil
nil
nil
nil
+ ((actual_parameter_part . 92)(aspect_specification_opt . 491))
+ ((actual_parameter_part . 92)(aspect_specification_opt . 490))
+ ((actual_parameter_part . 92)(aspect_specification_opt . 489))
nil
- ((actual_parameter_part . 91)(aspect_specification_opt . 478))
- ((actual_parameter_part . 91)(aspect_specification_opt . 477))
- ((actual_parameter_part . 91)(aspect_specification_opt . 476))
+ ((actual_parameter_part . 92)(aspect_specification_opt . 488))
nil
- ((actual_parameter_part . 91)(aspect_specification_opt . 475))
+ ((aggregate . 157)(attribute_reference . 51)(factor . 161)(name .
197)(primary . 166)(qualified_expression . 54)(range . 486)(selected_component
. 55)(simple_expression . 487)(term . 176)(term_list .
177)(unary_adding_operator . 178))
nil
- ((aggregate . 153)(association_opt . 474)(attribute_reference .
51)(choice_expression . 178)(choice_relation_and_list .
179)(choice_relation_or_list . 180)(choice_relation_xor_list .
181)(choice_relation_and_then_list . 182)(choice_relation_or_else_list .
183)(choice_relation . 184)(discrete_choice . 185)(discrete_choice_list .
186)(expression . 187)(expression_opt . 188)(factor . 155)(name . 189)(primary
. 159)(qualified_expression . 54)(raise_expression . 160)(range . 190)(relati
[...]
nil
+ ((aggregate . 157)(association_opt . 485)(attribute_reference .
51)(choice_expression . 186)(choice_relation_and_list .
187)(choice_relation_or_list . 188)(choice_relation_xor_list .
189)(choice_relation_and_then_list . 190)(choice_relation_or_else_list .
191)(choice_relation . 192)(discrete_choice . 193)(discrete_choice_list .
194)(expression . 195)(expression_opt . 196)(factor . 161)(name . 197)(primary
. 166)(qualified_expression . 54)(raise_expression . 168)(range . 198)(relati
[...]
nil
- ((aggregate . 153)(attribute_reference . 51)(factor . 155)(name .
156)(primary . 159)(qualified_expression . 54)(selected_component .
55)(simple_expression . 472)(term . 168)(term_list . 169)(unary_adding_operator
. 170))
+ ((aggregate . 157)(attribute_reference . 51)(factor .
161)(membership_choice_list . 480)(membership_choice . 481)(name . 197)(primary
. 166)(qualified_expression . 54)(range . 482)(selected_component .
55)(simple_expression . 483)(term . 176)(term_list . 177)(unary_adding_operator
. 178))
nil
+ ((aggregate . 157)(attribute_reference . 51)(factor . 161)(name .
163)(primary . 166)(qualified_expression . 54)(selected_component .
55)(simple_expression . 478)(term . 176)(term_list . 177)(unary_adding_operator
. 178))
nil
nil
nil
nil
nil
- ((aggregate . 153)(attribute_reference . 51)(factor .
155)(membership_choice_list . 468)(membership_choice . 469)(name . 189)(primary
. 159)(qualified_expression . 54)(range . 470)(selected_component .
55)(simple_expression . 471)(term . 168)(term_list . 169)(unary_adding_operator
. 170))
nil
- ((aggregate . 153)(attribute_reference . 51)(factor . 155)(name .
156)(primary . 159)(qualified_expression . 54)(selected_component .
55)(simple_expression . 466)(term . 168)(term_list . 169)(unary_adding_operator
. 170))
+ ((aggregate . 157)(attribute_reference . 51)(factor . 161)(name .
163)(primary . 166)(qualified_expression . 54)(selected_component .
55)(simple_expression . 477)(term . 176)(term_list . 177)(unary_adding_operator
. 178))
((aggregate . 225)(attribute_reference . 51)(attribute_designator .
226)(name . 227)(qualified_expression . 54)(selected_component . 55))
- ((aggregate . 153)(attribute_reference . 51)(choice_expression .
178)(choice_relation_and_list . 179)(choice_relation_or_list .
180)(choice_relation_xor_list . 181)(choice_relation_and_then_list .
182)(choice_relation_or_else_list . 183)(choice_relation . 184)(discrete_choice
. 463)(factor . 155)(name . 189)(primary . 159)(qualified_expression .
54)(range . 190)(selected_component . 55)(simple_expression . 464)(term .
168)(term_list . 169)(unary_adding_operator . 170))
- ((aggregate . 153)(attribute_reference . 51)(expression . 462)(factor .
155)(name . 156)(primary . 159)(qualified_expression . 54)(raise_expression .
160)(relation_and_list . 161)(relation_and_then_list . 162)(relation_or_list .
163)(relation_or_else_list . 164)(relation_xor_list . 165)(relation .
166)(selected_component . 55)(simple_expression . 167)(term . 168)(term_list .
169)(unary_adding_operator . 170))
- ((aggregate . 153)(attribute_reference . 51)(choice_relation .
460)(factor . 155)(name . 156)(primary . 159)(qualified_expression .
54)(selected_component . 55)(simple_expression . 451)(term . 168)(term_list .
169)(unary_adding_operator . 170))
- ((aggregate . 153)(attribute_reference . 51)(choice_relation .
458)(factor . 155)(name . 156)(primary . 159)(qualified_expression .
54)(selected_component . 55)(simple_expression . 451)(term . 168)(term_list .
169)(unary_adding_operator . 170))
- ((aggregate . 153)(attribute_reference . 51)(choice_relation .
456)(factor . 155)(name . 156)(primary . 159)(qualified_expression .
54)(selected_component . 55)(simple_expression . 451)(term . 168)(term_list .
169)(unary_adding_operator . 170))
+ ((aggregate . 157)(attribute_reference . 51)(choice_expression .
186)(choice_relation_and_list . 187)(choice_relation_or_list .
188)(choice_relation_xor_list . 189)(choice_relation_and_then_list .
190)(choice_relation_or_else_list . 191)(choice_relation . 192)(discrete_choice
. 474)(factor . 161)(name . 197)(primary . 166)(qualified_expression .
54)(range . 198)(selected_component . 55)(simple_expression . 475)(term .
176)(term_list . 177)(unary_adding_operator . 178))
+ ((aggregate . 157)(attribute_reference . 51)(expression . 473)(factor .
161)(name . 163)(primary . 166)(qualified_expression . 54)(raise_expression .
168)(relation_and_list . 169)(relation_and_then_list . 170)(relation_or_list .
171)(relation_or_else_list . 172)(relation_xor_list . 173)(relation .
174)(selected_component . 55)(simple_expression . 175)(term . 176)(term_list .
177)(unary_adding_operator . 178))
+ ((aggregate . 157)(attribute_reference . 51)(choice_relation .
471)(factor . 161)(name . 163)(primary . 166)(qualified_expression .
54)(selected_component . 55)(simple_expression . 462)(term . 176)(term_list .
177)(unary_adding_operator . 178))
+ ((aggregate . 157)(attribute_reference . 51)(choice_relation .
469)(factor . 161)(name . 163)(primary . 166)(qualified_expression .
54)(selected_component . 55)(simple_expression . 462)(term . 176)(term_list .
177)(unary_adding_operator . 178))
+ ((aggregate . 157)(attribute_reference . 51)(choice_relation .
467)(factor . 161)(name . 163)(primary . 166)(qualified_expression .
54)(selected_component . 55)(simple_expression . 462)(term . 176)(term_list .
177)(unary_adding_operator . 178))
nil
nil
- ((aggregate . 153)(attribute_reference . 51)(choice_relation .
453)(factor . 155)(name . 156)(primary . 159)(qualified_expression .
54)(selected_component . 55)(simple_expression . 451)(term . 168)(term_list .
169)(unary_adding_operator . 170))
- ((aggregate . 153)(attribute_reference . 51)(choice_relation .
452)(factor . 155)(name . 156)(primary . 159)(qualified_expression .
54)(selected_component . 55)(simple_expression . 451)(term . 168)(term_list .
169)(unary_adding_operator . 170))
- ((aggregate . 153)(attribute_reference . 51)(choice_relation .
450)(factor . 155)(name . 156)(primary . 159)(qualified_expression .
54)(selected_component . 55)(simple_expression . 451)(term . 168)(term_list .
169)(unary_adding_operator . 170))
- ((attribute_reference . 51)(name . 449)(qualified_expression .
54)(selected_component . 55))
+ ((aggregate . 157)(attribute_reference . 51)(choice_relation .
464)(factor . 161)(name . 163)(primary . 166)(qualified_expression .
54)(selected_component . 55)(simple_expression . 462)(term . 176)(term_list .
177)(unary_adding_operator . 178))
+ ((aggregate . 157)(attribute_reference . 51)(choice_relation .
463)(factor . 161)(name . 163)(primary . 166)(qualified_expression .
54)(selected_component . 55)(simple_expression . 462)(term . 176)(term_list .
177)(unary_adding_operator . 178))
+ ((aggregate . 157)(attribute_reference . 51)(choice_relation .
461)(factor . 161)(name . 163)(primary . 166)(qualified_expression .
54)(selected_component . 55)(simple_expression . 462)(term . 176)(term_list .
177)(unary_adding_operator . 178))
+ ((aggregate . 157)(attribute_reference . 51)(expression . 460)(factor .
161)(name . 163)(primary . 166)(qualified_expression . 54)(raise_expression .
168)(relation_and_list . 169)(relation_and_then_list . 170)(relation_or_list .
171)(relation_or_else_list . 172)(relation_xor_list . 173)(relation .
174)(selected_component . 55)(simple_expression . 175)(term . 176)(term_list .
177)(unary_adding_operator . 178))
+ ((attribute_reference . 51)(name . 458)(qualified_expression .
54)(selected_component . 55))
nil
- ((aggregate . 153)(attribute_reference . 51)(expression . 448)(factor .
155)(name . 156)(primary . 159)(qualified_expression . 54)(raise_expression .
160)(relation_and_list . 161)(relation_and_then_list . 162)(relation_or_list .
163)(relation_or_else_list . 164)(relation_xor_list . 165)(relation .
166)(selected_component . 55)(simple_expression . 167)(term . 168)(term_list .
169)(unary_adding_operator . 170))
- nil
- ((attribute_reference . 443)(direct_name . 444)(name .
445)(qualified_expression . 54)(selected_component . 55))
+ ((attribute_reference . 455)(direct_name . 456)(name .
457)(qualified_expression . 54)(selected_component . 55))
((attribute_reference . 51)(name . 68)(qualified_expression .
54)(selected_component . 55))
nil
nil
@@ -3437,8 +3461,8 @@
nil
nil
nil
- ((abstract_subprogram_declaration . 302)(aspect_clause . 303)(at_clause
. 304)(body . 305)(body_stub . 306)(declaration . 431)(entry_declaration .
310)(enumeration_representation_clause . 311)(exception_declaration .
312)(expression_function_declaration . 313)(full_type_declaration .
314)(function_specification . 16)(generic_declaration .
315)(generic_formal_part . 18)(generic_instantiation .
316)(generic_package_declaration . 20)(generic_renaming_declaration .
317)(generic_subprog [...]
nil
+ ((abstract_subprogram_declaration . 306)(aspect_clause . 307)(at_clause
. 308)(body . 309)(body_stub . 310)(declaration . 442)(entry_declaration .
314)(enumeration_representation_clause . 315)(exception_declaration .
316)(expression_function_declaration . 317)(full_type_declaration .
318)(function_specification . 16)(generic_declaration .
319)(generic_formal_part . 18)(generic_instantiation .
320)(generic_package_declaration . 20)(generic_renaming_declaration .
321)(generic_subprog [...]
nil
nil
nil
@@ -3452,8 +3476,8 @@
nil
nil
nil
- ((function_specification . 425)(procedure_specification .
426)(subprogram_specification . 427))
nil
+ ((function_specification . 436)(procedure_specification .
437)(subprogram_specification . 438))
nil
nil
nil
@@ -3478,138 +3502,138 @@
nil
nil
nil
- ((abstract_subprogram_declaration . 302)(aspect_clause . 303)(at_clause
. 304)(body . 305)(body_stub . 306)(declaration . 307)(declarations .
308)(declarative_part_opt . 423)(entry_declaration .
310)(enumeration_representation_clause . 311)(exception_declaration .
312)(expression_function_declaration . 313)(full_type_declaration .
314)(function_specification . 16)(generic_declaration .
315)(generic_formal_part . 18)(generic_instantiation .
316)(generic_package_declaration . 20)(gen [...]
- ((binary_adding_operator . 354))
nil
+ ((abstract_subprogram_declaration . 306)(aspect_clause . 307)(at_clause
. 308)(body . 309)(body_stub . 310)(declaration . 311)(declarations .
312)(declarative_part_opt . 434)(entry_declaration .
314)(enumeration_representation_clause . 315)(exception_declaration .
316)(expression_function_declaration . 317)(full_type_declaration .
318)(function_specification . 16)(generic_declaration .
319)(generic_formal_part . 18)(generic_instantiation .
320)(generic_package_declaration . 20)(gen [...]
+ ((binary_adding_operator . 358))
nil
nil
- ((aggregate . 153)(attribute_reference . 51)(factor . 155)(name .
156)(primary . 159)(qualified_expression . 54)(selected_component . 55)(term .
422))
nil
+ ((aggregate . 157)(attribute_reference . 51)(factor . 161)(name .
163)(primary . 166)(qualified_expression . 54)(selected_component . 55)(term .
433))
nil
nil
nil
- ((aggregate . 153)(attribute_reference . 51)(factor . 421)(name .
156)(primary . 159)(qualified_expression . 54)(selected_component . 55))
- ((aggregate . 153)(attribute_reference . 51)(factor . 155)(name .
156)(primary . 159)(qualified_expression . 54)(selected_component .
55)(simple_expression . 420)(term . 168)(term_list . 169)(unary_adding_operator
. 170))
- ((aggregate . 153)(attribute_reference . 51)(factor . 155)(name .
156)(primary . 159)(qualified_expression . 54)(raise_expression . 160)(relation
. 419)(selected_component . 55)(simple_expression . 167)(term . 168)(term_list
. 169)(unary_adding_operator . 170))
- ((aggregate . 153)(attribute_reference . 51)(factor . 155)(name .
156)(primary . 159)(qualified_expression . 54)(raise_expression . 160)(relation
. 417)(selected_component . 55)(simple_expression . 167)(term . 168)(term_list
. 169)(unary_adding_operator . 170))
- ((aggregate . 153)(attribute_reference . 51)(factor . 155)(name .
156)(primary . 159)(qualified_expression . 54)(raise_expression . 160)(relation
. 415)(selected_component . 55)(simple_expression . 167)(term . 168)(term_list
. 169)(unary_adding_operator . 170))
- ((aggregate . 153)(attribute_reference . 51)(factor . 155)(name .
156)(primary . 159)(qualified_expression . 54)(raise_expression . 160)(relation
. 414)(selected_component . 55)(simple_expression . 167)(term . 168)(term_list
. 169)(unary_adding_operator . 170))
nil
- ((aggregate . 153)(attribute_reference . 51)(factor . 155)(name .
156)(primary . 159)(qualified_expression . 54)(raise_expression . 160)(relation
. 412)(selected_component . 55)(simple_expression . 167)(term . 168)(term_list
. 169)(unary_adding_operator . 170))
+ ((aggregate . 157)(attribute_reference . 51)(factor . 432)(name .
163)(primary . 166)(qualified_expression . 54)(selected_component . 55))
+ ((aggregate . 157)(attribute_reference . 51)(factor . 161)(name .
163)(primary . 166)(qualified_expression . 54)(selected_component .
55)(simple_expression . 431)(term . 176)(term_list . 177)(unary_adding_operator
. 178))
+ ((aggregate . 157)(attribute_reference . 51)(factor . 161)(name .
163)(primary . 166)(qualified_expression . 54)(raise_expression . 168)(relation
. 430)(selected_component . 55)(simple_expression . 175)(term . 176)(term_list
. 177)(unary_adding_operator . 178))
+ ((aggregate . 157)(attribute_reference . 51)(factor . 161)(name .
163)(primary . 166)(qualified_expression . 54)(raise_expression . 168)(relation
. 428)(selected_component . 55)(simple_expression . 175)(term . 176)(term_list
. 177)(unary_adding_operator . 178))
+ ((aggregate . 157)(attribute_reference . 51)(factor . 161)(name .
163)(primary . 166)(qualified_expression . 54)(raise_expression . 168)(relation
. 426)(selected_component . 55)(simple_expression . 175)(term . 176)(term_list
. 177)(unary_adding_operator . 178))
+ ((aggregate . 157)(attribute_reference . 51)(factor . 161)(name .
163)(primary . 166)(qualified_expression . 54)(raise_expression . 168)(relation
. 425)(selected_component . 55)(simple_expression . 175)(term . 176)(term_list
. 177)(unary_adding_operator . 178))
nil
- ((aggregate . 153)(attribute_reference . 51)(factor . 155)(name .
156)(primary . 159)(qualified_expression . 54)(raise_expression . 160)(relation
. 410)(selected_component . 55)(simple_expression . 167)(term . 168)(term_list
. 169)(unary_adding_operator . 170))
- ((aggregate . 153)(attribute_reference . 51)(name . 156)(primary .
409)(qualified_expression . 54)(selected_component . 55))
- ((aggregate . 153)(attribute_reference . 51)(expression . 154)(factor .
155)(name . 156)(pragma_argument_association . 408)(primary .
159)(qualified_expression . 54)(raise_expression . 160)(relation_and_list .
161)(relation_and_then_list . 162)(relation_or_list .
163)(relation_or_else_list . 164)(relation_xor_list . 165)(relation .
166)(selected_component . 55)(simple_expression . 167)(term . 168)(term_list .
169)(unary_adding_operator . 170))
+ ((aggregate . 157)(attribute_reference . 51)(factor . 161)(name .
163)(primary . 166)(qualified_expression . 54)(raise_expression . 168)(relation
. 423)(selected_component . 55)(simple_expression . 175)(term . 176)(term_list
. 177)(unary_adding_operator . 178))
nil
- ((actual_parameter_part . 91))
- ((actual_parameter_part . 91))
- ((quantifier . 405))
+ ((aggregate . 157)(attribute_reference . 51)(factor . 161)(name .
163)(primary . 166)(qualified_expression . 54)(raise_expression . 168)(relation
. 421)(selected_component . 55)(simple_expression . 175)(term . 176)(term_list
. 177)(unary_adding_operator . 178))
+ ((aggregate . 157)(attribute_reference . 51)(name . 163)(primary .
420)(qualified_expression . 54)(selected_component . 55))
nil
+ ((aggregate . 157)(attribute_reference . 51)(case_expression .
158)(conditional_quantified_expression . 159)(expression . 160)(factor .
161)(if_expression . 162)(name . 163)(pragma_argument_association .
418)(primary . 166)(qualified_expression . 54)(quantified_expression .
167)(raise_expression . 168)(relation_and_list . 169)(relation_and_then_list .
170)(relation_or_list . 171)(relation_or_else_list . 172)(relation_xor_list .
173)(relation . 174)(selected_component . 55)(simple_e [...]
+ ((aggregate . 157)(attribute_reference . 51)(expression . 417)(factor .
161)(name . 163)(primary . 166)(qualified_expression . 54)(raise_expression .
168)(relation_and_list . 169)(relation_and_then_list . 170)(relation_or_list .
171)(relation_or_else_list . 172)(relation_xor_list . 173)(relation .
174)(selected_component . 55)(simple_expression . 175)(term . 176)(term_list .
177)(unary_adding_operator . 178))
nil
+ ((actual_parameter_part . 92))
+ ((actual_parameter_part . 92))
nil
nil
- ((aggregate . 153)(attribute_reference . 51)(expression . 399)(factor .
155)(name . 156)(primary . 159)(qualified_expression . 54)(raise_expression .
160)(relation_and_list . 161)(relation_and_then_list . 162)(relation_or_list .
163)(relation_or_else_list . 164)(relation_xor_list . 165)(relation .
166)(selected_component . 55)(simple_expression . 167)(term . 168)(term_list .
169)(unary_adding_operator . 170))
nil
nil
nil
nil
- ((function_specification . 16)(procedure_specification .
32)(subprogram_specification . 395))
nil
+ ((iterator_specification . 409))
nil
nil
nil
- ((attribute_reference . 51)(name . 392)(qualified_expression .
54)(selected_component . 55))
- ((attribute_reference . 51)(name . 391)(qualified_expression .
54)(selected_component . 55))
- ((actual_parameter_part . 91)(aspect_specification_opt . 665))
- ((actual_parameter_part . 91)(aspect_specification_opt . 664))
- ((accept_statement . 638)(assignment_statement .
639)(asynchronous_select . 640)(attribute_reference . 51)(block_statement .
641)(case_statement . 642)(conditional_entry_call . 643)(delay_statement .
644)(exit_statement . 645)(extended_return_statement .
646)(handled_sequence_of_statements . 647)(if_statement . 648)(iteration_scheme
. 649)(label_opt . 650)(loop_statement . 651)(name . 652)(pragma .
653)(procedure_call_statement . 654)(qualified_expression . 54)(raise_statement
. 65 [...]
nil
- ((aspect_specification_opt . 618))
nil
+ ((function_specification . 16)(procedure_specification .
32)(subprogram_specification . 404))
nil
nil
nil
nil
+ ((attribute_reference . 51)(name . 401)(qualified_expression .
54)(selected_component . 55))
+ ((attribute_reference . 51)(name . 400)(qualified_expression .
54)(selected_component . 55))
+ ((actual_parameter_part . 92)(aspect_specification_opt . 676))
+ ((actual_parameter_part . 92)(aspect_specification_opt . 675))
+ ((accept_statement . 649)(assignment_statement .
650)(asynchronous_select . 651)(attribute_reference . 51)(block_statement .
652)(case_statement . 653)(conditional_entry_call . 654)(delay_statement .
655)(exit_statement . 656)(extended_return_statement .
657)(handled_sequence_of_statements . 658)(if_statement . 659)(iteration_scheme
. 660)(label_opt . 661)(loop_statement . 662)(name . 663)(pragma .
664)(procedure_call_statement . 665)(qualified_expression . 54)(raise_statement
. 66 [...]
nil
+ ((aspect_specification_opt . 629))
nil
nil
+ ((case_expression_alternative . 625)(case_expression_alternative_list .
626))
nil
- ((iterator_specification . 614))
- ((aggregate . 153)(attribute_reference . 51)(expression . 612)(factor .
155)(name . 156)(primary . 159)(qualified_expression . 54)(raise_expression .
160)(relation_and_list . 161)(relation_and_then_list . 162)(relation_or_list .
163)(relation_or_else_list . 164)(relation_xor_list . 165)(relation .
166)(selected_component . 55)(simple_expression . 167)(term . 168)(term_list .
169)(unary_adding_operator . 170))
nil
+ ((aggregate . 157)(attribute_reference . 51)(expression . 619)(factor .
161)(name . 163)(primary . 166)(qualified_expression . 54)(raise_expression .
168)(relation_and_list . 169)(relation_and_then_list . 170)(relation_or_list .
171)(relation_or_else_list . 172)(relation_xor_list . 173)(relation .
174)(selected_component . 55)(simple_expression . 175)(term . 176)(term_list .
177)(unary_adding_operator . 178))
+ ((aggregate . 157)(association_opt . 184)(association_list .
618)(attribute_reference . 51)(choice_expression .
186)(choice_relation_and_list . 187)(choice_relation_or_list .
188)(choice_relation_xor_list . 189)(choice_relation_and_then_list .
190)(choice_relation_or_else_list . 191)(choice_relation . 192)(discrete_choice
. 193)(discrete_choice_list . 194)(expression . 195)(expression_opt .
196)(factor . 161)(name . 197)(primary . 166)(qualified_expression .
54)(raise_expression . [...]
nil
nil
nil
- ((aggregate . 153)(attribute_reference . 51)(factor . 155)(name .
156)(primary . 159)(qualified_expression . 54)(raise_expression . 160)(relation
. 611)(selected_component . 55)(simple_expression . 167)(term . 168)(term_list
. 169)(unary_adding_operator . 170))
+ ((aggregate . 157)(attribute_reference . 51)(expression . 615)(factor .
161)(name . 163)(primary . 166)(qualified_expression . 54)(raise_expression .
168)(relation_and_list . 169)(relation_and_then_list . 170)(relation_or_list .
171)(relation_or_else_list . 172)(relation_xor_list . 173)(relation .
174)(selected_component . 55)(simple_expression . 175)(term . 176)(term_list .
177)(unary_adding_operator . 178))
nil
- ((aggregate . 153)(attribute_reference . 51)(factor . 155)(name .
156)(primary . 159)(qualified_expression . 54)(raise_expression . 160)(relation
. 610)(selected_component . 55)(simple_expression . 167)(term . 168)(term_list
. 169)(unary_adding_operator . 170))
nil
nil
- ((aggregate . 153)(attribute_reference . 51)(factor . 155)(name .
156)(primary . 159)(qualified_expression . 54)(raise_expression . 160)(relation
. 609)(selected_component . 55)(simple_expression . 167)(term . 168)(term_list
. 169)(unary_adding_operator . 170))
nil
- ((aggregate . 153)(attribute_reference . 51)(factor . 155)(name .
156)(primary . 159)(qualified_expression . 54)(raise_expression . 160)(relation
. 608)(selected_component . 55)(simple_expression . 167)(term . 168)(term_list
. 169)(unary_adding_operator . 170))
nil
nil
+ ((aggregate . 157)(attribute_reference . 51)(factor . 161)(name .
163)(primary . 166)(qualified_expression . 54)(raise_expression . 168)(relation
. 613)(selected_component . 55)(simple_expression . 175)(term . 176)(term_list
. 177)(unary_adding_operator . 178))
nil
- ((multiplying_operator . 359))
+ ((aggregate . 157)(attribute_reference . 51)(factor . 161)(name .
163)(primary . 166)(qualified_expression . 54)(raise_expression . 168)(relation
. 612)(selected_component . 55)(simple_expression . 175)(term . 176)(term_list
. 177)(unary_adding_operator . 178))
nil
nil
+ ((aggregate . 157)(attribute_reference . 51)(factor . 161)(name .
163)(primary . 166)(qualified_expression . 54)(raise_expression . 168)(relation
. 611)(selected_component . 55)(simple_expression . 175)(term . 176)(term_list
. 177)(unary_adding_operator . 178))
nil
+ ((aggregate . 157)(attribute_reference . 51)(factor . 161)(name .
163)(primary . 166)(qualified_expression . 54)(raise_expression . 168)(relation
. 610)(selected_component . 55)(simple_expression . 175)(term . 176)(term_list
. 177)(unary_adding_operator . 178))
nil
- ((aspect_specification_opt . 128))
- ((aliased_opt . 601))
- ((attribute_reference . 51)(name . 598)(qualified_expression .
54)(selected_component . 55))
- ((abstract_subprogram_declaration . 302)(aspect_clause . 303)(at_clause
. 304)(body . 305)(body_stub . 306)(declaration . 307)(declarations .
308)(declarative_part_opt . 597)(entry_declaration .
310)(enumeration_representation_clause . 311)(exception_declaration .
312)(expression_function_declaration . 313)(full_type_declaration .
314)(function_specification . 16)(generic_declaration .
315)(generic_formal_part . 18)(generic_instantiation .
316)(generic_package_declaration . 20)(gen [...]
nil
- ((discriminant_part_opt . 596))
- ((aspect_specification_opt . 595))
nil
+ ((multiplying_operator . 363))
nil
nil
- ((aspect_specification_opt . 591))
nil
nil
- ((attribute_reference . 51)(name . 588)(qualified_expression .
54)(selected_component . 55))
+ ((aspect_specification_opt . 129))
+ ((aliased_opt . 603))
+ ((attribute_reference . 51)(name . 243)(name_opt .
600)(qualified_expression . 54)(selected_component . 55))
+ ((abstract_subprogram_declaration . 306)(aspect_clause . 307)(at_clause
. 308)(body . 309)(body_stub . 310)(declaration . 311)(declarations .
312)(declarative_part_opt . 599)(entry_declaration .
314)(enumeration_representation_clause . 315)(exception_declaration .
316)(expression_function_declaration . 317)(full_type_declaration .
318)(function_specification . 16)(generic_declaration .
319)(generic_formal_part . 18)(generic_instantiation .
320)(generic_package_declaration . 20)(gen [...]
nil
+ ((access_definition . 597)(null_exclusion_opt . 598))
+ ((discriminant_part_opt . 595))
nil
nil
+ ((aspect_specification_opt . 592))
nil
- ((actual_parameter_part . 91))
- ((access_definition . 583)(null_exclusion_opt . 584))
nil
nil
- ((actual_parameter_part . 91))
+ ((aspect_specification_opt . 588))
+ ((attribute_reference . 51)(name . 587)(qualified_expression .
54)(selected_component . 55))
nil
- ((relational_operator . 577))
nil
nil
- ((aggregate . 153)(attribute_reference . 51)(choice_relation .
581)(factor . 155)(name . 156)(primary . 159)(qualified_expression .
54)(selected_component . 55)(simple_expression . 451)(term . 168)(term_list .
169)(unary_adding_operator . 170))
- ((aggregate . 153)(attribute_reference . 51)(choice_relation .
580)(factor . 155)(name . 156)(primary . 159)(qualified_expression .
54)(selected_component . 55)(simple_expression . 451)(term . 168)(term_list .
169)(unary_adding_operator . 170))
nil
- ((aggregate . 153)(attribute_reference . 51)(choice_relation .
579)(factor . 155)(name . 156)(primary . 159)(qualified_expression .
54)(selected_component . 55)(simple_expression . 451)(term . 168)(term_list .
169)(unary_adding_operator . 170))
+ ((actual_parameter_part . 92))
+ ((actual_parameter_part . 92))
nil
- ((aggregate . 153)(attribute_reference . 51)(choice_relation .
578)(factor . 155)(name . 156)(primary . 159)(qualified_expression .
54)(selected_component . 55)(simple_expression . 451)(term . 168)(term_list .
169)(unary_adding_operator . 170))
nil
nil
+ ((relational_operator . 579))
nil
nil
- ((relational_operator . 577))
+ ((aggregate . 157)(attribute_reference . 51)(choice_relation .
583)(factor . 161)(name . 163)(primary . 166)(qualified_expression .
54)(selected_component . 55)(simple_expression . 462)(term . 176)(term_list .
177)(unary_adding_operator . 178))
+ ((aggregate . 157)(attribute_reference . 51)(choice_relation .
582)(factor . 161)(name . 163)(primary . 166)(qualified_expression .
54)(selected_component . 55)(simple_expression . 462)(term . 176)(term_list .
177)(unary_adding_operator . 178))
nil
+ ((aggregate . 157)(attribute_reference . 51)(choice_relation .
581)(factor . 161)(name . 163)(primary . 166)(qualified_expression .
54)(selected_component . 55)(simple_expression . 462)(term . 176)(term_list .
177)(unary_adding_operator . 178))
nil
- ((aggregate . 153)(attribute_reference . 51)(factor .
155)(membership_choice_list . 575)(membership_choice . 469)(name . 189)(primary
. 159)(qualified_expression . 54)(range . 470)(selected_component .
55)(simple_expression . 471)(term . 168)(term_list . 169)(unary_adding_operator
. 170))
+ ((aggregate . 157)(attribute_reference . 51)(choice_relation .
580)(factor . 161)(name . 163)(primary . 166)(qualified_expression .
54)(selected_component . 55)(simple_expression . 462)(term . 176)(term_list .
177)(unary_adding_operator . 178))
nil
nil
nil
nil
+ ((relational_operator . 579))
nil
nil
nil
+ ((aggregate . 157)(attribute_reference . 51)(factor .
161)(membership_choice_list . 577)(membership_choice . 481)(name . 197)(primary
. 166)(qualified_expression . 54)(range . 482)(selected_component .
55)(simple_expression . 483)(term . 176)(term_list . 177)(unary_adding_operator
. 178))
nil
nil
nil
nil
- ((access_definition . 566)(attribute_reference . 51)(name .
567)(null_exclusion_opt . 215)(null_exclusion_opt_name_type .
568)(qualified_expression . 54)(selected_component . 569))
- ((discriminant_specification_opt . 563)(identifier_list . 261))
nil
nil
nil
@@ -3618,65 +3642,64 @@
nil
nil
nil
+ ((access_definition . 568)(attribute_reference . 51)(name .
569)(null_exclusion_opt . 517)(null_exclusion_opt_name_type .
570)(qualified_expression . 54)(selected_component . 571))
nil
+ ((discriminant_specification_opt . 565)(identifier_list . 263))
nil
nil
nil
nil
nil
- ((aspect_specification_opt . 550))
nil
nil
nil
nil
nil
- ((aspect_specification_opt . 545))
nil
nil
nil
+ ((aspect_specification_opt . 552))
nil
- ((aspect_specification_opt . 542))
- ((attribute_reference . 51)(name . 541)(qualified_expression .
54)(selected_component . 55))
- ((actual_parameter_part . 91)(aspect_specification_opt . 540))
- ((aggregate . 153)(attribute_reference . 51)(expression . 538)(factor .
155)(name . 156)(primary . 159)(qualified_expression . 54)(raise_expression .
160)(relation_and_list . 161)(relation_and_then_list . 162)(relation_or_list .
163)(relation_or_else_list . 164)(relation_xor_list . 165)(relation .
166)(selected_component . 55)(simple_expression . 167)(term . 168)(term_list .
169)(unary_adding_operator . 170))
nil
nil
nil
nil
+ ((aspect_specification_opt . 547))
nil
- ((attribute_reference . 51)(name . 536)(qualified_expression .
54)(selected_component . 55))
nil
nil
- ((access_definition . 532)(mode_opt . 533)(null_exclusion_opt . 215))
nil
nil
- ((aggregate . 153)(association_opt . 176)(association_list .
531)(attribute_reference . 51)(choice_expression .
178)(choice_relation_and_list . 179)(choice_relation_or_list .
180)(choice_relation_xor_list . 181)(choice_relation_and_then_list .
182)(choice_relation_or_else_list . 183)(choice_relation . 184)(discrete_choice
. 185)(discrete_choice_list . 186)(expression . 187)(expression_opt .
188)(factor . 155)(name . 189)(primary . 159)(qualified_expression .
54)(raise_expression . [...]
+ ((aspect_specification_opt . 544))
+ ((attribute_reference . 51)(name . 543)(qualified_expression .
54)(selected_component . 55))
+ ((actual_parameter_part . 92)(aspect_specification_opt . 542))
+ ((aggregate . 157)(attribute_reference . 51)(expression . 540)(factor .
161)(name . 163)(primary . 166)(qualified_expression . 54)(raise_expression .
168)(relation_and_list . 169)(relation_and_then_list . 170)(relation_or_list .
171)(relation_or_else_list . 172)(relation_xor_list . 173)(relation .
174)(selected_component . 55)(simple_expression . 175)(term . 176)(term_list .
177)(unary_adding_operator . 178))
nil
nil
nil
nil
nil
- ((case_expression_alternative . 796)(case_expression_alternative_list .
797))
- ((aggregate . 153)(attribute_reference . 51)(expression . 794)(factor .
155)(name . 156)(primary . 159)(qualified_expression . 54)(raise_expression .
160)(relation_and_list . 161)(relation_and_then_list . 162)(relation_or_list .
163)(relation_or_else_list . 164)(relation_xor_list . 165)(relation .
166)(selected_component . 55)(simple_expression . 167)(term . 168)(term_list .
169)(unary_adding_operator . 170))
+ ((attribute_reference . 51)(name . 538)(qualified_expression .
54)(selected_component . 55))
nil
nil
+ ((access_definition . 534)(mode_opt . 535)(null_exclusion_opt . 517))
nil
nil
- ((null_exclusion_opt . 790))
- ((formal_part . 92)(parameter_and_result_profile . 789))
- ((formal_part . 116)(parameter_profile_opt . 788))
- ((actual_parameter_part . 91))
+ ((null_exclusion_opt . 811))
+ ((formal_part . 93)(parameter_and_result_profile . 810))
+ ((formal_part . 117)(parameter_profile_opt . 809))
+ ((actual_parameter_part . 92))
nil
- ((aspect_specification_opt . 786))
- ((aggregate . 153)(attribute_reference . 51)(expression . 785)(factor .
155)(name . 156)(primary . 159)(qualified_expression . 54)(raise_expression .
160)(relation_and_list . 161)(relation_and_then_list . 162)(relation_or_list .
163)(relation_or_else_list . 164)(relation_xor_list . 165)(relation .
166)(selected_component . 55)(simple_expression . 167)(term . 168)(term_list .
169)(unary_adding_operator . 170))
+ ((aspect_specification_opt . 807))
+ ((aggregate . 157)(attribute_reference . 51)(expression . 806)(factor .
161)(name . 163)(primary . 166)(qualified_expression . 54)(raise_expression .
168)(relation_and_list . 169)(relation_and_then_list . 170)(relation_or_list .
171)(relation_or_else_list . 172)(relation_xor_list . 173)(relation .
174)(selected_component . 55)(simple_expression . 175)(term . 176)(term_list .
177)(unary_adding_operator . 178))
nil
- ((actual_parameter_part . 91)(formal_package_actual_part . 783))
+ ((actual_parameter_part . 92)(formal_package_actual_part . 804))
nil
nil
nil
nil
nil
- ((attribute_reference . 51)(name . 779)(qualified_expression .
54)(selected_component . 55))
+ ((attribute_reference . 51)(name . 800)(qualified_expression .
54)(selected_component . 55))
nil
nil
nil
@@ -3688,7 +3711,7 @@
nil
nil
nil
- ((aggregate . 153)(attribute_reference . 51)(discrete_subtype_definition
. 764)(discrete_subtype_definition_list . 765)(factor .
155)(index_subtype_definition . 766)(index_subtype_definition_list . 767)(name
. 768)(primary . 159)(qualified_expression . 54)(range .
769)(selected_component . 55)(simple_expression . 770)(subtype_indication .
771)(term . 168)(term_list . 169)(unary_adding_operator . 170))
+ ((aggregate . 157)(attribute_reference . 51)(discrete_subtype_definition
. 788)(discrete_subtype_definition_list . 789)(factor .
161)(index_subtype_definition . 790)(index_subtype_definition_list . 791)(name
. 792)(primary . 166)(qualified_expression . 54)(range .
738)(selected_component . 55)(simple_expression . 487)(subtype_indication .
739)(term . 176)(term_list . 177)(unary_adding_operator . 178))
nil
nil
nil
@@ -3696,79 +3719,84 @@
nil
nil
nil
- ((actual_parameter_part . 91))
+ ((actual_parameter_part . 92))
nil
nil
nil
nil
nil
nil
- ((aggregate . 153)(attribute_reference . 51)(factor .
155)(membership_choice . 758)(name . 189)(primary . 159)(qualified_expression .
54)(range . 470)(selected_component . 55)(simple_expression . 471)(term .
168)(term_list . 169)(unary_adding_operator . 170))
+ ((aggregate . 157)(attribute_reference . 51)(factor .
161)(membership_choice . 783)(name . 197)(primary . 166)(qualified_expression .
54)(range . 482)(selected_component . 55)(simple_expression . 483)(term .
176)(term_list . 177)(unary_adding_operator . 178))
nil
- ((aggregate . 153)(attribute_reference . 51)(expression . 757)(factor .
155)(name . 156)(primary . 159)(qualified_expression . 54)(raise_expression .
160)(relation_and_list . 161)(relation_and_then_list . 162)(relation_or_list .
163)(relation_or_else_list . 164)(relation_xor_list . 165)(relation .
166)(selected_component . 55)(simple_expression . 167)(term . 168)(term_list .
169)(unary_adding_operator . 170))
- ((aggregate . 153)(attribute_reference . 51)(factor . 155)(name .
156)(primary . 159)(qualified_expression . 54)(selected_component .
55)(simple_expression . 756)(term . 168)(term_list . 169)(unary_adding_operator
. 170))
+ ((aggregate . 157)(attribute_reference . 51)(expression . 782)(factor .
161)(name . 163)(primary . 166)(qualified_expression . 54)(raise_expression .
168)(relation_and_list . 169)(relation_and_then_list . 170)(relation_or_list .
171)(relation_or_else_list . 172)(relation_xor_list . 173)(relation .
174)(selected_component . 55)(simple_expression . 175)(term . 176)(term_list .
177)(unary_adding_operator . 178))
+ ((aggregate . 157)(attribute_reference . 51)(factor . 161)(name .
163)(primary . 166)(qualified_expression . 54)(selected_component .
55)(simple_expression . 781)(term . 176)(term_list . 177)(unary_adding_operator
. 178))
nil
nil
nil
nil
+ ((aggregate . 779)(record_rep . 780))
nil
+ ((aggregate . 157)(attribute_reference . 51)(expression . 776)(factor .
161)(name . 163)(primary . 166)(qualified_expression . 54)(raise_expression .
168)(relation_and_list . 169)(relation_and_then_list . 170)(relation_or_list .
171)(relation_or_else_list . 172)(relation_xor_list . 173)(relation .
174)(selected_component . 55)(simple_expression . 175)(term . 176)(term_list .
177)(unary_adding_operator . 178))
+ ((actual_parameter_part . 92)(aspect_specification_opt . 179))
nil
- ((attribute_reference . 51)(name . 753)(qualified_expression .
54)(selected_component . 55))
- ((aggregate . 751)(record_rep . 752))
+ ((discriminant_part_opt . 773))
+ ((aspect_specification_opt . 726))
+ ((attribute_reference . 51)(name . 730)(qualified_expression .
54)(selected_component . 55)(subtype_indication . 771))
nil
- ((aggregate . 153)(attribute_reference . 51)(expression . 748)(factor .
155)(name . 156)(primary . 159)(qualified_expression . 54)(raise_expression .
160)(relation_and_list . 161)(relation_and_then_list . 162)(relation_or_list .
163)(relation_or_else_list . 164)(relation_xor_list . 165)(relation .
166)(selected_component . 55)(simple_expression . 167)(term . 168)(term_list .
169)(unary_adding_operator . 170))
- ((actual_parameter_part . 91)(aspect_specification_opt . 171))
- ((discriminant_part_opt . 746))
- ((aspect_specification_opt . 715))
+ ((discriminant_part_opt . 768))
+ ((aspect_specification_opt . 725))
nil
- ((attribute_reference . 51)(name . 742)(qualified_expression .
54)(selected_component . 55)(subtype_indication . 743))
- ((discriminant_part_opt . 740))
- ((aspect_specification_opt . 714))
nil
nil
+ ((attribute_reference . 51)(name . 762)(qualified_expression .
54)(selected_component . 55))
nil
- ((actual_parameter_part . 91))
nil
nil
- ((constant_opt . 731))
nil
+ ((constant_opt . 758))
nil
- ((paren_expression . 726))
- ((formal_part . 116)(parameter_profile_opt . 724))
- ((accept_statement . 638)(assignment_statement .
639)(asynchronous_select . 640)(attribute_reference . 51)(block_statement .
641)(case_statement . 642)(conditional_entry_call . 643)(delay_statement .
644)(exit_statement . 645)(extended_return_statement .
646)(handled_sequence_of_statements . 722)(if_statement . 648)(iteration_scheme
. 649)(label_opt . 650)(loop_statement . 651)(name . 652)(pragma .
653)(procedure_call_statement . 654)(qualified_expression . 54)(raise_statement
. 65 [...]
- ((attribute_reference . 51)(name . 213)(name_opt .
721)(qualified_expression . 54)(selected_component . 55))
nil
+ ((paren_expression . 753))
+ ((formal_part . 117)(parameter_profile_opt . 751))
+ ((accept_statement . 649)(assignment_statement .
650)(asynchronous_select . 651)(attribute_reference . 51)(block_statement .
652)(case_statement . 653)(conditional_entry_call . 654)(delay_statement .
655)(exit_statement . 656)(extended_return_statement .
657)(handled_sequence_of_statements . 749)(if_statement . 659)(iteration_scheme
. 660)(label_opt . 661)(loop_statement . 662)(name . 663)(pragma .
664)(procedure_call_statement . 665)(qualified_expression . 54)(raise_statement
. 66 [...]
+ ((attribute_reference . 51)(name . 243)(name_opt .
748)(qualified_expression . 54)(selected_component . 55))
nil
nil
nil
nil
+ ((aggregate . 157)(attribute_reference . 51)(expression . 747)(factor .
161)(name . 163)(primary . 166)(qualified_expression . 54)(raise_expression .
168)(relation_and_list . 169)(relation_and_then_list . 170)(relation_or_list .
171)(relation_or_else_list . 172)(relation_xor_list . 173)(relation .
174)(selected_component . 55)(simple_expression . 175)(term . 176)(term_list .
177)(unary_adding_operator . 178))
nil
nil
- ((aggregate . 153)(attribute_reference . 51)(expression . 716)(factor .
155)(name . 156)(primary . 159)(qualified_expression . 54)(raise_expression .
160)(relation_and_list . 161)(relation_and_then_list . 162)(relation_or_list .
163)(relation_or_else_list . 164)(relation_xor_list . 165)(relation .
166)(selected_component . 55)(simple_expression . 167)(term . 168)(term_list .
169)(unary_adding_operator . 170))
- ((aspect_specification_opt . 715))
- ((aspect_specification_opt . 714))
nil
nil
+ ((elsif_expression_item . 743)(elsif_expression_list . 744))
+ ((aggregate . 157)(attribute_reference . 51)(expression . 740)(factor .
161)(name . 163)(primary . 166)(qualified_expression . 54)(raise_expression .
168)(relation_and_list . 169)(relation_and_then_list . 170)(relation_or_list .
171)(relation_or_else_list . 172)(relation_xor_list . 173)(relation .
174)(selected_component . 55)(simple_expression . 175)(term . 176)(term_list .
177)(unary_adding_operator . 178))
+ ((aggregate . 157)(attribute_reference . 51)(discrete_subtype_definition
. 736)(factor . 161)(name . 737)(primary . 166)(qualified_expression .
54)(range . 738)(selected_component . 55)(simple_expression .
487)(subtype_indication . 739)(term . 176)(term_list .
177)(unary_adding_operator . 178))
+ ((attribute_reference . 51)(name . 733)(qualified_expression .
54)(selected_component . 55))
+ ((attribute_reference . 51)(name . 730)(qualified_expression .
54)(selected_component . 55)(subtype_indication . 731))
+ ((aggregate . 157)(attribute_reference . 51)(choice_expression .
186)(choice_relation_and_list . 187)(choice_relation_or_list .
188)(choice_relation_xor_list . 189)(choice_relation_and_then_list .
190)(choice_relation_or_else_list . 191)(choice_relation . 192)(discrete_choice
. 193)(discrete_choice_list . 728)(factor . 161)(name . 197)(primary .
166)(qualified_expression . 54)(range . 198)(selected_component .
55)(simple_expression . 475)(term . 176)(term_list . 177)(unary_adding_o [...]
nil
nil
- ((attribute_reference . 51)(name . 710)(qualified_expression .
54)(selected_component . 55))
- ((accept_statement . 638)(assignment_statement .
639)(asynchronous_select . 640)(attribute_reference . 51)(block_statement .
641)(case_statement . 642)(conditional_entry_call . 643)(delay_statement .
644)(exit_statement . 645)(extended_return_statement .
646)(handled_sequence_of_statements . 709)(if_statement . 648)(iteration_scheme
. 649)(label_opt . 650)(loop_statement . 651)(name . 652)(pragma .
653)(procedure_call_statement . 654)(qualified_expression . 54)(raise_statement
. 65 [...]
- ((aggregate . 153)(attribute_reference . 51)(expression .
187)(expression_opt . 708)(factor . 155)(name . 156)(primary .
159)(qualified_expression . 54)(raise_expression . 160)(relation_and_list .
161)(relation_and_then_list . 162)(relation_or_list .
163)(relation_or_else_list . 164)(relation_xor_list . 165)(relation .
166)(selected_component . 55)(simple_expression . 167)(term . 168)(term_list .
169)(unary_adding_operator . 170))
- ((abstract_subprogram_declaration . 302)(aspect_clause . 303)(at_clause
. 304)(body . 305)(body_stub . 306)(declaration . 307)(declarations .
308)(declarative_part_opt . 707)(entry_declaration .
310)(enumeration_representation_clause . 311)(exception_declaration .
312)(expression_function_declaration . 313)(full_type_declaration .
314)(function_specification . 16)(generic_declaration .
315)(generic_formal_part . 18)(generic_instantiation .
316)(generic_package_declaration . 20)(gen [...]
- ((aggregate . 153)(attribute_reference . 51)(expression . 706)(factor .
155)(name . 156)(primary . 159)(qualified_expression . 54)(raise_expression .
160)(relation_and_list . 161)(relation_and_then_list . 162)(relation_or_list .
163)(relation_or_else_list . 164)(relation_xor_list . 165)(relation .
166)(selected_component . 55)(simple_expression . 167)(term . 168)(term_list .
169)(unary_adding_operator . 170))
- ((identifier_opt . 704))
- ((iterator_specification . 701)(iterator_specification_opt . 702))
+ ((aspect_specification_opt . 726))
+ ((aspect_specification_opt . 725))
nil
- ((aggregate . 153)(attribute_reference . 51)(expression .
187)(expression_opt . 699)(factor . 155)(name . 156)(primary .
159)(qualified_expression . 54)(raise_expression . 160)(relation_and_list .
161)(relation_and_then_list . 162)(relation_or_list .
163)(relation_or_else_list . 164)(relation_xor_list . 165)(relation .
166)(selected_component . 55)(simple_expression . 167)(term . 168)(term_list .
169)(unary_adding_operator . 170))
- ((accept_statement . 638)(assignment_statement .
639)(asynchronous_select . 640)(attribute_reference . 51)(block_statement .
641)(case_statement . 642)(conditional_entry_call . 643)(delay_statement .
644)(exit_statement . 645)(extended_return_statement . 646)(if_statement .
648)(iteration_scheme . 649)(label_opt . 650)(loop_statement . 651)(name .
652)(pragma . 653)(procedure_call_statement . 654)(qualified_expression .
54)(raise_statement . 655)(requeue_statement . 656)(selected_c [...]
nil
- ((attribute_reference . 51)(name . 696)(qualified_expression .
54)(selected_component . 55))
- ((attribute_reference . 51)(name . 694)(qualified_expression .
54)(selected_component . 55))
- ((aggregate . 153)(attribute_reference . 51)(expression .
691)(extended_return_object_declaration .
692)(extended_return_object_declaration_opt . 693)(factor . 155)(name .
156)(primary . 159)(qualified_expression . 54)(raise_expression .
160)(relation_and_list . 161)(relation_and_then_list . 162)(relation_or_list .
163)(relation_or_else_list . 164)(relation_xor_list . 165)(relation .
166)(selected_component . 55)(simple_expression . 167)(term . 168)(term_list .
169)(unary_adding_op [...]
- ((accept_statement . 679)(attribute_reference . 51)(delay_alternative .
680)(delay_statement . 681)(entry_call_alternative . 682)(name .
683)(procedure_call_statement . 684)(qualified_expression .
54)(selected_component . 55)(select_alternative . 685)(select_alternative_list
. 686)(select_alternative_list_opt . 687)(triggering_alternative . 688))
- ((aggregate . 153)(attribute_reference . 51)(expression .
187)(expression_opt . 676)(factor . 155)(name . 156)(primary .
159)(qualified_expression . 54)(raise_expression . 160)(relation_and_list .
161)(relation_and_then_list . 162)(relation_or_list .
163)(relation_or_else_list . 164)(relation_xor_list . 165)(relation .
166)(selected_component . 55)(simple_expression . 167)(term . 168)(term_list .
169)(unary_adding_operator . 170))
+ ((attribute_reference . 51)(name . 723)(qualified_expression .
54)(selected_component . 55))
+ ((accept_statement . 649)(assignment_statement .
650)(asynchronous_select . 651)(attribute_reference . 51)(block_statement .
652)(case_statement . 653)(conditional_entry_call . 654)(delay_statement .
655)(exit_statement . 656)(extended_return_statement .
657)(handled_sequence_of_statements . 722)(if_statement . 659)(iteration_scheme
. 660)(label_opt . 661)(loop_statement . 662)(name . 663)(pragma .
664)(procedure_call_statement . 665)(qualified_expression . 54)(raise_statement
. 66 [...]
+ ((aggregate . 157)(attribute_reference . 51)(expression .
195)(expression_opt . 721)(factor . 161)(name . 163)(primary .
166)(qualified_expression . 54)(raise_expression . 168)(relation_and_list .
169)(relation_and_then_list . 170)(relation_or_list .
171)(relation_or_else_list . 172)(relation_xor_list . 173)(relation .
174)(selected_component . 55)(simple_expression . 175)(term . 176)(term_list .
177)(unary_adding_operator . 178))
+ ((abstract_subprogram_declaration . 306)(aspect_clause . 307)(at_clause
. 308)(body . 309)(body_stub . 310)(declaration . 311)(declarations .
312)(declarative_part_opt . 720)(entry_declaration .
314)(enumeration_representation_clause . 315)(exception_declaration .
316)(expression_function_declaration . 317)(full_type_declaration .
318)(function_specification . 16)(generic_declaration .
319)(generic_formal_part . 18)(generic_instantiation .
320)(generic_package_declaration . 20)(gen [...]
+ ((aggregate . 157)(attribute_reference . 51)(expression . 719)(factor .
161)(name . 163)(primary . 166)(qualified_expression . 54)(raise_expression .
168)(relation_and_list . 169)(relation_and_then_list . 170)(relation_or_list .
171)(relation_or_else_list . 172)(relation_xor_list . 173)(relation .
174)(selected_component . 55)(simple_expression . 175)(term . 176)(term_list .
177)(unary_adding_operator . 178))
+ ((identifier_opt . 717))
+ ((iterator_specification . 714)(iterator_specification_opt . 715))
nil
+ ((aggregate . 157)(attribute_reference . 51)(expression .
195)(expression_opt . 712)(factor . 161)(name . 163)(primary .
166)(qualified_expression . 54)(raise_expression . 168)(relation_and_list .
169)(relation_and_then_list . 170)(relation_or_list .
171)(relation_or_else_list . 172)(relation_xor_list . 173)(relation .
174)(selected_component . 55)(simple_expression . 175)(term . 176)(term_list .
177)(unary_adding_operator . 178))
+ ((accept_statement . 649)(assignment_statement .
650)(asynchronous_select . 651)(attribute_reference . 51)(block_statement .
652)(case_statement . 653)(conditional_entry_call . 654)(delay_statement .
655)(exit_statement . 656)(extended_return_statement . 657)(if_statement .
659)(iteration_scheme . 660)(label_opt . 661)(loop_statement . 662)(name .
663)(pragma . 664)(procedure_call_statement . 665)(qualified_expression .
54)(raise_statement . 666)(requeue_statement . 667)(selected_c [...]
nil
+ ((attribute_reference . 51)(name . 709)(qualified_expression .
54)(selected_component . 55))
+ ((attribute_reference . 51)(name . 707)(qualified_expression .
54)(selected_component . 55))
+ ((aggregate . 157)(attribute_reference . 51)(expression .
704)(extended_return_object_declaration .
705)(extended_return_object_declaration_opt . 706)(factor . 161)(name .
163)(primary . 166)(qualified_expression . 54)(raise_expression .
168)(relation_and_list . 169)(relation_and_then_list . 170)(relation_or_list .
171)(relation_or_else_list . 172)(relation_xor_list . 173)(relation .
174)(selected_component . 55)(simple_expression . 175)(term . 176)(term_list .
177)(unary_adding_op [...]
+ ((accept_statement . 692)(attribute_reference . 51)(delay_alternative .
693)(delay_statement . 694)(entry_call_alternative . 695)(name .
696)(procedure_call_statement . 697)(qualified_expression .
54)(selected_component . 55)(select_alternative . 698)(select_alternative_list
. 699)(select_alternative_list_opt . 700)(triggering_alternative . 701))
+ ((aggregate . 157)(attribute_reference . 51)(expression .
195)(expression_opt . 689)(factor . 161)(name . 163)(primary .
166)(qualified_expression . 54)(raise_expression . 168)(relation_and_list .
169)(relation_and_then_list . 170)(relation_or_list .
171)(relation_or_else_list . 172)(relation_xor_list . 173)(relation .
174)(selected_component . 55)(simple_expression . 175)(term . 176)(term_list .
177)(unary_adding_operator . 178))
nil
nil
nil
@@ -3779,444 +3807,440 @@
nil
nil
nil
- ((accept_statement . 638)(assignment_statement .
639)(asynchronous_select . 640)(attribute_reference . 51)(block_statement .
641)(case_statement . 642)(compound_statement . 672)(conditional_entry_call .
643)(delay_statement . 644)(exit_statement . 645)(extended_return_statement .
646)(if_statement . 648)(iteration_scheme . 649)(loop_statement . 651)(name .
652)(pragma . 653)(procedure_call_statement . 654)(qualified_expression .
54)(raise_statement . 655)(requeue_statement . 656)(s [...]
nil
- ((actual_parameter_part . 91))
nil
nil
nil
+ ((accept_statement . 649)(assignment_statement .
650)(asynchronous_select . 651)(attribute_reference . 51)(block_statement .
652)(case_statement . 653)(compound_statement . 683)(conditional_entry_call .
654)(delay_statement . 655)(exit_statement . 656)(extended_return_statement .
657)(if_statement . 659)(iteration_scheme . 660)(loop_statement . 662)(name .
663)(pragma . 664)(procedure_call_statement . 665)(qualified_expression .
54)(raise_statement . 666)(requeue_statement . 667)(s [...]
nil
+ ((actual_parameter_part . 92))
nil
nil
- ((accept_statement . 638)(assignment_statement .
639)(asynchronous_select . 640)(attribute_reference . 51)(block_statement .
641)(case_statement . 642)(conditional_entry_call . 643)(delay_statement .
644)(exit_statement . 645)(extended_return_statement . 646)(if_statement .
648)(iteration_scheme . 649)(label_opt . 650)(loop_statement . 651)(name .
652)(pragma . 653)(procedure_call_statement . 654)(qualified_expression .
54)(raise_statement . 655)(requeue_statement . 656)(selected_c [...]
nil
nil
nil
nil
+ ((accept_statement . 649)(assignment_statement .
650)(asynchronous_select . 651)(attribute_reference . 51)(block_statement .
652)(case_statement . 653)(conditional_entry_call . 654)(delay_statement .
655)(exit_statement . 656)(extended_return_statement . 657)(if_statement .
659)(iteration_scheme . 660)(label_opt . 661)(loop_statement . 662)(name .
663)(pragma . 664)(procedure_call_statement . 665)(qualified_expression .
54)(raise_statement . 666)(requeue_statement . 667)(selected_c [...]
nil
nil
nil
nil
- ((exception_handler . 941)(exception_handler_list .
942)(exception_handler_list_opt . 943))
nil
- ((aggregate . 153)(attribute_reference . 51)(expression . 939)(factor .
155)(name . 156)(primary . 159)(qualified_expression . 54)(raise_expression .
160)(relation_and_list . 161)(relation_and_then_list . 162)(relation_or_list .
163)(relation_or_else_list . 164)(relation_xor_list . 165)(relation .
166)(selected_component . 55)(simple_expression . 167)(term . 168)(term_list .
169)(unary_adding_operator . 170))
nil
nil
nil
- ((accept_statement . 638)(assignment_statement .
639)(asynchronous_select . 640)(attribute_reference . 51)(block_statement .
641)(case_statement . 642)(conditional_entry_call . 643)(delay_statement .
644)(exit_statement . 645)(extended_return_statement . 646)(if_statement .
648)(iteration_scheme . 649)(label_opt . 650)(loop_statement . 651)(name .
652)(pragma . 653)(procedure_call_statement . 654)(qualified_expression .
54)(raise_statement . 655)(requeue_statement . 656)(selected_c [...]
- ((attribute_reference . 51)(name . 213)(name_opt .
937)(qualified_expression . 54)(selected_component . 55))
+ ((exception_handler . 951)(exception_handler_list .
952)(exception_handler_list_opt . 953))
nil
+ ((aggregate . 157)(attribute_reference . 51)(expression . 949)(factor .
161)(name . 163)(primary . 166)(qualified_expression . 54)(raise_expression .
168)(relation_and_list . 169)(relation_and_then_list . 170)(relation_or_list .
171)(relation_or_else_list . 172)(relation_xor_list . 173)(relation .
174)(selected_component . 55)(simple_expression . 175)(term . 176)(term_list .
177)(unary_adding_operator . 178))
nil
- ((aggregate . 153)(attribute_reference . 51)(expression . 935)(factor .
155)(name . 156)(primary . 159)(qualified_expression . 54)(raise_expression .
160)(relation_and_list . 161)(relation_and_then_list . 162)(relation_or_list .
163)(relation_or_else_list . 164)(relation_xor_list . 165)(relation .
166)(selected_component . 55)(simple_expression . 167)(term . 168)(term_list .
169)(unary_adding_operator . 170))
- ((accept_statement . 638)(assignment_statement .
639)(asynchronous_select . 640)(attribute_reference . 51)(block_statement .
641)(case_statement . 642)(conditional_entry_call . 643)(delay_statement .
644)(exit_statement . 645)(extended_return_statement . 646)(if_statement .
648)(iteration_scheme . 649)(label_opt . 650)(loop_statement . 651)(name .
652)(pragma . 653)(procedure_call_statement . 654)(qualified_expression .
54)(raise_statement . 655)(requeue_statement . 656)(selected_c [...]
nil
- ((accept_statement . 638)(assignment_statement .
639)(asynchronous_select . 640)(attribute_reference . 51)(block_statement .
641)(case_statement . 642)(conditional_entry_call . 643)(delay_statement .
644)(exit_statement . 645)(extended_return_statement . 646)(if_statement .
648)(iteration_scheme . 649)(label_opt . 650)(loop_statement . 651)(name .
652)(pragma . 653)(procedure_call_statement . 654)(qualified_expression .
54)(raise_statement . 655)(requeue_statement . 656)(selected_c [...]
nil
- ((accept_statement . 638)(actual_parameter_part .
91)(assignment_statement . 639)(asynchronous_select . 640)(attribute_reference
. 51)(block_statement . 641)(case_statement . 642)(conditional_entry_call .
643)(delay_statement . 644)(exit_statement . 645)(extended_return_statement .
646)(if_statement . 648)(iteration_scheme . 649)(label_opt .
650)(loop_statement . 651)(name . 652)(pragma . 653)(procedure_call_statement .
654)(qualified_expression . 54)(raise_statement . 655)(requeue [...]
- ((accept_statement . 638)(assignment_statement .
639)(asynchronous_select . 640)(attribute_reference . 51)(block_statement .
641)(case_statement . 642)(conditional_entry_call . 643)(delay_statement .
644)(exit_statement . 645)(extended_return_statement . 646)(if_statement .
648)(iteration_scheme . 649)(label_opt . 650)(loop_statement . 651)(name .
652)(pragma . 653)(procedure_call_statement . 654)(qualified_expression .
54)(raise_statement . 655)(requeue_statement . 656)(selected_c [...]
+ ((accept_statement . 649)(assignment_statement .
650)(asynchronous_select . 651)(attribute_reference . 51)(block_statement .
652)(case_statement . 653)(conditional_entry_call . 654)(delay_statement .
655)(exit_statement . 656)(extended_return_statement . 657)(if_statement .
659)(iteration_scheme . 660)(label_opt . 661)(loop_statement . 662)(name .
663)(pragma . 664)(procedure_call_statement . 665)(qualified_expression .
54)(raise_statement . 666)(requeue_statement . 667)(selected_c [...]
+ ((attribute_reference . 51)(name . 243)(name_opt .
947)(qualified_expression . 54)(selected_component . 55))
nil
nil
nil
nil
+ ((aggregate . 157)(attribute_reference . 51)(expression . 944)(factor .
161)(name . 163)(primary . 166)(qualified_expression . 54)(raise_expression .
168)(relation_and_list . 169)(relation_and_then_list . 170)(relation_or_list .
171)(relation_or_else_list . 172)(relation_xor_list . 173)(relation .
174)(selected_component . 55)(simple_expression . 175)(term . 176)(term_list .
177)(unary_adding_operator . 178))
+ ((accept_statement . 649)(assignment_statement .
650)(asynchronous_select . 651)(attribute_reference . 51)(block_statement .
652)(case_statement . 653)(conditional_entry_call . 654)(delay_statement .
655)(exit_statement . 656)(extended_return_statement . 657)(if_statement .
659)(iteration_scheme . 660)(label_opt . 661)(loop_statement . 662)(name .
663)(pragma . 664)(procedure_call_statement . 665)(qualified_expression .
54)(raise_statement . 666)(requeue_statement . 667)(selected_c [...]
nil
+ ((accept_statement . 649)(assignment_statement .
650)(asynchronous_select . 651)(attribute_reference . 51)(block_statement .
652)(case_statement . 653)(conditional_entry_call . 654)(delay_statement .
655)(exit_statement . 656)(extended_return_statement . 657)(if_statement .
659)(iteration_scheme . 660)(label_opt . 661)(loop_statement . 662)(name .
663)(pragma . 664)(procedure_call_statement . 665)(qualified_expression .
54)(raise_statement . 666)(requeue_statement . 667)(selected_c [...]
nil
+ ((accept_statement . 649)(actual_parameter_part .
92)(assignment_statement . 650)(asynchronous_select . 651)(attribute_reference
. 51)(block_statement . 652)(case_statement . 653)(conditional_entry_call .
654)(delay_statement . 655)(exit_statement . 656)(extended_return_statement .
657)(if_statement . 659)(iteration_scheme . 660)(label_opt .
661)(loop_statement . 662)(name . 663)(pragma . 664)(procedure_call_statement .
665)(qualified_expression . 54)(raise_statement . 666)(requeue [...]
+ ((accept_statement . 649)(assignment_statement .
650)(asynchronous_select . 651)(attribute_reference . 51)(block_statement .
652)(case_statement . 653)(conditional_entry_call . 654)(delay_statement .
655)(exit_statement . 656)(extended_return_statement . 657)(if_statement .
659)(iteration_scheme . 660)(label_opt . 661)(loop_statement . 662)(name .
663)(pragma . 664)(procedure_call_statement . 665)(qualified_expression .
54)(raise_statement . 666)(requeue_statement . 667)(selected_c [...]
nil
nil
nil
- ((actual_parameter_part . 91))
nil
- ((actual_parameter_part . 91))
nil
nil
nil
nil
nil
+ ((actual_parameter_part . 92))
nil
+ ((actual_parameter_part . 92))
nil
nil
- ((aggregate . 153)(attribute_reference . 51)(expression . 911)(factor .
155)(name . 156)(primary . 159)(qualified_expression . 54)(raise_expression .
160)(relation_and_list . 161)(relation_and_then_list . 162)(relation_or_list .
163)(relation_or_else_list . 164)(relation_xor_list . 165)(relation .
166)(selected_component . 55)(simple_expression . 167)(term . 168)(term_list .
169)(unary_adding_operator . 170))
nil
nil
nil
nil
- ((actual_parameter_part . 91))
- ((actual_parameter_part . 904)(actual_parameter_part_opt . 905))
nil
nil
+ ((aggregate . 157)(attribute_reference . 51)(expression . 920)(factor .
161)(name . 163)(primary . 166)(qualified_expression . 54)(raise_expression .
168)(relation_and_list . 169)(relation_and_then_list . 170)(relation_or_list .
171)(relation_or_else_list . 172)(relation_xor_list . 173)(relation .
174)(selected_component . 55)(simple_expression . 175)(term . 176)(term_list .
177)(unary_adding_operator . 178))
nil
nil
nil
- ((aggregate . 153)(attribute_reference . 51)(expression . 899)(factor .
155)(name . 156)(primary . 159)(qualified_expression . 54)(raise_expression .
160)(relation_and_list . 161)(relation_and_then_list . 162)(relation_or_list .
163)(relation_or_else_list . 164)(relation_xor_list . 165)(relation .
166)(selected_component . 55)(simple_expression . 167)(term . 168)(term_list .
169)(unary_adding_operator . 170))
- ((attribute_reference . 51)(name . 742)(qualified_expression .
54)(selected_component . 55)(subtype_indication . 898))
- ((aggregate . 153)(attribute_reference . 51)(discrete_subtype_definition
. 897)(factor . 155)(name . 891)(primary . 159)(qualified_expression .
54)(range . 769)(selected_component . 55)(simple_expression .
770)(subtype_indication . 771)(term . 168)(term_list .
169)(unary_adding_operator . 170))
- ((attribute_reference . 51)(name . 895)(qualified_expression .
54)(selected_component . 55))
nil
+ ((actual_parameter_part . 92))
+ ((actual_parameter_part . 913)(actual_parameter_part_opt . 914))
nil
- ((aggregate . 153)(attribute_reference . 51)(discrete_subtype_definition
. 890)(factor . 155)(identifier_list . 217)(name . 891)(parameter_specification
. 218)(parameter_specification_list . 219)(primary . 159)(qualified_expression
. 54)(range . 769)(selected_component . 55)(simple_expression .
770)(subtype_indication . 771)(term . 168)(term_list .
169)(unary_adding_operator . 170))
- ((aspect_specification_opt . 889))
- ((aggregate . 153)(attribute_reference . 51)(case_expression .
886)(expression . 887)(factor . 155)(if_expression . 888)(name . 156)(primary .
159)(qualified_expression . 54)(raise_expression . 160)(relation_and_list .
161)(relation_and_then_list . 162)(relation_or_list .
163)(relation_or_else_list . 164)(relation_xor_list . 165)(relation .
166)(selected_component . 55)(simple_expression . 167)(term . 168)(term_list .
169)(unary_adding_operator . 170))
- ((aspect_specification_opt . 885))
- ((aspect_specification_opt . 884))
- ((aspect_specification_opt . 883))
- ((aspect_specification_opt . 882))
nil
- ((access_definition . 879)(array_type_definition .
880)(attribute_reference . 51)(name . 742)(null_exclusion_opt .
215)(qualified_expression . 54)(selected_component . 55)(subtype_indication .
881))
+ ((case_expression_alternative . 909))
nil
- ((aggregate . 153)(attribute_reference . 51)(expression . 877)(factor .
155)(name . 156)(primary . 159)(qualified_expression . 54)(raise_expression .
160)(relation_and_list . 161)(relation_and_then_list . 162)(relation_or_list .
163)(relation_or_else_list . 164)(relation_xor_list . 165)(relation .
166)(selected_component . 55)(simple_expression . 167)(term . 168)(term_list .
169)(unary_adding_operator . 170))
- ((attribute_reference . 51)(name . 213)(name_opt .
876)(qualified_expression . 54)(selected_component . 55))
nil
- ((abstract_limited_synchronized_opt . 866)(abstract_limited_opt .
867)(abstract_tagged_limited_opt . 868)(access_definition .
869)(array_type_definition . 870)(derived_type_definition .
871)(enumeration_type_definition . 872)(interface_type_definition .
873)(null_exclusion_opt . 215)(record_type_definition . 874)(type_definition .
875))
+ ((actual_parameter_part . 92)(constraint . 829)(index_constraint . 830))
nil
- ((abstract_subprogram_declaration . 302)(aspect_clause . 303)(at_clause
. 304)(body . 305)(body_stub . 306)(declaration . 307)(declarations .
308)(declarative_part_opt . 854)(entry_declaration .
310)(enumeration_representation_clause . 311)(exception_declaration .
312)(expression_function_declaration . 313)(full_type_declaration .
314)(function_specification . 16)(generic_declaration .
315)(generic_formal_part . 18)(generic_instantiation .
316)(generic_package_declaration . 20)(gen [...]
+ ((attribute_reference . 51)(name . 905)(qualified_expression .
54)(selected_component . 55))
+ ((actual_parameter_part . 92))
+ ((aggregate . 157)(attribute_reference . 51)(name . 163)(primary .
298)(qualified_expression . 54)(selected_component . 55))
+ ((aggregate . 157)(attribute_reference . 51)(discrete_subtype_definition
. 903)(factor . 161)(name . 737)(primary . 166)(qualified_expression .
54)(range . 738)(selected_component . 55)(simple_expression .
487)(subtype_indication . 739)(term . 176)(term_list .
177)(unary_adding_operator . 178))
nil
- ((aspect_specification_opt . 851))
+ ((actual_parameter_part . 92)(constraint . 829)(index_constraint . 830))
nil
- ((actual_parameter_part . 91)(constraint . 821)(index_constraint . 822))
- ((aspect_specification_opt . 848))
- ((abstract_subprogram_declaration . 302)(aspect_clause . 303)(at_clause
. 304)(body . 305)(body_stub . 306)(declaration . 307)(declarations .
308)(declarative_part_opt . 846)(entry_declaration .
310)(enumeration_representation_clause . 311)(exception_declaration .
312)(expression_function_declaration . 313)(full_type_declaration .
314)(function_specification . 16)(generic_declaration .
315)(generic_formal_part . 18)(generic_instantiation .
316)(generic_package_declaration . 20)(gen [...]
nil
- ((aspect_specification_opt . 843))
nil
+ ((aggregate . 157)(attribute_reference . 51)(expression . 901)(factor .
161)(name . 163)(primary . 166)(qualified_expression . 54)(raise_expression .
168)(relation_and_list . 169)(relation_and_then_list . 170)(relation_or_list .
171)(relation_or_else_list . 172)(relation_xor_list . 173)(relation .
174)(selected_component . 55)(simple_expression . 175)(term . 176)(term_list .
177)(unary_adding_operator . 178))
+ ((aggregate . 157)(attribute_reference . 51)(expression . 900)(factor .
161)(name . 163)(primary . 166)(qualified_expression . 54)(raise_expression .
168)(relation_and_list . 169)(relation_and_then_list . 170)(relation_or_list .
171)(relation_or_else_list . 172)(relation_xor_list . 173)(relation .
174)(selected_component . 55)(simple_expression . 175)(term . 176)(term_list .
177)(unary_adding_operator . 178))
nil
- ((aggregate . 153)(attribute_reference . 51)(expression . 840)(factor .
155)(name . 156)(primary . 159)(qualified_expression . 54)(raise_expression .
160)(relation_and_list . 161)(relation_and_then_list . 162)(relation_or_list .
163)(relation_or_else_list . 164)(relation_xor_list . 165)(relation .
166)(selected_component . 55)(simple_expression . 167)(term . 168)(term_list .
169)(unary_adding_operator . 170))
- ((mod_clause_opt . 839))
+ ((elsif_expression_item . 899))
nil
nil
- ((actual_parameter_part . 91))
- ((attribute_reference . 51)(name . 834)(qualified_expression .
54)(selected_component . 55))
- ((attribute_reference . 51)(name . 833)(qualified_expression .
54)(selected_component . 55))
nil
nil
nil
- ((aggregate . 153)(attribute_reference . 51)(expression . 831)(factor .
155)(name . 156)(primary . 159)(qualified_expression . 54)(raise_expression .
160)(relation_and_list . 161)(relation_and_then_list . 162)(relation_or_list .
163)(relation_or_else_list . 164)(relation_xor_list . 165)(relation .
166)(selected_component . 55)(simple_expression . 167)(term . 168)(term_list .
169)(unary_adding_operator . 170))
- ((aggregate . 153)(attribute_reference . 51)(expression . 830)(factor .
155)(name . 156)(primary . 159)(qualified_expression . 54)(raise_expression .
160)(relation_and_list . 161)(relation_and_then_list . 162)(relation_or_list .
163)(relation_or_else_list . 164)(relation_xor_list . 165)(relation .
166)(selected_component . 55)(simple_expression . 167)(term . 168)(term_list .
169)(unary_adding_operator . 170))
- ((attribute_reference . 51)(name . 567)(qualified_expression .
54)(selected_component . 829))
+ ((aggregate . 157)(attribute_reference . 51)(discrete_subtype_definition
. 894)(factor . 161)(identifier_list . 236)(name . 737)(parameter_specification
. 237)(parameter_specification_list . 238)(primary . 166)(qualified_expression
. 54)(range . 738)(selected_component . 55)(simple_expression .
487)(subtype_indication . 739)(term . 176)(term_list .
177)(unary_adding_operator . 178))
+ ((aspect_specification_opt . 893))
+ ((aggregate . 157)(attribute_reference . 51)(case_expression .
158)(conditional_quantified_expression . 891)(expression . 892)(factor .
161)(if_expression . 162)(name . 163)(primary . 166)(qualified_expression .
54)(quantified_expression . 167)(raise_expression . 168)(relation_and_list .
169)(relation_and_then_list . 170)(relation_or_list .
171)(relation_or_else_list . 172)(relation_xor_list . 173)(relation .
174)(selected_component . 55)(simple_expression . 175)(term . 176)(term_l [...]
+ ((aspect_specification_opt . 890))
+ ((aspect_specification_opt . 889))
+ ((aspect_specification_opt . 888))
+ ((aspect_specification_opt . 887))
nil
- ((aggregate . 153)(attribute_reference . 51)(name . 156)(primary .
293)(qualified_expression . 54)(selected_component . 55))
+ ((access_definition . 884)(array_type_definition .
885)(attribute_reference . 51)(name . 730)(null_exclusion_opt .
517)(qualified_expression . 54)(selected_component . 55)(subtype_indication .
886))
nil
+ ((aggregate . 157)(attribute_reference . 51)(expression . 882)(factor .
161)(name . 163)(primary . 166)(qualified_expression . 54)(raise_expression .
168)(relation_and_list . 169)(relation_and_then_list . 170)(relation_or_list .
171)(relation_or_else_list . 172)(relation_xor_list . 173)(relation .
174)(selected_component . 55)(simple_expression . 175)(term . 176)(term_list .
177)(unary_adding_operator . 178))
+ ((attribute_reference . 51)(name . 243)(name_opt .
881)(qualified_expression . 54)(selected_component . 55))
+ ((actual_parameter_part . 92))
+ ((attribute_reference . 51)(name . 879)(qualified_expression .
54)(selected_component . 55))
+ ((attribute_reference . 51)(name . 878)(qualified_expression .
54)(selected_component . 55))
+ ((abstract_limited_synchronized_opt . 868)(abstract_limited_opt .
869)(abstract_tagged_limited_opt . 870)(access_definition .
871)(array_type_definition . 872)(derived_type_definition .
873)(enumeration_type_definition . 874)(interface_type_definition .
875)(null_exclusion_opt . 517)(record_type_definition . 876)(type_definition .
877))
nil
nil
+ ((aspect_specification_opt . 856))
+ ((abstract_subprogram_declaration . 306)(aspect_clause . 307)(at_clause
. 308)(body . 309)(body_stub . 310)(declaration . 311)(declarations .
312)(declarative_part_opt . 854)(entry_declaration .
314)(enumeration_representation_clause . 315)(exception_declaration .
316)(expression_function_declaration . 317)(full_type_declaration .
318)(function_specification . 16)(generic_declaration .
319)(generic_formal_part . 18)(generic_instantiation .
320)(generic_package_declaration . 20)(gen [...]
nil
- ((actual_parameter_part . 91)(constraint . 821)(index_constraint . 822))
+ ((aspect_specification_opt . 852))
nil
+ ((aspect_specification_opt . 850))
+ ((abstract_subprogram_declaration . 306)(aspect_clause . 307)(at_clause
. 308)(body . 309)(body_stub . 310)(declaration . 311)(declarations .
312)(declarative_part_opt . 848)(entry_declaration .
314)(enumeration_representation_clause . 315)(exception_declaration .
316)(expression_function_declaration . 317)(full_type_declaration .
318)(function_specification . 16)(generic_declaration .
319)(generic_formal_part . 18)(generic_instantiation .
320)(generic_package_declaration . 20)(gen [...]
nil
nil
+ ((aggregate . 157)(attribute_reference . 51)(expression . 844)(factor .
161)(name . 163)(primary . 166)(qualified_expression . 54)(raise_expression .
168)(relation_and_list . 169)(relation_and_then_list . 170)(relation_or_list .
171)(relation_or_else_list . 172)(relation_xor_list . 173)(relation .
174)(selected_component . 55)(simple_expression . 175)(term . 176)(term_list .
177)(unary_adding_operator . 178))
+ ((mod_clause_opt . 843))
nil
nil
- ((attribute_reference . 51)(interface_list . 817)(name .
814)(qualified_expression . 54)(selected_component . 55))
- ((attribute_reference . 51)(interface_list . 816)(name .
814)(qualified_expression . 54)(selected_component . 55))
- ((attribute_reference . 51)(interface_list . 815)(name .
814)(qualified_expression . 54)(selected_component . 55))
nil
- ((attribute_reference . 51)(interface_list . 813)(name .
814)(qualified_expression . 54)(selected_component . 55))
- ((actual_parameter_part . 91)(and_interface_list_opt . 812))
nil
nil
- ((aggregate . 153)(association_opt . 176)(association_list .
193)(attribute_reference . 51)(choice_expression .
178)(choice_relation_and_list . 179)(choice_relation_or_list .
180)(choice_relation_xor_list . 181)(choice_relation_and_then_list .
182)(choice_relation_or_else_list . 183)(choice_relation . 184)(discrete_choice
. 185)(discrete_choice_list . 186)(expression . 187)(expression_opt .
188)(factor . 155)(name . 189)(primary . 159)(qualified_expression .
54)(raise_expression . [...]
- ((aspect_specification_opt . 809))
+ ((aggregate . 157)(attribute_reference . 51)(expression . 838)(factor .
161)(name . 163)(primary . 166)(qualified_expression . 54)(raise_expression .
168)(relation_and_list . 169)(relation_and_then_list . 170)(relation_or_list .
171)(relation_or_else_list . 172)(relation_xor_list . 173)(relation .
174)(selected_component . 55)(simple_expression . 175)(term . 176)(term_list .
177)(unary_adding_operator . 178))
+ ((aggregate . 157)(attribute_reference . 51)(expression . 837)(factor .
161)(name . 163)(primary . 166)(qualified_expression . 54)(raise_expression .
168)(relation_and_list . 169)(relation_and_then_list . 170)(relation_or_list .
171)(relation_or_else_list . 172)(relation_xor_list . 173)(relation .
174)(selected_component . 55)(simple_expression . 175)(term . 176)(term_list .
177)(unary_adding_operator . 178))
+ ((attribute_reference . 51)(name . 569)(qualified_expression .
54)(selected_component . 836))
nil
- ((aspect_specification_opt . 808))
nil
- ((identifier_list . 217)(parameter_specification .
218)(parameter_specification_list . 219))
nil
nil
- ((attribute_reference . 51)(name . 806)(qualified_expression .
54)(selected_component . 55))
- ((aggregate . 153)(attribute_reference . 51)(expression . 805)(factor .
155)(name . 156)(primary . 159)(qualified_expression . 54)(raise_expression .
160)(relation_and_list . 161)(relation_and_then_list . 162)(relation_or_list .
163)(relation_or_else_list . 164)(relation_xor_list . 165)(relation .
166)(selected_component . 55)(simple_expression . 167)(term . 168)(term_list .
169)(unary_adding_operator . 170))
nil
+ ((actual_parameter_part . 92)(constraint . 829)(index_constraint . 830))
nil
- ((elsif_expression_item . 802)(elsif_expression_list . 803))
- ((aggregate . 153)(attribute_reference . 51)(choice_expression .
178)(choice_relation_and_list . 179)(choice_relation_or_list .
180)(choice_relation_xor_list . 181)(choice_relation_and_then_list .
182)(choice_relation_or_else_list . 183)(choice_relation . 184)(discrete_choice
. 185)(discrete_choice_list . 799)(factor . 155)(name . 189)(primary .
159)(qualified_expression . 54)(range . 190)(selected_component .
55)(simple_expression . 464)(term . 168)(term_list . 169)(unary_adding_o [...]
nil
+ ((attribute_reference . 51)(interface_list . 825)(name .
822)(qualified_expression . 54)(selected_component . 55))
+ ((attribute_reference . 51)(interface_list . 824)(name .
822)(qualified_expression . 54)(selected_component . 55))
+ ((attribute_reference . 51)(interface_list . 823)(name .
822)(qualified_expression . 54)(selected_component . 55))
nil
- ((case_expression_alternative . 1077))
+ ((attribute_reference . 51)(interface_list . 821)(name .
822)(qualified_expression . 54)(selected_component . 55))
+ ((actual_parameter_part . 92)(and_interface_list_opt . 820))
nil
- ((aggregate . 153)(attribute_reference . 51)(expression . 1075)(factor .
155)(name . 156)(primary . 159)(qualified_expression . 54)(raise_expression .
160)(relation_and_list . 161)(relation_and_then_list . 162)(relation_or_list .
163)(relation_or_else_list . 164)(relation_xor_list . 165)(relation .
166)(selected_component . 55)(simple_expression . 167)(term . 168)(term_list .
169)(unary_adding_operator . 170))
- ((aggregate . 153)(attribute_reference . 51)(expression . 1074)(factor .
155)(name . 156)(primary . 159)(qualified_expression . 54)(raise_expression .
160)(relation_and_list . 161)(relation_and_then_list . 162)(relation_or_list .
163)(relation_or_else_list . 164)(relation_xor_list . 165)(relation .
166)(selected_component . 55)(simple_expression . 167)(term . 168)(term_list .
169)(unary_adding_operator . 170))
nil
- ((elsif_expression_item . 1073))
+ ((aggregate . 157)(association_opt . 184)(association_list .
201)(attribute_reference . 51)(case_expression . 158)(choice_expression .
186)(choice_relation_and_list . 187)(choice_relation_or_list .
188)(choice_relation_xor_list . 189)(choice_relation_and_then_list .
190)(choice_relation_or_else_list . 191)(choice_relation .
192)(conditional_quantified_expression . 202)(discrete_choice .
193)(discrete_choice_list . 194)(expression . 195)(expression_opt . 196)(factor
. 161)(if_expres [...]
+ ((aspect_specification_opt . 817))
nil
+ ((aspect_specification_opt . 816))
nil
- ((actual_parameter_part . 91))
+ ((identifier_list . 236)(parameter_specification .
237)(parameter_specification_list . 238))
nil
nil
+ ((attribute_reference . 51)(name . 814)(qualified_expression .
54)(selected_component . 55))
+ ((aggregate . 157)(attribute_reference . 51)(expression . 813)(factor .
161)(name . 163)(primary . 166)(qualified_expression . 54)(raise_expression .
168)(relation_and_list . 169)(relation_and_then_list . 170)(relation_or_list .
171)(relation_or_else_list . 172)(relation_xor_list . 173)(relation .
174)(selected_component . 55)(simple_expression . 175)(term . 176)(term_list .
177)(unary_adding_operator . 178))
nil
+ ((actual_parameter_part . 92))
nil
- ((attribute_reference . 51)(interface_list . 1067)(name .
814)(qualified_expression . 54)(selected_component . 55))
nil
nil
- ((actual_parameter_part . 91))
nil
+ ((attribute_reference . 51)(interface_list . 1080)(name .
822)(qualified_expression . 54)(selected_component . 55))
nil
nil
+ ((actual_parameter_part . 92))
nil
- ((aggregate . 153)(association_opt . 176)(association_list .
193)(attribute_reference . 51)(choice_expression .
178)(choice_relation_and_list . 179)(choice_relation_or_list .
180)(choice_relation_xor_list . 181)(choice_relation_and_then_list .
182)(choice_relation_or_else_list . 183)(choice_relation . 184)(discrete_choice
. 185)(discrete_choice_list . 186)(discrete_subtype_definition .
764)(discrete_subtype_definition_list . 1063)(expression . 187)(expression_opt
. 188)(factor . 15 [...]
- ((aggregate . 153)(attribute_reference . 51)(factor . 155)(name .
189)(primary . 159)(qualified_expression . 54)(range . 1039)(selected_component
. 55)(simple_expression . 770)(term . 168)(term_list .
169)(unary_adding_operator . 170))
nil
nil
- ((attribute_reference . 51)(index_subtype_definition . 1059)(name .
1060)(qualified_expression . 54)(selected_component . 55))
nil
- ((aggregate . 153)(attribute_reference . 51)(discrete_subtype_definition
. 1057)(factor . 155)(name . 891)(primary . 159)(qualified_expression .
54)(range . 769)(selected_component . 55)(simple_expression .
770)(subtype_indication . 771)(term . 168)(term_list .
169)(unary_adding_operator . 170))
+ ((aggregate . 157)(association_opt . 184)(association_list .
201)(attribute_reference . 51)(case_expression . 158)(choice_expression .
186)(choice_relation_and_list . 187)(choice_relation_or_list .
188)(choice_relation_xor_list . 189)(choice_relation_and_then_list .
190)(choice_relation_or_else_list . 191)(choice_relation .
192)(conditional_quantified_expression . 202)(discrete_choice .
193)(discrete_choice_list . 194)(discrete_subtype_definition .
788)(discrete_subtype_definition_ [...]
+ ((aggregate . 157)(attribute_reference . 51)(factor . 161)(name .
197)(primary . 166)(qualified_expression . 54)(range . 1001)(selected_component
. 55)(simple_expression . 487)(term . 176)(term_list .
177)(unary_adding_operator . 178))
nil
- ((attribute_reference . 51)(name . 1038)(qualified_expression .
54)(selected_component . 55))
nil
nil
+ ((attribute_reference . 51)(index_subtype_definition . 1071)(name .
1072)(qualified_expression . 54)(selected_component . 55))
nil
+ ((aggregate . 157)(attribute_reference . 51)(discrete_subtype_definition
. 1069)(factor . 161)(name . 737)(primary . 166)(qualified_expression .
54)(range . 738)(selected_component . 55)(simple_expression .
487)(subtype_indication . 739)(term . 176)(term_list .
177)(unary_adding_operator . 178))
nil
nil
- ((actual_parameter_part . 91)(aspect_specification_opt . 1055))
- ((actual_parameter_part . 91)(aspect_specification_opt . 1054))
- ((attribute_reference . 51)(name . 1053)(qualified_expression .
54)(selected_component . 55))
nil
nil
nil
- ((component_clause . 1050)(component_clause_list . 1051))
nil
nil
- ((aspect_specification_opt . 1047))
nil
- ((aspect_specification_opt . 1045))
- ((attribute_reference . 51)(interface_list . 1044)(name .
814)(qualified_expression . 54)(selected_component . 55))
+ ((component_clause . 1066)(component_clause_list . 1067))
nil
nil
+ ((aspect_specification_opt . 1063))
+ ((attribute_reference . 51)(interface_list . 1062)(name .
822)(qualified_expression . 54)(selected_component . 55))
nil
- ((aggregate . 153)(attribute_reference . 51)(factor . 155)(name .
189)(primary . 159)(qualified_expression . 54)(range . 1039)(selected_component
. 55)(simple_expression . 770)(term . 168)(term_list .
169)(unary_adding_operator . 170))
- ((attribute_reference . 51)(name . 1038)(qualified_expression .
54)(selected_component . 55))
nil
- ((aspect_specification_opt . 1035))
- ((attribute_reference . 51)(interface_list . 1034)(name .
814)(qualified_expression . 54)(selected_component . 55))
nil
+ ((aspect_specification_opt . 1057))
nil
+ ((attribute_reference . 51)(interface_list . 1055)(name .
822)(qualified_expression . 54)(selected_component . 55))
nil
- ((aggregate . 153)(attribute_reference . 51)(expression . 1029)(factor .
155)(name . 156)(primary . 159)(qualified_expression . 54)(raise_expression .
160)(relation_and_list . 161)(relation_and_then_list . 162)(relation_or_list .
163)(relation_or_else_list . 164)(relation_xor_list . 165)(relation .
166)(selected_component . 55)(simple_expression . 167)(term . 168)(term_list .
169)(unary_adding_operator . 170))
- ((aggregate . 153)(attribute_reference . 51)(expression . 1028)(factor .
155)(name . 156)(primary . 159)(qualified_expression . 54)(raise_expression .
160)(relation_and_list . 161)(relation_and_then_list . 162)(relation_or_list .
163)(relation_or_else_list . 164)(relation_xor_list . 165)(relation .
166)(selected_component . 55)(simple_expression . 167)(term . 168)(term_list .
169)(unary_adding_operator . 170))
- ((enumeration_literal . 1026)(enumeration_literal_list . 1027))
nil
- ((aggregate . 153)(attribute_reference . 51)(expression . 1023)(factor .
155)(name . 156)(primary . 159)(qualified_expression . 54)(raise_expression .
160)(relation_and_list . 161)(relation_and_then_list . 162)(relation_or_list .
163)(relation_or_else_list . 164)(relation_xor_list . 165)(relation .
166)(selected_component . 55)(simple_expression . 167)(term . 168)(term_list .
169)(unary_adding_operator . 170))
nil
- ((aggregate . 153)(attribute_reference . 51)(factor . 155)(name .
156)(primary . 159)(qualified_expression . 54)(selected_component .
55)(simple_expression . 1021)(term . 168)(term_list .
169)(unary_adding_operator . 170))
- ((aspect_clause . 1014)(at_clause . 304)(component_declaration .
1015)(component_item . 1016)(component_list . 1017)(component_list_opt .
1018)(enumeration_representation_clause . 311)(identifier_list .
1019)(record_representation_clause . 335)(variant_part . 1020))
+ ((aspect_specification_opt . 1049))
nil
+ ((aggregate . 157)(attribute_reference . 51)(expression . 1047)(factor .
161)(name . 163)(primary . 166)(qualified_expression . 54)(raise_expression .
168)(relation_and_list . 169)(relation_and_then_list . 170)(relation_or_list .
171)(relation_or_else_list . 172)(relation_xor_list . 173)(relation .
174)(selected_component . 55)(simple_expression . 175)(term . 176)(term_list .
177)(unary_adding_operator . 178))
+ ((aggregate . 157)(attribute_reference . 51)(expression . 1046)(factor .
161)(name . 163)(primary . 166)(qualified_expression . 54)(raise_expression .
168)(relation_and_list . 169)(relation_and_then_list . 170)(relation_or_list .
171)(relation_or_else_list . 172)(relation_xor_list . 173)(relation .
174)(selected_component . 55)(simple_expression . 175)(term . 176)(term_list .
177)(unary_adding_operator . 178))
+ ((enumeration_literal . 1044)(enumeration_literal_list . 1045))
nil
+ ((aggregate . 157)(attribute_reference . 51)(expression . 1041)(factor .
161)(name . 163)(primary . 166)(qualified_expression . 54)(raise_expression .
168)(relation_and_list . 169)(relation_and_then_list . 170)(relation_or_list .
171)(relation_or_else_list . 172)(relation_xor_list . 173)(relation .
174)(selected_component . 55)(simple_expression . 175)(term . 176)(term_list .
177)(unary_adding_operator . 178))
nil
- ((record_definition . 1008))
+ ((aggregate . 157)(attribute_reference . 51)(factor . 161)(name .
163)(primary . 166)(qualified_expression . 54)(selected_component .
55)(simple_expression . 1039)(term . 176)(term_list .
177)(unary_adding_operator . 178))
+ ((aspect_clause . 1032)(at_clause . 308)(component_declaration .
1033)(component_item . 1034)(component_list . 1035)(component_list_opt .
1036)(enumeration_representation_clause . 315)(identifier_list .
1037)(record_representation_clause . 339)(variant_part . 1038))
nil
nil
nil
+ ((record_definition . 1026))
nil
nil
nil
- ((aspect_specification_opt . 1006))
nil
nil
nil
- ((aspect_specification_opt . 1003))
- ((aspect_specification_opt . 1001))
- ((aspect_specification_opt . 999))
+ ((aspect_specification_opt . 1024))
+ ((actual_parameter_part . 92)(aspect_specification_opt . 1023))
+ ((actual_parameter_part . 92)(aspect_specification_opt . 1022))
+ ((attribute_reference . 51)(name . 1021)(qualified_expression .
54)(selected_component . 55))
nil
nil
nil
+ ((aspect_specification_opt . 1018))
+ ((aspect_specification_opt . 1016))
+ ((aspect_specification_opt . 1014))
nil
nil
nil
nil
nil
nil
- ((actual_parameter_part . 91)(constraint . 821)(index_constraint . 822))
- ((attribute_reference . 51)(name . 213)(name_opt .
988)(qualified_expression . 54)(selected_component . 55))
nil
- ((attribute_reference . 51)(name . 987)(qualified_expression .
54)(selected_component . 55))
- ((actual_parameter_part . 91))
- ((aggregate . 153)(attribute_reference . 51)(discrete_subtype_definition
. 986)(factor . 155)(name . 891)(primary . 159)(qualified_expression .
54)(range . 769)(selected_component . 55)(simple_expression .
770)(subtype_indication . 771)(term . 168)(term_list .
169)(unary_adding_operator . 170))
nil
+ ((attribute_reference . 51)(name . 243)(name_opt .
1004)(qualified_expression . 54)(selected_component . 55))
nil
nil
- ((aspect_clause . 977)(at_clause . 304)(entry_body .
978)(enumeration_representation_clause . 311)(function_specification .
16)(overriding_indicator_opt . 979)(procedure_specification .
32)(protected_operation_item . 980)(protected_operation_item_list .
981)(protected_operation_item_list_opt . 982)(record_representation_clause .
335)(subprogram_body . 983)(subprogram_declaration . 984))
- ((abstract_subprogram_declaration . 302)(aspect_clause . 303)(at_clause
. 304)(body . 305)(body_stub . 306)(declaration . 307)(declarations .
308)(declarative_part_opt . 975)(entry_declaration .
310)(enumeration_representation_clause . 311)(exception_declaration .
312)(expression_function_declaration . 313)(full_type_declaration .
314)(function_specification . 16)(generic_declaration .
315)(generic_formal_part . 18)(generic_instantiation .
316)(generic_package_declaration . 20)(gen [...]
+ ((aggregate . 157)(attribute_reference . 51)(expression . 1003)(factor .
161)(name . 163)(primary . 166)(qualified_expression . 54)(raise_expression .
168)(relation_and_list . 169)(relation_and_then_list . 170)(relation_or_list .
171)(relation_or_else_list . 172)(relation_xor_list . 173)(relation .
174)(selected_component . 55)(simple_expression . 175)(term . 176)(term_list .
177)(unary_adding_operator . 178))
nil
- ((aggregate . 153)(association_opt . 176)(association_list .
193)(attribute_reference . 51)(choice_expression .
178)(choice_relation_and_list . 179)(choice_relation_or_list .
180)(choice_relation_xor_list . 181)(choice_relation_and_then_list .
182)(choice_relation_or_else_list . 183)(choice_relation . 184)(discrete_choice
. 185)(discrete_choice_list . 186)(expression . 187)(expression_opt .
188)(factor . 155)(name . 189)(primary . 159)(qualified_expression .
54)(raise_expression . [...]
nil
- ((formal_part . 116)(parameter_profile_opt . 974))
nil
- ((identifier_opt . 973))
- ((case_statement_alternative . 971)(case_statement_alternative_list .
972))
- ((accept_statement . 638)(assignment_statement .
639)(asynchronous_select . 640)(attribute_reference . 51)(block_statement .
641)(case_statement . 642)(conditional_entry_call . 643)(delay_statement .
644)(exit_statement . 645)(extended_return_statement .
646)(handled_sequence_of_statements . 969)(if_statement . 648)(iteration_scheme
. 649)(label_opt . 650)(loop_statement . 651)(name . 652)(pragma .
653)(procedure_call_statement . 654)(qualified_expression . 54)(raise_statement
. 65 [...]
+ ((aggregate . 157)(attribute_reference . 51)(factor . 161)(name .
197)(primary . 166)(qualified_expression . 54)(range . 1001)(selected_component
. 55)(simple_expression . 487)(term . 176)(term_list .
177)(unary_adding_operator . 178))
nil
+ ((attribute_reference . 51)(name . 998)(qualified_expression .
54)(selected_component . 55))
+ ((actual_parameter_part . 92))
+ ((attribute_reference . 51)(name . 1000)(qualified_expression .
54)(selected_component . 55))
+ ((attribute_reference . 51)(name . 998)(qualified_expression .
54)(selected_component . 55))
+ ((aggregate . 157)(attribute_reference . 51)(expression . 997)(factor .
161)(name . 163)(primary . 166)(qualified_expression . 54)(raise_expression .
168)(relation_and_list . 169)(relation_and_then_list . 170)(relation_or_list .
171)(relation_or_else_list . 172)(relation_xor_list . 173)(relation .
174)(selected_component . 55)(simple_expression . 175)(term . 176)(term_list .
177)(unary_adding_operator . 178))
nil
+ ((aspect_clause . 987)(at_clause . 308)(entry_body .
988)(enumeration_representation_clause . 315)(expression_function_declaration .
989)(function_specification . 16)(null_procedure_declaration .
990)(overriding_indicator_opt . 991)(procedure_specification .
32)(protected_operation_item . 992)(protected_operation_item_list .
993)(protected_operation_item_list_opt . 994)(record_representation_clause .
339)(subprogram_body . 995)(subprogram_declaration . 996))
+ ((abstract_subprogram_declaration . 306)(aspect_clause . 307)(at_clause
. 308)(body . 309)(body_stub . 310)(declaration . 311)(declarations .
312)(declarative_part_opt . 985)(entry_declaration .
314)(enumeration_representation_clause . 315)(exception_declaration .
316)(expression_function_declaration . 317)(full_type_declaration .
318)(function_specification . 16)(generic_declaration .
319)(generic_formal_part . 18)(generic_instantiation .
320)(generic_package_declaration . 20)(gen [...]
+ ((aggregate . 157)(association_opt . 184)(association_list .
201)(attribute_reference . 51)(case_expression . 158)(choice_expression .
186)(choice_relation_and_list . 187)(choice_relation_or_list .
188)(choice_relation_xor_list . 189)(choice_relation_and_then_list .
190)(choice_relation_or_else_list . 191)(choice_relation .
192)(conditional_quantified_expression . 202)(discrete_choice .
193)(discrete_choice_list . 194)(expression . 195)(expression_opt . 196)(factor
. 161)(if_expres [...]
nil
- ((aggregate . 153)(attribute_reference . 51)(expression .
187)(expression_opt . 967)(factor . 155)(name . 156)(primary .
159)(qualified_expression . 54)(raise_expression . 160)(relation_and_list .
161)(relation_and_then_list . 162)(relation_or_list .
163)(relation_or_else_list . 164)(relation_xor_list . 165)(relation .
166)(selected_component . 55)(simple_expression . 167)(term . 168)(term_list .
169)(unary_adding_operator . 170))
+ ((formal_part . 117)(parameter_profile_opt . 984))
nil
- ((accept_statement . 638)(assignment_statement .
639)(asynchronous_select . 640)(attribute_reference . 51)(block_statement .
641)(case_statement . 642)(conditional_entry_call . 643)(delay_statement .
644)(exit_statement . 645)(extended_return_statement . 646)(if_statement .
648)(iteration_scheme . 649)(label_opt . 650)(loop_statement . 651)(name .
652)(pragma . 653)(procedure_call_statement . 654)(qualified_expression .
54)(raise_statement . 655)(requeue_statement . 656)(selected_c [...]
+ ((identifier_opt . 983))
+ ((case_statement_alternative . 981)(case_statement_alternative_list .
982))
+ ((accept_statement . 649)(assignment_statement .
650)(asynchronous_select . 651)(attribute_reference . 51)(block_statement .
652)(case_statement . 653)(conditional_entry_call . 654)(delay_statement .
655)(exit_statement . 656)(extended_return_statement .
657)(handled_sequence_of_statements . 979)(if_statement . 659)(iteration_scheme
. 660)(label_opt . 661)(loop_statement . 662)(name . 663)(pragma .
664)(procedure_call_statement . 665)(qualified_expression . 54)(raise_statement
. 66 [...]
nil
nil
- ((aggregate . 153)(attribute_reference . 51)(expression . 964)(factor .
155)(name . 156)(primary . 159)(qualified_expression . 54)(raise_expression .
160)(relation_and_list . 161)(relation_and_then_list . 162)(relation_or_list .
163)(relation_or_else_list . 164)(relation_xor_list . 165)(relation .
166)(selected_component . 55)(simple_expression . 167)(term . 168)(term_list .
169)(unary_adding_operator . 170))
+ ((aggregate . 157)(attribute_reference . 51)(expression .
195)(expression_opt . 977)(factor . 161)(name . 163)(primary .
166)(qualified_expression . 54)(raise_expression . 168)(relation_and_list .
169)(relation_and_then_list . 170)(relation_or_list .
171)(relation_or_else_list . 172)(relation_xor_list . 173)(relation .
174)(selected_component . 55)(simple_expression . 175)(term . 176)(term_list .
177)(unary_adding_operator . 178))
nil
nil
- ((accept_statement . 638)(assignment_statement .
639)(asynchronous_select . 640)(attribute_reference . 51)(block_statement .
641)(case_statement . 642)(conditional_entry_call . 643)(delay_statement .
644)(exit_statement . 645)(extended_return_statement .
646)(handled_sequence_of_statements . 962)(if_statement . 648)(iteration_scheme
. 649)(label_opt . 650)(loop_statement . 651)(name . 652)(pragma .
653)(procedure_call_statement . 654)(qualified_expression . 54)(raise_statement
. 65 [...]
+ ((accept_statement . 649)(assignment_statement .
650)(asynchronous_select . 651)(attribute_reference . 51)(block_statement .
652)(case_statement . 653)(conditional_entry_call . 654)(delay_statement .
655)(exit_statement . 656)(extended_return_statement . 657)(if_statement .
659)(iteration_scheme . 660)(label_opt . 661)(loop_statement . 662)(name .
663)(pragma . 664)(procedure_call_statement . 665)(qualified_expression .
54)(raise_statement . 666)(requeue_statement . 667)(selected_c [...]
nil
+ ((aggregate . 157)(attribute_reference . 51)(expression . 974)(factor .
161)(name . 163)(primary . 166)(qualified_expression . 54)(raise_expression .
168)(relation_and_list . 169)(relation_and_then_list . 170)(relation_or_list .
171)(relation_or_else_list . 172)(relation_xor_list . 173)(relation .
174)(selected_component . 55)(simple_expression . 175)(term . 176)(term_list .
177)(unary_adding_operator . 178))
nil
- ((aliased_opt . 961))
nil
- ((accept_statement . 638)(assignment_statement .
639)(asynchronous_select . 640)(attribute_reference . 51)(block_statement .
641)(case_statement . 642)(conditional_entry_call . 643)(delay_statement .
644)(exit_statement . 645)(extended_return_statement . 646)(if_statement .
648)(iteration_scheme . 649)(label_opt . 650)(loop_statement . 651)(name .
652)(pragma . 653)(procedure_call_statement . 654)(qualified_expression .
54)(raise_statement . 655)(requeue_statement . 656)(selected_c [...]
nil
- ((accept_statement . 679)(delay_alternative . 680)(delay_statement .
955)(select_alternative . 957))
+ ((accept_statement . 649)(assignment_statement .
650)(asynchronous_select . 651)(attribute_reference . 51)(block_statement .
652)(case_statement . 653)(conditional_entry_call . 654)(delay_statement .
655)(exit_statement . 656)(extended_return_statement .
657)(handled_sequence_of_statements . 972)(if_statement . 659)(iteration_scheme
. 660)(label_opt . 661)(loop_statement . 662)(name . 663)(pragma .
664)(procedure_call_statement . 665)(qualified_expression . 54)(raise_statement
. 66 [...]
nil
nil
- ((accept_statement . 638)(assignment_statement .
639)(asynchronous_select . 640)(attribute_reference . 51)(block_statement .
641)(case_statement . 642)(conditional_entry_call . 643)(delay_statement .
644)(exit_statement . 645)(extended_return_statement . 646)(if_statement .
648)(iteration_scheme . 649)(label_opt . 650)(loop_statement . 651)(name .
652)(pragma . 653)(procedure_call_statement . 654)(qualified_expression .
54)(raise_statement . 655)(requeue_statement . 656)(selected_c [...]
- ((delay_alternative . 954)(delay_statement . 955))
+ ((aliased_opt . 971))
nil
+ ((accept_statement . 649)(assignment_statement .
650)(asynchronous_select . 651)(attribute_reference . 51)(block_statement .
652)(case_statement . 653)(conditional_entry_call . 654)(delay_statement .
655)(exit_statement . 656)(extended_return_statement . 657)(if_statement .
659)(iteration_scheme . 660)(label_opt . 661)(loop_statement . 662)(name .
663)(pragma . 664)(procedure_call_statement . 665)(qualified_expression .
54)(raise_statement . 666)(requeue_statement . 667)(selected_c [...]
nil
+ ((accept_statement . 692)(delay_alternative . 693)(delay_statement .
965)(select_alternative . 967))
nil
nil
+ ((accept_statement . 649)(assignment_statement .
650)(asynchronous_select . 651)(attribute_reference . 51)(block_statement .
652)(case_statement . 653)(conditional_entry_call . 654)(delay_statement .
655)(exit_statement . 656)(extended_return_statement . 657)(if_statement .
659)(iteration_scheme . 660)(label_opt . 661)(loop_statement . 662)(name .
663)(pragma . 664)(procedure_call_statement . 665)(qualified_expression .
54)(raise_statement . 666)(requeue_statement . 667)(selected_c [...]
+ ((delay_alternative . 964)(delay_statement . 965))
nil
nil
nil
- ((attribute_reference . 51)(exception_choice .
947)(exception_choice_list . 948)(name . 949)(qualified_expression .
54)(selected_component . 55))
nil
- ((exception_handler . 944))
nil
nil
nil
nil
+ ((attribute_reference . 51)(exception_choice .
957)(exception_choice_list . 958)(name . 959)(qualified_expression .
54)(selected_component . 55))
nil
+ ((exception_handler . 954))
nil
- ((actual_parameter_part . 91))
nil
nil
nil
- ((accept_statement . 1173)(delay_alternative . 1174)(delay_statement .
955))
nil
- ((accept_statement . 638)(assignment_statement .
639)(asynchronous_select . 640)(attribute_reference . 51)(block_statement .
641)(case_statement . 642)(conditional_entry_call . 643)(delay_statement .
644)(exit_statement . 645)(extended_return_statement . 646)(if_statement .
648)(iteration_scheme . 649)(label_opt . 650)(loop_statement . 651)(name .
652)(pragma . 653)(procedure_call_statement . 654)(qualified_expression .
54)(raise_statement . 655)(requeue_statement . 656)(selected_c [...]
nil
+ ((actual_parameter_part . 92))
nil
nil
nil
- ((accept_statement . 638)(assignment_statement .
639)(asynchronous_select . 640)(attribute_reference . 51)(block_statement .
641)(case_statement . 642)(conditional_entry_call . 643)(delay_statement .
644)(exit_statement . 645)(extended_return_statement . 646)(if_statement .
648)(iteration_scheme . 649)(label_opt . 650)(loop_statement . 651)(name .
652)(pragma . 653)(procedure_call_statement . 654)(qualified_expression .
54)(raise_statement . 655)(requeue_statement . 656)(selected_c [...]
- ((constant_opt . 1165))
+ ((accept_statement . 1177)(delay_alternative . 1178)(delay_statement .
965))
nil
+ ((accept_statement . 649)(assignment_statement .
650)(asynchronous_select . 651)(attribute_reference . 51)(block_statement .
652)(case_statement . 653)(conditional_entry_call . 654)(delay_statement .
655)(exit_statement . 656)(extended_return_statement . 657)(if_statement .
659)(iteration_scheme . 660)(label_opt . 661)(loop_statement . 662)(name .
663)(pragma . 664)(procedure_call_statement . 665)(qualified_expression .
54)(raise_statement . 666)(requeue_statement . 667)(selected_c [...]
nil
nil
- ((identifier_opt . 1161))
- ((elsif_statement_item . 1159)(elsif_statement_list . 1160))
nil
nil
+ ((accept_statement . 649)(assignment_statement .
650)(asynchronous_select . 651)(attribute_reference . 51)(block_statement .
652)(case_statement . 653)(conditional_entry_call . 654)(delay_statement .
655)(exit_statement . 656)(extended_return_statement . 657)(if_statement .
659)(iteration_scheme . 660)(label_opt . 661)(loop_statement . 662)(name .
663)(pragma . 664)(procedure_call_statement . 665)(qualified_expression .
54)(raise_statement . 666)(requeue_statement . 667)(selected_c [...]
+ ((constant_opt . 1169))
nil
- ((aggregate . 153)(attribute_reference . 51)(choice_expression .
178)(choice_relation_and_list . 179)(choice_relation_or_list .
180)(choice_relation_xor_list . 181)(choice_relation_and_then_list .
182)(choice_relation_or_else_list . 183)(choice_relation . 184)(discrete_choice
. 185)(discrete_choice_list . 1153)(factor . 155)(name . 189)(primary .
159)(qualified_expression . 54)(range . 190)(selected_component .
55)(simple_expression . 464)(term . 168)(term_list . 169)(unary_adding_ [...]
nil
- ((case_statement_alternative . 1152))
nil
+ ((identifier_opt . 1165))
+ ((elsif_statement_item . 1163)(elsif_statement_list . 1164))
nil
nil
nil
+ ((aggregate . 157)(attribute_reference . 51)(choice_expression .
186)(choice_relation_and_list . 187)(choice_relation_or_list .
188)(choice_relation_xor_list . 189)(choice_relation_and_then_list .
190)(choice_relation_or_else_list . 191)(choice_relation . 192)(discrete_choice
. 193)(discrete_choice_list . 1157)(factor . 161)(name . 197)(primary .
166)(qualified_expression . 54)(range . 198)(selected_component .
55)(simple_expression . 475)(term . 176)(term_list . 177)(unary_adding_ [...]
nil
+ ((case_statement_alternative . 1156))
nil
- ((function_specification . 16)(procedure_specification .
32)(subprogram_specification . 1145))
nil
- ((aspect_clause . 977)(at_clause . 304)(entry_body .
978)(enumeration_representation_clause . 311)(function_specification .
16)(overriding_indicator_opt . 979)(procedure_specification .
32)(protected_operation_item . 1144)(record_representation_clause .
335)(subprogram_body . 983)(subprogram_declaration . 984))
nil
nil
nil
- ((attribute_reference . 51)(name . 1142)(qualified_expression .
54)(selected_component . 55))
nil
- ((actual_parameter_part . 91))
nil
- ((formal_part . 116)(parameter_profile_opt . 1139))
nil
+ ((function_specification . 436)(procedure_specification .
437)(subprogram_specification . 1149))
nil
+ ((aspect_clause . 987)(at_clause . 308)(entry_body .
988)(enumeration_representation_clause . 315)(expression_function_declaration .
989)(function_specification . 16)(null_procedure_declaration .
990)(overriding_indicator_opt . 991)(procedure_specification .
32)(protected_operation_item . 1148)(record_representation_clause .
339)(subprogram_body . 995)(subprogram_declaration . 996))
nil
nil
nil
nil
+ ((actual_parameter_part . 92)(constraint . 1146)(index_constraint . 830))
+ ((attribute_reference . 51)(name . 1145)(qualified_expression .
54)(selected_component . 55))
+ ((actual_parameter_part . 92))
nil
+ ((aggregate . 157)(attribute_reference . 51)(expression . 1144)(factor .
161)(name . 163)(primary . 166)(qualified_expression . 54)(raise_expression .
168)(relation_and_list . 169)(relation_and_then_list . 170)(relation_or_list .
171)(relation_or_else_list . 172)(relation_xor_list . 173)(relation .
174)(selected_component . 55)(simple_expression . 175)(term . 176)(term_list .
177)(unary_adding_operator . 178))
nil
- ((aggregate . 153)(attribute_reference . 51)(expression . 1138)(factor .
155)(name . 156)(primary . 159)(qualified_expression . 54)(raise_expression .
160)(relation_and_list . 161)(relation_and_then_list . 162)(relation_or_list .
163)(relation_or_else_list . 164)(relation_xor_list . 165)(relation .
166)(selected_component . 55)(simple_expression . 167)(term . 168)(term_list .
169)(unary_adding_operator . 170))
nil
- ((aggregate . 153)(attribute_reference . 51)(expression . 1136)(factor .
155)(name . 156)(primary . 159)(qualified_expression . 54)(raise_expression .
160)(relation_and_list . 161)(relation_and_then_list . 162)(relation_or_list .
163)(relation_or_else_list . 164)(relation_xor_list . 165)(relation .
166)(selected_component . 55)(simple_expression . 167)(term . 168)(term_list .
169)(unary_adding_operator . 170))
+ ((formal_part . 117)(parameter_profile_opt . 1142))
nil
- ((aggregate . 153)(attribute_reference . 51)(expression . 1134)(factor .
155)(name . 156)(primary . 159)(qualified_expression . 54)(raise_expression .
160)(relation_and_list . 161)(relation_and_then_list . 162)(relation_or_list .
163)(relation_or_else_list . 164)(relation_xor_list . 165)(relation .
166)(selected_component . 55)(simple_expression . 167)(term . 168)(term_list .
169)(unary_adding_operator . 170))
nil
- ((attribute_reference . 51)(name . 1038)(qualified_expression .
54)(selected_component . 55))
nil
nil
- ((aspect_specification_opt . 1131))
nil
- ((attribute_reference . 51)(name . 1130)(qualified_expression .
54)(selected_component . 55))
- ((attribute_reference . 51)(name . 742)(qualified_expression .
54)(selected_component . 55)(subtype_indication . 1129))
nil
- ((direct_name . 1127)(direct_name_opt . 1128))
nil
+ ((aggregate . 157)(attribute_reference . 51)(expression . 1141)(factor .
161)(name . 163)(primary . 166)(qualified_expression . 54)(raise_expression .
168)(relation_and_list . 169)(relation_and_then_list . 170)(relation_or_list .
171)(relation_or_else_list . 172)(relation_xor_list . 173)(relation .
174)(selected_component . 55)(simple_expression . 175)(term . 176)(term_list .
177)(unary_adding_operator . 178))
nil
+ ((aggregate . 157)(attribute_reference . 51)(expression . 1139)(factor .
161)(name . 163)(primary . 166)(qualified_expression . 54)(raise_expression .
168)(relation_and_list . 169)(relation_and_then_list . 170)(relation_or_list .
171)(relation_or_else_list . 172)(relation_xor_list . 173)(relation .
174)(selected_component . 55)(simple_expression . 175)(term . 176)(term_list .
177)(unary_adding_operator . 178))
nil
+ ((aggregate . 157)(attribute_reference . 51)(expression . 1137)(factor .
161)(name . 163)(primary . 166)(qualified_expression . 54)(raise_expression .
168)(relation_and_list . 169)(relation_and_then_list . 170)(relation_or_list .
171)(relation_or_else_list . 172)(relation_xor_list . 173)(relation .
174)(selected_component . 55)(simple_expression . 175)(term . 176)(term_list .
177)(unary_adding_operator . 178))
nil
- ((aspect_clause . 1014)(at_clause . 304)(component_declaration .
1015)(component_item . 1122)(enumeration_representation_clause .
311)(identifier_list . 1019)(record_representation_clause . 335)(variant_part .
1123))
+ ((attribute_reference . 51)(name . 998)(qualified_expression .
54)(selected_component . 55))
nil
+ ((actual_parameter_part . 92)(aspect_specification_opt . 1135))
nil
nil
nil
+ ((aspect_specification_opt . 1131))
nil
+ ((attribute_reference . 51)(name . 1130)(qualified_expression .
54)(selected_component . 55))
+ ((attribute_reference . 51)(name . 730)(qualified_expression .
54)(selected_component . 55)(subtype_indication . 1129))
nil
+ ((direct_name . 1127)(direct_name_opt . 1128))
nil
nil
nil
nil
- ((real_range_specification_opt . 1116))
- ((real_range_specification_opt . 1115))
+ ((aspect_clause . 1032)(at_clause . 308)(component_declaration .
1033)(component_item . 1122)(enumeration_representation_clause .
315)(identifier_list . 1037)(record_representation_clause . 339)(variant_part .
1123))
nil
nil
- ((identifier_opt . 1112))
- ((abstract_subprogram_declaration . 302)(aspect_clause . 303)(at_clause
. 304)(body . 305)(body_stub . 306)(declaration . 307)(declarations .
308)(declarative_part_opt . 1111)(entry_declaration .
310)(enumeration_representation_clause . 311)(exception_declaration .
312)(expression_function_declaration . 313)(full_type_declaration .
314)(function_specification . 16)(generic_declaration .
315)(generic_formal_part . 18)(generic_instantiation .
316)(generic_package_declaration . 20)(ge [...]
nil
nil
nil
- ((abstract_subprogram_declaration . 302)(aspect_clause . 303)(at_clause
. 304)(body . 305)(body_stub . 306)(declaration . 307)(declarations .
308)(declarative_part_opt . 854)(entry_declaration .
310)(enumeration_representation_clause . 311)(exception_declaration .
312)(expression_function_declaration . 313)(full_type_declaration .
314)(function_specification . 16)(generic_declaration .
315)(generic_formal_part . 18)(generic_instantiation .
316)(generic_package_declaration . 20)(gen [...]
- ((actual_parameter_part . 91)(constraint . 1106)(index_constraint . 822))
nil
nil
nil
- ((identifier_opt . 1105))
- ((abstract_subprogram_declaration . 302)(aspect_clause . 303)(at_clause
. 304)(body . 305)(body_stub . 306)(declaration . 307)(declarations .
308)(declarative_part_opt . 1104)(entry_declaration .
310)(enumeration_representation_clause . 311)(exception_declaration .
312)(expression_function_declaration . 313)(full_type_declaration .
314)(function_specification . 16)(generic_declaration .
315)(generic_formal_part . 18)(generic_instantiation .
316)(generic_package_declaration . 20)(ge [...]
nil
nil
- ((abstract_subprogram_declaration . 302)(aspect_clause . 303)(at_clause
. 304)(body . 305)(body_stub . 306)(declaration . 307)(declarations .
308)(declarative_part_opt . 846)(entry_declaration .
310)(enumeration_representation_clause . 311)(exception_declaration .
312)(expression_function_declaration . 313)(full_type_declaration .
314)(function_specification . 16)(generic_declaration .
315)(generic_formal_part . 18)(generic_instantiation .
316)(generic_package_declaration . 20)(gen [...]
+ ((real_range_specification_opt . 1116))
+ ((real_range_specification_opt . 1115))
nil
nil
+ ((abstract_subprogram_declaration . 306)(aspect_clause . 307)(at_clause
. 308)(body . 309)(body_stub . 310)(declaration . 311)(declarations .
312)(declarative_part_opt . 854)(entry_declaration .
314)(enumeration_representation_clause . 315)(exception_declaration .
316)(expression_function_declaration . 317)(full_type_declaration .
318)(function_specification . 16)(generic_declaration .
319)(generic_formal_part . 18)(generic_instantiation .
320)(generic_package_declaration . 20)(gen [...]
nil
nil
- ((component_clause . 1097))
- ((aggregate . 153)(attribute_reference . 51)(expression . 1095)(factor .
155)(name . 156)(primary . 159)(qualified_expression . 54)(raise_expression .
160)(relation_and_list . 161)(relation_and_then_list . 162)(relation_or_list .
163)(relation_or_else_list . 164)(relation_xor_list . 165)(relation .
166)(selected_component . 55)(simple_expression . 167)(term . 168)(term_list .
169)(unary_adding_operator . 170))
- ((actual_parameter_part . 91)(aspect_specification_opt . 1094))
+ ((identifier_opt . 1109))
+ ((abstract_subprogram_declaration . 306)(aspect_clause . 307)(at_clause
. 308)(body . 309)(body_stub . 310)(declaration . 311)(declarations .
312)(declarative_part_opt . 1108)(entry_declaration .
314)(enumeration_representation_clause . 315)(exception_declaration .
316)(expression_function_declaration . 317)(full_type_declaration .
318)(function_specification . 16)(generic_declaration .
319)(generic_formal_part . 18)(generic_instantiation .
320)(generic_package_declaration . 20)(ge [...]
nil
nil
- ((access_definition . 1088)(attribute_reference .
51)(component_definition . 1091)(name . 742)(null_exclusion_opt .
215)(qualified_expression . 54)(selected_component . 55)(subtype_indication .
1090))
nil
- ((access_definition . 1088)(attribute_reference .
51)(component_definition . 1089)(name . 742)(null_exclusion_opt .
215)(qualified_expression . 54)(selected_component . 55)(subtype_indication .
1090))
+ ((abstract_subprogram_declaration . 306)(aspect_clause . 307)(at_clause
. 308)(body . 309)(body_stub . 310)(declaration . 311)(declarations .
312)(declarative_part_opt . 848)(entry_declaration .
314)(enumeration_representation_clause . 315)(exception_declaration .
316)(expression_function_declaration . 317)(full_type_declaration .
318)(function_specification . 16)(generic_declaration .
319)(generic_formal_part . 18)(generic_instantiation .
320)(generic_package_declaration . 20)(gen [...]
nil
- ((actual_parameter_part . 91))
+ ((identifier_opt . 1103))
+ ((abstract_subprogram_declaration . 306)(aspect_clause . 307)(at_clause
. 308)(body . 309)(body_stub . 310)(declaration . 311)(declarations .
312)(declarative_part_opt . 1102)(entry_declaration .
314)(enumeration_representation_clause . 315)(exception_declaration .
316)(expression_function_declaration . 317)(full_type_declaration .
318)(function_specification . 16)(generic_declaration .
319)(generic_formal_part . 18)(generic_instantiation .
320)(generic_package_declaration . 20)(ge [...]
nil
- ((aggregate . 153)(attribute_reference . 51)(name . 156)(primary .
293)(qualified_expression . 54)(selected_component . 55))
nil
nil
- ((attribute_reference . 51)(name . 1083)(qualified_expression .
54)(selected_component . 55))
nil
nil
+ ((component_clause . 1098))
+ ((aggregate . 157)(attribute_reference . 51)(expression . 1096)(factor .
161)(name . 163)(primary . 166)(qualified_expression . 54)(raise_expression .
168)(relation_and_list . 169)(relation_and_then_list . 170)(relation_or_list .
171)(relation_or_else_list . 172)(relation_xor_list . 173)(relation .
174)(selected_component . 55)(simple_expression . 175)(term . 176)(term_list .
177)(unary_adding_operator . 178))
nil
+ ((access_definition . 1091)(attribute_reference .
51)(component_definition . 1095)(name . 730)(null_exclusion_opt .
517)(qualified_expression . 54)(selected_component . 55)(subtype_indication .
1093))
nil
+ ((actual_parameter_part . 92))
+ ((access_definition . 1091)(attribute_reference .
51)(component_definition . 1092)(name . 730)(null_exclusion_opt .
517)(qualified_expression . 54)(selected_component . 55)(subtype_indication .
1093))
nil
- ((aggregate . 153)(attribute_reference . 51)(expression . 1081)(factor .
155)(name . 156)(primary . 159)(qualified_expression . 54)(raise_expression .
160)(relation_and_list . 161)(relation_and_then_list . 162)(relation_or_list .
163)(relation_or_else_list . 164)(relation_xor_list . 165)(relation .
166)(selected_component . 55)(simple_expression . 167)(term . 168)(term_list .
169)(unary_adding_operator . 170))
- ((aggregate . 153)(attribute_reference . 51)(expression . 1080)(factor .
155)(name . 156)(primary . 159)(qualified_expression . 54)(raise_expression .
160)(relation_and_list . 161)(relation_and_then_list . 162)(relation_or_list .
163)(relation_or_else_list . 164)(relation_xor_list . 165)(relation .
166)(selected_component . 55)(simple_expression . 167)(term . 168)(term_list .
169)(unary_adding_operator . 170))
+ ((aggregate . 157)(attribute_reference . 51)(name . 163)(primary .
298)(qualified_expression . 54)(selected_component . 55))
nil
nil
+ ((attribute_reference . 51)(name . 1087)(qualified_expression .
54)(selected_component . 55))
nil
- ((aggregate . 153)(attribute_reference . 51)(expression . 1078)(factor .
155)(name . 156)(primary . 159)(qualified_expression . 54)(raise_expression .
160)(relation_and_list . 161)(relation_and_then_list . 162)(relation_or_list .
163)(relation_or_else_list . 164)(relation_xor_list . 165)(relation .
166)(selected_component . 55)(simple_expression . 167)(term . 168)(term_list .
169)(unary_adding_operator . 170))
nil
nil
- ((aggregate . 153)(attribute_reference . 51)(expression . 1241)(factor .
155)(name . 156)(primary . 159)(qualified_expression . 54)(raise_expression .
160)(relation_and_list . 161)(relation_and_then_list . 162)(relation_or_list .
163)(relation_or_else_list . 164)(relation_xor_list . 165)(relation .
166)(selected_component . 55)(simple_expression . 167)(term . 168)(term_list .
169)(unary_adding_operator . 170))
nil
nil
+ ((aggregate . 157)(attribute_reference . 51)(expression . 1085)(factor .
161)(name . 163)(primary . 166)(qualified_expression . 54)(raise_expression .
168)(relation_and_list . 169)(relation_and_then_list . 170)(relation_or_list .
171)(relation_or_else_list . 172)(relation_xor_list . 173)(relation .
174)(selected_component . 55)(simple_expression . 175)(term . 176)(term_list .
177)(unary_adding_operator . 178))
nil
- ((actual_parameter_part . 91))
nil
- ((attribute_reference . 51)(name . 1240)(qualified_expression .
54)(selected_component . 55))
+ ((actual_parameter_part . 92))
nil
- ((access_definition . 1238)(attribute_reference . 51)(name .
742)(null_exclusion_opt . 215)(qualified_expression . 54)(selected_component .
55)(subtype_indication . 1239))
+ ((attribute_reference . 51)(name . 1243)(qualified_expression .
54)(selected_component . 55))
+ ((access_definition . 1241)(attribute_reference . 51)(name .
730)(null_exclusion_opt . 517)(qualified_expression . 54)(selected_component .
55)(subtype_indication . 1242))
nil
nil
nil
@@ -4225,90 +4249,90 @@
nil
nil
nil
+ ((aggregate . 157)(attribute_reference . 51)(factor . 161)(name .
163)(primary . 166)(qualified_expression . 54)(selected_component .
55)(simple_expression . 1238)(term . 176)(term_list .
177)(unary_adding_operator . 178))
nil
+ ((abstract_subprogram_declaration . 306)(aspect_clause . 307)(at_clause
. 308)(body . 309)(body_stub . 310)(declaration . 311)(declarations .
312)(declarative_part_opt . 848)(entry_declaration .
314)(enumeration_representation_clause . 315)(exception_declaration .
316)(expression_function_declaration . 317)(full_type_declaration .
318)(function_specification . 16)(generic_declaration .
319)(generic_formal_part . 18)(generic_instantiation .
320)(generic_package_declaration . 20)(gen [...]
nil
- ((aggregate . 153)(attribute_reference . 51)(factor . 155)(name .
156)(primary . 159)(qualified_expression . 54)(selected_component .
55)(simple_expression . 1234)(term . 168)(term_list .
169)(unary_adding_operator . 170))
nil
- ((attribute_reference . 51)(interface_list . 1233)(name .
814)(qualified_expression . 54)(selected_component . 55))
+ ((attribute_reference . 51)(interface_list . 1235)(name .
822)(qualified_expression . 54)(selected_component . 55))
nil
nil
- ((abstract_subprogram_declaration . 302)(aspect_clause . 303)(at_clause
. 304)(body . 305)(body_stub . 306)(declaration . 307)(declarations .
308)(declarative_part_opt . 846)(entry_declaration .
310)(enumeration_representation_clause . 311)(exception_declaration .
312)(expression_function_declaration . 313)(full_type_declaration .
314)(function_specification . 16)(generic_declaration .
315)(generic_formal_part . 18)(generic_instantiation .
316)(generic_package_declaration . 20)(gen [...]
+ ((abstract_subprogram_declaration . 306)(aspect_clause . 307)(at_clause
. 308)(body . 309)(body_stub . 310)(declaration . 311)(declarations .
312)(declarative_part_opt . 854)(entry_declaration .
314)(enumeration_representation_clause . 315)(exception_declaration .
316)(expression_function_declaration . 317)(full_type_declaration .
318)(function_specification . 16)(generic_declaration .
319)(generic_formal_part . 18)(generic_instantiation .
320)(generic_package_declaration . 20)(gen [...]
nil
nil
+ ((attribute_reference . 51)(interface_list . 1231)(name .
822)(qualified_expression . 54)(selected_component . 55))
nil
- ((attribute_reference . 51)(interface_list . 1229)(name .
814)(qualified_expression . 54)(selected_component . 55))
nil
+ ((aggregate . 157)(attribute_reference . 51)(expression . 1229)(factor .
161)(name . 163)(primary . 166)(qualified_expression . 54)(raise_expression .
168)(relation_and_list . 169)(relation_and_then_list . 170)(relation_or_list .
171)(relation_or_else_list . 172)(relation_xor_list . 173)(relation .
174)(selected_component . 55)(simple_expression . 175)(term . 176)(term_list .
177)(unary_adding_operator . 178))
+ ((aggregate . 157)(attribute_reference . 51)(factor . 161)(name .
163)(primary . 166)(qualified_expression . 54)(selected_component .
55)(simple_expression . 1228)(term . 176)(term_list .
177)(unary_adding_operator . 178))
nil
- ((abstract_subprogram_declaration . 302)(aspect_clause . 303)(at_clause
. 304)(body . 305)(body_stub . 306)(declaration . 307)(declarations .
308)(declarative_part_opt . 854)(entry_declaration .
310)(enumeration_representation_clause . 311)(exception_declaration .
312)(expression_function_declaration . 313)(full_type_declaration .
314)(function_specification . 16)(generic_declaration .
315)(generic_formal_part . 18)(generic_instantiation .
316)(generic_package_declaration . 20)(gen [...]
nil
nil
- ((aggregate . 153)(attribute_reference . 51)(expression . 1225)(factor .
155)(name . 156)(primary . 159)(qualified_expression . 54)(raise_expression .
160)(relation_and_list . 161)(relation_and_then_list . 162)(relation_or_list .
163)(relation_or_else_list . 164)(relation_xor_list . 165)(relation .
166)(selected_component . 55)(simple_expression . 167)(term . 168)(term_list .
169)(unary_adding_operator . 170))
- ((aggregate . 153)(attribute_reference . 51)(factor . 155)(name .
156)(primary . 159)(qualified_expression . 54)(selected_component .
55)(simple_expression . 1224)(term . 168)(term_list .
169)(unary_adding_operator . 170))
+ ((enumeration_literal . 1227))
+ ((aggregate . 157)(attribute_reference . 51)(factor . 161)(name .
163)(primary . 166)(qualified_expression . 54)(selected_component .
55)(simple_expression . 1226)(term . 176)(term_list .
177)(unary_adding_operator . 178))
+ ((access_definition . 1091)(attribute_reference .
51)(component_definition . 1225)(name . 730)(null_exclusion_opt .
517)(qualified_expression . 54)(selected_component . 55)(subtype_indication .
1093))
nil
nil
- ((enumeration_literal . 1223))
nil
- ((aggregate . 153)(attribute_reference . 51)(factor . 155)(name .
156)(primary . 159)(qualified_expression . 54)(selected_component .
55)(simple_expression . 1222)(term . 168)(term_list .
169)(unary_adding_operator . 170))
- ((access_definition . 1088)(attribute_reference .
51)(component_definition . 1221)(name . 742)(null_exclusion_opt .
215)(qualified_expression . 54)(selected_component . 55)(subtype_indication .
1090))
nil
nil
nil
nil
nil
+ ((and_interface_list_opt . 1222))
+ ((actual_parameter_part . 92)(and_interface_list_opt . 1219)(constraint
. 1220)(constraint_opt . 1221)(index_constraint . 830))
nil
nil
nil
- ((and_interface_list_opt . 1218))
- ((actual_parameter_part . 91)(and_interface_list_opt . 1215)(constraint
. 1216)(constraint_opt . 1217)(index_constraint . 822))
nil
nil
nil
- ((aspect_specification_opt . 1213))
+ ((aspect_specification_opt . 1216))
nil
- ((aspect_specification_opt . 1212))
+ ((aspect_specification_opt . 1215))
+ nil
+ ((aspect_specification_opt . 1214))
+ ((aspect_specification_opt . 1213))
nil
- ((aspect_specification_opt . 1211))
- ((aspect_specification_opt . 1210))
nil
- ((attribute_reference . 51)(name . 1209)(qualified_expression .
54)(selected_component . 55))
- ((actual_parameter_part . 91))
- ((identifier_opt . 1208))
+ ((actual_parameter_part . 92))
nil
- ((aspect_specification_opt . 128))
- ((entry_body_formal_part . 1206)(formal_part .
116)(parameter_profile_opt . 1207))
- ((accept_statement . 638)(assignment_statement .
639)(asynchronous_select . 640)(attribute_reference . 51)(block_statement .
641)(case_statement . 642)(conditional_entry_call . 643)(delay_statement .
644)(exit_statement . 645)(extended_return_statement .
646)(handled_sequence_of_statements . 1204)(if_statement .
648)(iteration_scheme . 649)(label_opt . 650)(loop_statement . 651)(name .
652)(pragma . 653)(procedure_call_statement . 654)(qualified_expression .
54)(raise_statement . 6 [...]
+ ((identifier_opt . 1212))
nil
- ((accept_statement . 638)(assignment_statement .
639)(asynchronous_select . 640)(attribute_reference . 51)(block_statement .
641)(case_statement . 642)(conditional_entry_call . 643)(delay_statement .
644)(exit_statement . 645)(extended_return_statement .
646)(handled_sequence_of_statements . 1203)(if_statement .
648)(iteration_scheme . 649)(label_opt . 650)(loop_statement . 651)(name .
652)(pragma . 653)(procedure_call_statement . 654)(qualified_expression .
54)(raise_statement . 6 [...]
+ ((aspect_specification_opt . 129))
+ ((entry_body_formal_part . 1210)(formal_part .
117)(parameter_profile_opt . 1211))
+ ((accept_statement . 649)(assignment_statement .
650)(asynchronous_select . 651)(attribute_reference . 51)(block_statement .
652)(case_statement . 653)(conditional_entry_call . 654)(delay_statement .
655)(exit_statement . 656)(extended_return_statement .
657)(handled_sequence_of_statements . 1208)(if_statement .
659)(iteration_scheme . 660)(label_opt . 661)(loop_statement . 662)(name .
663)(pragma . 664)(procedure_call_statement . 665)(qualified_expression .
54)(raise_statement . 6 [...]
+ ((accept_statement . 649)(assignment_statement .
650)(asynchronous_select . 651)(attribute_reference . 51)(block_statement .
652)(case_statement . 653)(conditional_entry_call . 654)(delay_statement .
655)(exit_statement . 656)(extended_return_statement .
657)(handled_sequence_of_statements . 1207)(if_statement .
659)(iteration_scheme . 660)(label_opt . 661)(loop_statement . 662)(name .
663)(pragma . 664)(procedure_call_statement . 665)(qualified_expression .
54)(raise_statement . 6 [...]
nil
nil
nil
nil
- ((identifier_opt . 1200))
nil
- ((accept_statement . 638)(assignment_statement .
639)(asynchronous_select . 640)(attribute_reference . 51)(block_statement .
641)(case_statement . 642)(conditional_entry_call . 643)(delay_statement .
644)(exit_statement . 645)(extended_return_statement . 646)(if_statement .
648)(iteration_scheme . 649)(label_opt . 650)(loop_statement . 651)(name .
652)(pragma . 653)(procedure_call_statement . 654)(qualified_expression .
54)(raise_statement . 655)(requeue_statement . 656)(selected_c [...]
- ((aggregate . 153)(attribute_reference . 51)(expression .
187)(expression_opt . 1198)(factor . 155)(name . 156)(primary .
159)(qualified_expression . 54)(raise_expression . 160)(relation_and_list .
161)(relation_and_then_list . 162)(relation_or_list .
163)(relation_or_else_list . 164)(relation_xor_list . 165)(relation .
166)(selected_component . 55)(simple_expression . 167)(term . 168)(term_list .
169)(unary_adding_operator . 170))
+ ((identifier_opt . 1204))
nil
+ ((accept_statement . 649)(assignment_statement .
650)(asynchronous_select . 651)(attribute_reference . 51)(block_statement .
652)(case_statement . 653)(conditional_entry_call . 654)(delay_statement .
655)(exit_statement . 656)(extended_return_statement . 657)(if_statement .
659)(iteration_scheme . 660)(label_opt . 661)(loop_statement . 662)(name .
663)(pragma . 664)(procedure_call_statement . 665)(qualified_expression .
54)(raise_statement . 666)(requeue_statement . 667)(selected_c [...]
+ ((aggregate . 157)(attribute_reference . 51)(expression .
195)(expression_opt . 1202)(factor . 161)(name . 163)(primary .
166)(qualified_expression . 54)(raise_expression . 168)(relation_and_list .
169)(relation_and_then_list . 170)(relation_or_list .
171)(relation_or_else_list . 172)(relation_xor_list . 173)(relation .
174)(selected_component . 55)(simple_expression . 175)(term . 176)(term_list .
177)(unary_adding_operator . 178))
nil
- ((elsif_statement_item . 1196))
nil
+ ((elsif_statement_item . 1200))
nil
nil
nil
- ((access_definition . 1189)(attribute_reference . 51)(name .
742)(null_exclusion_opt . 215)(qualified_expression .
54)(return_subtype_indication . 1190)(selected_component .
55)(subtype_indication . 1191))
nil
+ ((access_definition . 1193)(attribute_reference . 51)(name .
730)(null_exclusion_opt . 517)(qualified_expression .
54)(return_subtype_indication . 1194)(selected_component .
55)(subtype_indication . 1195))
nil
nil
nil
nil
nil
nil
- ((accept_statement . 638)(assignment_statement .
639)(asynchronous_select . 640)(attribute_reference . 51)(block_statement .
641)(case_statement . 642)(conditional_entry_call . 643)(delay_statement .
644)(exit_statement . 645)(extended_return_statement . 646)(if_statement .
648)(iteration_scheme . 649)(label_opt . 650)(loop_statement . 651)(name .
652)(pragma . 653)(procedure_call_statement . 654)(qualified_expression .
54)(raise_statement . 655)(requeue_statement . 656)(selected_c [...]
nil
- ((identifier_opt . 1182))
- ((attribute_reference . 51)(exception_choice . 1181)(name .
949)(qualified_expression . 54)(selected_component . 55))
- ((accept_statement . 638)(assignment_statement .
639)(asynchronous_select . 640)(attribute_reference . 51)(block_statement .
641)(case_statement . 642)(conditional_entry_call . 643)(delay_statement .
644)(exit_statement . 645)(extended_return_statement . 646)(if_statement .
648)(iteration_scheme . 649)(label_opt . 650)(loop_statement . 651)(name .
652)(pragma . 653)(procedure_call_statement . 654)(qualified_expression .
54)(raise_statement . 655)(requeue_statement . 656)(selected_c [...]
- ((attribute_reference . 51)(exception_choice .
947)(exception_choice_list . 1179)(name . 949)(qualified_expression .
54)(selected_component . 55))
+ ((accept_statement . 649)(assignment_statement .
650)(asynchronous_select . 651)(attribute_reference . 51)(block_statement .
652)(case_statement . 653)(conditional_entry_call . 654)(delay_statement .
655)(exit_statement . 656)(extended_return_statement . 657)(if_statement .
659)(iteration_scheme . 660)(label_opt . 661)(loop_statement . 662)(name .
663)(pragma . 664)(procedure_call_statement . 665)(qualified_expression .
54)(raise_statement . 666)(requeue_statement . 667)(selected_c [...]
nil
+ ((identifier_opt . 1186))
+ ((attribute_reference . 51)(exception_choice . 1185)(name .
959)(qualified_expression . 54)(selected_component . 55))
+ ((accept_statement . 649)(assignment_statement .
650)(asynchronous_select . 651)(attribute_reference . 51)(block_statement .
652)(case_statement . 653)(conditional_entry_call . 654)(delay_statement .
655)(exit_statement . 656)(extended_return_statement . 657)(if_statement .
659)(iteration_scheme . 660)(label_opt . 661)(loop_statement . 662)(name .
663)(pragma . 664)(procedure_call_statement . 665)(qualified_expression .
54)(raise_statement . 666)(requeue_statement . 667)(selected_c [...]
+ ((attribute_reference . 51)(exception_choice .
957)(exception_choice_list . 1183)(name . 959)(qualified_expression .
54)(selected_component . 55))
nil
nil
nil
@@ -4323,22 +4347,21 @@
nil
nil
nil
- ((accept_statement . 638)(assignment_statement .
639)(asynchronous_select . 640)(attribute_reference . 51)(block_statement .
641)(case_statement . 642)(conditional_entry_call . 643)(delay_statement .
644)(exit_statement . 645)(extended_return_statement . 646)(if_statement .
648)(iteration_scheme . 649)(label_opt . 650)(loop_statement . 651)(name .
652)(pragma . 653)(procedure_call_statement . 654)(qualified_expression .
54)(raise_statement . 655)(requeue_statement . 656)(selected_c [...]
nil
+ ((accept_statement . 649)(assignment_statement .
650)(asynchronous_select . 651)(attribute_reference . 51)(block_statement .
652)(case_statement . 653)(conditional_entry_call . 654)(delay_statement .
655)(exit_statement . 656)(extended_return_statement . 657)(if_statement .
659)(iteration_scheme . 660)(label_opt . 661)(loop_statement . 662)(name .
663)(pragma . 664)(procedure_call_statement . 665)(qualified_expression .
54)(raise_statement . 666)(requeue_statement . 667)(selected_c [...]
nil
nil
nil
nil
nil
- ((accept_statement . 638)(assignment_statement .
639)(asynchronous_select . 640)(attribute_reference . 51)(block_statement .
641)(case_statement . 642)(conditional_entry_call . 643)(delay_statement .
644)(exit_statement . 645)(extended_return_statement . 646)(if_statement .
648)(iteration_scheme . 649)(label_opt . 650)(loop_statement . 651)(name .
652)(pragma . 653)(procedure_call_statement . 654)(qualified_expression .
54)(raise_statement . 655)(requeue_statement . 656)(selected_c [...]
nil
+ ((accept_statement . 649)(assignment_statement .
650)(asynchronous_select . 651)(attribute_reference . 51)(block_statement .
652)(case_statement . 653)(conditional_entry_call . 654)(delay_statement .
655)(exit_statement . 656)(extended_return_statement . 657)(if_statement .
659)(iteration_scheme . 660)(label_opt . 661)(loop_statement . 662)(name .
663)(pragma . 664)(procedure_call_statement . 665)(qualified_expression .
54)(raise_statement . 666)(requeue_statement . 667)(selected_c [...]
nil
nil
- ((identifier_list . 217)(parameter_specification .
218)(parameter_specification_list . 219))
nil
+ ((identifier_list . 236)(parameter_specification .
237)(parameter_specification_list . 238))
nil
nil
- ((actual_parameter_part . 91))
nil
nil
nil
@@ -4348,70 +4371,70 @@
nil
nil
nil
- ((variant_list . 1254)(variant . 1255))
nil
- ((aspect_specification_opt . 1252))
nil
+ ((variant_list . 1256)(variant . 1257))
nil
+ ((aspect_specification_opt . 1254))
nil
- ((real_range_specification_opt . 1249))
- ((identifier_opt . 1248))
nil
nil
+ ((real_range_specification_opt . 1251))
nil
- ((identifier_opt . 1245))
nil
+ ((identifier_opt . 1249))
nil
nil
nil
+ ((identifier_opt . 1246))
nil
nil
nil
nil
nil
- ((actual_parameter_part . 91)(constraint . 1106)(index_constraint . 822))
nil
- ((aggregate . 153)(attribute_reference . 51)(factor . 155)(name .
156)(primary . 159)(qualified_expression . 54)(selected_component .
55)(simple_expression . 1304)(term . 168)(term_list .
169)(unary_adding_operator . 170))
- ((abstract_subprogram_declaration . 302)(aspect_clause . 303)(at_clause
. 304)(body . 305)(body_stub . 306)(declaration . 307)(declarations .
308)(declarative_part_opt . 846)(entry_declaration .
310)(enumeration_representation_clause . 311)(exception_declaration .
312)(expression_function_declaration . 313)(full_type_declaration .
314)(function_specification . 16)(generic_declaration .
315)(generic_formal_part . 18)(generic_instantiation .
316)(generic_package_declaration . 20)(gen [...]
+ ((actual_parameter_part . 92)(constraint . 1146)(index_constraint . 830))
+ ((aggregate . 157)(attribute_reference . 51)(factor . 161)(name .
163)(primary . 166)(qualified_expression . 54)(selected_component .
55)(simple_expression . 1306)(term . 176)(term_list .
177)(unary_adding_operator . 178))
nil
nil
- ((abstract_subprogram_declaration . 302)(aspect_clause . 303)(at_clause
. 304)(body . 305)(body_stub . 306)(declaration . 307)(declarations .
308)(declarative_part_opt . 854)(entry_declaration .
310)(enumeration_representation_clause . 311)(exception_declaration .
312)(expression_function_declaration . 313)(full_type_declaration .
314)(function_specification . 16)(generic_declaration .
315)(generic_formal_part . 18)(generic_instantiation .
316)(generic_package_declaration . 20)(gen [...]
+ ((abstract_subprogram_declaration . 306)(aspect_clause . 307)(at_clause
. 308)(body . 309)(body_stub . 310)(declaration . 311)(declarations .
312)(declarative_part_opt . 848)(entry_declaration .
314)(enumeration_representation_clause . 315)(exception_declaration .
316)(expression_function_declaration . 317)(full_type_declaration .
318)(function_specification . 16)(generic_declaration .
319)(generic_formal_part . 18)(generic_instantiation .
320)(generic_package_declaration . 20)(gen [...]
nil
nil
+ ((abstract_subprogram_declaration . 306)(aspect_clause . 307)(at_clause
. 308)(body . 309)(body_stub . 310)(declaration . 311)(declarations .
312)(declarative_part_opt . 854)(entry_declaration .
314)(enumeration_representation_clause . 315)(exception_declaration .
316)(expression_function_declaration . 317)(full_type_declaration .
318)(function_specification . 16)(generic_declaration .
319)(generic_formal_part . 18)(generic_instantiation .
320)(generic_package_declaration . 20)(gen [...]
nil
- ((aggregate . 153)(attribute_reference . 51)(factor . 155)(name .
156)(primary . 159)(qualified_expression . 54)(selected_component .
55)(simple_expression . 1301)(term . 168)(term_list .
169)(unary_adding_operator . 170))
- ((aggregate . 153)(attribute_reference . 51)(expression . 1300)(factor .
155)(name . 156)(primary . 159)(qualified_expression . 54)(raise_expression .
160)(relation_and_list . 161)(relation_and_then_list . 162)(relation_or_list .
163)(relation_or_else_list . 164)(relation_xor_list . 165)(relation .
166)(selected_component . 55)(simple_expression . 167)(term . 168)(term_list .
169)(unary_adding_operator . 170))
+ ((aggregate . 157)(attribute_reference . 51)(factor . 161)(name .
163)(primary . 166)(qualified_expression . 54)(selected_component .
55)(simple_expression . 1303)(term . 176)(term_list .
177)(unary_adding_operator . 178))
+ ((aggregate . 157)(attribute_reference . 51)(expression . 1302)(factor .
161)(name . 163)(primary . 166)(qualified_expression . 54)(raise_expression .
168)(relation_and_list . 169)(relation_and_then_list . 170)(relation_or_list .
171)(relation_or_else_list . 172)(relation_xor_list . 173)(relation .
174)(selected_component . 55)(simple_expression . 175)(term . 176)(term_list .
177)(unary_adding_operator . 178))
nil
- ((aggregate . 153)(attribute_reference . 51)(choice_expression .
178)(choice_relation_and_list . 179)(choice_relation_or_list .
180)(choice_relation_xor_list . 181)(choice_relation_and_then_list .
182)(choice_relation_or_else_list . 183)(choice_relation . 184)(discrete_choice
. 185)(discrete_choice_list . 1298)(factor . 155)(name . 189)(primary .
159)(qualified_expression . 54)(range . 190)(selected_component .
55)(simple_expression . 464)(term . 168)(term_list . 169)(unary_adding_ [...]
- ((variant . 1297))
+ ((aggregate . 157)(attribute_reference . 51)(choice_expression .
186)(choice_relation_and_list . 187)(choice_relation_or_list .
188)(choice_relation_xor_list . 189)(choice_relation_and_then_list .
190)(choice_relation_or_else_list . 191)(choice_relation . 192)(discrete_choice
. 193)(discrete_choice_list . 1300)(factor . 161)(name . 197)(primary .
166)(qualified_expression . 54)(range . 198)(selected_component .
55)(simple_expression . 475)(term . 176)(term_list . 177)(unary_adding_ [...]
+ ((variant . 1299))
nil
nil
- ((record_definition . 1294))
+ ((record_definition . 1296))
nil
nil
nil
nil
nil
- ((aggregate . 153)(attribute_reference . 51)(expression .
187)(expression_opt . 1293)(factor . 155)(name . 156)(primary .
159)(qualified_expression . 54)(raise_expression . 160)(relation_and_list .
161)(relation_and_then_list . 162)(relation_or_list .
163)(relation_or_else_list . 164)(relation_xor_list . 165)(relation .
166)(selected_component . 55)(simple_expression . 167)(term . 168)(term_list .
169)(unary_adding_operator . 170))
+ ((aggregate . 157)(attribute_reference . 51)(expression .
195)(expression_opt . 1295)(factor . 161)(name . 163)(primary .
166)(qualified_expression . 54)(raise_expression . 168)(relation_and_list .
169)(relation_and_then_list . 170)(relation_or_list .
171)(relation_or_else_list . 172)(relation_xor_list . 173)(relation .
174)(selected_component . 55)(simple_expression . 175)(term . 176)(term_list .
177)(unary_adding_operator . 178))
nil
- ((identifier_opt . 1291))
- ((identifier_opt . 1290))
+ ((identifier_opt . 1293))
+ ((identifier_opt . 1292))
nil
nil
nil
nil
- ((accept_statement . 638)(assignment_statement .
639)(asynchronous_select . 640)(attribute_reference . 51)(block_statement .
641)(case_statement . 642)(conditional_entry_call . 643)(delay_statement .
644)(exit_statement . 645)(extended_return_statement . 646)(if_statement .
648)(iteration_scheme . 649)(label_opt . 650)(loop_statement . 651)(name .
652)(pragma . 653)(procedure_call_statement . 654)(qualified_expression .
54)(raise_statement . 655)(requeue_statement . 656)(selected_c [...]
+ ((accept_statement . 649)(assignment_statement .
650)(asynchronous_select . 651)(attribute_reference . 51)(block_statement .
652)(case_statement . 653)(conditional_entry_call . 654)(delay_statement .
655)(exit_statement . 656)(extended_return_statement . 657)(if_statement .
659)(iteration_scheme . 660)(label_opt . 661)(loop_statement . 662)(name .
663)(pragma . 664)(procedure_call_statement . 665)(qualified_expression .
54)(raise_statement . 666)(requeue_statement . 667)(selected_c [...]
nil
nil
nil
nil
- ((aggregate . 153)(attribute_reference . 51)(expression . 1285)(factor .
155)(name . 156)(primary . 159)(qualified_expression . 54)(raise_expression .
160)(relation_and_list . 161)(relation_and_then_list . 162)(relation_or_list .
163)(relation_or_else_list . 164)(relation_xor_list . 165)(relation .
166)(selected_component . 55)(simple_expression . 167)(term . 168)(term_list .
169)(unary_adding_operator . 170))
+ ((aggregate . 157)(attribute_reference . 51)(expression . 1287)(factor .
161)(name . 163)(primary . 166)(qualified_expression . 54)(raise_expression .
168)(relation_and_list . 169)(relation_and_then_list . 170)(relation_or_list .
171)(relation_or_else_list . 172)(relation_xor_list . 173)(relation .
174)(selected_component . 55)(simple_expression . 175)(term . 176)(term_list .
177)(unary_adding_operator . 178))
nil
nil
nil
nil
nil
- ((accept_statement . 638)(assignment_statement .
639)(asynchronous_select . 640)(attribute_reference . 51)(block_statement .
641)(case_statement . 642)(conditional_entry_call . 643)(delay_statement .
644)(exit_statement . 645)(extended_return_statement . 646)(if_statement .
648)(iteration_scheme . 649)(label_opt . 650)(loop_statement . 651)(name .
652)(pragma . 653)(procedure_call_statement . 654)(qualified_expression .
54)(raise_statement . 655)(requeue_statement . 656)(selected_c [...]
+ ((accept_statement . 649)(assignment_statement .
650)(asynchronous_select . 651)(attribute_reference . 51)(block_statement .
652)(case_statement . 653)(conditional_entry_call . 654)(delay_statement .
655)(exit_statement . 656)(extended_return_statement . 657)(if_statement .
659)(iteration_scheme . 660)(label_opt . 661)(loop_statement . 662)(name .
663)(pragma . 664)(procedure_call_statement . 665)(qualified_expression .
54)(raise_statement . 666)(requeue_statement . 667)(selected_c [...]
nil
nil
nil
@@ -4424,25 +4447,25 @@
nil
nil
nil
- ((aspect_specification_opt . 1311))
+ ((aspect_specification_opt . 1313))
nil
nil
nil
nil
- ((aspect_specification_opt . 1308))
+ ((aspect_specification_opt . 1310))
nil
nil
nil
nil
- ((aggregate . 153)(attribute_reference . 51)(factor . 155)(name .
156)(primary . 159)(qualified_expression . 54)(selected_component .
55)(simple_expression . 1325)(term . 168)(term_list .
169)(unary_adding_operator . 170))
+ ((aggregate . 157)(attribute_reference . 51)(factor . 161)(name .
163)(primary . 166)(qualified_expression . 54)(selected_component .
55)(simple_expression . 1327)(term . 176)(term_list .
177)(unary_adding_operator . 178))
nil
nil
nil
- ((aspect_clause . 1014)(at_clause . 304)(component_declaration .
1015)(component_item . 1016)(component_list . 1017)(component_list_opt .
1323)(enumeration_representation_clause . 311)(identifier_list .
1019)(record_representation_clause . 335)(variant_part . 1020))
+ ((aspect_clause . 1032)(at_clause . 308)(component_declaration .
1033)(component_item . 1034)(component_list . 1035)(component_list_opt .
1325)(enumeration_representation_clause . 315)(identifier_list .
1037)(record_representation_clause . 339)(variant_part . 1038))
nil
nil
- ((abstract_subprogram_declaration . 302)(aspect_clause . 303)(at_clause
. 304)(body . 305)(body_stub . 306)(declaration . 307)(declarations .
308)(declarative_part_opt . 1320)(entry_declaration .
310)(enumeration_representation_clause . 311)(exception_declaration .
312)(expression_function_declaration . 313)(full_type_declaration .
314)(function_specification . 16)(generic_declaration .
315)(generic_formal_part . 18)(generic_instantiation .
316)(generic_package_declaration . 20)(ge [...]
- ((aggregate . 153)(attribute_reference . 51)(discrete_subtype_definition
. 1319)(factor . 155)(name . 891)(primary . 159)(qualified_expression .
54)(range . 769)(selected_component . 55)(simple_expression .
770)(subtype_indication . 771)(term . 168)(term_list .
169)(unary_adding_operator . 170))
+ ((abstract_subprogram_declaration . 306)(aspect_clause . 307)(at_clause
. 308)(body . 309)(body_stub . 310)(declaration . 311)(declarations .
312)(declarative_part_opt . 1322)(entry_declaration .
314)(enumeration_representation_clause . 315)(exception_declaration .
316)(expression_function_declaration . 317)(full_type_declaration .
318)(function_specification . 16)(generic_declaration .
319)(generic_formal_part . 18)(generic_instantiation .
320)(generic_package_declaration . 20)(ge [...]
+ ((aggregate . 157)(attribute_reference . 51)(discrete_subtype_definition
. 1321)(factor . 161)(name . 737)(primary . 166)(qualified_expression .
54)(range . 738)(selected_component . 55)(simple_expression .
487)(subtype_indication . 739)(term . 176)(term_list .
177)(unary_adding_operator . 178))
nil
nil
nil
@@ -4456,11 +4479,11 @@
nil
nil
nil
- ((accept_statement . 638)(assignment_statement .
639)(asynchronous_select . 640)(attribute_reference . 51)(block_statement .
641)(case_statement . 642)(conditional_entry_call . 643)(delay_statement .
644)(exit_statement . 645)(extended_return_statement .
646)(handled_sequence_of_statements . 1330)(if_statement .
648)(iteration_scheme . 649)(label_opt . 650)(loop_statement . 651)(name .
652)(pragma . 653)(procedure_call_statement . 654)(qualified_expression .
54)(raise_statement . 6 [...]
- ((formal_part . 116)(parameter_profile_opt . 1329))
+ ((accept_statement . 649)(assignment_statement .
650)(asynchronous_select . 651)(attribute_reference . 51)(block_statement .
652)(case_statement . 653)(conditional_entry_call . 654)(delay_statement .
655)(exit_statement . 656)(extended_return_statement .
657)(handled_sequence_of_statements . 1332)(if_statement .
659)(iteration_scheme . 660)(label_opt . 661)(loop_statement . 662)(name .
663)(pragma . 664)(procedure_call_statement . 665)(qualified_expression .
54)(raise_statement . 6 [...]
+ ((formal_part . 117)(parameter_profile_opt . 1331))
nil
nil
- ((identifier_opt . 1332))
+ ((identifier_opt . 1334))
nil
nil]))
"Parser table.")
diff --git a/packages/ada-mode/ada-imenu.el b/packages/ada-mode/ada-imenu.el
index 459aa12..f5af9e1 100644
--- a/packages/ada-mode/ada-imenu.el
+++ b/packages/ada-mode/ada-imenu.el
@@ -1,6 +1,6 @@
-;;; ada-imenu.el - Ada mode interface to imenu for Ada Mode
+;;; ada-imenu.el - Ada mode interface to imenu for Ada Mode -*-
lexical-binding:t -*-
-;; Copyright (C) 2012, 2013 Free Software Foundation, Inc.
+;; Copyright (C) 2012, 2013, 2015 Free Software Foundation, Inc.
;;
;; Author: Simon Wright <address@hidden>
;; Contributors: see ada-mode.el, and specifically Christian Egli
@@ -70,7 +70,7 @@ each type of entity that can be found in an Ada file.")
)
;; ada--imenu-mode does not depend on file local variables
-(add-hook 'ada-mode-hook 'ada--imenu-mode)
+(add-hook 'ada-mode-hook #'ada--imenu-mode)
(provide 'ada-imenu)
diff --git a/packages/ada-mode/ada-indent-user-options.el
b/packages/ada-mode/ada-indent-user-options.el
index fabe076..1be01cd 100644
--- a/packages/ada-mode/ada-indent-user-options.el
+++ b/packages/ada-mode/ada-indent-user-options.el
@@ -1,6 +1,6 @@
-;;; user options shared by Ada mode indentation engines
+;; user options shared by Ada mode indentation engines -*- lexical-binding:t
-*-
;;
-;; Copyright (C) 2012, 2013 Free Software Foundation, Inc.
+;; Copyright (C) 2012, 2013, 2015 Free Software Foundation, Inc.
;;
;; Author: Stephen Leake <address@hidden>
;; Contributors: Simon Wright <address@hidden>
@@ -36,8 +36,7 @@ procedure Foo is
begin
>>>null;"
:type 'integer
- :group 'ada-indentation
- :safe 'integerp)
+ :safe #'integerp)
(make-variable-buffer-local 'ada-indent)
(defvar ada-broken-indent nil)
@@ -57,18 +56,30 @@ begin
Example :
My_Var : My_Type :=
>>(Field1 => Value);"
- :type 'integer
- :group 'ada-indentation
- :safe 'integerp)
+ :type 'integer
+ :safe #'integerp)
(make-variable-buffer-local 'ada-indent-broken)
(defcustom ada-indent-comment-col-0 nil
"If non-nil, comments currently starting in column 0 are left in column 0.
Otherwise, they are indented with previous comments or code."
+ :type 'boolean
+ :safe #'booleanp)
+(make-variable-buffer-local 'ada-indent-comment-col-0)
+
+(defcustom ada-indent-comment-gnat nil
+ "If non-nil, comments are indented to meet the GNAT comment style check.
+That is, one of:
+
+- multiple of ada-indent
+- next non-blank line
+- previous non-blank line
+
+Otherwise, they are indented as a with previous comments or code."
:type 'boolean
:group 'ada-indentation
- :safe 'booleanp)
-(make-variable-buffer-local 'ada-indent-comment-col-0)
+ :safe #'booleanp)
+(make-variable-buffer-local 'ada-indent-comment-gnat)
(defvar ada-label-indent nil)
(make-obsolete-variable
@@ -95,8 +106,7 @@ Example :
<<Label_2>>
<<<<Foo := 0;"
:type 'integer
- :group 'ada-indentation
- :safe 'integerp)
+ :safe #'integerp)
(make-variable-buffer-local 'ada-indent-label)
(defcustom ada-indent-record-rel-type 3
@@ -105,9 +115,8 @@ Example :
An example is:
type A is
>>>record"
- :type 'integer
- :group 'ada-indent
- :safe 'integerp)
+ :type 'integer
+ :safe #'integerp)
(make-variable-buffer-local 'ada-indent-record-rel-type)
(defcustom ada-indent-renames 2
@@ -135,9 +144,8 @@ Examples:
function A (B : Integer)
return C
>>>>>>>>>>>renames Foo;"
- :type 'integer
- :group 'ada-indent
- :safe 'integerp)
+ :type 'integer
+ :safe #'integerp)
(make-variable-buffer-local 'ada-indent-renames)
(defcustom ada-indent-return 0
@@ -154,9 +162,8 @@ relative to line containing 'function'.
An example is:
function A (B : Integer)
>>>>>>>>>>>return C;"
- :type 'integer
- :group 'ada-indent
- :safe 'integerp)
+ :type 'integer
+ :safe #'integerp)
(make-variable-buffer-local 'ada-indent-return)
(defvar ada-use-indent nil)
@@ -176,9 +183,8 @@ An example is:
An example is:
use Ada.Text_IO,
>>Ada.Numerics;"
- :type 'integer
- :group 'ada
- :safe 'integerp)
+ :type 'integer
+ :safe #'integerp)
(make-variable-buffer-local 'ada-indent-use)
(defvar ada-when-indent nil)
@@ -199,8 +205,7 @@ An example is:
case A is
>>>when B =>"
:type 'integer
- :group 'ada-indent
- :safe 'integerp)
+ :safe #'integerp)
(make-variable-buffer-local 'ada-indent-when)
(defvar ada-with-indent nil)
@@ -220,9 +225,8 @@ An example is:
An example is:
with Ada.Text_IO,
>>Ada.Numerics;"
- :type 'integer
- :group 'ada
- :safe 'integerp)
+ :type 'integer
+ :safe #'integerp)
(make-variable-buffer-local 'ada-indent-with)
(provide 'ada-indent-user-options)
diff --git a/packages/ada-mode/ada-mode-compat-23.4.el
b/packages/ada-mode/ada-mode-compat-23.4.el
deleted file mode 100644
index 8f78797..0000000
--- a/packages/ada-mode/ada-mode-compat-23.4.el
+++ /dev/null
@@ -1,41 +0,0 @@
-;;; ada-mode-compat-23.4.el --- Implement current Emacs features not present
in Emacs 23.4
-
-;; Copyright (C) 2013 Free Software Foundation, Inc.
-
-;; 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/>.
-
-(defvar compilation-filter-start (make-marker)
- "")
-
-(defun compilation-filter-start (proc)
- ""
- (set-marker compilation-filter-start (point-max)))
-
-(defun compilation--put-prop (matchnum prop val)
- (when (and (integerp matchnum) (match-beginning matchnum))
- (put-text-property
- (match-beginning matchnum) (match-end matchnum)
- prop val)))
-
-;; FIXME: emacs 24.x manages compilation-filter-start, emacs 23.4 does not
-;;
-;; gnat-core.el gnat-prj-parse-emacs-final needs:
-;; (add-hook 'compilation-start-hook 'ada-gnat-compilation-start))
-;;
-;; ada-gnat.el ada-gnat-compilation-filter needs:
-;; (set-marker compilation-filter-start (point)))
-
-;; end of file
diff --git a/packages/ada-mode/ada-mode-compat-24.2.el
b/packages/ada-mode/ada-mode-compat-24.2.el
index aa152db..51ac700 100644
--- a/packages/ada-mode/ada-mode-compat-24.2.el
+++ b/packages/ada-mode/ada-mode-compat-24.2.el
@@ -1,6 +1,7 @@
-;;; ada-mode-compat-24.2.el --- Implement current Emacs features not present
in Emacs 24.2
+;; ada-mode-compat-24.2.el --- Implement current Emacs features not present in
Emacs 24.2 -*- lexical-binding:t -*-
+;; FIXME: rename to ada-mode-compat.el, rely on functionp etc. doc emacs
version for each item
-;; Copyright (C) 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -19,13 +20,18 @@
;; using cl-lib 0.4 from Gnu ELPA
-(defun file-name-base (&optional filename)
- "Return the base name of the FILENAME: no directory, no extension.
+(when (not (functionp 'file-name-base))
+ (defun file-name-base (&optional filename)
+ "Return the base name of the FILENAME: no directory, no extension.
FILENAME defaults to `buffer-file-name'."
- (file-name-sans-extension
- (file-name-nondirectory (or filename (buffer-file-name)))))
+ (file-name-sans-extension
+ (file-name-nondirectory (or filename (buffer-file-name))))))
+(when (not (functionp 'font-lock-ensure))
+ (defun font-lock-ensure (&optional beg end)
+ (font-lock-fontify-region (or beg (point-min)) (or end (point-max)))))
+;; FIXME: need cl-flet, but there is no macrop
(provide 'ada-mode-compat-24.2)
;; end of file
diff --git a/packages/ada-mode/ada-mode.el b/packages/ada-mode/ada-mode.el
index c67a3ea..8fb112a 100644
--- a/packages/ada-mode/ada-mode.el
+++ b/packages/ada-mode/ada-mode.el
@@ -1,13 +1,13 @@
-;;; ada-mode.el --- major-mode for editing Ada sources
+;;; ada-mode.el --- major-mode for editing Ada sources -*- lexical-binding:t
-*-
;;
-;;; Copyright (C) 1994, 1995, 1997 - 2014 Free Software Foundation, Inc.
+;; Copyright (C) 1994, 1995, 1997 - 2016 Free Software Foundation, Inc.
;;
;; Author: Stephen Leake <address@hidden>
;; Maintainer: Stephen Leake <address@hidden>
;; Keywords: languages
;; ada
-;; Version: 5.1.7
-;; package-requires: ((wisi "1.1.0") (cl-lib "0.4") (emacs "24.2"))
+;; Version: 5.1.9
+;; package-requires: ((wisi "1.1.2") (cl-lib "0.4") (emacs "24.2"))
;; url: http://stephe-leake.org/emacs/ada-mode/emacs-ada-mode.html
;;
;; (Gnu ELPA requires single digits between dots in versions)
@@ -168,10 +168,10 @@
(defun ada-mode-version ()
"Return Ada mode version."
(interactive)
- (let ((version-string "5.1.7"))
+ (let ((version-string "5.1.9"))
;; must match:
;; ada-mode.texi
- ;; README
+ ;; README-ada-mode
;; Version: above
(if (called-interactively-p 'interactive)
(message version-string)
@@ -196,8 +196,7 @@ Non-nil means automatically change case of preceding word
while typing.
Casing of Ada keywords is done according to `ada-case-keyword',
identifiers are Mixed_Case."
:type 'boolean
- :group 'ada
- :safe 'booleanp)
+ :safe #'booleanp)
(make-variable-buffer-local 'ada-auto-case)
(defcustom ada-case-exception-file nil
@@ -215,28 +214,41 @@ character, and end either at the end of the word or at a _
character. Characters after the first word are ignored, and not
preserved when the list is written back to the file."
:type '(repeat (file))
- :group 'ada
- :safe 'listp)
+ :safe #'listp)
-(defcustom ada-case-keyword 'downcase-word
+(defcustom ada-case-keyword 'lower-case
"Buffer-local value that may override project variable `case_keyword'.
Global value is default for project variable `case_keyword'.
Function to call to adjust the case of Ada keywords."
- :type '(choice (const downcase-word)
- (const upcase-word))
- :group 'ada
- :safe 'functionp)
+ :type '(choice (const lower-case)
+ (const upper-case))
+ ;; We'd like to specify that the value must be a function that takes
+ ;; one arg, but custom doesn't support that. ':safe' is supposed
+ ;; to be used to prevent user-provided functions from compromising
+ ;; security, so ":safe #'functionp" is not appropriate. So we
+ ;; use a symbol, and a cl-ecase in ada-case-keyword.
+ :safe (lambda (val) (memq val '(lower-case upper-case)))
+ )
(make-variable-buffer-local 'ada-case-keyword)
-(defcustom ada-case-identifier 'ada-mixed-case
+(defcustom ada-case-identifier 'mixed-case
"Buffer-local value that may override project variable `case_keyword'.
Global value is default for project variable `case_keyword'.
-Function to call to adjust the case of Ada keywords."
- :type '(choice (const ada-mixed-case)
- (const downcase-region)
- (const upcase-region))
- :group 'ada
- :safe 'functionp)
+Function to call to adjust the case of Ada keywords.
+Called with three args;
+start - buffer pos of start of identifier
+end - end of identifier
+force-case - if t, treat `ada-case-strict' as t"
+ :type '(choice (const mixed-case)
+ (const lower-case)
+ (const upper-case))
+ ;; see comment on :safe at ada-case-keyword
+ :safe (lambda (val) (memq val '(mixed-case lower-case upper-case)))
+ )
+;; we'd like to check that there are 3 args, since the previous
+;; release required 2 here. But there doesn't seem to be a way to
+;; access the arg count, which is only available for byte-compiled
+;; functions
(make-variable-buffer-local 'ada-case-identifier)
(defcustom ada-case-strict t
@@ -245,8 +257,7 @@ Global value is default for project variable `case_strict'.
If non-nil, force Mixed_Case for identifiers.
Otherwise, allow UPPERCASE for identifiers."
:type 'boolean
- :group 'ada
- :safe 'booleanp)
+ :safe #'booleanp)
(make-variable-buffer-local 'ada-case-strict)
(defcustom ada-language-version 'ada2012
@@ -257,35 +268,36 @@ indentation parser accepts."
(const ada95)
(const ada2005)
(const ada2012))
- :group 'ada
- :safe 'symbolp)
+ :safe #'symbolp)
(make-variable-buffer-local 'ada-language-version)
(defcustom ada-fill-comment-prefix "-- "
"Comment fill prefix."
- :type 'string
- :group 'ada)
+ :type 'string)
(make-variable-buffer-local 'ada-language-version)
(defcustom ada-fill-comment-postfix " --"
"Comment fill postfix."
- :type 'string
- :group 'ada)
+ :type 'string)
(make-variable-buffer-local 'ada-language-version)
(defcustom ada-prj-file-extensions '("adp" "prj")
"List of Emacs Ada mode project file extensions.
Used when searching for a project file.
Any file with one of these extensions will be parsed by
`ada-prj-parse-file-1'."
- :type 'list
- :group 'ada)
+ :type 'list)
(defcustom ada-prj-file-ext-extra nil
"List of secondary project file extensions.
Used when searching for a project file that can be a primary or
secondary project file (referenced from a primary). The user
must provide a parser for a file with one of these extensions."
- :type 'list
+ :type 'list)
+
+(defcustom ada-prj-parse-hook nil
+ "Hook run at start of `ada-parse-prj-file'.
+Useful for setting `ada-xref-tool' and similar vars."
+ :type 'function
:group 'ada)
;;;;; end of user variables
@@ -356,7 +368,7 @@ Values defined by cross reference packages.")
(define-key map "\C-c\C-x" 'ada-show-overriding)
(define-key map "\C-c\M-x" 'ada-show-overridden)
(define-key map "\C-c\C-y" 'ada-case-create-exception)
- (define-key map "\C-c\M-y" 'ada-case-create-partial-exception)
+ (define-key map "\C-c\C-\M-y" 'ada-case-create-partial-exception)
(define-key map [C-down-mouse-3] 'ada-popup-menu)
(ada-case-activate-keys map)
@@ -377,7 +389,8 @@ Values defined by cross reference packages.")
["Find and select project ..." ada-build-prompt-select-prj-file t]
["Select project ..." ada-prj-select t]
["Show project" ada-prj-show t]
- ["Show project search path" ada-prj-show-path t]
+ ["Show project file search path" ada-prj-show-prj-path t]
+ ["Show source file search path" ada-prj-show-src-path t]
)
("Build"
["Next compilation error" next-error t]
@@ -393,6 +406,7 @@ Values defined by cross reference packages.")
("Navigate"
["Other file" ada-find-other-file t]
["Other file don't find decl" ada-find-other-file-noset t]
+ ["Find file in project" ada-find-file t]
["Goto declaration/body" ada-goto-declaration t]
["Goto next statement keyword" ada-next-statement-keyword t]
["Goto declaration start" ada-goto-declaration-start t]
@@ -456,29 +470,17 @@ Values defined by cross reference packages.")
["Indent current statement" ada-indent-statement t]
["Goto next statement keyword" ada-next-statement-keyword t]
["Goto prev statement keyword" ada-next-statement-keyword t]
- ["Other File" ada-find-other-file t]
- ["Other file don't find decl" ada-find-other-file-noset t]))
+ ["Other File" ada-find-other-file t]))
-(defun ada-popup-menu (position)
- "Pops up a `ada-context-menu', with `ada-context-menu-on-identifer' set
appropriately.
-POSITION is the location the mouse was clicked on.
-Sets `ada-context-menu-last-point' to the current position before
-displaying the menu. When a function from the menu is called,
-point is where the mouse button was clicked."
- (interactive "e")
+(defun ada-popup-menu ()
+ "Pops up `ada-context-menu'.
+When a function from the menu is called, point is where the mouse
+button was clicked."
+ (interactive)
(mouse-set-point last-input-event)
-
- (setq ada-context-menu-on-identifier
- (and (char-after)
- (or (= (char-syntax (char-after)) ?w)
- (= (char-after) ?_))
- (not (ada-in-string-or-comment-p))
- (save-excursion (skip-syntax-forward "w")
- (not (ada-after-keyword-p)))
- ))
- (popup-menu ada-context-menu)
- )
+ (popup-menu ada-context-menu)
+ )
(defun ada-indent-newline-indent ()
"insert a newline, indent the old and new lines."
@@ -591,7 +593,7 @@ Placeholders are defined by the skeleton backend."
"return\\|"
"type\\|"
"when"
- "\\)\\>\\)"))
+ "\\)\\>[^_]\\)")) ;; in case "_" has punctuation syntax
"See the variable `align-region-separate' for more information.")
(defun ada-align ()
@@ -604,23 +606,32 @@ current construct."
(deactivate-mark))
;; else see if we are in a construct we know how to align
- (cond
- ((ada-in-paramlist-p)
+ (let ((parse-result (syntax-ppss)))
+ (cond
+ ((ada-in-paramlist-p parse-result)
(ada-format-paramlist))
- (t
- (align-current))
- )))
+ ((and
+ (ada-in-paren-p parse-result)
+ (ada-in-case-expression))
+ ;; align '=>'
+ (let ((begin (nth 1 parse-result))
+ (end (scan-lists (point) 1 1)))
+ (align begin end 'entire)))
+
+ (t
+ (align-current))
+ ))))
(defvar ada-in-paramlist-p nil
;; Supplied by indentation engine parser
"Function to return t if point is inside the parameter-list of a subprogram
declaration.
-Function is called with no arguments.")
+Function is called with one optional argument; syntax-ppss result.")
-(defun ada-in-paramlist-p ()
+(defun ada-in-paramlist-p (&optional parse-result)
"Return t if point is inside the parameter-list of a subprogram declaration."
(when ada-in-paramlist-p
- (funcall ada-in-paramlist-p)))
+ (funcall ada-in-paramlist-p parse-result)))
(defun ada-format-paramlist ()
"Reformat the parameter list point is in."
@@ -809,13 +820,13 @@ Each parameter declaration is represented by a list
(defun ada-insert-paramlist-single-line (paramlist)
"Insert a single-line formatted PARAMLIST in the buffer."
+ ;; point is properly indented
(let ((i (length paramlist))
param)
;; clean up whitespace
- (skip-syntax-forward " ")
- (delete-char (- (skip-syntax-backward " ")))
- (insert " (")
+ (delete-char (- (skip-syntax-forward " ")))
+ (insert "(")
(setq i (length paramlist))
(while (not (zerop i))
@@ -1023,14 +1034,17 @@ list."
(unless word
(if (use-region-p)
- (setq word (buffer-substring-no-properties (region-beginning)
(region-end)))
+ (progn
+ (setq word (buffer-substring-no-properties (region-beginning)
(region-end)))
+ (deactivate-mark))
(save-excursion
- (skip-syntax-backward "w_")
- (setq word
- (buffer-substring-no-properties
- (point)
- (progn (skip-syntax-forward "w_") (point))
- )))))
+ (let ((syntax (if partial "w" "w_")))
+ (skip-syntax-backward syntax)
+ (setq word
+ (buffer-substring-no-properties
+ (point)
+ (progn (skip-syntax-forward syntax) (point))
+ ))))))
(let* ((exceptions (ada-case-read-exceptions file-name))
(full-exceptions (car exceptions))
@@ -1058,10 +1072,9 @@ User is prompted to choose a file from project variable
casing if it is a list."
(interactive)
(ada-case-create-exception nil nil t))
-(defun ada-in-numeric-literal-p ()
- "Return t if point is after a prefix of a numeric literal."
- ;; FIXME: this is actually a based numeric literal; excludes 1234
- (looking-back "\\([0-9]+#[0-9a-fA-F_]+\\)"))
+(defun ada-in-based-numeric-literal-p ()
+ "Return t if point is after a prefix of a based numeric literal."
+ (looking-back "\\([0-9]+#[0-9a-fA-F_]+\\)" (line-beginning-position)))
(defvar ada-keywords nil
"List of Ada keywords for current `ada-language-version'.")
@@ -1073,11 +1086,24 @@ User is prompted to choose a file from project variable
casing if it is a list."
(point))))
(member (downcase word) ada-keywords)))
-(defun ada-mixed-case (start end)
+(defun ada-case-keyword (beg end)
+ (cl-ecase ada-case-keyword
+ (lower-case (downcase-region beg end))
+ (upper-case (upcase-region beg end))
+ ))
+
+(defun ada-case-identifier (start end force-case-strict)
+ (cl-ecase ada-case-identifier
+ (mixed-case (ada-mixed-case start end force-case-strict))
+ (lower-case (downcase-region start end))
+ (upper-case (upcase-region start end))
+ ))
+
+(defun ada-mixed-case (start end force-case-strict)
"Adjust case of region START END to Mixed_Case."
(let ((done nil)
next)
- (if ada-case-strict
+ (if (or force-case-strict ada-case-strict)
(downcase-region start end))
(goto-char start)
(while (not done)
@@ -1095,7 +1121,7 @@ User is prompted to choose a file from project variable
casing if it is a list."
(setq done t))
)))
-(defun ada-case-adjust-identifier ()
+(defun ada-case-adjust-identifier (&optional force-case)
"Adjust case of the previous word as an identifier.
Uses `ada-case-identifier', with exceptions defined in
`ada-case-full-exceptions', `ada-case-partial-exceptions'."
@@ -1118,7 +1144,7 @@ Uses `ada-case-identifier', with exceptions defined in
(delete-region (point) end))
;; else apply ada-case-identifier
- (funcall ada-case-identifier start end)
+ (ada-case-identifier start end force-case)
;; apply partial-exceptions
(goto-char start)
@@ -1139,13 +1165,23 @@ Uses `ada-case-identifier', with exceptions defined in
(if (< (point) end)
(setq start (point))
(setq done t))
- )))))
+ )))))
+
+(defun ada-case-adjust-keyword ()
+ "Adjust the case of the previous word as a keyword.
+'word' here is allowed to be underscore-separated (GPR external_as_list)."
+ (save-excursion
+ (let ((end (point-marker))
+ (start (progn (skip-syntax-backward "w_") (point))))
+ (ada-case-keyword start end)
+ )))
(defun ada-case-adjust (&optional typed-char in-comment)
"Adjust the case of the word before point.
When invoked interactively, TYPED-CHAR must be
`last-command-event', and it must not have been inserted yet.
-If IN-COMMENT is non-nil, adjust case of words in comments and strings as
code."
+If IN-COMMENT is non-nil, adjust case of words in comments and strings as code,
+and treat `ada-case-strict' as t in code.."
(when (not (bobp))
(when (save-excursion
(forward-char -1); back to last character in word
@@ -1161,7 +1197,8 @@ If IN-COMMENT is non-nil, adjust case of words in
comments and strings as code."
;; referenced in a comment, via
;; ada-case-adjust-at-point.
- (not (ada-in-numeric-literal-p))
+ (not (ada-in-based-numeric-literal-p))
+ ;; don't adjust case on hex digits
))
;; The indentation engine may trigger a reparse on
@@ -1177,15 +1214,15 @@ If IN-COMMENT is non-nil, adjust case of words in
comments and strings as code."
(save-excursion
(skip-syntax-backward "w_")
(eq (char-before) ?')))
- (ada-case-adjust-identifier))
+ (ada-case-adjust-identifier in-comment))
((and
(not in-comment)
(not (eq typed-char ?_))
(ada-after-keyword-p))
- (funcall ada-case-keyword -1))
+ (ada-case-adjust-keyword))
- (t (ada-case-adjust-identifier))
+ (t (ada-case-adjust-identifier in-comment))
))
)))
@@ -1292,7 +1329,7 @@ Optional PLIST defaults to `ada-prj-current-project'."
(plist-get prj prop)
;; no project, just use default vars
- ;; must match code in ada-prj-default
+ ;; must match code in ada-prj-default, except for src_dir.
(cl-case prop
(ada_compiler ada-compiler)
(auto_case ada-auto-case)
@@ -1304,7 +1341,7 @@ Optional PLIST defaults to `ada-prj-current-project'."
(list ada-case-exception-file)))
(path_sep path-separator)
(proc_env process-environment)
- (src_dir (list "."))
+ (src_dir (list (directory-file-name default-directory)))
(xref_tool ada-xref-tool)
))))
@@ -1358,7 +1395,7 @@ Include properties set via
`ada-prj-default-compiler-alist',
(list ada-case-exception-file))
'path_sep path-separator;; prj variable so users can override it
for their compiler
'proc_env process-environment
- 'src_dir (list (if src-dir src-dir "."))
+ 'src_dir (if src-dir (list src-dir) nil)
'xref_tool ada-xref-tool
))
@@ -1388,7 +1425,8 @@ list. Parser must modify or add to the property list and
return it.")
(defun ada-parse-prj-file (prj-file)
"Read Emacs Ada or compiler-specific project file PRJ-FILE, set project
properties in `ada-prj-alist'."
;; Not called ada-prj-parse-file for Ada mode 4.01 compatibility
- ;; FIXME: use the right name, add an alias
+ ;; FIXME: need to kill gpr-query session if .gpr file has changed (like from
non-agg to agg!)
+ (run-hooks `ada-prj-parse-hook)
(let ((project (ada-prj-default))
(parser (cdr (assoc (file-name-extension prj-file)
ada-prj-parser-alist))))
@@ -1643,15 +1681,27 @@ Indexed by project variable xref_tool.")
(interactive)
(message "current Emacs Ada mode project file: %s" ada-prj-current-file))
-(defvar ada-prj-show-path nil
+(defvar ada-prj-show-prj-path nil
;; Supplied by compiler
- "Function to show project search path used by compiler (and possibly xref
tool)."
+ "Function to show project file search path used by compiler (and possibly
xref tool)."
)
-(defun ada-prj-show-path ()
+(defun ada-prj-show-prj-path ()
(interactive)
- (when ada-prj-show-path
- (funcall ada-prj-show-path)))
+ (when ada-prj-show-prj-path
+ (funcall ada-prj-show-prj-path)))
+
+(defun ada-prj-show-src-path ()
+ "Show the project source file search path."
+ (interactive)
+ (if compilation-search-path
+ (progn
+ (pop-to-buffer (get-buffer-create "*Ada project source file search
path*"))
+ (erase-buffer)
+ (dolist (file compilation-search-path)
+ (insert (format "%s\n" file))))
+ (message "no project source file search path set")
+ ))
(defvar ada-show-xref-tool-buffer nil
;; Supplied by xref tool
@@ -1902,6 +1952,17 @@ other file.")
(when ada-on-context-clause
(funcall ada-on-context-clause)))
+(defvar ada-in-case-expression nil
+ ;; supplied by indentation engine
+ "Function called with no parameters; it should return non-nil
+ if point is in a case expression.")
+
+(defun ada-in-case-expression ()
+ "See `ada-in-case-expression' variable."
+ (interactive)
+ (when ada-in-case-expression
+ (funcall ada-in-case-expression)))
+
(defvar ada-goto-subunit-name nil
;; supplied by indentation engine
"Function called with no parameters; if the current buffer
@@ -1974,13 +2035,7 @@ set."
(error "%s (opened) and %s (found in project) are two different files"
file-name found-file)))))
-(defun ada-find-other-file-noset (other-window)
- "Same as `ada-find-other-file', but preserve point in the other file,
-don't move to corresponding declaration."
- (interactive "P")
- (ada-find-other-file other-window t))
-
-(defun ada-find-other-file (other-window &optional no-set-point)
+(defun ada-find-other-file (other-window)
"Move to the corresponding declaration in another file.
- If region is active, assume it contains a package name;
@@ -2000,11 +2055,7 @@ don't move to corresponding declaration."
on the corresponding specification or body.
If OTHER-WINDOW (set by interactive prefix) is non-nil, show the
-buffer in another window.
-
-If NO-SET-POINT is nil, set point in the other file on the
-corresponding declaration. If non-nil, preserve existing point in
-the other file."
+buffer in another window."
;; ff-get-file, ff-find-other file first process
;; ff-special-constructs, then run the following hooks:
@@ -2019,6 +2070,10 @@ the other file."
(interactive "P")
(ada-check-current-project (buffer-file-name))
+ ;; clear ff-function-name, so it either ff-special-constructs or
+ ;; ada-which-function will set it.
+ (setq ff-function-name nil)
+
(cond
(mark-active
(setq ff-function-name (buffer-substring-no-properties (point) (mark)))
@@ -2059,37 +2114,36 @@ identifier. May be an Ada identifier or operator."
(when (ada-in-comment-p)
(error "Inside comment"))
- (let (identifier)
-
- (skip-chars-backward "a-zA-Z0-9_<>=+\\-\\*/&")
+ (skip-chars-backward "a-zA-Z0-9_<>=+\\-\\*/&")
- ;; Just in front of, or inside, a string => we could have an
- ;; operator function declaration.
+ ;; Just in front of, or inside, a string => we could have an
+ ;; operator function declaration.
+ (cond
+ ((ada-in-string-p)
(cond
- ((ada-in-string-p)
- (cond
- ((and (= (char-before) ?\")
- (progn
- (forward-char -1)
- (looking-at (concat "\"\\(" ada-operator-re "\\)\""))))
- (setq identifier (concat "\"" (match-string-no-properties 1) "\"")))
+ ((and (= (char-before) ?\")
+ (progn
+ (forward-char -1)
+ (looking-at (concat "\"\\(" ada-operator-re "\\)\""))))
+ (concat "\"" (match-string-no-properties 1) "\""))
- (t
- (error "Inside string or character constant"))
- ))
+ (t
+ (error "Inside string or character constant"))
+ ))
- ((and (= (char-after) ?\")
- (looking-at (concat "\"\\(" ada-operator-re "\\)\"")))
- (setq identifier (concat "\"" (match-string-no-properties 1) "\"")))
+ ((and (= (char-after) ?\")
+ (looking-at (concat "\"\\(" ada-operator-re "\\)\"")))
+ (concat "\"" (match-string-no-properties 1) "\""))
- ((looking-at "[a-zA-Z0-9_]+\\|[+\\-*/&=<>]")
- (setq identifier (match-string-no-properties 0)))
+ ((looking-at "[a-zA-Z0-9_]+\\|[+\\-*/&=<>]")
+ (match-string-no-properties 0))
- (t
- (error "No identifier around"))
- )))
+ (t
+ (error "No identifier around"))
+ ))
+;; FIXME (for emacs 25): use find-tag-marker-ring, ring-insert, pop-tag-mark
(see xref.el)
(defvar ada-goto-pos-ring '()
"List of positions selected by navigation functions. Used
to go back to these positions.")
@@ -2114,6 +2168,7 @@ to go back to these positions.")
(defun ada-goto-source (file line column other-window)
"Find and select FILE, at LINE and COLUMN.
FILE may be absolute, or on `compilation-search-path'.
+LINE, COLUMN are Emacs origin.
If OTHER-WINDOW is non-nil, show the buffer in another window."
(let ((file-1
@@ -2431,10 +2486,10 @@ is currently in. Called with no parameters.")
;; Supplied by indentation engine
"Function called with no parameters; it should move forward to
the next keyword in the statement following the one point is
-in (ie from 'if' to 'then'). If not in a keyword, move forward
-to the next keyword in the current statement. If at the last keyword,
-move forward to the first keyword in the next statement or next
-keyword in the containing statement.")
+in (ie from 'if' to 'then'). If not in a keyword, move forward to
+the next keyword in the current statement. If at the last
+keyword, move forward to the first keyword in the next statement
+or next keyword in the containing statement.")
(defvar ada-goto-end nil
;; Supplied by indentation engine
@@ -2448,12 +2503,18 @@ Called with no parameters.")
(defun ada-next-statement-keyword ()
;; Supplied by indentation engine
- "See `ada-next-statement-keyword' variable."
+ "See `ada-next-statement-keyword' variable. In addition,
+if on open parenthesis move to matching closing parenthesis."
(interactive)
- (when ada-next-statement-keyword
- (unless (region-active-p)
- (push-mark))
- (funcall ada-next-statement-keyword)))
+ (if (= (syntax-class (syntax-after (point))) 4)
+ ;; on open paren
+ (forward-sexp)
+
+ ;; else move by keyword
+ (when ada-next-statement-keyword
+ (unless (region-active-p)
+ (push-mark))
+ (funcall ada-next-statement-keyword))))
(defvar ada-prev-statement-keyword nil
;; Supplied by indentation engine
@@ -2463,12 +2524,18 @@ keyword in the statement following the one point is in
(ie from
keyword in the previous statement or containing statement.")
(defun ada-prev-statement-keyword ()
- "See `ada-prev-statement-keyword' variable."
+ "See `ada-prev-statement-keyword' variable. In addition,
+if on close parenthesis move to matching open parenthesis."
(interactive)
- (when ada-prev-statement-keyword
- (unless (region-active-p)
- (push-mark))
- (funcall ada-prev-statement-keyword)))
+ (if (= (syntax-class (syntax-after (1- (point)))) 5)
+ ;; on close paren
+ (backward-sexp)
+
+ ;; else move by keyword
+ (when ada-prev-statement-keyword
+ (unless (region-active-p)
+ (push-mark))
+ (funcall ada-prev-statement-keyword))))
;;;; code creation
@@ -2502,17 +2569,22 @@ package body file, containing skeleton code that will
compile.")
(defun ada-ff-create-body ()
;; no error if not set; let ada-skel do its thing.
(when ada-make-package-body
- ;; ff-find-other-file calls us with point in an empty buffer for the
- ;; body file; ada-make-package-body expects to be in the spec. So go
- ;; back.
- (let ((body-file-name (buffer-file-name)))
- (ff-find-the-other-file)
+ ;; ff-find-other-file calls us with point in an empty buffer for
+ ;; the body file; ada-make-package-body expects to be in the
+ ;; spec. So go back to the spec, and delete the body buffer so it
+ ;; does not get written to disk.
+ (let ((body-buffer (current-buffer))
+ (body-file-name (buffer-file-name)))
+
+ (set-buffer-modified-p nil);; may have a skeleton; allow silent delete
+
+ (ff-find-the-other-file);; back to spec
+
+ (kill-buffer body-buffer)
(ada-make-package-body body-file-name)
- ;; FIXME (later): if 'ada-make-package-body' fails, delete the body
buffer
- ;; so it doesn't get written to disk, and we can try again.
- ;; back to the body, read in from the disk.
+ ;; back to the new body file, read in from the disk.
(ff-find-the-other-file)
(revert-buffer t t))
))
@@ -2526,11 +2598,21 @@ If POSTFIX and JUSTIFY are non-nil,
`ada-fill-comment-postfix' is appended
to each line filled and justified.
The paragraph is indented on the first line."
(interactive "P")
- (if (and (not (ada-in-comment-p))
- (not (looking-at "[ \t]*--")))
+ (if (not (or (ada-in-comment-p)
+ (looking-at "[ \t]*--")))
(error "Not inside comment"))
- (let* ((inhibit-modification-hooks t) ;; don't run parser for font-lock;
comment text is exposed
+ ;; fill-region-as-paragraph leaves comment text exposed (without
+ ;; comment prefix) when inserting a newline; don't trigger a parse
+ ;; because of that (in particular, jit-lock requires a parse; other
+ ;; hooks may as well). In general, we don't need to trigger a parse
+ ;; for comment changes.
+ ;;
+ ;; FIXME: add ada-inibit-parse instead; let other change hooks run.
+ ;; FIXME: wisi-after-change still needs to adjust wisi-cache-max
+ ;; FIXME: even better, consider patch suggested by Stefan Monnier to
+ ;; move almost all code out of the change hooks (see email).
+ (let* ((inhibit-modification-hooks t)
indent from to
(opos (point-marker))
;; we bind `fill-prefix' here rather than in ada-mode because
@@ -2539,6 +2621,8 @@ The paragraph is indented on the first line."
(fill-prefix ada-fill-comment-prefix)
(fill-column (current-fill-column)))
+ ;; We should run before-change-functions here, but we don't know from/to
yet.
+
;; Find end of comment paragraph
(back-to-indentation)
(while (and (not (eobp)) (looking-at ".*--[ \t]*[^ \t\n]"))
@@ -2601,13 +2685,11 @@ The paragraph is indented on the first line."
;; we disabled modification hooks, so font-lock will not run to
;; re-fontify the comment prefix; do that here.
- (when (memq 'jit-lock-after-change after-change-functions)
- (jit-lock-after-change from to 0))
- ))
+ ;; FIXME: Use actual original size instead of 0!
+ (run-hook-with-args 'after-change-functions from to 0)))
;;;; support for font-lock.el
-;; casing keywords defined here to keep the two lists together
(defconst ada-83-keywords
'("abort" "abs" "accept" "access" "all" "and" "array" "at" "begin"
"body" "case" "constant" "declare" "delay" "delta" "digits" "do"
@@ -2661,7 +2743,9 @@ The paragraph is indented on the first line."
(setq local-abbrev-table ada-mode-abbrev-table)
(set (make-local-variable 'syntax-propertize-function)
'ada-syntax-propertize)
- (set (make-local-variable 'syntax-begin-function) nil)
+ (when (boundp 'syntax-begin-function)
+ ;; obsolete in emacs-25.1
+ (set (make-local-variable 'syntax-begin-function) nil))
(set (make-local-variable 'parse-sexp-ignore-comments) t)
(set (make-local-variable 'parse-sexp-lookup-properties) t)
(set 'case-fold-search t); Ada is case insensitive; the syntax parsing
requires this setting
@@ -2800,8 +2884,8 @@ The paragraph is indented on the first line."
(unless (featurep 'ada-xref-tool)
(cl-case ada-xref-tool
- ((nil 'gnat) (require 'ada-gnat-xref))
- ('gpr_query (require 'gpr-query))
+ ((nil gnat) (require 'ada-gnat-xref))
+ (gpr_query (require 'gpr-query))
))
(unless (featurep 'ada-compiler)
diff --git a/packages/ada-mode/ada-mode.info b/packages/ada-mode/ada-mode.info
index e2c10f9..a3f0aaa 100644
--- a/packages/ada-mode/ada-mode.info
+++ b/packages/ada-mode/ada-mode.info
@@ -1,7 +1,7 @@
-This is ada-mode.info, produced by makeinfo version 5.2 from
+This is ada-mode.info, produced by makeinfo version 6.0 from
ada-mode.texi.
-Copyright (C) 1999 - 2014 Free Software Foundation, Inc.
+Copyright (C) 1999 - 2015 Free Software Foundation, Inc.
Permission is granted to copy, distribute and/or modify this
document under the terms of the GNU Free Documentation License,
@@ -22,7 +22,9 @@ END-INFO-DIR-ENTRY
File: ada-mode.info, Node: Top, Next: Overview, Prev: (dir), Up: (dir)
-Copyright (C) 1999 - 2014 Free Software Foundation, Inc.
+Ada Mode Version 5.1.9
+
+ Copyright (C) 1999 - 2015 Free Software Foundation, Inc.
Permission is granted to copy, distribute and/or modify this
document under the terms of the GNU Free Documentation License,
@@ -94,8 +96,7 @@ File: ada-mode.info, Node: Installation, Next:
Customization, Prev: Overview,
2 Installation
**************
-Ada mode requires Emacs 24.2 or greater; it also requires the Emacs lisp
-sources (not just the compiled binaries).
+Ada mode requires Emacs 24.2 or greater.
Ada mode is distributed in the Gnu ELPA package archive; it can be
installed via 'M-x list-packages' (*note (emacs)Packages::). You must
@@ -139,22 +140,24 @@ File: ada-mode.info, Node: gpr_query, Next: Upgrading,
Prev: Ada Reference Ma
Ada mode has support for an external cross reference tool 'gpr_query',
which supports Ada, C, C++, and any other language for which AdaCore gcc
-provices the '-fdump-xref' ('-fdump-xref' is an AdaCore extension).
+provides the '-fdump-xref' ('-fdump-xref' is an AdaCore extension).
- 'gpr_query' requires the 'gnatcoll' library provided by AdaCore. Ada
-mode requires the very latest version 'gnatcoll 1.7w' distributed with
-GNAT GPL 2014.
+ 'gpr_query' requires the 'gnatcoll' library provided by AdaCore,
+distributed with GNAT GPL 2014.
To build 'gpr_query', assuming GNAT GPL 2014 is installed in
-'/usr/gnat-gpl-2014', and '/usr/gnat-gpl-2014/bin' is in PATH:
+'/usr/gnat-gpl-2014', and '/usr/gnat-gpl-2014/bin' is in PATH (if you
+are running Windows, use Cygwin bash to run these commands, with GNAT
+GPL bin first in PATH) (note that gnatcoll-gpl-2014-src.tar.gz unzips to
+gnatcoll-1.7w-src):
- tar xf ~/Downloads/gnatcoll-1.7x-src.tgz
+ tar xf ~/Downloads/gnatcoll-gpl-2014-src.tar.gz
cd gnatcoll-1.7w-src
./configure --prefix=/usr/gnat-gpl-2014
make
sudo make install
cd ~/.emacs.d/elpa/ada-mode-5.xx/build
- make install-gpr_query
+ make install
To build an sqlite3 executable that is compatible with the database
created by 'gpr_query':
@@ -280,7 +283,8 @@ it, add the following to '~/.emacs':
(require 'gpr-query)
To use 'gpr_query', the Ada code 'gpr_query.adb' must be compiled;
-see *note Installation::.
+see *note Installation::. In addition, non-Ada code must be compiled
+with the AdaCore gcc extension '-fdump-xref'.
To use a cross reference tool other than the above, you must write
Emacs lisp code that provides the interface to the compiler, and set
@@ -332,6 +336,15 @@ the syntax to set a variable is the following:
Navigate to subprograms and types by name, from a list in a
dedicated window.
'which-func'
+'jit-lock-defer-time'
+ In large files, parsing is slow, so it gets in the way of
+ interactive typing due to immediate font-lock triggering a parse.
+ Delay the font-lock by setting an Emacs file-local variable in an
+ Ada comment:
+
+ -- Local Variables:
+ -- jit-lock-defer-time: 0.5
+ -- End:
The above can all be set by the following code in your '~/.emacs'.
Note that some are functions are added to 'before-save-hook'; they run
@@ -1020,7 +1033,7 @@ line specifies a project variable name and its value,
separated by "="
concatenated.
There must be no space between the variable name and "=", and no
-trailing spaces.
+trailing spaces after the value.
The current project file is given by the lisp variable
'ada-prj-default-project-file', and shown by the menu command <Ada |
@@ -1050,10 +1063,14 @@ File: ada-mode.info, Node: Project file variables,
Prev: Project file overview
==========================
To set a project variable that is a list, specify each element of the
-list on a separate line in the project file.
+list on a separate line in the project file. The value on the last line
+is the last element in the list.
+
+ A variable name that starts with '$' is set as a process environment
+variable, for processes launched from Emacs for the project.
- Process environment variables can be referenced using the normal
-'$var' syntax.
+ In variable values, process environment variables can be referenced
+using the normal '$var' syntax.
Most project variables have defaults that can be changed by setting
elisp variables; the table below identifies the elisp variable for each
@@ -1259,6 +1276,15 @@ can also configure the indentation, via the following
variables:
column 0. Otherwise, they are indented with previous comments or
code.
+'ada-indent-comment-gnat' (default value: nil)
+ If non-nil, comments are indented to meet the GNAT style check; one
+ of:
+ * multiple of 'ada-indent'
+ * next non-blank line
+ * previous non-blank line
+
+ Otherwise, they are indented with previous comments or code.
+
'ada-indent-label' (default value: -3)
Number of columns to indent a label.
@@ -2437,47 +2463,47 @@ Index
Tag Table:
Node: Top945
-Node: Overview2576
-Node: Installation3787
-Node: Ada Reference Manual4753
-Node: gpr_query5029
-Node: Upgrading6094
-Node: Customization6666
-Node: Non-standard file names7148
-Node: Other compiler8989
-Node: Other cross-reference9568
-Node: Other customization10503
-Node: Compiling Executing13140
-Node: Compile commands13875
-Node: Compiling Examples16613
-Node: No project files17445
-Node: Set compiler options22811
-Node: Set source search path24773
-Node: Use GNAT project file27226
-Node: Use multiple GNAT project files30000
-Node: Use a Makefile32720
-Node: Compiler errors34035
-Node: Project files34852
-Node: Project file overview35879
-Node: Project file variables37407
-Node: Moving Through Ada Code41037
-Node: Identifier completion43736
-Node: Indentation44698
-Node: Statement skeletons48750
-Node: Aligning code50535
-Node: Automatic casing51480
-Node: Comment Handling54184
-Node: Key summary54703
-Node: Developer overview57330
-Node: Directory structure57670
-Node: Package organization61156
-Node: Ada mode61391
-Node: gpr mode63587
-Node: GNAT core63870
-Node: Wisi64704
-Node: OpenToken65671
-Node: ELPA66273
-Node: GNU Free Documentation License66883
-Node: Index92044
+Node: Overview2603
+Node: Installation3814
+Node: Ada Reference Manual4706
+Node: gpr_query4982
+Node: Upgrading6155
+Node: Customization6727
+Node: Non-standard file names7209
+Node: Other compiler9050
+Node: Other cross-reference9629
+Node: Other customization10654
+Node: Compiling Executing13626
+Node: Compile commands14361
+Node: Compiling Examples17099
+Node: No project files17931
+Node: Set compiler options23297
+Node: Set source search path25259
+Node: Use GNAT project file27712
+Node: Use multiple GNAT project files30486
+Node: Use a Makefile33206
+Node: Compiler errors34521
+Node: Project files35338
+Node: Project file overview36365
+Node: Project file variables37909
+Node: Moving Through Ada Code41754
+Node: Identifier completion44453
+Node: Indentation45415
+Node: Statement skeletons49763
+Node: Aligning code51548
+Node: Automatic casing52493
+Node: Comment Handling55197
+Node: Key summary55716
+Node: Developer overview58343
+Node: Directory structure58683
+Node: Package organization62169
+Node: Ada mode62404
+Node: gpr mode64600
+Node: GNAT core64883
+Node: Wisi65717
+Node: OpenToken66684
+Node: ELPA67286
+Node: GNU Free Documentation License67896
+Node: Index93057
End Tag Table
diff --git a/packages/ada-mode/ada-mode.texi b/packages/ada-mode/ada-mode.texi
index 96b2610..71b612f 100644
--- a/packages/ada-mode/ada-mode.texi
+++ b/packages/ada-mode/ada-mode.texi
@@ -3,7 +3,7 @@
@settitle Ada Mode
@copying
-Copyright @copyright{} 1999 - 2014 Free Software Foundation, Inc.
+Copyright @copyright{} 1999 - 2015 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
@@ -26,7 +26,7 @@ developing GNU and promoting software freedom.''
@titlepage
@sp 10
address@hidden Ada Mode Version 5.1.7
address@hidden Ada Mode Version 5.1.9
@page
@vskip 0pt plus 1filll
@insertcopying
@@ -36,6 +36,8 @@ developing GNU and promoting software freedom.''
@node Top, Overview, (dir), (dir)
+Ada Mode Version 5.1.9
+
@ifnottex
@insertcopying
@end ifnottex
@@ -94,8 +96,7 @@ information on debugging.
@node Installation, Customization, Overview, Top
@chapter Installation
-Ada mode requires Emacs 24.2 or greater; it also requires the Emacs
-lisp sources (not just the compiled binaries).
+Ada mode requires Emacs 24.2 or greater.
Ada mode is distributed in the Gnu ELPA package archive; it can be
installed via @code{M-x list-packages} (@pxref{Packages,,,emacs,Emacs
@@ -134,27 +135,35 @@ Annotated Ada Reference Manual in info format.
@section gpr_query
Ada mode has support for an external cross reference
tool @code{gpr_query}, which supports Ada, C, C++, and any other
-language for which AdaCore gcc provices the @code{-fdump-xref}
+language for which AdaCore gcc provides the @code{-fdump-xref}
(@code{-fdump-xref} is an AdaCore extension).
address@hidden FIXME: list xref features supported by gpr_query but not gnatfind
address@hidden at least:
address@hidden C and C++ source code
address@hidden ada-xref-overriding-function
address@hidden ada-xref-overridden-function
+
@code{gpr_query} requires the @code{gnatcoll} library provided by
-AdaCore. Ada mode requires the very latest version @code{gnatcoll
-1.7w} distributed with GNAT GPL 2014.
+AdaCore, distributed with GNAT GPL 2014.
To build @code{gpr_query}, assuming GNAT GPL 2014 is installed in
@file{/usr/gnat-gpl-2014}, and @file{/usr/gnat-gpl-2014/bin} is in
-PATH:
+PATH (if you are running Windows, use Cygwin bash to run these
+commands, with GNAT GPL bin first in PATH) (note that
+gnatcoll-gpl-2014-src.tar.gz unzips to gnatcoll-1.7w-src):
@example
-tar xf ~/Downloads/gnatcoll-1.7x-src.tgz
+tar xf ~/Downloads/gnatcoll-gpl-2014-src.tar.gz
cd gnatcoll-1.7w-src
./configure --prefix=/usr/gnat-gpl-2014
address@hidden on cygwin, finds cygwin as build type; not a problem
@c make Gnatcoll_Build=Debug
@c sudo make Gnatcoll_Build=Debug install
make
sudo make install
cd ~/.emacs.d/elpa/ada-mode-5.xx/build
-make install-gpr_query
+make install
@end example
To build an sqlite3 executable that is compatible with the database
@@ -278,7 +287,8 @@ file @file{ada-gnat-xref.el}. One other tool is supported:
@end example
To use @file{gpr_query}, the Ada code @file{gpr_query.adb} must be
-compiled; see @ref{Installation}.
+compiled; see @ref{Installation}. In addition, non-Ada code must be
+compiled with the AdaCore gcc extension @code{-fdump-xref}.
To use a cross reference tool other than the above, you must write
Emacs lisp code that provides the interface to the compiler, and set
@@ -329,6 +339,18 @@ Navigate to subprograms and types by name, from a
minibuffer menu.
@item speedbar
Navigate to subprograms and types by name, from a list in a dedicated window.
@item which-func
address@hidden jit-lock-defer-time
+In large files, parsing is slow, so it gets in the way of
+interactive typing due to immediate font-lock triggering a
+parse. Delay the font-lock by setting an Emacs file-local variable
+in an Ada comment:
+
address@hidden
+-- Local Variables:
+-- jit-lock-defer-time: 0.5
+-- End:
address@hidden example
+
@end table
The above can all be set by the following code in your
@@ -1061,7 +1083,7 @@ Some variables (like @code{src_dir}) are lists; multiple
occurrences
are concatenated.
There must be no space between the variable name and ``='', and no
-trailing spaces.
+trailing spaces after the value.
The current project file is given by the lisp variable
@code{ada-prj-default-project-file}, and shown by the menu command
@@ -1091,10 +1113,15 @@ just @code{ada-select-prj-file}, or by selecting it
from the menu.
@section Project file variables
To set a project variable that is a list, specify each element of the
-list on a separate line in the project file.
+list on a separate line in the project file. The value on the last
+line is the last element in the list.
-Process environment variables can be referenced using the
-normal @code{$var} syntax.
+A variable name that starts with @code{$} is set as a process
+environment variable, for processes launched from Emacs for the
+project.
+
+In variable values, process environment variables can be referenced
+using the normal @code{$var} syntax.
Most project variables have defaults that can be changed by setting
elisp variables; the table below identifies the elisp variable for each
@@ -1188,6 +1215,7 @@ project file.
@item @code{gpr_project_path} [default: @code{""}]
Same as @code{ada_project_path}.
address@hidden FIXME: add ada-build project vars
@end table
@node Moving Through Ada Code, Identifier completion, Project files, Top
@@ -1323,6 +1351,20 @@ Number of columns to indent the continuation of a broken
line.
If non-nil, comments currently starting in column 0 are left in column
0. Otherwise, they are indented with previous comments or code.
address@hidden @code{ada-indent-comment-gnat} (default value: nil)
+If non-nil, comments are indented to meet the GNAT style check; one
+of:
+ @itemize
+ @item
+ multiple of @code{ada-indent}
+ @item
+ next non-blank line
+ @item
+ previous non-blank line
+ @end itemize
+
+Otherwise, they are indented with previous comments or code.
+
@item @code{ada-indent-label} (default value: -3)
Number of columns to indent a label.
diff --git a/packages/ada-mode/ada-prj.el b/packages/ada-mode/ada-prj.el
index c05afbf..819c970 100644
--- a/packages/ada-mode/ada-prj.el
+++ b/packages/ada-mode/ada-prj.el
@@ -1,4 +1,4 @@
-;; dummy file to hide obsolete bundled version
+;;; ada-prj.el --- Dummy file to hide obsolete bundled version -*-
lexical-binding:t -*-
(require 'ada-mode)
(provide 'ada-prj)
(message "'ada-prj' is obsolete; use 'ada-mode' instead")
diff --git a/packages/ada-mode/ada-ref-man.el b/packages/ada-mode/ada-ref-man.el
old mode 100755
new mode 100644
diff --git a/packages/ada-mode/ada-skel.el b/packages/ada-mode/ada-skel.el
index 9544222..d8b6a68 100644
--- a/packages/ada-mode/ada-skel.el
+++ b/packages/ada-mode/ada-skel.el
@@ -1,6 +1,6 @@
-;;; ada-skel.el --- an extension to Ada mode for inserting statement skeletons
+;;; ada-skel.el --- Extension to Ada mode for inserting statement skeletons
-*- lexical-binding:t -*-
-;; Copyright (C) 1987, 1993, 1994, 1996-2014 Free Software Foundation, Inc.
+;; Copyright (C) 1987, 1993, 1994, 1996-2015 Free Software Foundation, Inc.
;; Authors: Stephen Leake <address@hidden>
@@ -74,11 +74,11 @@
-- This text was inserted by ada-skel-initial-string;
-- M-x customize-variable <RET> ada-skel-initial-string <RET>
-- (info \"(ada-mode)Statement skeletons\")"
- "*String to insert in empty buffer.
+ "String to insert in empty buffer.
This could end in a token recognized by `ada-skel-expand'."
:type 'string
:group 'ada
- :safe 'stringp)
+ :safe #'stringp)
(define-skeleton ada-skel-user-restricted
"Example copyright/license skeleton, with automatic year and owner."
@@ -453,10 +453,10 @@ it is a name, and use the word before that as the token."
(provide 'ada-skeletons)
(provide 'ada-skel)
-(setq ada-expand 'ada-skel-expand)
-(setq ada-next-placeholder 'ada-skel-next-placeholder)
-(setq ada-prev-placeholder 'ada-skel-prev-placeholder)
+(setq ada-expand #'ada-skel-expand)
+(setq ada-next-placeholder #'ada-skel-next-placeholder)
+(setq ada-prev-placeholder #'ada-skel-prev-placeholder)
-(add-hook 'ada-mode-hook 'ada-skel-setup)
+(add-hook 'ada-mode-hook #'ada-skel-setup)
;;; ada-skel.el ends here
diff --git a/packages/ada-mode/ada-stmt.el b/packages/ada-mode/ada-stmt.el
index 163c1de..3f5ed24 100644
--- a/packages/ada-mode/ada-stmt.el
+++ b/packages/ada-mode/ada-stmt.el
@@ -1,4 +1,4 @@
-;; dummy file to hide obsolete bundled version
+;;; ada-stmt.el --- Dummy file to hide obsolete bundled version -*-
lexical-binding:t -*-
(require 'ada-mode)
(provide 'ada-stmt)
(message "'ada-stmt' is obsolete; use 'ada-mode' instead")
diff --git a/packages/ada-mode/ada-wisi-opentoken.el
b/packages/ada-mode/ada-wisi-opentoken.el
index 7b7ad0b..fbc4daf 100644
--- a/packages/ada-mode/ada-wisi-opentoken.el
+++ b/packages/ada-mode/ada-wisi-opentoken.el
@@ -1,7 +1,7 @@
-;;; ada-wisi-opentoken.el --- An indentation function for ada-wisi that
indents OpenToken
-;; grammar statements nicely.
+;; ada-wisi-opentoken.el --- An indentation function for ada-wisi that indents
-*- lexical-binding:t -*-
+;; OpenTokengrammar statements nicely.
-;; Copyright (C) 2013, 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2015 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/packages/ada-mode/ada-wisi.el b/packages/ada-mode/ada-wisi.el
index e939ce7..e076bc0 100644
--- a/packages/ada-mode/ada-wisi.el
+++ b/packages/ada-mode/ada-wisi.el
@@ -1,8 +1,8 @@
-;;; An indentation engine for Ada mode, using the wisi generalized LALR parser
+;;; ada-wisi.el --- Indentation engine for Ada mode, using the wisi
generalized LALR parser -*- lexical-binding:t -*-
;;
;; [1] ISO/IEC 8652:2012(E); Ada 2012 reference manual
;;
-;; Copyright (C) 2012 - 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2012 - 2016 Free Software Foundation, Inc.
;;
;; Author: Stephen Leake <address@hidden>
;;
@@ -44,8 +44,8 @@
name-paren ;; anything that looks like a procedure call, since the grammar
can't distinguish most of them
open-paren
return
- return-1
- return-2
+ return-with-params
+ return-without-params
statement-end
statement-other
statement-start
@@ -135,7 +135,11 @@ if in paren, pos following paren."
;; test/ada_mode-opentoken.ads
;; private package GDS.Commands.Add_Statement is
;; type Instance is new Nonterminal.Instance with null record;
- offset)
+ ;;
+ ;; test/ada_mode-nominal.adb
+ ;; return B : Integer :=
+ ;; (Local_Function);
+ (+ indent offset))
((eq 'label_opt (wisi-cache-token cache))
(+ indent (- ada-indent-label) offset))
@@ -302,6 +306,17 @@ point must be on CACHE. PREV-TOKEN is the token before the
one being indented."
;; defer to after-cache)
nil)
+ (list-break
+ ;; test/ada_mode-parens.adb
+ ;; Foo (X
+ ;; , -- used to get an error here; don't care about the
actual indentation
+ ;; indenting ','
+ ;;
+ ;; We don't actually care what the indentation is, since this
+ ;; should only occur while editing; defer to after-cache
+ ;; avoids an error and does something reasonable.
+ nil)
+
(name
(cond
((let ((temp (save-excursion (wisi-goto-containing cache))))
@@ -462,7 +477,7 @@ point must be on CACHE. PREV-TOKEN is the token before the
one being indented."
))
)))
- (return-1;; parameter list
+ (return-with-params;; parameter list
(let ((return-pos (point)))
(wisi-goto-containing cache nil) ;; matching 'function'
(cond
@@ -475,7 +490,7 @@ point must be on CACHE. PREV-TOKEN is the token before the
one being indented."
(+ (current-column) ada-indent-return))
)))
- (return-2;; no parameter list
+ (return-without-params;; no parameter list
(wisi-goto-containing cache nil) ;; matching 'function'
(+ (current-column) ada-indent-broken))
@@ -563,8 +578,14 @@ point must be on CACHE. PREV-TOKEN is the token before the
one being indented."
;; indenting 'new'; containing is 'with'
(+ (current-column) ada-indent-broken))
- ((full_type_declaration subtype_declaration)
- (while (not (memq (wisi-cache-token containing) '(TYPE
SUBTYPE)))
+ ((full_type_declaration
+ protected_type_declaration
+ single_protected_declaration
+ single_task_declaration
+ subtype_declaration
+ task_type_declaration)
+
+ (while (not (memq (wisi-cache-token containing)
'(PROTECTED SUBTYPE TASK TYPE)))
(setq containing (wisi-goto-containing containing)))
(cond
@@ -578,6 +599,18 @@ point must be on CACHE. PREV-TOKEN is the token before the
one being indented."
;; subtype Integer_String is String
;; with Dynamic_Predicate => Integer'Value
(Integer_String) in Integer
;; indenting 'with'
+ ;;
+ ;; test/ada_mode.ads
+ ;; protected Separate_Protected_Body
+ ;; with
+ ;; Priority => 5
+ ;; indenting 'with'
+ ;;
+ ;; test/ada_nominal.ads
+ ;; task type Task_Type_1 (Name : access String)
+ ;; with
+ ;; Storage_Size => 512 + 256
+ ;; indenting 'with'
type-col)
(null_private
@@ -652,10 +685,21 @@ point must be on CACHE. PREV-TOKEN is the token before
the one being indented."
))
(private_extension_declaration
- ;; test/ada_mode-nominal.ads
- ;; type Limited_Derived_Type_3 is abstract limited
- ;; new Private_Type_1 with private;
- (+ (current-indentation) ada-indent-broken))
+ (cl-ecase (wisi-cache-token cache)
+ (WITH
+ ;; test/aspects.ads
+ ;; type Date_Set is tagged private
+ ;; with
+ ;; indenting 'with'
+ (current-indentation))
+
+ (t
+ ;; test/ada_mode-nominal.ads
+ ;; type Limited_Derived_Type_3 is abstract limited
+ ;; new Private_Type_1 with private;
+ ;; indenting 'new'
+ (+ (current-indentation) ada-indent-broken))
+ ))
(private_type_declaration
;; test/aspects.ads
@@ -686,7 +730,12 @@ point must be on CACHE. PREV-TOKEN is the token before the
one being indented."
(ada-wisi-indent-cache ada-indent-broken cache))
))
- ((subprogram_body subprogram_declaration
subprogram_specification null_procedure_declaration)
+ ((abstract_subprogram_declaration
+ expression_function_declaration
+ subprogram_body
+ subprogram_declaration
+ subprogram_specification
+ null_procedure_declaration)
(cl-ecase (wisi-cache-token cache)
(IS
;; test/ada_mode-nominal.ads
@@ -744,9 +793,6 @@ point must be on CACHE. PREV-TOKEN is the token before the
one being indented."
(list-break
(ada-wisi-indent-list-break cache prev-token))
- (statement-other
- ;; defer to ada-wisi-after-cache
- nil)
))))
))
))
@@ -898,7 +944,7 @@ cached token, return new indentation for point."
;; 1)
(+ paren-column 1 ada-indent-broken))))
- ((return-1 return-2)
+ ((return-with-params return-without-params)
;; test/ada_mode-nominal.adb
;; function Function_Access_1
;; (A_Param : in Float)
@@ -1087,11 +1133,15 @@ cached token, return new indentation for point."
;; type Synchronized_Formal_Derived_Type is abstract
synchronized new Formal_Private_Type and Interface_Type
;; with private;
- subtype_declaration)
- ;; test/ada_mode-nominal.ads
- ;; subtype Subtype_2 is Signed_Integer_Type range 10 ..
- ;; 20;
+ subtype_declaration
+ ;; test/ada_mode-nominal.ads
+ ;; subtype Subtype_2 is Signed_Integer_Type range 10 ..
+ ;; 20;
+ private_type_declaration
+ ;; type Private_Type_2 is abstract tagged limited
+ ;; private;
+ )
(+ (current-column) ada-indent-broken))
(null_procedure_declaration
@@ -1136,7 +1186,7 @@ cached token, return new indentation for point."
(ada-wisi-indent-containing ada-indent-broken cache))
(WITH
- (cl-case (wisi-cache-nonterm cache)
+ (cl-ecase (wisi-cache-nonterm cache)
(aggregate
;; test/ada_mode-nominal-child.ads
;; (Default_Parent with
@@ -1211,8 +1261,47 @@ cached token, return new indentation for point."
;; would align the comment with the block-middle, which is wrong. So
;; we only call ada-wisi-after-cache.
- ;; FIXME: need option to match gnat style check; change indentation to
match (ie mod 3)
- (ada-wisi-after-cache))
+ (let ((indent (ada-wisi-after-cache))
+ prev-indent next-indent)
+ (if ada-indent-comment-gnat
+ ;; match the gnat comment indent style check; comments must
+ ;; be aligned to one of:
+ ;;
+ ;; - multiple of ada-indent
+ ;; - next non-blank line
+ ;; - previous non-blank line
+ ;;
+ ;; Note that we must indent the prev and next lines, in case
+ ;; they are not currently correct.
+ (cond
+ ((= 0 (% indent ada-indent))
+ ;; this will handle comments at bob and eob, so we don't
+ ;; need to worry about those positions in the next checks.
+ indent)
+
+ ((and (setq prev-indent
+ (save-excursion (forward-line
-1)(indent-according-to-mode)(current-indentation)))
+ (= indent prev-indent))
+ indent)
+
+ ((and (setq next-indent
+ ;; we use forward-comment here, instead of
+ ;; forward-line, because consecutive comment
+ ;; lines are indented to the current one, which
+ ;; we don't know yet.
+ (save-excursion (forward-comment
(point-max))(indent-according-to-mode)(current-indentation)))
+ (= indent next-indent))
+ indent)
+
+ (t
+ (or
+ prev-indent
+ next-indent
+ (floor indent ada-indent)))
+ )
+
+ ;; not forcing gnat style
+ indent)))
(t
;; comment is after a comment
@@ -1270,10 +1359,24 @@ cached token, return new indentation for point."
(defun ada-wisi-on-context-clause ()
"For `ada-on-context-clause'."
-
+ (let (cache)
+ (save-excursion
+ ;; Don't require parse of large file just for ada-find-other-file
+ (and (< (point-max) wisi-size-threshold)
+ (setq cache (wisi-goto-statement-start))
+ (memq (wisi-cache-nonterm cache) '(use_clause with_clause))
+ ))))
+
+(defun ada-wisi-in-case-expression ()
+ "For `ada-in-case-expression'."
(save-excursion
- (and (wisi-goto-statement-start)
- (memq (wisi-cache-nonterm (wisi-goto-statement-start)) '(use_clause
with_clause)))))
+ ;; Used by ada-align, which does indent, which will require parse
+ ;; We know we are in a paren.
+ (ada-goto-open-paren 1)
+ (let ((cache (wisi-get-cache (point))))
+ (and cache
+ (eq (wisi-cache-nonterm cache) 'case_expression)))
+ ))
(defun ada-wisi-goto-subunit-name ()
"For `ada-goto-subunit-name'."
@@ -1336,7 +1439,10 @@ Also return cache at start."
((protected_body protected_type_declaration
single_protected_declaration)
(eq (wisi-cache-token cache) 'PROTECTED))
- ((subprogram_body subprogram_declaration
null_procedure_declaration)
+ ((abstract_subprogram_declaration
+ subprogram_body
+ subprogram_declaration
+ null_procedure_declaration)
(memq (wisi-cache-token cache) '(NOT OVERRIDING FUNCTION
PROCEDURE)))
(task_type_declaration
@@ -1419,11 +1525,11 @@ Also return cache at start."
(when first (setq first nil)))
))
-(defun ada-wisi-in-paramlist-p ()
+(defun ada-wisi-in-paramlist-p (&optional parse-result)
"For `ada-in-paramlist-p'."
(wisi-validate-cache (point))
;; (info "(elisp)Parser State" "*syntax-ppss*")
- (let* ((parse-result (syntax-ppss))
+ (let ((parse-result (or parse-result (syntax-ppss)))
cache)
(and (> (nth 0 parse-result) 0)
;; cache is nil if the parse failed
@@ -1514,6 +1620,10 @@ Also return cache at start."
(setq default-begin (point))
(wisi-forward-find-token 'SEMICOLON end t))
+ ((equal token 'LEFT_PAREN)
+ ;; anonymous access procedure type
+ (goto-char (scan-sexps (1- (point)) 1)))
+
((member token '(SEMICOLON RIGHT_PAREN))
(when (not type-end)
(setq type-end (save-excursion (backward-char 1)
(skip-syntax-backward " ") (point))))
@@ -1551,13 +1661,11 @@ Also return cache at start."
paramlist))
(defun ada-wisi-which-function-1 (keyword add-body)
- "used in `ada-wisi-which-function'."
- (let (region
- result
- (cache (wisi-forward-find-class 'name (point-max))))
-
- (setq result (wisi-cache-text cache))
+ "Used in `ada-wisi-which-function'."
+ (let* ((cache (wisi-forward-find-class 'name (point-max)))
+ (result (wisi-cache-text cache)))
+ ;; See comment at ada-mode.el on why we don't overwrite ff-function-name.
(when (not ff-function-name)
(setq ff-function-name
(concat
@@ -1578,12 +1686,11 @@ Also return cache at start."
;; bob or failed parse
(setq result "")
- (cl-case (wisi-cache-nonterm cache)
- ((generic_package_declaration generic_subprogram_declaration)
- ;; name is after next statement keyword
- (wisi-next-statement-cache cache)
- (setq cache (wisi-get-cache (point))))
- )
+ (when (memq (wisi-cache-nonterm cache)
+ '(generic_package_declaration
generic_subprogram_declaration))
+ ;; name is after next statement keyword
+ (wisi-next-statement-cache cache)
+ (setq cache (wisi-get-cache (point))))
;; add or delete 'body' as needed
(cl-ecase (wisi-cache-nonterm cache)
@@ -1600,7 +1707,8 @@ Also return cache at start."
((protected_type_declaration single_protected_declaration)
(setq result (ada-wisi-which-function-1 "protected" t)))
- ((subprogram_declaration
+ ((abstract_subprogram_declaration
+ subprogram_declaration
generic_subprogram_declaration ;; after 'generic'
null_procedure_declaration)
(setq result (ada-wisi-which-function-1
@@ -1639,12 +1747,12 @@ TOKEN-TEXT; move point to just past token."
(let ((end (point)))
;; this first test must be very fast; it is executed for every token
(when (and (memq (aref token-text 0) '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))
- (string-match "^[0-9]+" token-text))
+ (string-match "^[0-9_]+$" token-text))
(cond
((= (char-after) ?#)
;; based number
(forward-char 1)
- (if (not (looking-at "[0-9a-fA-F]+"))
+ (if (not (looking-at "[0-9a-fA-F_]+"))
(progn (goto-char end) nil)
(goto-char (match-end 0))
@@ -1689,7 +1797,7 @@ TOKEN-TEXT; move point to just past token."
((= (char-after) ?.)
;; decimal real number?
(forward-char 1)
- (if (not (looking-at "[0-9]+"))
+ (if (not (looking-at "[0-9_]+"))
;; decimal integer
(progn (goto-char end) t)
@@ -1744,6 +1852,7 @@ TOKEN-TEXT; move point to just past token."
(setq ada-make-subprogram-body 'ada-wisi-make-subprogram-body)
(setq ada-next-statement-keyword 'wisi-forward-statement-keyword)
(setq ada-on-context-clause 'ada-wisi-on-context-clause)
+(setq ada-in-case-expression 'ada-wisi-in-case-expression)
(setq ada-prev-statement-keyword 'wisi-backward-statement-keyword)
(setq ada-reset-parser 'wisi-invalidate-cache)
(setq ada-scan-paramlist 'ada-wisi-scan-paramlist)
diff --git a/packages/ada-mode/ada-xref.el b/packages/ada-mode/ada-xref.el
index be8edc2..6816d8a 100644
--- a/packages/ada-mode/ada-xref.el
+++ b/packages/ada-mode/ada-xref.el
@@ -1,4 +1,5 @@
-;; dummy file to hide obsolete bundled version
+;;; ada-xref.el --- Dummy file to hide obsolete bundled version -*-
lexical-binding:t -*-
+;;; see xref-ada.el for Emacs 25 xref minor mode for ada-mode
(require 'ada-mode)
(provide 'ada-xref)
(message "'ada-xref' is obsolete; use 'ada-mode' instead")
diff --git a/packages/ada-mode/gnat-core.el b/packages/ada-mode/gnat-core.el
index 287bad4..f8d4f31 100644
--- a/packages/ada-mode/gnat-core.el
+++ b/packages/ada-mode/gnat-core.el
@@ -1,9 +1,9 @@
-;; Support for running GNAT tools, which support multiple programming
+;; gnat-core.el --- Support for running GNAT tools, which support multiple
programming -*- lexical-binding:t -*-
;; languages.
;;
;; GNAT is provided by AdaCore; see http://libre.adacore.com/
;;
-;;; Copyright (C) 2012 - 2014 Free Software Foundation, Inc.
+;;; Copyright (C) 2012 - 2015 Free Software Foundation, Inc.
;;
;; Author: Stephen Leake <address@hidden>
;; Maintainer: Stephen Leake <address@hidden>
@@ -56,16 +56,16 @@
project))
-(defun gnat-prj-show-path ()
- "For `ada-prj-show-path'."
+(defun gnat-prj-show-prj-path ()
+ "For `ada-prj-show-prj-path'."
(interactive)
(if (ada-prj-get 'prj_dir)
(progn
- (pop-to-buffer (get-buffer-create "*GNAT project search path*"))
+ (pop-to-buffer (get-buffer-create "*GNAT project file search path*"))
(erase-buffer)
(dolist (file (ada-prj-get 'prj_dir))
(insert (format "%s\n" file))))
- (message "no GNAT project search path files")
+ (message "no project file search path set")
))
(defun gnat-prj-parse-emacs-one (name value project)
@@ -147,7 +147,7 @@ Uses 'gnat list'. Returns new (SRC-DIRS PRJ-DIRS)."
(while (not (looking-at "^$"))
(back-to-indentation)
(if (looking-at "<Current_Directory>")
- (cl-pushnew "." prj-dirs :test #'equal)
+ (cl-pushnew (directory-file-name default-directory) prj-dirs
:test #'equal)
(let ((f (expand-file-name
(buffer-substring-no-properties (point)
(point-at-eol)))))
(cl-pushnew f prj-dirs :test #'equal)
@@ -162,15 +162,16 @@ Uses 'gnat list'. Returns new (SRC-DIRS PRJ-DIRS)."
))
(list src-dirs prj-dirs)))
+;; FIXME: use a dispatching function instead, with autoload, to
+;; avoid "require" here, and this declare
+;; Using 'require' at top level gives the wrong default ada-xref-tool
+(declare-function gpr-query-get-src-dirs "gpr-query.el" (src-dirs))
+(declare-function gpr-query-get-prj-dirs "gpr-query.el" (prj-dirs))
(defun gnat-get-paths (project)
"Add project and/or compiler source, project paths to PROJECT src_dir and/or
prj_dir."
(let ((src-dirs (ada-prj-get 'src_dir project))
(prj-dirs (ada-prj-get 'prj_dir project)))
- ;; FIXME: use a dispatching function instead, with autoload, to
- ;; avoid "require" here, which gives "warning: function not
- ;; known".
- ;; Using 'require' at top level gives the wrong default ada-xref-tool
(cl-ecase (ada-prj-get 'xref_tool project)
(gnat
(let ((res (gnat-get-paths-1 src-dirs prj-dirs)))
@@ -345,6 +346,11 @@ list."
)
)))
+(defun gnatprep-setup ()
+ (when (boundp 'wisi-indent-calculate-functions)
+ (add-to-list 'wisi-indent-calculate-functions 'gnatprep-indent))
+ )
+
;;;; support for xref tools
(defun ada-gnat-file-name-from-ada-name (ada-name)
"For `ada-file-name-from-ada-name'."
@@ -373,6 +379,7 @@ list."
'(("a-textio" . "Ada.Text_IO")
("a-chahan" . "Ada.Characters.Handling")
("a-comlin" . "Ada.Command_Line")
+ ("a-contai" . "Ada.Containers")
("a-except" . "Ada.Exceptions")
("a-numeri" . "Ada.Numerics")
("a-string" . "Ada.Strings")
@@ -391,9 +398,8 @@ list."
(defun ada-gnat-ada-name-from-file-name (file-name)
"For `ada-ada-name-from-file-name'."
- (let* (status
- (ada-name (file-name-sans-extension (file-name-nondirectory
file-name)))
- (predefined (cdr (assoc ada-name ada-gnat-predefined-package-alist))))
+ (let* ((ada-name (file-name-sans-extension (file-name-nondirectory
file-name)))
+ (predefined (cdr (assoc ada-name ada-gnat-predefined-package-alist))))
(if predefined
predefined
@@ -415,19 +421,15 @@ list."
;; contain path info. So we pass a directory to gnat-run-no-prj.
(let ((start-buffer (current-buffer))
(start-file (buffer-file-name))
- ;; can also specify gnat stub options/switches in .gpr file, in package
'gnatstub'.
(opts (when (ada-prj-get 'gnat_stub_opts)
(split-string (ada-prj-get 'gnat_stub_opts))))
(switches (when (ada-prj-get 'gnat_stub_switches)
(split-string (ada-prj-get 'gnat_stub_switches))))
+ (process-environment (ada-prj-get 'proc_env)) ;; for GPR_PROJECT_PATH
)
- ;; Make sure all relevant files are saved to disk. This also saves
- ;; the bogus body buffer created by ff-find-the-other-file, so we
- ;; need -f gnat stub option. We won't get here if there is an
- ;; existing body file.
+ ;; Make sure all relevant files are saved to disk.
(save-some-buffers t)
- (cl-pushnew "-f" opts :test #'equal)
(with-current-buffer (gnat-run-buffer)
(gnat-run-no-prj
(append (list "stub") opts (list start-file "-cargs") switches)
diff --git a/packages/ada-mode/gnat-inspect.el
b/packages/ada-mode/gnat-inspect.el
deleted file mode 100644
index 5fb2d4b..0000000
--- a/packages/ada-mode/gnat-inspect.el
+++ /dev/null
@@ -1,572 +0,0 @@
-;;; gnat-inspect.el --- minor-mode for navigating sources using the
-;;; AdaCore cross reference tool gnatinspect.
-;;;
-;;; gnatinspect supports Ada and any gcc language that supports the
-;;; -fdump-xref switch (which includes C, C++).
-;;
-;;; Copyright (C) 2013, 2014 Free Software Foundation, Inc.
-
-;; Author: Stephen Leake <address@hidden>
-;; Maintainer: Stephen Leake <address@hidden>
-;; Version: 1.0
-
-;; 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/>.
-
-;;; Usage:
-;;
-;; M-x gnat-inspect
-
-(require 'ada-mode) ;; for ada-prj-*, some other things
-(require 'cl-lib)
-(require 'compile)
-
-;;;;; sessions
-
-;; gnatinspect reads the project files and the database at startup,
-;; which is noticeably slow for a reasonably sized project. But
-;; running queries after startup is fast. So we leave gnatinspect
-;; running, and send it new queries via stdin, getting responses via
-;; stdout.
-;;
-;; We maintain a cache of active sessions, one per gnat project.
-
-(cl-defstruct (gnat-inspect--session)
- (process nil) ;; running gnatinspect
- (buffer nil) ;; receives output of gnatinspect
- (sent-kill-p nil)
- (closed-p nil))
-
-(defconst gnat-inspect-buffer-name-prefix " *gnatinspect-")
-
-(defun gnat-inspect--start-process (session)
- "Start the session process running gnatinspect."
- (unless (buffer-live-p (gnat-inspect--session-buffer session))
- ;; user may have killed buffer
- (setf (gnat-inspect--session-buffer session) (gnat-run-buffer
gnat-inspect-buffer-name-prefix)))
-
- (with-current-buffer (gnat-inspect--session-buffer session)
- (let ((process-environment (ada-prj-get 'proc_env)) ;; for GPR_PROJECT_PATH
-
- ;; WORKAROUND: gnatinspect from gnatcoll-1.6w-20130902 can't handle
aggregate projects; M910-032
- (project-file (file-name-nondirectory
- (ada-prj-get 'gpr_file))))
- (erase-buffer); delete any previous messages, prompt
- (setf (gnat-inspect--session-process session)
- ;; FIXME: need good error message on bad project file:
- ;; "can't handle aggregate projects?")
- (start-process (concat "gnatinspect " (buffer-name))
- (gnat-inspect--session-buffer session)
- "gnatinspect"
- (concat "--project=" project-file)))
- (set-process-query-on-exit-flag (gnat-inspect--session-process session)
nil)
- (gnat-inspect-session-wait session)
- )))
-
-(defun gnat-inspect--make-session ()
- "Create and return a session for the current project file."
- (let ((session
- (make-gnat-inspect--session
- :buffer (gnat-run-buffer gnat-inspect-buffer-name-prefix))))
- (gnat-inspect--start-process session)
- session))
-
-(defvar gnat-inspect--sessions '()
- "Assoc list of sessions, indexed by absolute GNAT project file name.")
-
-(defun gnat-inspect-cached-session ()
- "Return a session for the current project file, creating it if necessary."
- (gnat-inspect-ensure-gpr)
-
- (let* ((session (cdr (assoc ada-prj-current-file gnat-inspect--sessions))))
- (if session
- (progn
- (unless (process-live-p (gnat-inspect--session-process session))
- (gnat-inspect--start-process session))
- session)
- ;; else
- (prog1
- (setq session (gnat-inspect--make-session))
- (setq gnat-inspect--sessions
- (cl-acons ada-prj-current-file session gnat-inspect--sessions))))
- ))
-
-(defun gnat-inspect-show-session-buffer ()
- (interactive)
- (pop-to-buffer (gnat-inspect-cached-session)))
-
-(defconst gnat-inspect-prompt "^>>> $"
- ;; gnatinspect output ends with this
- "Regexp matching gnatinspect prompt; indicates previous command is
complete.")
-
-(defun gnat-inspect-session-wait (session)
- "Wait for the current command to complete."
- (unless (process-live-p (gnat-inspect--session-process session))
- (error "gnatinspect process failed"))
-
- (with-current-buffer (gnat-inspect--session-buffer session)
- (let ((process (gnat-inspect--session-process session))
- (search-start (point-min))
- (wait-count 0))
- (while (progn
- ;; process output is inserted before point, so move back over it
to search it
- (goto-char search-start)
- (not (re-search-forward gnat-inspect-prompt (point-max) 1)));;
don't search same text again
- (setq search-start (point))
- (message (concat "running gnatinspect ..." (make-string wait-count ?.)))
- (accept-process-output process 1.0)
- (setq wait-count (1+ wait-count)))
- (message (concat "running gnatinspect ... done"))
- )))
-
-(defun gnat-inspect-session-send (cmd wait)
- "Send CMD to gnatinspect session for current project.
-If WAIT is non-nil, wait for command to complete.
-Return buffer that holds output."
- (let ((session (gnat-inspect-cached-session)))
- (with-current-buffer (gnat-inspect--session-buffer session)
- (erase-buffer)
- (process-send-string (gnat-inspect--session-process session)
- (concat cmd "\n"))
- (when wait
- (gnat-inspect-session-wait session))
- (current-buffer)
- )))
-
-(defun gnat-inspect-kill-all-sessions ()
- (interactive)
- (let ((count 0))
- (mapc (lambda (assoc)
- (let ((session (cdr assoc)))
- (when (process-live-p (gnat-inspect--session-process session))
- (setq count (1+ count))
- (process-send-string (gnat-inspect--session-process session)
"exit\n")
- )))
- gnat-inspect--sessions)
- (message "Killed %d sessions" count)
- ))
-
-;;;;; utils
-
-(defun gnat-inspect-ensure-gpr ()
- (unless (ada-prj-get 'gpr_file)
- (error "no gpr file specified")))
-
-(defconst gnat-inspect-ident-file-regexp
- ;;
Write_Message:C:\Projects\GDS\work_dscovr_release\common\1553\gds-mil_std_1553-utf.ads:252:25
- ;;
Write_Message:/Projects/GDS/work_dscovr_release/common/1553/gds-mil_std_1553-utf.ads:252:25
-
"\\([^:]*\\):\\(\\(?:.:\\\|/\\)[^:]*\\):\\([0123456789]+\\):\\([0123456789]+\\)"
- "Regexp matching <identifier>:<file>:<line>:<column>")
-
-(defconst gnat-inspect-ident-file-regexp-alist
- (list (concat "^" gnat-inspect-ident-file-regexp) 2 3 4)
- "For compilation-error-regexp-alist, matching `gnatinspect
overriding_recursive' output")
-
-(defconst gnat-inspect-ident-file-type-regexp
- (concat gnat-inspect-ident-file-regexp " (\\(.*\\))")
- "Regexp matching <identifier>:<file>:<line>:<column> (<type>)")
-
-(defconst gnat-inspect-ident-file-scope-regexp-alist
- ;; RX_Enable:C:\common\1553\gds-hardware-bus_1553-raw_read_write.adb:163:13
(write reference)
scope=New_Packet_TX:C:\common\1553\gds-hardware-bus_1553-raw_read_write.adb:97:14
-
- (list (concat
- gnat-inspect-ident-file-regexp
- " (.*) "
- "scope="
- gnat-inspect-ident-file-regexp
- )
- 2 3 4;; file line column
- ;; 2 ;; type = error
- ;; nil ;; hyperlink
- ;; (list 4 'gnat-inspect-scope-secondary-error)
- )
- "For compilation-error-regexp-alist, matching `gnatinspect refs' output")
-
-;; debugging:
-;; in *compilation-gnatinspect-refs*, run
-;; (progn (set-text-properties (point-min)(point-max)
nil)(compilation-parse-errors (point-min)(point-max)
gnat-inspect-ident-file-scope-regexp-alist))
-
-(defun gnat-inspect-compilation (identifier file line col cmd comp-err)
- "Run gnatinspect IDENTIFIER:FILE:LINE:COL CMD,
-set compilation-mode with compilation-error-regexp-alist set to COMP-ERR."
- (gnat-inspect-ensure-gpr)
-
- (let ((cmd-1 (format "%s %s:%s:%d:%d" cmd identifier file line col))
- (result-count 0)
- file line column)
- (with-current-buffer (gnat-inspect--session-buffer
(gnat-inspect-cached-session))
- (compilation-mode)
- (setq buffer-read-only nil)
- (set (make-local-variable 'compilation-error-regexp-alist) (list
comp-err))
- (gnat-inspect-session-send cmd-1 t)
- ;; at EOB. gnatinspect returns one line per result
- (setq result-count (- (line-number-at-pos) 1))
- (if (fboundp 'font-lock-ensure)
- (font-lock-ensure)
- (font-lock-fontify-buffer))
- ;; font-lock-fontify-buffer applies compilation-message text properties
- ;; NOTE: Won't be needed in 24.5 any more, since compilation-next-error
- ;; will apply compilation-message text properties on the fly.
- ;; IMPROVEME: for some reason, next-error works, but the font
- ;; colors are not right (no koolaid!)
- (goto-char (point-min))
-
- (cl-case result-count
- (0
- (error "gnatinspect returned no results"))
- (1
- ;; just go there, don't display session-buffer. We have to
- ;; fetch the compilation-message while in the session-buffer.
- (let* ((msg (compilation-next-error 0 nil (point-min)))
- ;; FIXME: Woah! This is messing with very internal details!
- (loc (compilation--message->loc msg)))
- (setq file (caar (compilation--loc->file-struct loc))
- line (caar (cddr (compilation--loc->file-struct loc)))
- column (1- (compilation--loc->col loc)))
- ))
-
- ));; case, with-currrent-buffer
-
- ;; compilation-next-error-function assumes there is not at error
- ;; at point-min; work around that by moving forward 0 errors for
- ;; the first one.
- (if (> result-count 1)
- ;; more than one result; display session buffer
- (next-error 0 t)
- ;; else don't display
- (ada-goto-source file line column nil))
- ))
-
-(defun gnat-inspect-dist (found-line line found-col col)
- "Return non-nil if found-line, -col is closer to line, col than
min-distance."
- (+ (abs (- found-line line))
- (* (abs (- found-col col)) 250)))
-
-;;;;; user interface functions
-
-(defun gnat-inspect-refresh ()
- "For `ada-xref-refresh-function', using gnatinspect."
- (interactive)
- (gnat-inspect-session-send "refresh" t))
-
-(defun gnat-inspect-other (identifier file line col)
- "For `ada-xref-other-function', using gnatinspect."
- (when (eq ?\" (aref identifier 0))
- ;; gnatinspect wants the quotes stripped
- (setq col (+ 1 col))
- (setq identifier (substring identifier 1 (1- (length identifier))))
- )
-
- (let ((cmd (format "refs %s:%s:%d:%d" identifier (file-name-nondirectory
file) line col))
- (decl-loc nil)
- (body-loc nil)
- (search-type nil)
- (min-distance (1- (expt 2 29)))
- (result nil))
-
- (with-current-buffer (gnat-inspect-session-send cmd t)
- ;; 'gnatinspect refs' returns a list containing the declaration,
- ;; the body, and all the references, in no particular order.
- ;;
- ;; We search the list, looking for the input location,
- ;; declaration and body, then return the declaration or body as
- ;; appropriate.
- ;;
- ;; the format of each line is name:file:line:column (type)
scope=name:file:line:column
- ;; 1 2 3 4 5
- ;;
- ;; 'type' can be:
- ;; body
- ;; declaration
- ;; full declaration (for a private type)
- ;; implicit reference
- ;; reference
- ;; static call
- ;;
- ;;
Module_Type:/home/Projects/GDS/work_stephe_2/common/1553/gds-hardware-bus_1553-wrapper.ads:171:9
(full declaration)
scope=Wrapper:/home/Projects/GDS/work_stephe_2/common/1553/gds-hardware-bus_1553-wrapper.ads:49:31
- ;;
- ;;
itc_assert:/home/Projects/GDS/work_stephe_2/common/itc/opsim/itc_dscovr_gdsi/Gds1553/src/Gds1553.cpp:830:9
(reference)
scope=Gds1553WriteSubaddress:/home/Projects/GDS/work_stephe_2/common/itc/opsim/itc_dscovr_gdsi/Gds1553/inc/Gds1553.hpp:173:24
-
- (message "parsing result ...")
-
- (goto-char (point-min))
-
- (while (not (eobp))
- (cond
- ((looking-at gnat-inspect-ident-file-type-regexp)
- ;; process line
- (let* ((found-file (expand-file-name (match-string 2)));; converts
Windows to normal
- (found-line (string-to-number (match-string 3)))
- (found-col (string-to-number (match-string 4)))
- (found-type (match-string 5))
- (dist (gnat-inspect-dist found-line line found-col col))
- )
-
- (when (string-equal found-type "declaration")
- (setq decl-loc (list found-file found-line (1- found-col))))
-
- (when (or
- (string-equal found-type "body")
- (string-equal found-type "full declaration"))
- (setq body-loc (list found-file found-line (1- found-col))))
-
- (when
- ;; In general, we don't know where in the gnatinspect
- ;; output the search item occurs, so we search for it.
- ;;
- ;; We use the same distance algorithm as gnatinspect
- ;; to allow a fuzzy match on edited code.
- (and (equal found-file file)
- (< dist min-distance))
- (setq min-distance dist)
- (setq search-type found-type))
- ))
-
- (t ;; ignore line
- ;;
- ;; This skips GPR_PROJECT_PATH and echoed command at start of buffer.
- ;;
- ;; It also skips warning lines. For example,
- ;; gnatcoll-1.6w-20130902 can't handle the Auto_Text_IO
- ;; language, because it doesn't use the gprconfig
- ;; configuration project. That gives lines like:
- ;;
- ;; common_text_io.gpr:15:07: language unknown for
"gds-hardware-bus_1553-time_tone.ads"
- ;;
- ;; There are probably other warnings that might be reported as well.
- )
- )
- (forward-line 1)
- )
-
- (cond
- ((null search-type)
- (error "gnatinspect did not return other item; refresh?"))
-
- ((and
- (string-equal search-type "declaration")
- body-loc)
- (setq result body-loc))
-
- (decl-loc
- (setq result decl-loc))
- )
-
- (when (null result)
- (error "gnatinspect did not return other item; refresh?"))
-
- (message "parsing result ... done")
- result)))
-
-(defun gnat-inspect-all (identifier file line col)
- "For `ada-xref-all-function', using gnatinspect."
- ;; This will in general return a list of references, so we use
- ;; `compilation-start' to run gnatinspect, so the user can navigate
- ;; to each result in turn via `next-error'.
- (gnat-inspect-compilation identifier file line col "refs"
'gnat-inspect-ident-file))
-
-(defun gnat-inspect-parents (identifier file line col)
- "For `ada-xref-parent-function', using gnatinspect."
- (gnat-inspect-compilation identifier file line col "parent_types"
'gnat-inspect-ident-file))
-
-(defun gnat-inspect-overriding (identifier file line col)
- "For `ada-xref-overriding-function', using gnatinspect."
- (gnat-inspect-compilation identifier file line col "overridden_recursive"
'gnat-inspect-ident-file))
-
-(defun gnat-inspect-overridden-1 (identifier file line col)
- "For `ada-xref-overridden-function', using gnatinspect."
- (unless (ada-prj-get 'gpr_file)
- (error "no gnat project file defined."))
-
- (when (eq ?\" (aref identifier 0))
- ;; gnatinspect wants the quotes stripped
- (setq col (+ 1 col))
- (setq identifier (substring identifier 1 (1- (length identifier))))
- )
-
- (let ((cmd (format "overrides %s:%s:%d:%d" identifier
(file-name-nondirectory file) line col))
- result)
- (with-current-buffer (gnat-inspect-session-send cmd t)
-
- (goto-char (point-min))
- (when (looking-at gnat-inspect-ident-file-regexp)
- (setq result
- (list
- (match-string 2)
- (string-to-number (match-string 3))
- (string-to-number (match-string 4)))))
-
- (when (null result)
- (error "gnatinspect did not return other item; refresh?"))
-
- (message "parsing result ... done")
- result)))
-
-(defun gnat-inspect-overridden (other-window)
- "Move to the overridden declaration of the identifier around point.
-If OTHER-WINDOW (set by interactive prefix) is non-nil, show the
-buffer in another window."
- (interactive "P")
-
- (let ((target
- (gnat-inspect-overridden-1
- (thing-at-point 'symbol)
- (buffer-file-name)
- (line-number-at-pos)
- (save-excursion
- (goto-char (car (bounds-of-thing-at-point 'symbol)))
- (1+ (current-column)))
- )))
-
- (ada-goto-source (nth 0 target)
- (nth 1 target)
- (nth 2 target)
- other-window)
- ))
-
-(defun gnat-inspect-goto-declaration (other-window)
- "Move to the declaration or body of the identifier around point.
-If at the declaration, go to the body, and vice versa. If at a
-reference, goto the declaration.
-
-If OTHER-WINDOW (set by interactive prefix) is non-nil, show the
-buffer in another window."
- (interactive "P")
-
- (let ((target
- (gnat-inspect-other
- (thing-at-point 'symbol)
- (buffer-file-name)
- (line-number-at-pos)
- (save-excursion
- (goto-char (car (bounds-of-thing-at-point 'symbol)))
- (1+ (current-column)))
- )))
-
- (ada-goto-source (nth 0 target)
- (nth 1 target)
- (nth 2 target)
- other-window)
- ))
-
-(defvar gnat-inspect-map
- (let ((map (make-sparse-keymap)))
- ;; C-c C-i prefix for gnat-inspect minor mode
-
- (define-key map "\C-c\C-i\C-d" 'gnat-inspect-goto-declaration)
- (define-key map "\C-c\C-i\C-p" 'ada-build-prompt-select-prj-file)
- (define-key map "\C-c\C-i\C-q" 'gnat-inspect-refresh)
- (define-key map "\C-c\C-i\C-r" 'gnat-inspect-all)
- map
- ) "Local keymap used for GNAT inspect minor mode.")
-
-(defvar gnat-inspect-menu (make-sparse-keymap "gnat-inspect"))
-(easy-menu-define gnat-inspect-menu gnat-inspect-map "Menu keymap for
gnat-inspect minor mode"
- '("gnat-inspect"
- ["Find and select project ..." ada-build-prompt-select-prj-file t]
- ["Select project ..." ada-prj-select t]
- ["Show current project" ada-prj-show t]
- ["Next compilation error" next-error t]
- ["Show secondary error" ada-show-secondary-error t]
- ["Refresh cross reference cache" gnat-inspect-refresh t]
- ))
-
-(define-minor-mode gnat-inspect
- "Minor mode for navigating sources using GNAT cross reference tool.
-Enable mode if ARG is positive"
- :initial-value t
- :lighter " gnat-inspect" ;; mode line
-
- ;; just enable the menu and keymap
- )
-
-;;;;; support for Ada mode
-
-(defun ada-gnat-inspect-select-prj ()
- (setq ada-file-name-from-ada-name 'ada-gnat-file-name-from-ada-name)
- (setq ada-ada-name-from-file-name 'ada-gnat-ada-name-from-file-name)
- (setq ada-make-package-body 'ada-gnat-make-package-body)
-
- (add-hook 'ada-syntax-propertize-hook 'gnatprep-syntax-propertize)
-
- ;; must be after indentation engine setup, because that resets the
- ;; indent function list.
- (add-hook 'ada-mode-hook 'ada-gnat-inspect-setup t)
-
- (setq ada-xref-refresh-function 'gnat-inspect-refresh)
- (setq ada-xref-all-function 'gnat-inspect-all)
- (setq ada-xref-other-function 'gnat-inspect-other)
- (setq ada-xref-parent-function 'gnat-inspect-parents)
- (setq ada-xref-all-function 'gnat-inspect-all)
- (setq ada-xref-overriding-function 'gnat-inspect-overriding)
- (setq ada-xref-overridden-function 'gnat-inspect-overridden-1)
- (setq ada-show-xref-tool-buffer 'gnat-inspect-show-session-buffer)
-
- (add-to-list 'completion-ignored-extensions ".ali") ;; gnat library files,
used for cross reference
- )
-
-(defun ada-gnat-inspect-deselect-prj ()
- (setq ada-file-name-from-ada-name nil)
- (setq ada-ada-name-from-file-name nil)
- (setq ada-make-package-body nil)
-
- (setq ada-syntax-propertize-hook (delq 'gnatprep-syntax-propertize
ada-syntax-propertize-hook))
- (setq ada-mode-hook (delq 'ada-gnat-inspect-setup ada-mode-hook))
-
- (setq ada-xref-other-function nil)
- (setq ada-xref-parent-function nil)
- (setq ada-xref-all-function nil)
- (setq ada-xref-overriding-function nil)
- (setq ada-xref-overridden-function nil)
- (setq ada-show-xref-tool-buffer nil)
-
- (setq completion-ignored-extensions (delete ".ali"
completion-ignored-extensions))
- )
-
-(defun ada-gnat-inspect-setup ()
- (when (boundp 'wisi-indent-calculate-functions)
- (add-to-list 'wisi-indent-calculate-functions 'gnatprep-indent))
- )
-
-(defun ada-gnat-inspect ()
- "Set Ada mode global vars to use gnatinspect."
- (add-to-list 'ada-prj-parser-alist '("gpr" . gnat-parse-gpr))
- (add-to-list 'ada-select-prj-xref-tool '(gnat_inspect .
ada-gnat-inspect-select-prj))
- (add-to-list 'ada-deselect-prj-xref-tool '(gnat_inspect .
ada-gnat-inspect-deselect-prj))
-
- ;; no parse-*-xref
-
- (font-lock-add-keywords 'ada-mode
- ;; gnatprep preprocessor line
- (list (list "^[ \t]*\\(#.*\n\\)" '(1 font-lock-type-face t))))
-
- (add-hook 'ada-gnat-fix-error-hook 'ada-gnat-fix-error)
- )
-
-(provide 'gnat-inspect)
-(provide 'ada-xref-tool)
-
-(add-to-list 'compilation-error-regexp-alist-alist
- (cons 'gnat-inspect-ident-file
gnat-inspect-ident-file-regexp-alist))
-(add-to-list 'compilation-error-regexp-alist-alist
- (cons 'gnat-inspect-ident-file-scope
gnat-inspect-ident-file-scope-regexp-alist))
-
-(unless (and (boundp 'ada-xref-tool)
- (default-value 'ada-xref-tool))
- (setq ada-xref-tool 'gnat_inspect))
-
-(ada-gnat-inspect)
-
-;;; end of file
diff --git a/packages/ada-mode/gpr-grammar-wy.el
b/packages/ada-mode/gpr-grammar-wy.el
index cd6c4d6..1c1381e 100644
--- a/packages/ada-mode/gpr-grammar-wy.el
+++ b/packages/ada-mode/gpr-grammar-wy.el
@@ -1,6 +1,6 @@
;;; gpr-grammar-wy.el --- Generated parser support file
-;; Copyright (C) 2013 Free Software Foundation, Inc.
+;; Copyright (C) 2013 - 2015 Free Software Foundation, Inc.
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
@@ -27,6 +27,7 @@
("case" . CASE)
("configuration" . CONFIGURATION)
("end" . END)
+ ("extends" . EXTENDS)
("external" . EXTERNAL)
("external_as_list" . EXTERNAL_AS_LIST)
("for" . FOR)
@@ -37,6 +38,7 @@
("others" . OTHERS)
("package" . PACKAGE)
("project" . PROJECT)
+ ("renames" . RENAMES)
(")" . RIGHT_PAREN)
("standard" . STANDARD)
("type" . TYPE)
@@ -73,7 +75,7 @@
(defconst gpr-grammar-wy--parse-table
(wisi-compile-grammar
- '((AMPERSAND COLON COLON_EQUALS COMMA DOT EQUAL_GREATER QUOTE SEMICOLON
VERTICAL_BAR IDENTIFIER STRING_LITERAL ABSTRACT AGGREGATE CASE CONFIGURATION
END EXTERNAL EXTERNAL_AS_LIST FOR IS LEFT_PAREN LIBRARY NULL OTHERS PACKAGE
PROJECT RIGHT_PAREN STANDARD TYPE USE WHEN WITH )
+ '((AMPERSAND COLON COLON_EQUALS COMMA DOT EQUAL_GREATER QUOTE SEMICOLON
VERTICAL_BAR IDENTIFIER STRING_LITERAL ABSTRACT AGGREGATE CASE CONFIGURATION
END EXTENDS EXTERNAL EXTERNAL_AS_LIST FOR IS LEFT_PAREN LIBRARY NULL OTHERS
PACKAGE PROJECT RENAMES RIGHT_PAREN STANDARD TYPE USE WHEN WITH )
((aggregate
((LEFT_PAREN string_list RIGHT_PAREN )
(progn
@@ -87,6 +89,10 @@
((FOR IDENTIFIER LEFT_PAREN STRING_LITERAL RIGHT_PAREN USE expression
SEMICOLON )
(progn
(wisi-statement-action [1 statement-start 3 open-paren 5 close-paren 6
statement-other 8 statement-end])
+ (wisi-containing-action 6 7)))
+ ((FOR EXTERNAL LEFT_PAREN STRING_LITERAL RIGHT_PAREN USE expression
SEMICOLON )
+ (progn
+ (wisi-statement-action [1 statement-start 3 open-paren 5 close-paren 6
statement-other 8 statement-end])
(wisi-containing-action 6 7))))
(attribute_prefix
((PROJECT ))
@@ -101,9 +107,10 @@
(wisi-statement-action [1 statement-start 3 block-start 5 block-end 7
statement-end])
(wisi-containing-action 3 4))))
(case_item
- ((WHEN discrete_choice_list EQUAL_GREATER declarative_items )
+ ((WHEN discrete_choice_list EQUAL_GREATER declarative_items_opt )
(progn
(wisi-statement-action [1 block-middle 3 block-start])
+ (wisi-containing-action 1 3)
(wisi-containing-action 3 4))))
(case_items
(())
@@ -122,9 +129,11 @@
((typed_string_declaration ))
((package_declaration )))
(declarative_items
- (())
((declarative_item ))
((declarative_items declarative_item )))
+ (declarative_items_opt
+ (())
+ ((declarative_items )))
(discrete_choice
(())
((STRING_LITERAL ))
@@ -146,14 +155,32 @@
((name DOT IDENTIFIER )))
(project_declaration_opt
(())
- ((simple_project_declaration )))
+ ((simple_project_declaration ))
+ ((project_extension )))
(package_declaration
- ((package_spec )))
+ ((package_spec ))
+ ((package_extension ))
+ ((package_renaming )))
(package_spec
- ((PACKAGE identifier_opt IS simple_declarative_items END identifier_opt
SEMICOLON )
+ ((PACKAGE identifier_opt IS declarative_items_opt END identifier_opt
SEMICOLON )
(progn
(wisi-statement-action [1 statement-start 3 block-start 5 block-end 7
statement-end])
(wisi-containing-action 3 4))))
+ (package_extension
+ ((PACKAGE identifier_opt EXTENDS name IS declarative_items_opt END
identifier_opt SEMICOLON )
+ (progn
+ (wisi-statement-action [1 statement-start 5 block-start 7 block-end 9
statement-end])
+ (wisi-containing-action 5 6))))
+ (package_renaming
+ ((PACKAGE identifier_opt RENAMES name SEMICOLON )
+ (progn
+ (wisi-statement-action [1 statement-start 3 statement-other 5
statement-end])
+ (wisi-containing-action 3 4))))
+ (project_extension
+ ((PROJECT identifier_opt EXTENDS STRING_LITERAL IS
declarative_items_opt END identifier_opt SEMICOLON )
+ (progn
+ (wisi-statement-action [1 statement-start 5 block-start 7 block-end 9
statement-end])
+ (wisi-containing-action 5 6))))
(project_qualifier_opt
(())
((ABSTRACT ))
@@ -175,12 +202,8 @@
((case_statement ))
((NULL SEMICOLON )
(wisi-statement-action [1 statement-start 2 statement-end])))
- (simple_declarative_items
- (())
- ((simple_declarative_item ))
- ((simple_declarative_items simple_declarative_item )))
(simple_project_declaration
- ((PROJECT identifier_opt IS declarative_items END identifier_opt
SEMICOLON )
+ ((PROJECT identifier_opt IS declarative_items_opt END identifier_opt
SEMICOLON )
(progn
(wisi-statement-action [1 statement-start 3 block-start 5 block-end 7
statement-end])
(wisi-containing-action 3 4))))
@@ -210,146 +233,197 @@
((WITH string_list SEMICOLON ))))
[((default . error) (ABSTRACT . (context_clause_opt . 0)) (AGGREGATE .
(context_clause_opt . 0)) (CONFIGURATION . (context_clause_opt . 0)) (LIBRARY .
(context_clause_opt . 0)) (STANDARD . (context_clause_opt . 0)) (PROJECT .
(context_clause_opt . 0)) ($EOI . (context_clause_opt . 0)) (WITH . 7))
((default . error) ($EOI . (project_qualifier_opt . 1)) (PROJECT .
(project_qualifier_opt . 1)))
- ((default . error) (LIBRARY . 34) ($EOI . (project_qualifier_opt . 3))
(PROJECT . (project_qualifier_opt . 3)))
+ ((default . error) (LIBRARY . 35) ($EOI . (project_qualifier_opt . 3))
(PROJECT . (project_qualifier_opt . 3)))
((default . error) ($EOI . (project_qualifier_opt . 6)) (PROJECT .
(project_qualifier_opt . 6)))
((default . error) ($EOI . (project_qualifier_opt . 5)) (PROJECT .
(project_qualifier_opt . 5)))
- ((default . error) (IS . (identifier_opt . 0)) (IDENTIFIER . 16))
+ ((default . error) (EXTENDS . (identifier_opt . 0)) (IS .
(identifier_opt . 0)) (IDENTIFIER . 21))
((default . error) ($EOI . (project_qualifier_opt . 2)) (PROJECT .
(project_qualifier_opt . 2)))
- ((default . error) (LEFT_PAREN . 20) (STRING_LITERAL . 17) (EXTERNAL .
18) (EXTERNAL_AS_LIST . 19) (DOT . (identifier_opt . 0)) (AMPERSAND .
(identifier_opt . 0)) (SEMICOLON . (identifier_opt . 0)) (COMMA .
(identifier_opt . 0)) (QUOTE . (identifier_opt . 0)) (IDENTIFIER . 16)
(PROJECT . 21))
- ((default . error) ($EOI . 15))
+ ((default . error) (LEFT_PAREN . 19) (STRING_LITERAL . 22) (EXTERNAL .
17) (EXTERNAL_AS_LIST . 18) (DOT . (identifier_opt . 0)) (AMPERSAND .
(identifier_opt . 0)) (SEMICOLON . (identifier_opt . 0)) (COMMA .
(identifier_opt . 0)) (QUOTE . (identifier_opt . 0)) (IDENTIFIER . 21)
(PROJECT . 20))
+ ((default . error) ($EOI . 16))
((default . error) (ABSTRACT . (context_clause_opt . 1)) (AGGREGATE .
(context_clause_opt . 1)) (CONFIGURATION . (context_clause_opt . 1)) (LIBRARY .
(context_clause_opt . 1)) (STANDARD . (context_clause_opt . 1)) (PROJECT .
(context_clause_opt . 1)) ($EOI . (context_clause_opt . 1)) (WITH . 7))
((default . error) (PROJECT . (project_qualifier_opt . 0)) ($EOI .
(project_qualifier_opt . 0)) (ABSTRACT . 1) (STANDARD . 6) (AGGREGATE . 2)
(LIBRARY . 4) (CONFIGURATION . 3))
+ ((default . error) ($EOI . (project_declaration_opt . 2)))
((default . error) ($EOI . (project_declaration_opt . 1)))
((default . error) ($EOI . (context_clause . 0)) (PROJECT .
(context_clause . 0)) (STANDARD . (context_clause . 0)) (LIBRARY .
(context_clause . 0)) (CONFIGURATION . (context_clause . 0)) (AGGREGATE .
(context_clause . 0)) (ABSTRACT . (context_clause . 0)) (WITH . (context_clause
. 0)))
((default . error) ($EOI . (project_declaration_opt . 0)) (PROJECT . 5))
((default . error) (WITH . (context_clause . 1)) (ABSTRACT .
(context_clause . 1)) (AGGREGATE . (context_clause . 1)) (CONFIGURATION .
(context_clause . 1)) (LIBRARY . (context_clause . 1)) (STANDARD .
(context_clause . 1)) (PROJECT . (context_clause . 1)) ($EOI . (context_clause
. 1)))
- ((default . error) ($EOI . accept) (WITH . accept) (WHEN . accept) (USE
. accept) (TYPE . accept) (STANDARD . accept) (RIGHT_PAREN . accept) (PROJECT .
accept) (PACKAGE . accept) (OTHERS . accept) (NULL . accept) (LIBRARY . accept)
(LEFT_PAREN . accept) (IS . accept) (FOR . accept) (EXTERNAL_AS_LIST . accept)
(EXTERNAL . accept) (END . accept) (CONFIGURATION . accept) (CASE . accept)
(AGGREGATE . accept) (ABSTRACT . accept) (STRING_LITERAL . accept) (IDENTIFIER
. accept) (VERTICAL_ [...]
- ((default . error) (RIGHT_PAREN . (identifier_opt . 1)) (COMMA .
(identifier_opt . 1)) (IS . (identifier_opt . 1)) (DOT . (identifier_opt . 1))
(AMPERSAND . (identifier_opt . 1)) (SEMICOLON . (identifier_opt . 1)) (QUOTE .
(identifier_opt . 1)))
- ((default . error) (RIGHT_PAREN . (string_primary . 0)) (COMMA .
(string_primary . 0)) (AMPERSAND . (string_primary . 0)) (SEMICOLON .
(string_primary . 0)))
- ((default . error) (LEFT_PAREN . 43))
- ((default . error) (LEFT_PAREN . 43))
- ((default . error) (LEFT_PAREN . 20) (STRING_LITERAL . 17) (EXTERNAL .
18) (EXTERNAL_AS_LIST . 19) (DOT . (identifier_opt . 0)) (AMPERSAND .
(identifier_opt . 0)) (RIGHT_PAREN . ( 41 (identifier_opt . 0))) (COMMA .
(identifier_opt . 0)) (QUOTE . (identifier_opt . 0)) (IDENTIFIER . 16)
(PROJECT . 21))
+ ((default . error) ($EOI . accept) (STRING_LITERAL . accept) (IDENTIFIER
. accept) (VERTICAL_BAR . accept) (SEMICOLON . accept) (QUOTE . accept)
(EQUAL_GREATER . accept) (DOT . accept) (COMMA . accept) (COLON_EQUALS .
accept) (COLON . accept) (AMPERSAND . accept) (WITH . accept) (WHEN . accept)
(USE . accept) (TYPE . accept) (STANDARD . accept) (RIGHT_PAREN . accept)
(RENAMES . accept) (PROJECT . accept) (PACKAGE . accept) (OTHERS . accept)
(NULL . accept) (LIBRARY . accept) (LEFT_ [...]
+ ((default . error) (LEFT_PAREN . 45))
+ ((default . error) (LEFT_PAREN . 45))
+ ((default . error) (LEFT_PAREN . 19) (STRING_LITERAL . 22) (EXTERNAL .
17) (EXTERNAL_AS_LIST . 18) (DOT . (identifier_opt . 0)) (AMPERSAND .
(identifier_opt . 0)) (RIGHT_PAREN . ( 43 (identifier_opt . 0))) (COMMA .
(identifier_opt . 0)) (QUOTE . (identifier_opt . 0)) (IDENTIFIER . 21)
(PROJECT . 20))
((default . error) (QUOTE . (attribute_prefix . 0)))
+ ((default . error) (RIGHT_PAREN . (identifier_opt . 1)) (COMMA .
(identifier_opt . 1)) (EXTENDS . (identifier_opt . 1)) (RENAMES .
(identifier_opt . 1)) (IS . (identifier_opt . 1)) (DOT . (identifier_opt . 1))
(AMPERSAND . (identifier_opt . 1)) (QUOTE . (identifier_opt . 1)) (SEMICOLON .
(identifier_opt . 1)))
+ ((default . error) (RIGHT_PAREN . (string_primary . 0)) (COMMA .
(string_primary . 0)) (AMPERSAND . (string_primary . 0)) (SEMICOLON .
(string_primary . 0)))
((default . error) (RIGHT_PAREN . (term . 2)) (COMMA . (term . 2))
(AMPERSAND . (term . 2)) (SEMICOLON . (term . 2)))
- ((default . error) (QUOTE . 40))
+ ((default . error) (QUOTE . 42))
((default . error) (RIGHT_PAREN . (string_primary . 3)) (COMMA .
(string_primary . 3)) (AMPERSAND . (string_primary . 3)) (SEMICOLON .
(string_primary . 3)))
- ((default . error) (SEMICOLON . (string_list . 0)) (RIGHT_PAREN .
(string_list . 0)) (COMMA . (string_list . 0)) (AMPERSAND . 39))
+ ((default . error) (SEMICOLON . (string_list . 0)) (RIGHT_PAREN .
(string_list . 0)) (COMMA . (string_list . 0)) (AMPERSAND . 41))
((default . error) (RIGHT_PAREN . (string_primary . 2)) (COMMA .
(string_primary . 2)) (AMPERSAND . (string_primary . 2)) (SEMICOLON .
(string_primary . 2)))
((default . error) (COMMA . (name . 0)) (RIGHT_PAREN . (name . 0)) (IS .
(name . 0)) (SEMICOLON . (name . 0)) (AMPERSAND . (name . 0)) (DOT . (name .
0)) (QUOTE . (name . 0)))
- ((default . error) (RIGHT_PAREN . (string_primary . 1)) (COMMA .
(string_primary . 1)) (AMPERSAND . (string_primary . 1)) (SEMICOLON .
(string_primary . 1)) (DOT . 38) (QUOTE . (attribute_prefix . 1)))
+ ((default . error) (RIGHT_PAREN . (string_primary . 1)) (COMMA .
(string_primary . 1)) (AMPERSAND . (string_primary . 1)) (SEMICOLON .
(string_primary . 1)) (DOT . 40) (QUOTE . (attribute_prefix . 1)))
((default . error) (RIGHT_PAREN . (term . 0)) (COMMA . (term . 0))
(AMPERSAND . (term . 0)) (SEMICOLON . (term . 0)))
((default . error) (COMMA . (string_expression . 0)) (RIGHT_PAREN .
(string_expression . 0)) (SEMICOLON . (string_expression . 0)) (AMPERSAND .
(string_expression . 0)))
- ((default . error) (COMMA . 36) (SEMICOLON . 37))
+ ((default . error) (COMMA . 38) (SEMICOLON . 39))
((default . error) (COMMA . (expression . 0)) (RIGHT_PAREN . (expression
. 0)) (SEMICOLON . (expression . 0)) (AMPERSAND . (expression . 0)))
- ((default . error) (IS . 35))
+ ((default . error) (EXTENDS . 36) (IS . 37))
((default . error) ($EOI . (project_qualifier_opt . 4)) (PROJECT .
(project_qualifier_opt . 4)))
- ((default . error) (END . (declarative_items . 0)) (TYPE .
((declarative_items . 0) 57)) (IDENTIFIER . ((declarative_items . 0) 52))
(NULL . ((declarative_items . 0) 55)) (CASE . ((declarative_items . 0) 53))
(FOR . ((declarative_items . 0) 54)) (PACKAGE . ((declarative_items . 0) 56)))
- ((default . error) (LEFT_PAREN . 20) (STRING_LITERAL . 17) (EXTERNAL .
18) (EXTERNAL_AS_LIST . 19) (DOT . (identifier_opt . 0)) (AMPERSAND .
(identifier_opt . 0)) (RIGHT_PAREN . (identifier_opt . 0)) (COMMA .
(identifier_opt . 0)) (SEMICOLON . (identifier_opt . 0)) (QUOTE .
(identifier_opt . 0)) (IDENTIFIER . 16) (PROJECT . 21))
+ ((default . error) (STRING_LITERAL . 71))
+ ((default . error) (END . (declarative_items_opt . 0)) (TYPE . 58)
(IDENTIFIER . 59) (NULL . 56) (CASE . 54) (FOR . 55) (PACKAGE . 57))
+ ((default . error) (LEFT_PAREN . 19) (STRING_LITERAL . 22) (EXTERNAL .
17) (EXTERNAL_AS_LIST . 18) (DOT . (identifier_opt . 0)) (AMPERSAND .
(identifier_opt . 0)) (RIGHT_PAREN . (identifier_opt . 0)) (COMMA .
(identifier_opt . 0)) (SEMICOLON . (identifier_opt . 0)) (QUOTE .
(identifier_opt . 0)) (IDENTIFIER . 21) (PROJECT . 20))
((default . error) (WITH . (with_clause . 0)) (ABSTRACT . (with_clause .
0)) (AGGREGATE . (with_clause . 0)) (CONFIGURATION . (with_clause . 0))
(LIBRARY . (with_clause . 0)) (STANDARD . (with_clause . 0)) (PROJECT .
(with_clause . 0)) ($EOI . (with_clause . 0)))
+ ((default . error) (IDENTIFIER . 52))
+ ((default . error) (LEFT_PAREN . 19) (STRING_LITERAL . 22) (EXTERNAL .
17) (EXTERNAL_AS_LIST . 18) (DOT . (identifier_opt . 0)) (SEMICOLON .
(identifier_opt . 0)) (COMMA . (identifier_opt . 0)) (RIGHT_PAREN .
(identifier_opt . 0)) (AMPERSAND . (identifier_opt . 0)) (QUOTE .
(identifier_opt . 0)) (IDENTIFIER . 21) (PROJECT . 20))
((default . error) (IDENTIFIER . 50))
- ((default . error) (LEFT_PAREN . 20) (STRING_LITERAL . 17) (EXTERNAL .
18) (EXTERNAL_AS_LIST . 19) (DOT . (identifier_opt . 0)) (SEMICOLON .
(identifier_opt . 0)) (COMMA . (identifier_opt . 0)) (RIGHT_PAREN .
(identifier_opt . 0)) (AMPERSAND . (identifier_opt . 0)) (QUOTE .
(identifier_opt . 0)) (IDENTIFIER . 16) (PROJECT . 21))
- ((default . error) (IDENTIFIER . 48))
((default . error) (SEMICOLON . (term . 1)) (AMPERSAND . (term . 1))
(COMMA . (term . 1)) (RIGHT_PAREN . (term . 1)))
- ((default . error) (COMMA . 36) (RIGHT_PAREN . 47))
- ((default . error) (LEFT_PAREN . 20) (STRING_LITERAL . 17) (EXTERNAL .
18) (EXTERNAL_AS_LIST . 19) (DOT . (identifier_opt . 0)) (AMPERSAND .
(identifier_opt . 0)) (RIGHT_PAREN . (identifier_opt . 0)) (COMMA .
(identifier_opt . 0)) (QUOTE . (identifier_opt . 0)) (IDENTIFIER . 16)
(PROJECT . 21))
+ ((default . error) (COMMA . 38) (RIGHT_PAREN . 49))
+ ((default . error) (LEFT_PAREN . 19) (STRING_LITERAL . 22) (EXTERNAL .
17) (EXTERNAL_AS_LIST . 18) (DOT . (identifier_opt . 0)) (AMPERSAND .
(identifier_opt . 0)) (RIGHT_PAREN . (identifier_opt . 0)) (COMMA .
(identifier_opt . 0)) (QUOTE . (identifier_opt . 0)) (IDENTIFIER . 21)
(PROJECT . 20))
((default . error) (AMPERSAND . (external_value . 1)) (SEMICOLON .
(external_value . 1)) (RIGHT_PAREN . (external_value . 1)) (COMMA .
(external_value . 1)))
((default . error) (AMPERSAND . (external_value . 0)) (SEMICOLON .
(external_value . 0)) (RIGHT_PAREN . (external_value . 0)) (COMMA .
(external_value . 0)))
((default . error) ($EOI . (compilation_unit . 0)))
((default . error) (COMMA . (aggregate . 0)) (RIGHT_PAREN . (aggregate .
0)) (SEMICOLON . (aggregate . 0)) (AMPERSAND . (aggregate . 0)))
- ((default . error) (LEFT_PAREN . 75) (COMMA . (attribute_reference .
0)) (RIGHT_PAREN . (attribute_reference . 0)) (SEMICOLON . (attribute_reference
. 0)) (AMPERSAND . (attribute_reference . 0)))
+ ((default . error) (LEFT_PAREN . 83) (COMMA . (attribute_reference .
0)) (RIGHT_PAREN . (attribute_reference . 0)) (SEMICOLON . (attribute_reference
. 0)) (AMPERSAND . (attribute_reference . 0)))
((default . error) (SEMICOLON . (expression . 1)) (COMMA . (expression .
1)) (RIGHT_PAREN . (expression . 1)) (AMPERSAND . (expression . 1)))
((default . error) (IS . (name . 1)) (COMMA . (name . 1)) (RIGHT_PAREN .
(name . 1)) (SEMICOLON . (name . 1)) (AMPERSAND . (name . 1)) (DOT . (name .
1)) (QUOTE . (name . 1)))
- ((default . error) (AMPERSAND . 39) (RIGHT_PAREN . (string_list . 1))
(SEMICOLON . (string_list . 1)) (COMMA . (string_list . 1)))
- ((default . error) (COLON . 73) (COLON_EQUALS . 74))
- ((default . error) (DOT . (identifier_opt . 0)) (IS . (identifier_opt .
0)) (IDENTIFIER . 16))
- ((default . error) (IDENTIFIER . 71))
- ((default . error) (SEMICOLON . 70))
- ((default . error) (IS . (identifier_opt . 0)) (IDENTIFIER . 16))
- ((default . error) (IDENTIFIER . 68))
- ((default . error) (WHEN . (simple_declarative_item . 2)) (END .
(simple_declarative_item . 2)) (IDENTIFIER . (simple_declarative_item . 2))
(CASE . (simple_declarative_item . 2)) (FOR . (simple_declarative_item . 2))
(NULL . (simple_declarative_item . 2)) (PACKAGE . (simple_declarative_item .
2)) (TYPE . (simple_declarative_item . 2)))
- ((default . error) (WHEN . (simple_declarative_item . 3)) (END .
(simple_declarative_item . 3)) (IDENTIFIER . (simple_declarative_item . 3))
(CASE . (simple_declarative_item . 3)) (FOR . (simple_declarative_item . 3))
(NULL . (simple_declarative_item . 3)) (PACKAGE . (simple_declarative_item .
3)) (TYPE . (simple_declarative_item . 3)))
- ((default . error) (WHEN . (declarative_items . 1)) (END .
(declarative_items . 1)) (IDENTIFIER . (declarative_items . 1)) (CASE .
(declarative_items . 1)) (FOR . (declarative_items . 1)) (NULL .
(declarative_items . 1)) (PACKAGE . (declarative_items . 1)) (TYPE .
(declarative_items . 1)))
- ((default . error) (END . 66) (TYPE . 57) (IDENTIFIER . 52) (NULL .
55) (CASE . 53) (FOR . 54) (PACKAGE . 56))
- ((default . error) (WHEN . (declarative_item . 2)) (END .
(declarative_item . 2)) (TYPE . (declarative_item . 2)) (PACKAGE .
(declarative_item . 2)) (NULL . (declarative_item . 2)) (FOR .
(declarative_item . 2)) (CASE . (declarative_item . 2)) (IDENTIFIER .
(declarative_item . 2)))
- ((default . error) (WHEN . (package_declaration . 0)) (END .
(package_declaration . 0)) (IDENTIFIER . (package_declaration . 0)) (CASE .
(package_declaration . 0)) (FOR . (package_declaration . 0)) (NULL .
(package_declaration . 0)) (PACKAGE . (package_declaration . 0)) (TYPE .
(package_declaration . 0)))
- ((default . error) (WHEN . (declarative_item . 0)) (END .
(declarative_item . 0)) (TYPE . (declarative_item . 0)) (PACKAGE .
(declarative_item . 0)) (NULL . (declarative_item . 0)) (FOR .
(declarative_item . 0)) (CASE . (declarative_item . 0)) (IDENTIFIER .
(declarative_item . 0)))
- ((default . error) (WHEN . (declarative_item . 1)) (END .
(declarative_item . 1)) (TYPE . (declarative_item . 1)) (PACKAGE .
(declarative_item . 1)) (NULL . (declarative_item . 1)) (FOR .
(declarative_item . 1)) (CASE . (declarative_item . 1)) (IDENTIFIER .
(declarative_item . 1)))
- ((default . error) (SEMICOLON . (identifier_opt . 0)) (IDENTIFIER . 16))
- ((default . error) (WHEN . (declarative_items . 2)) (TYPE .
(declarative_items . 2)) (PACKAGE . (declarative_items . 2)) (NULL .
(declarative_items . 2)) (FOR . (declarative_items . 2)) (CASE .
(declarative_items . 2)) (IDENTIFIER . (declarative_items . 2)) (END .
(declarative_items . 2)))
- ((default . error) (IS . 83))
- ((default . error) (IS . 82))
- ((default . error) (WHEN . (simple_declarative_item . 4)) (TYPE .
(simple_declarative_item . 4)) (PACKAGE . (simple_declarative_item . 4)) (NULL
. (simple_declarative_item . 4)) (FOR . (simple_declarative_item . 4)) (CASE .
(simple_declarative_item . 4)) (IDENTIFIER . (simple_declarative_item . 4))
(END . (simple_declarative_item . 4)))
- ((default . error) (USE . 81) (LEFT_PAREN . 80))
- ((default . error) (DOT . 38) (IS . 79))
- ((default . error) (IDENTIFIER . 78))
- ((default . error) (LEFT_PAREN . 20) (STRING_LITERAL . 17) (EXTERNAL .
18) (EXTERNAL_AS_LIST . 19) (DOT . (identifier_opt . 0)) (AMPERSAND .
(identifier_opt . 0)) (SEMICOLON . (identifier_opt . 0)) (QUOTE .
(identifier_opt . 0)) (IDENTIFIER . 16) (PROJECT . 21))
- ((default . error) (STRING_LITERAL . 76))
- ((default . error) (RIGHT_PAREN . 96))
- ((default . error) (AMPERSAND . 39) (SEMICOLON . 95))
- ((default . error) (COLON_EQUALS . 94))
- ((default . error) (END . (case_items . 0)) (WHEN . ((case_items . 0)
91)))
- ((default . error) (STRING_LITERAL . 90))
- ((default . error) (LEFT_PAREN . 20) (STRING_LITERAL . 17) (EXTERNAL .
18) (EXTERNAL_AS_LIST . 19) (DOT . (identifier_opt . 0)) (AMPERSAND .
(identifier_opt . 0)) (SEMICOLON . (identifier_opt . 0)) (QUOTE .
(identifier_opt . 0)) (IDENTIFIER . 16) (PROJECT . 21))
- ((default . error) (END . (simple_declarative_items . 0)) (IDENTIFIER .
((simple_declarative_items . 0) 52)) (NULL . ((simple_declarative_items . 0)
55)) (CASE . ((simple_declarative_items . 0) 53)) (FOR .
((simple_declarative_items . 0) 54)))
- ((default . error) (LEFT_PAREN . 43))
- ((default . error) (SEMICOLON . 85))
+ ((default . error) (AMPERSAND . 41) (RIGHT_PAREN . (string_list . 1))
(SEMICOLON . (string_list . 1)) (COMMA . (string_list . 1)))
+ ((default . error) (DOT . (identifier_opt . 0)) (IS . (identifier_opt .
0)) (IDENTIFIER . 21))
+ ((default . error) (EXTERNAL . 80) (IDENTIFIER . 81))
+ ((default . error) (SEMICOLON . 79))
+ ((default . error) (IS . (identifier_opt . 0)) (EXTENDS .
(identifier_opt . 0)) (RENAMES . (identifier_opt . 0)) (IDENTIFIER . 21))
+ ((default . error) (IDENTIFIER . 77))
+ ((default . error) (COLON . 75) (COLON_EQUALS . 76))
+ ((default . error) (WHEN . (simple_declarative_item . 2)) (END .
(simple_declarative_item . 2)) (CASE . (simple_declarative_item . 2)) (FOR .
(simple_declarative_item . 2)) (NULL . (simple_declarative_item . 2)) (PACKAGE
. (simple_declarative_item . 2)) (TYPE . (simple_declarative_item . 2))
(IDENTIFIER . (simple_declarative_item . 2)))
+ ((default . error) (WHEN . (simple_declarative_item . 3)) (END .
(simple_declarative_item . 3)) (CASE . (simple_declarative_item . 3)) (FOR .
(simple_declarative_item . 3)) (NULL . (simple_declarative_item . 3)) (PACKAGE
. (simple_declarative_item . 3)) (TYPE . (simple_declarative_item . 3))
(IDENTIFIER . (simple_declarative_item . 3)))
+ ((default . error) (WHEN . (declarative_items . 0)) (END .
(declarative_items . 0)) (CASE . (declarative_items . 0)) (FOR .
(declarative_items . 0)) (NULL . (declarative_items . 0)) (PACKAGE .
(declarative_items . 0)) (TYPE . (declarative_items . 0)) (IDENTIFIER .
(declarative_items . 0)))
+ ((default . error) (WHEN . (declarative_items_opt . 1)) (END .
(declarative_items_opt . 1)) (TYPE . 58) (IDENTIFIER . 59) (NULL . 56) (CASE
. 54) (FOR . 55) (PACKAGE . 57))
+ ((default . error) (END . 73))
+ ((default . error) (WHEN . (declarative_item . 2)) (END .
(declarative_item . 2)) (IDENTIFIER . (declarative_item . 2)) (TYPE .
(declarative_item . 2)) (PACKAGE . (declarative_item . 2)) (NULL .
(declarative_item . 2)) (FOR . (declarative_item . 2)) (CASE .
(declarative_item . 2)))
+ ((default . error) (WHEN . (package_declaration . 0)) (END .
(package_declaration . 0)) (CASE . (package_declaration . 0)) (FOR .
(package_declaration . 0)) (NULL . (package_declaration . 0)) (PACKAGE .
(package_declaration . 0)) (TYPE . (package_declaration . 0)) (IDENTIFIER .
(package_declaration . 0)))
+ ((default . error) (WHEN . (package_declaration . 1)) (END .
(package_declaration . 1)) (CASE . (package_declaration . 1)) (FOR .
(package_declaration . 1)) (NULL . (package_declaration . 1)) (PACKAGE .
(package_declaration . 1)) (TYPE . (package_declaration . 1)) (IDENTIFIER .
(package_declaration . 1)))
+ ((default . error) (WHEN . (package_declaration . 2)) (END .
(package_declaration . 2)) (CASE . (package_declaration . 2)) (FOR .
(package_declaration . 2)) (NULL . (package_declaration . 2)) (PACKAGE .
(package_declaration . 2)) (TYPE . (package_declaration . 2)) (IDENTIFIER .
(package_declaration . 2)))
+ ((default . error) (WHEN . (declarative_item . 0)) (END .
(declarative_item . 0)) (IDENTIFIER . (declarative_item . 0)) (TYPE .
(declarative_item . 0)) (PACKAGE . (declarative_item . 0)) (NULL .
(declarative_item . 0)) (FOR . (declarative_item . 0)) (CASE .
(declarative_item . 0)))
+ ((default . error) (WHEN . (declarative_item . 1)) (END .
(declarative_item . 1)) (IDENTIFIER . (declarative_item . 1)) (TYPE .
(declarative_item . 1)) (PACKAGE . (declarative_item . 1)) (NULL .
(declarative_item . 1)) (FOR . (declarative_item . 1)) (CASE .
(declarative_item . 1)))
+ ((default . error) (IS . 72))
+ ((default . error) (END . (declarative_items_opt . 0)) (TYPE . 58)
(IDENTIFIER . 59) (NULL . 56) (CASE . 54) (FOR . 55) (PACKAGE . 57))
+ ((default . error) (SEMICOLON . (identifier_opt . 0)) (IDENTIFIER . 21))
+ ((default . error) (WHEN . (declarative_items . 1)) (IDENTIFIER .
(declarative_items . 1)) (TYPE . (declarative_items . 1)) (PACKAGE .
(declarative_items . 1)) (NULL . (declarative_items . 1)) (FOR .
(declarative_items . 1)) (CASE . (declarative_items . 1)) (END .
(declarative_items . 1)))
+ ((default . error) (IDENTIFIER . 94))
+ ((default . error) (LEFT_PAREN . 19) (STRING_LITERAL . 22) (EXTERNAL .
17) (EXTERNAL_AS_LIST . 18) (DOT . (identifier_opt . 0)) (AMPERSAND .
(identifier_opt . 0)) (SEMICOLON . (identifier_opt . 0)) (QUOTE .
(identifier_opt . 0)) (IDENTIFIER . 21) (PROJECT . 20))
+ ((default . error) (IS . 92))
+ ((default . error) (IS . 90) (EXTENDS . 89) (RENAMES . 91))
+ ((default . error) (WHEN . (simple_declarative_item . 4)) (IDENTIFIER .
(simple_declarative_item . 4)) (TYPE . (simple_declarative_item . 4)) (PACKAGE
. (simple_declarative_item . 4)) (NULL . (simple_declarative_item . 4)) (FOR .
(simple_declarative_item . 4)) (CASE . (simple_declarative_item . 4)) (END .
(simple_declarative_item . 4)))
+ ((default . error) (LEFT_PAREN . 88))
+ ((default . error) (USE . 87) (LEFT_PAREN . 86))
+ ((default . error) (DOT . 40) (IS . 85))
+ ((default . error) (STRING_LITERAL . 84))
+ ((default . error) (RIGHT_PAREN . 111))
+ ((default . error) (END . (case_items . 0)) (WHEN . ( 108 (case_items .
0))))
+ ((default . error) (STRING_LITERAL . 107))
+ ((default . error) (LEFT_PAREN . 19) (STRING_LITERAL . 22) (EXTERNAL .
17) (EXTERNAL_AS_LIST . 18) (DOT . (identifier_opt . 0)) (AMPERSAND .
(identifier_opt . 0)) (SEMICOLON . (identifier_opt . 0)) (QUOTE .
(identifier_opt . 0)) (IDENTIFIER . 21) (PROJECT . 20))
+ ((default . error) (STRING_LITERAL . 105))
+ ((default . error) (DOT . (identifier_opt . 0)) (IS . (identifier_opt .
0)) (IDENTIFIER . 21))
+ ((default . error) (END . (declarative_items_opt . 0)) (TYPE . 58)
(IDENTIFIER . 59) (NULL . 56) (CASE . 54) (FOR . 55) (PACKAGE . 57))
+ ((default . error) (DOT . (identifier_opt . 0)) (SEMICOLON .
(identifier_opt . 0)) (IDENTIFIER . 21))
+ ((default . error) (LEFT_PAREN . 45))
+ ((default . error) (AMPERSAND . 41) (SEMICOLON . 100))
+ ((default . error) (COLON_EQUALS . 99))
+ ((default . error) (SEMICOLON . 98))
+ ((default . error) (END . 97))
+ ((default . error) (SEMICOLON . (identifier_opt . 0)) (IDENTIFIER . 21))
((default . error) ($EOI . (simple_project_declaration . 0)))
- ((default . error) (SEMICOLON . 108))
- ((default . error) (END . (simple_declarative_items . 1)) (IDENTIFIER .
(simple_declarative_items . 1)) (CASE . (simple_declarative_items . 1)) (FOR .
(simple_declarative_items . 1)) (NULL . (simple_declarative_items . 1)))
- ((default . error) (END . 106) (IDENTIFIER . 52) (NULL . 55) (CASE .
53) (FOR . 54))
- ((default . error) (AMPERSAND . 39) (SEMICOLON . 105))
- ((default . error) (RIGHT_PAREN . 104))
- ((default . error) (VERTICAL_BAR . (discrete_choice . 0)) (EQUAL_GREATER
. (discrete_choice . 0)) (STRING_LITERAL . 100) (OTHERS . 101))
+ ((default . error) (LEFT_PAREN . 19) (STRING_LITERAL . 22) (EXTERNAL .
17) (EXTERNAL_AS_LIST . 18) (DOT . (identifier_opt . 0)) (AMPERSAND .
(identifier_opt . 0)) (SEMICOLON . (identifier_opt . 0)) (QUOTE .
(identifier_opt . 0)) (IDENTIFIER . 21) (PROJECT . 20))
+ ((default . error) (WHEN . (simple_declarative_item . 0)) (IDENTIFIER .
(simple_declarative_item . 0)) (TYPE . (simple_declarative_item . 0)) (PACKAGE
. (simple_declarative_item . 0)) (NULL . (simple_declarative_item . 0)) (FOR .
(simple_declarative_item . 0)) (CASE . (simple_declarative_item . 0)) (END .
(simple_declarative_item . 0)))
+ ((default . error) (SEMICOLON . 124))
+ ((default . error) (DOT . 40) (SEMICOLON . 123))
+ ((default . error) (END . 122))
+ ((default . error) (DOT . 40) (IS . 121))
+ ((default . error) (RIGHT_PAREN . 120))
+ ((default . error) (AMPERSAND . 41) (SEMICOLON . 119))
+ ((default . error) (RIGHT_PAREN . 118))
+ ((default . error) (VERTICAL_BAR . (discrete_choice . 0)) (EQUAL_GREATER
. (discrete_choice . 0)) (STRING_LITERAL . 115) (OTHERS . 114))
((default . error) (END . (case_items . 1)) (WHEN . (case_items . 1)))
- ((default . error) (END . 98) (WHEN . 91))
- ((default . error) (LEFT_PAREN . 20) (STRING_LITERAL . 17) (EXTERNAL .
18) (EXTERNAL_AS_LIST . 19) (DOT . (identifier_opt . 0)) (AMPERSAND .
(identifier_opt . 0)) (SEMICOLON . (identifier_opt . 0)) (QUOTE .
(identifier_opt . 0)) (IDENTIFIER . 16) (PROJECT . 21))
- ((default . error) (WHEN . (simple_declarative_item . 0)) (TYPE .
(simple_declarative_item . 0)) (PACKAGE . (simple_declarative_item . 0)) (NULL
. (simple_declarative_item . 0)) (FOR . (simple_declarative_item . 0)) (CASE .
(simple_declarative_item . 0)) (IDENTIFIER . (simple_declarative_item . 0))
(END . (simple_declarative_item . 0)))
+ ((default . error) (END . 112) (WHEN . 108))
((default . error) (AMPERSAND . (attribute_reference . 1)) (SEMICOLON .
(attribute_reference . 1)) (RIGHT_PAREN . (attribute_reference . 1)) (COMMA .
(attribute_reference . 1)))
- ((default . error) (AMPERSAND . 39) (SEMICOLON . 114))
- ((default . error) (CASE . 113))
+ ((default . error) (CASE . 135))
((default . error) (WHEN . (case_items . 2)) (END . (case_items . 2)))
- ((default . error) (VERTICAL_BAR . (discrete_choice . 1)) (EQUAL_GREATER
. (discrete_choice . 1)))
((default . error) (VERTICAL_BAR . (discrete_choice . 2)) (EQUAL_GREATER
. (discrete_choice . 2)))
+ ((default . error) (VERTICAL_BAR . (discrete_choice . 1)) (EQUAL_GREATER
. (discrete_choice . 1)))
((default . error) (EQUAL_GREATER . (discrete_choice_list . 0))
(VERTICAL_BAR . (discrete_choice_list . 0)))
- ((default . error) (VERTICAL_BAR . 112) (EQUAL_GREATER . 111))
- ((default . error) (USE . 110))
- ((default . error) (WHEN . (attribute_declaration . 0)) (END .
(attribute_declaration . 0)) (TYPE . (attribute_declaration . 0)) (PACKAGE .
(attribute_declaration . 0)) (NULL . (attribute_declaration . 0)) (FOR .
(attribute_declaration . 0)) (CASE . (attribute_declaration . 0)) (IDENTIFIER .
(attribute_declaration . 0)))
- ((default . error) (SEMICOLON . (identifier_opt . 0)) (IDENTIFIER . 16))
- ((default . error) (NULL . (simple_declarative_items . 2)) (FOR .
(simple_declarative_items . 2)) (CASE . (simple_declarative_items . 2))
(IDENTIFIER . (simple_declarative_items . 2)) (END . (simple_declarative_items
. 2)))
- ((default . error) (WHEN . (typed_string_declaration . 0)) (END .
(typed_string_declaration . 0)) (IDENTIFIER . (typed_string_declaration . 0))
(CASE . (typed_string_declaration . 0)) (FOR . (typed_string_declaration . 0))
(NULL . (typed_string_declaration . 0)) (PACKAGE . (typed_string_declaration .
0)) (TYPE . (typed_string_declaration . 0)))
- ((default . error) (SEMICOLON . 119))
- ((default . error) (LEFT_PAREN . 20) (STRING_LITERAL . 17) (EXTERNAL .
18) (EXTERNAL_AS_LIST . 19) (DOT . (identifier_opt . 0)) (AMPERSAND .
(identifier_opt . 0)) (SEMICOLON . (identifier_opt . 0)) (QUOTE .
(identifier_opt . 0)) (IDENTIFIER . 16) (PROJECT . 21))
- ((default . error) (END . (declarative_items . 0)) (WHEN .
(declarative_items . 0)) (TYPE . ((declarative_items . 0) 57)) (IDENTIFIER .
((declarative_items . 0) 52)) (NULL . ((declarative_items . 0) 55)) (CASE .
((declarative_items . 0) 53)) (FOR . ((declarative_items . 0) 54)) (PACKAGE .
((declarative_items . 0) 56)))
- ((default . error) (EQUAL_GREATER . (discrete_choice . 0)) (VERTICAL_BAR
. (discrete_choice . 0)) (STRING_LITERAL . 100) (OTHERS . 101))
- ((default . error) (SEMICOLON . 115))
- ((default . error) (WHEN . (simple_declarative_item . 1)) (TYPE .
(simple_declarative_item . 1)) (PACKAGE . (simple_declarative_item . 1)) (NULL
. (simple_declarative_item . 1)) (FOR . (simple_declarative_item . 1)) (CASE .
(simple_declarative_item . 1)) (IDENTIFIER . (simple_declarative_item . 1))
(END . (simple_declarative_item . 1)))
- ((default . error) (WHEN . (case_statement . 0)) (END . (case_statement
. 0)) (TYPE . (case_statement . 0)) (PACKAGE . (case_statement . 0)) (NULL .
(case_statement . 0)) (FOR . (case_statement . 0)) (CASE . (case_statement .
0)) (IDENTIFIER . (case_statement . 0)))
+ ((default . error) (VERTICAL_BAR . 134) (EQUAL_GREATER . 133))
+ ((default . error) (USE . 132))
+ ((default . error) (WHEN . (attribute_declaration . 0)) (END .
(attribute_declaration . 0)) (IDENTIFIER . (attribute_declaration . 0)) (TYPE .
(attribute_declaration . 0)) (PACKAGE . (attribute_declaration . 0)) (NULL .
(attribute_declaration . 0)) (FOR . (attribute_declaration . 0)) (CASE .
(attribute_declaration . 0)))
+ ((default . error) (USE . 131))
+ ((default . error) (END . (declarative_items_opt . 0)) (TYPE . 58)
(IDENTIFIER . 59) (NULL . 56) (CASE . 54) (FOR . 55) (PACKAGE . 57))
+ ((default . error) (SEMICOLON . (identifier_opt . 0)) (IDENTIFIER . 21))
+ ((default . error) (WHEN . (package_renaming . 0)) (END .
(package_renaming . 0)) (IDENTIFIER . (package_renaming . 0)) (TYPE .
(package_renaming . 0)) (PACKAGE . (package_renaming . 0)) (NULL .
(package_renaming . 0)) (FOR . (package_renaming . 0)) (CASE .
(package_renaming . 0)))
+ ((default . error) (WHEN . (typed_string_declaration . 0)) (END .
(typed_string_declaration . 0)) (CASE . (typed_string_declaration . 0)) (FOR .
(typed_string_declaration . 0)) (NULL . (typed_string_declaration . 0))
(PACKAGE . (typed_string_declaration . 0)) (TYPE . (typed_string_declaration .
0)) (IDENTIFIER . (typed_string_declaration . 0)))
+ ((default . error) (AMPERSAND . 41) (SEMICOLON . 128))
+ ((default . error) (SEMICOLON . 127))
+ ((default . error) ($EOI . (project_extension . 0)))
+ ((default . error) (WHEN . (simple_declarative_item . 1)) (IDENTIFIER .
(simple_declarative_item . 1)) (TYPE . (simple_declarative_item . 1)) (PACKAGE
. (simple_declarative_item . 1)) (NULL . (simple_declarative_item . 1)) (FOR .
(simple_declarative_item . 1)) (CASE . (simple_declarative_item . 1)) (END .
(simple_declarative_item . 1)))
+ ((default . error) (SEMICOLON . 142))
+ ((default . error) (END . 141))
+ ((default . error) (LEFT_PAREN . 19) (STRING_LITERAL . 22) (EXTERNAL .
17) (EXTERNAL_AS_LIST . 18) (DOT . (identifier_opt . 0)) (AMPERSAND .
(identifier_opt . 0)) (SEMICOLON . (identifier_opt . 0)) (QUOTE .
(identifier_opt . 0)) (IDENTIFIER . 21) (PROJECT . 20))
+ ((default . error) (LEFT_PAREN . 19) (STRING_LITERAL . 22) (EXTERNAL .
17) (EXTERNAL_AS_LIST . 18) (DOT . (identifier_opt . 0)) (AMPERSAND .
(identifier_opt . 0)) (SEMICOLON . (identifier_opt . 0)) (QUOTE .
(identifier_opt . 0)) (IDENTIFIER . 21) (PROJECT . 20))
+ ((default . error) (END . (declarative_items_opt . 0)) (WHEN .
(declarative_items_opt . 0)) (TYPE . 58) (IDENTIFIER . 59) (NULL . 56) (CASE
. 54) (FOR . 55) (PACKAGE . 57))
+ ((default . error) (EQUAL_GREATER . (discrete_choice . 0)) (VERTICAL_BAR
. (discrete_choice . 0)) (STRING_LITERAL . 115) (OTHERS . 114))
+ ((default . error) (SEMICOLON . 136))
+ ((default . error) (WHEN . (case_statement . 0)) (END . (case_statement
. 0)) (IDENTIFIER . (case_statement . 0)) (TYPE . (case_statement . 0))
(PACKAGE . (case_statement . 0)) (NULL . (case_statement . 0)) (FOR .
(case_statement . 0)) (CASE . (case_statement . 0)))
((default . error) (EQUAL_GREATER . (discrete_choice_list . 1))
(VERTICAL_BAR . (discrete_choice_list . 1)))
- ((default . error) (END . (case_item . 0)) (WHEN . (case_item . 0))
(TYPE . 57) (IDENTIFIER . 52) (NULL . 55) (CASE . 53) (FOR . 54) (PACKAGE
. 56))
- ((default . error) (AMPERSAND . 39) (SEMICOLON . 120))
- ((default . error) (WHEN . (package_spec . 0)) (END . (package_spec .
0)) (TYPE . (package_spec . 0)) (PACKAGE . (package_spec . 0)) (NULL .
(package_spec . 0)) (FOR . (package_spec . 0)) (CASE . (package_spec . 0))
(IDENTIFIER . (package_spec . 0)))
- ((default . error) (WHEN . (attribute_declaration . 1)) (IDENTIFIER .
(attribute_declaration . 1)) (CASE . (attribute_declaration . 1)) (FOR .
(attribute_declaration . 1)) (NULL . (attribute_declaration . 1)) (PACKAGE .
(attribute_declaration . 1)) (TYPE . (attribute_declaration . 1)) (END .
(attribute_declaration . 1)))]
- [((compilation_unit . 8)(context_clause . 9)(context_clause_opt .
10)(simple_project_declaration . 11)(with_clause . 12))
+ ((default . error) (END . (case_item . 0)) (WHEN . (case_item . 0)))
+ ((default . error) (AMPERSAND . 41) (SEMICOLON . 145))
+ ((default . error) (AMPERSAND . 41) (SEMICOLON . 144))
+ ((default . error) (SEMICOLON . (identifier_opt . 0)) (IDENTIFIER . 21))
+ ((default . error) (WHEN . (package_spec . 0)) (END . (package_spec .
0)) (IDENTIFIER . (package_spec . 0)) (TYPE . (package_spec . 0)) (PACKAGE .
(package_spec . 0)) (NULL . (package_spec . 0)) (FOR . (package_spec . 0))
(CASE . (package_spec . 0)))
+ ((default . error) (SEMICOLON . 146))
+ ((default . error) (WHEN . (attribute_declaration . 2)) (CASE .
(attribute_declaration . 2)) (FOR . (attribute_declaration . 2)) (NULL .
(attribute_declaration . 2)) (PACKAGE . (attribute_declaration . 2)) (TYPE .
(attribute_declaration . 2)) (IDENTIFIER . (attribute_declaration . 2)) (END .
(attribute_declaration . 2)))
+ ((default . error) (WHEN . (attribute_declaration . 1)) (CASE .
(attribute_declaration . 1)) (FOR . (attribute_declaration . 1)) (NULL .
(attribute_declaration . 1)) (PACKAGE . (attribute_declaration . 1)) (TYPE .
(attribute_declaration . 1)) (IDENTIFIER . (attribute_declaration . 1)) (END .
(attribute_declaration . 1)))
+ ((default . error) (WHEN . (package_extension . 0)) (END .
(package_extension . 0)) (IDENTIFIER . (package_extension . 0)) (TYPE .
(package_extension . 0)) (PACKAGE . (package_extension . 0)) (NULL .
(package_extension . 0)) (FOR . (package_extension . 0)) (CASE .
(package_extension . 0)))]
+ [((compilation_unit . 8)(context_clause . 9)(context_clause_opt .
10)(project_extension . 11)(simple_project_declaration . 12)(with_clause . 13))
+ nil
+ nil
+ nil
+ nil
+ ((identifier_opt . 34))
+ nil
+ ((aggregate . 23)(attribute_prefix . 24)(attribute_reference .
25)(expression . 26)(external_value . 27)(identifier_opt . 28)(name .
29)(string_expression . 30)(string_primary . 31)(string_list . 32)(term . 33))
+ nil
+ ((with_clause . 15))
+ ((project_qualifier_opt . 14))
+ nil
+ nil
+ nil
+ ((project_declaration_opt . 48)(project_extension .
11)(simple_project_declaration . 12))
+ nil
+ nil
+ ((aggregate . 47))
+ ((aggregate . 46))
+ ((aggregate . 23)(attribute_prefix . 24)(attribute_reference .
25)(expression . 26)(external_value . 27)(identifier_opt . 28)(name .
29)(string_expression . 30)(string_primary . 31)(string_list . 44)(term . 33))
+ nil
+ nil
+ nil
+ nil
+ nil
+ nil
+ nil
+ nil
+ nil
+ nil
nil
nil
nil
nil
- ((identifier_opt . 33))
nil
- ((aggregate . 22)(attribute_prefix . 23)(attribute_reference .
24)(expression . 25)(external_value . 26)(identifier_opt . 27)(name .
28)(string_expression . 29)(string_primary . 30)(string_list . 31)(term . 32))
nil
- ((with_clause . 14))
- ((project_qualifier_opt . 13))
nil
+ ((attribute_declaration . 60)(case_statement . 61)(declarative_item .
62)(declarative_items . 63)(declarative_items_opt . 64)(package_declaration .
65)(package_spec . 66)(package_extension . 67)(package_renaming .
68)(simple_declarative_item . 69)(typed_string_declaration . 70))
+ ((aggregate . 23)(attribute_prefix . 24)(attribute_reference .
25)(expression . 53)(external_value . 27)(identifier_opt . 28)(name .
29)(string_expression . 30)(string_primary . 31)(term . 33))
nil
- ((project_declaration_opt . 46)(simple_project_declaration . 11))
nil
+ ((aggregate . 23)(attribute_prefix . 24)(attribute_reference .
25)(external_value . 27)(identifier_opt . 28)(name . 29)(string_expression .
30)(string_primary . 31)(term . 51))
nil
nil
nil
- ((aggregate . 45))
- ((aggregate . 44))
- ((aggregate . 22)(attribute_prefix . 23)(attribute_reference .
24)(expression . 25)(external_value . 26)(identifier_opt . 27)(name .
28)(string_expression . 29)(string_primary . 30)(string_list . 42)(term . 32))
+ ((aggregate . 23)(attribute_prefix . 24)(attribute_reference .
25)(expression . 26)(external_value . 27)(identifier_opt . 28)(name .
29)(string_expression . 30)(string_primary . 31)(string_list . 44)(term . 33))
nil
nil
nil
@@ -358,74 +432,75 @@
nil
nil
nil
+ ((identifier_opt . 28)(name . 82))
nil
nil
+ ((identifier_opt . 78))
nil
nil
nil
nil
- ((attribute_declaration . 58)(case_statement . 59)(declarative_item .
60)(declarative_items . 61)(package_declaration . 62)(package_spec .
63)(simple_declarative_item . 64)(typed_string_declaration . 65))
- ((aggregate . 22)(attribute_prefix . 23)(attribute_reference .
24)(expression . 51)(external_value . 26)(identifier_opt . 27)(name .
28)(string_expression . 29)(string_primary . 30)(term . 32))
nil
+ ((attribute_declaration . 60)(case_statement . 61)(declarative_item .
74)(package_declaration . 65)(package_spec . 66)(package_extension .
67)(package_renaming . 68)(simple_declarative_item .
69)(typed_string_declaration . 70))
nil
- ((aggregate . 22)(attribute_prefix . 23)(attribute_reference .
24)(external_value . 26)(identifier_opt . 27)(name . 28)(string_expression .
29)(string_primary . 30)(term . 49))
nil
nil
nil
- ((aggregate . 22)(attribute_prefix . 23)(attribute_reference .
24)(expression . 25)(external_value . 26)(identifier_opt . 27)(name .
28)(string_expression . 29)(string_primary . 30)(string_list . 42)(term . 32))
nil
nil
nil
nil
+ ((attribute_declaration . 60)(case_statement . 61)(declarative_item .
62)(declarative_items . 63)(declarative_items_opt . 96)(package_declaration .
65)(package_spec . 66)(package_extension . 67)(package_renaming .
68)(simple_declarative_item . 69)(typed_string_declaration . 70))
+ ((identifier_opt . 95))
nil
nil
+ ((aggregate . 23)(attribute_prefix . 24)(attribute_reference .
25)(expression . 93)(external_value . 27)(identifier_opt . 28)(name .
29)(string_expression . 30)(string_primary . 31)(term . 33))
nil
nil
nil
- ((identifier_opt . 27)(name . 72))
nil
nil
- ((identifier_opt . 69))
nil
nil
nil
+ ((case_item . 109)(case_items . 110))
nil
- ((attribute_declaration . 58)(case_statement . 59)(declarative_item .
67)(package_declaration . 62)(package_spec . 63)(simple_declarative_item .
64)(typed_string_declaration . 65))
+ ((aggregate . 23)(attribute_prefix . 24)(attribute_reference .
25)(expression . 106)(external_value . 27)(identifier_opt . 28)(name .
29)(string_expression . 30)(string_primary . 31)(term . 33))
nil
+ ((identifier_opt . 28)(name . 104))
+ ((attribute_declaration . 60)(case_statement . 61)(declarative_item .
62)(declarative_items . 63)(declarative_items_opt . 103)(package_declaration .
65)(package_spec . 66)(package_extension . 67)(package_renaming .
68)(simple_declarative_item . 69)(typed_string_declaration . 70))
+ ((identifier_opt . 28)(name . 102))
+ ((aggregate . 101))
nil
nil
nil
- ((identifier_opt . 84))
nil
+ ((identifier_opt . 126))
nil
+ ((aggregate . 23)(attribute_prefix . 24)(attribute_reference .
25)(expression . 125)(external_value . 27)(identifier_opt . 28)(name .
29)(string_expression . 30)(string_primary . 31)(term . 33))
nil
nil
nil
nil
nil
- ((aggregate . 22)(attribute_prefix . 23)(attribute_reference .
24)(expression . 77)(external_value . 26)(identifier_opt . 27)(name .
28)(string_expression . 29)(string_primary . 30)(term . 32))
nil
nil
nil
+ ((discrete_choice . 116)(discrete_choice_list . 117))
nil
- ((case_item . 92)(case_items . 93))
+ ((case_item . 113))
nil
- ((aggregate . 22)(attribute_prefix . 23)(attribute_reference .
24)(expression . 89)(external_value . 26)(identifier_opt . 27)(name .
28)(string_expression . 29)(string_primary . 30)(term . 32))
- ((attribute_declaration . 58)(case_statement .
59)(simple_declarative_item . 87)(simple_declarative_items . 88))
- ((aggregate . 86))
nil
nil
nil
nil
- ((attribute_declaration . 58)(case_statement .
59)(simple_declarative_item . 107))
nil
nil
- ((discrete_choice . 102)(discrete_choice_list . 103))
nil
- ((case_item . 99))
- ((aggregate . 22)(attribute_prefix . 23)(attribute_reference .
24)(expression . 97)(external_value . 26)(identifier_opt . 27)(name .
28)(string_expression . 29)(string_primary . 30)(term . 32))
nil
nil
+ ((attribute_declaration . 60)(case_statement . 61)(declarative_item .
62)(declarative_items . 63)(declarative_items_opt . 130)(package_declaration .
65)(package_spec . 66)(package_extension . 67)(package_renaming .
68)(simple_declarative_item . 69)(typed_string_declaration . 70))
+ ((identifier_opt . 129))
nil
nil
nil
@@ -434,19 +509,19 @@
nil
nil
nil
+ ((aggregate . 23)(attribute_prefix . 24)(attribute_reference .
25)(expression . 140)(external_value . 27)(identifier_opt . 28)(name .
29)(string_expression . 30)(string_primary . 31)(term . 33))
+ ((aggregate . 23)(attribute_prefix . 24)(attribute_reference .
25)(expression . 139)(external_value . 27)(identifier_opt . 28)(name .
29)(string_expression . 30)(string_primary . 31)(term . 33))
+ ((attribute_declaration . 60)(case_statement . 61)(declarative_item .
62)(declarative_items . 63)(declarative_items_opt . 138)(package_declaration .
65)(package_spec . 66)(package_extension . 67)(package_renaming .
68)(simple_declarative_item . 69)(typed_string_declaration . 70))
+ ((discrete_choice . 137))
nil
- ((identifier_opt . 109))
nil
nil
nil
- ((aggregate . 22)(attribute_prefix . 23)(attribute_reference .
24)(expression . 118)(external_value . 26)(identifier_opt . 27)(name .
28)(string_expression . 29)(string_primary . 30)(term . 32))
- ((attribute_declaration . 58)(case_statement . 59)(declarative_item .
60)(declarative_items . 117)(package_declaration . 62)(package_spec .
63)(simple_declarative_item . 64)(typed_string_declaration . 65))
- ((discrete_choice . 116))
nil
nil
+ ((identifier_opt . 143))
nil
nil
- ((attribute_declaration . 58)(case_statement . 59)(declarative_item .
67)(package_declaration . 62)(package_spec . 63)(simple_declarative_item .
64)(typed_string_declaration . 65))
nil
nil
nil]))
diff --git a/packages/ada-mode/gpr-mode.el b/packages/ada-mode/gpr-mode.el
index 798964a..4bdf5b3 100644
--- a/packages/ada-mode/gpr-mode.el
+++ b/packages/ada-mode/gpr-mode.el
@@ -1,6 +1,6 @@
-;;; gpr-mode --- major-mode for editing GNAT project files
+;; gpr-mode --- Major mode for editing GNAT project files -*-
lexical-binding:t -*-
-;; Copyright (C) 2004, 2007, 2008, 2012-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2004, 2007, 2008, 2012-2015 Free Software Foundation, Inc.
;; Author: Stephen Leake <address@hidden>
;; Maintainer: Stephen Leake <address@hidden>
@@ -46,19 +46,16 @@
(define-key map [return] 'ada-indent-newline-indent)
(define-key map "\C-c`" 'ada-show-secondary-error)
;; comment-dwim is in global map on M-;
- (define-key map "\C-c\C-c" 'compile)
+ (define-key map "\C-c\C-c" 'ada-build-make)
(define-key map "\C-c\C-e" 'gpr-expand)
(define-key map "\C-c\C-f" 'gpr-show-parse-error)
(define-key map "\C-c\C-i" 'gpr-indent-statement)
- ;; FIXME (later): implement?
- ;; (define-key map "\C-c\C-n" 'ada-next-statement-keyword)
- ;; (define-key map "\C-c\C-p" 'ada-prev-statement-keyword)
(define-key map "\C-c\C-o" 'ff-find-other-file)
(define-key map "\C-c\C-P" 'gpr-set-as-project)
(define-key map "\C-c\C-t" 'ada-case-read-all-exceptions)
(define-key map "\C-c\C-w" 'ada-case-adjust-at-point)
(define-key map "\C-c\C-y" 'ada-case-create-exception)
- (define-key map "\C-c\C-\M-y" (lambda () (ada-case-create-exception nil
nil t)))
+ (define-key map "\C-c\C-\M-y" 'ada-case-create-partial-exception)
(define-key map "\M-n" 'skeleton-next-placeholder)
(define-key map "\M-p" 'skeleton-prev-placeholder)
map
@@ -76,6 +73,7 @@
["Customize" (customize-group 'ada)];; we reuse the Ada indentation
options
["------" nil nil]
+ ["Build current project" ada-build-make t]
["Find and select project ..." ada-build-prompt-select-prj-file t]
["Select project ..." ada-prj-select t]
["Parse and select current file" gpr-set-as-project t]
@@ -131,11 +129,38 @@ Function is called with no arguments.")
(when gpr-indent-statement
(funcall gpr-indent-statement)))
+(defconst gpr-casing-keywords
+ '(
+ "abstract"
+ "aggregate"
+ "case"
+ "configuration"
+ "end"
+ "extends"
+ "external"
+ "external_as_list"
+ "for"
+ "is"
+ "library"
+ "limited"
+ "null"
+ "others"
+ "package"
+ "project"
+ "renames"
+ "standard"
+ "type"
+ "use"
+ "when"
+ "with"
+ )
+ "List of gpr mode keywords for auto-casing.")
+
(defvar gpr-font-lock-keywords
(progn
(list
;;
- ;; keyword plus name.
+ ;; keyword plus name. FIXME: move to grammar action, use gpr-keywords
here (see ada-font-lock-keywords).
(list (concat
"\\<\\("
"package\\|"
@@ -148,8 +173,10 @@ Function is called with no arguments.")
;; Main keywords
(list (concat "\\<"
(regexp-opt
- '("abstract" "aggregate" "case" "configuration" "external"
"is" "library" "null" "others"
- "renames" "standard" "type" "use" "when" "with") t)
+ '("abstract" "aggregate" "case" "configuration" "extends"
+ "external" "external_as_list" "is" "library" "null"
+ "others" "renames" "standard" "type" "use" "when" "with")
+ t)
"\\>")
'(1 font-lock-keyword-face))
;;
@@ -207,6 +234,7 @@ of the package or project point is in or just after, or
nil.")
(end-of-line 1)
(gpr-which-function)))
+(declare-function gpr-query-kill-all-sessions "gpr-query.el" nil)
(defun gpr-set-as-project (&optional file)
"Set FILE (default current buffer file) as Emacs project file."
(interactive)
@@ -214,7 +242,7 @@ of the package or project point is in or just after, or
nil.")
;; Kill sessions to catch changed env vars
;; FIXME: need dispatching kill single session
(cl-ecase ada-xref-tool
- (gnat_xref nil)
+ (gnat nil)
(gpr_query (gpr-query-kill-all-sessions))
)
(ada-parse-prj-file (or file (buffer-file-name)))
@@ -231,7 +259,9 @@ of the package or project point is in or just after, or
nil.")
(setq mode-name "GNAT Project")
(use-local-map gpr-mode-map)
(set-syntax-table ada-mode-syntax-table)
- (set (make-local-variable 'syntax-begin-function) nil)
+ (when (boundp 'syntax-begin-function)
+ ;; obsolete in emacs-25.1
+ (set (make-local-variable 'syntax-begin-function) nil))
(set 'case-fold-search t); gpr is case insensitive; the syntax parsing
requires this setting
(set (make-local-variable 'comment-start) "--")
(set (make-local-variable 'comment-end) "")
@@ -240,6 +270,9 @@ of the package or project point is in or just after, or
nil.")
(set (make-local-variable 'require-final-newline) t)
+ (ada-case-activate-keys gpr-mode-map)
+ (set (make-local-variable 'ada-keywords) gpr-casing-keywords)
+
(set (make-local-variable 'font-lock-defaults)
'(gpr-font-lock-keywords
nil t
diff --git a/packages/ada-mode/gpr-mode.info b/packages/ada-mode/gpr-mode.info
index a001029..48bcae5 100644
--- a/packages/ada-mode/gpr-mode.info
+++ b/packages/ada-mode/gpr-mode.info
@@ -1,4 +1,4 @@
-This is gpr-mode.info, produced by makeinfo version 5.2 from
+This is gpr-mode.info, produced by makeinfo version 6.0 from
gpr-mode.texi.
Copyright (C) 2013 Free Software Foundation, Inc.
diff --git a/packages/ada-mode/gpr-query.el b/packages/ada-mode/gpr-query.el
index be03ca8..ccb980e 100644
--- a/packages/ada-mode/gpr-query.el
+++ b/packages/ada-mode/gpr-query.el
@@ -1,10 +1,9 @@
-;;; gpr-query.el --- minor-mode for navigating sources using the
-;;; custom gpr_query tool.
-;;;
-;;; gpr-query supports Ada and any gcc language that supports the
-;;; AdaCore -fdump-xref switch (which includes C, C++).
+;; gpr-query.el --- Minor mode for navigating sources using gpr_query -*-
lexical-binding:t -*-
;;
-;;; Copyright (C) 2013, 2014 Free Software Foundation, Inc.
+;; gpr-query supports Ada and any gcc language that supports the
+;; AdaCore -fdump-xref switch (which includes C, C++).
+;;
+;; Copyright (C) 2013 - 2015 Free Software Foundation, Inc.
;; Author: Stephen Leake <address@hidden>
;; Maintainer: Stephen Leake <address@hidden>
@@ -29,6 +28,8 @@
;;
;; M-x gpr-query
+(require 'ada-mode-compat-24.2)
+
(require 'ada-mode) ;; for ada-prj-*, some other things
(require 'gnat-core)
(require 'cl-lib)
@@ -64,8 +65,6 @@
(setf (gpr-query--session-process session)
;; gnatcoll-1.6 can't handle aggregate projects; M910-032
;; gpr_query can handle some aggregate projects, but not all
- ;; FIXME: need good error message on bad project file:
- ;; "can't handle aggregate projects?")
(start-process (concat "gpr_query " (buffer-name))
(gpr-query--session-buffer session)
"gpr_query"
@@ -73,10 +72,17 @@
(set-process-query-on-exit-flag (gpr-query--session-process session) nil)
(gpr-query-session-wait session)
- ;; check for warnings about invalid directories etc
- (goto-char (point-min))
- (when (search-forward "warning:" nil t)
- (error "gpr_query warnings"))
+ ;; Check for warnings about invalid directories etc. But some
+ ;; warnings are tolerable, so only abort if process actually
+ ;; died.
+ (if (process-live-p (gpr-query--session-process session))
+ (progn
+ (goto-char (point-min))
+ (when (search-forward "warning:" nil t)
+ (beep)
+ (message "gpr_query warnings")))
+
+ (error "gpr-query process failed to start"))
)))
(defun gpr-query--make-session ()
@@ -126,7 +132,7 @@
(not (re-search-forward gpr-query-prompt (point-max) 1))))
(setq search-start (point));; don't search same text again
(message (concat "running gpr_query ..." (make-string wait-count ?.)))
- ;; FIXME: use --display-progress
+ ;; IMPROVEME: use --display-progress
(accept-process-output process 1.0)
(setq wait-count (1+ wait-count)))
(if (process-live-p process)
@@ -203,16 +209,20 @@ Uses 'gpr_query'. Returns new list."
src-dirs)
(defun gpr-query-get-prj-dirs (prj-dirs)
- "Append list of source dirs in current gpr project to PRJ-DIRS.
+ "Append list of project dirs in current gpr project to PRJ-DIRS.
Uses 'gpr_query'. Returns new list."
(with-current-buffer (gpr-query--session-buffer (gpr-query-cached-session))
(gpr-query-session-send "project_path" t)
(goto-char (point-min))
(while (not (looking-at gpr-query-prompt))
- (cl-pushnew (directory-file-name
- (buffer-substring-no-properties (point) (point-at-eol)))
- prj-dirs :test #'equal)
+ (cl-pushnew
+ (let ((dir (buffer-substring-no-properties (point) (point-at-eol))))
+ (if (string= dir ".")
+ (directory-file-name default-directory)
+ dir))
+ prj-dirs
+ :test #'equal)
(forward-line 1))
)
prj-dirs)
@@ -220,7 +230,7 @@ Uses 'gpr_query'. Returns new list."
(defconst gpr-query-ident-file-regexp
;;
C:\Projects\GDS\work_dscovr_release\common\1553\gds-mil_std_1553-utf.ads:252:25
;;
/Projects/GDS/work_dscovr_release/common/1553/gds-mil_std_1553-utf.ads:252:25
- "\\(\\(?:.:\\\|/\\)[^:]*\\):\\([0123456789]+\\):\\([0123456789]+\\)"
+ "\\(\\(?:.:\\\\\\|/\\)[^:]*\\):\\([0123456789]+\\):\\([0123456789]+\\)"
;; 1 2 3
"Regexp matching <file>:<line>:<column>")
@@ -232,10 +242,6 @@ Uses 'gpr_query'. Returns new list."
(concat gpr-query-ident-file-regexp " (\\(.*\\))")
"Regexp matching <file>:<line>:<column> (<type>)")
-;; debugging:
-;; in *compilation-gpr_query-refs*, run
-;; (progn (set-text-properties (point-min)(point-max)
nil)(compilation-parse-errors (point-min)(point-max)
gpr-query-ident-file-regexp-alist))
-
(defun gpr-query-compilation (identifier file line col cmd comp-err)
"Run gpr_query IDENTIFIER:FILE:LINE:COL CMD,
set compilation-mode with compilation-error-regexp-alist set to COMP-ERR."
@@ -244,40 +250,55 @@ set compilation-mode with compilation-error-regexp-alist
set to COMP-ERR."
;; to each result in turn via `next-error'.
(let ((cmd-1 (format "%s %s:%s:%d:%d" cmd identifier file line col))
(result-count 0)
- file line column)
+ target-file target-line target-col)
(with-current-buffer (gpr-query--session-buffer (gpr-query-cached-session))
(compilation-mode)
(setq buffer-read-only nil)
(set (make-local-variable 'compilation-error-regexp-alist) (list
comp-err))
(gpr-query-session-send cmd-1 t)
- ;; point is at EOB. gpr_query returns one line per result plus prompt
+
+ ;; point is at EOB. gpr_query returns one line per result plus prompt,
warnings
(setq result-count (- (line-number-at-pos) 1))
- ;; Won't be needed in 24.5 any more.
- (if (fboundp 'font-lock-ensure)
- (font-lock-ensure)
- (font-lock-fontify-buffer))
- ;; font-lock-fontify-buffer applies compilation-message text properties
- ;; FIXME: Won't be needed in 24.5 any more, since compilation-next-error
- ;; will apply compilation-message text properties on the fly.
- ;; IMPROVEME: for some reason, next-error works, but the font
- ;; colors are not right (no koolaid!)
+
+ (font-lock-ensure)
+ ;; pre Emacs 25, font-lock-ensure applies compilation-message
+ ;; text properties
+ ;;
+ ;; post Emacs 25, compilation-next-error applies
+ ;; compilation-message text properties on the fly via
+ ;; compilation--ensure-parse. But that doesn't apply face text
+ ;; properties.
+ ;;
+ ;; IMPROVEME: next-error works, but the font colors are not
+ ;; right (bad regexp?)
+
(goto-char (point-min))
+ (cond
+ ((looking-at "^warning: ")
+ (setq result-count (1- result-count))
+ (forward-line 1))
+ ((looking-at "^Error: entity not found")
+ (error (buffer-substring-no-properties (line-beginning-position)
(line-end-position))))
+ )
(cl-case result-count
(0
(error "gpr_query returned no results"))
(1
- (when (looking-at "^Error: entity not found")
- (error (buffer-substring-no-properties (line-beginning-position)
(line-end-position))))
-
;; just go there, don't display session-buffer. We have to
- ;; fetch the compilation-message while in the session-buffer.
- (let* ((msg (compilation-next-error 0 nil (point-min)))
- ;; FIXME: '--' indicates internal-only; use compile-goto-error
- (loc (compilation--message->loc msg)))
- (setq file (caar (compilation--loc->file-struct loc))
- line (caar (cddr (compilation--loc->file-struct loc)))
- column (1- (compilation--loc->col loc)))
+ ;; fetch the compilation-message while in the
+ ;; session-buffer. and call ada-goot-source outside the
+ ;; with-current-buffer above.
+ (compilation--ensure-parse (point-max))
+ (let* ((msg (compilation-next-error 0))
+ ;; IMPROVEME: '--' indicates internal-only. But we can't
+ ;; use compile-goto-error, because that displays the
+ ;; session-buffer.
+ (loc (compilation--message->loc msg)))
+ (setq target-file (caar (compilation--loc->file-struct loc))
+ target-line (caar (cddr (compilation--loc->file-struct loc)))
+ target-col (1- (compilation--loc->col loc))
+ )
))
(t
@@ -286,18 +307,20 @@ set compilation-mode with compilation-error-regexp-alist
set to COMP-ERR."
));; case, with-currrent-buffer
- (if (> result-count 1)
- ;; more than one result; display session buffer, goto first ref
- ;;
- ;; compilation-next-error-function assumes there is not an error
- ;; at point-min; work around that by moving forward 0 errors for
- ;; the first one. Unless the first line contains "warning: ".
- (if (looking-at "^warning: ")
- (next-error)
- (next-error 0 t))
-
- ;; just one result; go there
- (ada-goto-source file line column nil))
+ (if (= result-count 1)
+ (ada-goto-source target-file target-line target-col nil)
+
+ ;; more than one result; display session buffer, goto first ref
+ ;;
+ ;; compilation-next-error-function assumes there is not an error
+ ;; at point-min; work around that by moving forward 0 errors for
+ ;; the first one. Unless the first line contains "warning: ".
+ (set-buffer next-error-last-buffer)
+ (goto-char (point-min))
+ (if (looking-at "^warning: ")
+ (next-error)
+ (next-error 0 t))
+ )
))
(defun gpr-query-dist (found-line line found-col col)
@@ -372,8 +395,8 @@ buffer in another window."
(define-key map "\C-c\C-i\C-p" 'ada-build-prompt-select-prj-file)
(define-key map "\C-c\C-i\C-q" 'gpr-query-refresh)
(define-key map "\C-c\C-i\C-r" 'gpr-query-show-references)
- ;; FIXME: (define-key map "\C-c\M-d" 'gpr-query-parents)
- ;; FIXME: overriding
+ ;; IMPROVEME: (define-key map "\C-c\M-d" 'gpr-query-parents)
+ ;; IMPROVEME: overriding
map
) "Local keymap used for gpr query minor mode.")
@@ -396,7 +419,7 @@ buffer in another window."
(define-minor-mode gpr-query
"Minor mode for navigating sources using GNAT cross reference tool.
-Enable mode if ARG is positive"
+Enable mode if ARG is positive."
:initial-value t
:lighter " gpr-query" ;; mode line
@@ -574,12 +597,6 @@ Enable mode if ARG is positive"
(setq ada-ada-name-from-file-name 'ada-gnat-ada-name-from-file-name)
(setq ada-make-package-body 'ada-gnat-make-package-body)
- (add-hook 'ada-syntax-propertize-hook 'gnatprep-syntax-propertize)
-
- ;; must be after indentation engine setup, because that resets the
- ;; indent function list.
- (add-hook 'ada-mode-hook 'ada-gpr-query-setup t)
-
(setq ada-xref-refresh-function 'gpr-query-refresh)
(setq ada-xref-all-function 'gpr-query-all)
(setq ada-xref-other-function 'gpr-query-other)
@@ -597,9 +614,6 @@ Enable mode if ARG is positive"
(setq ada-ada-name-from-file-name nil)
(setq ada-make-package-body nil)
- (setq ada-syntax-propertize-hook (delq 'gnatprep-syntax-propertize
ada-syntax-propertize-hook))
- (setq ada-mode-hook (delq 'ada-gpr-query-setup ada-mode-hook))
-
(setq ada-xref-other-function nil)
(setq ada-xref-parent-function nil)
(setq ada-xref-all-function nil)
@@ -610,11 +624,6 @@ Enable mode if ARG is positive"
(setq completion-ignored-extensions (delete ".ali"
completion-ignored-extensions))
)
-(defun ada-gpr-query-setup ()
- (when (boundp 'wisi-indent-calculate-functions)
- (add-to-list 'wisi-indent-calculate-functions 'gnatprep-indent))
- )
-
(defun ada-gpr-query ()
"Set Ada mode global vars to use gpr_query."
(add-to-list 'ada-prj-parser-alist '("gpr" . gnat-parse-gpr))
@@ -622,10 +631,6 @@ Enable mode if ARG is positive"
(add-to-list 'ada-deselect-prj-xref-tool '(gpr_query .
ada-gpr-query-deselect-prj))
;; no parse-*-xref
-
- (font-lock-add-keywords 'ada-mode
- ;; gnatprep preprocessor line
- (list (list "^[ \t]*\\(#.*\n\\)" '(1 font-lock-preprocessor-face t))))
)
(provide 'gpr-query)
diff --git a/packages/ada-mode/gpr-skel.el b/packages/ada-mode/gpr-skel.el
index 9990f09..6947845 100644
--- a/packages/ada-mode/gpr-skel.el
+++ b/packages/ada-mode/gpr-skel.el
@@ -1,6 +1,6 @@
-;;; gpr-skel.el --- an extension to Gpr mode for inserting statement skeletons
+;; gpr-skel.el --- Extension to gpr-mode for inserting statement skeletons
-*- lexical-binding:t -*-
-;; Copyright (C) 2013, 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2015 Free Software Foundation, Inc.
;; Authors: Stephen Leake <address@hidden>
@@ -41,12 +41,15 @@
;;;;; user variables, example skeletons intended to be overwritten
+(defgroup gpr nil
+ "Major mode for editing GNAT project files in Emacs."
+ :group 'languages)
+
(defcustom gpr-skel-initial-string "{header}\n{project}"
- "*String to insert in empty buffer.
+ "String to insert in empty buffer.
This could end in a token recognized by `gpr-skel-expand'."
:type 'string
- :group 'gpr
- :safe 'stringp)
+ :safe #'stringp)
(define-skeleton gpr-skel-user-restricted
"Example copyright/license skeleton, with automatic year and owner."
@@ -264,8 +267,8 @@ it is a name, and use the word before that as the token."
(provide 'gpr-skeletons)
(provide 'gpr-skel)
-(setq gpr-expand 'skeleton-expand)
+(setq gpr-expand #'skeleton-expand)
-(add-hook 'gpr-mode-hook 'gpr-skel-setup)
+(add-hook 'gpr-mode-hook #'gpr-skel-setup)
;;; end of file
diff --git a/packages/ada-mode/gpr-wisi.el b/packages/ada-mode/gpr-wisi.el
index 0736094..13c8dcd 100644
--- a/packages/ada-mode/gpr-wisi.el
+++ b/packages/ada-mode/gpr-wisi.el
@@ -1,8 +1,6 @@
-;;; An indentation engine for gpr mode, using the wisent LALR parser
+;; gpr-wisi.el --- Indentation engine for gpr mode, using the wisi parser -*-
lexical-binding:t -*-
;;
-;; [1] GNAT user guide (info "gnat_ugn")
-;;
-;; Copyright (C) 2013, 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2013 - 2015 Free Software Foundation, Inc.
;;
;; Author: Stephen Leake <address@hidden>
;;
@@ -77,7 +75,6 @@ or containing ancestor of CACHE that is at a line beginning."
(block-middle
(wisi-indent-start
(if (eq (wisi-cache-token cache) 'WHEN) ada-indent-when 0)
- ;; FIXME (later): need test of ada-indent-when in gpr
cache))
(close-paren (wisi-indent-paren 0))
(open-paren nil); let after-keyword handle it
@@ -87,6 +84,9 @@ or containing ancestor of CACHE that is at a line beginning."
0
;; not at bob
(gpr-wisi-indent-containing ada-indent cache)))
+
+ (statement-end
+ (gpr-wisi-indent-containing ada-indent-broken cache))
))
))
diff --git a/packages/aggressive-indent/README.md
b/packages/aggressive-indent/README.md
index 8abb380..68e07ad 100644
--- a/packages/aggressive-indent/README.md
+++ b/packages/aggressive-indent/README.md
@@ -1,6 +1,5 @@
-aggressive-indent-mode
+aggressive-indent-mode
[](http://melpa.org/#/aggressive-indent)
[](http://stable.melpa.org/#/aggressive-indent)
======================
-(_[Wanna say thank you?](https://gratipay.com/Malabarba/)_)
`electric-indent-mode` is enough to keep your code nicely aligned when
all you do is type. However, once you start shifting blocks around,
@@ -8,7 +7,7 @@ transposing lines, or slurping and barfing sexps, indentation
is bound
to go wrong.
**`aggressive-indent-mode`** is a minor mode that keeps your code **always**
-indented. It reindents after every command, making it more reliable
+indented. It reindents after every change, making it more reliable
than `electric-indent-mode`.
### Demonstration ###
@@ -40,10 +39,8 @@ every programming mode, you can do something like:
#### Manual Installation ####
If you don't want to install from Melpa, you can download it manually,
-place it in your `load-path` along with its two dependencies:
-
-- [Names](https://github.com/Bruce-Connor/names/)
-- and `cl-lib` (which you should already have if your `emacs-version` is at
least 24.3).
+place it in your `load-path` along with its dependency `cl-lib` (which
+you should already have if your `emacs-version` is at least 24.3).
Then require it with:
@@ -62,3 +59,7 @@ following clause:
'(and (derived-mode-p 'c++-mode)
(null (string-match "\\([;{}]\\|\\b\\(if\\|for\\|while\\)\\b\\)"
(thing-at-point 'line)))))
+
+## Contribute ##
+
+[](https://gratipay.com/Malabarba)
diff --git a/packages/aggressive-indent/aggressive-indent.el
b/packages/aggressive-indent/aggressive-indent.el
index d1f70d4..67c3af8 100644
--- a/packages/aggressive-indent/aggressive-indent.el
+++ b/packages/aggressive-indent/aggressive-indent.el
@@ -1,11 +1,11 @@
-;;; aggressive-indent.el --- Minor mode to aggressively keep your code always
indented
+;;; aggressive-indent.el --- Minor mode to aggressively keep your code always
indented -*- lexical-binding:t -*-
;; Copyright (C) 2014, 2015 Free Software Foundation, Inc
;; Author: Artur Malabarba <address@hidden>
-;; URL: http://github.com/Malabarba/aggressive-indent-mode
-;; Version: 1.0
-;; Package-Requires: ((emacs "24.1") (names "20150125.9") (cl-lib "0.5"))
+;; URL: https://github.com/Malabarba/aggressive-indent-mode
+;; Version: 1.5
+;; Package-Requires: ((emacs "24.1") (cl-lib "0.5"))
;; Keywords: indent lisp maint tools
;; Prefix: aggressive-indent
;; Separator: -
@@ -18,7 +18,7 @@
;; to go wrong.
;;
;; `aggressive-indent-mode' is a minor mode that keeps your code always
-;; indented. It reindents after every command, making it more reliable
+;; indented. It reindents after every change, making it more reliable
;; than `electric-indent-mode'.
;;
;; ### Instructions ###
@@ -79,47 +79,45 @@
;; GNU General Public License for more details.
;;
-;;; Change Log:
-;; 0.3.1 - 2014/10/30 - Define new delete-backward bound to backspace.
-;; 0.3 - 2014/10/23 - Implement a smarter engine for non-lisp modes.
-;; 0.2 - 2014/10/20 - Reactivate `electric-indent-mode'.
-;; 0.2 - 2014/10/19 - Add variable `aggressive-indent-dont-indent-if', so
the user can prevent indentation.
-;; 0.1 - 2014/10/15 - Release.
;;; Code:
(require 'cl-lib)
-;;;###autoload
-(define-namespace aggressive-indent-
-:group indent
-
-(defconst version (eval-when-compile
- (require 'lisp-mnt)
- (lm-version))
- "Version of the aggressive-indent.el package.")
-(defun bug-report ()
+(defgroup aggressive-indent nil
+ "Customization group for aggressive-indent."
+ :prefix "aggressive-indent-"
+ :group 'electricity
+ :group 'indent)
+
+(defun aggressive-indent-bug-report ()
"Opens github issues page in a web browser. Please send any bugs you find.
Please include your Emacs and `aggressive-indent' versions."
(interactive)
(message "Your `aggressive-indent-version' is: %s, and your emacs version
is: %s.
Please include this in your report!"
- version emacs-version)
- (browse-url
"https://github.com/Bruce-Connor/aggressive-indent-mode/issues/new";))
+ (eval-when-compile
+ (ignore-errors
+ (require 'lisp-mnt)
+ (lm-version)))
+ emacs-version)
+ (browse-url
"https://github.com/Malabarba/aggressive-indent-mode/issues/new";))
+
+(defvar aggressive-indent-mode)
-
-;;; Start of actual Code:
-(defcustom dont-electric-modes '(ruby-mode)
+;;; Configuring indentarion
+(defcustom aggressive-indent-dont-electric-modes '(ruby-mode)
"List of major-modes where `electric-indent' should be disabled."
:type '(choice
(const :tag "Never use `electric-indent-mode'." t)
(repeat :tag "List of major-modes to avoid `electric-indent-mode'."
symbol))
:package-version '(aggressive-indent . "0.3.1"))
-(defcustom excluded-modes
+(defcustom aggressive-indent-excluded-modes
'(
bibtex-mode
cider-repl-mode
coffee-mode
+ comint-mode
conf-mode
Custom-mode
diff-mode
@@ -129,6 +127,7 @@ Please include this in your report!"
jabber-chat-mode
haml-mode
haskell-mode
+ haskell-interactive-mode
image-mode
makefile-mode
makefile-gmake-mode
@@ -154,7 +153,7 @@ active. If the minor mode is turned on with the local
command,
:type '(repeat symbol)
:package-version '(aggressive-indent . "0.3.1"))
-(defcustom protected-commands '(undo undo-tree-undo undo-tree-redo)
+(defcustom aggressive-indent-protected-commands '(undo undo-tree-undo
undo-tree-redo whitespace-cleanup)
"Commands after which indentation will NOT be performed.
Aggressive indentation could break things like `undo' by locking
the user in a loop, so this variable is used to control which
@@ -162,28 +161,12 @@ commands will NOT be followed by a re-indent."
:type '(repeat symbol)
:package-version '(aggressive-indent . "0.1"))
-(defcustom comments-too nil
+(defcustom aggressive-indent-comments-too nil
"If non-nil, aggressively indent in comments as well."
:type 'boolean
:package-version '(aggressive-indent . "0.3"))
-(defvar -internal-dont-indent-if
- '((memq this-command aggressive-indent-protected-commands)
- (region-active-p)
- buffer-read-only
- (null (buffer-modified-p))
- (and (boundp 'smerge-mode) smerge-mode)
- (string-match "\\`[[:blank:]]*\n?\\'" (or (thing-at-point 'line) ""))
- (let ((sp (syntax-ppss)))
- ;; Comments.
- (or (and (not aggressive-indent-comments-too) (elt sp 4))
- ;; Strings.
- (elt sp 3))))
- "List of forms which prevent indentation when they evaluate to non-nil.
-This is for internal use only. For user customization, use
-`aggressive-indent-dont-indent-if' instead.")
-
-(defcustom modes-to-prefer-defun
+(defcustom aggressive-indent-modes-to-prefer-defun
'(emacs-lisp-mode lisp-mode scheme-mode clojure-mode)
"List of major-modes in which indenting defun is preferred.
Add here any major modes with very good definitions of
@@ -198,6 +181,32 @@ change."
:type '(repeat symbol)
:package-version '(aggressive-indent . "0.3"))
+;;; Preventing indentation
+(defvar aggressive-indent--internal-dont-indent-if
+ '((memq this-command aggressive-indent-protected-commands)
+ (region-active-p)
+ buffer-read-only
+ undo-in-progress
+ (null (buffer-modified-p))
+ (and (boundp 'smerge-mode) smerge-mode)
+ (let ((line (thing-at-point 'line)))
+ (when (stringp line)
+ (or (string-match "\\`[[:blank:]]*\n?\\'" line)
+ ;; If the user is starting to type a comment.
+ (and (stringp comment-start)
+ (string-match (concat "\\`[[:blank:]]*"
+ (substring comment-start 0 1)
+ "[[:blank:]]*$")
+ line)))))
+ (let ((sp (syntax-ppss)))
+ ;; Comments.
+ (or (and (not aggressive-indent-comments-too) (elt sp 4))
+ ;; Strings.
+ (elt sp 3))))
+ "List of forms which prevent indentation when they evaluate to non-nil.
+This is for internal use only. For user customization, use
+`aggressive-indent-dont-indent-if' instead.")
+
(eval-after-load 'yasnippet
'(when (boundp 'yas--active-field-overlay)
(add-to-list 'aggressive-indent--internal-dont-indent-if
@@ -213,8 +222,25 @@ change."
'(when (boundp 'ac-completing)
(add-to-list 'aggressive-indent--internal-dont-indent-if
'ac-completing)))
-
-(defcustom dont-indent-if '()
+(eval-after-load 'multiple-cursors-core
+ '(when (boundp 'multiple-cursors-mode)
+ (add-to-list 'aggressive-indent--internal-dont-indent-if
+ 'multiple-cursors-mode)))
+(eval-after-load 'iedit
+ '(when (boundp 'iedit-mode)
+ (add-to-list 'aggressive-indent--internal-dont-indent-if
+ 'iedit-mode)))
+(eval-after-load 'evil
+ '(when (boundp 'iedit-mode)
+ (add-to-list 'aggressive-indent--internal-dont-indent-if
+ 'iedit-mode)))
+(eval-after-load 'coq
+ '(add-to-list 'aggressive-indent--internal-dont-indent-if
+ '(and (derived-mode-p 'coq-mode)
+ (not (string-match "\\.[[:space:]]*$"
+ (thing-at-point 'line))))))
+
+(defcustom aggressive-indent-dont-indent-if '()
"List of variables and functions to prevent aggressive indenting.
This variable is a list where each element is a Lisp form.
As long as any one of these forms returns non-nil,
@@ -222,54 +248,55 @@ aggressive-indent will not perform any indentation.
See `aggressive-indent--internal-dont-indent-if' for usage examples."
:type '(repeat sexp)
- :group 'aggressive-indent
:package-version '(aggressive-indent . "0.2"))
-(defvar -error-message
- "One of the forms in `aggressive-indent-dont-indent-if' had the following
error, I've disabled it until you fix it: %S"
+(defvar aggressive-indent--error-message "One of the forms in
`aggressive-indent-dont-indent-if' had the following error, I've disabled it
until you fix it: %S"
"Error message thrown by `aggressive-indent-dont-indent-if'.")
-(defvar -has-errored nil
+(defvar aggressive-indent--has-errored nil
"Keep track of whether `aggressive-indent-dont-indent-if' is throwing.
This is used to prevent an infinite error loop on the user.")
-(defun -run-user-hooks ()
+(defun aggressive-indent--run-user-hooks ()
"Safely run forms in `aggressive-indent-dont-indent-if'.
If any of them errors out, we only report it once until it stops
erroring again."
- (and dont-indent-if
+ (and aggressive-indent-dont-indent-if
(condition-case er
- (prog1 (eval (cons 'or dont-indent-if))
- (setq -has-errored nil))
- (error (unless -has-errored
- (setq -has-errored t)
- (message -error-message er))))))
-
-:autoload
-(defun indent-defun ()
+ (prog1 (eval (cons 'or aggressive-indent-dont-indent-if))
+ (setq aggressive-indent--has-errored nil))
+ (error (unless aggressive-indent--has-errored
+ (setq aggressive-indent--has-errored t)
+ (message aggressive-indent--error-message er))))))
+
+;;; Indenting defun
+;;;###autoload
+(defun aggressive-indent-indent-defun (&optional l r)
"Indent current defun.
-Throw an error if parentheses are unbalanced."
+Throw an error if parentheses are unbalanced.
+If L and R are provided, use them for finding the start and end of defun."
(interactive)
(let ((p (point-marker)))
(set-marker-insertion-type p t)
(indent-region
- (save-excursion (beginning-of-defun 1) (point))
- (save-excursion (end-of-defun 1) (point)))
+ (save-excursion
+ (when l (goto-char l))
+ (beginning-of-defun 1) (point))
+ (save-excursion
+ (when r (goto-char r))
+ (end-of-defun 1) (point)))
(goto-char p)))
-(defun -softly-indent-defun ()
+(defun aggressive-indent--softly-indent-defun (&optional l r)
"Indent current defun unobstrusively.
Like `aggressive-indent-indent-defun', but without errors or
-messages."
- (unless (or (run-hook-wrapped
- 'aggressive-indent--internal-dont-indent-if
- #'eval)
- (aggressive-indent--run-user-hooks))
- (cl-letf (((symbol-function 'message) #'ignore))
- (ignore-errors (indent-defun)))))
-
-:autoload
-(defun indent-region-and-on (l r)
+messages. L and R passed to `aggressive-indent-indent-defun'."
+ (cl-letf (((symbol-function 'message) #'ignore))
+ (ignore-errors (aggressive-indent-indent-defun l r))))
+
+;;; Indenting region
+;;;###autoload
+(defun aggressive-indent-indent-region-and-on (l r)
"Indent region between L and R, and then some.
Call `indent-region' between L and R, and then keep indenting
until nothing more happens."
@@ -279,111 +306,119 @@ until nothing more happens."
(set-marker-insertion-type p t)
(unwind-protect
(progn
- (goto-char r)
- (setq was-begining-of-line
- (= r (line-beginning-position)))
+ (unless (= l r)
+ (when (= (char-before r) ?\n)
+ (cl-decf r)))
;; If L is at the end of a line, skip that line.
(unless (= l r)
- (goto-char l)
- (when (= l (line-end-position))
+ (when (= (char-after l) ?\n)
(cl-incf l)))
;; Indent the affected region.
+ (goto-char r)
(unless (= l r) (indent-region l r))
- ;; `indent-region' doesn't do anything if R was the beginning of a
line, so we indent manually there.
- (when was-begining-of-line
- (indent-according-to-mode))
;; And then we indent each following line until nothing happens.
(forward-line 1)
- (while (and (null (eobp))
- (/= (progn (skip-chars-forward "[:blank:]\n")
- (point))
- (progn (indent-according-to-mode)
- (point))))
- (forward-line 1)))
+ (skip-chars-forward "[:blank:]\n\r\xc")
+ (let* ((eod (ignore-errors
+ (save-excursion (end-of-defun)
+ (point-marker))))
+ (point-limit (if (and eod (< (point) eod))
+ eod (point-max-marker))))
+ (while (and (null (eobp))
+ (let ((op (point))
+ (np (progn (indent-according-to-mode)
+ (point))))
+ ;; As long as we're indenting things to the
+ ;; left, keep indenting.
+ (or (< np op)
+ ;; If we're indenting to the right, or
+ ;; not at all, stop at the limit.
+ (< (point) point-limit))))
+ (forward-line 1)
+ (skip-chars-forward "[:blank:]\n\r\f"))))
(goto-char p))))
-(defun -softly-indent-region-and-on (l r &rest _)
+(defun aggressive-indent--softly-indent-region-and-on (l r &rest _)
"Indent region between L and R, and a bit more.
Like `aggressive-indent-indent-region-and-on', but without errors
or messages."
- (unless (or (run-hook-wrapped
- 'aggressive-indent--internal-dont-indent-if
- #'eval)
- (aggressive-indent--run-user-hooks))
- (cl-letf (((symbol-function 'message) #'ignore))
- (ignore-errors (indent-region-and-on l r)))))
-
-(defvar -changed-list-right nil
- "List of right limit of regions changed in the last command loop.")
+ (cl-letf (((symbol-function 'message) #'ignore))
+ (ignore-errors (aggressive-indent-indent-region-and-on l r))))
-(defvar -changed-list-left nil
- "List of left limit of regions changed in the last command loop.")
+;;; Tracking changes
+(defvar aggressive-indent--changed-list nil
+ "List of (left right) limit of regions changed in the last command loop.")
+(make-variable-buffer-local 'aggressive-indent--changed-list)
-(defun -indent-if-changed ()
+(defun aggressive-indent--indent-if-changed ()
"Indent any region that changed in the last command loop."
- (let ((inhibit-modification-hooks t))
- (when -changed-list-left
- (-softly-indent-region-and-on
- (apply #'min -changed-list-left)
- (apply #'max -changed-list-right))
- (setq -changed-list-left nil
- -changed-list-right nil))))
-
-(defun -keep-track-of-changes (l r &rest _)
+ (when aggressive-indent--changed-list
+ (save-excursion
+ (save-selected-window
+ (unless (or (run-hook-wrapped
'aggressive-indent--internal-dont-indent-if #'eval)
+ (aggressive-indent--run-user-hooks))
+ (while-no-input
+ (redisplay)
+ (let ((inhibit-modification-hooks t)
+ (inhibit-point-motion-hooks t)
+ (indent-function
+ (if (cl-member-if #'derived-mode-p
aggressive-indent-modes-to-prefer-defun)
+ #'aggressive-indent--softly-indent-defun
#'aggressive-indent--softly-indent-region-and-on)))
+ (while aggressive-indent--changed-list
+ (apply indent-function (car aggressive-indent--changed-list))
+ (setq aggressive-indent--changed-list
+ (cdr aggressive-indent--changed-list))))))))))
+
+(defun aggressive-indent--keep-track-of-changes (l r &rest _)
"Store the limits (L and R) of each change in the buffer."
- (push l -changed-list-left)
- (push r -changed-list-right))
+ (when aggressive-indent-mode
+ (push (list l r) aggressive-indent--changed-list)))
-
;;; Minor modes
-:autoload
-(define-minor-mode mode
+;;;###autoload
+(define-minor-mode aggressive-indent-mode
nil nil " =>"
- '(("" . aggressive-indent-indent-defun)
- ([backspace] menu-item "maybe-delete-indentation" ignore
- :filter (lambda (&optional _)
- (when (and (looking-back "^[[:blank:]]+")
- ;; Wherever we don't want to indent, we probably also
- ;; want the default backspace behavior.
- (not (run-hook-wrapped
- 'aggressive-indent--internal-dont-indent-if
- #'eval))
- (not (aggressive-indent--run-user-hooks)))
- #'delete-indentation))))
- (if mode
+ `((,(kbd "C-c C-q") . aggressive-indent-indent-defun)
+ ([backspace]
+ menu-item "maybe-delete-indentation" ignore :filter
+ (lambda (&optional _)
+ (when (and (looking-back "^[[:blank:]]+")
+ ;; Wherever we don't want to indent, we probably also
+ ;; want the default backspace behavior.
+ (not (run-hook-wrapped
'aggressive-indent--internal-dont-indent-if #'eval))
+ (not (aggressive-indent--run-user-hooks)))
+ #'delete-indentation))))
+ (if aggressive-indent-mode
(if (and global-aggressive-indent-mode
- (or (cl-member-if #'derived-mode-p excluded-modes)
+ (or (cl-member-if #'derived-mode-p
aggressive-indent-excluded-modes)
(memq major-mode '(text-mode fundamental-mode))
buffer-read-only))
- (mode -1)
- ;; Should electric indent be ON or OFF?
- (if (or (eq dont-electric-modes t)
- (cl-member-if #'derived-mode-p dont-electric-modes))
- (-local-electric nil)
- (-local-electric t))
- (if (cl-member-if #'derived-mode-p modes-to-prefer-defun)
- (add-hook 'post-command-hook #'-softly-indent-defun nil 'local)
- (add-hook 'after-change-functions #'-keep-track-of-changes nil
'local)
- (add-hook 'post-command-hook #'-indent-if-changed nil 'local)))
+ (aggressive-indent-mode -1)
+ ;; Should electric indent be ON or OFF?
+ (if (or (eq aggressive-indent-dont-electric-modes t)
+ (cl-member-if #'derived-mode-p
aggressive-indent-dont-electric-modes))
+ (aggressive-indent--local-electric nil)
+ (aggressive-indent--local-electric t))
+ (add-hook 'after-change-functions
#'aggressive-indent--keep-track-of-changes nil 'local)
+ (add-hook 'post-command-hook #'aggressive-indent--indent-if-changed
nil 'local))
;; Clean the hooks
- (remove-hook 'after-change-functions #'-keep-track-of-changes 'local)
- (remove-hook 'post-command-hook #'-indent-if-changed 'local)
- (remove-hook 'post-command-hook #'-softly-indent-defun 'local)))
+ (remove-hook 'after-change-functions
#'aggressive-indent--keep-track-of-changes 'local)
+ (remove-hook 'post-command-hook #'aggressive-indent--indent-if-changed
'local)
+ (remove-hook 'post-command-hook #'aggressive-indent--softly-indent-defun
'local)))
-(defun -local-electric (on)
+(defun aggressive-indent--local-electric (on)
"Turn variable `electric-indent-mode' on or off locally, as per boolean ON."
(if (fboundp 'electric-indent-local-mode)
(electric-indent-local-mode (if on 1 -1))
(set (make-local-variable 'electric-indent-mode) on)))
-:autoload
+;;;###autoload
(define-globalized-minor-mode global-aggressive-indent-mode
- mode mode)
+ aggressive-indent-mode aggressive-indent-mode)
-:autoload
+;;;###autoload
(defalias 'aggressive-indent-global-mode
#'global-aggressive-indent-mode)
-)
(provide 'aggressive-indent)
;;; aggressive-indent.el ends here
diff --git a/packages/ahungry-theme/ahungry-theme.el
b/packages/ahungry-theme/ahungry-theme.el
index 533305d..98deaf0 100644
--- a/packages/ahungry-theme/ahungry-theme.el
+++ b/packages/ahungry-theme/ahungry-theme.el
@@ -1,11 +1,11 @@
-;;; ahungry-theme.el --- Ahungry color theme for Emacs. Make sure to
(load-theme 'ahungry).
+;;; ahungry-theme.el --- Ahungry color theme for Emacs. Make sure to
(load-theme 'ahungry). -*- lexical-binding:t -*-
-;; Copyright (C) 2015 Free Software Foundation, Inc.
+;; Copyright (C) 2015,2016 Free Software Foundation, Inc.
;; Author: Matthew Carter <address@hidden>
;; Maintainer: Matthew Carter <address@hidden>
;; URL: https://github.com/ahungry/color-theme-ahungry
-;; Version: 1.0.6
+;; Version: 1.1.0
;; Keywords: ahungry palette color theme emacs color-theme deftheme
;; Package-Requires: ((emacs "24"))
@@ -36,6 +36,29 @@
;;; News:
+;;;; Changes since 1.0.12:
+;; - Add erc/jabber faces to begin with
+
+;;;; Changes since 1.0.11:
+;; - Purple is too hard to read on poor contrast monitors, use a blue
+
+;;;; Changes since 1.0.10:
+;; - Add faces for powerline/spaceline setup
+;; - Reduce org-mode heading sizes slightly
+
+;;;; Changes since 1.0.9:
+;; - Add/adjust some of the org-mode faces
+
+;;;; Changes since 1.0.8:
+;; - Add even more colors for magit 2.0 face names
+
+;;;; Changes since 1.0.7:
+;; - Add colors for magit 2.0 face names
+
+;;;; Changes since 1.0.6:
+;; - Remove warning producing call to "default" background color
+;; - Add a color update for mm-uu-extract
+
;;;; Changes since 1.0.5:
;; - Add a few colors for helm (the defaults did not work well with this theme)
@@ -52,7 +75,7 @@
(deftheme ahungry
"Ahungry Theme")
-(let ((mainbg (if (display-graphic-p) "#222222" "default")))
+(let ((mainbg (when (display-graphic-p) "#222222")));; "default")))
(custom-theme-set-faces
'ahungry ;; This is the theme name
`(default ((t (:foreground "#ffffff" :background ,mainbg
@@ -67,6 +90,13 @@
:box (:line-width 1 :color nil :style
released-button)))))
'(mode-line-inactive ((t (:foreground "#444444" :background "#66ff33"))))
'(mode-line-buffer-id ((t (:bold t :foreground "#ffffff" :background
"#0055ff"))))
+ '(powerline-active1 ((t (:foreground "#ffffff" :background "#222222"))))
+ '(powerline-active2 ((t (:foreground "#ffffff" :background "#77ff00"))))
+ '(powerline-inactive1 ((t (:foreground "#ffffff" :background "#555555"))))
+ '(powerline-inactive2 ((t (:foreground "#ffffff" :background "#66ff33"))))
+ '(spaceline-flycheck-error ((t (:foreground "#ff0066" :background
"#333333"))))
+ '(spaceline-flycheck-info ((t (:foreground "#ffaa00" :background
"#333333"))))
+ '(spaceline-flycheck-warning ((t (:foreground "#ffaa00" :background
"#333333"))))
'(region ((t (:background "#444444"))))
'(link ((t (:underline t :foreground "#33ff99"))))
'(custom-link ((t (:inherit 'link))))
@@ -82,7 +112,7 @@
'(font-lock-keyword-face ((t (:foreground "#3cff00" :bold t))))
'(font-lock-string-face ((t (:foreground "#ff0077" :italic nil :bold nil))))
'(font-lock-type-face ((t (:foreground "#deff00" :bold t))))
- '(font-lock-variable-name-face ((t (:foreground "#9900ff" :bold t))))
+ '(font-lock-variable-name-face ((t (:foreground "#0033ff" :bold t))))
'(font-lock-warning-face ((t (:bold t :foreground "#ff0000"))))
'(font-lock-function-name-face ((t (:foreground "#ffee00" :bold t))))
'(comint-highlight-input ((t (:italic t :bold t))))
@@ -111,21 +141,21 @@
'(gnus-cite-face-2 ((t (:foreground "#cba559"))))
'(gnus-cite-face-3 ((t (:foreground "#83ae92"))))
'(gnus-cite-face-4 ((t (:foreground "#6898a7"))))
- '(gnus-group-mail-1-empty ((t (:foreground "#00bbff"))))
- '(gnus-group-mail-1 ((t (:bold t :foreground "#00bbff"))))
- '(gnus-group-mail-2-empty ((t (:foreground "#00ffbb"))))
- '(gnus-group-mail-2 ((t (:bold t :foreground "#00ffbb"))))
+ '(gnus-group-mail-1-empty ((t (:foreground "#009955"))))
+ '(gnus-group-mail-1 ((t (:bold t :foreground "#ff9900"))))
+ '(gnus-group-mail-2-empty ((t (:foreground "#009955"))))
+ '(gnus-group-mail-2 ((t (:bold t :foreground "#ffaa00"))))
'(gnus-group-mail-3-empty ((t (:foreground "#009955"))))
- '(gnus-group-mail-3 ((t (:bold t :foreground "#ffc800"))))
- '(gnus-group-mail-low-empty ((t (:foreground "#005fff"))))
+ '(gnus-group-mail-3 ((t (:bold t :foreground "#ffcc00"))))
+ '(gnus-group-mail-low-empty ((t (:foreground "#009955"))))
'(gnus-group-mail-low ((t (:bold t :foreground "#005fff"))))
- '(gnus-group-news-1-empty ((t (:foreground "#00bbff"))))
- '(gnus-group-news-1 ((t (:bold t :foreground "#00bbff"))))
- '(gnus-group-news-2-empty ((t (:foreground "#00ffbb"))))
- '(gnus-group-news-2 ((t (:bold t :foreground "#00ffbb"))))
+ '(gnus-group-news-1-empty ((t (:foreground "#009955"))))
+ '(gnus-group-news-1 ((t (:bold t :foreground "#ff9900"))))
+ '(gnus-group-news-2-empty ((t (:foreground "#009955"))))
+ '(gnus-group-news-2 ((t (:bold t :foreground "#ffaa00"))))
'(gnus-group-news-3-empty ((t (:foreground "#009955"))))
- '(gnus-group-news-3 ((t (:bold t :foreground "#ffc800"))))
- '(gnus-group-news-low-empty ((t (:foreground "#005fff"))))
+ '(gnus-group-news-3 ((t (:bold t :foreground "#ffcc00"))))
+ '(gnus-group-news-low-empty ((t (:foreground "#009955"))))
'(gnus-group-news-low ((t (:bold t :foreground "#005fff"))))
'(gnus-header-name ((t (:bold t :foreground "#33ffbb"))))
'(gnus-header-from ((t (:bold t :foreground "#ffc800"))))
@@ -154,9 +184,10 @@
'(message-header-subject ((t (:foreground "#ffffff"))))
'(message-header-to ((t (:foreground "#ffffff"))))
'(message-header-cc ((t (:foreground "#ffffff"))))
- '(org-hide ((t (:foreground "#009933"))))
- '(org-level-1 ((t (:bold t :foreground "#4477ff" :height 1.5))))
- '(org-level-2 ((t (:bold nil :foreground "#ffc800" :height 1.2))))
+ '(mm-uu-extract ((t (:foreground "#0066ff"))))
+ '(org-hide ((t (:foreground "#222222"))))
+ '(org-level-1 ((t (:bold t :foreground "#4477ff" :height 1.4))))
+ '(org-level-2 ((t (:bold nil :foreground "#ffc800" :height 1.1))))
'(org-level-3 ((t (:bold t :foreground "#00aa33" :height 1.0))))
'(org-level-4 ((t (:bold nil :foreground "#f68585" :height 1.0))))
'(org-date ((t (:underline t :foreground "#ff0066"))))
@@ -167,6 +198,7 @@
'(org-block ((t (:foreground "#999999"))))
'(org-quote ((t (:inherit org-block :bold t :slant italic))))
'(org-verse ((t (:inherit org-block :bold t :slant italic))))
+ '(org-table ((t (:foreground "#0055ff"))))
'(org-todo ((t (:bold t :foreground "#ff0099"))))
'(org-done ((t (:bold t :foreground "#00cc33"))))
'(org-agenda-structure ((t (:weight bold :foreground "#f68585"))))
@@ -179,16 +211,35 @@
'(org-block-end-line ((t (:foreground "#bbbbbb" :background "#333333"))))
'(org-document-title ((t (:weight bold :foreground "#0077cc"))))
'(org-document-info ((t (:weight normal :foreground "#0077cc"))))
+ '(org-document-info-keyword ((t (:weight normal :foreground "#aaaaaa"))))
'(org-warning ((t (:weight normal :foreground "#ee0033"))))
- '(magit-header ((t (:foreground "#ffc800"))))
- '(magit-diff-add ((t (:foreground "#00ff00"))))
- '(magit-diff-del ((t (:foreground "#ff0000"))))
- '(magit-item-highlight ((t (:background "#111111" :slant normal :weight
extra-bold :inverse-video nil))))
+ '(magit-hash ((t (:foreground "#6699aa"))))
+ '(magit-branch-local ((t (:foreground "#0066ff"))))
+ '(magit-branch-remote ((t (:foreground "#ffcc44"))))
+ '(magit-diffstat-added ((t (:foreground "#00ff66"))))
+ '(magit-diff-added-highlight ((t (:foreground "#33ff00" :weight normal))))
+ '(magit-diff-added ((t (:foreground "#44aa00" :weight normal))))
+ '(magit-diff-removed-highlight ((t (:foreground "#ff0033" :weight normal))))
+ '(magit-diff-removed ((t (:foreground "#aa0044" :weight normal))))
+ '(magit-diff-hunk-heading ((t (:foreground "#aaaa00"))))
+ '(magit-diff-hunk-heading-highlight ((t (:foreground "#ffff00"))))
+ '(magit-diffstat-removed ((t (:foreground "#ff0066"))))
+ '(magit-diff-context-highlight ((t (:foreground "#ffffff"))))
+ '(magit-section-heading ((t (:foreground "#ff0066"))))
+ '(magit-section-highlight ((t (:weight bold))));;:foreground "#ffffff"))))
'(minibuffer-prompt ((t (:foreground "#0055ff" :bold t))))
'(web-mode-html-tag-bracket-face ((t (:foreground "#666666"))))
'(helm-selection ((t (:foreground "#ff0099" :italic t :bold t :background
"#f2e997"))))
'(helm-match ((t (:foreground "gold1"))))
'(helm-visible-mark ((t (:background "#f2e997" :foreground "#ff0099" :bold
nil :italic nil))))
+ '(erc-nick-default-face ((t (:foreground "#ff0099"))))
+ '(erc-current-nick-face ((t (:foreground "#0099ff"))))
+ '(erc-input-face ((t (:foreground "#0099ff"))))
+ '(erc-prompt-face ((t (:background nil :foreground "#666666" :bold t
:italic t))))
+ '(erc-timestamp-face ((t (:background nil :foreground "#666666" :bold nil
:italic t))))
+ '(jabber-chat-prompt-foreign ((t (:foreground "#ff0099"))))
+ '(jabber-chat-prompt-local ((t (:foreground "#0099ff"))))
+ '(jabber-rare-time-face ((t (:foreground "#666666" :bold nil :italic t))))
)
(custom-theme-set-variables
'ahungry
diff --git a/packages/ampc/ampc.el b/packages/ampc/ampc.el
new file mode 100644
index 0000000..6e9bbd6
--- /dev/null
+++ b/packages/ampc/ampc.el
@@ -0,0 +1,3123 @@
+;;; ampc.el --- Asynchronous Music Player Controller -*- lexical-binding: t -*-
+
+;; Copyright (C) 2011-2012, 2016 Free Software Foundation, Inc.
+
+;; Author: Christopher Schmidt <address@hidden>
+;; Comment: On Jan 2016, I couldn't get hold of Christopher Schmidt
+;; nor could I find ampc anywhere, so I re-instated GNU ELPA's old version
+;; and marked it as "maintainerless".
+;; Maintainer: address@hidden
+;; Version: 0.2
+;; Created: 2011-12-06
+;; Keywords: ampc, mpc, mpd
+;; Compatibility: GNU Emacs: 24.x
+
+;; This file is part of ampc.
+
+;; 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:
+;;; * description
+;; ampc is a controller for the Music Player Daemon (http://mpd.wikia.com/).
+
+;;; ** installation
+;; If you use GNU ELPA, install ampc via M-x package-list-packages RET or
+;; (package-install 'ampc). Otherwise, grab the files in this repository and
+;; put the Emacs Lisp ones somewhere in your load-path or add the directory the
+;; files are in to it, e.g.:
+;;
+;; (add-to-list 'load-path "~/.emacs.d/ampc")
+;; (autoload 'ampc "ampc" nil t)
+;;
+;; Byte-compile ampc (M-x byte-compile-file RET /path/to/ampc.el RET) to
improve
+;; its performance!
+
+;;; *** tagger
+;; ampc is not only a frontend to MPD but also a full-blown audio file tagger.
+;; To use this feature you have to build the backend application,
`ampc_tagger',
+;; which in turn uses TagLib (http://taglib.github.com/), a dual-licended
+;; (LGPL/MPL) audio meta-data library written in C++. TagLib has no
+;; dependencies on its own.
+;;
+;; To build `ampc_tagger', locate ampc_tagger.cpp. The file can be found in
the
+;; directory in which this file, ampc.el, is located. Compile the file and
+;; either customize `ampc-tagger-executable' to point to the binary file or
move
+;; the executable in a suitable directory so Emacs finds it via consulting
+;; `exec-path'.
+;;
+;; g++ -O2 ampc_tagger.cpp -oampc_tagger -ltag && sudo cp ampc_tagger
/usr/local/bin && rm ampc_tagger
+;;
+;; You have to customize `ampc-tagger-music-directories' in order to use the
+;; tagger. This variable should be a list of directories in which your music
+;; files are located. Usually this list should have only one entry, the value
+;; of your mpd.conf's `music_directory'.
+;;
+;; If `ampc-tagger-backup-directory' is non-nil, the tagger saved copies of all
+;; files that are about to be modified to this directory. Emacs's regular
+;; numeric backup filename syntax is used for the backup file names. By
default
+;; `ampc-tagger-backup-directory' is set to "~/.emacs.d/ampc-backups/".
+
+;;; ** usage
+;; To invoke ampc call the command `ampc', e.g. via M-x ampc RET. The first
+;; argument to `ampc' is the host, the second is the port. Both values default
+;; to nil. If nil, ampc will use the value specified in `ampc-default-server',
+;; by default localhost:6600. To make ampc use the full frame rather than the
+;; selected window for its window setup, customise `ampc-use-full-frame' to a
+;; non-nil value.
+;;
+;; ampc offers three independent views which expose different parts of the user
+;; interface. The current playlist view, the default view at startup, may be
+;; accessed using the `J' key (that is `S-j'). The playlist view may be
+;; accessed using the `K' key. The outputs view may be accessed by pressing
+;; `L'.
+
+;;; *** current playlist view
+;; The playlist view looks like this:
+;;
+;; .........................
+;; . 1 . 3 . 4 . 5 .
+;; .......... . . .
+;; . 2 . . . .
+;; . . . . .
+;; . . . . .
+;; . ................
+;; . . 6 .
+;; . . .
+;; .........................
+;;
+;; Window one exposes basic information about the daemon, such as the current
+;; state (stop/play/pause), the song currently playing or the volume.
+;;
+;; All windows, except the status window, contain a tabular list of items.
Each
+;; item may be selected/marked. There may be multiple selections.
+;;
+;; To mark an entry, move the point to the entry and press `m' (ampc-mark). To
+;; unmark an entry, press `u' (ampc-unmark). To unmark all entries, press `U'
+;; (ampc-unmark-all). To toggle marks, press `t' (ampc-toggle-marks).
Pressing
+;; `<down-mouse-1>' with the mouse mouse cursor on a list entry will move point
+;; to the entry and toggle the mark. To navigate to the next entry, press `n'
+;; (ampc-next-line). Analogous, pressing `p' (ampc-previous-line) moves the
+;; point to the previous entry.
+;;
+;; Window two shows the current playlist. The song that is currently played by
+;; the daemon, if any, is highlighted. To delete the selected songs from the
+;; playlist, press `d' (ampc-delete). Pressing `<down-mouse-3>' will move the
+;; point to the entry under cursor and delete it from the playlist. To move
the
+;; selected songs up, press `<up>' (ampc-up). Analogous, press `<down>'
+;; (ampc-down) to move the selected songs down. Pressing `RET'
+;; (ampc-play-this) or `<down-mouse-2>' will play the song at point/cursor.
+;;
+;; Windows three to five are tag browsers. You use them to narrow the song
+;; database to certain songs. Think of tag browsers as filters, analogous to
+;; piping `grep' outputs through additional `grep' filters. The property of
the
+;; songs that is filtered is displayed in the header line of the window.
+;;
+;; Window six shows the songs that match the filters defined by windows three
to
+;; five. To add the selected song to the playlist, press `a' (ampc-add).
+;; Pressing `<down-mouse-3>' will move the point to the entry under the cursor
+;; and execute `ampc-add'. These key bindings works in tag browsers as well.
+;; Calling `ampc-add' in a tag browser adds all songs filtered up to the
+;; selected browser to the playlist.
+;;
+;; The tag browsers of the current playlist view (accessed via `J') are `Genre'
+;; (window 3), `Artist' (window 4) and `Album' (window 5). The key `M' may be
+;; used to fire up a slightly modified current playlist view. There is no
+;; difference to the default current playlist view other than that the tag
+;; browsers filter to `Genre' (window 3), `Album' (window 4) and `Artist'
+;; (window 5). Metaphorically speaking, the order of the `grep' filters
defined
+;; by the tag browsers is different.
+
+;;; *** playlist view
+;; The playlist view resembles the current playlist view. The window, which
+;; exposes the playlist content, is replaced by three windows, vertically
+;; arragned, though. The top one still shows the current playlist. The bottom
+;; one shows a list of stored playlists. The middle window exposes the content
+;; of the selected (stored) playlist. All commands that used to work in the
+;; current playlist view and modify the current playlist now modify the
selected
+;; (stored) playlist unless the point is within the current playlist buffer.
+;; The list of stored playlists is the only view in ampc that may have only one
+;; marked entry.
+;;
+;; To queue a playlist, press `l' (ampc-load) or `<down-mouse-2>'. To delete a
+;; playlist, press `d' (ampc-delete-playlist) or `<down-mouse-3>'. The command
+;; `ampc-rename-playlist', bound to `r', can be used to rename a playlist.
+;;
+;; Again, the key `<' may be used to setup a playlist view with a different
+;; order of tag browsers.
+
+;;; *** outputs view
+;; The outputs view contains a single list which shows the configured outputs
of
+;; MPD. To toggle the enabled property of the selected outputs, press `a'
+;; (ampc-toggle-output-enabled) or `<mouse-3>'.
+
+;;; ** tagger
+;; To start the tagging subsystem, press `I' (ampc-tagger). This key binding
+;; works in every buffer associated with ampc. First, the command tries to
+;; determine which files you want to tag. The files are collected using either
+;; the selected entries within the current buffer, the file associated with the
+;; entry at point, or, if both sources did not provide any files, the audio
file
+;; that is currently played by MPD. Next, the tagger view is created. On the
+;; right there is the buffer that contain the tag data. Each line in this
+;; buffer represents a tag with a value. Tag and value are separated by a
+;; colon. Valid tags are "Title", "Artist", "Album", "Comment", "Genre",
"Year"
+;; and "Track". The value can be an arbitrary string. Whitespaces in front
and
+;; at the end of the value are ignored. If the value is "<keep>", the tag line
+;; is ignored.
+;;
+;; To save the specified tag values back to the files, press `C-c C-c'
+;; (ampc-tagger-save). To exit the tagger and restore the previous window
+;; configuration, press `C-c C-q'. `C-u C-c C-c' saved the tags and exits the
+;; tagger. Only tags that are actually specified within the tagger buffer
+;; written back to the file. Other tags will not be touched by ampc. For
+;; example, to clear the "Commentary" tag, you need to specify the line
+;;
+;; Commentary:
+;;
+;; In the tagger buffer. Omitting this line will make the tagger not touch the
+;; "Commentary" tag at all.
+;;
+;; On the right there is the files list buffer. The selection of this buffer
+;; specifies which files the command `ampc-tag-save' will write to. If no file
+;; is selected, the file at point in the file list buffer is used.
+;;
+;; To reset the values of the tags specified in the tagger buffer to the common
+;; values of all selected files specified by the selection of the files list
+;; buffer, press `C-c C-r' (ampc-tagger-reset). With a prefix argument,
+;; `ampc-tagger-reset' restores missing tags as well.
+;;
+;; You can use tab-completion within the tagger buffer for both tags and tag
+;; values.
+;;
+;; You can also use the tagging subsystem on its own without a running ampc
+;; instance. To start the tagger, call `ampc-tag-files'. This function
accepts
+;; one argument, a list of absolute file names which are the files to tag.
ampc
+;; provides a minor mode for dired, `ampc-tagger-dired-mode'. If this mode is
+;; enabled within a dired buffer, pressing `C-c C-t' (ampc-tagger-dired) will
+;; start the tagger on the current selection.
+;;
+;; The following ampc-specific hooks are run during tagger usage:
+;;
+;; `ampc-tagger-grab-hook': Run by the tagger before grabbing tags of a file.
+;; Each function is called with one argument, the file name.
+;;
+;; `ampc-tagger-grabbed-hook': Run by the tagger after grabbing tags of a file.
+;; Each function is called with one argument, the file name.
+;;
+;; `ampc-tagger-store-hook': Run by the tagger before writing tags back to a
+;; file. Each function is called with two arguments, FOUND-CHANGED and DATA.
+;; FOUND-CHANGED is non-nil if the tags that are about to be written differ
from
+;; the ones in the file. DATA is a cons. The car specifies the full file name
+;; of the file that is about to be written to, the cdr is an alist that
+;; specifies the tags that are about to be (over-)written. The car of each
+;; entry in this list is a symbol specifying the tag (one of the ones in
+;; `ampc-tagger-tags'), the cdr a string specifying the value. The cdr of DATA
+;; may be modified. If FOUND-CHANGED is nil and the cdr of DATA is not
modified
+;; throughout the hook is run, the file is not touched.
+;; `ampc-tagger-stored-hook' is still run, though.
+;;
+;; `ampc-tagger-stored-hook': Run by the tagger after writing tags back to a
+;; file. Each function is called with two arguments, FOUND-CHANGED and DATA.
+;; These are the same arguments that were already passed to
+;; `ampc-tagger-store-hook'. The car of DATA, the file name, may be modified.
+;;
+;; These hooks can be used to handle vc locking and unlocking of files. For
+;; renaming files according to their (new) tag values, ampc provides the
+;; function `ampc-tagger-rename-artist-title' which may be added to
+;; `ampc-tagger-stored-hook'. The new file name generated by this function is
+;; "Artist"_-_"Title"."extension". Characters within "Artist" and "Title" that
+;; are not alphanumeric are substituted with underscores.
+
+;;; ** global keys
+;; Aside from `J', `M', `K', `<' and `L', which may be used to select different
+;; views, and `I' which starts the tagger, ampc defines the following global
+;; keys. These binding are available in every buffer associated with ampc:
+;;
+;; `k' (ampc-toggle-play): Toggle play state. If MPD does not play a song,
+;; start playing the song at point if the current buffer is the playlist
buffer,
+;; otherwise start at the beginning of the playlist. With numeric prefix
+;; argument 4, stop player rather than pause if applicable.
+;;
+;; `l' (ampc-next): Play next song.
+;; `j' (ampc-previous): Play previous song
+;;
+;; `c' (ampc-clear): Clear playlist.
+;; `s' (ampc-shuffle): Shuffle playlist.
+;;
+;; `S' (ampc-store): Store playlist.
+;; `O' (ampc-load): Load selected playlist into the current playlist.
+;; `R' (ampc-rename-playlist): Rename selected playlist.
+;; `D' (ampc-delete-playlist): Delete selected playlist.
+;;
+;; `y' (ampc-increase-volume): Increase volume.
+;; `M-y' (ampc-decrease-volume): Decrease volume.
+;; `C-M-y' (ampc-set-volume): Set volume.
+;; `h' (ampc-increase-crossfade): Increase crossfade.
+;; `M-h' (ampc-decrease-crossfade): Decrease crossfade.
+;; `C-M-h' (ampc-set-crossfade): Set crossfade.
+;;
+;; `e' (ampc-toggle-repeat): Toggle repeat state.
+;; `r' (ampc-toggle-random): Toggle random state.
+;; `f' (ampc-toggle-consume): Toggle consume state.
+;;
+;; `P' (ampc-goto-current-song): Select the current playlist window and move
+;; point to the current song.
+;; `G' (ampc-mini): Select song to play via `completing-read'.
+;;
+;; `T' (ampc-trigger-update): Trigger a database update.
+;; `Z' (ampc-suspend): Suspend ampc.
+;; `q' (ampc-quit): Quit ampc.
+;;
+;; The keymap of ampc is designed to fit the QWERTY United States keyboard
+;; layout. If you use another keyboard layout, feel free to modify
+;; `ampc-mode-map'. For example, I use a regular QWERTZ German keyboard
+;; (layout), so I modify `ampc-mode-map' in my init.el like this:
+;;
+;; (eval-after-load 'ampc
+;; '(flet ((substitute-ampc-key
+;; (from to)
+;; (define-key ampc-mode-map to (lookup-key ampc-mode-map from))
+;; (define-key ampc-mode-map from nil)))
+;; (substitute-ampc-key (kbd "z") (kbd "Z"))
+;; (substitute-ampc-key (kbd "y") (kbd "z"))
+;; (substitute-ampc-key (kbd "M-y") (kbd "M-z"))
+;; (substitute-ampc-key (kbd "C-M-y") (kbd "C-M-z"))
+;; (substitute-ampc-key (kbd "<") (kbd ";"))))
+;;
+;; If ampc is suspended, you can still use every interactive command that does
+;; not directly operate on or with the user interace of ampc. For example it
is
+;; perfectly fine to call `ampc-increase-volume' or `ampc-toggle-play' via M-x
+;; RET. Especially the commands `ampc-status' and `ampc-mini' are
predesignated
+;; to be bound in the global keymap and called when ampc is suspended.
+;; `ampc-status' messages the information that is displayed by the status
window
+;; of ampc. `ampc-mini' lets you select a song to play via `completing-read'.
+;; To start ampc suspended, call `ampc' with the third argument being non-nil.
+;; To check whether ampc is connected to the daemon and/or suspended, call
+;; `ampc-is-on-p' or `ampc-suspended-p'.
+;;
+;; (global-set-key (kbd "<f7>")
+;; (lambda ()
+;; (interactive)
+;; (unless (ampc-on-p)
+;; (ampc nil nil t))
+;; (ampc-status)))
+;; (global-set-key (kbd "<f8>")
+;; (lambda ()
+;; (interactive)
+;; (unless (ampc-on-p)
+;; (ampc nil nil t))
+;; (ampc-mini)))
+
+;;; Code:
+;;; * code
+(eval-when-compile (require 'cl-lib))
+(require 'network-stream)
+(require 'avl-tree)
+
+;;; ** declarations
+(defgroup ampc ()
+ "Asynchronous client for the Music Player Daemon."
+ :prefix "ampc-"
+ :group 'multimedia
+ :group 'applications)
+
+;;; *** customs
+(defcustom ampc-debug nil
+ "Non-nil means log outgoing communication between ampc and MPD.
+If the value is neither t nor nil, also log incoming data."
+ :type '(choice (const :tag "Disable" nil)
+ (const :tag "Outgoing" t)
+ (const :tag "Incoming and outgoing" full)))
+
+(defcustom ampc-use-full-frame nil
+ "If non-nil, ampc will use the entire Emacs screen."
+ :type 'boolean)
+
+(defcustom ampc-truncate-lines t
+ "If non-nil, truncate lines in ampc buffers."
+ :type 'boolean)
+
+(defcustom ampc-default-server '("localhost" . 6600)
+ "The MPD server to connect to if the arguments to `ampc' are nil.
+This variable is a cons cell, with the car specifying the
+hostname and the cdr specifying the port. Both values can be
+nil, which will make ampc query the user for values on each
+invocation."
+ :type '(cons (choice :tag "Hostname"
+ (string)
+ (const :tag "Ask" nil))
+ (choice :tag "Port"
+ (string)
+ (integer)
+ (const :tag "Ask" nil))))
+
+(defcustom ampc-synchronous-commands '(t status currentsong play)
+ "List of MPD commands that should be executed synchronously.
+Executing commands that print lots of output synchronously will
+result in massive performance improvements of ampc. If the car
+of this list is t, execute all commands synchronously other
+than the ones specified by the rest of the list."
+ :type '(repeat symbol))
+
+(defcustom ampc-status-tags nil
+ "List of additional tags of the current song that are added to
+the internal status of ampc and thus are passed to the functions
+in `ampc-status-changed-hook'. Each element may be a string that
+specifies a tag that is returned by MPD's `currentsong'
+command."
+ :type '(list symbol))
+
+(defcustom ampc-volume-step 5
+ "Default step of `ampc-increase-volume' and
+`ampc-decrease-volume' for changing the volume."
+ :type 'integer)
+
+(defcustom ampc-crossfade-step 5
+ "Default step of `ampc-increase-crossfade' and
+`ampc-decrease-crossfade' for changing the crossfade."
+ :type 'integer)
+
+(defcustom ampc-tag-transform-funcs '(("Time" . ampc-transform-time)
+ ("Track" . ampc-transform-track))
+ "Alist of tag treatment functions.
+The car, a string, of each entry specifies the MPD tag, the cdr a
+function which transforms the tag to the value that should be
+used by ampc. The function is called with one string argument,
+the tag value, and should return the treated value."
+ :type '(alist :key-type string :value-type function))
+
+(defcustom ampc-tagger-music-directories nil
+ "List of base directories in which your music files are located.
+Usually this list should have only one entry, the value of your
+mpd.conf's `music_directory'"
+ :type '(list directory))
+
+(defcustom ampc-tagger-executable "ampc_tagger"
+ "The name or full path to ampc's tagger executable."
+ :type 'string)
+
+(defcustom ampc-tagger-backup-directory
+ (file-name-directory (locate-user-emacs-file "ampc-backups/"))
+ "The directory in which the tagger copies files before modifying.
+If nil, disable backups."
+ :type '(choice (const :tag "Disable backups" nil)
+ (directory :tag "Directory")))
+
+;;; **** hooks
+(defcustom ampc-before-startup-hook nil
+ "A hook run before startup.
+This hook is called as the first thing when ampc is started."
+ :type 'hook)
+
+(defcustom ampc-connected-hook nil
+ "A hook run after ampc connected to MPD."
+ :type 'hook)
+
+(defcustom ampc-suspend-hook nil
+ "A hook run when suspending ampc."
+ :type 'hook)
+
+(defcustom ampc-quit-hook nil
+ "A hook run when exiting ampc."
+ :type 'hook)
+
+(defcustom ampc-status-changed-hook nil
+ "A hook run whenever the status of the daemon (that is volatile
+properties such as volume or current song) changes. The hook is
+run with one arg, an alist that contains the new status. The car
+of each entry is a symbol, the cdr is a string. Valid keys are:
+
+ volume
+ repeat
+ random
+ consume
+ xfade
+ state
+ song
+ Artist
+ Title
+
+and the keys in `ampc-status-tags'. Not all keys may be present
+all the time!"
+ :type 'hook)
+
+(defcustom ampc-tagger-grab-hook nil
+ "Hook run by the tagger before grabbing tags of a file.
+Each function is called with one argument, the file name."
+ :type 'hook)
+(defcustom ampc-tagger-grabbed-hook nil
+ "Hook run by the tagger after grabbing tags of a file.
+Each function is called with one argument, the file name."
+ :type 'hook)
+
+(defcustom ampc-tagger-store-hook nil
+ "Hook run by the tagger before writing tags back to a file.
+Each function is called with two arguments, FOUND-CHANGED and
+DATA. FOUND-CHANGED is non-nil if the tags that are about to be
+written differ from the ones in the file. DATA is a cons. The
+car specifies the full file name of the file that is about to be
+written to, the cdr is an alist that specifies the tags that are
+about to be (over-)written. The car of each entry in this list
+is a symbol specifying the tag (one of the ones in
+`ampc-tagger-tags'), the cdr a string specifying the value. The
+cdr of DATA may be modified. If FOUND-CHANGED is nil and the cdr
+of DATA is not modified throughout the hook is run, the file is
+not touched. `ampc-tagger-stored-hook' is still run, though."
+ :type 'hook)
+(defcustom ampc-tagger-stored-hook nil
+ "Hook run by the tagger after writing tags back to a file.
+Each function is called with two arguments, FOUND-CHANGED and
+DATA. These are the same arguments that were already passed to
+`ampc-tagger-store-hook'. The car of DATA, the file name, may be
+modified."
+ :type 'hook)
+
+;;; *** faces
+(defface ampc-mark-face '((t (:inherit font-lock-constant-face)))
+ "Face of the mark.")
+(defface ampc-marked-face '((t (:inherit warning)))
+ "Face of marked entries.")
+(defface ampc-unmarked-face '((t (:inerhit default)))
+ "Face of unmarked entries.")
+(defface ampc-current-song-mark-face '((t (:inherit region)))
+ "Face of mark of the current song.")
+(defface ampc-current-song-marked-face '((t (:inherit region)))
+ "Face of the current song if marked.")
+
+(defface ampc-tagger-tag-face '((t (:inherit font-lock-constant-face)))
+ "Face of tags within the tagger.")
+(defface ampc-tagger-keyword-face '((t (:inherit font-lock-keyword-face)))
+ "Face of tags within the tagger.")
+
+;;; *** internal variables
+(defvar ampc-views
+ (let* ((songs '(1.0 song :properties (("Track" :title "#" :width 4)
+ ("Title" :min 15 :max 40)
+ ("Time" :width 6)
+ ("Artist" :min 15 :max 40)
+ ("Album" :min 15 :max 40))))
+ (rs_a `(1.0 vertical
+ (0.7 horizontal
+ (0.33 tag :tag "Genre" :id 1 :select t)
+ (0.33 tag :tag "Artist" :id 2)
+ (1.0 tag :tag "Album" :id 3))
+ ,songs))
+ (rs_b `(1.0 vertical
+ (0.7 horizontal
+ (0.33 tag :tag "Genre" :id 1 :select t)
+ (0.33 tag :tag "Album" :id 2)
+ (1.0 tag :tag "Artist" :id 3))
+ ,songs))
+ (pl-prop '(:properties (("Title" :min 15 :max 40)
+ ("Artist" :min 15 :max 40)
+ ("Album" :min 15 :max 40)
+ ("Time" :width 6)))))
+ `((tagger
+ horizontal
+ (0.65 files-list
+ :properties ((filename :shrink t :title "File" :min 20 :max 40)
+ ("Title" :min 15 :max 40)
+ ("Artist" :min 15 :max 40)
+ ("Album" :min 15 :max 40)
+ ("Genre" :min 15 :max 40)
+ ("Year" :width 5)
+ ("Track" :title "#" :width 4)
+ ("Comment" :min 15 :max 40))
+ :dedicated nil)
+ (1.0 tagger))
+ ("Current playlist view (Genre|Artist|Album)"
+ ,(kbd "J")
+ horizontal
+ (0.4 vertical
+ (6 status)
+ (1.0 current-playlist ,@pl-prop))
+ ,rs_a)
+ ("Current playlist view (Genre|Album|Artist)"
+ ,(kbd "M")
+ horizontal
+ (0.4 vertical
+ (6 status)
+ (1.0 current-playlist ,@pl-prop))
+ ,rs_b)
+ ("Playlist view (Genre|Artist|Album)"
+ ,(kbd "K")
+ horizontal
+ (0.4 vertical
+ (6 status)
+ (1.0 vertical
+ (0.4 current-playlist ,@pl-prop)
+ (0.4 playlist ,@pl-prop)
+ (1.0 playlists)))
+ ,rs_a)
+ ("Playlist view (Genre|Album|Artist)"
+ ,(kbd "<")
+ horizontal
+ (0.4 vertical
+ (6 status)
+ (1.0 vertical
+ (0.4 current-playlist ,@pl-prop)
+ (0.4 playlist ,@pl-prop)
+ (1.0 playlists)))
+ ,rs_b)
+ ("Outputs view"
+ ,(kbd "L")
+ outputs :properties (("outputname" :title "Name" :min 10 :max 30)
+ ("outputenabled" :title "Enabled" :width 9))))))
+
+(defvar ampc-connection nil)
+(defvar ampc-host nil)
+(defvar ampc-port nil)
+(defvar ampc-outstanding-commands nil)
+
+(defvar ampc-no-implicit-next-dispatch nil)
+(defvar ampc-working-timer nil)
+(defvar ampc-yield nil)
+(defvar ampc-yield-redisplay nil)
+
+(defvar ampc-windows nil)
+(defvar ampc-all-buffers nil)
+
+(defvar ampc-type nil)
+(make-variable-buffer-local 'ampc-type)
+(defvar ampc-dirty nil)
+(make-variable-buffer-local 'ampc-dirty)
+
+(defvar ampc-internal-db nil)
+(defvar ampc-status nil)
+
+(defvar ampc-tagger-previous-configuration nil)
+(defvar ampc-tagger-version-verified nil)
+(defvar ampc-tagger-completion-all-files nil)
+(defvar ampc-tagger-genres nil)
+
+(defconst ampc-tagger-version "0.1")
+(defconst ampc-tagger-tags '(Title Artist Album Comment Genre Year Track))
+
+;;; *** mode maps
+(defvar ampc-mode-map
+ (let ((map (make-sparse-keymap)))
+ (suppress-keymap map)
+ (define-key map (kbd "k") 'ampc-toggle-play)
+ (define-key map (kbd "l") 'ampc-next)
+ (define-key map (kbd "j") 'ampc-previous)
+ (define-key map (kbd "c") 'ampc-clear)
+ (define-key map (kbd "s") 'ampc-shuffle)
+ (define-key map (kbd "S") 'ampc-store)
+ (define-key map (kbd "O") 'ampc-load)
+ (define-key map (kbd "R") 'ampc-rename-playlist)
+ (define-key map (kbd "D") 'ampc-delete-playlist)
+ (define-key map (kbd "y") 'ampc-increase-volume)
+ (define-key map (kbd "M-y") 'ampc-decrease-volume)
+ (define-key map (kbd "C-M-y") 'ampc-set-volume)
+ (define-key map (kbd "h") 'ampc-increase-crossfade)
+ (define-key map (kbd "M-h") 'ampc-decrease-crossfade)
+ (define-key map (kbd "C-M-h") 'ampc-set-crossfade)
+ (define-key map (kbd "e") 'ampc-toggle-repeat)
+ (define-key map (kbd "r") 'ampc-toggle-random)
+ (define-key map (kbd "f") 'ampc-toggle-consume)
+ (define-key map (kbd "P") 'ampc-goto-current-song)
+ (define-key map (kbd "G") 'ampc-mini)
+ (define-key map (kbd "q") 'ampc-quit)
+ (define-key map (kbd "z") 'ampc-suspend)
+ (define-key map (kbd "T") 'ampc-trigger-update)
+ (define-key map (kbd "I") 'ampc-tagger)
+ (cl-loop for view in ampc-views
+ do (when (stringp (car view))
+ (define-key map (cadr view)
+ `(lambda ()
+ (interactive)
+ (ampc-change-view ',view)))))
+ map))
+
+(defvar ampc-item-mode-map
+ (let ((map (make-sparse-keymap)))
+ (suppress-keymap map)
+ (define-key map (kbd "m") 'ampc-mark)
+ (define-key map (kbd "u") 'ampc-unmark)
+ (define-key map (kbd "U") 'ampc-unmark-all)
+ (define-key map (kbd "n") 'ampc-next-line)
+ (define-key map (kbd "p") 'ampc-previous-line)
+ (define-key map (kbd "<down-mouse-1>") 'ampc-mouse-toggle-mark)
+ (define-key map (kbd "<mouse-1>") 'ampc-mouse-align-point)
+ (define-key map [remap next-line] 'ampc-next-line)
+ (define-key map [remap previous-line] 'ampc-previous-line)
+ (define-key map [remap tab-to-tab-stop] 'ampc-move-to-tab)
+ map))
+
+(defvar ampc-current-playlist-mode-map
+ (let ((map (make-sparse-keymap)))
+ (suppress-keymap map)
+ (define-key map (kbd "RET") 'ampc-play-this)
+ (define-key map (kbd "<down-mouse-2>") 'ampc-mouse-play-this)
+ (define-key map (kbd "<mouse-2>") 'ampc-mouse-align-point)
+ (define-key map (kbd "<down-mouse-3>") 'ampc-mouse-delete)
+ (define-key map (kbd "<mouse-3>") 'ampc-mouse-align-point)
+ map))
+
+(defvar ampc-playlist-mode-map
+ (let ((map (make-sparse-keymap)))
+ (suppress-keymap map)
+ (define-key map (kbd "t") 'ampc-toggle-marks)
+ (define-key map (kbd "d") 'ampc-delete)
+ (define-key map (kbd "<up>") 'ampc-up)
+ (define-key map (kbd "<down>") 'ampc-down)
+ (define-key map (kbd "<down-mouse-3>") 'ampc-mouse-delete)
+ (define-key map (kbd "<mouse-3>") 'ampc-mouse-align-point)
+ map))
+
+(defvar ampc-playlists-mode-map
+ (let ((map (make-sparse-keymap)))
+ (suppress-keymap map)
+ (define-key map (kbd "l") 'ampc-load)
+ (define-key map (kbd "r") 'ampc-rename-playlist)
+ (define-key map (kbd "d") 'ampc-delete-playlist)
+ (define-key map (kbd "<down-mouse-2>") 'ampc-mouse-load)
+ (define-key map (kbd "<mouse-2>") 'ampc-mouse-align-point)
+ (define-key map (kbd "<down-mouse-3>") 'ampc-mouse-delete-playlist)
+ (define-key map (kbd "<mouse-3>") 'ampc-mouse-align-point)
+ map))
+
+(defvar ampc-tag-song-mode-map
+ (let ((map (make-sparse-keymap)))
+ (suppress-keymap map)
+ (define-key map (kbd "t") 'ampc-toggle-marks)
+ (define-key map (kbd "a") 'ampc-add)
+ (define-key map (kbd "<down-mouse-3>") 'ampc-mouse-add)
+ (define-key map (kbd "<mouse-3>") 'ampc-mouse-align-point)
+ map))
+
+(defvar ampc-outputs-mode-map
+ (let ((map (make-sparse-keymap)))
+ (suppress-keymap map)
+ (define-key map (kbd "t") 'ampc-toggle-marks)
+ (define-key map (kbd "a") 'ampc-toggle-output-enabled)
+ (define-key map (kbd "<down-mouse-3>") 'ampc-mouse-toggle-output-enabled)
+ (define-key map (kbd "<mouse-3>") 'ampc-mouse-align-point)
+ map))
+
+(defvar ampc-files-list-mode-map
+ (let ((map (make-sparse-keymap)))
+ (suppress-keymap map)
+ (define-key map (kbd "t") 'ampc-toggle-marks)
+ (define-key map (kbd "C-c C-q") 'ampc-tagger-quit)
+ (define-key map (kbd "C-c C-c") 'ampc-tagger-save)
+ (define-key map (kbd "C-c C-r") 'ampc-tagger-reset)
+ (define-key map [remap ampc-tagger] nil)
+ (define-key map [remap ampc-quit] 'ampc-tagger-quit)
+ (cl-loop for view in ampc-views
+ do (when (stringp (car view))
+ (define-key map (cadr view) nil)))
+ map))
+
+(defvar ampc-tagger-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "C-c C-q") 'ampc-tagger-quit)
+ (define-key map (kbd "C-c C-c") 'ampc-tagger-save)
+ (define-key map (kbd "C-c C-r") 'ampc-tagger-reset)
+ (define-key map (kbd "TAB") 'ampc-tagger-completion-at-point)
+ map))
+
+(defvar ampc-tagger-dired-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "C-c C-t") 'ampc-tagger-dired)
+ map))
+
+;;; **** menu
+(easy-menu-define nil ampc-mode-map nil
+ `("ampc"
+ ("Change view" ,@(cl-loop for view in ampc-views
+ when (stringp (car view))
+ collect (vector (car view)
+ `(lambda ()
+ (interactive)
+ (ampc-change-view ',view)))
+ end))
+ ["Run tagger" ampc-tagger]
+ "--"
+ ["Play" ampc-toggle-play
+ :visible (and ampc-status
+ (not (equal (cdr (assq 'state ampc-status)) "play")))]
+ ["Pause" ampc-toggle-play
+ :visible (and ampc-status
+ (equal (cdr (assq 'state ampc-status)) "play"))]
+ ["Stop" (lambda () (interactive) (ampc-toggle-play 4))
+ :visible (and ampc-status
+ (equal (cdr (assq 'state ampc-status)) "play"))]
+ ["Next" ampc-next]
+ ["Previous" ampc-previous]
+ "--"
+ ["Clear playlist" ampc-clear]
+ ["Shuffle playlist" ampc-shuffle]
+ ["Store playlist" ampc-store]
+ ["Queue Playlist" ampc-load :visible (ampc-playlist)]
+ ["Rename Playlist" ampc-rename-playlist :visible (ampc-playlist)]
+ ["Delete Playlist" ampc-delete-playlist :visible (ampc-playlist)]
+ "--"
+ ["Increase volume" ampc-increase-volume]
+ ["Decrease volume" ampc-decrease-volume]
+ ["Set volume" ampc-set-volume]
+ ["Increase crossfade" ampc-increase-crossfade]
+ ["Decrease crossfade" ampc-decrease-crossfade]
+ ["Set crossfade" ampc-set-crossfade]
+ ["Toggle repeat" ampc-toggle-repeat
+ :style toggle
+ :selected (equal (cdr (assq 'repeat ampc-status)) "1")]
+ ["Toggle random" ampc-toggle-random
+ :style toggle
+ :selected (equal (cdr (assq 'random ampc-status)) "1")]
+ ["Toggle consume" ampc-toggle-consume
+ :style toggle
+ :selected (equal (cdr (assq 'consume ampc-status)) "1")]
+ "--"
+ ["Trigger update" ampc-trigger-update]
+ ["Suspend" ampc-suspend]
+ ["Quit" ampc-quit]))
+
+(easy-menu-define ampc-selection-menu ampc-item-mode-map
+ "Selection menu for ampc"
+ '("ampc Mark"
+ ["Add to playlist" ampc-add
+ :visible (not (eq (car ampc-type) 'outputs))]
+ ["Toggle enabled" ampc-toggle-output-enabled
+ :visible (eq (car ampc-type) 'outputs)]
+ "--"
+ ["Next line" ampc-next-line]
+ ["Previous line" ampc-previous-line]
+ ["Mark" ampc-mark]
+ ["Unmark" ampc-unmark]
+ ["Unmark all" ampc-unmark-all]
+ ["Toggle marks" ampc-toggle-marks
+ :visible (not (eq (car ampc-type) 'playlists))]))
+
+(defvar ampc-tool-bar-map
+ (let ((map (make-sparse-keymap)))
+ (tool-bar-local-item
+ "mpc/prev" 'ampc-previous 'previous map
+ :help "Previous")
+ (tool-bar-local-item
+ "mpc/play" 'ampc-toggle-play 'play map
+ :help "Play"
+ :visible '(and ampc-status
+ (not (equal (cdr (assq 'state ampc-status)) "play"))))
+ (tool-bar-local-item
+ "mpc/pause" 'ampc-toggle-play 'pause map
+ :help "Pause"
+ :visible '(and ampc-status
+ (equal (cdr (assq 'state ampc-status)) "play")))
+ (tool-bar-local-item
+ "mpc/stop" (lambda () (interactive) (ampc-toggle-play 4)) 'stop map
+ :help "Stop"
+ :visible '(and ampc-status
+ (equal (cdr (assq 'state ampc-status)) "play")))
+ (tool-bar-local-item
+ "mpc/next" 'ampc-next 'next map
+ :help "Next")
+ map))
+
+;;; ** code
+;;; *** macros
+(defmacro ampc-with-buffer (type &rest body)
+ (declare (indent 1) (debug t))
+ `(let* ((type- ,type)
+ (w (if (windowp type-)
+ type-
+ (cl-loop for w in (ampc-normalize-windows)
+ thereis (when (with-current-buffer
+ (window-buffer w)
+ (cl-etypecase type-
+ (symbol (eq (car ampc-type) type-))
+ (cons (equal ampc-type type-))))
+ w)))))
+ (when w
+ (with-selected-window w
+ (with-current-buffer (window-buffer w)
+ (let ((inhibit-read-only t))
+ ,@(if (eq (car body) 'no-se)
+ (cdr body)
+ `((save-excursion
+ (goto-char (point-min))
+ ,@body)))))))))
+
+(defmacro ampc-fill-skeleton (tag &rest body)
+ (declare (indent 1) (debug t))
+ `(let ((tag- ,tag)
+ (data-buffer (current-buffer)))
+ (ignore data-buffer) ;Don't warn if `body' doesn't use it.
+ (ampc-with-buffer tag-
+ no-se
+ (unless (eq ampc-dirty 'keep-dirty)
+ (let ((old-point-data (get-text-property (point) 'cmp-data))
+ (old-window-start-offset
+ (1- (count-lines (window-start) (point)))))
+ (put-text-property (point-min) (point-max) 'not-updated t)
+ (when (eq ampc-dirty 'erase)
+ (put-text-property (point-min) (point-max) 'data nil))
+ (goto-char (point-min))
+ ,@body
+ (goto-char (point-min))
+ (cl-loop until (eobp)
+ do (if (get-text-property (point) 'not-updated)
+ (kill-line 1)
+ (add-text-properties (+ (point) 2)
+ (progn (forward-line nil)
+ (1- (point)))
+ '(mouse-face highlight))))
+ (remove-text-properties (point-min) (point-max) '(not-updated))
+ (goto-char (point-min))
+ (when old-point-data
+ (cl-loop until (eobp)
+ do (when (equal (get-text-property (point) 'cmp-data)
+ old-point-data)
+ (set-window-start
+ nil
+ (save-excursion
+ (forward-line (- old-window-start-offset))
+ (point))
+ t)
+ (cl-return))
+ (forward-line)
+ finally do (goto-char (point-min)))))
+ (let ((effective-height (- (window-height)
+ (if mode-line-format 1 0)
+ (if header-line-format 1 0))))
+ (when (< (- (1- (line-number-at-pos (point-max)))
+ (line-number-at-pos (window-start)))
+ effective-height)
+ (set-window-start nil
+ (save-excursion
+ (goto-char (point-max))
+ (forward-line (- (1+ effective-height)))
+ (point))
+ t)))
+ (ampc-align-point)
+ (ampc-set-dirty nil)))))
+
+(defmacro ampc-with-selection (arg &rest body)
+ (declare (indent 1) (debug t))
+ `(let ((arg- ,arg))
+ (if (or (and (not arg-)
+ (save-excursion
+ (goto-char (point-min))
+ (search-forward-regexp "^* " nil t)))
+ (and arg- (symbolp arg-)))
+ (cl-loop initially do (goto-char (point-min))
+ finally do (ampc-align-point)
+ while (search-forward-regexp "^* " nil t)
+ for index from 0
+ do (save-excursion
+ ,@body))
+ (setf arg- (prefix-numeric-value arg-))
+ (ampc-align-point)
+ (cl-loop until (eobp)
+ for index from 0 to (1- (abs arg-))
+ do (save-excursion
+ ,@body)
+ until (if (< arg- 0) (ampc-previous-line) (ampc-next-line))))))
+
+(defmacro ampc-iterate-source (data-buffer delimiter bindings &rest body)
+ (declare (indent 3) (debug t))
+ (when (memq (intern delimiter) bindings)
+ (cl-callf2 delq (intern delimiter) bindings)
+ (push (list (intern delimiter)
+ '(buffer-substring (point) (line-end-position)))
+ bindings))
+ `(,@(if data-buffer `(with-current-buffer ,data-buffer) '(progn))
+ (when (search-forward-regexp
+ ,(concat "^" (regexp-quote delimiter) ": ")
+ nil t)
+ (cl-loop with next
+ do (save-restriction
+ (setf next (ampc-narrow-entry
+ ,(concat "^" (regexp-quote delimiter) ": ")))
+ (let ,(cl-loop for binding in bindings
+ if (consp binding)
+ collect binding
+ else
+ collect `(,binding (ampc-extract
+ (ampc-extract-regexp
+ ,(symbol-name
binding))))
+ end)
+ ,@body))
+ while next
+ do (goto-char next)))))
+
+(defmacro ampc-iterate-source-output (delimiter bindings pad-data &rest body)
+ (declare (indent 2) (debug t))
+ `(let ((output-buffer (current-buffer))
+ (tags (cl-loop for (tag . props) in
+ (plist-get (cdr ampc-type) :properties)
+ collect (cons tag (ampc-extract-regexp tag)))))
+ (ampc-iterate-source
+ data-buffer ,delimiter ,bindings
+ (let ((pad-data ,pad-data))
+ (with-current-buffer output-buffer
+ (ampc-insert (ampc-pad pad-data) ,@body))))))
+
+(defmacro ampc-extract-regexp (tag)
+ (if (stringp tag)
+ (concat "^" (regexp-quote tag) ": \\(.*\\)$")
+ `(concat "^" (regexp-quote ,tag) ": \\(.*\\)$")))
+
+(defmacro ampc-tagger-log (&rest what)
+ (declare (indent 0) (debug t))
+ `(with-current-buffer (get-buffer-create "*Tagger Log*")
+ (ampc-tagger-log-mode)
+ (save-excursion
+ (goto-char (point-max))
+ (let ((inhibit-read-only t)
+ (what (concat ,@what)))
+ (when ampc-debug
+ (message "ampc: %s" what))
+ (insert what)))))
+
+;;; *** modes
+(define-derived-mode ampc-outputs-mode ampc-item-mode "ampc-o")
+
+(define-derived-mode ampc-tag-song-mode ampc-item-mode "ampc-ts")
+
+(define-derived-mode ampc-current-playlist-mode ampc-playlist-mode "ampc-cpl"
+ (ampc-highlight-current-song-mode))
+
+(define-derived-mode ampc-playlist-mode ampc-item-mode "ampc-pl")
+
+(define-derived-mode ampc-playlists-mode ampc-item-mode "ampc-pls")
+
+(define-derived-mode ampc-files-list-mode ampc-item-mode "ampc-files-list")
+
+(define-derived-mode ampc-tagger-mode nil "ampc-tagger"
+ (set (make-local-variable 'tool-bar-map) ampc-tool-bar-map)
+ (set (make-local-variable 'tab-stop-list)
+ (list (+ (cl-loop for tag in ampc-tagger-tags
+ maximize (length (symbol-name tag)))
+ 2)))
+ (set (make-local-variable 'completion-at-point-functions)
+ '(ampc-tagger-complete-tag ampc-tagger-complete-value))
+ (setf truncate-lines ampc-truncate-lines
+ font-lock-defaults
+ `(((,(concat "^\\([ \t]*\\(?:"
+ (mapconcat #'symbol-name ampc-tagger-tags "\\|")
+ "\\)[ \t]*:\\)"
+ "\\(\\(?:[ \t]*"
+ "\\(?:"
+ (mapconcat #'identity ampc-tagger-genres "\\|")
"\\|<keep>"
+ "\\)"
+ "[ \t]*$\\)?\\)")
+ (1 'ampc-tagger-tag-face)
+ (2 'ampc-tagger-keyword-face)))
+ t)))
+
+(define-derived-mode ampc-tagger-log-mode nil "ampc-tagger-log")
+
+(define-derived-mode ampc-item-mode ampc-mode "ampc-item"
+ (setf font-lock-defaults '((("^\\(\\*\\)\\(.*\\)$"
+ (1 'ampc-mark-face)
+ (2 'ampc-marked-face))
+ ("" 0 'ampc-unmarked-face))
+ t)))
+
+(define-derived-mode ampc-mode special-mode "ampc"
+ (buffer-disable-undo)
+ (set (make-local-variable 'tool-bar-map) ampc-tool-bar-map)
+ (setf truncate-lines ampc-truncate-lines
+ mode-line-modified "--"))
+
+(define-minor-mode ampc-highlight-current-song-mode ""
+ ;; FIXME: The "" above looks bogus!
+ nil
+ nil
+ nil
+ (funcall (if ampc-highlight-current-song-mode
+ #'font-lock-add-keywords
+ #'font-lock-remove-keywords)
+ nil
+ '((ampc-find-current-song
+ (1 'ampc-current-song-mark-face)
+ (2 'ampc-current-song-marked-face)))))
+
+;;;###autoload
+(define-minor-mode ampc-tagger-dired-mode
+ "Minor mode that adds a audio file meta data tagging key binding to dired."
+ :lighter " ampc-tagger"
+ (cl-assert (derived-mode-p 'dired-mode)))
+
+;;; *** internal functions
+(defun ampc-tagger-report (args status)
+ (unless (zerop status)
+ (let ((message (format (concat "ampc_tagger (%s %s) returned with a "
+ "non-zero exit status (%s)")
+ ampc-tagger-executable
+ (mapconcat #'identity args " ")
+ status)))
+ (ampc-tagger-log message "\n")
+ (error message))))
+
+(defun ampc-tagger-call (&rest args)
+ (ampc-tagger-report
+ args
+ (apply #'call-process ampc-tagger-executable nil t nil args)))
+
+(defun ampc-int-insert-cmp (p1 p2)
+ (cond ((< p1 p2) 'insert)
+ ((eq p1 p2) 'overwrite)
+ (t (- p1 p2))))
+
+(defun ampc-normalize-windows ()
+ (setf ampc-windows
+ (cl-loop for (window . buffer) in ampc-windows
+ collect (cons (if (and (window-live-p window)
+ (eq (window-buffer window) buffer))
+ window
+ (get-buffer-window buffer))
+ buffer)))
+ (delq nil (mapcar #'car ampc-windows)))
+
+(defun ampc-restore-window-configuration ()
+ (let ((windows
+ (sort (delq nil
+ (mapcar (lambda (w)
+ (when (eq (window-frame w)
+ (selected-frame))
+ w))
+ (ampc-normalize-windows)))
+ (lambda (w1 w2)
+ (cl-loop for w in (window-list nil nil (frame-first-window))
+ do (when (eq w w1)
+ (cl-return t))
+ (when (eq w w2)
+ (cl-return nil)))))))
+ (when windows
+ (setf (window-dedicated-p (car windows)) nil)
+ (cl-loop for w in (cdr windows)
+ do (delete-window w)))))
+
+(defun ampc-tagger-tags-modified (tags new-tags)
+ (cl-loop with found-changed
+ for (tag . value) in new-tags
+ for prop = (assq tag tags)
+ do (unless (equal (cdr prop) value)
+ (setf (cdr prop) value
+ found-changed t))
+ finally return found-changed))
+
+(defun ampc-change-view (view)
+ (if (equal ampc-outstanding-commands '((idle nil)))
+ (ampc-configure-frame (cddr view))
+ (message "ampc is busy, cannot change window layout")))
+
+(defun ampc-quote (string)
+ (concat "\"" (replace-regexp-in-string "\"" "\\\"" string) "\""))
+
+(defun ampc-in-ampc-p (&optional or-in-tagger)
+ (or (when (ampc-on-p)
+ ampc-type)
+ (when or-in-tagger
+ (memq (car ampc-type) '(files-list tagger)))))
+
+(defun ampc-add-impl (&optional data)
+ (ampc-on-files (lambda (file)
+ (if (ampc-playlist)
+ (ampc-send-command 'playlistadd
+ '(:keep-prev t)
+ (ampc-quote (ampc-playlist))
+ file)
+ (ampc-send-command 'add '(:keep-prev t) (ampc-quote
file)))
+ data)))
+
+(defun ampc-on-files (func &optional data)
+ (cond ((null data)
+ (cl-loop for d in (get-text-property (line-end-position) 'data)
+ do (ampc-on-files func d)))
+ ((avl-tree-p data)
+ (avl-tree-mapc (lambda (e) (ampc-on-files func (cdr e))) data))
+ ((stringp data)
+ (funcall func data))
+ (t
+ (cl-loop for d in (reverse data)
+ do (ampc-on-files func (cdr (assoc "file" d)))))))
+
+(defun ampc-skip (N)
+ (ampc-send-command
+ 'play
+ `(:callback ,(lambda ()
+ (ampc-send-command 'status '(:front t))))
+ (lambda ()
+ (let ((song (cdr (assq 'song ampc-status)))
+ (playlist-length (cdr (assq 'playlistlength ampc-status))))
+ (unless (and song playlist-length)
+ (throw 'skip nil))
+ (max 0 (min (+ (string-to-number song) N)
+ (1- (string-to-number playlist-length))))))))
+
+(cl-defun ampc-find-current-song
+ (limit &aux (point (point)) (song (cdr (assq 'song ampc-status))))
+ (when (and song
+ (<= (1- (line-number-at-pos (point)))
+ (setf song (string-to-number song)))
+ (>= (1- (line-number-at-pos limit)) song))
+ (goto-char (point-min))
+ (forward-line song)
+ (save-restriction
+ (narrow-to-region (max point (point)) (min limit (line-end-position)))
+ (search-forward-regexp "\\(?1:\\(\\`\\*\\)?\\)\\(?2:.*\\)$"))))
+
+(defun ampc-set-volume-impl (arg &optional func)
+ (when arg
+ (setf arg (prefix-numeric-value arg)))
+ (ampc-send-command
+ 'setvol
+ `(:callback ,(lambda ()
+ (ampc-send-command 'status '(:front t))))
+ (lambda ()
+ (unless ampc-status
+ (throw 'skip nil))
+ (max (min (if func
+ (funcall func
+ (string-to-number
+ (cdr (assq 'volume ampc-status)))
+ (or arg ampc-volume-step))
+ arg)
+ 100)
+ 0))))
+
+(defun ampc-set-crossfade-impl (arg &optional func)
+ (when arg
+ (setf arg (prefix-numeric-value arg)))
+ (ampc-send-command
+ 'crossfade
+ `(:callback ,(lambda ()
+ (ampc-send-command 'status '(:front t))))
+ (lambda ()
+ (unless ampc-status
+ (throw 'skip nil))
+ (max (if func
+ (funcall func
+ (string-to-number
+ (cdr (assq 'xfade ampc-status)))
+ (or arg ampc-crossfade-step))
+ arg)
+ 0))))
+
+(cl-defun ampc-tagger-make-backup (file)
+ (unless ampc-tagger-backup-directory
+ (cl-return-from ampc-tagger-make-backup))
+ (when (functionp ampc-tagger-backup-directory)
+ (funcall ampc-tagger-backup-directory file)
+ (cl-return-from ampc-tagger-make-backup))
+ (unless (file-directory-p ampc-tagger-backup-directory)
+ (make-directory ampc-tagger-backup-directory t))
+ (let* ((real-file
+ (cl-loop with real-file = file
+ for target = (file-symlink-p real-file)
+ while target
+ do (setf real-file (expand-file-name
+ target (file-name-directory real-file)))
+ finally return real-file))
+ (target
+ (cl-loop with base = (file-name-nondirectory real-file)
+ for i from 1
+ for file = (expand-file-name
+ (concat base ".~"
+ (int-to-string i)
+ "~")
+ ampc-tagger-backup-directory)
+ while (file-exists-p file)
+ finally return file)))
+ (ampc-tagger-log "\tBackup file: " (abbreviate-file-name target) "\n")
+ (copy-file real-file target nil t)))
+
+(cl-defun ampc-move (N &aux with-marks entries-to-move (up (< N 0)))
+ (save-excursion
+ (goto-char (point-min))
+ (cl-loop while (search-forward-regexp "^* " nil t)
+ do (push (point) entries-to-move)))
+ (if entries-to-move
+ (setf with-marks t)
+ (push (point) entries-to-move))
+ (when (save-excursion
+ (cl-loop with max = (1- (count-lines (point-min) (point-max)))
+ for p in entries-to-move
+ do (goto-char p)
+ for line = (+ (1- (line-number-at-pos)) N)
+ always (and (>= line 0) (<= line max))))
+ (when up
+ (setf entries-to-move (nreverse entries-to-move)))
+ (when with-marks
+ (ampc-unmark-all))
+ (cl-loop for p in entries-to-move
+ do (goto-char p)
+ for line = (1- (line-number-at-pos))
+ do (if (and (not (eq (car ampc-type) 'current-playlist))
+ (ampc-playlist))
+ (ampc-send-command 'playlistmove
+ '(:keep-prev t)
+ (ampc-quote (ampc-playlist))
+ line
+ (+ line N))
+ (ampc-send-command 'move '(:keep-prev t) line (+ line N))))
+ (if with-marks
+ (cl-loop for p in (nreverse entries-to-move)
+ do (goto-char p)
+ (forward-line N)
+ (save-excursion
+ (ampc-mark-impl t 1))
+ (ampc-align-point))
+ (forward-line N)
+ (ampc-align-point))))
+
+(defun ampc-toggle-state (state arg)
+ (when (or arg ampc-status)
+ (ampc-send-command
+ state
+ nil
+ (cond ((null arg)
+ (if (equal (cdr (assq state ampc-status)) "1")
+ 0
+ 1))
+ ((> (prefix-numeric-value arg) 0) 1)
+ (t 0)))))
+
+(defun ampc-playlist (&optional at-point)
+ (ampc-with-buffer 'playlists
+ (if (and (not at-point)
+ (search-forward-regexp "^* \\(.*\\)$" nil t))
+ (let ((result (match-string 1)))
+ (set-text-properties 0 (length result) nil result)
+ result)
+ (unless (eobp)
+ (buffer-substring-no-properties
+ (+ (line-beginning-position) 2)
+ (line-end-position))))))
+
+(cl-defun ampc-mark-impl (select N &aux result (inhibit-read-only t))
+ (when (eq (car ampc-type) 'playlists)
+ (cl-assert (or (not select) (null N) (eq N 1)))
+ (ampc-with-buffer 'playlists
+ (cl-loop while (search-forward-regexp "^\\* " nil t)
+ do (replace-match " " nil nil))))
+ (cl-loop repeat (or N 1)
+ until (eobp)
+ do (move-beginning-of-line nil)
+ (delete-char 1)
+ (insert (if select "*" " "))
+ (setf result (ampc-next-line nil)))
+ (ampc-post-mark-change-update)
+ result)
+
+(defun ampc-post-mark-change-update ()
+ (cl-ecase (car ampc-type)
+ ((current-playlist playlist outputs))
+ (playlists
+ (ampc-update-playlist))
+ ((song tag)
+ (cl-loop
+ for w in
+ (cl-loop for w on (ampc-normalize-windows)
+ thereis (when (or (eq (car w) (selected-window))
+ (and (eq (car ampc-type) 'tag)
+ (eq (with-current-buffer
+ (window-buffer (car w))
+ (car ampc-type))
+ 'song)))
+ (cdr w)))
+ do (with-current-buffer (window-buffer w)
+ (when (memq (car ampc-type) '(song tag))
+ (ampc-set-dirty t))))
+ (ampc-fill-tag-song))
+ (files-list
+ (ampc-tagger-update))))
+
+(cl-defun ampc-tagger-get-values (tag all-files &aux result)
+ (ampc-with-buffer 'files-list
+ no-se
+ (save-excursion
+ (cl-macrolet
+ ((add-file
+ ()
+ `(let ((value (cdr (assq tag (get-text-property (point) 'data)))))
+ (unless (member value result)
+ (push value result)))))
+ (if all-files
+ (cl-loop until (eobp)
+ initially do (goto-char (point-min))
+ (ampc-align-point)
+ do (add-file)
+ until (ampc-next-line))
+ (ampc-with-selection nil
+ (add-file))))))
+ result)
+
+(defun ampc-tagger-update ()
+ (ampc-with-buffer 'tagger
+ (cl-loop
+ while (search-forward-regexp (concat "^[ \t]*\\("
+ (mapconcat #'symbol-name
+ ampc-tagger-tags
+ "\\|")
+ "\\)[ \t]*:"
+ "[ \t]*\\(<keep>[ \t]*?\\)"
+ "\\(?:\n\\)?$")
+ nil
+ t)
+ for tag = (intern (match-string 1))
+ do (when (memq tag ampc-tagger-tags)
+ (let ((values (save-match-data (ampc-tagger-get-values tag nil))))
+ (when (eq (length values) 1)
+ (replace-match (car values) nil t nil 2)))))))
+
+(defun ampc-tagger-complete-tag ()
+ (save-excursion
+ (save-restriction
+ (narrow-to-region (line-beginning-position) (line-end-position))
+ (unless (search-backward-regexp "^.*:" nil t)
+ (when (search-backward-regexp "\\(^\\|[ \t]\\).*" nil t)
+ (when (looking-at "[ \t]")
+ (forward-char 1))
+ (list (point)
+ (search-forward-regexp ":\\|$")
+ (mapcar (lambda (tag) (concat (symbol-name tag) ":"))
+ ampc-tagger-tags)))))))
+
+(cl-defun ampc-tagger-complete-value (&aux tag)
+ (save-excursion
+ (save-restriction
+ (narrow-to-region (line-beginning-position) (line-end-position))
+ (save-excursion
+ (unless (search-backward-regexp (concat "^[ \t]*\\("
+ (mapconcat #'symbol-name
+ ampc-tagger-tags
+ "\\|")
+ "\\)[ \t]*:")
+ nil t)
+ (cl-return-from ampc-tagger-complete-tag))
+ (setf tag (intern (match-string 1))))
+ (save-excursion
+ (search-backward-regexp "[: \t]")
+ (forward-char 1)
+ (list (point)
+ (search-forward-regexp "[ \t]\\|$")
+ (let ((values (cons "<keep>" (ampc-tagger-get-values
+ tag
+
ampc-tagger-completion-all-files))))
+ (when (eq tag 'Genre)
+ (cl-loop for g in ampc-tagger-genres
+ do (unless (member g values)
+ (push g values))))
+ values))))))
+
+(defun ampc-align-point ()
+ (unless (eobp)
+ (move-beginning-of-line nil)
+ (forward-char 2)
+ (re-search-forward " *" nil t)))
+
+(cl-defun ampc-pad (tabs &optional dont-honour-item-mode)
+ (cl-loop with new-tab-stop-list
+ with offset-dec = (if (and (not dont-honour-item-mode)
+ (derived-mode-p 'ampc-item-mode))
+ 2
+ 0)
+ for tab in tabs
+ for offset-cell on (if (derived-mode-p 'ampc-item-mode)
+ tab-stop-list
+ (cons 0 tab-stop-list))
+ for offset = (car offset-cell)
+ for props in (or (plist-get (cdr ampc-type) :properties)
+ '(nil . nil))
+ by (lambda (cell) (or (cdr cell) '(nil . nil)))
+ do (cl-decf offset offset-dec)
+ with first = t
+ with current-offset = 0
+ when (<= current-offset offset)
+ do (when (and (not first) (eq (- offset current-offset) 0))
+ (cl-incf offset))
+ and concat (make-string (- offset current-offset) ? ) into result
+ and do (setf current-offset offset)
+ else
+ concat " " into result
+ and do (cl-incf current-offset)
+ end
+ do (unless tab
+ (setf tab ""))
+ (when (and (plist-get (cdr props) :shrink)
+ (cadr offset-cell)
+ (>= (+ current-offset (length tab) 1) (- (cadr
offset-cell)
+ offset-dec)))
+ (setf tab (concat (substring tab 0 (max (- (cadr offset-cell)
+ offset-dec
+ current-offset
+ 4)
+ 3))
+ "...")))
+ concat tab into result
+ do (push (+ current-offset offset-dec) new-tab-stop-list)
+ (cl-incf current-offset (length tab))
+ (setf first nil)
+ finally return
+ (if (equal (cl-callf nreverse new-tab-stop-list) tab-stop-list)
+ result
+ (propertize result 'tab-stop-list new-tab-stop-list))))
+
+(defun ampc-update-header ()
+ (when (or (memq (car ampc-type) '(tag playlists))
+ (plist-get (cdr ampc-type) :properties))
+ (setf header-line-format
+ (concat
+ (make-string (floor (fringe-columns 'left t)) ? )
+ (cl-ecase (car ampc-type)
+ (tag
+ (concat " " (plist-get (cdr ampc-type) :tag)))
+ (playlists
+ " Playlists")
+ (t
+ (ampc-pad (cl-loop for (name . props) in
+ (plist-get (cdr ampc-type) :properties)
+ collect (or (plist-get props :title) name))
+ t)))))))
+
+(defun ampc-set-dirty (tag-or-dirty &optional dirty)
+ (if (or (null tag-or-dirty) (memq tag-or-dirty '(t erase keep-dirty)))
+ (setf ampc-dirty tag-or-dirty)
+ (cl-loop for w in (ampc-normalize-windows)
+ do (with-current-buffer (window-buffer w)
+ (when (eq (car ampc-type) tag-or-dirty)
+ (ampc-set-dirty dirty))))))
+
+(defun ampc-update ()
+ (if ampc-status
+ (cl-loop for w in (ampc-normalize-windows)
+ do (with-current-buffer (window-buffer w)
+ (when (and ampc-dirty (not (eq ampc-dirty 'keep-dirty)))
+ (cl-ecase (car ampc-type)
+ (outputs
+ (ampc-send-command 'outputs))
+ (playlist
+ (ampc-update-playlist))
+ ((tag song)
+ (if (assoc (ampc-tags) ampc-internal-db)
+ (ampc-fill-tag-song)
+ (push (cons (ampc-tags) nil) ampc-internal-db)
+ (ampc-set-dirty 'tag 'keep-dirty)
+ (ampc-set-dirty 'song 'keep-dirty)
+ (ampc-send-command 'listallinfo)))
+ (status
+ (ampc-send-command 'status)
+ (ampc-send-command 'currentsong))
+ (playlists
+ (ampc-send-command 'listplaylists))
+ (current-playlist
+ (ampc-send-command 'playlistinfo))))))
+ (ampc-send-command 'status)
+ (ampc-send-command 'currentsong)))
+
+(defun ampc-update-playlist ()
+ (ampc-with-buffer 'playlists
+ (if (search-forward-regexp "^\\* " nil t)
+ (ampc-send-command 'listplaylistinfo
+ nil
+ (get-text-property (point) 'data))
+ (ampc-with-buffer 'playlist
+ (erase-buffer)
+ (ampc-set-dirty nil)))))
+
+(defun ampc-send-command-impl (command)
+ (when ampc-debug
+ (message "ampc: -> %s" command))
+ (when (ampc-on-p)
+ (process-send-string ampc-connection (concat command "\n"))))
+
+(cl-defun ampc-send-command (command &optional props &rest args)
+ (cl-destructuring-bind (&key (front nil) (keep-prev nil) (full-remove nil)
+ (remove-other nil) &allow-other-keys
+ &aux idle)
+ props
+ (when (and (not keep-prev)
+ (eq (caar ampc-outstanding-commands) command)
+ (equal (cl-cddar ampc-outstanding-commands) args))
+ (cl-return-from ampc-send-command))
+ (unless ampc-working-timer
+ (setf ampc-yield 0
+ ampc-working-timer (run-at-time nil 0.1 'ampc-yield)))
+ (when (equal (caar ampc-outstanding-commands) 'idle)
+ (pop ampc-outstanding-commands)
+ (setf idle t))
+ (when (and (not keep-prev) (cdr ampc-outstanding-commands))
+ (setf (cdr ampc-outstanding-commands)
+ (cl-loop for other-cmd in (cdr ampc-outstanding-commands)
+ unless (and (memq (car other-cmd) (list command
remove-other))
+ (or (not full-remove)
+ (progn
+ (cl-assert (null remove-other))
+ (equal (cddr other-cmd) args))))
+ collect other-cmd
+ end)))
+ (setf command (apply #'list command props args))
+ (if front
+ (push command ampc-outstanding-commands)
+ (setf ampc-outstanding-commands
+ (nconc ampc-outstanding-commands
+ (list command))))
+ (when idle
+ (push '(noidle nil) ampc-outstanding-commands)
+ (ampc-send-command-impl "noidle"))))
+
+(defun ampc-send-next-command ()
+ (cl-loop while ampc-outstanding-commands
+ for command =
+ (cl-loop for command = (car ampc-outstanding-commands)
+ for command-id = (replace-regexp-in-string
+ "^.*?-" ""
+ (symbol-name (car command)))
+ thereis
+ (catch 'skip
+ (ampc-send-command-impl
+ (concat command-id
+ (cl-loop for a in (cddr command)
+ concat " "
+ do (when (functionp a)
+ (cl-callf funcall a))
+ concat (cl-etypecase a
+ (integer (number-to-string a))
+ (string a)))))
+ (let ((callback (plist-get (cl-cadar
ampc-outstanding-commands)
+ :callback))
+ (old-head (pop ampc-outstanding-commands)))
+ (when callback (funcall callback))
+ (push old-head ampc-outstanding-commands))
+ command-id)
+ do (pop ampc-outstanding-commands)
+ while ampc-outstanding-commands)
+ while command
+ while (let ((member (memq (intern command)
ampc-synchronous-commands)))
+ (if member
+ (not (eq (car ampc-synchronous-commands) t))
+ (eq (car ampc-synchronous-commands) t)))
+ do (cl-loop with head = ampc-outstanding-commands
+ with ampc-no-implicit-next-dispatch = t
+ with ampc-yield-redisplay = t
+ while (ampc-on-p)
+ while (eq head ampc-outstanding-commands)
+ do (accept-process-output ampc-connection 0 100)))
+ (unless ampc-outstanding-commands
+ (when ampc-working-timer
+ (cancel-timer ampc-working-timer)
+ (setf ampc-yield nil
+ ampc-working-timer nil)
+ (ampc-fill-status))
+ (setf ampc-outstanding-commands '((idle nil)))
+ (ampc-send-command-impl "idle")))
+
+(defun ampc-tree< (a b)
+ (string< (car a) (car b)))
+
+(defun ampc-create-tree ()
+ (avl-tree-create 'ampc-tree<))
+
+(defsubst ampc-extract (regexp)
+ (goto-char (point-min))
+ (when (search-forward-regexp regexp nil t)
+ (match-string 1)))
+
+(defsubst ampc-clean-tag (tag value)
+ (if value
+ (let ((func (cdr (assoc tag ampc-tag-transform-funcs))))
+ (if func
+ (funcall func value)
+ value))
+ (unless (equal tag "Track")
+ "[Not Specified]")))
+
+(defun ampc-insert (element data &optional cmp cmp-data)
+ (goto-char (point-min))
+ (unless cmp-data
+ (setf cmp-data data))
+ (let ((action
+ (if (functionp cmp)
+ (cl-loop until (eobp)
+ for tp = (get-text-property (+ (point) 2) 'cmp-data)
+ thereis (let ((r (funcall cmp cmp-data tp)))
+ (if (symbolp r)
+ r
+ (forward-line r)
+ nil))
+ finally return 'insert)
+ (cl-loop with stringp-cmp-data = (stringp cmp-data)
+ with min = 1
+ with max = (1+ (count-lines (point-min) (point-max)))
+ with at-min = t
+ do (when (< (- max min) 20)
+ (unless at-min
+ (forward-line (- min max)))
+ (cl-return (cl-loop repeat (- max min)
+ for tp = (get-text-property (+
(point) 2)
+
'cmp-data)
+ thereis
+ (if (equal tp cmp-data)
+ 'update
+ (unless (if stringp-cmp-data
+ (string< tp cmp-data)
+ (string<
+
(buffer-substring-no-properties
+ (+ (point) 2)
+ (line-end-position))
+ element))
+ 'insert))
+ do (forward-line)
+ finally return 'insert)))
+ do (forward-line (funcall (if at-min #'+ #'-)
+ (/ (- max min) 2)))
+ for tp = (get-text-property (+ (point) 2) 'cmp-data)
+ thereis (when (equal tp cmp-data) 'update)
+ do (if (setf at-min (if stringp-cmp-data
+ (string< tp cmp-data)
+ (string<
(buffer-substring-no-properties
+ (+ (point) 2)
+ (line-end-position))
+ element)))
+ (cl-incf min (floor (/ (- max min) 2.0)))
+ (cl-decf max (floor (/ (- max min) 2.0))))
+ finally return 'insert))))
+ (cl-ecase action
+ (insert
+ (insert (propertize (concat " " element "\n")
+ 'data (if (eq cmp t) (list data) data)
+ 'cmp-data cmp-data)))
+ ((update overwrite)
+ (remove-text-properties (point) (1+ (point)) '(not-updated))
+ (when (or (eq ampc-dirty 'erase) (eq action 'overwrite))
+ (let ((origin (point)))
+ (forward-char 2)
+ (kill-line 1)
+ (insert element "\n")
+ (goto-char origin)))
+ (let ((next (1+ (line-end-position))))
+ (put-text-property (point) next 'cmp-data cmp-data)
+ (put-text-property
+ (point) next
+ 'data (cond ((eq cmp t)
+ (let ((rest (get-text-property (point) 'data)))
+ (if (memq data rest)
+ rest
+ (cons data rest))))
+ (t data))))
+ (eq (char-after) ?*)))))
+
+(defun ampc-fill-tag (trees)
+ (put-text-property (point-min) (point-max) 'data nil)
+ (cl-loop with new-trees
+ for tree in trees
+ do (when tree
+ (avl-tree-mapc
+ (lambda (e)
+ (when (ampc-insert (car e) (cdr e) t (car e))
+ (push (cdr e) new-trees)))
+ tree))
+ finally return new-trees))
+
+(defun ampc-fill-song (trees)
+ (cl-loop
+ for songs in trees
+ do (cl-loop for song in songs
+ do (ampc-insert
+ (ampc-pad
+ (cl-loop for (p . v) in (plist-get (cdr ampc-type)
:properties)
+ collect (cdr (assoc p song))))
+ `((,song))))))
+
+(defsubst ampc-narrow-entry (delimiter-regexp)
+ (let ((result))
+ (narrow-to-region
+ (line-beginning-position)
+ (or (save-excursion
+ (goto-char (line-end-position))
+ (when (search-forward-regexp delimiter-regexp nil t)
+ (setf result (point))
+ (1- (line-beginning-position))))
+ (point-max)))
+ result))
+
+(defun ampc-fill-playlist ()
+ (ampc-fill-skeleton 'playlist
+ (let ((index 0))
+ (ampc-iterate-source-output "file" (file)
+ (cl-loop for (tag . tag-regexp) in tags
+ collect (ampc-clean-tag tag (ampc-extract tag-regexp)))
+ `(("file" . ,file)
+ (index . ,(1- (cl-incf index))))
+ 'ampc-int-insert-cmp
+ index))))
+
+(defun ampc-fill-outputs ()
+ (ampc-fill-skeleton 'outputs
+ (ampc-iterate-source-output "outputid" (outputid outputenabled)
+ (cl-loop for (tag . tag-regexp) in tags
+ collect (ampc-clean-tag tag (ampc-extract tag-regexp)))
+ `(("outputid" . ,outputid)
+ ("outputenabled" . ,outputenabled)))))
+
+(cl-defun ampc-mini-impl (&aux songs)
+ (ampc-iterate-source
+ nil
+ "file"
+ (Title
+ Artist
+ (Pos (string-to-number (ampc-extract (ampc-extract-regexp "Pos")))))
+ (let ((entry (cons (concat Title
+ (when Artist
+ (concat " - " Artist)))
+ Pos)))
+ (cl-loop with mentry = (cons (car entry) (cdr entry))
+ for index from 2
+ while (assoc (car mentry) songs)
+ do (setf (car mentry) (concat (car entry)
+ " (" (int-to-string index) ")"))
+ finally do (push mentry songs))))
+ (unless songs
+ (message "No song in the playlist")
+ (cl-return-from ampc-mini-impl))
+ (let ((song (assoc (let ((inhibit-quit t))
+ (prog1
+ (with-local-quit
+ (completing-read "Song to play: " songs nil t))
+ (setf quit-flag nil)))
+ songs)))
+ (when song
+ (ampc-play-this (cdr song)))))
+
+(defun ampc-fill-current-playlist ()
+ (ampc-fill-skeleton 'current-playlist
+ (ampc-iterate-source-output
+ "file"
+ (file (pos (string-to-number (ampc-extract
+ (ampc-extract-regexp "Pos")))))
+ (cl-loop for (tag . tag-regexp) in tags
+ collect (ampc-clean-tag tag (ampc-extract tag-regexp)))
+ `(("file" . ,file)
+ ("Pos" . ,pos))
+ 'ampc-int-insert-cmp
+ pos)))
+
+(defun ampc-fill-playlists ()
+ (ampc-fill-skeleton 'playlists
+ (with-current-buffer data-buffer
+ (cl-loop while (search-forward-regexp "^playlist: \\(.*\\)$" nil t)
+ for playlist = (match-string 1)
+ do (ampc-with-buffer 'playlists
+ (ampc-insert playlist playlist)))))
+ (ampc-set-dirty 'playlist t)
+ (ampc-update))
+
+(defun ampc-yield ()
+ (cl-incf ampc-yield)
+ (ampc-fill-status)
+ (when ampc-yield-redisplay
+ (redisplay t)))
+
+(defun ampc-fill-status ()
+ (ampc-with-buffer 'status
+ (erase-buffer)
+ (funcall (or (plist-get (cadr ampc-type) :filler)
+ (lambda (_)
+ (insert (ampc-status t) "\n")))
+ ampc-status)
+ (ampc-set-dirty nil)))
+
+(defun ampc-fill-tag-song ()
+ (cl-loop
+ with trees = (list (cdr (assoc (ampc-tags) ampc-internal-db)))
+ for type in '(tag song)
+ do
+ (cl-loop
+ for w in (ampc-normalize-windows)
+ do
+ (with-current-buffer (window-buffer w)
+ (when (eq (car ampc-type) type)
+ (if ampc-dirty
+ (if (and (not trees) (not (eq ampc-dirty 'keep-dirty)))
+ (progn
+ (let ((inhibit-read-only t))
+ (erase-buffer))
+ (ampc-set-dirty nil))
+ (ampc-fill-skeleton w
+ (if (eq type 'tag)
+ (setf trees (ampc-fill-tag trees))
+ (ampc-fill-song trees))))
+ (setf trees nil)
+ (save-excursion
+ (goto-char (point-min))
+ (cl-loop while (search-forward-regexp "^* " nil t)
+ do (cl-callf append trees
+ (get-text-property (point) 'data))))))))))
+
+(defun ampc-transform-track (track)
+ (when (eq (length track) 1)
+ (setf track (concat "0" track)))
+ track)
+
+(cl-defun ampc-transform-time (data &aux (time (string-to-number data)))
+ (concat (number-to-string (/ time 60))
+ ":"
+ (when (< (% time 60) 10)
+ "0")
+ (number-to-string (% time 60))))
+
+(defun ampc-handle-idle ()
+ (cl-loop until (eobp)
+ for subsystem = (buffer-substring (point) (line-end-position))
+ do (when (string-match "^changed: \\(.*\\)$" subsystem)
+ (cl-case (intern (match-string 1 subsystem))
+ (database
+ (setf ampc-internal-db (list (cons (ampc-tags) nil)))
+ (ampc-set-dirty 'tag 'keep-dirty)
+ (ampc-set-dirty 'song 'keep-dirty)
+ (ampc-send-command 'listallinfo))
+ (output
+ (ampc-set-dirty 'outputs t))
+ ((player options mixer)
+ (setf ampc-status nil)
+ (ampc-set-dirty 'status t))
+ (stored_playlist
+ (ampc-set-dirty 'playlists t))
+ (playlist
+ (ampc-set-dirty 'current-playlist t)
+ (ampc-set-dirty 'status t))))
+ (forward-line))
+ (ampc-update))
+
+(defun ampc-handle-setup (status)
+ (unless (and (string-match "^ MPD \\(.+\\)\\.\\(.+\\)\\.\\(.+\\)$"
+ status)
+ (let ((version-a (string-to-number (match-string 1 status)))
+ (version-b (string-to-number (match-string 2 status)))
+ ;; (version-c (string-to-number (match-string 2 status)))
+ )
+ (or (> version-a 0)
+ (>= version-b 15))))
+ (error (concat "Your version of MPD is not supported. "
+ "ampc supports MPD protocol version 0.15.0 "
+ "and later"))))
+
+(defun ampc-fill-internal-db (running)
+ (cl-loop with tree = (assoc (ampc-tags) ampc-internal-db)
+ with tags =
+ (cl-loop for w in (ampc-normalize-windows)
+ for props = (with-current-buffer (window-buffer w)
+ (when (eq (car ampc-type) 'tag)
+ (ampc-set-dirty t)
+ (plist-get (cdr ampc-type) :tag)))
+ when props
+ collect props
+ end)
+ with song-props = (ampc-with-buffer 'song
+ (ampc-set-dirty t)
+ (plist-get (cdr ampc-type)
:properties))
+ for origin = (and (search-forward-regexp "^file: " nil t)
+ (line-beginning-position))
+ then next
+ while origin
+ do (goto-char (1+ origin))
+ for next = (and (search-forward-regexp "^file: " nil t)
+ (line-beginning-position))
+ while (or (not running) next)
+ do (save-restriction
+ (narrow-to-region origin (or next (point-max)))
+ (ampc-fill-internal-db-entry tree tags song-props))
+ (when running
+ (delete-region origin next)
+ (setf next origin))))
+
+(defun ampc-tags ()
+ (cl-loop for w in (ampc-normalize-windows)
+ for tag = (with-current-buffer (window-buffer w)
+ (when (eq (car ampc-type) 'tag)
+ (plist-get (cdr ampc-type) :tag)))
+ when tag
+ collect tag
+ end))
+
+(defun ampc-fill-internal-db-entry (tree tags song-props)
+ (cl-loop for tag in tags
+ for data = (ampc-clean-tag tag (ampc-extract (ampc-extract-regexp
tag)))
+ do (unless (cdr tree)
+ (setf (cdr tree) (ampc-create-tree)))
+ (setf tree (avl-tree-enter (cdr tree)
+ (cons data nil)
+ (lambda (_ match)
+ match))))
+ (push (cons (cons "file" (ampc-extract (ampc-extract-regexp "file")))
+ (cl-loop for p in song-props
+ for data = (ampc-clean-tag (car p)
+ (ampc-extract
+ (ampc-extract-regexp (car
p))))
+ when data
+ collect (cons (car p) data)
+ end))
+ (cdr tree)))
+
+(defun ampc-fill-status-var (tags)
+ (cl-loop for k in tags
+ for v = (ampc-extract (ampc-extract-regexp k))
+ for s = (intern k)
+ do (if v
+ (setf (cdr (or (assq s ampc-status)
+ (car (push (cons s nil) ampc-status))))
+ v)
+ (cl-callf2 assq-delete-all s ampc-status))))
+
+(defun ampc-handle-current-song ()
+ (ampc-fill-status-var (append ampc-status-tags '("Artist" "Title" "file")))
+ (ampc-fill-status)
+ (run-hook-with-args ampc-status-changed-hook ampc-status))
+
+(defun ampc-handle-status ()
+ (ampc-fill-status-var '("volume" "repeat" "random" "consume" "xfade" "state"
+ "song" "playlistlength"))
+ (ampc-with-buffer 'current-playlist
+ (when ampc-highlight-current-song-mode
+ (font-lock-fontify-buffer)))
+ (run-hook-with-args ampc-status-changed-hook ampc-status))
+
+(defun ampc-handle-update ()
+ (message "Database update started"))
+
+(defun ampc-handle-command (status)
+ (cond
+ ((eq status 'error)
+ (pop ampc-outstanding-commands))
+ ((eq status 'running)
+ (cl-case (caar ampc-outstanding-commands)
+ (listallinfo (ampc-fill-internal-db t))))
+ (t
+ (let ((command (pop ampc-outstanding-commands)))
+ (cl-case (car command)
+ (idle
+ (ampc-handle-idle))
+ (setup
+ (ampc-handle-setup status))
+ (currentsong
+ (ampc-handle-current-song))
+ (status
+ (ampc-handle-status))
+ (update
+ (ampc-handle-update))
+ (listplaylistinfo
+ (ampc-fill-playlist))
+ (listplaylists
+ (ampc-fill-playlists))
+ (playlistinfo
+ (ampc-fill-current-playlist))
+ (mini-playlistinfo
+ (ampc-mini-impl))
+ (mini-currentsong
+ (ampc-status))
+ (shuffle-listplaylistinfo
+ (ampc-shuffle-playlist (plist-get (cadr command) :playlist)))
+ (listallinfo
+ (ampc-handle-listallinfo))
+ (outputs
+ (ampc-fill-outputs))))
+ (unless ampc-outstanding-commands
+ (ampc-update)))))
+
+(cl-defun ampc-shuffle-playlist (playlist &aux songs)
+ (ampc-iterate-source nil "file" (file)
+ (push (cons file (random)) songs))
+ (ampc-send-command 'playlistclear '(:full-remove t) (ampc-quote playlist))
+ (cl-loop for file in (mapcar #'car (sort songs
+ (lambda (a b) (< (cdr a) (cdr b)))))
+ do (ampc-send-command 'playlistadd
+ '(:keep-prev t)
+ (ampc-quote playlist)
+ file)))
+
+
+(defun ampc-handle-listallinfo ()
+ (ampc-fill-internal-db nil)
+ (ampc-set-dirty 'tag t)
+ (ampc-set-dirty 'song t))
+
+(defun ampc-filter (_process string)
+ (cl-assert (buffer-live-p (process-buffer ampc-connection)))
+ (with-current-buffer (process-buffer ampc-connection)
+ (when string
+ (when (and ampc-debug (not (eq ampc-debug t)))
+ (message "ampc: <- %s" string))
+ (goto-char (process-mark ampc-connection))
+ (insert string)
+ (set-marker (process-mark ampc-connection) (point)))
+ (save-excursion
+ (goto-char (point-min))
+ (let ((success))
+ (if (or (progn
+ (when (search-forward-regexp
+ "^ACK \\[\\(.*\\)\\] {.*} \\(.*\\)\n\\'"
+ nil
+ t)
+ (message "ampc command error: %s (%s; %s)"
+ (match-string 2)
+ (match-string 1)
+ (funcall (if ampc-debug #'identity #'car)
+ (car ampc-outstanding-commands)))
+ t))
+ (when (search-forward-regexp "^OK\\(.*\\)\n\\'" nil t)
+ (setf success t)))
+ (progn
+ (let ((match-end (match-end 0)))
+ (save-restriction
+ (narrow-to-region (point-min) match-end)
+ (goto-char (point-min))
+ (ampc-handle-command (if success (match-string 1) 'error)))
+ (delete-region (point-min) match-end))
+ (unless ampc-no-implicit-next-dispatch
+ (ampc-send-next-command))))
+ (ampc-handle-command 'running)))))
+
+(cl-defun ampc-set-tab-offsets
+ (&rest properties &aux (min 2) (optional-padding 0))
+ (unless properties
+ (cl-return-from ampc-set-tab-offsets))
+ (set (make-local-variable 'tab-stop-list) nil)
+ (cl-loop for (_title . props) in properties
+ for min- = (plist-get props :min)
+ do (cl-incf min (or (plist-get props :width) min-))
+ (when min-
+ (cl-incf optional-padding (- (plist-get props :max) min-))))
+ (cl-loop for (_title . props) in properties
+ with offset = 2
+ do (push offset tab-stop-list)
+ (cl-incf offset (or (plist-get props :width)
+ (let ((min- (plist-get props :min))
+ (max (plist-get props :max)))
+ (if (>= min (window-width))
+ min-
+ (min max
+ (+ min-
+ (floor (* (/ (float (- max min-))
+ optional-padding)
+ (- (window-width)
+ min))))))))))
+ (cl-callf nreverse tab-stop-list))
+
+(cl-defun ampc-configure-frame-1 (split &aux (split-type (car split)))
+ (if (memq split-type '(vertical horizontal))
+ (let* ((sizes))
+ (cl-loop with length = (if (eq split-type 'horizontal)
+ (window-total-width)
+ (window-total-height))
+ with rest = length
+ with rest-car
+ for (size . subsplit) in (cdr split)
+ do (if (equal size 1.0)
+ (progn (push t sizes)
+ (setf rest-car sizes))
+ (let ((l (if (integerp size) size (round (* size
length)))))
+ (cl-decf rest l)
+ (push l sizes)))
+ finally do (setf (car rest-car) rest))
+ (let ((first-window (selected-window)))
+ (cl-callf nreverse sizes)
+ (cl-loop for size in (copy-sequence sizes)
+ for window on (cdr sizes)
+ do (select-window
+ (setf (car window)
+ (split-window nil size (eq split-type
'horizontal)))))
+ (setf (car sizes) first-window))
+ (cl-loop for subsplit in (cdr split)
+ for window in sizes
+ with result
+ do (with-selected-window window
+ (setf result
+ (or (ampc-configure-frame-1 (cdr subsplit))
result)))
+ finally return result))
+ (setf (window-dedicated-p (selected-window)) nil)
+ (pop-to-buffer-same-window
+ (get-buffer-create
+ (concat "*"
+ (mapconcat (lambda (s) (concat (upcase (substring s 0 1))
+ (substring s 1)))
+ (if (memq split-type '(tag song))
+ (list (or (plist-get (cdr split) :tag) "song"))
+ (split-string (symbol-name split-type) "-"))
+ " ")
+ "*")))
+ (if (memq split-type '(tag song))
+ (ampc-tag-song-mode)
+ (let ((mode (intern (concat "ampc-" (symbol-name split-type) "-mode"))))
+ (unless (fboundp mode)
+ (setf mode 'ampc-mode))
+ (unless (eq major-mode 'mode) ;FIXME: This quote looks spurious!
+ (funcall mode))))
+ (cl-destructuring-bind
+ (&key (properties nil) (dedicated t) (mode-line t) &allow-other-keys)
+ (cdr split)
+ (apply #'ampc-set-tab-offsets properties)
+ (setf ampc-type split
+ (window-dedicated-p (selected-window)) dedicated
+ mode-line-format (when mode-line
+ (default-value 'mode-line-format))))
+ (set (make-local-variable 'mode-line-buffer-identification)
+ '(:eval (let ((result
+ (concat (car-safe (propertized-buffer-identification
+ (buffer-name)))
+ (when ampc-dirty
+ " [Updating...]"))))
+ (if (< (length result) 12)
+ (concat result (make-string (- 12 (length result)) ? ))
+ result))))
+ (ampc-update-header)
+ (add-to-list 'ampc-all-buffers (current-buffer))
+ (push (cons (or (plist-get (cdr split) :id) 9999) (selected-window))
+ ampc-windows)
+ (ampc-set-dirty t)
+ (when (plist-get (cdr split) :select)
+ (selected-window))))
+
+(cl-defun ampc-configure-frame
+ (split &optional no-update &aux (old-selection ampc-type)
old-window-starts)
+ (cl-loop for w in (ampc-normalize-windows)
+ do (with-selected-window w
+ (with-current-buffer (window-buffer w)
+ (push (cons (current-buffer) (window-start))
+ old-window-starts))))
+ (if (not ampc-use-full-frame)
+ (ampc-restore-window-configuration)
+ (setf (window-dedicated-p (selected-window)) nil)
+ (delete-other-windows))
+ (setf ampc-windows nil)
+ (let ((select-window (ampc-configure-frame-1 split)))
+ (setf ampc-windows
+ (mapcar (lambda (window)
+ (cons window (window-buffer window)))
+ (mapcar #'cdr (sort ampc-windows
+ (lambda (a b) (< (car a) (car b)))))))
+ (cl-loop for w in (ampc-normalize-windows)
+ do (with-selected-window w
+ (let ((old-window-start (cdr (assq (current-buffer)
+ old-window-starts))))
+ (when old-window-start
+ (set-window-start nil old-window-start)))
+ (when (and (derived-mode-p 'ampc-item-mode)
+ (> (length tab-stop-list) 1))
+ (ampc-set-dirty 'erase))))
+ (select-window (or (cl-loop for w in (ampc-normalize-windows)
+ thereis
+ (when (equal (with-current-buffer
(window-buffer w)
+ ampc-type)
+ old-selection)
+ w))
+ select-window
+ (selected-window))))
+ (unless no-update
+ (ampc-update)))
+
+(defun ampc-tagger-rename-artist-title (_changed-tags data)
+ "Rename music file according to its tags.
+This function is meant to be inserted into
+`ampc-tagger-stored-hook'. The new file name is
+`Artist'_-_`Title'.`extension'. Characters within `Artist' and
+`Title' that are not alphanumeric are substituted with underscore."
+ (let* ((artist (replace-regexp-in-string
+ "[^a-zA-Z0-9]" "_"
+ (or (cdr (assq 'Artist (cdr data))) "")))
+ (title (replace-regexp-in-string
+ "[^a-zA-Z0-9]" "_"
+ (or (cdr (assq 'Title (cdr data))) "")))
+ (new-file
+ (expand-file-name (replace-regexp-in-string
+ "_\\(_\\)+"
+ "_"
+ (concat artist
+ (when (and (> (length artist) 0)
+ (> (length title) 0))
+ "_-_")
+ title
+ (file-name-extension (car data) t)))
+ (file-name-directory (car data)))))
+ (unless (equal (car data) new-file)
+ (ampc-tagger-log "Renaming file " (abbreviate-file-name (car data))
+ " to " (abbreviate-file-name new-file) "\n")
+ (rename-file (car data) new-file)
+ (setf (car data) new-file))))
+
+;;; *** interactives
+(defun ampc-tagger-completion-at-point (&optional all-files)
+ "Perform completion at point via `completion-at-point'.
+If optional prefix argument ALL-FILES is non-nil, use all files
+within the files list buffer as source for completion. The
+default behaviour is to use only the selected ones."
+ (interactive "P")
+ (let ((ampc-tagger-completion-all-files all-files))
+ (completion-at-point)))
+
+(defun ampc-tagger-reset (&optional reset-all-tags)
+ "Reset all tag values within the tagger, based on the selection of files.
+If optional prefix argument RESET-ALL-TAGS is non-nil, restore
+all tags."
+ (interactive "P")
+ (when reset-all-tags
+ (ampc-with-buffer 'tagger
+ no-se
+ (erase-buffer)
+ (cl-loop for tag in ampc-tagger-tags
+ do (insert (ampc-pad (list (concat (symbol-name tag) ":")
"dummy"))
+ "\n"))
+ (goto-char (point-min))
+ (re-search-forward ":\\( \\)+")))
+ (ampc-with-buffer 'tagger
+ (cl-loop while (search-forward-regexp
+ (concat "^\\([ \t]*\\)\\("
+ (mapconcat #'symbol-name ampc-tagger-tags "\\|")
+ "\\)\\([ \t]*\\):\\([ \t]*.*\\)$")
+ nil
+ t)
+ do (replace-match "" nil nil nil 1)
+ (replace-match "" nil nil nil 3)
+ (replace-match (concat (make-string (- (car tab-stop-list)
+ (1+ (length (match-string
2))))
+ ? )
+ "<keep>")
+ nil nil nil 4)))
+ (ampc-tagger-update)
+ (ampc-with-buffer 'tagger
+ no-se
+ (when (looking-at "[ \t]+")
+ (goto-char (match-end 0)))))
+
+(cl-defun ampc-tagger-save (&optional quit &aux tags)
+ "Save tags.
+If optional prefix argument QUIT is non-nil, quit tagger
+afterwards. If the numeric value of QUIT is 16, quit tagger and
+do not trigger a database update"
+ (interactive "P")
+ (ampc-with-buffer 'tagger
+ (cl-loop do (cl-loop until (eobp)
+ while (looking-at "^[ \t]*$")
+ do (forward-line))
+ until (eobp)
+ do (unless (and (looking-at
+ (concat "^[ \t]*\\("
+ (mapconcat #'symbol-name
+ ampc-tagger-tags
+ "\\|")
+ "\\)[ \t]*:"
+ "[ \t]*\\(.*\\)[ \t]*$"))
+ (not (assq (intern (match-string 1)) tags)))
+ (error "Malformed line \"%s\""
+ (buffer-substring (line-beginning-position)
+ (line-end-position))))
+ (push (cons (intern (match-string 1))
+ (let ((val (match-string 2)))
+ (if (string= "<keep>" val)
+ t
+ (set-text-properties 0 (length val) nil val)
+ val)))
+ tags)
+ (forward-line)))
+ (cl-callf2 rassq-delete-all t tags)
+ (with-temp-buffer
+ (cl-loop for (tag . value) in tags
+ do (insert (symbol-name tag) "\n"
+ value "\n"))
+ (let ((input-buffer (current-buffer)))
+ (ampc-with-buffer 'files-list
+ no-se
+ (let ((reporter
+ (make-progress-reporter "Storing tags"
+ 0
+ (let ((count (count-matches "^\\* ")))
+ (if (zerop count)
+ 1
+ count))))
+ (step 0))
+ (ampc-with-selection nil
+ (let* ((data (get-text-property (point) 'data))
+ (old-tags (cl-loop for (tag . data) in (cdr data)
+ collect (cons tag data)))
+ (found-changed (ampc-tagger-tags-modified (cdr data) tags)))
+ (let ((pre-hook-tags (cdr data)))
+ (run-hook-with-args 'ampc-tagger-store-hook found-changed data)
+ (setf found-changed
+ (or found-changed
+ (ampc-tagger-tags-modified pre-hook-tags
+ (cdr data)))))
+ (when found-changed
+ (ampc-tagger-log
+ "Storing tags for file "
+ (abbreviate-file-name (car data)) "\n"
+ "\tOld tags:\n"
+ (cl-loop for (tag . value) in old-tags
+ concat (concat "\t\t"
+ (symbol-name tag) ": "
+ value "\n"))
+ "\tNew tags:\n"
+ (cl-loop for (tag . value) in (cdr data)
+ concat (concat "\t\t"
+ (symbol-name tag) ": "
+ value "\n")))
+ (ampc-tagger-make-backup (car data))
+ (ampc-tagger-report
+ (list "--set" (car data))
+ (with-temp-buffer
+ (insert-buffer-substring input-buffer)
+ (prog1
+ (call-process-region (point-min) (point-max)
+ ampc-tagger-executable
+ nil t nil
+ "--set" (car data))
+ (when ampc-debug
+ (message "ampc-tagger: %s"
+ (buffer-substring
+ (point-min) (point))))))))
+ (run-hook-with-args 'ampc-tagger-stored-hook found-changed data)
+ (let ((inhibit-read-only t))
+ (move-beginning-of-line nil)
+ (forward-char 2)
+ (kill-line 1)
+ (insert
+ (ampc-pad (cl-loop for p in (plist-get (cdr ampc-type)
+ :properties)
+ when (eq (car p) 'filename)
+ collect (file-name-nondirectory (car data))
+ else
+ collect (cdr (assq (intern (car p))
+ (cdr data)))
+ end))
+ "\n")
+ (forward-line -1)
+ (put-text-property (line-beginning-position)
+ (1+ (line-end-position))
+ 'data data))
+ (progress-reporter-update reporter (cl-incf step))))
+ (progress-reporter-done reporter)))))
+ (when quit
+ (ampc-tagger-quit (eq (prefix-numeric-value quit) 16))))
+
+(defun ampc-tagger-quit (&optional no-update)
+ "Quit tagger and restore previous window configuration.
+With optional prefix NO-UPDATE, do not trigger a database update."
+ (interactive "P")
+ (set-window-configuration (or (car-safe ampc-tagger-previous-configuration)
+ ampc-tagger-previous-configuration))
+ (when (car-safe ampc-tagger-previous-configuration)
+ (unless no-update
+ (ampc-trigger-update))
+ (setf ampc-windows (cadr ampc-tagger-previous-configuration)))
+ (setf ampc-tagger-previous-configuration nil))
+
+(defun ampc-move-to-tab ()
+ "Move point to next logical tab stop."
+ (interactive)
+ (let ((tab (cl-loop for tab in
+ (or (get-text-property (point) 'tab-stop-list)
+ tab-stop-list)
+ while (>= (current-column) tab)
+ finally return tab)))
+ (when tab
+ (goto-char (min (+ (line-beginning-position) tab)
(line-end-position))))))
+
+(defun ampc-mouse-play-this (event)
+ (interactive "e")
+ (select-window (posn-window (event-end event)))
+ (goto-char (posn-point (event-end event)))
+ (ampc-play-this))
+
+(defun ampc-mouse-delete (event)
+ (interactive "e")
+ (select-window (posn-window (event-end event)))
+ (goto-char (posn-point (event-end event)))
+ (ampc-delete 1))
+
+(defun ampc-mouse-add (event)
+ (interactive "e")
+ (select-window (posn-window (event-end event)))
+ (goto-char (posn-point (event-end event)))
+ (ampc-add-impl))
+
+(defun ampc-mouse-delete-playlist (event)
+ (interactive "e")
+ (select-window (posn-window (event-end event)))
+ (goto-char (posn-point (event-end event)))
+ (ampc-delete-playlist t))
+
+(defun ampc-mouse-load (event)
+ (interactive "e")
+ (select-window (posn-window (event-end event)))
+ (goto-char (posn-point (event-end event)))
+ (ampc-load t))
+
+(defun ampc-mouse-toggle-output-enabled (event)
+ (interactive "e")
+ (select-window (posn-window (event-end event)))
+ (goto-char (posn-point (event-end event)))
+ (ampc-toggle-output-enabled 1))
+
+(cl-defun ampc-mouse-toggle-mark (event &aux (inhibit-read-only t))
+ (interactive "e")
+ (let ((window (posn-window (event-end event))))
+ (when (with-selected-window window
+ (goto-char (posn-point (event-end event)))
+ (unless (eobp)
+ (move-beginning-of-line nil)
+ (ampc-mark-impl (not (eq (char-after) ?*)) 1)
+ t))
+ (select-window window))))
+
+(defun ampc-mouse-align-point (event)
+ (interactive "e")
+ (select-window (posn-window (event-end event)))
+ (goto-char (posn-point (event-end event)))
+ (ampc-align-point))
+
+(cl-defun ampc-unmark-all (&aux (inhibit-read-only t))
+ "Remove all marks."
+ (interactive)
+ (cl-assert (ampc-in-ampc-p t))
+ (save-excursion
+ (goto-char (point-min))
+ (cl-loop while (search-forward-regexp "^\\* " nil t)
+ do (replace-match " " nil nil)))
+ (ampc-post-mark-change-update))
+
+(defun ampc-trigger-update ()
+ "Trigger a database update."
+ (interactive)
+ (cl-assert (ampc-on-p))
+ (ampc-send-command 'update))
+
+(cl-defun ampc-toggle-marks (&aux (inhibit-read-only t))
+ "Toggle marks.
+Marked entries become unmarked, and vice versa."
+ (interactive)
+ (cl-assert (ampc-in-ampc-p t))
+ (save-excursion
+ (cl-loop for (a . b) in '(("* " . "T ")
+ (" " . "* ")
+ ("T " . " "))
+ do (goto-char (point-min))
+ (cl-loop while (search-forward-regexp (concat "^" (regexp-quote
a))
+ nil
+ t)
+ do (replace-match b nil nil))))
+ (ampc-post-mark-change-update))
+
+(defun ampc-up (&optional arg)
+ "Move selected entries ARG positions upwards.
+ARG defaults to one."
+ (interactive "p")
+ (cl-assert (ampc-in-ampc-p))
+ (ampc-move (- (or arg 1))))
+
+(defun ampc-down (&optional arg)
+ "Move selected entries ARG positions downwards.
+ARG defaults to one."
+ (interactive "p")
+ (cl-assert (ampc-in-ampc-p))
+ (ampc-move (or arg 1)))
+
+(defun ampc-mark (&optional arg)
+ "Mark the next ARG'th entries.
+ARG defaults to 1."
+ (interactive "p")
+ (cl-assert (ampc-in-ampc-p t))
+ (ampc-mark-impl t arg))
+
+(defun ampc-unmark (&optional arg)
+ "Unmark the next ARG'th entries.
+ARG defaults to 1."
+ (interactive "p")
+ (cl-assert (ampc-in-ampc-p t))
+ (ampc-mark-impl nil arg))
+
+(defun ampc-set-volume (&optional arg)
+ "Set volume to ARG percent.
+If ARG is nil, read ARG from minibuffer."
+ (interactive "P")
+ (cl-assert (ampc-on-p))
+ (ampc-set-volume-impl (or arg (read-number "Volume: "))))
+
+(defun ampc-increase-volume (&optional arg)
+ "Increase volume by prefix argument ARG or, if ARG is nil,
+`ampc-volume-step'."
+ (interactive "P")
+ (cl-assert (ampc-on-p))
+ (ampc-set-volume-impl arg '+))
+
+(defun ampc-decrease-volume (&optional arg)
+ "Decrease volume by prefix argument ARG or, if ARG is nil,
+`ampc-volume-step'."
+ (interactive "P")
+ (cl-assert (ampc-on-p))
+ (ampc-set-volume-impl arg '-))
+
+(defun ampc-set-crossfade (&optional arg)
+ "Set crossfade to ARG seconds.
+If ARG is nil, read ARG from minibuffer."
+ (interactive "P")
+ (cl-assert (ampc-on-p))
+ (ampc-set-crossfade-impl (or arg (read-number "Crossfade: "))))
+
+(defun ampc-increase-crossfade (&optional arg)
+ "Increase crossfade by prefix argument ARG or, if ARG is nil,
+`ampc-crossfade-step'."
+ (interactive "P")
+ (cl-assert (ampc-on-p))
+ (ampc-set-crossfade-impl arg '+))
+
+(defun ampc-decrease-crossfade (&optional arg)
+ "Decrease crossfade by prefix argument ARG or, if ARG is nil,
+`ampc-crossfade-step'."
+ (interactive "P")
+ (cl-assert (ampc-on-p))
+ (ampc-set-crossfade-impl arg '-))
+
+(defun ampc-toggle-repeat (&optional arg)
+ "Toggle MPD's repeat state.
+With prefix argument ARG, enable repeating if ARG is positive,
+otherwise disable it."
+ (interactive "P")
+ (cl-assert (ampc-on-p))
+ (ampc-toggle-state 'repeat arg))
+
+(defun ampc-toggle-consume (&optional arg)
+ "Toggle MPD's consume state.
+With prefix argument ARG, enable consuming if ARG is positive,
+otherwise disable it.
+
+When consume is activated, each song played is removed from the playlist."
+ (interactive "P")
+ (cl-assert (ampc-on-p))
+ (ampc-toggle-state 'consume arg))
+
+(defun ampc-toggle-random (&optional arg)
+ "Toggle MPD's random state.
+With prefix argument ARG, enable random playing if ARG is positive,
+otherwise disable it."
+ (interactive "P")
+ (ampc-toggle-state 'random arg))
+
+(defun ampc-play-this (&optional arg)
+ "Play selected song.
+With prefix argument ARG, play the ARG'th song located at the
+zero-indexed position of the current playlist."
+ (interactive "P")
+ (cl-assert (and (ampc-on-p) (or arg (ampc-in-ampc-p))))
+ (if (not arg)
+ (unless (eobp)
+ (ampc-send-command 'play nil (1- (line-number-at-pos)))
+ (ampc-send-command 'pause nil 0))
+ (ampc-send-command 'play nil arg)
+ (ampc-send-command 'pause nil 0)))
+
+(cl-defun ampc-toggle-play
+ (&optional arg &aux (state (cdr (assq 'state ampc-status))))
+ "Toggle play state.
+If MPD does not play a song already, start playing the song at
+point if the current buffer is the playlist buffer, otherwise
+start at the beginning of the playlist.
+
+If ARG is 4, stop player rather than pause if applicable."
+ (interactive "P")
+ (cl-assert (ampc-on-p))
+ (unless state
+ (cl-return-from ampc-toggle-play))
+ (when arg
+ (setf arg (prefix-numeric-value arg)))
+ (cl-ecase (intern state)
+ (stop
+ (when (or (null arg) (> arg 0))
+ (ampc-send-command
+ 'play
+ '(:remove-other (pause))
+ (if (and (eq (car ampc-type) 'current-playlist) (not (eobp)))
+ (1- (line-number-at-pos))
+ 0))))
+ (pause
+ (when (or (null arg) (> arg 0))
+ (ampc-send-command 'pause '(:remove-other (play)) 0)))
+ (play
+ (cond ((or (null arg) (< arg 0))
+ (ampc-send-command 'pause '(:remove-other (play)) 1))
+ ((eq arg 4)
+ (ampc-send-command 'stop))))))
+
+(defun ampc-next (&optional arg)
+ "Play next song.
+With prefix argument ARG, skip ARG songs."
+ (interactive "p")
+ (cl-assert (ampc-on-p))
+ (ampc-skip (or arg 1)))
+
+(defun ampc-previous (&optional arg)
+ "Play previous song.
+With prefix argument ARG, skip ARG songs."
+ (interactive "p")
+ (cl-assert (ampc-on-p))
+ (ampc-skip (- (or arg 1))))
+
+(defun ampc-rename-playlist (new-name)
+ "Rename selected playlist to NEW-NAME.
+If NEW-NAME is nil, read NEW-NAME from the minibuffer."
+ (interactive "M")
+ (unless new-name
+ (setf new-name (read-from-minibuffer (concat "New name for playlist "
+ (ampc-playlist)
+ ": "))))
+ (cl-assert (ampc-in-ampc-p))
+ (if (ampc-playlist)
+ (ampc-send-command 'rename '(:full-remove t) (ampc-quote new-name))
+ (message "No playlist selected")))
+
+(defun ampc-load (&optional at-point)
+ "Load selected playlist in the current playlist.
+If optional argument AT-POINT is non-nil (or if no playlist is
+selected), use playlist at point rather than the selected one."
+ (interactive)
+ (cl-assert (ampc-in-ampc-p))
+ (if (ampc-playlist at-point)
+ (ampc-send-command
+ 'load '(:keep-prev t)
+ (ampc-quote (ampc-playlist at-point)))
+ (if at-point
+ (message "No playlist at point")
+ (message "No playlist selected"))))
+
+(defun ampc-toggle-output-enabled (&optional arg)
+ "Toggle the next ARG outputs.
+If ARG is omitted, use the selected entries."
+ (interactive "P")
+ (cl-assert (ampc-in-ampc-p))
+ (ampc-with-selection arg
+ (let ((data (get-text-property (point) 'data)))
+ (ampc-send-command (if (equal (cdr (assoc "outputenabled" data)) "1")
+ 'disableoutput
+ 'enableoutput)
+ '(:full-remove t)
+ (cdr (assoc "outputid" data))))))
+
+(defun ampc-delete (&optional arg)
+ "Delete the next ARG songs from the playlist.
+If ARG is omitted, use the selected entries. If ARG is non-nil,
+all marks after point are removed nontheless."
+ (interactive "P")
+ (cl-assert (ampc-in-ampc-p))
+ (let ((first-del nil))
+ (ampc-with-selection arg
+ (unless (or first-del (when arg (< arg 0)))
+ (setf first-del (point)))
+ (let ((val (1- (- (line-number-at-pos) (if (or (not arg) (> arg 0))
+ index
+ 0)))))
+ (if (and (not (eq (car ampc-type) 'current-playlist)) (ampc-playlist))
+ (ampc-send-command 'playlistdelete
+ '(:keep-prev t)
+ (ampc-quote (ampc-playlist))
+ val)
+ (ampc-send-command 'delete '(:keep-prev t) val))
+ (ampc-mark-impl nil nil)))
+ (when first-del
+ (goto-char first-del))))
+
+(defun ampc-shuffle ()
+ "Shuffle playlist."
+ (interactive)
+ (cl-assert (ampc-on-p))
+ (if (and (not (eq (car ampc-type) 'current-playlist)) (ampc-playlist))
+ (ampc-send-command 'shuffle-listplaylistinfo
+ `(:playlist ,(ampc-playlist))
+ (ampc-quote (ampc-playlist)))
+ (ampc-send-command 'shuffle)))
+
+(defun ampc-clear ()
+ "Clear playlist."
+ (interactive)
+ (cl-assert (ampc-on-p))
+ (if (and (not (eq (car ampc-type) 'current-playlist)) (ampc-playlist))
+ (ampc-send-command 'playlistclear '(:full-remove t)
+ (ampc-quote (ampc-playlist)))
+ (ampc-send-command 'clear)))
+
+(defun ampc-add (&optional arg)
+ "Add the songs associated with the next ARG entries after point
+to the playlist.
+If ARG is omitted, use the selected entries in the current buffer."
+ (interactive "P")
+ (cl-assert (ampc-in-ampc-p))
+ (ampc-with-selection arg
+ (ampc-add-impl)))
+
+(defun ampc-status (&optional no-print)
+ "Display and return the information that is displayed in the status window.
+If optional argument NO-PRINT is non-nil, just return the text.
+If NO-PRINT is nil, the display may be delayed if ampc does not
+have enough information yet."
+ (interactive)
+ (cl-assert (ampc-on-p))
+ (unless (or ampc-status no-print)
+ (ampc-send-command 'status)
+ (ampc-send-command 'mini-currentsong)
+ (cl-return-from ampc-status))
+ (let* ((flags (mapconcat
+ #'identity
+ (cl-loop for (f . n) in '((repeat . "Repeat")
+ (random . "Random")
+ (consume . "Consume"))
+ when (equal (cdr (assq f ampc-status)) "1")
+ collect n
+ end)
+ "|"))
+ (state (cdr (assq 'state ampc-status)))
+ (status (concat "State: " state
+ (when (and ampc-yield no-print)
+ (concat (make-string (- 10 (length state)) ? )
+ (nth (% ampc-yield 4) '("|" "/" "-" "\\"))))
+ "\n"
+ (when (equal state "play")
+ (concat "Playing: "
+ (ampc-clean-tag
+ 'Artist
+ (cdr (assq 'Artist ampc-status)))
+ " - "
+ (ampc-clean-tag
+ 'Title
+ (cdr (assq 'Title ampc-status)))
+ "\n"))
+ "Volume: " (cdr (assq 'volume ampc-status)) "\n"
+ "Crossfade: " (cdr (assq 'xfade ampc-status))
+ (unless (equal flags "")
+ (concat "\n" flags)))))
+ (unless no-print
+ (message "%s" status))
+ status))
+
+(defun ampc-delete-playlist (&optional at-point)
+ "Delete selected playlist.
+If optional argument AT-POINT is non-nil (or if no playlist is
+selected), use playlist at point rather than the selected one."
+ (interactive)
+ (cl-assert (ampc-in-ampc-p))
+ (if (ampc-playlist at-point)
+ (when (y-or-n-p (concat "Delete playlist " (ampc-playlist at-point) "?"))
+ (ampc-send-command 'rm '(:full-remove t)
+ (ampc-quote (ampc-playlist at-point))))
+ (if at-point
+ (message "No playlist at point")
+ (message "No playlist selected"))))
+
+(require 'dired) ;Needed to properly compile
dired-map-over-marks.
+;;;###autoload
+(defun ampc-tagger-dired (&optional arg)
+ "Start the tagging subsystem on dired's marked files.
+With optional prefix argument ARG, use the next ARG files."
+ (interactive "P")
+ (cl-assert (derived-mode-p 'dired-mode))
+ (ampc-tag-files
+ (cl-loop for file in (dired-map-over-marks (dired-get-filename) arg)
+ unless (file-directory-p file)
+ collect file
+ end)))
+
+;;;###autoload
+(defun ampc-tag-files (files)
+ "Start the tagging subsystem.
+FILES should be a list of absolute file names, the files to tag."
+ (unless files
+ (message "No files specified")
+ (cl-return-from ampc-tagger-files t))
+ (when (memq (car ampc-type) '(files-list tagger))
+ (message "You are already within the tagger")
+ (cl-return-from ampc-tagger-files t))
+ (let ((reporter (make-progress-reporter "Grabbing tags" 0 (length files))))
+ (cl-loop for file in-ref files
+ for i from 1
+ do (run-hook-with-args 'ampc-tagger-grab-hook file)
+ (with-temp-buffer
+ (ampc-tagger-call "--get" file)
+ (setf file
+ (apply #'list
+ file
+ (cl-loop for tag in ampc-tagger-tags
+ collect
+ (cons tag (or (ampc-extract
(ampc-extract-regexp
+ (symbol-name
tag)))
+ ""))))))
+ (run-hook-with-args 'ampc-tagger-grabbed-hook file)
+ (progress-reporter-update reporter i))
+ (progress-reporter-done reporter))
+ (unless ampc-tagger-previous-configuration
+ (setf ampc-tagger-previous-configuration (current-window-configuration)))
+ (ampc-configure-frame (cdr (assq 'tagger ampc-views)) t)
+ (ampc-with-buffer 'files-list
+ (erase-buffer)
+ (cl-loop for (file . props) in files
+ do (insert (propertize
+ (concat
+ " "
+ (ampc-pad
+ (cl-loop for p in (plist-get (cdr ampc-type)
:properties)
+ when (eq (car p) 'filename)
+ collect (file-name-nondirectory file)
+ else
+ collect (cdr (assq (intern (car p)) props))
+ end))
+ "\n")
+ 'data (cons file props))))
+ (ampc-set-dirty nil)
+ (ampc-toggle-marks))
+ (ampc-with-buffer 'tagger
+ no-se
+ (ampc-tagger-reset t)
+ (goto-char (point-min))
+ (search-forward-regexp ": *")
+ (ampc-set-dirty nil))
+ nil)
+
+(cl-defun ampc-tagger (&optional arg &aux files)
+ "Start the tagging subsystem.
+The files to tag are collected by using either the selected
+entries within the current buffer or the next ARG entries at
+point if numeric perfix argument ARG is non-nil, the file
+associated with the entry at point, or, if both sources did not
+provide any files, the audio file that is currently played by
+MPD."
+ (interactive "P")
+ (cl-assert (ampc-in-ampc-p))
+ (unless ampc-tagger-version-verified
+ (with-temp-buffer
+ (ampc-tagger-call "--version")
+ (goto-char (point-min))
+ (let ((version (buffer-substring (line-beginning-position)
+ (line-end-position))))
+ (unless (equal version ampc-tagger-version)
+ (message (concat "The reported version of %s is not supported - "
+ "got \"%s\", want \"%s\"")
+ ampc-tagger-executable
+ version
+ ampc-tagger-version)
+ (cl-return-from ampc-tagger))))
+ (setf ampc-tagger-version-verified t))
+ (unless ampc-tagger-genres
+ (with-temp-buffer
+ (ampc-tagger-call "--genres")
+ (cl-loop while (search-backward-regexp "^\\(.+\\)$" nil t)
+ do (push (match-string 1) ampc-tagger-genres))))
+ (unless ampc-tagger-music-directories
+ (message (concat "ampc-tagger-music-directories is nil. Fill it via "
+ "M-x customize-variable RET ampc-tagger-music-directories
"
+ "RET"))
+ (cl-return-from ampc-tagger))
+ (cl-case (car ampc-type)
+ (current-playlist
+ (save-excursion
+ (ampc-with-selection arg
+ (cl-callf nconc files (list (cdr (assoc "file" (get-text-property
+ (line-end-position)
+ 'data))))))))
+ ((playlist tag song)
+ (save-excursion
+ (ampc-with-selection arg
+ (ampc-on-files (lambda (file) (push file files)))))
+ (cl-callf nreverse files))
+ (t
+ (let ((file (cdr (assoc 'file ampc-status))))
+ (when file
+ (setf files (list file))))))
+ (cl-loop for file in-ref files
+ for read-file = (locate-file file ampc-tagger-music-directories)
+ do (unless read-file
+ (error "Cannot locate file %s in ampc-tagger-music-directories"
+ file)
+ (cl-return-from ampc-tagger))
+ (setf file (expand-file-name read-file)))
+ (setf ampc-tagger-previous-configuration
+ (list (current-window-configuration) ampc-windows))
+ (when (ampc-tag-files files)
+ (setf ampc-tagger-previous-configuration nil)))
+
+(defun ampc-store (&optional name-or-append)
+ "Store current playlist as NAME-OR-APPEND.
+If NAME is non-nil and not a string, append selected entries
+within the current playlist buffer to the selected playlist. If
+NAME-OR-APPEND is a negative integer, append the next (-
+NAME-OR-APPEND) entries after point within the current playlist
+buffer to the selected playlist. If NAME-OR-APPEND is nil, read
+playlist name from the minibuffer."
+ (interactive "P")
+ (cl-assert (ampc-in-ampc-p))
+ (unless name-or-append
+ (setf name-or-append (read-from-minibuffer "Save playlist as: ")))
+ (if (stringp name-or-append)
+ (ampc-send-command 'save '(:full-remove t) (ampc-quote name-or-append))
+ (if (not (ampc-playlist))
+ (message "No playlist selected")
+ (ampc-with-buffer 'current-playlist
+ (when name-or-append
+ (cl-callf prefix-numeric-value name-or-append))
+ (ampc-with-selection (if (and name-or-append (< name-or-append 0))
+ (- name-or-append)
+ nil)
+ (ampc-send-command
+ 'playlistadd
+ '(:keep-prev t)
+ (ampc-quote (ampc-playlist))
+ (ampc-quote (cdr (assoc "file"
+ (get-text-property (point) 'data))))))))))
+
+(cl-defun ampc-goto-current-song (&aux (song (cdr (assq 'song ampc-status))))
+ "Select the current playlist window and move point to the current song."
+ (interactive)
+ (cl-assert (ampc-in-ampc-p))
+ (let ((window (ampc-with-buffer 'current-playlist
+ (selected-window))))
+ (when window
+ (select-window window)
+ (when song
+ (goto-char (point-min))
+ (forward-line (string-to-number song)))
+ (ampc-align-point))))
+
+(defun ampc-previous-line (&optional arg)
+ "Go to previous ARG'th entry in the current buffer.
+ARG defaults to 1."
+ (interactive "p")
+ (cl-assert (ampc-in-ampc-p t))
+ (ampc-next-line (* (or arg 1) -1)))
+
+(defun ampc-next-line (&optional arg)
+ "Go to next ARG'th entry in the current buffer.
+ARG defaults to 1."
+ (interactive "p")
+ (cl-assert (ampc-in-ampc-p t))
+ (forward-line arg)
+ (if (eobp)
+ (progn (forward-line -1)
+ (forward-char 2)
+ t)
+ (ampc-align-point)
+ nil))
+
+(cl-defun ampc-suspend (&optional (run-hook t))
+ "Suspend ampc.
+This function resets the window configuration, but does not close
+the connection to MPD or destroy the internal cache of ampc.
+This means subsequent startups of ampc will be faster."
+ (interactive)
+ (when ampc-working-timer
+ (cancel-timer ampc-working-timer))
+ (ampc-restore-window-configuration)
+ (cl-loop for b in ampc-all-buffers
+ do (when (buffer-live-p b)
+ (kill-buffer b)))
+ (setf ampc-windows nil
+ ampc-all-buffers nil
+ ampc-working-timer nil)
+ (when run-hook
+ (run-hooks 'ampc-suspend-hook)))
+
+(defun ampc-mini ()
+ "Select song to play via `completing-read'."
+ (interactive)
+ (cl-assert (ampc-on-p))
+ (ampc-send-command 'mini-playlistinfo))
+
+(defun ampc-quit (&optional arg)
+ "Quit ampc.
+If prefix argument ARG is non-nil, kill the MPD instance that
+ampc is connected to."
+ (interactive "P")
+ (when (ampc-on-p)
+ (set-process-filter ampc-connection nil)
+ (when (equal (car-safe ampc-outstanding-commands) '(idle nil))
+ (ampc-send-command-impl "noidle")
+ (with-current-buffer (process-buffer ampc-connection)
+ (cl-loop do (goto-char (point-min))
+ until (search-forward-regexp "^\\(ACK\\)\\|\\(OK\\).*\n\\'"
nil t)
+ while (ampc-on-p)
+ do (accept-process-output ampc-connection nil 50))))
+ (ampc-send-command-impl (if arg "kill" "close"))
+ (delete-process ampc-connection))
+ (when ampc-working-timer
+ (cancel-timer ampc-working-timer))
+ (ampc-suspend nil)
+ (setf ampc-connection nil
+ ampc-internal-db nil
+ ampc-outstanding-commands nil
+ ampc-status nil)
+ (run-hooks 'ampc-quit-hook))
+
+;;;###autoload
+(defun ampc-suspended-p ()
+ "Return non-nil if ampc is suspended."
+ (interactive)
+ (and (ampc-on-p) (not ampc-windows)))
+
+;;;###autoload
+(defun ampc-on-p ()
+ "Return non-nil if ampc is connected to the daemon."
+ (interactive)
+ (and ampc-connection (memq (process-status ampc-connection) '(open run))))
+
+;;;###autoload
+(defun ampc (&optional host port suspend)
+ "Ampc is an asynchronous client for the MPD media player.
+This function is the main entry point for ampc.
+
+HOST and PORT specify the MPD instance to connect to. The values
+default to the ones specified in `ampc-default-server'."
+ (interactive)
+ (unless (byte-code-function-p (symbol-function 'ampc))
+ (message "You should byte-compile ampc"))
+ (run-hooks 'ampc-before-startup-hook)
+ (unless host
+ (setf host (or (car ampc-default-server) (read-string "Host: "))))
+ (unless port
+ (setf port (or (cdr ampc-default-server) (read-string "Port: "))))
+ (when (and ampc-connection
+ (not (and (equal host ampc-host)
+ (equal port ampc-port)
+ (ampc-on-p))))
+ (ampc-quit))
+ (unless ampc-connection
+ (let ((connection (open-network-stream "ampc"
+ (with-current-buffer
+ (get-buffer-create " *ampc*")
+ (erase-buffer)
+ (current-buffer))
+ host
+ port
+ :type 'plain :return-list t)))
+ (unless (car connection)
+ (error "Failed connecting to server: %s"
+ (plist-get ampc-connection :error)))
+ (setf ampc-connection (car connection)
+ ampc-host host
+ ampc-port port))
+ (set-process-coding-system ampc-connection 'utf-8-unix 'utf-8-unix)
+ (set-process-filter ampc-connection 'ampc-filter)
+ (set-process-query-on-exit-flag ampc-connection nil)
+ (setf ampc-outstanding-commands '((setup))))
+ (if suspend
+ (ampc-update)
+ (ampc-configure-frame (cl-cddadr ampc-views)))
+ (run-hooks 'ampc-connected-hook)
+ (when suspend
+ (ampc-suspend))
+ (ampc-filter (process-buffer ampc-connection) nil))
+
+(provide 'ampc)
+
+;; Local Variables:
+;; eval: (outline-minor-mode 1)
+;; outline-regexp: ";;; \\*+"
+;; fill-column: 80
+;; indent-tabs-mode: nil
+;; End:
+;;; ampc.el ends here
diff --git a/packages/ampc/ampc_tagger.cpp b/packages/ampc/ampc_tagger.cpp
new file mode 100644
index 0000000..b62de7c
--- /dev/null
+++ b/packages/ampc/ampc_tagger.cpp
@@ -0,0 +1,218 @@
+// ampc_tagger.el --- Asynchronous Music Player Controller Tagger
+
+// Copyright (C) 2012 Free Software Foundation, Inc.
+
+// Author: Christopher Schmidt <address@hidden>
+// Maintainer: Christopher Schmidt <address@hidden>
+// Created: 2012-07-17
+
+// This file is part of ampc.
+
+// 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/>.
+
+#include <iostream>
+#include <sstream>
+
+#include <taglib/fileref.h>
+#include <taglib/tag.h>
+#include <taglib/id3v1genres.h>
+
+std::wstring const version=L"0.1";
+std::locale original_wcout_locale;
+
+bool get(std::string const& file)
+{
+ using namespace TagLib;
+
+ FileRef file_ref(file.c_str());
+ Tag* tag;
+ if(file_ref.isNull() || !(tag=file_ref.tag()))
+ {
+ std::wcerr << L"ERROR: Failed opening file." << std::endl;
+ return true;
+ }
+
+ std::wcout << L"Title: " << tag->title().toWString() << std::endl <<
+ L"Artist: " << tag->artist().toWString() << std::endl <<
+ L"Album: " << tag->album().toWString() << std::endl <<
+ L"Comment: " << tag->comment().toWString() << std::endl <<
+ L"Genre: " << tag->genre().toWString() << std::endl;
+ if(tag->year())
+ {
+ std::wcout << L"Year: ";
+ std::locale new_locale=std::wcout.imbue(original_wcout_locale);
+ std::wcout << tag->year();
+ std::wcout.imbue(new_locale);
+ std::wcout << std::endl;
+ }
+ if(tag->track())
+ {
+ std::wcout << L"Track: ";
+ std::locale new_locale=std::wcout.imbue(original_wcout_locale);
+ std::wcout << tag->track();
+ std::wcout.imbue(new_locale);
+ std::wcout << std::endl;
+ }
+
+ return false;
+}
+
+bool set(std::string const& file)
+{
+ using namespace TagLib;
+
+ FileRef file_ref(file.c_str());
+ Tag* tag;
+ if(file_ref.isNull() || !(tag=file_ref.tag()))
+ {
+ std::wcerr << L"ERROR: Failed opening file." << std::endl;
+ return true;
+ }
+
+ for(;;)
+ {
+ if(!std::wcin)
+ {
+ std::wcerr << L"ERROR: invalid input data." << std::endl;
+ return true;
+ }
+
+ std::wstring tag_to_set;
+ getline(std::wcin, tag_to_set);
+ if(tag_to_set == L"")
+ {
+ break;
+ }
+
+ std::wstring value;
+ getline(std::wcin, value);
+
+ std::wcout << L"Setting " << tag_to_set <<
+ L" to " << value << std::endl;
+
+ if(tag_to_set == L"Title")
+ {
+ tag->setTitle(value);
+ }
+ else if(tag_to_set == L"Artist")
+ {
+ tag->setArtist(value);
+ }
+ else if(tag_to_set == L"Album")
+ {
+ tag->setAlbum(value);
+ }
+ else if(tag_to_set == L"Comment")
+ {
+ tag->setComment(value);
+ }
+ else if(tag_to_set == L"Genre")
+ {
+ tag->setGenre(value);
+ }
+ else if(tag_to_set == L"Year")
+ {
+ unsigned int ival;
+ if(value == L"")
+ {
+ ival=0;
+ }
+ else
+ {
+ std::wistringstream val(value);
+ val >> ival;
+ }
+ tag->setYear(ival);
+ }
+ else if(tag_to_set == L"Track")
+ {
+ unsigned int ival;
+ if(value == L"")
+ {
+ ival=0;
+ }
+ else
+ {
+ std::wistringstream val(value);
+ val >> ival;
+ }
+ tag->setTrack(ival);
+ }
+ else
+ {
+ std::wcerr << L"Unknown tag " << tag_to_set << std::endl;
+ return true;
+ }
+ }
+
+ if(!file_ref.save())
+ {
+ std::wcerr << L"Failed saving file." << std::endl;
+ return true;
+ }
+
+ return false;
+}
+
+int main(int const argc, char**const argv)
+{
+ std::locale loc("");
+ original_wcout_locale=std::wcout.imbue(loc);
+ std::wcin.imbue(loc);
+ std::locale::global(loc);
+
+ std::string action;
+ if(argc >= 2)
+ {
+ action=argv[1];
+ }
+
+ if(action == "--version")
+ {
+ std::wcout << version << std::endl;
+ return 0;
+ }
+ else if(action == "--genres")
+ {
+ using namespace TagLib;
+ StringList genres=ID3v1::genreList();
+ for(StringList::ConstIterator genre=genres.begin();
+ genre!=genres.end();
+ ++genre)
+ {
+ std::wcout << genre->toWString() << std::endl;
+ }
+ return 0;
+ }
+ else if(action == "--get" && argc == 3)
+ {
+ return get(argv[2]) ? 1 : 0;
+ }
+ else if(action == "--set" && argc == 3)
+ {
+ return set(argv[2]) ? 1 : 0;
+ }
+ else
+ {
+ std::wcerr <<
+ L"Usage: ampc_tagger [--version|--genres|--set file|--get file]" <<
+ std::endl;
+ return 1;
+ }
+}
+
+// Local Variables:
+// fill-column: 80
+// indent-tabs-mode: nil
+// End:
diff --git a/packages/arbitools/arbitools.el b/packages/arbitools/arbitools.el
new file mode 100644
index 0000000..6c30404
--- /dev/null
+++ b/packages/arbitools/arbitools.el
@@ -0,0 +1,217 @@
+;;; arbitools.el --- Package for chess tournaments administration
+
+;; Copyright 2016 Free Software Foundation, Inc.
+
+;; Author: David Gonzalez Gandara <address@hidden>
+;; Version: 0.51
+
+;; 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:
+
+;; REQUIRES:
+;; ---------------------------
+;;
+;;
+;; USAGE:
+;; ---------------------------
+;; arbitools.el is an interface for the pythong package "arbitools",
+;; designed to manage chess tournament reports. If you don't install the
+;; python package you can still have the syntax colouring.
+;;
+;; FEATURES:
+;; ----------------------------
+;; - Syntax colouring for the official trf FIDE files. This facilitates
+;; manual edition of the files.
+;;
+;; - Updating the players ratings. By means of the function arbitools-update
+;;
+;; - Adding players to an existing file. By arbitools-add
+;;
+;; - Getting standings and report files from a tournament file. By
+;; arbitools-standings.
+;;
+;; You will find more information in www.ourenxadrez.org/arbitools.htm
+
+;;; Code:
+
+(defun arbitools-update (elolist)
+ "Update the players ratings."
+ (interactive "selolist:")
+ ;; FIXME: What if `list' is "foo; bar"?
+ (call-process "arbitools-run.py" nil nil nil "update" buffer-file-name "-l"
elolist))
+
+(defun arbitools-add (addfile)
+ "Add players to an existing file."
+ (interactive "faddfile: ")
+ ;; FIXME: What if `addlist' is "foo; bar"?
+ (call-process "arbitools-add.py" nil nil nil "-a" addfile "-i"
buffer-file-name))
+
+(defun arbitools-standings ()
+ "Get standings and report files from a tournament file."
+ (interactive)
+ ;; (shell-command (concat (expand-file-name "arbitools-standings.py") " -i "
buffer-file-name))) ;this is to use the actual path
+ (call-process "arbitools-standings.py" nil nil nil "-i" buffer-file-name))
+
+(defun arbitools-delete-round (round)
+ "Delete round"
+ (interactive "sround: ")
+ (beginning-of-buffer)
+ (while (re-search-forward "^001" nil t)
+ (forward-char (+ 88 (* (- (string-to-number round) 1) 10)))
+ (delete-char 10)
+ (insert " "))
+ (beginning-of-buffer))
+
+(defun arbitools-insert-result (round white black result)
+ "Insert a result"
+ (interactive "sround: \nswhite: \nsblack: \nsresult: ")
+ (beginning-of-buffer)
+ (while (re-search-forward "^001" nil t)
+ (forward-char 4) ;; rank number
+ ;; (print (format "%s" white))
+ (when (string= white (thing-at-point 'word))
+ ;;go to first round taking into account the cursor is in the rank number
+ (forward-char (+ 85 (* (- (string-to-number round) 1) 10)))
+ (insert " ") ;; replace the first positions with spaces
+ (delete-char 2) ;; delete the former characters
+ ;; make room for bigger numbers
+ (cond ((= 2 (length black))
+ (backward-char 1))
+ ((= 3 (length black))
+ (backward-char 2)))
+ (insert (format "%s w %s" black result))
+ (delete-char 5)
+ ;; adjust when numbers are longer
+ (cond ((= 2 (length black)) (delete-char 1))
+ ((= 3 (length black)) (delete-char 2))))
+ (when (string= black (thing-at-point 'word))
+ ;;go to first round taking into account the cursor is in the rank number
+ (forward-char (+ 85 (* (- (string-to-number round) 1) 10)))
+ (insert " ") ;; replace the first positions with spaces
+ (delete-char 2) ;; delete the former characters
+ ;; make room for bigger numbers
+ (cond ((= 2 (length white)) (backward-char 1))
+ ((= 3 (length white)) (backward-char 2)))
+ (cond ((string= "1" result) (insert (format "%s b 0" white)))
+ ((string= "0" result) (insert (format "%s b 1" white))))
+ (delete-char 5)
+ ;; adjust when numbers are longer
+ (cond ((= 2 (length white)) (delete-char 1))
+ ((= 3 (length white)) (delete-char 2)))))
+ (beginning-of-buffer))
+
+(defun arbitools-it3 ()
+ "Get the IT3 tournament report."
+ (interactive)
+ (call-process "arbitools-run.py" nil nil nil "it3" buffer-file-name))
+
+(defun arbitools-fedarating ()
+ "Get the FEDA rating admin file."
+ (interactive)
+ (call-process "arbitools-run.py" nil nil nil "fedarating" buffer-file-name))
+
+(defvar arbitools-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "C-c i") 'arbitools-it3)
+ map)
+ "Keymap for Arbitools major mode.")
+
+
+(easy-menu-define arbitools-mode-menu arbitools-mode-map
+ "Menu for Arbitools mode"
+ '("Arbitools"
+ ["Insert Result" arbitools-insert-result]
+ ["Delete Round" arbitools-delete-round]
+ "---"
+ ["Get It3 form Report" arbitools-it3]
+ ["Get FEDA Ratinf file" arbitools-fedarating]
+ ))
+
+
+(defvar arbitools-highlights
+ '(("^001" . font-lock-function-name-face) ; name of the tournament
+ ("^012.*" . font-lock-comment-face)
+
("\\(^022\\|^032\\|^042\\|^052\\|^062\\|^072\\|^082\\|^092\\|^102\\|^112\\|^122\\).*"
. font-lock-constant-face)
+ ("^132.*" . font-lock-warning-face) ;dates
+ ("^013" . font-lock-warning-face) ;teams
+ ("\\(^013.\\{1\\}\\)\\(.\\{31\\}\\)" 2 font-lock-comment-face) ;; teams
+ ;; (" [0-9]\\{6,\\} " . font-lock-variable-name-face) ;FIDE ID
+ ("\\(^001.\\{11\\}\\)\\(.\\{32\\}\\)" 2 font-lock-string-face) ;; Name of
the player (by position)
+ ("\\(^001.\\{55\\}\\)\\(.\\{10\\}\\)" 2 font-lock-function-name-face) ;;
FIDE ID
+ ("\\(^001.\\{88\\}\\)\\(.\\{4\\}\\)" 2 font-lock-comment-face) ;; round 1
opponent
+ ;; ("\\(^132.\\{88\\}\\)\\(.\\{8\\}\\)" 2 font-lock-string-face) ;; round
1 date line
+ ("\\(^001.\\{93\\}\\)\\(.\\{1\\}\\)" 2 font-lock-string-face) ;; round 1
colour
+ ("\\(^001.\\{95\\}\\)\\(.\\{1\\}\\)" 2 font-lock-function-name-face) ;;
round 1 result
+ ;; rest of rounds
+ ("\\(^001.\\{98\\}\\)\\(.\\{4\\}\\)" 2 font-lock-comment-face)
+ ;; ("\\(^132.\\{98\\}\\)\\(.\\{8\\}\\)" 2 font-lock-string-face)
+ ("\\(^001.\\{103\\}\\)\\(.\\{1\\}\\)" 2 font-lock-string-face)
+ ("\\(^001.\\{105\\}\\)\\(.\\{1\\}\\)" 2 font-lock-function-name-face)
+ ("\\(^001.\\{108\\}\\)\\(.\\{4\\}\\)" 2 font-lock-comment-face)
+ ;; ("\\(^132.\\{108\\}\\)\\(.\\{8\\}\\)" 2 font-lock-string-face)
+ ("\\(^001.\\{113\\}\\)\\(.\\{1\\}\\)" 2 font-lock-string-face)
+ ("\\(^001.\\{115\\}\\)\\(.\\{1\\}\\)" 2 font-lock-function-name-face)
+ ("\\(^001.\\{118\\}\\)\\(.\\{4\\}\\)" 2 font-lock-comment-face)
+ ;; ("\\(^132.\\{118\\}\\)\\(.\\{8\\}\\)" 2 font-lock-string-face)
+ ("\\(^001.\\{123\\}\\)\\(.\\{1\\}\\)" 2 font-lock-string-face)
+ ("\\(^001.\\{125\\}\\)\\(.\\{1\\}\\)" 2 font-lock-function-name-face)
+ ("\\(^001.\\{128\\}\\)\\(.\\{4\\}\\)" 2 font-lock-comment-face)
+ ;; ("\\(^132.\\{128\\}\\)\\(.\\{8\\}\\)" 2 font-lock-string-face)
+ ("\\(^001.\\{133\\}\\)\\(.\\{1\\}\\)" 2 font-lock-string-face)
+ ("\\(^001.\\{135\\}\\)\\(.\\{1\\}\\)" 2 font-lock-function-name-face)
+ ("\\(^001.\\{138\\}\\)\\(.\\{4\\}\\)" 2 font-lock-comment-face)
+ ;; ("\\(^132.\\{138\\}\\)\\(.\\{8\\}\\)" 2 font-lock-string-face)
+ ("\\(^001.\\{143\\}\\)\\(.\\{1\\}\\)" 2 font-lock-string-face)
+ ("\\(^001.\\{145\\}\\)\\(.\\{1\\}\\)" 2 font-lock-function-name-face)
+ ("\\(^001.\\{148\\}\\)\\(.\\{4\\}\\)" 2 font-lock-comment-face)
+ ;; ("\\(^132.\\{148\\}\\)\\(.\\{8\\}\\)" 2 font-lock-string-face)
+ ("\\(^001.\\{153\\}\\)\\(.\\{1\\}\\)" 2 font-lock-string-face)
+ ("\\(^001.\\{155\\}\\)\\(.\\{1\\}\\)" 2 font-lock-function-name-face)
+ ("\\(^001.\\{158\\}\\)\\(.\\{4\\}\\)" 2 font-lock-comment-face)
+ ;; ("\\(^132.\\{158\\}\\)\\(.\\{8\\}\\)" 2 font-lock-string-face)
+ ("\\(^001.\\{163\\}\\)\\(.\\{1\\}\\)" 2 font-lock-string-face)
+ ("\\(^001.\\{165\\}\\)\\(.\\{1\\}\\)" 2 font-lock-function-name-face)
+ ("\\(^001.\\{168\\}\\)\\(.\\{4\\}\\)" 2 font-lock-comment-face)
+ ;; ("\\(^132.\\{168\\}\\)\\(.\\{8\\}\\)" 2 font-lock-string-face)
+ ("\\(^001.\\{173\\}\\)\\(.\\{1\\}\\)" 2 font-lock-string-face)
+ ("\\(^001.\\{175\\}\\)\\(.\\{1\\}\\)" 2 font-lock-function-name-face)
+ ("\\(^001.\\{178\\}\\)\\(.\\{4\\}\\)" 2 font-lock-comment-face)
+ ;; ("\\(^132.\\{178\\}\\)\\(.\\{8\\}\\)" 2 font-lock-string-face)
+ ("\\(^001.\\{183\\}\\)\\(.\\{1\\}\\)" 2 font-lock-string-face)
+ ("\\(^001.\\{185\\}\\)\\(.\\{1\\}\\)" 2 font-lock-function-name-face)
+ ("\\(^001.\\{188\\}\\)\\(.\\{4\\}\\)" 2 font-lock-comment-face)
+ ;; ("\\(^132.\\{188\\}\\)\\(.\\{8\\}\\)" 2 font-lock-string-face)
+ ("\\(^001.\\{193\\}\\)\\(.\\{1\\}\\)" 2 font-lock-string-face)
+ ("\\(^001.\\{195\\}\\)\\(.\\{1\\}\\)" 2 font-lock-function-name-face)
+ ("\\(^001.\\{198\\}\\)\\(.\\{4\\}\\)" 2 font-lock-comment-face)
+ ;; ("\\(^132.\\{198\\}\\)\\(.\\{8\\}\\)" 2 font-lock-string-face)
+ ("\\(^001.\\{203\\}\\)\\(.\\{1\\}\\)" 2 font-lock-string-face)
+ ("\\(^001.\\{205\\}\\)\\(.\\{1\\}\\)" 2 font-lock-function-name-face)))
+
+;;;###autoload
+(define-derived-mode arbitools-mode
+ fundamental-mode
+ "Arbitools"
+ "Major mode for Chess Tournament Management."
+ ;(setq font-lock-defaults '(arbitools-highlights))
+ (use-local-map arbitools-mode-map)
+ (set (make-local-variable 'font-lock-defaults) '(arbitools-highlights)))
+
+;;;###autoload
+(add-to-list 'auto-mode-alist '("\\.trf?\\'" . arbitools-mode))
+
+(provide 'arbitools)
+
+;;; arbitools.el ends here
diff --git a/packages/async/README.md b/packages/async/README.md
new file mode 100644
index 0000000..a5b0866
--- /dev/null
+++ b/packages/async/README.md
@@ -0,0 +1,145 @@
+<p><a href="http://www.gnu.org/licenses/gpl-3.0.txt";><img
src="https://img.shields.io/badge/license-GPL_3-green.svg"; alt="License GPL 3"
/></a>
+<a href="http://melpa.org/#/async";><img
src="http://melpa.org/packages/async-badge.svg"; alt="MELPA" title="" /></a>
+<a href="http://stable.melpa.org/#/async";><img
src="http://stable.melpa.org/packages/async-badge.svg"; alt="MELPA Stable"
title="" /></a></p>
+
+
+# emacs-async
+
+`async.el` is a module for doing asynchronous processing in Emacs.
+
+# Install
+
+## Install dired-async
+
+Add to your `.emacs.el`:
+
+ (autoload 'dired-async-mode "dired-async.el" nil t)
+ (dired-async-mode 1)
+
+This will allow you to run asynchronously
+the dired commands for copying, renaming and symlinking.
+If you are a [helm](https://github.com/emacs-helm/helm) user, this will allow
you
+to copy, rename etc... asynchronously from
[helm](https://github.com/emacs-helm/helm).
+Note that with [helm](https://github.com/emacs-helm/helm)
+you can disable this by running the copy, rename etc... commands with a prefix
argument.
+
+If you don't want to make dired/helm asynchronous disable it with
`dired-async-mode`.
+
+## Enable asynchronous compilation of your (M)elpa packages
+
+By default emacs package.el compile packages in its running emacs session.
+This is not a problem when installing a new package (which is not actually
loaded in current emacs)
+but it may create errors and bad compilation when upgrading a package (old
version of package is already loaded
+and running in current emacs).
+You can remedy to this by allowing async to compile your packages
asynchronously,
+(helm and magit actually do this by default,
+so if you are using these packages they will compile asynchronously)
+to do this, add to your init file:
+
+ (async-bytecomp-package-mode 1)
+
+
+You can control which packages will compile async with
`async-bytecomp-allowed-packages`.
+Set it to `'(all)` to be sure you will compile all packages asynchronously.
+
+# Usage
+
+The interface is intended to be very easy to use:
+
+## async-start
+
+ async-start START-FUNC FINISH-FUNC
+
+Execute START-FUNC (often a lambda) in a subordinate Emacs process. When
+done, the return value is passed to FINISH-FUNC. Example:
+
+ (async-start
+ ;; What to do in the child process
+ (lambda ()
+ (message "This is a test")
+ (sleep-for 3)
+ 222)
+
+ ;; What to do when it finishes
+ (lambda (result)
+ (message "Async process done, result should be 222: %s" result)))
+
+If FINISH-FUNC is `nil` or missing, a future is returned that can be inspected
+using `async-get`, blocking until the value is ready. Example:
+
+ (let ((proc (async-start
+ ;; What to do in the child process
+ (lambda ()
+ (message "This is a test")
+ (sleep-for 3)
+ 222))))
+
+ (message "I'm going to do some work here") ;; ....
+
+ (message "Waiting on async process, result should be 222: %s"
+ (async-get proc)))
+
+If you don't want to use a callback, and you don't care about any return value
+from the child process, pass the `'ignore` symbol as the second argument (if
+you don't, and never call `async-get`, it will leave ``*emacs*`` process
buffers
+hanging around):
+
+ (async-start
+ (lambda ()
+ (delete-file "a remote file on a slow link" nil))
+ 'ignore)
+
+Note: Even when FINISH-FUNC is present, a future is still returned except that
+it yields no value (since the value is passed to FINISH-FUNC). Calling
+`async-get` on such a future always returns `nil`. It can still be useful,
+however, as an argument to `async-ready` or `async-wait`.
+
+## async-start-process
+
+ async-start-process NAME PROGRAM FINISH-FUNC &rest PROGRAM-ARGS
+
+Start the executable PROGRAM asynchronously. See `async-start`. PROGRAM is
+passed PROGRAM-ARGS, calling FINISH-FUNC with the process object when done.
+If FINISH-FUNC is `nil`, the future object will return the process object when
+the program is finished. Set DEFAULT-DIRECTORY to change PROGRAM's current
+working directory.
+
+## async-get
+
+ async-get FUTURE
+
+Get the value from an asynchronously called function when it is ready. FUTURE
is
+returned by `async-start` or `async-start-process` when its FINISH-FUNC is
+`nil`.
+
+## async-ready
+
+ async-ready FUTURE
+
+Query a FUTURE to see if its function's value is ready -- i.e., if no blocking
+would result from a call to `async-get` on that FUTURE.
+
+## async-wait
+
+ async-wait FUTURE
+
+Wait for FUTURE to become ready.
+
+## async-inject-variables
+
+ async-inject-variables INCLUDE-REGEXP &optional PREDICATE EXCLUDE-REGEXP
+
+Return a `setq` form that replicates part of the calling environment. It sets
+the value for every variable matching INCLUDE-REGEXP and also PREDICATE. It
+will not perform injection for any variable matching EXCLUDE-REGEXP (if
+present). It is intended to be used as follows:
+
+ (async-start
+ `(lambda ()
+ (require 'smtpmail)
+ (with-temp-buffer
+ (insert ,(buffer-substring-no-properties (point-min) (point-max)))
+ ;; Pass in the variable environment for smtpmail
+ ,(async-inject-variables "\\`\\(smtpmail\\|\\(user-\\)?mail\\)-")
+ (smtpmail-send-it)))
+ 'ignore)
diff --git a/packages/async/async-bytecomp.el b/packages/async/async-bytecomp.el
new file mode 100644
index 0000000..54313c0
--- /dev/null
+++ b/packages/async/async-bytecomp.el
@@ -0,0 +1,177 @@
+;;; async-bytecomp.el --- Async functions to compile elisp files async
+
+;; Copyright (C) 2014-2016 Free Software Foundation, Inc.
+
+;; Authors: John Wiegley <address@hidden>
+;; Thierry Volpiatto <address@hidden>
+
+;; Keywords: dired async byte-compile
+;; X-URL: https://github.com/jwiegley/dired-async
+
+;; 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 GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+;;
+;; This package provide the `async-byte-recompile-directory' function
+;; which allows, as the name says to recompile a directory outside of
+;; your running emacs.
+;; The benefit is your files will be compiled in a clean environment without
+;; the old *.el files loaded.
+;; Among other things, this fix a bug in package.el which recompile
+;; the new files in the current environment with the old files loaded,
creating
+;; errors in most packages after upgrades.
+;;
+;; NB: This package is advicing the function `package--compile'.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'async)
+
+(defcustom async-bytecomp-allowed-packages
+ '(async helm helm-core helm-ls-git helm-ls-hg magit)
+ "Packages in this list will be compiled asynchronously by `package--compile'.
+All the dependencies of these packages will be compiled async too,
+so no need to add dependencies to this list.
+The value of this variable can also be a list with a single element,
+the symbol `all', in this case packages are always compiled asynchronously."
+ :group 'async
+ :type '(repeat (choice symbol)))
+
+(defvar async-byte-compile-log-file "~/.emacs.d/async-bytecomp.log")
+
+;;;###autoload
+(defun async-byte-recompile-directory (directory &optional quiet)
+ "Compile all *.el files in DIRECTORY asynchronously.
+All *.elc files are systematically deleted before proceeding."
+ (cl-loop with dir = (directory-files directory t "\\.elc\\'")
+ unless dir return nil
+ for f in dir
+ when (file-exists-p f) do (delete-file f))
+ ;; Ensure async is reloaded when async.elc is deleted.
+ ;; This happen when recompiling its own directory.
+ (load "async")
+ (let ((call-back
+ `(lambda (&optional ignore)
+ (if (file-exists-p async-byte-compile-log-file)
+ (let ((buf (get-buffer-create byte-compile-log-buffer))
+ (n 0))
+ (with-current-buffer buf
+ (goto-char (point-max))
+ (let ((inhibit-read-only t))
+ (insert-file-contents async-byte-compile-log-file)
+ (compilation-mode))
+ (display-buffer buf)
+ (delete-file async-byte-compile-log-file)
+ (unless ,quiet
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward "^.*:Error:" nil t)
+ (cl-incf n)))
+ (if (> n 0)
+ (message "Failed to compile %d files in directory
`%s'" n ,directory)
+ (message "Directory `%s' compiled asynchronously
with warnings" ,directory)))))
+ (unless ,quiet
+ (message "Directory `%s' compiled asynchronously with
success" ,directory))))))
+ (async-start
+ `(lambda ()
+ (require 'bytecomp)
+ ,(async-inject-variables "\\`\\(load-path\\)\\|byte\\'")
+ (let ((default-directory (file-name-as-directory ,directory))
+ error-data)
+ (add-to-list 'load-path default-directory)
+ (byte-recompile-directory ,directory 0 t)
+ (when (get-buffer byte-compile-log-buffer)
+ (setq error-data (with-current-buffer byte-compile-log-buffer
+ (buffer-substring-no-properties (point-min)
(point-max))))
+ (unless (string= error-data "")
+ (with-temp-file ,async-byte-compile-log-file
+ (erase-buffer)
+ (insert error-data))))))
+ call-back)
+ (unless quiet (message "Started compiling asynchronously directory %s"
directory))))
+
+(defvar package-archive-contents)
+(defvar package-alist)
+(declare-function package-desc-reqs "package.el" (cl-x))
+
+(defun async-bytecomp--get-package-deps (pkg &optional only)
+ ;; Same as `package--get-deps' but parse instead `package-archive-contents'
+ ;; because PKG is not already installed and not present in `package-alist'.
+ ;; However fallback to `package-alist' in case PKG no more present
+ ;; in `package-archive-contents' due to modification to `package-archives'.
+ ;; See issue #58.
+ (let* ((pkg-desc (cadr (or (assq pkg package-archive-contents)
+ (assq pkg package-alist))))
+ (direct-deps (cl-loop for p in (package-desc-reqs pkg-desc)
+ for name = (car p)
+ when (or (assq name package-archive-contents)
+ (assq name package-alist))
+ collect name))
+ (indirect-deps (unless (eq only 'direct)
+ (delete-dups
+ (cl-loop for p in direct-deps append
+ (async-bytecomp--get-package-deps p))))))
+ (cl-case only
+ (direct direct-deps)
+ (separate (list direct-deps indirect-deps))
+ (indirect indirect-deps)
+ (t (delete-dups (append direct-deps indirect-deps))))))
+
+(defun async-bytecomp-get-allowed-pkgs ()
+ (when (and async-bytecomp-allowed-packages
+ (listp async-bytecomp-allowed-packages))
+ (if package-archive-contents
+ (cl-loop for p in async-bytecomp-allowed-packages
+ when (assq p package-archive-contents)
+ append (async-bytecomp--get-package-deps p) into reqs
+ finally return
+ (delete-dups
+ (append async-bytecomp-allowed-packages reqs)))
+ async-bytecomp-allowed-packages)))
+
+(defadvice package--compile (around byte-compile-async)
+ (let ((cur-package (package-desc-name pkg-desc))
+ (pkg-dir (package-desc-dir pkg-desc)))
+ (if (or (equal async-bytecomp-allowed-packages '(all))
+ (memq cur-package (async-bytecomp-get-allowed-pkgs)))
+ (progn
+ (when (eq cur-package 'async)
+ (fmakunbound 'async-byte-recompile-directory))
+ ;; Add to `load-path' the latest version of async and
+ ;; reload it when reinstalling async.
+ (when (string= cur-package "async")
+ (cl-pushnew pkg-dir load-path)
+ (load "async-bytecomp"))
+ ;; `async-byte-recompile-directory' will add directory
+ ;; as needed to `load-path'.
+ (async-byte-recompile-directory (package-desc-dir pkg-desc) t))
+ ad-do-it)))
+
+;;;###autoload
+(define-minor-mode async-bytecomp-package-mode
+ "Byte compile asynchronously packages installed with package.el.
+Async compilation of packages can be controlled by
+`async-bytecomp-allowed-packages'."
+ :group 'async
+ :global t
+ (if async-bytecomp-package-mode
+ (ad-activate 'package--compile)
+ (ad-deactivate 'package--compile)))
+
+(provide 'async-bytecomp)
+
+;;; async-bytecomp.el ends here
diff --git a/packages/async/async-test.el b/packages/async/async-test.el
new file mode 100644
index 0000000..76d6a3a
--- /dev/null
+++ b/packages/async/async-test.el
@@ -0,0 +1,140 @@
+;;; async-test.el --- async.el-related tests
+
+;; Copyright (C) 2012-2016 Free Software Foundation, Inc.
+
+;; Author: John Wiegley <address@hidden>
+;; Created: 10 Jul 2012
+;; Version: 1.0
+;; Keywords: async
+;; X-URL: https://github.com/jwiegley/emacs-async
+
+;; 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 GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Contains tests for all the async modules.
+
+;;; Code:
+
+(require 'async)
+
+
+(eval-when-compile
+ (require 'cl))
+
+(defun async-test-1 ()
+ (interactive)
+ (message "Starting async-test-1...")
+ (async-start
+ ;; What to do in the child process
+ (lambda ()
+ (message "This is a test")
+ (sleep-for 3)
+ 222)
+
+ ;; What to do when it finishes
+ (lambda (result)
+ (message "Async process done, result should be 222: %s" result)))
+ (message "Starting async-test-1...done"))
+
+(defun async-test-2 ()
+ (interactive)
+ (message "Starting async-test-2...")
+ (let ((proc (async-start
+ ;; What to do in the child process
+ (lambda ()
+ (message "This is a test")
+ (sleep-for 3)
+ 222))))
+ (message "I'm going to do some work here")
+ ;; ....
+ (message "Async process done, result should be 222: %s"
+ (async-get proc))))
+
+(defun async-test-3 ()
+ (interactive)
+ (message "Starting async-test-3...")
+ (async-start
+ ;; What to do in the child process
+ (lambda ()
+ (message "This is a test")
+ (sleep-for 3)
+ (error "Error in child process")
+ 222)
+
+ ;; What to do when it finishes
+ (lambda (result)
+ (message "Async process done, result should be 222: %s" result)))
+ (message "Starting async-test-1...done"))
+
+(defun async-test-4 ()
+ (interactive)
+ (message "Starting async-test-4...")
+ (async-start-process "sleep" "sleep"
+ ;; What to do when it finishes
+ (lambda (proc)
+ (message "Sleep done, exit code was %d"
+ (process-exit-status proc)))
+ "3")
+ (message "Starting async-test-4...done"))
+
+(defun async-test-5 ()
+ (interactive)
+ (message "Starting async-test-5...")
+ (let ((proc
+ (async-start
+ ;; What to do in the child process
+ (lambda ()
+ (message "This is a test, sending message")
+ (async-send :hello "world")
+ ;; wait for a message
+ (let ((msg (async-receive)))
+ (message "Child got message: %s"
+ (plist-get msg :goodbye)))
+ (sleep-for 3)
+ 222)
+
+ ;; What to do when it finishes
+ (lambda (result)
+ (if (async-message-p result)
+ (message "Got hello from child process: %s"
+ (plist-get result :hello))
+ (message "Async process done, result should be 222: %s"
+ result))))))
+ (async-send proc :goodbye "everyone"))
+ (message "Starting async-test-5...done"))
+
+(defun async-test-6 ()
+ (interactive)
+ (message "Starting async-test-6...")
+ (async-start
+ ;; What to do in the child process
+ `(lambda ()
+ ,(async-inject-variables "\\`user-mail-address\\'")
+ (format "user-mail-address = %s" user-mail-address))
+
+ ;; What to do when it finishes
+ (lambda (result)
+ (message "Async process done: %s" result))))
+
+
+(provide 'async-test)
+
+;;; async-test.el ends here
+
+;; Local Variables:
+;; no-byte-compile: t
+;; End:
diff --git a/packages/async/async.el b/packages/async/async.el
new file mode 100644
index 0000000..24db2a1
--- /dev/null
+++ b/packages/async/async.el
@@ -0,0 +1,303 @@
+;;; async.el --- Asynchronous processing in Emacs
+
+;; Copyright (C) 2012-2016 Free Software Foundation, Inc.
+
+;; Author: John Wiegley <address@hidden>
+;; Created: 18 Jun 2012
+;; Version: 1.6
+
+;; Keywords: async
+;; X-URL: https://github.com/jwiegley/emacs-async
+
+;; 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 GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Adds the ability to call asynchronous functions and process with ease. See
+;; the documentation for `async-start' and `async-start-process'.
+
+;;; Code:
+
+(defgroup async nil
+ "Simple asynchronous processing in Emacs"
+ :group 'emacs)
+
+(defvar async-debug nil)
+(defvar async-send-over-pipe t)
+(defvar async-in-child-emacs nil)
+(defvar async-callback nil)
+(defvar async-callback-for-process nil)
+(defvar async-callback-value nil)
+(defvar async-callback-value-set nil)
+(defvar async-current-process nil)
+(defvar async--procvar nil)
+
+(defun async-inject-variables
+ (include-regexp &optional predicate exclude-regexp)
+ "Return a `setq' form that replicates part of the calling environment.
+It sets the value for every variable matching INCLUDE-REGEXP and
+also PREDICATE. It will not perform injection for any variable
+matching EXCLUDE-REGEXP (if present). It is intended to be used
+as follows:
+
+ (async-start
+ `(lambda ()
+ (require 'smtpmail)
+ (with-temp-buffer
+ (insert ,(buffer-substring-no-properties (point-min) (point-max)))
+ ;; Pass in the variable environment for smtpmail
+ ,(async-inject-variables \"\\`\\(smtpmail\\|\\(user-\\)?mail\\)-\")
+ (smtpmail-send-it)))
+ 'ignore)"
+ `(setq
+ ,@(let (bindings)
+ (mapatoms
+ (lambda (sym)
+ (if (and (boundp sym)
+ (or (null include-regexp)
+ (string-match include-regexp (symbol-name sym)))
+ (not (string-match
+ (or exclude-regexp "-syntax-table\\'")
+ (symbol-name sym))))
+ (let ((value (symbol-value sym)))
+ (when (or (null predicate)
+ (funcall predicate sym))
+ (setq bindings (cons `(quote ,value) bindings)
+ bindings (cons sym bindings)))))))
+ bindings)))
+
+(defalias 'async-inject-environment 'async-inject-variables)
+
+(defun async-handle-result (func result buf)
+ (if (null func)
+ (progn
+ (set (make-local-variable 'async-callback-value) result)
+ (set (make-local-variable 'async-callback-value-set) t))
+ (unwind-protect
+ (if (and (listp result)
+ (eq 'async-signal (nth 0 result)))
+ (signal (car (nth 1 result))
+ (cdr (nth 1 result)))
+ (funcall func result))
+ (unless async-debug
+ (kill-buffer buf)))))
+
+(defun async-when-done (proc &optional change)
+ "Process sentinal used to retrieve the value from the child process."
+ (when (eq 'exit (process-status proc))
+ (with-current-buffer (process-buffer proc)
+ (let ((async-current-process proc))
+ (if (= 0 (process-exit-status proc))
+ (if async-callback-for-process
+ (if async-callback
+ (prog1
+ (funcall async-callback proc)
+ (unless async-debug
+ (kill-buffer (current-buffer))))
+ (set (make-local-variable 'async-callback-value) proc)
+ (set (make-local-variable 'async-callback-value-set) t))
+ (goto-char (point-max))
+ (backward-sexp)
+ (async-handle-result async-callback (read (current-buffer))
+ (current-buffer)))
+ (set (make-local-variable 'async-callback-value)
+ (list 'error
+ (format "Async process '%s' failed with exit code %d"
+ (process-name proc) (process-exit-status proc))))
+ (set (make-local-variable 'async-callback-value-set) t))))))
+
+(defun async--receive-sexp (&optional stream)
+ (let ((sexp (decode-coding-string (base64-decode-string
+ (read stream)) 'utf-8-unix))
+ ;; Parent expects UTF-8 encoded text.
+ (coding-system-for-write 'utf-8-unix))
+ (if async-debug
+ (message "Received sexp {{{%s}}}" (pp-to-string sexp)))
+ (setq sexp (read sexp))
+ (if async-debug
+ (message "Read sexp {{{%s}}}" (pp-to-string sexp)))
+ (eval sexp)))
+
+(defun async--insert-sexp (sexp)
+ (let (print-level
+ print-length
+ (print-escape-nonascii t)
+ (print-circle t))
+ (prin1 sexp (current-buffer))
+ ;; Just in case the string we're sending might contain EOF
+ (encode-coding-region (point-min) (point-max) 'utf-8-unix)
+ (base64-encode-region (point-min) (point-max) t)
+ (goto-char (point-min)) (insert ?\")
+ (goto-char (point-max)) (insert ?\" ?\n)))
+
+(defun async--transmit-sexp (process sexp)
+ (with-temp-buffer
+ (if async-debug
+ (message "Transmitting sexp {{{%s}}}" (pp-to-string sexp)))
+ (async--insert-sexp sexp)
+ (process-send-region process (point-min) (point-max))))
+
+(defun async-batch-invoke ()
+ "Called from the child Emacs process' command-line."
+ ;; Make sure 'message' and 'prin1' encode stuff in UTF-8, as parent
+ ;; process expects.
+ (let ((coding-system-for-write 'utf-8-unix))
+ (setq async-in-child-emacs t
+ debug-on-error async-debug)
+ (if debug-on-error
+ (prin1 (funcall
+ (async--receive-sexp (unless async-send-over-pipe
+ command-line-args-left))))
+ (condition-case err
+ (prin1 (funcall
+ (async--receive-sexp (unless async-send-over-pipe
+ command-line-args-left))))
+ (error
+ (prin1 (list 'async-signal err)))))))
+
+(defun async-ready (future)
+ "Query a FUTURE to see if the ready is ready -- i.e., if no blocking
+would result from a call to `async-get' on that FUTURE."
+ (and (memq (process-status future) '(exit signal))
+ (with-current-buffer (process-buffer future)
+ async-callback-value-set)))
+
+(defun async-wait (future)
+ "Wait for FUTURE to become ready."
+ (while (not (async-ready future))
+ (sit-for 0.05)))
+
+(defun async-get (future)
+ "Get the value from an asynchronously function when it is ready.
+FUTURE is returned by `async-start' or `async-start-process' when
+its FINISH-FUNC is nil."
+ (async-wait future)
+ (with-current-buffer (process-buffer future)
+ (async-handle-result #'identity async-callback-value (current-buffer))))
+
+(defun async-message-p (value)
+ "Return true of VALUE is an async.el message packet."
+ (and (listp value)
+ (plist-get value :async-message)))
+
+(defun async-send (&rest args)
+ "Send the given messages to the asychronous Emacs PROCESS."
+ (let ((args (append args '(:async-message t))))
+ (if async-in-child-emacs
+ (if async-callback
+ (funcall async-callback args))
+ (async--transmit-sexp (car args) (list 'quote (cdr args))))))
+
+(defun async-receive (&rest args)
+ "Send the given messages to the asychronous Emacs PROCESS."
+ (async--receive-sexp))
+
+;;;###autoload
+(defun async-start-process (name program finish-func &rest program-args)
+ "Start the executable PROGRAM asynchronously. See `async-start'.
+PROGRAM is passed PROGRAM-ARGS, calling FINISH-FUNC with the
+process object when done. If FINISH-FUNC is nil, the future
+object will return the process object when the program is
+finished. Set DEFAULT-DIRECTORY to change PROGRAM's current
+working directory."
+ (let* ((buf (generate-new-buffer (concat "*" name "*")))
+ (proc (let ((process-connection-type nil))
+ (apply #'start-process name buf program program-args))))
+ (with-current-buffer buf
+ (set (make-local-variable 'async-callback) finish-func)
+ (set-process-sentinel proc #'async-when-done)
+ (unless (string= name "emacs")
+ (set (make-local-variable 'async-callback-for-process) t))
+ proc)))
+
+;;;###autoload
+(defun async-start (start-func &optional finish-func)
+ "Execute START-FUNC (often a lambda) in a subordinate Emacs process.
+When done, the return value is passed to FINISH-FUNC. Example:
+
+ (async-start
+ ;; What to do in the child process
+ (lambda ()
+ (message \"This is a test\")
+ (sleep-for 3)
+ 222)
+
+ ;; What to do when it finishes
+ (lambda (result)
+ (message \"Async process done, result should be 222: %s\"
+ result)))
+
+If FINISH-FUNC is nil or missing, a future is returned that can
+be inspected using `async-get', blocking until the value is
+ready. Example:
+
+ (let ((proc (async-start
+ ;; What to do in the child process
+ (lambda ()
+ (message \"This is a test\")
+ (sleep-for 3)
+ 222))))
+
+ (message \"I'm going to do some work here\") ;; ....
+
+ (message \"Waiting on async process, result should be 222: %s\"
+ (async-get proc)))
+
+If you don't want to use a callback, and you don't care about any
+return value form the child process, pass the `ignore' symbol as
+the second argument (if you don't, and never call `async-get', it
+will leave *emacs* process buffers hanging around):
+
+ (async-start
+ (lambda ()
+ (delete-file \"a remote file on a slow link\" nil))
+ 'ignore)
+
+Note: Even when FINISH-FUNC is present, a future is still
+returned except that it yields no value (since the value is
+passed to FINISH-FUNC). Call `async-get' on such a future always
+returns nil. It can still be useful, however, as an argument to
+`async-ready' or `async-wait'."
+ (let ((sexp start-func)
+ ;; Subordinate Emacs will send text encoded in UTF-8.
+ (coding-system-for-read 'utf-8-unix))
+ (setq async--procvar
+ (async-start-process
+ "emacs" (file-truename
+ (expand-file-name invocation-name
+ invocation-directory))
+ finish-func
+ "-Q" "-l"
+ ;; Using `locate-library' ensure we use the right file
+ ;; when the .elc have been deleted.
+ (locate-library "async")
+ "-batch" "-f" "async-batch-invoke"
+ (if async-send-over-pipe
+ "<none>"
+ (with-temp-buffer
+ (async--insert-sexp (list 'quote sexp))
+ (buffer-string)))))
+ (if async-send-over-pipe
+ (async--transmit-sexp async--procvar (list 'quote sexp)))
+ async--procvar))
+
+(defmacro async-sandbox(func)
+ "Evaluate FUNC in a separate Emacs process, synchronously."
+ `(async-get (async-start ,func)))
+
+(provide 'async)
+
+;;; async.el ends here
diff --git a/packages/async/dired-async.el b/packages/async/dired-async.el
new file mode 100644
index 0000000..ecab9cb
--- /dev/null
+++ b/packages/async/dired-async.el
@@ -0,0 +1,290 @@
+;;; dired-async.el --- Copy/move/delete asynchronously in dired.
+
+;; Copyright (C) 2012-2016 Free Software Foundation, Inc.
+
+;; Authors: John Wiegley <address@hidden>
+;; Thierry Volpiatto <address@hidden>
+
+;; Keywords: dired async network
+;; X-URL: https://github.com/jwiegley/dired-async
+
+;; 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 GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This file provide a redefinition of `dired-create-file' function,
+;; performs copies, moves and all what is handled by `dired-create-file'
+;; in the background using a slave Emacs process,
+;; by means of the async.el module.
+;; To use it, put this in your .emacs:
+
+;; (dired-async-mode 1)
+
+;; This will enable async copy/rename etc...
+;; in dired and helm.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'dired-aux)
+(require 'async)
+
+(eval-when-compile
+ (defvar async-callback))
+(defvar dired-async-operation nil)
+
+(defgroup dired-async nil
+ "Copy rename files asynchronously from dired."
+ :group 'dired)
+
+(defcustom dired-async-env-variables-regexp
+ "\\`\\(tramp-\\(default\\|connection\\|remote\\)\\|ange-ftp\\)-.*"
+ "Variables matching this regexp will be loaded on Child Emacs."
+ :type 'regexp
+ :group 'dired-async)
+
+(defcustom dired-async-message-function 'dired-async-mode-line-message
+ "Function to use to notify result when operation finish.
+Should take same args as `message'."
+ :group 'dired-async
+ :type 'function)
+
+(defcustom dired-async-log-file "/tmp/dired-async.log"
+ "File use to communicate errors from Child Emacs to host Emacs."
+ :group 'dired-async
+ :type 'string)
+
+(defface dired-async-message
+ '((t (:foreground "yellow")))
+ "Face used for mode-line message."
+ :group 'dired-async)
+
+(defface dired-async-mode-message
+ '((t (:foreground "Gold")))
+ "Face used for `dired-async--modeline-mode' lighter."
+ :group 'dired-async)
+
+(define-minor-mode dired-async--modeline-mode
+ "Notify mode-line that an async process run."
+ :group 'dired-async
+ :global t
+ :lighter (:eval (propertize (format " [%s Async job(s) running]"
+ (length (dired-async-processes)))
+ 'face 'dired-async-mode-message))
+ (unless dired-async--modeline-mode
+ (let ((visible-bell t)) (ding))))
+
+(defun dired-async-mode-line-message (text &rest args)
+ "Notify end of operation in `mode-line'."
+ (message nil)
+ (let ((mode-line-format (concat
+ " " (propertize
+ (if args
+ (apply #'format text args)
+ text)
+ 'face 'dired-async-message))))
+ (force-mode-line-update)
+ (sit-for 3)
+ (force-mode-line-update)))
+
+(defun dired-async-processes ()
+ (cl-loop for p in (process-list)
+ when (cl-loop for c in (process-command p) thereis
+ (string= "async-batch-invoke" c))
+ collect p))
+
+(defun dired-async-kill-process ()
+ (interactive)
+ (let* ((processes (dired-async-processes))
+ (proc (car (last processes))))
+ (delete-process proc)
+ (unless (> (length processes) 1)
+ (dired-async--modeline-mode -1))))
+
+(defun dired-async-after-file-create (len-flist)
+ "Callback function used for operation handled by `dired-create-file'."
+ (unless (dired-async-processes)
+ ;; Turn off mode-line notification
+ ;; only when last process end.
+ (dired-async--modeline-mode -1))
+ (when dired-async-operation
+ (if (file-exists-p dired-async-log-file)
+ (progn
+ (pop-to-buffer (get-buffer-create "*dired async*"))
+ (erase-buffer)
+ (insert "Error: ")
+ (insert-file-contents dired-async-log-file)
+ (delete-file dired-async-log-file))
+ (run-with-timer
+ 0.1 nil
+ dired-async-message-function "Asynchronous %s of %s file(s) on %s
file(s) done"
+ (car dired-async-operation) (cadr dired-async-operation) len-flist))))
+
+(defun dired-async-maybe-kill-ftp ()
+ "Return a form to kill ftp process in child emacs."
+ (quote
+ (progn
+ (require 'cl-lib)
+ (let ((buf (cl-loop for b in (buffer-list)
+ thereis (and (string-match
+ "\\`\\*ftp.*"
+ (buffer-name b)) b))))
+ (when buf (kill-buffer buf))))))
+
+(defun dired-async-create-files (file-creator operation fn-list
name-constructor
+ &optional marker-char)
+ "Same as `dired-create-files' but asynchronous.
+
+See `dired-create-files' for the behavior of arguments."
+ (setq dired-async-operation nil)
+ (let (dired-create-files-failures
+ failures async-fn-list
+ skipped (success-count 0)
+ (total (length fn-list))
+ callback)
+ (let (to overwrite-query
+ overwrite-backup-query) ; for dired-handle-overwrite
+ (dolist (from fn-list)
+ (setq to (funcall name-constructor from))
+ (if (equal to from)
+ (progn
+ (setq to nil)
+ (dired-log "Cannot %s to same file: %s\n"
+ (downcase operation) from)))
+ (if (not to)
+ (setq skipped (cons (dired-make-relative from) skipped))
+ (let* ((overwrite (file-exists-p to))
+ (dired-overwrite-confirmed ; for dired-handle-overwrite
+ (and overwrite
+ (let ((help-form '(format "\
+Type SPC or `y' to overwrite file `%s',
+DEL or `n' to skip to next,
+ESC or `q' to not overwrite any of the remaining files,
+`!' to overwrite all remaining files with no more questions." to)))
+ (dired-query 'overwrite-query
+ "Overwrite `%s'?" to))))
+ ;; must determine if FROM is marked before file-creator
+ ;; gets a chance to delete it (in case of a move).
+ (actual-marker-char
+ (cond ((integerp marker-char) marker-char)
+ (marker-char (dired-file-marker from)) ; slow
+ (t nil))))
+ ;; Handle the `dired-copy-file' file-creator specially
+ ;; When copying a directory to another directory or
+ ;; possibly to itself or one of its subdirectories.
+ ;; e.g "~/foo/" => "~/test/"
+ ;; or "~/foo/" =>"~/foo/"
+ ;; or "~/foo/ => ~/foo/bar/")
+ ;; In this case the 'name-constructor' have set the destination
+ ;; TO to "~/test/foo" because the old emacs23 behavior
+ ;; of `copy-directory' was to not create the subdirectory
+ ;; and instead copy the contents.
+ ;; With the new behavior of `copy-directory'
+ ;; (similar to the `cp' shell command) we don't
+ ;; need such a construction of the target directory,
+ ;; so modify the destination TO to "~/test/" instead of
"~/test/foo/".
+ (let ((destname (file-name-directory to)))
+ (when (and (file-directory-p from)
+ (file-directory-p to)
+ (eq file-creator 'dired-copy-file))
+ (setq to destname))
+ ;; If DESTNAME is a subdirectory of FROM, not a symlink,
+ ;; and the method in use is copying, signal an error.
+ (and (eq t (car (file-attributes destname)))
+ (eq file-creator 'dired-copy-file)
+ (file-in-directory-p destname from)
+ (error "Cannot copy `%s' into its subdirectory `%s'"
+ from to)))
+ (if overwrite
+ (or (and dired-overwrite-confirmed
+ (push (cons from to) async-fn-list))
+ (progn
+ (push (dired-make-relative from) failures)
+ (dired-log "%s `%s' to `%s' failed"
+ operation from to)))
+ (push (cons from to) async-fn-list)))))
+ (setq callback
+ `(lambda (&optional ignore)
+ (dired-async-after-file-create ,total)
+ (when (string= ,(downcase operation) "rename")
+ (cl-loop for (file . to) in ',async-fn-list
+ do (and (get-file-buffer file)
+ (with-current-buffer (get-file-buffer file)
+ (set-visited-file-name to nil t))))))))
+ ;; Handle error happening in host emacs.
+ (cond
+ (dired-create-files-failures
+ (setq failures (nconc failures dired-create-files-failures))
+ (dired-log-summary
+ (format "%s failed for %d file%s in %d requests"
+ operation (length failures)
+ (dired-plural-s (length failures))
+ total)
+ failures))
+ (failures
+ (dired-log-summary
+ (format "%s failed for %d of %d file%s"
+ operation (length failures)
+ total (dired-plural-s total))
+ failures))
+ (skipped
+ (dired-log-summary
+ (format "%s: %d of %d file%s skipped"
+ operation (length skipped) total
+ (dired-plural-s total))
+ skipped))
+ (t (message "%s: %s file%s"
+ operation success-count (dired-plural-s success-count))))
+ ;; Start async process.
+ (when async-fn-list
+ (async-start `(lambda ()
+ (require 'cl-lib) (require 'dired-aux) (require 'dired-x)
+ ,(async-inject-variables
dired-async-env-variables-regexp)
+ (condition-case err
+ (let ((dired-recursive-copies (quote always)))
+ (cl-loop for (f . d) in (quote ,async-fn-list)
+ do (funcall (quote ,file-creator) f d t)))
+ (file-error
+ (with-temp-file ,dired-async-log-file
+ (insert (format "%S" err)))))
+ ,(dired-async-maybe-kill-ftp))
+ callback)
+ ;; Run mode-line notifications while process running.
+ (dired-async--modeline-mode 1)
+ (setq dired-async-operation (list operation (length async-fn-list)))
+ (message "%s proceeding asynchronously..." operation))))
+
+(defadvice dired-create-files (around dired-async)
+ (dired-async-create-files file-creator operation fn-list
+ name-constructor marker-char))
+
+;;;###autoload
+(define-minor-mode dired-async-mode
+ "Do dired actions asynchronously."
+ :group 'dired-async
+ :global t
+ (if dired-async-mode
+ (if (fboundp 'advice-add)
+ (advice-add 'dired-create-files :override #'dired-async-create-files)
+ (ad-activate 'dired-create-files))
+ (if (fboundp 'advice-remove)
+ (advice-remove 'dired-create-files #'dired-async-create-files)
+ (ad-deactivate 'dired-create-files))))
+
+
+(provide 'dired-async)
+
+;;; dired-async.el ends here
diff --git a/packages/async/smtpmail-async.el b/packages/async/smtpmail-async.el
new file mode 100644
index 0000000..5ac426d
--- /dev/null
+++ b/packages/async/smtpmail-async.el
@@ -0,0 +1,73 @@
+;;; smtpmail-async.el --- Send e-mail with smtpmail.el asynchronously
+
+;; Copyright (C) 2012-2016 Free Software Foundation, Inc.
+
+;; Author: John Wiegley <address@hidden>
+;; Created: 18 Jun 2012
+
+;; Keywords: email async
+;; X-URL: https://github.com/jwiegley/emacs-async
+
+;; 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 GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Send e-mail with smtpmail.el asynchronously. To use:
+;;
+;; (require 'smtpmail-async)
+;;
+;; (setq send-mail-function 'async-smtpmail-send-it
+;; message-send-mail-function 'async-smtpmail-send-it)
+;;
+;; This assumes you already have smtpmail.el working.
+
+;;; Code:
+
+(defgroup smtpmail-async nil
+ "Send e-mail with smtpmail.el asynchronously"
+ :group 'smptmail)
+
+(require 'async)
+(require 'smtpmail)
+(require 'message)
+
+(defvar async-smtpmail-before-send-hook nil
+ "Hook running in the child emacs in `async-smtpmail-send-it'.
+It is called just before calling `smtpmail-send-it'.")
+
+(defun async-smtpmail-send-it ()
+ (let ((to (message-field-value "To"))
+ (buf-content (buffer-substring-no-properties
+ (point-min) (point-max))))
+ (message "Delivering message to %s..." to)
+ (async-start
+ `(lambda ()
+ (require 'smtpmail)
+ (with-temp-buffer
+ (insert ,buf-content)
+ (set-buffer-multibyte nil)
+ ;; Pass in the variable environment for smtpmail
+ ,(async-inject-variables
+
"\\`\\(smtpmail\\|async-smtpmail\\|\\(user-\\)?mail\\)-\\|auth-sources\\|epg"
+ nil
"\\`\\(mail-header-format-function\\|smtpmail-address-buffer\\|mail-mode-abbrev-table\\)")
+ (run-hooks 'async-smtpmail-before-send-hook)
+ (smtpmail-send-it)))
+ `(lambda (&optional ignore)
+ (message "Delivering message to %s...done" ,to)))))
+
+(provide 'smtpmail-async)
+
+;;; smtpmail-async.el ends here
diff --git a/packages/avy/.dir-locals.el b/packages/avy/.dir-locals.el
new file mode 100644
index 0000000..3bcda92
--- /dev/null
+++ b/packages/avy/.dir-locals.el
@@ -0,0 +1,5 @@
+;;; Directory Local Variables
+;;; For more information see (info "(emacs) Directory Variables")
+
+((emacs-lisp-mode
+ (indent-tabs-mode . nil)))
diff --git a/packages/avy/Makefile b/packages/avy/Makefile
new file mode 100644
index 0000000..9303c7c
--- /dev/null
+++ b/packages/avy/Makefile
@@ -0,0 +1,20 @@
+emacs ?= emacs
+# EMACS = emacs-24.3
+
+LOAD = -l avy.el -l avy-test.el
+
+.PHONY: all test clean
+
+all: compile test
+
+test:
+ $(emacs) -batch $(LOAD) -f ert-run-tests-batch-and-exit
+
+compile:
+ $(emacs) -batch -l targets/avy-init.el
+
+run:
+ $(emacs) -Q -l targets/avy-init.el
+
+clean:
+ rm -f *.elc
diff --git a/packages/avy/README.md b/packages/avy/README.md
new file mode 100644
index 0000000..9df0ce2
--- /dev/null
+++ b/packages/avy/README.md
@@ -0,0 +1,112 @@
+## Introduction
+
+`avy` is a GNU Emacs package for jumping to visible text using a char-based
decision tree. See also
[ace-jump-mode](https://github.com/winterTTr/ace-jump-mode) and
[vim-easymotion](https://github.com/Lokaltog/vim-easymotion) - `avy` uses the
same idea.
+
+
+
+## Command overview
+
+You can bind some of these useful commands in your config.
+
+### `avy-goto-char`
+
+> Input one char, jump to it with a tree.
+
+```elisp
+(global-set-key (kbd "C-:") 'avy-goto-char)
+```
+
+After <kbd>C-: b</kbd>:
+
+
+
+### `avy-goto-char-2`
+
+> Input two consecutive chars, jump to the first one with a tree.
+
+The advantage over the previous one is less candidates for the tree search.
And it's not too inconvenient to enter two consecutive chars instead of one.
+
+```elisp
+(global-set-key (kbd "C-'") 'avy-goto-char-2)
+```
+
+After <kbd>C-' bu</kbd>:
+
+
+
+### `avy-goto-line`
+
+> Input zero chars, jump to a line start with a tree.
+
+```elisp
+(global-set-key (kbd "M-g f") 'avy-goto-line)
+```
+
+After <kbd>M-g f</kbd>:
+
+
+
+You can actually replace the <kbd>M-g g</kbd> binding of `goto-line`, since if
you enter a digit for `avy-goto-line`, it will switch to `goto-line` with that
digit already entered.
+
+### `avy-goto-word-1`
+
+> Input one char at word start, jump to a word start with a tree.
+
+```elisp
+(global-set-key (kbd "M-g w") 'avy-goto-word-1)
+```
+
+After <kbd>M-g wb</kbd>:
+
+
+
+### `avy-goto-word-0`
+
+> Input zero chars, jump to a word start with a tree.
+
+Compared to `avy-goto-word-1`, there are a lot more candidates. But at a least
there's not need to input the initial char.
+
+```elisp
+(global-set-key (kbd "M-g e") 'avy-goto-word-0)
+```
+
+After <kbd>M-g e</kbd>:
+
+
+
+
+### Other commands
+
+There are some more commands which you can explore yourself by looking at the
code.
+
+### Bindings
+
+You add this to your config to bind some stuff:
+
+```elisp
+(avy-setup-default)
+```
+
+It will bind, for example, `avy-isearch` to <kbd>C-'</kbd> in
`isearch-mode-map`, so that you can select one of the currently visible
`isearch` candidates using `avy`.
+
+### Customization
+
+See the comprehensive custom variable list on [the defcustom wiki
page](https://github.com/abo-abo/avy/wiki/defcustom).
+
+See how to write your own avy commands on [the custom-commands wiki
page](https://github.com/abo-abo/avy/wiki/custom-commands).
+
+## Contributing
+
+### Copyright Assignment
+
+Avy is subject to the same [copyright
assignment](http://www.gnu.org/prep/maintain/html_node/Copyright-Papers.html)
policy as Emacs itself, org-mode, CEDET and other packages in [GNU
ELPA](http://elpa.gnu.org/packages/). Any [legally
significant](http://www.gnu.org/prep/maintain/html_node/Legally-Significant.html#Legally-Significant)
contributions can only be accepted after the author has completed their
paperwork. Please see [the request
form](http://git.savannah.gnu.org/cgit/gnulib.git [...]
+
+The copyright assignment isn't a big deal, it just says that the copyright for
your submitted changes to Emacs belongs to the FSF. This assignment works for
all projects related to Emacs. To obtain it, you need to send one email, then
send one letter (if you live in the US, it's digital), and wait for some time
(in my case, I had to wait for one month).
+
+### Style
+
+The basic code style guide is to use `(setq indent-tabs-mode nil)`. It is
provided for you in
[.dir-locals.el](https://github.com/abo-abo/avy/blob/master/.dir-locals.el),
please obey it.
+
+Before submitting the change, run `make compile` and `make test` to make sure
that it doesn't introduce new compile warnings or test failures. Also run
<kbd>M-x</kbd> `checkdoc` to see that your changes obey the documentation
guidelines.
+
+Use your own judgment for the commit messages, I recommend a verbose style
using `magit-commit-add-log`.
diff --git a/packages/ace-window/avy-test.el b/packages/avy/avy-test.el
similarity index 100%
rename from packages/ace-window/avy-test.el
rename to packages/avy/avy-test.el
diff --git a/packages/avy/avy.el b/packages/avy/avy.el
new file mode 100644
index 0000000..45f2120
--- /dev/null
+++ b/packages/avy/avy.el
@@ -0,0 +1,1329 @@
+;;; avy.el --- tree-based completion -*- lexical-binding: t -*-
+
+;; Copyright (C) 2015 Free Software Foundation, Inc.
+
+;; Author: Oleh Krehel <address@hidden>
+;; URL: https://github.com/abo-abo/avy
+;; Version: 0.4.0
+;; Package-Requires: ((emacs "24.1") (cl-lib "0.5"))
+;; Keywords: point, location
+
+;; 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, 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.
+
+;; For a full copy of the GNU General Public License
+;; see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; This package provides a generic completion method based on building
+;; a balanced decision tree with each candidate being a leaf. To
+;; traverse the tree from the root to a desired leaf, typically a
+;; sequence of `read-key' can be used.
+;;
+;; In order for `read-key' to make sense, the tree needs to be
+;; visualized appropriately, with a character at each branch node. So
+;; this completion method works only for things that you can see on
+;; your screen, all at once:
+;;
+;; * character positions
+;; * word or subword start positions
+;; * line beginning positions
+;; * link positions
+;; * window positions
+;;
+;; If you're familiar with the popular `ace-jump-mode' package, this
+;; package does all that and more, without the implementation
+;; headache.
+
+;;; Code:
+(require 'cl-lib)
+(require 'ring)
+
+;;* Customization
+(defgroup avy nil
+ "Jump to things tree-style."
+ :group 'convenience
+ :prefix "avy-")
+
+(defcustom avy-keys '(?a ?s ?d ?f ?g ?h ?j ?k ?l)
+ "Default keys for jumping.
+Any key is either a character representing a self-inserting
+key (letters, digits, punctuation, etc.) or a symbol denoting a
+non-printing key like an arrow key (left, right, up, down). For
+non-printing keys, a corresponding entry in
+`avy-key-to-char-alist' must exist in order to visualize the key
+in the avy overlays."
+ :type '(repeat :tag "Keys" (choice (character :tag "char")
+ (symbol :tag "non-printing key"))))
+
+(defcustom avy-keys-alist nil
+ "Alist of avy-jump commands to `avy-keys' overriding the default `avy-keys'."
+ :type '(alist
+ :key-type (choice :tag "Command"
+ (const avy-goto-char)
+ (const avy-goto-char-2)
+ (const avy-isearch)
+ (const avy-goto-line)
+ (const avy-goto-subword-0)
+ (const avy-goto-subword-1)
+ (const avy-goto-word-0)
+ (const avy-goto-word-1)
+ (const avy-copy-line)
+ (const avy-copy-region)
+ (const avy-move-line))
+ :value-type (repeat :tag "Keys" character)))
+
+(defcustom avy-style 'at-full
+ "The default method of displaying the overlays.
+Use `avy-styles-alist' to customize this per-command."
+ :type '(choice
+ (const :tag "Pre" pre)
+ (const :tag "At" at)
+ (const :tag "At Full" at-full)
+ (const :tag "Post" post)
+ (const :tag "De Bruijn" de-bruijn)))
+
+(defcustom avy-styles-alist nil
+ "Alist of avy-jump commands to the style for each command.
+If the commands isn't on the list, `avy-style' is used."
+ :type '(alist
+ :key-type (choice :tag "Command"
+ (const avy-goto-char)
+ (const avy-goto-char-2)
+ (const avy-isearch)
+ (const avy-goto-line)
+ (const avy-goto-subword-0)
+ (const avy-goto-subword-1)
+ (const avy-goto-word-0)
+ (const avy-goto-word-1)
+ (const avy-copy-line)
+ (const avy-copy-region)
+ (const avy-move-line))
+ :value-type (choice
+ (const :tag "Pre" pre)
+ (const :tag "At" at)
+ (const :tag "At Full" at-full)
+ (const :tag "Post" post)
+ (const :tag "De Bruijn" de-bruijn))))
+
+(defcustom avy-dispatch-alist
+ '((?x . avy-action-kill)
+ (?m . avy-action-mark)
+ (?n . avy-action-copy))
+ "List of actions for `avy-handler-default'.
+
+Each item is (KEY . ACTION). When KEY not on `avy-keys' is
+pressed during the dispatch, ACTION is set to replace the default
+`avy-action-goto' once a candidate is finally selected."
+ :type
+ '(alist
+ :key-type (choice (character :tag "Char"))
+ :value-type (choice
+ (const :tag "Mark" avy-action-mark)
+ (const :tag "Copy" avy-action-copy)
+ (const :tag "Kill" avy-action-kill))))
+
+(defcustom avy-background nil
+ "When non-nil, a gray background will be added during the selection."
+ :type 'boolean)
+
+(defcustom avy-all-windows t
+ "Determine the list of windows to consider in search of candidates."
+ :type
+ '(choice
+ (const :tag "All Frames" all-frames)
+ (const :tag "This Frame" t)
+ (const :tag "This Window" nil)))
+
+(defcustom avy-case-fold-search t
+ "Non-nil if searches should ignore case."
+ :type 'boolean)
+
+(defcustom avy-word-punc-regexp "[!-/:address@hidden"
+ "Regexp of punctuation chars that count as word starts for `avy-goto-word-1.
+When nil, punctuation chars will not be matched.
+
+\"[!-/:address@hidden" will match all printable punctuation chars."
+ :type 'regexp)
+
+(defcustom avy-ignored-modes '(image-mode doc-view-mode pdf-view-mode)
+ "List of modes to ignore when searching for candidates.
+Typically, these modes don't use the text representation.")
+
+(defvar avy-translate-char-function #'identity
+ "Function to translate user input key into another key.
+For example, to make SPC do the same as ?a, use
+\(lambda (c) (if (= c 32) ?a c)).")
+
+(defface avy-lead-face-0
+ '((t (:foreground "white" :background "#4f57f9")))
+ "Face used for first non-terminating leading chars.")
+
+(defface avy-lead-face-1
+ '((t (:foreground "white" :background "gray")))
+ "Face used for matched leading chars.")
+
+(defface avy-lead-face-2
+ '((t (:foreground "white" :background "#f86bf3")))
+ "Face used for leading chars.")
+
+(defface avy-lead-face
+ '((t (:foreground "white" :background "#e52b50")))
+ "Face used for the leading chars.")
+
+(defface avy-background-face
+ '((t (:foreground "gray40")))
+ "Face for whole window background during selection.")
+
+(defface avy-goto-char-timer-face
+ '((t (:inherit highlight)))
+ "Face for matches during reading chars using `avy-goto-char-timer'.")
+
+(defconst avy-lead-faces '(avy-lead-face
+ avy-lead-face-0
+ avy-lead-face-2
+ avy-lead-face
+ avy-lead-face-0
+ avy-lead-face-2)
+ "Face sequence for `avy--overlay-at-full'.")
+
+(defvar avy-key-to-char-alist '((left . ?◀)
+ (right . ?▶)
+ (up . ?▲)
+ (down . ?▼)
+ (prior . ?△)
+ (next . ?▽))
+ "An alist from non-character keys to printable chars used in avy overlays.
+This alist must contain all keys used in `avy-keys' which are not
+self-inserting keys and thus aren't read as characters.")
+
+;;* Internals
+;;** Tree
+(defmacro avy-multipop (lst n)
+ "Remove LST's first N elements and return them."
+ `(if (<= (length ,lst) ,n)
+ (prog1 ,lst
+ (setq ,lst nil))
+ (prog1 ,lst
+ (setcdr
+ (nthcdr (1- ,n) (prog1 ,lst (setq ,lst (nthcdr ,n ,lst))))
+ nil))))
+
+(defun avy--de-bruijn (keys n)
+ "De Bruijn sequence for alphabet KEYS and subsequences of length N."
+ (let* ((k (length keys))
+ (a (make-list (* n k) 0))
+ sequence)
+ (cl-labels ((db (T p)
+ (if (> T n)
+ (if (eq (% n p) 0)
+ (setq sequence
+ (append sequence
+ (cl-subseq a 1 (1+ p)))))
+ (setf (nth T a) (nth (- T p) a))
+ (db (1+ T) p)
+ (cl-loop for j from (1+ (nth (- T p) a)) to (1- k) do
+ (setf (nth T a) j)
+ (db (1+ T) T)))))
+ (db 1 1)
+ (mapcar (lambda (n)
+ (nth n keys))
+ sequence))))
+
+(defun avy--path-alist-1 (lst seq-len keys)
+ "Build a De Bruin sequence from LST.
+SEQ-LEN is how many elements of KEYS it takes to identify a match."
+ (let ((db-seq (avy--de-bruijn keys seq-len))
+ prev-pos prev-seq prev-win path-alist)
+ ;; The De Bruijn seq is cyclic, so append the seq-len - 1 first chars to
+ ;; the end.
+ (setq db-seq (nconc db-seq (cl-subseq db-seq 0 (1- seq-len))))
+ (cl-labels ((subseq-and-pop ()
+ (when (nth (1- seq-len) db-seq)
+ (prog1 (cl-subseq db-seq 0 seq-len)
+ (pop db-seq)))))
+ (while lst
+ (let* ((cur (car lst))
+ (pos (cond
+ ;; ace-window has matches of the form (pos . wnd)
+ ((integerp (car cur)) (car cur))
+ ;; avy-jump have form ((start . end) . wnd)
+ ((consp (car cur)) (caar cur))
+ (t (error "Unexpected match representation: %s" cur))))
+ (win (cdr cur))
+ (path (if prev-pos
+ (let ((diff (if (eq win prev-win)
+ (- pos prev-pos)
+ 0)))
+ (when (and (> diff 0) (< diff seq-len))
+ (while (and (nth (1- seq-len) db-seq)
+ (not
+ (eq 0 (cl-search
+ (cl-subseq prev-seq diff)
+ (cl-subseq db-seq 0
seq-len)))))
+ (pop db-seq)))
+ (subseq-and-pop))
+ (subseq-and-pop))))
+ (if (not path)
+ (setq lst nil
+ path-alist nil)
+ (push (cons path (car lst)) path-alist)
+ (setq prev-pos pos
+ prev-seq path
+ prev-win win
+ lst (cdr lst))))))
+ (nreverse path-alist)))
+
+(defun avy-tree (lst keys)
+ "Coerce LST into a balanced tree.
+The degree of the tree is the length of KEYS.
+KEYS are placed appropriately on internal nodes."
+ (let ((len (length keys)))
+ (cl-labels
+ ((rd (ls)
+ (let ((ln (length ls)))
+ (if (< ln len)
+ (cl-pairlis keys
+ (mapcar (lambda (x) (cons 'leaf x)) ls))
+ (let ((ks (copy-sequence keys))
+ res)
+ (dolist (s (avy-subdiv ln len))
+ (push (cons (pop ks)
+ (if (eq s 1)
+ (cons 'leaf (pop ls))
+ (rd (avy-multipop ls s))))
+ res))
+ (nreverse res))))))
+ (rd lst))))
+
+(defun avy-subdiv (n b)
+ "Distribute N in B terms in a balanced way."
+ (let* ((p (1- (floor (+ (log n b) 1e-6))))
+ (x1 (expt b p))
+ (x2 (* b x1))
+ (delta (- n x2))
+ (n2 (/ delta (- x2 x1)))
+ (n1 (- b n2 1)))
+ (append
+ (make-list n1 x1)
+ (list
+ (- n (* n1 x1) (* n2 x2)))
+ (make-list n2 x2))))
+
+(defun avy-traverse (tree walker &optional recur-key)
+ "Traverse TREE generated by `avy-tree'.
+WALKER is a function that takes KEYS and LEAF.
+
+RECUR-KEY is used in recursion.
+
+LEAF is a member of LST argument of `avy-tree'.
+
+KEYS is the path from the root of `avy-tree' to LEAF."
+ (dolist (br tree)
+ (let ((key (cons (car br) recur-key)))
+ (if (eq (cadr br) 'leaf)
+ (funcall walker key (cddr br))
+ (avy-traverse (cdr br) walker key)))))
+
+(defvar avy-action nil
+ "Function to call at the end of select.")
+
+(defun avy-handler-default (char)
+ "The default handler for a bad CHAR."
+ (let (dispatch)
+ (if (setq dispatch (assoc char avy-dispatch-alist))
+ (progn
+ (setq avy-action (cdr dispatch))
+ (throw 'done 'restart))
+ (signal 'user-error (list "No such candidate" char))
+ (throw 'done nil))))
+
+(defvar avy-handler-function 'avy-handler-default
+ "A function to call for a bad `read-key' in `avy-read'.")
+
+(defvar avy-current-path ""
+ "Store the current incomplete path during `avy-read'.")
+
+(defun avy-read (tree display-fn cleanup-fn)
+ "Select a leaf from TREE using consecutive `read-char'.
+
+DISPLAY-FN should take CHAR and LEAF and signify that LEAFs
+associated with CHAR will be selected if CHAR is pressed. This is
+commonly done by adding a CHAR overlay at LEAF position.
+
+CLEANUP-FN should take no arguments and remove the effects of
+multiple DISPLAY-FN invokations."
+ (catch 'done
+ (setq avy-current-path "")
+ (while tree
+ (let ((avy--leafs nil))
+ (avy-traverse tree
+ (lambda (path leaf)
+ (push (cons path leaf) avy--leafs)))
+ (dolist (x avy--leafs)
+ (funcall display-fn (car x) (cdr x))))
+ (let ((char (funcall avy-translate-char-function (read-key)))
+ branch)
+ (funcall cleanup-fn)
+ (if (setq branch (assoc char tree))
+ (if (eq (car (setq tree (cdr branch))) 'leaf)
+ (throw 'done (cdr tree))
+ (setq avy-current-path
+ (concat avy-current-path (string (avy--key-to-char
char)))))
+ (funcall avy-handler-function char))))))
+
+(defun avy-read-de-bruijn (lst keys)
+ "Select from LST dispatching on KEYS."
+ ;; In theory, the De Bruijn sequence B(k,n) has k^n subsequences of length n
+ ;; (the path length) usable as paths, thus that's the lower bound. Due to
+ ;; partially overlapping matches, not all subsequences may be usable, so it's
+ ;; possible that the path-len must be incremented, e.g., if we're matching
+ ;; for x and a buffer contains xaxbxcx only every second subsequence is
+ ;; usable for the four matches.
+ (catch 'done
+ (let* ((path-len (ceiling (log (length lst) (length keys))))
+ (alist (avy--path-alist-1 lst path-len keys)))
+ (while (not alist)
+ (cl-incf path-len)
+ (setq alist (avy--path-alist-1 lst path-len keys)))
+ (let* ((len (length (caar alist)))
+ (i 0))
+ (setq avy-current-path "")
+ (while (< i len)
+ (dolist (x (reverse alist))
+ (avy--overlay-at-full (reverse (car x)) (cdr x)))
+ (let ((char (funcall avy-translate-char-function (read-key))))
+ (avy--remove-leading-chars)
+ (setq alist
+ (delq nil
+ (mapcar (lambda (x)
+ (when (eq (caar x) char)
+ (cons (cdr (car x)) (cdr x))))
+ alist)))
+ (setq avy-current-path
+ (concat avy-current-path (string (avy--key-to-char char))))
+ (cl-incf i)
+ (unless alist
+ (funcall avy-handler-function char))))
+ (cdar alist)))))
+
+;;** Rest
+(defun avy-window-list ()
+ "Return a list of windows depending on `avy-all-windows'."
+ (cond ((eq avy-all-windows 'all-frames)
+ (cl-mapcan #'window-list (frame-list)))
+
+ ((eq avy-all-windows t)
+ (window-list))
+
+ ((null avy-all-windows)
+ (list (selected-window)))
+
+ (t
+ (error "Unrecognized option: %S" avy-all-windows))))
+
+(defcustom avy-all-windows-alt t
+ "The alternative `avy-all-windows' for use with \\[universal-argument]."
+ :type '(choice
+ (const :tag "All windows on the current frame" t)
+ (const :tag "All windows on all frames" all-frames)))
+
+(defmacro avy-dowindows (flip &rest body)
+ "Depending on FLIP and `avy-all-windows' run BODY in each or selected
window."
+ (declare (indent 1)
+ (debug (form body)))
+ `(let ((avy-all-windows (if ,flip
+ avy-all-windows-alt
+ avy-all-windows)))
+ (dolist (wnd (avy-window-list))
+ (with-selected-window wnd
+ (unless (memq major-mode avy-ignored-modes)
+ ,@body)))))
+
+(defmacro avy-with (command &rest body)
+ "Set `avy-keys' according to COMMAND and execute BODY.
+Set `avy-style' according to COMMMAND as well."
+ (declare (indent 1)
+ (debug (form body)))
+ `(let ((avy-keys (or (cdr (assq ',command avy-keys-alist))
+ avy-keys))
+ (avy-style (or (cdr (assq ',command avy-styles-alist))
+ avy-style)))
+ (setq avy-action nil)
+ ,@body))
+
+(defun avy-action-goto (pt)
+ "Goto PT."
+ (goto-char pt))
+
+(defun avy-action-mark (pt)
+ "Mark sexp at PT."
+ (goto-char pt)
+ (set-mark (point))
+ (forward-sexp))
+
+(defun avy-action-copy (pt)
+ "Copy sexp starting on PT."
+ (save-excursion
+ (let (str)
+ (goto-char pt)
+ (forward-sexp)
+ (setq str (buffer-substring pt (point)))
+ (kill-new str)
+ (message "Copied: %s" str))))
+
+(defun avy-action-kill (pt)
+ "Kill sexp at PT."
+ (goto-char pt)
+ (forward-sexp)
+ (kill-region pt (point))
+ (message "Killed: %s" (current-kill 0)))
+
+(defun avy--process (candidates overlay-fn)
+ "Select one of CANDIDATES using `avy-read'.
+Use OVERLAY-FN to visualize the decision overlay."
+ (unless (and (consp (car candidates))
+ (windowp (cdar candidates)))
+ (setq candidates
+ (mapcar (lambda (x) (cons x (selected-window)))
+ candidates)))
+ (let ((len (length candidates))
+ (cands (copy-sequence candidates))
+ res)
+ (if (= len 0)
+ (message "zero candidates")
+ (if (= len 1)
+ (setq res (car candidates))
+ (unwind-protect
+ (progn
+ (avy--make-backgrounds
+ (avy-window-list))
+ (setq res (if (eq avy-style 'de-bruijn)
+ (avy-read-de-bruijn
+ candidates avy-keys)
+ (avy-read (avy-tree candidates avy-keys)
+ overlay-fn
+ #'avy--remove-leading-chars))))
+ (avy--done)))
+ (cond ((eq res 'restart)
+ (avy--process cands overlay-fn))
+ ;; ignore exit from `avy-handler-function'
+ ((eq res 'exit))
+ (t
+ (avy-push-mark)
+ (when (and (consp res)
+ (windowp (cdr res)))
+ (let* ((window (cdr res))
+ (frame (window-frame window)))
+ (unless (equal frame (selected-frame))
+ (select-frame-set-input-focus frame))
+ (select-window window))
+ (setq res (car res)))
+
+ (funcall (or avy-action 'avy-action-goto)
+ (if (consp res)
+ (car res)
+ res)))))))
+
+(defvar avy--overlays-back nil
+ "Hold overlays for when `avy-background' is t.")
+
+(defun avy--make-backgrounds (wnd-list)
+ "Create a dim background overlay for each window on WND-LIST."
+ (when avy-background
+ (setq avy--overlays-back
+ (mapcar (lambda (w)
+ (let ((ol (make-overlay
+ (window-start w)
+ (window-end w)
+ (window-buffer w))))
+ (overlay-put ol 'face 'avy-background-face)
+ (overlay-put ol 'window w)
+ ol))
+ wnd-list))))
+
+(defun avy--done ()
+ "Clean up overlays."
+ (mapc #'delete-overlay avy--overlays-back)
+ (setq avy--overlays-back nil)
+ (avy--remove-leading-chars))
+
+(defun avy--next-visible-point ()
+ "Return the next closest point without 'invisible property."
+ (let ((s (point)))
+ (while (and (not (= (point-max) (setq s (next-overlay-change s))))
+ (get-char-property s 'invisible)))
+ s))
+
+(defun avy--next-invisible-point ()
+ "Return the next closest point with 'invisible property."
+ (let ((s (point)))
+ (while (and (not (= (point-max) (setq s (next-overlay-change s))))
+ (not (get-char-property s 'invisible))))
+ s))
+
+(defun avy--find-visible-regions (rbeg rend)
+ "Return a list of all visible regions between RBEG and REND."
+ (setq rbeg (max rbeg (point-min)))
+ (setq rend (min rend (point-max)))
+ (when (< rbeg rend)
+ (let (visibles beg)
+ (save-excursion
+ (save-restriction
+ (narrow-to-region rbeg rend)
+ (setq beg (goto-char (point-min)))
+ (while (not (= (point) (point-max)))
+ (goto-char (avy--next-invisible-point))
+ (push (cons beg (point)) visibles)
+ (setq beg (goto-char (avy--next-visible-point))))
+ (nreverse visibles))))))
+
+(defun avy--regex-candidates (regex &optional beg end pred group)
+ "Return all elements that match REGEX.
+Each element of the list is ((BEG . END) . WND)
+When PRED is non-nil, it's a filter for matching point positions.
+When GROUP is non-nil, (BEG . END) should delimit that regex group."
+ (setq group (or group 0))
+ (let ((case-fold-search (or avy-case-fold-search
+ (string= regex (downcase regex))))
+ candidates)
+ (avy-dowindows current-prefix-arg
+ (dolist (pair (avy--find-visible-regions
+ (or beg (window-start))
+ (or end (window-end (selected-window) t))))
+ (save-excursion
+ (goto-char (car pair))
+ (while (re-search-forward regex (cdr pair) t)
+ (unless (get-char-property (1- (point)) 'invisible)
+ (when (or (null pred)
+ (funcall pred))
+ (push (cons (cons (match-beginning group)
+ (match-end group))
+ wnd) candidates)))))))
+ (nreverse candidates)))
+
+(defvar avy--overlay-offset 0
+ "The offset to apply in `avy--overlay'.")
+
+(defvar avy--overlays-lead nil
+ "Hold overlays for leading chars.")
+
+(defun avy--remove-leading-chars ()
+ "Remove leading char overlays."
+ (mapc #'delete-overlay avy--overlays-lead)
+ (setq avy--overlays-lead nil))
+
+(defun avy--old-str (pt wnd)
+ "Return a one-char string at PT in WND."
+ (let ((old-str (with-selected-window wnd
+ (buffer-substring pt (1+ pt)))))
+ (if avy-background
+ (propertize old-str 'face 'avy-background-face)
+ old-str)))
+
+(defun avy--overlay (str beg end wnd &optional compose-fn)
+ "Create an overlay with STR from BEG to END in WND.
+COMPOSE-FN is a lambda that concatenates the old string at BEG with STR."
+ (let ((eob (with-selected-window wnd (point-max))))
+ (when (<= beg eob)
+ (let* ((beg (+ beg avy--overlay-offset))
+ (ol (make-overlay beg (or end (1+ beg)) (window-buffer wnd)))
+ (old-str (if (eq beg eob) "" (avy--old-str beg wnd)))
+ (os-line-prefix (get-text-property 0 'line-prefix old-str))
+ (os-wrap-prefix (get-text-property 0 'wrap-prefix old-str))
+ other-ol)
+ (when os-line-prefix
+ (add-text-properties 0 1 `(line-prefix ,os-line-prefix) str))
+ (when os-wrap-prefix
+ (add-text-properties 0 1 `(wrap-prefix ,os-wrap-prefix) str))
+ (when (setq other-ol (cl-find-if
+ (lambda (o) (overlay-get o 'goto-address))
+ (overlays-at beg)))
+ (add-text-properties
+ 0 (length old-str)
+ `(face ,(overlay-get other-ol 'face)) old-str))
+ (overlay-put ol 'window wnd)
+ (overlay-put ol 'category 'avy)
+ (overlay-put ol (if (eq beg eob)
+ 'after-string
+ 'display)
+ (funcall
+ (or compose-fn #'concat)
+ str old-str))
+ (push ol avy--overlays-lead)))))
+
+(defcustom avy-highlight-first nil
+ "When non-nil highlight the first decision char with `avy-lead-face-0'.
+Do this even when the char is terminating."
+ :type 'boolean)
+
+(defun avy--key-to-char (c)
+ "If C is no character, translate it using `avy-key-to-char-alist'."
+ (if (characterp c)
+ c
+ (or (cdr (assoc c avy-key-to-char-alist))
+ (error "Unknown key %s" c))))
+
+(defun avy-candidate-beg (leaf)
+ "Return the start position for LEAF."
+ (cond ((numberp leaf)
+ leaf)
+ ((consp (car leaf))
+ (caar leaf))
+ (t
+ (car leaf))))
+
+(defun avy-candidate-end (leaf)
+ "Return the end position for LEAF."
+ (cond ((numberp leaf)
+ leaf)
+ ((consp (car leaf))
+ (cdar leaf))
+ (t
+ (car leaf))))
+
+(defun avy-candidate-wnd (leaf)
+ "Return the window for LEAF."
+ (if (consp leaf)
+ (cdr leaf)
+ (selected-window)))
+
+(defun avy--overlay-pre (path leaf)
+ "Create an overlay with PATH at LEAF.
+PATH is a list of keys from tree root to LEAF.
+LEAF is normally ((BEG . END) . WND)."
+ (let* ((path (mapcar #'avy--key-to-char path))
+ (str (propertize (apply #'string (reverse path))
+ 'face 'avy-lead-face)))
+ (when (or avy-highlight-first (> (length str) 1))
+ (set-text-properties 0 1 '(face avy-lead-face-0) str))
+ (setq str (concat
+ (propertize avy-current-path
+ 'face 'avy-lead-face-1)
+ str))
+ (avy--overlay
+ str
+ (avy-candidate-beg leaf) nil
+ (avy-candidate-wnd leaf))))
+
+(defun avy--overlay-at (path leaf)
+ "Create an overlay with PATH at LEAF.
+PATH is a list of keys from tree root to LEAF.
+LEAF is normally ((BEG . END) . WND)."
+ (let* ((path (mapcar #'avy--key-to-char path))
+ (str (propertize
+ (string (car (last path)))
+ 'face 'avy-lead-face)))
+ (avy--overlay
+ str
+ (avy-candidate-beg leaf) nil
+ (avy-candidate-wnd leaf)
+ (lambda (str old-str)
+ (cond ((string= old-str "\n")
+ (concat str "\n"))
+ ;; add padding for wide-width character
+ ((eq (string-width old-str) 2)
+ (concat str " "))
+ (t
+ str))))))
+
+(defun avy--overlay-at-full (path leaf)
+ "Create an overlay with PATH at LEAF.
+PATH is a list of keys from tree root to LEAF.
+LEAF is normally ((BEG . END) . WND)."
+ (let* ((path (mapcar #'avy--key-to-char path))
+ (str (propertize
+ (apply #'string (reverse path))
+ 'face 'avy-lead-face))
+ (len (length path))
+ (beg (avy-candidate-beg leaf))
+ (wnd (cdr leaf))
+ end)
+ (dotimes (i len)
+ (set-text-properties (- len i 1) (- len i)
+ `(face ,(nth i avy-lead-faces))
+ str))
+ (when (eq avy-style 'de-bruijn)
+ (setq str (concat
+ (propertize avy-current-path
+ 'face 'avy-lead-face-1)
+ str))
+ (setq len (length str)))
+ (with-selected-window wnd
+ (save-excursion
+ (goto-char beg)
+ (let* ((lep (if (bound-and-true-p visual-line-mode)
+ (save-excursion
+ (end-of-visual-line)
+ (point))
+ (line-end-position)))
+ (len-and-str (avy--update-offset-and-str len str lep)))
+ (setq len (car len-and-str))
+ (setq str (cdr len-and-str))
+ (setq end (if (= beg lep)
+ (1+ beg)
+ (min (+ beg
+ (if (eq (char-after) ?\t)
+ 1
+ len))
+ lep)))
+ (when (and (bound-and-true-p visual-line-mode)
+ (> len (- end beg))
+ (not (eq lep beg)))
+ (setq len (- end beg))
+ (let ((old-str (apply #'string (reverse path))))
+ (setq str
+ (substring
+ (propertize
+ old-str
+ 'face
+ (if (= (length old-str) 1)
+ 'avy-lead-face
+ 'avy-lead-face-0))
+ 0 len)))))))
+ (avy--overlay
+ str beg end wnd
+ (lambda (str old-str)
+ (cond ((string= old-str "\n")
+ (concat str "\n"))
+ ((string= old-str "\t")
+ (concat str (make-string (max (- tab-width len) 0) ?\ )))
+ (t
+ ;; add padding for wide-width character
+ (if (eq (string-width old-str) 2)
+ (concat str " ")
+ str)))))))
+
+(defun avy--overlay-post (path leaf)
+ "Create an overlay with PATH at LEAF.
+PATH is a list of keys from tree root to LEAF.
+LEAF is normally ((BEG . END) . WND)."
+ (let* ((path (mapcar #'avy--key-to-char path))
+ (str (propertize (apply #'string (reverse path))
+ 'face 'avy-lead-face)))
+ (when (or avy-highlight-first (> (length str) 1))
+ (set-text-properties 0 1 '(face avy-lead-face-0) str))
+ (setq str (concat
+ (propertize avy-current-path
+ 'face 'avy-lead-face-1)
+ str))
+ (avy--overlay
+ str
+ (avy-candidate-end leaf) nil
+ (avy-candidate-wnd leaf))))
+
+(defun avy--update-offset-and-str (offset str lep)
+ "Recalculate the length of the new overlay at point.
+
+OFFSET is the previous overlay length.
+STR is the overlay string that we wish to add.
+LEP is the line end position.
+
+We want to add an overlay between point and END=point+OFFSET.
+When other overlays already exist between point and END, set
+OFFSET to be the difference between the start of the first
+overlay and point. This is equivalent to truncating our new
+overlay, so that it doesn't intersect with overlays that already
+exist."
+ (let* ((wnd (selected-window))
+ (beg (point))
+ (oov (delq nil
+ (mapcar
+ (lambda (o)
+ (and (eq (overlay-get o 'category) 'avy)
+ (eq (overlay-get o 'window) wnd)
+ (overlay-start o)))
+ (overlays-in beg (min (+ beg offset) lep))))))
+ (when oov
+ (setq offset (- (apply #'min oov) beg))
+ (setq str (substring str 0 offset)))
+ (let ((other-ov (cl-find-if
+ (lambda (o)
+ (and (eq (overlay-get o 'category) 'avy)
+ (eq (overlay-start o) beg)
+ (not (eq (overlay-get o 'window) wnd))))
+ (overlays-in (point) (min (+ (point) offset) lep)))))
+ (when (and other-ov
+ (> (overlay-end other-ov)
+ (+ beg offset)))
+ (setq str (concat str (buffer-substring
+ (+ beg offset)
+ (overlay-end other-ov))))
+ (setq offset (- (overlay-end other-ov)
+ beg))))
+ (cons offset str)))
+
+(defun avy--style-fn (style)
+ "Transform STYLE symbol to a style function."
+ (cl-case style
+ (pre #'avy--overlay-pre)
+ (at #'avy--overlay-at)
+ (at-full 'avy--overlay-at-full)
+ (post #'avy--overlay-post)
+ (de-bruijn #'avy--overlay-at-full)
+ (t (error "Unexpected style %S" style))))
+
+(defun avy--generic-jump (regex window-flip style &optional beg end)
+ "Jump to REGEX.
+When WINDOW-FLIP is non-nil, do the opposite of `avy-all-windows'.
+STYLE determines the leading char overlay style.
+BEG and END delimit the area where candidates are searched."
+ (let ((avy-all-windows
+ (if window-flip
+ (not avy-all-windows)
+ avy-all-windows)))
+ (avy--process
+ (avy--regex-candidates regex beg end)
+ (avy--style-fn style))))
+
+;;* Commands
+;;;###autoload
+(defun avy-goto-char (char &optional arg)
+ "Jump to the currently visible CHAR.
+The window scope is determined by `avy-all-windows' (ARG negates it)."
+ (interactive (list (read-char "char: " t)
+ current-prefix-arg))
+ (avy-with avy-goto-char
+ (avy--generic-jump
+ (if (= 13 char)
+ "\n"
+ (regexp-quote (string char)))
+ arg
+ avy-style)))
+
+;;;###autoload
+(defun avy-goto-char-in-line (char)
+ "Jump to the currently visible CHAR in the current line."
+ (interactive (list (read-char "char: " t)))
+ (avy-with avy-goto-char
+ (avy--generic-jump
+ (regexp-quote (string char))
+ avy-all-windows
+ avy-style
+ (line-beginning-position)
+ (line-end-position))))
+
+;;;###autoload
+(defun avy-goto-char-2 (char1 char2 &optional arg)
+ "Jump to the currently visible CHAR1 followed by CHAR2.
+The window scope is determined by `avy-all-windows' (ARG negates it)."
+ (interactive (list (read-char "char 1: " t)
+ (read-char "char 2: " t)
+ current-prefix-arg))
+ (avy-with avy-goto-char-2
+ (avy--generic-jump
+ (regexp-quote (string char1 char2))
+ arg
+ avy-style)))
+
+;;;###autoload
+(defun avy-isearch ()
+ "Jump to one of the current isearch candidates."
+ (interactive)
+ (avy-with avy-isearch
+ (let ((avy-background nil))
+ (avy--process
+ (avy--regex-candidates isearch-string)
+ (avy--style-fn avy-style))
+ (isearch-done))))
+
+;;;###autoload
+(defun avy-goto-word-0 (arg)
+ "Jump to a word start.
+The window scope is determined by `avy-all-windows' (ARG negates it)."
+ (interactive "P")
+ (avy-with avy-goto-word-0
+ (avy--generic-jump "\\b\\sw" arg avy-style)))
+
+;;;###autoload
+(defun avy-goto-word-1 (char &optional arg)
+ "Jump to the currently visible CHAR at a word start.
+The window scope is determined by `avy-all-windows' (ARG negates it)."
+ (interactive (list (read-char "char: " t)
+ current-prefix-arg))
+ (avy-with avy-goto-word-1
+ (let* ((str (string char))
+ (regex (cond ((string= str ".")
+ "\\.")
+ ((and avy-word-punc-regexp
+ (string-match avy-word-punc-regexp str))
+ (regexp-quote str))
+ (t
+ (concat
+ "\\b"
+ str)))))
+ (avy--generic-jump regex arg avy-style))))
+
+(declare-function subword-backward "subword")
+(defvar subword-backward-regexp)
+
+(defcustom avy-subword-extra-word-chars '(?{ ?= ?} ?* ?: ?> ?<)
+ "A list of characters that should temporarily match \"\\w\".
+This variable is used by `avy-goto-subword-0' and `avy-goto-subword-1'."
+ :type '(repeat character))
+
+;;;###autoload
+(defun avy-goto-subword-0 (&optional arg predicate)
+ "Jump to a word or subword start.
+
+The window scope is determined by `avy-all-windows' (ARG negates it).
+
+When PREDICATE is non-nil it's a function of zero parameters that
+should return true."
+ (interactive "P")
+ (require 'subword)
+ (avy-with avy-goto-subword-0
+ (let ((case-fold-search nil)
+ (subword-backward-regexp
+
"\\(\\(\\W\\|[[:lower:][:digit:]]\\)\\([!-/:@`~[:upper:]]+\\W*\\)\\|\\W\\w+\\)")
+ candidates)
+ (avy-dowindows arg
+ (let ((syn-tbl (copy-syntax-table)))
+ (dolist (char avy-subword-extra-word-chars)
+ (modify-syntax-entry char "w" syn-tbl))
+ (with-syntax-table syn-tbl
+ (let ((ws (window-start))
+ window-cands)
+ (save-excursion
+ (goto-char (window-end (selected-window) t))
+ (subword-backward)
+ (while (> (point) ws)
+ (when (or (null predicate)
+ (and predicate (funcall predicate)))
+ (unless (get-char-property (point) 'invisible)
+ (push (cons (point) (selected-window)) window-cands)))
+ (subword-backward)))
+ (setq candidates (nconc candidates window-cands))))))
+ (avy--process candidates (avy--style-fn avy-style)))))
+
+;;;###autoload
+(defun avy-goto-subword-1 (char &optional arg)
+ "Jump to the currently visible CHAR at a subword start.
+The window scope is determined by `avy-all-windows' (ARG negates it).
+The case of CHAR is ignored."
+ (interactive (list (read-char "char: " t)
+ current-prefix-arg))
+ (avy-with avy-goto-subword-1
+ (let ((char (downcase char)))
+ (avy-goto-subword-0
+ arg (lambda () (eq (downcase (char-after)) char))))))
+
+;;;###autoload
+(defun avy-goto-word-or-subword-1 ()
+ "Forward to `avy-goto-subword-1' or `avy-goto-word-1'.
+Which one depends on variable `subword-mode'."
+ (interactive)
+ (if (bound-and-true-p subword-mode)
+ (call-interactively #'avy-goto-subword-1)
+ (call-interactively #'avy-goto-word-1)))
+
+(defvar visual-line-mode)
+
+(defun avy--line (&optional arg beg end)
+ "Select a line.
+The window scope is determined by `avy-all-windows' (ARG negates it).
+Narrow the scope to BEG END."
+ (let (candidates)
+ (avy-dowindows arg
+ (let ((ws (or beg (window-start))))
+ (save-excursion
+ (save-restriction
+ (narrow-to-region ws (or end (window-end (selected-window) t)))
+ (goto-char (point-min))
+ (while (< (point) (point-max))
+ (unless (get-char-property
+ (max (1- (point)) ws) 'invisible)
+ (push (cons
+ (if (eq avy-style 'post)
+ (line-end-position)
+ (point))
+ (selected-window)) candidates))
+ (if visual-line-mode
+ (progn
+ (setq temporary-goal-column 0)
+ (line-move-visual 1 t))
+ (forward-line 1)))))))
+ (let ((avy-action #'identity))
+ (avy--process (nreverse candidates) (avy--style-fn avy-style)))))
+
+;;;###autoload
+(defun avy-goto-line (&optional arg)
+ "Jump to a line start in current buffer.
+
+When ARG is 1, jump to lines currently visible, with the option
+to cancel to `goto-line' by entering a number.
+
+When ARG is 4, negate the window scope determined by
+`avy-all-windows'.
+
+Otherwise, forward to `goto-line' with ARG."
+ (interactive "p")
+ (setq arg (or arg 1))
+ (if (not (memq arg '(1 4)))
+ (progn
+ (goto-char (point-min))
+ (forward-line (1- arg)))
+ (avy-with avy-goto-line
+ (let* ((avy-handler-function
+ (lambda (char)
+ (if (or (< char ?0)
+ (> char ?9))
+ (avy-handler-default char)
+ (let ((line (read-from-minibuffer
+ "Goto line: " (string char))))
+ (when line
+ (avy-push-mark)
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (forward-line (1- (string-to-number line))))
+ (throw 'done 'exit))))))
+ (r (avy--line (eq arg 4))))
+ (unless (eq r t)
+ (avy-action-goto r))))))
+
+;;;###autoload
+(defun avy-goto-line-above ()
+ "Goto visible line above the cursor."
+ (interactive)
+ (let* ((avy-all-windows nil)
+ (r (avy--line nil (window-start)
+ (line-beginning-position))))
+ (unless (eq r t)
+ (avy-action-goto r))))
+
+;;;###autoload
+(defun avy-goto-line-below ()
+ "Goto visible line below the cursor."
+ (interactive)
+ (let* ((avy-all-windows nil)
+ (r (avy--line
+ nil (line-beginning-position 2)
+ (window-end (selected-window) t))))
+ (unless (eq r t)
+ (avy-action-goto r))))
+
+(defcustom avy-line-insert-style 'above
+ "How to insert the newly copied/cut line."
+ :type '(choice
+ (const :tag "Above" above)
+ (const :tag "Below" below)))
+
+;;;###autoload
+(defun avy-copy-line (arg)
+ "Copy a selected line above the current line.
+ARG lines can be used."
+ (interactive "p")
+ (let ((initial-window (selected-window)))
+ (avy-with avy-copy-line
+ (let* ((start (avy--line))
+ (str (buffer-substring-no-properties
+ start
+ (save-excursion
+ (goto-char start)
+ (move-end-of-line arg)
+ (point)))))
+ (select-window initial-window)
+ (cond ((eq avy-line-insert-style 'above)
+ (beginning-of-line)
+ (save-excursion
+ (insert str "\n")))
+ ((eq avy-line-insert-style 'below)
+ (end-of-line)
+ (insert "\n" str)
+ (beginning-of-line))
+ (t
+ (user-error "Unexpected `avy-line-insert-style'")))))))
+
+;;;###autoload
+(defun avy-move-line (arg)
+ "Move a selected line above the current line.
+ARG lines can be used."
+ (interactive "p")
+ (let ((initial-window (selected-window)))
+ (avy-with avy-move-line
+ (let ((start (avy--line)))
+ (save-excursion
+ (goto-char start)
+ (kill-whole-line arg))
+ (select-window initial-window)
+ (cond ((eq avy-line-insert-style 'above)
+ (beginning-of-line)
+ (save-excursion
+ (insert
+ (current-kill 0))))
+ ((eq avy-line-insert-style 'below)
+ (end-of-line)
+ (newline)
+ (save-excursion
+ (insert (substring (current-kill 0) 0 -1))))
+ (t
+ (user-error "Unexpected `avy-line-insert-style'")))))))
+
+;;;###autoload
+(defun avy-copy-region (arg)
+ "Select two lines and copy the text between them to point.
+
+The window scope is determined by `avy-all-windows' or
+`avy-all-windows-alt' when ARG is non-nil."
+ (interactive "P")
+ (let ((initial-window (selected-window)))
+ (avy-with avy-copy-region
+ (let* ((beg (save-selected-window
+ (avy--line arg)))
+ (end (avy--line arg))
+ (str (buffer-substring-no-properties
+ beg
+ (save-excursion
+ (goto-char end)
+ (line-end-position)))))
+ (select-window initial-window)
+ (cond ((eq avy-line-insert-style 'above)
+ (beginning-of-line)
+ (save-excursion
+ (insert str "\n")))
+ ((eq avy-line-insert-style 'below)
+ (end-of-line)
+ (newline)
+ (save-excursion
+ (insert str)))
+ (t
+ (user-error "Unexpected `avy-line-insert-style'")))))))
+
+;;;###autoload
+(defun avy-setup-default ()
+ "Setup the default shortcuts."
+ (eval-after-load "isearch"
+ '(define-key isearch-mode-map (kbd "C-'") 'avy-isearch)))
+
+(defcustom avy-timeout-seconds 0.5
+ "How many seconds to wait for the second char.")
+
+(defun avy--read-candidates ()
+ "Read as many chars as possible and return their occurences.
+At least one char must be read, and then repeatedly one next char
+may be read if it is entered before `avy-timeout-seconds'. `DEL'
+deletes the last char entered, and `RET' exits with the currently
+read string immediately instead of waiting for another char for
+`avy-timeout-seconds'.
+The format of the result is the same as that of `avy--regex-candidates'.
+This function obeys `avy-all-windows' setting."
+ (let ((str "") char break overlays regex)
+ (unwind-protect
+ (progn
+ (while (and (not break)
+ (setq char
+ (read-char (format "char%s: "
+ (if (string= str "")
+ str
+ (format " (%s)" str)))
+ t
+ (and (not (string= str ""))
+ avy-timeout-seconds))))
+ ;; Unhighlight
+ (dolist (ov overlays)
+ (delete-overlay ov))
+ (setq overlays nil)
+ (cond
+ ;; Handle RET
+ ((= char 13)
+ (setq break t))
+ ;; Handle DEL
+ ((= char 127)
+ (let ((l (length str)))
+ (when (>= l 1)
+ (setq str (substring str 0 (1- l))))))
+ (t
+ (setq str (concat str (list char)))))
+ ;; Highlight
+ (when (>= (length str) 1)
+ (let ((case-fold-search
+ (or avy-case-fold-search (string= str (downcase str))))
+ found)
+ (avy-dowindows current-prefix-arg
+ (dolist (pair (avy--find-visible-regions
+ (window-start)
+ (window-end (selected-window) t)))
+ (save-excursion
+ (goto-char (car pair))
+ (setq regex (regexp-quote str))
+ (while (re-search-forward regex (cdr pair) t)
+ (unless (get-char-property (1- (point)) 'invisible)
+ (let ((ov (make-overlay
+ (match-beginning 0)
+ (match-end 0))))
+ (setq found t)
+ (push ov overlays)
+ (overlay-put ov 'window (selected-window))
+ (overlay-put ov 'face
'avy-goto-char-timer-face)))))))
+ ;; No matches at all, so there's surely a typo in the input.
+ (unless found (beep)))))
+ (nreverse (mapcar (lambda (ov)
+ (cons (cons (overlay-start ov)
+ (overlay-end ov))
+ (overlay-get ov 'window)))
+ overlays)))
+ (dolist (ov overlays)
+ (delete-overlay ov)))))
+
+;;;###autoload
+(defun avy-goto-char-timer (&optional arg)
+ "Read one or many consecutive chars and jump to the first one.
+The window scope is determined by `avy-all-windows' (ARG negates it)."
+ (interactive "P")
+ (let ((avy-all-windows (if arg
+ (not avy-all-windows)
+ avy-all-windows)))
+ (avy-with avy-goto-char-timer
+ (avy--process
+ (avy--read-candidates)
+ (avy--style-fn avy-style)))))
+
+(defvar avy-ring (make-ring 20)
+ "Hold the window and point history.")
+
+(defun avy-push-mark ()
+ "Store the current point and window."
+ (ring-insert avy-ring
+ (cons (point) (selected-window)))
+ (unless (region-active-p)
+ (push-mark)))
+
+(defun avy-pop-mark ()
+ "Jump back to the last location of `avy-push-mark'."
+ (interactive)
+ (let (res)
+ (condition-case nil
+ (progn
+ (while (not (window-live-p
+ (cdr (setq res (ring-remove avy-ring 0))))))
+ (let* ((window (cdr res))
+ (frame (window-frame window)))
+ (when (and (frame-live-p frame)
+ (not (eq frame (selected-frame))))
+ (select-frame-set-input-focus frame))
+ (select-window window)
+ (goto-char (car res))))
+ (error
+ (set-mark-command 4)))))
+
+(define-obsolete-function-alias
+ 'avy--goto 'identity "0.3.0"
+ "Don't use this function any more.
+`avy--process' will do the jump all by itself.")
+
+(define-obsolete-function-alias 'avy--with-avy-keys 'avy-with "0.3.0")
+
+(provide 'avy)
+
+;;; avy.el ends here
diff --git a/packages/avy/doc/Changelog.org b/packages/avy/doc/Changelog.org
new file mode 100644
index 0000000..6d5b80c
--- /dev/null
+++ b/packages/avy/doc/Changelog.org
@@ -0,0 +1,325 @@
+* 0.3.0
+** Fixes
+*** Candidate window reversal
+See [[https://github.com/abo-abo/avy/issues/27][#27]].
+
+*** Jumping to newlines with =at-full= style
+See [[https://github.com/abo-abo/avy/issues/5][#5]].
+
+*** Stop =at-full= style from shifting text sometimes
+See [[https://github.com/abo-abo/avy/issues/5][#5]].
+
+*** Fix =at-full= interaction with tabs
+When at a tab, visualize it using =tab-width= spaces.
+
+See [[https://github.com/abo-abo/avy/issues/43][#43]].
+
+*** Fix overlay issue when the same buffer is in two windows
+
+See [[https://github.com/abo-abo/avy/issues/47][#47]] and
http://debbugs.gnu.org/cgi/bugreport.cgi?bug=20607.
+
+*** Quote punctuation chars
+
+See [[https://github.com/abo-abo/avy/issues/63][#63]].
+
+*** Update screenshot for =avy-goto-char= in README.md
+Use ~C-:~ as the new suggested binding instead of the pi char.
+
+See [[https://github.com/abo-abo/avy/issues/64][#64]].
+
+** New Features
+*** =avy-goto-line= can now break into =goto-line=
+Just enter a digit and you'll be transferred into =goto-line= prompt
+with that digit already entered. This means that you can just bind
+~M-g g~ to =avy-goto-line= without losing anything.
+
+See [[https://github.com/abo-abo/avy/issues/29][#29]].
+
+*** =avy-goto-line= now works with all kinds of overlay styles
+Any of the following do something different now:
+
+#+begin_src elisp
+(setq avy-styles-alist
+ '((avy-goto-line . post)))
+(setq avy-styles-alist
+ '((avy-goto-line . at)))
+(setq avy-styles-alist
+ '((avy-goto-line . at-full)))
+(setq avy-styles-alist
+ '((avy-goto-line . pre)))
+#+end_src
+
+See [[https://github.com/abo-abo/ace-link/issues/17][#17]].
+
+*** New defcustom =avy-case-fold-search=
+Non-nil when searches should ignore case, so e.g. =avy-goto-char= "b"
+will match both "b" and "B". On by default. Use this to turn off this
+behavior:
+
+#+begin_src elisp
+(setq avy-case-fold-search nil)
+#+end_src
+
+See [[https://github.com/abo-abo/avy/issues/34][#34]].
+
+*** New command =avy-goto-word-or-subword-1=
+
+Enter one char, and select a visible word or subword that starts with
+it, depending on =subword-mode=. Move the point there.
+
+See [[https://github.com/abo-abo/avy/issues/33][#33]].
+
+*** =avy-move-line= should remove empty line after original one is moved
+
+See [[https://github.com/abo-abo/avy/issues/40][#40]].
+
+*** =avy-move-line= now takes a prefix arg
+Use e.g. ~M-3~ before =avy-move-line= to move 3 lines at once.
+
+*** Most commands can be used non-interactively
+Example:
+#+begin_src elisp
+(defun avy-goto-lp ()
+ (interactive)
+ (avy-goto-char ?\())
+#+end_src
+
+This command only goes to the "(" character. This is actually very
+similar to [[http://oremacs.com/lispy/#lispy-ace-paren][=lispy-ace-paren=]],
except the implementation is only one
+line.
+
+See [[https://github.com/abo-abo/avy/issues/44][#44]].
+
+*** (almost) all defcustoms are explained on the wiki
+
+See [[https://github.com/abo-abo/avy/wiki/defcustom][the defcustom wiki page]].
+
+*** Allow all operations to work across frames
+
+You have to customize =avy-all-windows= for this. By default, it's set
+to work on all windows on the current frame.
+
+To make it work only on the current window, use:
+#+begin_src elisp
+(setq avy-all-windows nil)
+#+end_src
+
+To make it work on all frames, use:
+#+begin_src elisp
+(setq avy-all-windows 'all-frames)
+#+end_src
+
+*** New command =avy-goto-char-in-line=
+
+This is =avy-goto-char= reduced only to the current line. Few
+candidates means very short decision chars path.
+
+See [[https://github.com/abo-abo/avy/issues/49][#49]].
+
+*** New overlay style =de-bruijn=
+
+How to use it:
+
+#+begin_src elisp
+(setq avy-style 'de-bruijn)
+#+end_src
+
+What it does: when your leading chars are clumped up together, it's
+impossible to overlay the decision path without shifting the buffer
+text a bit. For example, with the word "buffer", you =avy-goto-char= "b", and:
+
+- the path for the first "f" is "aj"
+- the path for the second "f" is "ak"
+
+It's not possible to overlay 4 characters over "ff" in "buffer". But
+to with =de-bruijn= style, which results in the path being "aj" and
+"jk". It's possible to overlay "ajk" just fine.
+
+Pros and cons of =de-bruijn= over other styles:
+
+- a pro is that it's possible to display the full decision path for
+ clumped up chars, which is truncated for other styles
+- a con is that the decision path is of the same length (e.g. 2 or 3)
+ for all candidates, while with other styles it's possible to have a
+ few candidets with a shorter path.
+
+See [[https://github.com/abo-abo/avy/issues/51][#51]] and
[[https://github.com/abo-abo/avy/issues/5][#5]].
+
+*** New defcustom =avy-ignored-modes=
+
+This is meant for visual modes like =doc-view-mode= or =image-mode=
+that can have a huge number of chars in a single window. Which results
+in a huge number of candidates even in other windows.
+
+Current setting:
+
+#+begin_src elisp
+(setq avy-ignored-modes '(image-mode doc-view-mode pdf-view-mode))
+#+end_src
+
+See [[https://github.com/abo-abo/avy/issues/57][#57]].
+
+*** New tutorial on writing custom commands
+
+See the [[https://github.com/abo-abo/avy/wiki/custom-commands][the
custom-commands wiki page]] and
[[https://github.com/abo-abo/avy/issues/55][#55]].
+
+*** New face setup
+New variable =avy-lead-faces= will determine the faces used to color
+the current decision depth you're in. For example, if to select a
+particular candidate you need to press "abc":
+
+- "a" will be highlighted with a face that corresponds to depth 3
+- "b" will be highlighted with a face that corresponds to depth 2
+- "c" will be highlighted with a face that corresponds to depth 1
+
+But if another candidate needs "ef":
+
+- "e" will be highlighted with a face that corresponds to depth 2
+- "f" will be highlighted with a face that corresponds to depth 1
+
+See [[https://github.com/abo-abo/avy/issues/53][#53]].
+
+*** New variable =avy-translate-char-function=
+
+You can use this, for example, to interpret one character as another in
=avy-keys=.
+
+Example:
+#+begin_src elisp
+(setq avy-translate-char-function
+ (lambda (c) (if (= c 32) ?a c)))
+#+end_src
+
+This will translate ~SPC~ (32) into ~a~. So you can press either ~a~ or ~SPC~
to mean "a".
+
+*** =avy-isearch= works for different styles
+
+See [[https://github.com/abo-abo/avy/issues/61][#61]].
+
+*** Switch the default style from =pre= to =at-full=
+
+I've come to like =at-full= more than =pre= over time. The difference
+is that =pre= hides no chars in your buffer, while =at-full= doesn't
+shift text.
+
+Use this to restore the previous default behavior:
+#+begin_src elisp
+(setq avy-style 'pre)
+#+end_src
+* 0.4.0
+** Fixes
+*** =avy-goto-char-timer= obeys =avy-styles-alist=
+See [[https://github.com/abo-abo/avy/issues/67][#67]].
+*** Add =de-bruijn= to the defcustom of =avy-styles-alist=
+See [[https://github.com/abo-abo/avy/issues/73][#73]].
+*** Respect the current input method for target chars
+See [[https://github.com/abo-abo/avy/issues/76][#76]].
+*** =avy-goto-subword-0= shouldn't offer invisible chars
+See [[https://github.com/abo-abo/avy/issues/90][#90]].
+*** Better =case-fold-search= handling
+See [[https://github.com/abo-abo/avy/issues/87][#87]].
+*** Add misc punctuation to subword commands
+See [[https://github.com/abo-abo/avy/issues/93][#93]].
+*** Add padding for wide-width chars (ex. Japanese and Chinese)
+See [[https://github.com/abo-abo/avy/issues/96][#96]].
+*** =avy-goto-line=
+**** Push mark for numeric line
+See [[https://github.com/abo-abo/avy/issues/74][#74]].
+**** Allow numeric prefix arg
+The old behavior remains for ARG 1 or 4. For all other ARG, simply go
+to that line.
+See [[https://github.com/abo-abo/avy/issues/86][#86]].
+**** Work for =visual-line-mode=
+See [[https://github.com/abo-abo/avy/issues/91][#91]].
+**** Don't error on end of buffer
+See [[https://github.com/abo-abo/avy/issues/91][#91]].
+**** Obey =avy-background=
+See [[https://github.com/abo-abo/avy/issues/94][#94]].
+**** Fix for narrowed regions
+See [[https://github.com/abo-abo/avy/issues/122][#122]],
[[https://github.com/abo-abo/avy/issues/123][#123]].
+**** Don't modify =avy-action=
+See [[https://github.com/abo-abo/avy/issues/124][#124]].
+*** =avy-goto-char-timer=
+**** May read as many chars as you want
+See [[https://github.com/abo-abo/avy/issues/97][#97]].
+**** Highlight matches while reading chars
+See [[https://github.com/abo-abo/avy/issues/98][#98]].
+**** Highlight depending on =avy-all-windows=
+See [[https://github.com/abo-abo/avy/issues/104][#104]].
+**** Make faster for =org-mode=
+See [[https://github.com/abo-abo/avy/issues/100][#100]].
+**** Add case fold search
+See [[https://github.com/abo-abo/avy/issues/128][#128]].
+*** =avy-copy-region=
+**** Keep the same selectors for the second pass
+See [[https://github.com/abo-abo/avy/issues/120][#120]],
[[https://github.com/abo-abo/avy/issues/121][#121]].
+**** Copy/move to initial window
+See [[https://github.com/abo-abo/avy/issues/131][#131]].
+*** Search only in the visible region
+See [[https://github.com/abo-abo/avy/issues/108][#108]],
[[https://github.com/abo-abo/avy/issues/109][#109]].
+*** Fix jumping to the last char of a folded Org outline
+See [[https://github.com/abo-abo/avy/issues/108][#108]].
+*** Fix for both =org-indent-mode= and =visual-line-mode=
+See [[https://github.com/abo-abo/avy/issues/110][#110]].
+*** Beep when there are no matches
+See [[https://github.com/abo-abo/avy/issues/111][#111]].
+*** Simplify overlay code
+Most functions reuse =avy--overlay= now.
+*** Fix de-bruijn "no catch for tag"
+See [[https://github.com/abo-abo/avy/issues/116][#116]].
+*** Fix overlays at =point-max=
+See [[https://github.com/abo-abo/avy/issues/125][#125]].
+*** Improve =case-fold-search= condition
+See [[https://github.com/abo-abo/avy/issues/126][#126]].
+*** Don't shorten selector string for =visual-line-mode= and =bolp=
+See [[https://github.com/abo-abo/avy/issues/129][#129]].
+*** Fix interaction with =goto-address-mode=
+** New Features
+*** Allow non-printing keys in =avy-keys=
+Now you can set avy-keys also to the arrow keys and page up/down, e.g.
+
+#+begin_src elisp
+(setq avy-keys '(left right up down prior next))
+#+end_src
+
+and those will be displayed as ▲, ▼, ◀, ▶, △, ▽ in the overlays. The
+display is controlled by the variable =avy-key-to-char-alist=.
+
+See [[https://github.com/abo-abo/avy/issues/77][#77]].
+*** Allow to switch action midway from goto to kill/mark/copy
+For example, suppose you have:
+
+#+begin_src elisp
+(global-set-key (kbd "M-t") 'avy-goto-word-1)
+#+end_src
+
+- To jump to a certain word starting with "w" (e.g. first one on
+ screen): ~M-t w a~
+- To copy the word instead of jumping to it: ~M-t w na~.
+- To mark the word after jumping to it: ~M-t w ma~.
+- To kill the word after jumping to it: ~M-t w xa~.
+
+You can customize =avy-dispatch-alist= to modify these actions.
+
+See [[https://github.com/abo-abo/avy/issues/78][#78]].
+
+*** New command =avy-pop-mark=
+Goes back to the last location of =push-mark=:
+
+- has its own history,
+- handles multiple frames.
+
+See [[https://github.com/abo-abo/avy/issues/81][#81]]
[[https://github.com/abo-abo/avy/issues/88][#88]]
[[https://github.com/abo-abo/avy/issues/69][#69]].
+*** New commands =avy-goto-line-above= and =avy-goto-line-below=
+See [[https://github.com/abo-abo/avy/issues/106][#106]].
+*** New defcustom =avy-line-insert-style=
+Allows to modify the behavior of =avy-copy-line=, =avy-move-line=, and
=avy-copy-region=.
+See [[https://github.com/abo-abo/avy/issues/117][#117]].
+*** New defcustom =avy-all-windows-alt=
+Allows to customize the behavior of =universal-argument= modifying
+=avy-all-windows=.
+See [[https://github.com/abo-abo/avy/issues/118][#118]].
+*** New defcustom =avy-subword-extra-word-chars=
+Allows to customize the behavior of =avy-goto-subword-0= and
+=avy-goto-subword-1= by adding extra chars that should match as word
+constituents.
+See [[https://github.com/abo-abo/avy/issues/116][#116]].
diff --git a/packages/hydra/hydra-init.el b/packages/avy/targets/avy-init.el
similarity index 70%
copy from packages/hydra/hydra-init.el
copy to packages/avy/targets/avy-init.el
index 80b4159..9ce46bb 100644
--- a/packages/hydra/hydra-init.el
+++ b/packages/avy/targets/avy-init.el
@@ -1,4 +1,4 @@
-;;; hydra-test.el --- bare hydra init
+;;; avy-init.el --- bare avy init
;; Copyright (C) 2015 Free Software Foundation, Inc.
@@ -20,10 +20,13 @@
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
(add-to-list 'load-path default-directory)
-(require 'hydra)
-(setq hydra-examples-verbatim t)
-(require 'hydra-examples)
-(require 'hydra-test)
-(mapc #'byte-compile-file '("hydra.el"))
-(switch-to-buffer "*Compile-Log*")
-(ert t)
+(mapc #'byte-compile-file '("avy.el"))
+(require 'avy)
+(if (fboundp 'checkdoc-file)
+ (checkdoc-file "avy.el")
+ (require 'checkdoc)
+ (with-current-buffer (find-file "avy.el")
+ (checkdoc-current-buffer t)))
+
+(global-set-key (kbd "C-c j") 'avy-goto-char)
+(global-set-key (kbd "C-'") 'avy-goto-char-2)
diff --git a/packages/beacon/COPYING b/packages/beacon/COPYING
new file mode 100644
index 0000000..92b370f
--- /dev/null
+++ b/packages/beacon/COPYING
@@ -0,0 +1,674 @@
+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/beacon/Readme.org b/packages/beacon/Readme.org
new file mode 100644
index 0000000..50631c8
--- /dev/null
+++ b/packages/beacon/Readme.org
@@ -0,0 +1,41 @@
+#+TITLE: Beacon --- Never lose your cursor again
+
+This is a global minor-mode. Turn it on everywhere with:
+#+BEGIN_SRC emacs-lisp
+(beacon-mode 1)
+#+END_SRC
+
+[[file:example-beacon.gif]]
+
+Whenever the window scrolls a light will shine on top of your cursor
+so you know where it is.
+
+That’s it.
+
+** Customizations
+
+- The appearance of the beacon is configured by ~beacon-size~ and
+ ~beacon-color~.
+
+- The duration is configured by ~beacon-blink-duration~ and
+ ~beacon-blink-delay~.
+
+- To customize /when/ the beacon should blink at all, configure
+ ~beacon-blink-when-window-scrolls~,
+ ~beacon-blink-when-window-changes~, and
+ ~beacon-blink-when-point-moves~.
+
+- To prevent the beacon from blinking only on specific situations
+ configure ~beacon-dont-blink-major-modes~,
+ ~beacon-dont-blink-predicates~, or ~beacon-dont-blink-commands~. You
+ can also disable it only in specific buffers by doing
+ ~(setq-local beacon-mode nil)~.
+
+- Beacon can also push the mark for you whenever point moves a long
+ distance. For this, configure ~beacon-push-mark~.
+
+** Contributors
+
+- [[https://github.com/tsdh][Tassilo Horn]]
+
+If you’d like to help too, just open a PR.
diff --git a/packages/beacon/beacon.el b/packages/beacon/beacon.el
new file mode 100644
index 0000000..4226149
--- /dev/null
+++ b/packages/beacon/beacon.el
@@ -0,0 +1,459 @@
+;;; beacon.el --- Highlight the cursor whenever the window scrolls -*-
lexical-binding: t; -*-
+
+;; Copyright (C) 2015 Free Software Foundation, Inc.
+
+;; Author: Artur Malabarba <address@hidden>
+;; URL: https://github.com/Malabarba/beacon
+;; Keywords: convenience
+;; Version: 1.0
+;; Package-Requires: ((seq "1.11"))
+
+;; 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 is a global minor-mode. Turn it on everywhere with:
+;; ┌────
+;; │ (beacon-mode 1)
+;; └────
+;;
+;; Whenever the window scrolls a light will shine on top of your cursor so
+;; you know where it is.
+;;
+;; That’s it.
+;;
+;; See the accompanying Readme.org for configuration details.
+
+;;; Code:
+
+(require 'seq)
+(require 'faces)
+(unless (fboundp 'seq-mapn)
+ ;; This is for people who are on outdated Emacs snapshots. Will be
+ ;; deleted in a couple of weeks.
+ (defun seq-mapn (function sequence &rest sequences)
+ "Like `seq-map' but FUNCTION is mapped over all SEQUENCES.
+The arity of FUNCTION must match the number of SEQUENCES, and the
+mapping stops on the shortest sequence.
+Return a list of the results.
+
+\(fn FUNCTION SEQUENCES...)"
+ (let ((result nil)
+ (sequences (seq-map (lambda (s) (seq-into s 'list))
+ (cons sequence sequences))))
+ (while (not (memq nil sequences))
+ (push (apply function (seq-map #'car sequences)) result)
+ (setq sequences (seq-map #'cdr sequences)))
+ (nreverse result))))
+
+(defgroup beacon nil
+ "Customization group for beacon."
+ :group 'emacs
+ :prefix "beacon-")
+
+(defvar beacon--timer nil)
+
+(defcustom beacon-push-mark 35
+ "Should the mark be pushed before long movements?
+If nil, `beacon' will not push the mark.
+Otherwise this should be a number, and `beacon' will push the
+mark whenever point moves more than that many lines."
+ :type '(choice integer (const nil)))
+
+(defcustom beacon-blink-when-point-moves-vertically nil
+ "Should the beacon blink when moving a long distance vertically?
+If nil, don't blink due to vertical movement.
+If non-nil, this should be an integer, which is the minimum
+movement distance (in lines) that triggers a beacon blink."
+ :type '(choice integer (const nil)))
+
+(defcustom beacon-blink-when-point-moves-horizontally nil
+ "Should the beacon blink when moving a long distance horizontally?
+If nil, don't blink due to horizontal movement.
+If non-nil, this should be an integer, which is the minimum
+movement distance (in columns) that triggers a beacon blink."
+ :type '(choice integer (const nil)))
+
+(defcustom beacon-blink-when-buffer-changes t
+ "Should the beacon blink when changing buffer?"
+ :type 'boolean)
+
+(defcustom beacon-blink-when-window-scrolls t
+ "Should the beacon blink when the window scrolls?"
+ :type 'boolean)
+
+(defcustom beacon-blink-when-window-changes t
+ "Should the beacon blink when the window changes?"
+ :type 'boolean)
+
+(defcustom beacon-blink-when-focused nil
+ "Should the beacon blink when Emacs gains focus?
+Note that, due to a limitation of `focus-in-hook', this might
+trigger false positives on some systems."
+ :type 'boolean
+ :package-version '(beacon . "0.2"))
+
+(defcustom beacon-blink-duration 0.3
+ "Time, in seconds, that the blink should last."
+ :type 'number)
+
+(defcustom beacon-blink-delay 0.3
+ "Time, in seconds, before starting to fade the beacon."
+ :type 'number)
+
+(defcustom beacon-size 40
+ "Size of the beacon in characters."
+ :type 'number)
+
+(defcustom beacon-color 0.5
+ "Color of the beacon.
+This can be a string or a number.
+
+If it is a number, the color is taken to be white or
+black (depending on the current theme's background) and this
+number is a float between 0 and 1 specifing the brightness.
+
+If it is a string, it is a color name or specification,
+e.g. \"#666600\"."
+ :type '(choice number color))
+
+(defface beacon-fallback-background
+ '((((class color) (background light)) (:background "black"))
+ (((class color) (background dark)) (:background "white")))
+ "Fallback beacon background color.
+Used in cases where the color can't be determined by Emacs.
+Only the background of this face is used.")
+
+(defvar beacon-dont-blink-predicates nil
+ "A list of predicates that prevent the beacon blink.
+These predicate functions are called in order, with no
+arguments, before blinking the beacon. If any returns
+non-nil, the beacon will not blink.
+
+For instance, if you want to disable beacon on buffers where
+`hl-line-mode' is on, you can do:
+
+ (add-hook \\='beacon-dont-blink-predicates
+ (lambda () (bound-and-true-p hl-line-mode)))")
+
+(add-hook 'beacon-dont-blink-predicates #'window-minibuffer-p)
+
+(defcustom beacon-dont-blink-major-modes '(t magit-status-mode magit-popup-mode
+ inf-ruby-mode
+ gnus-summary-mode gnus-group-mode)
+ "A list of major-modes where the beacon won't blink.
+Whenever the current buffer satisfies `derived-mode-p' for
+one of the major-modes on this list, the beacon will not
+blink."
+ :type '(repeat symbol))
+
+(defcustom beacon-dont-blink-commands '(next-line previous-line
+ forward-line)
+ "A list of commands that should not make the beacon blink.
+Use this for commands that scroll the window in very
+predictable ways, when the blink would be more distracting
+than helpful.."
+ :type '(repeat symbol))
+
+
+;;; Internal variables
+(defvar beacon--window-scrolled nil)
+(defvar beacon--previous-place nil)
+(defvar beacon--previous-mark-head nil)
+(defvar beacon--previous-window nil)
+(defvar beacon--previous-window-start 0)
+
+(defun beacon--record-vars ()
+ (unless (window-minibuffer-p)
+ (setq beacon--previous-mark-head (car mark-ring))
+ (setq beacon--previous-place (point-marker))
+ (setq beacon--previous-window (selected-window))
+ (setq beacon--previous-window-start (window-start))))
+
+
+;;; Overlays
+(defvar beacon--ovs nil)
+
+(defconst beacon-overlay-priority (/ most-positive-fixnum 2)
+ "Priotiy used on all of our overlays.")
+
+(defun beacon--make-overlay (length &rest properties)
+ "Put an overlay at point with background COLOR."
+ (let ((ov (make-overlay (point) (+ length (point)))))
+ (overlay-put ov 'beacon t)
+ ;; Our overlay is very temporary, so we take the liberty of giving
+ ;; it a high priority.
+ (overlay-put ov 'priority beacon-overlay-priority)
+ (overlay-put ov 'window (selected-window))
+ (while properties
+ (overlay-put ov (pop properties) (pop properties)))
+ (push ov beacon--ovs)
+ ov))
+
+(defun beacon--colored-overlay (color)
+ "Put an overlay at point with background COLOR."
+ (beacon--make-overlay 1 'face (list :background color)))
+
+(defun beacon--ov-put-after-string (overlay colors)
+ "Add an after-string property to OVERLAY.
+The property's value is a string of spaces with background
+COLORS applied to each one.
+If COLORS is nil, OVERLAY is deleted!"
+ (if (not colors)
+ (when (overlayp overlay)
+ (delete-overlay overlay))
+ (overlay-put overlay 'beacon-colors colors)
+ (overlay-put overlay 'after-string
+ (propertize
+ (mapconcat (lambda (c) (propertize " " 'face (list
:background c)))
+ colors
+ "")
+ 'cursor 1000))))
+
+(defun beacon--after-string-overlay (colors)
+ "Put an overlay at point with an after-string property.
+The property's value is a string of spaces with background
+COLORS applied to each one."
+ ;; The after-string must not be longer than the remaining columns
+ ;; from point to right window-end else it will be wrapped around.
+ (let ((colors (seq-take colors (- (window-width) (current-column)))))
+ (beacon--ov-put-after-string (beacon--make-overlay 0) colors)))
+
+(defun beacon--ov-at-point ()
+ (car (or (seq-filter (lambda (o) (overlay-get o 'beacon))
+ (overlays-in (point) (point)))
+ (seq-filter (lambda (o) (overlay-get o 'beacon))
+ (overlays-at (point))))))
+
+(defun beacon--vanish ()
+ "Turn off the beacon."
+ (when (timerp beacon--timer)
+ (cancel-timer beacon--timer))
+ (mapc #'delete-overlay beacon--ovs)
+ (setq beacon--ovs nil))
+
+
+;;; Colors
+(defun beacon--int-range (a b)
+ "Return a list of integers between A inclusive and B exclusive.
+Only returns `beacon-size' elements."
+ (let ((d (/ (- b a) beacon-size))
+ (out (list a)))
+ (dotimes (_ (1- beacon-size))
+ (push (+ (car out) d) out))
+ (nreverse out)))
+
+(defun beacon--color-range ()
+ "Return a list of background colors for the beacon."
+ (let* ((default-bg (or (save-excursion
+ (unless (eobp)
+ (forward-line 1)
+ (unless (or (bobp) (not (bolp)))
+ (forward-char -1)))
+ (background-color-at-point))
+ (face-background 'default)))
+ (bg (color-values (if (or (not (stringp default-bg))
+ (string-match "\\`unspecified-" default-bg))
+ (face-attribute 'beacon-fallback-background
:background)
+ default-bg)))
+ (fg (cond
+ ((stringp beacon-color) (color-values beacon-color))
+ ((and (stringp bg)
+ (< (color-distance "black" bg)
+ (color-distance "white" bg)))
+ (make-list 3 (* beacon-color 65535)))
+ (t (make-list 3 (* (- 1 beacon-color) 65535))))))
+ (apply #'seq-mapn (lambda (r g b) (format "#%04x%04x%04x" r g b))
+ (mapcar (lambda (n) (butlast (beacon--int-range (elt fg n) (elt bg
n))))
+ [0 1 2]))))
+
+
+;;; Blinking
+(defun beacon--shine ()
+ "Shine a beacon at point."
+ (let ((colors (beacon--color-range)))
+ (save-excursion
+ (while colors
+ (if (looking-at "$")
+ (progn
+ (beacon--after-string-overlay colors)
+ (setq colors nil))
+ (beacon--colored-overlay (pop colors))
+ (forward-char 1))))))
+
+(defun beacon--dec ()
+ "Decrease the beacon brightness by one."
+ (pcase (beacon--ov-at-point)
+ (`nil (beacon--vanish))
+ ((and o (let c (overlay-get o 'beacon-colors)) (guard c))
+ (beacon--ov-put-after-string o (cdr c)))
+ (o
+ (delete-overlay o)
+ (save-excursion
+ (while (and (condition-case nil
+ (progn (forward-char 1) t)
+ (end-of-buffer nil))
+ (setq o (beacon--ov-at-point)))
+ (let ((colors (overlay-get o 'beacon-colors)))
+ (if (not colors)
+ (move-overlay o (1- (point)) (point))
+ (forward-char -1)
+ (beacon--colored-overlay (pop colors))
+ (beacon--ov-put-after-string o colors)
+ (forward-char 1))))))))
+
+;;;###autoload
+(defun beacon-blink ()
+ "Blink the beacon at the position of the cursor.
+Unlike `beacon-blink-automated', the beacon will blink
+unconditionally (even if `beacon-mode' is disabled), and this can
+be invoked as a user command or called from lisp code."
+ (interactive)
+ (beacon--vanish)
+ (beacon--shine)
+ (setq beacon--timer
+ (run-at-time beacon-blink-delay
+ (/ beacon-blink-duration 1.0 beacon-size)
+ #'beacon--dec)))
+
+(defun beacon-blink-automated ()
+ "If appropriate, blink the beacon at the position of the cursor.
+Unlike `beacon-blink', the blinking is conditioned on a series of
+variables: `beacon-mode', `beacon-dont-blink-commands',
+`beacon-dont-blink-major-modes', and
+`beacon-dont-blink-predicates'."
+ ;; Record vars here in case something is blinking outside the
+ ;; command loop.
+ (beacon--record-vars)
+ (unless (or (not beacon-mode)
+ (run-hook-with-args-until-success 'beacon-dont-blink-predicates)
+ (seq-find #'derived-mode-p beacon-dont-blink-major-modes)
+ (memq (or this-command last-command) beacon-dont-blink-commands))
+ (beacon-blink)))
+
+
+;;; Movement detection
+(defun beacon--movement-> (delta-y &optional delta-x)
+ "Return non-nil if latest vertical movement is > DELTA-Y.
+If DELTA-Y is nil, return nil.
+The same is true for DELTA-X and horizonta movement."
+ (and delta-y
+ (markerp beacon--previous-place)
+ (equal (marker-buffer beacon--previous-place)
+ (current-buffer))
+ ;; Quick check that prevents running the code below in very
+ ;; short movements (like typing).
+ (> (abs (- (point) beacon--previous-place))
+ delta-y)
+ ;; Col movement.
+ (or (and delta-x
+ (> (abs (- (current-column)
+ (save-excursion
+ (goto-char beacon--previous-place)
+ (current-column))))
+ delta-x))
+ ;; Check if the movement was >= DELTA lines by moving DELTA
+ ;; lines. `count-screen-lines' is too slow if the movement had
+ ;; thousands of lines.
+ (save-excursion
+ (let ((p (point)))
+ (goto-char (min beacon--previous-place p))
+ (vertical-motion delta-y)
+ (> (max p beacon--previous-place)
+ (line-beginning-position)))))))
+
+(defun beacon--maybe-push-mark ()
+ "Push mark if it seems to be safe."
+ (when (and (not mark-active)
+ (beacon--movement-> beacon-push-mark))
+ (let ((head (car mark-ring)))
+ (when (and (eq beacon--previous-mark-head head)
+ (not (equal head beacon--previous-place)))
+ (push-mark beacon--previous-place 'silent)))))
+
+(defun beacon--post-command ()
+ "Blink if point moved very far."
+ (cond
+ ;; Sanity check.
+ ((not (markerp beacon--previous-place)))
+ ;; Blink for switching windows.
+ ((and beacon-blink-when-window-changes
+ (not (eq beacon--previous-window (selected-window))))
+ (beacon-blink-automated))
+ ;; Blink for scrolling.
+ ((and beacon--window-scrolled
+ (equal beacon--window-scrolled (selected-window)))
+ (beacon-blink-automated))
+ ;; Blink for movement
+ ((beacon--movement-> beacon-blink-when-point-moves-vertically
+ beacon-blink-when-point-moves-horizontally)
+ (beacon-blink-automated)))
+ (beacon--maybe-push-mark)
+ (setq beacon--window-scrolled nil))
+
+(defun beacon--window-scroll-function (win start-pos)
+ "Blink the beacon or record that window has been scrolled.
+If invoked during the command loop, record the current window so
+that it may be blinked on post-command. This is because the
+scrolled window might not be active, but we only know that at
+`post-command-hook'.
+
+If invoked outside the command loop, `post-command-hook' would be
+unreliable, so just blink immediately."
+ (unless (or (and (equal beacon--previous-window-start start-pos)
+ (equal beacon--previous-window win))
+ (not beacon-blink-when-window-scrolls))
+ (if this-command
+ (setq beacon--window-scrolled win)
+ (setq beacon--window-scrolled nil)
+ (beacon-blink-automated))))
+
+(defun beacon--blink-on-focus ()
+ "Blink if `beacon-blink-when-focused' is non-nil"
+ (when beacon-blink-when-focused
+ (beacon-blink-automated)))
+
+
+;;; Minor-mode
+(defcustom beacon-lighter
+ (cond
+ ;; ((char-displayable-p ?💡) " 💡")
+ ;; ((char-displayable-p ?Λ) " Λ")
+ (t " (*)"))
+ "Lighter string used on the mode-line."
+ :type 'string)
+
+;;;###autoload
+(define-minor-mode beacon-mode
+ nil nil beacon-lighter nil
+ :global t
+ (if beacon-mode
+ (progn
+ (add-hook 'window-scroll-functions #'beacon--window-scroll-function)
+ (add-hook 'focus-in-hook #'beacon--blink-on-focus)
+ (add-hook 'post-command-hook #'beacon--post-command)
+ (add-hook 'pre-command-hook #'beacon--record-vars)
+ (add-hook 'pre-command-hook #'beacon--vanish))
+ (remove-hook 'focus-in-hook #'beacon--blink-on-focus)
+ (remove-hook 'window-scroll-functions #'beacon--window-scroll-function)
+ (remove-hook 'post-command-hook #'beacon--post-command)
+ (remove-hook 'pre-command-hook #'beacon--record-vars)
+ (remove-hook 'pre-command-hook #'beacon--vanish)))
+
+(provide 'beacon)
+;;; beacon.el ends here
+
+;; Local Variables:
+;; indent-tabs-mode: nil
+;; End:
diff --git a/packages/beacon/example-beacon.gif
b/packages/beacon/example-beacon.gif
new file mode 100644
index 0000000..4c01c77
Binary files /dev/null and b/packages/beacon/example-beacon.gif differ
diff --git a/packages/bug-hunter/README.org b/packages/bug-hunter/README.org
new file mode 100644
index 0000000..d8c9463
--- /dev/null
+++ b/packages/bug-hunter/README.org
@@ -0,0 +1,92 @@
+#+OPTIONS: toc:nil num:nil
+#+TITLE: [[file:hunter.png]] The Bug Hunter
[[https://travis-ci.org/Malabarba/elisp-bug-hunter][file:https://travis-ci.org/Malabarba/elisp-bug-hunter.svg?branch=master]]
+
+/Automatically debug and bisect your init (.emacs) file!/
+
+The Bug Hunter is an Emacs library that finds the source of an error
+or unexpected behavior inside an elisp configuration file (typically
+~init.el~ or ~.emacs~).
+
+[[file:hunter-screencast.gif]]
+
+* Usage Examples
+
+** Automated error hunting
+If your Emacs init file signals an error during startup, but you don’t
+know why, simply issue
+#+BEGIN_SRC text
+M-x bug-hunter-init-file RET e
+#+END_SRC
+and The Bug Hunter will find it for you. Note that your ~init.el~
+(or ~.emacs~) must be idempotent for this to work.
+
+** Interactive hunt
+
+If Emacs starts up without errors but something is not working as it
+should, invoke the same command, but choose the interactive option:
+#+BEGIN_SRC text
+M-x bug-hunter-init-file RET i
+#+END_SRC
+The Bug Hunter will start a separate Emacs instance several times, and
+then it will ask you each time whether that instance presented the
+problem you have. After doing this about 5--12 times, you’ll be given
+the results.
+
+** Assertion hunt
+
+The Bug Hunter can also find your issue based on an assertion.
+Essentially, if you can write a code snippet that returns non-nil when
+it detects the issue, just provide this snippet as the assertion and
+the Bug Hunter will do the rest.
+
+For example, let’s say there’s something in your init file that’s
+loading the ~cl~ library, and you don’t want that. You /know/ you’re
+not loading it yourself, but how can you figure out which external
+package is responsible for this outrage?
+
+#+BEGIN_SRC text
+M-x bug-hunter-init-file RET a (featurep 'cl) RET
+#+END_SRC
+
+*That’s it!* You’ll be given a nice buffer reporting the results:
+
+[[file:cl-example.png]]
+- Are you getting obscure errors when trying to open /“.tex”/ files?
+ - Don’t despair! Just use ~(find-file "dummy.tex")~ as the assertion.
+- Did ~ox-html~ stop working due to some arcane misconfiguration?
+ - Just write an assertion that does an export and checks the result.
+- Does some random command suddenly bind itself to ~C-j~ and you can’t figure
out why?
+ - ~(eq (key-binding "\n") 'unwanted-command)~ is the assertion for you!
+
+Finally, you can also use ~bug-hunter-file~ to hunt in other files.
+
+* Installation
+The Bug Hunter is available from
[[https://elpa.gnu.org/packages/bug-hunter.html][GNU Elpa]] to all Emacs
versions since
+~24.1~. To install, just issue
+
+#+BEGIN_SRC text
+M-x package-install RET bug-hunter
+#+END_SRC
+
+* init.org and other literate-style configs
+
+Some people (me included) like to organize their init files by
+writting it in ~org-mode~ instead of Emacs-Lisp. This usually involves
+adding something like this to ~init.el~,
+#+BEGIN_SRC emacs-lisp
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Maybe some code up here ;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(require 'org)
+(org-babel-tangle-file "~/.emacs.d/org-init.org"
+ "~/.emacs.d/org-init.el")
+(load "~/.emacs.d/org-init.el")
+#+END_SRC
+
+At first, this makes the Bug-Hunter essentially useless, for it will
+do the hunting in ~init.el~ instead of the much more extensive
+~org-init.el~. The name of the second file (~org-init.el~) will vary,
+but the point is the same. But fear not! There’s a simple solution:
+
+1. If you have any code above the call to ~org-babel-tangle-file~, copy that
to the top of ~org-init.el~ (or whatever is the name of your tangled file).
This includes that ~(require 'org)~ over there.
+2. Invoke ~M-x~ ~bug-hunter-file~ (instead of ~bug-hunter-init-file~). It will
ask you which file to debug, and you need to point it to your tangled output
file ~org-init.el~.
diff --git a/packages/bug-hunter/bug-hunter.el
b/packages/bug-hunter/bug-hunter.el
index bd6c06d..6875470 100644
--- a/packages/bug-hunter/bug-hunter.el
+++ b/packages/bug-hunter/bug-hunter.el
@@ -1,10 +1,10 @@
-;;; bug-hunter.el --- Hunt down errors in elisp files -*- lexical-binding: t;
-*-
+;;; bug-hunter.el --- Hunt down errors by bisecting elisp files -*-
lexical-binding: t; -*-
;; Copyright (C) 2015 Free Software Foundation, Inc.
-;; Author: Artur Malabarba <address@hidden>
-;; URL: http://github.com/Bruce-Connor/elisp-bug-hunter
-;; Version: 0.1
+;; Author: Artur Malabarba <address@hidden>
+;; URL: https://github.com/Malabarba/elisp-bug-hunter
+;; Version: 1.1
;; Keywords: lisp
;; Package-Requires: ((seq "1.3") (cl-lib "0.5"))
@@ -22,65 +22,95 @@
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
-;; `bug-hunter' is an Emacs library that finds the source of an error or
-;; unexpected behavior inside an elisp configuration file (tipically
-;; `init.el' or `.emacs').
-;;
-;;
+;; An Emacs library that finds the source of an error or unexpected
+;; behavior inside an elisp configuration file (typically `init.el' or
+;; `.emacs').
+;;
;; Usage Examples
;; ==============
-;;
+;;
+;; Automated error hunting
+;; ~~~~~~~~~~~~~~~~~~~~~~~
+;;
;; If your Emacs init file signals an error during startup, but you don’t
;; know why, simply issue
;; ,----
-;; | M-x bug-hunter-init-file RET RET
+;; | M-x bug-hunter-init-file RET e
;; `----
-;; and `bug-hunter' will find it for you.
-;;
+;; and The Bug Hunter will find it for you. Note that your `init.el' (or
+;; `.emacs') must be idempotent for this to work.
+;;
+;;
+;; Interactive hunt
+;; ~~~~~~~~~~~~~~~~
+;;
;; If Emacs starts up without errors but something is not working as it
-;; should, invoke the same command, but give it in an assertion.
-;; Essentially, if you can write a snippet that detects the issue and
-;; returns non-nil, just provide this snippet as the assertion and the
-;; Bug Hunter will do a bisection search for you.
-;;
+;; should, invoke the same command, but choose the interactive option:
+;; ,----
+;; | M-x bug-hunter-init-file RET i
+;; `----
+;; The Bug Hunter will start a separate Emacs instance several times, and
+;; then it will ask you each time whether that instance presented the
+;; problem you have. After doing this about 5--12 times, you’ll be given
+;; the results.
+;;
+;;
+;; Assertion hunt
+;; ~~~~~~~~~~~~~~
+;;
+;; The Bug Hunter can also find your issue based on an assertion.
+;; Essentially, if you can write a code snippet that returns non-nil when
+;; it detects the issue, just provide this snippet as the assertion and
+;; the Bug Hunter will do the rest.
+;;
;; For example, let’s say there’s something in your init file that’s
;; loading the `cl' library, and you don’t want that. You /know/ you’re
;; not loading it yourself, but how can you figure out which external
;; package is responsible for this outrage?
-;;
+;;
;; ,----
-;; | M-x bug-hunter-init-file RET (featurep 'cl) RET
+;; | M-x bug-hunter-init-file RET a (featurep 'cl) RET
;; `----
-;;
+;;
;; *That’s it!* You’ll be given a nice buffer reporting the results:
-;;
-;; - Are you getting obscure errors when trying to open /“.tex”/ files?
-;; Don’t despair! Just use `(find-file "dummy.tex")' as the assertion.
-;; - Did `ox-html' stop working due to some arcane misconfiguration? Just
-;; write an assertion that does an export and checks the result.
+;;
+;; - Are you getting obscure errors when trying to open /".tex"/ files?
+;; - Don’t despair! Just use `(find-file "dummy.tex")' as the
+;; assertion.
+;; - Did `ox-html' stop working due to some arcane misconfiguration?
+;; - Just write an assertion that does an export and checks the result.
;; - Does some random command suddenly bind itself to `C-j' and you can’t
-;; figure out why? `(eq (key-binding "\n") 'unwanted-command)' is the
-;; assertion for you!
-;;
+;; figure out why?
+;; - `(eq (key-binding "\n") 'unwanted-command)' is the assertion for
+;; you!
+;;
;; Finally, you can also use `bug-hunter-file' to hunt in other files.
-;;
-
-;; Installation
-;; ============
-;;
-;; Bug Hunter will be on Gelpa shortly. For now, do the following:
-;; 1. Open the `bug-hunter.el` file.
-;; 2. Issue `M-x package-install-from-buffer`.
-
+;;
+;;
+;; init.org and other literate-style configs
+;; =========================================
+;;
+;; Please see the full Readme on http://github.com/Malabarba/elisp-bug-hunter
;;; Code:
(require 'seq)
(require 'cl-lib)
-(defvar bug-hunter--assertion-reminder
+(defconst bug-hunter--interactive-explanation
+ "You have asked to do an interactive hunt, here's how it goes.
+1) I will start a new Emacs instance, which opens a new frame.
+2) You will try to reproduce your problem on the new frame.
+3) When you’re done, close that frame.
+4) I will ask you if you managed to reproduce the problem.
+5) We will repeat steps up to %s times, so hang tight!")
+
+(defconst bug-hunter--assertion-reminder
"Remember, the assertion must be an expression that returns
non-nil in your current (problematic) Emacs state, AND that
-returns nil on a clean Emacs instance."
+returns nil on a clean Emacs instance.
+If you're unsure how to write an assertion, you can try the interactive
+hunt instead, or see some examples in the Readme:
+ https://github.com/Malabarba/elisp-bug-hunter";
"Printed to the user if they provide a bad assertion.")
(defvar bug-hunter--current-head nil
@@ -113,7 +143,10 @@ file.")
nil)
(end-of-file `(bug-caught (end-of-file) ,line ,col))
(invalid-read-syntax `(bug-caught ,er ,line ,col))
- (error (error "Ran into an error we don't understand, please file a
bug report: %S" er)))
+ (error
+ (if (string= (elt er 1) "Invalid modifier in string")
+ `(bug-caught (invalid-modifier) ,line ,col)
+ (error "Ran into an error we don't understand, please file a bug
report: %S" er))))
(nreverse out))))
(defun bug-hunter--read-contents (file)
@@ -138,6 +171,7 @@ R is passed to `format' and inserted."
R is passed to `bug-hunter--report-print'."
(declare (indent 1))
(apply #'bug-hunter--report-print r)
+ (redisplay)
(apply #'message r))
(defun bug-hunter--report-user-error (&rest r)
@@ -145,18 +179,22 @@ R is passed to `bug-hunter--report-print'."
R is passed to `bug-hunter--report-print'."
(declare (indent 1))
(apply #'bug-hunter--report-print r)
- (bug-hunter--report-print "\xc")
+ (bug-hunter--report-print "\xc\n")
(apply #'user-error r))
(defvar compilation-error-regexp-alist)
-(defun bug-hunter--init-report-buffer ()
- "Create and prepare the \"*Bug-Hunter Report*\" buffer."
- (or (get-buffer "*Bug-Hunter Report*")
- (with-current-buffer (get-buffer-create "*Bug-Hunter Report*")
- (compilation-mode "Bug Hunt")
- (set (make-local-variable 'compilation-error-regexp-alist)
- '(comma))
- (current-buffer))))
+(defun bug-hunter--init-report-buffer (assertion steps)
+ "Create and prepare the \"*Bug-Hunter Report*\" buffer.
+Also add some descriptions depending on ASSERTION."
+ (with-current-buffer (get-buffer-create "*Bug-Hunter Report*")
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (compilation-mode "Bug Hunt")
+ (set (make-local-variable 'compilation-error-regexp-alist)
+ '(comma))
+ (pcase assertion
+ (`interactive (insert (format bug-hunter--interactive-explanation (+ 2
steps))))))
+ (current-buffer)))
(defun bug-hunter--pretty-format (value padding)
"Return a VALUE as a string with PADDING spaces on the left."
@@ -180,6 +218,9 @@ the file."
(cl-case (car error)
(end-of-file
"There's a missing closing parenthesis, the expression on this line
never ends.")
+ (invalid-modifier (concat "There's a string on this line with an invalid
modifier."
+ "\n A \"modifier\" is a \\ followed by a few
characters."
+ "\n For example, \\C-; is an invalid
modifier."))
(invalid-read-syntax
(let ((char (cadr error)))
(if (member char '("]" ")"))
@@ -200,7 +241,7 @@ the file."
"")
(when (> size 16)
(format "\n ... %s omitted expressions ...\n\n"
- (- size 14)))
+ (- size 14)))
(when (> size 16)
(mapconcat (lambda (x) (bug-hunter--pretty-format x 4))
(seq-drop forms (- size 7)) "")))))
@@ -208,47 +249,79 @@ the file."
(concat "The assertion returned the following value here:\n"
(bug-hunter--pretty-format (cadr error) 4)))
(t (format "The following error was signaled here:\n %S"
- error))))
+ error))))
(when expression
(bug-hunter--report " Caused by the following expression:\n%s"
(bug-hunter--pretty-format expression 4)))
- (bug-hunter--report "\xc")
+ (bug-hunter--report "\xc\n")
`[,error ,line ,column ,expression])
;;; Execution functions
-(defun bug-hunter--run-form (form)
- "Run FORM with \"emacs -Q\" and return the result."
+(defun bug-hunter--print-to-temp (sexp)
+ "Print SEXP to a temp file and return the file name."
+ (let ((print-length nil)
+ (print-level nil)
+ (file (make-temp-file "bug-hunter")))
+ (with-temp-file file
+ (print sexp (current-buffer)))
+ file))
+
+(defun bug-hunter--run-emacs (file &rest args)
+ "Start an Emacs process to run FILE and return the output buffer.
+ARGS are passed before \"-l FILE\"."
(let ((out-buf (generate-new-buffer "*Bug-Hunter Command*"))
(exec (file-truename (expand-file-name invocation-name
- invocation-directory)))
- (file-name (make-temp-file "bug-hunter")))
+ invocation-directory))))
+ (apply #'call-process exec nil out-buf nil
+ (append args (list "-l" file)))
+ out-buf))
+
+(defun bug-hunter--run-form (form)
+ "Run FORM with \"emacs -Q\" and return the result."
+ (let ((file-name (bug-hunter--print-to-temp (list 'prin1 form))))
(unwind-protect
- (let ((print-length nil)
- (print-level nil))
- (with-temp-file file-name
- (print (list 'prin1 form) (current-buffer)))
- (call-process exec nil out-buf nil
- "-Q" "--batch" "-l"
- (shell-quote-argument file-name))
- (with-current-buffer out-buf
- (goto-char (point-max))
- (forward-sexp -1)
- (prog1 (read (current-buffer))
- (kill-buffer (current-buffer)))))
+ (with-current-buffer (bug-hunter--run-emacs file-name "-Q" "--batch")
+ (goto-char (point-max))
+ (forward-sexp -1)
+ (prog1 (read (current-buffer))
+ (kill-buffer (current-buffer))))
(delete-file file-name))))
+(defun bug-hunter--run-form-interactively (form)
+ "Run FORM in a graphical instance and ask user about the outcome."
+ (let ((file-name (bug-hunter--print-to-temp (list 'prin1 form))))
+ (unwind-protect
+ (bug-hunter--run-emacs file-name "-Q")
+ (delete-file file-name))
+ (y-or-n-p "Did you find the problem/bug in this instance (if you encounter
some other issue, answer `n')? ")))
+
+(defun bug-hunter--wrap-forms-for-eval (forms)
+ "Return FORMS wrapped in initialization code."
+ `(let ((server-name (make-temp-file "bug-hunter-temp-server-file")))
+ (delete-file server-name)
+ (if site-run-file (load site-run-file t t))
+ (run-hooks 'before-init-hook)
+ ,@forms
+ (package-initialize)
+ (run-hooks 'after-init-hook)))
+
(defun bug-hunter--run-and-test (forms assertion)
"Execute FORMS in the background and test ASSERTION.
-See `bug-hunter' for a description on the ASSERTION."
- (bug-hunter--run-form
- `(condition-case er
- (let ((server-name (make-temp-file "bug-hunter-temp-server-file")))
- (delete-file server-name)
- ,@forms
- (run-hooks 'after-init-hook)
- ,assertion)
- (error (cons 'bug-caught er)))))
+See `bug-hunter' for a description on the ASSERTION.
+
+If ASSERTION is 'interactive, the form is run through
+`bug-hunter--run-form-interactively'. Otherwise, a slightly
+modified version of the form combined with ASSERTION is run
+through `bug-hunter--run-form'."
+ (if (eq assertion 'interactive)
+ (bug-hunter--run-form-interactively
+ (bug-hunter--wrap-forms-for-eval forms))
+ (bug-hunter--run-form
+ `(condition-case er
+ ,(append (bug-hunter--wrap-forms-for-eval forms)
+ (list assertion))
+ (error (cons 'bug-caught er))))))
@@ -263,25 +336,29 @@ ASSERTION is received by `bug-hunter--bisect-start'.
SAFE is a list of forms confirmed to not match the ASSERTION,
HEAD is a list of forms to be tested now, and TAIL is a list
which will be inspected if HEAD doesn't match ASSERTION."
- (cond
- ((not tail)
- (vector (length safe)
- ;; Sometimes we already ran this, sometimes not. So it's
- ;; easier to just run it anyway to get the return value.
- (bug-hunter--run-and-test (append safe head) assertion)))
- ((and (message "Testing: %s/%s"
- (cl-incf bug-hunter--i)
- bug-hunter--estimate)
- (setq bug-hunter--current-head head)
- (bug-hunter--run-and-test (append safe head) assertion))
- (apply #'bug-hunter--bisect
- assertion
- safe
- (bug-hunter--split head)))
- (t (apply #'bug-hunter--bisect
- assertion
- (append safe head)
- (bug-hunter--split tail)))))
+ (message "Testing: %s/%s" (cl-incf bug-hunter--i) bug-hunter--estimate)
+ ;; Used if the user quits.
+ (setq bug-hunter--current-head head)
+ (let ((ret-val (bug-hunter--run-and-test (append safe head) assertion)))
+ (cond
+ ((not tail)
+ (cl-assert ret-val nil)
+ (vector (length safe) ret-val))
+ ;; Issue in the head.
+ ((and ret-val (< (length head) 2))
+ (vector (length safe) ret-val))
+ (ret-val
+ (apply #'bug-hunter--bisect
+ assertion
+ safe
+ (bug-hunter--split head)))
+ ;; Issue in the tail.
+ (t (apply #'bug-hunter--bisect
+ assertion
+ (append safe head)
+ ;; If tail has length 1, we already know where the issue is,
+ ;; but we still do this to get the return value.
+ (bug-hunter--split tail))))))
(defun bug-hunter--bisect-start (forms assertion)
"Run a bisection search on list of FORMS using ASSERTION.
@@ -292,7 +369,6 @@ ASSERTION's return value.
If ASSERTION is nil, n is the position of the first form to
signal an error and value is (bug-caught . ERROR-SIGNALED)."
(let ((bug-hunter--i 0)
- (bug-hunter--estimate (ceiling (log (length forms) 2)))
(bug-hunter--current-head nil))
(condition-case-unless-debug nil
(apply #'bug-hunter--bisect assertion nil (bug-hunter--split forms))
@@ -320,10 +396,16 @@ Bug hunter will refuse to hunt if (i) an error is
signaled or the
assertion is triggered while running emacs -Q, or (ii) no errors
are signaled and the assertion is not triggered after all EXPRs
are evaluated."
- (pop-to-buffer (bug-hunter--init-report-buffer))
(let ((expressions (unless (eq (car-safe rich-forms) 'bug-caught)
- (mapcar #'car rich-forms))))
+ (mapcar #'car rich-forms)))
+ (bug-hunter--estimate (ceiling (log (length rich-forms) 2))))
+ ;; Prepare buffer, and make sure they've seen it.
+ (switch-to-buffer (bug-hunter--init-report-buffer assertion
bug-hunter--estimate))
+ (when (eq assertion 'interactive)
+ (read-char-choice "Please read the instructions above and type 6 when
ready. " '(?6)))
+
(cond
+ ;; Check for errors when reading the init file.
((not expressions)
(apply #'bug-hunter--report-error (cdr rich-forms))
(apply #'vector (cdr rich-forms)))
@@ -335,10 +417,12 @@ are evaluated."
(if assertion
(concat "The assertion returned nil after loading the entire
file.\n"
bug-hunter--assertion-reminder)
- "No errors signaled after loading the entire file. If you're
-looking for something that's not an error, you need to provide an
-assertion. See this link for some examples:
- https://github.com/Bruce-Connor/elisp-bug-hunter";)
+ "No errors signaled after loading the entire file.
+If you're looking for something that's not an error, use the
+interactive hunt instead of the error hunt. If you have some
+elisp proficiency, you can also use the assertion hunt, see this
+link for some examples:
+ https://github.com/Malabarba/elisp-bug-hunter";)
(or assertion "")))
;; Make sure we're in a forest, not a volcano.
@@ -370,37 +454,49 @@ There's nothing more I can do here.")
(list 'assertion-triggered ret)
(car linecol) (cadr linecol) expression)))))))))
+(defconst bug-hunter--hunt-type-prompt
+ "To bisect interactively, type i
+To use automatic error detection, type e
+To provide a lisp assertion, type a
+=> ")
+
(defun bug-hunter--read-from-minibuffer ()
"Read a list of expressions from the minibuffer.
-Wraps them in a progn if necessary."
- (require 'simple)
- (let ((exprs
- (with-temp-buffer
- ;; Copied from `read--expression'.
- (let ((minibuffer-completing-symbol t))
- (minibuffer-with-setup-hook
- (lambda ()
- ;; FIXME: call emacs-lisp-mode?
- (add-function :before-until (local
'eldoc-documentation-function)
- #'elisp-eldoc-documentation-function)
- (add-hook 'completion-at-point-functions
- #'elisp-completion-at-point nil t)
- (run-hooks 'eval-expression-minibuffer-setup-hook))
- (insert
- (read-from-minibuffer
- "Expression that returns nil if all is well (optional): "
- nil read-expression-map nil 'read-expression-history))))
- (goto-char (point-min))
- (mapcar #'car (bug-hunter--read-buffer)))))
- (if (cdr exprs)
- (cons #'progn exprs)
- (car exprs))))
+Wraps them in a progn if necessary to always return a single
+form.
+
+The user may decide to not provide input, in which case
+'interactive is returned. Note, this is different from the user
+typing `RET' at an empty prompt, in which case nil is returned."
+ (pcase (read-char-choice bug-hunter--hunt-type-prompt '(?i ?e ?a))
+ (`?i 'interactive)
+ (`?e nil)
+ (_
+ (require 'simple)
+ (let ((exprs
+ (with-temp-buffer
+ ;; Copied from `read--expression'.
+ (let ((minibuffer-completing-symbol t))
+ (minibuffer-with-setup-hook
+ (lambda ()
+ (add-hook 'completion-at-point-functions
+ #'elisp-completion-at-point nil t)
+ (run-hooks 'eval-expression-minibuffer-setup-hook))
+ (insert
+ (read-from-minibuffer
+ "Provide an assertion. This is a lisp expression that
returns nil if (and only if) everything is fine:\n => "
+ nil read-expression-map nil 'read-expression-history))))
+ (goto-char (point-min))
+ (mapcar #'car (bug-hunter--read-buffer)))))
+ (if (cdr exprs)
+ (cons #'progn exprs)
+ (car exprs))))))
;;;###autoload
(defun bug-hunter-file (file &optional assertion)
"Bisect FILE while testing ASSERTION.
All sexps in FILE are read and passed to `bug-hunter-hunt' as a
-list. See `bug-hunter-hunt' for how to use assertion."
+list. See `bug-hunter-hunt' for how to use ASSERTION."
(interactive
(list
(read-file-name "File to bisect: "
@@ -416,7 +512,7 @@ list. See `bug-hunter-hunt' for how to use assertion."
"Test ASSERTION throughout `user-init-file'.
All sexps inside `user-init-file' are read and passed to
`bug-hunter-hunt' as a list. See `bug-hunter-hunt' for how to use
-assertion."
+ASSERTION."
(interactive (list (bug-hunter--read-from-minibuffer)))
(bug-hunter-file user-init-file assertion))
diff --git a/packages/company-math/.dir-locals.el
b/packages/company-math/.dir-locals.el
new file mode 100644
index 0000000..064a938
--- /dev/null
+++ b/packages/company-math/.dir-locals.el
@@ -0,0 +1,3 @@
+
+((emacs-lisp-mode
+ (indent-tabs-mode)))
diff --git a/packages/company-math/company-math.el
b/packages/company-math/company-math.el
new file mode 100644
index 0000000..49d3028
--- /dev/null
+++ b/packages/company-math/company-math.el
@@ -0,0 +1,169 @@
+;;; company-math.el --- Completion backends for unicode math symbols and latex
tags
+;;
+;; Copyright (C) 2015 Free Software Foundation, Inc.
+;; Author: Vitalie Spinu <address@hidden>
+;; URL: https://github.com/vspinu/company-math
+;; Keywords: Unicode, symbols, completion
+;; Version: 1.1
+;; Package-Requires: ((company "0.8.0") (math-symbol-lists "1.0"))
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; 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-prefix-regexp "\\\\\\([^ \t]+\\)"
+ "Regexp matching the prefix of the company-math symbol.
+First subgroup must match the actual symbol to be used in the
+completion."
+ :group 'company-math
+ :type 'string)
+
+(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)
+ "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)
+ "Build a list of math symbols ready to be used in ac source.
+ALIST is one of the defined alist in package `symbols'. Return a
+list of LaTeX symbols with text property :symbol being the
+corresponding unicode symbol."
+ (delq nil
+ (mapcar
+ #'(lambda (el)
+ (let* ((tex (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--symbols
+ (delete-dups
+ (append (company-math--make-candidates math-symbol-list-basic)
+ (company-math--make-candidates math-symbol-list-extended)))
+ "List of math completion candidates.")
+
+(defun company-math--prefix (allow-faces disallow-faces)
+ (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
+ (when (looking-back company-math-prefix-regexp (point-at-bol))
+ (match-string 1))))))
+
+(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-prefix-regexp)
+ (delete-region (match-beginning 0) pos)
+ (insert symbol))))
+
+
+;;; BACKENDS
+
+;;;###autoload
+(defun company-latex-commands (command &optional arg &rest ignored)
+ "Company backend for latex commands."
+ (interactive (list 'interactive))
+ (cl-case command
+ (interactive (company-begin-backend 'company-latex-commands))
+ (prefix (unless (company-in-string-or-comment)
+ (company-math--prefix t '())))
+ (candidates (all-completions arg math-symbol-list-latex-commands))
+ (sorted t)))
+
+;;;###autoload
+(defun company-math-symbols-latex (command &optional arg &rest ignored)
+ "Company backend for LaTeX mathematical symbols."
+ (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-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.
+See the unicode-math page [1] for a list of fonts that have a
+good support for mathematical symbols.
+
+ [1]
http://ftp.snt.utwente.nl/pub/software/tex/help/Catalogue/entries/unicode-math.html
+"
+ (interactive (list 'interactive))
+ (cl-case command
+ (interactive (company-begin-backend 'company-math-symbols-unicode))
+ (prefix (company-math--prefix 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 (mapcar (lambda (candidate)
+ (concat candidate " "))
+ (all-completions arg company-math--symbols)))
+ (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
new file mode 100644
index 0000000..781a46a
Binary files /dev/null and b/packages/company-math/img/latex-symbols.png differ
diff --git a/packages/company-math/img/unicode-symbols.png
b/packages/company-math/img/unicode-symbols.png
new file mode 100644
index 0000000..050e6fe
Binary files /dev/null and b/packages/company-math/img/unicode-symbols.png
differ
diff --git a/packages/company-math/readme.md b/packages/company-math/readme.md
new file mode 100644
index 0000000..fa80258
--- /dev/null
+++ b/packages/company-math/readme.md
@@ -0,0 +1,68 @@
+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` - unicode symbols (_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.
+
+## Activation ##
+
+Install from [MELPA](http://melpa.milkbox.net/) repository.
+
+You can either register each backend globally:
+
+
+```lisp
+
+;; global activation of the unicode symbol completion
+(add-to-list 'company-backends 'company-math-symbols-unicode)
+
+
+```
+
+or locally per emacs mode:
+
+
+```lisp
+
+;; 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:
+
+```
+(add-hook TeX-mode-hook 'my-latex-mode-setup)
+```
+
+## Customization ##
+
+Set `company-tooltip-align-annotations` to t in order to allin symbols to the
+right as in the above previews.
+
+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
+environmnts. You can use the following variables to adjust this behavior to
your
+liking: `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/company-statistics/README.org
b/packages/company-statistics/README.org
index 3fef3a4..012b63b 100644
--- a/packages/company-statistics/README.org
+++ b/packages/company-statistics/README.org
@@ -11,7 +11,7 @@ Using the package is simple.
If you install it from the elpa.gnu.org repository with Emacs' package manager,
you only need to enable the mode, e.g., in your =init.el= file:
#+begin_src emacs-lisp
-(add-to-hook 'after-init-hook 'company-statistics-mode)
+(add-hook 'after-init-hook 'company-statistics-mode)
#+end_src
Alternatively, make sure =company-statistics.el= is in your =load-path=, and
add
diff --git a/packages/company-statistics/company-statistics-tests.el
b/packages/company-statistics/company-statistics-tests.el
index 6e0b460..3fa336a 100644
--- a/packages/company-statistics/company-statistics-tests.el
+++ b/packages/company-statistics/company-statistics-tests.el
@@ -1,6 +1,6 @@
-;;; company-statistics-tests.el --- company-statistics tests
+;;; company-statistics-tests.el --- company-statistics tests -*-
lexical-binding: t -*-
-;; Copyright (C) 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
;; Author: Ingo Lohmar
@@ -21,7 +21,7 @@
;;; Commentary:
-;; emacs -batch -L . -l ert -l company-statistics-tests.el -f
ert-run-tests-batch-and-exit
+;; emacs -batch -L . -L ../company-mode/ -l ert -l company-statistics-tests.el
-f ert-run-tests-batch-and-exit
;;; Code:
@@ -77,16 +77,25 @@ V2 (starting at index I2) satisfy the binary predicate
PRED, default
(let ((company-statistics-size 5))
(company-statistics--init)
(let ((major-mode 'foo-mode)
- (buffer-file-name nil))
+ (company-statistics--context
+ '((:keyword "if")
+ (:symbol "parent")
+ (:file "foo-file"))))
(company-statistics--finished "foo"))
(let ((major-mode 'foo-mode)
- (buffer-file-name "bar-file"))
+ (company-statistics--context
+ '((:symbol "statistics")
+ (:file "bar-file"))))
(company-statistics--finished "bar"))
(let ((major-mode 'baz-mode)
- (buffer-file-name nil))
+ (company-statistics--context
+ '((:keyword "unless")
+ (:symbol "company"))))
(company-statistics--finished "baz"))
(let ((major-mode 'baz-mode)
- (buffer-file-name "quux-file"))
+ (company-statistics--context
+ '((:keyword "when")
+ (:file "quux-file"))))
(company-statistics--finished "quux"))
,@body)
;; tear down to clean slate
@@ -155,43 +164,82 @@ V2 (starting at index I2) satisfy the binary predicate
PRED, default
(should (equal company-statistics--log cs-history))
(should (equal company-statistics--index cs-index))))))
-(ert-deftest c-s-score-change-default ()
+(ert-deftest c-s-score-change-light ()
"Test a few things about the default score updates."
- (let ((major-mode 'foobar-mode)
- (buffer-file-name nil)) ;must not generate context entries
- (should (equal (company-statistics-score-change-default "dummy")
- '((nil . 1) (foobar-mode . 1))))
- (let ((buffer-file-name "test-file.XYZ"))
- (should (equal (company-statistics-score-change-default "dummy")
- '((nil . 1) (foobar-mode . 1) ("test-file.XYZ" . 1)))))))
+ (let ((major-mode 'foobar-mode))
+ (should (equal (company-statistics-score-change-light "dummy")
+ '((nil . 1) (foobar-mode . 1))))))
-(ert-deftest c-s-score-calc-default ()
+(ert-deftest c-s-score-calc-light ()
"Test score calculation default."
(cs-fixture
+ ;; FIXME assumes that light context is a subset of the heavy context?
+ (let ((major-mode 'foo-mode))
+ (should (eq (company-statistics-score-calc-light "foo") 2))
+ (should (eq (company-statistics-score-calc-light "bar") 2))
+ (should (eq (company-statistics-score-calc-light "baz") 1))
+ (should (eq (company-statistics-score-calc-light "quux") 1)))
+ (let ((major-mode 'baz-mode))
+ (should (eq (company-statistics-score-calc-light "foo") 1))
+ (should (eq (company-statistics-score-calc-light "bar") 1))
+ (should (eq (company-statistics-score-calc-light "baz") 2))
+ (should (eq (company-statistics-score-calc-light "quux") 2)))))
+
+(ert-deftest c-s-score-change-heavy ()
+ "Test a few things about the heavy score updates."
+ (let ((major-mode 'foobar-mode))
+ (should (equal (company-statistics-score-change-heavy "dummy")
+ '((nil . 1) (foobar-mode . 1))))
+ (let ((company-statistics--context
+ '((:keyword "kwd")
+ nil ;deliberately omit parent symbol
+ (:file "test-file.XYZ"))))
+ (should (equal (company-statistics-score-change-heavy "dummy")
+ '((nil . 1) (foobar-mode . 1)
+ ((:keyword "kwd") . 1)
+ ((:file "test-file.XYZ") . 1)))))))
+
+(ert-deftest c-s-score-calc-heavy ()
+ "Test heavy score calculation."
+ (cs-fixture
(let ((major-mode 'foo-mode)
- (buffer-file-name nil))
- (should (eq (company-statistics-score-calc-default "foo") 2))
- (should (eq (company-statistics-score-calc-default "bar") 2))
- (should (eq (company-statistics-score-calc-default "baz") 1))
- (should (eq (company-statistics-score-calc-default "quux") 1)))
+ (company-statistics--context
+ '((:symbol "company")
+ (:file "foo-file"))))
+ (should (eq (company-statistics-score-calc-heavy "dummy") 0))
+ (should (eq (company-statistics-score-calc-heavy "foo") 3))
+ (should (eq (company-statistics-score-calc-heavy "bar") 2))
+ (should (eq (company-statistics-score-calc-heavy "baz") 2))
+ (should (eq (company-statistics-score-calc-heavy "quux") 1)))
(let ((major-mode 'foo-mode)
- (buffer-file-name "bar-file"))
- (should (eq (company-statistics-score-calc-default "foo") 2))
- (should (eq (company-statistics-score-calc-default "bar") 3))
- (should (eq (company-statistics-score-calc-default "baz") 1))
- (should (eq (company-statistics-score-calc-default "quux") 1)))
+ (company-statistics--context
+ '((:keyword "unless")
+ (:symbol "parent")
+ (:file "quux-file"))))
+ (should (eq (company-statistics-score-calc-heavy "dummy") 0))
+ (should (eq (company-statistics-score-calc-heavy "foo") 3))
+ (should (eq (company-statistics-score-calc-heavy "bar") 2))
+ (should (eq (company-statistics-score-calc-heavy "baz") 2))
+ (should (eq (company-statistics-score-calc-heavy "quux") 2)))
(let ((major-mode 'baz-mode)
- (buffer-file-name nil))
- (should (eq (company-statistics-score-calc-default "foo") 1))
- (should (eq (company-statistics-score-calc-default "bar") 1))
- (should (eq (company-statistics-score-calc-default "baz") 2))
- (should (eq (company-statistics-score-calc-default "quux") 2)))
+ (company-statistics--context
+ '((:keyword "when")
+ (:file "baz-file"))))
+ (should (eq (company-statistics-score-calc-heavy "dummy") 0))
+ (should (eq (company-statistics-score-calc-heavy "foo") 1))
+ (should (eq (company-statistics-score-calc-heavy "bar") 1))
+ (should (eq (company-statistics-score-calc-heavy "baz") 2))
+ (should (eq (company-statistics-score-calc-heavy "quux") 3)))
(let ((major-mode 'baz-mode)
- (buffer-file-name "quux-file"))
- (should (eq (company-statistics-score-calc-default "foo") 1))
- (should (eq (company-statistics-score-calc-default "bar") 1))
- (should (eq (company-statistics-score-calc-default "baz") 2))
- (should (eq (company-statistics-score-calc-default "quux") 3)))))
+ (company-statistics--context
+ '((:keyword "if")
+ (:symbol "statistics")
+ (:file "quux-file"))))
+ (should (eq (company-statistics-score-calc-heavy "dummy") 0))
+ (should (eq (company-statistics-score-calc-heavy "foo") 2))
+ (should (eq (company-statistics-score-calc-heavy "bar") 2))
+ (should (eq (company-statistics-score-calc-heavy "baz") 2))
+ (should (eq (company-statistics-score-calc-heavy "quux") 3)))))
(ert-deftest c-s-alist-update ()
"Test central helper function for context/score alist update."
diff --git a/packages/company-statistics/company-statistics.el
b/packages/company-statistics/company-statistics.el
index 3346c96..62c3c1d 100644
--- a/packages/company-statistics/company-statistics.el
+++ b/packages/company-statistics/company-statistics.el
@@ -1,10 +1,10 @@
-;;; company-statistics.el --- Sort candidates using completion history
+;;; company-statistics.el --- Sort candidates using completion history -*-
lexical-binding: t -*-
-;; Copyright (C) 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
;; Author: Ingo Lohmar <address@hidden>
;; URL: https://github.com/company-mode/company-statistics
-;; Version: 0.1.1
+;; Version: 0.2.2
;; Keywords: abbrev, convenience, matching
;; Package-Requires: ((emacs "24.3") (company "0.8.5"))
@@ -27,7 +27,7 @@
;;
;; Package installed from elpa.gnu.org:
;;
-;; (add-hook 'after-init-hook 'company-statistics-mode)
+;; (add-hook 'after-init-hook #'company-statistics-mode)
;;
;; Manually installed: make sure that this file is in load-path, and
;;
@@ -40,10 +40,10 @@
;;
;; The same candidate might occur in different modes, projects, files etc., and
;; possibly has a different meaning each time. Therefore along with the
-;; completion, we store some context information. In the default
configuration,
-;; we track the overall frequency, the major-mode of the buffer, and the
-;; filename (if it applies), and the same criteria are used to score all
-;; possible candidates.
+;; completion, we store some context information. In the default (heavy)
+;; configuration, we track the overall frequency, the major-mode of the buffer,
+;; the last preceding keyword, the parent symbol, and the filename (if it
+;; applies), and the same criteria are used to score all possible candidates.
;;; Code:
@@ -56,41 +56,40 @@
(defcustom company-statistics-size 400
"Number of completion choices that `company-statistics' keeps track of.
As this is a global cache, making it too small defeats the purpose."
- :group 'company-statistics
:type 'integer
- :initialize (lambda (option init-size) (setq company-statistics-size
init-size))
- :set 'company-statistics--log-resize)
+ :initialize #'custom-initialize-default
+ :set #'company-statistics--log-resize)
(defcustom company-statistics-file
(concat user-emacs-directory "company-statistics-cache.el")
"File to save company-statistics state."
- :group 'company-statistics
:type 'string)
(defcustom company-statistics-auto-save t
"Whether to save the statistics when leaving emacs."
- :group 'company-statistics
:type 'boolean)
(defcustom company-statistics-auto-restore t
"Whether to restore statistics when company-statistics is enabled and has
not been used before."
- :group 'company-statistics
:type 'boolean)
-(defcustom company-statistics-score-change
'company-statistics-score-change-default
+(defcustom company-statistics-capture-context
#'company-statistics-capture-context-heavy
+ "Function called with single argument (t if completion started manually).
+This is the place to store any context information for a completion run."
+ :type 'function)
+
+(defcustom company-statistics-score-change
#'company-statistics-score-change-heavy
"Function called with completion choice. Using arbitrary other info,
it should produce an alist, each entry labeling a context and the
associated score update: ((ctx-a . 1) (\"str\" . 0.5) (nil . 1)). Nil is
the global context."
- :group 'company-statistics
:type 'function)
-(defcustom company-statistics-score-calc 'company-statistics-score-calc-default
+(defcustom company-statistics-score-calc #'company-statistics-score-calc-heavy
"Function called with completion candidate. Using arbitrary other info,
eg, on the current context, it should evaluate to the candidate's score (a
number)."
- :group 'company-statistics
:type 'function)
;; internal vars, persistence
@@ -107,7 +106,7 @@ number)."
(defun company-statistics--init ()
"Initialize company-statistics."
(setq company-statistics--scores
- (make-hash-table :test 'equal :size company-statistics-size))
+ (make-hash-table :test #'equal :size company-statistics-size))
(setq company-statistics--log (make-vector company-statistics-size nil)
company-statistics--index 0))
@@ -163,22 +162,95 @@ number)."
;; score calculation for insert/retrieval --- can be changed on-the-fly
-(defun company-statistics-score-change-default (cand)
- "Count for global score, mode context, filename context."
- (nconc ;when's nil is removed
- (list (cons nil 1) (cons major-mode 1)) ;major-mode is never nil
- (when buffer-file-name
- (list (cons buffer-file-name 1)))))
+(defun company-statistics-score-change-light (cand)
+ "Count for global score and mode context."
+ (list (cons nil 1)
+ (cons major-mode 1))) ;major-mode is never nil
-(defun company-statistics-score-calc-default (cand)
- "Global score, and bonus for matching major mode and filename."
+(defun company-statistics-score-calc-light (cand)
+ "Global score, and bonus for matching major mode."
(let ((scores (gethash cand company-statistics--scores)))
(if scores
;; cand may be in scores and still have no global score left
(+ (or (cdr (assoc nil scores)) 0)
+ (or (cdr (assoc major-mode scores)) 0))
+ 0)))
+
+(defvar company-statistics--context nil
+ "Current completion context, a list of entries searched using `assoc'.")
+
+(defun company-statistics--last-keyword ()
+ "Return last keyword, ie, text of region fontified with the
+font-lock-keyword-face up to point, or nil."
+ (let ((face-pos (point)))
+ (while (and (number-or-marker-p face-pos)
+ (< (point-min) face-pos)
+ (not (eq (get-text-property (1- face-pos) 'face)
+ 'font-lock-keyword-face)))
+ (setq face-pos
+ (previous-single-property-change face-pos 'face nil (point-min))))
+ (when (and (number-or-marker-p face-pos)
+ (eq (get-text-property (max (point-min) (1- face-pos)) 'face)
+ 'font-lock-keyword-face))
+ (list :keyword
+ (buffer-substring-no-properties
+ (previous-single-property-change face-pos 'face nil (point-min))
+ face-pos)))))
+
+(defun company-statistics--parent-symbol ()
+ "Return symbol immediately preceding current completion prefix, or nil.
+May be separated by punctuation, but not by whitespace."
+ ;; expects to be at start of company-prefix; little sense for lisps
+ (let ((preceding (save-excursion
+ (unless (zerop (skip-syntax-backward "."))
+ (substring-no-properties (symbol-name
(symbol-at-point)))))))
+ (when preceding
+ (list :symbol preceding))))
+
+(defun company-statistics--file-name ()
+ "Return buffer file name, or nil."
+ (when buffer-file-name
+ (list :file buffer-file-name)))
+
+(defun company-statistics-capture-context-heavy (manual)
+ "Calculate some context, once for the whole completion run."
+ (save-excursion
+ (backward-char (length company-prefix))
+ (setq company-statistics--context
+ (delq nil
+ (list (company-statistics--last-keyword)
+ (company-statistics--parent-symbol)
+ (company-statistics--file-name))))))
+
+(defun company-statistics-score-change-heavy (cand)
+ "Count for global score, mode context, last keyword, parent symbol,
+buffer file name."
+ (let ((last-kwd (assoc :keyword company-statistics--context))
+ (parent-symbol (assoc :symbol company-statistics--context))
+ (file (assoc :file company-statistics--context)))
+ (nconc ;when's nil is removed
+ (list (cons nil 1)
+ (cons major-mode 1)) ;major-mode is never nil
+ ;; only add pieces of context if non-nil
+ (when last-kwd (list (cons last-kwd 1)))
+ (when parent-symbol (list (cons parent-symbol 1)))
+ (when file (list (cons file 1))))))
+
+(defun company-statistics-score-calc-heavy (cand)
+ "Global score, and bonus for matching major mode, last keyword, parent
+symbol, buffer file name."
+ (let ((scores (gethash cand company-statistics--scores))
+ (last-kwd (assoc :keyword company-statistics--context))
+ (parent-symbol (assoc :symbol company-statistics--context))
+ (file (assoc :file company-statistics--context)))
+ (if scores
+ ;; cand may be in scores and still have no global score left
+ (+ (or (cdr (assoc nil scores)) 0)
(or (cdr (assoc major-mode scores)) 0)
- (or (cdr (when buffer-file-name ;to not get nil context
- (assoc buffer-file-name scores))) 0))
+ ;; some context may not apply, make sure to not get nil context
+ (or (cdr (when last-kwd (assoc last-kwd scores))) 0)
+ (or (cdr (when parent-symbol (assoc parent-symbol scores))) 0)
+ (or (cdr (when file (assoc file scores))) 0))
0)))
;; score manipulation in one place --- know about hash value alist structure
@@ -209,7 +281,7 @@ one. ALIST structure and cdrs may be changed!"
(company-statistics--alist-update
(gethash cand company-statistics--scores)
score-updates
- '+)
+ #'+)
company-statistics--scores))
(defun company-statistics--log-revert (&optional index)
@@ -225,8 +297,8 @@ one. ALIST structure and cdrs may be changed!"
(company-statistics--alist-update
(gethash cand company-statistics--scores)
score-updates
- '-
- 'zerop)))
+ #'-
+ #'zerop)))
(if new-scores ;sth left
(puthash cand new-scores company-statistics--scores)
(remhash cand company-statistics--scores))))))
@@ -240,6 +312,9 @@ one. ALIST structure and cdrs may be changed!"
;; core functions: updater, actual sorting transformer, minor-mode
+(defun company-statistics--start (manual)
+ (funcall company-statistics-capture-context manual))
+
(defun company-statistics--finished (result)
"After completion, update scores and log."
(let* ((score-updates (funcall company-statistics-score-change result))
@@ -280,10 +355,14 @@ configuration. You can customize this behavior with
(company-statistics--init)))
(add-to-list 'company-transformers
'company-sort-by-statistics 'append)
+ (add-hook 'company-completion-started-hook
+ 'company-statistics--start)
(add-hook 'company-completion-finished-hook
'company-statistics--finished))
(setq company-transformers
(delq 'company-sort-by-statistics company-transformers))
+ (remove-hook 'company-completion-started-hook
+ 'company-statistics--start)
(remove-hook 'company-completion-finished-hook
'company-statistics--finished)))
diff --git a/packages/context-coloring/.gitignore
b/packages/context-coloring/.gitignore
index f090318..a269508 100644
--- a/packages/context-coloring/.gitignore
+++ b/packages/context-coloring/.gitignore
@@ -1,3 +1,4 @@
*.elc
+.cask/
/benchmark/logs/
-/libraries/
+/test/coverage/
diff --git a/packages/context-coloring/.travis.yml
b/packages/context-coloring/.travis.yml
index 2dcc8a6..ba959a9 100644
--- a/packages/context-coloring/.travis.yml
+++ b/packages/context-coloring/.travis.yml
@@ -1,21 +1,23 @@
-# https://github.com/rolandwalker/emacs-travis
+sudo: false
language: emacs-lisp
-node_js:
- - "0.10"
-
env:
- matrix:
- - EMACS=emacs24
+ - EVM_EMACS=emacs-24.3-travis
+ - EVM_EMACS=emacs-24.4-travis
+ - EVM_EMACS=emacs-24.5-travis
+
+before_install:
+ - export PATH="/home/travis/.evm/bin:$PATH"
+ - export PATH="/home/travis/.cask/bin:$PATH"
+ - git clone https://github.com/rejeep/evm.git /home/travis/.evm
+ - evm config path /tmp
+ - evm install ${EVM_EMACS} --use --skip
+ - curl -fsSkL https://raw.github.com/cask/cask/master/go | python
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
- - npm install -g scopifier
+ - cask
script:
- make test EMACS=${EMACS}
+ - emacs --version
+ - make test
diff --git a/packages/context-coloring/Cask b/packages/context-coloring/Cask
new file mode 100644
index 0000000..b1535a9
--- /dev/null
+++ b/packages/context-coloring/Cask
@@ -0,0 +1,8 @@
+(source melpa)
+
+(package-file "context-coloring.el")
+
+(depends-on "js2-mode")
+
+(development
+ (depends-on "undercover"))
diff --git a/packages/context-coloring/LICENSE
b/packages/context-coloring/LICENSE
new file mode 100644
index 0000000..94a9ed0
--- /dev/null
+++ b/packages/context-coloring/LICENSE
@@ -0,0 +1,674 @@
+ 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/context-coloring/Makefile
b/packages/context-coloring/Makefile
index 3a6a0be..f729409 100644
--- a/packages/context-coloring/Makefile
+++ b/packages/context-coloring/Makefile
@@ -1,41 +1,46 @@
EMACS = emacs
-DEPENDENCIES = libraries/ert-async.el libraries/js2-mode.el
+CASK = EMACS=${EMACS} cask
+DEPENDENCIES = .cask/
all: uncompile compile test
bench: ${DEPENDENCIES}
- ${EMACS} -Q \
+ ${CASK} exec ${EMACS} -Q \
-L . \
- -L libraries \
-l context-coloring \
- -l benchmark/context-coloring-benchmark \
+ -l benchmark/context-coloring-benchmark.el \
-f context-coloring-benchmark-run
compile: ${DEPENDENCIES}
- ${EMACS} -Q -batch \
+ ${CASK} exec ${EMACS} -Q -batch \
-L . \
- -L libraries \
- -f batch-byte-compile *.el libraries/*.el
+ -f batch-byte-compile *.el
uncompile:
- rm -f *.elc libraries/*.elc
+ rm -f *.elc
clean: uncompile
- rm -f ${DEPENDENCIES}
+ rm -rf ${DEPENDENCIES}
${DEPENDENCIES}:
- ${EMACS} -Q -batch \
- -l scripts/download-dependencies.el \
- -f download-dependencies
+ ${CASK}
test: ${DEPENDENCIES}
- ${EMACS} -Q -batch \
+ ${CASK} exec ${EMACS} -Q -batch \
-L . \
- -L libraries \
-l ert \
- -l ert-async \
- -l context-coloring \
+ -l test/context-coloring-coverage.el \
+ -f context-coloring-coverage-ci-init \
+ -l test/context-coloring-test.el \
+ -f ert-run-tests-batch-and-exit
+
+cover: ${DEPENDENCIES}
+ ${CASK} exec ${EMACS} -Q -batch \
+ -L . \
+ -l ert \
+ -l test/context-coloring-coverage.el \
+ -f context-coloring-coverage-local-init \
-l test/context-coloring-test.el \
-f ert-run-tests-batch-and-exit
-.PHONY: all bench compile uncompile clean test
+.PHONY: all bench compile uncompile clean test cover
diff --git a/packages/context-coloring/README.md
b/packages/context-coloring/README.md
index 7eeacf7..21f1eb5 100644
--- a/packages/context-coloring/README.md
+++ b/packages/context-coloring/README.md
@@ -1,195 +1,66 @@
-# Context Coloring [](https://travis-ci.org/jacksonrayhamilton/context-coloring)
+# Context Coloring [](https://travis-ci.org/jacksonrayhamilton/context-coloring)
[](https://coveralls.io/r/jacksonrayhamilton/context-coloring?branch=master)
<p align="center">
<img alt="Screenshot of JavaScript code highlighted by context."
src="screenshot.png" title="Screenshot">
</p>
-Highlights code according to function context.
+Highlights code by scope. Top-level scopes are one color, second-level scopes
+are another color, and so on. Variables retain the color of the scope in which
+they are defined. A variable defined in an outer scope referenced by an inner
+scope is colored the same as the outer scope.
-- Code in the global scope is one color. Code in functions within the global
- scope is a different color, and code within such functions is another color,
- and so on.
-- Identifiers retain the color of the scope in which they are declared.
-
-Lexical scope information at-a-glance can assist a programmer in understanding
-the overall structure of a program. It can help to curb nasty bugs like name
-shadowing. A rainbow can indicate excessive complexity. State change within a
-closure is easily monitored.
-
-By default, context-coloring still highlights comments and strings
-syntactically. It is still easy to differentiate code from non-code, and
strings
-cannot be confused for variables.
-
-This coloring strategy is probably more useful than conventional syntax
-highlighting. Highlighting keywords can help one to detect spelling errors, but
-a [linter][] could also spot those errors, and if integrated with [flycheck][],
-an extra spot opens up in your editing toolbelt.
-
-Give context-coloring a try; you may find that it *changes the way you write
-code*.
+By default, comments and strings are still highlighted syntactically.
## Features
-- Supported languages: JavaScript
-- Light and dark (customizable) color schemes.
-- Very fast for files under 1000 lines.
+- Light and dark customizable color schemes.
+- JavaScript support:
+ - Script, function and block scopes (and even `catch` block scopes).
+ - Node.js "file-level" scope detection.
+- Emacs Lisp support:
+ - `defun`, `lambda`, `let`, `let*`, `cond`, `condition-case`, `defadvice`,
+ `dolist`, `quote`, `backquote` and backquote splicing.
+ - Works in `eval-expression` too.
## Installation
-Requires Emacs 24+.
-
-JavaScript language support requires either [js2-mode][], or
-[Node.js 0.10+][node] and the [scopifier][] executable.
-
-### ELPA
-
-- `M-x package-install RET context-coloring RET`
-
-### Git
-
-- Clone this repository.
-
-```bash
-cd ~/.emacs.d/
-git clone https://github.com/jacksonrayhamilton/context-coloring.git
-```
-
-- Byte-compile the package for improved speed.
+Requires Emacs 24.3+. JavaScript language support requires
+[js2-mode](https://github.com/mooz/js2-mode).
-```bash
-cd context-coloring/
-make compile
-```
-
-- Add the following to your `~/.emacs` file:
+To install, run the command `M-x package-install RET context-coloring RET`, and
+then add the following to your init file:
```lisp
-(add-to-list 'load-path "~/.emacs.d/context-coloring")
-(require 'context-coloring)
-```
+;; JavaScript:
+(add-to-list 'auto-mode-alist '("\\.js\\'" . js2-mode))
+(add-hook 'js2-mode-hook #'context-coloring-mode)
-### scopifier (for non-js2-mode users)
+;; Emacs Lisp:
+(add-hook 'emacs-lisp-mode-hook #'context-coloring-mode)
-```bash
-npm install -g scopifier
+;; eval-expression:
+(add-hook 'eval-expression-minibuffer-setup-hook #'context-coloring-mode) ;
24.4+
+(add-hook 'minibuffer-setup-hook #'context-coloring-mode) ;
24.3
```
-## Usage
-
-Add the following to your `~/.emacs` file:
+## Color Schemes
-```lisp
-;; non-js2-mode users:
-(add-hook 'js-mode-hook 'context-coloring-mode)
+The [Zenburn](https://github.com/bbatsov/zenburn-emacs) theme, featured in the
+screenshot above, now supports context coloring.
-;; js2-mode users:
-(add-to-list 'auto-mode-alist '("\\.js\\'" . js2-mode))
-(add-hook 'js2-mode-hook 'context-coloring-mode)
-```
+You can define your own colors by customizing faces like
+`context-coloring-level-N-face`, where N is a number starting from 0.
-## Customizing
+[See here](https://gist.github.com/jacksonrayhamilton/6b89ca3b85182c490816) for
+some color schemes for popular custom themes.
-### Options
+## Options
- `context-coloring-syntactic-comments` (default: `t`): If non-nil, also color
comments using `font-lock`.
- `context-coloring-syntactic-strings` (default: `t`): If non-nil, also color
strings using `font-lock`.
-- `context-coloring-delay` (default: `0.25`; supported modes: `js-mode`,
- `js3-mode`): Delay between a buffer update and colorization.
-- `context-coloring-js-block-scopes` (default: `nil`; supported modes:
- `js2-mode`): If non-nil, also color block scopes in the scope hierarchy in
- JavaScript.
-
-### Color Schemes
-
-Color schemes for custom themes are automatically applied when those themes are
-active. Built-in theme support is available for: `ample`, `anti-zenburn`,
-`grandshell`, `leuven`, `monokai`, `solarized`, `spacegray`, `tango` and
-`zenburn`.
-
-You can define your own theme colors too:
-
-```lisp
-(context-coloring-define-theme
- 'zenburn
- :colors '("#DCDCCC"
- "#93E0E3"
- "#BFEBBF"
- "#F0DFAF"
- "#DFAF8F"
- "#CC9393"
- "#DC8CC3"
- "#94BFF3"
- "#9FC59F"
- "#D0BF8F"
- "#DCA3A3"))
-```
-
-See `C-h f context-coloring-define-theme` for more info on theme parameters.
-
-## Extending
-
-To add support for a new language, write a "scopifier" for it, and define a new
-coloring dispatch strategy with `context-coloring-define-dispatch`. Then the
-plugin should handle the rest. (See `C-h f context-coloring-define-dispatch`
for
-more info on dispatch strategies.)
-
-A "scopifier" is a CLI program that reads a buffer's contents from stdin and
-writes a JSON array of numbers to stdout. Every three numbers in the array
-represent a range of color. For instance, if I fed the following string of
-JavaScript code to a scopifier:
-
-```js
-var a = function () {};
-```
-
-Then the scopifier would produce the following array:
-
-```js
-[1,24,0,9,23,1]
-```
-
-Where, for every three numbers, the first number is a 1-indexed start
[point][],
-the second number is an exclusive end point, and the third number is a scope
-level. The result of applying level 0 coloring to the range [1, 24) and
then
-applying level 1 coloring to the range [9, 23) would result in the
following
-coloring:
-
-<p align="center">
- <img alt="Screenshot of ranges [1, 24) and [9, 23)."
src="scopifier.png" title="Screenshot">
-</p>
-
-If there is an abstract syntax tree generator for your language, you can walk
-the syntax tree, find variables and scopes, and build their positions and
levels
-into an array like the one above.
-
-For example, a Ruby scopifier might be defined and implemented like this:
-
-```lisp
-(context-coloring-define-dispatch
- 'ruby
- :modes '(ruby-mode)
- :executable "ruby"
- :command "/home/username/scopifier")
-```
-
-```ruby
-#!/usr/bin/env ruby
-def scopifier(code)
- # Parse code.
- # Return an array.
-end
-print scopifier ARGF.read
-```
-
-When a `--version` argument is passed, a scopifier should print its version
-number and exit. This allows context-coloring to determine if an update is
-required.
-
-[linter]: http://jshint.com/about/
-[flycheck]: http://www.flycheck.org/
-[js2-mode]: https://github.com/mooz/js2-mode
-[node]: http://nodejs.org/download/
-[scopifier]: https://github.com/jacksonrayhamilton/scopifier
-[point]: http://www.gnu.org/software/emacs/manual/html_node/elisp/Point.html
+- `context-coloring-javascript-block-scopes` (default: `nil`): If non-nil, also
+ color block scopes in the scope hierarchy in JavaScript.
+- `context-coloring-javascript-detect-top-level-scope` (default: `t`): If
+ non-nil, detect when to use file-level scope.
diff --git a/packages/context-coloring/benchmark/context-coloring-benchmark.el
b/packages/context-coloring/benchmark/context-coloring-benchmark.el
index 2de5646..c627249 100644
--- a/packages/context-coloring/benchmark/context-coloring-benchmark.el
+++ b/packages/context-coloring/benchmark/context-coloring-benchmark.el
@@ -1,4 +1,4 @@
-;;; benchmark/context-coloring-benchmark.el --- Benchmarks for context
coloring. -*- lexical-binding: t; -*-
+;;; context-coloring-benchmark.el --- Benchmarks for context coloring -*-
lexical-binding: t; -*-
;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
@@ -19,16 +19,14 @@
;;; Commentary:
-;; Benchmarks for context-coloring.
+;; Benchmarks for context coloring.
-;; `ert' instruments and benchmarks the package's functions, and the results
are
-;; logged to `benchmark/logs'.
-
-;; To run, execute `make bench' from the project root.
+;; Use with `make bench'.
;;; Code:
(require 'context-coloring)
+(require 'elp)
(require 'js2-mode)
@@ -40,134 +38,126 @@
"Resolve PATH from this file's directory."
(expand-file-name path context-coloring-benchmark-path))
-(defun context-coloring-benchmark-log-results (result-file fixture)
- "Log benchmarking results to RESULT-FILE for fixture FIXTURE."
- (elp-results)
- (let ((results-buffer (current-buffer)))
- (with-temp-buffer
- (insert (concat fixture "\n"))
- (prepend-to-buffer results-buffer (point-min) (point-max)))
- (with-temp-buffer
- (insert "\n")
- (append-to-buffer results-buffer (point-min) (point-max))))
- (make-directory (context-coloring-benchmark-resolve-path "./logs") t)
- (append-to-file nil nil result-file))
-
-(defun context-coloring-benchmark-next-tick (function)
- "Defer execution of FUNCTION to clear the stack and to ensure
-asynchrony."
- (run-at-time 0.001 nil function))
-
-(defun context-coloring-benchmark-next (list continue stop)
- "Run the next test in LIST by calling CONTINUE. When LIST is
-exhausted, call STOP instead."
- (if (null list)
- (progn
- (context-coloring-benchmark-next-tick stop))
- (context-coloring-benchmark-next-tick
- (lambda ()
- (funcall
- continue
- (car list)
- (lambda ()
- (context-coloring-benchmark-next (cdr list) continue stop)))))))
-
-(defun context-coloring-benchmark-async (title setup teardown fixtures
callback)
- "Execute a benchmark titled TITLE with SETUP and TEARDOWN
-callbacks. Measure the performance of all FIXTURES, calling
-CALLBACK when all are done."
- (funcall setup)
+(defun context-coloring-benchmark-log-results (result-file fixture statistics)
+ "Log results to RESULT-FILE for FIXTURE with STATISTICS."
+ (let ((results (prog1
+ (progn
+ (elp-results)
+ (buffer-substring-no-properties (point-min)
(point-max)))
+ (kill-buffer))))
+ (make-directory (context-coloring-benchmark-resolve-path "./logs") t)
+ (append-to-file
+ (with-temp-buffer
+ (goto-char (point-min))
+ (insert (format "For fixture \"%s\":\n" fixture))
+ (insert "\n")
+ (insert "General statistics:\n")
+ (insert (format "File size: %s bytes\n" (plist-get statistics
:file-size)))
+ (insert (format "Lines: %s\n" (plist-get statistics :lines)))
+ (insert (format "Words: %s\n" (plist-get statistics :words)))
+ (insert (format "Colorization times: %s\n"
+ (context-coloring-join
+ (mapcar (lambda (number)
+ (format "%.4f" number))
+ (plist-get statistics :colorization-times)) ",
")))
+ (insert (format "Average colorization time: %.4f\n"
+ (plist-get statistics :average-colorization-time)))
+ (insert "\n")
+ (insert "Function statistics:\n")
+ (insert "(Function Name / Call Count / Elapsed Time / Average Time):\n")
+ (insert results)
+ (insert "\n")
+ (buffer-substring-no-properties (point-min) (point-max)))
+ nil result-file)))
+
+(defun context-coloring-benchmark (title fixtures)
+ "Execute a benchmark titled TITLE against FIXTURES."
(let ((result-file (context-coloring-benchmark-resolve-path
(format "./logs/results-%s-%s.log"
title (format-time-string "%s")))))
- (context-coloring-benchmark-next
- fixtures
- (lambda (path next)
+ (mapc
+ (lambda (path)
(let ((fixture (context-coloring-benchmark-resolve-path path))
+ colorization-start-time
+ (colorization-times '())
advice)
(setq
advice
(let ((count 0))
(lambda (original-function)
- (funcall
- original-function
- (lambda ()
- (setq count (+ count 1))
- ;; Test 5 times.
- (if (= count 5)
- (progn
- (advice-remove 'context-coloring-colorize advice)
- (kill-buffer)
- (context-coloring-benchmark-log-results
- result-file
- fixture)
- (funcall next))
- (funcall 'context-coloring-colorize)))))))
- (advice-add 'context-coloring-colorize :around advice)
+ (funcall original-function)
+ (setq count (+ count 1))
+ ;; First 5 runs are for gathering real coloring times,
+ ;; unaffected by elp instrumentation.
+ (when (<= count 5)
+ (push (- (float-time) colorization-start-time)
colorization-times))
+ (cond
+ ((= count 10)
+ (advice-remove #'context-coloring-colorize advice)
+ (context-coloring-benchmark-log-results
+ result-file
+ fixture
+ (list
+ :file-size (nth 7 (file-attributes fixture))
+ :lines (count-lines (point-min) (point-max))
+ :words (count-words (point-min) (point-max))
+ :colorization-times colorization-times
+ :average-colorization-time (/ (apply #'+ colorization-times)
5)))
+ (elp-restore-all)
+ (kill-buffer))
+ ;; The last 5 runs are for gathering function call and
+ ;; duration statistics.
+ ((= count 5)
+ (elp-instrument-package "context-coloring-")
+ (context-coloring-colorize))
+ (t
+ (setq colorization-start-time (float-time))
+ (context-coloring-colorize))))))
+ (advice-add #'context-coloring-colorize :around advice)
+ (setq colorization-start-time (float-time))
(find-file fixture)))
- (lambda ()
- (funcall teardown)
- (when callback (funcall callback))))))
+ fixtures)))
-(defconst context-coloring-benchmark-js-fixtures
+(defconst context-coloring-benchmark-javascript-fixtures
'("./fixtures/jquery-2.1.1.js"
"./fixtures/lodash-2.4.1.js"
"./fixtures/async-0.9.0.js"
"./fixtures/mkdirp-0.5.0.js")
"Arbitrary JavaScript files for performance scrutiny.")
-(defun context-coloring-benchmark-js-mode-setup ()
- "Preparation logic for `js-mode'."
- (add-hook 'js-mode-hook 'context-coloring-mode)
- (elp-instrument-package "context-coloring-"))
-
-(defun context-coloring-benchmark-js-mode-teardown ()
- "Cleanup logic for `js-mode'."
- (remove-hook 'js-mode-hook 'context-coloring-mode))
-
-(defun context-coloring-benchmark-js-mode-run (callback)
- "Benchmark `js-mode', then call CALLBACK."
- (context-coloring-benchmark-async
- "js-mode"
- 'context-coloring-benchmark-js-mode-setup
- 'context-coloring-benchmark-js-mode-teardown
- context-coloring-benchmark-js-fixtures
- callback))
-
-(defun context-coloring-benchmark-js2-mode-setup ()
- "Preparation logic for `js2-mode'."
- (setq js2-mode-show-parse-errors nil)
- (setq js2-mode-show-strict-warnings nil)
+(defun context-coloring-benchmark-js2-mode-run ()
+ "Benchmark `js2-mode'."
(add-to-list 'auto-mode-alist '("\\.js\\'" . js2-mode))
- (add-hook 'js2-mode-hook 'context-coloring-mode)
- (elp-instrument-package "context-coloring-"))
-
-(defun context-coloring-benchmark-js2-mode-teardown ()
- "Cleanup logic for `js2-mode'."
- (remove-hook 'js2-mode-hook 'context-coloring-mode)
+ (add-hook 'js2-mode-hook #'context-coloring-mode)
+ (let ((js2-mode-show-parse-errors nil)
+ (js2-mode-show-strict-warnings nil))
+ (context-coloring-benchmark
+ "js2-mode"
+ context-coloring-benchmark-javascript-fixtures))
(setq auto-mode-alist (delete '("\\.js\\'" . js2-mode)
auto-mode-alist))
- (setq js2-mode-show-strict-warnings t)
- (setq js2-mode-show-parse-errors t))
-
-(defun context-coloring-benchmark-js2-mode-run (callback)
- "Benchmark `js2-mode', then call CALLBACK."
- (context-coloring-benchmark-async
- "js2-mode"
- 'context-coloring-benchmark-js2-mode-setup
- 'context-coloring-benchmark-js2-mode-teardown
- context-coloring-benchmark-js-fixtures
- callback))
+ (remove-hook 'js2-mode-hook #'context-coloring-mode))
+
+(defconst context-coloring-benchmark-emacs-lisp-fixtures
+ '("./fixtures/lisp.el"
+ "./fixtures/faces.el"
+ "./fixtures/subr.el"
+ "./fixtures/simple.el")
+ "Arbitrary Emacs Lisp files for performance scrutiny.")
+
+(defun context-coloring-benchmark-emacs-lisp-mode-run ()
+ "Benchmark `emacs-lisp-mode', then call CALLBACK."
+ (add-hook 'emacs-lisp-mode-hook #'context-coloring-mode)
+ (context-coloring-benchmark
+ "emacs-lisp-mode"
+ context-coloring-benchmark-emacs-lisp-fixtures)
+ (remove-hook 'emacs-lisp-mode-hook #'context-coloring-mode))
(defun context-coloring-benchmark-run ()
"Benchmark all modes, then exit."
- (context-coloring-benchmark-next
- '(context-coloring-benchmark-js-mode-run
- context-coloring-benchmark-js2-mode-run)
- (lambda (function next)
- (funcall function next))
- (lambda ()
- (kill-emacs))))
+ (context-coloring-benchmark-js2-mode-run)
+ (context-coloring-benchmark-emacs-lisp-mode-run)
+ (kill-emacs))
(provide 'context-coloring-benchmark)
diff --git a/packages/yasnippet/doc/doc/.nosearch
b/packages/context-coloring/benchmark/fixtures/.nosearch
similarity index 100%
copy from packages/yasnippet/doc/doc/.nosearch
copy to packages/context-coloring/benchmark/fixtures/.nosearch
diff --git a/packages/context-coloring/benchmark/fixtures/faces.el
b/packages/context-coloring/benchmark/fixtures/faces.el
new file mode 100644
index 0000000..5176bed
--- /dev/null
+++ b/packages/context-coloring/benchmark/fixtures/faces.el
@@ -0,0 +1,2764 @@
+;;; faces.el --- Lisp faces
+
+;; Copyright (C) 1992-1996, 1998-2015 Free Software Foundation, Inc.
+
+;; Maintainer: address@hidden
+;; Keywords: internal
+;; Package: emacs
+
+;; 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:
+
+(defcustom term-file-prefix (purecopy "term/")
+ "If non-nil, Emacs startup performs terminal-specific initialization.
+It does this by: (load (concat term-file-prefix (getenv \"TERM\")))
+
+You may set this variable to nil in your init file if you do not wish
+the terminal-initialization file to be loaded."
+ :type '(choice (const :tag "No terminal-specific initialization" nil)
+ (string :tag "Name of directory with term files"))
+ :group 'terminals)
+
+(declare-function xw-defined-colors "term/common-win" (&optional frame))
+
+(defvar help-xref-stack-item)
+
+(defvar face-name-history nil
+ "History list for some commands that read face names.
+Maximum length of the history list is determined by the value
+of `history-length', which see.")
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Font selection.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defgroup font-selection nil
+ "Influencing face font selection."
+ :group 'faces)
+
+
+(defcustom face-font-selection-order
+ '(:width :height :weight :slant)
+ "A list specifying how face font selection chooses fonts.
+Each of the four symbols `:width', `:height', `:weight', and `:slant'
+must appear once in the list, and the list must not contain any other
+elements. Font selection first tries to find a best matching font
+for those face attributes that appear before in the list. For
+example, if `:slant' appears before `:height', font selection first
+tries to find a font with a suitable slant, even if this results in
+a font height that isn't optimal."
+ :tag "Font selection order"
+ :type '(list symbol symbol symbol symbol)
+ :group 'font-selection
+ :set #'(lambda (symbol value)
+ (set-default symbol value)
+ (internal-set-font-selection-order value)))
+
+
+;; In the absence of Fontconfig support, Monospace and Sans Serif are
+;; unavailable, and we fall back on the courier and helv families,
+;; which are generally available.
+(defcustom face-font-family-alternatives
+ (mapcar (lambda (arg) (mapcar 'purecopy arg))
+ '(("Monospace" "courier" "fixed")
+ ("courier" "CMU Typewriter Text" "fixed")
+ ("Sans Serif" "helv" "helvetica" "arial" "fixed")
+ ("helv" "helvetica" "arial" "fixed")))
+ "Alist of alternative font family names.
+Each element has the form (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...).
+If fonts of family FAMILY can't be loaded, try ALTERNATIVE1, then
+ALTERNATIVE2 etc."
+ :tag "Alternative font families to try"
+ :type '(repeat (repeat string))
+ :group 'font-selection
+ :set #'(lambda (symbol value)
+ (set-default symbol value)
+ (internal-set-alternative-font-family-alist value)))
+
+
+;; This is defined originally in xfaces.c.
+(defcustom face-font-registry-alternatives
+ (mapcar (lambda (arg) (mapcar 'purecopy arg))
+ (if (featurep 'w32)
+ '(("iso8859-1" "ms-oemlatin")
+ ("gb2312.1980" "gb2312" "gbk" "gb18030")
+ ("jisx0208.1990" "jisx0208.1983" "jisx0208.1978")
+ ("ksc5601.1989" "ksx1001.1992" "ksc5601.1987")
+ ("muletibetan-2" "muletibetan-0"))
+ '(("gb2312.1980" "gb2312.80&gb8565.88" "gbk" "gb18030")
+ ("jisx0208.1990" "jisx0208.1983" "jisx0208.1978")
+ ("ksc5601.1989" "ksx1001.1992" "ksc5601.1987")
+ ("muletibetan-2" "muletibetan-0"))))
+ "Alist of alternative font registry names.
+Each element has the form (REGISTRY ALTERNATIVE1 ALTERNATIVE2 ...).
+If fonts of registry REGISTRY can be loaded, font selection
+tries to find a best matching font among all fonts of registry
+REGISTRY, ALTERNATIVE1, ALTERNATIVE2, and etc."
+ :tag "Alternative font registries to try"
+ :type '(repeat (repeat string))
+ :version "21.1"
+ :group 'font-selection
+ :set #'(lambda (symbol value)
+ (set-default symbol value)
+ (internal-set-alternative-font-registry-alist value)))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Creation, copying.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+(defun face-list ()
+ "Return a list of all defined faces."
+ (mapcar #'car face-new-frame-defaults))
+
+(defun make-face (face &optional no-init-from-resources)
+ "Define a new face with name FACE, a symbol.
+Do not call this directly from Lisp code; use `defface' instead.
+
+If FACE is already known as a face, leave it unmodified. Return FACE.
+
+NO-INIT-FROM-RESOURCES has been deprecated and is no longer used
+and will go away. Handling of conditional X resources application
+has been pushed down to make-x-resource-internal itself."
+ (interactive (list (read-from-minibuffer
+ "Make face: " nil nil t 'face-name-history)))
+ (unless (facep face)
+ ;; Make frame-local faces (this also makes the global one).
+ (dolist (frame (frame-list))
+ (internal-make-lisp-face face frame))
+ ;; Add the face to the face menu.
+ (when (fboundp 'facemenu-add-new-face)
+ (facemenu-add-new-face face))
+ ;; Define frame-local faces for all frames from X resources.
+ (make-face-x-resource-internal face))
+ face)
+
+;; Handling of whether to apply X resources or not, has been pushed down
+;; to make-face-x-resource-internal itself, thus the optional arg is no
+;; longer evaluated at all and going away.
+(set-advertised-calling-convention 'make-face '(face) "24.4")
+
+(defun make-empty-face (face)
+ "Define a new, empty face with name FACE.
+Do not call this directly from Lisp code; use `defface' instead."
+ (interactive (list (read-from-minibuffer
+ "Make empty face: " nil nil t 'face-name-history)))
+ (make-face face))
+
+(defun copy-face (old-face new-face &optional frame new-frame)
+ "Define a face named NEW-FACE, which is a copy of OLD-FACE.
+This function does not copy face customization data, so NEW-FACE
+will not be made customizable. Most Lisp code should not call
+this function; use `defface' with :inherit instead.
+
+If NEW-FACE already exists as a face, modify it to be like
+OLD-FACE. If NEW-FACE doesn't already exist, create it.
+
+If the optional argument FRAME is a frame, change NEW-FACE on
+FRAME only. If FRAME is t, copy the frame-independent default
+specification for OLD-FACE to NEW-FACE. If FRAME is nil, copy
+the defaults as well as the faces on each existing frame.
+
+If the optional fourth argument NEW-FRAME is given, copy the
+information from face OLD-FACE on frame FRAME to NEW-FACE on
+frame NEW-FRAME. In this case, FRAME must not be nil."
+ (let ((inhibit-quit t))
+ (if (null frame)
+ (progn
+ (when new-frame
+ (error "Copying face %s from all frames to one frame"
+ old-face))
+ (make-empty-face new-face)
+ (dolist (frame (frame-list))
+ (copy-face old-face new-face frame))
+ (copy-face old-face new-face t))
+ (make-empty-face new-face)
+ (internal-copy-lisp-face old-face new-face frame new-frame))
+ new-face))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Predicates, type checks.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun facep (face)
+ "Return non-nil if FACE is a face name; nil otherwise.
+A face name can be a string or a symbol."
+ (internal-lisp-face-p face))
+
+
+(defun check-face (face)
+ "Signal an error if FACE doesn't name a face.
+Value is FACE."
+ (unless (facep face)
+ (error "Not a face: %s" face))
+ face)
+
+
+;; The ID returned is not to be confused with the internally used IDs
+;; of realized faces. The ID assigned to Lisp faces is used to
+;; support faces in display table entries.
+
+(defun face-id (face &optional _frame)
+ "Return the internal ID of face with name FACE.
+If FACE is a face-alias, return the ID of the target face.
+The optional argument FRAME is ignored, since the internal face ID
+of a face name is the same for all frames."
+ (check-face face)
+ (or (get face 'face)
+ (face-id (get face 'face-alias))))
+
+(defun face-equal (face1 face2 &optional frame)
+ "Non-nil if faces FACE1 and FACE2 are equal.
+Faces are considered equal if all their attributes are equal.
+If the optional argument FRAME is given, report on FACE1 and FACE2 in that
frame.
+If FRAME is t, report on the defaults for FACE1 and FACE2 (for new frames).
+If FRAME is omitted or nil, use the selected frame."
+ (internal-lisp-face-equal-p face1 face2 frame))
+
+
+(defun face-differs-from-default-p (face &optional frame)
+ "Return non-nil if FACE displays differently from the default face.
+If the optional argument FRAME is given, report on face FACE in that frame.
+If FRAME is t, report on the defaults for face FACE (for new frames).
+If FRAME is omitted or nil, use the selected frame."
+ (let ((attrs
+ (delq :inherit (mapcar 'car face-attribute-name-alist)))
+ (differs nil))
+ (while (and attrs (not differs))
+ (let* ((attr (pop attrs))
+ (attr-val (face-attribute face attr frame t)))
+ (when (and
+ (not (eq attr-val 'unspecified))
+ (display-supports-face-attributes-p (list attr attr-val)
+ frame))
+ (setq differs attr))))
+ differs))
+
+
+(defun face-nontrivial-p (face &optional frame)
+ "True if face FACE has some non-nil attribute.
+If the optional argument FRAME is given, report on face FACE in that frame.
+If FRAME is t, report on the defaults for face FACE (for new frames).
+If FRAME is omitted or nil, use the selected frame."
+ (not (internal-lisp-face-empty-p face frame)))
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Setting face attributes from X resources.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defcustom face-x-resources
+ (mapcar
+ (lambda (arg)
+ ;; FIXME; can we purecopy some of the conses too?
+ (cons (car arg)
+ (cons (purecopy (car (cdr arg))) (purecopy (cdr (cdr arg))))))
+ '((:family (".attributeFamily" . "Face.AttributeFamily"))
+ (:foundry (".attributeFoundry" . "Face.AttributeFoundry"))
+ (:width (".attributeWidth" . "Face.AttributeWidth"))
+ (:height (".attributeHeight" . "Face.AttributeHeight"))
+ (:weight (".attributeWeight" . "Face.AttributeWeight"))
+ (:slant (".attributeSlant" . "Face.AttributeSlant"))
+ (:foreground (".attributeForeground" . "Face.AttributeForeground"))
+ (:distant-foreground
+ (".attributeDistantForeground" . "Face.AttributeDistantForeground"))
+ (:background (".attributeBackground" . "Face.AttributeBackground"))
+ (:overline (".attributeOverline" . "Face.AttributeOverline"))
+ (:strike-through (".attributeStrikeThrough" .
"Face.AttributeStrikeThrough"))
+ (:box (".attributeBox" . "Face.AttributeBox"))
+ (:underline (".attributeUnderline" . "Face.AttributeUnderline"))
+ (:inverse-video (".attributeInverse" . "Face.AttributeInverse"))
+ (:stipple
+ (".attributeStipple" . "Face.AttributeStipple")
+ (".attributeBackgroundPixmap" . "Face.AttributeBackgroundPixmap"))
+ (:bold (".attributeBold" . "Face.AttributeBold"))
+ (:italic (".attributeItalic" . "Face.AttributeItalic"))
+ (:font (".attributeFont" . "Face.AttributeFont"))
+ (:inherit (".attributeInherit" . "Face.AttributeInherit"))))
+ "List of X resources and classes for face attributes.
+Each element has the form (ATTRIBUTE ENTRY1 ENTRY2...) where ATTRIBUTE is
+the name of a face attribute, and each ENTRY is a cons of the form
+\(RESOURCE . CLASS) with RESOURCE being the resource and CLASS being the
+X resource class for the attribute."
+ :type '(repeat (cons symbol (repeat (cons string string))))
+ :group 'faces)
+
+
+(declare-function internal-face-x-get-resource "xfaces.c"
+ (resource class &optional frame))
+
+(declare-function internal-set-lisp-face-attribute-from-resource "xfaces.c"
+ (face attr value &optional frame))
+
+(defun set-face-attribute-from-resource (face attribute resource class frame)
+ "Set FACE's ATTRIBUTE from X resource RESOURCE, class CLASS on FRAME.
+Value is the attribute value specified by the resource, or nil
+if not present. This function displays a message if the resource
+specifies an invalid attribute."
+ (let* ((face-name (face-name face))
+ (value (internal-face-x-get-resource (concat face-name resource)
+ class frame)))
+ (when value
+ (condition-case ()
+ (internal-set-lisp-face-attribute-from-resource
+ face attribute (downcase value) frame)
+ (error
+ (message "Face %s, frame %s: invalid attribute %s %s from X resource"
+ face-name frame attribute value))))
+ value))
+
+
+(defun set-face-attributes-from-resources (face frame)
+ "Set attributes of FACE from X resources for FRAME."
+ (when (memq (framep frame) '(x w32))
+ (dolist (definition face-x-resources)
+ (let ((attribute (car definition)))
+ (dolist (entry (cdr definition))
+ (set-face-attribute-from-resource face attribute (car entry)
+ (cdr entry) frame))))))
+
+
+(defun make-face-x-resource-internal (face &optional frame)
+ "Fill frame-local FACE on FRAME from X resources.
+FRAME nil or not specified means do it for all frames.
+
+If `inhibit-x-resources' is non-nil, this function does nothing."
+ (unless inhibit-x-resources
+ (dolist (frame (if (null frame) (frame-list) (list frame)))
+ ;; `x-create-frame' already took care of correctly handling
+ ;; the reverse video case-- do _not_ touch the default face
+ (unless (and (eq face 'default)
+ (frame-parameter frame 'reverse))
+ (set-face-attributes-from-resources face frame)))))
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Retrieving face attributes.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun face-name (face)
+ "Return the name of face FACE."
+ (symbol-name (check-face face)))
+
+
+(defun face-all-attributes (face &optional frame)
+ "Return an alist stating the attributes of FACE.
+Each element of the result has the form (ATTR-NAME . ATTR-VALUE).
+If FRAME is omitted or nil the value describes the default attributes,
+but if you specify FRAME, the value describes the attributes
+of FACE on FRAME."
+ (mapcar (lambda (pair)
+ (let ((attr (car pair)))
+ (cons attr (face-attribute face attr (or frame t)))))
+ face-attribute-name-alist))
+
+(defun face-attribute (face attribute &optional frame inherit)
+ "Return the value of FACE's ATTRIBUTE on FRAME.
+If the optional argument FRAME is given, report on face FACE in that frame.
+If FRAME is t, report on the defaults for face FACE (for new frames).
+If FRAME is omitted or nil, use the selected frame.
+
+If INHERIT is nil, only attributes directly defined by FACE are considered,
+ so the return value may be `unspecified', or a relative value.
+If INHERIT is non-nil, FACE's definition of ATTRIBUTE is merged with the
+ faces specified by its `:inherit' attribute; however the return value
+ may still be `unspecified' or relative.
+If INHERIT is a face or a list of faces, then the result is further merged
+ with that face (or faces), until it becomes specified and absolute.
+
+To ensure that the return value is always specified and absolute, use a
+value of `default' for INHERIT; this will resolve any unspecified or
+relative values by merging with the `default' face (which is always
+completely specified)."
+ (let ((value (internal-get-lisp-face-attribute face attribute frame)))
+ (when (and inherit (face-attribute-relative-p attribute value))
+ ;; VALUE is relative, so merge with inherited faces
+ (let ((inh-from (face-attribute face :inherit frame)))
+ (unless (or (null inh-from) (eq inh-from 'unspecified))
+ (condition-case nil
+ (setq value
+ (face-attribute-merged-with attribute value inh-from
frame))
+ ;; The `inherit' attribute may point to non existent faces.
+ (error nil)))))
+ (when (and inherit
+ (not (eq inherit t))
+ (face-attribute-relative-p attribute value))
+ ;; We should merge with INHERIT as well
+ (setq value (face-attribute-merged-with attribute value inherit frame)))
+ value))
+
+(defun face-attribute-merged-with (attribute value faces &optional frame)
+ "Merges ATTRIBUTE, initially VALUE, with faces from FACES until absolute.
+FACES may be either a single face or a list of faces.
+\[This is an internal function.]"
+ (cond ((not (face-attribute-relative-p attribute value))
+ value)
+ ((null faces)
+ value)
+ ((consp faces)
+ (face-attribute-merged-with
+ attribute
+ (face-attribute-merged-with attribute value (car faces) frame)
+ (cdr faces)
+ frame))
+ (t
+ (merge-face-attribute attribute
+ value
+ (face-attribute faces attribute frame t)))))
+
+
+(defmacro face-attribute-specified-or (value &rest body)
+ "Return VALUE, unless it's `unspecified', in which case evaluate BODY and
return the result."
+ (let ((temp (make-symbol "value")))
+ `(let ((,temp ,value))
+ (if (not (eq ,temp 'unspecified))
+ ,temp
+ ,@body))))
+
+(defun face-foreground (face &optional frame inherit)
+ "Return the foreground color name of FACE, or nil if unspecified.
+If the optional argument FRAME is given, report on face FACE in that frame.
+If FRAME is t, report on the defaults for face FACE (for new frames).
+If FRAME is omitted or nil, use the selected frame.
+
+If INHERIT is nil, only a foreground color directly defined by FACE is
+ considered, so the return value may be nil.
+If INHERIT is t, and FACE doesn't define a foreground color, then any
+ foreground color that FACE inherits through its `:inherit' attribute
+ is considered as well; however the return value may still be nil.
+If INHERIT is a face or a list of faces, then it is used to try to
+ resolve an unspecified foreground color.
+
+To ensure that a valid color is always returned, use a value of
+`default' for INHERIT; this will resolve any unspecified values by
+merging with the `default' face (which is always completely specified)."
+ (face-attribute-specified-or (face-attribute face :foreground frame inherit)
+ nil))
+
+(defun face-background (face &optional frame inherit)
+ "Return the background color name of FACE, or nil if unspecified.
+If the optional argument FRAME is given, report on face FACE in that frame.
+If FRAME is t, report on the defaults for face FACE (for new frames).
+If FRAME is omitted or nil, use the selected frame.
+
+If INHERIT is nil, only a background color directly defined by FACE is
+ considered, so the return value may be nil.
+If INHERIT is t, and FACE doesn't define a background color, then any
+ background color that FACE inherits through its `:inherit' attribute
+ is considered as well; however the return value may still be nil.
+If INHERIT is a face or a list of faces, then it is used to try to
+ resolve an unspecified background color.
+
+To ensure that a valid color is always returned, use a value of
+`default' for INHERIT; this will resolve any unspecified values by
+merging with the `default' face (which is always completely specified)."
+ (face-attribute-specified-or (face-attribute face :background frame inherit)
+ nil))
+
+(defun face-stipple (face &optional frame inherit)
+ "Return the stipple pixmap name of FACE, or nil if unspecified.
+If the optional argument FRAME is given, report on face FACE in that frame.
+If FRAME is t, report on the defaults for face FACE (for new frames).
+If FRAME is omitted or nil, use the selected frame.
+
+If INHERIT is nil, only a stipple directly defined by FACE is
+ considered, so the return value may be nil.
+If INHERIT is t, and FACE doesn't define a stipple, then any stipple
+ that FACE inherits through its `:inherit' attribute is considered as
+ well; however the return value may still be nil.
+If INHERIT is a face or a list of faces, then it is used to try to
+ resolve an unspecified stipple.
+
+To ensure that a valid stipple or nil is always returned, use a value of
+`default' for INHERIT; this will resolve any unspecified values by merging
+with the `default' face (which is always completely specified)."
+ (face-attribute-specified-or (face-attribute face :stipple frame inherit)
+ nil))
+
+
+(defalias 'face-background-pixmap 'face-stipple)
+
+
+(defun face-underline-p (face &optional frame inherit)
+ "Return non-nil if FACE specifies a non-nil underlining.
+If the optional argument FRAME is given, report on face FACE in that frame.
+If FRAME is t, report on the defaults for face FACE (for new frames).
+If FRAME is omitted or nil, use the selected frame.
+Optional argument INHERIT is passed to `face-attribute'."
+ (face-attribute-specified-or
+ (face-attribute face :underline frame inherit) nil))
+
+
+(defun face-inverse-video-p (face &optional frame inherit)
+ "Return non-nil if FACE specifies a non-nil inverse-video.
+If the optional argument FRAME is given, report on face FACE in that frame.
+If FRAME is t, report on the defaults for face FACE (for new frames).
+If FRAME is omitted or nil, use the selected frame.
+Optional argument INHERIT is passed to `face-attribute'."
+ (eq (face-attribute face :inverse-video frame inherit) t))
+
+
+(defun face-bold-p (face &optional frame inherit)
+ "Return non-nil if the font of FACE is bold on FRAME.
+If the optional argument FRAME is given, report on face FACE in that frame.
+If FRAME is t, report on the defaults for face FACE (for new frames).
+If FRAME is omitted or nil, use the selected frame.
+Optional argument INHERIT is passed to `face-attribute'.
+Use `face-attribute' for finer control."
+ (let ((bold (face-attribute face :weight frame inherit)))
+ (memq bold '(semi-bold bold extra-bold ultra-bold))))
+
+
+(defun face-italic-p (face &optional frame inherit)
+ "Return non-nil if the font of FACE is italic on FRAME.
+If the optional argument FRAME is given, report on face FACE in that frame.
+If FRAME is t, report on the defaults for face FACE (for new frames).
+If FRAME is omitted or nil, use the selected frame.
+Optional argument INHERIT is passed to `face-attribute'.
+Use `face-attribute' for finer control."
+ (let ((italic (face-attribute face :slant frame inherit)))
+ (memq italic '(italic oblique))))
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Face documentation.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun face-documentation (face)
+ "Get the documentation string for FACE.
+If FACE is a face-alias, get the documentation for the target face."
+ (let ((alias (get face 'face-alias)))
+ (if alias
+ (let ((doc (get alias 'face-documentation)))
+ (format "%s is an alias for the face `%s'.%s" face alias
+ (if doc (format "\n%s" doc)
+ "")))
+ (get face 'face-documentation))))
+
+
+(defun set-face-documentation (face string)
+ "Set the documentation string for FACE to STRING."
+ ;; Perhaps the text should go in DOC.
+ (put face 'face-documentation (purecopy string)))
+
+
+(defalias 'face-doc-string 'face-documentation)
+(defalias 'set-face-doc-string 'set-face-documentation)
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Setting face attributes.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+(defun set-face-attribute (face frame &rest args)
+ "Set attributes of FACE on FRAME from ARGS.
+This function overrides the face attributes specified by FACE's
+face spec. It is mostly intended for internal use only.
+
+If FRAME is nil, set the attributes for all existing frames, as
+well as the default for new frames. If FRAME is t, change the
+default for new frames only.
+
+ARGS must come in pairs ATTRIBUTE VALUE. ATTRIBUTE must be a
+valid face attribute name. All attributes can be set to
+`unspecified'; this fact is not further mentioned below.
+
+The following attributes are recognized:
+
+`:family'
+
+VALUE must be a string specifying the font family
+\(e.g. \"Monospace\") or a fontset.
+
+`:foundry'
+
+VALUE must be a string specifying the font foundry,
+e.g. ``adobe''. If a font foundry is specified, wild-cards `*'
+and `?' are allowed.
+
+`:width'
+
+VALUE specifies the relative proportionate width of the font to use.
+It must be one of the symbols `ultra-condensed', `extra-condensed',
+`condensed', `semi-condensed', `normal', `semi-expanded', `expanded',
+`extra-expanded', or `ultra-expanded'.
+
+`:height'
+
+VALUE specifies the relative or absolute height of the font. An
+absolute height is an integer, and specifies font height in units
+of 1/10 pt. A relative height is either a floating point number,
+which specifies a scaling factor for the underlying face height;
+or a function that takes a single argument (the underlying face
+height) and returns the new height. Note that for the `default'
+face, you must specify an absolute height (since there is nothing
+for it to be relative to).
+
+`:weight'
+
+VALUE specifies the weight of the font to use. It must be one of the
+symbols `ultra-bold', `extra-bold', `bold', `semi-bold', `normal',
+`semi-light', `light', `extra-light', `ultra-light'.
+
+`:slant'
+
+VALUE specifies the slant of the font to use. It must be one of the
+symbols `italic', `oblique', `normal', `reverse-italic', or
+`reverse-oblique'.
+
+`:foreground', `:background'
+
+VALUE must be a color name, a string.
+
+`:underline'
+
+VALUE specifies whether characters in FACE should be underlined.
+If VALUE is t, underline with foreground color of the face.
+If VALUE is a string, underline with that color.
+If VALUE is nil, explicitly don't underline.
+
+Otherwise, VALUE must be a property list of the form:
+
+`(:color COLOR :style STYLE)'.
+
+COLOR can be a either a color name string or `foreground-color'.
+STYLE can be either `line' or `wave'.
+If a keyword/value pair is missing from the property list, a
+default value will be used for the value.
+The default value of COLOR is the foreground color of the face.
+The default value of STYLE is `line'.
+
+`:overline'
+
+VALUE specifies whether characters in FACE should be overlined. If
+VALUE is t, overline with foreground color of the face. If VALUE is a
+string, overline with that color. If VALUE is nil, explicitly don't
+overline.
+
+`:strike-through'
+
+VALUE specifies whether characters in FACE should be drawn with a line
+striking through them. If VALUE is t, use the foreground color of the
+face. If VALUE is a string, strike-through with that color. If VALUE
+is nil, explicitly don't strike through.
+
+`:box'
+
+VALUE specifies whether characters in FACE should have a box drawn
+around them. If VALUE is nil, explicitly don't draw boxes. If
+VALUE is t, draw a box with lines of width 1 in the foreground color
+of the face. If VALUE is a string, the string must be a color name,
+and the box is drawn in that color with a line width of 1. Otherwise,
+VALUE must be a property list of the form `(:line-width WIDTH
+:color COLOR :style STYLE)'. If a keyword/value pair is missing from
+the property list, a default value will be used for the value, as
+specified below. WIDTH specifies the width of the lines to draw; it
+defaults to 1. If WIDTH is negative, the absolute value is the width
+of the lines, and draw top/bottom lines inside the characters area,
+not around it. COLOR is the name of the color to draw in, default is
+the foreground color of the face for simple boxes, and the background
+color of the face for 3D boxes. STYLE specifies whether a 3D box
+should be draw. If STYLE is `released-button', draw a box looking
+like a released 3D button. If STYLE is `pressed-button' draw a box
+that appears like a pressed button. If STYLE is nil, the default if
+the property list doesn't contain a style specification, draw a 2D
+box.
+
+`:inverse-video'
+
+VALUE specifies whether characters in FACE should be displayed in
+inverse video. VALUE must be one of t or nil.
+
+`:stipple'
+
+If VALUE is a string, it must be the name of a file of pixmap data.
+The directories listed in the `x-bitmap-file-path' variable are
+searched. Alternatively, VALUE may be a list of the form (WIDTH
+HEIGHT DATA) where WIDTH and HEIGHT are the size in pixels, and DATA
+is a string containing the raw bits of the bitmap. VALUE nil means
+explicitly don't use a stipple pattern.
+
+For convenience, attributes `:family', `:foundry', `:width',
+`:height', `:weight', and `:slant' may also be set in one step
+from an X font name:
+
+`:font'
+
+Set font-related face attributes from VALUE. VALUE must be a
+valid font name or font object. Setting this attribute will also
+set the `:family', `:foundry', `:width', `:height', `:weight',
+and `:slant' attributes.
+
+`:inherit'
+
+VALUE is the name of a face from which to inherit attributes, or
+a list of face names. Attributes from inherited faces are merged
+into the face like an underlying face would be, with higher
+priority than underlying faces.
+
+For backward compatibility, the keywords `:bold' and `:italic'
+can be used to specify weight and slant respectively. This usage
+is considered obsolete. For these two keywords, the VALUE must
+be either t or nil. A value of t for `:bold' is equivalent to
+setting `:weight' to `bold', and a value of t for `:italic' is
+equivalent to setting `:slant' to `italic'. But if `:weight' is
+specified in the face spec, `:bold' is ignored, and if `:slant'
+is specified, `:italic' is ignored."
+ (setq args (purecopy args))
+ (let ((where (if (null frame) 0 frame))
+ (spec args)
+ family foundry)
+ ;; If we set the new-frame defaults, this face is modified outside Custom.
+ (if (memq where '(0 t))
+ (put (or (get face 'face-alias) face) 'face-modified t))
+ ;; If family and/or foundry are specified, set it first. Certain
+ ;; face attributes, e.g. :weight semi-condensed, are not supported
+ ;; in every font. See bug#1127.
+ (while spec
+ (cond ((eq (car spec) :family)
+ (setq family (cadr spec)))
+ ((eq (car spec) :foundry)
+ (setq foundry (cadr spec))))
+ (setq spec (cddr spec)))
+ (when (or family foundry)
+ (when (and (stringp family)
+ (string-match "\\([^-]*\\)-\\([^-]*\\)" family))
+ (unless foundry
+ (setq foundry (match-string 1 family)))
+ (setq family (match-string 2 family)))
+ (when (or (stringp family) (eq family 'unspecified))
+ (internal-set-lisp-face-attribute face :family (purecopy family)
+ where))
+ (when (or (stringp foundry) (eq foundry 'unspecified))
+ (internal-set-lisp-face-attribute face :foundry (purecopy foundry)
+ where)))
+ (while args
+ (unless (memq (car args) '(:family :foundry))
+ (internal-set-lisp-face-attribute face (car args)
+ (purecopy (cadr args))
+ where))
+ (setq args (cddr args)))))
+
+(defun make-face-bold (face &optional frame _noerror)
+ "Make the font of FACE be bold, if possible.
+FRAME nil or not specified means change face on all frames.
+Argument NOERROR is ignored and retained for compatibility.
+Use `set-face-attribute' for finer control of the font weight."
+ (interactive (list (read-face-name "Make which face bold"
+ (face-at-point t))))
+ (set-face-attribute face frame :weight 'bold))
+
+
+(defun make-face-unbold (face &optional frame _noerror)
+ "Make the font of FACE be non-bold, if possible.
+FRAME nil or not specified means change face on all frames.
+Argument NOERROR is ignored and retained for compatibility."
+ (interactive (list (read-face-name "Make which face non-bold"
+ (face-at-point t))))
+ (set-face-attribute face frame :weight 'normal))
+
+
+(defun make-face-italic (face &optional frame _noerror)
+ "Make the font of FACE be italic, if possible.
+FRAME nil or not specified means change face on all frames.
+Argument NOERROR is ignored and retained for compatibility.
+Use `set-face-attribute' for finer control of the font slant."
+ (interactive (list (read-face-name "Make which face italic"
+ (face-at-point t))))
+ (set-face-attribute face frame :slant 'italic))
+
+
+(defun make-face-unitalic (face &optional frame _noerror)
+ "Make the font of FACE be non-italic, if possible.
+FRAME nil or not specified means change face on all frames.
+Argument NOERROR is ignored and retained for compatibility."
+ (interactive (list (read-face-name "Make which face non-italic"
+ (face-at-point t))))
+ (set-face-attribute face frame :slant 'normal))
+
+
+(defun make-face-bold-italic (face &optional frame _noerror)
+ "Make the font of FACE be bold and italic, if possible.
+FRAME nil or not specified means change face on all frames.
+Argument NOERROR is ignored and retained for compatibility.
+Use `set-face-attribute' for finer control of font weight and slant."
+ (interactive (list (read-face-name "Make which face bold-italic"
+ (face-at-point t))))
+ (set-face-attribute face frame :weight 'bold :slant 'italic))
+
+
+(defun set-face-font (face font &optional frame)
+ "Change font-related attributes of FACE to those of FONT (a string).
+FRAME nil or not specified means change face on all frames.
+This sets the attributes `:family', `:foundry', `:width',
+`:height', `:weight', and `:slant'. When called interactively,
+prompt for the face and font."
+ (interactive (read-face-and-attribute :font))
+ (set-face-attribute face frame :font font))
+
+
+;; Implementation note: Emulating gray background colors with a
+;; stipple pattern is now part of the face realization process, and is
+;; done in C depending on the frame on which the face is realized.
+
+(defun set-face-background (face color &optional frame)
+ "Change the background color of face FACE to COLOR (a string).
+FRAME nil or not specified means change face on all frames.
+COLOR can be a system-defined color name (see `list-colors-display')
+or a hex spec of the form #RRGGBB.
+When called interactively, prompts for the face and color."
+ (interactive (read-face-and-attribute :background))
+ (set-face-attribute face frame :background (or color 'unspecified)))
+
+
+(defun set-face-foreground (face color &optional frame)
+ "Change the foreground color of face FACE to COLOR (a string).
+FRAME nil or not specified means change face on all frames.
+COLOR can be a system-defined color name (see `list-colors-display')
+or a hex spec of the form #RRGGBB.
+When called interactively, prompts for the face and color."
+ (interactive (read-face-and-attribute :foreground))
+ (set-face-attribute face frame :foreground (or color 'unspecified)))
+
+
+(defun set-face-stipple (face stipple &optional frame)
+ "Change the stipple pixmap of face FACE to STIPPLE.
+FRAME nil or not specified means change face on all frames.
+STIPPLE should be a string, the name of a file of pixmap data.
+The directories listed in the `x-bitmap-file-path' variable are searched.
+
+Alternatively, STIPPLE may be a list of the form (WIDTH HEIGHT DATA)
+where WIDTH and HEIGHT are the size in pixels,
+and DATA is a string, containing the raw bits of the bitmap."
+ (interactive (read-face-and-attribute :stipple))
+ (set-face-attribute face frame :stipple (or stipple 'unspecified)))
+
+
+(defun set-face-underline (face underline &optional frame)
+ "Specify whether face FACE is underlined.
+UNDERLINE nil means FACE explicitly doesn't underline.
+UNDERLINE t means FACE underlines with its foreground color.
+If UNDERLINE is a string, underline with that color.
+
+UNDERLINE may also be a list of the form (:color COLOR :style STYLE),
+where COLOR is a string or `foreground-color', and STYLE is either
+`line' or `wave'. :color may be omitted, which means to use the
+foreground color. :style may be omitted, which means to use a line.
+
+FRAME nil or not specified means change face on all frames.
+Use `set-face-attribute' to ``unspecify'' underlining."
+ (interactive (read-face-and-attribute :underline))
+ (set-face-attribute face frame :underline underline))
+
+(define-obsolete-function-alias 'set-face-underline-p
+ 'set-face-underline "24.3")
+
+
+(defun set-face-inverse-video (face inverse-video-p &optional frame)
+ "Specify whether face FACE is in inverse video.
+INVERSE-VIDEO-P non-nil means FACE displays explicitly in inverse video.
+INVERSE-VIDEO-P nil means FACE explicitly is not in inverse video.
+FRAME nil or not specified means change face on all frames.
+Use `set-face-attribute' to ``unspecify'' the inverse video attribute."
+ (interactive
+ (let ((list (read-face-and-attribute :inverse-video)))
+ (list (car list) (if (cadr list) t))))
+ (set-face-attribute face frame :inverse-video inverse-video-p))
+
+(define-obsolete-function-alias 'set-face-inverse-video-p
+ 'set-face-inverse-video "24.4")
+
+(defun set-face-bold (face bold-p &optional frame)
+ "Specify whether face FACE is bold.
+BOLD-P non-nil means FACE should explicitly display bold.
+BOLD-P nil means FACE should explicitly display non-bold.
+FRAME nil or not specified means change face on all frames.
+Use `set-face-attribute' or `modify-face' for finer control."
+ (if (null bold-p)
+ (make-face-unbold face frame)
+ (make-face-bold face frame)))
+
+(define-obsolete-function-alias 'set-face-bold-p 'set-face-bold "24.4")
+
+
+(defun set-face-italic (face italic-p &optional frame)
+ "Specify whether face FACE is italic.
+ITALIC-P non-nil means FACE should explicitly display italic.
+ITALIC-P nil means FACE should explicitly display non-italic.
+FRAME nil or not specified means change face on all frames.
+Use `set-face-attribute' or `modify-face' for finer control."
+ (if (null italic-p)
+ (make-face-unitalic face frame)
+ (make-face-italic face frame)))
+
+(define-obsolete-function-alias 'set-face-italic-p 'set-face-italic "24.4")
+
+
+(defalias 'set-face-background-pixmap 'set-face-stipple)
+
+
+(defun invert-face (face &optional frame)
+ "Swap the foreground and background colors of FACE.
+If FRAME is omitted or nil, it means change face on all frames.
+If FACE specifies neither foreground nor background color,
+set its foreground and background to the background and foreground
+of the default face. Value is FACE."
+ (interactive (list (read-face-name "Invert face" (face-at-point t))))
+ (let ((fg (face-attribute face :foreground frame))
+ (bg (face-attribute face :background frame)))
+ (if (not (and (eq fg 'unspecified) (eq bg 'unspecified)))
+ (set-face-attribute face frame :foreground bg :background fg)
+ (set-face-attribute face frame
+ :foreground
+ (face-attribute 'default :background frame)
+ :background
+ (face-attribute 'default :foreground frame))))
+ face)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Interactively modifying faces.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar crm-separator) ; from crm.el
+
+(defun read-face-name (prompt &optional default multiple)
+ "Read one or more face names, prompting with PROMPT.
+PROMPT should not end in a space or a colon.
+
+Return DEFAULT if the user enters the empty string.
+If DEFAULT is non-nil, it should be a single face or a list of face names
+\(symbols or strings). In the latter case, return the `car' of DEFAULT
+\(if MULTIPLE is nil, see below), or DEFAULT (if MULTIPLE is non-nil).
+
+If MULTIPLE is non-nil, this function uses `completing-read-multiple'
+to read multiple faces with \"[ \\t]*,[ \\t]*\" as the separator regexp
+and it returns a list of face names. Otherwise, it reads and returns
+a single face name."
+ (if (and default (not (stringp default)))
+ (setq default
+ (cond ((symbolp default)
+ (symbol-name default))
+ (multiple
+ (mapconcat (lambda (f) (if (symbolp f) (symbol-name f) f))
+ default ", "))
+ ;; If we only want one, and the default is more than one,
+ ;; discard the unwanted ones.
+ (t (symbol-name (car default))))))
+ (when (and default (not multiple))
+ (require 'crm)
+ ;; For compatibility with `completing-read-multiple' use `crm-separator'
+ ;; to define DEFAULT if MULTIPLE is nil.
+ (setq default (car (split-string default crm-separator t))))
+
+ (let ((prompt (if default
+ (format "%s (default `%s'): " prompt default)
+ (format "%s: " prompt)))
+ aliasfaces nonaliasfaces faces)
+ ;; Build up the completion tables.
+ (mapatoms (lambda (s)
+ (if (facep s)
+ (if (get s 'face-alias)
+ (push (symbol-name s) aliasfaces)
+ (push (symbol-name s) nonaliasfaces)))))
+ (if multiple
+ (progn
+ (dolist (face (completing-read-multiple
+ prompt
+ (completion-table-in-turn nonaliasfaces aliasfaces)
+ nil t nil 'face-name-history default))
+ ;; Ignore elements that are not faces
+ ;; (for example, because DEFAULT was "all faces")
+ (if (facep face) (push (intern face) faces)))
+ (nreverse faces))
+ (let ((face (completing-read
+ prompt
+ (completion-table-in-turn nonaliasfaces aliasfaces)
+ nil t nil 'face-name-history default)))
+ (if (facep face) (intern face))))))
+
+;; Not defined without X, but behind window-system test.
+(defvar x-bitmap-file-path)
+
+(defun face-valid-attribute-values (attribute &optional frame)
+ "Return valid values for face attribute ATTRIBUTE.
+The optional argument FRAME is used to determine available fonts
+and colors. If it is nil or not specified, the selected frame is used.
+Value is an alist of (NAME . VALUE) if ATTRIBUTE expects a value out
+of a set of discrete values. Value is `integerp' if ATTRIBUTE expects
+an integer value."
+ (let ((valid
+ (pcase attribute
+ (`:family
+ (if (window-system frame)
+ (mapcar (lambda (x) (cons x x))
+ (font-family-list))
+ ;; Only one font on TTYs.
+ (list (cons "default" "default"))))
+ (`:foundry
+ (list nil))
+ (`:width
+ (mapcar #'(lambda (x) (cons (symbol-name (aref x 1)) (aref x 1)))
+ font-width-table))
+ (`:weight
+ (mapcar #'(lambda (x) (cons (symbol-name (aref x 1)) (aref x 1)))
+ font-weight-table))
+ (`:slant
+ (mapcar #'(lambda (x) (cons (symbol-name (aref x 1)) (aref x 1)))
+ font-slant-table))
+ (`:inverse-video
+ (mapcar #'(lambda (x) (cons (symbol-name x) x))
+ (internal-lisp-face-attribute-values attribute)))
+ ((or `:underline `:overline `:strike-through `:box)
+ (if (window-system frame)
+ (nconc (mapcar #'(lambda (x) (cons (symbol-name x) x))
+ (internal-lisp-face-attribute-values attribute))
+ (mapcar #'(lambda (c) (cons c c))
+ (defined-colors frame)))
+ (mapcar #'(lambda (x) (cons (symbol-name x) x))
+ (internal-lisp-face-attribute-values attribute))))
+ ((or `:foreground `:background)
+ (mapcar #'(lambda (c) (cons c c))
+ (defined-colors frame)))
+ (`:height
+ 'integerp)
+ (`:stipple
+ (and (memq (window-system frame) '(x ns)) ; No stipple on w32
+ (mapcar #'list
+ (apply #'nconc
+ (mapcar (lambda (dir)
+ (and (file-readable-p dir)
+ (file-directory-p dir)
+ (directory-files dir)))
+ x-bitmap-file-path)))))
+ (`:inherit
+ (cons '("none" . nil)
+ (mapcar #'(lambda (c) (cons (symbol-name c) c))
+ (face-list))))
+ (_
+ (error "Internal error")))))
+ (if (and (listp valid) (not (memq attribute '(:inherit))))
+ (nconc (list (cons "unspecified" 'unspecified)) valid)
+ valid)))
+
+
+(defconst face-attribute-name-alist
+ '((:family . "font family")
+ (:foundry . "font foundry")
+ (:width . "character set width")
+ (:height . "height in 1/10 pt")
+ (:weight . "weight")
+ (:slant . "slant")
+ (:underline . "underline")
+ (:overline . "overline")
+ (:strike-through . "strike-through")
+ (:box . "box")
+ (:inverse-video . "inverse-video display")
+ (:foreground . "foreground color")
+ (:background . "background color")
+ (:stipple . "background stipple")
+ (:inherit . "inheritance"))
+ "An alist of descriptive names for face attributes.
+Each element has the form (ATTRIBUTE-NAME . DESCRIPTION) where
+ATTRIBUTE-NAME is a face attribute name (a keyword symbol), and
+DESCRIPTION is a descriptive name for ATTRIBUTE-NAME.")
+
+
+(defun face-descriptive-attribute-name (attribute)
+ "Return a descriptive name for ATTRIBUTE."
+ (cdr (assq attribute face-attribute-name-alist)))
+
+
+(defun face-read-string (face default name &optional completion-alist)
+ "Interactively read a face attribute string value.
+FACE is the face whose attribute is read. If non-nil, DEFAULT is the
+default string to return if no new value is entered. NAME is a
+descriptive name of the attribute for prompting. COMPLETION-ALIST is an
+alist of valid values, if non-nil.
+
+Entering nothing accepts the default string DEFAULT.
+Value is the new attribute value."
+ ;; Capitalize NAME (we don't use `capitalize' because that capitalizes
+ ;; each word in a string separately).
+ (setq name (concat (upcase (substring name 0 1)) (substring name 1)))
+ (let* ((completion-ignore-case t)
+ (value (completing-read
+ (if default
+ (format "%s for face `%s' (default %s): "
+ name face default)
+ (format "%s for face `%s': " name face))
+ completion-alist nil nil nil nil default)))
+ (if (equal value "") default value)))
+
+
+(defun face-read-integer (face default name)
+ "Interactively read an integer face attribute value.
+FACE is the face whose attribute is read. DEFAULT is the default
+value to return if no new value is entered. NAME is a descriptive
+name of the attribute for prompting. Value is the new attribute value."
+ (let ((new-value
+ (face-read-string face
+ (format "%s" default)
+ name
+ (list (cons "unspecified" 'unspecified)))))
+ (cond ((equal new-value "unspecified")
+ 'unspecified)
+ ((member new-value '("unspecified-fg" "unspecified-bg"))
+ new-value)
+ (t
+ (string-to-number new-value)))))
+
+
+;; FIXME this does allow you to enter the list forms of :box,
+;; :stipple, or :underline, because face-valid-attribute-values does
+;; not return those forms.
+(defun read-face-attribute (face attribute &optional frame)
+ "Interactively read a new value for FACE's ATTRIBUTE.
+Optional argument FRAME nil or unspecified means read an attribute value
+of a global face. Value is the new attribute value."
+ (let* ((old-value (face-attribute face attribute frame))
+ (attribute-name (face-descriptive-attribute-name attribute))
+ (valid (face-valid-attribute-values attribute frame))
+ new-value)
+ ;; Represent complex attribute values as strings by printing them
+ ;; out. Stipple can be a vector; (WIDTH HEIGHT DATA). Box can be
+ ;; a list `(:width WIDTH :color COLOR)' or `(:width WIDTH :shadow
+ ;; SHADOW)'. Underline can be `(:color COLOR :style STYLE)'.
+ (and (memq attribute '(:box :stipple :underline))
+ (or (consp old-value)
+ (vectorp old-value))
+ (setq old-value (prin1-to-string old-value)))
+ (cond ((listp valid)
+ (let ((default
+ (or (car (rassoc old-value valid))
+ (format "%s" old-value))))
+ (setq new-value
+ (face-read-string face default attribute-name valid))
+ (if (equal new-value default)
+ ;; Nothing changed, so don't bother with all the stuff
+ ;; below. In particular, this avoids a non-tty color
+ ;; from being canonicalized for a tty when the user
+ ;; just uses the default.
+ (setq new-value old-value)
+ ;; Terminal frames can support colors that don't appear
+ ;; explicitly in VALID, using color approximation code
+ ;; in tty-colors.el.
+ (when (and (memq attribute '(:foreground :background))
+ (not (memq (window-system frame) '(x w32 ns)))
+ (not (member new-value
+ '("unspecified"
+ "unspecified-fg" "unspecified-bg"))))
+ (setq new-value (car (tty-color-desc new-value frame))))
+ (when (assoc new-value valid)
+ (setq new-value (cdr (assoc new-value valid)))))))
+ ((eq valid 'integerp)
+ (setq new-value (face-read-integer face old-value attribute-name)))
+ (t (error "Internal error")))
+ ;; Convert stipple and box value text we read back to a list or
+ ;; vector if it looks like one. This makes the assumption that a
+ ;; pixmap file name won't start with an open-paren.
+ (and (memq attribute '(:stipple :box :underline))
+ (stringp new-value)
+ (string-match-p "^[[(]" new-value)
+ (setq new-value (read new-value)))
+ new-value))
+
+(declare-function fontset-list "fontset.c" ())
+(declare-function x-list-fonts "xfaces.c"
+ (pattern &optional face frame maximum width))
+
+(defun read-face-font (face &optional frame)
+ "Read the name of a font for FACE on FRAME.
+If optional argument FRAME is nil or omitted, use the selected frame."
+ (let ((completion-ignore-case t))
+ (completing-read (format "Set font attributes of face `%s' from font: "
face)
+ (append (fontset-list) (x-list-fonts "*" nil frame)))))
+
+
+(defun read-all-face-attributes (face &optional frame)
+ "Interactively read all attributes for FACE.
+If optional argument FRAME is nil or omitted, use the selected frame.
+Value is a property list of attribute names and new values."
+ (let (result)
+ (dolist (attribute face-attribute-name-alist result)
+ (setq result (cons (car attribute)
+ (cons (read-face-attribute face (car attribute) frame)
+ result))))))
+
+(defun modify-face (&optional face foreground background stipple
+ bold-p italic-p underline inverse-p frame)
+ "Modify attributes of faces interactively.
+If optional argument FRAME is nil or omitted, modify the face used
+for newly created frame, i.e. the global face.
+For non-interactive use, `set-face-attribute' is preferred.
+When called from Lisp, if FACE is nil, all arguments but FRAME are ignored
+and the face and its settings are obtained by querying the user."
+ (interactive)
+ (if face
+ (set-face-attribute face frame
+ :foreground (or foreground 'unspecified)
+ :background (or background 'unspecified)
+ :stipple stipple
+ :weight (if bold-p 'bold 'normal)
+ :slant (if italic-p 'italic 'normal)
+ :underline underline
+ :inverse-video inverse-p)
+ (setq face (read-face-name "Modify face" (face-at-point t)))
+ (apply #'set-face-attribute face frame
+ (read-all-face-attributes face frame))))
+
+(defun read-face-and-attribute (attribute &optional frame)
+ "Read face name and face attribute value.
+ATTRIBUTE is the attribute whose new value is read.
+FRAME nil or unspecified means read attribute value of global face.
+Value is a list (FACE NEW-VALUE) where FACE is the face read
+\(a symbol), and NEW-VALUE is value read."
+ (cond ((eq attribute :font)
+ (let* ((prompt "Set font-related attributes of face")
+ (face (read-face-name prompt (face-at-point t)))
+ (font (read-face-font face frame)))
+ (list face font)))
+ (t
+ (let* ((attribute-name (face-descriptive-attribute-name attribute))
+ (prompt (format "Set %s of face" attribute-name))
+ (face (read-face-name prompt (face-at-point t)))
+ (new-value (read-face-attribute face attribute frame)))
+ (list face new-value)))))
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Listing faces.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defconst list-faces-sample-text
+ "abcdefghijklmnopqrstuvwxyz ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+ "Text string to display as the sample text for `list-faces-display'.")
+
+
+;; The name list-faces would be more consistent, but let's avoid a
+;; conflict with Lucid, which uses that name differently.
+
+(defvar help-xref-stack)
+(defun list-faces-display (&optional regexp)
+ "List all faces, using the same sample text in each.
+The sample text is a string that comes from the variable
+`list-faces-sample-text'.
+
+If REGEXP is non-nil, list only those faces with names matching
+this regular expression. When called interactively with a prefix
+argument, prompt for a regular expression using `read-regexp'."
+ (interactive (list (and current-prefix-arg
+ (read-regexp "List faces matching regexp"))))
+ (let ((all-faces (zerop (length regexp)))
+ (frame (selected-frame))
+ (max-length 0)
+ faces line-format
+ disp-frame window face-name)
+ ;; We filter and take the max length in one pass
+ (setq faces
+ (delq nil
+ (mapcar (lambda (f)
+ (let ((s (symbol-name f)))
+ (when (or all-faces (string-match-p regexp s))
+ (setq max-length (max (length s) max-length))
+ f)))
+ (sort (face-list) #'string-lessp))))
+ (unless faces
+ (error "No faces matching \"%s\"" regexp))
+ (setq max-length (1+ max-length)
+ line-format (format "%%-%ds" max-length))
+ (with-help-window "*Faces*"
+ (with-current-buffer standard-output
+ (setq truncate-lines t)
+ (insert
+ (substitute-command-keys
+ (concat
+ "\\<help-mode-map>Use "
+ (if (display-mouse-p) "\\[help-follow-mouse] or ")
+ "\\[help-follow] on a face name to customize it\n"
+ "or on its sample text for a description of the face.\n\n")))
+ (setq help-xref-stack nil)
+ (dolist (face faces)
+ (setq face-name (symbol-name face))
+ (insert (format line-format face-name))
+ ;; Hyperlink to a customization buffer for the face. Using
+ ;; the help xref mechanism may not be the best way.
+ (save-excursion
+ (save-match-data
+ (search-backward face-name)
+ (setq help-xref-stack-item `(list-faces-display ,regexp))
+ (help-xref-button 0 'help-customize-face face)))
+ (let ((beg (point))
+ (line-beg (line-beginning-position)))
+ (insert list-faces-sample-text)
+ ;; Hyperlink to a help buffer for the face.
+ (save-excursion
+ (save-match-data
+ (search-backward list-faces-sample-text)
+ (help-xref-button 0 'help-face face)))
+ (insert "\n")
+ (put-text-property beg (1- (point)) 'face face)
+ ;; Make all face commands default to the proper face
+ ;; anywhere in the line.
+ (put-text-property line-beg (1- (point)) 'read-face-name face)
+ ;; If the sample text has multiple lines, line up all of them.
+ (goto-char beg)
+ (forward-line 1)
+ (while (not (eobp))
+ (insert-char ?\s max-length)
+ (forward-line 1))))
+ (goto-char (point-min))))
+ ;; If the *Faces* buffer appears in a different frame,
+ ;; copy all the face definitions from FRAME,
+ ;; so that the display will reflect the frame that was selected.
+ (setq window (get-buffer-window (get-buffer "*Faces*") t))
+ (setq disp-frame (if window (window-frame window)
+ (car (frame-list))))
+ (or (eq frame disp-frame)
+ (dolist (face (face-list))
+ (copy-face face face frame disp-frame)))))
+
+
+(defun describe-face (face &optional frame)
+ "Display the properties of face FACE on FRAME.
+Interactively, FACE defaults to the faces of the character after point
+and FRAME defaults to the selected frame.
+
+If the optional argument FRAME is given, report on face FACE in that frame.
+If FRAME is t, report on the defaults for face FACE (for new frames).
+If FRAME is omitted or nil, use the selected frame."
+ (interactive (list (read-face-name "Describe face"
+ (or (face-at-point t) 'default)
+ t)))
+ (let* ((attrs '((:family . "Family")
+ (:foundry . "Foundry")
+ (:width . "Width")
+ (:height . "Height")
+ (:weight . "Weight")
+ (:slant . "Slant")
+ (:foreground . "Foreground")
+ (:distant-foreground . "DistantForeground")
+ (:background . "Background")
+ (:underline . "Underline")
+ (:overline . "Overline")
+ (:strike-through . "Strike-through")
+ (:box . "Box")
+ (:inverse-video . "Inverse")
+ (:stipple . "Stipple")
+ (:font . "Font")
+ (:fontset . "Fontset")
+ (:inherit . "Inherit")))
+ (max-width (apply #'max (mapcar #'(lambda (x) (length (cdr x)))
+ attrs))))
+ (help-setup-xref (list #'describe-face face)
+ (called-interactively-p 'interactive))
+ (unless face
+ (setq face 'default))
+ (if (not (listp face))
+ (setq face (list face)))
+ (with-help-window (help-buffer)
+ (with-current-buffer standard-output
+ (dolist (f face)
+ (if (stringp f) (setq f (intern f)))
+ ;; We may get called for anonymous faces (i.e., faces
+ ;; expressed using prop-value plists). Those can't be
+ ;; usefully customized, so ignore them.
+ (when (symbolp f)
+ (insert "Face: " (symbol-name f))
+ (if (not (facep f))
+ (insert " undefined face.\n")
+ (let ((customize-label "customize this face")
+ file-name)
+ (insert (concat " (" (propertize "sample" 'font-lock-face f)
")"))
+ (princ (concat " (" customize-label ")\n"))
+ ;; FIXME not sure how much of this belongs here, and
+ ;; how much in `face-documentation'. The latter is
+ ;; not used much, but needs to return nil for
+ ;; undocumented faces.
+ (let ((alias (get f 'face-alias))
+ (face f)
+ obsolete)
+ (when alias
+ (setq face alias)
+ (insert
+ (format "\n %s is an alias for the face `%s'.\n%s"
+ f alias
+ (if (setq obsolete (get f 'obsolete-face))
+ (format " This face is obsolete%s; use `%s'
instead.\n"
+ (if (stringp obsolete)
+ (format " since %s" obsolete)
+ "")
+ alias)
+ ""))))
+ (insert "\nDocumentation:\n"
+ (or (face-documentation face)
+ "Not documented as a face.")
+ "\n\n"))
+ (with-current-buffer standard-output
+ (save-excursion
+ (re-search-backward
+ (concat "\\(" customize-label "\\)") nil t)
+ (help-xref-button 1 'help-customize-face f)))
+ (setq file-name (find-lisp-object-file-name f 'defface))
+ (when file-name
+ (princ "Defined in `")
+ (princ (file-name-nondirectory file-name))
+ (princ "'")
+ ;; Make a hyperlink to the library.
+ (save-excursion
+ (re-search-backward "`\\([^`']+\\)'" nil t)
+ (help-xref-button 1 'help-face-def f file-name))
+ (princ ".")
+ (terpri)
+ (terpri))
+ (dolist (a attrs)
+ (let ((attr (face-attribute f (car a) frame)))
+ (insert (make-string (- max-width (length (cdr a))) ?\s)
+ (cdr a) ": " (format "%s" attr))
+ (if (and (eq (car a) :inherit)
+ (not (eq attr 'unspecified)))
+ ;; Make a hyperlink to the parent face.
+ (save-excursion
+ (re-search-backward ": \\([^:]+\\)" nil t)
+ (help-xref-button 1 'help-face attr)))
+ (insert "\n")))))
+ (terpri)))))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Face specifications (defface).
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Parameter FRAME Is kept for call compatibility to with previous
+;; face implementation.
+
+(defun face-attr-construct (face &optional _frame)
+ "Return a `defface'-style attribute list for FACE.
+Value is a property list of pairs ATTRIBUTE VALUE for all specified
+face attributes of FACE where ATTRIBUTE is the attribute name and
+VALUE is the specified value of that attribute.
+Argument FRAME is ignored and retained for compatibility."
+ (let (result)
+ (dolist (entry face-attribute-name-alist result)
+ (let* ((attribute (car entry))
+ (value (face-attribute face attribute)))
+ (unless (eq value 'unspecified)
+ (setq result (nconc (list attribute value) result)))))))
+
+
+(defun face-spec-set-match-display (display frame)
+ "Non-nil if DISPLAY matches FRAME.
+DISPLAY is part of a spec such as can be used in `defface'.
+If FRAME is nil, the current FRAME is used."
+ (let* ((conjuncts display)
+ conjunct req options
+ ;; t means we have succeeded against all the conjuncts in
+ ;; DISPLAY that have been tested so far.
+ (match t))
+ (if (eq conjuncts t)
+ (setq conjuncts nil))
+ (while (and conjuncts match)
+ (setq conjunct (car conjuncts)
+ conjuncts (cdr conjuncts)
+ req (car conjunct)
+ options (cdr conjunct)
+ match (cond ((eq req 'type)
+ (or (memq (window-system frame) options)
+ (and (memq 'graphic options)
+ (memq (window-system frame) '(x w32 ns)))
+ ;; FIXME: This should be revisited to use
+ ;; display-graphic-p, provided that the
+ ;; color selection depends on the number
+ ;; of supported colors, and all defface's
+ ;; are changed to look at number of colors
+ ;; instead of (type graphic) etc.
+ (if (null (window-system frame))
+ (memq 'tty options)
+ (or (and (memq 'motif options)
+ (featurep 'motif))
+ (and (memq 'gtk options)
+ (featurep 'gtk))
+ (and (memq 'lucid options)
+ (featurep 'x-toolkit)
+ (not (featurep 'motif))
+ (not (featurep 'gtk)))
+ (and (memq 'x-toolkit options)
+ (featurep 'x-toolkit))))))
+ ((eq req 'min-colors)
+ (>= (display-color-cells frame) (car options)))
+ ((eq req 'class)
+ (memq (frame-parameter frame 'display-type) options))
+ ((eq req 'background)
+ (memq (frame-parameter frame 'background-mode)
+ options))
+ ((eq req 'supports)
+ (display-supports-face-attributes-p options frame))
+ (t (error "Unknown req `%S' with options `%S'"
+ req options)))))
+ match))
+
+
+(defun face-spec-choose (spec &optional frame no-match-retval)
+ "Return the proper attributes for FRAME, out of SPEC.
+
+If no match is found or SPEC is nil, return nil, unless NO-MATCH-RETVAL
+is given, in which case return its value instead."
+ (unless frame
+ (setq frame (selected-frame)))
+ (let ((tail spec)
+ result defaults match-found)
+ (while tail
+ (let* ((entry (pop tail))
+ (display (car entry))
+ (attrs (cdr entry))
+ thisval)
+ ;; Get the attributes as actually specified by this alternative.
+ (setq thisval
+ (if (null (cdr attrs)) ;; was (listp (car attrs))
+ ;; Old-style entry, the attribute list is the
+ ;; first element.
+ (car attrs)
+ attrs))
+
+ ;; If the condition is `default', that sets the default
+ ;; for following conditions.
+ (if (eq display 'default)
+ (setq defaults thisval)
+ ;; Otherwise, if it matches, use it.
+ (when (face-spec-set-match-display display frame)
+ (setq result thisval
+ tail nil
+ match-found t)))))
+ ;; If defaults have been found, it's safe to just append those to the
result
+ ;; list (which at this point will be either nil or contain actual specs)
and
+ ;; return it to the caller. Since there will most definitely be something
to
+ ;; return in this case, there's no need to know/check if a match was found.
+ (if defaults
+ (append result defaults)
+ (if match-found
+ result
+ no-match-retval))))
+
+
+(defun face-spec-reset-face (face &optional frame)
+ "Reset all attributes of FACE on FRAME to unspecified."
+ (apply 'set-face-attribute face frame
+ (if (eq face 'default)
+ ;; For the default face, avoid making any attribute
+ ;; unspecified. Instead, set attributes to default values
+ ;; (see also realize_default_face in xfaces.c).
+ (append
+ '(:underline nil :overline nil :strike-through nil
+ :box nil :inverse-video nil :stipple nil :inherit nil)
+ ;; `display-graphic-p' is unavailable when running
+ ;; temacs, prior to loading frame.el.
+ (when (fboundp 'display-graphic-p)
+ (unless (display-graphic-p frame)
+ `(:family "default" :foundry "default" :width normal
+ :height 1 :weight normal :slant normal
+ :foreground ,(if (frame-parameter nil 'reverse)
+ "unspecified-bg"
+ "unspecified-fg")
+ :background ,(if (frame-parameter nil 'reverse)
+ "unspecified-fg"
+ "unspecified-bg")))))
+ ;; For all other faces, unspecify all attributes.
+ (apply 'append
+ (mapcar (lambda (x) (list (car x) 'unspecified))
+ face-attribute-name-alist)))))
+
+(defun face-spec-set (face spec &optional spec-type)
+ "Set the face spec SPEC for FACE.
+See `defface' for the format of SPEC.
+
+The appearance of each face is controlled by its specs (set via
+this function), and by the internal frame-specific face
+attributes (set via `set-face-attribute').
+
+This function also defines FACE as a valid face name if it is not
+already one, and (re)calculates its attributes on existing
+frames.
+
+The argument SPEC-TYPE determines which spec to set:
+ nil or `face-override-spec' means the override spec (which is
+ usually what you want if calling this function outside of
+ Custom code);
+ `customized-face' or `saved-face' means the customized spec or
+ the saved custom spec;
+ `face-defface-spec' means the default spec
+ (usually set only via `defface');
+ `reset' means to ignore SPEC, but clear the `customized-face'
+ and `face-override-spec' specs;
+Any other value means not to set any spec, but to run the
+function for its other effects."
+ (if (get face 'face-alias)
+ (setq face (get face 'face-alias)))
+ ;; Save SPEC to the relevant symbol property.
+ (unless spec-type
+ (setq spec-type 'face-override-spec))
+ (if (memq spec-type '(face-defface-spec face-override-spec
+ customized-face saved-face))
+ (put face spec-type spec))
+ (if (memq spec-type '(reset saved-face))
+ (put face 'customized-face nil))
+ ;; Setting the face spec via Custom empties out any override spec,
+ ;; similar to how setting a variable via Custom changes its values.
+ (if (memq spec-type '(customized-face saved-face reset))
+ (put face 'face-override-spec nil))
+ ;; If we reset the face based on its custom spec, it is unmodified
+ ;; as far as Custom is concerned.
+ (unless (eq face 'face-override-spec)
+ (put face 'face-modified nil))
+ ;; Initialize the face if it does not exist, then recalculate.
+ (make-empty-face face)
+ (dolist (frame (frame-list))
+ (face-spec-recalc face frame)))
+
+(defun face-spec-recalc (face frame)
+ "Reset the face attributes of FACE on FRAME according to its specs.
+The following sources are applied in this order:
+
+ face reset to default values if it's the default face, otherwise set
+ to unspecified (through `face-spec-reset-face')
+ |
+ (theme and user customization)
+ or: if none of the above exist, and none match the current frame or
+ inherited from the defface spec instead of overwriting it
+ entirely, the following is applied instead:
+ (defface default spec)
+ (X resources (if applicable))
+ |
+ defface override spec"
+ (while (get face 'face-alias)
+ (setq face (get face 'face-alias)))
+ (face-spec-reset-face face frame)
+ ;; If FACE is customized or themed, set the custom spec from
+ ;; `theme-face' records.
+ (let ((theme-faces (get face 'theme-face))
+ (no-match-found 0)
+ spec theme-face-applied)
+ (if theme-faces
+ (dolist (elt (reverse theme-faces))
+ (setq spec (face-spec-choose (cadr elt) frame no-match-found))
+ (unless (eq spec no-match-found)
+ (face-spec-set-2 face frame spec)
+ (setq theme-face-applied t))))
+ ;; If there was a spec applicable to FRAME, that overrides the
+ ;; defface spec entirely (rather than inheriting from it). If
+ ;; there was no spec applicable to FRAME, apply the defface spec
+ ;; as well as any applicable X resources.
+ (unless theme-face-applied
+ (setq spec (face-spec-choose (face-default-spec face) frame))
+ (face-spec-set-2 face frame spec)
+ (make-face-x-resource-internal face frame))
+ (setq spec (face-spec-choose (get face 'face-override-spec) frame))
+ (face-spec-set-2 face frame spec)))
+
+(defun face-spec-set-2 (face frame spec)
+ "Set the face attributes of FACE on FRAME according to SPEC."
+ (let (attrs)
+ (while spec
+ (when (assq (car spec) face-x-resources)
+ (push (car spec) attrs)
+ (push (cadr spec) attrs))
+ (setq spec (cddr spec)))
+ (apply 'set-face-attribute face frame (nreverse attrs))))
+
+(defun face-attr-match-p (face attrs &optional frame)
+ "Return t if attributes of FACE match values in plist ATTRS.
+Optional parameter FRAME is the frame whose definition of FACE
+is used. If nil or omitted, use the selected frame."
+ (unless frame
+ (setq frame (selected-frame)))
+ (let* ((list face-attribute-name-alist)
+ (match t)
+ (bold (and (plist-member attrs :bold)
+ (not (plist-member attrs :weight))))
+ (italic (and (plist-member attrs :italic)
+ (not (plist-member attrs :slant))))
+ (plist (if (or bold italic)
+ (copy-sequence attrs)
+ attrs)))
+ ;; Handle the Emacs 20 :bold and :italic properties.
+ (if bold
+ (plist-put plist :weight (if bold 'bold 'normal)))
+ (if italic
+ (plist-put plist :slant (if italic 'italic 'normal)))
+ (while (and match list)
+ (let* ((attr (caar list))
+ (specified-value
+ (if (plist-member plist attr)
+ (plist-get plist attr)
+ 'unspecified))
+ (value-now (face-attribute face attr frame)))
+ (setq match (equal specified-value value-now))
+ (setq list (cdr list))))
+ match))
+
+(defsubst face-spec-match-p (face spec &optional frame)
+ "Return t if FACE, on FRAME, matches what SPEC says it should look like."
+ (face-attr-match-p face (face-spec-choose spec frame) frame))
+
+(defsubst face-default-spec (face)
+ "Return the default face-spec for FACE, ignoring any user customization.
+If there is no default for FACE, return nil."
+ (get face 'face-defface-spec))
+
+(defsubst face-user-default-spec (face)
+ "Return the user's customized face-spec for FACE, or the default if none.
+If there is neither a user setting nor a default for FACE, return nil."
+ (or (get face 'customized-face)
+ (get face 'saved-face)
+ (face-default-spec face)))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Frame-type independent color support.
+;;; We keep the old x-* names as aliases for back-compatibility.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun defined-colors (&optional frame)
+ "Return a list of colors supported for a particular frame.
+The argument FRAME specifies which frame to try.
+The value may be different for frames on different display types.
+If FRAME doesn't support colors, the value is nil.
+If FRAME is nil, that stands for the selected frame."
+ (if (memq (framep (or frame (selected-frame))) '(x w32 ns))
+ (xw-defined-colors frame)
+ (mapcar 'car (tty-color-alist frame))))
+(defalias 'x-defined-colors 'defined-colors)
+
+(declare-function xw-color-defined-p "xfns.c" (color &optional frame))
+
+(defun color-defined-p (color &optional frame)
+ "Return non-nil if COLOR is supported on frame FRAME.
+COLOR should be a string naming a color (e.g. \"white\"), or a
+string specifying a color's RGB components (e.g. \"#ff12ec\"), or
+the symbol `unspecified'.
+
+This function returns nil if COLOR is the symbol `unspecified',
+or one of the strings \"unspecified-fg\" or \"unspecified-bg\".
+
+If FRAME is omitted or nil, use the selected frame."
+ (unless (member color '(unspecified "unspecified-bg" "unspecified-fg"))
+ (if (member (framep (or frame (selected-frame))) '(x w32 ns))
+ (xw-color-defined-p color frame)
+ (numberp (tty-color-translate color frame)))))
+(defalias 'x-color-defined-p 'color-defined-p)
+
+(declare-function xw-color-values "xfns.c" (color &optional frame))
+
+(defun color-values (color &optional frame)
+ "Return a description of the color named COLOR on frame FRAME.
+COLOR should be a string naming a color (e.g. \"white\"), or a
+string specifying a color's RGB components (e.g. \"#ff12ec\").
+
+Return a list of three integers, (RED GREEN BLUE), each between 0
+and either 65280 or 65535 (the maximum depends on the system).
+Use `color-name-to-rgb' if you want RGB floating-point values
+normalized to 1.0.
+
+If FRAME is omitted or nil, use the selected frame.
+If FRAME cannot display COLOR, the value is nil.
+
+COLOR can also be the symbol `unspecified' or one of the strings
+\"unspecified-fg\" or \"unspecified-bg\", in which case the
+return value is nil."
+ (cond
+ ((member color '(unspecified "unspecified-fg" "unspecified-bg"))
+ nil)
+ ((memq (framep (or frame (selected-frame))) '(x w32 ns))
+ (xw-color-values color frame))
+ (t
+ (tty-color-values color frame))))
+
+(defalias 'x-color-values 'color-values)
+
+(declare-function xw-display-color-p "xfns.c" (&optional terminal))
+
+(defun display-color-p (&optional display)
+ "Return t if DISPLAY supports color.
+The optional argument DISPLAY specifies which display to ask about.
+DISPLAY should be either a frame or a display name (a string).
+If omitted or nil, that stands for the selected frame's display."
+ (if (memq (framep-on-display display) '(x w32 ns))
+ (xw-display-color-p display)
+ (tty-display-color-p display)))
+(defalias 'x-display-color-p 'display-color-p)
+
+(declare-function x-display-grayscale-p "xfns.c" (&optional terminal))
+
+(defun display-grayscale-p (&optional display)
+ "Return non-nil if frames on DISPLAY can display shades of gray.
+DISPLAY should be either a frame or a display name (a string).
+If omitted or nil, that stands for the selected frame's display."
+ (let ((frame-type (framep-on-display display)))
+ (cond
+ ((memq frame-type '(x w32 ns))
+ (x-display-grayscale-p display))
+ (t
+ (> (tty-color-gray-shades display) 2)))))
+
+(defun read-color (&optional prompt convert-to-RGB allow-empty-name msg)
+ "Read a color name or RGB triplet.
+Completion is available for color names, but not for RGB triplets.
+
+RGB triplets have the form \"#RRGGBB\". Each of the R, G, and B
+components can have one to four digits, but all three components
+must have the same number of digits. Each digit is a hex value
+between 0 and F; either upper case or lower case for A through F
+are acceptable.
+
+In addition to standard color names and RGB hex values, the
+following are available as color candidates. In each case, the
+corresponding color is used.
+
+ * `foreground at point' - foreground under the cursor
+ * `background at point' - background under the cursor
+
+Optional arg PROMPT is the prompt; if nil, use a default prompt.
+
+Interactively, or with optional arg CONVERT-TO-RGB-P non-nil,
+convert an input color name to an RGB hex string. Return the RGB
+hex string.
+
+If optional arg ALLOW-EMPTY-NAME is non-nil, the user is allowed
+to enter an empty color name (the empty string).
+
+Interactively, or with optional arg MSG non-nil, print the
+resulting color name in the echo area."
+ (interactive "i\np\ni\np") ; Always convert to RGB interactively.
+ (let* ((completion-ignore-case t)
+ (colors (or facemenu-color-alist
+ (append '("foreground at point" "background at point")
+ (if allow-empty-name '(""))
+ (defined-colors))))
+ (color (completing-read
+ (or prompt "Color (name or #RGB triplet): ")
+ ;; Completing function for reading colors, accepting
+ ;; both color names and RGB triplets.
+ (lambda (string pred flag)
+ (cond
+ ((null flag) ; Try completion.
+ (or (try-completion string colors pred)
+ (if (color-defined-p string)
+ string)))
+ ((eq flag t) ; List all completions.
+ (or (all-completions string colors pred)
+ (if (color-defined-p string)
+ (list string))))
+ ((eq flag 'lambda) ; Test completion.
+ (or (member string colors)
+ (color-defined-p string)))))
+ nil t)))
+
+ ;; Process named colors.
+ (when (member color colors)
+ (cond ((string-equal color "foreground at point")
+ (setq color (foreground-color-at-point)))
+ ((string-equal color "background at point")
+ (setq color (background-color-at-point))))
+ (when (and convert-to-RGB
+ (not (string-equal color "")))
+ (let ((components (x-color-values color)))
+ (unless (string-match-p
"^#\\(?:[a-fA-F0-9][a-fA-F0-9][a-fA-F0-9]\\)+$" color)
+ (setq color (format "#%04X%04X%04X"
+ (logand 65535 (nth 0 components))
+ (logand 65535 (nth 1 components))
+ (logand 65535 (nth 2 components))))))))
+ (when msg (message "Color: `%s'" color))
+ color))
+
+(defun face-at-point (&optional thing multiple)
+ "Return the face of the character after point.
+If it has more than one face, return the first one.
+If THING is non-nil try first to get a face name from the buffer.
+IF MULTIPLE is non-nil, return a list of all faces.
+Return nil if there is no face."
+ (let (faces)
+ (if thing
+ ;; Try to get a face name from the buffer.
+ (let ((face (intern-soft (thing-at-point 'symbol))))
+ (if (facep face)
+ (push face faces))))
+ ;; Add the named faces that the `read-face-name' or `face' property uses.
+ (let ((faceprop (or (get-char-property (point) 'read-face-name)
+ (get-char-property (point) 'face))))
+ (cond ((facep faceprop)
+ (push faceprop faces))
+ ((and (listp faceprop)
+ ;; Don't treat an attribute spec as a list of faces.
+ (not (keywordp (car faceprop)))
+ (not (memq (car faceprop)
+ '(foreground-color background-color))))
+ (dolist (face faceprop)
+ (if (facep face)
+ (push face faces))))))
+ (setq faces (delete-dups (nreverse faces)))
+ (if multiple faces (car faces))))
+
+(defun foreground-color-at-point ()
+ "Return the foreground color of the character after point."
+ ;; `face-at-point' alone is not sufficient. It only gets named faces.
+ ;; Need also pick up any face properties that are not associated with named
faces.
+ (let ((face (or (face-at-point)
+ (get-char-property (point) 'read-face-name)
+ (get-char-property (point) 'face))))
+ (cond ((and face (symbolp face))
+ (let ((value (face-foreground face nil 'default)))
+ (if (member value '("unspecified-fg" "unspecified-bg"))
+ nil
+ value)))
+ ((consp face)
+ (cond ((memq 'foreground-color face) (cdr (memq 'foreground-color
face)))
+ ((memq ':foreground face) (cadr (memq ':foreground face)))))
+ (t nil)))) ; Invalid face value.
+
+(defun background-color-at-point ()
+ "Return the background color of the character after point."
+ ;; `face-at-point' alone is not sufficient. It only gets named faces.
+ ;; Need also pick up any face properties that are not associated with named
faces.
+ (let ((face (or (face-at-point)
+ (get-char-property (point) 'read-face-name)
+ (get-char-property (point) 'face))))
+ (cond ((and face (symbolp face))
+ (let ((value (face-background face nil 'default)))
+ (if (member value '("unspecified-fg" "unspecified-bg"))
+ nil
+ value)))
+ ((consp face)
+ (cond ((memq 'background-color face) (cdr (memq 'background-color
face)))
+ ((memq ':background face) (cadr (memq ':background face)))))
+ (t nil)))) ; Invalid face value.
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Frame creation.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(declare-function x-display-list "xfns.c" ())
+(declare-function x-open-connection "xfns.c"
+ (display &optional xrm-string must-succeed))
+(declare-function x-get-resource "frame.c"
+ (attribute class &optional component subclass))
+(declare-function x-parse-geometry "frame.c" (string))
+(defvar x-display-name)
+
+(defun x-handle-named-frame-geometry (parameters)
+ "Add geometry parameters for a named frame to parameter list PARAMETERS.
+Value is the new parameter list."
+ ;; Note that `x-resource-name' has a global meaning.
+ (let ((x-resource-name (cdr (assq 'name parameters))))
+ (when x-resource-name
+ ;; Before checking X resources, we must have an X connection.
+ (or (window-system)
+ (x-display-list)
+ (x-open-connection (or (cdr (assq 'display parameters))
+ x-display-name)))
+ (let (res-geometry parsed)
+ (and (setq res-geometry (x-get-resource "geometry" "Geometry"))
+ (setq parsed (x-parse-geometry res-geometry))
+ (setq parameters
+ (append parameters parsed
+ ;; If the resource specifies a position,
+ ;; take note of that.
+ (if (or (assq 'top parsed) (assq 'left parsed))
+ '((user-position . t) (user-size . t)))))))))
+ parameters)
+
+
+(defun x-handle-reverse-video (frame parameters)
+ "Handle the reverse-video frame parameter and X resource.
+`x-create-frame' does not handle this one."
+ (when (cdr (or (assq 'reverse parameters)
+ (let ((resource (x-get-resource "reverseVideo"
+ "ReverseVideo")))
+ (if resource
+ (cons nil (member (downcase resource)
+ '("on" "true")))))))
+ (let* ((params (frame-parameters frame))
+ (bg (cdr (assq 'foreground-color params)))
+ (fg (cdr (assq 'background-color params))))
+ (modify-frame-parameters frame
+ (list (cons 'foreground-color fg)
+ (cons 'background-color bg)))
+ (if (equal bg (cdr (assq 'border-color params)))
+ (modify-frame-parameters frame
+ (list (cons 'border-color fg))))
+ (if (equal bg (cdr (assq 'mouse-color params)))
+ (modify-frame-parameters frame
+ (list (cons 'mouse-color fg))))
+ (if (equal bg (cdr (assq 'cursor-color params)))
+ (modify-frame-parameters frame
+ (list (cons 'cursor-color fg)))))))
+
+(declare-function x-create-frame "xfns.c" (parms))
+(declare-function x-setup-function-keys "term/common-win" (frame))
+
+(defun x-create-frame-with-faces (&optional parameters)
+ "Create and return a frame with frame parameters PARAMETERS.
+If PARAMETERS specify a frame name, handle X geometry resources
+for that name. If PARAMETERS includes a `reverse' parameter, or
+the X resource ``reverseVideo'' is present, handle that."
+ (setq parameters (x-handle-named-frame-geometry parameters))
+ (let* ((params (copy-tree parameters))
+ (visibility-spec (assq 'visibility parameters))
+ (delayed-params '(foreground-color background-color font
+ border-color cursor-color mouse-color
+ visibility scroll-bar-foreground
+ scroll-bar-background))
+ frame success)
+ (dolist (param delayed-params)
+ (setq params (assq-delete-all param params)))
+ (setq frame (x-create-frame `((visibility . nil) . ,params)))
+ (unwind-protect
+ (progn
+ (x-setup-function-keys frame)
+ (x-handle-reverse-video frame parameters)
+ (frame-set-background-mode frame t)
+ (face-set-after-frame-default frame parameters)
+ (if (null visibility-spec)
+ (make-frame-visible frame)
+ (modify-frame-parameters frame (list visibility-spec)))
+ (setq success t))
+ (unless success
+ (delete-frame frame)))
+ frame))
+
+(defun face-set-after-frame-default (frame &optional parameters)
+ "Initialize the frame-local faces of FRAME.
+Calculate the face definitions using the face specs, custom theme
+settings, X resources, and `face-new-frame-defaults'.
+Finally, apply any relevant face attributes found amongst the
+frame parameters in PARAMETERS."
+ (let ((window-system-p (memq (window-system frame) '(x w32))))
+ ;; The `reverse' is so that `default' goes first.
+ (dolist (face (nreverse (face-list)))
+ (condition-case ()
+ (progn
+ ;; Initialize faces from face spec and custom theme.
+ (face-spec-recalc face frame)
+ ;; Apply attributes specified by face-new-frame-defaults
+ (internal-merge-in-global-face face frame))
+ ;; Don't let invalid specs prevent frame creation.
+ (error nil))))
+
+ ;; Apply attributes specified by frame parameters.
+ (let ((face-params '((foreground-color default :foreground)
+ (background-color default :background)
+ (font default :font)
+ (border-color border :background)
+ (cursor-color cursor :background)
+ (scroll-bar-foreground scroll-bar :foreground)
+ (scroll-bar-background scroll-bar :background)
+ (mouse-color mouse :background))))
+ (dolist (param face-params)
+ (let* ((param-name (nth 0 param))
+ (value (cdr (assq param-name parameters))))
+ (if value
+ (set-face-attribute (nth 1 param) frame
+ (nth 2 param) value))))))
+
+(defun tty-handle-reverse-video (frame parameters)
+ "Handle the reverse-video frame parameter for terminal frames."
+ (when (cdr (assq 'reverse parameters))
+ (let* ((params (frame-parameters frame))
+ (bg (cdr (assq 'foreground-color params)))
+ (fg (cdr (assq 'background-color params))))
+ (modify-frame-parameters frame
+ (list (cons 'foreground-color fg)
+ (cons 'background-color bg)))
+ (if (equal bg (cdr (assq 'mouse-color params)))
+ (modify-frame-parameters frame
+ (list (cons 'mouse-color fg))))
+ (if (equal bg (cdr (assq 'cursor-color params)))
+ (modify-frame-parameters frame
+ (list (cons 'cursor-color fg)))))))
+
+
+(defun tty-create-frame-with-faces (&optional parameters)
+ "Create and return a frame from optional frame parameters PARAMETERS.
+If PARAMETERS contains a `reverse' parameter, handle that."
+ (let ((frame (make-terminal-frame parameters))
+ success)
+ (unwind-protect
+ (with-selected-frame frame
+ (tty-handle-reverse-video frame (frame-parameters frame))
+
+ (unless (terminal-parameter frame 'terminal-initted)
+ (set-terminal-parameter frame 'terminal-initted t)
+ (set-locale-environment nil frame)
+ (tty-run-terminal-initialization frame nil t))
+ (frame-set-background-mode frame t)
+ (face-set-after-frame-default frame parameters)
+ (setq success t))
+ (unless success
+ (delete-frame frame)))
+ frame))
+
+(defun tty-find-type (pred type)
+ "Return the longest prefix of TYPE to which PRED returns non-nil.
+TYPE should be a tty type name such as \"xterm-16color\".
+
+The function tries only those prefixes that are followed by a
+dash or underscore in the original type name, like \"xterm\" in
+the above example."
+ (let (hyphend)
+ (while (and type
+ (not (funcall pred type)))
+ ;; Strip off last hyphen and what follows, then try again
+ (setq type
+ (if (setq hyphend (string-match-p "[-_][^-_]+$" type))
+ (substring type 0 hyphend)
+ nil))))
+ type)
+
+(defvar tty-setup-hook nil
+ "Hook run after running the initialization function of a new text terminal.
+Specifically, `tty-run-terminal-initialization' runs this.
+This can be used to fine tune the `input-decode-map', for example.")
+
+(defun tty-run-terminal-initialization (frame &optional type run-hook)
+ "Run the special initialization code for the terminal type of FRAME.
+The optional TYPE parameter may be used to override the autodetected
+terminal type to a different value.
+
+If optional argument RUN-HOOK is non-nil, then as a final step,
+this runs the hook `tty-setup-hook'.
+
+If you set `term-file-prefix' to nil, this function does nothing."
+ (setq type (or type (tty-type frame)))
+ ;; Load library for our terminal type.
+ ;; User init file can set term-file-prefix to nil to prevent this.
+ (with-selected-frame frame
+ (unless (null term-file-prefix)
+ (let* (term-init-func)
+ ;; First, load the terminal initialization file, if it is
+ ;; available and it hasn't been loaded already.
+ (tty-find-type #'(lambda (type)
+ (let ((file (locate-library (concat term-file-prefix
type))))
+ (and file
+ (or (assoc file load-history)
+ (load file t t)))))
+ type)
+ ;; Next, try to find a matching initialization function, and call it.
+ (tty-find-type #'(lambda (type)
+ (fboundp (setq term-init-func
+ (intern (concat "terminal-init-"
type)))))
+ type)
+ (when (fboundp term-init-func)
+ (funcall term-init-func))
+ (set-terminal-parameter frame 'terminal-initted term-init-func)
+ (if run-hook (run-hooks 'tty-setup-hook))))))
+
+;; Called from C function init_display to initialize faces of the
+;; dumped terminal frame on startup.
+
+(defun tty-set-up-initial-frame-faces ()
+ (let ((frame (selected-frame)))
+ (frame-set-background-mode frame t)
+ (face-set-after-frame-default frame)))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Standard faces.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defgroup basic-faces nil
+ "The standard faces of Emacs."
+ :group 'faces)
+
+(defface default
+ '((t nil)) ; If this were nil, face-defface-spec would not be set.
+ "Basic default face."
+ :group 'basic-faces)
+
+(defface bold
+ '((t :weight bold))
+ "Basic bold face."
+ :group 'basic-faces)
+
+(defface italic
+ '((((supports :slant italic))
+ :slant italic)
+ (((supports :underline t))
+ :underline t)
+ (t
+ ;; Default to italic, even if it doesn't appear to be supported,
+ ;; because in some cases the display engine will do its own
+ ;; workaround (to `dim' on ttys).
+ :slant italic))
+ "Basic italic face."
+ :group 'basic-faces)
+
+(defface bold-italic
+ '((t :weight bold :slant italic))
+ "Basic bold-italic face."
+ :group 'basic-faces)
+
+(defface underline
+ '((((supports :underline t))
+ :underline t)
+ (((supports :weight bold))
+ :weight bold)
+ (t :underline t))
+ "Basic underlined face."
+ :group 'basic-faces)
+
+(defface fixed-pitch
+ '((t :family "Monospace"))
+ "The basic fixed-pitch face."
+ :group 'basic-faces)
+
+(defface variable-pitch
+ '((t :family "Sans Serif"))
+ "The basic variable-pitch face."
+ :group 'basic-faces)
+
+(defface shadow
+ '((((class color grayscale) (min-colors 88) (background light))
+ :foreground "grey50")
+ (((class color grayscale) (min-colors 88) (background dark))
+ :foreground "grey70")
+ (((class color) (min-colors 8) (background light))
+ :foreground "green")
+ (((class color) (min-colors 8) (background dark))
+ :foreground "yellow"))
+ "Basic face for shadowed text."
+ :group 'basic-faces
+ :version "22.1")
+
+(defface link
+ '((((class color) (min-colors 88) (background light))
+ :foreground "RoyalBlue3" :underline t)
+ (((class color) (background light))
+ :foreground "blue" :underline t)
+ (((class color) (min-colors 88) (background dark))
+ :foreground "cyan1" :underline t)
+ (((class color) (background dark))
+ :foreground "cyan" :underline t)
+ (t :inherit underline))
+ "Basic face for unvisited links."
+ :group 'basic-faces
+ :version "22.1")
+
+(defface link-visited
+ '((default :inherit link)
+ (((class color) (background light)) :foreground "magenta4")
+ (((class color) (background dark)) :foreground "violet"))
+ "Basic face for visited links."
+ :group 'basic-faces
+ :version "22.1")
+
+(defface highlight
+ '((((class color) (min-colors 88) (background light))
+ :background "darkseagreen2")
+ (((class color) (min-colors 88) (background dark))
+ :background "darkolivegreen")
+ (((class color) (min-colors 16) (background light))
+ :background "darkseagreen2")
+ (((class color) (min-colors 16) (background dark))
+ :background "darkolivegreen")
+ (((class color) (min-colors 8))
+ :background "green" :foreground "black")
+ (t :inverse-video t))
+ "Basic face for highlighting."
+ :group 'basic-faces)
+
+;; Region face: under NS, default to the system-defined selection
+;; color (optimized for the fixed white background of other apps),
+;; if background is light.
+(defface region
+ '((((class color) (min-colors 88) (background dark))
+ :background "blue3")
+ (((class color) (min-colors 88) (background light) (type gtk))
+ :distant-foreground "gtk_selection_fg_color"
+ :background "gtk_selection_bg_color")
+ (((class color) (min-colors 88) (background light) (type ns))
+ :distant-foreground "ns_selection_fg_color"
+ :background "ns_selection_bg_color")
+ (((class color) (min-colors 88) (background light))
+ :background "lightgoldenrod2")
+ (((class color) (min-colors 16) (background dark))
+ :background "blue3")
+ (((class color) (min-colors 16) (background light))
+ :background "lightgoldenrod2")
+ (((class color) (min-colors 8))
+ :background "blue" :foreground "white")
+ (((type tty) (class mono))
+ :inverse-video t)
+ (t :background "gray"))
+ "Basic face for highlighting the region."
+ :version "21.1"
+ :group 'basic-faces)
+
+(defface secondary-selection
+ '((((class color) (min-colors 88) (background light))
+ :background "yellow1")
+ (((class color) (min-colors 88) (background dark))
+ :background "SkyBlue4")
+ (((class color) (min-colors 16) (background light))
+ :background "yellow")
+ (((class color) (min-colors 16) (background dark))
+ :background "SkyBlue4")
+ (((class color) (min-colors 8))
+ :background "cyan" :foreground "black")
+ (t :inverse-video t))
+ "Basic face for displaying the secondary selection."
+ :group 'basic-faces)
+
+(defface trailing-whitespace
+ '((((class color) (background light))
+ :background "red1")
+ (((class color) (background dark))
+ :background "red1")
+ (t :inverse-video t))
+ "Basic face for highlighting trailing whitespace."
+ :version "21.1"
+ :group 'basic-faces)
+
+(defface escape-glyph
+ '((((background dark)) :foreground "cyan")
+ ;; See the comment in minibuffer-prompt for
+ ;; the reason not to use blue on MS-DOS.
+ (((type pc)) :foreground "magenta")
+ ;; red4 is too dark, but some say blue is too loud.
+ ;; brown seems to work ok. -- rms.
+ (t :foreground "brown"))
+ "Face for characters displayed as sequences using `^' or `\\'."
+ :group 'basic-faces
+ :version "22.1")
+
+(defface nobreak-space
+ '((((class color) (min-colors 88)) :inherit escape-glyph :underline t)
+ (((class color) (min-colors 8)) :background "magenta")
+ (t :inverse-video t))
+ "Face for displaying nobreak space."
+ :group 'basic-faces
+ :version "22.1")
+
+(defgroup mode-line-faces nil
+ "Faces used in the mode line."
+ :group 'mode-line
+ :group 'faces
+ :version "22.1")
+
+(defface mode-line
+ '((((class color) (min-colors 88))
+ :box (:line-width -1 :style released-button)
+ :background "grey75" :foreground "black")
+ (t
+ :inverse-video t))
+ "Basic mode line face for selected window."
+ :version "21.1"
+ :group 'mode-line-faces
+ :group 'basic-faces)
+
+(defface mode-line-inactive
+ '((default
+ :inherit mode-line)
+ (((class color) (min-colors 88) (background light))
+ :weight light
+ :box (:line-width -1 :color "grey75" :style nil)
+ :foreground "grey20" :background "grey90")
+ (((class color) (min-colors 88) (background dark) )
+ :weight light
+ :box (:line-width -1 :color "grey40" :style nil)
+ :foreground "grey80" :background "grey30"))
+ "Basic mode line face for non-selected windows."
+ :version "22.1"
+ :group 'mode-line-faces
+ :group 'basic-faces)
+(define-obsolete-face-alias 'modeline-inactive 'mode-line-inactive "22.1")
+
+(defface mode-line-highlight
+ '((((class color) (min-colors 88))
+ :box (:line-width 2 :color "grey40" :style released-button))
+ (t
+ :inherit highlight))
+ "Basic mode line face for highlighting."
+ :version "22.1"
+ :group 'mode-line-faces
+ :group 'basic-faces)
+(define-obsolete-face-alias 'modeline-highlight 'mode-line-highlight "22.1")
+
+(defface mode-line-emphasis
+ '((t (:weight bold)))
+ "Face used to emphasize certain mode line features.
+Use the face `mode-line-highlight' for features that can be selected."
+ :version "23.1"
+ :group 'mode-line-faces
+ :group 'basic-faces)
+
+(defface mode-line-buffer-id
+ '((t (:weight bold)))
+ "Face used for buffer identification parts of the mode line."
+ :version "22.1"
+ :group 'mode-line-faces
+ :group 'basic-faces)
+(define-obsolete-face-alias 'modeline-buffer-id 'mode-line-buffer-id "22.1")
+
+(defface header-line
+ '((default
+ :inherit mode-line)
+ (((type tty))
+ ;; This used to be `:inverse-video t', but that doesn't look very
+ ;; good when combined with inverse-video mode-lines and multiple
+ ;; windows. Underlining looks better, and is more consistent with
+ ;; the window-system face variants, which deemphasize the
+ ;; header-line in relation to the mode-line face. If a terminal
+ ;; can't underline, then the header-line will end up without any
+ ;; highlighting; this may be too confusing in general, although it
+ ;; happens to look good with the only current use of header-lines,
+ ;; the info browser. XXX
+ :inverse-video nil ;Override the value inherited from
mode-line.
+ :underline t)
+ (((class color grayscale) (background light))
+ :background "grey90" :foreground "grey20"
+ :box nil)
+ (((class color grayscale) (background dark))
+ :background "grey20" :foreground "grey90"
+ :box nil)
+ (((class mono) (background light))
+ :background "white" :foreground "black"
+ :inverse-video nil
+ :box nil
+ :underline t)
+ (((class mono) (background dark))
+ :background "black" :foreground "white"
+ :inverse-video nil
+ :box nil
+ :underline t))
+ "Basic header-line face."
+ :version "21.1"
+ :group 'basic-faces)
+
+(defface vertical-border
+ '((((type tty)) :inherit mode-line-inactive))
+ "Face used for vertical window dividers on ttys."
+ :version "22.1"
+ :group 'basic-faces)
+
+(defface window-divider '((t :foreground "gray60"))
+ "Basic face for window dividers.
+When a divider is less than 3 pixels wide, it is drawn solidly
+with the foreground of this face. For larger dividers this face
+is used for the inner part while the first pixel line/column is
+drawn with the `window-divider-first-pixel' face and the last
+pixel line/column with the `window-divider-last-pixel' face."
+ :version "24.4"
+ :group 'frames
+ :group 'basic-faces)
+
+(defface window-divider-first-pixel
+ '((t :foreground "gray80"))
+ "Basic face for first pixel line/column of window dividers.
+When a divider is at least 3 pixels wide, its first pixel
+line/column is drawn with the foreground of this face. If you do
+not want to accentuate the first pixel line/column, set this to
+the same as `window-divider' face."
+ :version "24.4"
+ :group 'frames
+ :group 'basic-faces)
+
+(defface window-divider-last-pixel
+ '((t :foreground "gray40"))
+ "Basic face for last pixel line/column of window dividers.
+When a divider is at least 3 pixels wide, its last pixel
+line/column is drawn with the foreground of this face. If you do
+not want to accentuate the last pixel line/column, set this to
+the same as `window-divider' face."
+ :version "24.4"
+ :group 'frames
+ :group 'basic-faces)
+
+(defface minibuffer-prompt
+ '((((background dark)) :foreground "cyan")
+ ;; Don't use blue because many users of the MS-DOS port customize
+ ;; their foreground color to be blue.
+ (((type pc)) :foreground "magenta")
+ (t :foreground "medium blue"))
+ "Face for minibuffer prompts.
+By default, Emacs automatically adds this face to the value of
+`minibuffer-prompt-properties', which is a list of text properties
+used to display the prompt text."
+ :version "22.1"
+ :group 'basic-faces)
+
+(setq minibuffer-prompt-properties
+ (append minibuffer-prompt-properties (list 'face 'minibuffer-prompt)))
+
+(defface fringe
+ '((((class color) (background light))
+ :background "grey95")
+ (((class color) (background dark))
+ :background "grey10")
+ (t
+ :background "gray"))
+ "Basic face for the fringes to the left and right of windows under X."
+ :version "21.1"
+ :group 'frames
+ :group 'basic-faces)
+
+(defface scroll-bar '((t nil))
+ "Basic face for the scroll bar colors under X."
+ :version "21.1"
+ :group 'frames
+ :group 'basic-faces)
+
+(defface border '((t nil))
+ "Basic face for the frame border under X."
+ :version "21.1"
+ :group 'frames
+ :group 'basic-faces)
+
+(defface cursor
+ '((((background light)) :background "black")
+ (((background dark)) :background "white"))
+ "Basic face for the cursor color under X.
+Currently, only the `:background' attribute is meaningful; all
+other attributes are ignored. The cursor foreground color is
+taken from the background color of the underlying text.
+
+Note: Other faces cannot inherit from the cursor face."
+ :version "21.1"
+ :group 'cursor
+ :group 'basic-faces)
+
+(put 'cursor 'face-no-inherit t)
+
+(defface mouse '((t nil))
+ "Basic face for the mouse color under X."
+ :version "21.1"
+ :group 'mouse
+ :group 'basic-faces)
+
+(defface tool-bar
+ '((default
+ :box (:line-width 1 :style released-button)
+ :foreground "black")
+ (((type x w32 ns) (class color))
+ :background "grey75")
+ (((type x) (class mono))
+ :background "grey"))
+ "Basic tool-bar face."
+ :version "21.1"
+ :group 'basic-faces)
+
+(defface menu
+ '((((type tty))
+ :inverse-video t)
+ (((type x-toolkit))
+ )
+ (t
+ :inverse-video t))
+ "Basic face for the font and colors of the menu bar and popup menus."
+ :version "21.1"
+ :group 'menu
+ :group 'basic-faces)
+
+(defface help-argument-name '((t :inherit italic))
+ "Face to highlight argument names in *Help* buffers."
+ :group 'help)
+
+(defface glyphless-char
+ '((((type tty)) :inherit underline)
+ (((type pc)) :inherit escape-glyph)
+ (t :height 0.6))
+ "Face for displaying non-graphic characters (e.g. U+202A (LRE)).
+It is used for characters of no fonts too."
+ :version "24.1"
+ :group 'basic-faces)
+
+(defface error
+ '((default :weight bold)
+ (((class color) (min-colors 88) (background light)) :foreground "Red1")
+ (((class color) (min-colors 88) (background dark)) :foreground "Pink")
+ (((class color) (min-colors 16) (background light)) :foreground "Red1")
+ (((class color) (min-colors 16) (background dark)) :foreground "Pink")
+ (((class color) (min-colors 8)) :foreground "red")
+ (t :inverse-video t))
+ "Basic face used to highlight errors and to denote failure."
+ :version "24.1"
+ :group 'basic-faces)
+
+(defface warning
+ '((default :weight bold)
+ (((class color) (min-colors 16)) :foreground "DarkOrange")
+ (((class color)) :foreground "yellow"))
+ "Basic face used to highlight warnings."
+ :version "24.1"
+ :group 'basic-faces)
+
+(defface success
+ '((default :weight bold)
+ (((class color) (min-colors 16) (background light)) :foreground
"ForestGreen")
+ (((class color) (min-colors 88) (background dark)) :foreground "Green1")
+ (((class color) (min-colors 16) (background dark)) :foreground "Green")
+ (((class color)) :foreground "green"))
+ "Basic face used to indicate successful operation."
+ :version "24.1"
+ :group 'basic-faces)
+
+;; Faces for TTY menus.
+(defface tty-menu-enabled-face
+ '((t
+ :foreground "yellow" :background "blue" :weight bold))
+ "Face for displaying enabled items in TTY menus."
+ :group 'basic-faces)
+
+(defface tty-menu-disabled-face
+ '((((class color) (min-colors 16))
+ :foreground "lightgray" :background "blue")
+ (t
+ :foreground "white" :background "blue"))
+ "Face for displaying disabled items in TTY menus."
+ :group 'basic-faces)
+
+(defface tty-menu-selected-face
+ '((t :background "red"))
+ "Face for displaying the currently selected item in TTY menus."
+ :group 'basic-faces)
+
+(defgroup paren-showing-faces nil
+ "Faces used to highlight paren matches."
+ :group 'paren-showing
+ :group 'faces
+ :version "22.1")
+
+(defface show-paren-match
+ '((((class color) (background light))
+ :background "turquoise") ; looks OK on tty (becomes cyan)
+ (((class color) (background dark))
+ :background "steelblue3") ; looks OK on tty (becomes blue)
+ (((background dark))
+ :background "grey50")
+ (t
+ :background "gray"))
+ "Face used for a matching paren."
+ :group 'paren-showing-faces)
+
+(defface show-paren-mismatch
+ '((((class color)) (:foreground "white" :background "purple"))
+ (t (:inverse-video t)))
+ "Face used for a mismatching paren."
+ :group 'paren-showing-faces)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Manipulating font names.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; This is here for compatibility with Emacs 20.2. For example,
+;; international/fontset.el uses x-resolve-font-name. The following
+;; functions are not used in the face implementation itself.
+
+(defvar x-font-regexp nil)
+(defvar x-font-regexp-head nil)
+(defvar x-font-regexp-weight nil)
+(defvar x-font-regexp-slant nil)
+
+(defconst x-font-regexp-weight-subnum 1)
+(defconst x-font-regexp-slant-subnum 2)
+(defconst x-font-regexp-swidth-subnum 3)
+(defconst x-font-regexp-adstyle-subnum 4)
+
+;;; Regexps matching font names in "Host Portable Character Representation."
+;;;
+(let ((- "[-?]")
+ (foundry "[^-]+")
+ (family "[^-]+")
+ (weight "\\(bold\\|demibold\\|medium\\)") ; 1
+; (weight\? "\\(\\*\\|bold\\|demibold\\|medium\\|\\)")
; 1
+ (weight\? "\\([^-]*\\)")
; 1
+ (slant "\\([ior]\\)") ; 2
+; (slant\? "\\([ior?*]?\\)") ; 2
+ (slant\? "\\([^-]?\\)") ; 2
+; (swidth "\\(\\*\\|normal\\|semicondensed\\|\\)") ; 3
+ (swidth "\\([^-]*\\)") ; 3
+; (adstyle "\\(\\*\\|sans\\|\\)") ; 4
+ (adstyle "\\([^-]*\\)") ; 4
+ (pixelsize "[0-9]+")
+ (pointsize "[0-9][0-9]+")
+ (resx "[0-9][0-9]+")
+ (resy "[0-9][0-9]+")
+ (spacing "[cmp?*]")
+ (avgwidth "[0-9]+")
+ (registry "[^-]+")
+ (encoding "[^-]+")
+ )
+ (setq x-font-regexp
+ (purecopy (concat "\\`\\*?[-?*]"
+ foundry - family - weight\? - slant\? - swidth - adstyle -
+ pixelsize - pointsize - resx - resy - spacing - avgwidth -
+ registry - encoding "\\*?\\'"
+ )))
+ (setq x-font-regexp-head
+ (purecopy (concat "\\`[-?*]" foundry - family - weight\? - slant\?
+ "\\([-*?]\\|\\'\\)")))
+ (setq x-font-regexp-slant (purecopy (concat - slant -)))
+ (setq x-font-regexp-weight (purecopy (concat - weight -)))
+ nil)
+
+
+(defun x-resolve-font-name (pattern &optional face frame)
+ "Return a font name matching PATTERN.
+All wildcards in PATTERN are instantiated.
+If PATTERN is nil, return the name of the frame's base font, which never
+contains wildcards.
+Given optional arguments FACE and FRAME, return a font which is
+also the same size as FACE on FRAME, or fail."
+ (and (eq frame t)
+ (setq frame nil))
+ (if pattern
+ ;; Note that x-list-fonts has code to handle a face with nil as its font.
+ (let ((fonts (x-list-fonts pattern face frame 1)))
+ (or fonts
+ (if face
+ (if (string-match-p "\\*" pattern)
+ (if (null (face-font face))
+ (error "No matching fonts are the same height as the
frame default font")
+ (error "No matching fonts are the same height as face
`%s'" face))
+ (if (null (face-font face))
+ (error "Height of font `%s' doesn't match the frame
default font"
+ pattern)
+ (error "Height of font `%s' doesn't match face `%s'"
+ pattern face)))
+ (error "No fonts match `%s'" pattern)))
+ (car fonts))
+ (cdr (assq 'font (frame-parameters (selected-frame))))))
+
+(defcustom font-list-limit 100
+ "This variable is obsolete and has no effect."
+ :type 'integer
+ :group 'display)
+(make-obsolete-variable 'font-list-limit nil "24.3")
+
+(provide 'faces)
+
+;;; faces.el ends here
diff --git a/packages/context-coloring/benchmark/fixtures/lisp.el
b/packages/context-coloring/benchmark/fixtures/lisp.el
new file mode 100644
index 0000000..7ebd80a
--- /dev/null
+++ b/packages/context-coloring/benchmark/fixtures/lisp.el
@@ -0,0 +1,930 @@
+;;; lisp.el --- Lisp editing commands for Emacs -*- lexical-binding:t -*-
+
+;; Copyright (C) 1985-1986, 1994, 2000-2015 Free Software Foundation, Inc.
+
+;; Maintainer: address@hidden
+;; Keywords: lisp, languages
+;; Package: emacs
+
+;; 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:
+
+;; Lisp editing commands to go with Lisp major mode. More-or-less
+;; applicable in other modes too.
+
+;;; Code:
+
+;; Note that this variable is used by non-lisp modes too.
+(defcustom defun-prompt-regexp nil
+ "If non-nil, a regexp to ignore before a defun.
+This is only necessary if the opening paren or brace is not in column 0.
+See function `beginning-of-defun'."
+ :type '(choice (const nil)
+ regexp)
+ :group 'lisp)
+(make-variable-buffer-local 'defun-prompt-regexp)
+
+(defcustom parens-require-spaces t
+ "If non-nil, add whitespace as needed when inserting parentheses.
+This affects `insert-parentheses' and `insert-pair'."
+ :type 'boolean
+ :group 'lisp)
+
+(defvar forward-sexp-function nil
+ ;; FIXME:
+ ;; - for some uses, we may want a "sexp-only" version, which only
+ ;; jumps over a well-formed sexp, rather than some dwimish thing
+ ;; like jumping from an "else" back up to its "if".
+ ;; - for up-list, we could use the "sexp-only" behavior as well
+ ;; to treat the dwimish halfsexp as a form of "up-list" step.
+ "If non-nil, `forward-sexp' delegates to this function.
+Should take the same arguments and behave similarly to `forward-sexp'.")
+
+(defun forward-sexp (&optional arg)
+ "Move forward across one balanced expression (sexp).
+With ARG, do it that many times. Negative arg -N means
+move backward across N balanced expressions.
+This command assumes point is not in a string or comment.
+Calls `forward-sexp-function' to do the work, if that is non-nil."
+ (interactive "^p")
+ (or arg (setq arg 1))
+ (if forward-sexp-function
+ (funcall forward-sexp-function arg)
+ (goto-char (or (scan-sexps (point) arg) (buffer-end arg)))
+ (if (< arg 0) (backward-prefix-chars))))
+
+(defun backward-sexp (&optional arg)
+ "Move backward across one balanced expression (sexp).
+With ARG, do it that many times. Negative arg -N means
+move forward across N balanced expressions.
+This command assumes point is not in a string or comment.
+Uses `forward-sexp' to do the work."
+ (interactive "^p")
+ (or arg (setq arg 1))
+ (forward-sexp (- arg)))
+
+(defun mark-sexp (&optional arg allow-extend)
+ "Set mark ARG sexps from point.
+The place mark goes is the same place \\[forward-sexp] would
+move to with the same argument.
+Interactively, if this command is repeated
+or (in Transient Mark mode) if the mark is active,
+it marks the next ARG sexps after the ones already marked.
+This command assumes point is not in a string or comment."
+ (interactive "P\np")
+ (cond ((and allow-extend
+ (or (and (eq last-command this-command) (mark t))
+ (and transient-mark-mode mark-active)))
+ (setq arg (if arg (prefix-numeric-value arg)
+ (if (< (mark) (point)) -1 1)))
+ (set-mark
+ (save-excursion
+ (goto-char (mark))
+ (forward-sexp arg)
+ (point))))
+ (t
+ (push-mark
+ (save-excursion
+ (forward-sexp (prefix-numeric-value arg))
+ (point))
+ nil t))))
+
+(defun forward-list (&optional arg)
+ "Move forward across one balanced group of parentheses.
+This command will also work on other parentheses-like expressions
+defined by the current language mode.
+With ARG, do it that many times.
+Negative arg -N means move backward across N groups of parentheses.
+This command assumes point is not in a string or comment."
+ (interactive "^p")
+ (or arg (setq arg 1))
+ (goto-char (or (scan-lists (point) arg 0) (buffer-end arg))))
+
+(defun backward-list (&optional arg)
+ "Move backward across one balanced group of parentheses.
+This command will also work on other parentheses-like expressions
+defined by the current language mode.
+With ARG, do it that many times.
+Negative arg -N means move forward across N groups of parentheses.
+This command assumes point is not in a string or comment."
+ (interactive "^p")
+ (or arg (setq arg 1))
+ (forward-list (- arg)))
+
+(defun down-list (&optional arg)
+ "Move forward down one level of parentheses.
+This command will also work on other parentheses-like expressions
+defined by the current language mode.
+With ARG, do this that many times.
+A negative argument means move backward but still go down a level.
+This command assumes point is not in a string or comment."
+ (interactive "^p")
+ (or arg (setq arg 1))
+ (let ((inc (if (> arg 0) 1 -1)))
+ (while (/= arg 0)
+ (goto-char (or (scan-lists (point) inc -1) (buffer-end arg)))
+ (setq arg (- arg inc)))))
+
+(defun backward-up-list (&optional arg)
+ "Move backward out of one level of parentheses.
+This command will also work on other parentheses-like expressions
+defined by the current language mode.
+With ARG, do this that many times.
+A negative argument means move forward but still to a less deep spot.
+This command assumes point is not in a string or comment."
+ (interactive "^p")
+ (up-list (- (or arg 1))))
+
+(defun up-list (&optional arg)
+ "Move forward out of one level of parentheses.
+This command will also work on other parentheses-like expressions
+defined by the current language mode.
+With ARG, do this that many times.
+A negative argument means move backward but still to a less deep spot.
+This command assumes point is not in a string or comment."
+ (interactive "^p")
+ (or arg (setq arg 1))
+ (let ((inc (if (> arg 0) 1 -1))
+ pos)
+ (while (/= arg 0)
+ (if (null forward-sexp-function)
+ (goto-char (or (scan-lists (point) inc 1) (buffer-end arg)))
+ (condition-case err
+ (while (progn (setq pos (point))
+ (forward-sexp inc)
+ (/= (point) pos)))
+ (scan-error (goto-char (nth (if (> arg 0) 3 2) err))))
+ (if (= (point) pos)
+ (signal 'scan-error
+ (list "Unbalanced parentheses" (point) (point)))))
+ (setq arg (- arg inc)))))
+
+(defun kill-sexp (&optional arg)
+ "Kill the sexp (balanced expression) following point.
+With ARG, kill that many sexps after point.
+Negative arg -N means kill N sexps before point.
+This command assumes point is not in a string or comment."
+ (interactive "p")
+ (let ((opoint (point)))
+ (forward-sexp (or arg 1))
+ (kill-region opoint (point))))
+
+(defun backward-kill-sexp (&optional arg)
+ "Kill the sexp (balanced expression) preceding point.
+With ARG, kill that many sexps before point.
+Negative arg -N means kill N sexps after point.
+This command assumes point is not in a string or comment."
+ (interactive "p")
+ (kill-sexp (- (or arg 1))))
+
+;; After Zmacs:
+(defun kill-backward-up-list (&optional arg)
+ "Kill the form containing the current sexp, leaving the sexp itself.
+A prefix argument ARG causes the relevant number of surrounding
+forms to be removed.
+This command assumes point is not in a string or comment."
+ (interactive "*p")
+ (let ((current-sexp (thing-at-point 'sexp)))
+ (if current-sexp
+ (save-excursion
+ (backward-up-list arg)
+ (kill-sexp)
+ (insert current-sexp))
+ (error "Not at a sexp"))))
+
+(defvar beginning-of-defun-function nil
+ "If non-nil, function for `beginning-of-defun-raw' to call.
+This is used to find the beginning of the defun instead of using the
+normal recipe (see `beginning-of-defun'). Major modes can define this
+if defining `defun-prompt-regexp' is not sufficient to handle the mode's
+needs.
+
+The function takes the same argument as `beginning-of-defun' and should
+behave similarly, returning non-nil if it found the beginning of a defun.
+Ideally it should move to a point right before an open-paren which encloses
+the body of the defun.")
+
+(defun beginning-of-defun (&optional arg)
+ "Move backward to the beginning of a defun.
+With ARG, do it that many times. Negative ARG means move forward
+to the ARGth following beginning of defun.
+
+If search is successful, return t; point ends up at the beginning
+of the line where the search succeeded. Otherwise, return nil.
+
+When `open-paren-in-column-0-is-defun-start' is non-nil, a defun
+is assumed to start where there is a char with open-parenthesis
+syntax at the beginning of a line. If `defun-prompt-regexp' is
+non-nil, then a string which matches that regexp may also precede
+the open-parenthesis. If `defun-prompt-regexp' and
+`open-paren-in-column-0-is-defun-start' are both nil, this
+function instead finds an open-paren at the outermost level.
+
+If the variable `beginning-of-defun-function' is non-nil, its
+value is called as a function, with argument ARG, to find the
+defun's beginning.
+
+Regardless of the values of `defun-prompt-regexp' and
+`beginning-of-defun-function', point always moves to the
+beginning of the line whenever the search is successful."
+ (interactive "^p")
+ (or (not (eq this-command 'beginning-of-defun))
+ (eq last-command 'beginning-of-defun)
+ (and transient-mark-mode mark-active)
+ (push-mark))
+ (and (beginning-of-defun-raw arg)
+ (progn (beginning-of-line) t)))
+
+(defun beginning-of-defun-raw (&optional arg)
+ "Move point to the character that starts a defun.
+This is identical to function `beginning-of-defun', except that point
+does not move to the beginning of the line when `defun-prompt-regexp'
+is non-nil.
+
+If variable `beginning-of-defun-function' is non-nil, its value
+is called as a function to find the defun's beginning."
+ (interactive "^p") ; change this to "P", maybe, if we ever come to pass ARG
+ ; to beginning-of-defun-function.
+ (unless arg (setq arg 1))
+ (cond
+ (beginning-of-defun-function
+ (condition-case nil
+ (funcall beginning-of-defun-function arg)
+ ;; We used to define beginning-of-defun-function as taking no argument
+ ;; but that makes it impossible to implement correct forward motion:
+ ;; we used to use end-of-defun for that, but it's not supposed to do
+ ;; the same thing (it moves to the end of a defun not to the beginning
+ ;; of the next).
+ ;; In case the beginning-of-defun-function uses the old calling
+ ;; convention, fallback on the old implementation.
+ (wrong-number-of-arguments
+ (if (> arg 0)
+ (dotimes (_ arg)
+ (funcall beginning-of-defun-function))
+ (dotimes (_ (- arg))
+ (funcall end-of-defun-function))))))
+
+ ((or defun-prompt-regexp open-paren-in-column-0-is-defun-start)
+ (and (< arg 0) (not (eobp)) (forward-char 1))
+ (and (re-search-backward (if defun-prompt-regexp
+ (concat (if
open-paren-in-column-0-is-defun-start
+ "^\\s(\\|" "")
+ "\\(?:" defun-prompt-regexp "\\)\\s(")
+ "^\\s(")
+ nil 'move arg)
+ (progn (goto-char (1- (match-end 0)))
+ t)))
+
+ ;; If open-paren-in-column-0-is-defun-start and defun-prompt-regexp
+ ;; are both nil, column 0 has no significance - so scan forward
+ ;; from BOB to see how nested point is, then carry on from there.
+ ;;
+ ;; It is generally not a good idea to land up here, because the
+ ;; call to scan-lists below can be extremely slow. This is because
+ ;; back_comment in syntax.c may have to scan from bob to find the
+ ;; beginning of each comment. Fixing this is not trivial -- cyd.
+
+ ((eq arg 0))
+ (t
+ (let ((floor (point-min))
+ (ceiling (point-max))
+ (arg-+ve (> arg 0)))
+ (save-restriction
+ (widen)
+ (let ((ppss (let (syntax-begin-function
+ font-lock-beginning-of-syntax-function)
+ (syntax-ppss)))
+ ;; position of least enclosing paren, or nil.
+ encl-pos)
+ ;; Back out of any comment/string, so that encl-pos will always
+ ;; become nil if we're at top-level.
+ (when (nth 8 ppss)
+ (goto-char (nth 8 ppss))
+ (setq ppss (syntax-ppss))) ; should be fast, due to cache.
+ (setq encl-pos (syntax-ppss-toplevel-pos ppss))
+ (if encl-pos (goto-char encl-pos))
+
+ (and encl-pos arg-+ve (setq arg (1- arg)))
+ (and (not encl-pos) (not arg-+ve) (not (looking-at "\\s("))
+ (setq arg (1+ arg)))
+
+ (condition-case nil ; to catch crazy parens.
+ (progn
+ (goto-char (scan-lists (point) (- arg) 0))
+ (if arg-+ve
+ (if (>= (point) floor)
+ t
+ (goto-char floor)
+ nil)
+ ;; forward to next (, or trigger the c-c
+ (goto-char (1- (scan-lists (point) 1 -1)))
+ (if (<= (point) ceiling)
+ t
+ (goto-char ceiling)
+ nil)))
+ (error
+ (goto-char (if arg-+ve floor ceiling))
+ nil))))))))
+
+(defvar end-of-defun-function
+ (lambda () (forward-sexp 1))
+ "Function for `end-of-defun' to call.
+This is used to find the end of the defun at point.
+It is called with no argument, right after calling `beginning-of-defun-raw'.
+So the function can assume that point is at the beginning of the defun body.
+It should move point to the first position after the defun.")
+
+(defun buffer-end (arg)
+ "Return the \"far end\" position of the buffer, in direction ARG.
+If ARG is positive, that's the end of the buffer.
+Otherwise, that's the beginning of the buffer."
+ (if (> arg 0) (point-max) (point-min)))
+
+(defun end-of-defun (&optional arg)
+ "Move forward to next end of defun.
+With argument, do it that many times.
+Negative argument -N means move back to Nth preceding end of defun.
+
+An end of a defun occurs right after the close-parenthesis that
+matches the open-parenthesis that starts a defun; see function
+`beginning-of-defun'.
+
+If variable `end-of-defun-function' is non-nil, its value
+is called as a function to find the defun's end."
+ (interactive "^p")
+ (or (not (eq this-command 'end-of-defun))
+ (eq last-command 'end-of-defun)
+ (and transient-mark-mode mark-active)
+ (push-mark))
+ (if (or (null arg) (= arg 0)) (setq arg 1))
+ (let ((pos (point))
+ (beg (progn (end-of-line 1) (beginning-of-defun-raw 1) (point)))
+ (skip (lambda ()
+ ;; When comparing point against pos, we want to consider that if
+ ;; point was right after the end of the function, it's still
+ ;; considered as "in that function".
+ ;; E.g. `eval-defun' from right after the last close-paren.
+ (unless (bolp)
+ (skip-chars-forward " \t")
+ (if (looking-at "\\s<\\|\n")
+ (forward-line 1))))))
+ (funcall end-of-defun-function)
+ (funcall skip)
+ (cond
+ ((> arg 0)
+ ;; Moving forward.
+ (if (> (point) pos)
+ ;; We already moved forward by one because we started from
+ ;; within a function.
+ (setq arg (1- arg))
+ ;; We started from after the end of the previous function.
+ (goto-char pos))
+ (unless (zerop arg)
+ (beginning-of-defun-raw (- arg))
+ (funcall end-of-defun-function)))
+ ((< arg 0)
+ ;; Moving backward.
+ (if (< (point) pos)
+ ;; We already moved backward because we started from between
+ ;; two functions.
+ (setq arg (1+ arg))
+ ;; We started from inside a function.
+ (goto-char beg))
+ (unless (zerop arg)
+ (beginning-of-defun-raw (- arg))
+ (setq beg (point))
+ (funcall end-of-defun-function))))
+ (funcall skip)
+ (while (and (< arg 0) (>= (point) pos))
+ ;; We intended to move backward, but this ended up not doing so:
+ ;; Try harder!
+ (goto-char beg)
+ (beginning-of-defun-raw (- arg))
+ (if (>= (point) beg)
+ (setq arg 0)
+ (setq beg (point))
+ (funcall end-of-defun-function)
+ (funcall skip)))))
+
+(defun mark-defun (&optional allow-extend)
+ "Put mark at end of this defun, point at beginning.
+The defun marked is the one that contains point or follows point.
+
+Interactively, if this command is repeated
+or (in Transient Mark mode) if the mark is active,
+it marks the next defun after the ones already marked."
+ (interactive "p")
+ (cond ((and allow-extend
+ (or (and (eq last-command this-command) (mark t))
+ (and transient-mark-mode mark-active)))
+ (set-mark
+ (save-excursion
+ (goto-char (mark))
+ (end-of-defun)
+ (point))))
+ (t
+ (let ((opoint (point))
+ beg end)
+ (push-mark opoint)
+ ;; Try first in this order for the sake of languages with nested
+ ;; functions where several can end at the same place as with
+ ;; the offside rule, e.g. Python.
+ (beginning-of-defun)
+ (setq beg (point))
+ (end-of-defun)
+ (setq end (point))
+ (while (looking-at "^\n")
+ (forward-line 1))
+ (if (> (point) opoint)
+ (progn
+ ;; We got the right defun.
+ (push-mark beg nil t)
+ (goto-char end)
+ (exchange-point-and-mark))
+ ;; beginning-of-defun moved back one defun
+ ;; so we got the wrong one.
+ (goto-char opoint)
+ (end-of-defun)
+ (push-mark (point) nil t)
+ (beginning-of-defun))
+ (re-search-backward "^\n" (- (point) 1) t)))))
+
+(defun narrow-to-defun (&optional _arg)
+ "Make text outside current defun invisible.
+The defun visible is the one that contains point or follows point.
+Optional ARG is ignored."
+ (interactive)
+ (save-excursion
+ (widen)
+ (let ((opoint (point))
+ beg end)
+ ;; Try first in this order for the sake of languages with nested
+ ;; functions where several can end at the same place as with
+ ;; the offside rule, e.g. Python.
+
+ ;; Finding the start of the function is a bit problematic since
+ ;; `beginning-of-defun' when we are on the first character of
+ ;; the function might go to the previous function.
+ ;;
+ ;; Therefore we first move one character forward and then call
+ ;; `beginning-of-defun'. However now we must check that we did
+ ;; not move into the next function.
+ (let ((here (point)))
+ (unless (eolp)
+ (forward-char))
+ (beginning-of-defun)
+ (when (< (point) here)
+ (goto-char here)
+ (beginning-of-defun)))
+ (setq beg (point))
+ (end-of-defun)
+ (setq end (point))
+ (while (looking-at "^\n")
+ (forward-line 1))
+ (unless (> (point) opoint)
+ ;; beginning-of-defun moved back one defun
+ ;; so we got the wrong one.
+ (goto-char opoint)
+ (end-of-defun)
+ (setq end (point))
+ (beginning-of-defun)
+ (setq beg (point)))
+ (goto-char end)
+ (re-search-backward "^\n" (- (point) 1) t)
+ (narrow-to-region beg end))))
+
+(defvar insert-pair-alist
+ '((?\( ?\)) (?\[ ?\]) (?\{ ?\}) (?\< ?\>) (?\" ?\") (?\' ?\') (?\` ?\'))
+ "Alist of paired characters inserted by `insert-pair'.
+Each element looks like (OPEN-CHAR CLOSE-CHAR) or (COMMAND-CHAR
+OPEN-CHAR CLOSE-CHAR). The characters OPEN-CHAR and CLOSE-CHAR
+of the pair whose key is equal to the last input character with
+or without modifiers, are inserted by `insert-pair'.")
+
+(defun insert-pair (&optional arg open close)
+ "Enclose following ARG sexps in a pair of OPEN and CLOSE characters.
+Leave point after the first character.
+A negative ARG encloses the preceding ARG sexps instead.
+No argument is equivalent to zero: just insert characters
+and leave point between.
+If `parens-require-spaces' is non-nil, this command also inserts a space
+before and after, depending on the surrounding characters.
+If region is active, insert enclosing characters at region boundaries.
+
+If arguments OPEN and CLOSE are nil, the character pair is found
+from the variable `insert-pair-alist' according to the last input
+character with or without modifiers. If no character pair is
+found in the variable `insert-pair-alist', then the last input
+character is inserted ARG times.
+
+This command assumes point is not in a string or comment."
+ (interactive "P")
+ (if (not (and open close))
+ (let ((pair (or (assq last-command-event insert-pair-alist)
+ (assq (event-basic-type last-command-event)
+ insert-pair-alist))))
+ (if pair
+ (if (nth 2 pair)
+ (setq open (nth 1 pair) close (nth 2 pair))
+ (setq open (nth 0 pair) close (nth 1 pair))))))
+ (if (and open close)
+ (if (and transient-mark-mode mark-active)
+ (progn
+ (save-excursion (goto-char (region-end)) (insert close))
+ (save-excursion (goto-char (region-beginning)) (insert open)))
+ (if arg (setq arg (prefix-numeric-value arg))
+ (setq arg 0))
+ (cond ((> arg 0) (skip-chars-forward " \t"))
+ ((< arg 0) (forward-sexp arg) (setq arg (- arg))))
+ (and parens-require-spaces
+ (not (bobp))
+ (memq (char-syntax (preceding-char)) (list ?w ?_ (char-syntax
close)))
+ (insert " "))
+ (insert open)
+ (save-excursion
+ (or (eq arg 0) (forward-sexp arg))
+ (insert close)
+ (and parens-require-spaces
+ (not (eobp))
+ (memq (char-syntax (following-char)) (list ?w ?_ (char-syntax
open)))
+ (insert " "))))
+ (insert-char (event-basic-type last-command-event)
+ (prefix-numeric-value arg))))
+
+(defun insert-parentheses (&optional arg)
+ "Enclose following ARG sexps in parentheses.
+Leave point after open-paren.
+A negative ARG encloses the preceding ARG sexps instead.
+No argument is equivalent to zero: just insert `()' and leave point between.
+If `parens-require-spaces' is non-nil, this command also inserts a space
+before and after, depending on the surrounding characters.
+If region is active, insert enclosing characters at region boundaries.
+
+This command assumes point is not in a string or comment."
+ (interactive "P")
+ (insert-pair arg ?\( ?\)))
+
+(defun delete-pair ()
+ "Delete a pair of characters enclosing the sexp that follows point."
+ (interactive)
+ (save-excursion (forward-sexp 1) (delete-char -1))
+ (delete-char 1))
+
+(defun raise-sexp (&optional arg)
+ "Raise ARG sexps higher up the tree."
+ (interactive "p")
+ (let ((s (if (and transient-mark-mode mark-active)
+ (buffer-substring (region-beginning) (region-end))
+ (buffer-substring
+ (point)
+ (save-excursion (forward-sexp arg) (point))))))
+ (backward-up-list 1)
+ (delete-region (point) (save-excursion (forward-sexp 1) (point)))
+ (save-excursion (insert s))))
+
+(defun move-past-close-and-reindent ()
+ "Move past next `)', delete indentation before it, then indent after it."
+ (interactive)
+ (up-list 1)
+ (forward-char -1)
+ (while (save-excursion ; this is my contribution
+ (let ((before-paren (point)))
+ (back-to-indentation)
+ (and (= (point) before-paren)
+ (progn
+ ;; Move to end of previous line.
+ (beginning-of-line)
+ (forward-char -1)
+ ;; Verify it doesn't end within a string or comment.
+ (let ((end (point))
+ state)
+ (beginning-of-line)
+ ;; Get state at start of line.
+ (setq state (list 0 nil nil
+ (null (calculate-lisp-indent))
+ nil nil nil nil
+ nil))
+ ;; Parse state across the line to get state at end.
+ (setq state (parse-partial-sexp (point) end nil nil
+ state))
+ ;; Check not in string or comment.
+ (and (not (elt state 3)) (not (elt state 4))))))))
+ (delete-indentation))
+ (forward-char 1)
+ (newline-and-indent))
+
+(defun check-parens () ; lame name?
+ "Check for unbalanced parentheses in the current buffer.
+More accurately, check the narrowed part of the buffer for unbalanced
+expressions (\"sexps\") in general. This is done according to the
+current syntax table and will find unbalanced brackets or quotes as
+appropriate. (See Info node `(emacs)Parentheses'.) If imbalance is
+found, an error is signaled and point is left at the first unbalanced
+character."
+ (interactive)
+ (condition-case data
+ ;; Buffer can't have more than (point-max) sexps.
+ (scan-sexps (point-min) (point-max))
+ (scan-error (goto-char (nth 2 data))
+ ;; Could print (nth 1 data), which is either
+ ;; "Containing expression ends prematurely" or
+ ;; "Unbalanced parentheses", but those may not be so
+ ;; accurate/helpful, e.g. quotes may actually be
+ ;; mismatched.
+ (user-error "Unmatched bracket or quote"))))
+
+(defun field-complete (table &optional predicate)
+ (declare (obsolete completion-in-region "24.4"))
+ (let ((minibuffer-completion-table table)
+ (minibuffer-completion-predicate predicate)
+ ;; This made sense for lisp-complete-symbol, but for
+ ;; field-complete, this is out of place. --Stef
+ ;; (completion-annotate-function
+ ;; (unless (eq predicate 'fboundp)
+ ;; (lambda (str)
+ ;; (if (fboundp (intern-soft str)) " <f>"))))
+ )
+ (call-interactively 'minibuffer-complete)))
+
+(defun lisp-complete-symbol (&optional predicate)
+ "Perform completion on Lisp symbol preceding point.
+Compare that symbol against the known Lisp symbols.
+If no characters can be completed, display a list of possible completions.
+Repeating the command at that point scrolls the list.
+
+When called from a program, optional arg PREDICATE is a predicate
+determining which symbols are considered, e.g. `commandp'.
+If PREDICATE is nil, the context determines which symbols are
+considered. If the symbol starts just after an open-parenthesis, only
+symbols with function definitions are considered. Otherwise, all
+symbols with function definitions, values or properties are
+considered."
+ (declare (obsolete completion-at-point "24.4"))
+ (interactive)
+ (let* ((data (lisp-completion-at-point predicate))
+ (plist (nthcdr 3 data)))
+ (if (null data)
+ (minibuffer-message "Nothing to complete")
+ (let ((completion-extra-properties plist))
+ (completion-in-region (nth 0 data) (nth 1 data) (nth 2 data)
+ (plist-get plist :predicate))))))
+
+(defun lisp--local-variables-1 (vars sexp)
+ "Return the vars locally bound around the witness, or nil if not found."
+ (let (res)
+ (while
+ (unless
+ (setq res
+ (pcase sexp
+ (`(,(or `let `let*) ,bindings)
+ (let ((vars vars))
+ (when (eq 'let* (car sexp))
+ (dolist (binding (cdr (reverse bindings)))
+ (push (or (car-safe binding) binding) vars)))
+ (lisp--local-variables-1
+ vars (car (cdr-safe (car (last bindings)))))))
+ (`(,(or `let `let*) ,bindings . ,body)
+ (let ((vars vars))
+ (dolist (binding bindings)
+ (push (or (car-safe binding) binding) vars))
+ (lisp--local-variables-1 vars (car (last body)))))
+ (`(lambda ,_) (setq sexp nil))
+ (`(lambda ,args . ,body)
+ (lisp--local-variables-1
+ (append args vars) (car (last body))))
+ (`(condition-case ,_ ,e) (lisp--local-variables-1 vars e))
+ (`(condition-case ,v ,_ . ,catches)
+ (lisp--local-variables-1
+ (cons v vars) (cdr (car (last catches)))))
+ (`(quote . ,_) (setq sexp nil))
+ (`(,_ . ,_)
+ (lisp--local-variables-1 vars (car (last sexp))))
+ (`lisp--witness--lisp (or vars '(nil)))
+ (_ nil)))
+ (setq sexp (ignore-errors (butlast sexp)))))
+ res))
+
+(defun lisp--local-variables ()
+ "Return a list of locally let-bound variables at point."
+ (save-excursion
+ (skip-syntax-backward "w_")
+ (let* ((ppss (syntax-ppss))
+ (txt (buffer-substring-no-properties (or (car (nth 9 ppss)) (point))
+ (or (nth 8 ppss) (point))))
+ (closer ()))
+ (dolist (p (nth 9 ppss))
+ (push (cdr (syntax-after p)) closer))
+ (setq closer (apply #'string closer))
+ (let* ((sexp (condition-case nil
+ (car (read-from-string
+ (concat txt "lisp--witness--lisp" closer)))
+ (end-of-file nil)))
+ (macroexpand-advice (lambda (expander form &rest args)
+ (condition-case nil
+ (apply expander form args)
+ (error form))))
+ (sexp
+ (unwind-protect
+ (progn
+ (advice-add 'macroexpand :around macroexpand-advice)
+ (macroexpand-all sexp))
+ (advice-remove 'macroexpand macroexpand-advice)))
+ (vars (lisp--local-variables-1 nil sexp)))
+ (delq nil
+ (mapcar (lambda (var)
+ (and (symbolp var)
+ (not (string-match (symbol-name var) "\\`[&_]"))
+ ;; Eliminate uninterned vars.
+ (intern-soft var)
+ var))
+ vars))))))
+
+(defvar lisp--local-variables-completion-table
+ ;; Use `defvar' rather than `defconst' since defconst would purecopy this
+ ;; value, which would doubly fail: it would fail because purecopy can't
+ ;; handle the recursive bytecode object, and it would fail because it would
+ ;; move `lastpos' and `lastvars' to pure space where they'd be immutable!
+ (let ((lastpos nil) (lastvars nil))
+ (letrec ((hookfun (lambda ()
+ (setq lastpos nil)
+ (remove-hook 'post-command-hook hookfun))))
+ (completion-table-dynamic
+ (lambda (_string)
+ (save-excursion
+ (skip-syntax-backward "_w")
+ (let ((newpos (cons (point) (current-buffer))))
+ (unless (equal lastpos newpos)
+ (add-hook 'post-command-hook hookfun)
+ (setq lastpos newpos)
+ (setq lastvars
+ (mapcar #'symbol-name (lisp--local-variables))))))
+ lastvars)))))
+
+;; FIXME: Support for Company brings in features which straddle eldoc.
+;; We should consolidate this, so that major modes can provide all that
+;; data all at once:
+;; - a function to extract "the reference at point" (may be more complex
+;; than a mere string, to distinguish various namespaces).
+;; - a function to jump to such a reference.
+;; - a function to show the signature/interface of such a reference.
+;; - a function to build a help-buffer about that reference.
+;; FIXME: Those functions should also be used by the normal completion code in
+;; the *Completions* buffer.
+
+(defun lisp--company-doc-buffer (str)
+ (let ((symbol (intern-soft str)))
+ ;; FIXME: we really don't want to "display-buffer and then undo it".
+ (save-window-excursion
+ ;; Make sure we don't display it in another frame, otherwise
+ ;; save-window-excursion won't be able to undo it.
+ (let ((display-buffer-overriding-action
+ '(nil . ((inhibit-switch-frame . t)))))
+ (ignore-errors
+ (cond
+ ((fboundp symbol) (describe-function symbol))
+ ((boundp symbol) (describe-variable symbol))
+ ((featurep symbol) (describe-package symbol))
+ ((facep symbol) (describe-face symbol))
+ (t (signal 'user-error nil)))
+ (help-buffer))))))
+
+(defun lisp--company-doc-string (str)
+ (let* ((symbol (intern-soft str))
+ (doc (if (fboundp symbol)
+ (documentation symbol t)
+ (documentation-property symbol 'variable-documentation t))))
+ (and (stringp doc)
+ (string-match ".*$" doc)
+ (match-string 0 doc))))
+
+(declare-function find-library-name "find-func" (library))
+
+(defun lisp--company-location (str)
+ (let ((sym (intern-soft str)))
+ (cond
+ ((fboundp sym) (find-definition-noselect sym nil))
+ ((boundp sym) (find-definition-noselect sym 'defvar))
+ ((featurep sym)
+ (require 'find-func)
+ (cons (find-file-noselect (find-library-name
+ (symbol-name sym)))
+ 0))
+ ((facep sym) (find-definition-noselect sym 'defface)))))
+
+(defun lisp-completion-at-point (&optional _predicate)
+ "Function used for `completion-at-point-functions' in `emacs-lisp-mode'."
+ (with-syntax-table emacs-lisp-mode-syntax-table
+ (let* ((pos (point))
+ (beg (condition-case nil
+ (save-excursion
+ (backward-sexp 1)
+ (skip-syntax-forward "'")
+ (point))
+ (scan-error pos)))
+ (end
+ (unless (or (eq beg (point-max))
+ (member (char-syntax (char-after beg))
+ '(?\s ?\" ?\( ?\))))
+ (condition-case nil
+ (save-excursion
+ (goto-char beg)
+ (forward-sexp 1)
+ (when (>= (point) pos)
+ (point)))
+ (scan-error pos))))
+ (funpos (eq (char-before beg) ?\()) ;t if in function position.
+ (table-etc
+ (if (not funpos)
+ ;; FIXME: We could look at the first element of the list and
+ ;; use it to provide a more specific completion table in some
+ ;; cases. E.g. filter out keywords that are not understood by
+ ;; the macro/function being called.
+ (list nil (completion-table-merge
+ lisp--local-variables-completion-table
+ (apply-partially #'completion-table-with-predicate
+ obarray
+ ;; Don't include all symbols
+ ;; (bug#16646).
+ (lambda (sym)
+ (or (boundp sym)
+ (fboundp sym)
+ (symbol-plist sym)))
+ 'strict))
+ :annotation-function
+ (lambda (str) (if (fboundp (intern-soft str)) " <f>"))
+ :company-doc-buffer #'lisp--company-doc-buffer
+ :company-docsig #'lisp--company-doc-string
+ :company-location #'lisp--company-location)
+ ;; Looks like a funcall position. Let's double check.
+ (save-excursion
+ (goto-char (1- beg))
+ (let ((parent
+ (condition-case nil
+ (progn (up-list -1) (forward-char 1)
+ (let ((c (char-after)))
+ (if (eq c ?\() ?\(
+ (if (memq (char-syntax c) '(?w ?_))
+ (read (current-buffer))))))
+ (error nil))))
+ (pcase parent
+ ;; FIXME: Rather than hardcode special cases here,
+ ;; we should use something like a symbol-property.
+ (`declare
+ (list t (mapcar (lambda (x) (symbol-name (car x)))
+ (delete-dups
+ ;; FIXME: We should include some
+ ;; docstring with each entry.
+ (append
+ macro-declarations-alist
+ defun-declarations-alist)))))
+ ((and (or `condition-case `condition-case-unless-debug)
+ (guard (save-excursion
+ (ignore-errors
+ (forward-sexp 2)
+ (< (point) beg)))))
+ (list t obarray
+ :predicate (lambda (sym) (get sym
'error-conditions))))
+ ((and ?\(
+ (guard (save-excursion
+ (goto-char (1- beg))
+ (up-list -1)
+ (forward-symbol -1)
+ (looking-at "\\_<let\\*?\\_>"))))
+ (list t obarray
+ :predicate #'boundp
+ :company-doc-buffer #'lisp--company-doc-buffer
+ :company-docsig #'lisp--company-doc-string
+ :company-location #'lisp--company-location))
+ (_ (list nil obarray
+ :predicate #'fboundp
+ :company-doc-buffer #'lisp--company-doc-buffer
+ :company-docsig #'lisp--company-doc-string
+ :company-location #'lisp--company-location
+ ))))))))
+ (when end
+ (let ((tail (if (null (car table-etc))
+ (cdr table-etc)
+ (cons
+ (if (memq (char-syntax (or (char-after end) ?\s))
+ '(?\s ?>))
+ (cadr table-etc)
+ (apply-partially 'completion-table-with-terminator
+ " " (cadr table-etc)))
+ (cddr table-etc)))))
+ `(,beg ,end ,@tail))))))
+
+;;; lisp.el ends here
diff --git a/packages/context-coloring/benchmark/fixtures/simple.el
b/packages/context-coloring/benchmark/fixtures/simple.el
new file mode 100644
index 0000000..5e5cd87
--- /dev/null
+++ b/packages/context-coloring/benchmark/fixtures/simple.el
@@ -0,0 +1,7901 @@
+;;; simple.el --- basic editing commands for Emacs -*- lexical-binding: t -*-
+
+;; Copyright (C) 1985-1987, 1993-2015 Free Software Foundation, Inc.
+
+;; Maintainer: address@hidden
+;; Keywords: internal
+;; Package: emacs
+
+;; 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:
+
+;; A grab-bag of basic Emacs commands not specifically related to some
+;; major mode or to file-handling.
+
+;;; Code:
+
+(eval-when-compile (require 'cl-lib))
+
+(declare-function widget-convert "wid-edit" (type &rest args))
+(declare-function shell-mode "shell" ())
+
+;;; From compile.el
+(defvar compilation-current-error)
+(defvar compilation-context-lines)
+
+(defcustom idle-update-delay 0.5
+ "Idle time delay before updating various things on the screen.
+Various Emacs features that update auxiliary information when point moves
+wait this many seconds after Emacs becomes idle before doing an update."
+ :type 'number
+ :group 'display
+ :version "22.1")
+
+(defgroup killing nil
+ "Killing and yanking commands."
+ :group 'editing)
+
+(defgroup paren-matching nil
+ "Highlight (un)matching of parens and expressions."
+ :group 'matching)
+
+;;; next-error support framework
+
+(defgroup next-error nil
+ "`next-error' support framework."
+ :group 'compilation
+ :version "22.1")
+
+(defface next-error
+ '((t (:inherit region)))
+ "Face used to highlight next error locus."
+ :group 'next-error
+ :version "22.1")
+
+(defcustom next-error-highlight 0.5
+ "Highlighting of locations in selected source buffers.
+If a number, highlight the locus in `next-error' face for the given time
+in seconds, or until the next command is executed.
+If t, highlight the locus until the next command is executed, or until
+some other locus replaces it.
+If nil, don't highlight the locus in the source buffer.
+If `fringe-arrow', indicate the locus by the fringe arrow
+indefinitely until some other locus replaces it."
+ :type '(choice (number :tag "Highlight for specified time")
+ (const :tag "Semipermanent highlighting" t)
+ (const :tag "No highlighting" nil)
+ (const :tag "Fringe arrow" fringe-arrow))
+ :group 'next-error
+ :version "22.1")
+
+(defcustom next-error-highlight-no-select 0.5
+ "Highlighting of locations in `next-error-no-select'.
+If number, highlight the locus in `next-error' face for given time in seconds.
+If t, highlight the locus indefinitely until some other locus replaces it.
+If nil, don't highlight the locus in the source buffer.
+If `fringe-arrow', indicate the locus by the fringe arrow
+indefinitely until some other locus replaces it."
+ :type '(choice (number :tag "Highlight for specified time")
+ (const :tag "Semipermanent highlighting" t)
+ (const :tag "No highlighting" nil)
+ (const :tag "Fringe arrow" fringe-arrow))
+ :group 'next-error
+ :version "22.1")
+
+(defcustom next-error-recenter nil
+ "Display the line in the visited source file recentered as specified.
+If non-nil, the value is passed directly to `recenter'."
+ :type '(choice (integer :tag "Line to recenter to")
+ (const :tag "Center of window" (4))
+ (const :tag "No recentering" nil))
+ :group 'next-error
+ :version "23.1")
+
+(defcustom next-error-hook nil
+ "List of hook functions run by `next-error' after visiting source file."
+ :type 'hook
+ :group 'next-error)
+
+(defvar next-error-highlight-timer nil)
+
+(defvar next-error-overlay-arrow-position nil)
+(put 'next-error-overlay-arrow-position 'overlay-arrow-string (purecopy "=>"))
+(add-to-list 'overlay-arrow-variable-list 'next-error-overlay-arrow-position)
+
+(defvar next-error-last-buffer nil
+ "The most recent `next-error' buffer.
+A buffer becomes most recent when its compilation, grep, or
+similar mode is started, or when it is used with \\[next-error]
+or \\[compile-goto-error].")
+
+(defvar next-error-function nil
+ "Function to use to find the next error in the current buffer.
+The function is called with 2 parameters:
+ARG is an integer specifying by how many errors to move.
+RESET is a boolean which, if non-nil, says to go back to the beginning
+of the errors before moving.
+Major modes providing compile-like functionality should set this variable
+to indicate to `next-error' that this is a candidate buffer and how
+to navigate in it.")
+(make-variable-buffer-local 'next-error-function)
+
+(defvar next-error-move-function nil
+ "Function to use to move to an error locus.
+It takes two arguments, a buffer position in the error buffer
+and a buffer position in the error locus buffer.
+The buffer for the error locus should already be current.
+nil means use goto-char using the second argument position.")
+(make-variable-buffer-local 'next-error-move-function)
+
+(defsubst next-error-buffer-p (buffer
+ &optional avoid-current
+ extra-test-inclusive
+ extra-test-exclusive)
+ "Test if BUFFER is a `next-error' capable buffer.
+
+If AVOID-CURRENT is non-nil, treat the current buffer
+as an absolute last resort only.
+
+The function EXTRA-TEST-INCLUSIVE, if non-nil, is called in each buffer
+that normally would not qualify. If it returns t, the buffer
+in question is treated as usable.
+
+The function EXTRA-TEST-EXCLUSIVE, if non-nil, is called in each buffer
+that would normally be considered usable. If it returns nil,
+that buffer is rejected."
+ (and (buffer-name buffer) ;First make sure it's live.
+ (not (and avoid-current (eq buffer (current-buffer))))
+ (with-current-buffer buffer
+ (if next-error-function ; This is the normal test.
+ ;; Optionally reject some buffers.
+ (if extra-test-exclusive
+ (funcall extra-test-exclusive)
+ t)
+ ;; Optionally accept some other buffers.
+ (and extra-test-inclusive
+ (funcall extra-test-inclusive))))))
+
+(defun next-error-find-buffer (&optional avoid-current
+ extra-test-inclusive
+ extra-test-exclusive)
+ "Return a `next-error' capable buffer.
+
+If AVOID-CURRENT is non-nil, treat the current buffer
+as an absolute last resort only.
+
+The function EXTRA-TEST-INCLUSIVE, if non-nil, is called in each buffer
+that normally would not qualify. If it returns t, the buffer
+in question is treated as usable.
+
+The function EXTRA-TEST-EXCLUSIVE, if non-nil, is called in each buffer
+that would normally be considered usable. If it returns nil,
+that buffer is rejected."
+ (or
+ ;; 1. If one window on the selected frame displays such buffer, return it.
+ (let ((window-buffers
+ (delete-dups
+ (delq nil (mapcar (lambda (w)
+ (if (next-error-buffer-p
+ (window-buffer w)
+ avoid-current
+ extra-test-inclusive extra-test-exclusive)
+ (window-buffer w)))
+ (window-list))))))
+ (if (eq (length window-buffers) 1)
+ (car window-buffers)))
+ ;; 2. If next-error-last-buffer is an acceptable buffer, use that.
+ (if (and next-error-last-buffer
+ (next-error-buffer-p next-error-last-buffer avoid-current
+ extra-test-inclusive extra-test-exclusive))
+ next-error-last-buffer)
+ ;; 3. If the current buffer is acceptable, choose it.
+ (if (next-error-buffer-p (current-buffer) avoid-current
+ extra-test-inclusive extra-test-exclusive)
+ (current-buffer))
+ ;; 4. Look for any acceptable buffer.
+ (let ((buffers (buffer-list)))
+ (while (and buffers
+ (not (next-error-buffer-p
+ (car buffers) avoid-current
+ extra-test-inclusive extra-test-exclusive)))
+ (setq buffers (cdr buffers)))
+ (car buffers))
+ ;; 5. Use the current buffer as a last resort if it qualifies,
+ ;; even despite AVOID-CURRENT.
+ (and avoid-current
+ (next-error-buffer-p (current-buffer) nil
+ extra-test-inclusive extra-test-exclusive)
+ (progn
+ (message "This is the only buffer with error message locations")
+ (current-buffer)))
+ ;; 6. Give up.
+ (error "No buffers contain error message locations")))
+
+(defun next-error (&optional arg reset)
+ "Visit next `next-error' message and corresponding source code.
+
+If all the error messages parsed so far have been processed already,
+the message buffer is checked for new ones.
+
+A prefix ARG specifies how many error messages to move;
+negative means move back to previous error messages.
+Just \\[universal-argument] as a prefix means reparse the error message buffer
+and start at the first error.
+
+The RESET argument specifies that we should restart from the beginning.
+
+\\[next-error] normally uses the most recently started
+compilation, grep, or occur buffer. It can also operate on any
+buffer with output from the \\[compile], \\[grep] commands, or,
+more generally, on any buffer in Compilation mode or with
+Compilation Minor mode enabled, or any buffer in which
+`next-error-function' is bound to an appropriate function.
+To specify use of a particular buffer for error messages, type
+\\[next-error] in that buffer when it is the only one displayed
+in the current frame.
+
+Once \\[next-error] has chosen the buffer for error messages, it
+runs `next-error-hook' with `run-hooks', and stays with that buffer
+until you use it in some other buffer which uses Compilation mode
+or Compilation Minor mode.
+
+To control which errors are matched, customize the variable
+`compilation-error-regexp-alist'."
+ (interactive "P")
+ (if (consp arg) (setq reset t arg nil))
+ (when (setq next-error-last-buffer (next-error-find-buffer))
+ ;; we know here that next-error-function is a valid symbol we can funcall
+ (with-current-buffer next-error-last-buffer
+ (funcall next-error-function (prefix-numeric-value arg) reset)
+ (when next-error-recenter
+ (recenter next-error-recenter))
+ (run-hooks 'next-error-hook))))
+
+(defun next-error-internal ()
+ "Visit the source code corresponding to the `next-error' message at point."
+ (setq next-error-last-buffer (current-buffer))
+ ;; we know here that next-error-function is a valid symbol we can funcall
+ (with-current-buffer next-error-last-buffer
+ (funcall next-error-function 0 nil)
+ (when next-error-recenter
+ (recenter next-error-recenter))
+ (run-hooks 'next-error-hook)))
+
+(defalias 'goto-next-locus 'next-error)
+(defalias 'next-match 'next-error)
+
+(defun previous-error (&optional n)
+ "Visit previous `next-error' message and corresponding source code.
+
+Prefix arg N says how many error messages to move backwards (or
+forwards, if negative).
+
+This operates on the output from the \\[compile] and \\[grep] commands."
+ (interactive "p")
+ (next-error (- (or n 1))))
+
+(defun first-error (&optional n)
+ "Restart at the first error.
+Visit corresponding source code.
+With prefix arg N, visit the source code of the Nth error.
+This operates on the output from the \\[compile] command, for instance."
+ (interactive "p")
+ (next-error n t))
+
+(defun next-error-no-select (&optional n)
+ "Move point to the next error in the `next-error' buffer and highlight match.
+Prefix arg N says how many error messages to move forwards (or
+backwards, if negative).
+Finds and highlights the source line like \\[next-error], but does not
+select the source buffer."
+ (interactive "p")
+ (let ((next-error-highlight next-error-highlight-no-select))
+ (next-error n))
+ (pop-to-buffer next-error-last-buffer))
+
+(defun previous-error-no-select (&optional n)
+ "Move point to the previous error in the `next-error' buffer and highlight
match.
+Prefix arg N says how many error messages to move backwards (or
+forwards, if negative).
+Finds and highlights the source line like \\[previous-error], but does not
+select the source buffer."
+ (interactive "p")
+ (next-error-no-select (- (or n 1))))
+
+;; Internal variable for `next-error-follow-mode-post-command-hook'.
+(defvar next-error-follow-last-line nil)
+
+(define-minor-mode next-error-follow-minor-mode
+ "Minor mode for compilation, occur and diff modes.
+With a prefix argument ARG, enable mode if ARG is positive, and
+disable it otherwise. If called from Lisp, enable mode if ARG is
+omitted or nil.
+When turned on, cursor motion in the compilation, grep, occur or diff
+buffer causes automatic display of the corresponding source code location."
+ :group 'next-error :init-value nil :lighter " Fol"
+ (if (not next-error-follow-minor-mode)
+ (remove-hook 'post-command-hook
'next-error-follow-mode-post-command-hook t)
+ (add-hook 'post-command-hook 'next-error-follow-mode-post-command-hook nil
t)
+ (make-local-variable 'next-error-follow-last-line)))
+
+;; Used as a `post-command-hook' by `next-error-follow-mode'
+;; for the *Compilation* *grep* and *Occur* buffers.
+(defun next-error-follow-mode-post-command-hook ()
+ (unless (equal next-error-follow-last-line (line-number-at-pos))
+ (setq next-error-follow-last-line (line-number-at-pos))
+ (condition-case nil
+ (let ((compilation-context-lines nil))
+ (setq compilation-current-error (point))
+ (next-error-no-select 0))
+ (error t))))
+
+
+;;;
+
+(defun fundamental-mode ()
+ "Major mode not specialized for anything in particular.
+Other major modes are defined by comparison with this one."
+ (interactive)
+ (kill-all-local-variables)
+ (run-mode-hooks))
+
+;; Special major modes to view specially formatted data rather than files.
+
+(defvar special-mode-map
+ (let ((map (make-sparse-keymap)))
+ (suppress-keymap map)
+ (define-key map "q" 'quit-window)
+ (define-key map " " 'scroll-up-command)
+ (define-key map [?\S-\ ] 'scroll-down-command)
+ (define-key map "\C-?" 'scroll-down-command)
+ (define-key map "?" 'describe-mode)
+ (define-key map "h" 'describe-mode)
+ (define-key map ">" 'end-of-buffer)
+ (define-key map "<" 'beginning-of-buffer)
+ (define-key map "g" 'revert-buffer)
+ map))
+
+(put 'special-mode 'mode-class 'special)
+(define-derived-mode special-mode nil "Special"
+ "Parent major mode from which special major modes should inherit."
+ (setq buffer-read-only t))
+
+;; Making and deleting lines.
+
+(defvar self-insert-uses-region-functions nil
+ "Special hook to tell if `self-insert-command' will use the region.
+It must be called via `run-hook-with-args-until-success' with no arguments.
+Any `post-self-insert-command' which consumes the region should
+register a function on this hook so that things like `delete-selection-mode'
+can refrain from consuming the region.")
+
+(defvar hard-newline (propertize "\n" 'hard t 'rear-nonsticky '(hard))
+ "Propertized string representing a hard newline character.")
+
+(defun newline (&optional arg interactive)
+ "Insert a newline, and move to left margin of the new line if it's blank.
+If option `use-hard-newlines' is non-nil, the newline is marked with the
+text-property `hard'.
+With ARG, insert that many newlines.
+
+If `electric-indent-mode' is enabled, this indents the final new line
+that it adds, and reindents the preceding line. To just insert
+a newline, use \\[electric-indent-just-newline].
+
+Calls `auto-fill-function' if the current column number is greater
+than the value of `fill-column' and ARG is nil.
+A non-nil INTERACTIVE argument means to run the `post-self-insert-hook'."
+ (interactive "*P\np")
+ (barf-if-buffer-read-only)
+ ;; Call self-insert so that auto-fill, abbrev expansion etc. happens.
+ ;; Set last-command-event to tell self-insert what to insert.
+ (let* ((was-page-start (and (bolp) (looking-at page-delimiter)))
+ (beforepos (point))
+ (last-command-event ?\n)
+ ;; Don't auto-fill if we have a numeric argument.
+ (auto-fill-function (if arg nil auto-fill-function))
+ (postproc
+ ;; Do the rest in post-self-insert-hook, because we want to do it
+ ;; *before* other functions on that hook.
+ (lambda ()
+ (cl-assert (eq ?\n (char-before)))
+ ;; Mark the newline(s) `hard'.
+ (if use-hard-newlines
+ (set-hard-newline-properties
+ (- (point) (prefix-numeric-value arg)) (point)))
+ ;; If the newline leaves the previous line blank, and we
+ ;; have a left margin, delete that from the blank line.
+ (save-excursion
+ (goto-char beforepos)
+ (beginning-of-line)
+ (and (looking-at "[ \t]$")
+ (> (current-left-margin) 0)
+ (delete-region (point)
+ (line-end-position))))
+ ;; Indent the line after the newline, except in one case:
+ ;; when we added the newline at the beginning of a line which
+ ;; starts a page.
+ (or was-page-start
+ (move-to-left-margin nil t)))))
+ (unwind-protect
+ (if (not interactive)
+ ;; FIXME: For non-interactive uses, many calls actually just want
+ ;; (insert "\n"), so maybe we should do just that, so as to avoid
+ ;; the risk of filling or running abbrevs unexpectedly.
+ (let ((post-self-insert-hook (list postproc)))
+ (self-insert-command (prefix-numeric-value arg)))
+ (unwind-protect
+ (progn
+ (add-hook 'post-self-insert-hook postproc nil t)
+ (self-insert-command (prefix-numeric-value arg)))
+ ;; We first used let-binding to protect the hook, but that was naive
+ ;; since add-hook affects the symbol-default value of the variable,
+ ;; whereas the let-binding might only protect the buffer-local value.
+ (remove-hook 'post-self-insert-hook postproc t)))
+ (cl-assert (not (member postproc post-self-insert-hook)))
+ (cl-assert (not (member postproc (default-value
'post-self-insert-hook))))))
+ nil)
+
+(defun set-hard-newline-properties (from to)
+ (let ((sticky (get-text-property from 'rear-nonsticky)))
+ (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)))))
+
+(defun open-line (n)
+ "Insert a newline and leave point before it.
+If there is a fill prefix and/or a `left-margin', insert them
+on the new line if the line would have been blank.
+With arg N, insert N newlines."
+ (interactive "*p")
+ (let* ((do-fill-prefix (and fill-prefix (bolp)))
+ (do-left-margin (and (bolp) (> (current-left-margin) 0)))
+ (loc (point-marker))
+ ;; Don't expand an abbrev before point.
+ (abbrev-mode nil))
+ (newline n)
+ (goto-char loc)
+ (while (> n 0)
+ (cond ((bolp)
+ (if do-left-margin (indent-to (current-left-margin)))
+ (if do-fill-prefix (insert-and-inherit fill-prefix))))
+ (forward-line 1)
+ (setq n (1- n)))
+ (goto-char loc)
+ (end-of-line)))
+
+(defun split-line (&optional arg)
+ "Split current line, moving portion beyond point vertically down.
+If the current line starts with `fill-prefix', insert it on the new
+line as well. With prefix ARG, don't insert `fill-prefix' on new line.
+
+When called from Lisp code, ARG may be a prefix string to copy."
+ (interactive "*P")
+ (skip-chars-forward " \t")
+ (let* ((col (current-column))
+ (pos (point))
+ ;; What prefix should we check for (nil means don't).
+ (prefix (cond ((stringp arg) arg)
+ (arg nil)
+ (t fill-prefix)))
+ ;; Does this line start with it?
+ (have-prfx (and prefix
+ (save-excursion
+ (beginning-of-line)
+ (looking-at (regexp-quote prefix))))))
+ (newline 1)
+ (if have-prfx (insert-and-inherit prefix))
+ (indent-to col 0)
+ (goto-char pos)))
+
+(defun delete-indentation (&optional arg)
+ "Join this line to previous and fix up whitespace at join.
+If there is a fill prefix, delete it from the beginning of this line.
+With argument, join this line to following line."
+ (interactive "*P")
+ (beginning-of-line)
+ (if arg (forward-line 1))
+ (if (eq (preceding-char) ?\n)
+ (progn
+ (delete-region (point) (1- (point)))
+ ;; If the second line started with the fill prefix,
+ ;; delete the prefix.
+ (if (and fill-prefix
+ (<= (+ (point) (length fill-prefix)) (point-max))
+ (string= fill-prefix
+ (buffer-substring (point)
+ (+ (point) (length fill-prefix)))))
+ (delete-region (point) (+ (point) (length fill-prefix))))
+ (fixup-whitespace))))
+
+(defalias 'join-line #'delete-indentation) ; easier to find
+
+(defun delete-blank-lines ()
+ "On blank line, delete all surrounding blank lines, leaving just one.
+On isolated blank line, delete that one.
+On nonblank line, delete any immediately following blank lines."
+ (interactive "*")
+ (let (thisblank singleblank)
+ (save-excursion
+ (beginning-of-line)
+ (setq thisblank (looking-at "[ \t]*$"))
+ ;; Set singleblank if there is just one blank line here.
+ (setq singleblank
+ (and thisblank
+ (not (looking-at "[ \t]*\n[ \t]*$"))
+ (or (bobp)
+ (progn (forward-line -1)
+ (not (looking-at "[ \t]*$")))))))
+ ;; Delete preceding blank lines, and this one too if it's the only one.
+ (if thisblank
+ (progn
+ (beginning-of-line)
+ (if singleblank (forward-line 1))
+ (delete-region (point)
+ (if (re-search-backward "[^ \t\n]" nil t)
+ (progn (forward-line 1) (point))
+ (point-min)))))
+ ;; Delete following blank lines, unless the current line is blank
+ ;; and there are no following blank lines.
+ (if (not (and thisblank singleblank))
+ (save-excursion
+ (end-of-line)
+ (forward-line 1)
+ (delete-region (point)
+ (if (re-search-forward "[^ \t\n]" nil t)
+ (progn (beginning-of-line) (point))
+ (point-max)))))
+ ;; Handle the special case where point is followed by newline and eob.
+ ;; Delete the line, leaving point at eob.
+ (if (looking-at "^[ \t]*\n\\'")
+ (delete-region (point) (point-max)))))
+
+(defcustom delete-trailing-lines t
+ "If non-nil, \\[delete-trailing-whitespace] deletes trailing lines.
+Trailing lines are deleted only if `delete-trailing-whitespace'
+is called on the entire buffer (rather than an active region)."
+ :type 'boolean
+ :group 'editing
+ :version "24.3")
+
+(defun delete-trailing-whitespace (&optional start end)
+ "Delete trailing whitespace between START and END.
+If called interactively, START and END are the start/end of the
+region if the mark is active, or of the buffer's accessible
+portion if the mark is inactive.
+
+This command deletes whitespace characters after the last
+non-whitespace character in each line between START and END. It
+does not consider formfeed characters to be whitespace.
+
+If this command acts on the entire buffer (i.e. if called
+interactively with the mark inactive, or called from Lisp with
+END nil), it also deletes all trailing lines at the end of the
+buffer if the variable `delete-trailing-lines' is non-nil."
+ (interactive (progn
+ (barf-if-buffer-read-only)
+ (if (use-region-p)
+ (list (region-beginning) (region-end))
+ (list nil nil))))
+ (save-match-data
+ (save-excursion
+ (let ((end-marker (copy-marker (or end (point-max))))
+ (start (or start (point-min))))
+ (goto-char start)
+ (while (re-search-forward "\\s-$" end-marker t)
+ (skip-syntax-backward "-" (line-beginning-position))
+ ;; Don't delete formfeeds, even if they are considered whitespace.
+ (if (looking-at-p ".*\f")
+ (goto-char (match-end 0)))
+ (delete-region (point) (match-end 0)))
+ ;; Delete trailing empty lines.
+ (goto-char end-marker)
+ (when (and (not end)
+ delete-trailing-lines
+ ;; Really the end of buffer.
+ (= (point-max) (1+ (buffer-size)))
+ (<= (skip-chars-backward "\n") -2))
+ (delete-region (1+ (point)) end-marker))
+ (set-marker end-marker nil))))
+ ;; Return nil for the benefit of `write-file-functions'.
+ nil)
+
+(defun newline-and-indent ()
+ "Insert a newline, then indent according to major mode.
+Indentation is done using the value of `indent-line-function'.
+In programming language modes, this is the same as TAB.
+In some text modes, where TAB inserts a tab, this command indents to the
+column specified by the function `current-left-margin'."
+ (interactive "*")
+ (delete-horizontal-space t)
+ (newline nil t)
+ (indent-according-to-mode))
+
+(defun reindent-then-newline-and-indent ()
+ "Reindent current line, insert newline, then indent the new line.
+Indentation of both lines is done according to the current major mode,
+which means calling the current value of `indent-line-function'.
+In programming language modes, this is the same as TAB.
+In some text modes, where TAB inserts a tab, this indents to the
+column specified by the function `current-left-margin'."
+ (interactive "*")
+ (let ((pos (point)))
+ ;; Be careful to insert the newline before indenting the line.
+ ;; Otherwise, the indentation might be wrong.
+ (newline)
+ (save-excursion
+ (goto-char pos)
+ ;; We are at EOL before the call to indent-according-to-mode, and
+ ;; after it we usually are as well, but not always. We tried to
+ ;; address it with `save-excursion' but that uses a normal marker
+ ;; whereas we need `move after insertion', so we do the save/restore
+ ;; by hand.
+ (setq pos (copy-marker pos t))
+ (indent-according-to-mode)
+ (goto-char pos)
+ ;; Remove the trailing white-space after indentation because
+ ;; indentation may introduce the whitespace.
+ (delete-horizontal-space t))
+ (indent-according-to-mode)))
+
+(defcustom read-quoted-char-radix 8
+ "Radix for \\[quoted-insert] and other uses of `read-quoted-char'.
+Legitimate radix values are 8, 10 and 16."
+ :type '(choice (const 8) (const 10) (const 16))
+ :group 'editing-basics)
+
+(defun read-quoted-char (&optional prompt)
+ "Like `read-char', but do not allow quitting.
+Also, if the first character read is an octal digit,
+we read any number of octal digits and return the
+specified character code. Any nondigit terminates the sequence.
+If the terminator is RET, it is discarded;
+any other terminator is used itself as input.
+
+The optional argument PROMPT specifies a string to use to prompt the user.
+The variable `read-quoted-char-radix' controls which radix to use
+for numeric input."
+ (let ((message-log-max nil)
+ (help-events (delq nil (mapcar (lambda (c) (unless (characterp c) c))
+ help-event-list)))
+ done (first t) (code 0) translated)
+ (while (not done)
+ (let ((inhibit-quit first)
+ ;; Don't let C-h or other help chars get the help
+ ;; message--only help function keys. See bug#16617.
+ (help-char nil)
+ (help-event-list help-events)
+ (help-form
+ "Type the special character you want to use,
+or the octal character code.
+RET terminates the character code and is discarded;
+any other non-digit terminates the character code and is then used as input."))
+ (setq translated (read-key (and prompt (format "%s-" prompt))))
+ (if inhibit-quit (setq quit-flag nil)))
+ (if (integerp translated)
+ (setq translated (char-resolve-modifiers translated)))
+ (cond ((null translated))
+ ((not (integerp translated))
+ (setq unread-command-events
+ (listify-key-sequence (this-single-command-raw-keys))
+ done t))
+ ((/= (logand translated ?\M-\^@) 0)
+ ;; Turn a meta-character into a character with the 0200 bit set.
+ (setq code (logior (logand translated (lognot ?\M-\^@)) 128)
+ done t))
+ ((and (<= ?0 translated)
+ (< translated (+ ?0 (min 10 read-quoted-char-radix))))
+ (setq code (+ (* code read-quoted-char-radix) (- translated ?0)))
+ (and prompt (setq prompt (message "%s %c" prompt translated))))
+ ((and (<= ?a (downcase translated))
+ (< (downcase translated)
+ (+ ?a -10 (min 36 read-quoted-char-radix))))
+ (setq code (+ (* code read-quoted-char-radix)
+ (+ 10 (- (downcase translated) ?a))))
+ (and prompt (setq prompt (message "%s %c" prompt translated))))
+ ((and (not first) (eq translated ?\C-m))
+ (setq done t))
+ ((not first)
+ (setq unread-command-events
+ (listify-key-sequence (this-single-command-raw-keys))
+ done t))
+ (t (setq code translated
+ done t)))
+ (setq first nil))
+ code))
+
+(defun quoted-insert (arg)
+ "Read next input character and insert it.
+This is useful for inserting control characters.
+With argument, insert ARG copies of the character.
+
+If the first character you type after this command is an octal digit,
+you should type a sequence of octal digits which specify a character code.
+Any nondigit terminates the sequence. If the terminator is a RET,
+it is discarded; any other terminator is used itself as input.
+The variable `read-quoted-char-radix' specifies the radix for this feature;
+set it to 10 or 16 to use decimal or hex instead of octal.
+
+In overwrite mode, this function inserts the character anyway, and
+does not handle octal digits specially. This means that if you use
+overwrite as your normal editing mode, you can use this function to
+insert characters when necessary.
+
+In binary overwrite mode, this function does overwrite, and octal
+digits are interpreted as a character code. This is intended to be
+useful for editing binary files."
+ (interactive "*p")
+ (let* ((char
+ ;; Avoid "obsolete" warnings for translation-table-for-input.
+ (with-no-warnings
+ (let (translation-table-for-input input-method-function)
+ (if (or (not overwrite-mode)
+ (eq overwrite-mode 'overwrite-mode-binary))
+ (read-quoted-char)
+ (read-char))))))
+ ;; This used to assume character codes 0240 - 0377 stand for
+ ;; characters in some single-byte character set, and converted them
+ ;; to Emacs characters. But in 23.1 this feature is deprecated
+ ;; in favor of inserting the corresponding Unicode characters.
+ ;; (if (and enable-multibyte-characters
+ ;; (>= char ?\240)
+ ;; (<= char ?\377))
+ ;; (setq char (unibyte-char-to-multibyte char)))
+ (unless (characterp char)
+ (user-error "%s is not a valid character"
+ (key-description (vector char))))
+ (if (> arg 0)
+ (if (eq overwrite-mode 'overwrite-mode-binary)
+ (delete-char arg)))
+ (while (> arg 0)
+ (insert-and-inherit char)
+ (setq arg (1- arg)))))
+
+(defun forward-to-indentation (&optional arg)
+ "Move forward ARG lines and position at first nonblank character."
+ (interactive "^p")
+ (forward-line (or arg 1))
+ (skip-chars-forward " \t"))
+
+(defun backward-to-indentation (&optional arg)
+ "Move backward ARG lines and position at first nonblank character."
+ (interactive "^p")
+ (forward-line (- (or arg 1)))
+ (skip-chars-forward " \t"))
+
+(defun back-to-indentation ()
+ "Move point to the first non-whitespace character on this line."
+ (interactive "^")
+ (beginning-of-line 1)
+ (skip-syntax-forward " " (line-end-position))
+ ;; Move back over chars that have whitespace syntax but have the p flag.
+ (backward-prefix-chars))
+
+(defun fixup-whitespace ()
+ "Fixup white space between objects around point.
+Leave one space or none, according to the context."
+ (interactive "*")
+ (save-excursion
+ (delete-horizontal-space)
+ (if (or (looking-at "^\\|\\s)")
+ (save-excursion (forward-char -1)
+ (looking-at "$\\|\\s(\\|\\s'")))
+ nil
+ (insert ?\s))))
+
+(defun delete-horizontal-space (&optional backward-only)
+ "Delete all spaces and tabs around point.
+If BACKWARD-ONLY is non-nil, only delete them before point."
+ (interactive "*P")
+ (let ((orig-pos (point)))
+ (delete-region
+ (if backward-only
+ orig-pos
+ (progn
+ (skip-chars-forward " \t")
+ (constrain-to-field nil orig-pos t)))
+ (progn
+ (skip-chars-backward " \t")
+ (constrain-to-field nil orig-pos)))))
+
+(defun just-one-space (&optional n)
+ "Delete all spaces and tabs around point, leaving one space (or N spaces).
+If N is negative, delete newlines as well, leaving -N spaces.
+See also `cycle-spacing'."
+ (interactive "*p")
+ (cycle-spacing n nil t))
+
+(defvar cycle-spacing--context nil
+ "Store context used in consecutive calls to `cycle-spacing' command.
+The first time this function is run, it saves the original point
+position and original spacing around the point in this
+variable.")
+
+(defun cycle-spacing (&optional n preserve-nl-back single-shot)
+ "Manipulate whitespace around point in a smart way.
+In interactive use, this function behaves differently in successive
+consecutive calls.
+
+The first call in a sequence acts like `just-one-space'.
+It deletes all spaces and tabs around point, leaving one space
+\(or N spaces). N is the prefix argument. If N is negative,
+it deletes newlines as well, leaving -N spaces.
+\(If PRESERVE-NL-BACK is non-nil, it does not delete newlines before point.)
+
+The second call in a sequence (or the first call if the above does
+not result in any changes) deletes all spaces.
+
+The third call in a sequence restores the original whitespace (and point).
+
+If SINGLE-SHOT is non-nil, it only performs the first step in the sequence."
+ (interactive "*p")
+ (let ((orig-pos (point))
+ (skip-characters (if (and n (< n 0)) " \t\n\r" " \t"))
+ (n (abs (or n 1))))
+ (skip-chars-backward (if preserve-nl-back " \t" skip-characters))
+ (constrain-to-field nil orig-pos)
+ (cond
+ ;; Command run for the first time or single-shot is non-nil.
+ ((or single-shot
+ (not (equal last-command this-command))
+ (not cycle-spacing--context))
+ (let* ((start (point))
+ (n (- n (skip-chars-forward " " (+ n (point)))))
+ (mid (point))
+ (end (progn
+ (skip-chars-forward skip-characters)
+ (constrain-to-field nil orig-pos t))))
+ (setq cycle-spacing--context ;; Save for later.
+ ;; Special handling for case where there was no space at all.
+ (unless (= start end)
+ (cons orig-pos (buffer-substring start (point)))))
+ ;; If this run causes no change in buffer content, delete all spaces,
+ ;; otherwise delete all excess spaces.
+ (delete-region (if (and (not single-shot) (zerop n) (= mid end))
+ start mid) end)
+ (insert (make-string n ?\s))))
+
+ ;; Command run for the second time.
+ ((not (equal orig-pos (point)))
+ (delete-region (point) orig-pos))
+
+ ;; Command run for the third time.
+ (t
+ (insert (cdr cycle-spacing--context))
+ (goto-char (car cycle-spacing--context))
+ (setq cycle-spacing--context nil)))))
+
+(defun beginning-of-buffer (&optional arg)
+ "Move point to the beginning of the buffer.
+With numeric arg N, put point N/10 of the way from the beginning.
+If the buffer is narrowed, this command uses the beginning of the
+accessible part of the buffer.
+
+If Transient Mark mode is disabled, leave mark at previous
+position, unless a \\[universal-argument] prefix is supplied.
+
+Don't use this command in Lisp programs!
+\(goto-char (point-min)) is faster."
+ (interactive "^P")
+ (or (consp arg)
+ (region-active-p)
+ (push-mark))
+ (let ((size (- (point-max) (point-min))))
+ (goto-char (if (and arg (not (consp arg)))
+ (+ (point-min)
+ (if (> size 10000)
+ ;; Avoid overflow for large buffer sizes!
+ (* (prefix-numeric-value arg)
+ (/ size 10))
+ (/ (+ 10 (* size (prefix-numeric-value arg))) 10)))
+ (point-min))))
+ (if (and arg (not (consp arg))) (forward-line 1)))
+(put 'beginning-of-buffer 'interactive-only
+ "use `(goto-char (point-min))' instead.")
+
+(defun end-of-buffer (&optional arg)
+ "Move point to the end of the buffer.
+With numeric arg N, put point N/10 of the way from the end.
+If the buffer is narrowed, this command uses the end of the
+accessible part of the buffer.
+
+If Transient Mark mode is disabled, leave mark at previous
+position, unless a \\[universal-argument] prefix is supplied.
+
+Don't use this command in Lisp programs!
+\(goto-char (point-max)) is faster."
+ (interactive "^P")
+ (or (consp arg) (region-active-p) (push-mark))
+ (let ((size (- (point-max) (point-min))))
+ (goto-char (if (and arg (not (consp arg)))
+ (- (point-max)
+ (if (> size 10000)
+ ;; Avoid overflow for large buffer sizes!
+ (* (prefix-numeric-value arg)
+ (/ size 10))
+ (/ (* size (prefix-numeric-value arg)) 10)))
+ (point-max))))
+ ;; If we went to a place in the middle of the buffer,
+ ;; adjust it to the beginning of a line.
+ (cond ((and arg (not (consp arg))) (forward-line 1))
+ ((and (eq (current-buffer) (window-buffer))
+ (> (point) (window-end nil t)))
+ ;; If the end of the buffer is not already on the screen,
+ ;; then scroll specially to put it near, but not at, the bottom.
+ (overlay-recenter (point))
+ (recenter -3))))
+(put 'end-of-buffer 'interactive-only "use `(goto-char (point-max))' instead.")
+
+(defcustom delete-active-region t
+ "Whether single-char deletion commands delete an active region.
+This has an effect only if Transient Mark mode is enabled, and
+affects `delete-forward-char' and `delete-backward-char', though
+not `delete-char'.
+
+If the value is the symbol `kill', the active region is killed
+instead of deleted."
+ :type '(choice (const :tag "Delete active region" t)
+ (const :tag "Kill active region" kill)
+ (const :tag "Do ordinary deletion" nil))
+ :group 'killing
+ :version "24.1")
+
+(defvar region-extract-function
+ (lambda (delete)
+ (when (region-beginning)
+ (if (eq delete 'delete-only)
+ (delete-region (region-beginning) (region-end))
+ (filter-buffer-substring (region-beginning) (region-end) delete))))
+ "Function to get the region's content.
+Called with one argument DELETE.
+If DELETE is `delete-only', then only delete the region and the return value
+is undefined. If DELETE is nil, just return the content as a string.
+If anything else, delete the region and return its content as a string.")
+
+(defun delete-backward-char (n &optional killflag)
+ "Delete the previous N characters (following if N is negative).
+If Transient Mark mode is enabled, the mark is active, and N is 1,
+delete the text in the region and deactivate the mark instead.
+To disable this, set option `delete-active-region' to nil.
+
+Optional second arg KILLFLAG, if non-nil, means to kill (save in
+kill ring) instead of delete. Interactively, N is the prefix
+arg, and KILLFLAG is set if N is explicitly specified.
+
+In Overwrite mode, single character backward deletion may replace
+tabs with spaces so as to back over columns, unless point is at
+the end of the line."
+ (interactive "p\nP")
+ (unless (integerp n)
+ (signal 'wrong-type-argument (list 'integerp n)))
+ (cond ((and (use-region-p)
+ delete-active-region
+ (= n 1))
+ ;; If a region is active, kill or delete it.
+ (if (eq delete-active-region 'kill)
+ (kill-region (region-beginning) (region-end) 'region)
+ (funcall region-extract-function 'delete-only)))
+ ;; In Overwrite mode, maybe untabify while deleting
+ ((null (or (null overwrite-mode)
+ (<= n 0)
+ (memq (char-before) '(?\t ?\n))
+ (eobp)
+ (eq (char-after) ?\n)))
+ (let ((ocol (current-column)))
+ (delete-char (- n) killflag)
+ (save-excursion
+ (insert-char ?\s (- ocol (current-column)) nil))))
+ ;; Otherwise, do simple deletion.
+ (t (delete-char (- n) killflag))))
+(put 'delete-backward-char 'interactive-only 'delete-char)
+
+(defun delete-forward-char (n &optional killflag)
+ "Delete the following N characters (previous if N is negative).
+If Transient Mark mode is enabled, the mark is active, and N is 1,
+delete the text in the region and deactivate the mark instead.
+To disable this, set variable `delete-active-region' to nil.
+
+Optional second arg KILLFLAG non-nil means to kill (save in kill
+ring) instead of delete. Interactively, N is the prefix arg, and
+KILLFLAG is set if N was explicitly specified."
+ (interactive "p\nP")
+ (unless (integerp n)
+ (signal 'wrong-type-argument (list 'integerp n)))
+ (cond ((and (use-region-p)
+ delete-active-region
+ (= n 1))
+ ;; If a region is active, kill or delete it.
+ (if (eq delete-active-region 'kill)
+ (kill-region (region-beginning) (region-end) 'region)
+ (funcall region-extract-function 'delete-only)))
+
+ ;; Otherwise, do simple deletion.
+ (t (delete-char n killflag))))
+(put 'delete-forward-char 'interactive-only 'delete-char)
+
+(defun mark-whole-buffer ()
+ "Put point at beginning and mark at end of buffer.
+If narrowing is in effect, only uses the accessible part of the buffer.
+You probably should not use this function in Lisp programs;
+it is usually a mistake for a Lisp function to use any subroutine
+that uses or sets the mark."
+ (interactive)
+ (push-mark (point))
+ (push-mark (point-max) nil t)
+ (goto-char (point-min)))
+
+
+;; Counting lines, one way or another.
+
+(defun goto-line (line &optional buffer)
+ "Go to LINE, counting from line 1 at beginning of buffer.
+If called interactively, a numeric prefix argument specifies
+LINE; without a numeric prefix argument, read LINE from the
+minibuffer.
+
+If optional argument BUFFER is non-nil, switch to that buffer and
+move to line LINE there. If called interactively with \\[universal-argument]
+as argument, BUFFER is the most recently selected other buffer.
+
+Prior to moving point, this function sets the mark (without
+activating it), unless Transient Mark mode is enabled and the
+mark is already active.
+
+This function is usually the wrong thing to use in a Lisp program.
+What you probably want instead is something like:
+ (goto-char (point-min))
+ (forward-line (1- N))
+If at all possible, an even better solution is to use char counts
+rather than line counts."
+ (interactive
+ (if (and current-prefix-arg (not (consp current-prefix-arg)))
+ (list (prefix-numeric-value current-prefix-arg))
+ ;; Look for a default, a number in the buffer at point.
+ (let* ((default
+ (save-excursion
+ (skip-chars-backward "0-9")
+ (if (looking-at "[0-9]")
+ (string-to-number
+ (buffer-substring-no-properties
+ (point)
+ (progn (skip-chars-forward "0-9")
+ (point)))))))
+ ;; Decide if we're switching buffers.
+ (buffer
+ (if (consp current-prefix-arg)
+ (other-buffer (current-buffer) t)))
+ (buffer-prompt
+ (if buffer
+ (concat " in " (buffer-name buffer))
+ "")))
+ ;; Read the argument, offering that number (if any) as default.
+ (list (read-number (format "Goto line%s: " buffer-prompt)
+ (list default (line-number-at-pos)))
+ buffer))))
+ ;; Switch to the desired buffer, one way or another.
+ (if buffer
+ (let ((window (get-buffer-window buffer)))
+ (if window (select-window window)
+ (switch-to-buffer-other-window buffer))))
+ ;; Leave mark at previous position
+ (or (region-active-p) (push-mark))
+ ;; Move to the specified line number in that buffer.
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (if (eq selective-display t)
+ (re-search-forward "[\n\C-m]" nil 'end (1- line))
+ (forward-line (1- line)))))
+(put 'goto-line 'interactive-only 'forward-line)
+
+(defun count-words-region (start end &optional arg)
+ "Count the number of words in the region.
+If called interactively, print a message reporting the number of
+lines, words, and characters in the region (whether or not the
+region is active); with prefix ARG, report for the entire buffer
+rather than the region.
+
+If called from Lisp, return the number of words between positions
+START and END."
+ (interactive (if current-prefix-arg
+ (list nil nil current-prefix-arg)
+ (list (region-beginning) (region-end) nil)))
+ (cond ((not (called-interactively-p 'any))
+ (count-words start end))
+ (arg
+ (count-words--buffer-message))
+ (t
+ (count-words--message "Region" start end))))
+
+(defun count-words (start end)
+ "Count words between START and END.
+If called interactively, START and END are normally the start and
+end of the buffer; but if the region is active, START and END are
+the start and end of the region. Print a message reporting the
+number of lines, words, and chars.
+
+If called from Lisp, return the number of words between START and
+END, without printing any message."
+ (interactive (list nil nil))
+ (cond ((not (called-interactively-p 'any))
+ (let ((words 0))
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char (point-min))
+ (while (forward-word 1)
+ (setq words (1+ words)))))
+ words))
+ ((use-region-p)
+ (call-interactively 'count-words-region))
+ (t
+ (count-words--buffer-message))))
+
+(defun count-words--buffer-message ()
+ (count-words--message
+ (if (buffer-narrowed-p) "Narrowed part of buffer" "Buffer")
+ (point-min) (point-max)))
+
+(defun count-words--message (str start end)
+ (let ((lines (count-lines start end))
+ (words (count-words start end))
+ (chars (- end start)))
+ (message "%s has %d line%s, %d word%s, and %d character%s."
+ str
+ lines (if (= lines 1) "" "s")
+ words (if (= words 1) "" "s")
+ chars (if (= chars 1) "" "s"))))
+
+(define-obsolete-function-alias 'count-lines-region 'count-words-region "24.1")
+
+(defun what-line ()
+ "Print the current buffer line number and narrowed line number of point."
+ (interactive)
+ (let ((start (point-min))
+ (n (line-number-at-pos)))
+ (if (= start 1)
+ (message "Line %d" n)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (message "line %d (narrowed line %d)"
+ (+ n (line-number-at-pos start) -1) n))))))
+
+(defun count-lines (start end)
+ "Return number of lines between START and END.
+This is usually the number of newlines between them,
+but can be one more if START is not equal to END
+and the greater of them is not at the start of a line."
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char (point-min))
+ (if (eq selective-display t)
+ (save-match-data
+ (let ((done 0))
+ (while (re-search-forward "[\n\C-m]" nil t 40)
+ (setq done (+ 40 done)))
+ (while (re-search-forward "[\n\C-m]" nil t 1)
+ (setq done (+ 1 done)))
+ (goto-char (point-max))
+ (if (and (/= start end)
+ (not (bolp)))
+ (1+ done)
+ done)))
+ (- (buffer-size) (forward-line (buffer-size)))))))
+
+(defun line-number-at-pos (&optional pos)
+ "Return (narrowed) buffer line number at position POS.
+If POS is nil, use current buffer location.
+Counting starts at (point-min), so the value refers
+to the contents of the accessible portion of the buffer."
+ (let ((opoint (or pos (point))) start)
+ (save-excursion
+ (goto-char (point-min))
+ (setq start (point))
+ (goto-char opoint)
+ (forward-line 0)
+ (1+ (count-lines start (point))))))
+
+(defun what-cursor-position (&optional detail)
+ "Print info on cursor position (on screen and within buffer).
+Also describe the character after point, and give its character code
+in octal, decimal and hex.
+
+For a non-ASCII multibyte character, also give its encoding in the
+buffer's selected coding system if the coding system encodes the
+character safely. If the character is encoded into one byte, that
+code is shown in hex. If the character is encoded into more than one
+byte, just \"...\" is shown.
+
+In addition, with prefix argument, show details about that character
+in *Help* buffer. See also the command `describe-char'."
+ (interactive "P")
+ (let* ((char (following-char))
+ (bidi-fixer
+ (cond ((memq char '(?\x202a ?\x202b ?\x202d ?\x202e))
+ ;; If the character is one of LRE, LRO, RLE, RLO, it
+ ;; will start a directional embedding, which could
+ ;; completely disrupt the rest of the line (e.g., RLO
+ ;; will display the rest of the line right-to-left).
+ ;; So we put an invisible PDF character after these
+ ;; characters, to end the embedding, which eliminates
+ ;; any effects on the rest of the line.
+ (propertize (string ?\x202c) 'invisible t))
+ ;; Strong right-to-left characters cause reordering of
+ ;; the following numerical characters which show the
+ ;; codepoint, so append LRM to countermand that.
+ ((memq (get-char-code-property char 'bidi-class) '(R AL))
+ (propertize (string ?\x200e) 'invisible t))
+ (t
+ "")))
+ (beg (point-min))
+ (end (point-max))
+ (pos (point))
+ (total (buffer-size))
+ (percent (if (> total 50000)
+ ;; Avoid overflow from multiplying by 100!
+ (/ (+ (/ total 200) (1- pos)) (max (/ total 100) 1))
+ (/ (+ (/ total 2) (* 100 (1- pos))) (max total 1))))
+ (hscroll (if (= (window-hscroll) 0)
+ ""
+ (format " Hscroll=%d" (window-hscroll))))
+ (col (current-column)))
+ (if (= pos end)
+ (if (or (/= beg 1) (/= end (1+ total)))
+ (message "point=%d of %d (%d%%) <%d-%d> column=%d%s"
+ pos total percent beg end col hscroll)
+ (message "point=%d of %d (EOB) column=%d%s"
+ pos total col hscroll))
+ (let ((coding buffer-file-coding-system)
+ encoded encoding-msg display-prop under-display)
+ (if (or (not coding)
+ (eq (coding-system-type coding) t))
+ (setq coding (default-value 'buffer-file-coding-system)))
+ (if (eq (char-charset char) 'eight-bit)
+ (setq encoding-msg
+ (format "(%d, #o%o, #x%x, raw-byte)" char char char))
+ ;; Check if the character is displayed with some `display'
+ ;; text property. In that case, set under-display to the
+ ;; buffer substring covered by that property.
+ (setq display-prop (get-char-property pos 'display))
+ (if display-prop
+ (let ((to (or (next-single-char-property-change pos 'display)
+ (point-max))))
+ (if (< to (+ pos 4))
+ (setq under-display "")
+ (setq under-display "..."
+ to (+ pos 4)))
+ (setq under-display
+ (concat (buffer-substring-no-properties pos to)
+ under-display)))
+ (setq encoded (and (>= char 128) (encode-coding-char char coding))))
+ (setq encoding-msg
+ (if display-prop
+ (if (not (stringp display-prop))
+ (format "(%d, #o%o, #x%x, part of display \"%s\")"
+ char char char under-display)
+ (format "(%d, #o%o, #x%x, part of display \"%s\"->\"%s\")"
+ char char char under-display display-prop))
+ (if encoded
+ (format "(%d, #o%o, #x%x, file %s)"
+ char char char
+ (if (> (length encoded) 1)
+ "..."
+ (encoded-string-description encoded coding)))
+ (format "(%d, #o%o, #x%x)" char char char)))))
+ (if detail
+ ;; We show the detailed information about CHAR.
+ (describe-char (point)))
+ (if (or (/= beg 1) (/= end (1+ total)))
+ (message "Char: %s%s %s point=%d of %d (%d%%) <%d-%d> column=%d%s"
+ (if (< char 256)
+ (single-key-description char)
+ (buffer-substring-no-properties (point) (1+ (point))))
+ bidi-fixer
+ encoding-msg pos total percent beg end col hscroll)
+ (message "Char: %s%s %s point=%d of %d (%d%%) column=%d%s"
+ (if enable-multibyte-characters
+ (if (< char 128)
+ (single-key-description char)
+ (buffer-substring-no-properties (point) (1+ (point))))
+ (single-key-description char))
+ bidi-fixer encoding-msg pos total percent col hscroll))))))
+
+;; Initialize read-expression-map. It is defined at C level.
+(defvar read-expression-map
+ (let ((m (make-sparse-keymap)))
+ (define-key m "\M-\t" 'completion-at-point)
+ ;; Might as well bind TAB to completion, since inserting a TAB char is
+ ;; much too rarely useful.
+ (define-key m "\t" 'completion-at-point)
+ (set-keymap-parent m minibuffer-local-map)
+ m))
+
+(defun read-minibuffer (prompt &optional initial-contents)
+ "Return a Lisp object read using the minibuffer, unevaluated.
+Prompt with PROMPT. If non-nil, optional second arg INITIAL-CONTENTS
+is a string to insert in the minibuffer before reading.
+\(INITIAL-CONTENTS can also be a cons of a string and an integer.
+Such arguments are used as in `read-from-minibuffer'.)"
+ ;; Used for interactive spec `x'.
+ (read-from-minibuffer prompt initial-contents minibuffer-local-map
+ t 'minibuffer-history))
+
+(defun eval-minibuffer (prompt &optional initial-contents)
+ "Return value of Lisp expression read using the minibuffer.
+Prompt with PROMPT. If non-nil, optional second arg INITIAL-CONTENTS
+is a string to insert in the minibuffer before reading.
+\(INITIAL-CONTENTS can also be a cons of a string and an integer.
+Such arguments are used as in `read-from-minibuffer'.)"
+ ;; Used for interactive spec `X'.
+ (eval (read--expression prompt initial-contents)))
+
+(defvar minibuffer-completing-symbol nil
+ "Non-nil means completing a Lisp symbol in the minibuffer.")
+(make-obsolete-variable 'minibuffer-completing-symbol nil "24.1" 'get)
+
+(defvar minibuffer-default nil
+ "The current default value or list of default values in the minibuffer.
+The functions `read-from-minibuffer' and `completing-read' bind
+this variable locally.")
+
+(defcustom eval-expression-print-level 4
+ "Value for `print-level' while printing value in `eval-expression'.
+A value of nil means no limit."
+ :group 'lisp
+ :type '(choice (const :tag "No Limit" nil) integer)
+ :version "21.1")
+
+(defcustom eval-expression-print-length 12
+ "Value for `print-length' while printing value in `eval-expression'.
+A value of nil means no limit."
+ :group 'lisp
+ :type '(choice (const :tag "No Limit" nil) integer)
+ :version "21.1")
+
+(defcustom eval-expression-debug-on-error t
+ "If non-nil set `debug-on-error' to t in `eval-expression'.
+If nil, don't change the value of `debug-on-error'."
+ :group 'lisp
+ :type 'boolean
+ :version "21.1")
+
+(defun eval-expression-print-format (value)
+ "Format VALUE as a result of evaluated expression.
+Return a formatted string which is displayed in the echo area
+in addition to the value printed by prin1 in functions which
+display the result of expression evaluation."
+ (if (and (integerp value)
+ (or (eq standard-output t)
+ (zerop (prefix-numeric-value current-prefix-arg))))
+ (let ((char-string
+ (if (and (characterp value)
+ (char-displayable-p value))
+ (prin1-char value))))
+ (if char-string
+ (format " (#o%o, #x%x, %s)" value value char-string)
+ (format " (#o%o, #x%x)" value value)))))
+
+(defvar eval-expression-minibuffer-setup-hook nil
+ "Hook run by `eval-expression' when entering the minibuffer.")
+
+(defun read--expression (prompt &optional initial-contents)
+ (let ((minibuffer-completing-symbol t))
+ (minibuffer-with-setup-hook
+ (lambda ()
+ (add-hook 'completion-at-point-functions
+ #'lisp-completion-at-point nil t)
+ (run-hooks 'eval-expression-minibuffer-setup-hook))
+ (read-from-minibuffer prompt initial-contents
+ read-expression-map t
+ 'read-expression-history))))
+
+;; We define this, rather than making `eval' interactive,
+;; for the sake of completion of names like eval-region, eval-buffer.
+(defun eval-expression (exp &optional insert-value)
+ "Evaluate EXP and print value in the echo area.
+When called interactively, read an Emacs Lisp expression and evaluate it.
+Value is also consed on to front of the variable `values'.
+Optional argument INSERT-VALUE non-nil (interactively, with prefix
+argument) means insert the result into the current buffer instead of
+printing it in the echo area.
+
+Normally, this function truncates long output according to the value
+of the variables `eval-expression-print-length' and
+`eval-expression-print-level'. With a prefix argument of zero,
+however, there is no such truncation. Such a prefix argument
+also causes integers to be printed in several additional formats
+\(octal, hexadecimal, and character).
+
+Runs the hook `eval-expression-minibuffer-setup-hook' on entering the
+minibuffer.
+
+If `eval-expression-debug-on-error' is non-nil, which is the default,
+this command arranges for all errors to enter the debugger."
+ (interactive
+ (list (read--expression "Eval: ")
+ current-prefix-arg))
+
+ (if (null eval-expression-debug-on-error)
+ (push (eval exp lexical-binding) values)
+ (let ((old-value (make-symbol "t")) new-value)
+ ;; Bind debug-on-error to something unique so that we can
+ ;; detect when evalled code changes it.
+ (let ((debug-on-error old-value))
+ (push (eval exp lexical-binding) values)
+ (setq new-value debug-on-error))
+ ;; If evalled code has changed the value of debug-on-error,
+ ;; propagate that change to the global binding.
+ (unless (eq old-value new-value)
+ (setq debug-on-error new-value))))
+
+ (let ((print-length (and (not (zerop (prefix-numeric-value insert-value)))
+ eval-expression-print-length))
+ (print-level (and (not (zerop (prefix-numeric-value insert-value)))
+ eval-expression-print-level))
+ (deactivate-mark))
+ (if insert-value
+ (with-no-warnings
+ (let ((standard-output (current-buffer)))
+ (prog1
+ (prin1 (car values))
+ (when (zerop (prefix-numeric-value insert-value))
+ (let ((str (eval-expression-print-format (car values))))
+ (if str (princ str)))))))
+ (prog1
+ (prin1 (car values) t)
+ (let ((str (eval-expression-print-format (car values))))
+ (if str (princ str t)))))))
+
+(defun edit-and-eval-command (prompt command)
+ "Prompting with PROMPT, let user edit COMMAND and eval result.
+COMMAND is a Lisp expression. Let user edit that expression in
+the minibuffer, then read and evaluate the result."
+ (let ((command
+ (let ((print-level nil)
+ (minibuffer-history-sexp-flag (1+ (minibuffer-depth))))
+ (unwind-protect
+ (read-from-minibuffer prompt
+ (prin1-to-string command)
+ read-expression-map t
+ 'command-history)
+ ;; If command was added to command-history as a string,
+ ;; get rid of that. We want only evaluable expressions there.
+ (if (stringp (car command-history))
+ (setq command-history (cdr command-history)))))))
+
+ ;; If command to be redone does not match front of history,
+ ;; add it to the history.
+ (or (equal command (car command-history))
+ (setq command-history (cons command command-history)))
+ (eval command)))
+
+(defun repeat-complex-command (arg)
+ "Edit and re-evaluate last complex command, or ARGth from last.
+A complex command is one which used the minibuffer.
+The command is placed in the minibuffer as a Lisp form for editing.
+The result is executed, repeating the command as changed.
+If the command has been changed or is not the most recent previous
+command it is added to the front of the command history.
+You can use the minibuffer history commands \
+\\<minibuffer-local-map>\\[next-history-element] and
\\[previous-history-element]
+to get different commands to edit and resubmit."
+ (interactive "p")
+ (let ((elt (nth (1- arg) command-history))
+ newcmd)
+ (if elt
+ (progn
+ (setq newcmd
+ (let ((print-level nil)
+ (minibuffer-history-position arg)
+ (minibuffer-history-sexp-flag (1+ (minibuffer-depth))))
+ (unwind-protect
+ (read-from-minibuffer
+ "Redo: " (prin1-to-string elt) read-expression-map t
+ (cons 'command-history arg))
+
+ ;; If command was added to command-history as a
+ ;; string, get rid of that. We want only
+ ;; evaluable expressions there.
+ (if (stringp (car command-history))
+ (setq command-history (cdr command-history))))))
+
+ ;; If command to be redone does not match front of history,
+ ;; add it to the history.
+ (or (equal newcmd (car command-history))
+ (setq command-history (cons newcmd command-history)))
+ (unwind-protect
+ (progn
+ ;; Trick called-interactively-p into thinking that `newcmd' is
+ ;; an interactive call (bug#14136).
+ (add-hook 'called-interactively-p-functions
+ #'repeat-complex-command--called-interactively-skip)
+ (eval newcmd))
+ (remove-hook 'called-interactively-p-functions
+ #'repeat-complex-command--called-interactively-skip)))
+ (if command-history
+ (error "Argument %d is beyond length of command history" arg)
+ (error "There are no previous complex commands to repeat")))))
+
+(defun repeat-complex-command--called-interactively-skip (i _frame1 frame2)
+ (and (eq 'eval (cadr frame2))
+ (eq 'repeat-complex-command
+ (cadr (backtrace-frame i #'called-interactively-p)))
+ 1))
+
+(defvar extended-command-history nil)
+
+(defun read-extended-command ()
+ "Read command name to invoke in `execute-extended-command'."
+ (minibuffer-with-setup-hook
+ (lambda ()
+ (set (make-local-variable 'minibuffer-default-add-function)
+ (lambda ()
+ ;; Get a command name at point in the original buffer
+ ;; to propose it after M-n.
+ (with-current-buffer (window-buffer (minibuffer-selected-window))
+ (and (commandp (function-called-at-point))
+ (format "%S" (function-called-at-point)))))))
+ ;; Read a string, completing from and restricting to the set of
+ ;; all defined commands. Don't provide any initial input.
+ ;; Save the command read on the extended-command history list.
+ (completing-read
+ (concat (cond
+ ((eq current-prefix-arg '-) "- ")
+ ((and (consp current-prefix-arg)
+ (eq (car current-prefix-arg) 4)) "C-u ")
+ ((and (consp current-prefix-arg)
+ (integerp (car current-prefix-arg)))
+ (format "%d " (car current-prefix-arg)))
+ ((integerp current-prefix-arg)
+ (format "%d " current-prefix-arg)))
+ ;; This isn't strictly correct if `execute-extended-command'
+ ;; is bound to anything else (e.g. [menu]).
+ ;; It could use (key-description (this-single-command-keys)),
+ ;; but actually a prompt other than "M-x" would be confusing,
+ ;; because "M-x" is a well-known prompt to read a command
+ ;; and it serves as a shorthand for "Extended command: ".
+ "M-x ")
+ obarray 'commandp t nil 'extended-command-history)))
+
+(defcustom suggest-key-bindings t
+ "Non-nil means show the equivalent key-binding when M-x command has one.
+The value can be a length of time to show the message for.
+If the value is non-nil and not a number, we wait 2 seconds."
+ :group 'keyboard
+ :type '(choice (const :tag "off" nil)
+ (integer :tag "time" 2)
+ (other :tag "on")))
+
+(defun execute-extended-command (prefixarg &optional command-name)
+ ;; Based on Fexecute_extended_command in keyboard.c of Emacs.
+ ;; Aaron S. Hawley <aaron.s.hawley(at)gmail.com> 2009-08-24
+ "Read a command name, then read the arguments and call the command.
+Interactively, to pass a prefix argument to the command you are
+invoking, give a prefix argument to `execute-extended-command'.
+Noninteractively, the argument PREFIXARG is the prefix argument to
+give to the command you invoke."
+ (interactive (list current-prefix-arg (read-extended-command)))
+ ;; Emacs<24 calling-convention was with a single `prefixarg' argument.
+ (if (null command-name)
+ (setq command-name (let ((current-prefix-arg prefixarg)) ; for prompt
+ (read-extended-command))))
+ (let* ((function (and (stringp command-name) (intern-soft command-name)))
+ (binding (and suggest-key-bindings
+ (not executing-kbd-macro)
+ (where-is-internal function overriding-local-map t))))
+ (unless (commandp function)
+ (error "`%s' is not a valid command name" command-name))
+ (setq this-command function)
+ ;; Normally `real-this-command' should never be changed, but here we really
+ ;; want to pretend that M-x <cmd> RET is nothing more than a "key
+ ;; binding" for <cmd>, so the command the user really wanted to run is
+ ;; `function' and not `execute-extended-command'. The difference is
+ ;; visible in cases such as M-x <cmd> RET and then C-x z (bug#11506).
+ (setq real-this-command function)
+ (let ((prefix-arg prefixarg))
+ (command-execute function 'record))
+ ;; If enabled, show which key runs this command.
+ (when binding
+ ;; But first wait, and skip the message if there is input.
+ (let* ((waited
+ ;; If this command displayed something in the echo area;
+ ;; wait a few seconds, then display our suggestion message.
+ (sit-for (cond
+ ((zerop (length (current-message))) 0)
+ ((numberp suggest-key-bindings) suggest-key-bindings)
+ (t 2)))))
+ (when (and waited (not (consp unread-command-events)))
+ (with-temp-message
+ (format "You can run the command `%s' with %s"
+ function (key-description binding))
+ (sit-for (if (numberp suggest-key-bindings)
+ suggest-key-bindings
+ 2))))))))
+
+(defun command-execute (cmd &optional record-flag keys special)
+ ;; BEWARE: Called directly from the C code.
+ "Execute CMD as an editor command.
+CMD must be a symbol that satisfies the `commandp' predicate.
+Optional second arg RECORD-FLAG non-nil
+means unconditionally put this command in the variable `command-history'.
+Otherwise, that is done only if an arg is read using the minibuffer.
+The argument KEYS specifies the value to use instead of (this-command-keys)
+when reading the arguments; if it is nil, (this-command-keys) is used.
+The argument SPECIAL, if non-nil, means that this command is executing
+a special event, so ignore the prefix argument and don't clear it."
+ (setq debug-on-next-call nil)
+ (let ((prefixarg (unless special
+ (prog1 prefix-arg
+ (setq current-prefix-arg prefix-arg)
+ (setq prefix-arg nil)))))
+ (if (and (symbolp cmd)
+ (get cmd 'disabled)
+ disabled-command-function)
+ ;; FIXME: Weird calling convention!
+ (run-hooks 'disabled-command-function)
+ (let ((final cmd))
+ (while
+ (progn
+ (setq final (indirect-function final))
+ (if (autoloadp final)
+ (setq final (autoload-do-load final cmd)))))
+ (cond
+ ((arrayp final)
+ ;; If requested, place the macro in the command history. For
+ ;; other sorts of commands, call-interactively takes care of this.
+ (when record-flag
+ (push `(execute-kbd-macro ,final ,prefixarg) command-history)
+ ;; Don't keep command history around forever.
+ (when (and (numberp history-length) (> history-length 0))
+ (let ((cell (nthcdr history-length command-history)))
+ (if (consp cell) (setcdr cell nil)))))
+ (execute-kbd-macro final prefixarg))
+ (t
+ ;; Pass `cmd' rather than `final', for the backtrace's sake.
+ (prog1 (call-interactively cmd record-flag keys)
+ (when (and (symbolp cmd)
+ (get cmd 'byte-obsolete-info)
+ (not (get cmd 'command-execute-obsolete-warned)))
+ (put cmd 'command-execute-obsolete-warned t)
+ (message "%s" (macroexp--obsolete-warning
+ cmd (get cmd 'byte-obsolete-info)
"command"))))))))))
+
+(defvar minibuffer-history nil
+ "Default minibuffer history list.
+This is used for all minibuffer input
+except when an alternate history list is specified.
+
+Maximum length of the history list is determined by the value
+of `history-length', which see.")
+(defvar minibuffer-history-sexp-flag nil
+ "Control whether history list elements are expressions or strings.
+If the value of this variable equals current minibuffer depth,
+they are expressions; otherwise they are strings.
+\(That convention is designed to do the right thing for
+recursive uses of the minibuffer.)")
+(setq minibuffer-history-variable 'minibuffer-history)
+(setq minibuffer-history-position nil) ;; Defvar is in C code.
+(defvar minibuffer-history-search-history nil)
+
+(defvar minibuffer-text-before-history nil
+ "Text that was in this minibuffer before any history commands.
+This is nil if there have not yet been any history commands
+in this use of the minibuffer.")
+
+(add-hook 'minibuffer-setup-hook 'minibuffer-history-initialize)
+
+(defun minibuffer-history-initialize ()
+ (setq minibuffer-text-before-history nil))
+
+(defun minibuffer-avoid-prompt (_new _old)
+ "A point-motion hook for the minibuffer, that moves point out of the prompt."
+ (constrain-to-field nil (point-max)))
+
+(defcustom minibuffer-history-case-insensitive-variables nil
+ "Minibuffer history variables for which matching should ignore case.
+If a history variable is a member of this list, then the
+\\[previous-matching-history-element] and \\[next-matching-history-element]\
+ commands ignore case when searching it, regardless of `case-fold-search'."
+ :type '(repeat variable)
+ :group 'minibuffer)
+
+(defun previous-matching-history-element (regexp n)
+ "Find the previous history element that matches REGEXP.
+\(Previous history elements refer to earlier actions.)
+With prefix argument N, search for Nth previous match.
+If N is negative, find the next or Nth next match.
+Normally, history elements are matched case-insensitively if
+`case-fold-search' is non-nil, but an uppercase letter in REGEXP
+makes the search case-sensitive.
+See also `minibuffer-history-case-insensitive-variables'."
+ (interactive
+ (let* ((enable-recursive-minibuffers t)
+ (regexp (read-from-minibuffer "Previous element matching (regexp): "
+ nil
+ minibuffer-local-map
+ nil
+ 'minibuffer-history-search-history
+ (car
minibuffer-history-search-history))))
+ ;; Use the last regexp specified, by default, if input is empty.
+ (list (if (string= regexp "")
+ (if minibuffer-history-search-history
+ (car minibuffer-history-search-history)
+ (user-error "No previous history search regexp"))
+ regexp)
+ (prefix-numeric-value current-prefix-arg))))
+ (unless (zerop n)
+ (if (and (zerop minibuffer-history-position)
+ (null minibuffer-text-before-history))
+ (setq minibuffer-text-before-history
+ (minibuffer-contents-no-properties)))
+ (let ((history (symbol-value minibuffer-history-variable))
+ (case-fold-search
+ (if (isearch-no-upper-case-p regexp t) ; assume isearch.el is dumped
+ ;; On some systems, ignore case for file names.
+ (if (memq minibuffer-history-variable
+ minibuffer-history-case-insensitive-variables)
+ t
+ ;; Respect the user's setting for case-fold-search:
+ case-fold-search)
+ nil))
+ prevpos
+ match-string
+ match-offset
+ (pos minibuffer-history-position))
+ (while (/= n 0)
+ (setq prevpos pos)
+ (setq pos (min (max 1 (+ pos (if (< n 0) -1 1))) (length history)))
+ (when (= pos prevpos)
+ (user-error (if (= pos 1)
+ "No later matching history item"
+ "No earlier matching history item")))
+ (setq match-string
+ (if (eq minibuffer-history-sexp-flag (minibuffer-depth))
+ (let ((print-level nil))
+ (prin1-to-string (nth (1- pos) history)))
+ (nth (1- pos) history)))
+ (setq match-offset
+ (if (< n 0)
+ (and (string-match regexp match-string)
+ (match-end 0))
+ (and (string-match (concat ".*\\(" regexp "\\)") match-string)
+ (match-beginning 1))))
+ (when match-offset
+ (setq n (+ n (if (< n 0) 1 -1)))))
+ (setq minibuffer-history-position pos)
+ (goto-char (point-max))
+ (delete-minibuffer-contents)
+ (insert match-string)
+ (goto-char (+ (minibuffer-prompt-end) match-offset))))
+ (if (memq (car (car command-history)) '(previous-matching-history-element
+ next-matching-history-element))
+ (setq command-history (cdr command-history))))
+
+(defun next-matching-history-element (regexp n)
+ "Find the next history element that matches REGEXP.
+\(The next history element refers to a more recent action.)
+With prefix argument N, search for Nth next match.
+If N is negative, find the previous or Nth previous match.
+Normally, history elements are matched case-insensitively if
+`case-fold-search' is non-nil, but an uppercase letter in REGEXP
+makes the search case-sensitive."
+ (interactive
+ (let* ((enable-recursive-minibuffers t)
+ (regexp (read-from-minibuffer "Next element matching (regexp): "
+ nil
+ minibuffer-local-map
+ nil
+ 'minibuffer-history-search-history
+ (car
minibuffer-history-search-history))))
+ ;; Use the last regexp specified, by default, if input is empty.
+ (list (if (string= regexp "")
+ (if minibuffer-history-search-history
+ (car minibuffer-history-search-history)
+ (user-error "No previous history search regexp"))
+ regexp)
+ (prefix-numeric-value current-prefix-arg))))
+ (previous-matching-history-element regexp (- n)))
+
+(defvar minibuffer-temporary-goal-position nil)
+
+(defvar minibuffer-default-add-function 'minibuffer-default-add-completions
+ "Function run by `goto-history-element' before consuming default values.
+This is useful to dynamically add more elements to the list of default values
+when `goto-history-element' reaches the end of this list.
+Before calling this function `goto-history-element' sets the variable
+`minibuffer-default-add-done' to t, so it will call this function only
+once. In special cases, when this function needs to be called more
+than once, it can set `minibuffer-default-add-done' to nil explicitly,
+overriding the setting of this variable to t in `goto-history-element'.")
+
+(defvar minibuffer-default-add-done nil
+ "When nil, add more elements to the end of the list of default values.
+The value nil causes `goto-history-element' to add more elements to
+the list of defaults when it reaches the end of this list. It does
+this by calling a function defined by `minibuffer-default-add-function'.")
+
+(make-variable-buffer-local 'minibuffer-default-add-done)
+
+(defun minibuffer-default-add-completions ()
+ "Return a list of all completions without the default value.
+This function is used to add all elements of the completion table to
+the end of the list of defaults just after the default value."
+ (let ((def minibuffer-default)
+ (all (all-completions ""
+ minibuffer-completion-table
+ minibuffer-completion-predicate)))
+ (if (listp def)
+ (append def all)
+ (cons def (delete def all)))))
+
+(defun goto-history-element (nabs)
+ "Puts element of the minibuffer history in the minibuffer.
+The argument NABS specifies the absolute history position."
+ (interactive "p")
+ (when (and (not minibuffer-default-add-done)
+ (functionp minibuffer-default-add-function)
+ (< nabs (- (if (listp minibuffer-default)
+ (length minibuffer-default)
+ 1))))
+ (setq minibuffer-default-add-done t
+ minibuffer-default (funcall minibuffer-default-add-function)))
+ (let ((minimum (if minibuffer-default
+ (- (if (listp minibuffer-default)
+ (length minibuffer-default)
+ 1))
+ 0))
+ elt minibuffer-returned-to-present)
+ (if (and (zerop minibuffer-history-position)
+ (null minibuffer-text-before-history))
+ (setq minibuffer-text-before-history
+ (minibuffer-contents-no-properties)))
+ (if (< nabs minimum)
+ (user-error (if minibuffer-default
+ "End of defaults; no next item"
+ "End of history; no default available")))
+ (if (> nabs (length (symbol-value minibuffer-history-variable)))
+ (user-error "Beginning of history; no preceding item"))
+ (unless (memq last-command '(next-history-element
+ previous-history-element))
+ (let ((prompt-end (minibuffer-prompt-end)))
+ (set (make-local-variable 'minibuffer-temporary-goal-position)
+ (cond ((<= (point) prompt-end) prompt-end)
+ ((eobp) nil)
+ (t (point))))))
+ (goto-char (point-max))
+ (delete-minibuffer-contents)
+ (setq minibuffer-history-position nabs)
+ (cond ((< nabs 0)
+ (setq elt (if (listp minibuffer-default)
+ (nth (1- (abs nabs)) minibuffer-default)
+ minibuffer-default)))
+ ((= nabs 0)
+ (setq elt (or minibuffer-text-before-history ""))
+ (setq minibuffer-returned-to-present t)
+ (setq minibuffer-text-before-history nil))
+ (t (setq elt (nth (1- minibuffer-history-position)
+ (symbol-value minibuffer-history-variable)))))
+ (insert
+ (if (and (eq minibuffer-history-sexp-flag (minibuffer-depth))
+ (not minibuffer-returned-to-present))
+ (let ((print-level nil))
+ (prin1-to-string elt))
+ elt))
+ (goto-char (or minibuffer-temporary-goal-position (point-max)))))
+
+(defun next-history-element (n)
+ "Puts next element of the minibuffer history in the minibuffer.
+With argument N, it uses the Nth following element."
+ (interactive "p")
+ (or (zerop n)
+ (goto-history-element (- minibuffer-history-position n))))
+
+(defun previous-history-element (n)
+ "Puts previous element of the minibuffer history in the minibuffer.
+With argument N, it uses the Nth previous element."
+ (interactive "p")
+ (or (zerop n)
+ (goto-history-element (+ minibuffer-history-position n))))
+
+(defun next-complete-history-element (n)
+ "Get next history element which completes the minibuffer before the point.
+The contents of the minibuffer after the point are deleted, and replaced
+by the new completion."
+ (interactive "p")
+ (let ((point-at-start (point)))
+ (next-matching-history-element
+ (concat
+ "^" (regexp-quote (buffer-substring (minibuffer-prompt-end) (point))))
+ n)
+ ;; next-matching-history-element always puts us at (point-min).
+ ;; Move to the position we were at before changing the buffer contents.
+ ;; This is still sensible, because the text before point has not changed.
+ (goto-char point-at-start)))
+
+(defun previous-complete-history-element (n)
+ "\
+Get previous history element which completes the minibuffer before the point.
+The contents of the minibuffer after the point are deleted, and replaced
+by the new completion."
+ (interactive "p")
+ (next-complete-history-element (- n)))
+
+;; For compatibility with the old subr of the same name.
+(defun minibuffer-prompt-width ()
+ "Return the display width of the minibuffer prompt.
+Return 0 if current buffer is not a minibuffer."
+ ;; Return the width of everything before the field at the end of
+ ;; the buffer; this should be 0 for normal buffers.
+ (1- (minibuffer-prompt-end)))
+
+;; isearch minibuffer history
+(add-hook 'minibuffer-setup-hook 'minibuffer-history-isearch-setup)
+
+(defvar minibuffer-history-isearch-message-overlay)
+(make-variable-buffer-local 'minibuffer-history-isearch-message-overlay)
+
+(defun minibuffer-history-isearch-setup ()
+ "Set up a minibuffer for using isearch to search the minibuffer history.
+Intended to be added to `minibuffer-setup-hook'."
+ (set (make-local-variable 'isearch-search-fun-function)
+ 'minibuffer-history-isearch-search)
+ (set (make-local-variable 'isearch-message-function)
+ 'minibuffer-history-isearch-message)
+ (set (make-local-variable 'isearch-wrap-function)
+ 'minibuffer-history-isearch-wrap)
+ (set (make-local-variable 'isearch-push-state-function)
+ 'minibuffer-history-isearch-push-state)
+ (add-hook 'isearch-mode-end-hook 'minibuffer-history-isearch-end nil t))
+
+(defun minibuffer-history-isearch-end ()
+ "Clean up the minibuffer after terminating isearch in the minibuffer."
+ (if minibuffer-history-isearch-message-overlay
+ (delete-overlay minibuffer-history-isearch-message-overlay)))
+
+(defun minibuffer-history-isearch-search ()
+ "Return the proper search function, for isearch in minibuffer history."
+ (lambda (string bound noerror)
+ (let ((search-fun
+ ;; Use standard functions to search within minibuffer text
+ (isearch-search-fun-default))
+ found)
+ ;; Avoid lazy-highlighting matches in the minibuffer prompt when
+ ;; searching forward. Lazy-highlight calls this lambda with the
+ ;; bound arg, so skip the minibuffer prompt.
+ (if (and bound isearch-forward (< (point) (minibuffer-prompt-end)))
+ (goto-char (minibuffer-prompt-end)))
+ (or
+ ;; 1. First try searching in the initial minibuffer text
+ (funcall search-fun string
+ (if isearch-forward bound (minibuffer-prompt-end))
+ noerror)
+ ;; 2. If the above search fails, start putting next/prev history
+ ;; elements in the minibuffer successively, and search the string
+ ;; in them. Do this only when bound is nil (i.e. not while
+ ;; lazy-highlighting search strings in the current minibuffer text).
+ (unless bound
+ (condition-case nil
+ (progn
+ (while (not found)
+ (cond (isearch-forward
+ (next-history-element 1)
+ (goto-char (minibuffer-prompt-end)))
+ (t
+ (previous-history-element 1)
+ (goto-char (point-max))))
+ (setq isearch-barrier (point) isearch-opoint (point))
+ ;; After putting the next/prev history element, search
+ ;; the string in them again, until next-history-element
+ ;; or previous-history-element raises an error at the
+ ;; beginning/end of history.
+ (setq found (funcall search-fun string
+ (unless isearch-forward
+ ;; For backward search, don't search
+ ;; in the minibuffer prompt
+ (minibuffer-prompt-end))
+ noerror)))
+ ;; Return point of the new search result
+ (point))
+ ;; Return nil when next(prev)-history-element fails
+ (error nil)))))))
+
+(defun minibuffer-history-isearch-message (&optional c-q-hack ellipsis)
+ "Display the minibuffer history search prompt.
+If there are no search errors, this function displays an overlay with
+the isearch prompt which replaces the original minibuffer prompt.
+Otherwise, it displays the standard isearch message returned from
+the function `isearch-message'."
+ (if (not (and (minibufferp) isearch-success (not isearch-error)))
+ ;; Use standard function `isearch-message' when not in the minibuffer,
+ ;; or search fails, or has an error (like incomplete regexp).
+ ;; This function overwrites minibuffer text with isearch message,
+ ;; so it's possible to see what is wrong in the search string.
+ (isearch-message c-q-hack ellipsis)
+ ;; Otherwise, put the overlay with the standard isearch prompt over
+ ;; the initial minibuffer prompt.
+ (if (overlayp minibuffer-history-isearch-message-overlay)
+ (move-overlay minibuffer-history-isearch-message-overlay
+ (point-min) (minibuffer-prompt-end))
+ (setq minibuffer-history-isearch-message-overlay
+ (make-overlay (point-min) (minibuffer-prompt-end)))
+ (overlay-put minibuffer-history-isearch-message-overlay 'evaporate t))
+ (overlay-put minibuffer-history-isearch-message-overlay
+ 'display (isearch-message-prefix c-q-hack ellipsis))
+ ;; And clear any previous isearch message.
+ (message "")))
+
+(defun minibuffer-history-isearch-wrap ()
+ "Wrap the minibuffer history search when search fails.
+Move point to the first history element for a forward search,
+or to the last history element for a backward search."
+ ;; When `minibuffer-history-isearch-search' fails on reaching the
+ ;; beginning/end of the history, wrap the search to the first/last
+ ;; minibuffer history element.
+ (if isearch-forward
+ (goto-history-element (length (symbol-value
minibuffer-history-variable)))
+ (goto-history-element 0))
+ (setq isearch-success t)
+ (goto-char (if isearch-forward (minibuffer-prompt-end) (point-max))))
+
+(defun minibuffer-history-isearch-push-state ()
+ "Save a function restoring the state of minibuffer history search.
+Save `minibuffer-history-position' to the additional state parameter
+in the search status stack."
+ (let ((pos minibuffer-history-position))
+ (lambda (cmd)
+ (minibuffer-history-isearch-pop-state cmd pos))))
+
+(defun minibuffer-history-isearch-pop-state (_cmd hist-pos)
+ "Restore the minibuffer history search state.
+Go to the history element by the absolute history position HIST-POS."
+ (goto-history-element hist-pos))
+
+
+;Put this on C-x u, so we can force that rather than C-_ into startup msg
+(define-obsolete-function-alias 'advertised-undo 'undo "23.2")
+
+(defconst undo-equiv-table (make-hash-table :test 'eq :weakness t)
+ "Table mapping redo records to the corresponding undo one.
+A redo record for undo-in-region maps to t.
+A redo record for ordinary undo maps to the following (earlier) undo.")
+
+(defvar undo-in-region nil
+ "Non-nil if `pending-undo-list' is not just a tail of `buffer-undo-list'.")
+
+(defvar undo-no-redo nil
+ "If t, `undo' doesn't go through redo entries.")
+
+(defvar pending-undo-list nil
+ "Within a run of consecutive undo commands, list remaining to be undone.
+If t, we undid all the way to the end of it.")
+
+(defun undo (&optional arg)
+ "Undo some previous changes.
+Repeat this command to undo more changes.
+A numeric ARG serves as a repeat count.
+
+In Transient Mark mode when the mark is active, only undo changes within
+the current region. Similarly, when not in Transient Mark mode, just
\\[universal-argument]
+as an argument limits undo to changes within the current region."
+ (interactive "*P")
+ ;; Make last-command indicate for the next command that this was an undo.
+ ;; That way, another undo will undo more.
+ ;; If we get to the end of the undo history and get an error,
+ ;; another undo command will find the undo history empty
+ ;; and will get another error. To begin undoing the undos,
+ ;; you must type some other command.
+ (let* ((modified (buffer-modified-p))
+ ;; For an indirect buffer, look in the base buffer for the
+ ;; auto-save data.
+ (base-buffer (or (buffer-base-buffer) (current-buffer)))
+ (recent-save (with-current-buffer base-buffer
+ (recent-auto-save-p)))
+ message)
+ ;; If we get an error in undo-start,
+ ;; the next command should not be a "consecutive undo".
+ ;; So set `this-command' to something other than `undo'.
+ (setq this-command 'undo-start)
+
+ (unless (and (eq last-command 'undo)
+ (or (eq pending-undo-list t)
+ ;; If something (a timer or filter?) changed the buffer
+ ;; since the previous command, don't continue the undo seq.
+ (let ((list buffer-undo-list))
+ (while (eq (car list) nil)
+ (setq list (cdr list)))
+ ;; If the last undo record made was made by undo
+ ;; it shows nothing else happened in between.
+ (gethash list undo-equiv-table))))
+ (setq undo-in-region
+ (or (region-active-p) (and arg (not (numberp arg)))))
+ (if undo-in-region
+ (undo-start (region-beginning) (region-end))
+ (undo-start))
+ ;; get rid of initial undo boundary
+ (undo-more 1))
+ ;; If we got this far, the next command should be a consecutive undo.
+ (setq this-command 'undo)
+ ;; Check to see whether we're hitting a redo record, and if
+ ;; so, ask the user whether she wants to skip the redo/undo pair.
+ (let ((equiv (gethash pending-undo-list undo-equiv-table)))
+ (or (eq (selected-window) (minibuffer-window))
+ (setq message (format "%s%s!"
+ (if (or undo-no-redo (not equiv))
+ "Undo" "Redo")
+ (if undo-in-region " in region" ""))))
+ (when (and (consp equiv) undo-no-redo)
+ ;; The equiv entry might point to another redo record if we have done
+ ;; undo-redo-undo-redo-... so skip to the very last equiv.
+ (while (let ((next (gethash equiv undo-equiv-table)))
+ (if next (setq equiv next))))
+ (setq pending-undo-list equiv)))
+ (undo-more
+ (if (numberp arg)
+ (prefix-numeric-value arg)
+ 1))
+ ;; Record the fact that the just-generated undo records come from an
+ ;; undo operation--that is, they are redo records.
+ ;; In the ordinary case (not within a region), map the redo
+ ;; record to the following undos.
+ ;; I don't know how to do that in the undo-in-region case.
+ (let ((list buffer-undo-list))
+ ;; Strip any leading undo boundaries there might be, like we do
+ ;; above when checking.
+ (while (eq (car list) nil)
+ (setq list (cdr list)))
+ (puthash list
+ ;; Prevent identity mapping. This can happen if
+ ;; consecutive nils are erroneously in undo list.
+ (if (or undo-in-region (eq list pending-undo-list))
+ t
+ pending-undo-list)
+ undo-equiv-table))
+ ;; Don't specify a position in the undo record for the undo command.
+ ;; Instead, undoing this should move point to where the change is.
+ (let ((tail buffer-undo-list)
+ (prev nil))
+ (while (car tail)
+ (when (integerp (car tail))
+ (let ((pos (car tail)))
+ (if prev
+ (setcdr prev (cdr tail))
+ (setq buffer-undo-list (cdr tail)))
+ (setq tail (cdr tail))
+ (while (car tail)
+ (if (eq pos (car tail))
+ (if prev
+ (setcdr prev (cdr tail))
+ (setq buffer-undo-list (cdr tail)))
+ (setq prev tail))
+ (setq tail (cdr tail)))
+ (setq tail nil)))
+ (setq prev tail tail (cdr tail))))
+ ;; Record what the current undo list says,
+ ;; so the next command can tell if the buffer was modified in between.
+ (and modified (not (buffer-modified-p))
+ (with-current-buffer base-buffer
+ (delete-auto-save-file-if-necessary recent-save)))
+ ;; Display a message announcing success.
+ (if message
+ (message "%s" message))))
+
+(defun buffer-disable-undo (&optional buffer)
+ "Make BUFFER stop keeping undo information.
+No argument or nil as argument means do this for the current buffer."
+ (interactive)
+ (with-current-buffer (if buffer (get-buffer buffer) (current-buffer))
+ (setq buffer-undo-list t)))
+
+(defun undo-only (&optional arg)
+ "Undo some previous changes.
+Repeat this command to undo more changes.
+A numeric ARG serves as a repeat count.
+Contrary to `undo', this will not redo a previous undo."
+ (interactive "*p")
+ (let ((undo-no-redo t)) (undo arg)))
+
+(defvar undo-in-progress nil
+ "Non-nil while performing an undo.
+Some change-hooks test this variable to do something different.")
+
+(defun undo-more (n)
+ "Undo back N undo-boundaries beyond what was already undone recently.
+Call `undo-start' to get ready to undo recent changes,
+then call `undo-more' one or more times to undo them."
+ (or (listp pending-undo-list)
+ (user-error (concat "No further undo information"
+ (and undo-in-region " for region"))))
+ (let ((undo-in-progress t))
+ ;; Note: The following, while pulling elements off
+ ;; `pending-undo-list' will call primitive change functions which
+ ;; will push more elements onto `buffer-undo-list'.
+ (setq pending-undo-list (primitive-undo n pending-undo-list))
+ (if (null pending-undo-list)
+ (setq pending-undo-list t))))
+
+(defun primitive-undo (n list)
+ "Undo N records from the front of the list LIST.
+Return what remains of the list."
+
+ ;; This is a good feature, but would make undo-start
+ ;; unable to do what is expected.
+ ;;(when (null (car (list)))
+ ;; ;; If the head of the list is a boundary, it is the boundary
+ ;; ;; preceding this command. Get rid of it and don't count it.
+ ;; (setq list (cdr list))))
+
+ (let ((arg n)
+ ;; In a writable buffer, enable undoing read-only text that is
+ ;; so because of text properties.
+ (inhibit-read-only t)
+ ;; Don't let `intangible' properties interfere with undo.
+ (inhibit-point-motion-hooks t)
+ ;; We use oldlist only to check for EQ. ++kfs
+ (oldlist buffer-undo-list)
+ (did-apply nil)
+ (next nil))
+ (while (> arg 0)
+ (while (setq next (pop list)) ;Exit inner loop at undo boundary.
+ ;; Handle an integer by setting point to that value.
+ (pcase next
+ ((pred integerp) (goto-char next))
+ ;; Element (t . TIME) records previous modtime.
+ ;; Preserve any flag of NONEXISTENT_MODTIME_NSECS or
+ ;; UNKNOWN_MODTIME_NSECS.
+ (`(t . ,time)
+ ;; If this records an obsolete save
+ ;; (not matching the actual disk file)
+ ;; then don't mark unmodified.
+ (when (or (equal time (visited-file-modtime))
+ (and (consp time)
+ (equal (list (car time) (cdr time))
+ (visited-file-modtime))))
+ (when (fboundp 'unlock-buffer)
+ (unlock-buffer))
+ (set-buffer-modified-p nil)))
+ ;; Element (nil PROP VAL BEG . END) is property change.
+ (`(nil . ,(or `(,prop ,val ,beg . ,end) pcase--dontcare))
+ (when (or (> (point-min) beg) (< (point-max) end))
+ (error "Changes to be undone are outside visible portion of
buffer"))
+ (put-text-property beg end prop val))
+ ;; Element (BEG . END) means range was inserted.
+ (`(,(and beg (pred integerp)) . ,(and end (pred integerp)))
+ ;; (and `(,beg . ,end) `(,(pred integerp) . ,(pred integerp)))
+ ;; Ideally: `(,(pred integerp beg) . ,(pred integerp end))
+ (when (or (> (point-min) beg) (< (point-max) end))
+ (error "Changes to be undone are outside visible portion of
buffer"))
+ ;; Set point first thing, so that undoing this undo
+ ;; does not send point back to where it is now.
+ (goto-char beg)
+ (delete-region beg end))
+ ;; Element (apply FUN . ARGS) means call FUN to undo.
+ (`(apply . ,fun-args)
+ (let ((currbuff (current-buffer)))
+ (if (integerp (car fun-args))
+ ;; Long format: (apply DELTA START END FUN . ARGS).
+ (pcase-let* ((`(,delta ,start ,end ,fun . ,args) fun-args)
+ (start-mark (copy-marker start nil))
+ (end-mark (copy-marker end t)))
+ (when (or (> (point-min) start) (< (point-max) end))
+ (error "Changes to be undone are outside visible portion
of buffer"))
+ (apply fun args) ;; Use `save-current-buffer'?
+ ;; Check that the function did what the entry
+ ;; said it would do.
+ (unless (and (= start start-mark)
+ (= (+ delta end) end-mark))
+ (error "Changes to be undone by function different than
announced"))
+ (set-marker start-mark nil)
+ (set-marker end-mark nil))
+ (apply fun-args))
+ (unless (eq currbuff (current-buffer))
+ (error "Undo function switched buffer"))
+ (setq did-apply t)))
+ ;; Element (STRING . POS) means STRING was deleted.
+ (`(,(and string (pred stringp)) . ,(and pos (pred integerp)))
+ (when (let ((apos (abs pos)))
+ (or (< apos (point-min)) (> apos (point-max))))
+ (error "Changes to be undone are outside visible portion of
buffer"))
+ (let (valid-marker-adjustments)
+ ;; Check that marker adjustments which were recorded
+ ;; with the (STRING . POS) record are still valid, ie
+ ;; the markers haven't moved. We check their validity
+ ;; before reinserting the string so as we don't need to
+ ;; mind marker insertion-type.
+ (while (and (markerp (car-safe (car list)))
+ (integerp (cdr-safe (car list))))
+ (let* ((marker-adj (pop list))
+ (m (car marker-adj)))
+ (and (eq (marker-buffer m) (current-buffer))
+ (= pos m)
+ (push marker-adj valid-marker-adjustments))))
+ ;; Insert string and adjust point
+ (if (< pos 0)
+ (progn
+ (goto-char (- pos))
+ (insert string))
+ (goto-char pos)
+ (insert string)
+ (goto-char pos))
+ ;; Adjust the valid marker adjustments
+ (dolist (adj valid-marker-adjustments)
+ (set-marker (car adj)
+ (- (car adj) (cdr adj))))))
+ ;; (MARKER . OFFSET) means a marker MARKER was adjusted by OFFSET.
+ (`(,(and marker (pred markerp)) . ,(and offset (pred integerp)))
+ (warn "Encountered %S entry in undo list with no matching (TEXT .
POS) entry"
+ next)
+ ;; Even though these elements are not expected in the undo
+ ;; list, adjust them to be conservative for the 24.4
+ ;; release. (Bug#16818)
+ (when (marker-buffer marker)
+ (set-marker marker
+ (- marker offset)
+ (marker-buffer marker))))
+ (_ (error "Unrecognized entry in undo list %S" next))))
+ (setq arg (1- arg)))
+ ;; Make sure an apply entry produces at least one undo entry,
+ ;; so the test in `undo' for continuing an undo series
+ ;; will work right.
+ (if (and did-apply
+ (eq oldlist buffer-undo-list))
+ (setq buffer-undo-list
+ (cons (list 'apply 'cdr nil) buffer-undo-list))))
+ list)
+
+;; Deep copy of a list
+(defun undo-copy-list (list)
+ "Make a copy of undo list LIST."
+ (mapcar 'undo-copy-list-1 list))
+
+(defun undo-copy-list-1 (elt)
+ (if (consp elt)
+ (cons (car elt) (undo-copy-list-1 (cdr elt)))
+ elt))
+
+(defun undo-start (&optional beg end)
+ "Set `pending-undo-list' to the front of the undo list.
+The next call to `undo-more' will undo the most recently made change.
+If BEG and END are specified, then only undo elements
+that apply to text between BEG and END are used; other undo elements
+are ignored. If BEG and END are nil, all undo elements are used."
+ (if (eq buffer-undo-list t)
+ (user-error "No undo information in this buffer"))
+ (setq pending-undo-list
+ (if (and beg end (not (= beg end)))
+ (undo-make-selective-list (min beg end) (max beg end))
+ buffer-undo-list)))
+
+(defun undo-make-selective-list (start end)
+ "Return a list of undo elements for the region START to END.
+The elements come from `buffer-undo-list', but we keep only
+the elements inside this region, and discard those outside this region.
+If we find an element that crosses an edge of this region,
+we stop and ignore all further elements."
+ (let ((undo-list-copy (undo-copy-list buffer-undo-list))
+ (undo-list (list nil))
+ some-rejected
+ undo-elt temp-undo-list delta)
+ (while undo-list-copy
+ (setq undo-elt (car undo-list-copy))
+ (let ((keep-this
+ (cond ((and (consp undo-elt) (eq (car undo-elt) t))
+ ;; This is a "was unmodified" element.
+ ;; Keep it if we have kept everything thus far.
+ (not some-rejected))
+ ;; Skip over marker adjustments, instead relying on
+ ;; finding them after (TEXT . POS) elements
+ ((markerp (car-safe undo-elt))
+ nil)
+ (t
+ (undo-elt-in-region undo-elt start end)))))
+ (if keep-this
+ (progn
+ (setq end (+ end (cdr (undo-delta undo-elt))))
+ ;; Don't put two nils together in the list
+ (when (not (and (eq (car undo-list) nil)
+ (eq undo-elt nil)))
+ (setq undo-list (cons undo-elt undo-list))
+ ;; If (TEXT . POS), "keep" its subsequent (MARKER
+ ;; . ADJUSTMENT) whose markers haven't moved.
+ (when (and (stringp (car-safe undo-elt))
+ (integerp (cdr-safe undo-elt)))
+ (let ((list-i (cdr undo-list-copy)))
+ (while (markerp (car-safe (car list-i)))
+ (let* ((adj-elt (pop list-i))
+ (m (car adj-elt)))
+ (and (eq (marker-buffer m) (current-buffer))
+ (= (cdr undo-elt) m)
+ (push adj-elt undo-list))))))))
+ (if (undo-elt-crosses-region undo-elt start end)
+ (setq undo-list-copy nil)
+ (setq some-rejected t)
+ (setq temp-undo-list (cdr undo-list-copy))
+ (setq delta (undo-delta undo-elt))
+
+ (when (/= (cdr delta) 0)
+ (let ((position (car delta))
+ (offset (cdr delta)))
+
+ ;; Loop down the earlier events adjusting their buffer
+ ;; positions to reflect the fact that a change to the buffer
+ ;; isn't being undone. We only need to process those element
+ ;; types which undo-elt-in-region will return as being in
+ ;; the region since only those types can ever get into the
+ ;; output
+
+ (while temp-undo-list
+ (setq undo-elt (car temp-undo-list))
+ (cond ((integerp undo-elt)
+ (if (>= undo-elt position)
+ (setcar temp-undo-list (- undo-elt offset))))
+ ((atom undo-elt) nil)
+ ((stringp (car undo-elt))
+ ;; (TEXT . POSITION)
+ (let ((text-pos (abs (cdr undo-elt)))
+ (point-at-end (< (cdr undo-elt) 0 )))
+ (if (>= text-pos position)
+ (setcdr undo-elt (* (if point-at-end -1 1)
+ (- text-pos offset))))))
+ ((integerp (car undo-elt))
+ ;; (BEGIN . END)
+ (when (>= (car undo-elt) position)
+ (setcar undo-elt (- (car undo-elt) offset))
+ (setcdr undo-elt (- (cdr undo-elt) offset))))
+ ((null (car undo-elt))
+ ;; (nil PROPERTY VALUE BEG . END)
+ (let ((tail (nthcdr 3 undo-elt)))
+ (when (>= (car tail) position)
+ (setcar tail (- (car tail) offset))
+ (setcdr tail (- (cdr tail) offset))))))
+ (setq temp-undo-list (cdr temp-undo-list))))))))
+ (setq undo-list-copy (cdr undo-list-copy)))
+ (nreverse undo-list)))
+
+(defun undo-elt-in-region (undo-elt start end)
+ "Determine whether UNDO-ELT falls inside the region START ... END.
+If it crosses the edge, we return nil.
+
+Generally this function is not useful for determining
+whether (MARKER . ADJUSTMENT) undo elements are in the region,
+because markers can be arbitrarily relocated. Instead, pass the
+marker adjustment's corresponding (TEXT . POS) element."
+ (cond ((integerp undo-elt)
+ (and (>= undo-elt start)
+ (<= undo-elt end)))
+ ((eq undo-elt nil)
+ t)
+ ((atom undo-elt)
+ nil)
+ ((stringp (car undo-elt))
+ ;; (TEXT . POSITION)
+ (and (>= (abs (cdr undo-elt)) start)
+ (<= (abs (cdr undo-elt)) end)))
+ ((and (consp undo-elt) (markerp (car undo-elt)))
+ ;; (MARKER . ADJUSTMENT)
+ (<= start (car undo-elt) end))
+ ((null (car undo-elt))
+ ;; (nil PROPERTY VALUE BEG . END)
+ (let ((tail (nthcdr 3 undo-elt)))
+ (and (>= (car tail) start)
+ (<= (cdr tail) end))))
+ ((integerp (car undo-elt))
+ ;; (BEGIN . END)
+ (and (>= (car undo-elt) start)
+ (<= (cdr undo-elt) end)))))
+
+(defun undo-elt-crosses-region (undo-elt start end)
+ "Test whether UNDO-ELT crosses one edge of that region START ... END.
+This assumes we have already decided that UNDO-ELT
+is not *inside* the region START...END."
+ (cond ((atom undo-elt) nil)
+ ((null (car undo-elt))
+ ;; (nil PROPERTY VALUE BEG . END)
+ (let ((tail (nthcdr 3 undo-elt)))
+ (and (< (car tail) end)
+ (> (cdr tail) start))))
+ ((integerp (car undo-elt))
+ ;; (BEGIN . END)
+ (and (< (car undo-elt) end)
+ (> (cdr undo-elt) start)))))
+
+;; Return the first affected buffer position and the delta for an undo element
+;; delta is defined as the change in subsequent buffer positions if we *did*
+;; the undo.
+(defun undo-delta (undo-elt)
+ (if (consp undo-elt)
+ (cond ((stringp (car undo-elt))
+ ;; (TEXT . POSITION)
+ (cons (abs (cdr undo-elt)) (length (car undo-elt))))
+ ((integerp (car undo-elt))
+ ;; (BEGIN . END)
+ (cons (car undo-elt) (- (car undo-elt) (cdr undo-elt))))
+ (t
+ '(0 . 0)))
+ '(0 . 0)))
+
+(defcustom undo-ask-before-discard nil
+ "If non-nil ask about discarding undo info for the current command.
+Normally, Emacs discards the undo info for the current command if
+it exceeds `undo-outer-limit'. But if you set this option
+non-nil, it asks in the echo area whether to discard the info.
+If you answer no, there is a slight risk that Emacs might crash, so
+only do it if you really want to undo the command.
+
+This option is mainly intended for debugging. You have to be
+careful if you use it for other purposes. Garbage collection is
+inhibited while the question is asked, meaning that Emacs might
+leak memory. So you should make sure that you do not wait
+excessively long before answering the question."
+ :type 'boolean
+ :group 'undo
+ :version "22.1")
+
+(defvar undo-extra-outer-limit nil
+ "If non-nil, an extra level of size that's ok in an undo item.
+We don't ask the user about truncating the undo list until the
+current item gets bigger than this amount.
+
+This variable only matters if `undo-ask-before-discard' is non-nil.")
+(make-variable-buffer-local 'undo-extra-outer-limit)
+
+;; When the first undo batch in an undo list is longer than
+;; undo-outer-limit, this function gets called to warn the user that
+;; the undo info for the current command was discarded. Garbage
+;; collection is inhibited around the call, so it had better not do a
+;; lot of consing.
+(setq undo-outer-limit-function 'undo-outer-limit-truncate)
+(defun undo-outer-limit-truncate (size)
+ (if undo-ask-before-discard
+ (when (or (null undo-extra-outer-limit)
+ (> size undo-extra-outer-limit))
+ ;; Don't ask the question again unless it gets even bigger.
+ ;; This applies, in particular, if the user quits from the question.
+ ;; Such a quit quits out of GC, but something else will call GC
+ ;; again momentarily. It will call this function again,
+ ;; but we don't want to ask the question again.
+ (setq undo-extra-outer-limit (+ size 50000))
+ (if (let (use-dialog-box track-mouse executing-kbd-macro )
+ (yes-or-no-p (format "Buffer `%s' undo info is %d bytes long;
discard it? "
+ (buffer-name) size)))
+ (progn (setq buffer-undo-list nil)
+ (setq undo-extra-outer-limit nil)
+ t)
+ nil))
+ (display-warning '(undo discard-info)
+ (concat
+ (format "Buffer `%s' undo info was %d bytes long.\n"
+ (buffer-name) size)
+ "The undo info was discarded because it exceeded \
+`undo-outer-limit'.
+
+This is normal if you executed a command that made a huge change
+to the buffer. In that case, to prevent similar problems in the
+future, set `undo-outer-limit' to a value that is large enough to
+cover the maximum size of normal changes you expect a single
+command to make, but not so large that it might exceed the
+maximum memory allotted to Emacs.
+
+If you did not execute any such command, the situation is
+probably due to a bug and you should report it.
+
+You can disable the popping up of this buffer by adding the entry
+\(undo discard-info) to the user option `warning-suppress-types',
+which is defined in the `warnings' library.\n")
+ :warning)
+ (setq buffer-undo-list nil)
+ t))
+
+(defcustom password-word-equivalents
+ '("password" "passcode" "passphrase" "pass phrase"
+ ; These are sorted according to the GNU en_US locale.
+ "암호" ; ko
+ "パスワード" ; ja
+ "ପ୍ରବେଶ ସଙ୍କେତ" ; or
+ "ពាក្យសម្ងាត់" ; km
+ "adgangskode" ; da
+ "contraseña" ; es
+ "contrasenya" ; ca
+ "geslo" ; sl
+ "hasło" ; pl
+ "heslo" ; cs, sk
+ "iphasiwedi" ; zu
+ "jelszó" ; hu
+ "lösenord" ; sv
+ "lozinka" ; hr, sr
+ "mật khẩu" ; vi
+ "mot de passe" ; fr
+ "parola" ; tr
+ "pasahitza" ; eu
+ "passord" ; nb
+ "passwort" ; de
+ "pasvorto" ; eo
+ "salasana" ; fi
+ "senha" ; pt
+ "slaptažodis" ; lt
+ "wachtwoord" ; nl
+ "كلمة السر" ; ar
+ "ססמה" ; he
+ "лозинка" ; sr
+ "пароль" ; kk, ru, uk
+ "गुप्तशब्द" ; mr
+ "शब्दकूट" ; hi
+ "પાસવર્ડ" ; gu
+ "సంకేతపదము" ; te
+ "ਪਾਸਵਰਡ" ; pa
+ "ಗುಪ್ತಪದ" ; kn
+ "கடவுச்சொல்" ; ta
+ "അടയാളവാക്ക്" ; ml
+ "গুপ্তশব্দ" ; as
+ "পাসওয়ার্ড" ; bn_IN
+ "රහස්පදය" ; si
+ "密码" ; zh_CN
+ "密碼" ; zh_TW
+ )
+ "List of words equivalent to \"password\".
+This is used by Shell mode and other parts of Emacs to recognize
+password prompts, including prompts in languages other than
+English. Different case choices should not be assumed to be
+included; callers should bind `case-fold-search' to t."
+ :type '(repeat string)
+ :version "24.4"
+ :group 'processes)
+
+(defvar shell-command-history nil
+ "History list for some commands that read shell commands.
+
+Maximum length of the history list is determined by the value
+of `history-length', which see.")
+
+(defvar shell-command-switch (purecopy "-c")
+ "Switch used to have the shell execute its command line argument.")
+
+(defvar shell-command-default-error-buffer nil
+ "Buffer name for `shell-command' and `shell-command-on-region' error output.
+This buffer is used when `shell-command' or `shell-command-on-region'
+is run interactively. A value of nil means that output to stderr and
+stdout will be intermixed in the output stream.")
+
+(declare-function mailcap-file-default-commands "mailcap" (files))
+(declare-function dired-get-filename "dired" (&optional localp
no-error-if-not-filep))
+
+(defun minibuffer-default-add-shell-commands ()
+ "Return a list of all commands associated with the current file.
+This function is used to add all related commands retrieved by `mailcap'
+to the end of the list of defaults just after the default value."
+ (interactive)
+ (let* ((filename (if (listp minibuffer-default)
+ (car minibuffer-default)
+ minibuffer-default))
+ (commands (and filename (require 'mailcap nil t)
+ (mailcap-file-default-commands (list filename)))))
+ (setq commands (mapcar (lambda (command)
+ (concat command " " filename))
+ commands))
+ (if (listp minibuffer-default)
+ (append minibuffer-default commands)
+ (cons minibuffer-default commands))))
+
+(declare-function shell-completion-vars "shell" ())
+
+(defvar minibuffer-local-shell-command-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map minibuffer-local-map)
+ (define-key map "\t" 'completion-at-point)
+ map)
+ "Keymap used for completing shell commands in minibuffer.")
+
+(defun read-shell-command (prompt &optional initial-contents hist &rest args)
+ "Read a shell command from the minibuffer.
+The arguments are the same as the ones of `read-from-minibuffer',
+except READ and KEYMAP are missing and HIST defaults
+to `shell-command-history'."
+ (require 'shell)
+ (minibuffer-with-setup-hook
+ (lambda ()
+ (shell-completion-vars)
+ (set (make-local-variable 'minibuffer-default-add-function)
+ 'minibuffer-default-add-shell-commands))
+ (apply 'read-from-minibuffer prompt initial-contents
+ minibuffer-local-shell-command-map
+ nil
+ (or hist 'shell-command-history)
+ args)))
+
+(defcustom async-shell-command-buffer 'confirm-new-buffer
+ "What to do when the output buffer is used by another shell command.
+This option specifies how to resolve the conflict where a new command
+wants to direct its output to the buffer `*Async Shell Command*',
+but this buffer is already taken by another running shell command.
+
+The value `confirm-kill-process' is used to ask for confirmation before
+killing the already running process and running a new process
+in the same buffer, `confirm-new-buffer' for confirmation before running
+the command in a new buffer with a name other than the default buffer name,
+`new-buffer' for doing the same without confirmation,
+`confirm-rename-buffer' for confirmation before renaming the existing
+output buffer and running a new command in the default buffer,
+`rename-buffer' for doing the same without confirmation."
+ :type '(choice (const :tag "Confirm killing of running command"
+ confirm-kill-process)
+ (const :tag "Confirm creation of a new buffer"
+ confirm-new-buffer)
+ (const :tag "Create a new buffer"
+ new-buffer)
+ (const :tag "Confirm renaming of existing buffer"
+ confirm-rename-buffer)
+ (const :tag "Rename the existing buffer"
+ rename-buffer))
+ :group 'shell
+ :version "24.3")
+
+(defun async-shell-command (command &optional output-buffer error-buffer)
+ "Execute string COMMAND asynchronously in background.
+
+Like `shell-command', but adds `&' at the end of COMMAND
+to execute it asynchronously.
+
+The output appears in the buffer `*Async Shell Command*'.
+That buffer is in shell mode.
+
+You can configure `async-shell-command-buffer' to specify what to do in
+case when `*Async Shell Command*' buffer is already taken by another
+running shell command. To run COMMAND without displaying the output
+in a window you can configure `display-buffer-alist' to use the action
+`display-buffer-no-window' for the buffer `*Async Shell Command*'.
+
+In Elisp, you will often be better served by calling `start-process'
+directly, since it offers more control and does not impose the use of a
+shell (with its need to quote arguments)."
+ (interactive
+ (list
+ (read-shell-command "Async shell command: " nil nil
+ (let ((filename
+ (cond
+ (buffer-file-name)
+ ((eq major-mode 'dired-mode)
+ (dired-get-filename nil t)))))
+ (and filename (file-relative-name filename))))
+ current-prefix-arg
+ shell-command-default-error-buffer))
+ (unless (string-match "&[ \t]*\\'" command)
+ (setq command (concat command " &")))
+ (shell-command command output-buffer error-buffer))
+
+(defun shell-command (command &optional output-buffer error-buffer)
+ "Execute string COMMAND in inferior shell; display output, if any.
+With prefix argument, insert the COMMAND's output at point.
+
+If COMMAND ends in `&', execute it asynchronously.
+The output appears in the buffer `*Async Shell Command*'.
+That buffer is in shell mode. You can also use
+`async-shell-command' that automatically adds `&'.
+
+Otherwise, COMMAND is executed synchronously. The output appears in
+the buffer `*Shell Command Output*'. If the output is short enough to
+display in the echo area (which is determined by the variables
+`resize-mini-windows' and `max-mini-window-height'), it is shown
+there, but it is nonetheless available in buffer `*Shell Command
+Output*' even though that buffer is not automatically displayed.
+
+To specify a coding system for converting non-ASCII characters
+in the shell command output, use \\[universal-coding-system-argument] \
+before this command.
+
+Noninteractive callers can specify coding systems by binding
+`coding-system-for-read' and `coding-system-for-write'.
+
+The optional second argument OUTPUT-BUFFER, if non-nil,
+says to put the output in some other buffer.
+If OUTPUT-BUFFER is a buffer or buffer name, put the output there.
+If OUTPUT-BUFFER is not a buffer and not nil,
+insert output in current buffer. (This cannot be done asynchronously.)
+In either case, the buffer is first erased, and the output is
+inserted after point (leaving mark after it).
+
+If the command terminates without error, but generates output,
+and you did not specify \"insert it in the current buffer\",
+the output can be displayed in the echo area or in its buffer.
+If the output is short enough to display in the echo area
+\(determined by the variable `max-mini-window-height' if
+`resize-mini-windows' is non-nil), it is shown there.
+Otherwise,the buffer containing the output is displayed.
+
+If there is output and an error, and you did not specify \"insert it
+in the current buffer\", a message about the error goes at the end
+of the output.
+
+If there is no output, or if output is inserted in the current buffer,
+then `*Shell Command Output*' is deleted.
+
+If the optional third argument ERROR-BUFFER is non-nil, it is a buffer
+or buffer name to which to direct the command's standard error output.
+If it is nil, error output is mingled with regular output.
+In an interactive call, the variable `shell-command-default-error-buffer'
+specifies the value of ERROR-BUFFER.
+
+In Elisp, you will often be better served by calling `call-process' or
+`start-process' directly, since it offers more control and does not impose
+the use of a shell (with its need to quote arguments)."
+
+ (interactive
+ (list
+ (read-shell-command "Shell command: " nil nil
+ (let ((filename
+ (cond
+ (buffer-file-name)
+ ((eq major-mode 'dired-mode)
+ (dired-get-filename nil t)))))
+ (and filename (file-relative-name filename))))
+ current-prefix-arg
+ shell-command-default-error-buffer))
+ ;; Look for a handler in case default-directory is a remote file name.
+ (let ((handler
+ (find-file-name-handler (directory-file-name default-directory)
+ 'shell-command)))
+ (if handler
+ (funcall handler 'shell-command command output-buffer error-buffer)
+ (if (and output-buffer
+ (not (or (bufferp output-buffer) (stringp output-buffer))))
+ ;; Output goes in current buffer.
+ (let ((error-file
+ (if error-buffer
+ (make-temp-file
+ (expand-file-name "scor"
+ (or small-temporary-file-directory
+ temporary-file-directory)))
+ nil)))
+ (barf-if-buffer-read-only)
+ (push-mark nil t)
+ ;; We do not use -f for csh; we will not support broken use of
+ ;; .cshrcs. Even the BSD csh manual says to use
+ ;; "if ($?prompt) exit" before things which are not useful
+ ;; non-interactively. Besides, if someone wants their other
+ ;; aliases for shell commands then they can still have them.
+ (call-process shell-file-name nil
+ (if error-file
+ (list t error-file)
+ t)
+ nil shell-command-switch command)
+ (when (and error-file (file-exists-p error-file))
+ (if (< 0 (nth 7 (file-attributes error-file)))
+ (with-current-buffer (get-buffer-create error-buffer)
+ (let ((pos-from-end (- (point-max) (point))))
+ (or (bobp)
+ (insert "\f\n"))
+ ;; Do no formatting while reading error file,
+ ;; because that can run a shell command, and we
+ ;; don't want that to cause an infinite recursion.
+ (format-insert-file error-file nil)
+ ;; Put point after the inserted errors.
+ (goto-char (- (point-max) pos-from-end)))
+ (display-buffer (current-buffer))))
+ (delete-file error-file))
+ ;; This is like exchange-point-and-mark, but doesn't
+ ;; activate the mark. It is cleaner to avoid activation,
+ ;; even though the command loop would deactivate the mark
+ ;; because we inserted text.
+ (goto-char (prog1 (mark t)
+ (set-marker (mark-marker) (point)
+ (current-buffer)))))
+ ;; Output goes in a separate buffer.
+ ;; Preserve the match data in case called from a program.
+ (save-match-data
+ (if (string-match "[ \t]*&[ \t]*\\'" command)
+ ;; Command ending with ampersand means asynchronous.
+ (let ((buffer (get-buffer-create
+ (or output-buffer "*Async Shell Command*")))
+ (directory default-directory)
+ proc)
+ ;; Remove the ampersand.
+ (setq command (substring command 0 (match-beginning 0)))
+ ;; Ask the user what to do with already running process.
+ (setq proc (get-buffer-process buffer))
+ (when proc
+ (cond
+ ((eq async-shell-command-buffer 'confirm-kill-process)
+ ;; If will kill a process, query first.
+ (if (yes-or-no-p "A command is running in the default
buffer. Kill it? ")
+ (kill-process proc)
+ (error "Shell command in progress")))
+ ((eq async-shell-command-buffer 'confirm-new-buffer)
+ ;; If will create a new buffer, query first.
+ (if (yes-or-no-p "A command is running in the default
buffer. Use a new buffer? ")
+ (setq buffer (generate-new-buffer
+ (or output-buffer "*Async Shell
Command*")))
+ (error "Shell command in progress")))
+ ((eq async-shell-command-buffer 'new-buffer)
+ ;; It will create a new buffer.
+ (setq buffer (generate-new-buffer
+ (or output-buffer "*Async Shell Command*"))))
+ ((eq async-shell-command-buffer 'confirm-rename-buffer)
+ ;; If will rename the buffer, query first.
+ (if (yes-or-no-p "A command is running in the default
buffer. Rename it? ")
+ (progn
+ (with-current-buffer buffer
+ (rename-uniquely))
+ (setq buffer (get-buffer-create
+ (or output-buffer "*Async Shell
Command*"))))
+ (error "Shell command in progress")))
+ ((eq async-shell-command-buffer 'rename-buffer)
+ ;; It will rename the buffer.
+ (with-current-buffer buffer
+ (rename-uniquely))
+ (setq buffer (get-buffer-create
+ (or output-buffer "*Async Shell
Command*"))))))
+ (with-current-buffer buffer
+ (setq buffer-read-only nil)
+ ;; Setting buffer-read-only to nil doesn't suffice
+ ;; if some text has a non-nil read-only property,
+ ;; which comint sometimes adds for prompts.
+ (let ((inhibit-read-only t))
+ (erase-buffer))
+ (display-buffer buffer '(nil (allow-no-window . t)))
+ (setq default-directory directory)
+ (setq proc (start-process "Shell" buffer shell-file-name
+ shell-command-switch command))
+ (setq mode-line-process '(":%s"))
+ (require 'shell) (shell-mode)
+ (set-process-sentinel proc 'shell-command-sentinel)
+ ;; Use the comint filter for proper handling of carriage
motion
+ ;; (see `comint-inhibit-carriage-motion'),.
+ (set-process-filter proc 'comint-output-filter)
+ ))
+ ;; Otherwise, command is executed synchronously.
+ (shell-command-on-region (point) (point) command
+ output-buffer nil error-buffer)))))))
+
+(defun display-message-or-buffer (message
+ &optional buffer-name not-this-window frame)
+ "Display MESSAGE in the echo area if possible, otherwise in a pop-up buffer.
+MESSAGE may be either a string or a buffer.
+
+A buffer is displayed using `display-buffer' if MESSAGE is too long for
+the maximum height of the echo area, as defined by `max-mini-window-height'
+if `resize-mini-windows' is non-nil.
+
+Returns either the string shown in the echo area, or when a pop-up
+buffer is used, the window used to display it.
+
+If MESSAGE is a string, then the optional argument BUFFER-NAME is the
+name of the buffer used to display it in the case where a pop-up buffer
+is used, defaulting to `*Message*'. In the case where MESSAGE is a
+string and it is displayed in the echo area, it is not specified whether
+the contents are inserted into the buffer anyway.
+
+Optional arguments NOT-THIS-WINDOW and FRAME are as for `display-buffer',
+and only used if a buffer is displayed."
+ (cond ((and (stringp message) (not (string-match "\n" message)))
+ ;; Trivial case where we can use the echo area
+ (message "%s" message))
+ ((and (stringp message)
+ (= (string-match "\n" message) (1- (length message))))
+ ;; Trivial case where we can just remove single trailing newline
+ (message "%s" (substring message 0 (1- (length message)))))
+ (t
+ ;; General case
+ (with-current-buffer
+ (if (bufferp message)
+ message
+ (get-buffer-create (or buffer-name "*Message*")))
+
+ (unless (bufferp message)
+ (erase-buffer)
+ (insert message))
+
+ (let ((lines
+ (if (= (buffer-size) 0)
+ 0
+ (count-screen-lines nil nil nil (minibuffer-window)))))
+ (cond ((= lines 0))
+ ((and (or (<= lines 1)
+ (<= lines
+ (if resize-mini-windows
+ (cond ((floatp max-mini-window-height)
+ (* (frame-height)
+ max-mini-window-height))
+ ((integerp max-mini-window-height)
+ max-mini-window-height)
+ (t
+ 1))
+ 1)))
+ ;; Don't use the echo area if the output buffer is
+ ;; already displayed in the selected frame.
+ (not (get-buffer-window (current-buffer))))
+ ;; Echo area
+ (goto-char (point-max))
+ (when (bolp)
+ (backward-char 1))
+ (message "%s" (buffer-substring (point-min) (point))))
+ (t
+ ;; Buffer
+ (goto-char (point-min))
+ (display-buffer (current-buffer)
+ not-this-window frame))))))))
+
+
+;; We have a sentinel to prevent insertion of a termination message
+;; in the buffer itself.
+(defun shell-command-sentinel (process signal)
+ (if (memq (process-status process) '(exit signal))
+ (message "%s: %s."
+ (car (cdr (cdr (process-command process))))
+ (substring signal 0 -1))))
+
+(defun shell-command-on-region (start end command
+ &optional output-buffer replace
+ error-buffer display-error-buffer)
+ "Execute string COMMAND in inferior shell with region as input.
+Normally display output (if any) in temp buffer `*Shell Command Output*';
+Prefix arg means replace the region with it. Return the exit code of
+COMMAND.
+
+To specify a coding system for converting non-ASCII characters
+in the input and output to the shell command, use
\\[universal-coding-system-argument]
+before this command. By default, the input (from the current buffer)
+is encoded using coding-system specified by `process-coding-system-alist',
+falling back to `default-process-coding-system' if no match for COMMAND
+is found in `process-coding-system-alist'.
+
+Noninteractive callers can specify coding systems by binding
+`coding-system-for-read' and `coding-system-for-write'.
+
+If the command generates output, the output may be displayed
+in the echo area or in a buffer.
+If the output is short enough to display in the echo area
+\(determined by the variable `max-mini-window-height' if
+`resize-mini-windows' is non-nil), it is shown there.
+Otherwise it is displayed in the buffer `*Shell Command Output*'.
+The output is available in that buffer in both cases.
+
+If there is output and an error, a message about the error
+appears at the end of the output. If there is no output, or if
+output is inserted in the current buffer, the buffer `*Shell
+Command Output*' is deleted.
+
+Optional fourth arg OUTPUT-BUFFER specifies where to put the
+command's output. If the value is a buffer or buffer name,
+put the output there. If the value is nil, use the buffer
+`*Shell Command Output*'. Any other value, excluding nil,
+means to insert the output in the current buffer. In either case,
+the output is inserted after point (leaving mark after it).
+
+Optional fifth arg REPLACE, if non-nil, means to insert the
+output in place of text from START to END, putting point and mark
+around it.
+
+Optional sixth arg ERROR-BUFFER, if non-nil, specifies a buffer
+or buffer name to which to direct the command's standard error
+output. If nil, error output is mingled with regular output.
+When called interactively, `shell-command-default-error-buffer'
+is used for ERROR-BUFFER.
+
+Optional seventh arg DISPLAY-ERROR-BUFFER, if non-nil, means to
+display the error buffer if there were any errors. When called
+interactively, this is t."
+ (interactive (let (string)
+ (unless (mark)
+ (error "The mark is not set now, so there is no region"))
+ ;; Do this before calling region-beginning
+ ;; and region-end, in case subprocess output
+ ;; relocates them while we are in the minibuffer.
+ (setq string (read-shell-command "Shell command on region: "))
+ ;; call-interactively recognizes region-beginning and
+ ;; region-end specially, leaving them in the history.
+ (list (region-beginning) (region-end)
+ string
+ current-prefix-arg
+ current-prefix-arg
+ shell-command-default-error-buffer
+ t)))
+ (let ((error-file
+ (if error-buffer
+ (make-temp-file
+ (expand-file-name "scor"
+ (or small-temporary-file-directory
+ temporary-file-directory)))
+ nil))
+ exit-status)
+ (if (or replace
+ (and output-buffer
+ (not (or (bufferp output-buffer) (stringp output-buffer)))))
+ ;; Replace specified region with output from command.
+ (let ((swap (and replace (< start end))))
+ ;; Don't muck with mark unless REPLACE says we should.
+ (goto-char start)
+ (and replace (push-mark (point) 'nomsg))
+ (setq exit-status
+ (call-process-region start end shell-file-name replace
+ (if error-file
+ (list t error-file)
+ t)
+ nil shell-command-switch command))
+ ;; It is rude to delete a buffer which the command is not using.
+ ;; (let ((shell-buffer (get-buffer "*Shell Command Output*")))
+ ;; (and shell-buffer (not (eq shell-buffer (current-buffer)))
+ ;; (kill-buffer shell-buffer)))
+ ;; Don't muck with mark unless REPLACE says we should.
+ (and replace swap (exchange-point-and-mark)))
+ ;; No prefix argument: put the output in a temp buffer,
+ ;; replacing its entire contents.
+ (let ((buffer (get-buffer-create
+ (or output-buffer "*Shell Command Output*"))))
+ (unwind-protect
+ (if (eq buffer (current-buffer))
+ ;; If the input is the same buffer as the output,
+ ;; delete everything but the specified region,
+ ;; then replace that region with the output.
+ (progn (setq buffer-read-only nil)
+ (delete-region (max start end) (point-max))
+ (delete-region (point-min) (min start end))
+ (setq exit-status
+ (call-process-region (point-min) (point-max)
+ shell-file-name t
+ (if error-file
+ (list t error-file)
+ t)
+ nil shell-command-switch
+ command)))
+ ;; Clear the output buffer, then run the command with
+ ;; output there.
+ (let ((directory default-directory))
+ (with-current-buffer buffer
+ (setq buffer-read-only nil)
+ (if (not output-buffer)
+ (setq default-directory directory))
+ (erase-buffer)))
+ (setq exit-status
+ (call-process-region start end shell-file-name nil
+ (if error-file
+ (list buffer error-file)
+ buffer)
+ nil shell-command-switch command)))
+ ;; Report the output.
+ (with-current-buffer buffer
+ (setq mode-line-process
+ (cond ((null exit-status)
+ " - Error")
+ ((stringp exit-status)
+ (format " - Signal [%s]" exit-status))
+ ((not (equal 0 exit-status))
+ (format " - Exit [%d]" exit-status)))))
+ (if (with-current-buffer buffer (> (point-max) (point-min)))
+ ;; There's some output, display it
+ (display-message-or-buffer buffer)
+ ;; No output; error?
+ (let ((output
+ (if (and error-file
+ (< 0 (nth 7 (file-attributes error-file))))
+ (format "some error output%s"
+ (if shell-command-default-error-buffer
+ (format " to the \"%s\" buffer"
+ shell-command-default-error-buffer)
+ ""))
+ "no output")))
+ (cond ((null exit-status)
+ (message "(Shell command failed with error)"))
+ ((equal 0 exit-status)
+ (message "(Shell command succeeded with %s)"
+ output))
+ ((stringp exit-status)
+ (message "(Shell command killed by signal %s)"
+ exit-status))
+ (t
+ (message "(Shell command failed with code %d and %s)"
+ exit-status output))))
+ ;; Don't kill: there might be useful info in the undo-log.
+ ;; (kill-buffer buffer)
+ ))))
+
+ (when (and error-file (file-exists-p error-file))
+ (if (< 0 (nth 7 (file-attributes error-file)))
+ (with-current-buffer (get-buffer-create error-buffer)
+ (let ((pos-from-end (- (point-max) (point))))
+ (or (bobp)
+ (insert "\f\n"))
+ ;; Do no formatting while reading error file,
+ ;; because that can run a shell command, and we
+ ;; don't want that to cause an infinite recursion.
+ (format-insert-file error-file nil)
+ ;; Put point after the inserted errors.
+ (goto-char (- (point-max) pos-from-end)))
+ (and display-error-buffer
+ (display-buffer (current-buffer)))))
+ (delete-file error-file))
+ exit-status))
+
+(defun shell-command-to-string (command)
+ "Execute shell command COMMAND and return its output as a string."
+ (with-output-to-string
+ (with-current-buffer
+ standard-output
+ (process-file shell-file-name nil t nil shell-command-switch command))))
+
+(defun process-file (program &optional infile buffer display &rest args)
+ "Process files synchronously in a separate process.
+Similar to `call-process', but may invoke a file handler based on
+`default-directory'. The current working directory of the
+subprocess is `default-directory'.
+
+File names in INFILE and BUFFER are handled normally, but file
+names in ARGS should be relative to `default-directory', as they
+are passed to the process verbatim. (This is a difference to
+`call-process' which does not support file handlers for INFILE
+and BUFFER.)
+
+Some file handlers might not support all variants, for example
+they might behave as if DISPLAY was nil, regardless of the actual
+value passed."
+ (let ((fh (find-file-name-handler default-directory 'process-file))
+ lc stderr-file)
+ (unwind-protect
+ (if fh (apply fh 'process-file program infile buffer display args)
+ (when infile (setq lc (file-local-copy infile)))
+ (setq stderr-file (when (and (consp buffer) (stringp (cadr buffer)))
+ (make-temp-file "emacs")))
+ (prog1
+ (apply 'call-process program
+ (or lc infile)
+ (if stderr-file (list (car buffer) stderr-file) buffer)
+ display args)
+ (when stderr-file (copy-file stderr-file (cadr buffer) t))))
+ (when stderr-file (delete-file stderr-file))
+ (when lc (delete-file lc)))))
+
+(defvar process-file-side-effects t
+ "Whether a call of `process-file' changes remote files.
+
+By default, this variable is always set to `t', meaning that a
+call of `process-file' could potentially change any file on a
+remote host. When set to `nil', a file handler could optimize
+its behavior with respect to remote file attribute caching.
+
+You should only ever change this variable with a let-binding;
+never with `setq'.")
+
+(defun start-file-process (name buffer program &rest program-args)
+ "Start a program in a subprocess. Return the process object for it.
+
+Similar to `start-process', but may invoke a file handler based on
+`default-directory'. See Info node `(elisp)Magic File Names'.
+
+This handler ought to run PROGRAM, perhaps on the local host,
+perhaps on a remote host that corresponds to `default-directory'.
+In the latter case, the local part of `default-directory' becomes
+the working directory of the process.
+
+PROGRAM and PROGRAM-ARGS might be file names. They are not
+objects of file handler invocation. File handlers might not
+support pty association, if PROGRAM is nil."
+ (let ((fh (find-file-name-handler default-directory 'start-file-process)))
+ (if fh (apply fh 'start-file-process name buffer program program-args)
+ (apply 'start-process name buffer program program-args))))
+
+;;;; Process menu
+
+(defvar tabulated-list-format)
+(defvar tabulated-list-entries)
+(defvar tabulated-list-sort-key)
+(declare-function tabulated-list-init-header "tabulated-list" ())
+(declare-function tabulated-list-print "tabulated-list"
+ (&optional remember-pos))
+
+(defvar process-menu-query-only nil)
+
+(define-derived-mode process-menu-mode tabulated-list-mode "Process Menu"
+ "Major mode for listing the processes called by Emacs."
+ (setq tabulated-list-format [("Process" 15 t)
+ ("Status" 7 t)
+ ("Buffer" 15 t)
+ ("TTY" 12 t)
+ ("Command" 0 t)])
+ (make-local-variable 'process-menu-query-only)
+ (setq tabulated-list-sort-key (cons "Process" nil))
+ (add-hook 'tabulated-list-revert-hook 'list-processes--refresh nil t)
+ (tabulated-list-init-header))
+
+(defun list-processes--refresh ()
+ "Recompute the list of processes for the Process List buffer.
+Also, delete any process that is exited or signaled."
+ (setq tabulated-list-entries nil)
+ (dolist (p (process-list))
+ (cond ((memq (process-status p) '(exit signal closed))
+ (delete-process p))
+ ((or (not process-menu-query-only)
+ (process-query-on-exit-flag p))
+ (let* ((buf (process-buffer p))
+ (type (process-type p))
+ (name (process-name p))
+ (status (symbol-name (process-status p)))
+ (buf-label (if (buffer-live-p buf)
+ `(,(buffer-name buf)
+ face link
+ help-echo ,(concat "Visit buffer `"
+ (buffer-name buf) "'")
+ follow-link t
+ process-buffer ,buf
+ action process-menu-visit-buffer)
+ "--"))
+ (tty (or (process-tty-name p) "--"))
+ (cmd
+ (if (memq type '(network serial))
+ (let ((contact (process-contact p t)))
+ (if (eq type 'network)
+ (format "(%s %s)"
+ (if (plist-get contact :type)
+ "datagram"
+ "network")
+ (if (plist-get contact :server)
+ (format "server on %s"
+ (or
+ (plist-get contact :host)
+ (plist-get contact :local)))
+ (format "connection to %s"
+ (plist-get contact :host))))
+ (format "(serial port %s%s)"
+ (or (plist-get contact :port) "?")
+ (let ((speed (plist-get contact :speed)))
+ (if speed
+ (format " at %s b/s" speed)
+ "")))))
+ (mapconcat 'identity (process-command p) " "))))
+ (push (list p (vector name status buf-label tty cmd))
+ tabulated-list-entries))))))
+
+(defun process-menu-visit-buffer (button)
+ (display-buffer (button-get button 'process-buffer)))
+
+(defun list-processes (&optional query-only buffer)
+ "Display a list of all processes that are Emacs sub-processes.
+If optional argument QUERY-ONLY is non-nil, only processes with
+the query-on-exit flag set are listed.
+Any process listed as exited or signaled is actually eliminated
+after the listing is made.
+Optional argument BUFFER specifies a buffer to use, instead of
+\"*Process List*\".
+The return value is always nil.
+
+This function lists only processes that were launched by Emacs. To
+see other processes running on the system, use `list-system-processes'."
+ (interactive)
+ (or (fboundp 'process-list)
+ (error "Asynchronous subprocesses are not supported on this system"))
+ (unless (bufferp buffer)
+ (setq buffer (get-buffer-create "*Process List*")))
+ (with-current-buffer buffer
+ (process-menu-mode)
+ (setq process-menu-query-only query-only)
+ (list-processes--refresh)
+ (tabulated-list-print))
+ (display-buffer buffer)
+ nil)
+
+(defvar universal-argument-map
+ (let ((map (make-sparse-keymap))
+ (universal-argument-minus
+ ;; For backward compatibility, minus with no modifiers is an ordinary
+ ;; command if digits have already been entered.
+ `(menu-item "" negative-argument
+ :filter ,(lambda (cmd)
+ (if (integerp prefix-arg) nil cmd)))))
+ (define-key map [switch-frame]
+ (lambda (e) (interactive "e")
+ (handle-switch-frame e) (universal-argument--mode)))
+ (define-key map [?\C-u] 'universal-argument-more)
+ (define-key map [?-] universal-argument-minus)
+ (define-key map [?0] 'digit-argument)
+ (define-key map [?1] 'digit-argument)
+ (define-key map [?2] 'digit-argument)
+ (define-key map [?3] 'digit-argument)
+ (define-key map [?4] 'digit-argument)
+ (define-key map [?5] 'digit-argument)
+ (define-key map [?6] 'digit-argument)
+ (define-key map [?7] 'digit-argument)
+ (define-key map [?8] 'digit-argument)
+ (define-key map [?9] 'digit-argument)
+ (define-key map [kp-0] 'digit-argument)
+ (define-key map [kp-1] 'digit-argument)
+ (define-key map [kp-2] 'digit-argument)
+ (define-key map [kp-3] 'digit-argument)
+ (define-key map [kp-4] 'digit-argument)
+ (define-key map [kp-5] 'digit-argument)
+ (define-key map [kp-6] 'digit-argument)
+ (define-key map [kp-7] 'digit-argument)
+ (define-key map [kp-8] 'digit-argument)
+ (define-key map [kp-9] 'digit-argument)
+ (define-key map [kp-subtract] universal-argument-minus)
+ map)
+ "Keymap used while processing \\[universal-argument].")
+
+(defun universal-argument--mode ()
+ (set-transient-map universal-argument-map))
+
+(defun universal-argument ()
+ "Begin a numeric argument for the following command.
+Digits or minus sign following \\[universal-argument] make up the numeric
argument.
+\\[universal-argument] following the digits or minus sign ends the argument.
+\\[universal-argument] without digits or minus sign provides 4 as argument.
+Repeating \\[universal-argument] without digits or minus sign
+ multiplies the argument by 4 each time.
+For some commands, just \\[universal-argument] by itself serves as a flag
+which is different in effect from any particular numeric argument.
+These commands include \\[set-mark-command] and \\[start-kbd-macro]."
+ (interactive)
+ (setq prefix-arg (list 4))
+ (universal-argument--mode))
+
+(defun universal-argument-more (arg)
+ ;; A subsequent C-u means to multiply the factor by 4 if we've typed
+ ;; nothing but C-u's; otherwise it means to terminate the prefix arg.
+ (interactive "P")
+ (setq prefix-arg (if (consp arg)
+ (list (* 4 (car arg)))
+ (if (eq arg '-)
+ (list -4)
+ arg)))
+ (when (consp prefix-arg) (universal-argument--mode)))
+
+(defun negative-argument (arg)
+ "Begin a negative numeric argument for the next command.
+\\[universal-argument] following digits or minus sign ends the argument."
+ (interactive "P")
+ (setq prefix-arg (cond ((integerp arg) (- arg))
+ ((eq arg '-) nil)
+ (t '-)))
+ (universal-argument--mode))
+
+(defun digit-argument (arg)
+ "Part of the numeric argument for the next command.
+\\[universal-argument] following digits or minus sign ends the argument."
+ (interactive "P")
+ (let* ((char (if (integerp last-command-event)
+ last-command-event
+ (get last-command-event 'ascii-character)))
+ (digit (- (logand char ?\177) ?0)))
+ (setq prefix-arg (cond ((integerp arg)
+ (+ (* arg 10)
+ (if (< arg 0) (- digit) digit)))
+ ((eq arg '-)
+ ;; Treat -0 as just -, so that -01 will work.
+ (if (zerop digit) '- (- digit)))
+ (t
+ digit))))
+ (universal-argument--mode))
+
+
+(defvar filter-buffer-substring-functions nil
+ "This variable is a wrapper hook around `buffer-substring--filter'.")
+(make-obsolete-variable 'filter-buffer-substring-functions
+ 'filter-buffer-substring-function "24.4")
+
+(defvar filter-buffer-substring-function #'buffer-substring--filter
+ "Function to perform the filtering in `filter-buffer-substring'.
+The function is called with the same 3 arguments (BEG END DELETE)
+that `filter-buffer-substring' received. It should return the
+buffer substring between BEG and END, after filtering. If DELETE is
+non-nil, it should delete the text between BEG and END from the buffer.")
+
+(defvar buffer-substring-filters nil
+ "List of filter functions for `buffer-substring--filter'.
+Each function must accept a single argument, a string, and return a string.
+The buffer substring is passed to the first function in the list,
+and the return value of each function is passed to the next.
+As a special convention, point is set to the start of the buffer text
+being operated on (i.e., the first argument of `buffer-substring--filter')
+before these functions are called.")
+(make-obsolete-variable 'buffer-substring-filters
+ 'filter-buffer-substring-function "24.1")
+
+(defun filter-buffer-substring (beg end &optional delete)
+ "Return the buffer substring between BEG and END, after filtering.
+If DELETE is non-nil, delete the text between BEG and END from the buffer.
+
+This calls the function that `filter-buffer-substring-function' specifies
+\(passing the same three arguments that it received) to do the work,
+and returns whatever it does. The default function does no filtering,
+unless a hook has been set.
+
+Use `filter-buffer-substring' instead of `buffer-substring',
+`buffer-substring-no-properties', or `delete-and-extract-region' when
+you want to allow filtering to take place. For example, major or minor
+modes can use `filter-buffer-substring-function' to extract characters
+that are special to a buffer, and should not be copied into other buffers."
+ (funcall filter-buffer-substring-function beg end delete))
+
+(defun buffer-substring--filter (beg end &optional delete)
+ "Default function to use for `filter-buffer-substring-function'.
+Its arguments and return value are as specified for `filter-buffer-substring'.
+This respects the wrapper hook `filter-buffer-substring-functions',
+and the abnormal hook `buffer-substring-filters'.
+No filtering is done unless a hook says to."
+ (with-wrapper-hook filter-buffer-substring-functions (beg end delete)
+ (cond
+ ((or delete buffer-substring-filters)
+ (save-excursion
+ (goto-char beg)
+ (let ((string (if delete (delete-and-extract-region beg end)
+ (buffer-substring beg end))))
+ (dolist (filter buffer-substring-filters)
+ (setq string (funcall filter string)))
+ string)))
+ (t
+ (buffer-substring beg end)))))
+
+
+;;;; Window system cut and paste hooks.
+
+(defvar interprogram-cut-function nil
+ "Function to call to make a killed region available to other programs.
+Most window systems provide a facility for cutting and pasting
+text between different programs, such as the clipboard on X and
+MS-Windows, or the pasteboard on Nextstep/Mac OS.
+
+This variable holds a function that Emacs calls whenever text is
+put in the kill ring, to make the new kill available to other
+programs. The function takes one argument, TEXT, which is a
+string containing the text which should be made available.")
+
+(defvar interprogram-paste-function nil
+ "Function to call to get text cut from other programs.
+Most window systems provide a facility for cutting and pasting
+text between different programs, such as the clipboard on X and
+MS-Windows, or the pasteboard on Nextstep/Mac OS.
+
+This variable holds a function that Emacs calls to obtain text
+that other programs have provided for pasting. The function is
+called with no arguments. If no other program has provided text
+to paste, the function should return nil (in which case the
+caller, usually `current-kill', should use the top of the Emacs
+kill ring). If another program has provided text to paste, the
+function should return that text as a string (in which case the
+caller should put this string in the kill ring as the latest
+kill).
+
+The function may also return a list of strings if the window
+system supports multiple selections. The first string will be
+used as the pasted text, but the other will be placed in the kill
+ring for easy access via `yank-pop'.
+
+Note that the function should return a string only if a program
+other than Emacs has provided a string for pasting; if Emacs
+provided the most recent string, the function should return nil.
+If it is difficult to tell whether Emacs or some other program
+provided the current string, it is probably good enough to return
+nil if the string is equal (according to `string=') to the last
+text Emacs provided.")
+
+
+
+;;;; The kill ring data structure.
+
+(defvar kill-ring nil
+ "List of killed text sequences.
+Since the kill ring is supposed to interact nicely with cut-and-paste
+facilities offered by window systems, use of this variable should
+interact nicely with `interprogram-cut-function' and
+`interprogram-paste-function'. The functions `kill-new',
+`kill-append', and `current-kill' are supposed to implement this
+interaction; you may want to use them instead of manipulating the kill
+ring directly.")
+
+(defcustom kill-ring-max 60
+ "Maximum length of kill ring before oldest elements are thrown away."
+ :type 'integer
+ :group 'killing)
+
+(defvar kill-ring-yank-pointer nil
+ "The tail of the kill ring whose car is the last thing yanked.")
+
+(defcustom save-interprogram-paste-before-kill nil
+ "Save clipboard strings into kill ring before replacing them.
+When one selects something in another program to paste it into Emacs,
+but kills something in Emacs before actually pasting it,
+this selection is gone unless this variable is non-nil,
+in which case the other program's selection is saved in the `kill-ring'
+before the Emacs kill and one can still paste it using \\[yank] \\[yank-pop]."
+ :type 'boolean
+ :group 'killing
+ :version "23.2")
+
+(defcustom kill-do-not-save-duplicates nil
+ "Do not add a new string to `kill-ring' if it duplicates the last one.
+The comparison is done using `equal-including-properties'."
+ :type 'boolean
+ :group 'killing
+ :version "23.2")
+
+(defun kill-new (string &optional replace)
+ "Make STRING the latest kill in the kill ring.
+Set `kill-ring-yank-pointer' to point to it.
+If `interprogram-cut-function' is non-nil, apply it to STRING.
+Optional second argument REPLACE non-nil means that STRING will replace
+the front of the kill ring, rather than being added to the list.
+
+When `save-interprogram-paste-before-kill' and `interprogram-paste-function'
+are non-nil, saves the interprogram paste string(s) into `kill-ring' before
+STRING.
+
+When the yank handler has a non-nil PARAM element, the original STRING
+argument is not used by `insert-for-yank'. However, since Lisp code
+may access and use elements from the kill ring directly, the STRING
+argument should still be a \"useful\" string for such uses."
+ (unless (and kill-do-not-save-duplicates
+ ;; Due to text properties such as 'yank-handler that
+ ;; can alter the contents to yank, comparison using
+ ;; `equal' is unsafe.
+ (equal-including-properties string (car kill-ring)))
+ (if (fboundp 'menu-bar-update-yank-menu)
+ (menu-bar-update-yank-menu string (and replace (car kill-ring)))))
+ (when save-interprogram-paste-before-kill
+ (let ((interprogram-paste (and interprogram-paste-function
+ (funcall interprogram-paste-function))))
+ (when interprogram-paste
+ (dolist (s (if (listp interprogram-paste)
+ (nreverse interprogram-paste)
+ (list interprogram-paste)))
+ (unless (and kill-do-not-save-duplicates
+ (equal-including-properties s (car kill-ring)))
+ (push s kill-ring))))))
+ (unless (and kill-do-not-save-duplicates
+ (equal-including-properties string (car kill-ring)))
+ (if (and replace kill-ring)
+ (setcar kill-ring string)
+ (push string kill-ring)
+ (if (> (length kill-ring) kill-ring-max)
+ (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil))))
+ (setq kill-ring-yank-pointer kill-ring)
+ (if interprogram-cut-function
+ (funcall interprogram-cut-function string)))
+
+(defun kill-append (string before-p)
+ "Append STRING to the end of the latest kill in the kill ring.
+If BEFORE-P is non-nil, prepend STRING to the kill.
+If `interprogram-cut-function' is set, pass the resulting kill to it."
+ (let* ((cur (car kill-ring)))
+ (kill-new (if before-p (concat string cur) (concat cur string))
+ (or (= (length cur) 0)
+ (equal nil (get-text-property 0 'yank-handler cur))))))
+
+(defcustom yank-pop-change-selection nil
+ "Whether rotating the kill ring changes the window system selection.
+If non-nil, whenever the kill ring is rotated (usually via the
+`yank-pop' command), Emacs also calls `interprogram-cut-function'
+to copy the new kill to the window system selection."
+ :type 'boolean
+ :group 'killing
+ :version "23.1")
+
+(defun current-kill (n &optional do-not-move)
+ "Rotate the yanking point by N places, and then return that kill.
+If N is zero and `interprogram-paste-function' is set to a
+function that returns a string or a list of strings, and if that
+function doesn't return nil, then that string (or list) is added
+to the front of the kill ring and the string (or first string in
+the list) is returned as the latest kill.
+
+If N is not zero, and if `yank-pop-change-selection' is
+non-nil, use `interprogram-cut-function' to transfer the
+kill at the new yank point into the window system selection.
+
+If optional arg DO-NOT-MOVE is non-nil, then don't actually
+move the yanking point; just return the Nth kill forward."
+
+ (let ((interprogram-paste (and (= n 0)
+ interprogram-paste-function
+ (funcall interprogram-paste-function))))
+ (if interprogram-paste
+ (progn
+ ;; Disable the interprogram cut function when we add the new
+ ;; text to the kill ring, so Emacs doesn't try to own the
+ ;; selection, with identical text.
+ (let ((interprogram-cut-function nil))
+ (if (listp interprogram-paste)
+ (mapc 'kill-new (nreverse interprogram-paste))
+ (kill-new interprogram-paste)))
+ (car kill-ring))
+ (or kill-ring (error "Kill ring is empty"))
+ (let ((ARGth-kill-element
+ (nthcdr (mod (- n (length kill-ring-yank-pointer))
+ (length kill-ring))
+ kill-ring)))
+ (unless do-not-move
+ (setq kill-ring-yank-pointer ARGth-kill-element)
+ (when (and yank-pop-change-selection
+ (> n 0)
+ interprogram-cut-function)
+ (funcall interprogram-cut-function (car ARGth-kill-element))))
+ (car ARGth-kill-element)))))
+
+
+
+;;;; Commands for manipulating the kill ring.
+
+(defcustom kill-read-only-ok nil
+ "Non-nil means don't signal an error for killing read-only text."
+ :type 'boolean
+ :group 'killing)
+
+(defun kill-region (beg end &optional region)
+ "Kill (\"cut\") text between point and mark.
+This deletes the text from the buffer and saves it in the kill ring.
+The command \\[yank] can retrieve it from there.
+\(If you want to save the region without killing it, use \\[kill-ring-save].)
+
+If you want to append the killed region to the last killed text,
+use \\[append-next-kill] before \\[kill-region].
+
+If the buffer is read-only, Emacs will beep and refrain from deleting
+the text, but put the text in the kill ring anyway. This means that
+you can use the killing commands to copy text from a read-only buffer.
+
+Lisp programs should use this function for killing text.
+ (To delete text, use `delete-region'.)
+Supply two arguments, character positions indicating the stretch of text
+ to be killed.
+Any command that calls this function is a \"kill command\".
+If the previous command was also a kill command,
+the text killed this time appends to the text killed last time
+to make one entry in the kill ring.
+
+The optional argument REGION if non-nil, indicates that we're not just killing
+some text between BEG and END, but we're killing the region."
+ ;; Pass mark first, then point, because the order matters when
+ ;; calling `kill-append'.
+ (interactive (list (mark) (point) 'region))
+ (unless (and beg end)
+ (error "The mark is not set now, so there is no region"))
+ (condition-case nil
+ (let ((string (if region
+ (funcall region-extract-function 'delete)
+ (filter-buffer-substring beg end 'delete))))
+ (when string ;STRING is nil if BEG = END
+ ;; Add that string to the kill ring, one way or another.
+ (if (eq last-command 'kill-region)
+ (kill-append string (< end beg))
+ (kill-new string nil)))
+ (when (or string (eq last-command 'kill-region))
+ (setq this-command 'kill-region))
+ (setq deactivate-mark t)
+ nil)
+ ((buffer-read-only text-read-only)
+ ;; The code above failed because the buffer, or some of the characters
+ ;; in the region, are read-only.
+ ;; We should beep, in case the user just isn't aware of this.
+ ;; However, there's no harm in putting
+ ;; the region's text in the kill ring, anyway.
+ (copy-region-as-kill beg end region)
+ ;; Set this-command now, so it will be set even if we get an error.
+ (setq this-command 'kill-region)
+ ;; This should barf, if appropriate, and give us the correct error.
+ (if kill-read-only-ok
+ (progn (message "Read only text copied to kill ring") nil)
+ ;; Signal an error if the buffer is read-only.
+ (barf-if-buffer-read-only)
+ ;; If the buffer isn't read-only, the text is.
+ (signal 'text-read-only (list (current-buffer)))))))
+
+;; copy-region-as-kill no longer sets this-command, because it's confusing
+;; to get two copies of the text when the user accidentally types M-w and
+;; then corrects it with the intended C-w.
+(defun copy-region-as-kill (beg end &optional region)
+ "Save the region as if killed, but don't kill it.
+In Transient Mark mode, deactivate the mark.
+If `interprogram-cut-function' is non-nil, also save the text for a window
+system cut and paste.
+
+The optional argument REGION if non-nil, indicates that we're not just copying
+some text between BEG and END, but we're copying the region.
+
+This command's old key binding has been given to `kill-ring-save'."
+ ;; Pass mark first, then point, because the order matters when
+ ;; calling `kill-append'.
+ (interactive (list (mark) (point)
+ (prefix-numeric-value current-prefix-arg)))
+ (let ((str (if region
+ (funcall region-extract-function nil)
+ (filter-buffer-substring beg end))))
+ (if (eq last-command 'kill-region)
+ (kill-append str (< end beg))
+ (kill-new str)))
+ (setq deactivate-mark t)
+ nil)
+
+(defun kill-ring-save (beg end &optional region)
+ "Save the region as if killed, but don't kill it.
+In Transient Mark mode, deactivate the mark.
+If `interprogram-cut-function' is non-nil, also save the text for a window
+system cut and paste.
+
+If you want to append the killed line to the last killed text,
+use \\[append-next-kill] before \\[kill-ring-save].
+
+The optional argument REGION if non-nil, indicates that we're not just copying
+some text between BEG and END, but we're copying the region.
+
+This command is similar to `copy-region-as-kill', except that it gives
+visual feedback indicating the extent of the region being copied."
+ ;; Pass mark first, then point, because the order matters when
+ ;; calling `kill-append'.
+ (interactive (list (mark) (point)
+ (prefix-numeric-value current-prefix-arg)))
+ (copy-region-as-kill beg end region)
+ ;; This use of called-interactively-p is correct because the code it
+ ;; controls just gives the user visual feedback.
+ (if (called-interactively-p 'interactive)
+ (indicate-copied-region)))
+
+(defun indicate-copied-region (&optional message-len)
+ "Indicate that the region text has been copied interactively.
+If the mark is visible in the selected window, blink the cursor
+between point and mark if there is currently no active region
+highlighting.
+
+If the mark lies outside the selected window, display an
+informative message containing a sample of the copied text. The
+optional argument MESSAGE-LEN, if non-nil, specifies the length
+of this sample text; it defaults to 40."
+ (let ((mark (mark t))
+ (point (point))
+ ;; Inhibit quitting so we can make a quit here
+ ;; look like a C-g typed as a command.
+ (inhibit-quit t))
+ (if (pos-visible-in-window-p mark (selected-window))
+ ;; Swap point-and-mark quickly so as to show the region that
+ ;; was selected. Don't do it if the region is highlighted.
+ (unless (and (region-active-p)
+ (face-background 'region))
+ ;; Swap point and mark.
+ (set-marker (mark-marker) (point) (current-buffer))
+ (goto-char mark)
+ (sit-for blink-matching-delay)
+ ;; Swap back.
+ (set-marker (mark-marker) mark (current-buffer))
+ (goto-char point)
+ ;; If user quit, deactivate the mark
+ ;; as C-g would as a command.
+ (and quit-flag mark-active
+ (deactivate-mark)))
+ (let ((len (min (abs (- mark point))
+ (or message-len 40))))
+ (if (< point mark)
+ ;; Don't say "killed"; that is misleading.
+ (message "Saved text until \"%s\""
+ (buffer-substring-no-properties (- mark len) mark))
+ (message "Saved text from \"%s\""
+ (buffer-substring-no-properties mark (+ mark len))))))))
+
+(defun append-next-kill (&optional interactive)
+ "Cause following command, if it kills, to add to previous kill.
+If the next command kills forward from point, the kill is
+appended to the previous killed text. If the command kills
+backward, the kill is prepended. Kill commands that act on the
+region, such as `kill-region', are regarded as killing forward if
+point is after mark, and killing backward if point is before
+mark.
+
+If the next command is not a kill command, `append-next-kill' has
+no effect.
+
+The argument is used for internal purposes; do not supply one."
+ (interactive "p")
+ ;; We don't use (interactive-p), since that breaks kbd macros.
+ (if interactive
+ (progn
+ (setq this-command 'kill-region)
+ (message "If the next command is a kill, it will append"))
+ (setq last-command 'kill-region)))
+
+;; Yanking.
+
+(defcustom yank-handled-properties
+ '((font-lock-face . yank-handle-font-lock-face-property)
+ (category . yank-handle-category-property))
+ "List of special text property handling conditions for yanking.
+Each element should have the form (PROP . FUN), where PROP is a
+property symbol and FUN is a function. When the `yank' command
+inserts text into the buffer, it scans the inserted text for
+stretches of text that have `eq' values of the text property
+PROP; for each such stretch of text, FUN is called with three
+arguments: the property's value in that text, and the start and
+end positions of the text.
+
+This is done prior to removing the properties specified by
+`yank-excluded-properties'."
+ :group 'killing
+ :type '(repeat (cons (symbol :tag "property symbol")
+ function))
+ :version "24.3")
+
+;; This is actually used in subr.el but defcustom does not work there.
+(defcustom yank-excluded-properties
+ '(category field follow-link fontified font-lock-face help-echo
+ intangible invisible keymap local-map mouse-face read-only
+ yank-handler)
+ "Text properties to discard when yanking.
+The value should be a list of text properties to discard or t,
+which means to discard all text properties.
+
+See also `yank-handled-properties'."
+ :type '(choice (const :tag "All" t) (repeat symbol))
+ :group 'killing
+ :version "24.3")
+
+(defvar yank-window-start nil)
+(defvar yank-undo-function nil
+ "If non-nil, function used by `yank-pop' to delete last stretch of yanked
text.
+Function is called with two parameters, START and END corresponding to
+the value of the mark and point; it is guaranteed that START <= END.
+Normally set from the UNDO element of a yank-handler; see `insert-for-yank'.")
+
+(defun yank-pop (&optional arg)
+ "Replace just-yanked stretch of killed text with a different stretch.
+This command is allowed only immediately after a `yank' or a `yank-pop'.
+At such a time, the region contains a stretch of reinserted
+previously-killed text. `yank-pop' deletes that text and inserts in its
+place a different stretch of killed text.
+
+With no argument, the previous kill is inserted.
+With argument N, insert the Nth previous kill.
+If N is negative, this is a more recent kill.
+
+The sequence of kills wraps around, so that after the oldest one
+comes the newest one.
+
+When this command inserts killed text into the buffer, it honors
+`yank-excluded-properties' and `yank-handler' as described in the
+doc string for `insert-for-yank-1', which see."
+ (interactive "*p")
+ (if (not (eq last-command 'yank))
+ (error "Previous command was not a yank"))
+ (setq this-command 'yank)
+ (unless arg (setq arg 1))
+ (let ((inhibit-read-only t)
+ (before (< (point) (mark t))))
+ (if before
+ (funcall (or yank-undo-function 'delete-region) (point) (mark t))
+ (funcall (or yank-undo-function 'delete-region) (mark t) (point)))
+ (setq yank-undo-function nil)
+ (set-marker (mark-marker) (point) (current-buffer))
+ (insert-for-yank (current-kill arg))
+ ;; Set the window start back where it was in the yank command,
+ ;; if possible.
+ (set-window-start (selected-window) yank-window-start t)
+ (if before
+ ;; This is like exchange-point-and-mark, but doesn't activate the mark.
+ ;; It is cleaner to avoid activation, even though the command
+ ;; loop would deactivate the mark because we inserted text.
+ (goto-char (prog1 (mark t)
+ (set-marker (mark-marker) (point) (current-buffer))))))
+ nil)
+
+(defun yank (&optional arg)
+ "Reinsert (\"paste\") the last stretch of killed text.
+More precisely, reinsert the most recent kill, which is the
+stretch of killed text most recently killed OR yanked. Put point
+at the end, and set mark at the beginning without activating it.
+With just \\[universal-argument] as argument, put point at beginning, and mark
at end.
+With argument N, reinsert the Nth most recent kill.
+
+When this command inserts text into the buffer, it honors the
+`yank-handled-properties' and `yank-excluded-properties'
+variables, and the `yank-handler' text property. See
+`insert-for-yank-1' for details.
+
+See also the command `yank-pop' (\\[yank-pop])."
+ (interactive "*P")
+ (setq yank-window-start (window-start))
+ ;; If we don't get all the way thru, make last-command indicate that
+ ;; for the following command.
+ (setq this-command t)
+ (push-mark (point))
+ (insert-for-yank (current-kill (cond
+ ((listp arg) 0)
+ ((eq arg '-) -2)
+ (t (1- arg)))))
+ (if (consp arg)
+ ;; This is like exchange-point-and-mark, but doesn't activate the mark.
+ ;; It is cleaner to avoid activation, even though the command
+ ;; loop would deactivate the mark because we inserted text.
+ (goto-char (prog1 (mark t)
+ (set-marker (mark-marker) (point) (current-buffer)))))
+ ;; If we do get all the way thru, make this-command indicate that.
+ (if (eq this-command t)
+ (setq this-command 'yank))
+ nil)
+
+(defun rotate-yank-pointer (arg)
+ "Rotate the yanking point in the kill ring.
+With ARG, rotate that many kills forward (or backward, if negative)."
+ (interactive "p")
+ (current-kill arg))
+
+;; Some kill commands.
+
+;; Internal subroutine of delete-char
+(defun kill-forward-chars (arg)
+ (if (listp arg) (setq arg (car arg)))
+ (if (eq arg '-) (setq arg -1))
+ (kill-region (point) (+ (point) arg)))
+
+;; Internal subroutine of backward-delete-char
+(defun kill-backward-chars (arg)
+ (if (listp arg) (setq arg (car arg)))
+ (if (eq arg '-) (setq arg -1))
+ (kill-region (point) (- (point) arg)))
+
+(defcustom backward-delete-char-untabify-method 'untabify
+ "The method for untabifying when deleting backward.
+Can be `untabify' -- turn a tab to many spaces, then delete one space;
+ `hungry' -- delete all whitespace, both tabs and spaces;
+ `all' -- delete all whitespace, including tabs, spaces and newlines;
+ nil -- just delete one character."
+ :type '(choice (const untabify) (const hungry) (const all) (const nil))
+ :version "20.3"
+ :group 'killing)
+
+(defun backward-delete-char-untabify (arg &optional killp)
+ "Delete characters backward, changing tabs into spaces.
+The exact behavior depends on `backward-delete-char-untabify-method'.
+Delete ARG chars, and kill (save in kill ring) if KILLP is non-nil.
+Interactively, ARG is the prefix arg (default 1)
+and KILLP is t if a prefix arg was specified."
+ (interactive "*p\nP")
+ (when (eq backward-delete-char-untabify-method 'untabify)
+ (let ((count arg))
+ (save-excursion
+ (while (and (> count 0) (not (bobp)))
+ (if (= (preceding-char) ?\t)
+ (let ((col (current-column)))
+ (forward-char -1)
+ (setq col (- col (current-column)))
+ (insert-char ?\s col)
+ (delete-char 1)))
+ (forward-char -1)
+ (setq count (1- count))))))
+ (let* ((skip (cond ((eq backward-delete-char-untabify-method 'hungry) " \t")
+ ((eq backward-delete-char-untabify-method 'all)
+ " \t\n\r")))
+ (n (if skip
+ (let* ((oldpt (point))
+ (wh (- oldpt (save-excursion
+ (skip-chars-backward skip)
+ (constrain-to-field nil oldpt)))))
+ (+ arg (if (zerop wh) 0 (1- wh))))
+ arg)))
+ ;; Avoid warning about delete-backward-char
+ (with-no-warnings (delete-backward-char n killp))))
+
+(defun zap-to-char (arg char)
+ "Kill up to and including ARGth occurrence of CHAR.
+Case is ignored if `case-fold-search' is non-nil in the current buffer.
+Goes backward if ARG is negative; error if CHAR not found."
+ (interactive (list (prefix-numeric-value current-prefix-arg)
+ (read-char "Zap to char: " t)))
+ ;; Avoid "obsolete" warnings for translation-table-for-input.
+ (with-no-warnings
+ (if (char-table-p translation-table-for-input)
+ (setq char (or (aref translation-table-for-input char) char))))
+ (kill-region (point) (progn
+ (search-forward (char-to-string char) nil nil arg)
+ (point))))
+
+;; kill-line and its subroutines.
+
+(defcustom kill-whole-line nil
+ "If non-nil, `kill-line' with no arg at start of line kills the whole line."
+ :type 'boolean
+ :group 'killing)
+
+(defun kill-line (&optional arg)
+ "Kill the rest of the current line; if no nonblanks there, kill thru newline.
+With prefix argument ARG, kill that many lines from point.
+Negative arguments kill lines backward.
+With zero argument, kills the text before point on the current line.
+
+When calling from a program, nil means \"no arg\",
+a number counts as a prefix arg.
+
+To kill a whole line, when point is not at the beginning, type \
+\\[move-beginning-of-line] \\[kill-line] \\[kill-line].
+
+If `show-trailing-whitespace' is non-nil, this command will just
+kill the rest of the current line, even if there are only
+nonblanks there.
+
+If option `kill-whole-line' is non-nil, then this command kills the whole line
+including its terminating newline, when used at the beginning of a line
+with no argument. As a consequence, you can always kill a whole line
+by typing \\[move-beginning-of-line] \\[kill-line].
+
+If you want to append the killed line to the last killed text,
+use \\[append-next-kill] before \\[kill-line].
+
+If the buffer is read-only, Emacs will beep and refrain from deleting
+the line, but put the line in the kill ring anyway. This means that
+you can use this command to copy text from a read-only buffer.
+\(If the variable `kill-read-only-ok' is non-nil, then this won't
+even beep.)"
+ (interactive "P")
+ (kill-region (point)
+ ;; It is better to move point to the other end of the kill
+ ;; before killing. That way, in a read-only buffer, point
+ ;; moves across the text that is copied to the kill ring.
+ ;; The choice has no effect on undo now that undo records
+ ;; the value of point from before the command was run.
+ (progn
+ (if arg
+ (forward-visible-line (prefix-numeric-value arg))
+ (if (eobp)
+ (signal 'end-of-buffer nil))
+ (let ((end
+ (save-excursion
+ (end-of-visible-line) (point))))
+ (if (or (save-excursion
+ ;; If trailing whitespace is visible,
+ ;; don't treat it as nothing.
+ (unless show-trailing-whitespace
+ (skip-chars-forward " \t" end))
+ (= (point) end))
+ (and kill-whole-line (bolp)))
+ (forward-visible-line 1)
+ (goto-char end))))
+ (point))))
+
+(defun kill-whole-line (&optional arg)
+ "Kill current line.
+With prefix ARG, kill that many lines starting from the current line.
+If ARG is negative, kill backward. Also kill the preceding newline.
+\(This is meant to make \\[repeat] work well with negative arguments.)
+If ARG is zero, kill current line but exclude the trailing newline."
+ (interactive "p")
+ (or arg (setq arg 1))
+ (if (and (> arg 0) (eobp) (save-excursion (forward-visible-line 0) (eobp)))
+ (signal 'end-of-buffer nil))
+ (if (and (< arg 0) (bobp) (save-excursion (end-of-visible-line) (bobp)))
+ (signal 'beginning-of-buffer nil))
+ (unless (eq last-command 'kill-region)
+ (kill-new "")
+ (setq last-command 'kill-region))
+ (cond ((zerop arg)
+ ;; We need to kill in two steps, because the previous command
+ ;; could have been a kill command, in which case the text
+ ;; before point needs to be prepended to the current kill
+ ;; ring entry and the text after point appended. Also, we
+ ;; need to use save-excursion to avoid copying the same text
+ ;; twice to the kill ring in read-only buffers.
+ (save-excursion
+ (kill-region (point) (progn (forward-visible-line 0) (point))))
+ (kill-region (point) (progn (end-of-visible-line) (point))))
+ ((< arg 0)
+ (save-excursion
+ (kill-region (point) (progn (end-of-visible-line) (point))))
+ (kill-region (point)
+ (progn (forward-visible-line (1+ arg))
+ (unless (bobp) (backward-char))
+ (point))))
+ (t
+ (save-excursion
+ (kill-region (point) (progn (forward-visible-line 0) (point))))
+ (kill-region (point)
+ (progn (forward-visible-line arg) (point))))))
+
+(defun forward-visible-line (arg)
+ "Move forward by ARG lines, ignoring currently invisible newlines only.
+If ARG is negative, move backward -ARG lines.
+If ARG is zero, move to the beginning of the current line."
+ (condition-case nil
+ (if (> arg 0)
+ (progn
+ (while (> arg 0)
+ (or (zerop (forward-line 1))
+ (signal 'end-of-buffer nil))
+ ;; If the newline we just skipped is invisible,
+ ;; don't count it.
+ (let ((prop
+ (get-char-property (1- (point)) 'invisible)))
+ (if (if (eq buffer-invisibility-spec t)
+ prop
+ (or (memq prop buffer-invisibility-spec)
+ (assq prop buffer-invisibility-spec)))
+ (setq arg (1+ arg))))
+ (setq arg (1- arg)))
+ ;; If invisible text follows, and it is a number of complete lines,
+ ;; skip it.
+ (let ((opoint (point)))
+ (while (and (not (eobp))
+ (let ((prop
+ (get-char-property (point) 'invisible)))
+ (if (eq buffer-invisibility-spec t)
+ prop
+ (or (memq prop buffer-invisibility-spec)
+ (assq prop buffer-invisibility-spec)))))
+ (goto-char
+ (if (get-text-property (point) 'invisible)
+ (or (next-single-property-change (point) 'invisible)
+ (point-max))
+ (next-overlay-change (point)))))
+ (unless (bolp)
+ (goto-char opoint))))
+ (let ((first t))
+ (while (or first (<= arg 0))
+ (if first
+ (beginning-of-line)
+ (or (zerop (forward-line -1))
+ (signal 'beginning-of-buffer nil)))
+ ;; If the newline we just moved to is invisible,
+ ;; don't count it.
+ (unless (bobp)
+ (let ((prop
+ (get-char-property (1- (point)) 'invisible)))
+ (unless (if (eq buffer-invisibility-spec t)
+ prop
+ (or (memq prop buffer-invisibility-spec)
+ (assq prop buffer-invisibility-spec)))
+ (setq arg (1+ arg)))))
+ (setq first nil))
+ ;; If invisible text follows, and it is a number of complete lines,
+ ;; skip it.
+ (let ((opoint (point)))
+ (while (and (not (bobp))
+ (let ((prop
+ (get-char-property (1- (point)) 'invisible)))
+ (if (eq buffer-invisibility-spec t)
+ prop
+ (or (memq prop buffer-invisibility-spec)
+ (assq prop buffer-invisibility-spec)))))
+ (goto-char
+ (if (get-text-property (1- (point)) 'invisible)
+ (or (previous-single-property-change (point) 'invisible)
+ (point-min))
+ (previous-overlay-change (point)))))
+ (unless (bolp)
+ (goto-char opoint)))))
+ ((beginning-of-buffer end-of-buffer)
+ nil)))
+
+(defun end-of-visible-line ()
+ "Move to end of current visible line."
+ (end-of-line)
+ ;; If the following character is currently invisible,
+ ;; skip all characters with that same `invisible' property value,
+ ;; then find the next newline.
+ (while (and (not (eobp))
+ (save-excursion
+ (skip-chars-forward "^\n")
+ (let ((prop
+ (get-char-property (point) 'invisible)))
+ (if (eq buffer-invisibility-spec t)
+ prop
+ (or (memq prop buffer-invisibility-spec)
+ (assq prop buffer-invisibility-spec))))))
+ (skip-chars-forward "^\n")
+ (if (get-text-property (point) 'invisible)
+ (goto-char (or (next-single-property-change (point) 'invisible)
+ (point-max)))
+ (goto-char (next-overlay-change (point))))
+ (end-of-line)))
+
+(defun insert-buffer (buffer)
+ "Insert after point the contents of BUFFER.
+Puts mark after the inserted text.
+BUFFER may be a buffer or a buffer name.
+
+This function is meant for the user to run interactively.
+Don't call it from programs: use `insert-buffer-substring' instead!"
+ (interactive
+ (list
+ (progn
+ (barf-if-buffer-read-only)
+ (read-buffer "Insert buffer: "
+ (if (eq (selected-window) (next-window))
+ (other-buffer (current-buffer))
+ (window-buffer (next-window)))
+ t))))
+ (push-mark
+ (save-excursion
+ (insert-buffer-substring (get-buffer buffer))
+ (point)))
+ nil)
+(put 'insert-buffer 'interactive-only 'insert-buffer-substring)
+
+(defun append-to-buffer (buffer start end)
+ "Append to specified buffer the text of the region.
+It is inserted into that buffer before its point.
+
+When calling from a program, give three arguments:
+BUFFER (or buffer name), START and END.
+START and END specify the portion of the current buffer to be copied."
+ (interactive
+ (list (read-buffer "Append to buffer: " (other-buffer (current-buffer) t))
+ (region-beginning) (region-end)))
+ (let* ((oldbuf (current-buffer))
+ (append-to (get-buffer-create buffer))
+ (windows (get-buffer-window-list append-to t t))
+ point)
+ (save-excursion
+ (with-current-buffer append-to
+ (setq point (point))
+ (barf-if-buffer-read-only)
+ (insert-buffer-substring oldbuf start end)
+ (dolist (window windows)
+ (when (= (window-point window) point)
+ (set-window-point window (point))))))))
+
+(defun prepend-to-buffer (buffer start end)
+ "Prepend to specified buffer the text of the region.
+It is inserted into that buffer after its point.
+
+When calling from a program, give three arguments:
+BUFFER (or buffer name), START and END.
+START and END specify the portion of the current buffer to be copied."
+ (interactive "BPrepend to buffer: \nr")
+ (let ((oldbuf (current-buffer)))
+ (with-current-buffer (get-buffer-create buffer)
+ (barf-if-buffer-read-only)
+ (save-excursion
+ (insert-buffer-substring oldbuf start end)))))
+
+(defun copy-to-buffer (buffer start end)
+ "Copy to specified buffer the text of the region.
+It is inserted into that buffer, replacing existing text there.
+
+When calling from a program, give three arguments:
+BUFFER (or buffer name), START and END.
+START and END specify the portion of the current buffer to be copied."
+ (interactive "BCopy to buffer: \nr")
+ (let ((oldbuf (current-buffer)))
+ (with-current-buffer (get-buffer-create buffer)
+ (barf-if-buffer-read-only)
+ (erase-buffer)
+ (save-excursion
+ (insert-buffer-substring oldbuf start end)))))
+
+(define-error 'mark-inactive (purecopy "The mark is not active now"))
+
+(defvar activate-mark-hook nil
+ "Hook run when the mark becomes active.
+It is also run at the end of a command, if the mark is active and
+it is possible that the region may have changed.")
+
+(defvar deactivate-mark-hook nil
+ "Hook run when the mark becomes inactive.")
+
+(defun mark (&optional force)
+ "Return this buffer's mark value as integer, or nil if never set.
+
+In Transient Mark mode, this function signals an error if
+the mark is not active. However, if `mark-even-if-inactive' is non-nil,
+or the argument FORCE is non-nil, it disregards whether the mark
+is active, and returns an integer or nil in the usual way.
+
+If you are using this in an editing command, you are most likely making
+a mistake; see the documentation of `set-mark'."
+ (if (or force (not transient-mark-mode) mark-active mark-even-if-inactive)
+ (marker-position (mark-marker))
+ (signal 'mark-inactive nil)))
+
+;; Behind display-selections-p.
+(declare-function x-selection-owner-p "xselect.c"
+ (&optional selection terminal))
+(declare-function x-selection-exists-p "xselect.c"
+ (&optional selection terminal))
+
+(defun deactivate-mark (&optional force)
+ "Deactivate the mark.
+If Transient Mark mode is disabled, this function normally does
+nothing; but if FORCE is non-nil, it deactivates the mark anyway.
+
+Deactivating the mark sets `mark-active' to nil, updates the
+primary selection according to `select-active-regions', and runs
+`deactivate-mark-hook'.
+
+If Transient Mark mode was temporarily enabled, reset the value
+of the variable `transient-mark-mode'; if this causes Transient
+Mark mode to be disabled, don't change `mark-active' to nil or
+run `deactivate-mark-hook'."
+ (when (or transient-mark-mode force)
+ (when (and (if (eq select-active-regions 'only)
+ (eq (car-safe transient-mark-mode) 'only)
+ select-active-regions)
+ (region-active-p)
+ (display-selections-p))
+ ;; The var `saved-region-selection', if non-nil, is the text in
+ ;; the region prior to the last command modifying the buffer.
+ ;; Set the selection to that, or to the current region.
+ (cond (saved-region-selection
+ (if (x-selection-owner-p 'PRIMARY)
+ (x-set-selection 'PRIMARY saved-region-selection))
+ (setq saved-region-selection nil))
+ ;; If another program has acquired the selection, region
+ ;; deactivation should not clobber it (Bug#11772).
+ ((and (/= (region-beginning) (region-end))
+ (or (x-selection-owner-p 'PRIMARY)
+ (null (x-selection-exists-p 'PRIMARY))))
+ (x-set-selection 'PRIMARY
+ (funcall region-extract-function nil)))))
+ (when mark-active (force-mode-line-update)) ;Refresh toolbar (bug#16382).
+ (cond
+ ((eq (car-safe transient-mark-mode) 'only)
+ (setq transient-mark-mode (cdr transient-mark-mode)))
+ ((eq transient-mark-mode 'lambda)
+ (setq transient-mark-mode nil)))
+ (setq mark-active nil)
+ (run-hooks 'deactivate-mark-hook)
+ (redisplay--update-region-highlight (selected-window))))
+
+(defun activate-mark (&optional no-tmm)
+ "Activate the mark.
+If NO-TMM is non-nil, leave `transient-mark-mode' alone."
+ (when (mark t)
+ (unless (region-active-p)
+ (force-mode-line-update) ;Refresh toolbar (bug#16382).
+ (setq mark-active t)
+ (unless (or transient-mark-mode no-tmm)
+ (setq transient-mark-mode 'lambda))
+ (run-hooks 'activate-mark-hook))))
+
+(defun set-mark (pos)
+ "Set this buffer's mark to POS. Don't use this function!
+That is to say, don't use this function unless you want
+the user to see that the mark has moved, and you want the previous
+mark position to be lost.
+
+Normally, when a new mark is set, the old one should go on the stack.
+This is why most applications should use `push-mark', not `set-mark'.
+
+Novice Emacs Lisp programmers often try to use the mark for the wrong
+purposes. The mark saves a location for the user's convenience.
+Most editing commands should not alter the mark.
+To remember a location for internal use in the Lisp program,
+store it in a Lisp variable. Example:
+
+ (let ((beg (point))) (forward-line 1) (delete-region beg (point)))."
+ (if pos
+ (progn
+ (set-marker (mark-marker) pos (current-buffer))
+ (activate-mark 'no-tmm))
+ ;; Normally we never clear mark-active except in Transient Mark mode.
+ ;; But when we actually clear out the mark value too, we must
+ ;; clear mark-active in any mode.
+ (deactivate-mark t)
+ ;; `deactivate-mark' sometimes leaves mark-active non-nil, but
+ ;; it should never be nil if the mark is nil.
+ (setq mark-active nil)
+ (set-marker (mark-marker) nil)))
+
+(defcustom use-empty-active-region nil
+ "Whether \"region-aware\" commands should act on empty regions.
+If nil, region-aware commands treat empty regions as inactive.
+If non-nil, region-aware commands treat the region as active as
+long as the mark is active, even if the region is empty.
+
+Region-aware commands are those that act on the region if it is
+active and Transient Mark mode is enabled, and on the text near
+point otherwise."
+ :type 'boolean
+ :version "23.1"
+ :group 'editing-basics)
+
+(defun use-region-p ()
+ "Return t if the region is active and it is appropriate to act on it.
+This is used by commands that act specially on the region under
+Transient Mark mode.
+
+The return value is t if Transient Mark mode is enabled and the
+mark is active; furthermore, if `use-empty-active-region' is nil,
+the region must not be empty. Otherwise, the return value is nil.
+
+For some commands, it may be appropriate to ignore the value of
+`use-empty-active-region'; in that case, use `region-active-p'."
+ (and (region-active-p)
+ (or use-empty-active-region (> (region-end) (region-beginning)))))
+
+(defun region-active-p ()
+ "Return t if Transient Mark mode is enabled and the mark is active.
+
+Some commands act specially on the region when Transient Mark
+mode is enabled. Usually, such commands should use
+`use-region-p' instead of this function, because `use-region-p'
+also checks the value of `use-empty-active-region'."
+ (and transient-mark-mode mark-active
+ ;; FIXME: Somehow we sometimes end up with mark-active non-nil but
+ ;; without the mark being set (e.g. bug#17324). We really should fix
+ ;; that problem, but in the mean time, let's make sure we don't say the
+ ;; region is active when there's no mark.
+ (mark)))
+
+
+(defvar redisplay-unhighlight-region-function
+ (lambda (rol) (when (overlayp rol) (delete-overlay rol))))
+
+(defvar redisplay-highlight-region-function
+ (lambda (start end window rol)
+ (if (not (overlayp rol))
+ (let ((nrol (make-overlay start end)))
+ (funcall redisplay-unhighlight-region-function rol)
+ (overlay-put nrol 'window window)
+ (overlay-put nrol 'face 'region)
+ ;; Normal priority so that a large region doesn't hide all the
+ ;; overlays within it, but high secondary priority so that if it
+ ;; ends/starts in the middle of a small overlay, that small overlay
+ ;; won't hide the region's boundaries.
+ (overlay-put nrol 'priority '(nil . 100))
+ nrol)
+ (unless (and (eq (overlay-buffer rol) (current-buffer))
+ (eq (overlay-start rol) start)
+ (eq (overlay-end rol) end))
+ (move-overlay rol start end (current-buffer)))
+ rol)))
+
+(defun redisplay--update-region-highlight (window)
+ (with-current-buffer (window-buffer window)
+ (let ((rol (window-parameter window 'internal-region-overlay)))
+ (if (not (region-active-p))
+ (funcall redisplay-unhighlight-region-function rol)
+ (let* ((pt (window-point window))
+ (mark (mark))
+ (start (min pt mark))
+ (end (max pt mark))
+ (new
+ (funcall redisplay-highlight-region-function
+ start end window rol)))
+ (unless (equal new rol)
+ (set-window-parameter window 'internal-region-overlay
+ new)))))))
+
+(defun redisplay--update-region-highlights (windows)
+ (with-demoted-errors "redisplay--update-region-highlights: %S"
+ (if (null windows)
+ (redisplay--update-region-highlight (selected-window))
+ (unless (listp windows) (setq windows (window-list-1 nil nil t)))
+ (if highlight-nonselected-windows
+ (mapc #'redisplay--update-region-highlight windows)
+ (let ((msw (and (window-minibuffer-p) (minibuffer-selected-window))))
+ (dolist (w windows)
+ (if (or (eq w (selected-window)) (eq w msw))
+ (redisplay--update-region-highlight w)
+ (funcall redisplay-unhighlight-region-function
+ (window-parameter w 'internal-region-overlay)))))))))
+
+(add-function :before pre-redisplay-function
+ #'redisplay--update-region-highlights)
+
+
+(defvar-local mark-ring nil
+ "The list of former marks of the current buffer, most recent first.")
+(put 'mark-ring 'permanent-local t)
+
+(defcustom mark-ring-max 16
+ "Maximum size of mark ring. Start discarding off end if gets this big."
+ :type 'integer
+ :group 'editing-basics)
+
+(defvar global-mark-ring nil
+ "The list of saved global marks, most recent first.")
+
+(defcustom global-mark-ring-max 16
+ "Maximum size of global mark ring. \
+Start discarding off end if gets this big."
+ :type 'integer
+ :group 'editing-basics)
+
+(defun pop-to-mark-command ()
+ "Jump to mark, and pop a new position for mark off the ring.
+\(Does not affect global mark ring)."
+ (interactive)
+ (if (null (mark t))
+ (error "No mark set in this buffer")
+ (if (= (point) (mark t))
+ (message "Mark popped"))
+ (goto-char (mark t))
+ (pop-mark)))
+
+(defun push-mark-command (arg &optional nomsg)
+ "Set mark at where point is.
+If no prefix ARG and mark is already set there, just activate it.
+Display `Mark set' unless the optional second arg NOMSG is non-nil."
+ (interactive "P")
+ (let ((mark (mark t)))
+ (if (or arg (null mark) (/= mark (point)))
+ (push-mark nil nomsg t)
+ (activate-mark 'no-tmm)
+ (unless nomsg
+ (message "Mark activated")))))
+
+(defcustom set-mark-command-repeat-pop nil
+ "Non-nil means repeating \\[set-mark-command] after popping mark pops it
again.
+That means that C-u \\[set-mark-command] \\[set-mark-command]
+will pop the mark twice, and
+C-u \\[set-mark-command] \\[set-mark-command] \\[set-mark-command]
+will pop the mark three times.
+
+A value of nil means \\[set-mark-command]'s behavior does not change
+after C-u \\[set-mark-command]."
+ :type 'boolean
+ :group 'editing-basics)
+
+(defun set-mark-command (arg)
+ "Set the mark where point is, or jump to the mark.
+Setting the mark also alters the region, which is the text
+between point and mark; this is the closest equivalent in
+Emacs to what some editors call the \"selection\".
+
+With no prefix argument, set the mark at point, and push the
+old mark position on local mark ring. Also push the old mark on
+global mark ring, if the previous mark was set in another buffer.
+
+When Transient Mark Mode is off, immediately repeating this
+command activates `transient-mark-mode' temporarily.
+
+With prefix argument (e.g., \\[universal-argument] \\[set-mark-command]), \
+jump to the mark, and set the mark from
+position popped off the local mark ring (this does not affect the global
+mark ring). Use \\[pop-global-mark] to jump to a mark popped off the global
+mark ring (see `pop-global-mark').
+
+If `set-mark-command-repeat-pop' is non-nil, repeating
+the \\[set-mark-command] command with no prefix argument pops the next position
+off the local (or global) mark ring and jumps there.
+
+With \\[universal-argument] \\[universal-argument] as prefix
+argument, unconditionally set mark where point is, even if
+`set-mark-command-repeat-pop' is non-nil.
+
+Novice Emacs Lisp programmers often try to use the mark for the wrong
+purposes. See the documentation of `set-mark' for more information."
+ (interactive "P")
+ (cond ((eq transient-mark-mode 'lambda)
+ (setq transient-mark-mode nil))
+ ((eq (car-safe transient-mark-mode) 'only)
+ (deactivate-mark)))
+ (cond
+ ((and (consp arg) (> (prefix-numeric-value arg) 4))
+ (push-mark-command nil))
+ ((not (eq this-command 'set-mark-command))
+ (if arg
+ (pop-to-mark-command)
+ (push-mark-command t)))
+ ((and set-mark-command-repeat-pop
+ (eq last-command 'pop-to-mark-command))
+ (setq this-command 'pop-to-mark-command)
+ (pop-to-mark-command))
+ ((and set-mark-command-repeat-pop
+ (eq last-command 'pop-global-mark)
+ (not arg))
+ (setq this-command 'pop-global-mark)
+ (pop-global-mark))
+ (arg
+ (setq this-command 'pop-to-mark-command)
+ (pop-to-mark-command))
+ ((eq last-command 'set-mark-command)
+ (if (region-active-p)
+ (progn
+ (deactivate-mark)
+ (message "Mark deactivated"))
+ (activate-mark)
+ (message "Mark activated")))
+ (t
+ (push-mark-command nil))))
+
+(defun push-mark (&optional location nomsg activate)
+ "Set mark at LOCATION (point, by default) and push old mark on mark ring.
+If the last global mark pushed was not in the current buffer,
+also push LOCATION on the global mark ring.
+Display `Mark set' unless the optional second arg NOMSG is non-nil.
+
+Novice Emacs Lisp programmers often try to use the mark for the wrong
+purposes. See the documentation of `set-mark' for more information.
+
+In Transient Mark mode, activate mark if optional third arg ACTIVATE non-nil."
+ (unless (null (mark t))
+ (setq mark-ring (cons (copy-marker (mark-marker)) mark-ring))
+ (when (> (length mark-ring) mark-ring-max)
+ (move-marker (car (nthcdr mark-ring-max mark-ring)) nil)
+ (setcdr (nthcdr (1- mark-ring-max) mark-ring) nil)))
+ (set-marker (mark-marker) (or location (point)) (current-buffer))
+ ;; Now push the mark on the global mark ring.
+ (if (and global-mark-ring
+ (eq (marker-buffer (car global-mark-ring)) (current-buffer)))
+ ;; The last global mark pushed was in this same buffer.
+ ;; Don't push another one.
+ nil
+ (setq global-mark-ring (cons (copy-marker (mark-marker)) global-mark-ring))
+ (when (> (length global-mark-ring) global-mark-ring-max)
+ (move-marker (car (nthcdr global-mark-ring-max global-mark-ring)) nil)
+ (setcdr (nthcdr (1- global-mark-ring-max) global-mark-ring) nil)))
+ (or nomsg executing-kbd-macro (> (minibuffer-depth) 0)
+ (message "Mark set"))
+ (if (or activate (not transient-mark-mode))
+ (set-mark (mark t)))
+ nil)
+
+(defun pop-mark ()
+ "Pop off mark ring into the buffer's actual mark.
+Does not set point. Does nothing if mark ring is empty."
+ (when mark-ring
+ (setq mark-ring (nconc mark-ring (list (copy-marker (mark-marker)))))
+ (set-marker (mark-marker) (+ 0 (car mark-ring)) (current-buffer))
+ (move-marker (car mark-ring) nil)
+ (if (null (mark t)) (ding))
+ (setq mark-ring (cdr mark-ring)))
+ (deactivate-mark))
+
+(define-obsolete-function-alias
+ 'exchange-dot-and-mark 'exchange-point-and-mark "23.3")
+(defun exchange-point-and-mark (&optional arg)
+ "Put the mark where point is now, and point where the mark is now.
+This command works even when the mark is not active,
+and it reactivates the mark.
+
+If Transient Mark mode is on, a prefix ARG deactivates the mark
+if it is active, and otherwise avoids reactivating it. If
+Transient Mark mode is off, a prefix ARG enables Transient Mark
+mode temporarily."
+ (interactive "P")
+ (let ((omark (mark t))
+ (temp-highlight (eq (car-safe transient-mark-mode) 'only)))
+ (if (null omark)
+ (error "No mark set in this buffer"))
+ (set-mark (point))
+ (goto-char omark)
+ (cond (temp-highlight
+ (setq transient-mark-mode (cons 'only transient-mark-mode)))
+ ((or (and arg (region-active-p)) ; (xor arg (not (region-active-p)))
+ (not (or arg (region-active-p))))
+ (deactivate-mark))
+ (t (activate-mark)))
+ nil))
+
+(defcustom shift-select-mode t
+ "When non-nil, shifted motion keys activate the mark momentarily.
+
+While the mark is activated in this way, any shift-translated point
+motion key extends the region, and if Transient Mark mode was off, it
+is temporarily turned on. Furthermore, the mark will be deactivated
+by any subsequent point motion key that was not shift-translated, or
+by any action that normally deactivates the mark in Transient Mark mode.
+
+See `this-command-keys-shift-translated' for the meaning of
+shift-translation."
+ :type 'boolean
+ :group 'editing-basics)
+
+(defun handle-shift-selection ()
+ "Activate/deactivate mark depending on invocation thru shift translation.
+This function is called by `call-interactively' when a command
+with a `^' character in its `interactive' spec is invoked, before
+running the command itself.
+
+If `shift-select-mode' is enabled and the command was invoked
+through shift translation, set the mark and activate the region
+temporarily, unless it was already set in this way. See
+`this-command-keys-shift-translated' for the meaning of shift
+translation.
+
+Otherwise, if the region has been activated temporarily,
+deactivate it, and restore the variable `transient-mark-mode' to
+its earlier value."
+ (cond ((and shift-select-mode this-command-keys-shift-translated)
+ (unless (and mark-active
+ (eq (car-safe transient-mark-mode) 'only))
+ (setq transient-mark-mode
+ (cons 'only
+ (unless (eq transient-mark-mode 'lambda)
+ transient-mark-mode)))
+ (push-mark nil nil t)))
+ ((eq (car-safe transient-mark-mode) 'only)
+ (setq transient-mark-mode (cdr transient-mark-mode))
+ (deactivate-mark))))
+
+(define-minor-mode transient-mark-mode
+ "Toggle Transient Mark mode.
+With a prefix argument ARG, enable Transient Mark mode if ARG is
+positive, and disable it otherwise. If called from Lisp, enable
+Transient Mark mode if ARG is omitted or nil.
+
+Transient Mark mode is a global minor mode. When enabled, the
+region is highlighted with the `region' face whenever the mark
+is active. The mark is \"deactivated\" by changing the buffer,
+and after certain other operations that set the mark but whose
+main purpose is something else--for example, incremental search,
+\\[beginning-of-buffer], and \\[end-of-buffer].
+
+You can also deactivate the mark by typing \\[keyboard-quit] or
+\\[keyboard-escape-quit].
+
+Many commands change their behavior when Transient Mark mode is
+in effect and the mark is active, by acting on the region instead
+of their usual default part of the buffer's text. Examples of
+such commands include \\[comment-dwim], \\[flush-lines], \\[keep-lines],
+\\[query-replace], \\[query-replace-regexp], \\[ispell], and \\[undo].
+To see the documentation of commands which are sensitive to the
+Transient Mark mode, invoke \\[apropos-documentation] and type \"transient\"
+or \"mark.*active\" at the prompt."
+ :global t
+ ;; It's defined in C/cus-start, this stops the d-m-m macro defining it again.
+ :variable transient-mark-mode)
+
+(defvar widen-automatically t
+ "Non-nil means it is ok for commands to call `widen' when they want to.
+Some commands will do this in order to go to positions outside
+the current accessible part of the buffer.
+
+If `widen-automatically' is nil, these commands will do something else
+as a fallback, and won't change the buffer bounds.")
+
+(defvar non-essential nil
+ "Whether the currently executing code is performing an essential task.
+This variable should be non-nil only when running code which should not
+disturb the user. E.g. it can be used to prevent Tramp from prompting the
+user for a password when we are simply scanning a set of files in the
+background or displaying possible completions before the user even asked
+for it.")
+
+(defun pop-global-mark ()
+ "Pop off global mark ring and jump to the top location."
+ (interactive)
+ ;; Pop entries which refer to non-existent buffers.
+ (while (and global-mark-ring (not (marker-buffer (car global-mark-ring))))
+ (setq global-mark-ring (cdr global-mark-ring)))
+ (or global-mark-ring
+ (error "No global mark set"))
+ (let* ((marker (car global-mark-ring))
+ (buffer (marker-buffer marker))
+ (position (marker-position marker)))
+ (setq global-mark-ring (nconc (cdr global-mark-ring)
+ (list (car global-mark-ring))))
+ (set-buffer buffer)
+ (or (and (>= position (point-min))
+ (<= position (point-max)))
+ (if widen-automatically
+ (widen)
+ (error "Global mark position is outside accessible part of buffer")))
+ (goto-char position)
+ (switch-to-buffer buffer)))
+
+(defcustom next-line-add-newlines nil
+ "If non-nil, `next-line' inserts newline to avoid `end of buffer' error."
+ :type 'boolean
+ :version "21.1"
+ :group 'editing-basics)
+
+(defun next-line (&optional arg try-vscroll)
+ "Move cursor vertically down ARG lines.
+Interactively, vscroll tall lines if `auto-window-vscroll' is enabled.
+Non-interactively, use TRY-VSCROLL to control whether to vscroll tall
+lines: if either `auto-window-vscroll' or TRY-VSCROLL is nil, this
+function will not vscroll.
+
+ARG defaults to 1.
+
+If there is no character in the target line exactly under the current column,
+the cursor is positioned after the character in that line which spans this
+column, or at the end of the line if it is not long enough.
+If there is no line in the buffer after this one, behavior depends on the
+value of `next-line-add-newlines'. If non-nil, it inserts a newline character
+to create a line, and moves the cursor to that line. Otherwise it moves the
+cursor to the end of the buffer.
+
+If the variable `line-move-visual' is non-nil, this command moves
+by display lines. Otherwise, it moves by buffer lines, without
+taking variable-width characters or continued lines into account.
+
+The command \\[set-goal-column] can be used to create
+a semipermanent goal column for this command.
+Then instead of trying to move exactly vertically (or as close as possible),
+this command moves to the specified goal column (or as close as possible).
+The goal column is stored in the variable `goal-column', which is nil
+when there is no goal column. Note that setting `goal-column'
+overrides `line-move-visual' and causes this command to move by buffer
+lines rather than by display lines.
+
+If you are thinking of using this in a Lisp program, consider
+using `forward-line' instead. It is usually easier to use
+and more reliable (no dependence on goal column, etc.)."
+ (interactive "^p\np")
+ (or arg (setq arg 1))
+ (if (and next-line-add-newlines (= arg 1))
+ (if (save-excursion (end-of-line) (eobp))
+ ;; When adding a newline, don't expand an abbrev.
+ (let ((abbrev-mode nil))
+ (end-of-line)
+ (insert (if use-hard-newlines hard-newline "\n")))
+ (line-move arg nil nil try-vscroll))
+ (if (called-interactively-p 'interactive)
+ (condition-case err
+ (line-move arg nil nil try-vscroll)
+ ((beginning-of-buffer end-of-buffer)
+ (signal (car err) (cdr err))))
+ (line-move arg nil nil try-vscroll)))
+ nil)
+(put 'next-line 'interactive-only 'forward-line)
+
+(defun previous-line (&optional arg try-vscroll)
+ "Move cursor vertically up ARG lines.
+Interactively, vscroll tall lines if `auto-window-vscroll' is enabled.
+Non-interactively, use TRY-VSCROLL to control whether to vscroll tall
+lines: if either `auto-window-vscroll' or TRY-VSCROLL is nil, this
+function will not vscroll.
+
+ARG defaults to 1.
+
+If there is no character in the target line exactly over the current column,
+the cursor is positioned after the character in that line which spans this
+column, or at the end of the line if it is not long enough.
+
+If the variable `line-move-visual' is non-nil, this command moves
+by display lines. Otherwise, it moves by buffer lines, without
+taking variable-width characters or continued lines into account.
+
+The command \\[set-goal-column] can be used to create
+a semipermanent goal column for this command.
+Then instead of trying to move exactly vertically (or as close as possible),
+this command moves to the specified goal column (or as close as possible).
+The goal column is stored in the variable `goal-column', which is nil
+when there is no goal column. Note that setting `goal-column'
+overrides `line-move-visual' and causes this command to move by buffer
+lines rather than by display lines.
+
+If you are thinking of using this in a Lisp program, consider using
+`forward-line' with a negative argument instead. It is usually easier
+to use and more reliable (no dependence on goal column, etc.)."
+ (interactive "^p\np")
+ (or arg (setq arg 1))
+ (if (called-interactively-p 'interactive)
+ (condition-case err
+ (line-move (- arg) nil nil try-vscroll)
+ ((beginning-of-buffer end-of-buffer)
+ (signal (car err) (cdr err))))
+ (line-move (- arg) nil nil try-vscroll))
+ nil)
+(put 'previous-line 'interactive-only
+ "use `forward-line' with negative argument instead.")
+
+(defcustom track-eol nil
+ "Non-nil means vertical motion starting at end of line keeps to ends of
lines.
+This means moving to the end of each line moved onto.
+The beginning of a blank line does not count as the end of a line.
+This has no effect when the variable `line-move-visual' is non-nil."
+ :type 'boolean
+ :group 'editing-basics)
+
+(defcustom goal-column nil
+ "Semipermanent goal column for vertical motion, as set by
\\[set-goal-column], or nil.
+A non-nil setting overrides the variable `line-move-visual', which see."
+ :type '(choice integer
+ (const :tag "None" nil))
+ :group 'editing-basics)
+(make-variable-buffer-local 'goal-column)
+
+(defvar temporary-goal-column 0
+ "Current goal column for vertical motion.
+It is the column where point was at the start of the current run
+of vertical motion commands.
+
+When moving by visual lines via the function `line-move-visual', it is a cons
+cell (COL . HSCROLL), where COL is the x-position, in pixels,
+divided by the default column width, and HSCROLL is the number of
+columns by which window is scrolled from left margin.
+
+When the `track-eol' feature is doing its job, the value is
+`most-positive-fixnum'.")
+
+(defcustom line-move-ignore-invisible t
+ "Non-nil means commands that move by lines ignore invisible newlines.
+When this option is non-nil, \\[next-line], \\[previous-line],
\\[move-end-of-line], and \\[move-beginning-of-line] behave
+as if newlines that are invisible didn't exist, and count
+only visible newlines. Thus, moving across across 2 newlines
+one of which is invisible will be counted as a one-line move.
+Also, a non-nil value causes invisible text to be ignored when
+counting columns for the purposes of keeping point in the same
+column by \\[next-line] and \\[previous-line].
+
+Outline mode sets this."
+ :type 'boolean
+ :group 'editing-basics)
+
+(defcustom line-move-visual t
+ "When non-nil, `line-move' moves point by visual lines.
+This movement is based on where the cursor is displayed on the
+screen, instead of relying on buffer contents alone. It takes
+into account variable-width characters and line continuation.
+If nil, `line-move' moves point by logical lines.
+A non-nil setting of `goal-column' overrides the value of this variable
+and forces movement by logical lines.
+A window that is horizontally scrolled also forces movement by logical
+lines."
+ :type 'boolean
+ :group 'editing-basics
+ :version "23.1")
+
+;; Only used if display-graphic-p.
+(declare-function font-info "font.c" (name &optional frame))
+
+(defun default-font-height ()
+ "Return the height in pixels of the current buffer's default face font."
+ (let ((default-font (face-font 'default)))
+ (cond
+ ((and (display-multi-font-p)
+ ;; Avoid calling font-info if the frame's default font was
+ ;; not changed since the frame was created. That's because
+ ;; font-info is expensive for some fonts, see bug #14838.
+ (not (string= (frame-parameter nil 'font) default-font)))
+ (aref (font-info default-font) 3))
+ (t (frame-char-height)))))
+
+(defun default-line-height ()
+ "Return the pixel height of current buffer's default-face text line.
+
+The value includes `line-spacing', if any, defined for the buffer
+or the frame."
+ (let ((dfh (default-font-height))
+ (lsp (if (display-graphic-p)
+ (or line-spacing
+ (default-value 'line-spacing)
+ (frame-parameter nil 'line-spacing)
+ 0)
+ 0)))
+ (if (floatp lsp)
+ (setq lsp (truncate (* (frame-char-height) lsp))))
+ (+ dfh lsp)))
+
+(defun window-screen-lines ()
+ "Return the number of screen lines in the text area of the selected window.
+
+This is different from `window-text-height' in that this function counts
+lines in units of the height of the font used by the default face displayed
+in the window, not in units of the frame's default font, and also accounts
+for `line-spacing', if any, defined for the window's buffer or frame.
+
+The value is a floating-point number."
+ (let ((edges (window-inside-pixel-edges))
+ (dlh (default-line-height)))
+ (/ (float (- (nth 3 edges) (nth 1 edges))) dlh)))
+
+;; Returns non-nil if partial move was done.
+(defun line-move-partial (arg noerror to-end)
+ (if (< arg 0)
+ ;; Move backward (up).
+ ;; If already vscrolled, reduce vscroll
+ (let ((vs (window-vscroll nil t))
+ (dlh (default-line-height)))
+ (when (> vs dlh)
+ (set-window-vscroll nil (- vs dlh) t)))
+
+ ;; Move forward (down).
+ (let* ((lh (window-line-height -1))
+ (rowh (car lh))
+ (vpos (nth 1 lh))
+ (ypos (nth 2 lh))
+ (rbot (nth 3 lh))
+ (this-lh (window-line-height))
+ (this-height (car this-lh))
+ (this-ypos (nth 2 this-lh))
+ (dlh (default-line-height))
+ (wslines (window-screen-lines))
+ (edges (window-inside-pixel-edges))
+ (winh (- (nth 3 edges) (nth 1 edges) 1))
+ py vs last-line)
+ (if (> (mod wslines 1.0) 0.0)
+ (setq wslines (round (+ wslines 0.5))))
+ (when (or (null lh)
+ (>= rbot dlh)
+ (<= ypos (- dlh))
+ (null this-lh)
+ (<= this-ypos (- dlh)))
+ (unless lh
+ (let ((wend (pos-visible-in-window-p t nil t)))
+ (setq rbot (nth 3 wend)
+ rowh (nth 4 wend)
+ vpos (nth 5 wend))))
+ (unless this-lh
+ (let ((wstart (pos-visible-in-window-p nil nil t)))
+ (setq this-ypos (nth 2 wstart)
+ this-height (nth 4 wstart))))
+ (setq py
+ (or (nth 1 this-lh)
+ (let ((ppos (posn-at-point))
+ col-row)
+ (setq col-row (posn-actual-col-row ppos))
+ (if col-row
+ (- (cdr col-row) (window-vscroll))
+ (cdr (posn-col-row ppos))))))
+ ;; VPOS > 0 means the last line is only partially visible.
+ ;; But if the part that is visible is at least as tall as the
+ ;; default font, that means the line is actually fully
+ ;; readable, and something like line-spacing is hidden. So in
+ ;; that case we accept the last line in the window as still
+ ;; visible, and consider the margin as starting one line
+ ;; later.
+ (if (and vpos (> vpos 0))
+ (if (and rowh
+ (>= rowh (default-font-height))
+ (< rowh dlh))
+ (setq last-line (min (- wslines scroll-margin) vpos))
+ (setq last-line (min (- wslines scroll-margin 1) (1- vpos)))))
+ (cond
+ ;; If last line of window is fully visible, and vscrolling
+ ;; more would make this line invisible, move forward.
+ ((and (or (< (setq vs (window-vscroll nil t)) dlh)
+ (null this-height)
+ (<= this-height dlh))
+ (or (null rbot) (= rbot 0)))
+ nil)
+ ;; If cursor is not in the bottom scroll margin, and the
+ ;; current line is is not too tall, move forward.
+ ((and (or (null this-height) (<= this-height winh))
+ vpos
+ (> vpos 0)
+ (< py last-line))
+ nil)
+ ;; When already vscrolled, we vscroll some more if we can,
+ ;; or clear vscroll and move forward at end of tall image.
+ ((> vs 0)
+ (when (or (and rbot (> rbot 0))
+ (and this-height (> this-height dlh)))
+ (set-window-vscroll nil (+ vs dlh) t)))
+ ;; If cursor just entered the bottom scroll margin, move forward,
+ ;; but also optionally vscroll one line so redisplay won't recenter.
+ ((and vpos
+ (> vpos 0)
+ (= py last-line))
+ ;; Don't vscroll if the partially-visible line at window
+ ;; bottom is not too tall (a.k.a. "just one more text
+ ;; line"): in that case, we do want redisplay to behave
+ ;; normally, i.e. recenter or whatever.
+ ;;
+ ;; Note: ROWH + RBOT from the value returned by
+ ;; pos-visible-in-window-p give the total height of the
+ ;; partially-visible glyph row at the end of the window. As
+ ;; we are dealing with floats, we disregard sub-pixel
+ ;; discrepancies between that and DLH.
+ (if (and rowh rbot (>= (- (+ rowh rbot) winh) 1))
+ (set-window-vscroll nil dlh t))
+ (line-move-1 arg noerror to-end)
+ t)
+ ;; If there are lines above the last line, scroll-up one line.
+ ((and vpos (> vpos 0))
+ (scroll-up 1)
+ t)
+ ;; Finally, start vscroll.
+ (t
+ (set-window-vscroll nil dlh t)))))))
+
+
+;; This is like line-move-1 except that it also performs
+;; vertical scrolling of tall images if appropriate.
+;; That is not really a clean thing to do, since it mixes
+;; scrolling with cursor motion. But so far we don't have
+;; a cleaner solution to the problem of making C-n do something
+;; useful given a tall image.
+(defun line-move (arg &optional noerror to-end try-vscroll)
+ "Move forward ARG lines.
+If NOERROR, don't signal an error if we can't move ARG lines.
+TO-END is unused.
+TRY-VSCROLL controls whether to vscroll tall lines: if either
+`auto-window-vscroll' or TRY-VSCROLL is nil, this function will
+not vscroll."
+ (if noninteractive
+ (line-move-1 arg noerror to-end)
+ (unless (and auto-window-vscroll try-vscroll
+ ;; Only vscroll for single line moves
+ (= (abs arg) 1)
+ ;; Under scroll-conservatively, the display engine
+ ;; does this better.
+ (zerop scroll-conservatively)
+ ;; But don't vscroll in a keyboard macro.
+ (not defining-kbd-macro)
+ (not executing-kbd-macro)
+ (line-move-partial arg noerror to-end))
+ (set-window-vscroll nil 0 t)
+ (if (and line-move-visual
+ ;; Display-based column are incompatible with goal-column.
+ (not goal-column)
+ ;; When the text in the window is scrolled to the left,
+ ;; display-based motion doesn't make sense (because each
+ ;; logical line occupies exactly one screen line).
+ (not (> (window-hscroll) 0))
+ ;; Likewise when the text _was_ scrolled to the left
+ ;; when the current run of vertical motion commands
+ ;; started.
+ (not (and (memq last-command
+ `(next-line previous-line ,this-command))
+ auto-hscroll-mode
+ (numberp temporary-goal-column)
+ (>= temporary-goal-column
+ (- (window-width) hscroll-margin)))))
+ (prog1 (line-move-visual arg noerror)
+ ;; If we moved into a tall line, set vscroll to make
+ ;; scrolling through tall images more smooth.
+ (let ((lh (line-pixel-height))
+ (edges (window-inside-pixel-edges))
+ (dlh (default-line-height))
+ winh)
+ (setq winh (- (nth 3 edges) (nth 1 edges) 1))
+ (if (and (< arg 0)
+ (< (point) (window-start))
+ (> lh winh))
+ (set-window-vscroll
+ nil
+ (- lh dlh) t))))
+ (line-move-1 arg noerror to-end)))))
+
+;; Display-based alternative to line-move-1.
+;; Arg says how many lines to move. The value is t if we can move the
+;; specified number of lines.
+(defun line-move-visual (arg &optional noerror)
+ "Move ARG lines forward.
+If NOERROR, don't signal an error if we can't move that many lines."
+ (let ((opoint (point))
+ (hscroll (window-hscroll))
+ target-hscroll)
+ ;; Check if the previous command was a line-motion command, or if
+ ;; we were called from some other command.
+ (if (and (consp temporary-goal-column)
+ (memq last-command `(next-line previous-line ,this-command)))
+ ;; If so, there's no need to reset `temporary-goal-column',
+ ;; but we may need to hscroll.
+ (if (or (/= (cdr temporary-goal-column) hscroll)
+ (> (cdr temporary-goal-column) 0))
+ (setq target-hscroll (cdr temporary-goal-column)))
+ ;; Otherwise, we should reset `temporary-goal-column'.
+ (let ((posn (posn-at-point))
+ x-pos)
+ (cond
+ ;; Handle the `overflow-newline-into-fringe' case:
+ ((eq (nth 1 posn) 'right-fringe)
+ (setq temporary-goal-column (cons (- (window-width) 1) hscroll)))
+ ((car (posn-x-y posn))
+ (setq x-pos (car (posn-x-y posn)))
+ ;; In R2L lines, the X pixel coordinate is measured from the
+ ;; left edge of the window, but columns are still counted
+ ;; from the logical-order beginning of the line, i.e. from
+ ;; the right edge in this case. We need to adjust for that.
+ (if (eq (current-bidi-paragraph-direction) 'right-to-left)
+ (setq x-pos (- (window-body-width nil t) 1 x-pos)))
+ (setq temporary-goal-column
+ (cons (/ (float x-pos)
+ (frame-char-width))
+ hscroll))))))
+ (if target-hscroll
+ (set-window-hscroll (selected-window) target-hscroll))
+ ;; vertical-motion can move more than it was asked to if it moves
+ ;; across display strings with newlines. We don't want to ring
+ ;; the bell and announce beginning/end of buffer in that case.
+ (or (and (or (and (>= arg 0)
+ (>= (vertical-motion
+ (cons (or goal-column
+ (if (consp temporary-goal-column)
+ (car temporary-goal-column)
+ temporary-goal-column))
+ arg))
+ arg))
+ (and (< arg 0)
+ (<= (vertical-motion
+ (cons (or goal-column
+ (if (consp temporary-goal-column)
+ (car temporary-goal-column)
+ temporary-goal-column))
+ arg))
+ arg)))
+ (or (>= arg 0)
+ (/= (point) opoint)
+ ;; If the goal column lies on a display string,
+ ;; `vertical-motion' advances the cursor to the end
+ ;; of the string. For arg < 0, this can cause the
+ ;; cursor to get stuck. (Bug#3020).
+ (= (vertical-motion arg) arg)))
+ (unless noerror
+ (signal (if (< arg 0) 'beginning-of-buffer 'end-of-buffer)
+ nil)))))
+
+;; This is the guts of next-line and previous-line.
+;; Arg says how many lines to move.
+;; The value is t if we can move the specified number of lines.
+(defun line-move-1 (arg &optional noerror _to-end)
+ ;; Don't run any point-motion hooks, and disregard intangibility,
+ ;; for intermediate positions.
+ (let ((inhibit-point-motion-hooks t)
+ (opoint (point))
+ (orig-arg arg))
+ (if (consp temporary-goal-column)
+ (setq temporary-goal-column (+ (car temporary-goal-column)
+ (cdr temporary-goal-column))))
+ (unwind-protect
+ (progn
+ (if (not (memq last-command '(next-line previous-line)))
+ (setq temporary-goal-column
+ (if (and track-eol (eolp)
+ ;; Don't count beg of empty line as end of line
+ ;; unless we just did explicit end-of-line.
+ (or (not (bolp)) (eq last-command
'move-end-of-line)))
+ most-positive-fixnum
+ (current-column))))
+
+ (if (not (or (integerp selective-display)
+ line-move-ignore-invisible))
+ ;; Use just newline characters.
+ ;; Set ARG to 0 if we move as many lines as requested.
+ (or (if (> arg 0)
+ (progn (if (> arg 1) (forward-line (1- arg)))
+ ;; This way of moving forward ARG lines
+ ;; verifies that we have a newline after the last
one.
+ ;; It doesn't get confused by intangible text.
+ (end-of-line)
+ (if (zerop (forward-line 1))
+ (setq arg 0)))
+ (and (zerop (forward-line arg))
+ (bolp)
+ (setq arg 0)))
+ (unless noerror
+ (signal (if (< arg 0)
+ 'beginning-of-buffer
+ 'end-of-buffer)
+ nil)))
+ ;; Move by arg lines, but ignore invisible ones.
+ (let (done)
+ (while (and (> arg 0) (not done))
+ ;; If the following character is currently invisible,
+ ;; skip all characters with that same `invisible' property
value.
+ (while (and (not (eobp)) (invisible-p (point)))
+ (goto-char (next-char-property-change (point))))
+ ;; Move a line.
+ ;; We don't use `end-of-line', since we want to escape
+ ;; from field boundaries occurring exactly at point.
+ (goto-char (constrain-to-field
+ (let ((inhibit-field-text-motion t))
+ (line-end-position))
+ (point) t t
+ 'inhibit-line-move-field-capture))
+ ;; If there's no invisibility here, move over the newline.
+ (cond
+ ((eobp)
+ (if (not noerror)
+ (signal 'end-of-buffer nil)
+ (setq done t)))
+ ((and (> arg 1) ;; Use vertical-motion for last move
+ (not (integerp selective-display))
+ (not (invisible-p (point))))
+ ;; We avoid vertical-motion when possible
+ ;; because that has to fontify.
+ (forward-line 1))
+ ;; Otherwise move a more sophisticated way.
+ ((zerop (vertical-motion 1))
+ (if (not noerror)
+ (signal 'end-of-buffer nil)
+ (setq done t))))
+ (unless done
+ (setq arg (1- arg))))
+ ;; The logic of this is the same as the loop above,
+ ;; it just goes in the other direction.
+ (while (and (< arg 0) (not done))
+ ;; For completely consistency with the forward-motion
+ ;; case, we should call beginning-of-line here.
+ ;; However, if point is inside a field and on a
+ ;; continued line, the call to (vertical-motion -1)
+ ;; below won't move us back far enough; then we return
+ ;; to the same column in line-move-finish, and point
+ ;; gets stuck -- cyd
+ (forward-line 0)
+ (cond
+ ((bobp)
+ (if (not noerror)
+ (signal 'beginning-of-buffer nil)
+ (setq done t)))
+ ((and (< arg -1) ;; Use vertical-motion for last move
+ (not (integerp selective-display))
+ (not (invisible-p (1- (point)))))
+ (forward-line -1))
+ ((zerop (vertical-motion -1))
+ (if (not noerror)
+ (signal 'beginning-of-buffer nil)
+ (setq done t))))
+ (unless done
+ (setq arg (1+ arg))
+ (while (and ;; Don't move over previous invis lines
+ ;; if our target is the middle of this line.
+ (or (zerop (or goal-column temporary-goal-column))
+ (< arg 0))
+ (not (bobp)) (invisible-p (1- (point))))
+ (goto-char (previous-char-property-change (point))))))))
+ ;; This is the value the function returns.
+ (= arg 0))
+
+ (cond ((> arg 0)
+ ;; If we did not move down as far as desired, at least go
+ ;; to end of line. Be sure to call point-entered and
+ ;; point-left-hooks.
+ (let* ((npoint (prog1 (line-end-position)
+ (goto-char opoint)))
+ (inhibit-point-motion-hooks nil))
+ (goto-char npoint)))
+ ((< arg 0)
+ ;; If we did not move up as far as desired,
+ ;; at least go to beginning of line.
+ (let* ((npoint (prog1 (line-beginning-position)
+ (goto-char opoint)))
+ (inhibit-point-motion-hooks nil))
+ (goto-char npoint)))
+ (t
+ (line-move-finish (or goal-column temporary-goal-column)
+ opoint (> orig-arg 0)))))))
+
+(defun line-move-finish (column opoint forward)
+ (let ((repeat t))
+ (while repeat
+ ;; Set REPEAT to t to repeat the whole thing.
+ (setq repeat nil)
+
+ (let (new
+ (old (point))
+ (line-beg (line-beginning-position))
+ (line-end
+ ;; Compute the end of the line
+ ;; ignoring effectively invisible newlines.
+ (save-excursion
+ ;; Like end-of-line but ignores fields.
+ (skip-chars-forward "^\n")
+ (while (and (not (eobp)) (invisible-p (point)))
+ (goto-char (next-char-property-change (point)))
+ (skip-chars-forward "^\n"))
+ (point))))
+
+ ;; Move to the desired column.
+ (line-move-to-column (truncate column))
+
+ ;; Corner case: suppose we start out in a field boundary in
+ ;; the middle of a continued line. When we get to
+ ;; line-move-finish, point is at the start of a new *screen*
+ ;; line but the same text line; then line-move-to-column would
+ ;; move us backwards. Test using C-n with point on the "x" in
+ ;; (insert "a" (propertize "x" 'field t) (make-string 89 ?y))
+ (and forward
+ (< (point) old)
+ (goto-char old))
+
+ (setq new (point))
+
+ ;; Process intangibility within a line.
+ ;; With inhibit-point-motion-hooks bound to nil, a call to
+ ;; goto-char moves point past intangible text.
+
+ ;; However, inhibit-point-motion-hooks controls both the
+ ;; intangibility and the point-entered/point-left hooks. The
+ ;; following hack avoids calling the point-* hooks
+ ;; unnecessarily. Note that we move *forward* past intangible
+ ;; text when the initial and final points are the same.
+ (goto-char new)
+ (let ((inhibit-point-motion-hooks nil))
+ (goto-char new)
+
+ ;; If intangibility moves us to a different (later) place
+ ;; in the same line, use that as the destination.
+ (if (<= (point) line-end)
+ (setq new (point))
+ ;; If that position is "too late",
+ ;; try the previous allowable position.
+ ;; See if it is ok.
+ (backward-char)
+ (if (if forward
+ ;; If going forward, don't accept the previous
+ ;; allowable position if it is before the target line.
+ (< line-beg (point))
+ ;; If going backward, don't accept the previous
+ ;; allowable position if it is still after the target line.
+ (<= (point) line-end))
+ (setq new (point))
+ ;; As a last resort, use the end of the line.
+ (setq new line-end))))
+
+ ;; Now move to the updated destination, processing fields
+ ;; as well as intangibility.
+ (goto-char opoint)
+ (let ((inhibit-point-motion-hooks nil))
+ (goto-char
+ ;; Ignore field boundaries if the initial and final
+ ;; positions have the same `field' property, even if the
+ ;; fields are non-contiguous. This seems to be "nicer"
+ ;; behavior in many situations.
+ (if (eq (get-char-property new 'field)
+ (get-char-property opoint 'field))
+ new
+ (constrain-to-field new opoint t t
+ 'inhibit-line-move-field-capture))))
+
+ ;; If all this moved us to a different line,
+ ;; retry everything within that new line.
+ (when (or (< (point) line-beg) (> (point) line-end))
+ ;; Repeat the intangibility and field processing.
+ (setq repeat t))))))
+
+(defun line-move-to-column (col)
+ "Try to find column COL, considering invisibility.
+This function works only in certain cases,
+because what we really need is for `move-to-column'
+and `current-column' to be able to ignore invisible text."
+ (if (zerop col)
+ (beginning-of-line)
+ (move-to-column col))
+
+ (when (and line-move-ignore-invisible
+ (not (bolp)) (invisible-p (1- (point))))
+ (let ((normal-location (point))
+ (normal-column (current-column)))
+ ;; If the following character is currently invisible,
+ ;; skip all characters with that same `invisible' property value.
+ (while (and (not (eobp))
+ (invisible-p (point)))
+ (goto-char (next-char-property-change (point))))
+ ;; Have we advanced to a larger column position?
+ (if (> (current-column) normal-column)
+ ;; We have made some progress towards the desired column.
+ ;; See if we can make any further progress.
+ (line-move-to-column (+ (current-column) (- col normal-column)))
+ ;; Otherwise, go to the place we originally found
+ ;; and move back over invisible text.
+ ;; that will get us to the same place on the screen
+ ;; but with a more reasonable buffer position.
+ (goto-char normal-location)
+ (let ((line-beg (line-beginning-position)))
+ (while (and (not (bolp)) (invisible-p (1- (point))))
+ (goto-char (previous-char-property-change (point) line-beg))))))))
+
+(defun move-end-of-line (arg)
+ "Move point to end of current line as displayed.
+With argument ARG not nil or 1, move forward ARG - 1 lines first.
+If point reaches the beginning or end of buffer, it stops there.
+
+To ignore the effects of the `intangible' text or overlay
+property, bind `inhibit-point-motion-hooks' to t.
+If there is an image in the current line, this function
+disregards newlines that are part of the text on which the image
+rests."
+ (interactive "^p")
+ (or arg (setq arg 1))
+ (let (done)
+ (while (not done)
+ (let ((newpos
+ (save-excursion
+ (let ((goal-column 0)
+ (line-move-visual nil))
+ (and (line-move arg t)
+ ;; With bidi reordering, we may not be at bol,
+ ;; so make sure we are.
+ (skip-chars-backward "^\n")
+ (not (bobp))
+ (progn
+ (while (and (not (bobp)) (invisible-p (1- (point))))
+ (goto-char (previous-single-char-property-change
+ (point) 'invisible)))
+ (backward-char 1)))
+ (point)))))
+ (goto-char newpos)
+ (if (and (> (point) newpos)
+ (eq (preceding-char) ?\n))
+ (backward-char 1)
+ (if (and (> (point) newpos) (not (eobp))
+ (not (eq (following-char) ?\n)))
+ ;; If we skipped something intangible and now we're not
+ ;; really at eol, keep going.
+ (setq arg 1)
+ (setq done t)))))))
+
+(defun move-beginning-of-line (arg)
+ "Move point to beginning of current line as displayed.
+\(If there's an image in the line, this disregards newlines
+which are part of the text that the image rests on.)
+
+With argument ARG not nil or 1, move forward ARG - 1 lines first.
+If point reaches the beginning or end of buffer, it stops there.
+To ignore intangibility, bind `inhibit-point-motion-hooks' to t."
+ (interactive "^p")
+ (or arg (setq arg 1))
+
+ (let ((orig (point))
+ first-vis first-vis-field-value)
+
+ ;; Move by lines, if ARG is not 1 (the default).
+ (if (/= arg 1)
+ (let ((line-move-visual nil))
+ (line-move (1- arg) t)))
+
+ ;; Move to beginning-of-line, ignoring fields and invisible text.
+ (skip-chars-backward "^\n")
+ (while (and (not (bobp)) (invisible-p (1- (point))))
+ (goto-char (previous-char-property-change (point)))
+ (skip-chars-backward "^\n"))
+
+ ;; Now find first visible char in the line.
+ (while (and (< (point) orig) (invisible-p (point)))
+ (goto-char (next-char-property-change (point) orig)))
+ (setq first-vis (point))
+
+ ;; See if fields would stop us from reaching FIRST-VIS.
+ (setq first-vis-field-value
+ (constrain-to-field first-vis orig (/= arg 1) t nil))
+
+ (goto-char (if (/= first-vis-field-value first-vis)
+ ;; If yes, obey them.
+ first-vis-field-value
+ ;; Otherwise, move to START with attention to fields.
+ ;; (It is possible that fields never matter in this case.)
+ (constrain-to-field (point) orig
+ (/= arg 1) t nil)))))
+
+
+;; Many people have said they rarely use this feature, and often type
+;; it by accident. Maybe it shouldn't even be on a key.
+(put 'set-goal-column 'disabled t)
+
+(defun set-goal-column (arg)
+ "Set the current horizontal position as a goal for \\[next-line] and
\\[previous-line].
+Those commands will move to this position in the line moved to
+rather than trying to keep the same horizontal position.
+With a non-nil argument ARG, clears out the goal column
+so that \\[next-line] and \\[previous-line] resume vertical motion.
+The goal column is stored in the variable `goal-column'."
+ (interactive "P")
+ (if arg
+ (progn
+ (setq goal-column nil)
+ (message "No goal column"))
+ (setq goal-column (current-column))
+ ;; The older method below can be erroneous if `set-goal-column' is bound
+ ;; to a sequence containing %
+ ;;(message (substitute-command-keys
+ ;;"Goal column %d (use \\[set-goal-column] with an arg to unset it)")
+ ;;goal-column)
+ (message "%s"
+ (concat
+ (format "Goal column %d " goal-column)
+ (substitute-command-keys
+ "(use \\[set-goal-column] with an arg to unset it)")))
+
+ )
+ nil)
+
+;;; Editing based on visual lines, as opposed to logical lines.
+
+(defun end-of-visual-line (&optional n)
+ "Move point to end of current visual line.
+With argument N not nil or 1, move forward N - 1 visual lines first.
+If point reaches the beginning or end of buffer, it stops there.
+To ignore intangibility, bind `inhibit-point-motion-hooks' to t."
+ (interactive "^p")
+ (or n (setq n 1))
+ (if (/= n 1)
+ (let ((line-move-visual t))
+ (line-move (1- n) t)))
+ ;; Unlike `move-beginning-of-line', `move-end-of-line' doesn't
+ ;; constrain to field boundaries, so we don't either.
+ (vertical-motion (cons (window-width) 0)))
+
+(defun beginning-of-visual-line (&optional n)
+ "Move point to beginning of current visual line.
+With argument N not nil or 1, move forward N - 1 visual lines first.
+If point reaches the beginning or end of buffer, it stops there.
+To ignore intangibility, bind `inhibit-point-motion-hooks' to t."
+ (interactive "^p")
+ (or n (setq n 1))
+ (let ((opoint (point)))
+ (if (/= n 1)
+ (let ((line-move-visual t))
+ (line-move (1- n) t)))
+ (vertical-motion 0)
+ ;; Constrain to field boundaries, like `move-beginning-of-line'.
+ (goto-char (constrain-to-field (point) opoint (/= n 1)))))
+
+(defun kill-visual-line (&optional arg)
+ "Kill the rest of the visual line.
+With prefix argument ARG, kill that many visual lines from point.
+If ARG is negative, kill visual lines backward.
+If ARG is zero, kill the text before point on the current visual
+line.
+
+If you want to append the killed line to the last killed text,
+use \\[append-next-kill] before \\[kill-line].
+
+If the buffer is read-only, Emacs will beep and refrain from deleting
+the line, but put the line in the kill ring anyway. This means that
+you can use this command to copy text from a read-only buffer.
+\(If the variable `kill-read-only-ok' is non-nil, then this won't
+even beep.)"
+ (interactive "P")
+ ;; Like in `kill-line', it's better to move point to the other end
+ ;; of the kill before killing.
+ (let ((opoint (point))
+ (kill-whole-line (and kill-whole-line (bolp))))
+ (if arg
+ (vertical-motion (prefix-numeric-value arg))
+ (end-of-visual-line 1)
+ (if (= (point) opoint)
+ (vertical-motion 1)
+ ;; Skip any trailing whitespace at the end of the visual line.
+ ;; We used to do this only if `show-trailing-whitespace' is
+ ;; nil, but that's wrong; the correct thing would be to check
+ ;; whether the trailing whitespace is highlighted. But, it's
+ ;; OK to just do this unconditionally.
+ (skip-chars-forward " \t")))
+ (kill-region opoint (if (and kill-whole-line (looking-at "\n"))
+ (1+ (point))
+ (point)))))
+
+(defun next-logical-line (&optional arg try-vscroll)
+ "Move cursor vertically down ARG lines.
+This is identical to `next-line', except that it always moves
+by logical lines instead of visual lines, ignoring the value of
+the variable `line-move-visual'."
+ (interactive "^p\np")
+ (let ((line-move-visual nil))
+ (with-no-warnings
+ (next-line arg try-vscroll))))
+
+(defun previous-logical-line (&optional arg try-vscroll)
+ "Move cursor vertically up ARG lines.
+This is identical to `previous-line', except that it always moves
+by logical lines instead of visual lines, ignoring the value of
+the variable `line-move-visual'."
+ (interactive "^p\np")
+ (let ((line-move-visual nil))
+ (with-no-warnings
+ (previous-line arg try-vscroll))))
+
+(defgroup visual-line nil
+ "Editing based on visual lines."
+ :group 'convenience
+ :version "23.1")
+
+(defvar visual-line-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [remap kill-line] 'kill-visual-line)
+ (define-key map [remap move-beginning-of-line] 'beginning-of-visual-line)
+ (define-key map [remap move-end-of-line] 'end-of-visual-line)
+ ;; These keybindings interfere with xterm function keys. Are
+ ;; there any other suitable bindings?
+ ;; (define-key map "\M-[" 'previous-logical-line)
+ ;; (define-key map "\M-]" 'next-logical-line)
+ map))
+
+(defcustom visual-line-fringe-indicators '(nil nil)
+ "How fringe indicators are shown for wrapped lines in `visual-line-mode'.
+The value should be a list of the form (LEFT RIGHT), where LEFT
+and RIGHT are symbols representing the bitmaps to display, to
+indicate wrapped lines, in the left and right fringes respectively.
+See also `fringe-indicator-alist'.
+The default is not to display fringe indicators for wrapped lines.
+This variable does not affect fringe indicators displayed for
+other purposes."
+ :type '(list (choice (const :tag "Hide left indicator" nil)
+ (const :tag "Left curly arrow" left-curly-arrow)
+ (symbol :tag "Other bitmap"))
+ (choice (const :tag "Hide right indicator" nil)
+ (const :tag "Right curly arrow" right-curly-arrow)
+ (symbol :tag "Other bitmap")))
+ :set (lambda (symbol value)
+ (dolist (buf (buffer-list))
+ (with-current-buffer buf
+ (when (and (boundp 'visual-line-mode)
+ (symbol-value 'visual-line-mode))
+ (setq fringe-indicator-alist
+ (cons (cons 'continuation value)
+ (assq-delete-all
+ 'continuation
+ (copy-tree fringe-indicator-alist)))))))
+ (set-default symbol value)))
+
+(defvar visual-line--saved-state nil)
+
+(define-minor-mode visual-line-mode
+ "Toggle visual line based editing (Visual Line mode).
+With a prefix argument ARG, enable Visual Line mode if ARG is
+positive, and disable it otherwise. If called from Lisp, enable
+the mode if ARG is omitted or nil.
+
+When Visual Line mode is enabled, `word-wrap' is turned on in
+this buffer, and simple editing commands are redefined to act on
+visual lines, not logical lines. See Info node `Visual Line
+Mode' for details."
+ :keymap visual-line-mode-map
+ :group 'visual-line
+ :lighter " Wrap"
+ (if visual-line-mode
+ (progn
+ (set (make-local-variable 'visual-line--saved-state) nil)
+ ;; Save the local values of some variables, to be restored if
+ ;; visual-line-mode is turned off.
+ (dolist (var '(line-move-visual truncate-lines
+ truncate-partial-width-windows
+ word-wrap fringe-indicator-alist))
+ (if (local-variable-p var)
+ (push (cons var (symbol-value var))
+ visual-line--saved-state)))
+ (set (make-local-variable 'line-move-visual) t)
+ (set (make-local-variable 'truncate-partial-width-windows) nil)
+ (setq truncate-lines nil
+ word-wrap t
+ fringe-indicator-alist
+ (cons (cons 'continuation visual-line-fringe-indicators)
+ fringe-indicator-alist)))
+ (kill-local-variable 'line-move-visual)
+ (kill-local-variable 'word-wrap)
+ (kill-local-variable 'truncate-lines)
+ (kill-local-variable 'truncate-partial-width-windows)
+ (kill-local-variable 'fringe-indicator-alist)
+ (dolist (saved visual-line--saved-state)
+ (set (make-local-variable (car saved)) (cdr saved)))
+ (kill-local-variable 'visual-line--saved-state)))
+
+(defun turn-on-visual-line-mode ()
+ (visual-line-mode 1))
+
+(define-globalized-minor-mode global-visual-line-mode
+ visual-line-mode turn-on-visual-line-mode)
+
+
+(defun transpose-chars (arg)
+ "Interchange characters around point, moving forward one character.
+With prefix arg ARG, effect is to take character before point
+and drag it forward past ARG other characters (backward if ARG negative).
+If no argument and at end of line, the previous two chars are exchanged."
+ (interactive "*P")
+ (and (null arg) (eolp) (forward-char -1))
+ (transpose-subr 'forward-char (prefix-numeric-value arg)))
+
+(defun transpose-words (arg)
+ "Interchange words around point, leaving point at end of them.
+With prefix arg ARG, effect is to take word before or around point
+and drag it forward past ARG other words (backward if ARG negative).
+If ARG is zero, the words around or after point and around or after mark
+are interchanged."
+ ;; FIXME: `foo a!nd bar' should transpose into `bar and foo'.
+ (interactive "*p")
+ (transpose-subr 'forward-word arg))
+
+(defun transpose-sexps (arg)
+ "Like \\[transpose-words] but applies to sexps.
+Does not work on a sexp that point is in the middle of
+if it is a list or string."
+ (interactive "*p")
+ (transpose-subr
+ (lambda (arg)
+ ;; Here we should try to simulate the behavior of
+ ;; (cons (progn (forward-sexp x) (point))
+ ;; (progn (forward-sexp (- x)) (point)))
+ ;; Except that we don't want to rely on the second forward-sexp
+ ;; putting us back to where we want to be, since forward-sexp-function
+ ;; might do funny things like infix-precedence.
+ (if (if (> arg 0)
+ (looking-at "\\sw\\|\\s_")
+ (and (not (bobp))
+ (save-excursion (forward-char -1) (looking-at "\\sw\\|\\s_"))))
+ ;; Jumping over a symbol. We might be inside it, mind you.
+ (progn (funcall (if (> arg 0)
+ 'skip-syntax-backward 'skip-syntax-forward)
+ "w_")
+ (cons (save-excursion (forward-sexp arg) (point)) (point)))
+ ;; Otherwise, we're between sexps. Take a step back before jumping
+ ;; to make sure we'll obey the same precedence no matter which direction
+ ;; we're going.
+ (funcall (if (> arg 0) 'skip-syntax-backward 'skip-syntax-forward) " .")
+ (cons (save-excursion (forward-sexp arg) (point))
+ (progn (while (or (forward-comment (if (> arg 0) 1 -1))
+ (not (zerop (funcall (if (> arg 0)
+ 'skip-syntax-forward
+ 'skip-syntax-backward)
+ ".")))))
+ (point)))))
+ arg 'special))
+
+(defun transpose-lines (arg)
+ "Exchange current line and previous line, leaving point after both.
+With argument ARG, takes previous line and moves it past ARG lines.
+With argument 0, interchanges line point is in with line mark is in."
+ (interactive "*p")
+ (transpose-subr (function
+ (lambda (arg)
+ (if (> arg 0)
+ (progn
+ ;; Move forward over ARG lines,
+ ;; but create newlines if necessary.
+ (setq arg (forward-line arg))
+ (if (/= (preceding-char) ?\n)
+ (setq arg (1+ arg)))
+ (if (> arg 0)
+ (newline arg)))
+ (forward-line arg))))
+ arg))
+
+;; FIXME seems to leave point BEFORE the current object when ARG = 0,
+;; which seems inconsistent with the ARG /= 0 case.
+;; FIXME document SPECIAL.
+(defun transpose-subr (mover arg &optional special)
+ "Subroutine to do the work of transposing objects.
+Works for lines, sentences, paragraphs, etc. MOVER is a function that
+moves forward by units of the given object (e.g. forward-sentence,
+forward-paragraph). If ARG is zero, exchanges the current object
+with the one containing mark. If ARG is an integer, moves the
+current object past ARG following (if ARG is positive) or
+preceding (if ARG is negative) objects, leaving point after the
+current object."
+ (let ((aux (if special mover
+ (lambda (x)
+ (cons (progn (funcall mover x) (point))
+ (progn (funcall mover (- x)) (point))))))
+ pos1 pos2)
+ (cond
+ ((= arg 0)
+ (save-excursion
+ (setq pos1 (funcall aux 1))
+ (goto-char (or (mark) (error "No mark set in this buffer")))
+ (setq pos2 (funcall aux 1))
+ (transpose-subr-1 pos1 pos2))
+ (exchange-point-and-mark))
+ ((> arg 0)
+ (setq pos1 (funcall aux -1))
+ (setq pos2 (funcall aux arg))
+ (transpose-subr-1 pos1 pos2)
+ (goto-char (car pos2)))
+ (t
+ (setq pos1 (funcall aux -1))
+ (goto-char (car pos1))
+ (setq pos2 (funcall aux arg))
+ (transpose-subr-1 pos1 pos2)))))
+
+(defun transpose-subr-1 (pos1 pos2)
+ (when (> (car pos1) (cdr pos1)) (setq pos1 (cons (cdr pos1) (car pos1))))
+ (when (> (car pos2) (cdr pos2)) (setq pos2 (cons (cdr pos2) (car pos2))))
+ (when (> (car pos1) (car pos2))
+ (let ((swap pos1))
+ (setq pos1 pos2 pos2 swap)))
+ (if (> (cdr pos1) (car pos2)) (error "Don't have two things to transpose"))
+ (atomic-change-group
+ ;; This sequence of insertions attempts to preserve marker
+ ;; positions at the start and end of the transposed objects.
+ (let* ((word (buffer-substring (car pos2) (cdr pos2)))
+ (len1 (- (cdr pos1) (car pos1)))
+ (len2 (length word))
+ (boundary (make-marker)))
+ (set-marker boundary (car pos2))
+ (goto-char (cdr pos1))
+ (insert-before-markers word)
+ (setq word (delete-and-extract-region (car pos1) (+ (car pos1) len1)))
+ (goto-char boundary)
+ (insert word)
+ (goto-char (+ boundary len1))
+ (delete-region (point) (+ (point) len2))
+ (set-marker boundary nil))))
+
+(defun backward-word (&optional arg)
+ "Move backward until encountering the beginning of a word.
+With argument ARG, do this that many times.
+If ARG is omitted or nil, move point backward one word."
+ (interactive "^p")
+ (forward-word (- (or arg 1))))
+
+(defun mark-word (&optional arg allow-extend)
+ "Set mark ARG words away from point.
+The place mark goes is the same place \\[forward-word] would
+move to with the same argument.
+Interactively, if this command is repeated
+or (in Transient Mark mode) if the mark is active,
+it marks the next ARG words after the ones already marked."
+ (interactive "P\np")
+ (cond ((and allow-extend
+ (or (and (eq last-command this-command) (mark t))
+ (region-active-p)))
+ (setq arg (if arg (prefix-numeric-value arg)
+ (if (< (mark) (point)) -1 1)))
+ (set-mark
+ (save-excursion
+ (goto-char (mark))
+ (forward-word arg)
+ (point))))
+ (t
+ (push-mark
+ (save-excursion
+ (forward-word (prefix-numeric-value arg))
+ (point))
+ nil t))))
+
+(defun kill-word (arg)
+ "Kill characters forward until encountering the end of a word.
+With argument ARG, do this that many times."
+ (interactive "p")
+ (kill-region (point) (progn (forward-word arg) (point))))
+
+(defun backward-kill-word (arg)
+ "Kill characters backward until encountering the beginning of a word.
+With argument ARG, do this that many times."
+ (interactive "p")
+ (kill-word (- arg)))
+
+(defun current-word (&optional strict really-word)
+ "Return the symbol or word that point is on (or a nearby one) as a string.
+The return value includes no text properties.
+If optional arg STRICT is non-nil, return nil unless point is within
+or adjacent to a symbol or word. In all cases the value can be nil
+if there is no word nearby.
+The function, belying its name, normally finds a symbol.
+If optional arg REALLY-WORD is non-nil, it finds just a word."
+ (save-excursion
+ (let* ((oldpoint (point)) (start (point)) (end (point))
+ (syntaxes (if really-word "w" "w_"))
+ (not-syntaxes (concat "^" syntaxes)))
+ (skip-syntax-backward syntaxes) (setq start (point))
+ (goto-char oldpoint)
+ (skip-syntax-forward syntaxes) (setq end (point))
+ (when (and (eq start oldpoint) (eq end oldpoint)
+ ;; Point is neither within nor adjacent to a word.
+ (not strict))
+ ;; Look for preceding word in same line.
+ (skip-syntax-backward not-syntaxes (line-beginning-position))
+ (if (bolp)
+ ;; No preceding word in same line.
+ ;; Look for following word in same line.
+ (progn
+ (skip-syntax-forward not-syntaxes (line-end-position))
+ (setq start (point))
+ (skip-syntax-forward syntaxes)
+ (setq end (point)))
+ (setq end (point))
+ (skip-syntax-backward syntaxes)
+ (setq start (point))))
+ ;; If we found something nonempty, return it as a string.
+ (unless (= start end)
+ (buffer-substring-no-properties start end)))))
+
+(defcustom fill-prefix nil
+ "String for filling to insert at front of new line, or nil for none."
+ :type '(choice (const :tag "None" nil)
+ string)
+ :group 'fill)
+(make-variable-buffer-local 'fill-prefix)
+(put 'fill-prefix 'safe-local-variable 'string-or-null-p)
+
+(defcustom auto-fill-inhibit-regexp nil
+ "Regexp to match lines which should not be auto-filled."
+ :type '(choice (const :tag "None" nil)
+ regexp)
+ :group 'fill)
+
+(defun do-auto-fill ()
+ "The default value for `normal-auto-fill-function'.
+This is the default auto-fill function, some major modes use a different one.
+Returns t if it really did any work."
+ (let (fc justify give-up
+ (fill-prefix fill-prefix))
+ (if (or (not (setq justify (current-justification)))
+ (null (setq fc (current-fill-column)))
+ (and (eq justify 'left)
+ (<= (current-column) fc))
+ (and auto-fill-inhibit-regexp
+ (save-excursion (beginning-of-line)
+ (looking-at auto-fill-inhibit-regexp))))
+ nil ;; Auto-filling not required
+ (if (memq justify '(full center right))
+ (save-excursion (unjustify-current-line)))
+
+ ;; Choose a fill-prefix automatically.
+ (when (and adaptive-fill-mode
+ (or (null fill-prefix) (string= fill-prefix "")))
+ (let ((prefix
+ (fill-context-prefix
+ (save-excursion (fill-forward-paragraph -1) (point))
+ (save-excursion (fill-forward-paragraph 1) (point)))))
+ (and prefix (not (equal prefix ""))
+ ;; Use auto-indentation rather than a guessed empty prefix.
+ (not (and fill-indent-according-to-mode
+ (string-match "\\`[ \t]*\\'" prefix)))
+ (setq fill-prefix prefix))))
+
+ (while (and (not give-up) (> (current-column) fc))
+ ;; Determine where to split the line.
+ (let* (after-prefix
+ (fill-point
+ (save-excursion
+ (beginning-of-line)
+ (setq after-prefix (point))
+ (and fill-prefix
+ (looking-at (regexp-quote fill-prefix))
+ (setq after-prefix (match-end 0)))
+ (move-to-column (1+ fc))
+ (fill-move-to-break-point after-prefix)
+ (point))))
+
+ ;; See whether the place we found is any good.
+ (if (save-excursion
+ (goto-char fill-point)
+ (or (bolp)
+ ;; There is no use breaking at end of line.
+ (save-excursion (skip-chars-forward " ") (eolp))
+ ;; It is futile to split at the end of the prefix
+ ;; since we would just insert the prefix again.
+ (and after-prefix (<= (point) after-prefix))
+ ;; Don't split right after a comment starter
+ ;; since we would just make another comment starter.
+ (and comment-start-skip
+ (let ((limit (point)))
+ (beginning-of-line)
+ (and (re-search-forward comment-start-skip
+ limit t)
+ (eq (point) limit))))))
+ ;; No good place to break => stop trying.
+ (setq give-up t)
+ ;; Ok, we have a useful place to break the line. Do it.
+ (let ((prev-column (current-column)))
+ ;; If point is at the fill-point, do not `save-excursion'.
+ ;; Otherwise, if a comment prefix or fill-prefix is inserted,
+ ;; point will end up before it rather than after it.
+ (if (save-excursion
+ (skip-chars-backward " \t")
+ (= (point) fill-point))
+ (default-indent-new-line t)
+ (save-excursion
+ (goto-char fill-point)
+ (default-indent-new-line t)))
+ ;; Now do justification, if required
+ (if (not (eq justify 'left))
+ (save-excursion
+ (end-of-line 0)
+ (justify-current-line justify nil t)))
+ ;; If making the new line didn't reduce the hpos of
+ ;; the end of the line, then give up now;
+ ;; trying again will not help.
+ (if (>= (current-column) prev-column)
+ (setq give-up t))))))
+ ;; Justify last line.
+ (justify-current-line justify t t)
+ t)))
+
+(defvar comment-line-break-function 'comment-indent-new-line
+ "Mode-specific function which line breaks and continues a comment.
+This function is called during auto-filling when a comment syntax
+is defined.
+The function should take a single optional argument, which is a flag
+indicating whether it should use soft newlines.")
+
+(defun default-indent-new-line (&optional soft)
+ "Break line at point and indent.
+If a comment syntax is defined, call `comment-indent-new-line'.
+
+The inserted newline is marked hard if variable `use-hard-newlines' is true,
+unless optional argument SOFT is non-nil."
+ (interactive)
+ (if comment-start
+ (funcall comment-line-break-function soft)
+ ;; Insert the newline before removing empty space so that markers
+ ;; get preserved better.
+ (if soft (insert-and-inherit ?\n) (newline 1))
+ (save-excursion (forward-char -1) (delete-horizontal-space))
+ (delete-horizontal-space)
+
+ (if (and fill-prefix (not adaptive-fill-mode))
+ ;; Blindly trust a non-adaptive fill-prefix.
+ (progn
+ (indent-to-left-margin)
+ (insert-before-markers-and-inherit fill-prefix))
+
+ (cond
+ ;; If there's an adaptive prefix, use it unless we're inside
+ ;; a comment and the prefix is not a comment starter.
+ (fill-prefix
+ (indent-to-left-margin)
+ (insert-and-inherit fill-prefix))
+ ;; If we're not inside a comment, just try to indent.
+ (t (indent-according-to-mode))))))
+
+(defvar normal-auto-fill-function 'do-auto-fill
+ "The function to use for `auto-fill-function' if Auto Fill mode is turned on.
+Some major modes set this.")
+
+(put 'auto-fill-function :minor-mode-function 'auto-fill-mode)
+;; `functions' and `hooks' are usually unsafe to set, but setting
+;; auto-fill-function to nil in a file-local setting is safe and
+;; can be useful to prevent auto-filling.
+(put 'auto-fill-function 'safe-local-variable 'null)
+
+(define-minor-mode auto-fill-mode
+ "Toggle automatic line breaking (Auto Fill mode).
+With a prefix argument ARG, enable Auto Fill mode if ARG is
+positive, and disable it otherwise. If called from Lisp, enable
+the mode if ARG is omitted or nil.
+
+When Auto Fill mode is enabled, inserting a space at a column
+beyond `current-fill-column' automatically breaks the line at a
+previous space.
+
+When `auto-fill-mode' is on, the `auto-fill-function' variable is
+non-`nil'.
+
+The value of `normal-auto-fill-function' specifies the function to use
+for `auto-fill-function' when turning Auto Fill mode on."
+ :variable (auto-fill-function
+ . (lambda (v) (setq auto-fill-function
+ (if v normal-auto-fill-function)))))
+
+;; This holds a document string used to document auto-fill-mode.
+(defun auto-fill-function ()
+ "Automatically break line at a previous space, in insertion of text."
+ nil)
+
+(defun turn-on-auto-fill ()
+ "Unconditionally turn on Auto Fill mode."
+ (auto-fill-mode 1))
+
+(defun turn-off-auto-fill ()
+ "Unconditionally turn off Auto Fill mode."
+ (auto-fill-mode -1))
+
+(custom-add-option 'text-mode-hook 'turn-on-auto-fill)
+
+(defun set-fill-column (arg)
+ "Set `fill-column' to specified argument.
+Use \\[universal-argument] followed by a number to specify a column.
+Just \\[universal-argument] as argument means to use the current column."
+ (interactive
+ (list (or current-prefix-arg
+ ;; We used to use current-column silently, but C-x f is too easily
+ ;; typed as a typo for C-x C-f, so we turned it into an error and
+ ;; now an interactive prompt.
+ (read-number "Set fill-column to: " (current-column)))))
+ (if (consp arg)
+ (setq arg (current-column)))
+ (if (not (integerp arg))
+ ;; Disallow missing argument; it's probably a typo for C-x C-f.
+ (error "set-fill-column requires an explicit argument")
+ (message "Fill column set to %d (was %d)" arg fill-column)
+ (setq fill-column arg)))
+
+(defun set-selective-display (arg)
+ "Set `selective-display' to ARG; clear it if no arg.
+When the value of `selective-display' is a number > 0,
+lines whose indentation is >= that value are not displayed.
+The variable `selective-display' has a separate value for each buffer."
+ (interactive "P")
+ (if (eq selective-display t)
+ (error "selective-display already in use for marked lines"))
+ (let ((current-vpos
+ (save-restriction
+ (narrow-to-region (point-min) (point))
+ (goto-char (window-start))
+ (vertical-motion (window-height)))))
+ (setq selective-display
+ (and arg (prefix-numeric-value arg)))
+ (recenter current-vpos))
+ (set-window-start (selected-window) (window-start))
+ (princ "selective-display set to " t)
+ (prin1 selective-display t)
+ (princ "." t))
+
+(defvaralias 'indicate-unused-lines 'indicate-empty-lines)
+
+(defun toggle-truncate-lines (&optional arg)
+ "Toggle truncating of long lines for the current buffer.
+When truncating is off, long lines are folded.
+With prefix argument ARG, truncate long lines if ARG is positive,
+otherwise fold them. Note that in side-by-side windows, this
+command has no effect if `truncate-partial-width-windows' is
+non-nil."
+ (interactive "P")
+ (setq truncate-lines
+ (if (null arg)
+ (not truncate-lines)
+ (> (prefix-numeric-value arg) 0)))
+ (force-mode-line-update)
+ (unless truncate-lines
+ (let ((buffer (current-buffer)))
+ (walk-windows (lambda (window)
+ (if (eq buffer (window-buffer window))
+ (set-window-hscroll window 0)))
+ nil t)))
+ (message "Truncate long lines %s"
+ (if truncate-lines "enabled" "disabled")))
+
+(defun toggle-word-wrap (&optional arg)
+ "Toggle whether to use word-wrapping for continuation lines.
+With prefix argument ARG, wrap continuation lines at word boundaries
+if ARG is positive, otherwise wrap them at the right screen edge.
+This command toggles the value of `word-wrap'. It has no effect
+if long lines are truncated."
+ (interactive "P")
+ (setq word-wrap
+ (if (null arg)
+ (not word-wrap)
+ (> (prefix-numeric-value arg) 0)))
+ (force-mode-line-update)
+ (message "Word wrapping %s"
+ (if word-wrap "enabled" "disabled")))
+
+(defvar overwrite-mode-textual (purecopy " Ovwrt")
+ "The string displayed in the mode line when in overwrite mode.")
+(defvar overwrite-mode-binary (purecopy " Bin Ovwrt")
+ "The string displayed in the mode line when in binary overwrite mode.")
+
+(define-minor-mode overwrite-mode
+ "Toggle Overwrite mode.
+With a prefix argument ARG, enable Overwrite mode if ARG is
+positive, and disable it otherwise. If called from Lisp, enable
+the mode if ARG is omitted or nil.
+
+When Overwrite mode is enabled, printing characters typed in
+replace existing text on a one-for-one basis, rather than pushing
+it to the right. At the end of a line, such characters extend
+the line. Before a tab, such characters insert until the tab is
+filled in. \\[quoted-insert] still inserts characters in
+overwrite mode; this is supposed to make it easier to insert
+characters when necessary."
+ :variable (overwrite-mode
+ . (lambda (v) (setq overwrite-mode (if v
'overwrite-mode-textual)))))
+
+(define-minor-mode binary-overwrite-mode
+ "Toggle Binary Overwrite mode.
+With a prefix argument ARG, enable Binary Overwrite mode if ARG
+is positive, and disable it otherwise. If called from Lisp,
+enable the mode if ARG is omitted or nil.
+
+When Binary Overwrite mode is enabled, printing characters typed
+in replace existing text. Newlines are not treated specially, so
+typing at the end of a line joins the line to the next, with the
+typed character between them. Typing before a tab character
+simply replaces the tab with the character typed.
+\\[quoted-insert] replaces the text at the cursor, just as
+ordinary typing characters do.
+
+Note that Binary Overwrite mode is not its own minor mode; it is
+a specialization of overwrite mode, entered by setting the
+`overwrite-mode' variable to `overwrite-mode-binary'."
+ :variable (overwrite-mode
+ . (lambda (v) (setq overwrite-mode (if v
'overwrite-mode-binary)))))
+
+(define-minor-mode line-number-mode
+ "Toggle line number display in the mode line (Line Number mode).
+With a prefix argument ARG, enable Line Number mode if ARG is
+positive, and disable it otherwise. If called from Lisp, enable
+the mode if ARG is omitted or nil.
+
+Line numbers do not appear for very large buffers and buffers
+with very long lines; see variables `line-number-display-limit'
+and `line-number-display-limit-width'."
+ :init-value t :global t :group 'mode-line)
+
+(define-minor-mode column-number-mode
+ "Toggle column number display in the mode line (Column Number mode).
+With a prefix argument ARG, enable Column Number mode if ARG is
+positive, and disable it otherwise.
+
+If called from Lisp, enable the mode if ARG is omitted or nil."
+ :global t :group 'mode-line)
+
+(define-minor-mode size-indication-mode
+ "Toggle buffer size display in the mode line (Size Indication mode).
+With a prefix argument ARG, enable Size Indication mode if ARG is
+positive, and disable it otherwise.
+
+If called from Lisp, enable the mode if ARG is omitted or nil."
+ :global t :group 'mode-line)
+
+(define-minor-mode auto-save-mode
+ "Toggle auto-saving in the current buffer (Auto Save mode).
+With a prefix argument ARG, enable Auto Save mode if ARG is
+positive, and disable it otherwise.
+
+If called from Lisp, enable the mode if ARG is omitted or nil."
+ :variable ((and buffer-auto-save-file-name
+ ;; If auto-save is off because buffer has shrunk,
+ ;; then toggling should turn it on.
+ (>= buffer-saved-size 0))
+ . (lambda (val)
+ (setq buffer-auto-save-file-name
+ (cond
+ ((null val) nil)
+ ((and buffer-file-name auto-save-visited-file-name
+ (not buffer-read-only))
+ buffer-file-name)
+ (t (make-auto-save-file-name))))))
+ ;; If -1 was stored here, to temporarily turn off saving,
+ ;; turn it back on.
+ (and (< buffer-saved-size 0)
+ (setq buffer-saved-size 0)))
+
+(defgroup paren-blinking nil
+ "Blinking matching of parens and expressions."
+ :prefix "blink-matching-"
+ :group 'paren-matching)
+
+(defcustom blink-matching-paren t
+ "Non-nil means show matching open-paren when close-paren is inserted.
+If t, highlight the paren. If `jump', move cursor to its position."
+ :type '(choice
+ (const :tag "Disable" nil)
+ (const :tag "Highlight" t)
+ (const :tag "Move cursor" jump))
+ :group 'paren-blinking)
+
+(defcustom blink-matching-paren-on-screen t
+ "Non-nil means show matching open-paren when it is on screen.
+If nil, don't show it (but the open-paren can still be shown
+when it is off screen).
+
+This variable has no effect if `blink-matching-paren' is nil.
+\(In that case, the open-paren is never shown.)
+It is also ignored if `show-paren-mode' is enabled."
+ :type 'boolean
+ :group 'paren-blinking)
+
+(defcustom blink-matching-paren-distance (* 100 1024)
+ "If non-nil, maximum distance to search backwards for matching open-paren.
+If nil, search stops at the beginning of the accessible portion of the buffer."
+ :version "23.2" ; 25->100k
+ :type '(choice (const nil) integer)
+ :group 'paren-blinking)
+
+(defcustom blink-matching-delay 1
+ "Time in seconds to delay after showing a matching paren."
+ :type 'number
+ :group 'paren-blinking)
+
+(defcustom blink-matching-paren-dont-ignore-comments nil
+ "If nil, `blink-matching-paren' ignores comments.
+More precisely, when looking for the matching parenthesis,
+it skips the contents of comments that end before point."
+ :type 'boolean
+ :group 'paren-blinking)
+
+(defun blink-matching-check-mismatch (start end)
+ "Return whether or not START...END are matching parens.
+END is the current point and START is the blink position.
+START might be nil if no matching starter was found.
+Returns non-nil if we find there is a mismatch."
+ (let* ((end-syntax (syntax-after (1- end)))
+ (matching-paren (and (consp end-syntax)
+ (eq (syntax-class end-syntax) 5)
+ (cdr end-syntax))))
+ ;; For self-matched chars like " and $, we can't know when they're
+ ;; mismatched or unmatched, so we can only do it for parens.
+ (when matching-paren
+ (not (and start
+ (or
+ (eq (char-after start) matching-paren)
+ ;; The cdr might hold a new paren-class info rather than
+ ;; a matching-char info, in which case the two CDRs
+ ;; should match.
+ (eq matching-paren (cdr-safe (syntax-after start)))))))))
+
+(defvar blink-matching-check-function #'blink-matching-check-mismatch
+ "Function to check parentheses mismatches.
+The function takes two arguments (START and END) where START is the
+position just before the opening token and END is the position right after.
+START can be nil, if it was not found.
+The function should return non-nil if the two tokens do not match.")
+
+(defvar blink-matching--overlay
+ (let ((ol (make-overlay (point) (point) nil t)))
+ (overlay-put ol 'face 'show-paren-match)
+ (delete-overlay ol)
+ ol)
+ "Overlay used to highlight the matching paren.")
+
+(defun blink-matching-open ()
+ "Momentarily highlight the beginning of the sexp before point."
+ (interactive)
+ (when (and (not (bobp))
+ blink-matching-paren)
+ (let* ((oldpos (point))
+ (message-log-max nil) ; Don't log messages about paren matching.
+ (blinkpos
+ (save-excursion
+ (save-restriction
+ (if blink-matching-paren-distance
+ (narrow-to-region
+ (max (minibuffer-prompt-end) ;(point-min) unless minibuf.
+ (- (point) blink-matching-paren-distance))
+ oldpos))
+ (let ((parse-sexp-ignore-comments
+ (and parse-sexp-ignore-comments
+ (not blink-matching-paren-dont-ignore-comments))))
+ (condition-case ()
+ (progn
+ (forward-sexp -1)
+ ;; backward-sexp skips backward over prefix chars,
+ ;; so move back to the matching paren.
+ (while (and (< (point) (1- oldpos))
+ (let ((code (syntax-after (point))))
+ (or (eq (syntax-class code) 6)
+ (eq (logand 1048576 (car code))
+ 1048576))))
+ (forward-char 1))
+ (point))
+ (error nil))))))
+ (mismatch (funcall blink-matching-check-function blinkpos oldpos)))
+ (cond
+ (mismatch
+ (if blinkpos
+ (if (minibufferp)
+ (minibuffer-message "Mismatched parentheses")
+ (message "Mismatched parentheses"))
+ (if (minibufferp)
+ (minibuffer-message "No matching parenthesis found")
+ (message "No matching parenthesis found"))))
+ ((not blinkpos) nil)
+ ((pos-visible-in-window-p blinkpos)
+ ;; Matching open within window, temporarily move to or highlight
+ ;; char after blinkpos but only if `blink-matching-paren-on-screen'
+ ;; is non-nil.
+ (and blink-matching-paren-on-screen
+ (not show-paren-mode)
+ (if (eq blink-matching-paren 'jump)
+ (save-excursion
+ (goto-char blinkpos)
+ (sit-for blink-matching-delay))
+ (unwind-protect
+ (progn
+ (move-overlay blink-matching--overlay blinkpos (1+
blinkpos)
+ (current-buffer))
+ (sit-for blink-matching-delay))
+ (delete-overlay blink-matching--overlay)))))
+ (t
+ (save-excursion
+ (goto-char blinkpos)
+ (let ((open-paren-line-string
+ ;; Show what precedes the open in its line, if anything.
+ (cond
+ ((save-excursion (skip-chars-backward " \t") (not (bolp)))
+ (buffer-substring (line-beginning-position)
+ (1+ blinkpos)))
+ ;; Show what follows the open in its line, if anything.
+ ((save-excursion
+ (forward-char 1)
+ (skip-chars-forward " \t")
+ (not (eolp)))
+ (buffer-substring blinkpos
+ (line-end-position)))
+ ;; Otherwise show the previous nonblank line,
+ ;; if there is one.
+ ((save-excursion (skip-chars-backward "\n \t") (not (bobp)))
+ (concat
+ (buffer-substring (progn
+ (skip-chars-backward "\n \t")
+ (line-beginning-position))
+ (progn (end-of-line)
+ (skip-chars-backward " \t")
+ (point)))
+ ;; Replace the newline and other whitespace with `...'.
+ "..."
+ (buffer-substring blinkpos (1+ blinkpos))))
+ ;; There is nothing to show except the char itself.
+ (t (buffer-substring blinkpos (1+ blinkpos))))))
+ (message "Matches %s"
+ (substring-no-properties open-paren-line-string)))))))))
+
+(defvar blink-paren-function 'blink-matching-open
+ "Function called, if non-nil, whenever a close parenthesis is inserted.
+More precisely, a char with closeparen syntax is self-inserted.")
+
+(defun blink-paren-post-self-insert-function ()
+ (when (and (eq (char-before) last-command-event) ; Sanity check.
+ (memq (char-syntax last-command-event) '(?\) ?\$))
+ blink-paren-function
+ (not executing-kbd-macro)
+ (not noninteractive)
+ ;; Verify an even number of quoting characters precede the close.
+ (= 1 (logand 1 (- (point)
+ (save-excursion
+ (forward-char -1)
+ (skip-syntax-backward "/\\")
+ (point))))))
+ (funcall blink-paren-function)))
+
+(put 'blink-paren-post-self-insert-function 'priority 100)
+
+(add-hook 'post-self-insert-hook #'blink-paren-post-self-insert-function
+ ;; Most likely, this hook is nil, so this arg doesn't matter,
+ ;; but I use it as a reminder that this function usually
+ ;; likes to be run after others since it does
+ ;; `sit-for'. That's also the reason it get a `priority' prop
+ ;; of 100.
+ 'append)
+
+;; This executes C-g typed while Emacs is waiting for a command.
+;; Quitting out of a program does not go through here;
+;; that happens in the QUIT macro at the C code level.
+(defun keyboard-quit ()
+ "Signal a `quit' condition.
+During execution of Lisp code, this character causes a quit directly.
+At top-level, as an editor command, this simply beeps."
+ (interactive)
+ ;; Avoid adding the region to the window selection.
+ (setq saved-region-selection nil)
+ (let (select-active-regions)
+ (deactivate-mark))
+ (if (fboundp 'kmacro-keyboard-quit)
+ (kmacro-keyboard-quit))
+ ;; Force the next redisplay cycle to remove the "Def" indicator from
+ ;; all the mode lines.
+ (if defining-kbd-macro
+ (force-mode-line-update t))
+ (setq defining-kbd-macro nil)
+ (let ((debug-on-quit nil))
+ (signal 'quit nil)))
+
+(defvar buffer-quit-function nil
+ "Function to call to \"quit\" the current buffer, or nil if none.
+\\[keyboard-escape-quit] calls this function when its more local actions
+\(such as canceling a prefix argument, minibuffer or region) do not apply.")
+
+(defun keyboard-escape-quit ()
+ "Exit the current \"mode\" (in a generalized sense of the word).
+This command can exit an interactive command such as `query-replace',
+can clear out a prefix argument or a region,
+can get out of the minibuffer or other recursive edit,
+cancel the use of the current buffer (for special-purpose buffers),
+or go back to just one window (by deleting all but the selected window)."
+ (interactive)
+ (cond ((eq last-command 'mode-exited) nil)
+ ((region-active-p)
+ (deactivate-mark))
+ ((> (minibuffer-depth) 0)
+ (abort-recursive-edit))
+ (current-prefix-arg
+ nil)
+ ((> (recursion-depth) 0)
+ (exit-recursive-edit))
+ (buffer-quit-function
+ (funcall buffer-quit-function))
+ ((not (one-window-p t))
+ (delete-other-windows))
+ ((string-match "^ \\*" (buffer-name (current-buffer)))
+ (bury-buffer))))
+
+(defun play-sound-file (file &optional volume device)
+ "Play sound stored in FILE.
+VOLUME and DEVICE correspond to the keywords of the sound
+specification for `play-sound'."
+ (interactive "fPlay sound file: ")
+ (let ((sound (list :file file)))
+ (if volume
+ (plist-put sound :volume volume))
+ (if device
+ (plist-put sound :device device))
+ (push 'sound sound)
+ (play-sound sound)))
+
+
+(defcustom read-mail-command 'rmail
+ "Your preference for a mail reading package.
+This is used by some keybindings which support reading mail.
+See also `mail-user-agent' concerning sending mail."
+ :type '(radio (function-item :tag "Rmail" :format "%t\n" rmail)
+ (function-item :tag "Gnus" :format "%t\n" gnus)
+ (function-item :tag "Emacs interface to MH"
+ :format "%t\n" mh-rmail)
+ (function :tag "Other"))
+ :version "21.1"
+ :group 'mail)
+
+(defcustom mail-user-agent 'message-user-agent
+ "Your preference for a mail composition package.
+Various Emacs Lisp packages (e.g. Reporter) require you to compose an
+outgoing email message. This variable lets you specify which
+mail-sending package you prefer.
+
+Valid values include:
+
+ `message-user-agent' -- use the Message package.
+ See Info node `(message)'.
+ `sendmail-user-agent' -- use the Mail package.
+ See Info node `(emacs)Sending Mail'.
+ `mh-e-user-agent' -- use the Emacs interface to the MH mail system.
+ See Info node `(mh-e)'.
+ `gnus-user-agent' -- like `message-user-agent', but with Gnus
+ paraphernalia if Gnus is running, particularly
+ the Gcc: header for archiving.
+
+Additional valid symbols may be available; check with the author of
+your package for details. The function should return non-nil if it
+succeeds.
+
+See also `read-mail-command' concerning reading mail."
+ :type '(radio (function-item :tag "Message package"
+ :format "%t\n"
+ message-user-agent)
+ (function-item :tag "Mail package"
+ :format "%t\n"
+ sendmail-user-agent)
+ (function-item :tag "Emacs interface to MH"
+ :format "%t\n"
+ mh-e-user-agent)
+ (function-item :tag "Message with full Gnus features"
+ :format "%t\n"
+ gnus-user-agent)
+ (function :tag "Other"))
+ :version "23.2" ; sendmail->message
+ :group 'mail)
+
+(defcustom compose-mail-user-agent-warnings t
+ "If non-nil, `compose-mail' warns about changes in `mail-user-agent'.
+If the value of `mail-user-agent' is the default, and the user
+appears to have customizations applying to the old default,
+`compose-mail' issues a warning."
+ :type 'boolean
+ :version "23.2"
+ :group 'mail)
+
+(defun rfc822-goto-eoh ()
+ "If the buffer starts with a mail header, move point to the header's end.
+Otherwise, moves to `point-min'.
+The end of the header is the start of the next line, if there is one,
+else the end of the last line. This function obeys RFC822."
+ (goto-char (point-min))
+ (when (re-search-forward
+ "^\\([:\n]\\|[^: \t\n]+[ \t\n]\\)" nil 'move)
+ (goto-char (match-beginning 0))))
+
+;; Used by Rmail (e.g., rmail-forward).
+(defvar mail-encode-mml nil
+ "If non-nil, mail-user-agent's `sendfunc' command should mml-encode
+the outgoing message before sending it.")
+
+(defun compose-mail (&optional to subject other-headers continue
+ switch-function yank-action send-actions
+ return-action)
+ "Start composing a mail message to send.
+This uses the user's chosen mail composition package
+as selected with the variable `mail-user-agent'.
+The optional arguments TO and SUBJECT specify recipients
+and the initial Subject field, respectively.
+
+OTHER-HEADERS is an alist specifying additional
+header fields. Elements look like (HEADER . VALUE) where both
+HEADER and VALUE are strings.
+
+CONTINUE, if non-nil, says to continue editing a message already
+being composed. Interactively, CONTINUE is the prefix argument.
+
+SWITCH-FUNCTION, if non-nil, is a function to use to
+switch to and display the buffer used for mail composition.
+
+YANK-ACTION, if non-nil, is an action to perform, if and when necessary,
+to insert the raw text of the message being replied to.
+It has the form (FUNCTION . ARGS). The user agent will apply
+FUNCTION to ARGS, to insert the raw text of the original message.
+\(The user agent will also run `mail-citation-hook', *after* the
+original text has been inserted in this way.)
+
+SEND-ACTIONS is a list of actions to call when the message is sent.
+Each action has the form (FUNCTION . ARGS).
+
+RETURN-ACTION, if non-nil, is an action for returning to the
+caller. It has the form (FUNCTION . ARGS). The function is
+called after the mail has been sent or put aside, and the mail
+buffer buried."
+ (interactive
+ (list nil nil nil current-prefix-arg))
+
+ ;; In Emacs 23.2, the default value of `mail-user-agent' changed
+ ;; from sendmail-user-agent to message-user-agent. Some users may
+ ;; encounter incompatibilities. This hack tries to detect problems
+ ;; and warn about them.
+ (and compose-mail-user-agent-warnings
+ (eq mail-user-agent 'message-user-agent)
+ (let (warn-vars)
+ (dolist (var '(mail-mode-hook mail-send-hook mail-setup-hook
+ mail-yank-hooks mail-archive-file-name
+ mail-default-reply-to mail-mailing-lists
+ mail-self-blind))
+ (and (boundp var)
+ (symbol-value var)
+ (push var warn-vars)))
+ (when warn-vars
+ (display-warning 'mail
+ (format "\
+The default mail mode is now Message mode.
+You have the following Mail mode variable%s customized:
+\n %s\n\nTo use Mail mode, set `mail-user-agent' to sendmail-user-agent.
+To disable this warning, set `compose-mail-user-agent-warnings' to nil."
+ (if (> (length warn-vars) 1) "s" "")
+ (mapconcat 'symbol-name
+ warn-vars " "))))))
+
+ (let ((function (get mail-user-agent 'composefunc)))
+ (funcall function to subject other-headers continue switch-function
+ yank-action send-actions return-action)))
+
+(defun compose-mail-other-window (&optional to subject other-headers continue
+ yank-action send-actions
+ return-action)
+ "Like \\[compose-mail], but edit the outgoing message in another window."
+ (interactive (list nil nil nil current-prefix-arg))
+ (compose-mail to subject other-headers continue
+ 'switch-to-buffer-other-window yank-action send-actions
+ return-action))
+
+(defun compose-mail-other-frame (&optional to subject other-headers continue
+ yank-action send-actions
+ return-action)
+ "Like \\[compose-mail], but edit the outgoing message in another frame."
+ (interactive (list nil nil nil current-prefix-arg))
+ (compose-mail to subject other-headers continue
+ 'switch-to-buffer-other-frame yank-action send-actions
+ return-action))
+
+
+(defvar set-variable-value-history nil
+ "History of values entered with `set-variable'.
+
+Maximum length of the history list is determined by the value
+of `history-length', which see.")
+
+(defun set-variable (variable value &optional make-local)
+ "Set VARIABLE to VALUE. VALUE is a Lisp object.
+VARIABLE should be a user option variable name, a Lisp variable
+meant to be customized by users. You should enter VALUE in Lisp syntax,
+so if you want VALUE to be a string, you must surround it with doublequotes.
+VALUE is used literally, not evaluated.
+
+If VARIABLE has a `variable-interactive' property, that is used as if
+it were the arg to `interactive' (which see) to interactively read VALUE.
+
+If VARIABLE has been defined with `defcustom', then the type information
+in the definition is used to check that VALUE is valid.
+
+With a prefix argument, set VARIABLE to VALUE buffer-locally."
+ (interactive
+ (let* ((default-var (variable-at-point))
+ (var (if (custom-variable-p default-var)
+ (read-variable (format "Set variable (default %s): "
default-var)
+ default-var)
+ (read-variable "Set variable: ")))
+ (minibuffer-help-form '(describe-variable var))
+ (prop (get var 'variable-interactive))
+ (obsolete (car (get var 'byte-obsolete-variable)))
+ (prompt (format "Set %s %s to value: " var
+ (cond ((local-variable-p var)
+ "(buffer-local)")
+ ((or current-prefix-arg
+ (local-variable-if-set-p var))
+ "buffer-locally")
+ (t "globally"))))
+ (val (progn
+ (when obsolete
+ (message (concat "`%S' is obsolete; "
+ (if (symbolp obsolete) "use `%S' instead"
"%s"))
+ var obsolete)
+ (sit-for 3))
+ (if prop
+ ;; Use VAR's `variable-interactive' property
+ ;; as an interactive spec for prompting.
+ (call-interactively `(lambda (arg)
+ (interactive ,prop)
+ arg))
+ (read-from-minibuffer prompt nil
+ read-expression-map t
+ 'set-variable-value-history
+ (format "%S" (symbol-value var)))))))
+ (list var val current-prefix-arg)))
+
+ (and (custom-variable-p variable)
+ (not (get variable 'custom-type))
+ (custom-load-symbol variable))
+ (let ((type (get variable 'custom-type)))
+ (when type
+ ;; Match with custom type.
+ (require 'cus-edit)
+ (setq type (widget-convert type))
+ (unless (widget-apply type :match value)
+ (error "Value `%S' does not match type %S of %S"
+ value (car type) variable))))
+
+ (if make-local
+ (make-local-variable variable))
+
+ (set variable value)
+
+ ;; Force a thorough redisplay for the case that the variable
+ ;; has an effect on the display, like `tab-width' has.
+ (force-mode-line-update))
+
+;; Define the major mode for lists of completions.
+
+(defvar completion-list-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [mouse-2] 'choose-completion)
+ (define-key map [follow-link] 'mouse-face)
+ (define-key map [down-mouse-2] nil)
+ (define-key map "\C-m" 'choose-completion)
+ (define-key map "\e\e\e" 'delete-completion-window)
+ (define-key map [left] 'previous-completion)
+ (define-key map [right] 'next-completion)
+ (define-key map "q" 'quit-window)
+ (define-key map "z" 'kill-this-buffer)
+ map)
+ "Local map for completion list buffers.")
+
+;; Completion mode is suitable only for specially formatted data.
+(put 'completion-list-mode 'mode-class 'special)
+
+(defvar completion-reference-buffer nil
+ "Record the buffer that was current when the completion list was requested.
+This is a local variable in the completion list buffer.
+Initial value is nil to avoid some compiler warnings.")
+
+(defvar completion-no-auto-exit nil
+ "Non-nil means `choose-completion-string' should never exit the minibuffer.
+This also applies to other functions such as `choose-completion'.")
+
+(defvar completion-base-position nil
+ "Position of the base of the text corresponding to the shown completions.
+This variable is used in the *Completions* buffers.
+Its value is a list of the form (START END) where START is the place
+where the completion should be inserted and END (if non-nil) is the end
+of the text to replace. If END is nil, point is used instead.")
+
+(defvar completion-list-insert-choice-function #'completion--replace
+ "Function to use to insert the text chosen in *Completions*.
+Called with three arguments (BEG END TEXT), it should replace the text
+between BEG and END with TEXT. Expected to be set buffer-locally
+in the *Completions* buffer.")
+
+(defvar completion-base-size nil
+ "Number of chars before point not involved in completion.
+This is a local variable in the completion list buffer.
+It refers to the chars in the minibuffer if completing in the
+minibuffer, or in `completion-reference-buffer' otherwise.
+Only characters in the field at point are included.
+
+If nil, Emacs determines which part of the tail end of the
+buffer's text is involved in completion by comparing the text
+directly.")
+(make-obsolete-variable 'completion-base-size 'completion-base-position "23.2")
+
+(defun delete-completion-window ()
+ "Delete the completion list window.
+Go to the window from which completion was requested."
+ (interactive)
+ (let ((buf completion-reference-buffer))
+ (if (one-window-p t)
+ (if (window-dedicated-p) (delete-frame))
+ (delete-window (selected-window))
+ (if (get-buffer-window buf)
+ (select-window (get-buffer-window buf))))))
+
+(defun previous-completion (n)
+ "Move to the previous item in the completion list."
+ (interactive "p")
+ (next-completion (- n)))
+
+(defun next-completion (n)
+ "Move to the next item in the completion list.
+With prefix argument N, move N items (negative N means move backward)."
+ (interactive "p")
+ (let ((beg (point-min)) (end (point-max)))
+ (while (and (> n 0) (not (eobp)))
+ ;; If in a completion, move to the end of it.
+ (when (get-text-property (point) 'mouse-face)
+ (goto-char (next-single-property-change (point) 'mouse-face nil end)))
+ ;; Move to start of next one.
+ (unless (get-text-property (point) 'mouse-face)
+ (goto-char (next-single-property-change (point) 'mouse-face nil end)))
+ (setq n (1- n)))
+ (while (and (< n 0) (not (bobp)))
+ (let ((prop (get-text-property (1- (point)) 'mouse-face)))
+ ;; If in a completion, move to the start of it.
+ (when (and prop (eq prop (get-text-property (point) 'mouse-face)))
+ (goto-char (previous-single-property-change
+ (point) 'mouse-face nil beg)))
+ ;; Move to end of the previous completion.
+ (unless (or (bobp) (get-text-property (1- (point)) 'mouse-face))
+ (goto-char (previous-single-property-change
+ (point) 'mouse-face nil beg)))
+ ;; Move to the start of that one.
+ (goto-char (previous-single-property-change
+ (point) 'mouse-face nil beg))
+ (setq n (1+ n))))))
+
+(defun choose-completion (&optional event)
+ "Choose the completion at point.
+If EVENT, use EVENT's position to determine the starting position."
+ (interactive (list last-nonmenu-event))
+ ;; In case this is run via the mouse, give temporary modes such as
+ ;; isearch a chance to turn off.
+ (run-hooks 'mouse-leave-buffer-hook)
+ (with-current-buffer (window-buffer (posn-window (event-start event)))
+ (let ((buffer completion-reference-buffer)
+ (base-size completion-base-size)
+ (base-position completion-base-position)
+ (insert-function completion-list-insert-choice-function)
+ (choice
+ (save-excursion
+ (goto-char (posn-point (event-start event)))
+ (let (beg end)
+ (cond
+ ((and (not (eobp)) (get-text-property (point) 'mouse-face))
+ (setq end (point) beg (1+ (point))))
+ ((and (not (bobp))
+ (get-text-property (1- (point)) 'mouse-face))
+ (setq end (1- (point)) beg (point)))
+ (t (error "No completion here")))
+ (setq beg (previous-single-property-change beg 'mouse-face))
+ (setq end (or (next-single-property-change end 'mouse-face)
+ (point-max)))
+ (buffer-substring-no-properties beg end)))))
+
+ (unless (buffer-live-p buffer)
+ (error "Destination buffer is dead"))
+ (quit-window nil (posn-window (event-start event)))
+
+ (with-current-buffer buffer
+ (choose-completion-string
+ choice buffer
+ (or base-position
+ (when base-size
+ ;; Someone's using old completion code that doesn't know
+ ;; about base-position yet.
+ (list (+ base-size (field-beginning))))
+ ;; If all else fails, just guess.
+ (list (choose-completion-guess-base-position choice)))
+ insert-function)))))
+
+;; Delete the longest partial match for STRING
+;; that can be found before POINT.
+(defun choose-completion-guess-base-position (string)
+ (save-excursion
+ (let ((opoint (point))
+ len)
+ ;; Try moving back by the length of the string.
+ (goto-char (max (- (point) (length string))
+ (minibuffer-prompt-end)))
+ ;; See how far back we were actually able to move. That is the
+ ;; upper bound on how much we can match and delete.
+ (setq len (- opoint (point)))
+ (if completion-ignore-case
+ (setq string (downcase string)))
+ (while (and (> len 0)
+ (let ((tail (buffer-substring (point) opoint)))
+ (if completion-ignore-case
+ (setq tail (downcase tail)))
+ (not (string= tail (substring string 0 len)))))
+ (setq len (1- len))
+ (forward-char 1))
+ (point))))
+
+(defun choose-completion-delete-max-match (string)
+ (declare (obsolete choose-completion-guess-base-position "23.2"))
+ (delete-region (choose-completion-guess-base-position string) (point)))
+
+(defvar choose-completion-string-functions nil
+ "Functions that may override the normal insertion of a completion choice.
+These functions are called in order with three arguments:
+CHOICE - the string to insert in the buffer,
+BUFFER - the buffer in which the choice should be inserted,
+BASE-POSITION - where to insert the completion.
+
+If a function in the list returns non-nil, that function is supposed
+to have inserted the CHOICE in the BUFFER, and possibly exited
+the minibuffer; no further functions will be called.
+
+If all functions in the list return nil, that means to use
+the default method of inserting the completion in BUFFER.")
+
+(defun choose-completion-string (choice &optional
+ buffer base-position insert-function)
+ "Switch to BUFFER and insert the completion choice CHOICE.
+BASE-POSITION says where to insert the completion.
+INSERT-FUNCTION says how to insert the completion and falls
+back on `completion-list-insert-choice-function' when nil."
+
+ ;; If BUFFER is the minibuffer, exit the minibuffer
+ ;; unless it is reading a file name and CHOICE is a directory,
+ ;; or completion-no-auto-exit is non-nil.
+
+ ;; Some older code may call us passing `base-size' instead of
+ ;; `base-position'. It's difficult to make any use of `base-size',
+ ;; so we just ignore it.
+ (unless (consp base-position)
+ (message "Obsolete `base-size' passed to choose-completion-string")
+ (setq base-position nil))
+
+ (let* ((buffer (or buffer completion-reference-buffer))
+ (mini-p (minibufferp buffer)))
+ ;; If BUFFER is a minibuffer, barf unless it's the currently
+ ;; active minibuffer.
+ (if (and mini-p
+ (not (and (active-minibuffer-window)
+ (equal buffer
+ (window-buffer (active-minibuffer-window))))))
+ (error "Minibuffer is not active for completion")
+ ;; Set buffer so buffer-local choose-completion-string-functions works.
+ (set-buffer buffer)
+ (unless (run-hook-with-args-until-success
+ 'choose-completion-string-functions
+ ;; The fourth arg used to be `mini-p' but was useless
+ ;; (since minibufferp can be used on the `buffer' arg)
+ ;; and indeed unused. The last used to be `base-size', so we
+ ;; keep it to try and avoid breaking old code.
+ choice buffer base-position nil)
+ ;; This remove-text-properties should be unnecessary since `choice'
+ ;; comes from buffer-substring-no-properties.
+ ;;(remove-text-properties 0 (length choice) '(mouse-face nil) choice)
+ ;; Insert the completion into the buffer where it was requested.
+ (funcall (or insert-function completion-list-insert-choice-function)
+ (or (car base-position) (point))
+ (or (cadr base-position) (point))
+ choice)
+ ;; Update point in the window that BUFFER is showing in.
+ (let ((window (get-buffer-window buffer t)))
+ (set-window-point window (point)))
+ ;; If completing for the minibuffer, exit it with this choice.
+ (and (not completion-no-auto-exit)
+ (minibufferp buffer)
+ minibuffer-completion-table
+ ;; If this is reading a file name, and the file name chosen
+ ;; is a directory, don't exit the minibuffer.
+ (let* ((result (buffer-substring (field-beginning) (point)))
+ (bounds
+ (completion-boundaries result minibuffer-completion-table
+ minibuffer-completion-predicate
+ "")))
+ (if (eq (car bounds) (length result))
+ ;; The completion chosen leads to a new set of completions
+ ;; (e.g. it's a directory): don't exit the minibuffer yet.
+ (let ((mini (active-minibuffer-window)))
+ (select-window mini)
+ (when minibuffer-auto-raise
+ (raise-frame (window-frame mini))))
+ (exit-minibuffer))))))))
+
+(define-derived-mode completion-list-mode nil "Completion List"
+ "Major mode for buffers showing lists of possible completions.
+Type \\<completion-list-mode-map>\\[choose-completion] in the completion list\
+ to select the completion near point.
+Or click to select one with the mouse.
+
+\\{completion-list-mode-map}"
+ (set (make-local-variable 'completion-base-size) nil))
+
+(defun completion-list-mode-finish ()
+ "Finish setup of the completions buffer.
+Called from `temp-buffer-show-hook'."
+ (when (eq major-mode 'completion-list-mode)
+ (setq buffer-read-only t)))
+
+(add-hook 'temp-buffer-show-hook 'completion-list-mode-finish)
+
+
+;; Variables and faces used in `completion-setup-function'.
+
+(defcustom completion-show-help t
+ "Non-nil means show help message in *Completions* buffer."
+ :type 'boolean
+ :version "22.1"
+ :group 'completion)
+
+;; This function goes in completion-setup-hook, so that it is called
+;; after the text of the completion list buffer is written.
+(defun completion-setup-function ()
+ (let* ((mainbuf (current-buffer))
+ (base-dir
+ ;; FIXME: This is a bad hack. We try to set the default-directory
+ ;; in the *Completions* buffer so that the relative file names
+ ;; displayed there can be treated as valid file names, independently
+ ;; from the completion context. But this suffers from many problems:
+ ;; - It's not clear when the completions are file names. With some
+ ;; completion tables (e.g. bzr revision specs), the listed
+ ;; completions can mix file names and other things.
+ ;; - It doesn't pay attention to possible quoting.
+ ;; - With fancy completion styles, the code below will not always
+ ;; find the right base directory.
+ (if minibuffer-completing-file-name
+ (file-name-as-directory
+ (expand-file-name
+ (buffer-substring (minibuffer-prompt-end)
+ (- (point) (or completion-base-size 0))))))))
+ (with-current-buffer standard-output
+ (let ((base-size completion-base-size) ;Read before killing localvars.
+ (base-position completion-base-position)
+ (insert-fun completion-list-insert-choice-function))
+ (completion-list-mode)
+ (set (make-local-variable 'completion-base-size) base-size)
+ (set (make-local-variable 'completion-base-position) base-position)
+ (set (make-local-variable 'completion-list-insert-choice-function)
+ insert-fun))
+ (set (make-local-variable 'completion-reference-buffer) mainbuf)
+ (if base-dir (setq default-directory base-dir))
+ ;; Maybe insert help string.
+ (when completion-show-help
+ (goto-char (point-min))
+ (if (display-mouse-p)
+ (insert (substitute-command-keys
+ "Click on a completion to select it.\n")))
+ (insert (substitute-command-keys
+ "In this buffer, type \\[choose-completion] to \
+select the completion near point.\n\n"))))))
+
+(add-hook 'completion-setup-hook 'completion-setup-function)
+
+(define-key minibuffer-local-completion-map [prior] 'switch-to-completions)
+(define-key minibuffer-local-completion-map "\M-v" 'switch-to-completions)
+
+(defun switch-to-completions ()
+ "Select the completion list window."
+ (interactive)
+ (let ((window (or (get-buffer-window "*Completions*" 0)
+ ;; Make sure we have a completions window.
+ (progn (minibuffer-completion-help)
+ (get-buffer-window "*Completions*" 0)))))
+ (when window
+ (select-window window)
+ ;; In the new buffer, go to the first completion.
+ ;; FIXME: Perhaps this should be done in `minibuffer-completion-help'.
+ (when (bobp)
+ (next-completion 1)))))
+
+;;; Support keyboard commands to turn on various modifiers.
+
+;; These functions -- which are not commands -- each add one modifier
+;; to the following event.
+
+(defun event-apply-alt-modifier (_ignore-prompt)
+ "\\<function-key-map>Add the Alt modifier to the following event.
+For example, type \\[event-apply-alt-modifier] & to enter Alt-&."
+ (vector (event-apply-modifier (read-event) 'alt 22 "A-")))
+(defun event-apply-super-modifier (_ignore-prompt)
+ "\\<function-key-map>Add the Super modifier to the following event.
+For example, type \\[event-apply-super-modifier] & to enter Super-&."
+ (vector (event-apply-modifier (read-event) 'super 23 "s-")))
+(defun event-apply-hyper-modifier (_ignore-prompt)
+ "\\<function-key-map>Add the Hyper modifier to the following event.
+For example, type \\[event-apply-hyper-modifier] & to enter Hyper-&."
+ (vector (event-apply-modifier (read-event) 'hyper 24 "H-")))
+(defun event-apply-shift-modifier (_ignore-prompt)
+ "\\<function-key-map>Add the Shift modifier to the following event.
+For example, type \\[event-apply-shift-modifier] & to enter Shift-&."
+ (vector (event-apply-modifier (read-event) 'shift 25 "S-")))
+(defun event-apply-control-modifier (_ignore-prompt)
+ "\\<function-key-map>Add the Ctrl modifier to the following event.
+For example, type \\[event-apply-control-modifier] & to enter Ctrl-&."
+ (vector (event-apply-modifier (read-event) 'control 26 "C-")))
+(defun event-apply-meta-modifier (_ignore-prompt)
+ "\\<function-key-map>Add the Meta modifier to the following event.
+For example, type \\[event-apply-meta-modifier] & to enter Meta-&."
+ (vector (event-apply-modifier (read-event) 'meta 27 "M-")))
+
+(defun event-apply-modifier (event symbol lshiftby prefix)
+ "Apply a modifier flag to event EVENT.
+SYMBOL is the name of this modifier, as a symbol.
+LSHIFTBY is the numeric value of this modifier, in keyboard events.
+PREFIX is the string that represents this modifier in an event type symbol."
+ (if (numberp event)
+ (cond ((eq symbol 'control)
+ (if (and (<= (downcase event) ?z)
+ (>= (downcase event) ?a))
+ (- (downcase event) ?a -1)
+ (if (and (<= (downcase event) ?Z)
+ (>= (downcase event) ?A))
+ (- (downcase event) ?A -1)
+ (logior (lsh 1 lshiftby) event))))
+ ((eq symbol 'shift)
+ (if (and (<= (downcase event) ?z)
+ (>= (downcase event) ?a))
+ (upcase event)
+ (logior (lsh 1 lshiftby) event)))
+ (t
+ (logior (lsh 1 lshiftby) event)))
+ (if (memq symbol (event-modifiers event))
+ event
+ (let ((event-type (if (symbolp event) event (car event))))
+ (setq event-type (intern (concat prefix (symbol-name event-type))))
+ (if (symbolp event)
+ event-type
+ (cons event-type (cdr event)))))))
+
+(define-key function-key-map [?\C-x ?@ ?h] 'event-apply-hyper-modifier)
+(define-key function-key-map [?\C-x ?@ ?s] 'event-apply-super-modifier)
+(define-key function-key-map [?\C-x ?@ ?m] 'event-apply-meta-modifier)
+(define-key function-key-map [?\C-x ?@ ?a] 'event-apply-alt-modifier)
+(define-key function-key-map [?\C-x ?@ ?S] 'event-apply-shift-modifier)
+(define-key function-key-map [?\C-x ?@ ?c] 'event-apply-control-modifier)
+
+;;;; Keypad support.
+
+;; Make the keypad keys act like ordinary typing keys. If people add
+;; bindings for the function key symbols, then those bindings will
+;; override these, so this shouldn't interfere with any existing
+;; bindings.
+
+;; Also tell read-char how to handle these keys.
+(mapc
+ (lambda (keypad-normal)
+ (let ((keypad (nth 0 keypad-normal))
+ (normal (nth 1 keypad-normal)))
+ (put keypad 'ascii-character normal)
+ (define-key function-key-map (vector keypad) (vector normal))))
+ ;; See also kp-keys bound in bindings.el.
+ '((kp-space ?\s)
+ (kp-tab ?\t)
+ (kp-enter ?\r)
+ (kp-separator ?,)
+ (kp-equal ?=)
+ ;; Do the same for various keys that are represented as symbols under
+ ;; GUIs but naturally correspond to characters.
+ (backspace 127)
+ (delete 127)
+ (tab ?\t)
+ (linefeed ?\n)
+ (clear ?\C-l)
+ (return ?\C-m)
+ (escape ?\e)
+ ))
+
+;;;;
+;;;; forking a twin copy of a buffer.
+;;;;
+
+(defvar clone-buffer-hook nil
+ "Normal hook to run in the new buffer at the end of `clone-buffer'.")
+
+(defvar clone-indirect-buffer-hook nil
+ "Normal hook to run in the new buffer at the end of
`clone-indirect-buffer'.")
+
+(defun clone-process (process &optional newname)
+ "Create a twin copy of PROCESS.
+If NEWNAME is nil, it defaults to PROCESS' name;
+NEWNAME is modified by adding or incrementing <N> at the end as necessary.
+If PROCESS is associated with a buffer, the new process will be associated
+ with the current buffer instead.
+Returns nil if PROCESS has already terminated."
+ (setq newname (or newname (process-name process)))
+ (if (string-match "<[0-9]+>\\'" newname)
+ (setq newname (substring newname 0 (match-beginning 0))))
+ (when (memq (process-status process) '(run stop open))
+ (let* ((process-connection-type (process-tty-name process))
+ (new-process
+ (if (memq (process-status process) '(open))
+ (let ((args (process-contact process t)))
+ (setq args (plist-put args :name newname))
+ (setq args (plist-put args :buffer
+ (if (process-buffer process)
+ (current-buffer))))
+ (apply 'make-network-process args))
+ (apply 'start-process newname
+ (if (process-buffer process) (current-buffer))
+ (process-command process)))))
+ (set-process-query-on-exit-flag
+ new-process (process-query-on-exit-flag process))
+ (set-process-inherit-coding-system-flag
+ new-process (process-inherit-coding-system-flag process))
+ (set-process-filter new-process (process-filter process))
+ (set-process-sentinel new-process (process-sentinel process))
+ (set-process-plist new-process (copy-sequence (process-plist process)))
+ new-process)))
+
+;; things to maybe add (currently partly covered by `funcall mode'):
+;; - syntax-table
+;; - overlays
+(defun clone-buffer (&optional newname display-flag)
+ "Create and return a twin copy of the current buffer.
+Unlike an indirect buffer, the new buffer can be edited
+independently of the old one (if it is not read-only).
+NEWNAME is the name of the new buffer. It may be modified by
+adding or incrementing <N> at the end as necessary to create a
+unique buffer name. If nil, it defaults to the name of the
+current buffer, with the proper suffix. If DISPLAY-FLAG is
+non-nil, the new buffer is shown with `pop-to-buffer'. Trying to
+clone a file-visiting buffer, or a buffer whose major mode symbol
+has a non-nil `no-clone' property, results in an error.
+
+Interactively, DISPLAY-FLAG is t and NEWNAME is the name of the
+current buffer with appropriate suffix. However, if a prefix
+argument is given, then the command prompts for NEWNAME in the
+minibuffer.
+
+This runs the normal hook `clone-buffer-hook' in the new buffer
+after it has been set up properly in other respects."
+ (interactive
+ (progn
+ (if buffer-file-name
+ (error "Cannot clone a file-visiting buffer"))
+ (if (get major-mode 'no-clone)
+ (error "Cannot clone a buffer in %s mode" mode-name))
+ (list (if current-prefix-arg
+ (read-buffer "Name of new cloned buffer: " (current-buffer)))
+ t)))
+ (if buffer-file-name
+ (error "Cannot clone a file-visiting buffer"))
+ (if (get major-mode 'no-clone)
+ (error "Cannot clone a buffer in %s mode" mode-name))
+ (setq newname (or newname (buffer-name)))
+ (if (string-match "<[0-9]+>\\'" newname)
+ (setq newname (substring newname 0 (match-beginning 0))))
+ (let ((buf (current-buffer))
+ (ptmin (point-min))
+ (ptmax (point-max))
+ (pt (point))
+ (mk (if mark-active (mark t)))
+ (modified (buffer-modified-p))
+ (mode major-mode)
+ (lvars (buffer-local-variables))
+ (process (get-buffer-process (current-buffer)))
+ (new (generate-new-buffer (or newname (buffer-name)))))
+ (save-restriction
+ (widen)
+ (with-current-buffer new
+ (insert-buffer-substring buf)))
+ (with-current-buffer new
+ (narrow-to-region ptmin ptmax)
+ (goto-char pt)
+ (if mk (set-mark mk))
+ (set-buffer-modified-p modified)
+
+ ;; Clone the old buffer's process, if any.
+ (when process (clone-process process))
+
+ ;; Now set up the major mode.
+ (funcall mode)
+
+ ;; Set up other local variables.
+ (mapc (lambda (v)
+ (condition-case () ;in case var is read-only
+ (if (symbolp v)
+ (makunbound v)
+ (set (make-local-variable (car v)) (cdr v)))
+ (error nil)))
+ lvars)
+
+ ;; Run any hooks (typically set up by the major mode
+ ;; for cloning to work properly).
+ (run-hooks 'clone-buffer-hook))
+ (if display-flag
+ ;; Presumably the current buffer is shown in the selected frame, so
+ ;; we want to display the clone elsewhere.
+ (let ((same-window-regexps nil)
+ (same-window-buffer-names))
+ (pop-to-buffer new)))
+ new))
+
+
+(defun clone-indirect-buffer (newname display-flag &optional norecord)
+ "Create an indirect buffer that is a twin copy of the current buffer.
+
+Give the indirect buffer name NEWNAME. Interactively, read NEWNAME
+from the minibuffer when invoked with a prefix arg. If NEWNAME is nil
+or if not called with a prefix arg, NEWNAME defaults to the current
+buffer's name. The name is modified by adding a `<N>' suffix to it
+or by incrementing the N in an existing suffix. Trying to clone a
+buffer whose major mode symbol has a non-nil `no-clone-indirect'
+property results in an error.
+
+DISPLAY-FLAG non-nil means show the new buffer with `pop-to-buffer'.
+This is always done when called interactively.
+
+Optional third arg NORECORD non-nil means do not put this buffer at the
+front of the list of recently selected ones."
+ (interactive
+ (progn
+ (if (get major-mode 'no-clone-indirect)
+ (error "Cannot indirectly clone a buffer in %s mode" mode-name))
+ (list (if current-prefix-arg
+ (read-buffer "Name of indirect buffer: " (current-buffer)))
+ t)))
+ (if (get major-mode 'no-clone-indirect)
+ (error "Cannot indirectly clone a buffer in %s mode" mode-name))
+ (setq newname (or newname (buffer-name)))
+ (if (string-match "<[0-9]+>\\'" newname)
+ (setq newname (substring newname 0 (match-beginning 0))))
+ (let* ((name (generate-new-buffer-name newname))
+ (buffer (make-indirect-buffer (current-buffer) name t)))
+ (with-current-buffer buffer
+ (run-hooks 'clone-indirect-buffer-hook))
+ (when display-flag
+ (pop-to-buffer buffer norecord))
+ buffer))
+
+
+(defun clone-indirect-buffer-other-window (newname display-flag &optional
norecord)
+ "Like `clone-indirect-buffer' but display in another window."
+ (interactive
+ (progn
+ (if (get major-mode 'no-clone-indirect)
+ (error "Cannot indirectly clone a buffer in %s mode" mode-name))
+ (list (if current-prefix-arg
+ (read-buffer "Name of indirect buffer: " (current-buffer)))
+ t)))
+ (let ((pop-up-windows t))
+ (clone-indirect-buffer newname display-flag norecord)))
+
+
+;;; Handling of Backspace and Delete keys.
+
+(defcustom normal-erase-is-backspace 'maybe
+ "Set the default behavior of the Delete and Backspace keys.
+
+If set to t, Delete key deletes forward and Backspace key deletes
+backward.
+
+If set to nil, both Delete and Backspace keys delete backward.
+
+If set to 'maybe (which is the default), Emacs automatically
+selects a behavior. On window systems, the behavior depends on
+the keyboard used. If the keyboard has both a Backspace key and
+a Delete key, and both are mapped to their usual meanings, the
+option's default value is set to t, so that Backspace can be used
+to delete backward, and Delete can be used to delete forward.
+
+If not running under a window system, customizing this option
+accomplishes a similar effect by mapping C-h, which is usually
+generated by the Backspace key, to DEL, and by mapping DEL to C-d
+via `keyboard-translate'. The former functionality of C-h is
+available on the F1 key. You should probably not use this
+setting if you don't have both Backspace, Delete and F1 keys.
+
+Setting this variable with setq doesn't take effect. Programmatically,
+call `normal-erase-is-backspace-mode' (which see) instead."
+ :type '(choice (const :tag "Off" nil)
+ (const :tag "Maybe" maybe)
+ (other :tag "On" t))
+ :group 'editing-basics
+ :version "21.1"
+ :set (lambda (symbol value)
+ ;; The fboundp is because of a problem with :set when
+ ;; dumping Emacs. It doesn't really matter.
+ (if (fboundp 'normal-erase-is-backspace-mode)
+ (normal-erase-is-backspace-mode (or value 0))
+ (set-default symbol value))))
+
+(defun normal-erase-is-backspace-setup-frame (&optional frame)
+ "Set up `normal-erase-is-backspace-mode' on FRAME, if necessary."
+ (unless frame (setq frame (selected-frame)))
+ (with-selected-frame frame
+ (unless (terminal-parameter nil 'normal-erase-is-backspace)
+ (normal-erase-is-backspace-mode
+ (if (if (eq normal-erase-is-backspace 'maybe)
+ (and (not noninteractive)
+ (or (memq system-type '(ms-dos windows-nt))
+ (memq window-system '(w32 ns))
+ (and (memq window-system '(x))
+ (fboundp 'x-backspace-delete-keys-p)
+ (x-backspace-delete-keys-p))
+ ;; If the terminal Emacs is running on has erase char
+ ;; set to ^H, use the Backspace key for deleting
+ ;; backward, and the Delete key for deleting forward.
+ (and (null window-system)
+ (eq tty-erase-char ?\^H))))
+ normal-erase-is-backspace)
+ 1 0)))))
+
+(define-minor-mode normal-erase-is-backspace-mode
+ "Toggle the Erase and Delete mode of the Backspace and Delete keys.
+With a prefix argument ARG, enable this feature if ARG is
+positive, and disable it otherwise. If called from Lisp, enable
+the mode if ARG is omitted or nil.
+
+On window systems, when this mode is on, Delete is mapped to C-d
+and Backspace is mapped to DEL; when this mode is off, both
+Delete and Backspace are mapped to DEL. (The remapping goes via
+`local-function-key-map', so binding Delete or Backspace in the
+global or local keymap will override that.)
+
+In addition, on window systems, the bindings of C-Delete, M-Delete,
+C-M-Delete, C-Backspace, M-Backspace, and C-M-Backspace are changed in
+the global keymap in accordance with the functionality of Delete and
+Backspace. For example, if Delete is remapped to C-d, which deletes
+forward, C-Delete is bound to `kill-word', but if Delete is remapped
+to DEL, which deletes backward, C-Delete is bound to
+`backward-kill-word'.
+
+If not running on a window system, a similar effect is accomplished by
+remapping C-h (normally produced by the Backspace key) and DEL via
+`keyboard-translate': if this mode is on, C-h is mapped to DEL and DEL
+to C-d; if it's off, the keys are not remapped.
+
+When not running on a window system, and this mode is turned on, the
+former functionality of C-h is available on the F1 key. You should
+probably not turn on this mode on a text-only terminal if you don't
+have both Backspace, Delete and F1 keys.
+
+See also `normal-erase-is-backspace'."
+ :variable ((eq (terminal-parameter nil 'normal-erase-is-backspace) 1)
+ . (lambda (v)
+ (setf (terminal-parameter nil 'normal-erase-is-backspace)
+ (if v 1 0))))
+ (let ((enabled (eq 1 (terminal-parameter
+ nil 'normal-erase-is-backspace))))
+
+ (cond ((or (memq window-system '(x w32 ns pc))
+ (memq system-type '(ms-dos windows-nt)))
+ (let ((bindings
+ `(([M-delete] [M-backspace])
+ ([C-M-delete] [C-M-backspace])
+ ([?\e C-delete] [?\e C-backspace]))))
+
+ (if enabled
+ (progn
+ (define-key local-function-key-map [delete] [deletechar])
+ (define-key local-function-key-map [kp-delete] [deletechar])
+ (define-key local-function-key-map [backspace] [?\C-?])
+ (dolist (b bindings)
+ ;; Not sure if input-decode-map is really right, but
+ ;; keyboard-translate-table (used below) only works
+ ;; for integer events, and key-translation-table is
+ ;; global (like the global-map, used earlier).
+ (define-key input-decode-map (car b) nil)
+ (define-key input-decode-map (cadr b) nil)))
+ (define-key local-function-key-map [delete] [?\C-?])
+ (define-key local-function-key-map [kp-delete] [?\C-?])
+ (define-key local-function-key-map [backspace] [?\C-?])
+ (dolist (b bindings)
+ (define-key input-decode-map (car b) (cadr b))
+ (define-key input-decode-map (cadr b) (car b))))))
+ (t
+ (if enabled
+ (progn
+ (keyboard-translate ?\C-h ?\C-?)
+ (keyboard-translate ?\C-? ?\C-d))
+ (keyboard-translate ?\C-h ?\C-h)
+ (keyboard-translate ?\C-? ?\C-?))))
+
+ (if (called-interactively-p 'interactive)
+ (message "Delete key deletes %s"
+ (if (eq 1 (terminal-parameter nil 'normal-erase-is-backspace))
+ "forward" "backward")))))
+
+(defvar vis-mode-saved-buffer-invisibility-spec nil
+ "Saved value of `buffer-invisibility-spec' when Visible mode is on.")
+
+(define-minor-mode read-only-mode
+ "Change whether the current buffer is read-only.
+With prefix argument ARG, make the buffer read-only if ARG is
+positive, otherwise make it writable. If buffer is read-only
+and `view-read-only' is non-nil, enter view mode.
+
+Do not call this from a Lisp program unless you really intend to
+do the same thing as the \\[read-only-mode] command, including
+possibly enabling or disabling View mode. Also, note that this
+command works by setting the variable `buffer-read-only', which
+does not affect read-only regions caused by text properties. To
+ignore read-only status in a Lisp program (whether due to text
+properties or buffer state), bind `inhibit-read-only' temporarily
+to a non-nil value."
+ :variable buffer-read-only
+ (cond
+ ((and (not buffer-read-only) view-mode)
+ (View-exit-and-edit)
+ (make-local-variable 'view-read-only)
+ (setq view-read-only t)) ; Must leave view mode.
+ ((and buffer-read-only view-read-only
+ ;; If view-mode is already active, `view-mode-enter' is a nop.
+ (not view-mode)
+ (not (eq (get major-mode 'mode-class) 'special)))
+ (view-mode-enter))))
+
+(define-minor-mode visible-mode
+ "Toggle making all invisible text temporarily visible (Visible mode).
+With a prefix argument ARG, enable Visible mode if ARG is
+positive, and disable it otherwise. If called from Lisp, enable
+the mode if ARG is omitted or nil.
+
+This mode works by saving the value of `buffer-invisibility-spec'
+and setting it to nil."
+ :lighter " Vis"
+ :group 'editing-basics
+ (when (local-variable-p 'vis-mode-saved-buffer-invisibility-spec)
+ (setq buffer-invisibility-spec vis-mode-saved-buffer-invisibility-spec)
+ (kill-local-variable 'vis-mode-saved-buffer-invisibility-spec))
+ (when visible-mode
+ (set (make-local-variable 'vis-mode-saved-buffer-invisibility-spec)
+ buffer-invisibility-spec)
+ (setq buffer-invisibility-spec nil)))
+
+(defvar messages-buffer-mode-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map special-mode-map)
+ (define-key map "g" nil) ; nothing to revert
+ map))
+
+(define-derived-mode messages-buffer-mode special-mode "Messages"
+ "Major mode used in the \"*Messages*\" buffer.")
+
+(defun messages-buffer ()
+ "Return the \"*Messages*\" buffer.
+If it does not exist, create and it switch it to `messages-buffer-mode'."
+ (or (get-buffer "*Messages*")
+ (with-current-buffer (get-buffer-create "*Messages*")
+ (messages-buffer-mode)
+ (current-buffer))))
+
+
+;; Minibuffer prompt stuff.
+
+;;(defun minibuffer-prompt-modification (start end)
+;; (error "You cannot modify the prompt"))
+;;
+;;
+;;(defun minibuffer-prompt-insertion (start end)
+;; (let ((inhibit-modification-hooks t))
+;; (delete-region start end)
+;; ;; Discard undo information for the text insertion itself
+;; ;; and for the text deletion.above.
+;; (when (consp buffer-undo-list)
+;; (setq buffer-undo-list (cddr buffer-undo-list)))
+;; (message "You cannot modify the prompt")))
+;;
+;;
+;;(setq minibuffer-prompt-properties
+;; (list 'modification-hooks '(minibuffer-prompt-modification)
+;; 'insert-in-front-hooks '(minibuffer-prompt-insertion)))
+
+
+;;;; Problematic external packages.
+
+;; rms says this should be done by specifying symbols that define
+;; versions together with bad values. This is therefore not as
+;; flexible as it could be. See the thread:
+;; http://lists.gnu.org/archive/html/emacs-devel/2007-08/msg00300.html
+(defconst bad-packages-alist
+ ;; Not sure exactly which semantic versions have problems.
+ ;; Definitely 2.0pre3, probably all 2.0pre's before this.
+ '((semantic semantic-version "\\`2\\.0pre[1-3]\\'"
+ "The version of `semantic' loaded does not work in Emacs 22.
+It can cause constant high CPU load.
+Upgrade to at least Semantic 2.0pre4 (distributed with CEDET 1.0pre4).")
+ ;; CUA-mode does not work with GNU Emacs version 22.1 and newer.
+ ;; Except for version 1.2, all of the 1.x and 2.x version of cua-mode
+ ;; provided the `CUA-mode' feature. Since this is no longer true,
+ ;; we can warn the user if the `CUA-mode' feature is ever provided.
+ (CUA-mode t nil
+"CUA-mode is now part of the standard GNU Emacs distribution,
+so you can now enable CUA via the Options menu or by customizing `cua-mode'.
+
+You have loaded an older version of CUA-mode which does not work
+correctly with this version of Emacs. You should remove the old
+version and use the one distributed with Emacs."))
+ "Alist of packages known to cause problems in this version of Emacs.
+Each element has the form (PACKAGE SYMBOL REGEXP STRING).
+PACKAGE is either a regular expression to match file names, or a
+symbol (a feature name), like for `with-eval-after-load'.
+SYMBOL is either the name of a string variable, or `t'. Upon
+loading PACKAGE, if SYMBOL is t or matches REGEXP, display a
+warning using STRING as the message.")
+
+(defun bad-package-check (package)
+ "Run a check using the element from `bad-packages-alist' matching PACKAGE."
+ (condition-case nil
+ (let* ((list (assoc package bad-packages-alist))
+ (symbol (nth 1 list)))
+ (and list
+ (boundp symbol)
+ (or (eq symbol t)
+ (and (stringp (setq symbol (eval symbol)))
+ (string-match-p (nth 2 list) symbol)))
+ (display-warning package (nth 3 list) :warning)))
+ (error nil)))
+
+(dolist (elem bad-packages-alist)
+ (let ((pkg (car elem)))
+ (with-eval-after-load pkg
+ (bad-package-check pkg))))
+
+
+;;; Generic dispatcher commands
+
+;; Macro `define-alternatives' is used to create generic commands.
+;; Generic commands are these (like web, mail, news, encrypt, irc, etc.)
+;; that can have different alternative implementations where choosing
+;; among them is exclusively a matter of user preference.
+
+;; (define-alternatives COMMAND) creates a new interactive command
+;; M-x COMMAND and a customizable variable COMMAND-alternatives.
+;; Typically, the user will not need to customize this variable; packages
+;; wanting to add alternative implementations should use
+;;
+;; ;;;###autoload (push '("My impl name" . my-impl-symbol) COMMAND-alternatives
+
+(defmacro define-alternatives (command &rest customizations)
+ "Define the new command `COMMAND'.
+
+The argument `COMMAND' should be a symbol.
+
+Running `M-x COMMAND RET' for the first time prompts for which
+alternative to use and records the selected command as a custom
+variable.
+
+Running `C-u M-x COMMAND RET' prompts again for an alternative
+and overwrites the previous choice.
+
+The variable `COMMAND-alternatives' contains an alist with
+alternative implementations of COMMAND. `define-alternatives'
+does not have any effect until this variable is set.
+
+CUSTOMIZATIONS, if non-nil, should be composed of alternating
+`defcustom' keywords and values to add to the declaration of
+`COMMAND-alternatives' (typically :group and :version)."
+ (let* ((command-name (symbol-name command))
+ (varalt-name (concat command-name "-alternatives"))
+ (varalt-sym (intern varalt-name))
+ (varimp-sym (intern (concat command-name "--implementation"))))
+ `(progn
+
+ (defcustom ,varalt-sym nil
+ ,(format "Alist of alternative implementations for the `%s' command.
+
+Each entry must be a pair (ALTNAME . ALTFUN), where:
+ALTNAME - The name shown at user to describe the alternative implementation.
+ALTFUN - The function called to implement this alternative."
+ command-name)
+ :type '(alist :key-type string :value-type function)
+ ,@customizations)
+
+ (put ',varalt-sym 'definition-name ',command)
+ (defvar ,varimp-sym nil "Internal use only.")
+
+ (defun ,command (&optional arg)
+ ,(format "Run generic command `%s'.
+If used for the first time, or with interactive ARG, ask the user which
+implementation to use for `%s'. The variable `%s'
+contains the list of implementations currently supported for this command."
+ command-name command-name varalt-name)
+ (interactive "P")
+ (when (or arg (null ,varimp-sym))
+ (let ((val (completing-read
+ ,(format "Select implementation for command `%s': "
+ command-name)
+ ,varalt-sym nil t)))
+ (unless (string-equal val "")
+ (when (null ,varimp-sym)
+ (message
+ "Use `C-u M-x %s RET' to select another implementation"
+ ,command-name)
+ (sit-for 3))
+ (customize-save-variable ',varimp-sym
+ (cdr (assoc-string val ,varalt-sym))))))
+ (if ,varimp-sym
+ (call-interactively ,varimp-sym)
+ (message ,(format "No implementation selected for command `%s'"
+ command-name)))))))
+
+
+;; This is here because files in obsolete/ are not scanned for autoloads.
+
+(defvar iswitchb-mode nil "\
+Non-nil if Iswitchb mode is enabled.
+See the command `iswitchb-mode' for a description of this minor mode.
+Setting this variable directly does not take effect;
+either customize it (see the info node `Easy Customization')
+or call the function `iswitchb-mode'.")
+
+(custom-autoload 'iswitchb-mode "iswitchb" nil)
+
+(autoload 'iswitchb-mode "iswitchb" "\
+Toggle Iswitchb mode.
+With a prefix argument ARG, enable Iswitchb mode if ARG is
+positive, and disable it otherwise. If called from Lisp, enable
+the mode if ARG is omitted or nil.
+
+Iswitchb mode is a global minor mode that enables switching
+between buffers using substrings. See `iswitchb' for details.
+
+\(fn &optional ARG)" t nil)
+
+(make-obsolete 'iswitchb-mode
+ "use `icomplete-mode' or `ido-mode' instead." "24.4")
+
+
+(provide 'simple)
+
+;;; simple.el ends here
diff --git a/packages/context-coloring/benchmark/fixtures/subr.el
b/packages/context-coloring/benchmark/fixtures/subr.el
new file mode 100644
index 0000000..d4da916
--- /dev/null
+++ b/packages/context-coloring/benchmark/fixtures/subr.el
@@ -0,0 +1,4800 @@
+;;; subr.el --- basic lisp subroutines for Emacs -*- coding: utf-8;
lexical-binding:t -*-
+
+;; Copyright (C) 1985-1986, 1992, 1994-1995, 1999-2015 Free Software
Foundation, Inc.
+
+;; Maintainer: address@hidden
+;; Keywords: internal
+;; Package: emacs
+
+;; 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:
+
+;; Beware: while this file has tag `utf-8', before it's compiled, it gets
+;; loaded as "raw-text", so non-ASCII chars won't work right during bootstrap.
+
+(defmacro declare-function (_fn _file &optional _arglist _fileonly)
+ "Tell the byte-compiler that function FN is defined, in FILE.
+Optional ARGLIST is the argument list used by the function.
+The FILE argument is not used by the byte-compiler, but by the
+`check-declare' package, which checks that FILE contains a
+definition for FN. ARGLIST is used by both the byte-compiler
+and `check-declare' to check for consistency.
+
+FILE can be either a Lisp file (in which case the \".el\"
+extension is optional), or a C file. C files are expanded
+relative to the Emacs \"src/\" directory. Lisp files are
+searched for using `locate-library', and if that fails they are
+expanded relative to the location of the file containing the
+declaration. A FILE with an \"ext:\" prefix is an external file.
+`check-declare' will check such files if they are found, and skip
+them without error if they are not.
+
+FILEONLY non-nil means that `check-declare' will only check that
+FILE exists, not that it defines FN. This is intended for
+function-definitions that `check-declare' does not recognize, e.g.
+`defstruct'.
+
+To specify a value for FILEONLY without passing an argument list,
+set ARGLIST to t. This is necessary because nil means an
+empty argument list, rather than an unspecified one.
+
+Note that for the purposes of `check-declare', this statement
+must be the first non-whitespace on a line.
+
+For more information, see Info node `(elisp)Declaring Functions'."
+ ;; Does nothing - byte-compile-declare-function does the work.
+ nil)
+
+
+;;;; Basic Lisp macros.
+
+(defalias 'not 'null)
+
+(defmacro noreturn (form)
+ "Evaluate FORM, expecting it not to return.
+If FORM does return, signal an error."
+ (declare (debug t))
+ `(prog1 ,form
+ (error "Form marked with `noreturn' did return")))
+
+(defmacro 1value (form)
+ "Evaluate FORM, expecting a constant return value.
+This is the global do-nothing version. There is also `testcover-1value'
+that complains if FORM ever does return differing values."
+ (declare (debug t))
+ form)
+
+(defmacro def-edebug-spec (symbol spec)
+ "Set the `edebug-form-spec' property of SYMBOL according to SPEC.
+Both SYMBOL and SPEC are unevaluated. The SPEC can be:
+0 (instrument no arguments); t (instrument all arguments);
+a symbol (naming a function with an Edebug specification); or a list.
+The elements of the list describe the argument types; see
+Info node `(elisp)Specification List' for details."
+ `(put (quote ,symbol) 'edebug-form-spec (quote ,spec)))
+
+(defmacro lambda (&rest cdr)
+ "Return a lambda expression.
+A call of the form (lambda ARGS DOCSTRING INTERACTIVE BODY) is
+self-quoting; the result of evaluating the lambda expression is the
+expression itself. The lambda expression may then be treated as a
+function, i.e., stored as the function value of a symbol, passed to
+`funcall' or `mapcar', etc.
+
+ARGS should take the same form as an argument list for a `defun'.
+DOCSTRING is an optional documentation string.
+ If present, it should describe how to call the function.
+ But documentation strings are usually not useful in nameless functions.
+INTERACTIVE should be a call to the function `interactive', which see.
+It may also be omitted.
+BODY should be a list of Lisp expressions.
+
+\(fn ARGS [DOCSTRING] [INTERACTIVE] BODY)"
+ (declare (doc-string 2) (indent defun)
+ (debug (&define lambda-list
+ [&optional stringp]
+ [&optional ("interactive" interactive)]
+ def-body)))
+ ;; Note that this definition should not use backquotes; subr.el should not
+ ;; depend on backquote.el.
+ (list 'function (cons 'lambda cdr)))
+
+(defmacro setq-local (var val)
+ "Set variable VAR to value VAL in current buffer."
+ ;; Can't use backquote here, it's too early in the bootstrap.
+ (list 'set (list 'make-local-variable (list 'quote var)) val))
+
+(defmacro defvar-local (var val &optional docstring)
+ "Define VAR as a buffer-local variable with default value VAL.
+Like `defvar' but additionally marks the variable as being automatically
+buffer-local wherever it is set."
+ (declare (debug defvar) (doc-string 3))
+ ;; Can't use backquote here, it's too early in the bootstrap.
+ (list 'progn (list 'defvar var val docstring)
+ (list 'make-variable-buffer-local (list 'quote var))))
+
+(defun apply-partially (fun &rest args)
+ "Return a function that is a partial application of FUN to ARGS.
+ARGS is a list of the first N arguments to pass to FUN.
+The result is a new function which does the same as FUN, except that
+the first N arguments are fixed at the values with which this function
+was called."
+ `(closure (t) (&rest args)
+ (apply ',fun ,@(mapcar (lambda (arg) `',arg) args) args)))
+
+(defmacro push (newelt place)
+ "Add NEWELT to the list stored in the generalized variable PLACE.
+This is morally equivalent to (setf PLACE (cons NEWELT PLACE)),
+except that PLACE is only evaluated once (after NEWELT)."
+ (declare (debug (form gv-place)))
+ (if (symbolp place)
+ ;; Important special case, to avoid triggering GV too early in
+ ;; the bootstrap.
+ (list 'setq place
+ (list 'cons newelt place))
+ (require 'macroexp)
+ (macroexp-let2 macroexp-copyable-p v newelt
+ (gv-letplace (getter setter) place
+ (funcall setter `(cons ,v ,getter))))))
+
+(defmacro pop (place)
+ "Return the first element of PLACE's value, and remove it from the list.
+PLACE must be a generalized variable whose value is a list.
+If the value is nil, `pop' returns nil but does not actually
+change the list."
+ (declare (debug (gv-place)))
+ ;; We use `car-safe' here instead of `car' because the behavior is the same
+ ;; (if it's not a cons cell, the `cdr' would have signaled an error already),
+ ;; but `car-safe' is total, so the byte-compiler can safely remove it if the
+ ;; result is not used.
+ `(car-safe
+ ,(if (symbolp place)
+ ;; So we can use `pop' in the bootstrap before `gv' can be used.
+ (list 'prog1 place (list 'setq place (list 'cdr place)))
+ (gv-letplace (getter setter) place
+ `(prog1 ,getter ,(funcall setter `(cdr ,getter)))))))
+
+(defmacro when (cond &rest body)
+ "If COND yields non-nil, do BODY, else return nil.
+When COND yields non-nil, eval BODY forms sequentially and return
+value of last one, or nil if there are none.
+
+\(fn COND BODY...)"
+ (declare (indent 1) (debug t))
+ (list 'if cond (cons 'progn body)))
+
+(defmacro unless (cond &rest body)
+ "If COND yields nil, do BODY, else return nil.
+When COND yields nil, eval BODY forms sequentially and return
+value of last one, or nil if there are none.
+
+\(fn COND BODY...)"
+ (declare (indent 1) (debug t))
+ (cons 'if (cons cond (cons nil body))))
+
+(defmacro dolist (spec &rest body)
+ "Loop over a list.
+Evaluate BODY with VAR bound to each car from LIST, in turn.
+Then evaluate RESULT to get return value, default nil.
+
+\(fn (VAR LIST [RESULT]) BODY...)"
+ (declare (indent 1) (debug ((symbolp form &optional form) body)))
+ ;; It would be cleaner to create an uninterned symbol,
+ ;; but that uses a lot more space when many functions in many files
+ ;; use dolist.
+ ;; FIXME: This cost disappears in byte-compiled lexical-binding files.
+ (let ((temp '--dolist-tail--))
+ ;; This is not a reliable test, but it does not matter because both
+ ;; semantics are acceptable, tho one is slightly faster with dynamic
+ ;; scoping and the other is slightly faster (and has cleaner semantics)
+ ;; with lexical scoping.
+ (if lexical-binding
+ `(let ((,temp ,(nth 1 spec)))
+ (while ,temp
+ (let ((,(car spec) (car ,temp)))
+ ,@body
+ (setq ,temp (cdr ,temp))))
+ ,@(cdr (cdr spec)))
+ `(let ((,temp ,(nth 1 spec))
+ ,(car spec))
+ (while ,temp
+ (setq ,(car spec) (car ,temp))
+ ,@body
+ (setq ,temp (cdr ,temp)))
+ ,@(if (cdr (cdr spec))
+ `((setq ,(car spec) nil) ,@(cdr (cdr spec))))))))
+
+(defmacro dotimes (spec &rest body)
+ "Loop a certain number of times.
+Evaluate BODY with VAR bound to successive integers running from 0,
+inclusive, to COUNT, exclusive. Then evaluate RESULT to get
+the return value (nil if RESULT is omitted).
+
+\(fn (VAR COUNT [RESULT]) BODY...)"
+ (declare (indent 1) (debug dolist))
+ ;; It would be cleaner to create an uninterned symbol,
+ ;; but that uses a lot more space when many functions in many files
+ ;; use dotimes.
+ ;; FIXME: This cost disappears in byte-compiled lexical-binding files.
+ (let ((temp '--dotimes-limit--)
+ (start 0)
+ (end (nth 1 spec)))
+ ;; This is not a reliable test, but it does not matter because both
+ ;; semantics are acceptable, tho one is slightly faster with dynamic
+ ;; scoping and the other has cleaner semantics.
+ (if lexical-binding
+ (let ((counter '--dotimes-counter--))
+ `(let ((,temp ,end)
+ (,counter ,start))
+ (while (< ,counter ,temp)
+ (let ((,(car spec) ,counter))
+ ,@body)
+ (setq ,counter (1+ ,counter)))
+ ,@(if (cddr spec)
+ ;; FIXME: This let often leads to "unused var" warnings.
+ `((let ((,(car spec) ,counter)) ,@(cddr spec))))))
+ `(let ((,temp ,end)
+ (,(car spec) ,start))
+ (while (< ,(car spec) ,temp)
+ ,@body
+ (setq ,(car spec) (1+ ,(car spec))))
+ ,@(cdr (cdr spec))))))
+
+(defmacro declare (&rest _specs)
+ "Do not evaluate any arguments, and return nil.
+If a `declare' form appears as the first form in the body of a
+`defun' or `defmacro' form, SPECS specifies various additional
+information about the function or macro; these go into effect
+during the evaluation of the `defun' or `defmacro' form.
+
+The possible values of SPECS are specified by
+`defun-declarations-alist' and `macro-declarations-alist'."
+ ;; FIXME: edebug spec should pay attention to defun-declarations-alist.
+ nil)
+
+(defmacro ignore-errors (&rest body)
+ "Execute BODY; if an error occurs, return nil.
+Otherwise, return result of last form in BODY.
+See also `with-demoted-errors' that does something similar
+without silencing all errors."
+ (declare (debug t) (indent 0))
+ `(condition-case nil (progn ,@body) (error nil)))
+
+;;;; Basic Lisp functions.
+
+(defun ignore (&rest _ignore)
+ "Do nothing and return nil.
+This function accepts any number of arguments, but ignores them."
+ (interactive)
+ nil)
+
+;; Signal a compile-error if the first arg is missing.
+(defun error (&rest args)
+ "Signal an error, making error message by passing all args to `format'.
+In Emacs, the convention is that error messages start with a capital
+letter but *do not* end with a period. Please follow this convention
+for the sake of consistency."
+ (declare (advertised-calling-convention (string &rest args) "23.1"))
+ (signal 'error (list (apply 'format args))))
+
+(defun user-error (format &rest args)
+ "Signal a pilot error, making error message by passing all args to `format'.
+In Emacs, the convention is that error messages start with a capital
+letter but *do not* end with a period. Please follow this convention
+for the sake of consistency.
+This is just like `error' except that `user-error's are expected to be the
+result of an incorrect manipulation on the part of the user, rather than the
+result of an actual problem."
+ (signal 'user-error (list (apply #'format format args))))
+
+(defun define-error (name message &optional parent)
+ "Define NAME as a new error signal.
+MESSAGE is a string that will be output to the echo area if such an error
+is signaled without being caught by a `condition-case'.
+PARENT is either a signal or a list of signals from which it inherits.
+Defaults to `error'."
+ (unless parent (setq parent 'error))
+ (let ((conditions
+ (if (consp parent)
+ (apply #'nconc
+ (mapcar (lambda (parent)
+ (cons parent
+ (or (get parent 'error-conditions)
+ (error "Unknown signal `%s'" parent))))
+ parent))
+ (cons parent (get parent 'error-conditions)))))
+ (put name 'error-conditions
+ (delete-dups (copy-sequence (cons name conditions))))
+ (when message (put name 'error-message message))))
+
+;; We put this here instead of in frame.el so that it's defined even on
+;; systems where frame.el isn't loaded.
+(defun frame-configuration-p (object)
+ "Return non-nil if OBJECT seems to be a frame configuration.
+Any list whose car is `frame-configuration' is assumed to be a frame
+configuration."
+ (and (consp object)
+ (eq (car object) 'frame-configuration)))
+
+;;;; List functions.
+
+(defsubst caar (x)
+ "Return the car of the car of X."
+ (car (car x)))
+
+(defsubst cadr (x)
+ "Return the car of the cdr of X."
+ (car (cdr x)))
+
+(defsubst cdar (x)
+ "Return the cdr of the car of X."
+ (cdr (car x)))
+
+(defsubst cddr (x)
+ "Return the cdr of the cdr of X."
+ (cdr (cdr x)))
+
+(defun last (list &optional n)
+ "Return the last link of LIST. Its car is the last element.
+If LIST is nil, return nil.
+If N is non-nil, return the Nth-to-last link of LIST.
+If N is bigger than the length of LIST, return LIST."
+ (if n
+ (and (>= n 0)
+ (let ((m (safe-length list)))
+ (if (< n m) (nthcdr (- m n) list) list)))
+ (and list
+ (nthcdr (1- (safe-length list)) list))))
+
+(defun butlast (list &optional n)
+ "Return a copy of LIST with the last N elements removed.
+If N is omitted or nil, the last element is removed from the
+copy."
+ (if (and n (<= n 0)) list
+ (nbutlast (copy-sequence list) n)))
+
+(defun nbutlast (list &optional n)
+ "Modifies LIST to remove the last N elements.
+If N is omitted or nil, remove the last element."
+ (let ((m (length list)))
+ (or n (setq n 1))
+ (and (< n m)
+ (progn
+ (if (> n 0) (setcdr (nthcdr (- (1- m) n) list) nil))
+ list))))
+
+(defun delete-dups (list)
+ "Destructively remove `equal' duplicates from LIST.
+Store the result in LIST and return it. LIST must be a proper list.
+Of several `equal' occurrences of an element in LIST, the first
+one is kept."
+ (let ((tail list))
+ (while tail
+ (setcdr tail (delete (car tail) (cdr tail)))
+ (setq tail (cdr tail))))
+ list)
+
+;; See http://lists.gnu.org/archive/html/emacs-devel/2013-05/msg00204.html
+(defun delete-consecutive-dups (list &optional circular)
+ "Destructively remove `equal' consecutive duplicates from LIST.
+First and last elements are considered consecutive if CIRCULAR is
+non-nil."
+ (let ((tail list) last)
+ (while (consp tail)
+ (if (equal (car tail) (cadr tail))
+ (setcdr tail (cddr tail))
+ (setq last (car tail)
+ tail (cdr tail))))
+ (if (and circular
+ (cdr list)
+ (equal last (car list)))
+ (nbutlast list)
+ list)))
+
+(defun number-sequence (from &optional to inc)
+ "Return a sequence of numbers from FROM to TO (both inclusive) as a list.
+INC is the increment used between numbers in the sequence and defaults to 1.
+So, the Nth element of the list is (+ FROM (* N INC)) where N counts from
+zero. TO is only included if there is an N for which TO = FROM + N * INC.
+If TO is nil or numerically equal to FROM, return (FROM).
+If INC is positive and TO is less than FROM, or INC is negative
+and TO is larger than FROM, return nil.
+If INC is zero and TO is neither nil nor numerically equal to
+FROM, signal an error.
+
+This function is primarily designed for integer arguments.
+Nevertheless, FROM, TO and INC can be integer or float. However,
+floating point arithmetic is inexact. For instance, depending on
+the machine, it may quite well happen that
+\(number-sequence 0.4 0.6 0.2) returns the one element list (0.4),
+whereas (number-sequence 0.4 0.8 0.2) returns a list with three
+elements. Thus, if some of the arguments are floats and one wants
+to make sure that TO is included, one may have to explicitly write
+TO as (+ FROM (* N INC)) or use a variable whose value was
+computed with this exact expression. Alternatively, you can,
+of course, also replace TO with a slightly larger value
+\(or a slightly more negative value if INC is negative)."
+ (if (or (not to) (= from to))
+ (list from)
+ (or inc (setq inc 1))
+ (when (zerop inc) (error "The increment can not be zero"))
+ (let (seq (n 0) (next from))
+ (if (> inc 0)
+ (while (<= next to)
+ (setq seq (cons next seq)
+ n (1+ n)
+ next (+ from (* n inc))))
+ (while (>= next to)
+ (setq seq (cons next seq)
+ n (1+ n)
+ next (+ from (* n inc)))))
+ (nreverse seq))))
+
+(defun copy-tree (tree &optional vecp)
+ "Make a copy of TREE.
+If TREE is a cons cell, this recursively copies both its car and its cdr.
+Contrast to `copy-sequence', which copies only along the cdrs. With second
+argument VECP, this copies vectors as well as conses."
+ (if (consp tree)
+ (let (result)
+ (while (consp tree)
+ (let ((newcar (car tree)))
+ (if (or (consp (car tree)) (and vecp (vectorp (car tree))))
+ (setq newcar (copy-tree (car tree) vecp)))
+ (push newcar result))
+ (setq tree (cdr tree)))
+ (nconc (nreverse result) tree))
+ (if (and vecp (vectorp tree))
+ (let ((i (length (setq tree (copy-sequence tree)))))
+ (while (>= (setq i (1- i)) 0)
+ (aset tree i (copy-tree (aref tree i) vecp)))
+ tree)
+ tree)))
+
+;;;; Various list-search functions.
+
+(defun assoc-default (key alist &optional test default)
+ "Find object KEY in a pseudo-alist ALIST.
+ALIST is a list of conses or objects. Each element
+ (or the element's car, if it is a cons) is compared with KEY by
+ calling TEST, with two arguments: (i) the element or its car,
+ and (ii) KEY.
+If that is non-nil, the element matches; then `assoc-default'
+ returns the element's cdr, if it is a cons, or DEFAULT if the
+ element is not a cons.
+
+If no element matches, the value is nil.
+If TEST is omitted or nil, `equal' is used."
+ (let (found (tail alist) value)
+ (while (and tail (not found))
+ (let ((elt (car tail)))
+ (when (funcall (or test 'equal) (if (consp elt) (car elt) elt) key)
+ (setq found t value (if (consp elt) (cdr elt) default))))
+ (setq tail (cdr tail)))
+ value))
+
+(defun assoc-ignore-case (key alist)
+ "Like `assoc', but ignores differences in case and text representation.
+KEY must be a string. Upper-case and lower-case letters are treated as equal.
+Unibyte strings are converted to multibyte for comparison."
+ (declare (obsolete assoc-string "22.1"))
+ (assoc-string key alist t))
+
+(defun assoc-ignore-representation (key alist)
+ "Like `assoc', but ignores differences in text representation.
+KEY must be a string.
+Unibyte strings are converted to multibyte for comparison."
+ (declare (obsolete assoc-string "22.1"))
+ (assoc-string key alist nil))
+
+(defun member-ignore-case (elt list)
+ "Like `member', but ignore differences in case and text representation.
+ELT must be a string. Upper-case and lower-case letters are treated as equal.
+Unibyte strings are converted to multibyte for comparison.
+Non-strings in LIST are ignored."
+ (while (and list
+ (not (and (stringp (car list))
+ (eq t (compare-strings elt 0 nil (car list) 0 nil t)))))
+ (setq list (cdr list)))
+ list)
+
+(defun assq-delete-all (key alist)
+ "Delete from ALIST all elements whose car is `eq' to KEY.
+Return the modified alist.
+Elements of ALIST that are not conses are ignored."
+ (while (and (consp (car alist))
+ (eq (car (car alist)) key))
+ (setq alist (cdr alist)))
+ (let ((tail alist) tail-cdr)
+ (while (setq tail-cdr (cdr tail))
+ (if (and (consp (car tail-cdr))
+ (eq (car (car tail-cdr)) key))
+ (setcdr tail (cdr tail-cdr))
+ (setq tail tail-cdr))))
+ alist)
+
+(defun rassq-delete-all (value alist)
+ "Delete from ALIST all elements whose cdr is `eq' to VALUE.
+Return the modified alist.
+Elements of ALIST that are not conses are ignored."
+ (while (and (consp (car alist))
+ (eq (cdr (car alist)) value))
+ (setq alist (cdr alist)))
+ (let ((tail alist) tail-cdr)
+ (while (setq tail-cdr (cdr tail))
+ (if (and (consp (car tail-cdr))
+ (eq (cdr (car tail-cdr)) value))
+ (setcdr tail (cdr tail-cdr))
+ (setq tail tail-cdr))))
+ alist)
+
+(defun remove (elt seq)
+ "Return a copy of SEQ with all occurrences of ELT removed.
+SEQ must be a list, vector, or string. The comparison is done with `equal'."
+ (if (nlistp seq)
+ ;; If SEQ isn't a list, there's no need to copy SEQ because
+ ;; `delete' will return a new object.
+ (delete elt seq)
+ (delete elt (copy-sequence seq))))
+
+(defun remq (elt list)
+ "Return LIST with all occurrences of ELT removed.
+The comparison is done with `eq'. Contrary to `delq', this does not use
+side-effects, and the argument LIST is not modified."
+ (while (and (eq elt (car list)) (setq list (cdr list))))
+ (if (memq elt list)
+ (delq elt (copy-sequence list))
+ list))
+
+;;;; Keymap support.
+
+(defun kbd (keys)
+ "Convert KEYS to the internal Emacs key representation.
+KEYS should be a string constant in the format used for
+saving keyboard macros (see `edmacro-mode')."
+ ;; Don't use a defalias, since the `pure' property is only true for
+ ;; the calling convention of `kbd'.
+ (read-kbd-macro keys))
+(put 'kbd 'pure t)
+
+(defun undefined ()
+ "Beep to tell the user this binding is undefined."
+ (interactive)
+ (ding)
+ (message "%s is undefined" (key-description (this-single-command-keys)))
+ (setq defining-kbd-macro nil)
+ (force-mode-line-update)
+ ;; If this is a down-mouse event, don't reset prefix-arg;
+ ;; pass it to the command run by the up event.
+ (setq prefix-arg
+ (when (memq 'down (event-modifiers last-command-event))
+ current-prefix-arg)))
+
+;; Prevent the \{...} documentation construct
+;; from mentioning keys that run this command.
+(put 'undefined 'suppress-keymap t)
+
+(defun suppress-keymap (map &optional nodigits)
+ "Make MAP override all normally self-inserting keys to be undefined.
+Normally, as an exception, digits and minus-sign are set to make prefix args,
+but optional second arg NODIGITS non-nil treats them like other chars."
+ (define-key map [remap self-insert-command] 'undefined)
+ (or nodigits
+ (let (loop)
+ (define-key map "-" 'negative-argument)
+ ;; Make plain numbers do numeric args.
+ (setq loop ?0)
+ (while (<= loop ?9)
+ (define-key map (char-to-string loop) 'digit-argument)
+ (setq loop (1+ loop))))))
+
+(defun make-composed-keymap (maps &optional parent)
+ "Construct a new keymap composed of MAPS and inheriting from PARENT.
+When looking up a key in the returned map, the key is looked in each
+keymap of MAPS in turn until a binding is found.
+If no binding is found in MAPS, the lookup continues in PARENT, if non-nil.
+As always with keymap inheritance, a nil binding in MAPS overrides
+any corresponding binding in PARENT, but it does not override corresponding
+bindings in other keymaps of MAPS.
+MAPS can be a list of keymaps or a single keymap.
+PARENT if non-nil should be a keymap."
+ `(keymap
+ ,@(if (keymapp maps) (list maps) maps)
+ ,@parent))
+
+(defun define-key-after (keymap key definition &optional after)
+ "Add binding in KEYMAP for KEY => DEFINITION, right after AFTER's binding.
+This is like `define-key' except that the binding for KEY is placed
+just after the binding for the event AFTER, instead of at the beginning
+of the map. Note that AFTER must be an event type (like KEY), NOT a command
+\(like DEFINITION).
+
+If AFTER is t or omitted, the new binding goes at the end of the keymap.
+AFTER should be a single event type--a symbol or a character, not a sequence.
+
+Bindings are always added before any inherited map.
+
+The order of bindings in a keymap only matters when it is used as
+a menu, so this function is not useful for non-menu keymaps."
+ (unless after (setq after t))
+ (or (keymapp keymap)
+ (signal 'wrong-type-argument (list 'keymapp keymap)))
+ (setq key
+ (if (<= (length key) 1) (aref key 0)
+ (setq keymap (lookup-key keymap
+ (apply 'vector
+ (butlast (mapcar 'identity key)))))
+ (aref key (1- (length key)))))
+ (let ((tail keymap) done inserted)
+ (while (and (not done) tail)
+ ;; Delete any earlier bindings for the same key.
+ (if (eq (car-safe (car (cdr tail))) key)
+ (setcdr tail (cdr (cdr tail))))
+ ;; If we hit an included map, go down that one.
+ (if (keymapp (car tail)) (setq tail (car tail)))
+ ;; When we reach AFTER's binding, insert the new binding after.
+ ;; If we reach an inherited keymap, insert just before that.
+ ;; If we reach the end of this keymap, insert at the end.
+ (if (or (and (eq (car-safe (car tail)) after)
+ (not (eq after t)))
+ (eq (car (cdr tail)) 'keymap)
+ (null (cdr tail)))
+ (progn
+ ;; Stop the scan only if we find a parent keymap.
+ ;; Keep going past the inserted element
+ ;; so we can delete any duplications that come later.
+ (if (eq (car (cdr tail)) 'keymap)
+ (setq done t))
+ ;; Don't insert more than once.
+ (or inserted
+ (setcdr tail (cons (cons key definition) (cdr tail))))
+ (setq inserted t)))
+ (setq tail (cdr tail)))))
+
+(defun map-keymap-sorted (function keymap)
+ "Implement `map-keymap' with sorting.
+Don't call this function; it is for internal use only."
+ (let (list)
+ (map-keymap (lambda (a b) (push (cons a b) list))
+ keymap)
+ (setq list (sort list
+ (lambda (a b)
+ (setq a (car a) b (car b))
+ (if (integerp a)
+ (if (integerp b) (< a b)
+ t)
+ (if (integerp b) t
+ ;; string< also accepts symbols.
+ (string< a b))))))
+ (dolist (p list)
+ (funcall function (car p) (cdr p)))))
+
+(defun keymap--menu-item-binding (val)
+ "Return the binding part of a menu-item."
+ (cond
+ ((not (consp val)) val) ;Not a menu-item.
+ ((eq 'menu-item (car val))
+ (let* ((binding (nth 2 val))
+ (plist (nthcdr 3 val))
+ (filter (plist-get plist :filter)))
+ (if filter (funcall filter binding)
+ binding)))
+ ((and (consp (cdr val)) (stringp (cadr val)))
+ (cddr val))
+ ((stringp (car val))
+ (cdr val))
+ (t val))) ;Not a menu-item either.
+
+(defun keymap--menu-item-with-binding (item binding)
+ "Build a menu-item like ITEM but with its binding changed to BINDING."
+ (cond
+ ((not (consp item)) binding) ;Not a menu-item.
+ ((eq 'menu-item (car item))
+ (setq item (copy-sequence item))
+ (let ((tail (nthcdr 2 item)))
+ (setcar tail binding)
+ ;; Remove any potential filter.
+ (if (plist-get (cdr tail) :filter)
+ (setcdr tail (plist-put (cdr tail) :filter nil))))
+ item)
+ ((and (consp (cdr item)) (stringp (cadr item)))
+ (cons (car item) (cons (cadr item) binding)))
+ (t (cons (car item) binding))))
+
+(defun keymap--merge-bindings (val1 val2)
+ "Merge bindings VAL1 and VAL2."
+ (let ((map1 (keymap--menu-item-binding val1))
+ (map2 (keymap--menu-item-binding val2)))
+ (if (not (and (keymapp map1) (keymapp map2)))
+ ;; There's nothing to merge: val1 takes precedence.
+ val1
+ (let ((map (list 'keymap map1 map2))
+ (item (if (keymapp val1) (if (keymapp val2) nil val2) val1)))
+ (keymap--menu-item-with-binding item map)))))
+
+(defun keymap-canonicalize (map)
+ "Return a simpler equivalent keymap.
+This resolves inheritance and redefinitions. The returned keymap
+should behave identically to a copy of KEYMAP w.r.t `lookup-key'
+and use in active keymaps and menus.
+Subkeymaps may be modified but are not canonicalized."
+ ;; FIXME: Problem with the difference between a nil binding
+ ;; that hides a binding in an inherited map and a nil binding that's ignored
+ ;; to let some further binding visible. Currently a nil binding hides all.
+ ;; FIXME: we may want to carefully (re)order elements in case they're
+ ;; menu-entries.
+ (let ((bindings ())
+ (ranges ())
+ (prompt (keymap-prompt map)))
+ (while (keymapp map)
+ (setq map (map-keymap ;; -internal
+ (lambda (key item)
+ (if (consp key)
+ ;; Treat char-ranges specially.
+ (push (cons key item) ranges)
+ (push (cons key item) bindings)))
+ map)))
+ ;; Create the new map.
+ (setq map (funcall (if ranges 'make-keymap 'make-sparse-keymap) prompt))
+ (dolist (binding ranges)
+ ;; Treat char-ranges specially. FIXME: need to merge as well.
+ (define-key map (vector (car binding)) (cdr binding)))
+ ;; Process the bindings starting from the end.
+ (dolist (binding (prog1 bindings (setq bindings ())))
+ (let* ((key (car binding))
+ (oldbind (assq key bindings)))
+ (push (if (not oldbind)
+ ;; The normal case: no duplicate bindings.
+ binding
+ ;; This is the second binding for this key.
+ (setq bindings (delq oldbind bindings))
+ (cons key (keymap--merge-bindings (cdr binding)
+ (cdr oldbind))))
+ bindings)))
+ (nconc map bindings)))
+
+(put 'keyboard-translate-table 'char-table-extra-slots 0)
+
+(defun keyboard-translate (from to)
+ "Translate character FROM to TO on the current terminal.
+This function creates a `keyboard-translate-table' if necessary
+and then modifies one entry in it."
+ (or (char-table-p keyboard-translate-table)
+ (setq keyboard-translate-table
+ (make-char-table 'keyboard-translate-table nil)))
+ (aset keyboard-translate-table from to))
+
+;;;; Key binding commands.
+
+(defun global-set-key (key command)
+ "Give KEY a global binding as COMMAND.
+COMMAND is the command definition to use; usually it is
+a symbol naming an interactively-callable function.
+KEY is a key sequence; noninteractively, it is a string or vector
+of characters or event types, and non-ASCII characters with codes
+above 127 (such as ISO Latin-1) can be included if you use a vector.
+
+Note that if KEY has a local binding in the current buffer,
+that local binding will continue to shadow any global binding
+that you make with this function."
+ (interactive "KSet key globally: \nCSet key %s to command: ")
+ (or (vectorp key) (stringp key)
+ (signal 'wrong-type-argument (list 'arrayp key)))
+ (define-key (current-global-map) key command))
+
+(defun local-set-key (key command)
+ "Give KEY a local binding as COMMAND.
+COMMAND is the command definition to use; usually it is
+a symbol naming an interactively-callable function.
+KEY is a key sequence; noninteractively, it is a string or vector
+of characters or event types, and non-ASCII characters with codes
+above 127 (such as ISO Latin-1) can be included if you use a vector.
+
+The binding goes in the current buffer's local map, which in most
+cases is shared with all other buffers in the same major mode."
+ (interactive "KSet key locally: \nCSet key %s locally to command: ")
+ (let ((map (current-local-map)))
+ (or map
+ (use-local-map (setq map (make-sparse-keymap))))
+ (or (vectorp key) (stringp key)
+ (signal 'wrong-type-argument (list 'arrayp key)))
+ (define-key map key command)))
+
+(defun global-unset-key (key)
+ "Remove global binding of KEY.
+KEY is a string or vector representing a sequence of keystrokes."
+ (interactive "kUnset key globally: ")
+ (global-set-key key nil))
+
+(defun local-unset-key (key)
+ "Remove local binding of KEY.
+KEY is a string or vector representing a sequence of keystrokes."
+ (interactive "kUnset key locally: ")
+ (if (current-local-map)
+ (local-set-key key nil))
+ nil)
+
+;;;; substitute-key-definition and its subroutines.
+
+(defvar key-substitution-in-progress nil
+ "Used internally by `substitute-key-definition'.")
+
+(defun substitute-key-definition (olddef newdef keymap &optional oldmap prefix)
+ "Replace OLDDEF with NEWDEF for any keys in KEYMAP now defined as OLDDEF.
+In other words, OLDDEF is replaced with NEWDEF where ever it appears.
+Alternatively, if optional fourth argument OLDMAP is specified, we redefine
+in KEYMAP as NEWDEF those keys which are defined as OLDDEF in OLDMAP.
+
+If you don't specify OLDMAP, you can usually get the same results
+in a cleaner way with command remapping, like this:
+ (define-key KEYMAP [remap OLDDEF] NEWDEF)
+\n(fn OLDDEF NEWDEF KEYMAP &optional OLDMAP)"
+ ;; Don't document PREFIX in the doc string because we don't want to
+ ;; advertise it. It's meant for recursive calls only. Here's its
+ ;; meaning
+
+ ;; If optional argument PREFIX is specified, it should be a key
+ ;; prefix, a string. Redefined bindings will then be bound to the
+ ;; original key, with PREFIX added at the front.
+ (or prefix (setq prefix ""))
+ (let* ((scan (or oldmap keymap))
+ (prefix1 (vconcat prefix [nil]))
+ (key-substitution-in-progress
+ (cons scan key-substitution-in-progress)))
+ ;; Scan OLDMAP, finding each char or event-symbol that
+ ;; has any definition, and act on it with hack-key.
+ (map-keymap
+ (lambda (char defn)
+ (aset prefix1 (length prefix) char)
+ (substitute-key-definition-key defn olddef newdef prefix1 keymap))
+ scan)))
+
+(defun substitute-key-definition-key (defn olddef newdef prefix keymap)
+ (let (inner-def skipped menu-item)
+ ;; Find the actual command name within the binding.
+ (if (eq (car-safe defn) 'menu-item)
+ (setq menu-item defn defn (nth 2 defn))
+ ;; Skip past menu-prompt.
+ (while (stringp (car-safe defn))
+ (push (pop defn) skipped))
+ ;; Skip past cached key-equivalence data for menu items.
+ (if (consp (car-safe defn))
+ (setq defn (cdr defn))))
+ (if (or (eq defn olddef)
+ ;; Compare with equal if definition is a key sequence.
+ ;; That is useful for operating on function-key-map.
+ (and (or (stringp defn) (vectorp defn))
+ (equal defn olddef)))
+ (define-key keymap prefix
+ (if menu-item
+ (let ((copy (copy-sequence menu-item)))
+ (setcar (nthcdr 2 copy) newdef)
+ copy)
+ (nconc (nreverse skipped) newdef)))
+ ;; Look past a symbol that names a keymap.
+ (setq inner-def
+ (or (indirect-function defn t) defn))
+ ;; For nested keymaps, we use `inner-def' rather than `defn' so as to
+ ;; avoid autoloading a keymap. This is mostly done to preserve the
+ ;; original non-autoloading behavior of pre-map-keymap times.
+ (if (and (keymapp inner-def)
+ ;; Avoid recursively scanning
+ ;; where KEYMAP does not have a submap.
+ (let ((elt (lookup-key keymap prefix)))
+ (or (null elt) (natnump elt) (keymapp elt)))
+ ;; Avoid recursively rescanning keymap being scanned.
+ (not (memq inner-def key-substitution-in-progress)))
+ ;; If this one isn't being scanned already, scan it now.
+ (substitute-key-definition olddef newdef keymap inner-def prefix)))))
+
+
+;;;; The global keymap tree.
+
+;; global-map, esc-map, and ctl-x-map have their values set up in
+;; keymap.c; we just give them docstrings here.
+
+(defvar global-map nil
+ "Default global keymap mapping Emacs keyboard input into commands.
+The value is a keymap which is usually (but not necessarily) Emacs's
+global map.")
+
+(defvar esc-map nil
+ "Default keymap for ESC (meta) commands.
+The normal global definition of the character ESC indirects to this keymap.")
+
+(defvar ctl-x-map nil
+ "Default keymap for C-x commands.
+The normal global definition of the character C-x indirects to this keymap.")
+
+(defvar ctl-x-4-map (make-sparse-keymap)
+ "Keymap for subcommands of C-x 4.")
+(defalias 'ctl-x-4-prefix ctl-x-4-map)
+(define-key ctl-x-map "4" 'ctl-x-4-prefix)
+
+(defvar ctl-x-5-map (make-sparse-keymap)
+ "Keymap for frame commands.")
+(defalias 'ctl-x-5-prefix ctl-x-5-map)
+(define-key ctl-x-map "5" 'ctl-x-5-prefix)
+
+
+;;;; Event manipulation functions.
+
+(defconst listify-key-sequence-1 (logior 128 ?\M-\C-@))
+
+(defun listify-key-sequence (key)
+ "Convert a key sequence to a list of events."
+ (if (vectorp key)
+ (append key nil)
+ (mapcar (function (lambda (c)
+ (if (> c 127)
+ (logxor c listify-key-sequence-1)
+ c)))
+ key)))
+
+(defun eventp (obj)
+ "True if the argument is an event object."
+ (when obj
+ (or (integerp obj)
+ (and (symbolp obj) obj (not (keywordp obj)))
+ (and (consp obj) (symbolp (car obj))))))
+
+(defun event-modifiers (event)
+ "Return a list of symbols representing the modifier keys in event EVENT.
+The elements of the list may include `meta', `control',
+`shift', `hyper', `super', `alt', `click', `double', `triple', `drag',
+and `down'.
+EVENT may be an event or an event type. If EVENT is a symbol
+that has never been used in an event that has been read as input
+in the current Emacs session, then this function may fail to include
+the `click' modifier."
+ (let ((type event))
+ (if (listp type)
+ (setq type (car type)))
+ (if (symbolp type)
+ ;; Don't read event-symbol-elements directly since we're not
+ ;; sure the symbol has already been parsed.
+ (cdr (internal-event-symbol-parse-modifiers type))
+ (let ((list nil)
+ (char (logand type (lognot (logior ?\M-\^@ ?\C-\^@ ?\S-\^@
+ ?\H-\^@ ?\s-\^@ ?\A-\^@)))))
+ (if (not (zerop (logand type ?\M-\^@)))
+ (push 'meta list))
+ (if (or (not (zerop (logand type ?\C-\^@)))
+ (< char 32))
+ (push 'control list))
+ (if (or (not (zerop (logand type ?\S-\^@)))
+ (/= char (downcase char)))
+ (push 'shift list))
+ (or (zerop (logand type ?\H-\^@))
+ (push 'hyper list))
+ (or (zerop (logand type ?\s-\^@))
+ (push 'super list))
+ (or (zerop (logand type ?\A-\^@))
+ (push 'alt list))
+ list))))
+
+(defun event-basic-type (event)
+ "Return the basic type of the given event (all modifiers removed).
+The value is a printing character (not upper case) or a symbol.
+EVENT may be an event or an event type. If EVENT is a symbol
+that has never been used in an event that has been read as input
+in the current Emacs session, then this function may return nil."
+ (if (consp event)
+ (setq event (car event)))
+ (if (symbolp event)
+ (car (get event 'event-symbol-elements))
+ (let* ((base (logand event (1- ?\A-\^@)))
+ (uncontrolled (if (< base 32) (logior base 64) base)))
+ ;; There are some numbers that are invalid characters and
+ ;; cause `downcase' to get an error.
+ (condition-case ()
+ (downcase uncontrolled)
+ (error uncontrolled)))))
+
+(defsubst mouse-movement-p (object)
+ "Return non-nil if OBJECT is a mouse movement event."
+ (eq (car-safe object) 'mouse-movement))
+
+(defun mouse-event-p (object)
+ "Return non-nil if OBJECT is a mouse click event."
+ ;; is this really correct? maybe remove mouse-movement?
+ (memq (event-basic-type object) '(mouse-1 mouse-2 mouse-3 mouse-movement)))
+
+(defun event-start (event)
+ "Return the starting position of EVENT.
+EVENT should be a mouse click, drag, or key press event. If
+EVENT is nil, the value of `posn-at-point' is used instead.
+
+The following accessor functions are used to access the elements
+of the position:
+
+`posn-window': The window the event is in.
+`posn-area': A symbol identifying the area the event occurred in,
+or nil if the event occurred in the text area.
+`posn-point': The buffer position of the event.
+`posn-x-y': The pixel-based coordinates of the event.
+`posn-col-row': The estimated column and row corresponding to the
+position of the event.
+`posn-actual-col-row': The actual column and row corresponding to the
+position of the event.
+`posn-string': The string object of the event, which is either
+nil or (STRING . POSITION)'.
+`posn-image': The image object of the event, if any.
+`posn-object': The image or string object of the event, if any.
+`posn-timestamp': The time the event occurred, in milliseconds.
+
+For more information, see Info node `(elisp)Click Events'."
+ (if (consp event) (nth 1 event)
+ (or (posn-at-point)
+ (list (selected-window) (point) '(0 . 0) 0))))
+
+(defun event-end (event)
+ "Return the ending position of EVENT.
+EVENT should be a click, drag, or key press event.
+
+See `event-start' for a description of the value returned."
+ (if (consp event) (nth (if (consp (nth 2 event)) 2 1) event)
+ (or (posn-at-point)
+ (list (selected-window) (point) '(0 . 0) 0))))
+
+(defsubst event-click-count (event)
+ "Return the multi-click count of EVENT, a click or drag event.
+The return value is a positive integer."
+ (if (and (consp event) (integerp (nth 2 event))) (nth 2 event) 1))
+
+;;;; Extracting fields of the positions in an event.
+
+(defun posnp (obj)
+ "Return non-nil if OBJ appears to be a valid `posn' object specifying a
window.
+If OBJ is a valid `posn' object, but specifies a frame rather
+than a window, return nil."
+ ;; FIXME: Correct the behavior of this function so that all valid
+ ;; `posn' objects are recognized, after updating other code that
+ ;; depends on its present behavior.
+ (and (windowp (car-safe obj))
+ (atom (car-safe (setq obj (cdr obj)))) ;AREA-OR-POS.
+ (integerp (car-safe (car-safe (setq obj (cdr obj))))) ;XOFFSET.
+ (integerp (car-safe (cdr obj))))) ;TIMESTAMP.
+
+(defsubst posn-window (position)
+ "Return the window in POSITION.
+POSITION should be a list of the form returned by the `event-start'
+and `event-end' functions."
+ (nth 0 position))
+
+(defsubst posn-area (position)
+ "Return the window area recorded in POSITION, or nil for the text area.
+POSITION should be a list of the form returned by the `event-start'
+and `event-end' functions."
+ (let ((area (if (consp (nth 1 position))
+ (car (nth 1 position))
+ (nth 1 position))))
+ (and (symbolp area) area)))
+
+(defun posn-point (position)
+ "Return the buffer location in POSITION.
+POSITION should be a list of the form returned by the `event-start'
+and `event-end' functions.
+Returns nil if POSITION does not correspond to any buffer location (e.g.
+a click on a scroll bar)."
+ (or (nth 5 position)
+ (let ((pt (nth 1 position)))
+ (or (car-safe pt)
+ ;; Apparently this can also be `vertical-scroll-bar' (bug#13979).
+ (if (integerp pt) pt)))))
+
+(defun posn-set-point (position)
+ "Move point to POSITION.
+Select the corresponding window as well."
+ (if (not (windowp (posn-window position)))
+ (error "Position not in text area of window"))
+ (select-window (posn-window position))
+ (if (numberp (posn-point position))
+ (goto-char (posn-point position))))
+
+(defsubst posn-x-y (position)
+ "Return the x and y coordinates in POSITION.
+The return value has the form (X . Y), where X and Y are given in
+pixels. POSITION should be a list of the form returned by
+`event-start' and `event-end'."
+ (nth 2 position))
+
+(declare-function scroll-bar-scale "scroll-bar" (num-denom whole))
+
+(defun posn-col-row (position)
+ "Return the nominal column and row in POSITION, measured in characters.
+The column and row values are approximations calculated from the x
+and y coordinates in POSITION and the frame's default character width
+and default line height, including spacing.
+For a scroll-bar event, the result column is 0, and the row
+corresponds to the vertical position of the click in the scroll bar.
+POSITION should be a list of the form returned by the `event-start'
+and `event-end' functions."
+ (let* ((pair (posn-x-y position))
+ (frame-or-window (posn-window position))
+ (frame (if (framep frame-or-window)
+ frame-or-window
+ (window-frame frame-or-window)))
+ (window (when (windowp frame-or-window) frame-or-window))
+ (area (posn-area position)))
+ (cond
+ ((null frame-or-window)
+ '(0 . 0))
+ ((eq area 'vertical-scroll-bar)
+ (cons 0 (scroll-bar-scale pair (1- (window-height window)))))
+ ((eq area 'horizontal-scroll-bar)
+ (cons (scroll-bar-scale pair (window-width window)) 0))
+ (t
+ ;; FIXME: This should take line-spacing properties on
+ ;; newlines into account.
+ (let* ((spacing (when (display-graphic-p frame)
+ (or (with-current-buffer
+ (window-buffer (frame-selected-window frame))
+ line-spacing)
+ (frame-parameter frame 'line-spacing)))))
+ (cond ((floatp spacing)
+ (setq spacing (truncate (* spacing
+ (frame-char-height frame)))))
+ ((null spacing)
+ (setq spacing 0)))
+ (cons (/ (car pair) (frame-char-width frame))
+ (/ (cdr pair) (+ (frame-char-height frame) spacing))))))))
+
+(defun posn-actual-col-row (position)
+ "Return the window row number in POSITION and character number in that row.
+
+Return nil if POSITION does not contain the actual position; in that case
+\`posn-col-row' can be used to get approximate values.
+POSITION should be a list of the form returned by the `event-start'
+and `event-end' functions.
+
+This function does not account for the width on display, like the
+number of visual columns taken by a TAB or image. If you need
+the coordinates of POSITION in character units, you should use
+\`posn-col-row', not this function."
+ (nth 6 position))
+
+(defsubst posn-timestamp (position)
+ "Return the timestamp of POSITION.
+POSITION should be a list of the form returned by the `event-start'
+and `event-end' functions."
+ (nth 3 position))
+
+(defun posn-string (position)
+ "Return the string object of POSITION.
+Value is a cons (STRING . STRING-POS), or nil if not a string.
+POSITION should be a list of the form returned by the `event-start'
+and `event-end' functions."
+ (let ((x (nth 4 position)))
+ ;; Apparently this can also be `handle' or `below-handle' (bug#13979).
+ (when (consp x) x)))
+
+(defsubst posn-image (position)
+ "Return the image object of POSITION.
+Value is a list (image ...), or nil if not an image.
+POSITION should be a list of the form returned by the `event-start'
+and `event-end' functions."
+ (nth 7 position))
+
+(defsubst posn-object (position)
+ "Return the object (image or string) of POSITION.
+Value is a list (image ...) for an image object, a cons cell
+\(STRING . STRING-POS) for a string object, and nil for a buffer position.
+POSITION should be a list of the form returned by the `event-start'
+and `event-end' functions."
+ (or (posn-image position) (posn-string position)))
+
+(defsubst posn-object-x-y (position)
+ "Return the x and y coordinates relative to the object of POSITION.
+The return value has the form (DX . DY), where DX and DY are
+given in pixels. POSITION should be a list of the form returned
+by `event-start' and `event-end'."
+ (nth 8 position))
+
+(defsubst posn-object-width-height (position)
+ "Return the pixel width and height of the object of POSITION.
+The return value has the form (WIDTH . HEIGHT). POSITION should
+be a list of the form returned by `event-start' and `event-end'."
+ (nth 9 position))
+
+
+;;;; Obsolescent names for functions.
+
+(define-obsolete-function-alias 'window-dot 'window-point "22.1")
+(define-obsolete-function-alias 'set-window-dot 'set-window-point "22.1")
+(define-obsolete-function-alias 'read-input 'read-string "22.1")
+(define-obsolete-function-alias 'show-buffer 'set-window-buffer "22.1")
+(define-obsolete-function-alias 'eval-current-buffer 'eval-buffer "22.1")
+(define-obsolete-function-alias 'string-to-int 'string-to-number "22.1")
+
+(make-obsolete 'forward-point "use (+ (point) N) instead." "23.1")
+(make-obsolete 'buffer-has-markers-at nil "24.3")
+
+(defun insert-string (&rest args)
+ "Mocklisp-compatibility insert function.
+Like the function `insert' except that any argument that is a number
+is converted into a string by expressing it in decimal."
+ (declare (obsolete insert "22.1"))
+ (dolist (el args)
+ (insert (if (integerp el) (number-to-string el) el))))
+
+(defun makehash (&optional test)
+ (declare (obsolete make-hash-table "22.1"))
+ (make-hash-table :test (or test 'eql)))
+
+(defun log10 (x)
+ "Return (log X 10), the log base 10 of X."
+ (declare (obsolete log "24.4"))
+ (log x 10))
+
+;; These are used by VM and some old programs
+(defalias 'focus-frame 'ignore "")
+(make-obsolete 'focus-frame "it does nothing." "22.1")
+(defalias 'unfocus-frame 'ignore "")
+(make-obsolete 'unfocus-frame "it does nothing." "22.1")
+(make-obsolete 'make-variable-frame-local
+ "explicitly check for a frame-parameter instead." "22.2")
+(set-advertised-calling-convention
+ 'all-completions '(string collection &optional predicate) "23.1")
+(set-advertised-calling-convention 'unintern '(name obarray) "23.3")
+(set-advertised-calling-convention 'redirect-frame-focus '(frame focus-frame)
"24.3")
+(set-advertised-calling-convention 'decode-char '(ch charset) "21.4")
+(set-advertised-calling-convention 'encode-char '(ch charset) "21.4")
+
+;;;; Obsolescence declarations for variables, and aliases.
+
+;; Special "default-FOO" variables which contain the default value of
+;; the "FOO" variable are nasty. Their implementation is brittle, and
+;; slows down several unrelated variable operations; furthermore, they
+;; can lead to really odd behavior if you decide to make them
+;; buffer-local.
+
+;; Not used at all in Emacs, last time I checked:
+(make-obsolete-variable 'default-mode-line-format 'mode-line-format "23.2")
+(make-obsolete-variable 'default-header-line-format 'header-line-format "23.2")
+(make-obsolete-variable 'default-line-spacing 'line-spacing "23.2")
+(make-obsolete-variable 'default-abbrev-mode 'abbrev-mode "23.2")
+(make-obsolete-variable 'default-ctl-arrow 'ctl-arrow "23.2")
+(make-obsolete-variable 'default-truncate-lines 'truncate-lines "23.2")
+(make-obsolete-variable 'default-left-margin 'left-margin "23.2")
+(make-obsolete-variable 'default-tab-width 'tab-width "23.2")
+(make-obsolete-variable 'default-case-fold-search 'case-fold-search "23.2")
+(make-obsolete-variable 'default-left-margin-width 'left-margin-width "23.2")
+(make-obsolete-variable 'default-right-margin-width 'right-margin-width "23.2")
+(make-obsolete-variable 'default-left-fringe-width 'left-fringe-width "23.2")
+(make-obsolete-variable 'default-right-fringe-width 'right-fringe-width "23.2")
+(make-obsolete-variable 'default-fringes-outside-margins
'fringes-outside-margins "23.2")
+(make-obsolete-variable 'default-scroll-bar-width 'scroll-bar-width "23.2")
+(make-obsolete-variable 'default-vertical-scroll-bar 'vertical-scroll-bar
"23.2")
+(make-obsolete-variable 'default-indicate-empty-lines 'indicate-empty-lines
"23.2")
+(make-obsolete-variable 'default-indicate-buffer-boundaries
'indicate-buffer-boundaries "23.2")
+(make-obsolete-variable 'default-fringe-indicator-alist
'fringe-indicator-alist "23.2")
+(make-obsolete-variable 'default-fringe-cursor-alist 'fringe-cursor-alist
"23.2")
+(make-obsolete-variable 'default-scroll-up-aggressively
'scroll-up-aggressively "23.2")
+(make-obsolete-variable 'default-scroll-down-aggressively
'scroll-down-aggressively "23.2")
+(make-obsolete-variable 'default-fill-column 'fill-column "23.2")
+(make-obsolete-variable 'default-cursor-type 'cursor-type "23.2")
+(make-obsolete-variable 'default-cursor-in-non-selected-windows
'cursor-in-non-selected-windows "23.2")
+(make-obsolete-variable 'default-buffer-file-coding-system
'buffer-file-coding-system "23.2")
+(make-obsolete-variable 'default-major-mode 'major-mode "23.2")
+(make-obsolete-variable 'default-enable-multibyte-characters
+ "use enable-multibyte-characters or set-buffer-multibyte instead" "23.2")
+
+(make-obsolete-variable 'define-key-rebound-commands nil "23.2")
+(make-obsolete-variable 'redisplay-end-trigger-functions 'jit-lock-register
"23.1")
+(make-obsolete-variable 'deferred-action-list 'post-command-hook "24.1")
+(make-obsolete-variable 'deferred-action-function 'post-command-hook "24.1")
+(make-obsolete-variable 'redisplay-dont-pause nil "24.5")
+(make-obsolete 'window-redisplay-end-trigger nil "23.1")
+(make-obsolete 'set-window-redisplay-end-trigger nil "23.1")
+
+(make-obsolete 'process-filter-multibyte-p nil "23.1")
+(make-obsolete 'set-process-filter-multibyte nil "23.1")
+
+;; Lisp manual only updated in 22.1.
+(define-obsolete-variable-alias 'executing-macro 'executing-kbd-macro
+ "before 19.34")
+
+(define-obsolete-variable-alias 'x-lost-selection-hooks
+ 'x-lost-selection-functions "22.1")
+(define-obsolete-variable-alias 'x-sent-selection-hooks
+ 'x-sent-selection-functions "22.1")
+
+;; This was introduced in 21.4 for pre-unicode unification. That
+;; usage was rendered obsolete in 23.1 which uses Unicode internally.
+;; Other uses are possible, so this variable is not _really_ obsolete,
+;; but Stefan insists to mark it so.
+(make-obsolete-variable 'translation-table-for-input nil "23.1")
+
+(defvaralias 'messages-buffer-max-lines 'message-log-max)
+
+;;;; Alternate names for functions - these are not being phased out.
+
+(defalias 'send-string 'process-send-string)
+(defalias 'send-region 'process-send-region)
+(defalias 'string= 'string-equal)
+(defalias 'string< 'string-lessp)
+(defalias 'move-marker 'set-marker)
+(defalias 'rplaca 'setcar)
+(defalias 'rplacd 'setcdr)
+(defalias 'beep 'ding) ;preserve lingual purity
+(defalias 'indent-to-column 'indent-to)
+(defalias 'backward-delete-char 'delete-backward-char)
+(defalias 'search-forward-regexp (symbol-function 're-search-forward))
+(defalias 'search-backward-regexp (symbol-function 're-search-backward))
+(defalias 'int-to-string 'number-to-string)
+(defalias 'store-match-data 'set-match-data)
+(defalias 'chmod 'set-file-modes)
+(defalias 'mkdir 'make-directory)
+;; These are the XEmacs names:
+(defalias 'point-at-eol 'line-end-position)
+(defalias 'point-at-bol 'line-beginning-position)
+
+(defalias 'user-original-login-name 'user-login-name)
+
+
+;;;; Hook manipulation functions.
+
+(defun add-hook (hook function &optional append local)
+ "Add to the value of HOOK the function FUNCTION.
+FUNCTION is not added if already present.
+FUNCTION is added (if necessary) at the beginning of the hook list
+unless the optional argument APPEND is non-nil, in which case
+FUNCTION is added at the end.
+
+The optional fourth argument, LOCAL, if non-nil, says to modify
+the hook's buffer-local value rather than its global value.
+This makes the hook buffer-local, and it makes t a member of the
+buffer-local value. That acts as a flag to run the hook
+functions of the global value as well as in the local value.
+
+HOOK should be a symbol, and FUNCTION may be any valid function. If
+HOOK is void, it is first set to nil. If HOOK's value is a single
+function, it is changed to a list of functions."
+ (or (boundp hook) (set hook nil))
+ (or (default-boundp hook) (set-default hook nil))
+ (if local (unless (local-variable-if-set-p hook)
+ (set (make-local-variable hook) (list t)))
+ ;; Detect the case where make-local-variable was used on a hook
+ ;; and do what we used to do.
+ (unless (and (consp (symbol-value hook)) (memq t (symbol-value hook)))
+ (setq local t)))
+ (let ((hook-value (if local (symbol-value hook) (default-value hook))))
+ ;; If the hook value is a single function, turn it into a list.
+ (when (or (not (listp hook-value)) (functionp hook-value))
+ (setq hook-value (list hook-value)))
+ ;; Do the actual addition if necessary
+ (unless (member function hook-value)
+ (when (stringp function)
+ (setq function (purecopy function)))
+ (setq hook-value
+ (if append
+ (append hook-value (list function))
+ (cons function hook-value))))
+ ;; Set the actual variable
+ (if local
+ (progn
+ ;; If HOOK isn't a permanent local,
+ ;; but FUNCTION wants to survive a change of modes,
+ ;; mark HOOK as partially permanent.
+ (and (symbolp function)
+ (get function 'permanent-local-hook)
+ (not (get hook 'permanent-local))
+ (put hook 'permanent-local 'permanent-local-hook))
+ (set hook hook-value))
+ (set-default hook hook-value))))
+
+(defun remove-hook (hook function &optional local)
+ "Remove from the value of HOOK the function FUNCTION.
+HOOK should be a symbol, and FUNCTION may be any valid function. If
+FUNCTION isn't the value of HOOK, or, if FUNCTION doesn't appear in the
+list of hooks to run in HOOK, then nothing is done. See `add-hook'.
+
+The optional third argument, LOCAL, if non-nil, says to modify
+the hook's buffer-local value rather than its default value."
+ (or (boundp hook) (set hook nil))
+ (or (default-boundp hook) (set-default hook nil))
+ ;; Do nothing if LOCAL is t but this hook has no local binding.
+ (unless (and local (not (local-variable-p hook)))
+ ;; Detect the case where make-local-variable was used on a hook
+ ;; and do what we used to do.
+ (when (and (local-variable-p hook)
+ (not (and (consp (symbol-value hook))
+ (memq t (symbol-value hook)))))
+ (setq local t))
+ (let ((hook-value (if local (symbol-value hook) (default-value hook))))
+ ;; Remove the function, for both the list and the non-list cases.
+ (if (or (not (listp hook-value)) (eq (car hook-value) 'lambda))
+ (if (equal hook-value function) (setq hook-value nil))
+ (setq hook-value (delete function (copy-sequence hook-value))))
+ ;; If the function is on the global hook, we need to shadow it locally
+ ;;(when (and local (member function (default-value hook))
+ ;; (not (member (cons 'not function) hook-value)))
+ ;; (push (cons 'not function) hook-value))
+ ;; Set the actual variable
+ (if (not local)
+ (set-default hook hook-value)
+ (if (equal hook-value '(t))
+ (kill-local-variable hook)
+ (set hook hook-value))))))
+
+(defmacro letrec (binders &rest body)
+ "Bind variables according to BINDERS then eval BODY.
+The value of the last form in BODY is returned.
+Each element of BINDERS is a list (SYMBOL VALUEFORM) which binds
+SYMBOL to the value of VALUEFORM.
+All symbols are bound before the VALUEFORMs are evalled."
+ ;; Only useful in lexical-binding mode.
+ ;; As a special-form, we could implement it more efficiently (and cleanly,
+ ;; making the vars actually unbound during evaluation of the binders).
+ (declare (debug let) (indent 1))
+ `(let ,(mapcar #'car binders)
+ ,@(mapcar (lambda (binder) `(setq ,@binder)) binders)
+ ,@body))
+
+(defmacro with-wrapper-hook (hook args &rest body)
+ "Run BODY, using wrapper functions from HOOK with additional ARGS.
+HOOK is an abnormal hook. Each hook function in HOOK \"wraps\"
+around the preceding ones, like a set of nested `around' advices.
+
+Each hook function should accept an argument list consisting of a
+function FUN, followed by the additional arguments in ARGS.
+
+The first hook function in HOOK is passed a FUN that, if it is called
+with arguments ARGS, performs BODY (i.e., the default operation).
+The FUN passed to each successive hook function is defined based
+on the preceding hook functions; if called with arguments ARGS,
+it does what the `with-wrapper-hook' call would do if the
+preceding hook functions were the only ones present in HOOK.
+
+Each hook function may call its FUN argument as many times as it wishes,
+including never. In that case, such a hook function acts to replace
+the default definition altogether, and any preceding hook functions.
+Of course, a subsequent hook function may do the same thing.
+
+Each hook function definition is used to construct the FUN passed
+to the next hook function, if any. The last (or \"outermost\")
+FUN is then called once."
+ (declare (indent 2) (debug (form sexp body))
+ (obsolete "use a <foo>-function variable modified by
`add-function'."
+ "24.4"))
+ ;; We need those two gensyms because CL's lexical scoping is not available
+ ;; for function arguments :-(
+ (let ((funs (make-symbol "funs"))
+ (global (make-symbol "global"))
+ (argssym (make-symbol "args"))
+ (runrestofhook (make-symbol "runrestofhook")))
+ ;; Since the hook is a wrapper, the loop has to be done via
+ ;; recursion: a given hook function will call its parameter in order to
+ ;; continue looping.
+ `(letrec ((,runrestofhook
+ (lambda (,funs ,global ,argssym)
+ ;; `funs' holds the functions left on the hook and `global'
+ ;; holds the functions left on the global part of the hook
+ ;; (in case the hook is local).
+ (if (consp ,funs)
+ (if (eq t (car ,funs))
+ (funcall ,runrestofhook
+ (append ,global (cdr ,funs)) nil ,argssym)
+ (apply (car ,funs)
+ (apply-partially
+ (lambda (,funs ,global &rest ,argssym)
+ (funcall ,runrestofhook ,funs ,global
,argssym))
+ (cdr ,funs) ,global)
+ ,argssym))
+ ;; Once there are no more functions on the hook, run
+ ;; the original body.
+ (apply (lambda ,args ,@body) ,argssym)))))
+ (funcall ,runrestofhook ,hook
+ ;; The global part of the hook, if any.
+ ,(if (symbolp hook)
+ `(if (local-variable-p ',hook)
+ (default-value ',hook)))
+ (list ,@args)))))
+
+(defun add-to-list (list-var element &optional append compare-fn)
+ "Add ELEMENT to the value of LIST-VAR if it isn't there yet.
+The test for presence of ELEMENT is done with `equal', or with
+COMPARE-FN if that's non-nil.
+If ELEMENT is added, it is added at the beginning of the list,
+unless the optional argument APPEND is non-nil, in which case
+ELEMENT is added at the end.
+
+The return value is the new value of LIST-VAR.
+
+This is handy to add some elements to configuration variables,
+but please do not abuse it in Elisp code, where you are usually
+better off using `push' or `cl-pushnew'.
+
+If you want to use `add-to-list' on a variable that is not
+defined until a certain package is loaded, you should put the
+call to `add-to-list' into a hook function that will be run only
+after loading the package. `eval-after-load' provides one way to
+do this. In some cases other hooks, such as major mode hooks,
+can do the job."
+ (declare
+ (compiler-macro
+ (lambda (exp)
+ ;; FIXME: Something like this could be used for `set' as well.
+ (if (or (not (eq 'quote (car-safe list-var)))
+ (special-variable-p (cadr list-var))
+ (not (macroexp-const-p append)))
+ exp
+ (let* ((sym (cadr list-var))
+ (append (eval append))
+ (msg (format "`add-to-list' can't use lexical var `%s'; use
`push' or `cl-pushnew'"
+ sym))
+ ;; Big ugly hack so we only output a warning during
+ ;; byte-compilation, and so we can use
+ ;; byte-compile-not-lexical-var-p to silence the warning
+ ;; when a defvar has been seen but not yet executed.
+ (warnfun (lambda ()
+ ;; FIXME: We should also emit a warning for let-bound
+ ;; variables with dynamic binding.
+ (when (assq sym byte-compile--lexical-environment)
+ (byte-compile-log-warning msg t :error))))
+ (code
+ (macroexp-let2 macroexp-copyable-p x element
+ `(if ,(if compare-fn
+ (progn
+ (require 'cl-lib)
+ `(cl-member ,x ,sym :test ,compare-fn))
+ ;; For bootstrapping reasons, don't rely on
+ ;; cl--compiler-macro-member for the base case.
+ `(member ,x ,sym))
+ ,sym
+ ,(if append
+ `(setq ,sym (append ,sym (list ,x)))
+ `(push ,x ,sym))))))
+ (if (not (macroexp--compiling-p))
+ code
+ `(progn
+ (macroexp--funcall-if-compiled ',warnfun)
+ ,code)))))))
+ (if (cond
+ ((null compare-fn)
+ (member element (symbol-value list-var)))
+ ((eq compare-fn 'eq)
+ (memq element (symbol-value list-var)))
+ ((eq compare-fn 'eql)
+ (memql element (symbol-value list-var)))
+ (t
+ (let ((lst (symbol-value list-var)))
+ (while (and lst
+ (not (funcall compare-fn element (car lst))))
+ (setq lst (cdr lst)))
+ lst)))
+ (symbol-value list-var)
+ (set list-var
+ (if append
+ (append (symbol-value list-var) (list element))
+ (cons element (symbol-value list-var))))))
+
+
+(defun add-to-ordered-list (list-var element &optional order)
+ "Add ELEMENT to the value of LIST-VAR if it isn't there yet.
+The test for presence of ELEMENT is done with `eq'.
+
+The resulting list is reordered so that the elements are in the
+order given by each element's numeric list order. Elements
+without a numeric list order are placed at the end of the list.
+
+If the third optional argument ORDER is a number (integer or
+float), set the element's list order to the given value. If
+ORDER is nil or omitted, do not change the numeric order of
+ELEMENT. If ORDER has any other value, remove the numeric order
+of ELEMENT if it has one.
+
+The list order for each element is stored in LIST-VAR's
+`list-order' property.
+
+The return value is the new value of LIST-VAR."
+ (let ((ordering (get list-var 'list-order)))
+ (unless ordering
+ (put list-var 'list-order
+ (setq ordering (make-hash-table :weakness 'key :test 'eq))))
+ (when order
+ (puthash element (and (numberp order) order) ordering))
+ (unless (memq element (symbol-value list-var))
+ (set list-var (cons element (symbol-value list-var))))
+ (set list-var (sort (symbol-value list-var)
+ (lambda (a b)
+ (let ((oa (gethash a ordering))
+ (ob (gethash b ordering)))
+ (if (and oa ob)
+ (< oa ob)
+ oa)))))))
+
+(defun add-to-history (history-var newelt &optional maxelt keep-all)
+ "Add NEWELT to the history list stored in the variable HISTORY-VAR.
+Return the new history list.
+If MAXELT is non-nil, it specifies the maximum length of the history.
+Otherwise, the maximum history length is the value of the `history-length'
+property on symbol HISTORY-VAR, if set, or the value of the `history-length'
+variable.
+Remove duplicates of NEWELT if `history-delete-duplicates' is non-nil.
+If optional fourth arg KEEP-ALL is non-nil, add NEWELT to history even
+if it is empty or a duplicate."
+ (unless maxelt
+ (setq maxelt (or (get history-var 'history-length)
+ history-length)))
+ (let ((history (symbol-value history-var))
+ tail)
+ (when (and (listp history)
+ (or keep-all
+ (not (stringp newelt))
+ (> (length newelt) 0))
+ (or keep-all
+ (not (equal (car history) newelt))))
+ (if history-delete-duplicates
+ (setq history (delete newelt history)))
+ (setq history (cons newelt history))
+ (when (integerp maxelt)
+ (if (= 0 maxelt)
+ (setq history nil)
+ (setq tail (nthcdr (1- maxelt) history))
+ (when (consp tail)
+ (setcdr tail nil)))))
+ (set history-var history)))
+
+
+;;;; Mode hooks.
+
+(defvar delay-mode-hooks nil
+ "If non-nil, `run-mode-hooks' should delay running the hooks.")
+(defvar delayed-mode-hooks nil
+ "List of delayed mode hooks waiting to be run.")
+(make-variable-buffer-local 'delayed-mode-hooks)
+(put 'delay-mode-hooks 'permanent-local t)
+
+(defvar change-major-mode-after-body-hook nil
+ "Normal hook run in major mode functions, before the mode hooks.")
+
+(defvar after-change-major-mode-hook nil
+ "Normal hook run at the very end of major mode functions.")
+
+(defun run-mode-hooks (&rest hooks)
+ "Run mode hooks `delayed-mode-hooks' and HOOKS, or delay HOOKS.
+If the variable `delay-mode-hooks' is non-nil, does not run any hooks,
+just adds the HOOKS to the list `delayed-mode-hooks'.
+Otherwise, runs hooks in the sequence: `change-major-mode-after-body-hook',
+`delayed-mode-hooks' (in reverse order), HOOKS, and finally
+`after-change-major-mode-hook'. Major mode functions should use
+this instead of `run-hooks' when running their FOO-mode-hook."
+ (if delay-mode-hooks
+ ;; Delaying case.
+ (dolist (hook hooks)
+ (push hook delayed-mode-hooks))
+ ;; Normal case, just run the hook as before plus any delayed hooks.
+ (setq hooks (nconc (nreverse delayed-mode-hooks) hooks))
+ (setq delayed-mode-hooks nil)
+ (apply 'run-hooks (cons 'change-major-mode-after-body-hook hooks))
+ (run-hooks 'after-change-major-mode-hook)))
+
+(defmacro delay-mode-hooks (&rest body)
+ "Execute BODY, but delay any `run-mode-hooks'.
+These hooks will be executed by the first following call to
+`run-mode-hooks' that occurs outside any `delayed-mode-hooks' form.
+Only affects hooks run in the current buffer."
+ (declare (debug t) (indent 0))
+ `(progn
+ (make-local-variable 'delay-mode-hooks)
+ (let ((delay-mode-hooks t))
+ ,@body)))
+
+;; PUBLIC: find if the current mode derives from another.
+
+(defun derived-mode-p (&rest modes)
+ "Non-nil if the current major mode is derived from one of MODES.
+Uses the `derived-mode-parent' property of the symbol to trace backwards."
+ (let ((parent major-mode))
+ (while (and (not (memq parent modes))
+ (setq parent (get parent 'derived-mode-parent))))
+ parent))
+
+;;;; Minor modes.
+
+;; If a minor mode is not defined with define-minor-mode,
+;; add it here explicitly.
+;; isearch-mode is deliberately excluded, since you should
+;; not call it yourself.
+(defvar minor-mode-list '(auto-save-mode auto-fill-mode abbrev-mode
+ overwrite-mode view-mode
+ hs-minor-mode)
+ "List of all minor mode functions.")
+
+(defun add-minor-mode (toggle name &optional keymap after toggle-fun)
+ "Register a new minor mode.
+
+This is an XEmacs-compatibility function. Use `define-minor-mode' instead.
+
+TOGGLE is a symbol which is the name of a buffer-local variable that
+is toggled on or off to say whether the minor mode is active or not.
+
+NAME specifies what will appear in the mode line when the minor mode
+is active. NAME should be either a string starting with a space, or a
+symbol whose value is such a string.
+
+Optional KEYMAP is the keymap for the minor mode that will be added
+to `minor-mode-map-alist'.
+
+Optional AFTER specifies that TOGGLE should be added after AFTER
+in `minor-mode-alist'.
+
+Optional TOGGLE-FUN is an interactive function to toggle the mode.
+It defaults to (and should by convention be) TOGGLE.
+
+If TOGGLE has a non-nil `:included' property, an entry for the mode is
+included in the mode-line minor mode menu.
+If TOGGLE has a `:menu-tag', that is used for the menu item's label."
+ (unless (memq toggle minor-mode-list)
+ (push toggle minor-mode-list))
+
+ (unless toggle-fun (setq toggle-fun toggle))
+ (unless (eq toggle-fun toggle)
+ (put toggle :minor-mode-function toggle-fun))
+ ;; Add the name to the minor-mode-alist.
+ (when name
+ (let ((existing (assq toggle minor-mode-alist)))
+ (if existing
+ (setcdr existing (list name))
+ (let ((tail minor-mode-alist) found)
+ (while (and tail (not found))
+ (if (eq after (caar tail))
+ (setq found tail)
+ (setq tail (cdr tail))))
+ (if found
+ (let ((rest (cdr found)))
+ (setcdr found nil)
+ (nconc found (list (list toggle name)) rest))
+ (push (list toggle name) minor-mode-alist))))))
+ ;; Add the toggle to the minor-modes menu if requested.
+ (when (get toggle :included)
+ (define-key mode-line-mode-menu
+ (vector toggle)
+ (list 'menu-item
+ (concat
+ (or (get toggle :menu-tag)
+ (if (stringp name) name (symbol-name toggle)))
+ (let ((mode-name (if (symbolp name) (symbol-value name))))
+ (if (and (stringp mode-name) (string-match "[^ ]+" mode-name))
+ (concat " (" (match-string 0 mode-name) ")"))))
+ toggle-fun
+ :button (cons :toggle toggle))))
+
+ ;; Add the map to the minor-mode-map-alist.
+ (when keymap
+ (let ((existing (assq toggle minor-mode-map-alist)))
+ (if existing
+ (setcdr existing keymap)
+ (let ((tail minor-mode-map-alist) found)
+ (while (and tail (not found))
+ (if (eq after (caar tail))
+ (setq found tail)
+ (setq tail (cdr tail))))
+ (if found
+ (let ((rest (cdr found)))
+ (setcdr found nil)
+ (nconc found (list (cons toggle keymap)) rest))
+ (push (cons toggle keymap) minor-mode-map-alist)))))))
+
+;;;; Load history
+
+(defsubst autoloadp (object)
+ "Non-nil if OBJECT is an autoload."
+ (eq 'autoload (car-safe object)))
+
+;; (defun autoload-type (object)
+;; "Returns the type of OBJECT or `function' or `command' if the type is nil.
+;; OBJECT should be an autoload object."
+;; (when (autoloadp object)
+;; (let ((type (nth 3 object)))
+;; (cond ((null type) (if (nth 2 object) 'command 'function))
+;; ((eq 'keymap t) 'macro)
+;; (type)))))
+
+;; (defalias 'autoload-file #'cadr
+;; "Return the name of the file from which AUTOLOAD will be loaded.
+;; \n\(fn AUTOLOAD)")
+
+(defun symbol-file (symbol &optional type)
+ "Return the name of the file that defined SYMBOL.
+The value is normally an absolute file name. It can also be nil,
+if the definition is not associated with any file. If SYMBOL
+specifies an autoloaded function, the value can be a relative
+file name without extension.
+
+If TYPE is nil, then any kind of definition is acceptable. If
+TYPE is `defun', `defvar', or `defface', that specifies function
+definition, variable definition, or face definition only."
+ (if (and (or (null type) (eq type 'defun))
+ (symbolp symbol)
+ (autoloadp (symbol-function symbol)))
+ (nth 1 (symbol-function symbol))
+ (let ((files load-history)
+ file)
+ (while files
+ (if (if type
+ (if (eq type 'defvar)
+ ;; Variables are present just as their names.
+ (member symbol (cdr (car files)))
+ ;; Other types are represented as (TYPE . NAME).
+ (member (cons type symbol) (cdr (car files))))
+ ;; We accept all types, so look for variable def
+ ;; and then for any other kind.
+ (or (member symbol (cdr (car files)))
+ (rassq symbol (cdr (car files)))))
+ (setq file (car (car files)) files nil))
+ (setq files (cdr files)))
+ file)))
+
+(defun locate-library (library &optional nosuffix path interactive-call)
+ "Show the precise file name of Emacs library LIBRARY.
+LIBRARY should be a relative file name of the library, a string.
+It can omit the suffix (a.k.a. file-name extension) if NOSUFFIX is
+nil (which is the default, see below).
+This command searches the directories in `load-path' like `\\[load-library]'
+to find the file that `\\[load-library] RET LIBRARY RET' would load.
+Optional second arg NOSUFFIX non-nil means don't add suffixes `load-suffixes'
+to the specified name LIBRARY.
+
+If the optional third arg PATH is specified, that list of directories
+is used instead of `load-path'.
+
+When called from a program, the file name is normally returned as a
+string. When run interactively, the argument INTERACTIVE-CALL is t,
+and the file name is displayed in the echo area."
+ (interactive (list (completing-read "Locate library: "
+ (apply-partially
+ 'locate-file-completion-table
+ load-path (get-load-suffixes)))
+ nil nil
+ t))
+ (let ((file (locate-file library
+ (or path load-path)
+ (append (unless nosuffix (get-load-suffixes))
+ load-file-rep-suffixes))))
+ (if interactive-call
+ (if file
+ (message "Library is file %s" (abbreviate-file-name file))
+ (message "No library %s in search path" library)))
+ file))
+
+
+;;;; Process stuff.
+
+(defun process-lines (program &rest args)
+ "Execute PROGRAM with ARGS, returning its output as a list of lines.
+Signal an error if the program returns with a non-zero exit status."
+ (with-temp-buffer
+ (let ((status (apply 'call-process program nil (current-buffer) nil args)))
+ (unless (eq status 0)
+ (error "%s exited with status %s" program status))
+ (goto-char (point-min))
+ (let (lines)
+ (while (not (eobp))
+ (setq lines (cons (buffer-substring-no-properties
+ (line-beginning-position)
+ (line-end-position))
+ lines))
+ (forward-line 1))
+ (nreverse lines)))))
+
+(defun process-live-p (process)
+ "Returns non-nil if PROCESS is alive.
+A process is considered alive if its status is `run', `open',
+`listen', `connect' or `stop'. Value is nil if PROCESS is not a
+process."
+ (and (processp process)
+ (memq (process-status process)
+ '(run open listen connect stop))))
+
+;; compatibility
+
+(make-obsolete
+ 'process-kill-without-query
+ "use `process-query-on-exit-flag' or `set-process-query-on-exit-flag'."
+ "22.1")
+(defun process-kill-without-query (process &optional _flag)
+ "Say no query needed if PROCESS is running when Emacs is exited.
+Optional second argument if non-nil says to require a query.
+Value is t if a query was formerly required."
+ (let ((old (process-query-on-exit-flag process)))
+ (set-process-query-on-exit-flag process nil)
+ old))
+
+(defun process-kill-buffer-query-function ()
+ "Ask before killing a buffer that has a running process."
+ (let ((process (get-buffer-process (current-buffer))))
+ (or (not process)
+ (not (memq (process-status process) '(run stop open listen)))
+ (not (process-query-on-exit-flag process))
+ (yes-or-no-p
+ (format "Buffer %S has a running process; kill it? "
+ (buffer-name (current-buffer)))))))
+
+(add-hook 'kill-buffer-query-functions 'process-kill-buffer-query-function)
+
+;; process plist management
+
+(defun process-get (process propname)
+ "Return the value of PROCESS' PROPNAME property.
+This is the last value stored with `(process-put PROCESS PROPNAME VALUE)'."
+ (plist-get (process-plist process) propname))
+
+(defun process-put (process propname value)
+ "Change PROCESS' PROPNAME property to VALUE.
+It can be retrieved with `(process-get PROCESS PROPNAME)'."
+ (set-process-plist process
+ (plist-put (process-plist process) propname value)))
+
+
+;;;; Input and display facilities.
+
+(defconst read-key-empty-map (make-sparse-keymap))
+
+(defvar read-key-delay 0.01) ;Fast enough for 100Hz repeat rate, hopefully.
+
+(defun read-key (&optional prompt)
+ "Read a key from the keyboard.
+Contrary to `read-event' this will not return a raw event but instead will
+obey the input decoding and translations usually done by `read-key-sequence'.
+So escape sequences and keyboard encoding are taken into account.
+When there's an ambiguity because the key looks like the prefix of
+some sort of escape sequence, the ambiguity is resolved via `read-key-delay'."
+ ;; This overriding-terminal-local-map binding also happens to
+ ;; disable quail's input methods, so although read-key-sequence
+ ;; always inherits the input method, in practice read-key does not
+ ;; inherit the input method (at least not if it's based on quail).
+ (let ((overriding-terminal-local-map nil)
+ (overriding-local-map read-key-empty-map)
+ (echo-keystrokes 0)
+ (old-global-map (current-global-map))
+ (timer (run-with-idle-timer
+ ;; Wait long enough that Emacs has the time to receive and
+ ;; process all the raw events associated with the single-key.
+ ;; But don't wait too long, or the user may find the delay
+ ;; annoying (or keep hitting more keys which may then get
+ ;; lost or misinterpreted).
+ ;; This is only relevant for keys which Emacs perceives as
+ ;; "prefixes", such as C-x (because of the C-x 8 map in
+ ;; key-translate-table and the C-x @ map in function-key-map)
+ ;; or ESC (because of terminal escape sequences in
+ ;; input-decode-map).
+ read-key-delay t
+ (lambda ()
+ (let ((keys (this-command-keys-vector)))
+ (unless (zerop (length keys))
+ ;; `keys' is non-empty, so the user has hit at least
+ ;; one key; there's no point waiting any longer, even
+ ;; though read-key-sequence thinks we should wait
+ ;; for more input to decide how to interpret the
+ ;; current input.
+ (throw 'read-key keys)))))))
+ (unwind-protect
+ (progn
+ (use-global-map
+ (let ((map (make-sparse-keymap)))
+ ;; Don't hide the menu-bar and tool-bar entries.
+ (define-key map [menu-bar] (lookup-key global-map [menu-bar]))
+ (define-key map [tool-bar]
+ ;; This hack avoids evaluating the :filter (Bug#9922).
+ (or (cdr (assq 'tool-bar global-map))
+ (lookup-key global-map [tool-bar])))
+ map))
+ (aref (catch 'read-key (read-key-sequence-vector prompt nil t)) 0))
+ (cancel-timer timer)
+ (use-global-map old-global-map))))
+
+(defvar read-passwd-map
+ ;; BEWARE: `defconst' would purecopy it, breaking the sharing with
+ ;; minibuffer-local-map along the way!
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map minibuffer-local-map)
+ (define-key map "\C-u" #'delete-minibuffer-contents) ;bug#12570
+ map)
+ "Keymap used while reading passwords.")
+
+(defun read-passwd (prompt &optional confirm default)
+ "Read a password, prompting with PROMPT, and return it.
+If optional CONFIRM is non-nil, read the password twice to make sure.
+Optional DEFAULT is a default password to use instead of empty input.
+
+This function echoes `.' for each character that the user types.
+Note that in batch mode, the input is not hidden!
+
+Once the caller uses the password, it can erase the password
+by doing (clear-string STRING)."
+ (if confirm
+ (let (success)
+ (while (not success)
+ (let ((first (read-passwd prompt nil default))
+ (second (read-passwd "Confirm password: " nil default)))
+ (if (equal first second)
+ (progn
+ (and (arrayp second) (clear-string second))
+ (setq success first))
+ (and (arrayp first) (clear-string first))
+ (and (arrayp second) (clear-string second))
+ (message "Password not repeated accurately; please start over")
+ (sit-for 1))))
+ success)
+ (let ((hide-chars-fun
+ (lambda (beg end _len)
+ (clear-this-command-keys)
+ (setq beg (min end (max (minibuffer-prompt-end)
+ beg)))
+ (dotimes (i (- end beg))
+ (put-text-property (+ i beg) (+ 1 i beg)
+ 'display (string ?.)))))
+ minibuf)
+ (minibuffer-with-setup-hook
+ (lambda ()
+ (setq minibuf (current-buffer))
+ ;; Turn off electricity.
+ (setq-local post-self-insert-hook nil)
+ (setq-local buffer-undo-list t)
+ (setq-local select-active-regions nil)
+ (use-local-map read-passwd-map)
+ (setq-local inhibit-modification-hooks nil) ;bug#15501.
+ (setq-local show-paren-mode nil) ;bug#16091.
+ (add-hook 'after-change-functions hide-chars-fun nil 'local))
+ (unwind-protect
+ (let ((enable-recursive-minibuffers t))
+ (read-string
+ (if noninteractive
+ (format "%s[INPUT WILL NOT BE HIDDEN!] " prompt) ; bug#17839
+ prompt)
+ nil t default)) ; t = "no history"
+ (when (buffer-live-p minibuf)
+ (with-current-buffer minibuf
+ ;; Not sure why but it seems that there might be cases where the
+ ;; minibuffer is not always properly reset later on, so undo
+ ;; whatever we've done here (bug#11392).
+ (remove-hook 'after-change-functions hide-chars-fun 'local)
+ (kill-local-variable 'post-self-insert-hook)
+ ;; And of course, don't keep the sensitive data around.
+ (erase-buffer))))))))
+
+(defun read-number (prompt &optional default)
+ "Read a numeric value in the minibuffer, prompting with PROMPT.
+DEFAULT specifies a default value to return if the user just types RET.
+The value of DEFAULT is inserted into PROMPT.
+This function is used by the `interactive' code letter `n'."
+ (let ((n nil)
+ (default1 (if (consp default) (car default) default)))
+ (when default1
+ (setq prompt
+ (if (string-match "\\(\\):[ \t]*\\'" prompt)
+ (replace-match (format " (default %s)" default1) t t prompt 1)
+ (replace-regexp-in-string "[ \t]*\\'"
+ (format " (default %s) " default1)
+ prompt t t))))
+ (while
+ (progn
+ (let ((str (read-from-minibuffer
+ prompt nil nil nil nil
+ (when default
+ (if (consp default)
+ (mapcar 'number-to-string (delq nil default))
+ (number-to-string default))))))
+ (condition-case nil
+ (setq n (cond
+ ((zerop (length str)) default1)
+ ((stringp str) (read str))))
+ (error nil)))
+ (unless (numberp n)
+ (message "Please enter a number.")
+ (sit-for 1)
+ t)))
+ n))
+
+(defun read-char-choice (prompt chars &optional inhibit-keyboard-quit)
+ "Read and return one of CHARS, prompting for PROMPT.
+Any input that is not one of CHARS is ignored.
+
+If optional argument INHIBIT-KEYBOARD-QUIT is non-nil, ignore
+keyboard-quit events while waiting for a valid input."
+ (unless (consp chars)
+ (error "Called `read-char-choice' without valid char choices"))
+ (let (char done show-help (helpbuf " *Char Help*"))
+ (let ((cursor-in-echo-area t)
+ (executing-kbd-macro executing-kbd-macro)
+ (esc-flag nil))
+ (save-window-excursion ; in case we call help-form-show
+ (while (not done)
+ (unless (get-text-property 0 'face prompt)
+ (setq prompt (propertize prompt 'face 'minibuffer-prompt)))
+ (setq char (let ((inhibit-quit inhibit-keyboard-quit))
+ (read-key prompt)))
+ (and show-help (buffer-live-p (get-buffer helpbuf))
+ (kill-buffer helpbuf))
+ (cond
+ ((not (numberp char)))
+ ;; If caller has set help-form, that's enough.
+ ;; They don't explicitly have to add help-char to chars.
+ ((and help-form
+ (eq char help-char)
+ (setq show-help t)
+ (help-form-show)))
+ ((memq char chars)
+ (setq done t))
+ ((and executing-kbd-macro (= char -1))
+ ;; read-event returns -1 if we are in a kbd macro and
+ ;; there are no more events in the macro. Attempt to
+ ;; get an event interactively.
+ (setq executing-kbd-macro nil))
+ ((not inhibit-keyboard-quit)
+ (cond
+ ((and (null esc-flag) (eq char ?\e))
+ (setq esc-flag t))
+ ((memq char '(?\C-g ?\e))
+ (keyboard-quit))))))))
+ ;; Display the question with the answer. But without cursor-in-echo-area.
+ (message "%s%s" prompt (char-to-string char))
+ char))
+
+(defun sit-for (seconds &optional nodisp obsolete)
+ "Redisplay, then wait for SECONDS seconds. Stop when input is available.
+SECONDS may be a floating-point value.
+\(On operating systems that do not support waiting for fractions of a
+second, floating-point values are rounded down to the nearest integer.)
+
+If optional arg NODISP is t, don't redisplay, just wait for input.
+Redisplay does not happen if input is available before it starts.
+
+Value is t if waited the full time with no input arriving, and nil otherwise.
+
+An obsolete, but still supported form is
+\(sit-for SECONDS &optional MILLISECONDS NODISP)
+where the optional arg MILLISECONDS specifies an additional wait period,
+in milliseconds; this was useful when Emacs was built without
+floating point support."
+ (declare (advertised-calling-convention (seconds &optional nodisp) "22.1"))
+ ;; This used to be implemented in C until the following discussion:
+ ;; http://lists.gnu.org/archive/html/emacs-devel/2006-07/msg00401.html
+ ;; Then it was moved here using an implementation based on an idle timer,
+ ;; which was then replaced by the use of read-event.
+ (if (numberp nodisp)
+ (setq seconds (+ seconds (* 1e-3 nodisp))
+ nodisp obsolete)
+ (if obsolete (setq nodisp obsolete)))
+ (cond
+ (noninteractive
+ (sleep-for seconds)
+ t)
+ ((input-pending-p t)
+ nil)
+ ((<= seconds 0)
+ (or nodisp (redisplay)))
+ (t
+ (or nodisp (redisplay))
+ ;; FIXME: we should not read-event here at all, because it's much too
+ ;; difficult to reliably "undo" a read-event by pushing it onto
+ ;; unread-command-events.
+ ;; For bug#14782, we need read-event to do the keyboard-coding-system
+ ;; decoding (hence non-nil as second arg under POSIX ttys).
+ ;; For bug#15614, we need read-event not to inherit-input-method.
+ ;; So we temporarily suspend input-method-function.
+ (let ((read (let ((input-method-function nil))
+ (read-event nil t seconds))))
+ (or (null read)
+ (progn
+ ;; If last command was a prefix arg, e.g. C-u, push this event onto
+ ;; unread-command-events as (t . EVENT) so it will be added to
+ ;; this-command-keys by read-key-sequence.
+ (if (eq overriding-terminal-local-map universal-argument-map)
+ (setq read (cons t read)))
+ (push read unread-command-events)
+ nil))))))
+
+;; Behind display-popup-menus-p test.
+(declare-function x-popup-dialog "menu.c" (position contents &optional header))
+
+(defun y-or-n-p (prompt)
+ "Ask user a \"y or n\" question. Return t if answer is \"y\".
+PROMPT is the string to display to ask the question. It should
+end in a space; `y-or-n-p' adds \"(y or n) \" to it.
+
+No confirmation of the answer is requested; a single character is
+enough. SPC also means yes, and DEL means no.
+
+To be precise, this function translates user input into responses
+by consulting the bindings in `query-replace-map'; see the
+documentation of that variable for more information. In this
+case, the useful bindings are `act', `skip', `recenter',
+`scroll-up', `scroll-down', and `quit'.
+An `act' response means yes, and a `skip' response means no.
+A `quit' response means to invoke `keyboard-quit'.
+If the user enters `recenter', `scroll-up', or `scroll-down'
+responses, perform the requested window recentering or scrolling
+and ask again.
+
+Under a windowing system a dialog box will be used if `last-nonmenu-event'
+is nil and `use-dialog-box' is non-nil."
+ ;; ¡Beware! when I tried to edebug this code, Emacs got into a weird state
+ ;; where all the keys were unbound (i.e. it somehow got triggered
+ ;; within read-key, apparently). I had to kill it.
+ (let ((answer 'recenter)
+ (padded (lambda (prompt &optional dialog)
+ (let ((l (length prompt)))
+ (concat prompt
+ (if (or (zerop l) (eq ?\s (aref prompt (1- l))))
+ "" " ")
+ (if dialog "" "(y or n) "))))))
+ (cond
+ (noninteractive
+ (setq prompt (funcall padded prompt))
+ (let ((temp-prompt prompt))
+ (while (not (memq answer '(act skip)))
+ (let ((str (read-string temp-prompt)))
+ (cond ((member str '("y" "Y")) (setq answer 'act))
+ ((member str '("n" "N")) (setq answer 'skip))
+ (t (setq temp-prompt (concat "Please answer y or n. "
+ prompt))))))))
+ ((and (display-popup-menus-p)
+ (listp last-nonmenu-event)
+ use-dialog-box)
+ (setq prompt (funcall padded prompt t)
+ answer (x-popup-dialog t `(,prompt ("Yes" . act) ("No" . skip)))))
+ (t
+ (setq prompt (funcall padded prompt))
+ (while
+ (let* ((scroll-actions '(recenter scroll-up scroll-down
+ scroll-other-window
scroll-other-window-down))
+ (key
+ (let ((cursor-in-echo-area t))
+ (when minibuffer-auto-raise
+ (raise-frame (window-frame (minibuffer-window))))
+ (read-key (propertize (if (memq answer scroll-actions)
+ prompt
+ (concat "Please answer y or n. "
+ prompt))
+ 'face 'minibuffer-prompt)))))
+ (setq answer (lookup-key query-replace-map (vector key) t))
+ (cond
+ ((memq answer '(skip act)) nil)
+ ((eq answer 'recenter)
+ (recenter) t)
+ ((eq answer 'scroll-up)
+ (ignore-errors (scroll-up-command)) t)
+ ((eq answer 'scroll-down)
+ (ignore-errors (scroll-down-command)) t)
+ ((eq answer 'scroll-other-window)
+ (ignore-errors (scroll-other-window)) t)
+ ((eq answer 'scroll-other-window-down)
+ (ignore-errors (scroll-other-window-down)) t)
+ ((or (memq answer '(exit-prefix quit)) (eq key ?\e))
+ (signal 'quit nil) t)
+ (t t)))
+ (ding)
+ (discard-input))))
+ (let ((ret (eq answer 'act)))
+ (unless noninteractive
+ (message "%s%c" prompt (if ret ?y ?n)))
+ ret)))
+
+
+;;; Atomic change groups.
+
+(defmacro atomic-change-group (&rest body)
+ "Perform BODY as an atomic change group.
+This means that if BODY exits abnormally,
+all of its changes to the current buffer are undone.
+This works regardless of whether undo is enabled in the buffer.
+
+This mechanism is transparent to ordinary use of undo;
+if undo is enabled in the buffer and BODY succeeds, the
+user can undo the change normally."
+ (declare (indent 0) (debug t))
+ (let ((handle (make-symbol "--change-group-handle--"))
+ (success (make-symbol "--change-group-success--")))
+ `(let ((,handle (prepare-change-group))
+ ;; Don't truncate any undo data in the middle of this.
+ (undo-outer-limit nil)
+ (undo-limit most-positive-fixnum)
+ (undo-strong-limit most-positive-fixnum)
+ (,success nil))
+ (unwind-protect
+ (progn
+ ;; This is inside the unwind-protect because
+ ;; it enables undo if that was disabled; we need
+ ;; to make sure that it gets disabled again.
+ (activate-change-group ,handle)
+ ,@body
+ (setq ,success t))
+ ;; Either of these functions will disable undo
+ ;; if it was disabled before.
+ (if ,success
+ (accept-change-group ,handle)
+ (cancel-change-group ,handle))))))
+
+(defun prepare-change-group (&optional buffer)
+ "Return a handle for the current buffer's state, for a change group.
+If you specify BUFFER, make a handle for BUFFER's state instead.
+
+Pass the handle to `activate-change-group' afterward to initiate
+the actual changes of the change group.
+
+To finish the change group, call either `accept-change-group' or
+`cancel-change-group' passing the same handle as argument. Call
+`accept-change-group' to accept the changes in the group as final;
+call `cancel-change-group' to undo them all. You should use
+`unwind-protect' to make sure the group is always finished. The call
+to `activate-change-group' should be inside the `unwind-protect'.
+Once you finish the group, don't use the handle again--don't try to
+finish the same group twice. For a simple example of correct use, see
+the source code of `atomic-change-group'.
+
+The handle records only the specified buffer. To make a multibuffer
+change group, call this function once for each buffer you want to
+cover, then use `nconc' to combine the returned values, like this:
+
+ (nconc (prepare-change-group buffer-1)
+ (prepare-change-group buffer-2))
+
+You can then activate that multibuffer change group with a single
+call to `activate-change-group' and finish it with a single call
+to `accept-change-group' or `cancel-change-group'."
+
+ (if buffer
+ (list (cons buffer (with-current-buffer buffer buffer-undo-list)))
+ (list (cons (current-buffer) buffer-undo-list))))
+
+(defun activate-change-group (handle)
+ "Activate a change group made with `prepare-change-group' (which see)."
+ (dolist (elt handle)
+ (with-current-buffer (car elt)
+ (if (eq buffer-undo-list t)
+ (setq buffer-undo-list nil)))))
+
+(defun accept-change-group (handle)
+ "Finish a change group made with `prepare-change-group' (which see).
+This finishes the change group by accepting its changes as final."
+ (dolist (elt handle)
+ (with-current-buffer (car elt)
+ (if (eq (cdr elt) t)
+ (setq buffer-undo-list t)))))
+
+(defun cancel-change-group (handle)
+ "Finish a change group made with `prepare-change-group' (which see).
+This finishes the change group by reverting all of its changes."
+ (dolist (elt handle)
+ (with-current-buffer (car elt)
+ (setq elt (cdr elt))
+ (save-restriction
+ ;; Widen buffer temporarily so if the buffer was narrowed within
+ ;; the body of `atomic-change-group' all changes can be undone.
+ (widen)
+ (let ((old-car
+ (if (consp elt) (car elt)))
+ (old-cdr
+ (if (consp elt) (cdr elt))))
+ ;; Temporarily truncate the undo log at ELT.
+ (when (consp elt)
+ (setcar elt nil) (setcdr elt nil))
+ (unless (eq last-command 'undo) (undo-start))
+ ;; Make sure there's no confusion.
+ (when (and (consp elt) (not (eq elt (last pending-undo-list))))
+ (error "Undoing to some unrelated state"))
+ ;; Undo it all.
+ (save-excursion
+ (while (listp pending-undo-list) (undo-more 1)))
+ ;; Reset the modified cons cell ELT to its original content.
+ (when (consp elt)
+ (setcar elt old-car)
+ (setcdr elt old-cdr))
+ ;; Revert the undo info to what it was when we grabbed the state.
+ (setq buffer-undo-list elt))))))
+
+;;;; Display-related functions.
+
+;; For compatibility.
+(define-obsolete-function-alias 'redraw-modeline
+ 'force-mode-line-update "24.3")
+
+(defun momentary-string-display (string pos &optional exit-char message)
+ "Momentarily display STRING in the buffer at POS.
+Display remains until next event is input.
+If POS is a marker, only its position is used; its buffer is ignored.
+Optional third arg EXIT-CHAR can be a character, event or event
+description list. EXIT-CHAR defaults to SPC. If the input is
+EXIT-CHAR it is swallowed; otherwise it is then available as
+input (as a command if nothing else).
+Display MESSAGE (optional fourth arg) in the echo area.
+If MESSAGE is nil, instructions to type EXIT-CHAR are displayed there."
+ (or exit-char (setq exit-char ?\s))
+ (let ((ol (make-overlay pos pos))
+ (str (copy-sequence string)))
+ (unwind-protect
+ (progn
+ (save-excursion
+ (overlay-put ol 'after-string str)
+ (goto-char pos)
+ ;; To avoid trouble with out-of-bounds position
+ (setq pos (point))
+ ;; If the string end is off screen, recenter now.
+ (if (<= (window-end nil t) pos)
+ (recenter (/ (window-height) 2))))
+ (message (or message "Type %s to continue editing.")
+ (single-key-description exit-char))
+ (let ((event (read-key)))
+ ;; `exit-char' can be an event, or an event description list.
+ (or (eq event exit-char)
+ (eq event (event-convert-list exit-char))
+ (setq unread-command-events
+ (append (this-single-command-raw-keys))))))
+ (delete-overlay ol))))
+
+
+;;;; Overlay operations
+
+(defun copy-overlay (o)
+ "Return a copy of overlay O."
+ (let ((o1 (if (overlay-buffer o)
+ (make-overlay (overlay-start o) (overlay-end o)
+ ;; FIXME: there's no easy way to find the
+ ;; insertion-type of the two markers.
+ (overlay-buffer o))
+ (let ((o1 (make-overlay (point-min) (point-min))))
+ (delete-overlay o1)
+ o1)))
+ (props (overlay-properties o)))
+ (while props
+ (overlay-put o1 (pop props) (pop props)))
+ o1))
+
+(defun remove-overlays (&optional beg end name val)
+ "Clear BEG and END of overlays whose property NAME has value VAL.
+Overlays might be moved and/or split.
+BEG and END default respectively to the beginning and end of buffer."
+ ;; This speeds up the loops over overlays.
+ (unless beg (setq beg (point-min)))
+ (unless end (setq end (point-max)))
+ (overlay-recenter end)
+ (if (< end beg)
+ (setq beg (prog1 end (setq end beg))))
+ (save-excursion
+ (dolist (o (overlays-in beg end))
+ (when (eq (overlay-get o name) val)
+ ;; Either push this overlay outside beg...end
+ ;; or split it to exclude beg...end
+ ;; or delete it entirely (if it is contained in beg...end).
+ (if (< (overlay-start o) beg)
+ (if (> (overlay-end o) end)
+ (progn
+ (move-overlay (copy-overlay o)
+ (overlay-start o) beg)
+ (move-overlay o end (overlay-end o)))
+ (move-overlay o (overlay-start o) beg))
+ (if (> (overlay-end o) end)
+ (move-overlay o end (overlay-end o))
+ (delete-overlay o)))))))
+
+;;;; Miscellanea.
+
+(defvar suspend-hook nil
+ "Normal hook run by `suspend-emacs', before suspending.")
+
+(defvar suspend-resume-hook nil
+ "Normal hook run by `suspend-emacs', after Emacs is continued.")
+
+(defvar temp-buffer-show-hook nil
+ "Normal hook run by `with-output-to-temp-buffer' after displaying the buffer.
+When the hook runs, the temporary buffer is current, and the window it
+was displayed in is selected.")
+
+(defvar temp-buffer-setup-hook nil
+ "Normal hook run by `with-output-to-temp-buffer' at the start.
+When the hook runs, the temporary buffer is current.
+This hook is normally set up with a function to put the buffer in Help
+mode.")
+
+(defconst user-emacs-directory
+ (if (eq system-type 'ms-dos)
+ ;; MS-DOS cannot have initial dot.
+ "~/_emacs.d/"
+ "~/.emacs.d/")
+ "Directory beneath which additional per-user Emacs-specific files are placed.
+Various programs in Emacs store information in this directory.
+Note that this should end with a directory separator.
+See also `locate-user-emacs-file'.")
+
+;;;; Misc. useful functions.
+
+(defsubst buffer-narrowed-p ()
+ "Return non-nil if the current buffer is narrowed."
+ (/= (- (point-max) (point-min)) (buffer-size)))
+
+(defun find-tag-default-bounds ()
+ "Determine the boundaries of the default tag, based on text at point.
+Return a cons cell with the beginning and end of the found tag.
+If there is no plausible default, return nil."
+ (let (from to bound)
+ (when (or (progn
+ ;; Look at text around `point'.
+ (save-excursion
+ (skip-syntax-backward "w_") (setq from (point)))
+ (save-excursion
+ (skip-syntax-forward "w_") (setq to (point)))
+ (> to from))
+ ;; Look between `line-beginning-position' and `point'.
+ (save-excursion
+ (and (setq bound (line-beginning-position))
+ (skip-syntax-backward "^w_" bound)
+ (> (setq to (point)) bound)
+ (skip-syntax-backward "w_")
+ (setq from (point))))
+ ;; Look between `point' and `line-end-position'.
+ (save-excursion
+ (and (setq bound (line-end-position))
+ (skip-syntax-forward "^w_" bound)
+ (< (setq from (point)) bound)
+ (skip-syntax-forward "w_")
+ (setq to (point)))))
+ (cons from to))))
+
+(defun find-tag-default ()
+ "Determine default tag to search for, based on text at point.
+If there is no plausible default, return nil."
+ (let ((bounds (find-tag-default-bounds)))
+ (when bounds
+ (buffer-substring-no-properties (car bounds) (cdr bounds)))))
+
+(defun find-tag-default-as-regexp ()
+ "Return regexp that matches the default tag at point.
+If there is no tag at point, return nil.
+
+When in a major mode that does not provide its own
+`find-tag-default-function', return a regexp that matches the
+symbol at point exactly."
+ (let ((tag (funcall (or find-tag-default-function
+ (get major-mode 'find-tag-default-function)
+ 'find-tag-default))))
+ (if tag (regexp-quote tag))))
+
+(defun find-tag-default-as-symbol-regexp ()
+ "Return regexp that matches the default tag at point as symbol.
+If there is no tag at point, return nil.
+
+When in a major mode that does not provide its own
+`find-tag-default-function', return a regexp that matches the
+symbol at point exactly."
+ (let ((tag-regexp (find-tag-default-as-regexp)))
+ (if (and tag-regexp
+ (eq (or find-tag-default-function
+ (get major-mode 'find-tag-default-function)
+ 'find-tag-default)
+ 'find-tag-default))
+ (format "\\_<%s\\_>" tag-regexp)
+ tag-regexp)))
+
+(defun play-sound (sound)
+ "SOUND is a list of the form `(sound KEYWORD VALUE...)'.
+The following keywords are recognized:
+
+ :file FILE - read sound data from FILE. If FILE isn't an
+absolute file name, it is searched in `data-directory'.
+
+ :data DATA - read sound data from string DATA.
+
+Exactly one of :file or :data must be present.
+
+ :volume VOL - set volume to VOL. VOL must an integer in the
+range 0..100 or a float in the range 0..1.0. If not specified,
+don't change the volume setting of the sound device.
+
+ :device DEVICE - play sound on DEVICE. If not specified,
+a system-dependent default device name is used.
+
+Note: :data and :device are currently not supported on Windows."
+ (if (fboundp 'play-sound-internal)
+ (play-sound-internal sound)
+ (error "This Emacs binary lacks sound support")))
+
+(declare-function w32-shell-dos-semantics "w32-fns" nil)
+
+(defun shell-quote-argument (argument)
+ "Quote ARGUMENT for passing as argument to an inferior shell."
+ (cond
+ ((eq system-type 'ms-dos)
+ ;; Quote using double quotes, but escape any existing quotes in
+ ;; the argument with backslashes.
+ (let ((result "")
+ (start 0)
+ end)
+ (if (or (null (string-match "[^\"]" argument))
+ (< (match-end 0) (length argument)))
+ (while (string-match "[\"]" argument start)
+ (setq end (match-beginning 0)
+ result (concat result (substring argument start end)
+ "\\" (substring argument end (1+ end)))
+ start (1+ end))))
+ (concat "\"" result (substring argument start) "\"")))
+
+ ((and (eq system-type 'windows-nt) (w32-shell-dos-semantics))
+
+ ;; First, quote argument so that CommandLineToArgvW will
+ ;; understand it. See
+ ;; http://msdn.microsoft.com/en-us/library/17w5ykft%28v=vs.85%29.aspx
+ ;; After we perform that level of quoting, escape shell
+ ;; metacharacters so that cmd won't mangle our argument. If the
+ ;; argument contains no double quote characters, we can just
+ ;; surround it with double quotes. Otherwise, we need to prefix
+ ;; each shell metacharacter with a caret.
+
+ (setq argument
+ ;; escape backslashes at end of string
+ (replace-regexp-in-string
+ "\\(\\\\*\\)$"
+ "\\1\\1"
+ ;; escape backslashes and quotes in string body
+ (replace-regexp-in-string
+ "\\(\\\\*\\)\""
+ "\\1\\1\\\\\""
+ argument)))
+
+ (if (string-match "[%!\"]" argument)
+ (concat
+ "^\""
+ (replace-regexp-in-string
+ "\\([%!()\"<>&|^]\\)"
+ "^\\1"
+ argument)
+ "^\"")
+ (concat "\"" argument "\"")))
+
+ (t
+ (if (equal argument "")
+ "''"
+ ;; Quote everything except POSIX filename characters.
+ ;; This should be safe enough even for really weird shells.
+ (replace-regexp-in-string
+ "\n" "'\n'"
+ (replace-regexp-in-string "[^-0-9a-zA-Z_./\n]" "\\\\\\&" argument))))
+ ))
+
+(defun string-or-null-p (object)
+ "Return t if OBJECT is a string or nil.
+Otherwise, return nil."
+ (or (stringp object) (null object)))
+
+(defun booleanp (object)
+ "Return t if OBJECT is one of the two canonical boolean values: t or nil.
+Otherwise, return nil."
+ (and (memq object '(nil t)) t))
+
+(defun special-form-p (object)
+ "Non-nil if and only if OBJECT is a special form."
+ (if (and (symbolp object) (fboundp object))
+ (setq object (indirect-function object t)))
+ (and (subrp object) (eq (cdr (subr-arity object)) 'unevalled)))
+
+(defun macrop (object)
+ "Non-nil if and only if OBJECT is a macro."
+ (let ((def (indirect-function object t)))
+ (when (consp def)
+ (or (eq 'macro (car def))
+ (and (autoloadp def) (memq (nth 4 def) '(macro t)))))))
+
+(defun field-at-pos (pos)
+ "Return the field at position POS, taking stickiness etc into account."
+ (let ((raw-field (get-char-property (field-beginning pos) 'field)))
+ (if (eq raw-field 'boundary)
+ (get-char-property (1- (field-end pos)) 'field)
+ raw-field)))
+
+(defun sha1 (object &optional start end binary)
+ "Return the SHA1 (Secure Hash Algorithm) of an OBJECT.
+OBJECT is either a string or a buffer. Optional arguments START and
+END are character positions specifying which portion of OBJECT for
+computing the hash. If BINARY is non-nil, return a string in binary
+form."
+ (secure-hash 'sha1 object start end binary))
+
+(defalias 'function-put #'put
+ ;; This is only really used in Emacs>24.4, but we add it to 24.4 already, so
+ ;; as to ease the pain when people use future autoload files that contain
+ ;; function-put.
+ "Set function F's property PROP to VALUE.
+The namespace for PROP is shared with symbols.
+So far, F can only be a symbol, not a lambda expression.")
+
+(defun function-get (f prop &optional autoload)
+ "Return the value of property PROP of function F.
+If AUTOLOAD is non-nil and F is autoloaded, try to autoload it
+in the hope that it will set PROP. If AUTOLOAD is `macro', only do it
+if it's an autoloaded macro."
+ (let ((val nil))
+ (while (and (symbolp f)
+ (null (setq val (get f prop)))
+ (fboundp f))
+ (let ((fundef (symbol-function f)))
+ (if (and autoload (autoloadp fundef)
+ (not (equal fundef
+ (autoload-do-load fundef f
+ (if (eq autoload 'macro)
+ 'macro)))))
+ nil ;Re-try `get' on the same `f'.
+ (setq f fundef))))
+ val))
+
+;;;; Support for yanking and text properties.
+;; Why here in subr.el rather than in simple.el? --Stef
+
+(defvar yank-handled-properties)
+(defvar yank-excluded-properties)
+
+(defun remove-yank-excluded-properties (start end)
+ "Process text properties between START and END, inserted for a `yank'.
+Perform the handling specified by `yank-handled-properties', then
+remove properties specified by `yank-excluded-properties'."
+ (let ((inhibit-read-only t))
+ (dolist (handler yank-handled-properties)
+ (let ((prop (car handler))
+ (fun (cdr handler))
+ (run-start start))
+ (while (< run-start end)
+ (let ((value (get-text-property run-start prop))
+ (run-end (next-single-property-change
+ run-start prop nil end)))
+ (funcall fun value run-start run-end)
+ (setq run-start run-end)))))
+ (if (eq yank-excluded-properties t)
+ (set-text-properties start end nil)
+ (remove-list-of-text-properties start end yank-excluded-properties))))
+
+(defvar yank-undo-function)
+
+(defun insert-for-yank (string)
+ "Call `insert-for-yank-1' repetitively for each `yank-handler' segment.
+
+See `insert-for-yank-1' for more details."
+ (let (to)
+ (while (setq to (next-single-property-change 0 'yank-handler string))
+ (insert-for-yank-1 (substring string 0 to))
+ (setq string (substring string to))))
+ (insert-for-yank-1 string))
+
+(defun insert-for-yank-1 (string)
+ "Insert STRING at point for the `yank' command.
+This function is like `insert', except it honors the variables
+`yank-handled-properties' and `yank-excluded-properties', and the
+`yank-handler' text property.
+
+Properties listed in `yank-handled-properties' are processed,
+then those listed in `yank-excluded-properties' are discarded.
+
+If STRING has a non-nil `yank-handler' property on its first
+character, the normal insert behavior is altered. The value of
+the `yank-handler' property must be a list of one to four
+elements, of the form (FUNCTION PARAM NOEXCLUDE UNDO).
+FUNCTION, if non-nil, should be a function of one argument, an
+ object to insert; it is called instead of `insert'.
+PARAM, if present and non-nil, replaces STRING as the argument to
+ FUNCTION or `insert'; e.g. if FUNCTION is `yank-rectangle', PARAM
+ may be a list of strings to insert as a rectangle.
+If NOEXCLUDE is present and non-nil, the normal removal of
+ `yank-excluded-properties' is not performed; instead FUNCTION is
+ responsible for the removal. This may be necessary if FUNCTION
+ adjusts point before or after inserting the object.
+UNDO, if present and non-nil, should be a function to be called
+ by `yank-pop' to undo the insertion of the current object. It is
+ given two arguments, the start and end of the region. FUNCTION
+ may set `yank-undo-function' to override UNDO."
+ (let* ((handler (and (stringp string)
+ (get-text-property 0 'yank-handler string)))
+ (param (or (nth 1 handler) string))
+ (opoint (point))
+ (inhibit-read-only inhibit-read-only)
+ end)
+
+ (setq yank-undo-function t)
+ (if (nth 0 handler) ; FUNCTION
+ (funcall (car handler) param)
+ (insert param))
+ (setq end (point))
+
+ ;; Prevent read-only properties from interfering with the
+ ;; following text property changes.
+ (setq inhibit-read-only t)
+
+ (unless (nth 2 handler) ; NOEXCLUDE
+ (remove-yank-excluded-properties opoint end))
+
+ ;; If last inserted char has properties, mark them as rear-nonsticky.
+ (if (and (> end opoint)
+ (text-properties-at (1- end)))
+ (put-text-property (1- end) end 'rear-nonsticky t))
+
+ (if (eq yank-undo-function t) ; not set by FUNCTION
+ (setq yank-undo-function (nth 3 handler))) ; UNDO
+ (if (nth 4 handler) ; COMMAND
+ (setq this-command (nth 4 handler)))))
+
+(defun insert-buffer-substring-no-properties (buffer &optional start end)
+ "Insert before point a substring of BUFFER, without text properties.
+BUFFER may be a buffer or a buffer name.
+Arguments START and END are character positions specifying the substring.
+They default to the values of (point-min) and (point-max) in BUFFER."
+ (let ((opoint (point)))
+ (insert-buffer-substring buffer start end)
+ (let ((inhibit-read-only t))
+ (set-text-properties opoint (point) nil))))
+
+(defun insert-buffer-substring-as-yank (buffer &optional start end)
+ "Insert before point a part of BUFFER, stripping some text properties.
+BUFFER may be a buffer or a buffer name.
+Arguments START and END are character positions specifying the substring.
+They default to the values of (point-min) and (point-max) in BUFFER.
+Before insertion, process text properties according to
+`yank-handled-properties' and `yank-excluded-properties'."
+ ;; Since the buffer text should not normally have yank-handler properties,
+ ;; there is no need to handle them here.
+ (let ((opoint (point)))
+ (insert-buffer-substring buffer start end)
+ (remove-yank-excluded-properties opoint (point))))
+
+(defun yank-handle-font-lock-face-property (face start end)
+ "If `font-lock-defaults' is nil, apply FACE as a `face' property.
+START and END denote the start and end of the text to act on.
+Do nothing if FACE is nil."
+ (and face
+ (null font-lock-defaults)
+ (put-text-property start end 'face face)))
+
+;; This removes `mouse-face' properties in *Help* buffer buttons:
+;; http://lists.gnu.org/archive/html/emacs-devel/2002-04/msg00648.html
+(defun yank-handle-category-property (category start end)
+ "Apply property category CATEGORY's properties between START and END."
+ (when category
+ (let ((start2 start))
+ (while (< start2 end)
+ (let ((end2 (next-property-change start2 nil end))
+ (original (text-properties-at start2)))
+ (set-text-properties start2 end2 (symbol-plist category))
+ (add-text-properties start2 end2 original)
+ (setq start2 end2))))))
+
+
+;;;; Synchronous shell commands.
+
+(defun start-process-shell-command (name buffer &rest args)
+ "Start a program in a subprocess. Return the process object for it.
+NAME is name for process. It is modified if necessary to make it unique.
+BUFFER is the buffer (or buffer name) to associate with the process.
+ Process output goes at end of that buffer, unless you specify
+ an output stream or filter function to handle the output.
+ BUFFER may be also nil, meaning that this process is not associated
+ with any buffer
+COMMAND is the shell command to run.
+
+An old calling convention accepted any number of arguments after COMMAND,
+which were just concatenated to COMMAND. This is still supported but strongly
+discouraged."
+ (declare (advertised-calling-convention (name buffer command) "23.1"))
+ ;; We used to use `exec' to replace the shell with the command,
+ ;; but that failed to handle (...) and semicolon, etc.
+ (start-process name buffer shell-file-name shell-command-switch
+ (mapconcat 'identity args " ")))
+
+(defun start-file-process-shell-command (name buffer &rest args)
+ "Start a program in a subprocess. Return the process object for it.
+Similar to `start-process-shell-command', but calls `start-file-process'."
+ (declare (advertised-calling-convention (name buffer command) "23.1"))
+ (start-file-process
+ name buffer
+ (if (file-remote-p default-directory) "/bin/sh" shell-file-name)
+ (if (file-remote-p default-directory) "-c" shell-command-switch)
+ (mapconcat 'identity args " ")))
+
+(defun call-process-shell-command (command &optional infile buffer display
+ &rest args)
+ "Execute the shell command COMMAND synchronously in separate process.
+The remaining arguments are optional.
+The program's input comes from file INFILE (nil means `/dev/null').
+Insert output in BUFFER before point; t means current buffer;
+ nil for BUFFER means discard it; 0 means discard and don't wait.
+BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
+REAL-BUFFER says what to do with standard output, as above,
+while STDERR-FILE says what to do with standard error in the child.
+STDERR-FILE may be nil (discard standard error output),
+t (mix it with ordinary output), or a file name string.
+
+Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.
+Wildcards and redirection are handled as usual in the shell.
+
+If BUFFER is 0, `call-process-shell-command' returns immediately with value
nil.
+Otherwise it waits for COMMAND to terminate and returns a numeric exit
+status or a signal description string.
+If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.
+
+An old calling convention accepted any number of arguments after DISPLAY,
+which were just concatenated to COMMAND. This is still supported but strongly
+discouraged."
+ (declare (advertised-calling-convention
+ (command &optional infile buffer display) "24.5"))
+ ;; We used to use `exec' to replace the shell with the command,
+ ;; but that failed to handle (...) and semicolon, etc.
+ (call-process shell-file-name
+ infile buffer display
+ shell-command-switch
+ (mapconcat 'identity (cons command args) " ")))
+
+(defun process-file-shell-command (command &optional infile buffer display
+ &rest args)
+ "Process files synchronously in a separate process.
+Similar to `call-process-shell-command', but calls `process-file'."
+ (declare (advertised-calling-convention
+ (command &optional infile buffer display) "24.5"))
+ (process-file
+ (if (file-remote-p default-directory) "/bin/sh" shell-file-name)
+ infile buffer display
+ (if (file-remote-p default-directory) "-c" shell-command-switch)
+ (mapconcat 'identity (cons command args) " ")))
+
+;;;; Lisp macros to do various things temporarily.
+
+(defmacro with-current-buffer (buffer-or-name &rest body)
+ "Execute the forms in BODY with BUFFER-OR-NAME temporarily current.
+BUFFER-OR-NAME must be a buffer or the name of an existing buffer.
+The value returned is the value of the last form in BODY. See
+also `with-temp-buffer'."
+ (declare (indent 1) (debug t))
+ `(save-current-buffer
+ (set-buffer ,buffer-or-name)
+ ,@body))
+
+(defun internal--before-with-selected-window (window)
+ (let ((other-frame (window-frame window)))
+ (list window (selected-window)
+ ;; Selecting a window on another frame also changes that
+ ;; frame's frame-selected-window. We must save&restore it.
+ (unless (eq (selected-frame) other-frame)
+ (frame-selected-window other-frame))
+ ;; Also remember the top-frame if on ttys.
+ (unless (eq (selected-frame) other-frame)
+ (tty-top-frame other-frame)))))
+
+(defun internal--after-with-selected-window (state)
+ ;; First reset frame-selected-window.
+ (when (window-live-p (nth 2 state))
+ ;; We don't use set-frame-selected-window because it does not
+ ;; pass the `norecord' argument to Fselect_window.
+ (select-window (nth 2 state) 'norecord)
+ (and (frame-live-p (nth 3 state))
+ (not (eq (tty-top-frame) (nth 3 state)))
+ (select-frame (nth 3 state) 'norecord)))
+ ;; Then reset the actual selected-window.
+ (when (window-live-p (nth 1 state))
+ (select-window (nth 1 state) 'norecord)))
+
+(defmacro with-selected-window (window &rest body)
+ "Execute the forms in BODY with WINDOW as the selected window.
+The value returned is the value of the last form in BODY.
+
+This macro saves and restores the selected window, as well as the
+selected window of each frame. It does not change the order of
+recently selected windows. If the previously selected window of
+some frame is no longer live at the end of BODY, that frame's
+selected window is left alone. If the selected window is no
+longer live, then whatever window is selected at the end of BODY
+remains selected.
+
+This macro uses `save-current-buffer' to save and restore the
+current buffer, since otherwise its normal operation could
+potentially make a different buffer current. It does not alter
+the buffer list ordering."
+ (declare (indent 1) (debug t))
+ `(let ((save-selected-window--state
+ (internal--before-with-selected-window ,window)))
+ (save-current-buffer
+ (unwind-protect
+ (progn (select-window (car save-selected-window--state) 'norecord)
+ ,@body)
+ (internal--after-with-selected-window save-selected-window--state)))))
+
+(defmacro with-selected-frame (frame &rest body)
+ "Execute the forms in BODY with FRAME as the selected frame.
+The value returned is the value of the last form in BODY.
+
+This macro saves and restores the selected frame, and changes the
+order of neither the recently selected windows nor the buffers in
+the buffer list."
+ (declare (indent 1) (debug t))
+ (let ((old-frame (make-symbol "old-frame"))
+ (old-buffer (make-symbol "old-buffer")))
+ `(let ((,old-frame (selected-frame))
+ (,old-buffer (current-buffer)))
+ (unwind-protect
+ (progn (select-frame ,frame 'norecord)
+ ,@body)
+ (when (frame-live-p ,old-frame)
+ (select-frame ,old-frame 'norecord))
+ (when (buffer-live-p ,old-buffer)
+ (set-buffer ,old-buffer))))))
+
+(defmacro save-window-excursion (&rest body)
+ "Execute BODY, then restore previous window configuration.
+This macro saves the window configuration on the selected frame,
+executes BODY, then calls `set-window-configuration' to restore
+the saved window configuration. The return value is the last
+form in BODY. The window configuration is also restored if BODY
+exits nonlocally.
+
+BEWARE: Most uses of this macro introduce bugs.
+E.g. it should not be used to try and prevent some code from opening
+a new window, since that window may sometimes appear in another frame,
+in which case `save-window-excursion' cannot help."
+ (declare (indent 0) (debug t))
+ (let ((c (make-symbol "wconfig")))
+ `(let ((,c (current-window-configuration)))
+ (unwind-protect (progn ,@body)
+ (set-window-configuration ,c)))))
+
+(defun internal-temp-output-buffer-show (buffer)
+ "Internal function for `with-output-to-temp-buffer'."
+ (with-current-buffer buffer
+ (set-buffer-modified-p nil)
+ (goto-char (point-min)))
+
+ (if temp-buffer-show-function
+ (funcall temp-buffer-show-function buffer)
+ (with-current-buffer buffer
+ (let* ((window
+ (let ((window-combination-limit
+ ;; When `window-combination-limit' equals
+ ;; `temp-buffer' or `temp-buffer-resize' and
+ ;; `temp-buffer-resize-mode' is enabled in this
+ ;; buffer bind it to t so resizing steals space
+ ;; preferably from the window that was split.
+ (if (or (eq window-combination-limit 'temp-buffer)
+ (and (eq window-combination-limit
+ 'temp-buffer-resize)
+ temp-buffer-resize-mode))
+ t
+ window-combination-limit)))
+ (display-buffer buffer)))
+ (frame (and window (window-frame window))))
+ (when window
+ (unless (eq frame (selected-frame))
+ (make-frame-visible frame))
+ (setq minibuffer-scroll-window window)
+ (set-window-hscroll window 0)
+ ;; Don't try this with NOFORCE non-nil!
+ (set-window-start window (point-min) t)
+ ;; This should not be necessary.
+ (set-window-point window (point-min))
+ ;; Run `temp-buffer-show-hook', with the chosen window selected.
+ (with-selected-window window
+ (run-hooks 'temp-buffer-show-hook))))))
+ ;; Return nil.
+ nil)
+
+;; Doc is very similar to with-temp-buffer-window.
+(defmacro with-output-to-temp-buffer (bufname &rest body)
+ "Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.
+
+This construct makes buffer BUFNAME empty before running BODY.
+It does not make the buffer current for BODY.
+Instead it binds `standard-output' to that buffer, so that output
+generated with `prin1' and similar functions in BODY goes into
+the buffer.
+
+At the end of BODY, this marks buffer BUFNAME unmodified and displays
+it in a window, but does not select it. The normal way to do this is
+by calling `display-buffer', then running `temp-buffer-show-hook'.
+However, if `temp-buffer-show-function' is non-nil, it calls that
+function instead (and does not run `temp-buffer-show-hook'). The
+function gets one argument, the buffer to display.
+
+The return value of `with-output-to-temp-buffer' is the value of the
+last form in BODY. If BODY does not finish normally, the buffer
+BUFNAME is not displayed.
+
+This runs the hook `temp-buffer-setup-hook' before BODY,
+with the buffer BUFNAME temporarily current. It runs the hook
+`temp-buffer-show-hook' after displaying buffer BUFNAME, with that
+buffer temporarily current, and the window that was used to display it
+temporarily selected. But it doesn't run `temp-buffer-show-hook'
+if it uses `temp-buffer-show-function'.
+
+By default, the setup hook puts the buffer into Help mode before running BODY.
+If BODY does not change the major mode, the show hook makes the buffer
+read-only, and scans it for function and variable names to make them into
+clickable cross-references.
+
+See the related form `with-temp-buffer-window'."
+ (declare (debug t))
+ (let ((old-dir (make-symbol "old-dir"))
+ (buf (make-symbol "buf")))
+ `(let* ((,old-dir default-directory)
+ (,buf
+ (with-current-buffer (get-buffer-create ,bufname)
+ (prog1 (current-buffer)
+ (kill-all-local-variables)
+ ;; FIXME: delete_all_overlays
+ (setq default-directory ,old-dir)
+ (setq buffer-read-only nil)
+ (setq buffer-file-name nil)
+ (setq buffer-undo-list t)
+ (let ((inhibit-read-only t)
+ (inhibit-modification-hooks t))
+ (erase-buffer)
+ (run-hooks 'temp-buffer-setup-hook)))))
+ (standard-output ,buf))
+ (prog1 (progn ,@body)
+ (internal-temp-output-buffer-show ,buf)))))
+
+(defmacro with-temp-file (file &rest body)
+ "Create a new buffer, evaluate BODY there, and write the buffer to FILE.
+The value returned is the value of the last form in BODY.
+See also `with-temp-buffer'."
+ (declare (indent 1) (debug t))
+ (let ((temp-file (make-symbol "temp-file"))
+ (temp-buffer (make-symbol "temp-buffer")))
+ `(let ((,temp-file ,file)
+ (,temp-buffer
+ (get-buffer-create (generate-new-buffer-name " *temp file*"))))
+ (unwind-protect
+ (prog1
+ (with-current-buffer ,temp-buffer
+ ,@body)
+ (with-current-buffer ,temp-buffer
+ (write-region nil nil ,temp-file nil 0)))
+ (and (buffer-name ,temp-buffer)
+ (kill-buffer ,temp-buffer))))))
+
+(defmacro with-temp-message (message &rest body)
+ "Display MESSAGE temporarily if non-nil while BODY is evaluated.
+The original message is restored to the echo area after BODY has finished.
+The value returned is the value of the last form in BODY.
+MESSAGE is written to the message log buffer if `message-log-max' is non-nil.
+If MESSAGE is nil, the echo area and message log buffer are unchanged.
+Use a MESSAGE of \"\" to temporarily clear the echo area."
+ (declare (debug t) (indent 1))
+ (let ((current-message (make-symbol "current-message"))
+ (temp-message (make-symbol "with-temp-message")))
+ `(let ((,temp-message ,message)
+ (,current-message))
+ (unwind-protect
+ (progn
+ (when ,temp-message
+ (setq ,current-message (current-message))
+ (message "%s" ,temp-message))
+ ,@body)
+ (and ,temp-message
+ (if ,current-message
+ (message "%s" ,current-message)
+ (message nil)))))))
+
+(defmacro with-temp-buffer (&rest body)
+ "Create a temporary buffer, and evaluate BODY there like `progn'.
+See also `with-temp-file' and `with-output-to-string'."
+ (declare (indent 0) (debug t))
+ (let ((temp-buffer (make-symbol "temp-buffer")))
+ `(let ((,temp-buffer (generate-new-buffer " *temp*")))
+ ;; FIXME: kill-buffer can change current-buffer in some odd cases.
+ (with-current-buffer ,temp-buffer
+ (unwind-protect
+ (progn ,@body)
+ (and (buffer-name ,temp-buffer)
+ (kill-buffer ,temp-buffer)))))))
+
+(defmacro with-silent-modifications (&rest body)
+ "Execute BODY, pretending it does not modify the buffer.
+If BODY performs real modifications to the buffer's text, other
+than cosmetic ones, undo data may become corrupted.
+
+This macro will run BODY normally, but doesn't count its buffer
+modifications as being buffer modifications. This affects things
+like `buffer-modified-p', checking whether the file is locked by
+someone else, running buffer modification hooks, and other things
+of that nature.
+
+Typically used around modifications of text-properties which do
+not really affect the buffer's content."
+ (declare (debug t) (indent 0))
+ (let ((modified (make-symbol "modified")))
+ `(let* ((,modified (buffer-modified-p))
+ (buffer-undo-list t)
+ (inhibit-read-only t)
+ (inhibit-modification-hooks t)
+ deactivate-mark
+ ;; Avoid setting and removing file locks and checking
+ ;; buffer's uptodate-ness w.r.t the underlying file.
+ buffer-file-name
+ buffer-file-truename)
+ (unwind-protect
+ (progn
+ ,@body)
+ (unless ,modified
+ (restore-buffer-modified-p nil))))))
+
+(defmacro with-output-to-string (&rest body)
+ "Execute BODY, return the text it sent to `standard-output', as a string."
+ (declare (indent 0) (debug t))
+ `(let ((standard-output
+ (get-buffer-create (generate-new-buffer-name " *string-output*"))))
+ (unwind-protect
+ (progn
+ (let ((standard-output standard-output))
+ ,@body)
+ (with-current-buffer standard-output
+ (buffer-string)))
+ (kill-buffer standard-output))))
+
+(defmacro with-local-quit (&rest body)
+ "Execute BODY, allowing quits to terminate BODY but not escape further.
+When a quit terminates BODY, `with-local-quit' returns nil but
+requests another quit. That quit will be processed as soon as quitting
+is allowed once again. (Immediately, if `inhibit-quit' is nil.)"
+ (declare (debug t) (indent 0))
+ `(condition-case nil
+ (let ((inhibit-quit nil))
+ ,@body)
+ (quit (setq quit-flag t)
+ ;; This call is to give a chance to handle quit-flag
+ ;; in case inhibit-quit is nil.
+ ;; Without this, it will not be handled until the next function
+ ;; call, and that might allow it to exit thru a condition-case
+ ;; that intends to handle the quit signal next time.
+ (eval '(ignore nil)))))
+
+(defmacro while-no-input (&rest body)
+ "Execute BODY only as long as there's no pending input.
+If input arrives, that ends the execution of BODY,
+and `while-no-input' returns t. Quitting makes it return nil.
+If BODY finishes, `while-no-input' returns whatever value BODY produced."
+ (declare (debug t) (indent 0))
+ (let ((catch-sym (make-symbol "input")))
+ `(with-local-quit
+ (catch ',catch-sym
+ (let ((throw-on-input ',catch-sym))
+ (or (input-pending-p)
+ (progn ,@body)))))))
+
+(defmacro condition-case-unless-debug (var bodyform &rest handlers)
+ "Like `condition-case' except that it does not prevent debugging.
+More specifically if `debug-on-error' is set then the debugger will be invoked
+even if this catches the signal."
+ (declare (debug condition-case) (indent 2))
+ `(condition-case ,var
+ ,bodyform
+ ,@(mapcar (lambda (handler)
+ `((debug ,@(if (listp (car handler)) (car handler)
+ (list (car handler))))
+ ,@(cdr handler)))
+ handlers)))
+
+(define-obsolete-function-alias 'condition-case-no-debug
+ 'condition-case-unless-debug "24.1")
+
+(defmacro with-demoted-errors (format &rest body)
+ "Run BODY and demote any errors to simple messages.
+FORMAT is a string passed to `message' to format any error message.
+It should contain a single %-sequence; e.g., \"Error: %S\".
+
+If `debug-on-error' is non-nil, run BODY without catching its errors.
+This is to be used around code which is not expected to signal an error
+but which should be robust in the unexpected case that an error is signaled.
+
+For backward compatibility, if FORMAT is not a constant string, it
+is assumed to be part of BODY, in which case the message format
+used is \"Error: %S\"."
+ (declare (debug t) (indent 1))
+ (let ((err (make-symbol "err"))
+ (format (if (and (stringp format) body) format
+ (prog1 "Error: %S"
+ (if format (push format body))))))
+ `(condition-case-unless-debug ,err
+ ,(macroexp-progn body)
+ (error (message ,format ,err) nil))))
+
+(defmacro combine-after-change-calls (&rest body)
+ "Execute BODY, but don't call the after-change functions till the end.
+If BODY makes changes in the buffer, they are recorded
+and the functions on `after-change-functions' are called several times
+when BODY is finished.
+The return value is the value of the last form in BODY.
+
+If `before-change-functions' is non-nil, then calls to the after-change
+functions can't be deferred, so in that case this macro has no effect.
+
+Do not alter `after-change-functions' or `before-change-functions'
+in BODY."
+ (declare (indent 0) (debug t))
+ `(unwind-protect
+ (let ((combine-after-change-calls t))
+ . ,body)
+ (combine-after-change-execute)))
+
+(defmacro with-case-table (table &rest body)
+ "Execute the forms in BODY with TABLE as the current case table.
+The value returned is the value of the last form in BODY."
+ (declare (indent 1) (debug t))
+ (let ((old-case-table (make-symbol "table"))
+ (old-buffer (make-symbol "buffer")))
+ `(let ((,old-case-table (current-case-table))
+ (,old-buffer (current-buffer)))
+ (unwind-protect
+ (progn (set-case-table ,table)
+ ,@body)
+ (with-current-buffer ,old-buffer
+ (set-case-table ,old-case-table))))))
+
+;;; Matching and match data.
+
+(defvar save-match-data-internal)
+
+;; We use save-match-data-internal as the local variable because
+;; that works ok in practice (people should not use that variable elsewhere).
+;; We used to use an uninterned symbol; the compiler handles that properly
+;; now, but it generates slower code.
+(defmacro save-match-data (&rest body)
+ "Execute the BODY forms, restoring the global value of the match data.
+The value returned is the value of the last form in BODY."
+ ;; It is better not to use backquote here,
+ ;; because that makes a bootstrapping problem
+ ;; if you need to recompile all the Lisp files using interpreted code.
+ (declare (indent 0) (debug t))
+ (list 'let
+ '((save-match-data-internal (match-data)))
+ (list 'unwind-protect
+ (cons 'progn body)
+ ;; It is safe to free (evaporate) markers immediately here,
+ ;; as Lisp programs should not copy from save-match-data-internal.
+ '(set-match-data save-match-data-internal 'evaporate))))
+
+(defun match-string (num &optional string)
+ "Return string of text matched by last search.
+NUM specifies which parenthesized expression in the last regexp.
+ Value is nil if NUMth pair didn't match, or there were less than NUM pairs.
+Zero means the entire text matched by the whole regexp or whole string.
+STRING should be given if the last search was by `string-match' on STRING.
+If STRING is nil, the current buffer should be the same buffer
+the search/match was performed in."
+ (if (match-beginning num)
+ (if string
+ (substring string (match-beginning num) (match-end num))
+ (buffer-substring (match-beginning num) (match-end num)))))
+
+(defun match-string-no-properties (num &optional string)
+ "Return string of text matched by last search, without text properties.
+NUM specifies which parenthesized expression in the last regexp.
+ Value is nil if NUMth pair didn't match, or there were less than NUM pairs.
+Zero means the entire text matched by the whole regexp or whole string.
+STRING should be given if the last search was by `string-match' on STRING.
+If STRING is nil, the current buffer should be the same buffer
+the search/match was performed in."
+ (if (match-beginning num)
+ (if string
+ (substring-no-properties string (match-beginning num)
+ (match-end num))
+ (buffer-substring-no-properties (match-beginning num)
+ (match-end num)))))
+
+
+(defun match-substitute-replacement (replacement
+ &optional fixedcase literal string subexp)
+ "Return REPLACEMENT as it will be inserted by `replace-match'.
+In other words, all back-references in the form `\\&' and `\\N'
+are substituted with actual strings matched by the last search.
+Optional FIXEDCASE, LITERAL, STRING and SUBEXP have the same
+meaning as for `replace-match'."
+ (let ((match (match-string 0 string)))
+ (save-match-data
+ (set-match-data (mapcar (lambda (x)
+ (if (numberp x)
+ (- x (match-beginning 0))
+ x))
+ (match-data t)))
+ (replace-match replacement fixedcase literal match subexp))))
+
+
+(defun looking-back (regexp &optional limit greedy)
+ "Return non-nil if text before point matches regular expression REGEXP.
+Like `looking-at' except matches before point, and is slower.
+LIMIT if non-nil speeds up the search by specifying a minimum
+starting position, to avoid checking matches that would start
+before LIMIT.
+
+If GREEDY is non-nil, extend the match backwards as far as
+possible, stopping when a single additional previous character
+cannot be part of a match for REGEXP. When the match is
+extended, its starting position is allowed to occur before
+LIMIT.
+
+As a general recommendation, try to avoid using `looking-back'
+wherever possible, since it is slow."
+ (let ((start (point))
+ (pos
+ (save-excursion
+ (and (re-search-backward (concat "\\(?:" regexp "\\)\\=") limit t)
+ (point)))))
+ (if (and greedy pos)
+ (save-restriction
+ (narrow-to-region (point-min) start)
+ (while (and (> pos (point-min))
+ (save-excursion
+ (goto-char pos)
+ (backward-char 1)
+ (looking-at (concat "\\(?:" regexp "\\)\\'"))))
+ (setq pos (1- pos)))
+ (save-excursion
+ (goto-char pos)
+ (looking-at (concat "\\(?:" regexp "\\)\\'")))))
+ (not (null pos))))
+
+(defsubst looking-at-p (regexp)
+ "\
+Same as `looking-at' except this function does not change the match data."
+ (let ((inhibit-changing-match-data t))
+ (looking-at regexp)))
+
+(defsubst string-match-p (regexp string &optional start)
+ "\
+Same as `string-match' except this function does not change the match data."
+ (let ((inhibit-changing-match-data t))
+ (string-match regexp string start)))
+
+(defun subregexp-context-p (regexp pos &optional start)
+ "Return non-nil if POS is in a normal subregexp context in REGEXP.
+A subregexp context is one where a sub-regexp can appear.
+A non-subregexp context is for example within brackets, or within a
+repetition bounds operator `\\=\\{...\\}', or right after a `\\'.
+If START is non-nil, it should be a position in REGEXP, smaller
+than POS, and known to be in a subregexp context."
+ ;; Here's one possible implementation, with the great benefit that it
+ ;; reuses the regexp-matcher's own parser, so it understands all the
+ ;; details of the syntax. A disadvantage is that it needs to match the
+ ;; error string.
+ (condition-case err
+ (progn
+ (string-match (substring regexp (or start 0) pos) "")
+ t)
+ (invalid-regexp
+ (not (member (cadr err) '("Unmatched [ or [^"
+ "Unmatched \\{"
+ "Trailing backslash")))))
+ ;; An alternative implementation:
+ ;; (defconst re-context-re
+ ;; (let* ((harmless-ch "[^\\[]")
+ ;; (harmless-esc "\\\\[^{]")
+ ;; (class-harmless-ch "[^][]")
+ ;; (class-lb-harmless "[^]:]")
+ ;; (class-lb-colon-maybe-charclass ":\\([a-z]+:]\\)?")
+ ;; (class-lb (concat "\\[\\(" class-lb-harmless
+ ;; "\\|" class-lb-colon-maybe-charclass "\\)"))
+ ;; (class
+ ;; (concat "\\[^?]?"
+ ;; "\\(" class-harmless-ch
+ ;; "\\|" class-lb "\\)*"
+ ;; "\\[?]")) ; special handling for bare [ at end of re
+ ;; (braces "\\\\{[0-9,]+\\\\}"))
+ ;; (concat "\\`\\(" harmless-ch "\\|" harmless-esc
+ ;; "\\|" class "\\|" braces "\\)*\\'"))
+ ;; "Matches any prefix that corresponds to a normal subregexp context.")
+ ;; (string-match re-context-re (substring regexp (or start 0) pos))
+ )
+
+;;;; split-string
+
+(defconst split-string-default-separators "[ \f\t\n\r\v]+"
+ "The default value of separators for `split-string'.
+
+A regexp matching strings of whitespace. May be locale-dependent
+\(as yet unimplemented). Should not match non-breaking spaces.
+
+Warning: binding this to a different value and using it as default is
+likely to have undesired semantics.")
+
+;; The specification says that if both SEPARATORS and OMIT-NULLS are
+;; defaulted, OMIT-NULLS should be treated as t. Simplifying the logical
+;; expression leads to the equivalent implementation that if SEPARATORS
+;; is defaulted, OMIT-NULLS is treated as t.
+(defun split-string (string &optional separators omit-nulls trim)
+ "Split STRING into substrings bounded by matches for SEPARATORS.
+
+The beginning and end of STRING, and each match for SEPARATORS, are
+splitting points. The substrings matching SEPARATORS are removed, and
+the substrings between the splitting points are collected as a list,
+which is returned.
+
+If SEPARATORS is non-nil, it should be a regular expression matching text
+which separates, but is not part of, the substrings. If nil it defaults to
+`split-string-default-separators', normally \"[ \\f\\t\\n\\r\\v]+\", and
+OMIT-NULLS is forced to t.
+
+If OMIT-NULLS is t, zero-length substrings are omitted from the list (so
+that for the default value of SEPARATORS leading and trailing whitespace
+are effectively trimmed). If nil, all zero-length substrings are retained,
+which correctly parses CSV format, for example.
+
+If TRIM is non-nil, it should be a regular expression to match
+text to trim from the beginning and end of each substring. If trimming
+makes the substring empty, it is treated as null.
+
+If you want to trim whitespace from the substrings, the reliably correct
+way is using TRIM. Making SEPARATORS match that whitespace gives incorrect
+results when there is whitespace at the start or end of STRING. If you
+see such calls to `split-string', please fix them.
+
+Note that the effect of `(split-string STRING)' is the same as
+`(split-string STRING split-string-default-separators t)'. In the rare
+case that you wish to retain zero-length substrings when splitting on
+whitespace, use `(split-string STRING split-string-default-separators)'.
+
+Modifies the match data; use `save-match-data' if necessary."
+ (let* ((keep-nulls (not (if separators omit-nulls t)))
+ (rexp (or separators split-string-default-separators))
+ (start 0)
+ this-start this-end
+ notfirst
+ (list nil)
+ (push-one
+ ;; Push the substring in range THIS-START to THIS-END
+ ;; onto LIST, trimming it and perhaps discarding it.
+ (lambda ()
+ (when trim
+ ;; Discard the trim from start of this substring.
+ (let ((tem (string-match trim string this-start)))
+ (and (eq tem this-start)
+ (setq this-start (match-end 0)))))
+
+ (when (or keep-nulls (< this-start this-end))
+ (let ((this (substring string this-start this-end)))
+
+ ;; Discard the trim from end of this substring.
+ (when trim
+ (let ((tem (string-match (concat trim "\\'") this 0)))
+ (and tem (< tem (length this))
+ (setq this (substring this 0 tem)))))
+
+ ;; Trimming could make it empty; check again.
+ (when (or keep-nulls (> (length this) 0))
+ (push this list)))))))
+
+ (while (and (string-match rexp string
+ (if (and notfirst
+ (= start (match-beginning 0))
+ (< start (length string)))
+ (1+ start) start))
+ (< start (length string)))
+ (setq notfirst t)
+ (setq this-start start this-end (match-beginning 0)
+ start (match-end 0))
+
+ (funcall push-one))
+
+ ;; Handle the substring at the end of STRING.
+ (setq this-start start this-end (length string))
+ (funcall push-one)
+
+ (nreverse list)))
+
+(defun combine-and-quote-strings (strings &optional separator)
+ "Concatenate the STRINGS, adding the SEPARATOR (default \" \").
+This tries to quote the strings to avoid ambiguity such that
+ (split-string-and-unquote (combine-and-quote-strings strs)) == strs
+Only some SEPARATORs will work properly."
+ (let* ((sep (or separator " "))
+ (re (concat "[\\\"]" "\\|" (regexp-quote sep))))
+ (mapconcat
+ (lambda (str)
+ (if (string-match re str)
+ (concat "\"" (replace-regexp-in-string "[\\\"]" "\\\\\\&" str) "\"")
+ str))
+ strings sep)))
+
+(defun split-string-and-unquote (string &optional separator)
+ "Split the STRING into a list of strings.
+It understands Emacs Lisp quoting within STRING, such that
+ (split-string-and-unquote (combine-and-quote-strings strs)) == strs
+The SEPARATOR regexp defaults to \"\\s-+\"."
+ (let ((sep (or separator "\\s-+"))
+ (i (string-match "\"" string)))
+ (if (null i)
+ (split-string string sep t) ; no quoting: easy
+ (append (unless (eq i 0) (split-string (substring string 0 i) sep t))
+ (let ((rfs (read-from-string string i)))
+ (cons (car rfs)
+ (split-string-and-unquote (substring string (cdr rfs))
+ sep)))))))
+
+
+;;;; Replacement in strings.
+
+(defun subst-char-in-string (fromchar tochar string &optional inplace)
+ "Replace FROMCHAR with TOCHAR in STRING each time it occurs.
+Unless optional argument INPLACE is non-nil, return a new string."
+ (let ((i (length string))
+ (newstr (if inplace string (copy-sequence string))))
+ (while (> i 0)
+ (setq i (1- i))
+ (if (eq (aref newstr i) fromchar)
+ (aset newstr i tochar)))
+ newstr))
+
+(defun replace-regexp-in-string (regexp rep string &optional
+ fixedcase literal subexp start)
+ "Replace all matches for REGEXP with REP in STRING.
+
+Return a new string containing the replacements.
+
+Optional arguments FIXEDCASE, LITERAL and SUBEXP are like the
+arguments with the same names of function `replace-match'. If START
+is non-nil, start replacements at that index in STRING.
+
+REP is either a string used as the NEWTEXT arg of `replace-match' or a
+function. If it is a function, it is called with the actual text of each
+match, and its value is used as the replacement text. When REP is called,
+the match data are the result of matching REGEXP against a substring
+of STRING.
+
+To replace only the first match (if any), make REGEXP match up to \\'
+and replace a sub-expression, e.g.
+ (replace-regexp-in-string \"\\\\(foo\\\\).*\\\\'\" \"bar\" \" foo foo\" nil
nil 1)
+ => \" bar foo\""
+
+ ;; To avoid excessive consing from multiple matches in long strings,
+ ;; don't just call `replace-match' continually. Walk down the
+ ;; string looking for matches of REGEXP and building up a (reversed)
+ ;; list MATCHES. This comprises segments of STRING which weren't
+ ;; matched interspersed with replacements for segments that were.
+ ;; [For a `large' number of replacements it's more efficient to
+ ;; operate in a temporary buffer; we can't tell from the function's
+ ;; args whether to choose the buffer-based implementation, though it
+ ;; might be reasonable to do so for long enough STRING.]
+ (let ((l (length string))
+ (start (or start 0))
+ matches str mb me)
+ (save-match-data
+ (while (and (< start l) (string-match regexp string start))
+ (setq mb (match-beginning 0)
+ me (match-end 0))
+ ;; If we matched the empty string, make sure we advance by one char
+ (when (= me mb) (setq me (min l (1+ mb))))
+ ;; Generate a replacement for the matched substring.
+ ;; Operate only on the substring to minimize string consing.
+ ;; Set up match data for the substring for replacement;
+ ;; presumably this is likely to be faster than munging the
+ ;; match data directly in Lisp.
+ (string-match regexp (setq str (substring string mb me)))
+ (setq matches
+ (cons (replace-match (if (stringp rep)
+ rep
+ (funcall rep (match-string 0 str)))
+ fixedcase literal str subexp)
+ (cons (substring string start mb) ; unmatched prefix
+ matches)))
+ (setq start me))
+ ;; Reconstruct a string from the pieces.
+ (setq matches (cons (substring string start l) matches)) ; leftover
+ (apply #'concat (nreverse matches)))))
+
+(defun string-prefix-p (str1 str2 &optional ignore-case)
+ "Return non-nil if STR1 is a prefix of STR2.
+If IGNORE-CASE is non-nil, the comparison is done without paying attention
+to case differences."
+ (eq t (compare-strings str1 nil nil
+ str2 0 (length str1) ignore-case)))
+
+(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)))))
+
+(defun bidi-string-mark-left-to-right (str)
+ "Return a string that can be safely inserted in left-to-right text.
+
+Normally, inserting a string with right-to-left (RTL) script into
+a buffer may cause some subsequent text to be displayed as part
+of the RTL segment (usually this affects punctuation characters).
+This function returns a string which displays as STR but forces
+subsequent text to be displayed as left-to-right.
+
+If STR contains any RTL character, this function returns a string
+consisting of STR followed by an invisible left-to-right mark
+\(LRM) character. Otherwise, it returns STR."
+ (unless (stringp str)
+ (signal 'wrong-type-argument (list 'stringp str)))
+ (if (string-match "\\cR" str)
+ (concat str (propertize (string ?\x200e) 'invisible t))
+ str))
+
+;;;; Specifying things to do later.
+
+(defun load-history-regexp (file)
+ "Form a regexp to find FILE in `load-history'.
+FILE, a string, is described in the function `eval-after-load'."
+ (if (file-name-absolute-p file)
+ (setq file (file-truename file)))
+ (concat (if (file-name-absolute-p file) "\\`" "\\(\\`\\|/\\)")
+ (regexp-quote file)
+ (if (file-name-extension file)
+ ""
+ ;; Note: regexp-opt can't be used here, since we need to call
+ ;; this before Emacs has been fully started. 2006-05-21
+ (concat "\\(" (mapconcat 'regexp-quote load-suffixes "\\|") "\\)?"))
+ "\\(" (mapconcat 'regexp-quote jka-compr-load-suffixes "\\|")
+ "\\)?\\'"))
+
+(defun load-history-filename-element (file-regexp)
+ "Get the first elt of `load-history' whose car matches FILE-REGEXP.
+Return nil if there isn't one."
+ (let* ((loads load-history)
+ (load-elt (and loads (car loads))))
+ (save-match-data
+ (while (and loads
+ (or (null (car load-elt))
+ (not (string-match file-regexp (car load-elt)))))
+ (setq loads (cdr loads)
+ load-elt (and loads (car loads)))))
+ load-elt))
+
+(put 'eval-after-load 'lisp-indent-function 1)
+(defun eval-after-load (file form)
+ "Arrange that if FILE is loaded, FORM will be run immediately afterwards.
+If FILE is already loaded, evaluate FORM right now.
+FORM can be an Elisp expression (in which case it's passed to `eval'),
+or a function (in which case it's passed to `funcall' with no argument).
+
+If a matching file is loaded again, FORM will be evaluated again.
+
+If FILE is a string, it may be either an absolute or a relative file
+name, and may have an extension (e.g. \".el\") or may lack one, and
+additionally may or may not have an extension denoting a compressed
+format (e.g. \".gz\").
+
+When FILE is absolute, this first converts it to a true name by chasing
+symbolic links. Only a file of this name (see next paragraph regarding
+extensions) will trigger the evaluation of FORM. When FILE is relative,
+a file whose absolute true name ends in FILE will trigger evaluation.
+
+When FILE lacks an extension, a file name with any extension will trigger
+evaluation. Otherwise, its extension must match FILE's. A further
+extension for a compressed format (e.g. \".gz\") on FILE will not affect
+this name matching.
+
+Alternatively, FILE can be a feature (i.e. a symbol), in which case FORM
+is evaluated at the end of any file that `provide's this feature.
+If the feature is provided when evaluating code not associated with a
+file, FORM is evaluated immediately after the provide statement.
+
+Usually FILE is just a library name like \"font-lock\" or a feature name
+like 'font-lock.
+
+This function makes or adds to an entry on `after-load-alist'."
+ (declare (compiler-macro
+ (lambda (whole)
+ (if (eq 'quote (car-safe form))
+ ;; Quote with lambda so the compiler can look inside.
+ `(eval-after-load ,file (lambda () ,(nth 1 form)))
+ whole))))
+ ;; Add this FORM into after-load-alist (regardless of whether we'll be
+ ;; evaluating it now).
+ (let* ((regexp-or-feature
+ (if (stringp file)
+ (setq file (purecopy (load-history-regexp file)))
+ file))
+ (elt (assoc regexp-or-feature after-load-alist))
+ (func
+ (if (functionp form) form
+ ;; Try to use the "current" lexical/dynamic mode for `form'.
+ (eval `(lambda () ,form) lexical-binding))))
+ (unless elt
+ (setq elt (list regexp-or-feature))
+ (push elt after-load-alist))
+ ;; Is there an already loaded file whose name (or `provide' name)
+ ;; matches FILE?
+ (prog1 (if (if (stringp file)
+ (load-history-filename-element regexp-or-feature)
+ (featurep file))
+ (funcall func))
+ (let ((delayed-func
+ (if (not (symbolp regexp-or-feature)) func
+ ;; For features, the after-load-alist elements get run when
+ ;; `provide' is called rather than at the end of the file.
+ ;; So add an indirection to make sure that `func' is really run
+ ;; "after-load" in case the provide call happens early.
+ (lambda ()
+ (if (not load-file-name)
+ ;; Not being provided from a file, run func right now.
+ (funcall func)
+ (let ((lfn load-file-name)
+ ;; Don't use letrec, because equal (in
+ ;; add/remove-hook) would get trapped in a cycle.
+ (fun (make-symbol "eval-after-load-helper")))
+ (fset fun (lambda (file)
+ (when (equal file lfn)
+ (remove-hook 'after-load-functions fun)
+ (funcall func))))
+ (add-hook 'after-load-functions fun 'append)))))))
+ ;; Add FORM to the element unless it's already there.
+ (unless (member delayed-func (cdr elt))
+ (nconc elt (list delayed-func)))))))
+
+(defmacro with-eval-after-load (file &rest body)
+ "Execute BODY after FILE is loaded.
+FILE is normally a feature name, but it can also be a file name,
+in case that file does not provide any feature."
+ (declare (indent 1) (debug t))
+ `(eval-after-load ,file (lambda () ,@body)))
+
+(defvar after-load-functions nil
+ "Special hook run after loading a file.
+Each function there is called with a single argument, the absolute
+name of the file just loaded.")
+
+(defun do-after-load-evaluation (abs-file)
+ "Evaluate all `eval-after-load' forms, if any, for ABS-FILE.
+ABS-FILE, a string, should be the absolute true name of a file just loaded.
+This function is called directly from the C code."
+ ;; Run the relevant eval-after-load forms.
+ (dolist (a-l-element after-load-alist)
+ (when (and (stringp (car a-l-element))
+ (string-match-p (car a-l-element) abs-file))
+ ;; discard the file name regexp
+ (mapc #'funcall (cdr a-l-element))))
+ ;; Complain when the user uses obsolete files.
+ (when (string-match-p "/obsolete/[^/]*\\'" abs-file)
+ ;; Maybe we should just use display-warning? This seems yucky...
+ (let* ((file (file-name-nondirectory abs-file))
+ (msg (format "Package %s is obsolete!"
+ (substring file 0
+ (string-match "\\.elc?\\>" file)))))
+ ;; Cribbed from cl--compiling-file.
+ (if (and (boundp 'byte-compile--outbuffer)
+ (bufferp (symbol-value 'byte-compile--outbuffer))
+ (equal (buffer-name (symbol-value 'byte-compile--outbuffer))
+ " *Compiler Output*"))
+ ;; Don't warn about obsolete files using other obsolete files.
+ (unless (and (stringp byte-compile-current-file)
+ (string-match-p "/obsolete/[^/]*\\'"
+ (expand-file-name
+ byte-compile-current-file
+ byte-compile-root-dir)))
+ (byte-compile-log-warning msg))
+ (run-with-timer 0 nil
+ (lambda (msg)
+ (message "%s" msg)) msg))))
+
+ ;; Finally, run any other hook.
+ (run-hook-with-args 'after-load-functions abs-file))
+
+(defun eval-next-after-load (file)
+ "Read the following input sexp, and run it whenever FILE is loaded.
+This makes or adds to an entry on `after-load-alist'.
+FILE should be the name of a library, with no directory name."
+ (declare (obsolete eval-after-load "23.2"))
+ (eval-after-load file (read)))
+
+
+(defun display-delayed-warnings ()
+ "Display delayed warnings from `delayed-warnings-list'.
+Used from `delayed-warnings-hook' (which see)."
+ (dolist (warning (nreverse delayed-warnings-list))
+ (apply 'display-warning warning))
+ (setq delayed-warnings-list nil))
+
+(defun collapse-delayed-warnings ()
+ "Remove duplicates from `delayed-warnings-list'.
+Collapse identical adjacent warnings into one (plus count).
+Used from `delayed-warnings-hook' (which see)."
+ (let ((count 1)
+ collapsed warning)
+ (while delayed-warnings-list
+ (setq warning (pop delayed-warnings-list))
+ (if (equal warning (car delayed-warnings-list))
+ (setq count (1+ count))
+ (when (> count 1)
+ (setcdr warning (cons (format "%s [%d times]" (cadr warning) count)
+ (cddr warning)))
+ (setq count 1))
+ (push warning collapsed)))
+ (setq delayed-warnings-list (nreverse collapsed))))
+
+;; At present this is only used for Emacs internals.
+;; Ref http://lists.gnu.org/archive/html/emacs-devel/2012-02/msg00085.html
+(defvar delayed-warnings-hook '(collapse-delayed-warnings
+ display-delayed-warnings)
+ "Normal hook run to process and display delayed warnings.
+By default, this hook contains functions to consolidate the
+warnings listed in `delayed-warnings-list', display them, and set
+`delayed-warnings-list' back to nil.")
+
+(defun delay-warning (type message &optional level buffer-name)
+ "Display a delayed warning.
+Aside from going through `delayed-warnings-list', this is equivalent
+to `display-warning'."
+ (push (list type message level buffer-name) delayed-warnings-list))
+
+
+;;;; invisibility specs
+
+(defun add-to-invisibility-spec (element)
+ "Add ELEMENT to `buffer-invisibility-spec'.
+See documentation for `buffer-invisibility-spec' for the kind of elements
+that can be added."
+ (if (eq buffer-invisibility-spec t)
+ (setq buffer-invisibility-spec (list t)))
+ (setq buffer-invisibility-spec
+ (cons element buffer-invisibility-spec)))
+
+(defun remove-from-invisibility-spec (element)
+ "Remove ELEMENT from `buffer-invisibility-spec'."
+ (if (consp buffer-invisibility-spec)
+ (setq buffer-invisibility-spec
+ (delete element buffer-invisibility-spec))))
+
+;;;; Syntax tables.
+
+(defmacro with-syntax-table (table &rest body)
+ "Evaluate BODY with syntax table of current buffer set to TABLE.
+The syntax table of the current buffer is saved, BODY is evaluated, and the
+saved table is restored, even in case of an abnormal exit.
+Value is what BODY returns."
+ (declare (debug t) (indent 1))
+ (let ((old-table (make-symbol "table"))
+ (old-buffer (make-symbol "buffer")))
+ `(let ((,old-table (syntax-table))
+ (,old-buffer (current-buffer)))
+ (unwind-protect
+ (progn
+ (set-syntax-table ,table)
+ ,@body)
+ (save-current-buffer
+ (set-buffer ,old-buffer)
+ (set-syntax-table ,old-table))))))
+
+(defun make-syntax-table (&optional oldtable)
+ "Return a new syntax table.
+Create a syntax table which inherits from OLDTABLE (if non-nil) or
+from `standard-syntax-table' otherwise."
+ (let ((table (make-char-table 'syntax-table nil)))
+ (set-char-table-parent table (or oldtable (standard-syntax-table)))
+ table))
+
+(defun syntax-after (pos)
+ "Return the raw syntax descriptor for the char after POS.
+If POS is outside the buffer's accessible portion, return nil."
+ (unless (or (< pos (point-min)) (>= pos (point-max)))
+ (let ((st (if parse-sexp-lookup-properties
+ (get-char-property pos 'syntax-table))))
+ (if (consp st) st
+ (aref (or st (syntax-table)) (char-after pos))))))
+
+(defun syntax-class (syntax)
+ "Return the code for the syntax class described by SYNTAX.
+
+SYNTAX should be a raw syntax descriptor; the return value is a
+integer which encodes the corresponding syntax class. See Info
+node `(elisp)Syntax Table Internals' for a list of codes.
+
+If SYNTAX is nil, return nil."
+ (and syntax (logand (car syntax) 65535)))
+
+;; Utility motion commands
+
+;; Whitespace
+
+(defun forward-whitespace (arg)
+ "Move point to the end of the next sequence of whitespace chars.
+Each such sequence may be a single newline, or a sequence of
+consecutive space and/or tab characters.
+With prefix argument ARG, do it ARG times if positive, or move
+backwards ARG times if negative."
+ (interactive "^p")
+ (if (natnump arg)
+ (re-search-forward "[ \t]+\\|\n" nil 'move arg)
+ (while (< arg 0)
+ (if (re-search-backward "[ \t]+\\|\n" nil 'move)
+ (or (eq (char-after (match-beginning 0)) ?\n)
+ (skip-chars-backward " \t")))
+ (setq arg (1+ arg)))))
+
+;; Symbols
+
+(defun forward-symbol (arg)
+ "Move point to the next position that is the end of a symbol.
+A symbol is any sequence of characters that are in either the
+word constituent or symbol constituent syntax class.
+With prefix argument ARG, do it ARG times if positive, or move
+backwards ARG times if negative."
+ (interactive "^p")
+ (if (natnump arg)
+ (re-search-forward "\\(\\sw\\|\\s_\\)+" nil 'move arg)
+ (while (< arg 0)
+ (if (re-search-backward "\\(\\sw\\|\\s_\\)+" nil 'move)
+ (skip-syntax-backward "w_"))
+ (setq arg (1+ arg)))))
+
+;; Syntax blocks
+
+(defun forward-same-syntax (&optional arg)
+ "Move point past all characters with the same syntax class.
+With prefix argument ARG, do it ARG times if positive, or move
+backwards ARG times if negative."
+ (interactive "^p")
+ (or arg (setq arg 1))
+ (while (< arg 0)
+ (skip-syntax-backward
+ (char-to-string (char-syntax (char-before))))
+ (setq arg (1+ arg)))
+ (while (> arg 0)
+ (skip-syntax-forward (char-to-string (char-syntax (char-after))))
+ (setq arg (1- arg))))
+
+
+;;;; Text clones
+
+(defvar text-clone--maintaining nil)
+
+(defun text-clone--maintain (ol1 after beg end &optional _len)
+ "Propagate the changes made under the overlay OL1 to the other clones.
+This is used on the `modification-hooks' property of text clones."
+ (when (and after (not undo-in-progress)
+ (not text-clone--maintaining)
+ (overlay-start ol1))
+ (let ((margin (if (overlay-get ol1 'text-clone-spreadp) 1 0)))
+ (setq beg (max beg (+ (overlay-start ol1) margin)))
+ (setq end (min end (- (overlay-end ol1) margin)))
+ (when (<= beg end)
+ (save-excursion
+ (when (overlay-get ol1 'text-clone-syntax)
+ ;; Check content of the clone's text.
+ (let ((cbeg (+ (overlay-start ol1) margin))
+ (cend (- (overlay-end ol1) margin)))
+ (goto-char cbeg)
+ (save-match-data
+ (if (not (re-search-forward
+ (overlay-get ol1 'text-clone-syntax) cend t))
+ ;; Mark the overlay for deletion.
+ (setq end cbeg)
+ (when (< (match-end 0) cend)
+ ;; Shrink the clone at its end.
+ (setq end (min end (match-end 0)))
+ (move-overlay ol1 (overlay-start ol1)
+ (+ (match-end 0) margin)))
+ (when (> (match-beginning 0) cbeg)
+ ;; Shrink the clone at its beginning.
+ (setq beg (max (match-beginning 0) beg))
+ (move-overlay ol1 (- (match-beginning 0) margin)
+ (overlay-end ol1)))))))
+ ;; Now go ahead and update the clones.
+ (let ((head (- beg (overlay-start ol1)))
+ (tail (- (overlay-end ol1) end))
+ (str (buffer-substring beg end))
+ (nothing-left t)
+ (text-clone--maintaining t))
+ (dolist (ol2 (overlay-get ol1 'text-clones))
+ (let ((oe (overlay-end ol2)))
+ (unless (or (eq ol1 ol2) (null oe))
+ (setq nothing-left nil)
+ (let ((mod-beg (+ (overlay-start ol2) head)))
+ ;;(overlay-put ol2 'modification-hooks nil)
+ (goto-char (- (overlay-end ol2) tail))
+ (unless (> mod-beg (point))
+ (save-excursion (insert str))
+ (delete-region mod-beg (point)))
+ ;;(overlay-put ol2 'modification-hooks
'(text-clone--maintain))
+ ))))
+ (if nothing-left (delete-overlay ol1))))))))
+
+(defun text-clone-create (start end &optional spreadp syntax)
+ "Create a text clone of START...END at point.
+Text clones are chunks of text that are automatically kept identical:
+changes done to one of the clones will be immediately propagated to the other.
+
+The buffer's content at point is assumed to be already identical to
+the one between START and END.
+If SYNTAX is provided it's a regexp that describes the possible text of
+the clones; the clone will be shrunk or killed if necessary to ensure that
+its text matches the regexp.
+If SPREADP is non-nil it indicates that text inserted before/after the
+clone should be incorporated in the clone."
+ ;; To deal with SPREADP we can either use an overlay with `nil t' along
+ ;; with insert-(behind|in-front-of)-hooks or use a slightly larger overlay
+ ;; (with a one-char margin at each end) with `t nil'.
+ ;; We opted for a larger overlay because it behaves better in the case
+ ;; where the clone is reduced to the empty string (we want the overlay to
+ ;; stay when the clone's content is the empty string and we want to use
+ ;; `evaporate' to make sure those overlays get deleted when needed).
+ ;;
+ (let* ((pt-end (+ (point) (- end start)))
+ (start-margin (if (or (not spreadp) (bobp) (<= start (point-min)))
+ 0 1))
+ (end-margin (if (or (not spreadp)
+ (>= pt-end (point-max))
+ (>= start (point-max)))
+ 0 1))
+ ;; FIXME: Reuse overlays at point to extend dups!
+ (ol1 (make-overlay (- start start-margin) (+ end end-margin) nil t))
+ (ol2 (make-overlay (- (point) start-margin) (+ pt-end end-margin) nil
t))
+ (dups (list ol1 ol2)))
+ (overlay-put ol1 'modification-hooks '(text-clone--maintain))
+ (when spreadp (overlay-put ol1 'text-clone-spreadp t))
+ (when syntax (overlay-put ol1 'text-clone-syntax syntax))
+ ;;(overlay-put ol1 'face 'underline)
+ (overlay-put ol1 'evaporate t)
+ (overlay-put ol1 'text-clones dups)
+ ;;
+ (overlay-put ol2 'modification-hooks '(text-clone--maintain))
+ (when spreadp (overlay-put ol2 'text-clone-spreadp t))
+ (when syntax (overlay-put ol2 'text-clone-syntax syntax))
+ ;;(overlay-put ol2 'face 'underline)
+ (overlay-put ol2 'evaporate t)
+ (overlay-put ol2 'text-clones dups)))
+
+;;;; Mail user agents.
+
+;; Here we include just enough for other packages to be able
+;; to define them.
+
+(defun define-mail-user-agent (symbol composefunc sendfunc
+ &optional abortfunc hookvar)
+ "Define a symbol to identify a mail-sending package for `mail-user-agent'.
+
+SYMBOL can be any Lisp symbol. Its function definition and/or
+value as a variable do not matter for this usage; we use only certain
+properties on its property list, to encode the rest of the arguments.
+
+COMPOSEFUNC is program callable function that composes an outgoing
+mail message buffer. This function should set up the basics of the
+buffer without requiring user interaction. It should populate the
+standard mail headers, leaving the `to:' and `subject:' headers blank
+by default.
+
+COMPOSEFUNC should accept several optional arguments--the same
+arguments that `compose-mail' takes. See that function's documentation.
+
+SENDFUNC is the command a user would run to send the message.
+
+Optional ABORTFUNC is the command a user would run to abort the
+message. For mail packages that don't have a separate abort function,
+this can be `kill-buffer' (the equivalent of omitting this argument).
+
+Optional HOOKVAR is a hook variable that gets run before the message
+is actually sent. Callers that use the `mail-user-agent' may
+install a hook function temporarily on this hook variable.
+If HOOKVAR is nil, `mail-send-hook' is used.
+
+The properties used on SYMBOL are `composefunc', `sendfunc',
+`abortfunc', and `hookvar'."
+ (put symbol 'composefunc composefunc)
+ (put symbol 'sendfunc sendfunc)
+ (put symbol 'abortfunc (or abortfunc 'kill-buffer))
+ (put symbol 'hookvar (or hookvar 'mail-send-hook)))
+
+(defvar called-interactively-p-functions nil
+ "Special hook called to skip special frames in `called-interactively-p'.
+The functions are called with 3 arguments: (I FRAME1 FRAME2),
+where FRAME1 is a \"current frame\", FRAME2 is the next frame,
+I is the index of the frame after FRAME2. It should return nil
+if those frames don't seem special and otherwise, it should return
+the number of frames to skip (minus 1).")
+
+(defconst internal--call-interactively (symbol-function 'call-interactively))
+
+(defun called-interactively-p (&optional kind)
+ "Return t if the containing function was called by `call-interactively'.
+If KIND is `interactive', then only return t if the call was made
+interactively by the user, i.e. not in `noninteractive' mode nor
+when `executing-kbd-macro'.
+If KIND is `any', on the other hand, it will return t for any kind of
+interactive call, including being called as the binding of a key or
+from a keyboard macro, even in `noninteractive' mode.
+
+This function is very brittle, it may fail to return the intended result when
+the code is debugged, advised, or instrumented in some form. Some macros and
+special forms (such as `condition-case') may also sometimes wrap their bodies
+in a `lambda', so any call to `called-interactively-p' from those bodies will
+indicate whether that lambda (rather than the surrounding function) was called
+interactively.
+
+Instead of using this function, it is cleaner and more reliable to give your
+function an extra optional argument whose `interactive' spec specifies
+non-nil unconditionally (\"p\" is a good way to do this), or via
+\(not (or executing-kbd-macro noninteractive)).
+
+The only known proper use of `interactive' for KIND is in deciding
+whether to display a helpful message, or how to display it. If you're
+thinking of using it for any other purpose, it is quite likely that
+you're making a mistake. Think: what do you want to do when the
+command is called from a keyboard macro?"
+ (declare (advertised-calling-convention (kind) "23.1"))
+ (when (not (and (eq kind 'interactive)
+ (or executing-kbd-macro noninteractive)))
+ (let* ((i 1) ;; 0 is the called-interactively-p frame.
+ frame nextframe
+ (get-next-frame
+ (lambda ()
+ (setq frame nextframe)
+ (setq nextframe (backtrace-frame i 'called-interactively-p))
+ ;; (message "Frame %d = %S" i nextframe)
+ (setq i (1+ i)))))
+ (funcall get-next-frame) ;; Get the first frame.
+ (while
+ ;; FIXME: The edebug and advice handling should be made modular and
+ ;; provided directly by edebug.el and nadvice.el.
+ (progn
+ ;; frame =(backtrace-frame i-2)
+ ;; nextframe=(backtrace-frame i-1)
+ (funcall get-next-frame)
+ ;; `pcase' would be a fairly good fit here, but it sometimes moves
+ ;; branches within local functions, which then messes up the
+ ;; `backtrace-frame' data we get,
+ (or
+ ;; Skip special forms (from non-compiled code).
+ (and frame (null (car frame)))
+ ;; Skip also `interactive-p' (because we don't want to know if
+ ;; interactive-p was called interactively but if it's caller was)
+ ;; and `byte-code' (idem; this appears in subexpressions of things
+ ;; like condition-case, which are wrapped in a separate bytecode
+ ;; chunk).
+ ;; FIXME: For lexical-binding code, this is much worse,
+ ;; because the frames look like "byte-code -> funcall -> #[...]",
+ ;; which is not a reliable signature.
+ (memq (nth 1 frame) '(interactive-p 'byte-code))
+ ;; Skip package-specific stack-frames.
+ (let ((skip (run-hook-with-args-until-success
+ 'called-interactively-p-functions
+ i frame nextframe)))
+ (pcase skip
+ (`nil nil)
+ (`0 t)
+ (_ (setq i (+ i skip -1)) (funcall get-next-frame)))))))
+ ;; Now `frame' should be "the function from which we were called".
+ (pcase (cons frame nextframe)
+ ;; No subr calls `interactive-p', so we can rule that out.
+ (`((,_ ,(pred (lambda (f) (subrp (indirect-function f)))) . ,_) . ,_)
nil)
+ ;; In case #<subr call-interactively> without going through the
+ ;; `call-interactively' symbol (bug#3984).
+ (`(,_ . (t ,(pred (eq internal--call-interactively)) . ,_)) t)
+ (`(,_ . (t call-interactively . ,_)) t)))))
+
+(defun interactive-p ()
+ "Return t if the containing function was run directly by user input.
+This means that the function was called with `call-interactively'
+\(which includes being called as the binding of a key)
+and input is currently coming from the keyboard (not a keyboard macro),
+and Emacs is not running in batch mode (`noninteractive' is nil).
+
+The only known proper use of `interactive-p' is in deciding whether to
+display a helpful message, or how to display it. If you're thinking
+of using it for any other purpose, it is quite likely that you're
+making a mistake. Think: what do you want to do when the command is
+called from a keyboard macro or in batch mode?
+
+To test whether your function was called with `call-interactively',
+either (i) add an extra optional argument and give it an `interactive'
+spec that specifies non-nil unconditionally (such as \"p\"); or (ii)
+use `called-interactively-p'."
+ (declare (obsolete called-interactively-p "23.2"))
+ (called-interactively-p 'interactive))
+
+(defun internal-push-keymap (keymap symbol)
+ (let ((map (symbol-value symbol)))
+ (unless (memq keymap map)
+ (unless (memq 'add-keymap-witness (symbol-value symbol))
+ (setq map (make-composed-keymap nil (symbol-value symbol)))
+ (push 'add-keymap-witness (cdr map))
+ (set symbol map))
+ (push keymap (cdr map)))))
+
+(defun internal-pop-keymap (keymap symbol)
+ (let ((map (symbol-value symbol)))
+ (when (memq keymap map)
+ (setf (cdr map) (delq keymap (cdr map))))
+ (let ((tail (cddr map)))
+ (and (or (null tail) (keymapp tail))
+ (eq 'add-keymap-witness (nth 1 map))
+ (set symbol tail)))))
+
+(define-obsolete-function-alias
+ 'set-temporary-overlay-map 'set-transient-map "24.4")
+
+(defun set-transient-map (map &optional keep-pred on-exit)
+ "Set MAP as a temporary keymap taking precedence over other keymaps.
+Normally, MAP is used only once, to look up the very next key.
+However, if the optional argument KEEP-PRED is t, MAP stays
+active if a key from MAP is used. KEEP-PRED can also be a
+function of no arguments: if it returns non-nil, then MAP stays
+active.
+
+Optional arg ON-EXIT, if non-nil, specifies a function that is
+called, with no arguments, after MAP is deactivated.
+
+This uses `overriding-terminal-local-map' which takes precedence over all other
+keymaps. As usual, if no match for a key is found in MAP, the normal key
+lookup sequence then continues."
+ (let ((clearfun (make-symbol "clear-transient-map")))
+ ;; Don't use letrec, because equal (in add/remove-hook) would get trapped
+ ;; in a cycle.
+ (fset clearfun
+ (lambda ()
+ (with-demoted-errors "set-transient-map PCH: %S"
+ (unless (cond
+ ((null keep-pred) nil)
+ ((not (eq map (cadr overriding-terminal-local-map)))
+ ;; There's presumably some other transient-map in
+ ;; effect. Wait for that one to terminate before we
+ ;; remove ourselves.
+ ;; For example, if isearch and C-u both use transient
+ ;; maps, then the lifetime of the C-u should be nested
+ ;; within isearch's, so the pre-command-hook of
+ ;; isearch should be suspended during the C-u one so
+ ;; we don't exit isearch just because we hit 1 after
+ ;; C-u and that 1 exits isearch whereas it doesn't
+ ;; exit C-u.
+ t)
+ ((eq t keep-pred)
+ (eq this-command
+ (lookup-key map (this-command-keys-vector))))
+ (t (funcall keep-pred)))
+ (internal-pop-keymap map 'overriding-terminal-local-map)
+ (remove-hook 'pre-command-hook clearfun)
+ (when on-exit (funcall on-exit))))))
+ (add-hook 'pre-command-hook clearfun)
+ (internal-push-keymap map 'overriding-terminal-local-map)))
+
+;;;; Progress reporters.
+
+;; Progress reporter has the following structure:
+;;
+;; (NEXT-UPDATE-VALUE . [NEXT-UPDATE-TIME
+;; MIN-VALUE
+;; MAX-VALUE
+;; MESSAGE
+;; MIN-CHANGE
+;; MIN-TIME])
+;;
+;; This weirdness is for optimization reasons: we want
+;; `progress-reporter-update' to be as fast as possible, so
+;; `(car reporter)' is better than `(aref reporter 0)'.
+;;
+;; NEXT-UPDATE-TIME is a float. While `float-time' loses a couple
+;; digits of precision, it doesn't really matter here. On the other
+;; hand, it greatly simplifies the code.
+
+(defsubst progress-reporter-update (reporter &optional value)
+ "Report progress of an operation in the echo area.
+REPORTER should be the result of a call to `make-progress-reporter'.
+
+If REPORTER is a numerical progress reporter---i.e. if it was
+ made using non-nil MIN-VALUE and MAX-VALUE arguments to
+ `make-progress-reporter'---then VALUE should be a number between
+ MIN-VALUE and MAX-VALUE.
+
+If REPORTER is a non-numerical reporter, VALUE should be nil.
+
+This function is relatively inexpensive. If the change since
+last update is too small or insufficient time has passed, it does
+nothing."
+ (when (or (not (numberp value)) ; For pulsing reporter
+ (>= value (car reporter))) ; For numerical reporter
+ (progress-reporter-do-update reporter value)))
+
+(defun make-progress-reporter (message &optional min-value max-value
+ current-value min-change min-time)
+ "Return progress reporter object for use with `progress-reporter-update'.
+
+MESSAGE is shown in the echo area, with a status indicator
+appended to the end. When you call `progress-reporter-done', the
+word \"done\" is printed after the MESSAGE. You can change the
+MESSAGE of an existing progress reporter by calling
+`progress-reporter-force-update'.
+
+MIN-VALUE and MAX-VALUE, if non-nil, are starting (0% complete)
+and final (100% complete) states of operation; the latter should
+be larger. In this case, the status message shows the percentage
+progress.
+
+If MIN-VALUE and/or MAX-VALUE is omitted or nil, the status
+message shows a \"spinning\", non-numeric indicator.
+
+Optional CURRENT-VALUE is the initial progress; the default is
+MIN-VALUE.
+Optional MIN-CHANGE is the minimal change in percents to report;
+the default is 1%.
+CURRENT-VALUE and MIN-CHANGE do not have any effect if MIN-VALUE
+and/or MAX-VALUE are nil.
+
+Optional MIN-TIME specifies the minimum interval time between
+echo area updates (default is 0.2 seconds.) If the function
+`float-time' is not present, time is not tracked at all. If the
+OS is not capable of measuring fractions of seconds, this
+parameter is effectively rounded up."
+ (when (string-match "[[:alnum:]]\\'" message)
+ (setq message (concat message "...")))
+ (unless min-time
+ (setq min-time 0.2))
+ (let ((reporter
+ ;; Force a call to `message' now
+ (cons (or min-value 0)
+ (vector (if (and (fboundp 'float-time)
+ (>= min-time 0.02))
+ (float-time) nil)
+ min-value
+ max-value
+ message
+ (if min-change (max (min min-change 50) 1) 1)
+ min-time))))
+ (progress-reporter-update reporter (or current-value min-value))
+ reporter))
+
+(defun progress-reporter-force-update (reporter &optional value new-message)
+ "Report progress of an operation in the echo area unconditionally.
+
+The first two arguments are the same as in `progress-reporter-update'.
+NEW-MESSAGE, if non-nil, sets a new message for the reporter."
+ (let ((parameters (cdr reporter)))
+ (when new-message
+ (aset parameters 3 new-message))
+ (when (aref parameters 0)
+ (aset parameters 0 (float-time)))
+ (progress-reporter-do-update reporter value)))
+
+(defvar progress-reporter--pulse-characters ["-" "\\" "|" "/"]
+ "Characters to use for pulsing progress reporters.")
+
+(defun progress-reporter-do-update (reporter value)
+ (let* ((parameters (cdr reporter))
+ (update-time (aref parameters 0))
+ (min-value (aref parameters 1))
+ (max-value (aref parameters 2))
+ (text (aref parameters 3))
+ (current-time (float-time))
+ (enough-time-passed
+ ;; See if enough time has passed since the last update.
+ (or (not update-time)
+ (when (>= current-time update-time)
+ ;; Calculate time for the next update
+ (aset parameters 0 (+ update-time (aref parameters 5)))))))
+ (cond ((and min-value max-value)
+ ;; Numerical indicator
+ (let* ((one-percent (/ (- max-value min-value) 100.0))
+ (percentage (if (= max-value min-value)
+ 0
+ (truncate (/ (- value min-value)
+ one-percent)))))
+ ;; Calculate NEXT-UPDATE-VALUE. If we are not printing
+ ;; message because not enough time has passed, use 1
+ ;; instead of MIN-CHANGE. This makes delays between echo
+ ;; area updates closer to MIN-TIME.
+ (setcar reporter
+ (min (+ min-value (* (+ percentage
+ (if enough-time-passed
+ ;; MIN-CHANGE
+ (aref parameters 4)
+ 1))
+ one-percent))
+ max-value))
+ (when (integerp value)
+ (setcar reporter (ceiling (car reporter))))
+ ;; Only print message if enough time has passed
+ (when enough-time-passed
+ (if (> percentage 0)
+ (message "%s%d%%" text percentage)
+ (message "%s" text)))))
+ ;; Pulsing indicator
+ (enough-time-passed
+ (let ((index (mod (1+ (car reporter)) 4))
+ (message-log-max nil))
+ (setcar reporter index)
+ (message "%s %s"
+ text
+ (aref progress-reporter--pulse-characters
+ index)))))))
+
+(defun progress-reporter-done (reporter)
+ "Print reporter's message followed by word \"done\" in echo area."
+ (message "%sdone" (aref (cdr reporter) 3)))
+
+(defmacro dotimes-with-progress-reporter (spec message &rest body)
+ "Loop a certain number of times and report progress in the echo area.
+Evaluate BODY with VAR bound to successive integers running from
+0, inclusive, to COUNT, exclusive. Then evaluate RESULT to get
+the return value (nil if RESULT is omitted).
+
+At each iteration MESSAGE followed by progress percentage is
+printed in the echo area. After the loop is finished, MESSAGE
+followed by word \"done\" is printed. This macro is a
+convenience wrapper around `make-progress-reporter' and friends.
+
+\(fn (VAR COUNT [RESULT]) MESSAGE BODY...)"
+ (declare (indent 2) (debug ((symbolp form &optional form) form body)))
+ (let ((temp (make-symbol "--dotimes-temp--"))
+ (temp2 (make-symbol "--dotimes-temp2--"))
+ (start 0)
+ (end (nth 1 spec)))
+ `(let ((,temp ,end)
+ (,(car spec) ,start)
+ (,temp2 (make-progress-reporter ,message ,start ,end)))
+ (while (< ,(car spec) ,temp)
+ ,@body
+ (progress-reporter-update ,temp2
+ (setq ,(car spec) (1+ ,(car spec)))))
+ (progress-reporter-done ,temp2)
+ nil ,@(cdr (cdr spec)))))
+
+
+;;;; Comparing version strings.
+
+(defconst version-separator "."
+ "Specify the string used to separate the version elements.
+
+Usually the separator is \".\", but it can be any other string.")
+
+
+(defconst version-regexp-alist
+ '(("^[-_+ ]?snapshot$" . -4)
+ ;; treat "1.2.3-20050920" and "1.2-3" as snapshot releases
+ ("^[-_+]$" . -4)
+ ;; treat "1.2.3-CVS" as snapshot release
+ ("^[-_+ ]?\\(cvs\\|git\\|bzr\\|svn\\|hg\\|darcs\\)$" . -4)
+ ("^[-_+ ]?alpha$" . -3)
+ ("^[-_+ ]?beta$" . -2)
+ ("^[-_+ ]?\\(pre\\|rc\\)$" . -1))
+ "Specify association between non-numeric version and its priority.
+
+This association is used to handle version string like \"1.0pre2\",
+\"0.9alpha1\", etc. It's used by `version-to-list' (which see) to convert the
+non-numeric part of a version string to an integer. For example:
+
+ String Version Integer List Version
+ \"0.9snapshot\" (0 9 -4)
+ \"1.0-git\" (1 0 -4)
+ \"1.0pre2\" (1 0 -1 2)
+ \"1.0PRE2\" (1 0 -1 2)
+ \"22.8beta3\" (22 8 -2 3)
+ \"22.8 Beta3\" (22 8 -2 3)
+ \"0.9alpha1\" (0 9 -3 1)
+ \"0.9AlphA1\" (0 9 -3 1)
+ \"0.9 alpha\" (0 9 -3)
+
+Each element has the following form:
+
+ (REGEXP . PRIORITY)
+
+Where:
+
+REGEXP regexp used to match non-numeric part of a version string.
+ It should begin with the `^' anchor and end with a `$' to
+ prevent false hits. Letter-case is ignored while matching
+ REGEXP.
+
+PRIORITY a negative integer specifying non-numeric priority of REGEXP.")
+
+
+(defun version-to-list (ver)
+ "Convert version string VER into a list of integers.
+
+The version syntax is given by the following EBNF:
+
+ VERSION ::= NUMBER ( SEPARATOR NUMBER )*.
+
+ NUMBER ::= (0|1|2|3|4|5|6|7|8|9)+.
+
+ SEPARATOR ::= `version-separator' (which see)
+ | `version-regexp-alist' (which see).
+
+The NUMBER part is optional if SEPARATOR is a match for an element
+in `version-regexp-alist'.
+
+Examples of valid version syntax:
+
+ 1.0pre2 1.0.7.5 22.8beta3 0.9alpha1 6.9.30Beta
+
+Examples of invalid version syntax:
+
+ 1.0prepre2 1.0..7.5 22.8X3 alpha3.2 .5
+
+Examples of version conversion:
+
+ Version String Version as a List of Integers
+ \"1.0.7.5\" (1 0 7 5)
+ \"1.0pre2\" (1 0 -1 2)
+ \"1.0PRE2\" (1 0 -1 2)
+ \"22.8beta3\" (22 8 -2 3)
+ \"22.8Beta3\" (22 8 -2 3)
+ \"0.9alpha1\" (0 9 -3 1)
+ \"0.9AlphA1\" (0 9 -3 1)
+ \"0.9alpha\" (0 9 -3)
+ \"0.9snapshot\" (0 9 -4)
+ \"1.0-git\" (1 0 -4)
+
+See documentation for `version-separator' and `version-regexp-alist'."
+ (or (and (stringp ver) (> (length ver) 0))
+ (error "Invalid version string: '%s'" ver))
+ ;; Change .x.y to 0.x.y
+ (if (and (>= (length ver) (length version-separator))
+ (string-equal (substring ver 0 (length version-separator))
+ version-separator))
+ (setq ver (concat "0" ver)))
+ (save-match-data
+ (let ((i 0)
+ (case-fold-search t) ; ignore case in matching
+ lst s al)
+ (while (and (setq s (string-match "[0-9]+" ver i))
+ (= s i))
+ ;; handle numeric part
+ (setq lst (cons (string-to-number (substring ver i (match-end 0)))
+ lst)
+ i (match-end 0))
+ ;; handle non-numeric part
+ (when (and (setq s (string-match "[^0-9]+" ver i))
+ (= s i))
+ (setq s (substring ver i (match-end 0))
+ i (match-end 0))
+ ;; handle alpha, beta, pre, etc. separator
+ (unless (string= s version-separator)
+ (setq al version-regexp-alist)
+ (while (and al (not (string-match (caar al) s)))
+ (setq al (cdr al)))
+ (cond (al
+ (push (cdar al) lst))
+ ;; Convert 22.3a to 22.3.1, 22.3b to 22.3.2, etc.
+ ((string-match "^[-_+ ]?\\([a-zA-Z]\\)$" s)
+ (push (- (aref (downcase (match-string 1 s)) 0) ?a -1)
+ lst))
+ (t (error "Invalid version syntax: '%s'" ver))))))
+ (if (null lst)
+ (error "Invalid version syntax: '%s'" ver)
+ (nreverse lst)))))
+
+
+(defun version-list-< (l1 l2)
+ "Return t if L1, a list specification of a version, is lower than L2.
+
+Note that a version specified by the list (1) is equal to (1 0),
+\(1 0 0), (1 0 0 0), etc. That is, the trailing zeros are insignificant.
+Also, a version given by the list (1) is higher than (1 -1), which in
+turn is higher than (1 -2), which is higher than (1 -3)."
+ (while (and l1 l2 (= (car l1) (car l2)))
+ (setq l1 (cdr l1)
+ l2 (cdr l2)))
+ (cond
+ ;; l1 not null and l2 not null
+ ((and l1 l2) (< (car l1) (car l2)))
+ ;; l1 null and l2 null ==> l1 length = l2 length
+ ((and (null l1) (null l2)) nil)
+ ;; l1 not null and l2 null ==> l1 length > l2 length
+ (l1 (< (version-list-not-zero l1) 0))
+ ;; l1 null and l2 not null ==> l2 length > l1 length
+ (t (< 0 (version-list-not-zero l2)))))
+
+
+(defun version-list-= (l1 l2)
+ "Return t if L1, a list specification of a version, is equal to L2.
+
+Note that a version specified by the list (1) is equal to (1 0),
+\(1 0 0), (1 0 0 0), etc. That is, the trailing zeros are insignificant.
+Also, a version given by the list (1) is higher than (1 -1), which in
+turn is higher than (1 -2), which is higher than (1 -3)."
+ (while (and l1 l2 (= (car l1) (car l2)))
+ (setq l1 (cdr l1)
+ l2 (cdr l2)))
+ (cond
+ ;; l1 not null and l2 not null
+ ((and l1 l2) nil)
+ ;; l1 null and l2 null ==> l1 length = l2 length
+ ((and (null l1) (null l2)))
+ ;; l1 not null and l2 null ==> l1 length > l2 length
+ (l1 (zerop (version-list-not-zero l1)))
+ ;; l1 null and l2 not null ==> l2 length > l1 length
+ (t (zerop (version-list-not-zero l2)))))
+
+
+(defun version-list-<= (l1 l2)
+ "Return t if L1, a list specification of a version, is lower or equal to L2.
+
+Note that integer list (1) is equal to (1 0), (1 0 0), (1 0 0 0),
+etc. That is, the trailing zeroes are insignificant. Also, integer
+list (1) is greater than (1 -1) which is greater than (1 -2)
+which is greater than (1 -3)."
+ (while (and l1 l2 (= (car l1) (car l2)))
+ (setq l1 (cdr l1)
+ l2 (cdr l2)))
+ (cond
+ ;; l1 not null and l2 not null
+ ((and l1 l2) (< (car l1) (car l2)))
+ ;; l1 null and l2 null ==> l1 length = l2 length
+ ((and (null l1) (null l2)))
+ ;; l1 not null and l2 null ==> l1 length > l2 length
+ (l1 (<= (version-list-not-zero l1) 0))
+ ;; l1 null and l2 not null ==> l2 length > l1 length
+ (t (<= 0 (version-list-not-zero l2)))))
+
+(defun version-list-not-zero (lst)
+ "Return the first non-zero element of LST, which is a list of integers.
+
+If all LST elements are zeros or LST is nil, return zero."
+ (while (and lst (zerop (car lst)))
+ (setq lst (cdr lst)))
+ (if lst
+ (car lst)
+ ;; there is no element different of zero
+ 0))
+
+
+(defun version< (v1 v2)
+ "Return t if version V1 is lower (older) than V2.
+
+Note that version string \"1\" is equal to \"1.0\", \"1.0.0\", \"1.0.0.0\",
+etc. That is, the trailing \".0\"s are insignificant. Also, version
+string \"1\" is higher (newer) than \"1pre\", which is higher than \"1beta\",
+which is higher than \"1alpha\", which is higher than \"1snapshot\".
+Also, \"-GIT\", \"-CVS\" and \"-NNN\" are treated as snapshot versions."
+ (version-list-< (version-to-list v1) (version-to-list v2)))
+
+(defun version<= (v1 v2)
+ "Return t if version V1 is lower (older) than or equal to V2.
+
+Note that version string \"1\" is equal to \"1.0\", \"1.0.0\", \"1.0.0.0\",
+etc. That is, the trailing \".0\"s are insignificant. Also, version
+string \"1\" is higher (newer) than \"1pre\", which is higher than \"1beta\",
+which is higher than \"1alpha\", which is higher than \"1snapshot\".
+Also, \"-GIT\", \"-CVS\" and \"-NNN\" are treated as snapshot versions."
+ (version-list-<= (version-to-list v1) (version-to-list v2)))
+
+(defun version= (v1 v2)
+ "Return t if version V1 is equal to V2.
+
+Note that version string \"1\" is equal to \"1.0\", \"1.0.0\", \"1.0.0.0\",
+etc. That is, the trailing \".0\"s are insignificant. Also, version
+string \"1\" is higher (newer) than \"1pre\", which is higher than \"1beta\",
+which is higher than \"1alpha\", which is higher than \"1snapshot\".
+Also, \"-GIT\", \"-CVS\" and \"-NNN\" are treated as snapshot versions."
+ (version-list-= (version-to-list v1) (version-to-list v2)))
+
+
+;;; Misc.
+(defconst menu-bar-separator '("--")
+ "Separator for menus.")
+
+;; The following statement ought to be in print.c, but `provide' can't
+;; be used there.
+;; http://lists.gnu.org/archive/html/emacs-devel/2009-08/msg00236.html
+(when (hash-table-p (car (read-from-string
+ (prin1-to-string (make-hash-table)))))
+ (provide 'hashtable-print-readable))
+
+;; This is used in lisp/Makefile.in and in leim/Makefile.in to
+;; generate file names for autoloads, custom-deps, and finder-data.
+(defun unmsys--file-name (file)
+ "Produce the canonical file name for FILE from its MSYS form.
+
+On systems other than MS-Windows, just returns FILE.
+On MS-Windows, converts /d/foo/bar form of file names
+passed by MSYS Make into d:/foo/bar that Emacs can grok.
+
+This function is called from lisp/Makefile and leim/Makefile."
+ (when (and (eq system-type 'windows-nt)
+ (string-match "\\`/[a-zA-Z]/" file))
+ (setq file (concat (substring file 1 2) ":" (substring file 2))))
+ file)
+
+
+;;; subr.el ends here
diff --git a/packages/context-coloring/context-coloring.el
b/packages/context-coloring/context-coloring.el
index cd1b97a..e5b5a73 100644
--- a/packages/context-coloring/context-coloring.el
+++ b/packages/context-coloring/context-coloring.el
@@ -1,12 +1,12 @@
-;;; context-coloring.el --- Syntax highlighting, except not for syntax. -*-
lexical-binding: t; -*-
+;;; context-coloring.el --- Highlight by scope -*- lexical-binding: t; -*-
;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
;; Author: Jackson Ray Hamilton <address@hidden>
+;; Version: 7.2.1
+;; Keywords: convenience faces tools
+;; Package-Requires: ((emacs "24.3") (js2-mode "20150713"))
;; URL: https://github.com/jacksonrayhamilton/context-coloring
-;; Keywords: context coloring syntax highlighting
-;; Version: 6.2.0
-;; Package-Requires: ((emacs "24") (js2-mode "20150126"))
;; This file is part of GNU Emacs.
@@ -25,55 +25,29 @@
;;; Commentary:
-;; Highlights code according to function context.
+;; Highlights code by scope. Top-level scopes are one color, second-level
+;; scopes are another color, and so on. Variables retain the color of the
scope
+;; in which they are defined. A variable defined in an outer scope referenced
+;; by an inner scope is colored the same as the outer scope.
-;; - Code in the global scope is one color. Code in functions within the
global
-;; scope is a different color, and code within such functions is another
-;; color, and so on.
-;; - Identifiers retain the color of the scope in which they are declared.
-
-;; Lexical scope information at-a-glance can assist a programmer in
-;; understanding the overall structure of a program. It can help to curb nasty
-;; bugs like name shadowing. A rainbow can indicate excessive complexity.
-;; State change within a closure is easily monitored.
-
-;; By default, Context Coloring still highlights comments and strings
-;; syntactically. It is still easy to differentiate code from non-code, and
-;; strings cannot be confused for variables.
-
-;; To use, add the following to your ~/.emacs:
-
-;; (require 'context-coloring)
-;; (add-hook 'js2-mode-hook 'context-coloring-mode)
-
-;; js-mode or js3-mode support requires Node.js 0.10+ and the scopifier
-;; executable.
-
-;; $ npm install -g scopifier
+;; By default, comments and strings are still highlighted syntactically.
;;; Code:
(require 'js2-mode)
-;;; Local variables
-
-(defvar-local context-coloring-buffer nil
- "Reference to this buffer (for timers).")
-
-
;;; Utilities
(defun context-coloring-join (strings delimiter)
"Join a list of STRINGS with the string DELIMITER."
- (mapconcat 'identity strings delimiter))
+ (mapconcat #'identity strings delimiter))
;;; Faces
-(defun context-coloring-defface (level tty light dark)
- "Define a face for LEVEL with colors for TTY, LIGHT and DARK
-backgrounds."
+(defun context-coloring-defface (level light dark tty)
+ "Define a face for LEVEL with LIGHT, DARK and TTY colors."
(let ((face (intern (format "context-coloring-level-%s-face" level)))
(doc (format "Context coloring face, level %s." level)))
(custom-declare-face
@@ -84,65 +58,189 @@ backgrounds."
doc
:group 'context-coloring)))
-(defun context-coloring-defface-neutral (level)
- "Define a face for LEVEL with the default neutral colors."
- (context-coloring-defface level nil "#3f3f3f" "#cdcdcd"))
+;; Provide some default colors based off Emacs's defaults.
+(context-coloring-defface 0 "#000000" "#ffffff" nil)
+(context-coloring-defface 1 "#008b8b" "#00ffff" "yellow")
+(context-coloring-defface 2 "#0000ff" "#87cefa" "green")
+(context-coloring-defface 3 "#483d8b" "#b0c4de" "cyan")
+(context-coloring-defface 4 "#a020f0" "#eedd82" "blue")
+(context-coloring-defface 5 "#a0522d" "#98fb98" "magenta")
+(context-coloring-defface 6 "#228b22" "#7fffd4" "red")
+(context-coloring-defface 7 "#3f3f3f" "#cdcdcd" nil)
+
+(defconst context-coloring-default-maximum-face 7
+ "Maximum face when there are no custom faces.")
+
+;; Create placeholder faces for users and theme authors.
+(dotimes (level 18)
+ (let* ((level (+ level 8))
+ (face (intern (format "context-coloring-level-%s-face" level)))
+ (doc (format "Context coloring face, level %s." level)))
+ (custom-declare-face face nil doc :group 'context-coloring)))
+
+(defvar-local context-coloring-maximum-face nil
+ "Dynamic index of the highest face available for coloring.")
+
+(defsubst context-coloring-level-face (level)
+ "Return symbol for face with LEVEL."
+ ;; `concat' is faster than `format' here.
+ (intern-soft
+ (concat "context-coloring-level-" (number-to-string level) "-face")))
+
+(defsubst context-coloring-bounded-level-face (level)
+ "Return symbol for face with LEVEL, bounded by the maximum."
+ (context-coloring-level-face (min level context-coloring-maximum-face)))
+
+(defconst context-coloring-level-face-regexp
+ "context-coloring-level-\\([[:digit:]]+\\)-face"
+ "Extract a level from a face.")
+
+(defun context-coloring-theme-highest-level (theme)
+ "Return the highest coloring level for THEME, or -1."
+ (let* ((settings (get theme 'theme-settings))
+ (tail settings)
+ face-string
+ number
+ (found -1))
+ (while tail
+ (and (eq (nth 0 (car tail)) 'theme-face)
+ (setq face-string (symbol-name (nth 1 (car tail))))
+ (string-match
+ context-coloring-level-face-regexp
+ face-string)
+ (setq number (string-to-number
+ (substring face-string
+ (match-beginning 1)
+ (match-end 1))))
+ (> number found)
+ (setq found number))
+ (setq tail (cdr tail)))
+ found))
+
+(defun context-coloring-update-maximum-face ()
+ "Save the highest possible face for the current theme."
+ (let ((themes (append custom-enabled-themes '(user)))
+ (continue t)
+ theme
+ highest-level)
+ (while continue
+ (setq theme (car themes))
+ (setq themes (cdr themes))
+ (setq highest-level (context-coloring-theme-highest-level theme))
+ (setq continue (and themes (= highest-level -1))))
+ (setq context-coloring-maximum-face
+ (cond
+ ((= highest-level -1)
+ context-coloring-default-maximum-face)
+ (t
+ highest-level)))))
+
+
+;;; Change detection
+
+(defvar-local context-coloring-changed-p nil
+ "Indication that the buffer has changed recently, which implies
+that it should be colored again by
+`context-coloring-maybe-colorize-idle-timer' if that timer is
+being used.")
-(context-coloring-defface 0 nil "#000000" "#ffffff")
-(context-coloring-defface 1 "yellow" "#007f80" "#ffff80")
-(context-coloring-defface 2 "green" "#001580" "#cdfacd")
-(context-coloring-defface 3 "cyan" "#550080" "#d8d8ff")
-(context-coloring-defface 4 "blue" "#802b00" "#e7c7ff")
-(context-coloring-defface 5 "magenta" "#6a8000" "#ffcdcd")
-(context-coloring-defface 6 "red" "#008000" "#ffe390")
-(context-coloring-defface-neutral 7)
+(defvar-local context-coloring-changed-start nil
+ "Beginning of last text that changed.")
-(defvar context-coloring-maximum-face nil
- "Index of the highest face available for coloring.")
+(defvar-local context-coloring-changed-end nil
+ "End of last text that changed.")
-(defvar context-coloring-original-maximum-face nil
- "Fallback value for `context-coloring-maximum-face' when all
- themes have been disabled.")
+(defvar-local context-coloring-changed-length nil
+ "Length of last text that changed.")
-(setq context-coloring-maximum-face 7)
+(defun context-coloring-change-function (start end length)
+ "Register a change so that a buffer can be colorized soon.
-(setq context-coloring-original-maximum-face
- context-coloring-maximum-face)
+START, END and LENGTH are recorded for later use."
+ ;; Tokenization is obsolete if there was a change.
+ (setq context-coloring-changed-start start)
+ (setq context-coloring-changed-end end)
+ (setq context-coloring-changed-length length)
+ (setq context-coloring-changed-p t))
+
+(defun context-coloring-maybe-colorize-with-buffer (buffer)
+ "Color BUFFER and if it has changed."
+ (when (and (eq buffer (current-buffer))
+ context-coloring-changed-p)
+ (context-coloring-colorize-with-buffer buffer)
+ (setq context-coloring-changed-p nil)
+ (setq context-coloring-changed-start nil)
+ (setq context-coloring-changed-end nil)
+ (setq context-coloring-changed-length nil)))
+
+(defvar-local context-coloring-maybe-colorize-idle-timer nil
+ "The currently-running idle timer for conditional coloring.")
-;; Theme authors can have up to 26 levels: 1 (0th) for globals, 24 (1st-24th)
-;; for nested levels, and 1 (25th) for infinity.
-(dotimes (number 18)
- (context-coloring-defface-neutral (+ number context-coloring-maximum-face
1)))
+(defvar-local context-coloring-colorize-idle-timer nil
+ "The currently-running idle timer for unconditional coloring.")
+(defcustom context-coloring-default-delay 0.25
+ "Default delay between a buffer update and colorization.
-;;; Face functions
+Increase this if your machine is high-performing. Decrease it if
+it ain't."
+ :type 'float
+ :group 'context-coloring)
-(defsubst context-coloring-level-face (level)
- "Return the symbol for a face with LEVEL."
- ;; `concat' is faster than `format' here.
- (intern-soft
- (concat "context-coloring-level-" (number-to-string level) "-face")))
+(make-obsolete-variable
+ 'context-coloring-delay
+ 'context-coloring-default-delay
+ "6.4.0")
+
+(defun context-coloring-cancel-timer (timer)
+ "Cancel TIMER."
+ (when timer
+ (cancel-timer timer)))
+
+(defun context-coloring-schedule-coloring (time)
+ "Schedule coloring to occur once after Emacs is idle for TIME."
+ (context-coloring-cancel-timer context-coloring-colorize-idle-timer)
+ (setq context-coloring-colorize-idle-timer
+ (run-with-idle-timer
+ time
+ nil
+ #'context-coloring-colorize-with-buffer
+ (current-buffer))))
-(defsubst context-coloring-bounded-level-face (level)
- "Return the symbol for a face with LEVEL, bounded by
-`context-coloring-maximum-face'."
- (context-coloring-level-face (min level context-coloring-maximum-face)))
+(defun context-coloring-setup-idle-change-detection ()
+ "Setup idle change detection."
+ (let ((dispatch (context-coloring-get-current-dispatch)))
+ (add-hook
+ 'after-change-functions #'context-coloring-change-function nil t)
+ (add-hook
+ 'kill-buffer-hook #'context-coloring-teardown-idle-change-detection nil t)
+ (setq context-coloring-maybe-colorize-idle-timer
+ (run-with-idle-timer
+ (or (plist-get dispatch :delay) context-coloring-default-delay)
+ t
+ #'context-coloring-maybe-colorize-with-buffer
+ (current-buffer)))))
+
+(defun context-coloring-teardown-idle-change-detection ()
+ "Teardown idle change detection."
+ (dolist (timer (list context-coloring-colorize-idle-timer
+ context-coloring-maybe-colorize-idle-timer))
+ (context-coloring-cancel-timer timer))
+ (remove-hook
+ 'kill-buffer-hook #'context-coloring-teardown-idle-change-detection t)
+ (remove-hook
+ 'after-change-functions #'context-coloring-change-function t))
;;; Colorization utilities
(defsubst context-coloring-colorize-region (start end level)
- "Color characters from the 1-indexed START point (inclusive) to
-the END point (exclusive) with the face corresponding to LEVEL."
+ "Color from START (inclusive) to END (exclusive) with LEVEL."
(add-text-properties
start
end
`(face ,(context-coloring-bounded-level-face level))))
-(defcustom context-coloring-comments-and-strings nil
- "If non-nil, also color comments and strings using `font-lock'."
- :group 'context-coloring)
-
(make-obsolete-variable
'context-coloring-comments-and-strings
"use `context-coloring-syntactic-comments' and
@@ -151,72 +249,87 @@ the END point (exclusive) with the face corresponding to
LEVEL."
(defcustom context-coloring-syntactic-comments t
"If non-nil, also color comments using `font-lock'."
+ :type 'boolean
:group 'context-coloring)
(defcustom context-coloring-syntactic-strings t
"If non-nil, also color strings using `font-lock'."
+ :type 'boolean
:group 'context-coloring)
(defun context-coloring-font-lock-syntactic-comment-function (state)
- "Tell `font-lock' to color a comment but not a string."
+ "Color a comment according to STATE."
(if (nth 3 state) nil font-lock-comment-face))
(defun context-coloring-font-lock-syntactic-string-function (state)
- "Tell `font-lock' to color a string but not a comment."
+ "Color a string according to STATE."
(if (nth 3 state) font-lock-string-face nil))
-(defsubst context-coloring-maybe-colorize-comments-and-strings ()
- "Color the current buffer's comments and strings if
-`context-coloring-comments-and-strings' is non-nil."
- (when (or context-coloring-comments-and-strings
- context-coloring-syntactic-comments
+(defsubst context-coloring-colorize-comments-and-strings (&optional min max)
+ "Maybe color comments and strings in buffer from MIN to MAX.
+MIN defaults to beginning of buffer. MAX defaults to end."
+ (when (or context-coloring-syntactic-comments
context-coloring-syntactic-strings)
- (let ((old-function font-lock-syntactic-face-function)
- saved-function-p)
- (cond
- ((and context-coloring-syntactic-comments
- (not context-coloring-syntactic-strings))
- (setq font-lock-syntactic-face-function
- 'context-coloring-font-lock-syntactic-comment-function)
- (setq saved-function-p t))
- ((and context-coloring-syntactic-strings
- (not context-coloring-syntactic-comments))
- (setq font-lock-syntactic-face-function
- 'context-coloring-font-lock-syntactic-string-function)
- (setq saved-function-p t)))
+ (let ((min (or min (point-min)))
+ (max (or max (point-max)))
+ (font-lock-syntactic-face-function
+ (cond
+ ((and context-coloring-syntactic-comments
+ (not context-coloring-syntactic-strings))
+ #'context-coloring-font-lock-syntactic-comment-function)
+ ((and context-coloring-syntactic-strings
+ (not context-coloring-syntactic-comments))
+ #'context-coloring-font-lock-syntactic-string-function)
+ (t
+ font-lock-syntactic-face-function))))
(save-excursion
- (font-lock-fontify-syntactically-region (point-min) (point-max)))
- (when saved-function-p
- (setq font-lock-syntactic-face-function old-function)))))
+ (font-lock-fontify-syntactically-region min max)
+ ;; TODO: Make configurable at the dispatch level.
+ (when (eq major-mode 'emacs-lisp-mode)
+ (font-lock-fontify-keywords-region min max))))))
+
+(defcustom context-coloring-initial-level 0
+ "Scope level at which to start coloring.
+
+If top-level variables and functions do not become global, but
+are scoped to a file (as in Node.js), set this to `1'."
+ :type 'integer
+ :safe #'integerp
+ :group 'context-coloring)
-;;; js2-mode colorization
+;;; JavaScript colorization
(defvar-local context-coloring-js2-scope-level-hash-table nil
"Associate `js2-scope' structures and with their scope
levels.")
-(defcustom context-coloring-js-block-scopes nil
+(defcustom context-coloring-javascript-block-scopes nil
"If non-nil, also color block scopes in the scope hierarchy in JavaScript.
The block-scoped `let' and `const' are introduced in ES6. Enable
-this for ES6 code; disable it elsewhere.
-
-Supported modes: `js2-mode'"
+this for ES6 code; disable it elsewhere."
+ :type 'boolean
+ :safe #'booleanp
:group 'context-coloring)
-(defsubst context-coloring-js2-scope-level (scope)
- "Return the level of SCOPE."
+(make-obsolete-variable
+ 'context-coloring-js-block-scopes
+ 'context-coloring-javascript-block-scopes
+ "7.0.0")
+
+(defsubst context-coloring-js2-scope-level (scope initial)
+ "Return the level of SCOPE, starting from INITIAL."
(cond ((gethash scope context-coloring-js2-scope-level-hash-table))
(t
- (let ((level 0)
+ (let ((level initial)
(current-scope scope)
enclosing-scope)
(while (and current-scope
(js2-node-parent current-scope)
(setq enclosing-scope
(js2-node-get-enclosing-scope current-scope)))
- (when (or context-coloring-js-block-scopes
+ (when (or context-coloring-javascript-block-scopes
(let ((type (js2-scope-type current-scope)))
(or (= type js2-SCRIPT)
(= type js2-FUNCTION)
@@ -226,8 +339,7 @@ Supported modes: `js2-mode'"
(puthash scope level
context-coloring-js2-scope-level-hash-table)))))
(defsubst context-coloring-js2-local-name-node-p (node)
- "Determine if NODE is a `js2-name-node' representing a local
-variable."
+ "Determine if NODE represents a local variable."
(and (js2-name-node-p node)
(let ((parent (js2-node-parent node)))
(not (or (and (js2-object-prop-node-p parent)
@@ -237,19 +349,27 @@ variable."
;; `js2-prop-get-node', so this always works.
(eq node (js2-prop-get-node-right parent))))))))
+(defvar-local context-coloring-point-max nil
+ "Cached value of `point-max'.")
+
(defsubst context-coloring-js2-colorize-node (node level)
"Color NODE with the color for LEVEL."
(let ((start (js2-node-abs-pos node)))
(context-coloring-colorize-region
start
- (+ start (js2-node-len node)) ; End
+ (min
+ ;; End
+ (+ start (js2-node-len node))
+ ;; Somes nodes (like the ast when there is an unterminated multiline
+ ;; comment) will stretch to the value of `point-max'.
+ context-coloring-point-max)
level)))
-(defun context-coloring-js2-colorize ()
- "Color the current buffer using the abstract syntax tree
-generated by `js2-mode'."
+(defun context-coloring-js2-colorize-ast ()
+ "Color the buffer using the `js2-mode' abstract syntax tree."
;; Reset the hash table; the old one could be obsolete.
- (setq context-coloring-js2-scope-level-hash-table (make-hash-table :test
'eq))
+ (setq context-coloring-js2-scope-level-hash-table (make-hash-table :test
#'eq))
+ (setq context-coloring-point-max (point-max))
(with-silent-modifications
(js2-visit-ast
js2-mode-ast
@@ -259,7 +379,7 @@ generated by `js2-mode'."
((js2-scope-p node)
(context-coloring-js2-colorize-node
node
- (context-coloring-js2-scope-level node)))
+ (context-coloring-js2-scope-level node
context-coloring-initial-level)))
((context-coloring-js2-local-name-node-p node)
(let* ((enclosing-scope (js2-node-get-enclosing-scope node))
(defining-scope (js2-get-defining-scope
@@ -272,151 +392,861 @@ generated by `js2-mode'."
(when (not (eq defining-scope enclosing-scope))
(context-coloring-js2-colorize-node
node
- (context-coloring-js2-scope-level defining-scope))))))
+ ;; Use `0' as an initial level so global variables are always
at
+ ;; the highest level (even if `context-coloring-initial-level'
+ ;; specifies an initial level for the rest of the code).
+ (context-coloring-js2-scope-level defining-scope 0))))))
;; The `t' indicates to search children.
t)))
- (context-coloring-maybe-colorize-comments-and-strings)))
-
-
-;;; Shell command scopification / colorization
+ (context-coloring-colorize-comments-and-strings)))
+
+(defconst context-coloring-node-comment-regexp
+ (concat
+ ;; Ensure the "//" or "/*" comment starts with the directive.
+ "\\(//[[:space:]]*\\|/\\*[[:space:]]*\\)"
+ ;; Support multiple directive formats.
+ "\\("
+ ;; JSLint and JSHint support a JSON-like format.
+ "\\(jslint\\|jshint\\)[[:space:]].*?node:[[:space:]]*true"
+ "\\|"
+ ;; ESLint just specifies the option name.
+ "eslint-env[[:space:]].*?node"
+ "\\)")
+ "Match a comment body hinting at a Node.js program.")
+
+;; TODO: Add ES6 module detection.
+(defun context-coloring-js2-top-level-local-p ()
+ "Guess whether top-level variables are local.
+For instance, the current file could be a Node.js program."
+ (or
+ ;; A shebang is a pretty obvious giveaway.
+ (string-equal
+ "node"
+ (save-excursion
+ (goto-char (point-min))
+ (when (looking-at auto-mode-interpreter-regexp)
+ (match-string 2))))
+ ;; Otherwise, perform static analysis.
+ (progn
+ (setq context-coloring-js2-scope-level-hash-table (make-hash-table :test
#'eq))
+ (catch 'node-program-p
+ (js2-visit-ast
+ js2-mode-ast
+ (lambda (node end-p)
+ (when (null end-p)
+ (when
+ (cond
+ ;; Infer based on inline linter configuration.
+ ((js2-comment-node-p node)
+ (string-match-p
+ context-coloring-node-comment-regexp
+ (js2-node-string node)))
+ ;; Infer based on the prescence of certain variables.
+ ((and (js2-name-node-p node)
+ (let ((parent (js2-node-parent node)))
+ (not (and (js2-object-prop-node-p parent)
+ (eq node (js2-object-prop-node-left
parent))))))
+ (let ((name (js2-name-node-name node))
+ (parent (js2-node-parent node)))
+ (and
+ (cond
+ ;; Check whether this is "exports.something" or
+ ;; "module.exports".
+ ((js2-prop-get-node-p parent)
+ (and
+ (eq node (js2-prop-get-node-left parent))
+ (or (string-equal name "exports")
+ (let* ((property (js2-prop-get-node-right parent))
+ (property-name (js2-name-node-name
property)))
+ (and (string-equal name "module")
+ (string-equal property-name "exports"))))))
+ ;; Check whether it's a "require('module')" call.
+ ((js2-call-node-p parent)
+ (or (string-equal name "require"))))
+ (let* ((enclosing-scope (js2-node-get-enclosing-scope
node))
+ (defining-scope (js2-get-defining-scope
+ enclosing-scope name)))
+ ;; The variable also must be global.
+ (null defining-scope))))))
+ (throw 'node-program-p t))
+ ;; The `t' indicates to search children.
+ t)))
+ ;; Default to returning nil from the catch body.
+ nil))))
+
+(defcustom context-coloring-javascript-detect-top-level-scope t
+ "If non-nil, detect when to use file-level scope."
+ :type 'boolean
+ :group 'context-coloring)
-(defun context-coloring-apply-tokens (tokens)
- "Process a vector of TOKENS to apply context-based coloring to
-the current buffer. Tokens are 3 integers: start, end, level.
-The vector is flat, with a new token occurring after every 3rd
-element."
+(defun context-coloring-js2-colorize ()
+ "Color the buffer using the `js2-mode'."
+ (cond
+ ;; Increase the initial level if we should.
+ ((and context-coloring-javascript-detect-top-level-scope
+ (context-coloring-js2-top-level-local-p))
+ (let ((context-coloring-initial-level 1))
+ (context-coloring-js2-colorize-ast)))
+ (t
+ (context-coloring-js2-colorize-ast))))
+
+
+;;; Emacs Lisp colorization
+
+(defconst context-coloring-WORD-CODE 2)
+(defconst context-coloring-SYMBOL-CODE 3)
+(defconst context-coloring-OPEN-PARENTHESIS-CODE 4)
+(defconst context-coloring-CLOSE-PARENTHESIS-CODE 5)
+(defconst context-coloring-EXPRESSION-PREFIX-CODE 6)
+(defconst context-coloring-STRING-QUOTE-CODE 7)
+(defconst context-coloring-ESCAPE-CODE 9)
+(defconst context-coloring-COMMENT-START-CODE 11)
+(defconst context-coloring-COMMENT-END-CODE 12)
+
+(defconst context-coloring-OCTOTHORPE-CHAR (string-to-char "#"))
+(defconst context-coloring-APOSTROPHE-CHAR (string-to-char "'"))
+(defconst context-coloring-OPEN-PARENTHESIS-CHAR (string-to-char "("))
+(defconst context-coloring-COMMA-CHAR (string-to-char ","))
+(defconst context-coloring-AT-CHAR (string-to-char "@"))
+(defconst context-coloring-BACKTICK-CHAR (string-to-char "`"))
+
+(defsubst context-coloring-get-syntax-code ()
+ "Get the syntax code at point."
+ (syntax-class
+ ;; Faster version of `syntax-after':
+ (aref (syntax-table) (char-after (point)))))
+
+(defsubst context-coloring-forward-sws ()
+ "Move forward through whitespace and comments."
+ (while (forward-comment 1)))
+
+(defsubst context-coloring-elisp-forward-sws ()
+ "Move through whitespace and comments, coloring comments."
+ (let ((start (point)))
+ (context-coloring-forward-sws)
+ (context-coloring-colorize-comments-and-strings start (point))))
+
+(defsubst context-coloring-elisp-forward-sexp ()
+ "Skip/ignore missing sexps, coloring comments and strings."
+ (let ((start (point)))
+ (when (= (context-coloring-get-syntax-code)
+ context-coloring-EXPRESSION-PREFIX-CODE)
+ ;; `forward-sexp' does not skip an unfinished expression (e.g. when the
+ ;; name of a symbol or the parentheses of a list do not follow a single
+ ;; quote).
+ (forward-char))
+ (condition-case nil
+ (forward-sexp)
+ (scan-error (context-coloring-forward-sws)))
+ (context-coloring-elisp-colorize-comments-and-strings-in-region
+ start (point))))
+
+(defsubst context-coloring-exact-regexp (word)
+ "Create a regexp matching exactly WORD."
+ (concat "\\`" (regexp-quote word) "\\'"))
+
+(defsubst context-coloring-exact-or-regexp (words)
+ "Create a regexp matching any exact word in WORDS."
+ (context-coloring-join
+ (mapcar #'context-coloring-exact-regexp words) "\\|"))
+
+(defconst context-coloring-elisp-ignored-word-regexp
+ (context-coloring-join (list "\\`[-+]?[0-9]"
+ "\\`[&:].+"
+ (context-coloring-exact-or-regexp
+ '("t" "nil" "." "?")))
+ "\\|")
+ "Match symbols that can't be bound as variables.")
+
+(defsubst context-coloring-elisp-identifier-p (syntax-code)
+ "Check if SYNTAX-CODE is an elisp identifier constituent."
+ (or (= syntax-code context-coloring-WORD-CODE)
+ (= syntax-code context-coloring-SYMBOL-CODE)))
+
+(defvar context-coloring-parse-interruptable-p t
+ "Set this to nil to force parse to continue until finished.")
+
+(defconst context-coloring-elisp-sexps-per-pause 350
+ "Pause after this many iterations to check for user input.
+If user input is pending, stop the parse. This makes for a
+smoother user experience for large files.
+
+This number should trigger pausing at about 60 frames per
+second.")
+
+(defvar context-coloring-elisp-sexp-count 0
+ "Current number of sexps leading up to the next pause.")
+
+(defsubst context-coloring-elisp-increment-sexp-count ()
+ "Maybe check if the user interrupted the current parse."
+ (setq context-coloring-elisp-sexp-count
+ (1+ context-coloring-elisp-sexp-count))
+ (when (and (zerop (% context-coloring-elisp-sexp-count
+ context-coloring-elisp-sexps-per-pause))
+ context-coloring-parse-interruptable-p
+ (input-pending-p))
+ (throw 'interrupted t)))
+
+(defvar context-coloring-elisp-scope-stack '()
+ "List of scopes in the current parse.")
+
+(defsubst context-coloring-elisp-make-scope (level)
+ "Make a scope object for LEVEL."
+ (list
+ :level level
+ :variables '()))
+
+(defsubst context-coloring-elisp-scope-get-level (scope)
+ "Get the level of SCOPE object."
+ (plist-get scope :level))
+
+(defsubst context-coloring-elisp-scope-add-variable (scope variable)
+ "Add to SCOPE a VARIABLE."
+ (plist-put scope :variables (cons variable (plist-get scope :variables))))
+
+(defsubst context-coloring-elisp-scope-has-variable (scope variable)
+ "Check if SCOPE has VARIABLE."
+ (member variable (plist-get scope :variables)))
+
+(defsubst context-coloring-elisp-get-variable-level (variable)
+ "Return the level of VARIABLE, or 0 if it isn't found."
+ (let* ((scope-stack context-coloring-elisp-scope-stack)
+ scope
+ level)
+ (while (and scope-stack (not level))
+ (setq scope (car scope-stack))
+ (cond
+ ((context-coloring-elisp-scope-has-variable scope variable)
+ (setq level (context-coloring-elisp-scope-get-level scope)))
+ (t
+ (setq scope-stack (cdr scope-stack)))))
+ ;; Assume a global variable.
+ (or level 0)))
+
+(defsubst context-coloring-elisp-get-current-scope-level ()
+ "Get the nesting level of the current scope."
+ (cond
+ ((car context-coloring-elisp-scope-stack)
+ (context-coloring-elisp-scope-get-level (car
context-coloring-elisp-scope-stack)))
+ (t
+ 0)))
+
+(defsubst context-coloring-elisp-push-scope ()
+ "Add a new scope to the bottom of the scope chain."
+ (push (context-coloring-elisp-make-scope
+ (1+ (context-coloring-elisp-get-current-scope-level)))
+ context-coloring-elisp-scope-stack))
+
+(defsubst context-coloring-elisp-pop-scope ()
+ "Remove the scope on the bottom of the scope chain."
+ (pop context-coloring-elisp-scope-stack))
+
+(defsubst context-coloring-elisp-add-variable (variable)
+ "Add VARIABLE to the current scope."
+ (context-coloring-elisp-scope-add-variable
+ (car context-coloring-elisp-scope-stack)
+ variable))
+
+(defsubst context-coloring-elisp-parse-bindable (callback)
+ "Parse the symbol at point.
+If the symbol can be bound, invoke CALLBACK with it."
+ (let* ((arg-string (buffer-substring-no-properties
+ (point)
+ (progn (context-coloring-elisp-forward-sexp)
+ (point)))))
+ (when (not (string-match-p
+ context-coloring-elisp-ignored-word-regexp
+ arg-string))
+ (funcall callback arg-string))))
+
+(defun context-coloring-elisp-parse-let-varlist (type)
+ "Parse the list of variable initializers at point.
+If TYPE is `let', all the variables are bound after all their
+initializers are parsed; if TYPE is `let*', each variable is
+bound immediately after its own initializer is parsed."
+ (let ((varlist '())
+ syntax-code)
+ ;; Enter.
+ (forward-char)
+ (context-coloring-elisp-forward-sws)
+ (while (/= (setq syntax-code (context-coloring-get-syntax-code))
+ context-coloring-CLOSE-PARENTHESIS-CODE)
+ (cond
+ ((= syntax-code context-coloring-OPEN-PARENTHESIS-CODE)
+ (forward-char)
+ (context-coloring-elisp-forward-sws)
+ (setq syntax-code (context-coloring-get-syntax-code))
+ (when (context-coloring-elisp-identifier-p syntax-code)
+ (context-coloring-elisp-parse-bindable
+ (lambda (var)
+ (push var varlist)))
+ (context-coloring-elisp-forward-sws)
+ (setq syntax-code (context-coloring-get-syntax-code))
+ (when (/= syntax-code context-coloring-CLOSE-PARENTHESIS-CODE)
+ (context-coloring-elisp-colorize-sexp)))
+ (context-coloring-elisp-forward-sws)
+ ;; Skip past the closing parenthesis.
+ (forward-char))
+ ((context-coloring-elisp-identifier-p syntax-code)
+ (context-coloring-elisp-parse-bindable
+ (lambda (var)
+ (push var varlist))))
+ (t
+ ;; Ignore artifacts.
+ (context-coloring-elisp-forward-sexp)))
+ (when (eq type 'let*)
+ (context-coloring-elisp-add-variable (pop varlist)))
+ (context-coloring-elisp-forward-sws))
+ (when (eq type 'let)
+ (while varlist
+ (context-coloring-elisp-add-variable (pop varlist))))
+ ;; Exit.
+ (forward-char)))
+
+(defun context-coloring-elisp-parse-arglist ()
+ "Parse the list of function arguments at point."
+ (let (syntax-code)
+ ;; Enter.
+ (forward-char)
+ (context-coloring-elisp-forward-sws)
+ (while (/= (setq syntax-code (context-coloring-get-syntax-code))
+ context-coloring-CLOSE-PARENTHESIS-CODE)
+ (cond
+ ((context-coloring-elisp-identifier-p syntax-code)
+ (context-coloring-elisp-parse-bindable
+ (lambda (arg)
+ (context-coloring-elisp-add-variable arg))))
+ (t
+ ;; Ignore artifacts.
+ (context-coloring-elisp-forward-sexp)))
+ (context-coloring-elisp-forward-sws))
+ ;; Exit.
+ (forward-char)))
+
+(defun context-coloring-elisp-skip-callee-name ()
+ "Skip past the opening parenthesis and name of a function."
+ ;; Enter.
+ (forward-char)
+ (context-coloring-elisp-forward-sws)
+ ;; Skip past the function name.
+ (forward-sexp)
+ (context-coloring-elisp-forward-sws))
+
+(defun context-coloring-elisp-colorize-scope (callback)
+ "Color the whole scope at point with its one color.
+Handle a header in CALLBACK."
+ (let ((start (point))
+ (end (progn (forward-sexp)
+ (point))))
+ (context-coloring-elisp-push-scope)
+ ;; Splash the whole thing in one color.
+ (context-coloring-colorize-region
+ start
+ end
+ (context-coloring-elisp-get-current-scope-level))
+ ;; Even if the parse is interrupted, this region should still be colored
+ ;; syntactically.
+ (context-coloring-elisp-colorize-comments-and-strings-in-region
+ start
+ end)
+ (goto-char start)
+ (context-coloring-elisp-skip-callee-name)
+ (funcall callback)
+ (context-coloring-elisp-colorize-region (point) (1- end))
+ ;; Exit.
+ (forward-char)
+ (context-coloring-elisp-pop-scope)))
+
+(defun context-coloring-elisp-parse-header (callback)
+ "Parse a function header at point with CALLBACK."
+ (when (= (context-coloring-get-syntax-code)
context-coloring-OPEN-PARENTHESIS-CODE)
+ (funcall callback)))
+
+(defun context-coloring-elisp-colorize-defun-like (callback)
+ "Color the defun-like function at point.
+Parse the header with CALLBACK."
+ (context-coloring-elisp-colorize-scope
+ (lambda ()
+ (when (context-coloring-elisp-identifier-p
(context-coloring-get-syntax-code))
+ ;; Color the defun's name with the top-level color.
+ (context-coloring-colorize-region
+ (point)
+ (progn (forward-sexp)
+ (point))
+ 0)
+ (context-coloring-elisp-forward-sws)
+ (context-coloring-elisp-parse-header callback)))))
+
+(defun context-coloring-elisp-colorize-defun ()
+ "Color the `defun' at point."
+ (context-coloring-elisp-colorize-defun-like
+ 'context-coloring-elisp-parse-arglist))
+
+(defun context-coloring-elisp-colorize-defadvice ()
+ "Color the `defadvice' at point."
+ (context-coloring-elisp-colorize-defun-like
+ (lambda ()
+ (let (syntax-code)
+ ;; Enter.
+ (forward-char)
+ (context-coloring-elisp-forward-sws)
+ (while (/= (setq syntax-code (context-coloring-get-syntax-code))
+ context-coloring-CLOSE-PARENTHESIS-CODE)
+ (cond
+ ((= syntax-code context-coloring-OPEN-PARENTHESIS-CODE)
+ (context-coloring-elisp-parse-arglist))
+ (t
+ ;; Ignore artifacts.
+ (context-coloring-elisp-forward-sexp)))
+ (context-coloring-elisp-forward-sws))))))
+
+(defun context-coloring-elisp-colorize-lambda-like (callback)
+ "Color the lambda-like function at point.
+Parsing the header with CALLBACK."
+ (context-coloring-elisp-colorize-scope
+ (lambda ()
+ (context-coloring-elisp-parse-header callback))))
+
+(defun context-coloring-elisp-colorize-lambda ()
+ "Color the `lambda' at point."
+ (context-coloring-elisp-colorize-lambda-like
+ 'context-coloring-elisp-parse-arglist))
+
+(defun context-coloring-elisp-colorize-let ()
+ "Color the `let' at point."
+ (context-coloring-elisp-colorize-lambda-like
+ (lambda ()
+ (context-coloring-elisp-parse-let-varlist 'let))))
+
+(defun context-coloring-elisp-colorize-let* ()
+ "Color the `let*' at point."
+ (context-coloring-elisp-colorize-lambda-like
+ (lambda ()
+ (context-coloring-elisp-parse-let-varlist 'let*))))
+
+(defun context-coloring-elisp-colorize-macroexp-let2 ()
+ "Color the `macroexp-let2' at point."
+ (let (syntax-code
+ variable)
+ (context-coloring-elisp-colorize-scope
+ (lambda ()
+ (and
+ (progn
+ (setq syntax-code (context-coloring-get-syntax-code))
+ (context-coloring-elisp-identifier-p syntax-code))
+ (progn
+ (context-coloring-elisp-colorize-sexp)
+ (context-coloring-elisp-forward-sws)
+ (setq syntax-code (context-coloring-get-syntax-code))
+ (context-coloring-elisp-identifier-p syntax-code))
+ (progn
+ (context-coloring-elisp-parse-bindable
+ (lambda (parsed-variable)
+ (setq variable parsed-variable)))
+ (context-coloring-elisp-forward-sws)
+ (when variable
+ (context-coloring-elisp-add-variable variable))))))))
+
+(defun context-coloring-elisp-colorize-cond ()
+ "Color the `cond' at point."
+ (let (syntax-code)
+ (context-coloring-elisp-skip-callee-name)
+ (while (/= (setq syntax-code (context-coloring-get-syntax-code))
+ context-coloring-CLOSE-PARENTHESIS-CODE)
+ (cond
+ ((= syntax-code context-coloring-OPEN-PARENTHESIS-CODE)
+ ;; Colorize inside the parens.
+ (let ((start (point)))
+ (forward-sexp)
+ (context-coloring-elisp-colorize-region
+ (1+ start) (1- (point)))
+ ;; Exit.
+ (forward-char)))
+ (t
+ ;; Ignore artifacts.
+ (context-coloring-elisp-forward-sexp)))
+ (context-coloring-elisp-forward-sws))
+ ;; Exit.
+ (forward-char)))
+
+(defun context-coloring-elisp-colorize-condition-case ()
+ "Color the `condition-case' at point."
+ (let (syntax-code
+ variable
+ case-pos
+ case-end)
+ (context-coloring-elisp-colorize-scope
+ (lambda ()
+ (setq syntax-code (context-coloring-get-syntax-code))
+ ;; Gracefully ignore missing variables.
+ (when (context-coloring-elisp-identifier-p syntax-code)
+ (context-coloring-elisp-parse-bindable
+ (lambda (parsed-variable)
+ (setq variable parsed-variable)))
+ (context-coloring-elisp-forward-sws))
+ (context-coloring-elisp-colorize-sexp)
+ (context-coloring-elisp-forward-sws)
+ ;; Parse the handlers with the error variable in scope.
+ (when variable
+ (context-coloring-elisp-add-variable variable))
+ (while (/= (setq syntax-code (context-coloring-get-syntax-code))
+ context-coloring-CLOSE-PARENTHESIS-CODE)
+ (cond
+ ((= syntax-code context-coloring-OPEN-PARENTHESIS-CODE)
+ (setq case-pos (point))
+ (context-coloring-elisp-forward-sexp)
+ (setq case-end (point))
+ (goto-char case-pos)
+ ;; Enter.
+ (forward-char)
+ (context-coloring-elisp-forward-sws)
+ (setq syntax-code (context-coloring-get-syntax-code))
+ (when (/= syntax-code context-coloring-CLOSE-PARENTHESIS-CODE)
+ ;; Skip the condition name(s).
+ (context-coloring-elisp-forward-sexp)
+ ;; Color the remaining portion of the handler.
+ (context-coloring-elisp-colorize-region
+ (point)
+ (1- case-end)))
+ ;; Exit.
+ (forward-char))
+ (t
+ ;; Ignore artifacts.
+ (context-coloring-elisp-forward-sexp)))
+ (context-coloring-elisp-forward-sws))))))
+
+(defun context-coloring-elisp-colorize-dolist ()
+ "Color the `dolist' at point."
+ (let (syntax-code
+ (index 0))
+ (context-coloring-elisp-colorize-scope
+ (lambda ()
+ (setq syntax-code (context-coloring-get-syntax-code))
+ (when (= syntax-code context-coloring-OPEN-PARENTHESIS-CODE)
+ (forward-char)
+ (context-coloring-elisp-forward-sws)
+ (while (/= (setq syntax-code (context-coloring-get-syntax-code))
+ context-coloring-CLOSE-PARENTHESIS-CODE)
+ (cond
+ ((and
+ (or (= index 0) (= index 2))
+ (context-coloring-elisp-identifier-p syntax-code))
+ ;; Add the first or third name to the scope.
+ (context-coloring-elisp-parse-bindable
+ (lambda (variable)
+ (context-coloring-elisp-add-variable variable))))
+ (t
+ ;; Color artifacts.
+ (context-coloring-elisp-colorize-sexp)))
+ (context-coloring-elisp-forward-sws)
+ (setq index (1+ index)))
+ ;; Exit.
+ (forward-char))))))
+
+(defun context-coloring-elisp-colorize-quote ()
+ "Color the `quote' at point."
+ (let* ((start (point))
+ (end (progn (forward-sexp)
+ (point))))
+ (context-coloring-colorize-region
+ start
+ end
+ (context-coloring-elisp-get-current-scope-level))
+ (context-coloring-elisp-colorize-comments-and-strings-in-region start
end)))
+
+(defvar context-coloring-elisp-callee-dispatch-hash-table
+ (let ((table (make-hash-table :test 'equal)))
+ (dolist (callee '("defun" "defun*" "defsubst" "defmacro" "cl-defun"
"cl-defsubst" "cl-defmacro"))
+ (puthash callee #'context-coloring-elisp-colorize-defun table))
+ (dolist (callee '("condition-case" "condition-case-unless-debug"))
+ (puthash callee #'context-coloring-elisp-colorize-condition-case table))
+ (dolist (callee '("dolist" "dotimes"))
+ (puthash callee #'context-coloring-elisp-colorize-dolist table))
+ (dolist (callee '("let" "gv-letplace"))
+ (puthash callee #'context-coloring-elisp-colorize-let table))
+ (puthash "let*" #'context-coloring-elisp-colorize-let* table)
+ (puthash "macroexp-let2" #'context-coloring-elisp-colorize-macroexp-let2
table)
+ (puthash "lambda" #'context-coloring-elisp-colorize-lambda table)
+ (puthash "cond" #'context-coloring-elisp-colorize-cond table)
+ (puthash "defadvice" #'context-coloring-elisp-colorize-defadvice table)
+ (puthash "quote" #'context-coloring-elisp-colorize-quote table)
+ (puthash "backquote" #'context-coloring-elisp-colorize-backquote table)
+ table)
+ "Map function names to their coloring functions.")
+
+(defun context-coloring-elisp-colorize-parenthesized-sexp ()
+ "Color the sexp enclosed by parenthesis at point."
+ (context-coloring-elisp-increment-sexp-count)
+ (let* ((start (point))
+ (end (progn (forward-sexp)
+ (point)))
+ (syntax-code (progn (goto-char start)
+ (forward-char)
+ ;; Coloring is unnecessary here, it'll happen
+ ;; presently.
+ (context-coloring-forward-sws)
+ (context-coloring-get-syntax-code)))
+ dispatch-function)
+ ;; Figure out if the sexp is a special form.
+ (cond
+ ((and (context-coloring-elisp-identifier-p syntax-code)
+ (setq dispatch-function (gethash
+ (buffer-substring-no-properties
+ (point)
+ (progn (forward-sexp)
+ (point)))
+
context-coloring-elisp-callee-dispatch-hash-table)))
+ (goto-char start)
+ (funcall dispatch-function))
+ ;; Not a special form; just colorize the remaining region.
+ (t
+ (context-coloring-colorize-region
+ start
+ end
+ (context-coloring-elisp-get-current-scope-level))
+ (context-coloring-elisp-colorize-region (point) (1- end))
+ (forward-char)))))
+
+(defun context-coloring-elisp-colorize-symbol ()
+ "Color the symbol at point."
+ (context-coloring-elisp-increment-sexp-count)
+ (let* ((symbol-pos (point))
+ (symbol-end (progn (forward-sexp)
+ (point)))
+ (symbol-string (buffer-substring-no-properties
+ symbol-pos
+ symbol-end)))
+ (cond
+ ((string-match-p context-coloring-elisp-ignored-word-regexp
symbol-string))
+ (t
+ (context-coloring-colorize-region
+ symbol-pos
+ symbol-end
+ (context-coloring-elisp-get-variable-level
+ symbol-string))))))
+
+(defun context-coloring-elisp-colorize-backquote-form ()
+ "Color the backquote form at point."
+ (let ((start (point))
+ (end (progn (forward-sexp)
+ (point)))
+ char)
+ (goto-char start)
+ (while (> end (progn (forward-char)
+ (point)))
+ (setq char (char-after))
+ (when (= char context-coloring-COMMA-CHAR)
+ (forward-char)
+ (when (= (char-after) context-coloring-AT-CHAR)
+ ;; If we don't do this "@" could be interpreted as a symbol.
+ (forward-char))
+ (context-coloring-elisp-forward-sws)
+ (context-coloring-elisp-colorize-sexp)))
+ ;; We could probably do this as part of the above loop but it'd be
+ ;; repetitive.
+ (context-coloring-elisp-colorize-comments-and-strings-in-region
+ start end)))
+
+(defun context-coloring-elisp-colorize-backquote ()
+ "Color the `backquote' at point."
+ (context-coloring-elisp-skip-callee-name)
+ (context-coloring-elisp-colorize-backquote-form)
+ ;; Exit.
+ (forward-char))
+
+(defun context-coloring-elisp-colorize-expression-prefix ()
+ "Color the expression prefix and expression at point.
+It could be a quoted or backquoted expression."
+ (context-coloring-elisp-increment-sexp-count)
+ (cond
+ ((/= (char-after) context-coloring-BACKTICK-CHAR)
+ (context-coloring-elisp-forward-sexp))
+ (t
+ (context-coloring-elisp-colorize-backquote-form))))
+
+(defun context-coloring-elisp-colorize-comment ()
+ "Color the comment at point."
+ (context-coloring-elisp-increment-sexp-count)
+ (context-coloring-elisp-forward-sws))
+
+(defun context-coloring-elisp-colorize-string ()
+ "Color the string at point."
+ (context-coloring-elisp-increment-sexp-count)
+ (let ((start (point)))
+ (forward-sexp)
+ (context-coloring-colorize-comments-and-strings start (point))))
+
+;; Elisp has whitespace, words, symbols, open/close parenthesis, expression
+;; prefix, string quote, comment starters/enders and escape syntax classes
only.
+
+(defun context-coloring-elisp-colorize-sexp ()
+ "Color the sexp at point."
+ (let ((syntax-code (context-coloring-get-syntax-code)))
+ (cond
+ ((= syntax-code context-coloring-OPEN-PARENTHESIS-CODE)
+ (context-coloring-elisp-colorize-parenthesized-sexp))
+ ((context-coloring-elisp-identifier-p syntax-code)
+ (context-coloring-elisp-colorize-symbol))
+ ((= syntax-code context-coloring-EXPRESSION-PREFIX-CODE)
+ (context-coloring-elisp-colorize-expression-prefix))
+ ((= syntax-code context-coloring-STRING-QUOTE-CODE)
+ (context-coloring-elisp-colorize-string))
+ ((= syntax-code context-coloring-ESCAPE-CODE)
+ (forward-char 2)))))
+
+(defun context-coloring-elisp-colorize-comments-and-strings-in-region (start
end)
+ "Color comments and strings between START and END."
+ (let (syntax-code)
+ (goto-char start)
+ (while (> end (progn (skip-syntax-forward "^\"<\\" end)
+ (point)))
+ (setq syntax-code (context-coloring-get-syntax-code))
+ (cond
+ ((= syntax-code context-coloring-STRING-QUOTE-CODE)
+ (context-coloring-elisp-colorize-string))
+ ((= syntax-code context-coloring-COMMENT-START-CODE)
+ (context-coloring-elisp-colorize-comment))
+ ((= syntax-code context-coloring-ESCAPE-CODE)
+ (forward-char 2))))))
+
+(defun context-coloring-elisp-colorize-region (start end)
+ "Color everything between START and END."
+ (let (syntax-code)
+ (goto-char start)
+ (while (> end (progn (skip-syntax-forward "^w_('\"<\\" end)
+ (point)))
+ (setq syntax-code (context-coloring-get-syntax-code))
+ (cond
+ ((= syntax-code context-coloring-OPEN-PARENTHESIS-CODE)
+ (context-coloring-elisp-colorize-parenthesized-sexp))
+ ((context-coloring-elisp-identifier-p syntax-code)
+ (context-coloring-elisp-colorize-symbol))
+ ((= syntax-code context-coloring-EXPRESSION-PREFIX-CODE)
+ (context-coloring-elisp-colorize-expression-prefix))
+ ((= syntax-code context-coloring-STRING-QUOTE-CODE)
+ (context-coloring-elisp-colorize-string))
+ ((= syntax-code context-coloring-COMMENT-START-CODE)
+ (context-coloring-elisp-colorize-comment))
+ ((= syntax-code context-coloring-ESCAPE-CODE)
+ (forward-char 2))))))
+
+(defun context-coloring-elisp-colorize-region-initially (start end)
+ "Begin coloring everything between START and END."
+ (setq context-coloring-elisp-sexp-count 0)
+ (setq context-coloring-elisp-scope-stack '())
+ (let ((inhibit-point-motion-hooks t)
+ (case-fold-search nil)
+ ;; This is a recursive-descent parser, so give it a big stack.
+ (max-lisp-eval-depth (max max-lisp-eval-depth 3000))
+ (max-specpdl-size (max max-specpdl-size 3000)))
+ (context-coloring-elisp-colorize-region start end)))
+
+(defun context-coloring-elisp-colorize-guard (callback)
+ "Silently color in CALLBACK."
(with-silent-modifications
- (let ((i 0)
- (len (length tokens)))
- (while (< i len)
- (context-coloring-colorize-region
- (elt tokens i)
- (elt tokens (+ i 1))
- (elt tokens (+ i 2)))
- (setq i (+ i 3))))
- (context-coloring-maybe-colorize-comments-and-strings)))
-
-(defun context-coloring-parse-array (array)
- "Parse ARRAY as a flat JSON array of numbers."
- (vconcat
- (mapcar 'string-to-number (split-string (substring array 1 -1) ","))))
-
-(defvar-local context-coloring-scopifier-process nil
- "The single scopifier process that can be running.")
-
-(defun context-coloring-kill-scopifier ()
- "Kill the currently-running scopifier process."
- (when (not (null context-coloring-scopifier-process))
- (delete-process context-coloring-scopifier-process)
- (setq context-coloring-scopifier-process nil)))
-
-(defun context-coloring-scopify-shell-command (command callback)
- "Invoke a scopifier via COMMAND, read its response
-asynchronously and invoke CALLBACK with its output."
-
- ;; Prior running tokenization is implicitly obsolete if this function is
- ;; called.
- (context-coloring-kill-scopifier)
-
- ;; Start the process.
- (setq context-coloring-scopifier-process
- (start-process-shell-command "scopifier" nil command))
-
- (let ((output ""))
-
- ;; The process may produce output in multiple chunks. This filter
- ;; accumulates the chunks into a message.
- (set-process-filter
- context-coloring-scopifier-process
- (lambda (_process chunk)
- (setq output (concat output chunk))))
-
- ;; When the process's message is complete, this sentinel parses it as JSON
- ;; and applies the tokens to the buffer.
- (set-process-sentinel
- context-coloring-scopifier-process
- (lambda (_process event)
- (when (equal "finished\n" event)
- (funcall callback output))))))
-
-(defun context-coloring-send-buffer-to-scopifier ()
- "Give the scopifier process its input so it can begin
-scopifying."
- (process-send-region
- context-coloring-scopifier-process
- (point-min) (point-max))
- (process-send-eof
- context-coloring-scopifier-process))
-
-(defun context-coloring-scopify-and-colorize (command &optional callback)
- "Invoke a scopifier via COMMAND with the current buffer's contents,
-read the scopifier's response asynchronously and apply a parsed
-list of tokens to `context-coloring-apply-tokens'.
-
-Invoke CALLBACK when complete."
- (let ((buffer context-coloring-buffer))
- (context-coloring-scopify-shell-command
- command
- (lambda (output)
- (let ((tokens (context-coloring-parse-array output)))
- (with-current-buffer buffer
- (context-coloring-apply-tokens tokens))
- (setq context-coloring-scopifier-process nil)
- (when callback (funcall callback))))))
- (context-coloring-send-buffer-to-scopifier))
+ (save-excursion
+ (condition-case nil
+ (funcall callback)
+ ;; Scan errors can happen virtually anywhere if parenthesis are
+ ;; unbalanced. Just swallow them. (`progn' for test coverage.)
+ (scan-error (progn))))))
+
+(defun context-coloring-elisp-colorize ()
+ "Color the current Emacs Lisp buffer."
+ (interactive)
+ (context-coloring-elisp-colorize-guard
+ (lambda ()
+ (cond
+ ;; Just colorize the changed region.
+ (context-coloring-changed-p
+ (let* ( ;; Prevent `beginning-of-defun' from making poor assumptions.
+ (open-paren-in-column-0-is-defun-start nil)
+ ;; Seek the beginning and end of the previous and next
+ ;; offscreen defuns, so just enough is colored.
+ (start (progn (goto-char context-coloring-changed-start)
+ (while (and (< (point-min) (point))
+ (pos-visible-in-window-p))
+ (end-of-line 0))
+ (beginning-of-defun)
+ (point)))
+ (end (progn (goto-char context-coloring-changed-end)
+ (while (and (> (point-max) (point))
+ (pos-visible-in-window-p))
+ (forward-line 1))
+ (end-of-defun)
+ (point))))
+ (context-coloring-elisp-colorize-region-initially start end)
+ ;; Fast coloring is nice, but if the code is not well-formed
+ ;; (e.g. an unclosed string literal is parsed at any time) then
+ ;; there could be leftover incorrectly-colored code offscreen. So
+ ;; do a clean sweep as soon as appropriate.
+ (context-coloring-schedule-coloring context-coloring-default-delay)))
+ (t
+ (context-coloring-elisp-colorize-region-initially (point-min)
(point-max)))))))
+
+
+;;; eval-expression colorization
+
+(defun context-coloring-eval-expression-match ()
+ "Determine expression start in `eval-expression'."
+ (string-match "\\`Eval: " (buffer-string)))
+
+(defun context-coloring-eval-expression-colorize ()
+ "Color the `eval-expression' minibuffer prompt as elisp."
+ (interactive)
+ (context-coloring-elisp-colorize-guard
+ (lambda ()
+ (context-coloring-elisp-colorize-region-initially
+ (progn
+ (context-coloring-eval-expression-match)
+ (1+ (match-end 0)))
+ (point-max)))))
;;; Dispatch
-(defvar context-coloring-dispatch-hash-table (make-hash-table :test 'eq)
- "Map dispatch strategy names to their corresponding property
- lists, which contain details about the strategies.")
+(defvar context-coloring-dispatch-hash-table (make-hash-table :test #'eq)
+ "Map dispatch strategy names to their property lists.")
-(defvar context-coloring-mode-hash-table (make-hash-table :test 'eq)
+(defvar context-coloring-mode-hash-table (make-hash-table :test #'eq)
"Map major mode names to dispatch property lists.")
-(defun context-coloring-select-dispatch (mode dispatch)
- "Use DISPATCH for MODE."
- (puthash
- mode
- (gethash
- dispatch
- context-coloring-dispatch-hash-table)
- context-coloring-mode-hash-table))
+(defvar context-coloring-dispatch-predicates '()
+ "Functions which may return a dispatch.")
+
+(defun context-coloring-get-current-dispatch ()
+ "Return the first dispatch appropriate for the current state."
+ (let ((predicates context-coloring-dispatch-predicates)
+ (parent major-mode)
+ dispatch)
+ ;; Maybe a predicate will be satisfied and return a dispatch.
+ (while (and predicates
+ (not (setq dispatch (funcall (pop predicates))))))
+ ;; If not, maybe a major mode (or a derivative) will define a dispatch.
+ (when (not dispatch)
+ (while (and parent
+ (not (setq dispatch (gethash parent
context-coloring-mode-hash-table)))
+ (setq parent (get parent 'derived-mode-parent)))))
+ dispatch))
(defun context-coloring-define-dispatch (symbol &rest properties)
"Define a new dispatch named SYMBOL with PROPERTIES.
A \"dispatch\" is a property list describing a strategy for
-coloring a buffer. There are three possible strategies: Parse
-and color in a single function (`:colorizer'), parse in a
-function that returns scope data (`:scopifier'), or parse with a
-shell command that returns scope data (`:command'). In the
-latter two cases, the scope data will be used to automatically
-color the buffer.
+coloring a buffer.
-PROPERTIES must include `:modes' and one of `:colorizer',
-`:scopifier' or `:command'.
+PROPERTIES must include one of `:modes' or `:predicate', and a
+`:colorizer'.
`:modes' - List of major modes this dispatch is valid for.
-`:colorizer' - Symbol referring to a function that parses and
-colors the buffer.
-
-`:scopifier' - Symbol referring to a function that parses the
-buffer a returns a flat vector of start, end and level data.
+`:predicate' - Function that determines if the dispatch is valid
+for any given state.
-`:executable' - Optional name of an executable required by
-`:command'.
+`:colorizer' - Function that parses and colors the buffer.
-`:command' - Shell command to execute with the current buffer
-sent via stdin, and with a flat JSON array of start, end and
-level data returned via stdout.
-
-`:version' - Minimum required version that should be printed when
-executing `:command' with a \"--version\" flag. The version
-should be numeric, e.g. \"2\", \"19700101\", \"1.2.3\",
-\"v1.2.3\" etc.
+`:delay' - Delay between buffer update and colorization, to
+override `context-coloring-default-delay'.
`:setup' - Arbitrary code to set up this dispatch when
`context-coloring-mode' is enabled.
@@ -424,570 +1254,154 @@ should be numeric, e.g. \"2\", \"19700101\", \"1.2.3\",
`:teardown' - Arbitrary code to tear down this dispatch when
`context-coloring-mode' is disabled."
(let ((modes (plist-get properties :modes))
- (colorizer (plist-get properties :colorizer))
- (scopifier (plist-get properties :scopifier))
- (command (plist-get properties :command)))
- (when (null modes)
- (error "No mode defined for dispatch"))
- (when (not (or colorizer
- scopifier
- command))
- (error "No colorizer, scopifier or command defined for dispatch"))
+ (predicate (plist-get properties :predicate))
+ (colorizer (plist-get properties :colorizer)))
+ (when (null (or modes predicate))
+ (error "No mode or predicate defined for dispatch"))
+ (when (not colorizer)
+ (error "No colorizer defined for dispatch"))
(puthash symbol properties context-coloring-dispatch-hash-table)
(dolist (mode modes)
- (when (null (gethash mode context-coloring-mode-hash-table))
- (puthash mode properties context-coloring-mode-hash-table)))))
-
-(context-coloring-define-dispatch
- 'javascript-node
- :modes '(js-mode js3-mode)
- :executable "scopifier"
- :command "scopifier"
- :version "v1.1.1")
+ (puthash mode properties context-coloring-mode-hash-table))
+ (when predicate
+ (push (lambda ()
+ (when (funcall predicate)
+ properties)) context-coloring-dispatch-predicates))))
-(context-coloring-define-dispatch
- 'javascript-js2
- :modes '(js2-mode)
- :colorizer 'context-coloring-js2-colorize
- :setup
- (lambda ()
- (add-hook 'js2-post-parse-callbacks 'context-coloring-colorize nil t))
- :teardown
- (lambda ()
- (remove-hook 'js2-post-parse-callbacks 'context-coloring-colorize t)))
-
-(defun context-coloring-dispatch (&optional callback)
- "Determine the optimal track for scopification / coloring of
-the current buffer, then execute it.
-
-Invoke CALLBACK when complete. It is invoked synchronously for
-elisp tracks, and asynchronously for shell command tracks."
- (let ((dispatch (gethash major-mode context-coloring-mode-hash-table))
- colorizer
- scopifier
- command)
- (cond
- ((setq colorizer (plist-get dispatch :colorizer))
- (funcall colorizer)
- (when callback (funcall callback)))
- ((setq scopifier (plist-get dispatch :scopifier))
- (context-coloring-apply-tokens (funcall scopifier))
- (when callback (funcall callback)))
- ((setq command (plist-get dispatch :command))
- (context-coloring-scopify-and-colorize command callback)))))
+(defun context-coloring-dispatch ()
+ "Determine how to color the current buffer, and color it."
+ (let* ((dispatch (context-coloring-get-current-dispatch))
+ (colorizer (plist-get dispatch :colorizer)))
+ (catch 'interrupted
+ (funcall colorizer))))
;;; Colorization
-(defun context-coloring-colorize (&optional callback)
- "Color the current buffer by function context.
-
-Invoke CALLBACK when complete; see `context-coloring-dispatch'."
+(defun context-coloring-colorize ()
+ "Color the current buffer by function context."
(interactive)
- (context-coloring-dispatch callback))
+ (context-coloring-update-maximum-face)
+ (context-coloring-dispatch))
-(defvar-local context-coloring-changed nil
- "Indication that the buffer has changed recently, which implies
-that it should be colored again by
-`context-coloring-colorize-idle-timer' if that timer is being
-used.")
+(defun context-coloring-colorize-with-buffer (buffer)
+ "Color BUFFER."
+ ;; Don't select deleted buffers.
+ (when (get-buffer buffer)
+ (with-current-buffer buffer
+ (context-coloring-colorize))))
-(defun context-coloring-change-function (_start _end _length)
- "Register a change so that a buffer can be colorized soon."
- ;; Tokenization is obsolete if there was a change.
- (context-coloring-kill-scopifier)
- (setq context-coloring-changed t))
-
-(defun context-coloring-maybe-colorize ()
- "Colorize the current buffer if it has changed."
- (when (and (eq context-coloring-buffer (window-buffer (selected-window)))
- context-coloring-changed)
- (setq context-coloring-changed nil)
- (context-coloring-colorize)))
-
-
-;;; Versioning
-
-(defun context-coloring-parse-version (string)
- "Extract segments of a version STRING into a list. \"v1.0.0\"
-produces (1 0 0), \"19700101\" produces (19700101), etc."
- (let (version)
- (while (string-match "[0-9]+" string)
- (setq version (append version
- (list (string-to-number (match-string 0 string)))))
- (setq string (substring string (match-end 0))))
- version))
-
-(defun context-coloring-check-version (expected actual)
- "Check that version EXPECTED is less than or equal to ACTUAL."
- (let ((expected (context-coloring-parse-version expected))
- (actual (context-coloring-parse-version actual))
- (continue t)
- (acceptable t))
- (while (and continue expected)
- (let ((an-expected (car expected))
- (an-actual (car actual)))
- (cond
- ((> an-actual an-expected)
- (setq acceptable t)
- (setq continue nil))
- ((< an-actual an-expected)
- (setq acceptable nil)
- (setq continue nil))))
- (setq expected (cdr expected))
- (setq actual (cdr actual)))
- acceptable))
-
-(defvar context-coloring-check-scopifier-version-hook nil
- "Hooks to run after checking the scopifier version.")
-
-(defun context-coloring-check-scopifier-version (&optional callback)
- "Asynchronously invoke CALLBACK with a predicate indicating
-whether the current scopifier version satisfies the minimum
-version number required for the current major mode."
- (let ((dispatch (gethash major-mode context-coloring-mode-hash-table)))
- (when dispatch
- (let ((version (plist-get dispatch :version))
- (command (plist-get dispatch :command)))
- (context-coloring-scopify-shell-command
- (context-coloring-join (list command "--version") " ")
- (lambda (output)
- (if (context-coloring-check-version version output)
- (progn
- (when callback (funcall callback t)))
- (when callback (funcall callback nil)))
- (run-hooks 'context-coloring-check-scopifier-version-hook)))))))
-
-
-;;; Themes
-
-(defvar context-coloring-theme-hash-table (make-hash-table :test 'eq)
- "Map theme names to theme properties.")
-
-(defun context-coloring-theme-p (theme)
- "Return t if THEME is defined, nil otherwise."
- (and (gethash theme context-coloring-theme-hash-table)))
-(defconst context-coloring-level-face-regexp
- "context-coloring-level-\\([[:digit:]]+\\)-face"
- "Extract a level from a face.")
+;;; Built-in dispatches
-(defvar context-coloring-originally-set-theme-hash-table
- (make-hash-table :test 'eq)
- "Cache custom themes who originally set their own
- `context-coloring-level-N-face' faces.")
-
-(defun context-coloring-theme-originally-set-p (theme)
- "Return t if there is a `context-coloring-level-N-face'
-originally set for THEME, nil otherwise."
- (let (originally-set)
- (cond
- ;; `setq' might return a non-nil value for the sake of this `cond'.
- ((setq
- originally-set
- (gethash
- theme
- context-coloring-originally-set-theme-hash-table))
- (eq originally-set 'yes))
- (t
- (let* ((settings (get theme 'theme-settings))
- (tail settings)
- found)
- (while (and tail (not found))
- (and (eq (nth 0 (car tail)) 'theme-face)
- (string-match
- context-coloring-level-face-regexp
- (symbol-name (nth 1 (car tail))))
- (setq found t))
- (setq tail (cdr tail)))
- found)))))
-
-(defun context-coloring-cache-originally-set (theme originally-set)
- "Remember if THEME had colors originally set for it. If
-ORIGINALLY-SET is non-nil, it did, otherwise it didn't."
- ;; Caching whether a theme was originally set is kind of dirty, but we have
to
- ;; do it to remember the past state of the theme. There are probably some
- ;; edge cases where caching will be an issue, but they are probably rare.
- (puthash
- theme
- (if originally-set 'yes 'no)
- context-coloring-originally-set-theme-hash-table))
-
-(defun context-coloring-warn-theme-originally-set (theme)
- "Warn the user that the colors for THEME are already originally
-set."
- (warn "Context coloring colors for theme `%s' are already defined" theme))
+(context-coloring-define-dispatch
+ 'javascript
+ :modes '(js2-mode)
+ :colorizer #'context-coloring-js2-colorize
+ :setup
+ (lambda ()
+ (add-hook 'js2-post-parse-callbacks #'context-coloring-colorize nil t))
+ :teardown
+ (lambda ()
+ (remove-hook 'js2-post-parse-callbacks #'context-coloring-colorize t)))
-(defun context-coloring-theme-highest-level (theme)
- "Return the highest level N of a face like
-`context-coloring-level-N-face' set for THEME, or `-1' if there
-is none."
- (let* ((settings (get theme 'theme-settings))
- (tail settings)
- face-string
- number
- (found -1))
- (while tail
- (and (eq (nth 0 (car tail)) 'theme-face)
- (setq face-string (symbol-name (nth 1 (car tail))))
- (string-match
- context-coloring-level-face-regexp
- face-string)
- (setq number (string-to-number
- (substring face-string
- (match-beginning 1)
- (match-end 1))))
- (> number found)
- (setq found number))
- (setq tail (cdr tail)))
- found))
+(context-coloring-define-dispatch
+ 'emacs-lisp
+ :modes '(emacs-lisp-mode)
+ :colorizer #'context-coloring-elisp-colorize
+ :delay 0.016 ;; Thanks to lazy colorization this can be 60 frames per second.
+ :setup #'context-coloring-setup-idle-change-detection
+ :teardown #'context-coloring-teardown-idle-change-detection)
+
+;; `eval-expression-minibuffer-setup-hook' is not available in Emacs 24.3, so
+;; the backwards-compatible recommendation is to use `minibuffer-setup-hook'
and
+;; rely on this predicate instead.
+(defun context-coloring-eval-expression-predicate ()
+ "Non-nil if the minibuffer is for `eval-expression'."
+ ;; Kinda better than checking `this-command', because `this-command' changes.
+ (context-coloring-eval-expression-match))
-(defun context-coloring-apply-theme (theme)
- "Apply THEME's properties to its respective custom theme,
-which must already exist and which *should* already be enabled."
- (let* ((properties (gethash theme context-coloring-theme-hash-table))
- (colors (plist-get properties :colors))
- (level -1))
- (setq context-coloring-maximum-face (- (length colors) 1))
- (apply
- 'custom-theme-set-faces
- theme
- (mapcar
- (lambda (color)
- (setq level (+ level 1))
- `(,(context-coloring-level-face level) ((t (:foreground ,color)))))
- colors))))
-
-(defun context-coloring-define-theme (theme &rest properties)
- "Define a context theme named THEME for coloring scope levels.
-
-PROPERTIES is a property list specifiying the following details:
-
-`:aliases': List of symbols of other custom themes that these
-colors are applicable to.
-
-`:colors': List of colors that this context theme uses.
-
-`:override': If non-nil, this context theme is intentionally
-overriding colors set by a custom theme. Don't set this non-nil
-unless there is a custom theme you want to use which sets
-`context-coloring-level-N-face' faces that you want to replace.
-
-`:recede': If non-nil, this context theme should not apply its
-colors if a custom theme already sets
-`context-coloring-level-N-face' faces. This option is
-optimistic; set this non-nil if you would rather confer the duty
-of picking colors to a custom theme author (if / when he ever
-gets around to it).
-
-By default, context themes will always override custom themes,
-even if those custom themes set `context-coloring-level-N-face'
-faces. If a context theme does override a custom theme, a
-warning will be raised, at which point you may want to enable the
-`:override' option, or just delete your context theme and opt to
-use your custom theme's author's colors instead.
-
-Context themes only work for the custom theme with the highest
-precedence, i.e. the car of `custom-enabled-themes'."
- (let ((aliases (plist-get properties :aliases))
- (override (plist-get properties :override))
- (recede (plist-get properties :recede)))
- (dolist (name (append `(,theme) aliases))
- (puthash name properties context-coloring-theme-hash-table)
- (when (custom-theme-p name)
- (let ((originally-set (context-coloring-theme-originally-set-p name)))
- (context-coloring-cache-originally-set name originally-set)
- ;; In the particular case when you innocently define colors that a
- ;; custom theme originally set, warn. Arguably this only has to be
- ;; done at enable time, but it is probably more useful to do it at
- ;; definition time for prompter feedback.
- (when (and originally-set
- (not recede)
- (not override))
- (context-coloring-warn-theme-originally-set name))
- ;; Set (or overwrite) colors.
- (when (not (and originally-set
- recede))
- (context-coloring-apply-theme name)))))))
-
-(defun context-coloring-enable-theme (theme)
- "Apply THEME if its colors are not already set, else just set
-`context-coloring-maximum-face' to the correct value for THEME."
- (let* ((properties (gethash theme context-coloring-theme-hash-table))
- (recede (plist-get properties :recede))
- (override (plist-get properties :override)))
- (cond
- (recede
- (let ((highest-level (context-coloring-theme-highest-level theme)))
- (cond
- ;; This can be true whether originally set by a custom theme or by a
- ;; context theme.
- ((> highest-level -1)
- (setq context-coloring-maximum-face highest-level))
- ;; It is possible that the corresponding custom theme did not exist at
- ;; the time of defining this context theme, and in that case the above
- ;; condition proves the custom theme did not originally set any faces,
- ;; so we have license to apply the context theme for the first time
- ;; here.
- (t
- (context-coloring-apply-theme theme)))))
- (t
- (let ((originally-set (context-coloring-theme-originally-set-p theme)))
- ;; Cache now in case the context theme was defined after the custom
- ;; theme.
- (context-coloring-cache-originally-set theme originally-set)
- (when (and originally-set
- (not override))
- (context-coloring-warn-theme-originally-set theme))
- (context-coloring-apply-theme theme))))))
-
-(defadvice enable-theme (after context-coloring-enable-theme (theme) activate)
- "Enable colors for context themes just-in-time."
- (when (and (not (eq theme 'user)) ; Called internally by `enable-theme'.
- (custom-theme-p theme) ; Guard against non-existent themes.
- (context-coloring-theme-p theme))
- (when (= (length custom-enabled-themes) 0)
- ;; Cache because we can't reliably figure it out in reverse.
- (setq context-coloring-original-maximum-face
- context-coloring-maximum-face))
- (context-coloring-enable-theme theme)))
-
-(defadvice disable-theme (after context-coloring-disable-theme (theme)
activate)
- "Update `context-coloring-maximum-face'."
- (when (custom-theme-p theme) ; Guard against non-existent themes.
- (let ((enabled-theme (car custom-enabled-themes)))
- (if (context-coloring-theme-p enabled-theme)
- (progn
- (context-coloring-enable-theme enabled-theme))
- ;; Assume we are back to no theme; act as if nothing ever happened.
- ;; This is still prone to intervention, but rather extraordinarily.
- (setq context-coloring-maximum-face
- context-coloring-original-maximum-face)))))
-
-(context-coloring-define-theme
- 'ample
- :recede t
- :colors '("#bdbdb3"
- "#baba36"
- "#6aaf50"
- "#5180b3"
- "#ab75c3"
- "#cd7542"
- "#dF9522"
- "#454545"))
-
-(context-coloring-define-theme
- 'anti-zenburn
- :recede t
- :colors '("#232333"
- "#6c1f1c"
- "#401440"
- "#0f2050"
- "#205070"
- "#336c6c"
- "#23733c"
- "#6b400c"
- "#603a60"
- "#2f4070"
- "#235c5c"))
-
-(context-coloring-define-theme
- 'grandshell
- :recede t
- :colors '("#bebebe"
- "#5af2ee"
- "#b2baf6"
- "#f09fff"
- "#efc334"
- "#f6df92"
- "#acfb5a"
- "#888888"))
-
-(context-coloring-define-theme
- 'leuven
- :recede t
- :colors '("#333333"
- "#0000FF"
- "#6434A3"
- "#BA36A5"
- "#D0372D"
- "#036A07"
- "#006699"
- "#006FE0"
- "#808080"))
-
-(context-coloring-define-theme
- 'monokai
- :recede t
- :colors '("#F8F8F2"
- "#66D9EF"
- "#A1EFE4"
- "#A6E22E"
- "#E6DB74"
- "#FD971F"
- "#F92672"
- "#FD5FF0"
- "#AE81FF"))
-
-(context-coloring-define-theme
- 'solarized
- :recede t
- :aliases '(solarized-light
- solarized-dark
- sanityinc-solarized-light
- sanityinc-solarized-dark)
- :colors '("#839496"
- "#268bd2"
- "#2aa198"
- "#859900"
- "#b58900"
- "#cb4b16"
- "#dc322f"
- "#d33682"
- "#6c71c4"
- "#69B7F0"
- "#69CABF"
- "#B4C342"
- "#DEB542"
- "#F2804F"
- "#FF6E64"
- "#F771AC"
- "#9EA0E5"))
-
-(context-coloring-define-theme
- 'spacegray
- :recede t
- :colors '("#ffffff"
- "#89AAEB"
- "#C189EB"
- "#bf616a"
- "#DCA432"
- "#ebcb8b"
- "#B4EB89"
- "#89EBCA"))
-
-(context-coloring-define-theme
- 'tango
- :recede t
- :colors '("#2e3436"
- "#346604"
- "#204a87"
- "#5c3566"
- "#a40000"
- "#b35000"
- "#c4a000"
- "#8ae234"
- "#8cc4ff"
- "#ad7fa8"
- "#ef2929"
- "#fcaf3e"
- "#fce94f"))
-
-(context-coloring-define-theme
- 'zenburn
- :recede t
- :colors '("#DCDCCC"
- "#93E0E3"
- "#BFEBBF"
- "#F0DFAF"
- "#DFAF8F"
- "#CC9393"
- "#DC8CC3"
- "#94BFF3"
- "#9FC59F"
- "#D0BF8F"
- "#DCA3A3"))
+(context-coloring-define-dispatch
+ 'eval-expression
+ :predicate #'context-coloring-eval-expression-predicate
+ :colorizer #'context-coloring-eval-expression-colorize
+ :delay 0.016
+ :setup #'context-coloring-setup-idle-change-detection
+ :teardown #'context-coloring-teardown-idle-change-detection)
+
+(defvar context-coloring-ignore-unavailable-predicates
+ (list
+ #'minibufferp)
+ "Cases when \"unavailable\" messages are silenced.
+Necessary in editing states where coloring is only sometimes
+permissible.")
+
+(defun context-coloring-ignore-unavailable-message-p ()
+ "Determine if the unavailable message should be silenced."
+ (let ((predicates context-coloring-ignore-unavailable-predicates)
+ (ignore-p nil))
+ (while (and predicates
+ (not ignore-p))
+ (setq ignore-p (funcall (pop predicates))))
+ ignore-p))
;;; Minor mode
-(defvar-local context-coloring-colorize-idle-timer nil
- "The currently-running idle timer.")
+;;;###autoload
+(define-minor-mode context-coloring-mode
+ "Toggle contextual code coloring.
+With a prefix argument ARG, enable Context Coloring mode if ARG
+is positive, and disable it otherwise. If called from Lisp,
+enable the mode if ARG is omitted or nil.
-(defcustom context-coloring-delay 0.25
- "Delay between a buffer update and colorization.
+Context Coloring mode is a buffer-local minor mode. When
+enabled, code is colored by scope. Scopes are colored
+hierarchically. Variables referenced from nested scopes retain
+the color of their defining scopes. Certain syntax, like
+comments and strings, is still colored with `font-lock'.
-Increase this if your machine is high-performing. Decrease it if
-it ain't.
+The entire buffer is colored initially. Changes to the buffer
+trigger recoloring.
-Supported modes: `js-mode', `js3-mode'"
- :group 'context-coloring)
+Define your own colors by customizing faces like
+`context-coloring-level-N-face', where N is a number starting
+from 0. If no face is found on a custom theme nor the `user'
+theme, the defaults are used.
-(defun context-coloring-setup-idle-change-detection ()
- "Setup idle change detection."
- (add-hook
- 'after-change-functions 'context-coloring-change-function nil t)
- (setq context-coloring-colorize-idle-timer
- (run-with-idle-timer
- context-coloring-delay
- t
- 'context-coloring-maybe-colorize)))
+New language / major mode support can be added with
+`context-coloring-define-dispatch', which see.
-;;;###autoload
-(define-minor-mode context-coloring-mode
- "Context-based code coloring, inspired by Douglas Crockford."
+Feature inspired by Douglas Crockford."
nil " Context" nil
- (if (not context-coloring-mode)
- (progn
- (context-coloring-kill-scopifier)
- (when context-coloring-colorize-idle-timer
- (cancel-timer context-coloring-colorize-idle-timer))
- (let ((dispatch (gethash major-mode context-coloring-mode-hash-table)))
- (when dispatch
- (let ((command (plist-get dispatch :command))
- (teardown (plist-get dispatch :teardown)))
- (when command
- (remove-hook
- 'after-change-functions 'context-coloring-change-function t))
- (when teardown
- (funcall teardown)))))
- (font-lock-mode)
- (jit-lock-mode t))
-
- ;; Remember this buffer. This value should not be dynamically-bound.
- (setq context-coloring-buffer (current-buffer))
-
+ (cond
+ (context-coloring-mode
;; Font lock is incompatible with this mode; the converse is also true.
(font-lock-mode 0)
(jit-lock-mode nil)
-
- ;; Safely change the valye of this function as necessary.
+ ;; ...but we do use font-lock functions here.
+ (font-lock-set-defaults)
+ ;; Safely change the value of this function as necessary.
(make-local-variable 'font-lock-syntactic-face-function)
-
- (let ((dispatch (gethash major-mode context-coloring-mode-hash-table)))
- (if dispatch
- (progn
- (let ((command (plist-get dispatch :command))
- (version (plist-get dispatch :version))
- (executable (plist-get dispatch :executable))
- (setup (plist-get dispatch :setup))
- (colorize-initially-p t))
- (when command
- ;; Shell commands recolor on change, idly.
- (cond
- ((and executable
- (null (executable-find executable)))
- (message "Executable \"%s\" not found" executable)
- (setq colorize-initially-p nil))
- (version
- (context-coloring-check-scopifier-version
- (lambda (sufficient-p)
- (if sufficient-p
- (progn
- (context-coloring-setup-idle-change-detection)
- (context-coloring-colorize))
- (message "Update to the minimum version of \"%s\" (%s)"
- executable version))))
- (setq colorize-initially-p nil))
- (t
- (context-coloring-setup-idle-change-detection))))
- (when setup
- (funcall setup))
- ;; Colorize once initially.
- (when colorize-initially-p
- (context-coloring-colorize))))
- (when (null dispatch)
- (message "Context coloring is not available for this major
mode"))))))
+ (let ((dispatch (context-coloring-get-current-dispatch)))
+ (cond
+ (dispatch
+ (let ((setup (plist-get dispatch :setup)))
+ (when setup
+ (funcall setup))
+ ;; Colorize once initially.
+ (let ((context-coloring-parse-interruptable-p nil))
+ (context-coloring-colorize))))
+ ((not (context-coloring-ignore-unavailable-message-p))
+ (message "Context coloring is unavailable here")))))
+ (t
+ (let ((dispatch (context-coloring-get-current-dispatch)))
+ (when dispatch
+ (let ((teardown (plist-get dispatch :teardown)))
+ (when teardown
+ (funcall teardown)))))
+ (font-lock-mode)
+ (jit-lock-mode t))))
(provide 'context-coloring)
diff --git a/packages/context-coloring/scopifier.png
b/packages/context-coloring/scopifier.png
deleted file mode 100644
index 1ec5d10..0000000
Binary files a/packages/context-coloring/scopifier.png and /dev/null differ
diff --git a/packages/context-coloring/scripts/dependencies
b/packages/context-coloring/scripts/dependencies
deleted file mode 100644
index c2a9107..0000000
--- a/packages/context-coloring/scripts/dependencies
+++ /dev/null
@@ -1,2 +0,0 @@
-https://raw.githubusercontent.com/mooz/js2-mode/master/js2-mode.el
-https://raw.githubusercontent.com/rejeep/ert-async.el/master/ert-async.el
diff --git a/packages/context-coloring/scripts/download-dependencies.el
b/packages/context-coloring/scripts/download-dependencies.el
deleted file mode 100644
index 2ab24e2..0000000
--- a/packages/context-coloring/scripts/download-dependencies.el
+++ /dev/null
@@ -1,61 +0,0 @@
-;;; scripts/download-dependencies.el --- Get files for development. -*-
lexical-binding: t; -*-
-
-;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
-
-;; 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 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/>.
-
-;; Download dependencies for development.
-
-;; Dependencies don't need to be version-controlled. They are also
-;; bleeding-edge, which is good because that is what most MELPA users are
using.
-
-;;; Code:
-
-(defconst download-dependencies-directory
- (file-name-directory (or load-file-name buffer-file-name))
- "This file's directory.")
-
-(defun download-dependencies-resolve-path (path)
- "Resolve a path relative to this file's directory."
- (expand-file-name path download-dependencies-directory))
-
-(defun download-dependencies-strip-headers ()
- "Remove the http headers included in the output of
-`url-retrieve-synchronously'."
- (goto-char 1)
- (kill-paragraph 1) ; The headers are 1 paragraph. I hope.
- (kill-line)) ; A line separates the headers from the file's content.
-
-(defun download-dependencies-get-dependencies ()
- "Read the `dependencies' file as a list of URLs."
- (with-temp-buffer
- (insert-file-contents (download-dependencies-resolve-path
"./dependencies"))
- (split-string (buffer-substring-no-properties (point-min) (point-max)))))
-
-(defun download-dependencies ()
- "Download dependencies for development."
- (let ((files (download-dependencies-get-dependencies)))
- (make-directory (download-dependencies-resolve-path "../libraries") t)
- (dolist (file files)
- (let* ((basename (file-name-nondirectory file))
- (destination (download-dependencies-resolve-path
- (concat "../libraries/" basename))))
- (unless (file-exists-p destination)
- (with-current-buffer (url-retrieve-synchronously file)
- (download-dependencies-strip-headers)
- (write-file destination)))))))
-
-;;; download-dependencies.el ends here
diff --git a/packages/context-coloring/test/binaries/outta-date
b/packages/context-coloring/test/binaries/outta-date
deleted file mode 100755
index 3ac2dd5..0000000
--- a/packages/context-coloring/test/binaries/outta-date
+++ /dev/null
@@ -1,5 +0,0 @@
-#!/usr/bin/env node
-
-'use strict';
-
-console.log('v2.0.4');
diff --git a/packages/context-coloring/test/context-coloring-coverage.el
b/packages/context-coloring/test/context-coloring-coverage.el
new file mode 100644
index 0000000..107908c
--- /dev/null
+++ b/packages/context-coloring/test/context-coloring-coverage.el
@@ -0,0 +1,155 @@
+;;; context-coloring-coverage.el --- Test coverage for context coloring -*-
lexical-binding: t; -*-
+
+;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
+
+;; 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 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 coverage support for context coloring.
+
+;; Use with `make cover'.
+
+;;; Code:
+
+(require 'json)
+(require 'undercover)
+
+
+(defconst context-coloring-coverage-directory
+ (file-name-directory (or load-file-name buffer-file-name))
+ "This file's directory.")
+
+(defun context-coloring-coverage-resolve-path (path)
+ "Resolve PATH from this file's directory."
+ (expand-file-name path context-coloring-coverage-directory))
+
+(defconst context-coloring-coverage-output-file-prefix
+ (format-time-string "%s"))
+
+(defconst context-coloring-coverage-output-directory
+ (context-coloring-coverage-resolve-path "./coverage/"))
+
+(defconst context-coloring-coverage-output-file
+ (concat context-coloring-coverage-output-directory
+ context-coloring-coverage-output-file-prefix ".json"))
+
+(defconst context-coloring-coverage-report-file
+ (concat context-coloring-coverage-output-directory
+ context-coloring-coverage-output-file-prefix ".txt"))
+
+(defun context-coloring-coverage-join (strings delimiter)
+ "Join a list of STRINGS with the string DELIMITER."
+ (mapconcat #'identity strings delimiter))
+
+(defun context-coloring-coverage-percentage (dividend divisor)
+ "Get the percentage of DIVIDEND / DIVISOR with precision 2."
+ (let ((percentage (/ (float (round (* (/ (float dividend) divisor) 10000)))
100)))
+ (number-to-string
+ (cond
+ ((= (mod percentage 1) 0)
+ ;; Get an integer because we don't like dangling zeros.
+ (round percentage))
+ (t
+ percentage)))))
+
+(defun context-coloring-coverage-format-source-file (source-file)
+ "Generate a report for SOURCE-FILE's line coverage."
+ (let* ((source-lines (split-string (cdr (assq 'source source-file)) "\n"))
+ (coverage (cdr (assq 'coverage source-file)))
+ (results (list "Hits | Source"
+ (context-coloring-coverage-join (make-vector 80 "-")
"")))
+ (lines-hit 0)
+ (lines-hittable 0)
+ hits
+ source-line)
+ (while coverage
+ (setq hits (car coverage))
+ (setq coverage (cdr coverage))
+ (setq source-line (car source-lines))
+ (setq source-lines (cdr source-lines))
+ (when (not (null hits))
+ (setq lines-hittable (+ lines-hittable 1))
+ (when (> hits 0)
+ (setq lines-hit (+ lines-hit 1))))
+ (setq results
+ (append results
+ (list (format
+ "%-5s %s %s"
+ (if hits hits "N/A")
+ (if (and hits (= hits 0)) "~" "|")
+ source-line)))))
+ (setq results
+ (append results
+ (list
+ ""
+ (format
+ "Lines: %s / %s"
+ lines-hit
+ lines-hittable)
+ (format
+ "Coverage: %s%%"
+ (context-coloring-coverage-percentage lines-hit
lines-hittable)))))
+ (context-coloring-coverage-join results "\n")))
+
+(defun context-coloring-coverage-format (coverage-data)
+ "Generate reports for all files in COVERAGE-DATA."
+ (context-coloring-coverage-join
+ (mapcar
+ #'context-coloring-coverage-format-source-file
+ (cdr (assq 'source_files coverage-data)))
+ "\n"))
+
+(defun context-coloring-coverage-local-init ()
+ "Initialize test coverage for local viewing."
+ (make-directory context-coloring-coverage-output-directory t)
+ (setq undercover-force-coverage t)
+ (setenv "COVERALLS_REPO_TOKEN" "noop")
+ (undercover "context-coloring.el"
+ (:report-file context-coloring-coverage-output-file)
+ (:send-report nil))
+ (add-hook
+ 'kill-emacs-hook
+ (lambda ()
+ (let (original-json-array-type
+ coverage-data
+ report)
+ (with-temp-buffer
+ (insert-file-contents-literally context-coloring-coverage-output-file)
+ (setq original-json-array-type json-array-type)
+ (setq json-array-type 'list)
+ (setq coverage-data
+ (json-read-from-string
+ (buffer-substring-no-properties (point-min) (point-max))))
+ (setq json-array-type original-json-array-type)
+ (setq report
+ (context-coloring-coverage-format coverage-data))
+ (setq report (concat report "\n")))
+ (princ report)
+ (with-temp-buffer
+ (insert report)
+ (write-file context-coloring-coverage-report-file))))
+ t)
+ (require 'context-coloring))
+
+(defun context-coloring-coverage-ci-init ()
+ "Initialize test coverage for continuous integration."
+ (undercover "context-coloring.el")
+ (require 'context-coloring))
+
+(provide 'context-coloring-coverage)
+
+;;; context-coloring-coverage.el ends here
diff --git a/packages/context-coloring/test/context-coloring-test.el
b/packages/context-coloring/test/context-coloring-test.el
index cbd2002..c57dce2 100644
--- a/packages/context-coloring/test/context-coloring-test.el
+++ b/packages/context-coloring/test/context-coloring-test.el
@@ -1,4 +1,4 @@
-;;; test/context-coloring-test.el --- Tests for context coloring. -*-
lexical-binding: t; -*-
+;;; context-coloring-test.el --- Tests for context coloring -*-
lexical-binding: t; -*-
;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
@@ -19,17 +19,15 @@
;;; Commentary:
-;; Tests for context-coloring.
+;; Tests for context coloring.
-;; Tests for both synchronous (elisp) and asynchronous (shell command) coloring
-;; are available. Basic plugin functionality is also tested.
-
-;; To run, execute `make test' from the project root.
+;; Use with `make test'.
;;; Code:
+(require 'cl-lib)
(require 'context-coloring)
-(require 'ert-async)
+(require 'ert)
(require 'js2-mode)
@@ -40,202 +38,110 @@
"This file's directory.")
(defun context-coloring-test-read-file (path)
- "Read a file's contents from PATH into a string."
+ "Return the file's contents from PATH as a string."
(with-temp-buffer
(insert-file-contents (expand-file-name path context-coloring-test-path))
(buffer-string)))
-(defun context-coloring-test-setup ()
- "Prepare before all tests."
- (setq context-coloring-comments-and-strings nil))
-
-(defun context-coloring-test-cleanup ()
- "Cleanup after all tests."
- (setq context-coloring-comments-and-strings t)
- (setq context-coloring-syntactic-comments nil)
- (setq context-coloring-syntactic-strings nil)
- (setq context-coloring-js-block-scopes nil)
- (setq context-coloring-check-scopifier-version-hook nil))
-
(defmacro context-coloring-test-with-fixture (fixture &rest body)
- "With the relative FIXTURE, evaluate BODY in a temporary
-buffer."
+ "With relative FIXTURE, evaluate BODY in a temporary buffer."
`(with-temp-buffer
- (unwind-protect
- (progn
- (context-coloring-test-setup)
- (insert (context-coloring-test-read-file ,fixture))
- ,@body)
- (context-coloring-test-cleanup))))
-
-(defun context-coloring-test-with-temp-buffer-async (callback)
- "Create a temporary buffer, and evaluate CALLBACK there. A
-teardown callback is passed to CALLBACK for it to invoke when it
-is done."
- (let ((previous-buffer (current-buffer))
- (temp-buffer (generate-new-buffer " *temp*")))
- (set-buffer temp-buffer)
- (funcall
- callback
- (lambda ()
- (and (buffer-name temp-buffer)
- (kill-buffer temp-buffer))
- (set-buffer previous-buffer)))))
-
-(defun context-coloring-test-with-fixture-async
- (fixture callback &optional setup)
- "With the relative FIXTURE, evaluate CALLBACK in a temporary
-buffer. A teardown callback is passed to CALLBACK for it to
-invoke when it is done. An optional SETUP callback can run
-arbitrary code before the mode is invoked."
- (context-coloring-test-with-temp-buffer-async
- (lambda (done-with-temp-buffer)
- (context-coloring-test-setup)
- (when setup (funcall setup))
- (insert (context-coloring-test-read-file fixture))
- (funcall
- callback
- (lambda ()
- (context-coloring-test-cleanup)
- (funcall done-with-temp-buffer))))))
+ (progn
+ (insert (context-coloring-test-read-file ,fixture))
+ ,@body)))
;;; Test defining utilities
-(defun context-coloring-test-js-mode (fixture callback &optional setup)
- "Use FIXTURE as the subject matter for test logic in CALLBACK.
-Optionally, provide setup code to run before the mode is
-instantiated in SETUP."
- (context-coloring-test-with-fixture-async
- fixture
- (lambda (done-with-test)
- (js-mode)
- (context-coloring-mode)
- (context-coloring-colorize
- (lambda ()
- (funcall callback done-with-test))))
- setup))
-
-(defmacro context-coloring-test-js2-mode (fixture setup &rest body)
- "Use FIXTURE as the subject matter for test logic in BODY."
- `(context-coloring-test-with-fixture
- ,fixture
- (require 'js2-mode)
- (setq js2-mode-show-parse-errors nil)
- (setq js2-mode-show-strict-warnings nil)
- (js2-mode)
- (when ,setup (funcall ,setup))
- (context-coloring-mode)
- ,@body))
-
-(cl-defmacro context-coloring-test-deftest-js-mode (name &key fixture-name)
- "Define an asynchronous test for `js-mode' with the name NAME
-in the typical format."
+(cl-defmacro context-coloring-test-define-deftest (name
+ &key mode
+ &key extension
+ &key no-fixture
+ &key
enable-context-coloring-mode
+ &key before-each
+ &key after-each)
+ "Define a deftest defmacro for tests prefixed with NAME. MODE
+is called to set up tests' environments. EXTENSION denotes the
+suffix for tests' fixture files. If NO-FIXTURE is non-nil, don't
+use a fixture. If ENABLE-CONTEXT-COLORING-MODE is non-nil,
+`context-coloring-mode' is activated before tests. Functions
+BEFORE-EACH and AFTER-EACH run before the major mode is activated
+before each test, and after each test, even if an error is
+signaled."
(declare (indent defun))
- (let ((test-name (intern (format "context-coloring-test-js-mode-%s" name)))
- (fixture (format "./fixtures/%s.js" (or fixture-name name)))
- (function-name (intern-soft
- (format "context-coloring-test-js-%s" name)))
- (setup-function-name (intern-soft
- (format
- "context-coloring-test-js-%s-setup" name))))
- `(ert-deftest-async ,test-name (done)
- (context-coloring-test-js-mode
- ,fixture
- (lambda (teardown)
- (unwind-protect
- (,function-name)
- (funcall teardown))
- (funcall done))
- ',setup-function-name))))
-
-(cl-defmacro context-coloring-test-deftest-js2-mode (name &key fixture-name)
- "Define a test for `js2-mode' with the name NAME in the typical
-format."
- (declare (indent defun))
- (let ((test-name (intern (format "context-coloring-test-js2-mode-%s" name)))
- (fixture (format "./fixtures/%s.js" (or fixture-name name)))
- (function-name (intern-soft
- (format "context-coloring-test-js-%s" name)))
- (setup-function-name (intern-soft
- (format
- "context-coloring-test-js-%s-setup" name))))
- `(ert-deftest ,test-name ()
- (context-coloring-test-js2-mode
- ,fixture
- ',setup-function-name
- (,function-name)))))
+ (let ((macro-name (intern (format "context-coloring-test-deftest%s"
+ (cond
+ ;; No name means no dash.
+ ((eq name nil) "")
+ (t (format "-%s" name)))))))
+ `(cl-defmacro ,macro-name (name
+ body
+ &key fixture
+ &key before
+ &key after)
+ (declare (indent defun))
+ ;; Commas in nested backquotes are not evaluated. Binding the variables
+ ;; here is probably the cleanest workaround.
+ (let ((mode ,mode)
+ (before-each ',before-each)
+ (after-each ',after-each)
+ (test-name (intern (format ,(format "%s-%%s"
+ (cond
+ (name)
+ (t "generic"))) name)))
+ (fixture (cond
+ (fixture (format "./fixtures/%s" fixture))
+ (,no-fixture "./fixtures/empty")
+ (t (format ,(format "./fixtures/%%s.%s" extension)
name)))))
+ ,@`((let ((enable-context-coloring-mode
,enable-context-coloring-mode))
+ `(ert-deftest ,test-name ()
+ (context-coloring-test-with-fixture
+ ,fixture
+ (when ,before-each (funcall ,before-each))
+ (,mode)
+ (when ,before (funcall ,before))
+ (when ,enable-context-coloring-mode (context-coloring-mode))
+ (unwind-protect
+ (progn
+ (funcall ,body))
+ (when ,after (funcall ,after))
+ (when ,after-each (funcall ,after-each)))))))))))
+
+(context-coloring-test-define-deftest nil
+ :mode #'fundamental-mode
+ :no-fixture t)
+
+(context-coloring-test-define-deftest javascript
+ :mode #'js2-mode
+ :extension "js"
+ :enable-context-coloring-mode t
+ :before-each (lambda ()
+ (setq js2-mode-show-parse-errors nil)
+ (setq js2-mode-show-strict-warnings nil)))
+
+(context-coloring-test-define-deftest emacs-lisp
+ :mode #'emacs-lisp-mode
+ :extension "el"
+ :enable-context-coloring-mode t)
+
+(context-coloring-test-define-deftest eval-expression
+ :mode #'fundamental-mode
+ :no-fixture t)
;;; Assertion functions
-(defmacro context-coloring-test-assert-region (&rest body)
- "Assert something about the face of points in a region.
-Provides the free variables `i', `length', `point', `face' and
-`actual-level' to the code in BODY."
- `(let ((i 0)
- (length (- end start)))
- (while (< i length)
- (let* ((point (+ i start))
- (face (get-text-property point 'face)))
- ,@body)
- (setq i (+ i 1)))))
-
-(defun context-coloring-test-assert-region-level (start end level)
- "Assert that all points in the range [START, END) are of level
-LEVEL."
- (context-coloring-test-assert-region
- (let (actual-level)
- (when (not (when face
- (let* ((face-string (symbol-name face))
- (matches (string-match
- context-coloring-level-face-regexp
- face-string)))
- (when matches
- (setq actual-level (string-to-number
- (substring face-string
- (match-beginning 1)
- (match-end 1))))
- (= level actual-level)))))
- (ert-fail (format (concat "Expected level in region [%s, %s), "
- "which is \"%s\", to be %s; "
- "but at point %s, it was %s")
- start end
- (buffer-substring-no-properties start end) level
- point actual-level))))))
-
-(defun context-coloring-test-assert-region-face (start end expected-face)
- "Assert that all points in the range [START, END) have the face
-EXPECTED-FACE."
- (context-coloring-test-assert-region
- (when (not (eq face expected-face))
- (ert-fail (format (concat "Expected face in region [%s, %s), "
- "which is \"%s\", to be %s; "
- "but at point %s, it was %s")
- start end
- (buffer-substring-no-properties start end) expected-face
- point face)))))
-
-(defun context-coloring-test-assert-region-comment-delimiter (start end)
- "Assert that all points in the range [START, END) have
-`font-lock-comment-delimiter-face'."
- (context-coloring-test-assert-region-face
- start end 'font-lock-comment-delimiter-face))
-
-(defun context-coloring-test-assert-region-comment (start end)
- "Assert that all points in the range [START, END) have
-`font-lock-comment-face'."
- (context-coloring-test-assert-region-face
- start end 'font-lock-comment-face))
-
-(defun context-coloring-test-assert-region-string (start end)
- "Assert that all points in the range [START, END) have
-`font-lock-string-face'."
- (context-coloring-test-assert-region-face
- start end 'font-lock-string-face))
+(defun context-coloring-test-get-last-message ()
+ "Get the last message in the current messages bufffer."
+ (let ((messages (split-string
+ (buffer-substring-no-properties
+ (point-min)
+ (point-max))
+ "\n")))
+ (car (nthcdr (- (length messages) 2) messages))))
(defun context-coloring-test-assert-message (expected buffer)
- "Assert that message EXPECTED exists in BUFFER."
+ "Assert that message EXPECTED is at the end of BUFFER."
(when (null (get-buffer buffer))
(ert-fail
(format
@@ -244,561 +150,764 @@ EXPECTED-FACE."
"but the buffer did not have any messages.")
buffer expected)))
(with-current-buffer buffer
- (let ((messages (split-string
- (buffer-substring-no-properties
- (point-min)
- (point-max))
- "\n")))
- (let ((message (car (nthcdr (- (length messages) 2) messages))))
- (when (not (equal message expected))
+ (let ((message (context-coloring-test-get-last-message)))
+ (when (not (equal message expected))
+ (ert-fail
+ (format
+ (concat
+ "Expected buffer `%s' to have message \"%s\", "
+ "but instead it was \"%s\"")
+ buffer expected
+ message))))))
+
+(defun context-coloring-test-assert-not-message (expected buffer)
+ "Assert that message EXPECTED is not at the end of BUFFER."
+ (when (get-buffer buffer)
+ (with-current-buffer buffer
+ (let ((message (context-coloring-test-get-last-message)))
+ (when (equal message expected)
(ert-fail
(format
(concat
- "Expected buffer `%s' to have message \"%s\", "
- "but instead it was \"%s\"")
- buffer expected
- message)))))))
+ "Expected buffer `%s' not to have message \"%s\", "
+ "but it did")
+ buffer expected)))))))
+
+(defun context-coloring-test-assert-error (body error-message)
+ "Assert that BODY signals ERROR-MESSAGE."
+ (let ((error-signaled-p nil))
+ (condition-case err
+ (progn
+ (funcall body))
+ (error
+ (setq error-signaled-p t)
+ (when (not (string-equal (cadr err) error-message))
+ (ert-fail (format (concat "Expected the error \"%s\" to be thrown, "
+ "but instead it was \"%s\".")
+ error-message
+ (cadr err))))))
+ (when (not error-signaled-p)
+ (ert-fail "Expected an error to be thrown, but there wasn't."))))
+
+
+;;; Miscellaneous tests
+
+(defmacro context-coloring-test-define-derived-mode (name)
+ "Define a derived mode exclusively for any test with NAME."
+ (let ((name (intern (format "context-coloring-test-%s-mode" name))))
+ `(define-derived-mode ,name fundamental-mode "Testing")))
+
+(defvar context-coloring-test-caused-p nil
+ "If non-nil, coloring was caused.")
+
+(defmacro context-coloring-test-assert-causes-coloring (&rest body)
+ "Assert that BODY causes coloring."
+ `(progn
+ ;; Gross, but I want this to pass on 24.3.
+ (ad-add-advice #'context-coloring-colorize
+ '(assert-causes-coloring
+ nil t
+ (advice . (lambda ()
+ (setq context-coloring-test-caused-p t))))
+ 'after
+ 0)
+ (ad-activate #'context-coloring-colorize)
+ ,@body
+ (when (not context-coloring-test-caused-p)
+ (ert-fail "Expected to have colorized, but it didn't."))))
+
+(defun context-coloring-test-cleanup-assert-causes-coloring ()
+ "Undo `context-coloring-test-assert-causes-coloring'."
+ (ad-unadvise #'context-coloring-colorize)
+ (setq context-coloring-test-caused-p nil))
+
+(context-coloring-test-define-derived-mode mode-startup)
+
+(context-coloring-test-deftest mode-startup
+ (lambda ()
+ (context-coloring-define-dispatch
+ 'mode-startup
+ :modes '(context-coloring-test-mode-startup-mode)
+ :colorizer #'ignore)
+ (context-coloring-test-mode-startup-mode)
+ (context-coloring-test-assert-causes-coloring
+ (context-coloring-mode)))
+ :after (lambda ()
+ (context-coloring-test-cleanup-assert-causes-coloring)))
+
+(context-coloring-test-define-derived-mode change-detection)
+
+(context-coloring-test-deftest change-detection
+ (lambda ()
+ (context-coloring-define-dispatch
+ 'idle-change
+ :modes '(context-coloring-test-change-detection-mode)
+ :colorizer #'ignore
+ :setup #'context-coloring-setup-idle-change-detection
+ :teardown #'context-coloring-teardown-idle-change-detection)
+ (context-coloring-test-change-detection-mode)
+ (context-coloring-mode)
+ (context-coloring-test-assert-causes-coloring
+ (insert " ")
+ ;; Simply cannot figure out how to trigger an idle timer; would much
rather
+ ;; test that. But (current-idle-time) always returns nil in these tests.
+ (context-coloring-maybe-colorize-with-buffer (current-buffer))))
+ :after (lambda ()
+ (context-coloring-test-cleanup-assert-causes-coloring)))
+
+(context-coloring-test-deftest unsupported-mode
+ (lambda ()
+ (context-coloring-mode)
+ (context-coloring-test-assert-message
+ "Context coloring is unavailable here"
+ "*Messages*")))
-(defun context-coloring-test-assert-no-message (buffer)
- "Assert that BUFFER has no message."
- (when (get-buffer buffer)
- (ert-fail (format (concat "Expected buffer `%s' to have no messages, "
- "but it did: `%s'")
- buffer
- (with-current-buffer buffer
- (buffer-string))))))
-
-(defun context-coloring-test-kill-buffer (buffer)
- "Kill BUFFER if it exists."
- (when (get-buffer buffer) (kill-buffer buffer)))
-
-(defun context-coloring-test-assert-face (level foreground &optional negate)
- "Assert that a face for LEVEL exists and that its `:foreground'
-is FOREGROUND, or the inverse if NEGATE is non-nil."
- (let* ((face (context-coloring-level-face level))
- actual-foreground)
- (when (not (or negate
- face))
- (ert-fail (format (concat "Expected face for level `%s' to exist; "
- "but it didn't")
- level)))
- (setq actual-foreground (face-attribute face :foreground))
- (when (funcall (if negate 'identity 'not)
- (string-equal foreground actual-foreground))
- (ert-fail (format (concat "Expected face for level `%s' "
- "%sto have foreground `%s'; "
- "but it %s.")
- level
- (if negate "not " "") foreground
- (if negate
- "did" (format "was `%s'" actual-foreground)))))))
-
-(defun context-coloring-test-assert-not-face (&rest arguments)
- "Assert that LEVEL does not have a face with `:foreground'
-FOREGROUND. Apply ARGUMENTS to
-`context-coloring-test-assert-face', see that function."
- (apply 'context-coloring-test-assert-face
- (append arguments '(t))))
-
-
-;;; The tests
-
-(ert-deftest context-coloring-test-unsupported-mode ()
- (context-coloring-test-with-fixture
- "./fixtures/function-scopes.js"
- (context-coloring-mode)
- (context-coloring-test-assert-message
- "Context coloring is not available for this major mode"
- "*Messages*")))
-
-(define-derived-mode
- context-coloring-test-unsupported-version-mode
- fundamental-mode
- "Testing"
- "Prevent `context-coloring-test-unsupported-version' from
- having any unintentional side-effects on mode support.")
-
-(ert-deftest-async context-coloring-test-unsupported-version (done)
- (context-coloring-define-dispatch
- 'outta-date
- :modes '(context-coloring-test-unsupported-version-mode)
- :executable "node"
- :command "node test/binaries/outta-date"
- :version "v2.1.3")
- (context-coloring-test-with-fixture-async
- "./fixtures/function-scopes.js"
- (lambda (teardown)
- (context-coloring-test-unsupported-version-mode)
- (add-hook
- 'context-coloring-check-scopifier-version-hook
- (lambda ()
- (unwind-protect
- (progn
- ;; Normally the executable would be something like "outta-date"
- ;; rather than "node".
- (context-coloring-test-assert-message
- "Update to the minimum version of \"node\" (v2.1.3)"
- "*Messages*"))
- (funcall teardown))
- (funcall done)))
- (context-coloring-mode))))
-
-(defvar context-coloring-test-theme-index 0
- "Unique index for unique theme names.")
-
-(defun context-coloring-test-get-next-theme ()
- "Return a unique symbol for a throwaway theme."
- (prog1
- (intern (format "context-coloring-test-theme-%s"
- context-coloring-test-theme-index))
- (setq context-coloring-test-theme-index
- (+ context-coloring-test-theme-index 1))))
-
-(defun context-coloring-test-assert-theme-originally-set-p
- (settings &optional negate)
- "Assert that `context-coloring-theme-originally-set-p' returns
-t for a theme with SETTINGS, or the inverse if NEGATE is
-non-nil."
- (let ((theme (context-coloring-test-get-next-theme)))
- (put theme 'theme-settings settings)
- (when (funcall (if negate 'identity 'not)
- (context-coloring-theme-originally-set-p theme))
- (ert-fail (format (concat "Expected theme `%s' with settings `%s' "
- "%sto be considered to have defined a level, "
- "but it %s.")
- theme settings
- (if negate "not " "")
- (if negate "was" "wasn't"))))))
-
-(defun context-coloring-test-assert-not-theme-originally-set-p (&rest
arguments)
- "Assert that `context-coloring-theme-originally-set-p' does not
-return t for a theme with SETTINGS. Apply ARGUMENTS to
-`context-coloring-test-assert-theme-originally-set-p', see that
-function."
- (apply 'context-coloring-test-assert-theme-originally-set-p
- (append arguments '(t))))
-
-(ert-deftest context-coloring-test-theme-originally-set-p ()
- (context-coloring-test-assert-theme-originally-set-p
- '((theme-face context-coloring-level-0-face)))
- (context-coloring-test-assert-theme-originally-set-p
- '((theme-face face)
- (theme-face context-coloring-level-0-face)))
- (context-coloring-test-assert-theme-originally-set-p
- '((theme-face context-coloring-level-0-face)
- (theme-face face)))
- (context-coloring-test-assert-not-theme-originally-set-p
- '((theme-face face)))
- )
-
-(defun context-coloring-test-assert-theme-settings-highest-level
- (settings expected-level)
- "Assert that a theme with SETTINGS has the highest level
-EXPECTED-LEVEL."
- (let ((theme (context-coloring-test-get-next-theme)))
- (put theme 'theme-settings settings)
- (context-coloring-test-assert-theme-highest-level theme expected-level)))
-
-(defun context-coloring-test-assert-theme-highest-level
- (theme expected-level &optional negate)
- "Assert that THEME has the highest level EXPECTED-LEVEL, or the
-inverse if NEGATE is non-nil."
- (let ((highest-level (context-coloring-theme-highest-level theme)))
- (when (funcall (if negate 'identity 'not) (eq highest-level
expected-level))
- (ert-fail (format (concat "Expected theme with settings `%s' "
- "%sto have a highest level of `%s', "
- "but it %s.")
- (get theme 'theme-settings)
- (if negate "not " "") expected-level
- (if negate "did" (format "was %s" highest-level)))))))
-
-(defun context-coloring-test-assert-theme-not-highest-level (&rest arguments)
- "Assert that THEME's highest level is not EXPECTED-LEVEL.
-Apply ARGUMENTS to
-`context-coloring-test-assert-theme-highest-level', see that
-function."
- (apply 'context-coloring-test-assert-theme-highest-level
- (append arguments '(t))))
-
-(ert-deftest context-coloring-test-theme-highest-level ()
- (context-coloring-test-assert-theme-settings-highest-level
- '((theme-face foo))
- -1)
- (context-coloring-test-assert-theme-settings-highest-level
- '((theme-face context-coloring-level-0-face))
- 0)
- (context-coloring-test-assert-theme-settings-highest-level
- '((theme-face context-coloring-level-1-face))
- 1)
- (context-coloring-test-assert-theme-settings-highest-level
- '((theme-face context-coloring-level-1-face)
- (theme-face context-coloring-level-0-face))
- 1)
- (context-coloring-test-assert-theme-settings-highest-level
- '((theme-face context-coloring-level-0-face)
- (theme-face context-coloring-level-1-face))
- 1)
- )
-
-(defmacro context-coloring-test-deftest-define-theme (name &rest body)
- "Define a test with name NAME and an automatically-generated
-theme symbol available as a free variable `theme'. Side-effects
-from enabling themes are reversed after BODY is executed and the
-test completes."
- (declare (indent defun))
- (let ((deftest-name (intern
- (format "context-coloring-test-define-theme-%s" name))))
- `(ert-deftest ,deftest-name ()
- (context-coloring-test-kill-buffer "*Warnings*")
- (let ((theme (context-coloring-test-get-next-theme)))
- (unwind-protect
- (progn
- ,@body)
- ;; Always cleanup.
- (disable-theme theme))))))
-
-(defun context-coloring-test-deftheme (theme)
- "Dynamically define theme THEME."
- (eval (macroexpand `(deftheme ,theme))))
-
-(context-coloring-test-deftest-define-theme additive
- (context-coloring-test-deftheme theme)
- (context-coloring-define-theme
- theme
- :colors '("#aaaaaa"
- "#bbbbbb"))
- (context-coloring-test-assert-no-message "*Warnings*")
- (enable-theme theme)
- (context-coloring-test-assert-no-message "*Warnings*")
- (context-coloring-test-assert-face 0 "#aaaaaa")
- (context-coloring-test-assert-face 1 "#bbbbbb"))
-
-(defun context-coloring-test-assert-defined-warning (theme)
- "Assert that a warning about colors already being defined for
-theme THEME is signaled."
- (context-coloring-test-assert-message
- (format (concat "Warning (emacs): Context coloring colors for theme "
- "`%s' are already defined")
- theme)
- "*Warnings*"))
-
-(context-coloring-test-deftest-define-theme unintentional-override
- (context-coloring-test-deftheme theme)
- (custom-theme-set-faces
- theme
- '(context-coloring-level-0-face ((t (:foreground "#aaaaaa"))))
- '(context-coloring-level-1-face ((t (:foreground "#bbbbbb")))))
- (context-coloring-define-theme
- theme
- :colors '("#cccccc"
- "#dddddd"))
- (context-coloring-test-assert-defined-warning theme)
- (context-coloring-test-kill-buffer "*Warnings*")
- (enable-theme theme)
- (context-coloring-test-assert-defined-warning theme)
- (context-coloring-test-assert-face 0 "#cccccc")
- (context-coloring-test-assert-face 1 "#dddddd"))
-
-(context-coloring-test-deftest-define-theme intentional-override
- (context-coloring-test-deftheme theme)
- (custom-theme-set-faces
- theme
- '(context-coloring-level-0-face ((t (:foreground "#aaaaaa"))))
- '(context-coloring-level-1-face ((t (:foreground "#bbbbbb")))))
- (context-coloring-define-theme
- theme
- :override t
- :colors '("#cccccc"
- "#dddddd"))
- (context-coloring-test-assert-no-message "*Warnings*")
- (enable-theme theme)
- (context-coloring-test-assert-no-message "*Warnings*")
- (context-coloring-test-assert-face 0 "#cccccc")
- (context-coloring-test-assert-face 1 "#dddddd"))
-
-(context-coloring-test-deftest-define-theme pre-recede
- (context-coloring-define-theme
- theme
- :recede t
- :colors '("#aaaaaa"
- "#bbbbbb"))
- (context-coloring-test-deftheme theme)
- (custom-theme-set-faces
- theme
- '(context-coloring-level-0-face ((t (:foreground "#cccccc"))))
- '(context-coloring-level-1-face ((t (:foreground "#dddddd")))))
- (enable-theme theme)
- (context-coloring-test-assert-no-message "*Warnings*")
- (context-coloring-test-assert-face 0 "#cccccc")
- (context-coloring-test-assert-face 1 "#dddddd"))
-
-(context-coloring-test-deftest-define-theme post-recede
- (context-coloring-test-deftheme theme)
- (custom-theme-set-faces
- theme
- '(context-coloring-level-0-face ((t (:foreground "#aaaaaa"))))
- '(context-coloring-level-1-face ((t (:foreground "#bbbbbb")))))
- (context-coloring-define-theme
- theme
- :recede t
- :colors '("#cccccc"
- "#dddddd"))
- (context-coloring-test-assert-no-message "*Warnings*")
- (context-coloring-test-assert-face 0 "#aaaaaa")
- (context-coloring-test-assert-face 1 "#bbbbbb")
- (enable-theme theme)
- (context-coloring-test-assert-no-message "*Warnings*")
- (context-coloring-test-assert-face 0 "#aaaaaa")
- (context-coloring-test-assert-face 1 "#bbbbbb"))
-
-(context-coloring-test-deftest-define-theme recede-not-defined
- (context-coloring-test-deftheme theme)
- (custom-theme-set-faces
- theme
- '(foo-face ((t (:foreground "#ffffff")))))
- (context-coloring-define-theme
- theme
- :recede t
- :colors '("#aaaaaa"
- "#bbbbbb"))
- (context-coloring-test-assert-no-message "*Warnings*")
- (context-coloring-test-assert-face 0 "#aaaaaa")
- (context-coloring-test-assert-face 1 "#bbbbbb")
- (enable-theme theme)
- (context-coloring-test-assert-no-message "*Warnings*")
- (context-coloring-test-assert-face 0 "#aaaaaa")
- (context-coloring-test-assert-face 1 "#bbbbbb"))
-
-(context-coloring-test-deftest-define-theme unintentional-obstinance
- (context-coloring-define-theme
- theme
- :colors '("#aaaaaa"
- "#bbbbbb"))
- (context-coloring-test-deftheme theme)
- (custom-theme-set-faces
- theme
- '(context-coloring-level-0-face ((t (:foreground "#cccccc"))))
- '(context-coloring-level-1-face ((t (:foreground "#dddddd")))))
- (enable-theme theme)
- (context-coloring-test-assert-defined-warning theme)
- (context-coloring-test-assert-face 0 "#aaaaaa")
- (context-coloring-test-assert-face 1 "#bbbbbb"))
-
-(context-coloring-test-deftest-define-theme intentional-obstinance
- (context-coloring-define-theme
- theme
- :override t
- :colors '("#aaaaaa"
- "#bbbbbb"))
- (context-coloring-test-deftheme theme)
- (custom-theme-set-faces
- theme
- '(context-coloring-level-0-face ((t (:foreground "#cccccc"))))
- '(context-coloring-level-1-face ((t (:foreground "#dddddd")))))
- (enable-theme theme)
- (context-coloring-test-assert-no-message "*Warnings*")
- (context-coloring-test-assert-face 0 "#aaaaaa")
- (context-coloring-test-assert-face 1 "#bbbbbb"))
-
-(defun context-coloring-test-assert-maximum-face (maximum &optional negate)
- "Assert that `context-coloring-maximum-face' is MAXIMUM, or the
-inverse if NEGATE is non-nil."
- (when (funcall (if negate 'identity 'not)
- (eq context-coloring-maximum-face maximum))
- (ert-fail (format (concat "Expected `context-coloring-maximum-face' "
- "%sto be `%s', "
- "but it %s.")
- (if negate "not " "") maximum
- (if negate
- "was"
- (format "was `%s'" context-coloring-maximum-face))))))
-
-(defun context-coloring-test-assert-not-maximum-face (&rest arguments)
- "Assert that `context-coloring-maximum-face' is not MAXIMUM.
-Apply ARGUMENTS to `context-coloring-test-assert-maximum-face',
-see that function."
- (apply 'context-coloring-test-assert-maximum-face
- (append arguments '(t))))
-
-(context-coloring-test-deftest-define-theme disable-cascade
- (context-coloring-test-deftheme theme)
- (context-coloring-define-theme
- theme
- :colors '("#aaaaaa"
- "#bbbbbb"))
- (let ((second-theme (context-coloring-test-get-next-theme)))
- (context-coloring-test-deftheme second-theme)
- (context-coloring-define-theme
- second-theme
- :colors '("#cccccc"
- "#dddddd"
- "#eeeeee"))
- (let ((third-theme (context-coloring-test-get-next-theme)))
- (context-coloring-test-deftheme third-theme)
- (context-coloring-define-theme
- third-theme
- :colors '("#111111"
- "#222222"
- "#333333"
- "#444444"))
- (enable-theme theme)
- (enable-theme second-theme)
- (enable-theme third-theme)
- (disable-theme third-theme)
- (context-coloring-test-assert-face 0 "#cccccc")
- (context-coloring-test-assert-face 1 "#dddddd")
- (context-coloring-test-assert-face 2 "#eeeeee")
- (context-coloring-test-assert-maximum-face 2))
- (disable-theme second-theme)
- (context-coloring-test-assert-face 0 "#aaaaaa")
- (context-coloring-test-assert-face 1 "#bbbbbb")
- (context-coloring-test-assert-maximum-face 1))
- (disable-theme theme)
- (context-coloring-test-assert-not-face 0 "#aaaaaa")
- (context-coloring-test-assert-not-face 1 "#bbbbbb")
- (context-coloring-test-assert-not-maximum-face 1))
-
-(defun context-coloring-test-js-function-scopes ()
- "Test fixtures/functions-scopes.js."
- (context-coloring-test-assert-region-level 1 9 0)
- (context-coloring-test-assert-region-level 9 23 1)
- (context-coloring-test-assert-region-level 23 25 0)
- (context-coloring-test-assert-region-level 25 34 1)
- (context-coloring-test-assert-region-level 34 35 0)
- (context-coloring-test-assert-region-level 35 52 1)
- (context-coloring-test-assert-region-level 52 66 2)
- (context-coloring-test-assert-region-level 66 72 1)
- (context-coloring-test-assert-region-level 72 81 2)
- (context-coloring-test-assert-region-level 81 82 1)
- (context-coloring-test-assert-region-level 82 87 2)
- (context-coloring-test-assert-region-level 87 89 1))
-
-(context-coloring-test-deftest-js-mode function-scopes)
-(context-coloring-test-deftest-js2-mode function-scopes)
-
-(defun context-coloring-test-js-global ()
- "Test fixtures/global.js."
- (context-coloring-test-assert-region-level 20 28 1)
- (context-coloring-test-assert-region-level 28 35 0)
- (context-coloring-test-assert-region-level 35 41 1))
-
-(context-coloring-test-deftest-js-mode global)
-(context-coloring-test-deftest-js2-mode global)
-
-(defun context-coloring-test-js-block-scopes ()
- "Test fixtures/block-scopes.js."
- (context-coloring-test-assert-region-level 20 64 1)
- (setq context-coloring-js-block-scopes t)
- (context-coloring-colorize)
- (context-coloring-test-assert-region-level 20 27 1)
- (context-coloring-test-assert-region-level 27 41 2)
- (context-coloring-test-assert-region-level 41 42 1)
- (context-coloring-test-assert-region-level 42 64 2))
-
-(context-coloring-test-deftest-js2-mode block-scopes)
-
-(defun context-coloring-test-js-catch ()
- "Test fixtures/js-catch.js."
- (context-coloring-test-assert-region-level 20 27 1)
- (context-coloring-test-assert-region-level 27 51 2)
- (context-coloring-test-assert-region-level 51 52 1)
- (context-coloring-test-assert-region-level 52 73 2)
- (context-coloring-test-assert-region-level 73 101 3)
- (context-coloring-test-assert-region-level 101 102 1)
- (context-coloring-test-assert-region-level 102 117 3)
- (context-coloring-test-assert-region-level 117 123 2))
-
-(context-coloring-test-deftest-js-mode catch)
-(context-coloring-test-deftest-js2-mode catch)
-
-(defun context-coloring-test-js-key-names ()
- "Test fixtures/key-names.js."
- (context-coloring-test-assert-region-level 20 63 1))
-
-(context-coloring-test-deftest-js-mode key-names)
-(context-coloring-test-deftest-js2-mode key-names)
-
-(defun context-coloring-test-js-property-lookup ()
- "Test fixtures/property-lookup.js."
- (context-coloring-test-assert-region-level 20 26 0)
- (context-coloring-test-assert-region-level 26 38 1)
- (context-coloring-test-assert-region-level 38 44 0)
- (context-coloring-test-assert-region-level 44 52 1)
- (context-coloring-test-assert-region-level 57 63 0)
- (context-coloring-test-assert-region-level 63 74 1))
-
-(context-coloring-test-deftest-js-mode property-lookup)
-(context-coloring-test-deftest-js2-mode property-lookup)
-
-(defun context-coloring-test-js-key-values ()
- "Test fixtures/key-values.js."
- (context-coloring-test-assert-region-level 78 79 1))
-
-(context-coloring-test-deftest-js-mode key-values)
-(context-coloring-test-deftest-js2-mode key-values)
-
-(defun context-coloring-test-js-syntactic-comments-and-strings ()
- "Test comments and strings."
- (context-coloring-test-assert-region-level 1 8 0)
- (context-coloring-test-assert-region-comment-delimiter 9 12)
- (context-coloring-test-assert-region-comment 12 16)
- (context-coloring-test-assert-region-comment-delimiter 17 20)
- (context-coloring-test-assert-region-comment 20 27)
- (context-coloring-test-assert-region-string 28 40)
- (context-coloring-test-assert-region-level 40 41 0))
-
-(defun context-coloring-test-js-syntactic-comments-and-strings-setup ()
- (setq context-coloring-syntactic-comments t)
- (setq context-coloring-syntactic-strings t))
-
-(context-coloring-test-deftest-js-mode syntactic-comments-and-strings
- :fixture-name comments-and-strings)
-(context-coloring-test-deftest-js2-mode syntactic-comments-and-strings
- :fixture-name comments-and-strings)
-
-(defalias 'context-coloring-test-js-comments-and-strings
- 'context-coloring-test-js-syntactic-comments-and-strings
- "Test comments and strings. Deprecated.")
-
-(defun context-coloring-test-js-comments-and-strings-setup ()
- "Setup comments and strings. Deprecated."
- (setq context-coloring-comments-and-strings t))
-
-(context-coloring-test-deftest-js-mode comments-and-strings)
-(context-coloring-test-deftest-js2-mode comments-and-strings)
-
-(defun context-coloring-test-js-syntactic-comments ()
- "Test syntactic comments."
- (context-coloring-test-assert-region-level 1 8 0)
- (context-coloring-test-assert-region-comment-delimiter 9 12)
- (context-coloring-test-assert-region-comment 12 16)
- (context-coloring-test-assert-region-comment-delimiter 17 20)
- (context-coloring-test-assert-region-comment 20 27)
- (context-coloring-test-assert-region-level 28 41 0))
-
-(defun context-coloring-test-js-syntactic-comments-setup ()
- "Setup syntactic comments."
- (setq context-coloring-syntactic-comments t))
-
-(context-coloring-test-deftest-js-mode syntactic-comments
- :fixture-name comments-and-strings)
-(context-coloring-test-deftest-js2-mode syntactic-comments
- :fixture-name comments-and-strings)
-
-(defun context-coloring-test-js-syntactic-strings ()
- "Test syntactic strings."
- (context-coloring-test-assert-region-level 1 28 0)
- (context-coloring-test-assert-region-string 28 40)
- (context-coloring-test-assert-region-level 40 41 0))
-
-(defun context-coloring-test-js-syntactic-strings-setup ()
- "Setup syntactic strings."
- (setq context-coloring-syntactic-strings t))
-
-(context-coloring-test-deftest-js-mode syntactic-strings
- :fixture-name comments-and-strings)
-(context-coloring-test-deftest-js2-mode syntactic-strings
- :fixture-name comments-and-strings)
+(context-coloring-test-deftest derived-mode
+ (lambda ()
+ (lisp-interaction-mode)
+ (context-coloring-mode)
+ (context-coloring-test-assert-not-message
+ "Context coloring is unavailable here"
+ "*Messages*")))
+
+(context-coloring-test-deftest unavailable-message-ignored
+ (lambda ()
+ (minibuffer-with-setup-hook
+ (lambda ()
+ (context-coloring-mode)
+ (context-coloring-test-assert-not-message
+ "Context coloring is unavailable here"
+ "*Messages*"))
+ (execute-kbd-macro
+ (vconcat
+ [?\C-u]
+ [?\M-!])))))
+
+(context-coloring-test-define-derived-mode define-dispatch-error)
+
+(context-coloring-test-deftest define-dispatch-error
+ (lambda ()
+ (context-coloring-test-assert-error
+ (lambda ()
+ (context-coloring-define-dispatch
+ 'define-dispatch-no-modes))
+ "No mode or predicate defined for dispatch")
+ (context-coloring-test-assert-error
+ (lambda ()
+ (context-coloring-define-dispatch
+ 'define-dispatch-no-strategy
+ :modes '(context-coloring-test-define-dispatch-error-mode)))
+ "No colorizer defined for dispatch")))
+
+(context-coloring-test-define-derived-mode disable-mode)
+
+(context-coloring-test-deftest disable-mode
+ (lambda ()
+ (let (torn-down)
+ (context-coloring-define-dispatch
+ 'disable-mode
+ :modes '(context-coloring-test-disable-mode-mode)
+ :colorizer #'ignore
+ :teardown (lambda ()
+ (setq torn-down t)))
+ (context-coloring-test-disable-mode-mode)
+ (context-coloring-mode)
+ (context-coloring-mode -1)
+ (when (not torn-down)
+ (ert-fail "Expected teardown function to have been called, but it
wasn't.")))))
+
+(defun context-coloring-test-assert-maximum-face (expected)
+ "Assert that `context-coloring-maximum-face' is EXPECTED."
+ (when (not (= context-coloring-maximum-face expected))
+ (ert-fail (format "Expected maximum face to be %s, but it was %s"
+ expected context-coloring-maximum-face))))
+
+(deftheme context-coloring-test-custom-theme)
+
+(context-coloring-test-define-derived-mode custom-theme)
+
+(context-coloring-test-deftest custom-theme
+ (lambda ()
+ (custom-theme-set-faces
+ 'context-coloring-test-custom-theme
+ '(context-coloring-level-0-face ((t :foreground "#aaaaaa")))
+ '(context-coloring-level-1-face ((t :foreground "#bbbbbb"))))
+ (custom-set-faces
+ '(context-coloring-level-0-face ((t :foreground "#aaaaaa"))))
+ (enable-theme 'context-coloring-test-custom-theme)
+ (context-coloring-define-dispatch
+ 'theme
+ :modes '(context-coloring-test-custom-theme-mode)
+ :colorizer #'ignore)
+ (context-coloring-test-custom-theme-mode)
+ (context-coloring-colorize)
+ (context-coloring-test-assert-maximum-face 1)
+ ;; This theme should now be ignored in favor of the `user' theme.
+ (custom-theme-reset-faces
+ 'context-coloring-test-custom-theme
+ '(context-coloring-level-0-face nil)
+ '(context-coloring-level-1-face nil))
+ (context-coloring-colorize)
+ ;; Maximum face for `user'.
+ (context-coloring-test-assert-maximum-face 0)
+ ;; Now `user' should be ignored too.
+ (custom-reset-faces
+ '(context-coloring-level-0-face nil))
+ (context-coloring-colorize)
+ ;; Expect the package's defaults.
+ (context-coloring-test-assert-maximum-face
+ context-coloring-default-maximum-face))
+ :after (lambda ()
+ (custom-reset-faces
+ '(context-coloring-level-0-face nil))
+ (disable-theme 'context-coloring-test-custom-theme)))
+
+
+;;; Coloring tests
+
+(defun context-coloring-test-face-to-level (face)
+ "Convert FACE symbol to its corresponding level, or nil."
+ (when face
+ (let* ((face-string (symbol-name face))
+ (matches (string-match
+ context-coloring-level-face-regexp
+ face-string)))
+ (when matches
+ (string-to-number (match-string 1 face-string))))))
+
+(defun context-coloring-test-assert-position-level (position level)
+ "Assert that POSITION has LEVEL."
+ (let* ((face (get-text-property position 'face))
+ (actual-level (context-coloring-test-face-to-level face)))
+ (when (not (= level actual-level))
+ (ert-fail (format (concat "Expected level at position %s, "
+ "which is \"%s\", to be %s; "
+ "but it was %s")
+ position
+ (buffer-substring-no-properties position (1+
position)) level
+ actual-level)))))
+
+(defun context-coloring-test-assert-position-face (position face-regexp)
+ "Assert that the face at POSITION satisfies FACE-REGEXP."
+ (let ((face (get-text-property position 'face)))
+ (when (or
+ ;; Pass a non-string to do an `equal' check (against a symbol or
nil).
+ (unless (stringp face-regexp)
+ (not (equal face-regexp face)))
+ ;; Otherwise do the matching.
+ (when (stringp face-regexp)
+ (not (string-match-p face-regexp (symbol-name face)))))
+ (ert-fail (format (concat "Expected face at position %s, "
+ "which is \"%s\", to be %s; "
+ "but it was %s")
+ position
+ (buffer-substring-no-properties position (1+
position)) face-regexp
+ face)))))
+
+(defun context-coloring-test-assert-position-comment (position)
+ "Assert that the face at POSITION is a comment."
+ (context-coloring-test-assert-position-face
+ position "\\`font-lock-comment\\(-delimiter\\)?-face\\'"))
+
+(defun context-coloring-test-assert-position-constant-comment (position)
+ "Assert that the face at POSITION is a constant comment."
+ (context-coloring-test-assert-position-face position
'(font-lock-constant-face
+
font-lock-comment-face)))
+
+(defun context-coloring-test-assert-position-string (position)
+ "Assert that the face at POSITION is a string."
+ (context-coloring-test-assert-position-face position 'font-lock-string-face))
+
+(defun context-coloring-test-assert-position-nil (position)
+ "Assert that the face at POSITION is nil."
+ (context-coloring-test-assert-position-face position nil))
+
+(defun context-coloring-test-assert-coloring (map)
+ "Assert that the current buffer's coloring will match MAP.
+
+MAP's newlines should correspond to the current fixture.
+
+The following characters appearing in MAP assert coloring for
+corresponding points in the fixture:
+
+0-9: Level equals number.
+C: Face is constant comment.
+c: Face is comment.
+n: Face is nil.
+s: Face is string.
+
+Any other characters are discarded. Characters \"x\" and any
+other non-letters are guaranteed to always be discarded."
+ ;; Omit the superfluous, formatting-related leading newline. Can't use
+ ;; `save-excursion' here because if an assertion fails it will cause future
+ ;; tests to get messed up.
+ (goto-char (point-min))
+ (let* ((map (substring map 1))
+ (index 0)
+ char-string
+ char)
+ (while (< index (length map))
+ (setq char-string (substring map index (1+ index)))
+ (setq char (string-to-char char-string))
+ (cond
+ ;; Newline
+ ((= char 10)
+ (forward-line)
+ (beginning-of-line))
+ ;; Number
+ ((and (>= char 48)
+ (<= char 57))
+ (context-coloring-test-assert-position-level
+ (point) (string-to-number char-string))
+ (forward-char))
+ ;; 'C' = Constant comment
+ ((= char 67)
+ (context-coloring-test-assert-position-constant-comment (point))
+ (forward-char))
+ ;; 'c' = Comment
+ ((= char 99)
+ (context-coloring-test-assert-position-comment (point))
+ (forward-char))
+ ;; 'n' = nil
+ ((= char 110)
+ (context-coloring-test-assert-position-nil (point))
+ (forward-char))
+ ;; 's' = String
+ ((= char 115)
+ (context-coloring-test-assert-position-string (point))
+ (forward-char))
+ (t
+ (forward-char)))
+ (setq index (1+ index)))))
+
+(context-coloring-test-deftest-javascript function-scopes
+ (lambda ()
+ (context-coloring-test-assert-coloring "
+000 0 0 11111111 11 110
+11111111 011 1
+ 111 1 1 22222222 22 221
+ 22222222 122 22
+1")))
+
+(context-coloring-test-deftest-javascript global
+ (lambda ()
+ (context-coloring-test-assert-coloring "
+(xxxxxxxx () {
+ 111 1 1 0000001xxx11
+}());")))
+
+(context-coloring-test-deftest-javascript block-scopes
+ (lambda ()
+ (context-coloring-test-assert-coloring "
+(xxxxxxxx () {
+ 11 111 2
+ 222 12
+ 222 22
+ 22222 12
+ 2
+}());
+
+(xxxxxxxx () {
+ 'xxx xxxxxx';
+ 11 111 2
+ 222 12
+ 222 22
+ 22222 22
+ 2
+}());"))
+ :before (lambda ()
+ (setq context-coloring-javascript-block-scopes t))
+ :after (lambda ()
+ (setq context-coloring-javascript-block-scopes nil)))
+
+(context-coloring-test-deftest-javascript catch
+ (lambda ()
+ (context-coloring-test-assert-coloring "
+(xxxxxxxx () {
+ 111 11 22222 222 2
+ 222 1 2 22
+ 222 22 33333 333 3
+ 333 1 3 33
+ 3
+ 2
+}());")))
+
+(context-coloring-test-deftest-javascript key-names
+ (lambda ()
+ (context-coloring-test-assert-coloring "
+(xxxxxxxx () {
+ 111111 1
+ 11 11
+ 1 1 1
+ 11
+}());")))
+
+(context-coloring-test-deftest-javascript property-lookup
+ (lambda ()
+ (context-coloring-test-assert-coloring "
+(xxxxxxxx () {
+ 0000001111111
+ 0000001 111111
+ 00000011111111111
+}());")))
+
+(context-coloring-test-deftest-javascript key-values
+ (lambda ()
+ (context-coloring-test-assert-coloring "
+(xxxxxxxx () {
+ xxx x;
+ (xxxxxxxx () {
+ xxxxxx {
+ x: 1
+ };
+ }());
+}());")))
+
+(context-coloring-test-deftest-javascript syntactic-comments-and-strings
+ (lambda ()
+ (context-coloring-test-assert-coloring "
+0000 00
+ccccccc
+cccccccccc
+ssssssssssss0"))
+ :fixture "comments-and-strings.js")
+
+(context-coloring-test-deftest-javascript syntactic-comments
+ (lambda ()
+ (context-coloring-test-assert-coloring "
+0000 00
+ccccccc
+cccccccccc
+0000000000000"))
+ :fixture "comments-and-strings.js"
+ :before (lambda ()
+ (setq context-coloring-syntactic-strings nil))
+ :after (lambda ()
+ (setq context-coloring-syntactic-strings t)))
+
+(context-coloring-test-deftest-javascript syntactic-strings
+ (lambda ()
+ (context-coloring-test-assert-coloring "
+0000 00
+0000000
+0000000000
+ssssssssssss0"))
+ :fixture "comments-and-strings.js"
+ :before (lambda ()
+ (setq context-coloring-syntactic-comments nil))
+ :after (lambda ()
+ (setq context-coloring-syntactic-comments t)))
+
+(context-coloring-test-deftest-javascript unterminated-comment
+ ;; As long as `add-text-properties' doesn't signal an error, this test
passes.
+ (lambda ()))
+
+(defun context-coloring-test-assert-javascript-elevated-level ()
+ "Assert that the \"initial-level.js\" file has elevated scope."
+ (context-coloring-test-assert-coloring "
+
+111 1 1 0000001xxx11"))
+
+(defun context-coloring-test-assert-javascript-global-level ()
+ "Assert that the \"initial-level.js\" file has global scope."
+ (context-coloring-test-assert-coloring "
+
+000 0 0 0000000xxx00"))
+
+(context-coloring-test-deftest-javascript initial-level
+ (lambda ()
+ (context-coloring-test-assert-javascript-elevated-level))
+ :fixture "initial-level.js"
+ :before (lambda ()
+ (setq context-coloring-initial-level 1))
+ :after (lambda ()
+ (setq context-coloring-initial-level 0)))
+
+(defun context-coloring-test-setup-top-level-scope (string)
+ "Make STRING the first line and colorize again."
+ (goto-char (point-min))
+ (kill-whole-line 0)
+ (insert string)
+ ;; Reparsing triggers recoloring.
+ (js2-reparse))
+
+(context-coloring-test-deftest-javascript top-level-scope
+ (lambda ()
+ (let ((positive-indicators
+ (list "#!/usr/bin/env node"
+ "/*jslint node: true */"
+ "// jshint node: true"
+ "/*eslint-env node */"
+ "module.exports"
+ "module.exports.a"
+ "exports.a"
+ "require('a')"))
+ (negative-indicators
+ (list "// Blah blah jshint blah."
+ "module"
+ "exports"
+ "var require; require('a')")))
+ (dolist (indicator positive-indicators)
+ (context-coloring-test-setup-top-level-scope indicator)
+ (context-coloring-test-assert-javascript-elevated-level))
+ (dolist (indicator negative-indicators)
+ (context-coloring-test-setup-top-level-scope indicator)
+ (context-coloring-test-assert-javascript-global-level))))
+ :fixture "initial-level.js")
+
+(context-coloring-test-deftest-emacs-lisp defun
+ (lambda ()
+ (context-coloring-test-assert-coloring "
+111111 000 1111 111 111111111 1111
+ 11 111 111 111 000011
+
+0000 0 0 00
+
+111111 01
+111111 111
+111111 0 1sss11")))
+
+(context-coloring-test-deftest-emacs-lisp defadvice
+ (lambda ()
+ (context-coloring-test-assert-coloring "
+1111111111 0 1111111 111111 11111 111 111111111
+ 2222 222 122
+ 22 1 2221")))
+
+(context-coloring-test-deftest-emacs-lisp lambda
+ (lambda ()
+ (context-coloring-test-assert-coloring "
+00000000 1111111 1111
+ 11111111 11 2222222 2222
+ 222 22 12 2221 111 0 00")))
+
+(context-coloring-test-deftest-emacs-lisp quote
+ (lambda ()
+ (context-coloring-test-assert-coloring "
+(xxxxx 0000000 00 00000)
+(xxx () (xxxxxxxxx (,0000)))
+
+(xxxxx x (x)
+ (xx (xx x 111
+ 111111 1 111 111
+ 111111 1 1111111111 11 111 1 111 1 00001 10000 11 00001 1 10000
+ sss ccc
+ 1111
+
+(xxxxxx '(sss cc
+ sss cc
+ ))
+
+(xxxxxx () 111111 11111)")))
+
+(context-coloring-test-deftest-emacs-lisp splice
+ (lambda ()
+ (context-coloring-test-assert-coloring "
+(xxxxxx ()
+ 111111 00001 100001)")))
+
+(context-coloring-test-deftest-emacs-lisp comment
+ (lambda ()
+ ;; Just check that the comment isn't parsed syntactically.
+ (context-coloring-test-assert-coloring "
+(xxxxx x ()
+ (xx (x xxxxx-xxxx xx) cccccccccc
+ 11 00000-0000 11))) cccccccccc")))
+
+(context-coloring-test-deftest-emacs-lisp string
+ (lambda ()
+ (context-coloring-test-assert-coloring "
+(xxxxx x (x)
+ (xxxxxx x x sss 1 0 sssss 0 1 sssssss11")))
+
+(context-coloring-test-deftest-emacs-lisp ignored
+ (lambda ()
+ (context-coloring-test-assert-coloring "
+(xxxxx x ()
+ (x x 1 11 11 111 111 11 11 11 1 111 (1 1 1)))")))
+
+(context-coloring-test-deftest-emacs-lisp sexp
+ (lambda ()
+ (context-coloring-test-assert-coloring "
+(xxx ()
+ `,@sss
+ `,@11
+ `,@11)")))
+
+(context-coloring-test-deftest-emacs-lisp let
+ (lambda ()
+ (context-coloring-test-assert-coloring "
+1111 11
+ 11 01
+ 11 00001
+ 11 2222 22
+ 22 02
+ 22 000022
+ 2222 2 2 2 00002211
+ 1111 1 1 1 000011
+
+1111 cc ccccccc
+ 1sss11")))
+
+(context-coloring-test-deftest-emacs-lisp empty-varlist
+ (lambda ()
+ (context-coloring-test-assert-coloring "
+1111111 1 11
+1111111 111
+
+1111 1cc
+ 11
+1111111 111")))
+
+(context-coloring-test-deftest-emacs-lisp varlist-spacing
+ (lambda ()
+ (context-coloring-test-assert-coloring "
+(111 (
+ (1 (222222 ()))))
+
+(111111 ( 1 1 )
+ 1 1)
+
+(111111111 0 ( (1) )
+ 1)")))
+
+(context-coloring-test-deftest-emacs-lisp let*
+ (lambda ()
+ (context-coloring-test-assert-coloring "
+11111 11
+ 11 11
+ 11 000011
+ 1111 1 1 1 0 0 00001
+ 22222 22
+ 22 12
+ 22 00002
+ 22 02
+ 22 222
+ 2222 1 1 2 2 2 000022
+ 1111 1 1 1 0 0 000011"))
+ :fixture "let-star.el")
+
+(context-coloring-test-deftest-emacs-lisp macroexp-let2
+ (lambda ()
+ (context-coloring-test-assert-coloring "
+1111 11111
+ 222222222-2222 00000000-00000000-0 2 111
+ 2 11121
+
+(11111111-1111 00000000-00000000-0)
+(11111111-1111)")))
+
+(context-coloring-test-deftest-emacs-lisp cond
+ (lambda ()
+ (context-coloring-test-assert-coloring "
+(xxx (x)
+ 11111
+ 11 11
+ 10000 11
+ 1111 1 00001 11
+ 11 11111 1 000011
+ cc c
+ sss1)")))
+
+(context-coloring-test-deftest-emacs-lisp condition-case
+ (lambda ()
+ (context-coloring-test-assert-coloring "
+1111111111-1111 111
+ 111111 000 00001
+ 111111 111 00001
+ 1111111 111111 111 000011
+
+(111111111-1111-111111-11111 111
+ cc c
+ (xxx () 222)
+ (11111 (xxx () 222))
+ sss)")))
+
+(context-coloring-test-deftest-emacs-lisp dolist
+ (lambda ()
+ (context-coloring-test-assert-coloring "
+1111111 111111
+ 2222222 2222 1111 2222222
+ 3333333 33 33 222 1111 2222223321")))
+
+(defun context-coloring-test-insert-unread-space ()
+ "Simulate the insertion of a space as if by a user."
+ (setq unread-command-events (cons '(t . 32)
+ unread-command-events)))
+
+(defun context-coloring-test-remove-faces ()
+ "Remove all faces in the current buffer."
+ (remove-text-properties (point-min) (point-max) '(face nil)))
+
+(context-coloring-test-deftest-emacs-lisp iteration
+ (lambda ()
+ (let ((context-coloring-elisp-sexps-per-pause 2))
+ (context-coloring-colorize)
+ (context-coloring-test-assert-coloring "
+cc `CC' `CC'
+(xxxxx x ())")
+ (context-coloring-test-remove-faces)
+ (context-coloring-test-insert-unread-space)
+ (context-coloring-colorize)
+ ;; Coloring is interrupted after the first "sexp" (the comment in this
+ ;; case).
+ (context-coloring-test-assert-coloring "
+cc `CC' `CC'
+nnnnnn n nnn"))))
+
+(context-coloring-test-deftest-emacs-lisp changed
+ (lambda ()
+ (context-coloring-test-remove-faces)
+ ;; Goto line 3.
+ (goto-char (point-min))
+ (forward-line (1- 3))
+ (insert " ")
+ ;; Mock `pos-visible-in-window-p' because in batch mode `get-buffer-window'
+ ;; returns nil. Emacs must not have a window in that environment.
+ (cl-letf (((symbol-function 'pos-visible-in-window-p)
+ (let ((calls 0))
+ (lambda ()
+ (prog1
+ ;; First and third calls start from center. Second and
+ ;; fourth calls are made immediately after moving past
+ ;; the first defun in either direction "off screen".
+ (cond
+ ((= calls 0) t)
+ ((= calls 1) nil)
+ ((= calls 2) t)
+ ((= calls 4) nil))
+ (setq calls (1+ calls)))))))
+ (context-coloring-colorize))
+ (context-coloring-test-assert-coloring "
+nnnn n nnn nnnnnnnn
+0000
+
+0000
+nnnnn n nnn nnnnnnnn")))
+
+(context-coloring-test-deftest-emacs-lisp unbalanced-parenthesis
+ (lambda ()
+ (context-coloring-test-assert-coloring "
+1111 111
+nnnn nn")))
+
+(context-coloring-test-deftest-eval-expression let
+ (lambda ()
+ (minibuffer-with-setup-hook
+ (lambda ()
+ ;; Perform the test in a hook as it's the only way I know of
examining
+ ;; the minibuffer's contents. The contents are implicitly submitted,
+ ;; so we have to ignore the errors in the arbitrary test subject
code.
+ (insert "(ignore-errors (let (a) (message a free)))")
+ (context-coloring-colorize)
+ (context-coloring-test-assert-coloring "
+xxxx: 0000000-000000 1111 111 11111111 1 0000110"))
+ ;; Simulate user input because `call-interactively' is blocking and
+ ;; doesn't seem to run the hook.
+ (execute-kbd-macro
+ (vconcat
+ [?\C-u] ;; Don't output the result of the arbitrary test subject code.
+ [?\M-:])))))
(provide 'context-coloring-test)
diff --git a/packages/test-simple/ChangeLog
b/packages/context-coloring/test/fixtures/.nosearch
similarity index 100%
copy from packages/test-simple/ChangeLog
copy to packages/context-coloring/test/fixtures/.nosearch
diff --git a/packages/context-coloring/test/fixtures/block-scopes.js
b/packages/context-coloring/test/fixtures/block-scopes.js
index 735ca6f..86e4a13 100644
--- a/packages/context-coloring/test/fixtures/block-scopes.js
+++ b/packages/context-coloring/test/fixtures/block-scopes.js
@@ -2,5 +2,15 @@
if (1) {
var a;
let b;
+ const c;
+ }
+}());
+
+(function () {
+ 'use strict';
+ if (1) {
+ var a;
+ let b;
+ const c;
}
}());
diff --git a/packages/context-coloring/test/fixtures/changed.el
b/packages/context-coloring/test/fixtures/changed.el
new file mode 100644
index 0000000..28c9602
--- /dev/null
+++ b/packages/context-coloring/test/fixtures/changed.el
@@ -0,0 +1,5 @@
+(l1) ; Not colored.
+(l2)
+
+(l4)
+(l5) ; Not colored.
diff --git a/packages/context-coloring/test/fixtures/comment.el
b/packages/context-coloring/test/fixtures/comment.el
new file mode 100644
index 0000000..c3ba432
--- /dev/null
+++ b/packages/context-coloring/test/fixtures/comment.el
@@ -0,0 +1,3 @@
+(defun a ()
+ (or (= token-char 96) ; 96 = '`'
+ (= token-char 44))) ; 44 = ','
diff --git a/packages/context-coloring/test/fixtures/cond.el
b/packages/context-coloring/test/fixtures/cond.el
new file mode 100644
index 0000000..d5aae5b
--- /dev/null
+++ b/packages/context-coloring/test/fixtures/cond.el
@@ -0,0 +1,8 @@
+(let (a)
+ (cond
+ (a t)
+ (free t)
+ ((eq a free) t)
+ (t (list a free))
+ ;; c
+ "s"))
diff --git a/packages/context-coloring/test/fixtures/condition-case.el
b/packages/context-coloring/test/fixtures/condition-case.el
new file mode 100644
index 0000000..151f591
--- /dev/null
+++ b/packages/context-coloring/test/fixtures/condition-case.el
@@ -0,0 +1,10 @@
+(condition-case err
+ (progn err free)
+ (error err free)
+ ((debug error) err free))
+
+(condition-case-unless-debug nil
+ ;; c
+ (let () nil)
+ (error (let () nil))
+ "s")
diff --git a/packages/context-coloring/test/fixtures/defadvice.el
b/packages/context-coloring/test/fixtures/defadvice.el
new file mode 100644
index 0000000..da1f0eb
--- /dev/null
+++ b/packages/context-coloring/test/fixtures/defadvice.el
@@ -0,0 +1,3 @@
+(defadvice a (before advice first (b) activate)
+ (let ((c b))
+ (+ b c)))
diff --git a/packages/context-coloring/test/fixtures/defun.el
b/packages/context-coloring/test/fixtures/defun.el
new file mode 100644
index 0000000..10a52f6
--- /dev/null
+++ b/packages/context-coloring/test/fixtures/defun.el
@@ -0,0 +1,8 @@
+(defun abc (def ghi &optional jkl)
+ (+ def ghi jkl free))
+
+(abc 1 2 3)
+
+(defun a)
+(defun ())
+(defun b ("a"))
diff --git a/packages/context-coloring/test/fixtures/dolist.el
b/packages/context-coloring/test/fixtures/dolist.el
new file mode 100644
index 0000000..f103670
--- /dev/null
+++ b/packages/context-coloring/test/fixtures/dolist.el
@@ -0,0 +1,3 @@
+(lambda (list)
+ (dolist (var list result)
+ (lambda () (+ var list result))))
diff --git a/packages/test-simple/ChangeLog
b/packages/context-coloring/test/fixtures/empty
similarity index 100%
rename from packages/test-simple/ChangeLog
rename to packages/context-coloring/test/fixtures/empty
diff --git a/packages/context-coloring/test/fixtures/empty-varlist.el
b/packages/context-coloring/test/fixtures/empty-varlist.el
new file mode 100644
index 0000000..5ee6a78
--- /dev/null
+++ b/packages/context-coloring/test/fixtures/empty-varlist.el
@@ -0,0 +1,6 @@
+(lambda ( ))
+(lambda ())
+
+(let (;;
+ ))
+(lambda ())
diff --git a/packages/context-coloring/test/fixtures/global.js
b/packages/context-coloring/test/fixtures/global.js
index a35619d..3de2147 100644
--- a/packages/context-coloring/test/fixtures/global.js
+++ b/packages/context-coloring/test/fixtures/global.js
@@ -1,3 +1,3 @@
(function () {
- var a = require('a');
+ var a = global('a');
}());
diff --git a/packages/context-coloring/test/fixtures/ignored.el
b/packages/context-coloring/test/fixtures/ignored.el
new file mode 100644
index 0000000..1f5fd42
--- /dev/null
+++ b/packages/context-coloring/test/fixtures/ignored.el
@@ -0,0 +1,2 @@
+(defun a ()
+ (+ a 1 +1 -1 1.0 #x0 ,a \a :a t nil (0 . 0)))
diff --git a/packages/context-coloring/test/fixtures/initial-level.js
b/packages/context-coloring/test/fixtures/initial-level.js
new file mode 100644
index 0000000..24a4b71
--- /dev/null
+++ b/packages/context-coloring/test/fixtures/initial-level.js
@@ -0,0 +1,2 @@
+
+var a = global('a');
diff --git a/packages/context-coloring/test/fixtures/iteration.el
b/packages/context-coloring/test/fixtures/iteration.el
new file mode 100644
index 0000000..c4e99ac
--- /dev/null
+++ b/packages/context-coloring/test/fixtures/iteration.el
@@ -0,0 +1,2 @@
+;; `aa' `bb'
+(defun a ())
diff --git a/packages/context-coloring/test/fixtures/lambda.el
b/packages/context-coloring/test/fixtures/lambda.el
new file mode 100644
index 0000000..9ab7be2
--- /dev/null
+++ b/packages/context-coloring/test/fixtures/lambda.el
@@ -0,0 +1,3 @@
+(funcall (lambda (fn a)
+ (funcall fn (lambda (fn)
+ (fn fn a) fn)) fn) 0 1)
diff --git a/packages/context-coloring/test/fixtures/let-star.el
b/packages/context-coloring/test/fixtures/let-star.el
new file mode 100644
index 0000000..44d743c
--- /dev/null
+++ b/packages/context-coloring/test/fixtures/let-star.el
@@ -0,0 +1,11 @@
+(let* (a
+ (b a)
+ (c free))
+ (and a b c d e free)
+ (let* (d
+ (e a)
+ (c free)
+ (g f)
+ (f g))
+ (and a b c d e free))
+ (and a b c d e free))
diff --git a/packages/context-coloring/test/fixtures/let.el
b/packages/context-coloring/test/fixtures/let.el
new file mode 100644
index 0000000..49edb50
--- /dev/null
+++ b/packages/context-coloring/test/fixtures/let.el
@@ -0,0 +1,13 @@
+(let (a
+ (b a)
+ (c free)
+ (d (let (a
+ (b a)
+ (c free))
+ (and a b c free))))
+ (and a b c free))
+
+(let ;; comment
+ ("s"))
+
+(let (a '))
diff --git a/packages/context-coloring/test/fixtures/macroexp-let2.el
b/packages/context-coloring/test/fixtures/macroexp-let2.el
new file mode 100644
index 0000000..1b61df2
--- /dev/null
+++ b/packages/context-coloring/test/fixtures/macroexp-let2.el
@@ -0,0 +1,6 @@
+(let (exp)
+ (macroexp-let2 macroexp-copyable-p v exp
+ v exp))
+
+(macroexp-let2 macroexp-copyable-p)
+(macroexp-let2)
diff --git a/packages/context-coloring/test/fixtures/quote.el
b/packages/context-coloring/test/fixtures/quote.el
new file mode 100644
index 0000000..5fc126d
--- /dev/null
+++ b/packages/context-coloring/test/fixtures/quote.el
@@ -0,0 +1,15 @@
+(quote (lambda () free))
+(let () (backquote (,free)))
+
+(defun a (a)
+ (or (eq a 'b)
+ (equal a '(a b))
+ (equal a `(,(append () `(a b ,(+ 1 free) ,free b) free) b ,free
+ "s" ; c
+ ))))
+
+(append '("a" ; b
+ "b" ; a
+ ))
+
+(lambda () '((?\" ?\")))
diff --git a/packages/context-coloring/test/fixtures/sexp.el
b/packages/context-coloring/test/fixtures/sexp.el
new file mode 100644
index 0000000..438dc02
--- /dev/null
+++ b/packages/context-coloring/test/fixtures/sexp.el
@@ -0,0 +1,4 @@
+(let ()
+ `,@"a"
+ `,@'b
+ `,@\c)
diff --git a/packages/context-coloring/test/fixtures/splice.el
b/packages/context-coloring/test/fixtures/splice.el
new file mode 100644
index 0000000..3a857a7
--- /dev/null
+++ b/packages/context-coloring/test/fixtures/splice.el
@@ -0,0 +1,2 @@
+(lambda ()
+ `(,@(a free) ,free))
diff --git a/packages/context-coloring/test/fixtures/string.el
b/packages/context-coloring/test/fixtures/string.el
new file mode 100644
index 0000000..4172642
--- /dev/null
+++ b/packages/context-coloring/test/fixtures/string.el
@@ -0,0 +1,2 @@
+(defun a (a)
+ (concat a b "(" a b "(\"" b a "(\"\""))
diff --git a/packages/context-coloring/test/fixtures/unbalanced-parenthesis.el
b/packages/context-coloring/test/fixtures/unbalanced-parenthesis.el
new file mode 100644
index 0000000..caaf7e2
--- /dev/null
+++ b/packages/context-coloring/test/fixtures/unbalanced-parenthesis.el
@@ -0,0 +1,2 @@
+(let ())
+(let ()
diff --git a/packages/context-coloring/test/fixtures/unterminated-comment.js
b/packages/context-coloring/test/fixtures/unterminated-comment.js
new file mode 100644
index 0000000..94d4703
--- /dev/null
+++ b/packages/context-coloring/test/fixtures/unterminated-comment.js
@@ -0,0 +1,6 @@
+function a() {
+ /*
+ function b() {
+
+ }
+}
diff --git a/packages/context-coloring/test/fixtures/varlist-spacing.el
b/packages/context-coloring/test/fixtures/varlist-spacing.el
new file mode 100644
index 0000000..97ec208
--- /dev/null
+++ b/packages/context-coloring/test/fixtures/varlist-spacing.el
@@ -0,0 +1,8 @@
+(let (
+ (a (lambda ()))))
+
+(lambda ( a b )
+ a b)
+
+(defadvice a ( (b) )
+ b)
diff --git a/packages/csv-mode/csv-mode.el b/packages/csv-mode/csv-mode.el
index a8ae4e4..1e20f8c 100644
--- a/packages/csv-mode/csv-mode.el
+++ b/packages/csv-mode/csv-mode.el
@@ -1,11 +1,11 @@
;;; csv-mode.el --- Major mode for editing comma/char separated values -*-
lexical-binding: t -*-
-;; Copyright (C) 2003, 2004, 2012, 2013, 2014 Free Software Foundation, Inc
+;; Copyright (C) 2003, 2004, 2012, 2013, 2014, 2015 Free Software Foundation,
Inc
;; Author: Francis J. Wright <F.J.Wright at qmul.ac.uk>
;; Time-stamp: <23 August 2004>
;; URL: http://centaur.maths.qmul.ac.uk/Emacs/
-;; Version: 1.2
+;; Version: 1.5
;; Keywords: convenience
;; This package is free software; you can redistribute it and/or modify
@@ -249,16 +249,7 @@ Number of spaces used by `csv-align-fields' after
separators."
(defconst csv-mode-line-format
- ;; See bindings.el for details of `mode-line-format' construction.
- (let* ((ml (copy-sequence (default-value 'mode-line-format)))
- (x (or (memq 'mode-line-position ml) (last 3 ml))))
- (when x
- (setcdr x (cons
- `(csv-field-index-string
- ("" csv-field-index-string
- ))
- (cdr x))))
- ml)
+ '(csv-field-index-string ("" csv-field-index-string))
"Mode line format string for CSV mode.")
(defvar csv-mode-map
@@ -322,9 +313,13 @@ CSV mode provides the following specific keyboard key
bindings:
(setq
;; Font locking -- separator plus syntactic:
font-lock-defaults '(csv-font-lock-keywords)
- buffer-invisibility-spec csv-invisibility-default
- ;; Mode line to support `csv-field-index-mode':
- mode-line-format csv-mode-line-format)
+ buffer-invisibility-spec csv-invisibility-default)
+ ;; Mode line to support `csv-field-index-mode':
+ (set (make-local-variable 'mode-line-position)
+ (pcase mode-line-position
+ (`(,(or (pred consp) (pred stringp)) . ,_)
+ `(,@mode-line-position ,csv-mode-line-format))
+ (_ `("" ,mode-line-position ,csv-mode-line-format))))
(set (make-local-variable 'truncate-lines) t)
;; Enable or disable `csv-field-index-mode' (could probably do this
;; a bit more efficiently):
@@ -337,24 +332,25 @@ It must be either a string or nil."
(list (edit-and-eval-command
"Comment start (string or nil): " csv-comment-start)))
;; Paragraph means a group of contiguous records:
- (setq csv-comment-start string)
(set (make-local-variable 'paragraph-separate) "[:space:]*$") ; White space.
(set (make-local-variable 'paragraph-start) "\n");Must include \n explicitly!
- (if string
- (progn
- (setq paragraph-separate (concat paragraph-separate "\\|" string)
- paragraph-start (concat paragraph-start "\\|" string))
- (set (make-local-variable 'comment-start) string)
- (modify-syntax-entry
- (string-to-char string) "<" csv-mode-syntax-table)
- (modify-syntax-entry ?\n ">" csv-mode-syntax-table))
- (with-syntax-table text-mode-syntax-table
- (modify-syntax-entry (string-to-char string)
- (string (char-syntax (string-to-char string)))
- csv-mode-syntax-table)
- (modify-syntax-entry ?\n
- (string (char-syntax ?\n))
- csv-mode-syntax-table))))
+ ;; Remove old comment-start/end if available
+ (with-syntax-table text-mode-syntax-table
+ (when comment-start
+ (modify-syntax-entry (string-to-char comment-start)
+ (string (char-syntax (string-to-char comment-start)))
+ csv-mode-syntax-table))
+ (modify-syntax-entry ?\n
+ (string (char-syntax ?\n))
+ csv-mode-syntax-table))
+ (when string
+ (setq paragraph-separate (concat paragraph-separate "\\|" string)
+ paragraph-start (concat paragraph-start "\\|" string))
+ (set (make-local-variable 'comment-start) string)
+ (modify-syntax-entry
+ (string-to-char string) "<" csv-mode-syntax-table)
+ (modify-syntax-entry ?\n ">" csv-mode-syntax-table))
+ (setq csv-comment-start string))
;;;###autoload
(add-to-list 'auto-mode-alist '("\\.[Cc][Ss][Vv]\\'" . csv-mode))
@@ -968,18 +964,17 @@ The fields yanked are those last killed by
`csv-kill-fields'."
(while (not (eobp)) ; for each record...
(or (csv-not-looking-at-record)
(let ((w widths)
- (beg (point)) ; Beginning of current field.
+ (col (current-column))
x)
(while (not (eolp))
(csv-end-of-field)
- (setq x (- (point) beg)) ; Field width.
+ (setq x (- (current-column) col)) ; Field width.
(if w
(if (> x (car w)) (setcar w x))
(setq w (list x)
widths (nconc widths w)))
(or (eolp) (forward-char)) ; Skip separator.
- (setq w (cdr w)
- beg (point)))))
+ (setq w (cdr w) col (current-column)))))
(forward-line))
widths))
@@ -1025,8 +1020,8 @@ If there is no selected region, default to the whole
buffer."
(align-padding (if (bolp) 0 csv-align-padding))
(left-padding 0) (right-padding 0)
(field-width
- ;; FIXME: Don't assume length=string-width!
- (progn (csv-end-of-field) (- (point) beg)))
+ (- (- (current-column)
+ (progn (csv-end-of-field) (current-column)))))
(column-width (pop w))
(x (- column-width field-width))) ; Required padding.
(set-marker end (point)) ; End of current field.
diff --git a/packages/dbus-codegen/dbus-codegen.el
b/packages/dbus-codegen/dbus-codegen.el
index d744b9f..5f60dd1 100644
--- a/packages/dbus-codegen/dbus-codegen.el
+++ b/packages/dbus-codegen/dbus-codegen.el
@@ -637,6 +637,7 @@ supported:
:transform-name FUNCTION -- FUNCTION is a function which converts
D-Bus method/signal/property names, into another representation.
By default `dbus-codegen-transform-name' is used."
+ ;; FIXME: A lot of redundancy with dbus-codegen-define-skeleton.
(unless (symbolp name)
(signal 'wrong-type-argument (list 'symbolp name)))
;; Accept a Lisp form as well as a string.
@@ -809,10 +810,10 @@ associated functions.
Other keywords are same as `dbus-codegen-define-proxy'."
(require 'xml)
(require 'subword)
- (let ((constructor (intern (format "%s-make" name))))
+ (let ((constructor (intern (format "%s--make" name))))
(if (or (plist-get args :redefine)
(not (fboundp constructor)))
- (eval `(define-dbus-proxy ,(intern name)
+ (eval `(dbus-codegen-define-proxy ,name
,(dbus-introspect bus service path)
,interface
,@args)))
@@ -838,6 +839,7 @@ supported:
:transform-name FUNCTION -- FUNCTION is a function which converts
D-Bus method/signal/property names, into another representation.
By default `dbus-codegen-transform-name' is used."
+ ;; FIXME: A lot of redundancy with dbus-codegen-define-proxy.
(unless (symbolp name)
(signal 'wrong-type-argument (list 'symbolp name)))
;; Accept a Lisp form as well as a string.
diff --git a/packages/debbugs/Debbugs.wsdl b/packages/debbugs/Debbugs.wsdl
index 427a381..f9657db 100644
--- a/packages/debbugs/Debbugs.wsdl
+++ b/packages/debbugs/Debbugs.wsdl
@@ -1,6 +1,6 @@
<?xml version="1.0" encoding="UTF-8"?>
-<!-- Copyright (C) 2011-2015 Free Software Foundation, Inc.
+<!-- Copyright (C) 2011-2016 Free Software Foundation, Inc.
This file is not part of GNU Emacs.
diff --git a/packages/debbugs/README b/packages/debbugs/README
index 439b10f..74f8db8 100644
--- a/packages/debbugs/README
+++ b/packages/debbugs/README
@@ -9,6 +9,12 @@ If you prefer the listing of bugs as TODO items of `org-mode',
you
could use the commands `M-x debbugs-org', `M-x debbugs-org-search' and
`M-x debbugs-org-bugs' instead.
+A minor mode `debbugs-browse-mode' let you browse URLs to the GNU Bug
+Tracker as well as bug identifiers prepared for `bug-reference-mode'.
+
+All these commands are described in the Debbugs User Guide, accessible via
+(info "(debbugs-ug)")
+
This package works by implementing basic functions to access a Debbugs
SOAP server (see <http://wiki.debian.org/DebbugsSoapInterface>). It
implements the SOAP functions "get_bugs", "newest_bugs", "get_status",
diff --git a/packages/debbugs/debbugs-browse.el
b/packages/debbugs/debbugs-browse.el
new file mode 100644
index 0000000..b4e87c7
--- /dev/null
+++ b/packages/debbugs/debbugs-browse.el
@@ -0,0 +1,68 @@
+;; debbugs-browse.el --- browse bug URLs with debbugs-gnu or debbugs-org
+
+;; Copyright (C) 2015-2016 Free Software Foundation, Inc.
+
+;; Author: Michael Albinus <address@hidden>
+;; Keywords: comm, hypermedia, maint
+;; Package: debbugs
+
+;; 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 file provides a minor mode for browsing bug URLs with
+;; `debbugs-gnu-bugs' or `debbugs-org-bugs'.
+
+;;; Code:
+
+(defcustom debbugs-browse-function 'debbugs-gnu-bugs
+ "The debbugs function used for showing bugs.
+This can be either `debbugs-gnu-bugs' or `debbugs-org-bugs'."
+ :group 'debbugs-gnu
+ :type '(choice (const debbugs-gnu-bugs)
+ (const debbugs-org-bugs))
+ :version "25.1")
+
+(defun debbugs-browse-url (url &optional _new-window)
+ (when (and (stringp url)
+ (string-match
+ (format
+ "^%s\\(%s\\)?\\([[:digit:]]+\\)$"
+ (regexp-quote "http://debbugs.gnu.org/";)
+ (regexp-quote "cgi/bugreport.cgi?bug="))
+ url))
+ (funcall debbugs-browse-function (string-to-number (match-string 2 url)))
+ ;; Return t for add-function mechanery.
+ t))
+
+;;;###autoload
+(define-minor-mode debbugs-browse-mode
+ "Browse GNU Debbugs bug URLs with debbugs-gnu or debbugs-org.
+With a prefix argument ARG, enable Debbugs Browse mode if ARG is
+positive, and disable it otherwise. If called from Lisp, enable
+the mode if ARG is omitted or nil.
+The customer option `debbugs-browse-function' controls, which of
+the two packages is used for showing bugs."
+ nil
+ ""
+ nil
+ (if debbugs-browse-mode
+ (add-function
+ :before-until (local 'browse-url-browser-function) 'debbugs-browse-url)
+ (remove-function (local 'browse-url-browser-function)
'debbugs-browse-url)))
+
+(provide 'debbugs-browse)
+;;; debbugs-browse.el ends here
diff --git a/packages/debbugs/debbugs-gnu.el b/packages/debbugs/debbugs-gnu.el
index 97c67e4..d22dd81 100644
--- a/packages/debbugs/debbugs-gnu.el
+++ b/packages/debbugs/debbugs-gnu.el
@@ -1,12 +1,11 @@
;;; debbugs-gnu.el --- interface for the GNU bug tracker
-;; Copyright (C) 2011-2015 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2016 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <address@hidden>
;; Michael Albinus <address@hidden>
;; Keywords: comm, hypermedia, maint
;; Package: debbugs
-;; Version: 0.6
;; This file is not part of GNU Emacs.
@@ -59,7 +58,7 @@
;; If a prefix is given to the command, more search parameters are
;; asked for, like packages (also a comma separated list, "emacs" is
;; the default), whether archived bugs shall be shown, and whether
-;; closed bugs shall be shown.
+;; closed bugs shall be suppressed from being retrieved.
;; Another command is
;;
@@ -76,20 +75,20 @@
;; The bug reports are downloaded from the bug tracker. In order to
;; not generate too much load of the server, up to 500 bugs will be
-;; downloaded at once. If there are more hits, you will be asked to
-;; change this limit, but please don't increase this number too much.
+;; downloaded at once. If there are more hits, several downloads will
+;; be performed, until all bugs are retrieved.
;; These default values could be changed also by customer options
-;; `debbugs-gnu-default-severities', `debbugs-gnu-default-packages',
-;; `debbugs-gnu-default-hits-per-page' and `debbugs-gnu-default-suppress-bugs'.
+;; `debbugs-gnu-default-severities', `debbugs-gnu-default-packages'
+;; and `debbugs-gnu-default-suppress-bugs'.
-;; The commands create one or more pages of bug lists. Every bug is
-;; shown in one line, including the bug number, the status (combining
-;; merged bug numbers, keywords and severities), the name of the
-;; submitter, and the title of the bug. On every bug line you could
-;; apply the following actions by the following keystrokes:
+;; The commands create a page of bug lists. Every bug is shown in one
+;; line, including the bug number, the status (combining merged bug
+;; numbers, keywords and severities), the name of the submitter, and
+;; the title of the bug. On every bug line you could apply the
+;; following actions by the following keystrokes:
-;; RET: Show corresponding messages in Gnus
+;; RET: Show corresponding messages in Gnus/Rmail
;; "C": Send a control message
;; "t": Mark the bug locally as tagged
;; "b": Show bugs this bug is blocked by
@@ -103,10 +102,11 @@
;; "s": Toggle bug sorting for age or for state
;; "x": Toggle suppressing of bugs
;; "/": Display only bugs matching a string
+;; "R": Display only bugs blocking the current release
;; "w": Display all the currently selected bug reports
-;; When you visit the related bug messages in Gnus, you could also
-;; send control messages by keystroke "C".
+;; When you visit the related bug messages in Gnus or Rmail, you could
+;; also send control messages by keystroke "C".
;; In the header line of every bug list page, you can toggle sorting
;; per column by selecting a column with the mouse. The sorting
@@ -119,11 +119,11 @@
;; This command shows you all existing user tags for the packages
;; defined in `debbugs-gnu-default-packages'. A prefix for the
-;; command allows you to use other packe names, or an arbitrary string
-;; for a user who has tagged bugs. The command returns the list of
-;; existing user tags for the given user(s) or package name(s),
-;; respectively. Applying RET on a user tag, all bugs tagged with
-;; this user tag are shown.
+;; command allows you to use other package names, or an arbitrary
+;; string for a user who has tagged bugs. The command returns the
+;; list of existing user tags for the given user(s) or package
+;; name(s), respectively. Applying RET on a user tag, all bugs tagged
+;; with this user tag are shown.
;; Unfortunately, it is not possible with the SOAP interface to show
;; all users who have tagged bugs. This list can be retrieved via
@@ -139,26 +139,62 @@
;;; Code:
(require 'debbugs)
-(require 'widget)
-(require 'wid-edit)
(require 'tabulated-list)
(require 'add-log)
+(require 'subr-x)
(eval-when-compile (require 'cl))
+(autoload 'article-decode-charset "gnus-art")
+(autoload 'diff-goto-source "diff-mode")
+(autoload 'diff-hunk-file-names "diff-mode")
+(autoload 'gnus-article-mime-handles "gnus-art")
(autoload 'gnus-read-ephemeral-emacs-bug-group "gnus-group")
-(autoload 'mail-header-subject "nnheader")
(autoload 'gnus-summary-article-header "gnus-sum")
+(autoload 'gnus-summary-select-article "gnus-sum")
+(autoload 'gnus-summary-show-article "gnus-sum")
+(autoload 'gnus-with-article-buffer "gnus-art")
+(autoload 'log-edit-insert-changelog "log-edit")
+(autoload 'mail-header-subject "nnheader")
+(autoload 'message-goto-body "message")
(autoload 'message-make-from "message")
+(autoload 'rmail-get-new-mail "rmail")
+(autoload 'rmail-show-message "rmail")
+(autoload 'rmail-summary "rmailsum")
+(autoload 'vc-dir-hide-up-to-date "vc-dir")
+(autoload 'vc-dir-mark "vc-dir")
+
+(defvar compilation-in-progress)
+(defvar diff-file-header-re)
+(defvar gnus-article-buffer)
+(defvar gnus-posting-styles)
+(defvar gnus-save-duplicate-list)
+(defvar gnus-suppress-duplicates)
+(defvar rmail-current-message)
+(defvar rmail-mode-map)
+(defvar rmail-summary-mode-map)
+(defvar rmail-total-messages)
+
+;; Buffer-local variables.
+(defvar debbugs-gnu-local-query)
+(defvar debbugs-gnu-local-filter)
+(defvar debbugs-gnu-local-suppress)
+(defvar debbugs-gnu-sort-state)
+(defvar debbugs-gnu-limit)
(defgroup debbugs-gnu ()
"UI for the debbugs.gnu.org bug tracker."
:group 'debbugs
:version "24.1")
+(defvar debbugs-gnu-blocking-report 19759
+ "The ID of the current release report used to track blocking bug reports.")
+
(defcustom debbugs-gnu-default-severities '("serious" "important" "normal")
"*The list severities bugs are searched for.
\"tagged\" is not a severity but marks locally tagged bugs."
;; <http://debbugs.gnu.org/Developer.html#severities>
+ ;; /ssh:debbugs:/etc/debbugs/config @gSeverityList
+ ;; We don't use "critical" and "grave".
:group 'debbugs-gnu
:type '(set (const "serious")
(const "important")
@@ -177,7 +213,8 @@
;; <http://debbugs.gnu.org/Packages.html>
;; <http://debbugs.gnu.org/cgi/pkgindex.cgi>
:group 'debbugs-gnu
- :type '(set (const "auctex")
+ :type '(set (const "adns")
+ (const "auctex")
(const "automake")
(const "cc-mode")
(const "coreutils")
@@ -197,31 +234,38 @@
(const "mh-e")
(const "org-mode")
(const "parted")
+ (const "sed")
(const "vc-dwim")
(const "woodchuck"))
- :version "24.4")
+ :version "25.1")
(defconst debbugs-gnu-all-packages
(mapcar 'cadr (cdr (get 'debbugs-gnu-default-packages 'custom-type)))
"*List of all possible package names.")
-(defcustom debbugs-gnu-default-hits-per-page 500
- "*The number of bugs shown per page."
- :group 'debbugs-gnu
- :type 'integer
- :version "24.1")
-
(defcustom debbugs-gnu-default-suppress-bugs
'((pending . "done"))
"*A list of specs for bugs to be suppressed.
An element of this list is a cons cell \(KEY . REGEXP\), with key
-being returned by `debbugs-get-status', and VAL a regular
+being returned by `debbugs-get-status', and REGEXP a regular
expression matching the corresponding value, a string. Showing
suppressed bugs is toggled by `debbugs-gnu-toggle-suppress'."
:group 'debbugs-gnu
:type '(alist :key-type symbol :value-type regexp)
:version "24.1")
+(defcustom debbugs-gnu-mail-backend 'gnus
+ "*The email backend to use for reading bug report email exchange.
+If this is 'gnus, the default, use Gnus.
+If this is 'rmail, use Rmail instead."
+ :group 'debbugs-gnu
+ :type '(choice (const :tag "Use Gnus" 'gnus)
+ (const :tag "Use Rmail" 'rmail))
+ :version "25.1")
+
+(defface debbugs-gnu-archived '((t (:inverse-video t)))
+ "Face for archived bug reports.")
+
(defface debbugs-gnu-new '((t (:foreground "red")))
"Face for new reports that nobody has answered.")
@@ -232,7 +276,7 @@ suppressed bugs is toggled by
`debbugs-gnu-toggle-suppress'."
"Face for reports that are pending.")
(defface debbugs-gnu-stale '((t (:foreground "orange")))
- "Face for reports that have not been touched for a week.")
+ "Face for reports that have not been touched for two weeks.")
(defface debbugs-gnu-done '((t (:foreground "DarkGrey")))
"Face for closed bug reports.")
@@ -240,14 +284,6 @@ suppressed bugs is toggled by
`debbugs-gnu-toggle-suppress'."
(defface debbugs-gnu-tagged '((t (:foreground "red")))
"Face for reports that have been tagged locally.")
-(defvar debbugs-gnu-widgets nil)
-
-(defvar debbugs-gnu-widget-map
- (let ((map (make-sparse-keymap)))
- (define-key map "\r" 'widget-button-press)
- (define-key map [mouse-2] 'widget-button-press)
- map))
-
(defvar debbugs-gnu-local-tags nil
"List of bug numbers tagged locally, and kept persistent.")
@@ -262,7 +298,7 @@ suppressed bugs is toggled by
`debbugs-gnu-toggle-suppress'."
";; -*- emacs-lisp -*-\n"
";; Debbugs tags connection history. Don't change this file.\n\n"
(format "(setq debbugs-gnu-local-tags '%S)"
- (sort (copy-sequence debbugs-gnu-local-tags) '<)))))
+ (sort (copy-sequence debbugs-gnu-local-tags) '>)))))
(defvar debbugs-gnu-current-query nil
"The query object of the current search.
@@ -276,6 +312,11 @@ It will be applied client-side, when parsing the results of
`debbugs-gnu-default-suppress-bugs'. In case of keys representing
a date, value is the cons cell \(BEFORE . AFTER\).")
+(defvar debbugs-gnu-current-suppress nil
+ "Whether bugs shall be suppressed.
+The specification which bugs shall be suppressed is taken from
+ `debbugs-gnu-default-suppress-bugs'.")
+
(defun debbugs-gnu-calendar-read (prompt acceptable &optional initial-contents)
"Return a string read from the minibuffer.
Derived from `calendar-read'."
@@ -313,6 +354,8 @@ marked as \"client-side filter\"."
(if (zerop (length phrase))
(setq phrase nil)
(add-to-list 'debbugs-gnu-current-query (cons 'phrase phrase)))
+ ;; We suppress closed bugs if there is no phrase.
+ (setq debbugs-gnu-current-suppress (null phrase))
;; The other queries.
(catch :finished
@@ -423,11 +466,7 @@ marked as \"client-side filter\"."
(t (throw :finished nil)))))
;; Do the search.
- (debbugs-gnu severities packages archivedp))
-
- ;; Reset query and filter.
- (setq debbugs-gnu-current-query nil
- debbugs-gnu-current-filter nil)))
+ (debbugs-gnu severities packages archivedp))))
;;;###autoload
(defun debbugs-gnu (severities &optional packages archivedp suppress tags)
@@ -459,81 +498,40 @@ marked as \"client-side filter\"."
(with-temp-buffer
(insert-file-contents debbugs-gnu-persistency-file)
(eval (read (current-buffer)))))
- (setq debbugs-gnu-widgets nil)
+ ;; Per default, we suppress retrieved unwanted bugs.
+ (when (called-interactively-p 'any)
+ (setq debbugs-gnu-current-suppress t))
;; Add queries.
(dolist (severity (if (consp severities) severities (list severities)))
(when (not (zerop (length severity)))
+ (when (string-equal severity "tagged")
+ (setq debbugs-gnu-current-suppress nil))
(add-to-list 'debbugs-gnu-current-query (cons 'severity severity))))
(dolist (package (if (consp packages) packages (list packages)))
(when (not (zerop (length package)))
(add-to-list 'debbugs-gnu-current-query (cons 'package package))))
(when archivedp
+ (setq debbugs-gnu-current-suppress nil)
(add-to-list 'debbugs-gnu-current-query '(archive . "1")))
(when suppress
+ (setq debbugs-gnu-current-suppress t)
(add-to-list 'debbugs-gnu-current-query '(status . "open"))
(add-to-list 'debbugs-gnu-current-query '(status . "forwarded")))
(dolist (tag (if (consp tags) tags (list tags)))
(when (not (zerop (length tag)))
(add-to-list 'debbugs-gnu-current-query (cons 'tag tag))))
- (unwind-protect
- (let ((hits debbugs-gnu-default-hits-per-page)
- (ids (debbugs-gnu-get-bugs debbugs-gnu-current-query)))
-
- (if (> (length ids) hits)
- (let ((cursor-in-echo-area nil))
- (setq hits
- (string-to-number
- (read-string
- (format
- "How many reports (available %d, default %d): "
- (length ids) hits)
- nil
- nil
- (number-to-string hits))))))
-
- (if (> (length ids) hits)
- (let ((i 0)
- curr-ids)
- (while ids
- (setq i (1+ i)
- curr-ids (butlast ids (- (length ids) hits)))
- (add-to-list
- 'debbugs-gnu-widgets
- (widget-convert
- 'push-button
- :follow-link 'mouse-face
- :notify (lambda (widget &rest ignore)
- (debbugs-gnu-show-reports widget))
- :keymap debbugs-gnu-widget-map
- :suppress suppress
- :buffer-name (format "*Emacs Bugs*<%d>" i)
- :bug-ids curr-ids
- :query debbugs-gnu-current-query
- :filter debbugs-gnu-current-filter
- :help-echo (format "%d-%d" (car ids) (car (last curr-ids)))
- :format " %[%v%]"
- (number-to-string i))
- 'append)
- (setq ids (last ids (- (length ids) hits))))
- (debbugs-gnu-show-reports (car debbugs-gnu-widgets)))
-
- (debbugs-gnu-show-reports
- (widget-convert
- 'const
- :suppress suppress
- :buffer-name "*Emacs Bugs*"
- :bug-ids ids
- :query debbugs-gnu-current-query
- :filter debbugs-gnu-current-filter))))
-
- ;; Reset query and filter.
- (setq debbugs-gnu-current-query nil
- debbugs-gnu-current-filter nil)))
+ ;; Show result.
+ (debbugs-gnu-show-reports)
+
+ ;; Reset query, filter and suppress.
+ (setq debbugs-gnu-current-query nil
+ debbugs-gnu-current-filter nil
+ debbugs-gnu-current-suppress nil))
(defun debbugs-gnu-get-bugs (query)
- "Retrieve bugs numbers from debbugs.gnu.org according search criteria."
+ "Retrieve bug numbers from debbugs.gnu.org according search criteria."
(let* ((debbugs-port "gnu.org")
(bugs (assoc 'bugs query))
(tags (assoc 'tag query))
@@ -552,7 +550,7 @@ marked as \"client-side filter\"."
(if phrase
(cond
((eq (car elt) 'phrase)
- (list (list :phrase (cdr elt) :max 500)))
+ (list (list :phrase (cdr elt))))
((eq (car elt) 'date)
(list (list :date (cddr elt) (cadr elt)
:operator "NUMBT")))
@@ -562,44 +560,49 @@ marked as \"client-side filter\"."
(list (intern (concat ":" (symbol-name (car elt))))
(cdr elt)))))))
- (sort
- (cond
- ;; If the query is just a list of bug numbers, we return them.
- (bugs (cdr bugs))
- ;; If the query contains the pseudo-severity "tagged", we return
- ;; just the local tagged bugs.
- (local-tags (copy-sequence debbugs-gnu-local-tags))
- ;; A full text query.
- (phrase
- (mapcar
- (lambda (x) (cdr (assoc "id" x)))
- (apply 'debbugs-search-est args)))
- ;; User tags.
- (tags
- (setq args (mapcar (lambda (x) (if (eq x :package) :user x)) args))
- (apply 'debbugs-get-usertag args))
- ;; Otherwise, we retrieve the bugs from the server.
- (t (apply 'debbugs-get-bugs args)))
- ;; Sort function.
- '<)))
-
-(defvar debbugs-gnu-current-widget nil)
-(defvar debbugs-gnu-current-limit nil)
-
-(defun debbugs-gnu-show-reports (widget)
- "Show bug reports as given in WIDGET property :bug-ids."
- ;; The tabulated mode sets several local variables. We must get rid
- ;; of them.
- (when (get-buffer (widget-get widget :buffer-name))
- (kill-buffer (widget-get widget :buffer-name)))
- (pop-to-buffer (get-buffer-create (widget-get widget :buffer-name)))
- (debbugs-gnu-mode)
+ (cond
+ ;; If the query is just a list of bug numbers, we return them.
+ (bugs (cdr bugs))
+ ;; If the query contains the pseudo-severity "tagged", we return
+ ;; just the local tagged bugs.
+ (local-tags (copy-sequence debbugs-gnu-local-tags))
+ ;; A full text query.
+ (phrase
+ (mapcar
+ (lambda (x) (cdr (assoc "id" x)))
+ (apply 'debbugs-search-est args)))
+ ;; User tags.
+ (tags
+ (setq args (mapcar (lambda (x) (if (eq x :package) :user x)) args))
+ (apply 'debbugs-get-usertag args))
+ ;; Otherwise, we retrieve the bugs from the server.
+ (t (apply 'debbugs-get-bugs args)))))
+
+(defun debbugs-gnu-show-reports (&optional offline)
+ "Show bug reports.
+If OFFLINE is non-nil, the query is not sent to the server. Bugs
+are taken from the cache instead."
(let ((inhibit-read-only t)
- (debbugs-port "gnu.org"))
- (erase-buffer)
- (set (make-local-variable 'debbugs-gnu-current-widget) widget)
-
- (dolist (status (apply 'debbugs-get-status (widget-get widget :bug-ids)))
+ (buffer-name "*Emacs Bugs*"))
+ ;; The tabulated mode sets several local variables. We must get
+ ;; rid of them.
+ (when (get-buffer buffer-name)
+ (kill-buffer buffer-name))
+ (switch-to-buffer (get-buffer-create buffer-name))
+ (debbugs-gnu-mode)
+
+ ;; Print bug reports.
+ (dolist (status
+ (let ((debbugs-cache-expiry (if offline nil debbugs-cache-expiry))
+ ids)
+ (apply 'debbugs-get-status
+ (if offline
+ (progn
+ (maphash (lambda (key _elem)
+ (push key ids))
+ debbugs-cache-data)
+ (sort ids '<))
+ (debbugs-gnu-get-bugs debbugs-gnu-local-query)))))
(let* ((id (cdr (assq 'id status)))
(words
(mapconcat
@@ -607,19 +610,20 @@ marked as \"client-side filter\"."
(cons (cdr (assq 'severity status))
(cdr (assq 'keywords status)))
","))
- (address (mail-header-parse-address
- (decode-coding-string (cdr (assq 'originator status))
- 'utf-8)))
+ (address (if (cdr (assq 'originator status))
+ (mail-header-parse-address
+ (decode-coding-string (cdr (assq 'originator status))
+ 'utf-8))))
(owner (if (cdr (assq 'owner status))
(car (mail-header-parse-address
(decode-coding-string (cdr (assq 'owner status))
'utf-8)))))
- (subject (decode-coding-string (cdr (assq 'subject status))
- 'utf-8))
+ (subject (if (cdr (assq 'subject status))
+ (decode-coding-string (cdr (assq 'subject status))
+ 'utf-8)))
merged)
(unless (equal (cdr (assq 'pending status)) "pending")
- (setq words
- (concat words "," (cdr (assq 'pending status)))))
+ (setq words (concat words "," (cdr (assq 'pending status)))))
(let ((packages (delete "emacs" (cdr (assq 'package status)))))
(when packages
(setq words (concat words "," (mapconcat 'identity packages ",")))))
@@ -652,9 +656,11 @@ marked as \"client-side filter\"."
'default))
(propertize
;; Mark status and age.
- words
+ (or words "")
'face
(cond
+ ((cdr (assq 'archived status))
+ 'debbugs-gnu-archived)
((equal (cdr (assq 'pending status)) "done")
'debbugs-gnu-done)
((member "pending" (cdr (assq 'keywords status)))
@@ -671,7 +677,8 @@ marked as \"client-side filter\"."
(propertize
;; Prefer the name over the address.
(or (cdr address)
- (car address))
+ (car address)
+ "")
'face
;; Mark own submitted bugs.
(if (and (stringp (car address))
@@ -679,7 +686,7 @@ marked as \"client-side filter\"."
'debbugs-gnu-tagged
'default))
(propertize
- subject
+ (or subject "")
'face
;; Mark owned bugs.
(if (and (stringp owner)
@@ -687,6 +694,7 @@ marked as \"client-side filter\"."
'debbugs-gnu-tagged
'default))))
'append))))
+
(tabulated-list-init-header)
(tabulated-list-print)
@@ -696,24 +704,6 @@ marked as \"client-side filter\"."
(defun debbugs-gnu-print-entry (list-id cols)
"Insert a debbugs entry at point.
Used instead of `tabulated-list-print-entry'."
- ;; This shall be in `debbugs-gnu-show-reports'. But
- ;; `tabulated-list-print' erases the buffer, therefore we do it
- ;; here. (bug#9047)
- (when (and debbugs-gnu-widgets (= (point) (point-min)))
- (widget-insert "Page:")
- (mapc
- (lambda (obj)
- (if (eq obj debbugs-gnu-current-widget)
- (widget-put obj :button-face 'widget-button-pressed)
- (widget-put obj :button-face 'widget-button-face))
- (widget-apply obj :create))
- debbugs-gnu-widgets)
- (widget-insert "\n\n")
- (save-excursion
- (widget-insert "\nPage:")
- (mapc (lambda (obj) (widget-apply obj :create)) debbugs-gnu-widgets)
- (widget-setup)))
-
(let ((beg (point))
(pos 0)
(case-fold-search t)
@@ -727,22 +717,20 @@ Used instead of `tabulated-list-print-entry'."
(title-length (nth 1 (aref tabulated-list-format 3))))
(when (and
;; We may have a narrowing in effect.
- (or (not debbugs-gnu-current-limit)
- (memq (cdr (assq 'id list-id)) debbugs-gnu-current-limit))
+ (or (not debbugs-gnu-limit)
+ (memq (cdr (assq 'id list-id)) debbugs-gnu-limit))
;; Filter suppressed bugs.
- (or (not (widget-get debbugs-gnu-current-widget :suppress))
- (and (not (memq (cdr (assq 'id list-id)) debbugs-gnu-local-tags))
- (not (catch :suppress
- (dolist (check debbugs-gnu-default-suppress-bugs)
- (when
- (string-match
- (cdr check)
- (or (cdr (assq (car check) list-id)) ""))
- (throw :suppress t)))))))
+ (or (not debbugs-gnu-local-suppress)
+ (not (catch :suppress
+ (dolist (check debbugs-gnu-default-suppress-bugs)
+ (when
+ (string-match
+ (cdr check)
+ (or (cdr (assq (car check) list-id)) ""))
+ (throw :suppress t))))))
;; Filter search list.
(not (catch :suppress
- (dolist (check
- (widget-get debbugs-gnu-current-widget :filter))
+ (dolist (check debbugs-gnu-local-filter)
(let ((val (cdr (assq (car check) list-id))))
(if (stringp (cdr check))
;; Regular expression.
@@ -777,54 +765,109 @@ Used instead of `tabulated-list-print-entry'."
(insert (propertize title 'help-echo title))
;; Add properties.
(add-text-properties
- beg (point) `(tabulated-list-id ,list-id mouse-face ,widget-mouse-face))
+ beg (point)
+ `(tabulated-list-id ,list-id mouse-face highlight))
(insert ?\n))))
+(defun debbugs-gnu-menu-map-emacs-enabled ()
+ "Whether \"Show Release Blocking Bugs\" is enabled in the menu."
+ (or ;; No package discriminator has been used.
+ (not (assq 'package debbugs-gnu-local-query))
+ ;; Package "emacs" has been selected.
+ (member '(package . "emacs") debbugs-gnu-local-query)))
+
+(defconst debbugs-gnu-bug-triage-file
+ (expand-file-name "../admin/notes/bug-triage" data-directory)
+ "The \"bug-triage\" file.")
+
+(defun debbugs-gnu-menu-map-bug-triage-enabled ()
+ "Whether \"Describe Bug Triage Procedure\" is enabled in the menu."
+ (and (debbugs-gnu-menu-map-emacs-enabled)
+ (stringp debbugs-gnu-bug-triage-file)
+ (file-readable-p debbugs-gnu-bug-triage-file)))
+
+(defun debbugs-gnu-view-bug-triage ()
+ "Show \"bug-triage\" file."
+ (interactive)
+ (view-file debbugs-gnu-bug-triage-file))
+
(defvar debbugs-gnu-mode-map
- (let ((map (make-sparse-keymap)))
+ (let ((map (make-sparse-keymap))
+ (menu-map (make-sparse-keymap)))
(set-keymap-parent map tabulated-list-mode-map)
(define-key map "\r" 'debbugs-gnu-select-report)
(define-key map [mouse-1] 'debbugs-gnu-select-report)
(define-key map [mouse-2] 'debbugs-gnu-select-report)
+ (define-key map "g" 'debbugs-gnu-rescan)
+ (define-key map "R" 'debbugs-gnu-show-all-blocking-reports)
+ (define-key map "C" 'debbugs-gnu-send-control-message)
+
(define-key map "s" 'debbugs-gnu-toggle-sort)
(define-key map "t" 'debbugs-gnu-toggle-tag)
- (define-key map "d" 'debbugs-gnu-display-status)
- (define-key map "g" 'debbugs-gnu-rescan)
(define-key map "x" 'debbugs-gnu-toggle-suppress)
(define-key map "/" 'debbugs-gnu-narrow-to-status)
(define-key map "w" 'debbugs-gnu-widen)
+
(define-key map "b" 'debbugs-gnu-show-blocked-by-reports)
(define-key map "B" 'debbugs-gnu-show-blocking-reports)
- (define-key map "C" 'debbugs-gnu-send-control-message)
+ (define-key map "d" 'debbugs-gnu-display-status)
+
+ (define-key map [menu-bar debbugs] (cons "Debbugs" menu-map))
+ (define-key menu-map [debbugs-gnu-select-report]
+ '(menu-item "Show Reports" debbugs-gnu-select-report
+ :help "Show all reports belonging to this bug"))
+ (define-key-after menu-map [debbugs-gnu-rescan]
+ '(menu-item "Refresh Bugs" debbugs-gnu-rescan
+ :help "Refresh bug list")
+ 'debbugs-gnu-select-report)
+ (define-key-after menu-map [debbugs-gnu-show-all-blocking-reports]
+ '(menu-item "Show Release Blocking Bugs"
+ debbugs-gnu-show-all-blocking-reports
+ :enable (debbugs-gnu-menu-map-emacs-enabled)
+ :help "Show all bugs blocking next Emacs release")
+ 'debbugs-gnu-rescan)
+ (define-key-after menu-map [debbugs-gnu-send-control-message]
+ '(menu-item "Send Control Message"
+ debbugs-gnu-send-control-message
+ :help "Send control message to debbugs.gnu.org")
+ 'debbugs-gnu-show-all-blocking-reports)
+
+ (define-key-after menu-map [debbugs-gnu-separator1]
+ '(menu-item "--") 'debbugs-gnu-send-control-message)
+ (define-key-after menu-map [debbugs-gnu-search]
+ '(menu-item "Search Bugs" debbugs-gnu-search
+ :help "Search bugs on debbugs.gnu.org")
+ 'debbugs-gnu-separator1)
+ (define-key-after menu-map [debbugs-gnu]
+ '(menu-item "Retrieve Bugs" debbugs-gnu
+ :help "Retrieve bugs from debbugs.gnu.org")
+ 'debbugs-gnu-search)
+ (define-key-after menu-map [debbugs-gnu-bugs]
+ '(menu-item "Retrieve Bugs by Number" debbugs-gnu-bugs
+ :help "Retrieve selected bugs from debbugs.gnu.org")
+ 'debbugs-gnu)
+
+ (define-key-after menu-map [debbugs-gnu-separator2]
+ '(menu-item "--") 'debbugs-gnu-bugs)
+ (define-key-after menu-map [debbugs-gnu-view-bug-triage]
+ '(menu-item "Describe Bug Triage Procedure"
+ debbugs-gnu-view-bug-triage
+ :enable (debbugs-gnu-menu-map-bug-triage-enabled)
+ :help "Show procedure of triaging bugs")
+ 'debbugs-gnu-separator2)
map))
(defun debbugs-gnu-rescan ()
"Rescan the current set of bug reports."
(interactive)
-
- ;; The last page will be provided with new bug ids.
- ;; TODO: Do it also for the other pages.
- (when (and debbugs-gnu-widgets
- (eq debbugs-gnu-current-widget (car (last debbugs-gnu-widgets))))
- (let ((first-id (car (widget-get debbugs-gnu-current-widget :bug-ids)))
- (last-id (car
- (last (widget-get debbugs-gnu-current-widget :bug-ids))))
- (ids (debbugs-gnu-get-bugs
- (widget-get debbugs-gnu-current-widget :query))))
-
- (while (and (<= first-id last-id) (not (memq first-id ids)))
- (setq first-id (1+ first-id)))
-
- (when (<= first-id last-id)
- (widget-put debbugs-gnu-current-widget :bug-ids (memq first-id ids)))))
-
- ;; Refresh the buffer. `save-excursion' does not work, so we
- ;; remember the position.
- (let ((pos (point)))
- (debbugs-gnu-show-reports debbugs-gnu-current-widget)
- (goto-char pos)))
-
-(defvar debbugs-gnu-sort-state 'number)
+ (let ((id (debbugs-gnu-current-id))
+ (debbugs-gnu-current-query debbugs-gnu-local-query)
+ (debbugs-gnu-current-filter debbugs-gnu-local-filter)
+ (debbugs-gnu-current-suppress debbugs-gnu-local-suppress)
+ (debbugs-cache-expiry (if current-prefix-arg t debbugs-cache-expiry)))
+ (debbugs-gnu-show-reports)
+ (when id
+ (debbugs-gnu-goto id))))
(define-derived-mode debbugs-gnu-mode tabulated-list-mode "Debbugs"
"Major mode for listing bug reports.
@@ -836,7 +879,13 @@ The following commands are available:
\\{debbugs-gnu-mode-map}"
(set (make-local-variable 'debbugs-gnu-sort-state) 'number)
- (set (make-local-variable 'debbugs-gnu-current-limit) nil)
+ (set (make-local-variable 'debbugs-gnu-limit) nil)
+ (set (make-local-variable 'debbugs-gnu-local-query)
+ debbugs-gnu-current-query)
+ (set (make-local-variable 'debbugs-gnu-local-filter)
+ debbugs-gnu-current-filter)
+ (set (make-local-variable 'debbugs-gnu-local-suppress)
+ debbugs-gnu-current-suppress)
(setq tabulated-list-format [("Id" 5 debbugs-gnu-sort-id)
("State" 20 debbugs-gnu-sort-state)
("Submitter" 25 t)
@@ -848,7 +897,7 @@ The following commands are available:
(setq buffer-read-only t))
(defun debbugs-gnu-sort-id (s1 s2)
- (< (cdr (assq 'id (car s1)))
+ (> (cdr (assq 'id (car s1)))
(cdr (assq 'id (car s2)))))
(defconst debbugs-gnu-state-preference
@@ -924,7 +973,7 @@ The following commands are available:
(interactive)
(let ((id (debbugs-gnu-current-id t))
(inhibit-read-only t))
- (setq debbugs-gnu-current-limit nil)
+ (setq debbugs-gnu-limit nil)
(tabulated-list-init-header)
(tabulated-list-print)
(when id
@@ -948,6 +997,26 @@ The following commands are available:
(message "Bug %d is not blocking any other bug" id)
(apply 'debbugs-gnu-bugs (cdr (assq 'blocks status))))))
+(defun debbugs-gnu-show-all-blocking-reports ()
+ "Narrow the display to just the reports that are blocking a release."
+ (interactive)
+ (let ((blockers (cdr (assq 'blockedby
+ (car (debbugs-get-status
+ debbugs-gnu-blocking-report)))))
+ (id (debbugs-gnu-current-id t))
+ (inhibit-read-only t)
+ status)
+ (setq debbugs-gnu-limit nil)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (setq status (debbugs-gnu-current-status))
+ (if (not (memq (cdr (assq 'id status)) blockers))
+ (delete-region (point) (progn (forward-line 1) (point)))
+ (push (cdr (assq 'id status)) debbugs-gnu-limit)
+ (forward-line 1)))
+ (when id
+ (debbugs-gnu-goto id))))
+
(defun debbugs-gnu-narrow-to-status (string &optional status-only)
"Only display the bugs matching STRING.
If STATUS-ONLY (the prefix), ignore matches in the From and
@@ -956,20 +1025,21 @@ Subject fields."
(let ((id (debbugs-gnu-current-id t))
(inhibit-read-only t)
status)
- (setq debbugs-gnu-current-limit nil)
+ (setq debbugs-gnu-limit nil)
(if (equal string "")
(debbugs-gnu-toggle-suppress)
(goto-char (point-min))
(while (not (eobp))
(setq status (debbugs-gnu-current-status))
(if (and (not (member string (assq 'keywords status)))
- (not (member string (assq 'severity status)))
+ (not (equal string (cdr (assq 'severity status))))
(or status-only
- (not (string-match string (cdr (assq 'originator
status)))))
+ (not (string-match
+ string (cdr (assq 'originator status)))))
(or status-only
(not (string-match string (cdr (assq 'subject status))))))
(delete-region (point) (progn (forward-line 1) (point)))
- (push (cdr (assq 'id status)) debbugs-gnu-current-limit)
+ (push (cdr (assq 'id status)) debbugs-gnu-limit)
(forward-line 1)))
(when id
(debbugs-gnu-goto id)))))
@@ -1016,8 +1086,7 @@ interest to you."
(defun debbugs-gnu-toggle-suppress ()
"Suppress bugs marked in `debbugs-gnu-suppress-bugs'."
(interactive)
- (widget-put debbugs-gnu-current-widget :suppress
- (not (widget-get debbugs-gnu-current-widget :suppress)))
+ (setq debbugs-gnu-local-suppress (not debbugs-gnu-local-suppress))
(tabulated-list-init-header)
(tabulated-list-print))
@@ -1032,22 +1101,78 @@ interest to you."
(defun debbugs-gnu-current-status ()
(get-text-property (line-beginning-position) 'tabulated-list-id))
-(defun debbugs-gnu-current-query ()
- (widget-get debbugs-gnu-current-widget :query))
-
-(defun debbugs-gnu-display-status (query status)
- "Display the query and status of the report on the current line."
- (interactive (list (debbugs-gnu-current-query)
+(defun debbugs-gnu-display-status (query filter status)
+ "Display the query, filter and status of the report on the current line."
+ (interactive (list debbugs-gnu-local-query
+ debbugs-gnu-local-filter
(debbugs-gnu-current-status)))
- (pop-to-buffer "*Bug Status*")
+ (switch-to-buffer "*Bug Status*")
(let ((inhibit-read-only t))
(erase-buffer)
- (when query (pp query (current-buffer)))
- (when status (pp status (current-buffer)))
+ (when query
+ (insert ";; Query\n")
+ (pp query (current-buffer))
+ (insert "\n"))
+ (when filter
+ (insert ";; Filter\n")
+ (pp filter (current-buffer))
+ (insert "\n"))
+ (when status
+ (insert ";; Status\n")
+ (pp status (current-buffer)))
(goto-char (point-min)))
(set-buffer-modified-p nil)
(special-mode))
+(defun debbugs-read-emacs-bug-with-rmail (id status merged)
+ "Read email exchange for debbugs bug ID.
+STATUS is the bug's status list.
+MERGED is the list of bugs merged with this one."
+ (let* ((mbox-dir (make-temp-file "debbugs" t))
+ (mbox-fname (format "%s/bug_%d.mbox" mbox-dir id)))
+ (debbugs-get-mbox id 'mboxmaint mbox-fname)
+ (rmail mbox-fname)
+ ;; Download messages of all the merged bug reports and append them
+ ;; to the mailbox of the requested bug.
+ (when merged
+ (dolist (bugno merged)
+ (let ((fn (make-temp-file "url")))
+ (debbugs-get-mbox bugno 'mboxmaint fn)
+ (rmail-get-new-mail fn)
+ (delete-file fn)
+ ;; Remove the 'unseen' attribute from all the messages we've
+ ;; just read, so that all of them appear in the summary with
+ ;; the same face.
+ (while (< rmail-current-message rmail-total-messages)
+ (rmail-show-message (1+ rmail-current-message))))))
+ (set (make-local-variable 'debbugs-gnu-bug-number) id)
+ (set (make-local-variable 'debbugs-gnu-subject)
+ (format "Re: bug#%d: %s" id (cdr (assq 'subject status))))
+ (rmail-summary)
+ (define-key rmail-summary-mode-map "C" 'debbugs-gnu-send-control-message)
+ (set-window-text-height nil 10)
+ (other-window 1)
+ (define-key rmail-mode-map "C" 'debbugs-gnu-send-control-message)
+ (rmail-show-message 1)))
+
+(defun debbugs-read-emacs-bug-with-gnus (id status merged)
+ "Read email exchange for debbugs bug ID.
+STATUS is the bug's status list.
+MERGED is the list of bugs merged with this one."
+ (require 'gnus-dup)
+ (setq gnus-suppress-duplicates t
+ gnus-save-duplicate-list t)
+ ;; Use Gnus.
+ (gnus-read-ephemeral-emacs-bug-group
+ (cons id (if (listp merged) merged (list merged)))
+ (cons (current-buffer)
+ (current-window-configuration)))
+ (with-current-buffer (window-buffer (selected-window))
+ (set (make-local-variable 'debbugs-gnu-bug-number) id)
+ (set (make-local-variable 'debbugs-gnu-subject)
+ (format "Re: bug#%d: %s" id (cdr (assq 'subject status))))
+ (debbugs-gnu-summary-mode 1)))
+
(defun debbugs-gnu-select-report ()
"Select the report on the current line."
(interactive)
@@ -1055,17 +1180,15 @@ interest to you."
(let* ((status (debbugs-gnu-current-status))
(id (cdr (assq 'id status)))
(merged (cdr (assq 'mergedwith status))))
- (gnus-read-ephemeral-emacs-bug-group
- (cons id (if (listp merged)
- merged
- (list merged)))
- (cons (current-buffer)
- (current-window-configuration)))
- (with-current-buffer (window-buffer (selected-window))
- (set (make-local-variable 'debbugs-gnu-bug-number) id)
- (set (make-local-variable 'debbugs-gnu-subject)
- (format "Re: bug#%d: %s" id (cdr (assq 'subject status))))
- (debbugs-gnu-summary-mode 1))))
+ (setq merged (if (listp merged) merged (list merged)))
+ (cond
+ ((not id)
+ (message "No bug report on the current line"))
+ ((eq debbugs-gnu-mail-backend 'rmail)
+ (debbugs-read-emacs-bug-with-rmail id status merged))
+ ((eq debbugs-gnu-mail-backend 'gnus)
+ (debbugs-read-emacs-bug-with-gnus id status merged))
+ (t (error "No valid mail backend specified")))))
(defvar debbugs-gnu-summary-mode-map
(let ((map (make-sparse-keymap)))
@@ -1073,8 +1196,6 @@ interest to you."
(define-key map [(meta m)] 'debbugs-gnu-apply-patch)
map))
-(defvar gnus-posting-styles)
-
(define-minor-mode debbugs-gnu-summary-mode
"Minor mode for providing a debbugs interface in Gnus summary buffers.
@@ -1113,6 +1234,9 @@ interest to you."
(re-search-forward "#\\([0-9]+\\)" nil t)))
(string-to-number (match-string 1)))))
+(defvar debbugs-gnu-send-mail-function nil
+ "A function to send control messages from debbugs.")
+
(defun debbugs-gnu-send-control-message (message &optional reverse)
"Send a control message for the current bug report.
You can set the severity or add a tag, or close the report. If
@@ -1132,6 +1256,7 @@ removed instead."
"owner" "noowner"
"invalid"
"reassign"
+ "retitle"
"patch" "wontfix" "moreinfo" "unreproducible" "fixed" "notabug"
"pending" "help" "security" "confirmed"
"usertag")
@@ -1163,6 +1288,7 @@ removed instead."
(insert "To: address@hidden"
"From: " (message-make-from) "\n"
(format "Subject: control message for bug #%d\n" id)
+ mail-header-separator
"\n"
(cond
((member message '("unarchive" "unmerge" "reopen" "noowner"))
@@ -1184,6 +1310,8 @@ removed instead."
" ")))
((equal message "owner")
(format "owner %d !\n" id))
+ ((equal message "retitle")
+ (format "retitle %d %s\n" id (read-string "New title: ")))
((equal message "reassign")
(format "reassign %d %s\n" id (read-string "Package(s): ")))
((equal message "close")
@@ -1211,7 +1339,11 @@ removed instead."
(format "tags %d%s %s\n"
id (if reverse " -" "")
message))))
- (funcall send-mail-function))))
+ (funcall (or debbugs-gnu-send-mail-function send-mail-function))
+ (remhash id debbugs-cache-data)
+ (message-goto-body)
+ (message "Control message sent:\n%s"
+ (buffer-substring-no-properties (point) (1- (point-max)))))))
(defvar debbugs-gnu-usertags-mode-map
(let ((map (make-sparse-keymap)))
@@ -1262,13 +1394,12 @@ The following commands are available:
;; Create buffer.
(when (get-buffer buffer-name)
(kill-buffer buffer-name))
- (pop-to-buffer (get-buffer-create buffer-name))
+ (switch-to-buffer (get-buffer-create buffer-name))
(debbugs-gnu-usertags-mode)
(setq tabulated-list-format `[("User" ,user-tab-length t)
("Tag" 10 t)])
(setq tabulated-list-sort-key (cons "User" nil))
;(setq tabulated-list-printer 'debbugs-gnu-print-entry)
- (erase-buffer)
;; Retrieve user tags.
(dolist (user users)
@@ -1277,8 +1408,8 @@ The following commands are available:
'tabulated-list-entries
;; `tabulated-list-id' is the parameter list for `debbugs-gnu'.
`((("tagged") (,user) nil nil (,tag))
- ,(vector (propertize user 'mouse-face widget-mouse-face)
- (propertize tag 'mouse-face widget-mouse-face)))
+ ,(vector (propertize user 'mouse-face 'highlight)
+ (propertize tag 'mouse-face 'highlight)))
'append)))
;; Add local tags.
@@ -1286,8 +1417,8 @@ The following commands are available:
(add-to-list
'tabulated-list-entries
`((("tagged"))
- ,(vector "" (propertize "(local tags)"
- 'mouse-face widget-mouse-face)))))
+ ,(vector
+ "" (propertize "(local tags)" 'mouse-face 'highlight)))))
;; Show them.
(tabulated-list-init-header)
@@ -1312,12 +1443,14 @@ The following commands are available:
(dolist (elt bugs)
(unless (natnump elt) (signal 'wrong-type-argument (list 'natnump elt))))
(add-to-list 'debbugs-gnu-current-query (cons 'bugs bugs))
+ ;; We do not suppress bugs requested explicitely.
+ (setq debbugs-gnu-current-suppress nil)
(debbugs-gnu nil))
(defvar debbugs-gnu-trunk-directory "~/src/emacs/trunk/"
"The directory where the main source tree lives.")
-(defvar debbugs-gnu-branch-directory "~/src/emacs/emacs-24/"
+(defvar debbugs-gnu-branch-directory "~/src/emacs/emacs-25/"
"The directory where the previous source tree lives.")
(defun debbugs-gnu-apply-patch (&optional branch)
@@ -1342,14 +1475,22 @@ If given a prefix, patch in the branch directory
instead."
;; buffer. Determine which.
(gnus-with-article-buffer
(dolist (handle (mapcar 'cdr (gnus-article-mime-handles)))
- (when (string-match "diff\\|patch" (mm-handle-media-type handle))
- (push (mm-handle-buffer handle) patch-buffers))))
+ (when (string-match "diff\\|patch\\|plain" (mm-handle-media-type
handle))
+ (push (cons (mm-handle-encoding handle)
+ (mm-handle-buffer handle))
+ patch-buffers))))
(unless patch-buffers
(gnus-summary-show-article 'raw)
(article-decode-charset)
- (push (current-buffer) patch-buffers))
- (dolist (buffer patch-buffers)
- (with-current-buffer buffer
+ (push (cons nil gnus-article-buffer) patch-buffers))
+ (dolist (elem patch-buffers)
+ (with-current-buffer (generate-new-buffer "*debbugs input patch*")
+ (insert-buffer-substring (cdr elem))
+ (cond ((eq (car elem) 'base64)
+ (base64-decode-region (point-min) (point-max)))
+ ((eq (car elem) 'quoted-printable)
+ (quoted-printable-decode-region (point-min) (point-max))))
+ (debbugs-gnu-fix-patch dir)
(call-process-region (point-min) (point-max)
"patch" nil output-buffer nil
"-r" rej "--no-backup-if-mismatch"
@@ -1363,7 +1504,7 @@ If given a prefix, patch in the branch directory instead."
(goto-char (point-max))
(save-some-buffers t)
(require 'compile)
- (mapcar 'kill-process compilation-in-progress)
+ (mapc 'kill-process compilation-in-progress)
(compile (format "cd %s; make -k" (expand-file-name "lisp" dir)))
(vc-dir dir)
(vc-dir-hide-up-to-date)
@@ -1385,6 +1526,36 @@ If given a prefix, patch in the branch directory
instead."
(switch-to-buffer "*vc-diff*")
(goto-char (point-min))))
+(defun debbugs-gnu-fix-patch (dir)
+ (setq dir (directory-file-name (expand-file-name dir)))
+ (goto-char (point-min))
+ (while (re-search-forward diff-file-header-re nil t)
+ (goto-char (match-beginning 0))
+ (let ((target-name (car (diff-hunk-file-names))))
+ (when (and target-name
+ (or (not (string-match "/" target-name))
+ (and (string-match "^[ab]/" target-name)
+ (not (file-exists-p
+ (expand-file-name (substring target-name 2)
+ dir))))
+ (file-exists-p (expand-file-name target-name dir))))
+ ;; We have a simple patch that refers to a file somewhere in the
+ ;; tree. Find it.
+ (when-let ((files (directory-files-recursively
+ dir
+ (concat "^" (regexp-quote
+ (file-name-nondirectory target-name))
+ "$"))))
+ (when (re-search-forward (concat "^[+]+ "
+ (regexp-quote target-name)
+ "\\([ \t\n]\\)")
+ nil t)
+ (replace-match (concat "+++ a"
+ (substring (car files) (length dir))
+ (match-string 1))
+ nil t)))))
+ (forward-line 2)))
+
(defun debbugs-gnu-find-contributor (string)
"Search through ChangeLogs to find contributors."
(interactive "sContributor match: ")
@@ -1427,9 +1598,9 @@ If given a prefix, patch in the branch directory instead."
;; Fall back on the email address.
(t
(cadr from))))))
- (goto-char (point-min))
+ (goto-char (point-max))
(end-of-line)
- (insert " (tiny change"))
+ (insert " Copyright-paperwork-exempt: yes"))
(goto-char point)))))
(defvar debbugs-gnu-lisp-mode-map
@@ -1474,7 +1645,11 @@ If given a prefix, patch in the branch directory
instead."
(save-some-buffers t)
(when (get-buffer "*vc-dir*")
(kill-buffer (get-buffer "*vc-dir*")))
- (vc-dir debbugs-gnu-trunk-directory)
+ (let ((trunk (expand-file-name debbugs-gnu-trunk-directory)))
+ (if (equal (cl-subseq default-directory 0 (length trunk))
+ trunk)
+ (vc-dir debbugs-gnu-trunk-directory)
+ (vc-dir debbugs-gnu-branch-directory)))
(goto-char (point-min))
(while (not (search-forward "edited" nil t))
(sit-for 0.01))
@@ -1495,6 +1670,7 @@ If given a prefix, patch in the branch directory instead."
;;; TODO:
-;; * Reorganize pages after client-side filtering.
+;; * Another random thought - is it possible to implement some local
+;; cache, so only changed bugs are fetched? Glenn Morris.
;;; debbugs-gnu.el ends here
diff --git a/packages/debbugs/debbugs-org.el b/packages/debbugs/debbugs-org.el
index d49219f..a95672d 100644
--- a/packages/debbugs/debbugs-org.el
+++ b/packages/debbugs/debbugs-org.el
@@ -1,11 +1,10 @@
;;; debbugs-org.el --- Org-mode interface for the GNU bug tracker
-;; Copyright (C) 2013-2015 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2016 Free Software Foundation, Inc.
;; Author: Michael Albinus <address@hidden>
;; Keywords: comm, hypermedia, maint, outlines
;; Package: debbugs
-;; Version: 0.6
;; This file is not part of GNU Emacs.
@@ -56,7 +55,7 @@
;; If a prefix is given to the command, more search parameters are
;; asked for, like packages (also a comma separated list, "emacs" is
;; the default), whether archived bugs shall be shown, and whether
-;; closed bugs shall be shown.
+;; closed bugs shall be suppressed from being retrieved.
;; Another command is
;;
@@ -71,12 +70,11 @@
;; The bug reports are downloaded from the bug tracker. In order to
;; not generate too much load of the server, up to 500 bugs will be
-;; downloaded at once. If there are more hits, you will be asked to
-;; change this limit, but please don't increase this number too much.
+;; downloaded at once. If there are more hits, several downloads will
+;; be performed, until all bugs are retrieved.
;; These default values could be changed also by customer options
-;; `debbugs-gnu-default-severities', `debbugs-gnu-default-packages'
-;; and `debbugs-gnu-default-hits-per-page'.
+;; `debbugs-gnu-default-severities' and `debbugs-gnu-default-packages'.
;; The commands create a TODO list. Besides the usual handling of
;; TODO items, you could apply the following actions by the following
@@ -87,9 +85,9 @@
;; "C-c # d": Show bug attributes
;; The last entry in a TODO record is the link [[Messages]]. If you
-;; follow this link, a Gnus ephemeral group is opened presenting all
-;; related messages for this bug. Here you could also send debbugs
-;; control messages by keystroke "C".
+;; follow this link, a Gnus ephemeral group or an Rmail buffer is
+;; opened presenting all related messages for this bug. Here you
+;; could also send debbugs control messages by keystroke "C".
;; Finally, if you simply want to list some bugs with known bug
;; numbers, call the command
@@ -104,6 +102,10 @@
(require 'org)
(eval-when-compile (require 'cl))
+;; Buffer-local variables.
+(defvar debbugs-gnu-local-query)
+(defvar debbugs-gnu-local-filter)
+
(defconst debbugs-org-severity-priority
(let ((priority ?A))
(mapcar
@@ -122,22 +124,10 @@
("B" . org-warning))
"Highlighting of prioritized TODO items.")
-;; We do not add the bug numbers list to the elisp:link, because this
-;; would be much too long. Instead, this variable shall keep the bug
-;; numbers.
-(defvar-local debbugs-org-ids nil
- "The list of bug ids to be shown following the elisp link.")
-
-(defvar debbugs-org-show-buffer-name "*Org Bugs*"
+(defvar debbugs-org-buffer-name "*Org Bugs*"
"The buffer name we present the bug reports.
This could be a temporary buffer, or a buffer linked with a file.")
-(defvar debbugs-org-mode) ;; Silence compiler.
-(defun debbugs-org-show-buffer-name ()
- "The buffer name we present the bug reports.
-This could be a temporary buffer, or a buffer linked with a file."
- (if debbugs-org-mode (buffer-name) debbugs-org-show-buffer-name))
-
;;;###autoload
(defun debbugs-org-search ()
"Search for bugs interactively.
@@ -203,10 +193,7 @@ returned."
(t (throw :finished nil)))))
;; Do the search.
- (debbugs-org severities packages))
-
- ;; Reset query and filter.
- (setq debbugs-gnu-current-query nil)))
+ (debbugs-org severities packages))))
;;;###autoload
(defun debbugs-org (severities &optional packages archivedp suppress tags)
@@ -255,46 +242,28 @@ returned."
(when (not (zerop (length tag)))
(add-to-list 'debbugs-gnu-current-query (cons 'tag tag))))
- (unwind-protect
- (with-current-buffer (get-buffer-create (debbugs-org-show-buffer-name))
- (erase-buffer)
-
- (let ((hits debbugs-gnu-default-hits-per-page))
- (setq debbugs-org-ids
- (debbugs-gnu-get-bugs debbugs-gnu-current-query))
-
- (when (> (length debbugs-org-ids) hits)
- (let ((cursor-in-echo-area nil))
- (setq hits
- (string-to-number
- (read-string
- (format
- "How many reports (available %d, default %d): "
- (length debbugs-org-ids) hits)
- nil
- nil
- (number-to-string hits))))))
-
- (debbugs-org-show-next-reports hits)))
-
- ;; Reset query.
- (setq debbugs-gnu-current-query nil)))
-
-(defun debbugs-org-show-reports (bug-numbers)
- "Show bug reports as given in BUG-NUMBERS."
- (pop-to-buffer (get-buffer-create (debbugs-org-show-buffer-name)))
- ;; Local variable `debbugs-org-ids' must survive.
- (let ((doi debbugs-org-ids))
+ ;; Show result.
+ (debbugs-org-show-reports)
+
+ ;; Reset query.
+ (setq debbugs-gnu-current-query nil))
+
+(defun debbugs-org-show-reports ()
+ "Show bug reports as retrieved via `debbugs-gnu-current-query'."
+ (let ((inhibit-read-only t)
+ (org-startup-folded t))
+ (when (get-buffer debbugs-org-buffer-name)
+ (kill-buffer debbugs-org-buffer-name))
+ (switch-to-buffer (get-buffer-create debbugs-org-buffer-name))
(org-mode)
(debbugs-org-mode 1)
- (setq debbugs-org-ids doi))
- (let ((inhibit-read-only t)
- (debbugs-port "gnu.org"))
(dolist (status
+ ;; `debbugs-get-status' returns in random order, so we must sort.
(sort
- (apply 'debbugs-get-status bug-numbers)
- (lambda (x y) (< (cdr (assq 'id x)) (cdr (assq 'id y))))))
+ (apply 'debbugs-get-status
+ (debbugs-gnu-get-bugs debbugs-gnu-local-query))
+ (lambda (a b) (> (cdr (assq 'id a)) (cdr (assq 'id b))))))
(let* ((beg (point))
(id (cdr (assq 'id status)))
(done (string-equal (cdr (assq 'pending status)) "done"))
@@ -369,7 +338,17 @@ returned."
(seconds-to-time last-modified))))
;; Add text properties.
- (add-text-properties beg (point) `(tabulated-list-id ,status))))))
+ (add-text-properties beg (point) `(tabulated-list-id ,status))))
+
+ ;; The end.
+ (insert "* COMMENT Local " "Variables\n"
+ "# Local " "Variables:\n"
+ "# mode: org\n"
+ "# eval: (debbugs-org-mode 1)\n"
+ "# End:\n")
+ (goto-char (point-min))
+ (org-overview)
+ (set-buffer-modified-p nil)))
(defun debbugs-org-regenerate-status ()
"Regenerate the `tabulated-list-id' text property.
@@ -388,42 +367,6 @@ the corresponding buffer (e.g. by closing Emacs)."
(end (org-end-of-subtree t)))
(add-text-properties beg end `(tabulated-list-id ,tli))))))
-(defun debbugs-org-show-next-reports (hits)
- "Show next HITS of bug reports."
- (with-current-buffer (get-buffer-create (debbugs-org-show-buffer-name))
- (save-excursion
- (goto-char (point-max))
- (when (re-search-backward
- "^* COMMENT \\[\\[elisp:(debbugs-org-show-next-reports" nil t)
- (forward-line -1)
- (delete-region (point) (point-max)))
- (debbugs-org-show-reports
- (butlast debbugs-org-ids (- (length debbugs-org-ids) hits)))
- (setq debbugs-org-ids
- (last debbugs-org-ids (- (length debbugs-org-ids) hits)))
- (goto-char (point-max))
- (when debbugs-org-ids
- (insert
- (format
- "* COMMENT [[elisp:(debbugs-org-show-next-reports %s)][Next
bugs]]\n\n"
- hits)))
- (insert "* COMMENT Local " "Variables\n")
- (when debbugs-org-ids
- (insert "#+NAME: init\n"
- "#+BEGIN_SRC elisp\n"
- (format "(setq debbugs-org-ids '%s)\n" debbugs-org-ids)
- "#+END_SRC\n\n"))
- (insert "# Local " "Variables:\n"
- "# mode: org\n"
- "# eval: (debbugs-org-mode 1)\n")
- (when debbugs-org-ids
- (insert (format "# eval: (%s \"init\")\n"
- (if (macrop 'org-sbe) "org-sbe" "sbe"))))
- (insert "# End:\n")
- (goto-char (point-min))
- (org-overview)
- (set-buffer-modified-p nil))))
-
(defconst debbugs-org-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "C-c # t") 'debbugs-gnu-toggle-tag)
@@ -441,6 +384,9 @@ the corresponding buffer (e.g. by closing Emacs)."
\\{debbugs-org-mode-map}"
:lighter " Debbugs" :keymap debbugs-org-mode-map
+ (set (make-local-variable 'debbugs-gnu-local-query)
debbugs-gnu-current-query)
+ (set (make-local-variable 'debbugs-gnu-local-filter)
+ debbugs-gnu-current-filter)
;; FIXME: Does not show any effect.
(set (make-local-variable 'org-priority-faces) debbugs-org-priority-faces)
(set (make-local-variable 'gnus-posting-styles)
diff --git a/packages/debbugs/debbugs-ug.info b/packages/debbugs/debbugs-ug.info
new file mode 100644
index 0000000..422aa98
--- /dev/null
+++ b/packages/debbugs/debbugs-ug.info
@@ -0,0 +1,594 @@
+This is debbugs-ug.info, produced by makeinfo version 6.0 from
+debbugs-ug.texi.
+
+Copyright (C) 2015-2016 Free Software Foundation, Inc.
+
+ Permission is granted to copy, distribute and/or modify this
+ document under the terms of the GNU Free Documentation License,
+ Version 1.2 or any later version published by the Free Software
+ Foundation; with no Invariant Sections, with the Front-Cover, or
+ Back-Cover Texts. A copy of the license is included in the
+ section entitled "GNU Free Documentation License" in the Emacs
+ manual.
+
+ This document is part of a collection distributed under the GNU
+ Free Documentation License. If you want to distribute this
+ document separately from the collection, you can do so by adding
+ a copy of the license to the document, as described in section 6
+ of the license.
+
+ All Emacs Lisp code contained in this document may be used,
+ distributed, and modified without restriction.
+INFO-DIR-SECTION Emacs
+START-INFO-DIR-ENTRY
+* Debbugs UG: (debbugs-ug). Debbugs User Interface in Emacs.
+END-INFO-DIR-ENTRY
+
+
+File: debbugs-ug.info, Node: Top, Next: Retrieving Bugs, Up: (dir)
+
+Debbugs User Guide
+******************
+
+Debbugs is a bugtracking system (BTS) that was initially written for
+the Debian project but currently used also by the GNU project. The
+main distinctive feature of Debbugs is that it's mostly email-based.
+All actions on bug reports: opening, closing, changing the status,
+commenting, forwarding are performed via email by sending specially
+composed letters to the particular email addresses. However,
+searching the bug reports, querying bug report status and viewing
+comments have been web-based for a long time. To overcome this
+inconvenience the Debbugs/SOAP service was introduced.
+
+ Based on the Debbugs/SOAP service, frontends are written which
+offer handling of bugs inside Emacs. These frontends are restricted
+to the GNU Debbugs server. Bugs are presented either as tabulated
+list ('debbugs-gnu') or as 'org-mode' TODO list ('debbugs-org', *note
+Org Mode: (org)Top.). As backend they use the 'debbugs' Emacs library
+(*note Debbugs Programmer's Manual: (debbugs)Top.).
+
+* Menu:
+
+* Retrieving Bugs:: How to retrieve bugs.
+* Searching Bugs:: How to search in the debbugs database.
+* Layout:: How the results are presented.
+* Minor Mode:: How to use browse bug URLs.
+
+* Command Index:: Debbugs commands.
+* Variable Index:: User options and variables.
+* Key Index:: Keyboard strokes on bug report buffers.
+
+
+File: debbugs-ug.info, Node: Retrieving Bugs, Next: Searching Bugs, Prev:
Top, Up: Top
+
+1 Retrieving Bugs
+*****************
+
+Bugs are retrieved by the 'debbugs-gnu' or 'debbugs-org' commands. In
+their simple version, they retrieve just bugs for the '"emacs"'
+package on the GNU Debbugs server, filtered by bug severities.
+Further filtering is possible when the commands are called with a
+prefix.
+
+ When the bug numbers to be retrieved are known, the commands
+'debbugs-gnu-bugs' or 'debbugs-org-bugs' are applicable.
+
+ -- Command: debbugs-gnu severities &optional packages archivedp
+ suppress tags
+ -- Command: debbugs-org severities &optional packages archivedp
+ suppress tags
+
+ These commands retrieve bug reports from the GNU Debbugs server.
+ 'debbugs-gnu' returns a tabulated list, and 'debbugs-org' returns
+ a list of TODO items in 'org-mode'. In order not to stress the
+ GNU Debbugs server, the bugs are retrieved in chunks of 500 bugs.
+ However, the bug report buffer shows all retrieved bugs then, in
+ reverse bug number order.
+
+ SEVERITIES is a list of strings which filter for the severities
+ of the bugs to be retrieved. Valid severities are '"serious"',
+ '"important"', '"normal"', '"minor"' and '"wishlist"' (see also
+ the constant 'debbugs-gnu-all-severities'). If the list is
+ empty, there is no filtering with respect to severities. The
+ keyword '"tagged"', which is also possible, is not a severity in
+ the GNU Debbugs server but allows to restrict the result to bugs
+ with a given user tag.
+
+ PACKAGES, also a list of strings, point to the defined software
+ packages on the GNU Debbugs server which shall be taken into
+ account. The existing package names are compiled into the
+ constant 'debbugs-gnu-all-packages'.
+
+ ARCHIVEDP, if non-'nil', extends the result also on archived bugs
+ on the GNU Debbugs server.
+
+ SUPPRESS shall also distinct between 'nil' and non-'nil'. When
+ non-'nil', closed bugs are suppressed from being retrieved from
+ the Debbugs server. Which bugs are regarded as suppressed is
+ configured in the customer option 'debbugs-gnu-suppress-bugs'.
+ Per default, bugs marked as '"done"' are suppressed from being
+ retrieved.
+
+ When SEVERITIES contains the severity '"tagged"', TAGS is
+ consulted in order to restrict the result on bugs which are
+ tagged with one of the strings of the list TAGS. This list can
+ also be empty; in this case locally tagged bugs are included into
+ the results.
+
+ Called interactively, the commands require just the SEVERITIES
+ and the TAGS (if SEVERITIES includes '"tagged"'). In order to
+ provide the other arguments interactively, the commands must be
+ called with a prefix, like 'C-u M-x debbugs-gnu'. In the
+ minibuffer, lists must be entered comma-separated.
+
+ Default values for interactive use could be configured in the
+ customer options 'debbugs-gnu-default-severities' and
+ 'debbugs-gnu-default-packages'.
+
+ *note Layout:: for the presentation of the results.
+
+ -- Command: debbugs-gnu-bugs &rest bugs
+ -- Command: debbugs-org-bugs &rest bugs
+
+ The commands 'debbugs-gnu-bugs' and 'debbugs-org-bugs' show bugs
+ specified by their bug number. Interactively, the bug numbers
+ must be entered as comma-separated list.
+
+ *note Layout:: for the presentation of the results.
+
+
+File: debbugs-ug.info, Node: Searching Bugs, Next: Layout, Prev: Retrieving
Bugs, Up: Top
+
+2 Searching in the Debbugs Database.
+************************************
+
+The GNU Debbugs server allows full text search in the database. It
+uses a HyperEstraier based search engine
+(http://fallabs.com/hyperestraier/uguide-en.html#searchcond)(1).
+
+ -- Command: debbugs-gnu-search
+ -- Command: debbugs-org-search
+
+ These both commands are completely interactive. They ask for a
+ '"search phrase"' for the full text search. It is just a string
+ which contains the words to be searched for, combined by
+ operators like AND, ANDNOT and OR. If there is no operator
+ between the words, AND is used by default.
+
+ Wild card searches are also supported. It can be used for
+ forward match search and backward match search. For example,
+ "[BW] euro" matches words which begin with "euro". "[EW] shere"
+ matches words which end with "sphere". Moreover, regular
+ expressions are also supported. For example, "[RX] ^inter.*al$"
+ matches words which begin with "inter" and end with "al".(2)
+
+ While the words to be searched for are case insensitive, the
+ operators must be specified case sensitive.
+
+ While the search for the phrase is performed only in the bodies
+ of the messages belonging to a bug report, it is also possible to
+ discriminate the search to further bug attributes. The commands
+ ask for such key-value pairs, until an empty key is returned.
+ Possible attributes are
+
+ 'severity'
+ A comma-separated list of bug severities, *Note Retrieving
+ Bugs::.
+
+ 'package'
+ A comma-separated list of defined software packages on the
+ GNU Debbugs server, *Note Retrieving Bugs::.
+
+ 'tags'
+ A comma-separated list of defined user tags.
+
+ 'submitter'
+ The email address of the bug submitter.
+
+ 'date'
+ A time period the bug has been in which the bug has been
+ submitted or modified.
+
+ 'subject'
+ Word(s) the subject of the bug report contains.
+
+ 'status'
+ The status of the bug report. Valid values are "done",
+ "forwarded" and "open".
+
+ It is also possible to apply these commands with an empty search
+ phrase. In this case, the GNU Debbugs server is searched only
+ for bugs which fulfill the given attributes. The attributes to
+ be applied are the same as already described, plus
+
+ 'archive'
+ Whether archived bugs shall be searched (no value to be
+ entered).
+
+ 'src'
+ Bugs which belong to a given source, if that attribute has
+ set.
+
+ 'tag'
+ An arbitrary string the bug is annotated with. Usually,
+ this is the same as the status mentioned above.
+
+ 'owner'
+ 'maint'
+ 'correspondent'
+ The email address of the bug's owner, maintainer, or
+ correspondent (somebody who has participated in bug
+ messages).
+
+ 'log_modified'
+ 'last_modified'
+ 'found_date'
+ 'fixed_date'
+ The date of the last update, or the date of the bug report /
+ bug fix.
+
+ 'unarchived'
+ The date the bug has been unarchived, if ever.
+
+ 'done'
+ The email address of the worker who has closed the bug (if
+ done).
+
+ 'forwarded'
+ A URL or an email address.
+
+ 'msgid'
+ The message id of the initial bug report.
+
+ 'summary'
+ The summary of the bug report.
+
+ Not all of these attributes could be queried on the GNU Debbugs
+ server via the Debbugs/SOAP backend. In this case, the results
+ of a query are discriminated on the client side, which is
+ indicated by the string "(client-side filter)" in the minibuffer
+ after the attribute name.
+
+ ---------- Footnotes ----------
+
+ (1) This has been added to the Debbugs/SOAP backend of the GNU
+Debbugs server only.
+
+ (2) Simplified forms, as described in the Hyperestraier User Guide,
+are not supported.
+
+
+File: debbugs-ug.info, Node: Layout, Next: Minor Mode, Prev: Searching
Bugs, Up: Top
+
+3 Layout
+********
+
+The commands described in the previous chapters generate (a) report
+buffer(s) applicable for navigation. 'debbugs-gnu-*' return a
+tabulated list, and 'debbugs-org-*' return a list of TODO items in
+'org-mode'.
+
+* Menu:
+
+* Tabulated Lists:: Tabulated Lists.
+* TODO Items:: TODO Items.
+* Control Messages:: Control Messages.
+
+
+File: debbugs-ug.info, Node: Tabulated Lists, Next: TODO Items, Up: Layout
+
+3.1 Tabulated Lists
+===================
+
+A tabulated list of bug reports consist of four columns for every bug
+entry: 'Id' (the bug number), 'State' (some bug attributes),
+'Submitter' (the name of the bug submitter), and 'Title' (the bug
+subject). Per default the bugs are sorted descending by 'Id'; this
+could be changed by clicking in the headline.
+
+ Different foreground colours present further information on the bug
+report. If the bug number uses a red colour ('debbugs-gnu-tagged'),
+the bug has been tagged locally. The same face is used to mark bugs
+in the submitter or title column, when the bug has been reported / is
+maintained by the user.
+
+ The bug state could appear in different colours: red
+('debbugs-gnu-new', nobody has answered yet to this bug), ForestGreen
+('debbugs-gnu-handled', the bug has been modified recently),
+MidnightBlue ('debbugs-gnu-pending', the bug is pending), orange
+('debbugs-gnu-stale', the bug has not been touched for a while), and
+DarkGrey ('debbugs-gnu-done', the bug is closed). Archived bugs are
+shown with inverse face ('debbugs-gnu-archived').
+
+ The bug report buffers have enabled the minor 'debbugs-gnu-mode'.
+This enables the following key strokes:
+
+'<RET>' 'debbugs-gnu-select-report'
+'<mouse-1>' Show the email messages that discuss the bug.
+'<mouse-2>'
+
+'d' 'debbugs-gnu-display-status'
+ Show all bug attributes.
+
+'/' 'debbugs-gnu-narrow-to-status'
+ Narrow the list of bugs to the bugs that match the
+ given regex in 'State', 'Submitter' or 'Title'.
+
+'R' 'debbugs-gnu-show-all-blocking-reports'
+ Narrow the list of bug reports to the ones that are
+ blocking the current release.
+
+'w' 'debbugs-gnu-widen'
+ Restore the full list again after narrowing.
+
+'g' 'debbugs-gnu-rescan'
+ Reload all bugs. With a prefix argument 'C-u', the
+ bug status cache is disabled, and all bug reports are
+ retrieved from the GNU Debbugs server.
+
+'B' 'debbugs-gnu-show-blocking-reports'
+'b' 'debbugs-gnu-show-blocked-by-reports'
+ Show all bug reports which are blocking / blocked by
+ this bug.
+
+'s' 'debbugs-gnu-toggle-sort'
+ Toggle sorting order of bugs.
+
+'t' 'debbugs-gnu-toggle-tag'
+ Toggle local tag of bugs.
+
+'x' 'debbugs-gnu-toggle-suppress'
+ Toggle showing of closed bugs.
+
+'C' 'debbugs-gnu-send-control-message'
+ Send a control message for this bug,
+ *note Control Messages::.
+
+
+ The user option 'debbugs-gnu-mail-backend' controls the
+presentation of email messages produced by typing '<RET>' or by
+clicking the mouse on a bug: if its value is 'gnus', the default, a
+GNUS ephemeral group for that bug will be shown; if its value is
+'rmail', the command will present an Rmail folder instead.
+
+
+File: debbugs-ug.info, Node: TODO Items, Next: Control Messages, Prev:
Tabulated Lists, Up: Layout
+
+3.2 TODO Items
+==============
+
+TODO items are offered as usual in 'org-mode'. The bug attributes are
+mapped onto properties of these items. They can be shown by the usual
+navigation in 'org-mode'.
+
+ Bug severities are mapped onto org severities, see
+'debbugs-org-severity-priority'.
+
+ The bug report buffers have enabled the minor 'debbugs-org-mode'.
+This enables the following key strokes:
+
+'<TAB>' 'org-cycle'
+ Outline the bug report attributes in 'org-mode'.
+
+'C-c # d' 'debbugs-gnu-display-status'
+ Show all bug attributes.
+
+'C-c # t' 'debbugs-gnu-toggle-tag'
+ Toggle local tag of bugs.
+
+'C-c # C' 'debbugs-gnu-send-control-message'
+ Send a control message for this bug, *note Control Messages::.
+
+
+ When the bug attributes are shown by 'org-cycle', there is a link
+'Messages' which opens a GNUS ephemeral group for that bug.
+
+
+File: debbugs-ug.info, Node: Control Messages, Prev: TODO Items, Up: Layout
+
+3.3 Control Messages
+====================
+
+Debbugs control messages are sent by email to the GNU Debbugs control
+server. Their format is described in
+<http://debbugs.gnu.org/server-control.html>.
+
+ A control message can be initiated in the tabulated list of bugs,
+in the list of org TODO items, or in the GNUS ephemeral group or Rmail
+folder opened for the messages belonging to a given bug. Control
+messages can be sent to unarchived bugs only, in case a bug is
+archived the control message 'unarchive' must be sent first.
+
+ In the minibuffer, the following control messages can be requested
+(assuming that 12345 is the bug the control message is intended for).
+The strings show the exact format of the control messages.
+
+'block'
+'unblock'
+ "block|unblock 12345 by 54321"
+
+ The second bug number is read interactively. It could be also a
+ list of comma-separated bug numbers.
+
+'close'
+ "close 12345 25.1"
+
+ The second argument, the Emacs version, is read interactively.
+
+'confirmed'
+'fixed'
+'help'
+'moreinfo'
+'notabug'
+'patch'
+'pending'
+'security'
+'unreproducible'
+'wontfix'
+ "tags 12345 confirmed|fixed|help|moreinfo|notabug"
+
+ "tags 12345 patch|pending|security|unreproducible|wontfix"
+
+'done'
+'donenotabug'
+'doneunreproducible'
+'donewontfix'
+ "tags 12345 fixed|notabug|unreproducible|wontfix"
+ "close 12345 25.1"
+
+ The second argument in the close message, the Emacs version, is
+ read interactively.
+
+'forcemerge'
+'merge'
+ "forcemerge|merge 12345 54321"
+
+ The second bug number is read interactively.
+
+'invalid'
+ "tags 12345 notabug"
+ "tags 12345 wontfix"
+ "close 12345"
+
+'noowner'
+ "noowner 12345"
+
+'owner'
+ "owner 12345 !"
+
+'reassign'
+ "reassign 12345 PACKAGE"
+
+ The package name on the GNU Debbugs server is read interactively.
+
+'reopen'
+ "reopen 12345"
+
+'retitle'
+ "retitle 12345 TITLE"
+
+ The new bug title is read interactively.
+
+'serious'
+'important'
+'normal'
+'minor'
+'wishlist'
+ "severity 12345 serious|important|normal|minor|wishlist"
+
+'unarchive'
+ "unarchive 12345"
+
+'unmerge'
+ "unmerge 12345"
+
+'usertag'
+ "user USERNAME"
+ "usertag 12345 TAG"
+
+ The username, read interactively, is either a package name or an
+ email address. The tag to be set is also read interactively.
+
+
+File: debbugs-ug.info, Node: Minor Mode, Next: Command Index, Prev: Layout,
Up: Top
+
+4 Minor Mode
+************
+
+Emacs uses 'bug-reference.el' for adding hyperlinks to bugs in files
+like 'ChangeLog', or in commentary sections of other files. The
+reference to such bugs have a specialized format, <Bug#12345>. The
+hyperlinks are implemented as minor modes 'bug-reference-mode' and
+'bug-reference-prog-mode'.
+
+ This package adds a new minor mode 'debbugs-browse-mode' on top of
+them. Instead of using the default built-in Emacs browser for a given
+bug reference, it opens a corresponding bug report buffer. The
+customer option 'debbugs-browse-function' controls, whether
+'debbugs-gnu-bugs' or 'debbugs-org-bugs' is called.
+
+ This minor mode is applicable for all URLs, not only bug
+references. Any URL with the format <http://debbugs.gnu.org/12345>
+will be shown in a bug report buffer, when 'debbugs-browse-mode' is
+enabled.
+
+
+File: debbugs-ug.info, Node: Command Index, Next: Variable Index, Prev:
Minor Mode, Up: Top
+
+Command Index
+*************
+
+ [index ]
+* Menu:
+
+* debbugs-browse-mode: Minor Mode. (line 12)
+* debbugs-gnu: Retrieving Bugs. (line 15)
+* debbugs-gnu-bugs: Retrieving Bugs. (line 69)
+* debbugs-gnu-search: Searching Bugs. (line 10)
+* debbugs-org: Retrieving Bugs. (line 17)
+* debbugs-org-bugs: Retrieving Bugs. (line 70)
+* debbugs-org-search: Searching Bugs. (line 11)
+
+
+File: debbugs-ug.info, Node: Variable Index, Next: Key Index, Prev: Command
Index, Up: Top
+
+Variable Index
+**************
+
+ [index ]
+* Menu:
+
+* debbugs-browse-function: Minor Mode. (line 12)
+* debbugs-gnu-all-packages: Retrieving Bugs. (line 36)
+* debbugs-gnu-all-severities: Retrieving Bugs. (line 27)
+* debbugs-gnu-default-packages: Retrieving Bugs. (line 63)
+* debbugs-gnu-default-severities: Retrieving Bugs. (line 63)
+* debbugs-gnu-default-suppress-bugs: Retrieving Bugs. (line 44)
+* debbugs-gnu-mail-backend: Tabulated Lists. (line 71)
+
+
+File: debbugs-ug.info, Node: Key Index, Prev: Variable Index, Up: Top
+
+Key Index
+*********
+
+ [index ]
+* Menu:
+
+* '/': Tabulated Lists. (line 36)
+* 'B': Tabulated Lists. (line 52)
+* 'b': Tabulated Lists. (line 53)
+* 'C': Tabulated Lists. (line 66)
+* 'C-c # C': TODO Items. (line 25)
+* 'C-c # d': TODO Items. (line 19)
+* 'C-c # t': TODO Items. (line 22)
+* 'd': Tabulated Lists. (line 33)
+* 'g': Tabulated Lists. (line 47)
+* '<mouse-1>': Tabulated Lists. (line 30)
+* '<mouse-2>': Tabulated Lists. (line 31)
+* 'R': Tabulated Lists. (line 40)
+* '<RET>': Tabulated Lists. (line 29)
+* 's': Tabulated Lists. (line 57)
+* 't': Tabulated Lists. (line 60)
+* '<TAB>': TODO Items. (line 16)
+* 'w': Tabulated Lists. (line 44)
+* 'x': Tabulated Lists. (line 63)
+
+
+
+Tag Table:
+Node: Top1097
+Node: Retrieving Bugs2635
+Node: Searching Bugs6095
+Ref: Searching Bugs-Footnote-19980
+Ref: Searching Bugs-Footnote-210068
+Node: Layout10159
+Node: Tabulated Lists10634
+Node: TODO Items13881
+Node: Control Messages14928
+Node: Minor Mode17324
+Node: Command Index18263
+Node: Variable Index18910
+Node: Key Index19558
+
+End Tag Table
diff --git a/packages/debbugs/debbugs-ug.texi b/packages/debbugs/debbugs-ug.texi
new file mode 100644
index 0000000..553e19b
--- /dev/null
+++ b/packages/debbugs/debbugs-ug.texi
@@ -0,0 +1,597 @@
+\input texinfo
address@hidden debbugs-ug.info
address@hidden Debbugs User Guide
+
address@hidden Emacs
address@hidden
+* Debbugs UG: (debbugs-ug). Debbugs User Interface in Emacs.
address@hidden direntry
+
address@hidden
+Copyright @copyright{} 2015-2016 Free Software Foundation, Inc.
+
address@hidden
+Permission is granted to copy, distribute and/or modify this document
+under the terms of the GNU Free Documentation License, Version 1.2 or
+any later version published by the Free Software Foundation; with no
+Invariant Sections, with the Front-Cover, or Back-Cover Texts. A copy of
+the license is included in the section entitled ``GNU Free Documentation
+License'' in the Emacs manual.
+
+This document is part of a collection distributed under the GNU Free
+Documentation License. If you want to distribute this document
+separately from the collection, you can do so by adding a copy of the
+license to the document, as described in section 6 of the license.
+
+All Emacs Lisp code contained in this document may be used, distributed,
+and modified without restriction.
address@hidden quotation
address@hidden copying
+
address@hidden
address@hidden Debbugs User Guide
address@hidden by Michael Albinus
address@hidden
address@hidden
address@hidden titlepage
+
address@hidden
+
+
address@hidden Top
address@hidden Debbugs User Guide
+
+Debbugs is a bugtracking system (BTS) that was initially written for
+the Debian project but currently used also by the GNU project. The
+main distinctive feature of Debbugs is that it's mostly email-based.
+All actions on bug reports: opening, closing, changing the status,
+commenting, forwarding are performed via email by sending specially
+composed letters to the particular email addresses. However,
+searching the bug reports, querying bug report status and viewing
+comments have been web-based for a long time. To overcome this
+inconvenience the Debbugs/SOAP service was introduced.
+
+Based on the Debbugs/SOAP service, frontends are written which offer
+handling of bugs inside Emacs. These frontends are restricted to the
+GNU Debbugs server. Bugs are presented either as tabulated list
+(@code{debbugs-gnu}) or as @code{org-mode} TODO list
+(@code{debbugs-org}, @pxref{Top, , Org Mode, org}). As backend they
+use the @code{debbugs} Emacs library (@pxref{Top, , Debbugs
+Programmer's Manual, debbugs}).
+
address@hidden
+* Retrieving Bugs:: How to retrieve bugs.
+* Searching Bugs:: How to search in the debbugs database.
+* Layout:: How the results are presented.
+* Minor Mode:: How to use browse bug URLs.
+
+* Command Index:: Debbugs commands.
+* Variable Index:: User options and variables.
+* Key Index:: Keyboard strokes on bug report buffers.
address@hidden menu
+
+
address@hidden Retrieving Bugs
address@hidden Retrieving Bugs
+
+Bugs are retrieved by the @code{debbugs-gnu} or @code{debbugs-org}
+commands. In their simple version, they retrieve just bugs for the
address@hidden"emacs"} package on the GNU Debbugs server, filtered by bug
+severities. Further filtering is possible when the commands are
+called with a prefix.
+
+When the bug numbers to be retrieved are known, the commands
address@hidden or @code{debbugs-org-bugs} are applicable.
+
+
address@hidden {Command} debbugs-gnu severities &optional packages archivedp
suppress tags
address@hidden {Command} debbugs-org severities &optional packages archivedp
suppress tags
+
+These commands retrieve bug reports from the GNU Debbugs server.
address@hidden returns a tabulated list, and @code{debbugs-org}
+returns a list of TODO items in @code{org-mode}. In order not to
+stress the GNU Debbugs server, the bugs are retrieved in chunks of 500
+bugs. However, the bug report buffer shows all retrieved bugs then,
+in reverse bug number order.
+
address@hidden debbugs-gnu-all-severities
address@hidden is a list of strings which filter for the severities
+of the bugs to be retrieved. Valid severities are @code{"serious"},
address@hidden"important"}, @code{"normal"}, @code{"minor"} and
address@hidden"wishlist"} (see also the constant
address@hidden). If the list is empty, there is no
+filtering with respect to severities. The keyword @code{"tagged"},
+which is also possible, is not a severity in the GNU Debbugs server
+but allows to restrict the result to bugs with a given user tag.
+
address@hidden debbugs-gnu-all-packages
address@hidden, also a list of strings, point to the defined software
+packages on the GNU Debbugs server which shall be taken into account.
+The existing package names are compiled into the constant
address@hidden
+
address@hidden, if address@hidden, extends the result also on
+archived bugs on the GNU Debbugs server.
+
address@hidden debbugs-gnu-default-suppress-bugs
address@hidden shall also distinct between @code{nil} and
address@hidden When address@hidden, closed bugs are suppressed from
+being retrieved from the Debbugs server. Which bugs are regarded as
+suppressed is configured in the customer option
address@hidden Per default, bugs marked as
address@hidden"done"} are suppressed from being retrieved.
+
+When @var{severities} contains the severity @code{"tagged"},
address@hidden is consulted in order to restrict the result on bugs which
+are tagged with one of the strings of the list @var{tags}. This list
+can also be empty; in this case locally tagged bugs are included into
+the results.
+
+Called interactively, the commands require just the @var{severities}
+and the @var{tags} (if @var{severities} includes @code{"tagged"}). In
+order to provide the other arguments interactively, the commands must
+be called with a prefix, like @kbd{C-u M-x debbugs-gnu}. In the
+minibuffer, lists must be entered comma-separated.
+
address@hidden debbugs-gnu-default-severities
address@hidden debbugs-gnu-default-packages
+Default values for interactive use could be configured in the customer
+options @code{debbugs-gnu-default-severities} and
address@hidden
+
address@hidden for the presentation of the results.
+
address@hidden deffn
+
+
address@hidden {Command} debbugs-gnu-bugs &rest bugs
address@hidden {Command} debbugs-org-bugs &rest bugs
+
+The commands @code{debbugs-gnu-bugs} and @code{debbugs-org-bugs} show
+bugs specified by their bug number. Interactively, the bug numbers
+must be entered as comma-separated list.
+
address@hidden for the presentation of the results.
+
address@hidden deffn
+
+
address@hidden Searching Bugs
address@hidden Searching in the Debbugs Database.
+
+The GNU Debbugs server allows full text search in the database. It
+uses a
address@hidden://fallabs.com/hyperestraier/uguide-en.html#searchcond,
+HyperEstraier based search address@hidden has been added to the
+Debbugs/SOAP backend of the GNU Debbugs server only.}.
+
address@hidden {Command} debbugs-gnu-search
address@hidden {Command} debbugs-org-search
+
+These both commands are completely interactive. They ask for a
address@hidden"search phrase"} for the full text search. It is just a string
+which contains the words to be searched for, combined by operators
+like AND, ANDNOT and OR. If there is no operator between the words,
+AND is used by default.
+
+Wild card searches are also supported. It can be used for forward
+match search and backward match search. For example, "[BW] euro"
+matches words which begin with "euro". "[EW] shere" matches words
+which end with "sphere". Moreover, regular expressions are also
+supported. For example, "[RX] ^inter.*al$" matches words which begin
+with "inter" and end with "al"address@hidden forms, as
+described in the Hyperestraier User Guide, are not supported.}
+
+While the words to be searched for are case insensitive, the operators
+must be specified case sensitive.
+
+While the search for the phrase is performed only in the bodies of the
+messages belonging to a bug report, it is also possible to
+discriminate the search to further bug attributes. The commands ask
+for such key-value pairs, until an empty key is returned. Possible
+attributes are
+
address@hidden @samp
address@hidden severity
+A comma-separated list of bug severities, @xref{Retrieving Bugs}.
+
address@hidden package
+A comma-separated list of defined software packages on the GNU Debbugs
+server, @xref{Retrieving Bugs}.
+
address@hidden tags
+A comma-separated list of defined user tags.
+
address@hidden submitter
+The email address of the bug submitter.
+
address@hidden date
+A time period the bug has been in which the bug has been submitted or
+modified.
+
address@hidden subject
+Word(s) the subject of the bug report contains.
+
address@hidden status
+The status of the bug report. Valid values are "done", "forwarded"
+and "open".
address@hidden table
+
+It is also possible to apply these commands with an empty search
+phrase. In this case, the GNU Debbugs server is searched only for
+bugs which fulfill the given attributes. The attributes to be applied
+are the same as already described, plus
+
address@hidden @samp
address@hidden archive
+Whether archived bugs shall be searched (no value to be entered).
+
address@hidden src
+Bugs which belong to a given source, if that attribute has set.
+
address@hidden tag
+An arbitrary string the bug is annotated with. Usually, this is the
+same as the status mentioned above.
+
address@hidden owner
address@hidden maint
address@hidden correspondent
+The email address of the bug's owner, maintainer, or correspondent
+(somebody who has participated in bug messages).
+
address@hidden log_modified
address@hidden last_modified
address@hidden found_date
address@hidden fixed_date
+The date of the last update, or the date of the bug report / bug fix.
+
address@hidden unarchived
+The date the bug has been unarchived, if ever.
+
address@hidden done
+The email address of the worker who has closed the bug (if done).
+
address@hidden forwarded
+A URL or an email address.
+
address@hidden msgid
+The message id of the initial bug report.
+
address@hidden summary
+The summary of the bug report.
address@hidden table
+
+Not all of these attributes could be queried on the GNU Debbugs server
+via the Debbugs/SOAP backend. In this case, the results of a query
+are discriminated on the client side, which is indicated by the string
+"(client-side filter)" in the minibuffer after the attribute name.
address@hidden deffn
+
+
address@hidden Layout
address@hidden Layout
+
+The commands described in the previous chapters generate (a) report
+buffer(s) applicable for navigation. @code{debbugs-gnu-*} return a
+tabulated list, and @code{debbugs-org-*} return a list of TODO items
+in @code{org-mode}.
+
address@hidden
+* Tabulated Lists:: Tabulated Lists.
+* TODO Items:: TODO Items.
+* Control Messages:: Control Messages.
address@hidden menu
+
+
address@hidden Tabulated Lists
address@hidden Tabulated Lists
+
+A tabulated list of bug reports consist of four columns for every bug
+entry: @code{Id} (the bug number), @code{State} (some bug attributes),
address@hidden (the name of the bug submitter), and @code{Title}
+(the bug subject). Per default the bugs are sorted descending by
address@hidden; this could be changed by clicking in the headline.
+
+Different foreground colours present further information on the bug
+report. If the bug number uses a red colour
+(@code{debbugs-gnu-tagged}), the bug has been tagged locally. The
+same face is used to mark bugs in the submitter or title column, when
+the bug has been reported / is maintained by the user.
+
+The bug state could appear in different colours: red
+(@code{debbugs-gnu-new}, nobody has answered yet to this bug),
+ForestGreen (@code{debbugs-gnu-handled}, the bug has been modified
+recently), MidnightBlue (@code{debbugs-gnu-pending}, the bug is
+pending), orange (@code{debbugs-gnu-stale}, the bug has not been
+touched for a while), and DarkGrey (@code{debbugs-gnu-done}, the bug
+is closed). Archived bugs are shown with inverse face
+(@code{debbugs-gnu-archived}).
+
+The bug report buffers have enabled the minor
address@hidden This enables the following key strokes:
+
address@hidden @columnfractions .20 .80
+
address@hidden
address@hidden @address@hidden
address@hidden@key{RET}} @*
address@hidden @address@hidden
address@hidden@key{mouse-1}} @*
address@hidden @address@hidden
address@hidden@key{mouse-2}} @tab
address@hidden @*
+Show the email messages that discuss the bug.
+
address@hidden @item
address@hidden @kbd{d}
address@hidden @tab
address@hidden @*
+Show all bug attributes.
+
address@hidden
address@hidden @kbd{/}
address@hidden/} @tab
address@hidden @*
+Narrow the list of bugs to the bugs that match the given regex in
address@hidden, @code{Submitter} or @code{Title}.
+
address@hidden
address@hidden @kbd{R}
address@hidden @tab
address@hidden @*
+Narrow the list of bug reports to the ones that are blocking the
+current release.
+
address@hidden
address@hidden @kbd{w}
address@hidden @tab
address@hidden @*
+Restore the full list again after narrowing.
+
address@hidden
address@hidden @kbd{g}
address@hidden @tab
address@hidden @*
+Reload all bugs. With a prefix argument @kbd{C-u}, the bug status
+cache is disabled, and all bug reports are retrieved from the GNU
+Debbugs server.
+
address@hidden
address@hidden @kbd{B}
address@hidden @*
address@hidden @kbd{b}
address@hidden @tab
address@hidden @*
address@hidden @*
+Show all bug reports which are blocking / blocked by this bug.
+
address@hidden
address@hidden @kbd{s}
address@hidden @tab
address@hidden @*
+Toggle sorting order of bugs.
+
address@hidden
address@hidden @kbd{t}
address@hidden @tab
address@hidden @*
+Toggle local tag of bugs.
+
address@hidden
address@hidden @kbd{x}
address@hidden @tab
address@hidden @*
+Toggle showing of closed bugs.
+
address@hidden
address@hidden @kbd{C}
address@hidden @tab
address@hidden @*
+Send a control message for this bug, @ref{Control Messages}.
+
address@hidden multitable
+
address@hidden debbugs-gnu-mail-backend
+The user option @code{debbugs-gnu-mail-backend} controls the
+presentation of email messages produced by typing @address@hidden or
+by clicking the mouse on a bug: if its value is @code{gnus}, the
+default, a GNUS ephemeral group for that bug will be shown; if its
+value is @code{rmail}, the command will present an Rmail folder
+instead.
+
+
address@hidden TODO Items
address@hidden TODO Items
+
+TODO items are offered as usual in @code{org-mode}. The bug
+attributes are mapped onto properties of these items. They can be
+shown by the usual navigation in @code{org-mode}.
+
+Bug severities are mapped onto org severities, see
address@hidden
+
+The bug report buffers have enabled the minor
address@hidden This enables the following key strokes:
+
address@hidden address@hidden # C}} {Some very very very long long text Some
very very very long long text Some very very very long long text}
+
address@hidden
address@hidden @address@hidden
address@hidden@key{TAB}} @tab
address@hidden @*
+Outline the bug report attributes in @code{org-mode}.
+
address@hidden
address@hidden @kbd{C-c # d}
address@hidden # d} @tab
address@hidden @*
+Show all bug attributes.
+
address@hidden
address@hidden @kbd{C-c # t}
address@hidden # t} @tab
address@hidden @*
+Toggle local tag of bugs.
+
address@hidden
address@hidden @kbd{C-c # C}
address@hidden # C} @tab
address@hidden @*
+Send a control message for this bug, @ref{Control Messages}.
+
address@hidden multitable
+
+When the bug attributes are shown by @code{org-cycle}, there is a link
address@hidden which opens a GNUS ephemeral group for that address@hidden
(@pxref{xxx}).
+
+
address@hidden Control Messages
address@hidden Control Messages
+
+Debbugs control messages are sent by email to the GNU Debbugs control
+server. Their format is described in
address@hidden://debbugs.gnu.org/server-control.html}.
+
+A control message can be initiated in the tabulated list of bugs, in
+the list of org TODO items, or in the GNUS ephemeral group or Rmail
+folder opened for the messages belonging to a given bug. Control
+messages can be sent to unarchived bugs only, in case a bug is
+archived the control message @samp{unarchive} must be sent first.
+
+In the minibuffer, the following control messages can be requested
+(assuming that 12345 is the bug the control message is intended for).
+The strings show the exact format of the control messages.
+
address@hidden @samp
address@hidden block
address@hidden unblock
+"block|unblock 12345 by 54321"
+
+The second bug number is read interactively. It could be also a list
+of comma-separated bug numbers.
+
address@hidden close
+"close 12345 25.1"
+
+The second argument, the Emacs version, is read interactively.
+
address@hidden confirmed
address@hidden fixed
address@hidden help
address@hidden moreinfo
address@hidden notabug
address@hidden patch
address@hidden pending
address@hidden security
address@hidden unreproducible
address@hidden wontfix
+"tags 12345 confirmed|fixed|help|moreinfo|notabug"
+
+"tags 12345 patch|pending|security|unreproducible|wontfix"
+
address@hidden done
address@hidden donenotabug
address@hidden doneunreproducible
address@hidden donewontfix
+"tags 12345 fixed|notabug|unreproducible|wontfix" @*
+"close 12345 25.1"
+
+The second argument in the close message, the Emacs version, is read
+interactively.
+
address@hidden forcemerge
address@hidden merge
+"forcemerge|merge 12345 54321"
+
+The second bug number is read interactively.
+
address@hidden invalid
+"tags 12345 notabug" @*
+"tags 12345 wontfix" @*
+"close 12345"
+
address@hidden noowner
+"noowner 12345"
+
address@hidden owner
+"owner 12345 !"
+
address@hidden reassign
+"reassign 12345 @var{package}"
+
+The package name on the GNU Debbugs server is read interactively.
+
address@hidden reopen
+"reopen 12345"
+
address@hidden retitle
+"retitle 12345 @var{title}"
+
+The new bug title is read interactively.
+
address@hidden serious
address@hidden important
address@hidden normal
address@hidden minor
address@hidden wishlist
+"severity 12345 serious|important|normal|minor|wishlist"
+
address@hidden unarchive
+"unarchive 12345"
+
address@hidden unmerge
+"unmerge 12345"
+
address@hidden usertag
+"user @var{username}" @*
+"usertag 12345 @var{tag}"
+
+The username, read interactively, is either a package name or an email
+address. The tag to be set is also read interactively.
address@hidden table
+
+
address@hidden Minor Mode
address@hidden Minor Mode
+
+Emacs uses @file{bug-reference.el} for adding hyperlinks to bugs in
+files like @file{ChangeLog}, or in commentary sections of other files.
+The reference to such bugs have a specialized format,
address@hidden The hyperlinks are implemented as minor modes
address@hidden and @code{bug-reference-prog-mode}.
+
address@hidden debbugs-browse-mode
address@hidden debbugs-browse-function
+This package adds a new minor mode @code{debbugs-browse-mode} on top
+of them. Instead of using the default built-in Emacs browser for a
+given bug reference, it opens a corresponding bug report buffer. The
+customer option @code{debbugs-browse-function} controls, whether
address@hidden or @code{debbugs-org-bugs} is called.
+
+This minor mode is applicable for all URLs, not only bug references.
+Any URL with the format @uref{http://debbugs.gnu.org/12345} will be
+shown in a bug report buffer, when @code{debbugs-browse-mode} is
+enabled.
+
+
address@hidden Command Index
address@hidden Command Index
address@hidden fn
+
+
address@hidden Variable Index
address@hidden Variable Index
address@hidden vr
+
+
address@hidden Key Index
address@hidden Key Index
address@hidden ky
+
address@hidden
+
address@hidden Local Variables:
address@hidden bug-reference-url-format: "http://debbugs.gnu.org/%s";
address@hidden eval: (bug-reference-mode)
address@hidden eval: (debbugs-browse-mode)
address@hidden End:
diff --git a/packages/debbugs/debbugs.el b/packages/debbugs/debbugs.el
index 35caf83..f145280 100644
--- a/packages/debbugs/debbugs.el
+++ b/packages/debbugs/debbugs.el
@@ -1,11 +1,12 @@
;;; debbugs.el --- SOAP library to access debbugs servers
-;; Copyright (C) 2011-2015 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2016 Free Software Foundation, Inc.
;; Author: Michael Albinus <address@hidden>
;; Keywords: comm, hypermedia
;; Package: debbugs
-;; Version: 0.6
+;; Version: 0.9
+;; Package-Requires: ((async "1.6"))
;; This file is not part of GNU Emacs.
@@ -36,6 +37,10 @@
(require 'soap-client)
(eval-when-compile (require 'cl))
+(declare-function soap-invoke-async "soap-client")
+(declare-function async-start "async")
+(declare-function async-get "async")
+
(defgroup debbugs nil
"Debbugs library"
:group 'hypermedia)
@@ -95,6 +100,52 @@ This corresponds to the Debbugs server to be accessed,
either
default-directory)))
"The WSDL object to be used describing the SOAP interface.")
+;; Please do not increase this value, otherwise we would run into
+;; performance problems on the server. Maybe we need to change this a
+;; server specific value.
+(defconst debbugs-max-hits-per-request 500
+ "The max number of bugs or results per soap invocation.")
+
+(defvar debbugs-cache-data
+ (make-hash-table :test 'equal :size debbugs-max-hits-per-request)
+ "Hash table of retrieved bugs.")
+
+(defcustom debbugs-cache-expiry (* 60 60)
+ "How many seconds debbugs query results are cached.
+`t' or 0 disables caching, `nil' disables expiring."
+ :group 'debbugs
+ :type '(choice (const :tag "Always" t)
+ (const :tag "Never" nil)
+ (integer :tag "Seconds")))
+
+(defvar debbugs-soap-invoke-async-object nil
+ "The object manipulated by `debbugs-soap-invoke-async'.")
+
+(defun debbugs-soap-invoke-async (operation-name &rest parameters)
+ "Invoke the SOAP connection asynchronously.
+If possible, it uses `soap-invoke-async' from soapclient 3.0.
+Otherwise, `async-start' from the async package is used."
+ (if (fboundp 'soap-invoke-async)
+ ;; This is soap-client 3.0.
+ (apply
+ 'soap-invoke-async
+ (lambda (response &rest args)
+ (setq debbugs-soap-invoke-async-object
+ (append debbugs-soap-invoke-async-object (car response))))
+ nil
+ debbugs-wsdl debbugs-port operation-name parameters)
+ ;; Fallback with async.
+ (async-start
+ `(lambda ()
+ (load ,(locate-library "soap-client"))
+ (apply
+ 'soap-invoke
+ (soap-load-wsdl
+ ,(expand-file-name
+ "Debbugs.wsdl"
+ (file-name-directory (locate-library "debbugs"))))
+ ,debbugs-port ,operation-name ',parameters)))))
+
(defun debbugs-get-bugs (&rest query)
"Return a list of bug numbers which match QUERY.
@@ -223,7 +274,8 @@ Every returned entry is an association list with the
following attributes:
`package': A list of package names the bug belongs to.
`severity': The severity of the bug report. This can be
- \"important\", \"grave\", \"normal\", \"minor\" or \"wishlist\".
+ \"critical\", \"grave\", \"serious\", \"important\",
+ \"normal\", \"minor\" or \"wishlist\".
`tags': The status of the bug report, a list of strings. This
can be \"fixed\", \"notabug\", \"wontfix\", \"unreproducible\",
@@ -290,41 +342,103 @@ Example:
\(last_modified . 1271200046.0)
\(pending . \"pending\")
\(package \"emacs\")))"
- (when bug-numbers
- (let ((object
- (car
- (soap-invoke
- debbugs-wsdl debbugs-port "get_status"
- (apply 'vector bug-numbers)))))
- (mapcar
- (lambda (x)
- (let (y)
- ;; "archived" is the number 1 or 0.
- (setq y (assoc 'archived (cdr (assoc 'value x))))
- (setcdr y (= (cdr y) 1))
- ;; "found_versions" and "fixed_versions" are lists,
- ;; containing strings or numbers.
- (dolist (attribute '(found_versions fixed_versions))
- (setq y (assoc attribute (cdr (assoc 'value x))))
- (setcdr y (mapcar
- (lambda (z) (if (numberp z) (number-to-string z) z))
- (cdr y))))
- ;; "mergedwith", "blocks" and "blockedby are strings,
- ;; containing blank separated bug numbers.
- (dolist (attribute '(mergedwith blocks blockedby))
- (setq y (assoc attribute (cdr (assoc 'value x))))
- (when (stringp (cdr y))
- (setcdr y (mapcar
- 'string-to-number (split-string (cdr y) " " t)))))
- ;; "package" is a string, containing comma separated
- ;; package names. "keywords" and "tags" are strings,
- ;; containing blank separated package names.
- (dolist (attribute '(package keywords tags))
- (setq y (assoc attribute (cdr (assoc 'value x))))
- (when (stringp (cdr y))
- (setcdr y (split-string (cdr y) ",\\| " t))))
- (cdr (assoc 'value x))))
- object))))
+ (let (cached-bugs)
+ ;; Check for cached bugs.
+ (setq bug-numbers (delete-dups bug-numbers)
+ bug-numbers
+ (delete
+ nil
+ (mapcar
+ (lambda (bug)
+ (let ((status (gethash bug debbugs-cache-data)))
+ (if (and
+ status
+ (or
+ (null debbugs-cache-expiry)
+ (and
+ (natnump debbugs-cache-expiry)
+ (> (cdr (assoc 'cache_time status))
+ (- (float-time)) debbugs-cache-expiry))))
+ (progn
+ (setq cached-bugs (append cached-bugs (list status)))
+ nil)
+ bug)))
+ bug-numbers)))
+
+ ;; Retrieve the data.
+ (setq debbugs-soap-invoke-async-object nil)
+ (when bug-numbers
+ ;; Retrieve bugs asynchronously.
+ (let ((bug-ids bug-numbers)
+ results)
+ (while bug-ids
+ (setq results
+ (append
+ results
+ (list
+ (debbugs-soap-invoke-async
+ "get_status"
+ (apply
+ 'vector
+ (butlast
+ bug-ids (- (length bug-ids)
+ debbugs-max-hits-per-request))))))
+
+ bug-ids
+ (last bug-ids (- (length bug-ids)
+ debbugs-max-hits-per-request))))
+
+ (dolist (res results)
+ (if (bufferp res)
+ ;; This is soap-client 3.0.
+ (while (buffer-live-p res)
+ (accept-process-output (get-buffer-process res) 0.1))
+ ;; Fallback with async.
+ (dolist (status (async-get res))
+ (setq debbugs-soap-invoke-async-object
+ (append debbugs-soap-invoke-async-object status)))))))
+
+ (append
+ cached-bugs
+ ;; Massage results.
+ (mapcar
+ (lambda (x)
+ (let (y)
+ ;; "archived" is the number 1 or 0.
+ (setq y (assoc 'archived (cdr (assoc 'value x))))
+ (setcdr y (= (cdr y) 1))
+ ;; "found_versions" and "fixed_versions" are lists,
+ ;; containing strings or numbers.
+ (dolist (attribute '(found_versions fixed_versions))
+ (setq y (assoc attribute (cdr (assoc 'value x))))
+ (setcdr y (mapcar
+ (lambda (z) (if (numberp z) (number-to-string z) z))
+ (cdr y))))
+ ;; "mergedwith", "blocks" and "blockedby are strings,
+ ;; containing blank separated bug numbers.
+ (dolist (attribute '(mergedwith blocks blockedby))
+ (setq y (assoc attribute (cdr (assoc 'value x))))
+ (when (stringp (cdr y))
+ (setcdr y (mapcar
+ 'string-to-number (split-string (cdr y) " " t)))))
+ ;; "package" is a string, containing comma separated
+ ;; package names. "keywords" and "tags" are strings,
+ ;; containing blank separated package names.
+ (dolist (attribute '(package keywords tags))
+ (setq y (assoc attribute (cdr (assoc 'value x))))
+ (when (stringp (cdr y))
+ (setcdr y (split-string (cdr y) ",\\| " t))))
+ ;; Cache the result, and return.
+ (if (and debbugs-cache-expiry (natnump debbugs-cache-expiry))
+ (puthash
+ (cdr (assoc 'key x))
+ ;; Put also a time stamp.
+ (cons (cons 'cache_time (floor (float-time)))
+ (cdr (assoc 'value x)))
+ debbugs-cache-data)
+ ;; Don't cache.
+ (cdr (assoc 'value x)))))
+ debbugs-soap-invoke-async-object))))
(defun debbugs-get-usertag (&rest query)
"Return a list of bug numbers which match QUERY.
@@ -441,7 +555,8 @@ The following conditions are possible:
:skip and :max are optional. They specify, how many hits are
skipped, and how many maximal hits are returned. This can be
- used for paged results. Per default, :skip is 0 and :max is 10.
+ used for paged results. Per default, :skip is 0 and all
+ possible hits are returned.
There must be exactly one such condition.
@@ -543,134 +658,155 @@ Examples:
,\(floor \(float-time \(encode-time 0 0 0 31 8 2011)))
:operator \"NUMBT\"))"
- (let (args result)
- ;; Compile search arguments.
- (dolist (elt query)
- (let (vec kw key val
- phrase-cond attr-cond)
-
- ;; Phrase is mandatory, even if empty.
- (when (and (or (member :skip elt) (member :max elt))
- (not (member :phrase elt)))
- (setq vec (vector "phrase" "")))
-
- ;; Parse condition.
- (while (consp elt)
- (setq kw (pop elt))
- (unless (keywordp kw)
- (error "Wrong keyword: %s" kw))
- (setq key (substring (symbol-name kw) 1))
- (case kw
- ;; Phrase condition.
- (:phrase
- ;; It shouldn't happen in an attribute condition.
- (if attr-cond
- (error "Wrong keyword: %s" kw))
- (setq phrase-cond t val (pop elt))
- ;; Value is a string.
- (if (stringp val)
- (setq vec (vconcat vec (list key val)))
- (error "Wrong %s: %s" key val)))
-
- ((:skip :max)
- ;; It shouldn't happen in an attribute condition.
- (if attr-cond
- (error "Wrong keyword: %s" kw))
- (setq phrase-cond t val (pop elt))
- ;; Value is a number.
- (if (numberp val)
- (setq vec (vconcat vec (list key (number-to-string val))))
- (error "Wrong %s: %s" key val)))
-
- ;; Attribute condition.
- ((:submitter :@author)
- ;; It shouldn't happen in a phrase condition.
- (if phrase-cond
- (error "Wrong keyword: %s" kw))
- (if (not (stringp (car elt)))
- (setq vec (vconcat vec (list key "")))
- ;; Value is an email address.
- (while (and (stringp (car elt))
- (string-match "\\`\\S-+\\'" (car elt)))
- (when (string-equal "me" (car elt))
- (setcar elt user-mail-address))
- (when (string-match "<\\(.+\\)>" (car elt))
- (setcar elt (match-string 1 (car elt))))
- (let ((x (pop elt)))
- (unless (member x val)
- (setq val (append val (list x))))))
- (setq vec
- (vconcat vec (list key (mapconcat 'identity val " "))))))
-
- (:status
- ;; It shouldn't happen in a phrase condition.
- (if phrase-cond
- (error "Wrong keyword: %s" kw))
- (setq attr-cond t)
- (if (not (stringp (car elt)))
- (setq vec (vconcat vec (list key "")))
- ;; Possible values: "done", "forwarded" and "open"
- (while (and (stringp (car elt))
- (string-match
- "\\`\\(done\\|forwarded\\|open\\)\\'" (car elt)))
- (let ((x (pop elt)))
- (unless (member x val)
- (setq val (append val (list x))))))
- (setq vec
- (vconcat vec (list key (mapconcat 'identity val " "))))))
-
- ((:subject :package :tags :severity :@title)
- ;; It shouldn't happen in a phrase condition.
- (if phrase-cond
- (error "Wrong keyword: %s" kw))
- (setq attr-cond t)
- (if (not (stringp (car elt)))
- (setq vec (vconcat vec (list key "")))
- ;; Just a string.
- (while (stringp (car elt))
- (let ((x (pop elt)))
- (unless (member x val)
- (setq val (append val (list x))))))
- (setq vec
- (vconcat vec (list key (mapconcat 'identity val " "))))))
-
- ((:date :@cdate)
- ;; It shouldn't happen in a phrase condition.
- (if phrase-cond
- (error "Wrong keyword: %s" kw))
- (setq attr-cond t)
- (if (not (numberp (car elt)))
- (setq vec (vconcat vec (list key "")))
- ;; Just a number.
- (while (numberp (car elt))
- (let ((x (pop elt)))
- (unless (member x val)
- (setq val (append val (list x))))))
- (setq vec
- (vconcat
- vec (list key (mapconcat 'number-to-string val " "))))))
-
- ((:operator :order)
- ;; It shouldn't happen in a phrase condition.
- (if phrase-cond
- (error "Wrong keyword: %s" kw))
- (setq attr-cond t val (pop elt))
- ;; Value is a number.
- (if (stringp val)
- (setq vec (vconcat vec (list key val)))
- (error "Wrong %s: %s" key val)))
-
- (t (error "Unknown key: %s" kw))))
-
- (setq args (vconcat args (list vec)))))
-
- (setq result
- (car (soap-invoke debbugs-wsdl debbugs-port "search_est" args)))
- ;; The result contains lists (key value). We transform it into
- ;; cons cells (key . value).
- (dolist (elt1 result result)
- (dolist (elt2 elt1)
- (setcdr elt2 (cadr elt2))))))
+ (let ((phrase (assoc :phrase query))
+ args result)
+ (if (and phrase (not (member :skip phrase)) (not (member :skip phrase)))
+ ;; We loop, until we have all results.
+ (let ((skip 0)
+ (query (delete phrase query))
+ result1)
+ (while skip
+ (setq result1
+ (apply
+ 'debbugs-search-est
+ (append
+ (list
+ (append
+ phrase `(:skip ,skip)
+ `(:max ,debbugs-max-hits-per-request)))
+ query))
+ skip (and (= (length result1) debbugs-max-hits-per-request)
+ (+ skip debbugs-max-hits-per-request))
+ result (append result result1)))
+ result)
+
+ ;; Compile search arguments.
+ (dolist (elt query)
+ (let (vec kw key val
+ phrase-cond attr-cond)
+
+ ;; Phrase is mandatory, even if empty.
+ (when (and (or (member :skip elt) (member :max elt))
+ (not (member :phrase elt)))
+ (setq vec (vector "phrase" "")))
+
+ ;; Parse condition.
+ (while (consp elt)
+ (setq kw (pop elt))
+ (unless (keywordp kw)
+ (error "Wrong keyword: %s" kw))
+ (setq key (substring (symbol-name kw) 1))
+ (cl-case kw
+ ;; Phrase condition.
+ (:phrase
+ ;; It shouldn't happen in an attribute condition.
+ (if attr-cond
+ (error "Wrong keyword: %s" kw))
+ (setq phrase-cond t val (pop elt))
+ ;; Value is a string.
+ (if (stringp val)
+ (setq vec (vconcat vec (list key val)))
+ (error "Wrong %s: %s" key val)))
+
+ ((:skip :max)
+ ;; It shouldn't happen in an attribute condition.
+ (if attr-cond
+ (error "Wrong keyword: %s" kw))
+ (setq phrase-cond t val (pop elt))
+ ;; Value is a number.
+ (if (numberp val)
+ (setq vec (vconcat vec (list key (number-to-string val))))
+ (error "Wrong %s: %s" key val)))
+
+ ;; Attribute condition.
+ ((:submitter :@author)
+ ;; It shouldn't happen in a phrase condition.
+ (if phrase-cond
+ (error "Wrong keyword: %s" kw))
+ (if (not (stringp (car elt)))
+ (setq vec (vconcat vec (list key "")))
+ ;; Value is an email address.
+ (while (and (stringp (car elt))
+ (string-match "\\`\\S-+\\'" (car elt)))
+ (when (string-equal "me" (car elt))
+ (setcar elt user-mail-address))
+ (when (string-match "<\\(.+\\)>" (car elt))
+ (setcar elt (match-string 1 (car elt))))
+ (let ((x (pop elt)))
+ (unless (member x val)
+ (setq val (append val (list x))))))
+ (setq vec
+ (vconcat vec (list key (mapconcat 'identity val " "))))))
+
+ (:status
+ ;; It shouldn't happen in a phrase condition.
+ (if phrase-cond
+ (error "Wrong keyword: %s" kw))
+ (setq attr-cond t)
+ (if (not (stringp (car elt)))
+ (setq vec (vconcat vec (list key "")))
+ ;; Possible values: "done", "forwarded" and "open"
+ (while (and (stringp (car elt))
+ (string-match
+ "\\`\\(done\\|forwarded\\|open\\)\\'" (car elt)))
+ (let ((x (pop elt)))
+ (unless (member x val)
+ (setq val (append val (list x))))))
+ (setq vec
+ (vconcat vec (list key (mapconcat 'identity val " "))))))
+
+ ((:subject :package :tags :severity :@title)
+ ;; It shouldn't happen in a phrase condition.
+ (if phrase-cond
+ (error "Wrong keyword: %s" kw))
+ (setq attr-cond t)
+ (if (not (stringp (car elt)))
+ (setq vec (vconcat vec (list key "")))
+ ;; Just a string.
+ (while (stringp (car elt))
+ (let ((x (pop elt)))
+ (unless (member x val)
+ (setq val (append val (list x))))))
+ (setq vec
+ (vconcat vec (list key (mapconcat 'identity val " "))))))
+
+ ((:date :@cdate)
+ ;; It shouldn't happen in a phrase condition.
+ (if phrase-cond
+ (error "Wrong keyword: %s" kw))
+ (setq attr-cond t)
+ (if (not (numberp (car elt)))
+ (setq vec (vconcat vec (list key "")))
+ ;; Just a number.
+ (while (numberp (car elt))
+ (let ((x (pop elt)))
+ (unless (member x val)
+ (setq val (append val (list x))))))
+ (setq vec
+ (vconcat
+ vec (list key (mapconcat 'number-to-string val " "))))))
+
+ ((:operator :order)
+ ;; It shouldn't happen in a phrase condition.
+ (if phrase-cond
+ (error "Wrong keyword: %s" kw))
+ (setq attr-cond t val (pop elt))
+ ;; Value is a number.
+ (if (stringp val)
+ (setq vec (vconcat vec (list key val)))
+ (error "Wrong %s: %s" key val)))
+
+ (t (error "Unknown key: %s" kw))))
+
+ (setq args (vconcat args (list vec)))))
+
+ (setq result
+ (car (soap-invoke debbugs-wsdl debbugs-port "search_est" args)))
+ ;; The result contains lists (key value). We transform it into
+ ;; cons cells (key . value).
+ (dolist (elt1 result result)
+ (dolist (elt2 elt1)
+ (setcdr elt2 (cadr elt2)))))))
(defun debbugs-get-attribute (bug-or-message attribute)
"Return the value of key ATTRIBUTE.
diff --git a/packages/debbugs/debbugs.info b/packages/debbugs/debbugs.info
new file mode 100644
index 0000000..b05bf77
--- /dev/null
+++ b/packages/debbugs/debbugs.info
@@ -0,0 +1,557 @@
+This is debbugs.info, produced by makeinfo version 6.0 from
+debbugs.texi.
+
+Copyright (C) 2011-2016 Free Software Foundation, Inc.
+
+ Permission is granted to copy, distribute and/or modify this
+ document under the terms of the GNU Free Documentation License,
+ Version 1.2 or any later version published by the Free Software
+ Foundation; with no Invariant Sections, with the Front-Cover, or
+ Back-Cover Texts. A copy of the license is included in the
+ section entitled "GNU Free Documentation License" in the Emacs
+ manual.
+
+ This document is part of a collection distributed under the GNU
+ Free Documentation License. If you want to distribute this
+ document separately from the collection, you can do so by adding
+ a copy of the license to the document, as described in section 6
+ of the license.
+
+ All Emacs Lisp code contained in this document may be used,
+ distributed, and modified without restriction.
+INFO-DIR-SECTION Emacs
+START-INFO-DIR-ENTRY
+* Debbugs: (debbugs). A library for communication with Debbugs.
+END-INFO-DIR-ENTRY
+
+
+File: debbugs.info, Node: Top, Next: Installation, Up: (dir)
+
+Debbugs Programmer's Manual
+***************************
+
+Debbugs is a bugtracking system (BTS) that was initially written for
+the Debian project but currently used also by the GNU project. The
+main distinctive feature of Debbugs is that it's mostly email-based.
+All actions on bug reports: opening, closing, changing the status,
+commenting, forwarding are performed via email by sending specially
+composed letters to the particular mail addresses. However, searching
+the bug reports, querying bug report status and viewing comments have
+been web-based for a long time. To overcome this inconvenience the
+Debbugs/SOAP service was introduced.
+
+ The Debbugs/SOAP service provides the means for developers to write
+client applications that can send the queries with certain search
+criteria to the Debbugs server and retrieve a set of bug reports that
+match them. The developer may also ask the Debbugs server for
+additional information about every bug report (e.g. subject, date,
+originator, tags and etc.) and get all comments and attachments.
+
+ 'debbugs', described in this document, is the Emacs library that
+exposes to developers the available functions provided by the Debbugs
+server. 'debbugs' uses Emacs' SOAP client library for communication
+with the Debbugs server. In tandem with Emacs' email facilities,
+'debbugs' provides a solution for building applications that interact
+with the Debbugs BTS directly from Emacs without addressing Debbugs'
+web interface.
+
+ The user interface for accessing the Debbugs server for GNU
+projects is described in *note Debbugs User Guide: (debbugs-ug)Top.
+
+* Menu:
+
+* Installation:: Getting and installing 'debbugs'.
+* Configuration:: Configuring 'debbugs'.
+* Requesting bug numbers:: How to request bug report numbers.
+* Requesting bugs statuses:: How to request the status of bug reports.
+* Requesting messages:: How to get messages from bug reports.
+* Requesting user tags:: How to request tags set by users.
+
+
+File: debbugs.info, Node: Installation, Next: Configuration, Prev: Top,
Up: Top
+
+1 Installation
+**************
+
+Installation on Emacs 24 or later
+---------------------------------
+
+Install 'debbugs' from the *note ELPA repository: (elisp)Packaging.
+
+Installation on Emacs 22 and Emacs 23
+-------------------------------------
+
+If you want to install 'debbugs' on Emacs 22/23, you will need to
+install the 'soap-client' library first. It can be downloaded from
+the Emacs SOAP client project page
+(http://code.google.com/p/emacs-soap-client/).
+
+ Compile the library and add it into your 'load-path':
+
+ (add-to-list 'load-path "/path/to/emacs-soap-client/")
+
+ 'debbugs' library can be downloaded from the ELPA repository
+(http://elpa.gnu.org/packages/). Compile it and set the 'load-path':
+
+ (add-to-list 'load-path "/path/to/debbugs/")
+
+Installation on Emacs 21
+------------------------
+
+We have not tried yet to install 'debbugs' on Emacs 21. We would
+definitely say that the installation will require even more additional
+libraries than needed for installation on Emacs 22/23.
+
+
+File: debbugs.info, Node: Configuration, Next: Requesting bug numbers,
Prev: Installation, Up: Top
+
+2 Configuration
+***************
+
+'debbugs' is already configured to work with two main ports of Debbugs
+BTS: <http://bugs.debian.org> and <http://debbugs.gnu.org>. So if you
+intend to use one of these ports, you don't need to configure
+'debbugs'. If you want to interact with a Debbugs port other than
+those listed, you have to configure 'debbugs' by adding a new server
+specifier to the 'debbugs-servers' variable. The actual port can be
+selected by the 'debbugs-port' variable.
+
+ -- Variable: debbugs-servers
+ List of Debbugs server specifiers. Each entry is a list that
+ contains a string identifying the port name and the server
+ parameters in keyword-value form. The list initially contains
+ two predefined and configured Debbugs servers: '"gnu.org"' and
+ '"debian.org"'.
+
+ Valid keywords are:
+
+ ':wsdl'
+ Location of WSDL. The value is a string with the URL that
+ should return the WSDL specification of the Debbugs/SOAP
+ service. This keyword is intended for future use, it is
+ ignored currently.
+
+ ':bugreport-url'
+ The URL of the server script ('bugreport.cgi' in the default
+ Debbugs installation) that provides the access to mboxes
+ with messages from bug reports.
+
+ Example. Add a new Debbugs port with name "foobars.net":
+
+ (add-to-list
+ 'debbugs-servers
+ '("foobars.net"
+ :wsdl "http://bugs.foobars.net/cgi/soap.cgi?WSDL";
+ :bugreport-url "http://bugs.foobars.net/cgi/bugreport.cgi";))
+
+ -- Variable: debbugs-port
+ This variable holds the name of the currently used port. The
+ value of the variable corresponds to the Debbugs server to be
+ accessed, either '"gnu.org"' or '"debian.org"', or a user defined
+ port name.
+
+ -- Variable: debbugs-cache-expiry
+ The function 'debbugs-get-status' (*note Requesting bugs
+ statuses::) caches retrieved status entries in order to improve
+ the performance. This variable determines the number of seconds
+ an entry is cached, before it is retrieved again. A value of
+ 'nil' disables cache expiration, and a value of 't' disables
+ caching. Both values are not recommended for a usual workflow.
+
+
+File: debbugs.info, Node: Requesting bug numbers, Next: Requesting bugs
statuses, Prev: Configuration, Up: Top
+
+3 Requesting bug numbers
+************************
+
+In Debbugs BTS, the bug number is the unique identifier of a bug
+report. The functions described in this section return from the
+Debbugs server the list of bug numbers that match a user's query.
+
+ -- Function: debbugs-get-bugs &rest query
+ This function returns a list of bug numbers that match the QUERY.
+ QUERY is a sequence of keyword-value pairs where the values are
+ strings, i.e. :KEYWORD "VALUE" [:KEYWORD "VALUE"]*
+
+ The keyword-value pair is a subquery. The keywords are allowed
+ to have multiple occurrence within the query at any place. The
+ subqueries with the same keyword form the logical subquery, which
+ returns the union of bugs of every subquery it contains.
+
+ The result of the QUERY is an intersection of results of all
+ subqueries.
+
+ Valid keywords are:
+
+ ':package'
+ The value is the name of the package a bug belongs to, like
+ '"emacs"', '"coreutils"', '"gnus"', or '"tramp"'.
+
+ ':src'
+ This is used to retrieve bugs that belong to source with
+ given name.
+
+ ':severity'
+ This is the severity of the bug. The exact set of available
+ severities depends on the policy of a particular Debbugs
+ port:
+
+ Debian port: '"critical"', '"grave"', '"serious"',
+ '"important"', '"normal"', '"minor"', '"wishlist"', and
+ '"fixed"'.
+
+ GNU port: '"serious"', '"important"', '"normal"', '"minor"',
+ '"wishlist"'.
+
+ ':tag'
+ An arbitrary string the bug is annotated with. Usually,
+ this is used to mark the status of the bug. The list of
+ possible tags depends on the Debbugs port.
+
+ Debian port: '"patch"', '"wontfix"', '"moreinfo"',
+ '"unreproducible"', '"fixed"', '"potato"', '"woody"',
+ '"sid"', '"help"', '"security"', '"upstream"', '"pending"',
+ '"sarge"', '"sarge-ignore"', '"experimental"', '"d-i"',
+ '"confirmed"', '"ipv6"', '"lfs"', '"fixed-in-experimental"',
+ '"fixed-upstream"', '"l10n"', '"etch"', '"etch-ignore"',
+ '"lenny"', '"lenny-ignore"', '"squeeze"',
+ '"squeeze-ignore"', '"wheezy"', '"wheezy-ignore"'. The
+ actual list of tags can be found on
+ <http://www.debian.org/Bugs/Developer#tags>.
+
+ GNU port: '"fixed"', '"notabug"', '"wontfix"',
+ '"unreproducible"', '"moreinfo"', '"patch"', '"pending"',
+ '"help"', '"security"', '"confirmed"'. See
+ <http://debbugs.gnu.org/Developer.html#tags> for the actual
+ list of tags.
+
+ ':owner'
+ This is used to identify bugs by the owner's email address.
+ The special email address '"me"' is used as pattern,
+ replaced with the variable 'user-mail-address' (*note
+ (elisp)User Identification::).
+
+ ':submitter'
+ With this keyword it is possible to filter bugs by the
+ submitter's email address. The special email address '"me"'
+ is used as pattern, replaced with the variable
+ 'user-mail-address'.
+
+ ':maint'
+ This is used to find bugs of the packages which are
+ maintained by the person with the given email address. The
+ special email address '"me"' is used as pattern, replaced
+ with 'user-mail-address'.
+
+ ':correspondent'
+ This allows to find bug reports where the person with the
+ given email address has participated. The special email
+ address '"me"' is used as pattern, replaced with
+ 'user-mail-address'.
+
+ ':affects'
+ With this keyword it is possible to find bugs which affect
+ the package with the given name. The bugs are chosen by the
+ value of field 'affects' in bug's status. The returned bugs
+ do not necessary belong to this package.
+
+ ':status'
+ Status of bug. Valid values are '"done"', '"forwarded"' and
+ '"open"'.
+
+ ':archive'
+ A keyword to filter for bugs which are already archived, or
+ not. Valid values are '"0"' (not archived), '"1"'
+ (archived) or '"both"'. If this keyword is not given in the
+ query, ':archive "0"' is assumed by default.
+
+ Example. Get all opened and forwarded release critical bugs for
+ the packages which are maintained by '"me"' and which have a
+ patch:
+
+ (let ((debbugs-port "debian.org"))
+ (debbugs-get-bugs :maint "me" :tag "patch"
+ :severity "critical"
+ :status "open"
+ :severity "grave"
+ :status "forwarded"
+ :severity "serious"))
+
+ -- Function: debbugs-newest-bugs amount
+ This function returns a list of bug numbers, according to AMOUNT
+ (a number) of latest bugs.
+
+ Example. Get the latest six bug report numbers from Debian BTS:
+
+ (let ((debbugs-port "debian.org"))
+ (debbugs-newest-bugs 6))
+ => (633152 633153 633154 633155 633156 633157)
+
+
+File: debbugs.info, Node: Requesting bugs statuses, Next: Requesting
messages, Prev: Requesting bug numbers, Up: Top
+
+4 Requesting bugs statuses
+**************************
+
+Bug status is a collection of fields that holds the information about
+the state and importance of the bug report, about originator, owner
+and various aspects of relationship with other bug reports.
+
+ -- Function: debbugs-get-status &rest bug-numbers
+ Return a list of status entries for the bug reports identified by
+ BUG-NUMBERS. Every returned entry is an association list with
+ the following attributes:
+
+ 'id'
+ 'bug_num'
+ The bug number.
+
+ 'package'
+ A list of package names the bug belongs to.
+
+ 'severity'
+ The severity of the bug report. Possible values are the
+ same as for ':severity' in 'debbugs-get-bugs' (*note
+ Requesting bug numbers::).
+
+ 'tags'
+ The status of the bug report, a list of strings. Possible
+ values are the same as for ':tags' in 'debbugs-get-bugs'
+ (*note Requesting bug numbers::).
+
+ 'pending'
+ The string '"pending"', '"forwarded"' or '"done"'.
+
+ 'subject'
+ Subject/Title of the bugreport.
+
+ 'originator'
+ The E-mail address of the bug report submitter.
+
+ 'mergedwith'
+ A list of bug numbers this bug was merged with.
+
+ 'source'
+ Source package name of the bug report.
+
+ 'date'
+ Date of bug creation. Encoded as UNIX time.
+
+ 'log_modified'
+ 'last_modified'
+ Date of last update. Encoded as UNIX time.
+
+ 'found_date'
+ 'fixed_date'
+ Date of bug report / bug fix (empty for now). Encoded as
+ UNIX time.
+
+ 'done'
+ The E-mail address of the worker who has closed the bug (if
+ done).
+
+ 'archived'
+ 't' if the bug is archived, 'nil' otherwise.
+
+ 'unarchived'
+ The date the bug has been unarchived, if ever. Encoded as
+ UNIX time.
+
+ 'found_versions'
+ 'fixed_versions'
+ List of version strings.
+
+ 'forwarded'
+ A URL or an E-mail address.
+
+ 'blocks'
+ A list of bug numbers this bug blocks.
+
+ 'blockedby'
+ A list of bug numbers this bug is blocked by.
+
+ 'msgid'
+ The message id of the initial bug report.
+
+ 'owner'
+ Who is responsible for fixing.
+
+ 'location'
+ Always the string '"db-h"' or '"archive"'.
+
+ 'affects'
+ A list of package names.
+
+ 'summary'
+ Arbitrary text.
+
+ Example. Get the status of bug number #10 from GNU BTS:
+
+ (let ((debbugs-port "gnu.org"))
+ (debbugs-get-status 10))
+ =>
+ (((source . "unknown") (found_versions) (done) (blocks)
+ (date . 1203606305.0) (fixed) (fixed_versions) (mergedwith)
+ (found) (unarchived) (blockedby) (keywords) (summary)
+ (msgid . "<address@hidden>") (id . 10)
+ (forwarded) (severity . "wishlist")
+ (owner . "Magnus Henoch <address@hidden>")
+ (log_modified . 1310061242.0) (location . "db-h")
+ (subject . "url-gw should support HTTP CONNECT proxies")
+ (originator . "Magnus Henoch <address@hidden>")
+ (last_modified . 1310061242.0) (pending . "pending") (affects)
+ (archived) (tags) (fixed_date) (package "emacs") (found_date)
+ (bug_num . 10)))
+
+ -- Function: debbugs-get-attribute bug-or-message attribute
+ General accessor that returns the value of key ATTRIBUTE.
+ BUG-OR-MESSAGE must be a list element returned by either
+ 'debbugs-get-status' or 'debbugs-get-bug-log' (*note Requesting
+ messages::).
+
+ Example. Return the originator of the last submitted bug report:
+
+ (let ((debbags-port "gnu.org"))
+ (debbugs-get-attribute
+ (car (apply 'debbugs-get-status (debbugs-newest-bugs 1)))
+ 'originator))
+ => "Jack Daniels <address@hidden>"
+
+
+File: debbugs.info, Node: Requesting messages, Next: Requesting user tags,
Prev: Requesting bugs statuses, Up: Top
+
+5 Requesting messages
+*********************
+
+ -- Function: debbugs-get-bug-log bug-number
+ Returns a list of messages related to BUG-NUMBER. Every message
+ is an association list with the following attributes:
+
+ 'msg_num'
+ The number of the message inside the bug log. The numbers
+ are ascending, newer messages have a higher number.
+ 'header'
+ The header lines from the E-mail messages, as arrived at the
+ bug tracker.
+ 'body'
+ The message body.
+ 'attachments'
+ A list of possible attachments, or 'nil'. Not implemented
+ yet server side.
+
+ -- Function: debbugs-get-message-numbers messages
+ Returns the message numbers of MESSAGES. MESSAGES must be the
+ result of a 'debbugs-get-bug-log' call.
+
+ Example. Get message numbers from bug report #456789 log from
+ Debian BTS:
+
+ (let ((debbugs-port "debian.org"))
+ (debbugs-get-message-numbers (debbugs-get-bug-log 456789)))
+ => (5 10 12)
+
+ -- Function: debbugs-get-message messages message-number
+ Returns the message MESSAGE-NUMBER of MESSAGES. MESSAGES must be
+ the result of a 'debbugs-get-bug-log' call. The returned message
+ is a list of strings. The first element are the header lines of
+ the message, the second element is the body of the message.
+ Further elements of the list, if any, are attachments of the
+ message. If there is no message with MESSAGE-NUMBER, the
+ function returns 'nil'.
+
+ Example: Return the first message of the last submitted bug
+ report to GNU BTS:
+
+ (let* ((debbugs-port "gnu.org")
+ (messages (apply 'debbugs-get-bug-log
+ (debbugs-newest-bugs 1))))
+ (debbugs-get-message
+ messages
+ (car (debbugs-get-message-numbers messages))))
+
+ -- Function: debbugs-get-mbox bug-number mbox-type &optional filename
+ Download mbox with all messages from bug report BUG-NUMBER.
+ MBOX-TYPE specifies a type of mbox and can be one of the
+ following symbols:
+
+ 'mboxfolder'
+ Download mbox folder, i.e. mbox with messages as they
+ arrived at the Debbugs server.
+
+ 'mboxmaint'
+ Download maintainer's mbox, i.e. mbox with messages as they
+ are resent from the Debbugs server.
+
+ 'mboxstat'
+ 'mboxstatus'
+ Download status mbox. The use of either symbol depends on
+ the actual Debbugs server configuration. For '"gnu.org"',
+ use the former; for '"debian.org' - the latter.
+
+ FILENAME, if non-'nil', is the name of the file to store mbox.
+ If FILENAME is 'nil', the downloaded mbox is inserted into the
+ current buffer.
+
+ Note, that mbox downloading will work only if the
+ ':bugreport-url' field of the 'debbugs-servers' variable is
+ specified (*note Configuration::).
+
+
+File: debbugs.info, Node: Requesting user tags, Prev: Requesting messages,
Up: Top
+
+6 Requesting user tags
+**********************
+
+A user tag is a string, a user has assigned to one or several bugs.
+The user is identified by an email address. The port '"gnu.org"' uses
+also package names as user identification.
+
+ -- Function: debbugs-get-usertag &rest query
+ Return a list of bug numbers which match QUERY.
+
+ QUERY is a sequence of keyword-value pairs where the values are
+ strings, i.e. :KEYWORD "VALUE" [:KEYWORD "VALUE"]*
+
+ Valid keywords are:
+
+ ':user'
+ The value is the name of the package a bug belongs to, like
+ '"emacs"', '"coreutils"', or '"tramp"'. It can also be an
+ email address of a user who has applied a user tag. The
+ special email address '"me"' is used as pattern, replaced
+ with 'user-mail-address'. There must be at least one such
+ entry; it is recommended to have exactly one.
+
+ ':tag'
+ A string applied as user tag. Often, it is a subproduct
+ identification, like '"cedet"' or '"tramp"' for the package
+ '"emacs"'.
+
+ If there is no ':tag' entry, no bug numbers will be returned but
+ a list of existing user tags for ':user'.
+
+ Example. Get all user tags for the package '"emacs"':
+
+ (let ((debbugs-port "gnu.org"))
+ (debbugs-get-usertag :user "emacs"))
+ => ("www" "solaris" "ls-lisp" "cygwin")
+
+ Get all bugs tagged by package '"emacs"' with '"www"' or
+ '"cygwin"')):
+
+ (let ((debbugs-port "gnu.org"))
+ (debbugs-get-usertag :user "emacs" :tag "www" :tag "cygwin"))
+ => (807 1223 5637)
+
+
+
+Tag Table:
+Node: Top1094
+Node: Installation3179
+Node: Configuration4278
+Node: Requesting bug numbers6629
+Node: Requesting bugs statuses11883
+Node: Requesting messages15934
+Node: Requesting user tags18949
+
+End Tag Table
diff --git a/packages/debbugs/debbugs.texi b/packages/debbugs/debbugs.texi
index c26717a..0a627d6 100644
--- a/packages/debbugs/debbugs.texi
+++ b/packages/debbugs/debbugs.texi
@@ -8,7 +8,7 @@
@end direntry
@copying
-Copyright @copyright{} 2011-2015 Free Software Foundation, Inc.
+Copyright @copyright{} 2011-2016 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
@@ -41,7 +41,7 @@ and modified without restriction.
@top Debbugs Programmer's Manual
Debbugs is a bugtracking system (BTS) that was initially written for
-the Debian project but actually used also by the GNU project. The
+the Debian project but currently used also by the GNU project. The
main distinctive feature of Debbugs is that it's mostly email-based.
All actions on bug reports: opening, closing, changing the status,
commenting, forwarding are performed via email by sending specially
@@ -65,6 +65,9 @@ facilities, @code{debbugs} provides a solution for building
applications that interact with the Debbugs BTS directly from Emacs
without addressing Debbugs' web interface.
+The user interface for accessing the Debbugs server for GNU projects
+is described in @ref{Top, Debbugs User Guide, , debbugs-ug}.
+
@menu
* Installation:: Getting and installing @code{debbugs}.
* Configuration:: Configuring @code{debbugs}.
@@ -157,6 +160,15 @@ the variable corresponds to the Debbugs server to be
accessed, either
@code{"gnu.org"} or @code{"debian.org"}, or a user defined port name.
@end defvar
address@hidden debbugs-cache-expiry
+The function @code{debbugs-get-status} (@pxref{Requesting bugs
+statuses}) caches retrieved status entries in order to improve the
+performance. This variable determines the number of seconds an entry
+is cached, before it is retrieved again. A value of @code{nil}
+disables cache expiration, and a value of @code{t} disables caching.
+Both values are not recommended for a usual workflow.
address@hidden defvar
+
@node Requesting bug numbers
@chapter Requesting bug numbers
diff --git a/packages/debbugs/dir b/packages/debbugs/dir
new file mode 100644
index 0000000..d841627
--- /dev/null
+++ b/packages/debbugs/dir
@@ -0,0 +1,23 @@
+-*- Text -*-
+This is the file .../info/dir, which contains the topmost node of the
+Info hierarchy. The first time you invoke Info you start off
+looking at that node, which is (dir)Top.
+
+File: dir Node: Top This is the top of the INFO tree
+
+The Info Directory
+******************
+
+ The Info Directory is the top-level menu of major Info topics.
+ Type "d" in Info to return to the Info Directory. Type "q" to exit Info.
+ Type "?" for a list of Info commands, or "h" to visit an Info tutorial.
+ Type "m" to choose a menu item--for instance,
+ "mEmacs<Return>" visits the Emacs manual.
+ In Emacs Info, you can click mouse button 2 on a menu item
+ or cross reference to follow it to its target.
+
+* Menu: Each line that starts with a * is a topic you can select with "m".
+
+Emacs
+* Debbugs: (debbugs). A library for communication with Debbugs.
+* Debbugs UG: (debbugs-ug). Debbugs User Interface in Emacs.
diff --git a/packages/diff-hl/README.md b/packages/diff-hl/README.md
index 325f53e..b8bbe3a 100644
--- a/packages/diff-hl/README.md
+++ b/packages/diff-hl/README.md
@@ -15,6 +15,8 @@ The package also contains auxiliary modes:
* `diff-hl-margin-mode` changes the highlighting function to
use the margin instead of the fringe.
* `diff-hl-amend-mode` shifts the reference revision back by one.
+* `diff-hl-flydiff-mode` implements highlighting changes on the fly.
+ It requires Emacs 24.4 or newer.
Check out the Commentary section in each respective file for the usage
instructions.
@@ -46,10 +48,9 @@ Emacs 24+. On OS X, Emacs 24.3 or higher is recommended.
Notes
=====
-* Since it uses the corresponding VC diff command, it's only accurate when the
- buffer is in saved state. Highlighting changes "on the fly" might be better,
- maybe we can do something similar to `highlight-markup-buffers` with a hidden
- buffer containing the unmodified copy.
+* By default `diff-hl-mode` uses the corresponding VC diff command, so
+ it's only accurate when the buffer is in saved state. Check out
+ `diff-hl-flydiff-mode`, it aims to handle unsaved buffers as well.
* We conflict with other modes when they put indicators on the fringe,
such as [Flycheck](https://github.com/flycheck/flycheck). This is
@@ -63,6 +64,9 @@ Notes
* Frame-local and buffer-local values of `line-spacing` are not supported.
+* Fringe width up to 16 works best (because we can't define a bitmap
+ with width above that number).
+
* [emacs-git-gutter](https://github.com/syohex/emacs-git-gutter) shows
indicators in the margin by default, allows you to customize how the
indicators look more easily, and has a "stage hunk" command.
@@ -86,5 +90,11 @@ psvn
Magit
-----
-If you have a recent enough version installed, it defines
-`magit-revert-buffer-hook`, which we use.
+If you're using a version before 2.4.0, it defines `magit-revert-buffer-hook`
+(or `magit-not-reverted-hook`), which we use.
+
+When using Magit 2.4 or newer, add this to your init script:
+
+```lisp
+(add-hook 'magit-post-refresh-hook 'diff-hl-magit-post-refresh)
+```
diff --git a/packages/diff-hl/diff-hl-dired.el
b/packages/diff-hl/diff-hl-dired.el
index 09cf851..895341b 100644
--- a/packages/diff-hl/diff-hl-dired.el
+++ b/packages/diff-hl/diff-hl-dired.el
@@ -1,6 +1,6 @@
;;; diff-hl-dired.el --- Highlight changed files in Dired -*- lexical-binding:
t -*-
-;; Copyright (C) 2012-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2015 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -33,6 +33,7 @@
(require 'diff-hl)
(require 'dired)
+(require 'vc-hooks)
(defvar diff-hl-dired-process-buffer nil)
@@ -62,9 +63,17 @@
(defcustom diff-hl-dired-extra-indicators t
"Non-nil to indicate ignored files."
- :group 'diff-hl
:type 'boolean)
+(defcustom diff-hl-dired-ignored-backends '(RCS)
+ "VC backends to ignore.
+The directories registered to one of these backends won't have
+status indicators."
+ :type `(repeat (choice ,@(mapcar
+ (lambda (name)
+ `(const :tag ,(symbol-name name) ,name))
+ vc-handled-backends))))
+
;;;###autoload
(define-minor-mode diff-hl-dired-mode
"Toggle VC diff highlighting on the side of a Dired window."
@@ -83,7 +92,7 @@
(def-dir default-directory)
(buffer (current-buffer))
dirs-alist files-alist)
- (when backend
+ (when (and backend (not (memq backend diff-hl-dired-ignored-backends)))
(diff-hl-dired-clear)
(if (buffer-live-p diff-hl-dired-process-buffer)
(let ((proc (get-buffer-process diff-hl-dired-process-buffer)))
@@ -126,10 +135,12 @@
(append dirs-alist files-alist))))))
)))))
-(defun diff-hl-dired-status-files (backend dir files uf)
+(defun diff-hl-dired-status-files (backend dir files update-function)
+ "Using version control BACKEND, return list of (FILE STATE EXTRA) entries
+for DIR containing FILES. Call UPDATE-FUNCTION as entries are added."
(if (version< "25" emacs-version)
- (vc-call-backend backend 'dir-status-files dir files uf)
- (vc-call-backend backend 'dir-status-files dir files nil uf)))
+ (vc-call-backend backend 'dir-status-files dir files update-function)
+ (vc-call-backend backend 'dir-status-files dir files nil update-function)))
(when (version< emacs-version "24.4.51.5")
;; Work around http://debbugs.gnu.org/19386
@@ -161,6 +172,7 @@
(defalias 'diff-hl-dired-clear 'diff-hl-remove-overlays)
+;;;###autoload
(defun diff-hl-dired-mode-unless-remote ()
(unless (file-remote-p default-directory)
(diff-hl-dired-mode)))
diff --git a/packages/diff-hl/diff-hl-flydiff.el
b/packages/diff-hl/diff-hl-flydiff.el
new file mode 100644
index 0000000..94dbbd7
--- /dev/null
+++ b/packages/diff-hl/diff-hl-flydiff.el
@@ -0,0 +1,172 @@
+;; Copyright (C) 2015, 2016 Free Software Foundation, Inc.
+
+;; Author: Jonathan Hayase <address@hidden>
+;; URL: https://github.com/dgutov/diff-hl
+
+;; 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 mode enables diffing on-the-fly (i.e. without saving the buffer first)
+;; Toggle in all buffers with M-x diff-hl-flydiff-mode
+
+;;; Code:
+
+(require 'diff-hl)
+(require 'diff)
+(unless (require 'nadvice nil t)
+ (error "`diff-hl-flydiff-mode' requires Emacs 24.4 or newer"))
+
+(defgroup diff-hl-flydiff nil
+ "Highlight changes on the fly"
+ :group 'diff-hl)
+
+(defcustom diff-hl-flydiff-delay 0.3
+ "The idle delay in seconds before highlighting is updated."
+ :type 'number)
+
+(defvar diff-hl-flydiff-modified-tick 0)
+(defvar diff-hl-flydiff-timer)
+(make-variable-buffer-local 'diff-hl-flydiff-modified-tick)
+
+(defun diff-hl-flydiff/vc-git--symbolic-ref (file)
+ (or
+ (vc-file-getprop file 'vc-git-symbolic-ref)
+ (let* (process-file-side-effects
+ (str (vc-git--run-command-string nil "symbolic-ref" "HEAD")))
+ (vc-file-setprop file 'vc-git-symbolic-ref
+ (if str
+ (if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str)
+ (match-string 2 str)
+ str))))))
+
+(defun diff-hl-flydiff/vc-git-working-revision (_file)
+ "Git-specific version of `vc-working-revision'."
+ (let (process-file-side-effects)
+ (vc-git--rev-parse "HEAD")))
+
+(defun diff-hl-flydiff/vc-git-mode-line-string (file)
+ "Return a string for `vc-mode-line' to put in the mode line for FILE."
+ (let* ((rev (vc-working-revision file))
+ (disp-rev (or (diff-hl-flydiff/vc-git--symbolic-ref file)
+ (substring rev 0 7)))
+ (def-ml (vc-default-mode-line-string 'Git file))
+ (help-echo (get-text-property 0 'help-echo def-ml))
+ (face (get-text-property 0 'face def-ml)))
+ (propertize (replace-regexp-in-string (concat rev "\\'") disp-rev def-ml t
t)
+ 'face face
+ 'help-echo (concat help-echo "\nCurrent revision: " rev))))
+
+;; Polyfill concrete revisions for vc-git-working-revision in Emacs 24.4, 24.5
+(when (version<= emacs-version "25.0")
+ (with-eval-after-load 'vc-git
+ (advice-add 'vc-git-working-revision :override
+ #'diff-hl-flydiff/vc-git-working-revision)
+ (advice-add 'vc-git-mode-line-string :override
+ #'diff-hl-flydiff/vc-git-mode-line-string)))
+
+(defun diff-hl-flydiff/working-revision (file)
+ "Like vc-working-revision, but always up-to-date"
+ (vc-file-setprop file 'vc-working-revision
+ (vc-call-backend (vc-backend file) 'working-revision file)))
+
+(defun diff-hl-flydiff-make-temp-file-name (file rev &optional manual)
+ "Return a backup file name for REV or the current version of FILE.
+If MANUAL is non-nil it means that a name for backups created by
+the user should be returned."
+ (let* ((auto-save-file-name-transforms
+ `((".*" ,temporary-file-directory t))))
+ (expand-file-name
+ (concat (make-auto-save-file-name)
+ ".~" (subst-char-in-string
+ ?/ ?_ rev)
+ (unless manual ".") "~")
+ temporary-file-directory)))
+
+(defun diff-hl-flydiff-create-revision (file revision)
+ "Read REVISION of FILE into a buffer and return the buffer."
+ (let ((automatic-backup (diff-hl-flydiff-make-temp-file-name file revision))
+ (filebuf (get-file-buffer file))
+ (filename (diff-hl-flydiff-make-temp-file-name file revision 'manual)))
+ (unless (file-exists-p filename)
+ (if (file-exists-p automatic-backup)
+ (rename-file automatic-backup filename nil)
+ (with-current-buffer filebuf
+ (let ((coding-system-for-read 'no-conversion)
+ (coding-system-for-write 'no-conversion))
+ (condition-case nil
+ (with-temp-file filename
+ (let ((outbuf (current-buffer)))
+ ;; Change buffer to get local value of
+ ;; vc-checkout-switches.
+ (with-current-buffer filebuf
+ (vc-call find-revision file revision outbuf))))
+ (error
+ (when (file-exists-p filename)
+ (delete-file filename))))))))
+ filename))
+
+(defun diff-hl-flydiff-buffer-with-head (file &optional backend)
+ "View the differences between BUFFER and its associated file.
+This requires the external program `diff' to be in your `exec-path'."
+ (interactive)
+ (vc-ensure-vc-buffer)
+ (setq diff-hl-flydiff-modified-tick (buffer-modified-tick))
+ (save-current-buffer
+ (let* ((temporary-file-directory
+ (if (file-directory-p "/dev/shm/")
+ "/dev/shm/"
+ temporary-file-directory))
+ (rev (diff-hl-flydiff-create-revision
+ file
+ (diff-hl-flydiff/working-revision file))))
+ (diff-no-select rev (current-buffer) "-U 0 --strip-trailing-cr" 'noasync
+ (get-buffer-create " *diff-hl-diff*")))))
+
+(defun diff-hl-flydiff-update ()
+ (unless (or
+ (not diff-hl-mode)
+ (= diff-hl-flydiff-modified-tick (buffer-modified-tick))
+ (file-remote-p default-directory))
+ (diff-hl-update)))
+
+(defun diff-hl-flydiff/modified-p (state)
+ (buffer-modified-p))
+
+;;;###autoload
+(define-minor-mode diff-hl-flydiff-mode
+ "Highlight diffs on-the-fly"
+ :lighter ""
+ :global t
+ (if diff-hl-flydiff-mode
+ (progn
+ (advice-add 'diff-hl-overlay-modified :override #'ignore)
+
+ (advice-add 'diff-hl-modified-p :before-until
+ #'diff-hl-flydiff/modified-p)
+ (advice-add 'diff-hl-changes-buffer :override
+ #'diff-hl-flydiff-buffer-with-head)
+ (setq diff-hl-flydiff-timer
+ (run-with-idle-timer diff-hl-flydiff-delay t
#'diff-hl-flydiff-update)))
+
+ (advice-remove 'diff-hl-overlay-modified #'ignore)
+
+ (advice-remove 'diff-hl-modified-p #'diff-hl-flydiff/modified-p)
+ (advice-remove 'diff-hl-changes-buffer #'diff-hl-flydiff-buffer-with-head)
+
+ (cancel-timer diff-hl-flydiff-timer)))
+
+(provide 'diff-hl-flydiff)
diff --git a/packages/diff-hl/diff-hl-margin.el
b/packages/diff-hl/diff-hl-margin.el
index 26fa7ad..32aa123 100644
--- a/packages/diff-hl/diff-hl-margin.el
+++ b/packages/diff-hl/diff-hl-margin.el
@@ -1,6 +1,6 @@
;;; diff-hl-margin.el --- Highlight buffer changes on margins -*-
lexical-binding: t -*-
-;; Copyright (C) 2012-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2015 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -44,16 +44,6 @@
"Highlight buffer changes on margin"
:group 'diff-hl)
-(defcustom diff-hl-margin-side 'left
- "Which margin to use for indicators."
- :type '(choice (const left)
- (const right))
- :set (lambda (var value)
- (let ((on diff-hl-margin-mode))
- (when on (diff-hl-margin-mode -1))
- (set-default var value)
- (when on (diff-hl-margin-mode 1)))))
-
;;;###autoload
(define-minor-mode diff-hl-margin-mode
"Toggle displaying `diff-hl-mode' highlights on the margin."
@@ -82,7 +72,7 @@
"Toggle displaying `diff-hl-mode' highlights on the margin locally.
You probably shouldn't use this function directly."
:lighter ""
- (let ((width-var (intern (format "%s-margin-width" diff-hl-margin-side))))
+ (let ((width-var (intern (format "%s-margin-width" diff-hl-side))))
(if diff-hl-margin-minor-mode
(progn
(set (make-local-variable 'diff-hl-margin-old-highlight-function)
@@ -96,6 +86,8 @@ You probably shouldn't use this function directly."
(dolist (win (get-buffer-window-list))
(set-window-buffer win (current-buffer))))
+(define-obsolete-variable-alias 'diff-hl-margin-side 'diff-hl-side "1.7.1")
+
(defun diff-hl-margin-minor-mode-off ()
(diff-hl-margin-minor-mode -1))
@@ -114,7 +106,7 @@ You probably shouldn't use this function directly."
(intern (format "diff-hl-%s"
type)))))))))
(defun diff-hl-highlight-on-margin (ovl type _shape)
- (let ((spec (cdr (assoc (cons type diff-hl-margin-side)
+ (let ((spec (cdr (assoc (cons type diff-hl-side)
diff-hl-margin-spec-cache))))
(overlay-put ovl 'before-string spec)))
diff --git a/packages/diff-hl/diff-hl.el b/packages/diff-hl/diff-hl.el
index 22a877a..2aaabd4 100644
--- a/packages/diff-hl/diff-hl.el
+++ b/packages/diff-hl/diff-hl.el
@@ -1,520 +1,585 @@
-;;; diff-hl.el --- Highlight uncommitted changes -*- lexical-binding: t -*-
-
-;; Copyright (C) 2012-2014 Free Software Foundation, Inc.
-
-;; Author: Dmitry Gutov <address@hidden>
-;; URL: https://github.com/dgutov/diff-hl
-;; Keywords: vc, diff
-;; Version: 1.7.0
-;; Package-Requires: ((cl-lib "0.2"))
-
-;; 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-hl-mode' highlights uncommitted changes on the left side of
-;; the window (using the fringe, by default), allows you to jump
-;; between the hunks and revert them selectively.
-
-;; Provided commands:
-;;
-;; `diff-hl-diff-goto-hunk' C-x v =
-;; `diff-hl-revert-hunk' C-x v n
-;; `diff-hl-previous-hunk' C-x v [
-;; `diff-hl-next-hunk' C-x v ]
-;;
-;; The mode takes advantage of `smartrep' if it is installed.
-
-;; Add either of the following to your init file.
-;;
-;; To use it in all buffers:
-;;
-;; (global-diff-hl-mode)
-;;
-;; Only in `prog-mode' buffers, with `vc-dir' integration:
-;;
-;; (add-hook 'prog-mode-hook 'turn-on-diff-hl-mode)
-;; (add-hook 'vc-dir-mode-hook 'turn-on-diff-hl-mode)
-
-;;; Code:
-
-(require 'fringe)
-(require 'diff-mode)
-(require 'vc)
-(require 'vc-dir)
-(eval-when-compile
- (require 'cl-lib)
- (require 'vc-git)
- (require 'vc-hg)
- (require 'face-remap))
-
-(defgroup diff-hl nil
- "VC diff highlighting on the side of a window"
- :group 'vc)
-
-(defface diff-hl-insert
- '((default :inherit diff-added)
- (((class color)) :foreground "green4"))
- "Face used to highlight inserted lines."
- :group 'diff-hl)
-
-(defface diff-hl-delete
- '((default :inherit diff-removed)
- (((class color)) :foreground "red3"))
- "Face used to highlight deleted lines."
- :group 'diff-hl)
-
-(defface diff-hl-change
- '((default :foreground "blue3")
- (((class color) (min-colors 88) (background light))
- :background "#ddddff")
- (((class color) (min-colors 88) (background dark))
- :background "#333355"))
- "Face used to highlight changed lines."
- :group 'diff-hl)
-
-(defcustom diff-hl-command-prefix (kbd "C-x v")
- "The prefix for all `diff-hl' commands."
- :group 'diff-hl
- :type 'string)
-
-(defcustom diff-hl-draw-borders t
- "Non-nil to draw borders around fringe indicators."
- :group 'diff-hl
- :type 'boolean)
-
-(defcustom diff-hl-highlight-function 'diff-hl-highlight-on-fringe
- "Function to highlight the current line. Its arguments are
- overlay, change type and position within a hunk."
- :group 'diff-hl
- :type 'function)
-
-(defcustom diff-hl-fringe-bmp-function 'diff-hl-fringe-bmp-from-pos
- "Function to choose the fringe bitmap for a given change type
- and position within a hunk. Should accept two arguments."
- :group 'diff-hl
- :type '(choice (const diff-hl-fringe-bmp-from-pos)
- (const diff-hl-fringe-bmp-from-type)
- function))
-
-(defcustom diff-hl-fringe-face-function 'diff-hl-fringe-face-from-type
- "Function to choose the fringe face for a given change type
- and position within a hunk. Should accept two arguments."
- :group 'diff-hl
- :type 'function)
-
-(defvar diff-hl-reference-revision nil
- "Revision to diff against. nil means the most recent one.")
-
-(defun diff-hl-define-bitmaps ()
- (let* ((scale (if (and (boundp 'text-scale-mode-amount)
- (numberp text-scale-mode-amount))
- (expt text-scale-mode-step text-scale-mode-amount)
- 1))
- (spacing (or (and (display-graphic-p) (default-value 'line-spacing))
0))
- (h (+ (ceiling (* (frame-char-height) scale))
- (if (floatp spacing)
- (truncate (* (frame-char-height) spacing))
- spacing)))
- (w (frame-parameter nil 'left-fringe))
- (middle (make-vector h (expt 2 (1- w))))
- (ones (1- (expt 2 w)))
- (top (copy-sequence middle))
- (bottom (copy-sequence middle))
- (single (copy-sequence middle)))
- (aset top 0 ones)
- (aset bottom (1- h) ones)
- (aset single 0 ones)
- (aset single (1- h) ones)
- (define-fringe-bitmap 'diff-hl-bmp-top top h w 'top)
- (define-fringe-bitmap 'diff-hl-bmp-middle middle h w 'center)
- (define-fringe-bitmap 'diff-hl-bmp-bottom bottom h w 'bottom)
- (define-fringe-bitmap 'diff-hl-bmp-single single h w 'top)
- (define-fringe-bitmap 'diff-hl-bmp-i [3 3 0 3 3 3 3 3 3 3] nil 2 'center)
- (let* ((w2 (* (/ w 2) 2))
- ;; When fringes are disabled, it's easier to fix up the width,
- ;; instead of doing nothing (#20).
- (w2 (if (zerop w2) 2 w2))
- (delete-row (- (expt 2 (1- w2)) 2))
- (middle-pos (1- (/ w2 2)))
- (middle-bit (expt 2 middle-pos))
- (insert-bmp (make-vector w2 (* 3 middle-bit))))
- (define-fringe-bitmap 'diff-hl-bmp-delete (make-vector 2 delete-row) w2
w2)
- (aset insert-bmp 0 0)
- (aset insert-bmp middle-pos delete-row)
- (aset insert-bmp (1+ middle-pos) delete-row)
- (aset insert-bmp (1- w2) 0)
- (define-fringe-bitmap 'diff-hl-bmp-insert insert-bmp w2 w2)
- )))
-
-(defun diff-hl-maybe-define-bitmaps ()
- (when (window-system) ;; No fringes in the console.
- (unless (fringe-bitmap-p 'diff-hl-bmp-empty)
- (diff-hl-define-bitmaps)
- (define-fringe-bitmap 'diff-hl-bmp-empty [0] 1 1 'center))))
-
-(defvar diff-hl-spec-cache (make-hash-table :test 'equal))
-
-(defun diff-hl-fringe-spec (type pos)
- (let* ((key (list type pos diff-hl-fringe-bmp-function))
- (val (gethash key diff-hl-spec-cache)))
- (unless val
- (let* ((face-sym (funcall diff-hl-fringe-face-function type pos))
- (bmp-sym (funcall diff-hl-fringe-bmp-function type pos)))
- (setq val (propertize " " 'display `((left-fringe ,bmp-sym
,face-sym))))
- (puthash key val diff-hl-spec-cache)))
- val))
-
-(defun diff-hl-fringe-face-from-type (type _pos)
- (intern (format "diff-hl-%s" type)))
-
-(defun diff-hl-fringe-bmp-from-pos (_type pos)
- (intern (format "diff-hl-bmp-%s" pos)))
-
-(defun diff-hl-fringe-bmp-from-type (type _pos)
- (cl-case type
- (unknown 'question-mark)
- (change 'exclamation-mark)
- (ignored 'diff-hl-bmp-i)
- (t (intern (format "diff-hl-bmp-%s" type)))))
-
-(defvar vc-svn-diff-switches)
-
-(defmacro diff-hl-with-diff-switches (body)
- `(let ((vc-git-diff-switches nil)
- (vc-hg-diff-switches nil)
- (vc-svn-diff-switches nil)
- (vc-diff-switches '("-U0"))
- (vc-disable-async-diff t))
- ,body))
-
-(defun diff-hl-changes ()
- (let* ((file buffer-file-name)
- (backend (vc-backend file)))
- (when backend
- (let ((state (vc-state file backend)))
- (cond
- ((or (eq state 'edited)
- (and (eq state 'up-to-date)
- ;; VC state is stale in after-revert-hook.
- (or revert-buffer-in-progress-p
- ;; Diffing against an older revision.
- diff-hl-reference-revision)))
- (let* ((buf-name " *diff-hl* ")
- diff-auto-refine-mode
- res)
- (diff-hl-with-diff-switches
- (vc-call-backend backend 'diff (list file)
- diff-hl-reference-revision nil
- buf-name))
- (with-current-buffer buf-name
- (goto-char (point-min))
- (unless (eobp)
- (ignore-errors
- (diff-beginning-of-hunk t))
- (while (looking-at diff-hunk-header-re-unified)
- (let ((line (string-to-number (match-string 3)))
- (len (let ((m (match-string 4)))
- (if m (string-to-number m) 1)))
- (beg (point)))
- (diff-end-of-hunk)
- (let* ((inserts (diff-count-matches "^\\+" beg (point)))
- (deletes (diff-count-matches "^-" beg (point)))
- (type (cond ((zerop deletes) 'insert)
- ((zerop inserts) 'delete)
- (t 'change))))
- (when (eq type 'delete)
- (setq len 1)
- (cl-incf line))
- (push (list line len type) res))))))
- (nreverse res)))
- ((eq state 'added)
- `((1 ,(line-number-at-pos (point-max)) insert)))
- ((eq state 'removed)
- `((1 ,(line-number-at-pos (point-max)) delete))))))))
-
-(defun diff-hl-update ()
- (let ((changes (diff-hl-changes))
- (current-line 1))
- (diff-hl-remove-overlays)
- (save-excursion
- (goto-char (point-min))
- (dolist (c changes)
- (cl-destructuring-bind (line len type) c
- (forward-line (- line current-line))
- (setq current-line line)
- (let ((hunk-beg (point)))
- (while (cl-plusp len)
- (diff-hl-add-highlighting
- type
- (cond
- ((not diff-hl-draw-borders) 'empty)
- ((and (= len 1) (= line current-line)) 'single)
- ((= len 1) 'bottom)
- ((= line current-line) 'top)
- (t 'middle)))
- (forward-line 1)
- (cl-incf current-line)
- (cl-decf len))
- (let ((h (make-overlay hunk-beg (point)))
- (hook '(diff-hl-overlay-modified)))
- (overlay-put h 'diff-hl t)
- (overlay-put h 'diff-hl-hunk t)
- (overlay-put h 'modification-hooks hook)
- (overlay-put h 'insert-in-front-hooks hook)
- (overlay-put h 'insert-behind-hooks hook))))))))
-
-(defun diff-hl-add-highlighting (type shape)
- (let ((o (make-overlay (point) (point))))
- (overlay-put o 'diff-hl t)
- (funcall diff-hl-highlight-function o type shape)
- o))
-
-(defun diff-hl-highlight-on-fringe (ovl type shape)
- (overlay-put ovl 'before-string (diff-hl-fringe-spec type shape)))
-
-(defun diff-hl-remove-overlays ()
- (dolist (o (overlays-in (point-min) (point-max)))
- (when (overlay-get o 'diff-hl) (delete-overlay o))))
-
-(defun diff-hl-overlay-modified (ov after-p _beg _end &optional _length)
- "Delete the hunk overlay and all our line overlays inside it."
- (unless after-p
- (when (overlay-buffer ov)
- (save-restriction
- (narrow-to-region (overlay-start ov) (overlay-end ov))
- (diff-hl-remove-overlays))
- (delete-overlay ov))))
-
-(defvar diff-hl-timer nil)
-
-(defun diff-hl-edit (_beg _end _len)
- "DTRT when we've `undo'-ne the buffer into unmodified state."
- (when undo-in-progress
- (when diff-hl-timer
- (cancel-timer diff-hl-timer))
- (setq diff-hl-timer
- (run-with-idle-timer 0.01 nil #'diff-hl-after-undo
(current-buffer)))))
-
-(defun diff-hl-after-undo (buffer)
- (with-current-buffer buffer
- (unless (buffer-modified-p)
- (diff-hl-update))))
-
-(defun diff-hl-diff-goto-hunk ()
- "Run VC diff command and go to the line corresponding to the current."
- (interactive)
- (vc-buffer-sync)
- (let* ((line (line-number-at-pos))
- (buffer (current-buffer)))
- (vc-diff-internal t (vc-deduce-fileset) diff-hl-reference-revision nil t)
- (vc-exec-after `(if (< (line-number-at-pos (point-max)) 3)
- (with-current-buffer ,buffer (diff-hl-remove-overlays))
- (diff-hl-diff-skip-to ,line)
- (setq vc-sentinel-movepoint (point))))))
-
-(defun diff-hl-diff-skip-to (line)
- "In `diff-mode', skip to the hunk and line corresponding to LINE
-in the source file, or the last line of the hunk above it."
- (diff-hunk-next)
- (let (found)
- (while (and (looking-at diff-hunk-header-re-unified) (not found))
- (let ((hunk-line (string-to-number (match-string 3)))
- (len (let ((m (match-string 4)))
- (if m (string-to-number m) 1))))
- (if (> line (+ hunk-line len))
- (diff-hunk-next)
- (setq found t)
- (if (< line hunk-line)
- ;; Retreat to the previous hunk.
- (forward-line -1)
- (let ((to-go (1+ (- line hunk-line))))
- (while (cl-plusp to-go)
- (forward-line 1)
- (unless (looking-at "^-")
- (cl-decf to-go))))))))))
-
-(defun diff-hl-revert-hunk ()
- "Revert the diff hunk with changes at or above the point."
- (interactive)
- (vc-buffer-sync)
- (let ((diff-buffer (generate-new-buffer-name "*diff-hl*"))
- (buffer (current-buffer))
- (line (save-excursion
- (unless (diff-hl-hunk-overlay-at (point))
- (diff-hl-previous-hunk))
- (line-number-at-pos)))
- (fileset (vc-deduce-fileset)))
- (unwind-protect
- (progn
- (vc-diff-internal nil fileset diff-hl-reference-revision nil
- nil diff-buffer)
- (vc-exec-after
- `(let (beg-line end-line)
- (when (eobp)
- (with-current-buffer ,buffer (diff-hl-remove-overlays))
- (error "Buffer is up-to-date"))
- (diff-hl-diff-skip-to ,line)
- (save-excursion
- (while (looking-at "[-+]") (forward-line 1))
- (setq end-line (line-number-at-pos (point)))
- (unless (eobp) (diff-split-hunk)))
- (unless (looking-at "[-+]") (forward-line -1))
- (while (looking-at "[-+]") (forward-line -1))
- (setq beg-line (line-number-at-pos (point)))
- (unless (looking-at "@")
- (forward-line 1)
- (diff-split-hunk))
- (let ((wbh (window-body-height)))
- (if (>= wbh (- end-line beg-line))
- (recenter (/ (+ wbh (- beg-line end-line) 2) 2))
- (recenter 1)))
- (unless (yes-or-no-p (format "Revert current hunk in %s?"
- ,(cl-caadr fileset)))
- (error "Revert canceled"))
- (let ((diff-advance-after-apply-hunk nil))
- (diff-apply-hunk t))
- (with-current-buffer ,buffer
- (save-buffer))
- (message "Hunk reverted"))))
- (quit-windows-on diff-buffer))))
-
-(defun diff-hl-hunk-overlay-at (pos)
- (cl-loop for o in (overlays-in pos (1+ pos))
- when (overlay-get o 'diff-hl-hunk)
- return o))
-
-(defun diff-hl-next-hunk (&optional backward)
- "Go to the beginning of the next hunk in the current buffer."
- (interactive)
- (let ((pos (save-excursion
- (catch 'found
- (while (not (if backward (bobp) (eobp)))
- (goto-char (if backward
- (previous-overlay-change (point))
- (next-overlay-change (point))))
- (let ((o (diff-hl-hunk-overlay-at (point))))
- (when (and o (= (overlay-start o) (point)))
- (throw 'found (overlay-start o)))))))))
- (if pos
- (goto-char pos)
- (error "No further hunks found"))))
-
-(defun diff-hl-previous-hunk ()
- "Go to the beginning of the previous hunk in the current buffer."
- (interactive)
- (diff-hl-next-hunk t))
-
-(define-prefix-command 'diff-hl-command-map)
-
-(let ((map diff-hl-command-map))
- (define-key map "n" 'diff-hl-revert-hunk)
- (define-key map "[" 'diff-hl-previous-hunk)
- (define-key map "]" 'diff-hl-next-hunk)
- map)
-
-;;;###autoload
-(define-minor-mode diff-hl-mode
- "Toggle VC diff highlighting."
- :lighter "" :keymap `(([remap vc-diff] . diff-hl-diff-goto-hunk)
- (,diff-hl-command-prefix . diff-hl-command-map))
- (if diff-hl-mode
- (progn
- (diff-hl-maybe-define-bitmaps)
- (add-hook 'after-save-hook 'diff-hl-update nil t)
- (add-hook 'after-change-functions 'diff-hl-edit nil t)
- (add-hook (if vc-mode
- ;; Defer until the end of this hook, so that its
- ;; elements can modify the update behavior.
- 'diff-hl-mode-on-hook
- ;; If we're only opening the file now,
- ;; `vc-find-file-hook' likely hasn't run yet, so
- ;; let's wait until the state information is
- ;; saved, in order not to fetch it twice.
- 'find-file-hook)
- 'diff-hl-update t t)
- (add-hook 'vc-checkin-hook 'diff-hl-update nil t)
- (add-hook 'after-revert-hook 'diff-hl-update nil t)
- ;; Magit does call `auto-revert-handler', but it usually
- ;; doesn't do much, because `buffer-stale--default-function'
- ;; doesn't care about changed VC state.
- ;; https://github.com/magit/magit/issues/603
- (add-hook 'magit-revert-buffer-hook 'diff-hl-update nil t)
- (add-hook 'auto-revert-mode-hook 'diff-hl-update nil t)
- (add-hook 'text-scale-mode-hook 'diff-hl-define-bitmaps nil t))
- (remove-hook 'after-save-hook 'diff-hl-update t)
- (remove-hook 'after-change-functions 'diff-hl-edit t)
- (remove-hook 'find-file-hook 'diff-hl-update t)
- (remove-hook 'vc-checkin-hook 'diff-hl-update t)
- (remove-hook 'after-revert-hook 'diff-hl-update t)
- (remove-hook 'magit-revert-buffer-hook 'diff-hl-update t)
- (remove-hook 'auto-revert-mode-hook 'diff-hl-update t)
- (remove-hook 'text-scale-mode-hook 'diff-hl-define-bitmaps t)
- (diff-hl-remove-overlays)))
-
-(when (require 'smartrep nil t)
- (let (smart-keys)
- (cl-labels ((scan (map)
- (map-keymap
- (lambda (event binding)
- (if (consp binding)
- (scan binding)
- (when (characterp event)
- (push (cons (string event) binding) smart-keys))))
- map)))
- (scan diff-hl-command-map)
- (smartrep-define-key diff-hl-mode-map diff-hl-command-prefix
smart-keys))))
-
-(defun diff-hl-dir-update ()
- (dolist (pair (if (vc-dir-marked-files)
- (vc-dir-marked-only-files-and-states)
- (vc-dir-child-files-and-states)))
- (when (eq 'up-to-date (cdr pair))
- (let ((buffer (find-buffer-visiting (car pair))))
- (when buffer
- (with-current-buffer buffer
- (diff-hl-remove-overlays)))))))
-
-(define-minor-mode diff-hl-dir-mode
- "Toggle `diff-hl-mode' integration in a `vc-dir-mode' buffer."
- :lighter ""
- (if diff-hl-dir-mode
- (add-hook 'vc-checkin-hook 'diff-hl-dir-update t t)
- (remove-hook 'vc-checkin-hook 'diff-hl-dir-update t)))
-
-;;;###autoload
-(defun turn-on-diff-hl-mode ()
- "Turn on `diff-hl-mode' or `diff-hl-dir-mode' in a buffer if appropriate."
- (cond
- (buffer-file-name
- (diff-hl-mode 1))
- ((eq major-mode 'vc-dir-mode)
- (diff-hl-dir-mode 1))))
-
-;;;###autoload
-(define-globalized-minor-mode global-diff-hl-mode diff-hl-mode
- turn-on-diff-hl-mode :after-hook (diff-hl-global-mode-change))
-
-(defun diff-hl-global-mode-change ()
- (unless global-diff-hl-mode
- (dolist (buf (buffer-list))
- (with-current-buffer buf
- (when diff-hl-dir-mode
- (diff-hl-dir-mode -1))))))
-
-(provide 'diff-hl)
-
-;;; diff-hl.el ends here
+;;; diff-hl.el --- Highlight uncommitted changes using VC -*- lexical-binding:
t -*-
+
+;; Copyright (C) 2012-2016 Free Software Foundation, Inc.
+
+;; Author: Dmitry Gutov <address@hidden>
+;; URL: https://github.com/dgutov/diff-hl
+;; Keywords: vc, diff
+;; Version: 1.8.3
+;; Package-Requires: ((cl-lib "0.2"))
+
+;; 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-hl-mode' highlights uncommitted changes on the side of the
+;; window (using the fringe, by default), allows you to jump between
+;; the hunks and revert them selectively.
+
+;; Provided commands:
+;;
+;; `diff-hl-diff-goto-hunk' C-x v =
+;; `diff-hl-revert-hunk' C-x v n
+;; `diff-hl-previous-hunk' C-x v [
+;; `diff-hl-next-hunk' C-x v ]
+;;
+;; The mode takes advantage of `smartrep' if it is installed.
+
+;; Add either of the following to your init file.
+;;
+;; To use it in all buffers:
+;;
+;; (global-diff-hl-mode)
+;;
+;; Only in `prog-mode' buffers, with `vc-dir' integration:
+;;
+;; (add-hook 'prog-mode-hook 'turn-on-diff-hl-mode)
+;; (add-hook 'vc-dir-mode-hook 'turn-on-diff-hl-mode)
+
+;;; Code:
+
+(require 'fringe)
+(require 'diff-mode)
+(require 'vc)
+(require 'vc-dir)
+(eval-when-compile
+ (require 'cl-lib)
+ (require 'vc-git)
+ (require 'vc-hg)
+ (require 'face-remap)
+ (declare-function smartrep-define-key 'smartrep))
+
+(defgroup diff-hl nil
+ "VC diff highlighting on the side of a window"
+ :group 'vc)
+
+(defface diff-hl-insert
+ '((default :inherit diff-added)
+ (((class color)) :foreground "green4"))
+ "Face used to highlight inserted lines."
+ :group 'diff-hl)
+
+(defface diff-hl-delete
+ '((default :inherit diff-removed)
+ (((class color)) :foreground "red3"))
+ "Face used to highlight deleted lines."
+ :group 'diff-hl)
+
+(defface diff-hl-change
+ '((default :foreground "blue3")
+ (((class color) (min-colors 88) (background light))
+ :background "#ddddff")
+ (((class color) (min-colors 88) (background dark))
+ :background "#333355"))
+ "Face used to highlight changed lines."
+ :group 'diff-hl)
+
+(defcustom diff-hl-command-prefix (kbd "C-x v")
+ "The prefix for all `diff-hl' commands."
+ :group 'diff-hl
+ :type 'string)
+
+(defcustom diff-hl-draw-borders t
+ "Non-nil to draw borders around fringe indicators."
+ :group 'diff-hl
+ :type 'boolean)
+
+(defcustom diff-hl-highlight-function 'diff-hl-highlight-on-fringe
+ "Function to highlight the current line. Its arguments are
+ overlay, change type and position within a hunk."
+ :group 'diff-hl
+ :type 'function)
+
+(defcustom diff-hl-fringe-bmp-function 'diff-hl-fringe-bmp-from-pos
+ "Function to choose the fringe bitmap for a given change type
+ and position within a hunk. Should accept two arguments."
+ :group 'diff-hl
+ :type '(choice (const diff-hl-fringe-bmp-from-pos)
+ (const diff-hl-fringe-bmp-from-type)
+ function))
+
+(defcustom diff-hl-fringe-face-function 'diff-hl-fringe-face-from-type
+ "Function to choose the fringe face for a given change type
+ and position within a hunk. Should accept two arguments."
+ :group 'diff-hl
+ :type 'function)
+
+(defcustom diff-hl-side 'left
+ "Which side to use for indicators."
+ :type '(choice (const left)
+ (const right))
+ :set (lambda (var value)
+ (let ((on (bound-and-true-p global-diff-hl-mode)))
+ (when on (global-diff-hl-mode -1))
+ (set-default var value)
+ (when on (global-diff-hl-mode 1)))))
+
+(defvar diff-hl-reference-revision nil
+ "Revision to diff against. nil means the most recent one.")
+
+(defun diff-hl-define-bitmaps ()
+ (let* ((scale (if (and (boundp 'text-scale-mode-amount)
+ (numberp text-scale-mode-amount))
+ (expt text-scale-mode-step text-scale-mode-amount)
+ 1))
+ (spacing (or (and (display-graphic-p) (default-value 'line-spacing))
0))
+ (h (+ (ceiling (* (frame-char-height) scale))
+ (if (floatp spacing)
+ (truncate (* (frame-char-height) spacing))
+ spacing)))
+ (w (min (frame-parameter nil (intern (format "%s-fringe"
diff-hl-side)))
+ 16))
+ (middle (make-vector h (expt 2 (1- w))))
+ (ones (1- (expt 2 w)))
+ (top (copy-sequence middle))
+ (bottom (copy-sequence middle))
+ (single (copy-sequence middle)))
+ (aset top 0 ones)
+ (aset bottom (1- h) ones)
+ (aset single 0 ones)
+ (aset single (1- h) ones)
+ (define-fringe-bitmap 'diff-hl-bmp-top top h w 'top)
+ (define-fringe-bitmap 'diff-hl-bmp-middle middle h w 'center)
+ (define-fringe-bitmap 'diff-hl-bmp-bottom bottom h w 'bottom)
+ (define-fringe-bitmap 'diff-hl-bmp-single single h w 'top)
+ (define-fringe-bitmap 'diff-hl-bmp-i [3 3 0 3 3 3 3 3 3 3] nil 2 'center)
+ (let* ((w2 (* (/ w 2) 2))
+ ;; When fringes are disabled, it's easier to fix up the width,
+ ;; instead of doing nothing (#20).
+ (w2 (if (zerop w2) 2 w2))
+ (delete-row (- (expt 2 (1- w2)) 2))
+ (middle-pos (1- (/ w2 2)))
+ (middle-bit (expt 2 middle-pos))
+ (insert-bmp (make-vector w2 (* 3 middle-bit))))
+ (define-fringe-bitmap 'diff-hl-bmp-delete (make-vector 2 delete-row) w2
w2)
+ (aset insert-bmp 0 0)
+ (aset insert-bmp middle-pos delete-row)
+ (aset insert-bmp (1+ middle-pos) delete-row)
+ (aset insert-bmp (1- w2) 0)
+ (define-fringe-bitmap 'diff-hl-bmp-insert insert-bmp w2 w2)
+ )))
+
+(defun diff-hl-maybe-define-bitmaps ()
+ (when (window-system) ;; No fringes in the console.
+ (unless (fringe-bitmap-p 'diff-hl-bmp-empty)
+ (diff-hl-define-bitmaps)
+ (define-fringe-bitmap 'diff-hl-bmp-empty [0] 1 1 'center))))
+
+(defvar diff-hl-spec-cache (make-hash-table :test 'equal))
+
+(defun diff-hl-fringe-spec (type pos side)
+ (let* ((key (list type pos side
+ diff-hl-fringe-face-function
+ diff-hl-fringe-bmp-function))
+ (val (gethash key diff-hl-spec-cache)))
+ (unless val
+ (let* ((face-sym (funcall diff-hl-fringe-face-function type pos))
+ (bmp-sym (funcall diff-hl-fringe-bmp-function type pos)))
+ (setq val (propertize " " 'display `((,(intern (format "%s-fringe"
side))
+ ,bmp-sym ,face-sym))))
+ (puthash key val diff-hl-spec-cache)))
+ val))
+
+(defun diff-hl-fringe-face-from-type (type _pos)
+ (intern (format "diff-hl-%s" type)))
+
+(defun diff-hl-fringe-bmp-from-pos (_type pos)
+ (intern (format "diff-hl-bmp-%s" pos)))
+
+(defun diff-hl-fringe-bmp-from-type (type _pos)
+ (cl-case type
+ (unknown 'question-mark)
+ (change 'exclamation-mark)
+ (ignored 'diff-hl-bmp-i)
+ (t (intern (format "diff-hl-bmp-%s" type)))))
+
+(defvar vc-svn-diff-switches)
+
+(defmacro diff-hl-with-diff-switches (body)
+ `(let ((vc-git-diff-switches nil)
+ (vc-hg-diff-switches nil)
+ (vc-svn-diff-switches nil)
+ (vc-diff-switches '("-U0"))
+ ,@(when (boundp 'vc-disable-async-diff)
+ '((vc-disable-async-diff t))))
+ ,body))
+
+(defun diff-hl-modified-p (state)
+ (or (eq state 'edited)
+ (and (eq state 'up-to-date)
+ ;; VC state is stale in after-revert-hook.
+ (or revert-buffer-in-progress-p
+ ;; Diffing against an older revision.
+ diff-hl-reference-revision))))
+
+(defun diff-hl-changes-buffer (file backend)
+ (let ((buf-name " *diff-hl* "))
+ (diff-hl-with-diff-switches
+ (vc-call-backend backend 'diff (list file)
+ diff-hl-reference-revision nil
+ buf-name))
+ buf-name))
+
+(defun diff-hl-changes ()
+ (let* ((file buffer-file-name)
+ (backend (vc-backend file)))
+ (when backend
+ (let ((state (vc-state file backend)))
+ (cond
+ ((diff-hl-modified-p state)
+ (let* (diff-auto-refine-mode res)
+ (with-current-buffer (diff-hl-changes-buffer file backend)
+ (goto-char (point-min))
+ (unless (eobp)
+ (ignore-errors
+ (diff-beginning-of-hunk t))
+ (while (looking-at diff-hunk-header-re-unified)
+ (let ((line (string-to-number (match-string 3)))
+ (len (let ((m (match-string 4)))
+ (if m (string-to-number m) 1)))
+ (beg (point)))
+ (diff-end-of-hunk)
+ (let* ((inserts (diff-count-matches "^\\+" beg (point)))
+ (deletes (diff-count-matches "^-" beg (point)))
+ (type (cond ((zerop deletes) 'insert)
+ ((zerop inserts) 'delete)
+ (t 'change))))
+ (when (eq type 'delete)
+ (setq len 1)
+ (cl-incf line))
+ (push (list line len type) res))))))
+ (nreverse res)))
+ ((eq state 'added)
+ `((1 ,(line-number-at-pos (point-max)) insert)))
+ ((eq state 'removed)
+ `((1 ,(line-number-at-pos (point-max)) delete))))))))
+
+(defun diff-hl-update ()
+ (let ((changes (diff-hl-changes))
+ (current-line 1))
+ (diff-hl-remove-overlays)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (dolist (c changes)
+ (cl-destructuring-bind (line len type) c
+ (forward-line (- line current-line))
+ (setq current-line line)
+ (let ((hunk-beg (point)))
+ (while (cl-plusp len)
+ (diff-hl-add-highlighting
+ type
+ (cond
+ ((not diff-hl-draw-borders) 'empty)
+ ((and (= len 1) (= line current-line)) 'single)
+ ((= len 1) 'bottom)
+ ((= line current-line) 'top)
+ (t 'middle)))
+ (forward-line 1)
+ (cl-incf current-line)
+ (cl-decf len))
+ (let ((h (make-overlay hunk-beg (point)))
+ (hook '(diff-hl-overlay-modified)))
+ (overlay-put h 'diff-hl t)
+ (overlay-put h 'diff-hl-hunk t)
+ (overlay-put h 'modification-hooks hook)
+ (overlay-put h 'insert-in-front-hooks hook)
+ (overlay-put h 'insert-behind-hooks hook)))))))))
+
+(defun diff-hl-add-highlighting (type shape)
+ (let ((o (make-overlay (point) (point))))
+ (overlay-put o 'diff-hl t)
+ (funcall diff-hl-highlight-function o type shape)
+ o))
+
+(defun diff-hl-highlight-on-fringe (ovl type shape)
+ (overlay-put ovl 'before-string (diff-hl-fringe-spec type shape
+ diff-hl-side)))
+
+(defun diff-hl-remove-overlays (&optional beg end)
+ (save-restriction
+ (widen)
+ (dolist (o (overlays-in (or beg (point-min)) (or end (point-max))))
+ (when (overlay-get o 'diff-hl) (delete-overlay o)))))
+
+(defun diff-hl-overlay-modified (ov after-p _beg _end &optional _length)
+ "Delete the hunk overlay and all our line overlays inside it."
+ (unless after-p
+ (when (overlay-buffer ov)
+ (diff-hl-remove-overlays (overlay-start ov) (overlay-end ov))
+ (delete-overlay ov))))
+
+(defvar diff-hl-timer nil)
+
+(defun diff-hl-edit (_beg _end _len)
+ "DTRT when we've `undo'-ne the buffer into unmodified state."
+ (when undo-in-progress
+ (when diff-hl-timer
+ (cancel-timer diff-hl-timer))
+ (setq diff-hl-timer
+ (run-with-idle-timer 0.01 nil #'diff-hl-after-undo
(current-buffer)))))
+
+(defun diff-hl-after-undo (buffer)
+ (with-current-buffer buffer
+ (unless (buffer-modified-p)
+ (diff-hl-update))))
+
+(defun diff-hl-diff-goto-hunk ()
+ "Run VC diff command and go to the line corresponding to the current."
+ (interactive)
+ (vc-buffer-sync)
+ (let* ((line (line-number-at-pos))
+ (buffer (current-buffer)))
+ (vc-diff-internal t (vc-deduce-fileset) diff-hl-reference-revision nil t)
+ (vc-exec-after `(if (< (line-number-at-pos (point-max)) 3)
+ (with-current-buffer ,buffer (diff-hl-remove-overlays))
+ (diff-hl-diff-skip-to ,line)
+ (setq vc-sentinel-movepoint (point))))))
+
+(defun diff-hl-diff-skip-to (line)
+ "In `diff-mode', skip to the hunk and line corresponding to LINE
+in the source file, or the last line of the hunk above it."
+ (diff-hunk-next)
+ (let (found)
+ (while (and (looking-at diff-hunk-header-re-unified) (not found))
+ (let ((hunk-line (string-to-number (match-string 3)))
+ (len (let ((m (match-string 4)))
+ (if m (string-to-number m) 1))))
+ (if (> line (+ hunk-line len))
+ (diff-hunk-next)
+ (setq found t)
+ (if (< line hunk-line)
+ ;; Retreat to the previous hunk.
+ (forward-line -1)
+ (let ((to-go (1+ (- line hunk-line))))
+ (while (cl-plusp to-go)
+ (forward-line 1)
+ (unless (looking-at "^-")
+ (cl-decf to-go))))))))))
+
+(defun diff-hl-revert-hunk ()
+ "Revert the diff hunk with changes at or above the point."
+ (interactive)
+ (vc-buffer-sync)
+ (let ((diff-buffer (generate-new-buffer-name "*diff-hl*"))
+ (buffer (current-buffer))
+ (line (save-excursion
+ (unless (diff-hl-hunk-overlay-at (point))
+ (diff-hl-previous-hunk))
+ (line-number-at-pos)))
+ (fileset (vc-deduce-fileset)))
+ (unwind-protect
+ (progn
+ (vc-diff-internal nil fileset diff-hl-reference-revision nil
+ nil diff-buffer)
+ (vc-exec-after
+ `(let (beg-line end-line)
+ (when (eobp)
+ (with-current-buffer ,buffer (diff-hl-remove-overlays))
+ (error "Buffer is up-to-date"))
+ (let (diff-auto-refine-mode)
+ (diff-hl-diff-skip-to ,line))
+ (save-excursion
+ (while (looking-at "[-+]") (forward-line 1))
+ (setq end-line (line-number-at-pos (point)))
+ (unless (eobp) (diff-split-hunk)))
+ (unless (looking-at "[-+]") (forward-line -1))
+ (while (looking-at "[-+]") (forward-line -1))
+ (setq beg-line (line-number-at-pos (point)))
+ (unless (looking-at "@")
+ (forward-line 1)
+ (diff-split-hunk))
+ (let ((wbh (window-body-height)))
+ (if (>= wbh (- end-line beg-line))
+ (recenter (/ (+ wbh (- beg-line end-line) 2) 2))
+ (recenter 1)))
+ (when diff-auto-refine-mode
+ (diff-refine-hunk))
+ (unless (yes-or-no-p (format "Revert current hunk in %s?"
+ ,(cl-caadr fileset)))
+ (error "Revert canceled"))
+ (let ((diff-advance-after-apply-hunk nil))
+ (diff-apply-hunk t))
+ (with-current-buffer ,buffer
+ (save-buffer))
+ (message "Hunk reverted"))))
+ (quit-windows-on diff-buffer t))))
+
+(defun diff-hl-hunk-overlay-at (pos)
+ (cl-loop for o in (overlays-in pos (1+ pos))
+ when (overlay-get o 'diff-hl-hunk)
+ return o))
+
+(defun diff-hl-next-hunk (&optional backward)
+ "Go to the beginning of the next hunk in the current buffer."
+ (interactive)
+ (let ((pos (save-excursion
+ (catch 'found
+ (while (not (if backward (bobp) (eobp)))
+ (goto-char (if backward
+ (previous-overlay-change (point))
+ (next-overlay-change (point))))
+ (let ((o (diff-hl-hunk-overlay-at (point))))
+ (when (and o (= (overlay-start o) (point)))
+ (throw 'found (overlay-start o)))))))))
+ (if pos
+ (goto-char pos)
+ (error "No further hunks found"))))
+
+(defun diff-hl-previous-hunk ()
+ "Go to the beginning of the previous hunk in the current buffer."
+ (interactive)
+ (diff-hl-next-hunk t))
+
+(defun diff-hl-mark-hunk ()
+ (interactive)
+ (let ((hunk (diff-hl-hunk-overlay-at (point))))
+ (unless hunk
+ (error "No hunk at point"))
+ (goto-char (overlay-start hunk))
+ (push-mark (overlay-end hunk) nil t)))
+
+(defvar diff-hl-command-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "n" 'diff-hl-revert-hunk)
+ (define-key map "[" 'diff-hl-previous-hunk)
+ (define-key map "]" 'diff-hl-next-hunk)
+ map))
+(fset 'diff-hl-command-map diff-hl-command-map)
+
+;;;###autoload
+(define-minor-mode diff-hl-mode
+ "Toggle VC diff highlighting."
+ :lighter "" :keymap `(([remap vc-diff] . diff-hl-diff-goto-hunk)
+ (,diff-hl-command-prefix . diff-hl-command-map))
+ (if diff-hl-mode
+ (progn
+ (diff-hl-maybe-define-bitmaps)
+ (add-hook 'after-save-hook 'diff-hl-update nil t)
+ (add-hook 'after-change-functions 'diff-hl-edit nil t)
+ (add-hook (if vc-mode
+ ;; Defer until the end of this hook, so that its
+ ;; elements can modify the update behavior.
+ 'diff-hl-mode-on-hook
+ ;; If we're only opening the file now,
+ ;; `vc-find-file-hook' likely hasn't run yet, so
+ ;; let's wait until the state information is
+ ;; saved, in order not to fetch it twice.
+ 'find-file-hook)
+ 'diff-hl-update t t)
+ (add-hook 'vc-checkin-hook 'diff-hl-update nil t)
+ (add-hook 'after-revert-hook 'diff-hl-update nil t)
+ ;; Magit does call `auto-revert-handler', but it usually
+ ;; doesn't do much, because `buffer-stale--default-function'
+ ;; doesn't care about changed VC state.
+ ;; https://github.com/magit/magit/issues/603
+ (add-hook 'magit-revert-buffer-hook 'diff-hl-update nil t)
+ ;; Magit versions 2.0-2.3 don't do the above and call this
+ ;; instead, but only when they dosn't call `revert-buffer':
+ (add-hook 'magit-not-reverted-hook 'diff-hl-update nil t)
+ (add-hook 'auto-revert-mode-hook 'diff-hl-update nil t)
+ (add-hook 'text-scale-mode-hook 'diff-hl-define-bitmaps nil t))
+ (remove-hook 'after-save-hook 'diff-hl-update t)
+ (remove-hook 'after-change-functions 'diff-hl-edit t)
+ (remove-hook 'find-file-hook 'diff-hl-update t)
+ (remove-hook 'vc-checkin-hook 'diff-hl-update t)
+ (remove-hook 'after-revert-hook 'diff-hl-update t)
+ (remove-hook 'magit-revert-buffer-hook 'diff-hl-update t)
+ (remove-hook 'magit-not-reverted-hook 'diff-hl-update t)
+ (remove-hook 'auto-revert-mode-hook 'diff-hl-update t)
+ (remove-hook 'text-scale-mode-hook 'diff-hl-define-bitmaps t)
+ (diff-hl-remove-overlays)))
+
+(when (require 'smartrep nil t)
+ (let (smart-keys)
+ (cl-labels ((scan (map)
+ (map-keymap
+ (lambda (event binding)
+ (if (consp binding)
+ (scan binding)
+ (when (characterp event)
+ (push (cons (string event) binding) smart-keys))))
+ map)))
+ (scan diff-hl-command-map)
+ (smartrep-define-key diff-hl-mode-map diff-hl-command-prefix
smart-keys))))
+
+(declare-function magit-toplevel "magit-git")
+(declare-function magit-unstaged-files "magit-git")
+
+(defun diff-hl-magit-post-refresh ()
+ (let* ((topdir (magit-toplevel))
+ (modified-files
+ (mapcar (lambda (file) (expand-file-name file topdir))
+ (magit-unstaged-files t)))
+ (unmodified-states '(up-to-date ignored unregistered)))
+ (dolist (buf (buffer-list))
+ (when (and (buffer-local-value 'diff-hl-mode buf)
+ (not (buffer-modified-p buf))
+ (file-in-directory-p (buffer-file-name buf) topdir))
+ (with-current-buffer buf
+ (let* ((file buffer-file-name)
+ (backend (vc-backend file)))
+ (when backend
+ (cond
+ ((member file modified-files)
+ (when (memq (vc-state file) unmodified-states)
+ (vc-state-refresh file backend))
+ (diff-hl-update))
+ ((not (memq (vc-state file backend) unmodified-states))
+ (vc-state-refresh file backend)
+ (diff-hl-update))))))))))
+
+(defun diff-hl-dir-update ()
+ (dolist (pair (if (vc-dir-marked-files)
+ (vc-dir-marked-only-files-and-states)
+ (vc-dir-child-files-and-states)))
+ (when (eq 'up-to-date (cdr pair))
+ (let ((buffer (find-buffer-visiting (car pair))))
+ (when buffer
+ (with-current-buffer buffer
+ (diff-hl-remove-overlays)))))))
+
+(define-minor-mode diff-hl-dir-mode
+ "Toggle `diff-hl-mode' integration in a `vc-dir-mode' buffer."
+ :lighter ""
+ (if diff-hl-dir-mode
+ (add-hook 'vc-checkin-hook 'diff-hl-dir-update t t)
+ (remove-hook 'vc-checkin-hook 'diff-hl-dir-update t)))
+
+;;;###autoload
+(defun turn-on-diff-hl-mode ()
+ "Turn on `diff-hl-mode' or `diff-hl-dir-mode' in a buffer if appropriate."
+ (cond
+ (buffer-file-name
+ (diff-hl-mode 1))
+ ((eq major-mode 'vc-dir-mode)
+ (diff-hl-dir-mode 1))))
+
+;;;###autoload
+(define-globalized-minor-mode global-diff-hl-mode diff-hl-mode
+ turn-on-diff-hl-mode :after-hook (diff-hl-global-mode-change))
+
+(defun diff-hl-global-mode-change ()
+ (unless global-diff-hl-mode
+ (dolist (buf (buffer-list))
+ (with-current-buffer buf
+ (when diff-hl-dir-mode
+ (diff-hl-dir-mode -1))))))
+
+(provide 'diff-hl)
+
+;;; diff-hl.el ends here
diff --git a/packages/dts-mode/README.mkd b/packages/dts-mode/README.mkd
new file mode 100644
index 0000000..8de2d90
--- /dev/null
+++ b/packages/dts-mode/README.mkd
@@ -0,0 +1,12 @@
+# dts-mode — A Device Tree major mode for emacs
+
+This is a quick attempt at getting basic highlighting for [Device
+Tree][devicetree] syntax in emacs. While it's fairly functional, it's not
+pretty; pull requests welcome.
+
+[devicetree]: http://www.devicetree.org/
+
+## Installation
+
+Available through [MELPA](http://melpa.milkbox.net/#/). Alternatively ensure
+`dts-mode.el` is available in `load-path` and `(require 'dts-mode)`.
diff --git a/packages/dts-mode/dts-mode.el b/packages/dts-mode/dts-mode.el
new file mode 100644
index 0000000..e1ce4fd
--- /dev/null
+++ b/packages/dts-mode/dts-mode.el
@@ -0,0 +1,177 @@
+;;; dts-mode.el --- Major mode for Device Tree source files
+
+;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
+
+;; Version: 0.1.0
+;; Author: Ben Gamari <address@hidden>
+;; Keywords: languages
+
+;; 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:
+
+(defconst dts-re-ident "\\([[:alpha:]_][[:alnum:]_,-]*\\)")
+
+(defvar dts-mode-font-lock-keywords
+ `(
+ ;; Names like `name: hi {`
+ (,(concat dts-re-ident ":") 1 font-lock-variable-name-face)
+ ;; Nodes
+ (,(concat dts-re-ident "\\(@[[:xdigit:]]+\\)?[[:space:]]*{")
+ (1 font-lock-type-face))
+ ;; Assignments
+ (,(concat dts-re-ident "[[:space:]]*=") 1 font-lock-variable-name-face)
+ (,(concat dts-re-ident "[[:space:]]*;") 1 font-lock-variable-name-face)
+ ;; References
+ (,(concat "&" dts-re-ident) 1 font-lock-variable-name-face)
+ )
+ )
+
+(defvar dts-mode-syntax-table
+ (let ((table (make-syntax-table)))
+ (modify-syntax-entry ?< "(>" table)
+ (modify-syntax-entry ?> ")<" table)
+
+ (modify-syntax-entry ?& "." table)
+ (modify-syntax-entry ?| "." table)
+ (modify-syntax-entry ?~ "." table)
+
+ ;; _ and , are both symbol constituents.
+ (modify-syntax-entry ?, "_" table)
+ (modify-syntax-entry ?_ "_" table)
+
+ ;; Strings
+ (modify-syntax-entry ?\" "\"" table)
+ (modify-syntax-entry ?\\ "\\" table)
+
+ ;; Comments
+ (modify-syntax-entry ?/ ". 124b" table)
+ (modify-syntax-entry ?* ". 23" table)
+ (modify-syntax-entry ?\n "> b" table)
+ (modify-syntax-entry ?\^m "> b" table)
+
+ table))
+
+;;;; Original manual indentation code.
+
+(defun dts--calculate-indentation ()
+ (interactive)
+ (save-excursion
+ (let ((end (point-at-eol))
+ (cnt 0)
+ (initial-point (point)))
+ (goto-char 0)
+ (while (re-search-forward "\\([{}]\\)" end t)
+ (if (string= (match-string-no-properties 0) "{")
+ (setq cnt (1+ cnt))
+ (setq cnt (1- cnt))))
+ ;; subtract one if the current line has an opening brace since we
+ ;; shouldn't add the indentation level until the following line
+ (goto-char initial-point)
+ (beginning-of-line)
+ (when (re-search-forward "{" (point-at-eol) t)
+ (setq cnt (1- cnt)))
+ cnt)))
+
+(defun dts-indent-line ()
+ (interactive)
+ (let ((indent (dts--calculate-indentation)))
+ (indent-line-to (* indent tab-width))))
+
+;;;; New SMIE-based indentation code.
+
+;; Compatibility macro.
+(defmacro dts--using-macro (name exp)
+ (declare (indent 1) (debug (symbolp form)))
+ (if (fboundp name) ;If macro exists at compiler-time, just use it.
+ exp
+ `(when (fboundp ',name) ;Else, check if it exists at run-time.
+ (eval ',exp)))) ;If it does, then run the code.
+
+(require 'smie nil t)
+
+(defvar dts-use-smie (and (fboundp 'smie-prec2->grammar) (fboundp 'pcase)))
+
+(defconst dts-grammar
+ ;; FIXME: The syntax-table gives symbol-constituent syntax to the comma,
+ ;; but the comma is also used as a separator!
+ (when (fboundp 'smie-prec2->grammar)
+ (smie-prec2->grammar
+ (smie-bnf->prec2
+ '((id) (val ("<" val ">"))
+ (exp ("{" exps "}")
+ ;; The "foo,bar = toto" can be handled either by considering
+ ;; "foo,bar" as a single token or as 3 tokens.
+ ;; Currently I consider it as 3 tokens, so the LHS of "=" can't be
+ ;; just `id' but has to be `vals'.
+ (vals "=" vals))
+ (exps (exp) (exps ";" exps))
+ (vals (val "," val)))
+ '((assoc ";")) '((assoc ","))))))
+
+(defun dts-indent-rules (kind token)
+ (dts--using-macro pcase
+ (pcase (cons kind token)
+ (`(:elem . basic) tab-width)
+ ;; (`(:elem . args) 0)
+ (`(:list-intro . "") ;FIXME: Not sure why we get "" here!
+ ;; After < we either have a plain list of data, as in: "operating-points
+ ;; = <1008000 1400000 ...>" or we have sometimes "refs with args" as in
+ ;; "clocks = <&apb1_gates 6>;".
+ (and (eq (char-before) ?<) (not (looking-at "&"))))
+ (`(:before . "{") (smie-rule-parent))
+ (`(:before . "<") (if (smie-rule-hanging-p) (smie-rule-parent)))
+ (`(:after . "=") (dts-indent-rules :elem 'basic))
+ )))
+
+;;;; The major mode itself.
+
+(defalias 'dts-parent-mode
+ (if (fboundp 'prog-mode) 'prog-mode 'fundamental-mode))
+
+;;;###autoload
+(define-derived-mode dts-mode dts-parent-mode "Devicetree";DTS would be
shorter!
+ "Major mode for editing Device Tree source files."
+
+ ;; Fonts
+ (set (make-local-variable 'font-lock-defaults)
+ '(dts-mode-font-lock-keywords nil nil nil nil))
+ (set (make-local-variable 'comment-start) "/* ")
+ (set (make-local-variable 'comment-end) " */")
+ (set (make-local-variable 'comment-multi-line) t)
+
+ ;; This is not specific to the DTS format, really, but DTS is mostly
+ ;; used in the context of the Linux kernel (and U-boot loader) where
+ ;; there's a strong preference to indent with TABs.
+ (set (make-local-variable 'indent-tabs-mode) t)
+
+ (dts--using-macro syntax-propertize-rules
+ (set (make-local-variable 'syntax-propertize-function)
+ (syntax-propertize-rules
+ ("#include[ \t]+\\(<\\).*\\(>\\)" (1 "|") (2 "|"))
+ ;; Treat things like /delete-property/ as a single identifier.
+ ("\\(/\\)[a-z]+\\(/\\)" (1 "_") (2 "_")))))
+ (if dts-use-smie
+ (smie-setup dts-grammar #'dts-indent-rules)
+ (set (make-local-variable 'indent-line-function) #'dts-indent-line)))
+
+;;;###autoload
+(add-to-list 'auto-mode-alist '("\\.dtsi?\\'" . dts-mode))
+
+(provide 'dts-mode)
+;;; dts-mode.el ends here
diff --git a/packages/ediprolog/ediprolog.el b/packages/ediprolog/ediprolog.el
index ef218a4..6818052 100644
--- a/packages/ediprolog/ediprolog.el
+++ b/packages/ediprolog/ediprolog.el
@@ -1,10 +1,10 @@
;;; ediprolog.el --- Emacs Does Interactive Prolog
-;; Copyright (C) 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
+;; Copyright (C) 2006, 2007, 2008, 2009, 2012, 2013 Free Software Foundation,
Inc.
;; Author: Markus Triska <address@hidden>
;; Keywords: languages, processes
-;; Version: 1.0
+;; Version: 1.1
;; 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
@@ -82,11 +82,11 @@
;; C-u F10 first consult buffer, then evaluate query (if any)
;; C-u C-u F10 like C-u F10, with a new process
-;; Tested with SWI-Prolog 5.6.55 + Emacs 21.2, 22.3 and 23.0.92.2.
+;; Tested with SWI-Prolog 5.6.55 + Emacs 21.2, 22.3, 23.1 and 24.3
;;; Code:
-(defconst ediprolog-version "0.9yb")
+(defconst ediprolog-version "0.9z")
(defgroup ediprolog nil
"Transparent interaction with SWI-Prolog."
@@ -160,8 +160,6 @@ default Prolog prompt.")
(erase-buffer)))
;; execute forms with default-directory etc. from invocation buffer
,@forms
- (unless (process-filter ediprolog-process)
- (set-process-filter ediprolog-process
'ediprolog-wait-for-prompt-filter))
(while (not ediprolog-seen-prompt)
;; Wait for output/sentinel and update consult window, if any.
;; As `accept-process-output' does not run the sentinel in
@@ -227,8 +225,11 @@ default Prolog prompt.")
(setq ediprolog-process
(apply #'start-process "ediprolog" (current-buffer) args))
(set-process-sentinel ediprolog-process 'ediprolog-sentinel)
+ (set-process-filter ediprolog-process
+ 'ediprolog-wait-for-prompt-filter)
(ediprolog-send-string
- (format "'$set_prompt'('%s').\n" ediprolog-prompt)))
+ (format "set_prolog_flag(color_term, false),\
+ '$set_prompt'('%s').\n" ediprolog-prompt)))
((error quit)
(ediprolog-log "No prompt found." "red" t)
(error "No prompt from: %s" ediprolog-program)))))
diff --git a/packages/el-search/el-search.el b/packages/el-search/el-search.el
new file mode 100644
index 0000000..52e919a
--- /dev/null
+++ b/packages/el-search/el-search.el
@@ -0,0 +1,1011 @@
+;;; el-search.el --- Expression based incremental search for emacs-lisp-mode
-*- lexical-binding: t -*-
+
+;; Copyright (C) 2015 Free Software Foundation, Inc
+
+;; Author: Michael Heerdegen <address@hidden>
+;; Maintainer: Michael Heerdegen <address@hidden>
+;; Created: 29 Jul 2015
+;; Keywords: lisp
+;; Compatibility: GNU Emacs 25
+;; Version: 0.1.3
+;; Package-Requires: ((emacs "25"))
+
+
+;; This file is not 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:
+
+;; Introduction
+;; ============
+;;
+;;
+;; The main user entry point is `el-search-pattern'. This command
+;; prompts for a `pcase' pattern and searches the current buffer for
+;; matching expressions by iteratively `read'ing buffer contents. For
+;; any match, point is put at the beginning of the expression found
+;; (unlike isearch which puts point at the end of matches).
+;;
+;; Why is it based on `pcase'? Because pattern matching (and the
+;; ability to combine destructuring and condition testing) is well
+;; suited for this task. In addition, pcase allows to add specialized
+;; pattern types and to combine them with other patterns in a natural
+;; and transparent way out of the box.
+;;
+;; It doesn't matter how the code is actually formatted. Comments are
+;; ignored, and strings are treated as atomic objects, their contents
+;; are not being searched.
+;;
+;;
+;; Example 1: if you enter
+;;
+;; 97
+;;
+;; at the prompt, this will find any occurrence of the number 97 in
+;; the code, but not 977 or (+ 90 7) or "My string containing 97".
+;; But it will find anything `eq' to 97 after reading, e.g. #x61 or
+;; ?a.
+;;
+;;
+;; Example 2: If you enter the pattern
+;;
+;; `(defvar ,_)
+;;
+;; you search for all defvar forms that don't specify an init value.
+;;
+;; The following will search for defvar forms with a docstring whose
+;; first line is longer than 70 characters:
+;;
+;; `(defvar ,_ ,_
+;; ,(and s (guard (< 70 (length (car (split-string s "\n")))))))
+;;
+;;
+;; When a search pattern is processed, the searched buffer is current
+;; with point at the beginning of the currently tested expression.
+;;
+;;
+;; Convenience
+;; ===========
+;;
+;; For pattern input, the minibuffer is put into `emacs-lisp-mode'.
+;;
+;; Any input PATTERN is silently transformed into (and exp PATTERN)
+;; so that you can always refer to the whole currently tested
+;; expression via the variable `exp'.
+;;
+;;
+;; Example 3:
+;;
+;; If you want to search a buffer for symbols that are defined in
+;; "cl-lib", you can use this pattern
+;;
+;; (guard (and (symbolp exp)
+;; (when-let ((file (symbol-file exp)))
+;; (string-match-p "cl-lib\\.elc?$" file))))
+;;
+;;
+;; ,----------------------------------------------------------------------
+;; | Q: "But I hate `pcase'! Can't we just do without?" |
+;; | |
+;; | A: Respect that you kept up until here! Just use (guard CODE), where|
+;; | CODE is any normal Elisp expression that returns non-nil when and |
+;; | only when you have a match. Use the variable `exp' to refer to |
+;; | the currently tested expression. Just like in the last example! |
+;; `----------------------------------------------------------------------
+;;
+;;
+;; It's cumbersome to write out the same complicated pattern
+;; constructs in the minibuffer again and again. You can define your
+;; own pcase pattern types for the purpose of el-search with
+;; `el-search-defpattern'. It is just like `pcase-defmacro', but the
+;; effect is limited to this package. See C-h f `el-search-pattern'
+;; for a list of predefined additional pattern forms.
+;;
+;;
+;; Replacing
+;; =========
+;;
+;; You can replace expressions with command `el-search-query-replace'.
+;; You are queried for a (pcase) pattern and a replacement expression.
+;; For each match of the pattern, the replacement expression is
+;; evaluated with the bindings created by the pcase matching in
+;; effect, and printed to produce the replacement string.
+;;
+;; Example: In some buffer you want to swap the two expressions at the
+;; places of the first two arguments in all calls of function `foo',
+;; so that e.g.
+;;
+;; (foo 'a (* 2 (+ 3 4)) t)
+;;
+;; becomes
+;;
+;; (foo (* 2 (+ 3 4)) 'a t).
+;;
+;; This will do it:
+;;
+;; M-x el-search-query-replace RET
+;; `(foo ,a ,b . ,rest) RET
+;; `(foo ,b ,a . ,rest) RET
+;;
+;; Type y to replace a match and go to the next one, r to replace
+;; without moving, SPC to go to the next match and ! to replace all
+;; remaining matches automatically. q quits. n is like SPC, so that
+;; y and n work like in isearch (meaning "yes" and "no") if you are
+;; used to that.
+;;
+;; It is possible to replace a match with multiple expressions using
+;; "splicing mode". When it is active, the replacement expression
+;; must evaluate to a list, and is spliced instead of inserted into
+;; the buffer for any replaced match. Use s to toggle splicing mode
+;; in a `el-search-query-replace' session.
+;;
+;;
+;; Suggested key bindings
+;; ======================
+;;
+;; (define-key emacs-lisp-mode-map [(control ?S)] #'el-search-pattern)
+;; (define-key emacs-lisp-mode-map [(control ?%)] #'el-search-query-replace)
+;;
+;; (define-key isearch-mode-map [(control ?S)]
#'el-search-search-from-isearch)
+;; (define-key isearch-mode-map [(control ?%)]
#'el-search-replace-from-isearch)
+;;
+;; The bindings in `isearch-mode-map' let you conveniently switch to
+;; elisp searching from isearch.
+;;
+;;
+;; Bugs, Known Limitations
+;; =======================
+;;
+;; - Replacing: in some cases the reader syntax of forms
+;; is changing due to reading+printing. "Some" because we can treat
+;; that problem in most cases.
+;;
+;; - Similarly: Comments are normally preserved (where it makes
+;; sense). But when replacing like `(foo ,a ,b) -> `(foo ,b ,a)
+;;
+;; in a content like
+;;
+;; (foo
+;; a
+;; ;;a comment
+;; b)
+;;
+;; the comment will be lost.
+;;
+;;
+;; Acknowledgments
+;; ===============
+;;
+;; Thanks to Stefan Monnier for corrections and advice.
+;;
+;;
+;; TODO:
+;;
+;; - When replacing like (progn A B C) -> A B C, the layout of the
+;; whole "group" A B C as a unit is lost. Instead of restoring layout
+;; as we do now (via "read mappings"), we could just make a backup of
+;; the original expression as a string, and use our search machinery
+;; to find occurrences in the replacement recursively.
+;;
+;; - detect infloops when replacing automatically (e.g. for 1 -> '(1))
+;;
+;; - implement backward searching
+;;
+;; - improve docstrings
+;;
+;; - handle more reader syntaxes, e.g. #n, #n#
+;;
+;; - Implement sessions; add multi-file support based on iterators. A
+;; file list is read in (or the user can specify an iterator as a
+;; variable). The state in the current buffer is just (buffer
+;; . marker). Or should this be abstracted into an own lib? Could
+;; be named "files-session" or so.
+
+
+
+;;; Code:
+
+;;;; Requirements
+
+(eval-when-compile
+ (require 'subr-x))
+
+(require 'cl-lib)
+(require 'elisp-mode)
+(require 'thingatpt)
+(require 'help-fns) ;el-search--make-docstring
+
+
+;;;; Configuration stuff
+
+(defgroup el-search nil
+ "Expression based search and replace for `emacs-lisp-mode'."
+ :group 'lisp)
+
+(defcustom el-search-this-expression-identifier 'exp
+ "Identifier referring to the current expression in pattern input.
+When entering a PATTERN in an interactive \"el-search\" command,
+the pattern actually used will be
+
+ `(and ,el-search-this-expression-identifier ,pattern)
+
+The default value is `exp'."
+ :type 'symbol)
+
+(defface el-search-match '((((background dark)) (:background "#0000A0"))
+ (t (:background "DarkSlateGray3")))
+ "Face for highlighting the current match.")
+
+(defface el-search-other-match '((((background dark)) (:background "#202060"))
+ (t (:background
"DarkSlateGray1")))
+ "Face for highlighting the other matches.")
+
+(defcustom el-search-smart-case-fold-search t
+ "Whether to use smart case folding in pattern matching.
+When an \"el-search\" pattern involves regexp matching (like for
+\"string\" or \"source\") and this option is non-nil,
+case-fold-search will be temporarily bound to t if the according
+regexp contains any upper case letter, and nil else. This is
+done independently for every single matching operation.
+
+If nil, the value of `case-fold-search' is decisive."
+ :type 'boolean)
+
+
+;;;; Helpers
+
+(defun el-search--smart-string-match-p (regexp string)
+ "`string-match-p' taking `el-search-smart-case-fold-search' into account."
+ (let ((case-fold-search (if el-search-smart-case-fold-search
+ (not (let ((case-fold-search nil))
+ (string-match-p "[[:upper:]]" regexp)))
+ case-fold-search)))
+ (string-match-p regexp string)))
+
+(defun el-search--print (expr)
+ (let ((print-quoted t)
+ (print-length nil)
+ (print-level nil))
+ (prin1-to-string expr)))
+
+(defvar el-search-read-expression-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map read-expression-map)
+ (define-key map [(control ?g)] #'abort-recursive-edit)
+ (define-key map [up] nil)
+ (define-key map [down] nil)
+ (define-key map [(control meta backspace)] #'backward-kill-sexp)
+ (define-key map [(control ?S)] #'exit-minibuffer)
+ map)
+ "Map for reading input with `el-search-read-expression'.")
+
+(defun el-search--setup-minibuffer ()
+ (emacs-lisp-mode)
+ (use-local-map el-search-read-expression-map)
+ (setq font-lock-mode t)
+ (funcall font-lock-function 1)
+ (backward-sexp)
+ (indent-sexp)
+ (goto-char (point-max))
+ (when-let ((this-sexp (with-current-buffer (window-buffer
(minibuffer-selected-window))
+ (thing-at-point 'sexp))))
+ (let ((more-defaults (list (concat "'" this-sexp))))
+ (setq-local minibuffer-default-add-function
+ (lambda () (if (listp minibuffer-default)
+ (append minibuffer-default more-defaults)
+ (cons minibuffer-default more-defaults)))))))
+
+;; $$$$$FIXME: this should be in Emacs! There is only a helper
`read--expression'.
+(defun el-search-read-expression (prompt &optional initial-contents hist
default read)
+ "Read expression for `my-eval-expression'."
+ (minibuffer-with-setup-hook #'el-search--setup-minibuffer
+ (read-from-minibuffer prompt initial-contents
el-search-read-expression-map read
+ (or hist 'read-expression-history) default)))
+
+(defvar el-search--initial-mb-contents nil)
+
+(defun el-search--read-pattern (prompt &optional default read)
+ (let ((input (el-search-read-expression
+ prompt el-search--initial-mb-contents 'el-search-history
default read)))
+ (if (or read (not (string= input ""))) input (car el-search-history))))
+
+(defun el-search--end-of-sexp ()
+ ;;Point must be at sexp beginning
+ (or (scan-sexps (point) 1) (point-max)))
+
+(defun el-search--ensure-sexp-start ()
+ "Move point to the next sexp beginning position.
+Don't move if already at beginning of a sexp. Point must not be
+inside a string or comment. `read' the expression at that point
+and return it."
+ (let ((not-done t) res)
+ (while not-done
+ (let ((stop-here nil)
+ (looking-at-from-back (lambda (regexp n)
+ (save-excursion
+ (backward-char n)
+ (looking-at regexp)))))
+ (while (not stop-here)
+ (cond
+ ((eobp) (signal 'end-of-buffer nil))
+ ((looking-at (rx (and (* space) ";"))) (forward-line))
+ ((looking-at (rx (+ (or space "\n")))) (goto-char (match-end 0)))
+
+ ;; FIXME: can the rest be done more generically?
+ ((and (looking-at (rx (or (syntax symbol) (syntax word))))
+ (not (looking-at "\\_<"))
+ (not (funcall looking-at-from-back ",@" 2)))
+ (forward-symbol 1))
+ ((or (and (looking-at "'") (funcall looking-at-from-back "#" 1))
+ (and (looking-at "@") (funcall looking-at-from-back "," 1)))
+ (forward-char))
+ (t (setq stop-here t)))))
+ (condition-case nil
+ (progn
+ (setq res (save-excursion (read (current-buffer))))
+ (setq not-done nil))
+ (error (forward-char))))
+ res))
+
+(defvar el-search--pcase-macros '()
+ "List of additional \"el-search\" pcase macros.")
+
+(defun el-search--make-docstring ()
+ ;; code mainly from `pcase--make-docstring'
+ (let* ((main (documentation (symbol-function 'el-search-pattern) 'raw))
+ (ud (help-split-fundoc main 'pcase)))
+ (with-temp-buffer
+ (insert (or (cdr ud) main))
+ (mapc
+ (pcase-lambda (`(,symbol . ,fun))
+ (when-let ((doc (documentation fun)))
+ (insert "\n\n\n-- ")
+ (setq doc (help-fns--signature symbol doc fun fun nil))
+ (insert "\n" (or doc "Not documented."))))
+ (reverse el-search--pcase-macros))
+ (let ((combined-doc (buffer-string)))
+ (if ud (help-add-fundoc-usage combined-doc (car ud)) combined-doc)))))
+
+(put 'el-search-pattern 'function-documentation '(el-search--make-docstring))
+
+(defmacro el-search-defpattern (name args &rest body)
+ "Like `pcase-defmacro', but limited to el-search patterns.
+The semantics is exactly that of `pcase-defmacro', but the scope
+of the definitions is limited to \"el-search\"."
+ (declare (indent 2) (debug defun))
+ `(setf (alist-get ',name el-search--pcase-macros)
+ (lambda ,args ,@body)))
+
+
+(defmacro el-search--with-additional-pcase-macros (&rest body)
+ `(cl-letf ,(mapcar (pcase-lambda (`(,symbol . ,fun))
+ `((get ',symbol 'pcase-macroexpander) #',fun))
+ el-search--pcase-macros)
+ ,@body))
+
+(defun el-search--matcher (pattern &rest body)
+ (eval ;use `eval' to allow for user defined pattern types at run time
+ (let ((expression (make-symbol "expression")))
+ `(el-search--with-additional-pcase-macros
+ (let ((byte-compile-debug t) ;make undefined pattern types raise an
error
+ (warning-suppress-log-types '((bytecomp)))
+ (pcase--dontwarn-upats (cons '_ pcase--dontwarn-upats)))
+ (byte-compile (lambda (,expression)
+ (pcase ,expression
+ (,pattern ,@(or body (list t)))
+ (_ nil)))))))))
+
+(defun el-search--match-p (matcher expression)
+ (funcall matcher expression))
+
+(defun el-search--wrap-pattern (pattern)
+ `(and ,el-search-this-expression-identifier ,pattern))
+
+(defun el-search--skip-expression (expression &optional read)
+ ;; Move forward at least one character. Don't move into a string or
+ ;; comment. Don't move further than the beginning of the next sexp.
+ ;; Try to move as far as possible. Point must be at the beginning
+ ;; of an expression.
+ ;; If there are positions where `read' would succeed, but that do
+ ;; not represent a valid sexp start, move past them (e.g. when
+ ;; before "#'" move past both characters).
+ ;;
+ ;; EXPRESSION must be the (read) expression at point, but when READ
+ ;; is non-nil, ignore the first argument and read the expression at
+ ;; point instead.
+ (when read (setq expression (save-excursion (read (current-buffer)))))
+ (cond
+ ((or (null expression)
+ (equal [] expression)
+ (not (or (listp expression) (vectorp expression))))
+ (goto-char (el-search--end-of-sexp)))
+ ((looking-at (rx (or ",@" "," "#'" "'")))
+ (goto-char (match-end 0)))
+ (t (forward-char))))
+
+(defun el-search--search-pattern-1 (matcher &optional noerror)
+ (let ((match-beg nil) (opoint (point)) current-expr)
+
+ ;; when inside a string or comment, move past it
+ (let ((syntax-here (syntax-ppss)))
+ (when (nth 3 syntax-here) ;inside a string
+ (goto-char (nth 8 syntax-here))
+ (forward-sexp))
+ (when (nth 4 syntax-here) ;inside a comment
+ (forward-line 1)
+ (while (and (not (eobp)) (looking-at (rx (and (* space) ";"))))
+ (forward-line 1))))
+
+ (if (catch 'no-match
+ (while (not match-beg)
+ (condition-case nil
+ (setq current-expr (el-search--ensure-sexp-start))
+ (end-of-buffer
+ (goto-char opoint)
+ (throw 'no-match t)))
+ (if (el-search--match-p matcher current-expr)
+ (setq match-beg (point)
+ opoint (point))
+ (el-search--skip-expression current-expr))))
+ (if noerror nil (signal 'end-of-buffer nil)))
+ match-beg))
+
+(defun el-search--search-pattern (pattern &optional noerror)
+ "Search elisp buffer with `pcase' PATTERN.
+Set point to the beginning of the occurrence found and return
+point. Optional second argument, if non-nil, means if fail just
+return nil (no error)."
+ (el-search--search-pattern-1 (el-search--matcher pattern) noerror))
+
+(defun el-search--do-subsexps (pos do-fun &optional ret-fun bound)
+ ;; In current buffer, for any expression start between POS and BOUND
+ ;; or (point-max), in order, call two argument function DO-FUN with
+ ;; the current sexp string and the ending position of the current
+ ;; sexp. When done, with RET-FUN given, call it with no args and
+ ;; return the result; else, return nil.
+ (save-excursion
+ (goto-char pos)
+ (condition-case nil
+ (while (< (point) (or bound (point-max)))
+ (let* ((this-sexp-end (save-excursion (thing-at-point--end-of-sexp)
(point)))
+ (this-sexp-string (buffer-substring-no-properties (point)
this-sexp-end)))
+ (funcall do-fun this-sexp-string this-sexp-end)
+ (el-search--skip-expression (read this-sexp-string))
+ (el-search--ensure-sexp-start)))
+ (end-of-buffer))
+ (when ret-fun (funcall ret-fun))))
+
+(defun el-search--create-read-map (&optional pos)
+ (let ((mapping '()))
+ (el-search--do-subsexps
+ (or pos (point))
+ (lambda (sexp _) (push (cons (read sexp) sexp) mapping))
+ (lambda () (nreverse mapping))
+ (save-excursion (thing-at-point--end-of-sexp) (point)))))
+
+(defun el-search--repair-replacement-layout (printed mapping)
+ (with-temp-buffer
+ (insert printed)
+ (el-search--do-subsexps
+ (point-min)
+ (lambda (sexp sexp-end)
+ (when-let ((old (cdr (assoc (read sexp) mapping))))
+ (delete-region (point) sexp-end)
+ (when (string-match-p "\n" old)
+ (unless (looking-back "^[[:space:]]*" (line-beginning-position))
+ (insert "\n"))
+ (unless (looking-at "[[:space:]\)]*$")
+ (insert "\n")
+ (backward-char)))
+ (save-excursion (insert old))))
+ (lambda () (buffer-substring (point-min) (point-max))))))
+
+(defun el-search--check-pattern-args (type args predicate &optional message)
+ "Check whether all ARGS fulfill PREDICATE.
+Raise an error if not. TYPE and optional argument MESSAGE are
+used to construct the error message."
+ (mapc (lambda (arg)
+ (unless (funcall predicate arg)
+ (error (concat "Pattern `%S': "
+ (or message (format "argument doesn't fulfill %S"
predicate))
+ ": %S")
+ type arg)))
+ args))
+
+
+;;;; Additional pattern type definitions
+
+(defun el-search--split (matcher1 matcher2 list)
+ "Helper for the append pattern type.
+
+When a splitting of LIST into two lists L1, L2 exist so that Li
+is matched by MATCHERi, return (L1 L2) for such Li, else return
+nil."
+ (let ((try-match (lambda (list1 list2)
+ (when (and (el-search--match-p matcher1 list1)
+ (el-search--match-p matcher2 list2))
+ (list list1 list2))))
+ (list1 list) (list2 '()) (match nil))
+ ;; don't use recursion, this could hit `max-lisp-eval-depth'
+ (while (and (not (setq match (funcall try-match list1 list2)))
+ (consp list1))
+ (let ((last-list1 (last list1)))
+ (if-let ((cdr-last-list1 (cdr last-list1)))
+ ;; list1 is a dotted list. Then list2 must be empty.
+ (progn (setcdr last-list1 nil)
+ (setq list2 cdr-last-list1))
+ (setq list1 (butlast list1 1)
+ list2 (cons (car last-list1) list2)))))
+ match))
+
+(el-search-defpattern append (&rest patterns)
+ "Matches any list factorable into lists matched by PATTERNS in order.
+
+PATTERNS is a list of patterns P1..Pn. Match any list L for that
+lists L1..Ln exist that are matched by P1..Pn in order and L is
+equal to the concatenation of L1..Ln. Ln is allowed to be no
+list.
+
+When different ways of matching are possible, it is unspecified
+which one is chosen.
+
+Example: the pattern
+
+ (append '(1 2 3) x (app car-safe 7))
+
+matches the list (1 2 3 4 5 6 7 8 9) and binds `x' to (4 5 6)."
+ (if (null patterns)
+ '(pred null)
+ (pcase-let ((`(,pattern . ,more-patterns) patterns))
+ (cond
+ ((null more-patterns) pattern)
+ ((null (cdr more-patterns))
+ `(and (pred listp)
+ (app ,(apply-partially #'el-search--split
+ (el-search--matcher pattern)
+ (el-search--matcher (car more-patterns)))
+ (,'\` ((,'\, ,pattern)
+ (,'\, ,(car more-patterns)))))))
+ (t `(append ,pattern (append ,@more-patterns)))))))
+
+(el-search-defpattern string (&rest regexps)
+ "Matches any string that is matched by all REGEXPS."
+ (el-search--check-pattern-args 'string regexps #'stringp)
+ (let ((string (make-symbol "string"))
+ (regexp (make-symbol "regexp")))
+ `(and (pred stringp)
+ (pred (lambda (,string)
+ (cl-every
+ (lambda (,regexp) (el-search--smart-string-match-p ,regexp
,string))
+ (list ,@regexps)))))))
+
+(el-search-defpattern symbol (&rest regexps)
+ "Matches any symbol whose name is matched by all REGEXPS."
+ (el-search--check-pattern-args 'symbol regexps #'stringp)
+ `(and (pred symbolp)
+ (app symbol-name (string ,@regexps))))
+
+(defun el-search--contains-p (matcher exp)
+ "Return non-nil when tree EXP contains a match for MATCHER.
+Recurse on all types of sequences. In the positive case the
+return value is (t elt), where ELT is a matching element found in
+EXP."
+ (if (el-search--match-p matcher exp)
+ (list t exp)
+ (and (sequencep exp)
+ (let ((try-match (apply-partially #'el-search--contains-p matcher)))
+ (if (consp exp)
+ (or (funcall try-match (car exp))
+ (funcall try-match (cdr exp)))
+ (cl-some try-match exp))))))
+
+(el-search-defpattern contains (&rest patterns)
+ "Matches trees that contain a match for all PATTERNs.
+Searches any tree of sequences recursively for matches. Objects
+of any kind matched by all PATTERNs are also matched.
+
+ Example: (contains (string \"H\") 17) matches ((\"Hallo\") x (5 [1 17]))"
+ (cond
+ ((null patterns) '_)
+ ((null (cdr patterns))
+ (let ((pattern (car patterns)))
+ `(app ,(apply-partially #'el-search--contains-p (el-search--matcher
pattern))
+ (,'\` (t (,'\, ,pattern))))))
+ (t `(and ,@(mapcar (lambda (pattern) `(contains ,pattern)) patterns)))))
+
+(el-search-defpattern not (pattern)
+ "Matches any object that is not matched by PATTERN."
+ `(app ,(apply-partially #'el-search--match-p (el-search--matcher pattern))
+ (pred not)))
+
+(defun el-search--match-symbol-file (regexp symbol)
+ (when-let ((symbol-file (and (symbolp symbol)
+ (symbol-file symbol))))
+ (el-search--smart-string-match-p
+ (if (symbolp regexp) (concat "\\`" (symbol-name regexp) "\\'") regexp)
+ (file-name-sans-extension (file-name-nondirectory symbol-file)))))
+
+(el-search-defpattern source (regexp)
+ "Matches any symbol whose `symbol-file' is matched by REGEXP.
+
+This pattern matches when the object is a symbol for that
+`symbol-file' returns a (non-nil) FILE-NAME that fulfills
+ (string-match-p REGEXP (file-name-sans-extension
+ (file-name-nondirectory FILENAME)))
+
+REGEXP can also be a symbol, in which case
+
+ (concat \"^\" (symbol-name regexp) \"$\")
+
+is used as regular expression."
+ (el-search--check-pattern-args 'source (list regexp) #'stringp)
+ `(pred (el-search--match-symbol-file ,regexp)))
+
+(defun el-search--match-key-sequence (keys expr)
+ (when-let ((expr-keys (pcase expr
+ ((or (pred stringp) (pred vectorp)) expr)
+ (`(kbd ,(and (pred stringp) string)) (ignore-errors
(kbd string))))))
+ (apply #'equal
+ (mapcar (lambda (keys) (ignore-errors (key-description keys)))
+ (list keys expr-keys)))))
+
+(el-search-defpattern keys (key-sequence)
+ "Matches descriptions of the KEY-SEQUENCE.
+KEY-SEQUENCE is a string or vector representing a key sequence,
+or an expression of the form (kbd STRING).
+
+Match any description of the same key sequence in any of these
+formats.
+
+Example: the pattern
+
+ (keys (kbd \"C-s\"))
+
+matches any of these expressions:
+
+ \"\\C-s\"
+ \"\C-s\"
+ (kbd \"C-s\")
+ [(control ?s)]"
+ (when (eq (car-safe key-sequence) 'kbd)
+ (setq key-sequence (kbd (cadr key-sequence))))
+ (el-search--check-pattern-args 'keys (list key-sequence) (lambda (x) (or
(stringp x) (vectorp x)))
+ "argument not a string or vector")
+ `(pred (el-search--match-key-sequence ,key-sequence)))
+
+(defun el-search--s (expr)
+ (cond
+ ((symbolp expr) `(or (symbol ,(symbol-name expr))
+ (,'\` (,'quote (,'\, (symbol ,(symbol-name expr)))))
+ (,'\` (,'function (,'\, (symbol ,(symbol-name
expr)))))))
+ ((stringp expr) `(string ,expr))
+ (t expr)))
+
+(el-search-defpattern l (&rest lpats)
+ "Alternative pattern type for matching lists.
+Match any list with subsequent elements matched by all LPATS in
+order.
+
+The idea is to be able to search for pieces of code (i.e. lists)
+with very brief input by using a specialized syntax.
+
+An LPAT can take the following forms:
+
+SYMBOL Matches any symbol S matched by SYMBOL's name interpreted
+ as a regexp. Matches also 'S and #'S for any such S.
+STRING Matches any string matched by STRING interpreted as a
+ regexp
+_ Matches any list element
+__ Matches any number of list elements (including zero)
+^ Matches zero elements, but only at the beginning of a list
+$ Matches zero elements, but only at the end of a list
+PAT Anything else is interpreted as a normal pcase pattern, and
+ matches one list element matched by it
+
+^ is only valid as the first, $ as the last of the LPATS.
+
+Example: To match defuns that contain \"hl\" in their name and
+have at least one mandatory, but also optional arguments, you
+could use this pattern:
+
+ (l ^ 'defun hl (l _ &optional))"
+ (let ((match-start nil) (match-end nil))
+ (when (eq (car-safe lpats) '^)
+ (setq match-start t)
+ (cl-callf cdr lpats))
+ (when (eq (car-safe (last lpats)) '$)
+ (setq match-end t)
+ (cl-callf butlast lpats 1))
+ `(append ,@(if match-start '() '(_))
+ ,@(mapcar
+ (lambda (elt)
+ (pcase elt
+ ('__ '_)
+ ('_ '`(,_))
+ ('_? '(or '() `(,_))) ;FIXME: useful - document? or should
we provide a (? PAT)
+ ;thing?
+ (_ `(,'\` ((,'\, ,(el-search--s elt)))))))
+ lpats)
+ ,@(if match-end '() '(_)))))
+
+
+;;;; Highlighting
+
+(defvar-local el-search-hl-overlay nil)
+
+(defvar-local el-search-hl-other-overlays '())
+
+(defvar el-search-keep-hl nil)
+
+(defun el-search-hl-sexp (&optional bounds)
+ (let ((bounds (or bounds
+ (list (point) (el-search--end-of-sexp)))))
+ (if (overlayp el-search-hl-overlay)
+ (apply #'move-overlay el-search-hl-overlay bounds)
+ (overlay-put (setq el-search-hl-overlay (apply #'make-overlay bounds))
+ 'face 'el-search-match))
+ (overlay-put el-search-hl-overlay 'priority 1002))
+ (add-hook 'post-command-hook #'el-search-hl-post-command-fun t t))
+
+(defun el-search--hl-other-matches-1 (pattern from to)
+ (mapc #'delete-overlay el-search-hl-other-overlays)
+ (setq el-search-hl-other-overlays '())
+ (let ((matcher (el-search--matcher pattern))
+ this-match-beg this-match-end
+ (done nil))
+ (save-excursion
+ (goto-char from)
+ (while (not done)
+ (setq this-match-beg (el-search--search-pattern-1 matcher t))
+ (if (not this-match-beg)
+ (setq done t)
+ (goto-char this-match-beg)
+ (setq this-match-end (el-search--end-of-sexp))
+ (let ((ov (make-overlay this-match-beg this-match-end)))
+ (overlay-put ov 'face 'el-search-other-match)
+ (overlay-put ov 'priority 1001)
+ (push ov el-search-hl-other-overlays)
+ (goto-char this-match-end)
+ (when (>= (point) to) (setq done t))))))))
+
+(defun el-search-hl-other-matches (pattern)
+ "Highlight all matches visible in the selected window."
+ (el-search--hl-other-matches-1 pattern
+ (save-excursion
+ (goto-char (window-start))
+ (beginning-of-defun-raw)
+ (point))
+ (window-end))
+ (add-hook 'window-scroll-functions #'el-search--after-scroll t t))
+
+(defun el-search--after-scroll (_win start)
+ (el-search--hl-other-matches-1 el-search-current-pattern
+ (save-excursion
+ (goto-char start)
+ (beginning-of-defun-raw)
+ (point))
+ (window-end nil t)))
+
+(defun el-search-hl-remove ()
+ (when (overlayp el-search-hl-overlay)
+ (delete-overlay el-search-hl-overlay))
+ (remove-hook 'window-scroll-functions #'el-search--after-scroll t)
+ (mapc #'delete-overlay el-search-hl-other-overlays)
+ (setq el-search-hl-other-overlays '()))
+
+(defun el-search-hl-post-command-fun ()
+ (unless (or el-search-keep-hl
+ (eq this-command 'el-search-query-replace)
+ (eq this-command 'el-search-pattern))
+ (el-search-hl-remove)
+ (remove-hook 'post-command-hook 'el-search-hl-post-command-fun t)))
+
+
+;;;; Core functions
+
+(defvar el-search-history '()
+ "List of input strings.")
+
+(defvar el-search-success nil)
+(defvar el-search-current-pattern nil)
+
+;;;###autoload
+(defun el-search-pattern (pattern)
+ "Start new or resume last elisp search.
+
+Search current buffer for expressions that are matched by `pcase'
+PATTERN. Use `read' to transform buffer contents into
+expressions.
+
+
+Additional `pcase' pattern types to be used with this command can
+be defined with `el-search-defpattern'.
+
+The following additional pattern types are currently defined:"
+ (interactive (list (if (and (eq this-command last-command)
+ el-search-success)
+ el-search-current-pattern
+ (let ((pattern
+ (el-search--read-pattern "Find pcase pattern: "
+ (car el-search-history)
+ t)))
+ ;; A very common mistake: input "foo" instead of
"'foo"
+ (when (and (symbolp pattern)
+ (not (eq pattern '_))
+ (or (not (boundp pattern))
+ (not (eq (symbol-value pattern)
pattern))))
+ (error "Please don't forget the quote when
searching for a symbol"))
+ (el-search--wrap-pattern pattern)))))
+ (if (not (called-interactively-p 'any))
+ (el-search--search-pattern pattern)
+ (setq this-command 'el-search-pattern) ;in case we come from isearch
+ (setq el-search-current-pattern pattern)
+ (let ((opoint (point)))
+ (when (and (eq this-command last-command) el-search-success)
+ (el-search--skip-expression nil t))
+ (setq el-search-success nil)
+ (when (condition-case nil
+ (el-search--search-pattern pattern)
+ (end-of-buffer (message "No match")
+ (goto-char opoint)
+ (el-search-hl-remove)
+ (ding)
+ nil))
+ (setq el-search-success t)
+ (el-search-hl-sexp)
+ (unless (eq this-command last-command)
+ (el-search-hl-other-matches pattern))))))
+
+(defvar el-search-search-and-replace-help-string
+ "\
+y Replace this match and move to the next.
+SPC or n Skip this match and move to the next.
+r Replace this match but don't move.
+! Replace all remaining matches automatically.
+q Quit. To resume, use e.g. `repeat-complex-command'.
+? Show this help.
+s Toggle splicing mode. When splicing mode is
+ on (default off), the replacement expression must
+ evaluate to a list, and the result is spliced into the
+ buffer, instead of just inserted.
+
+Hit any key to proceed."
+ "Help string for ? in `el-search-query-replace'.")
+
+(defun el-search-search-and-replace-pattern (pattern replacement &optional
mapping splice)
+ (let ((replace-all nil) (nbr-replaced 0) (nbr-skipped 0) (done nil)
+ (el-search-keep-hl t) (opoint (point))
+ (get-replacement (el-search--matcher pattern replacement)))
+ (unwind-protect
+ (while (and (not done) (el-search--search-pattern pattern t))
+ (setq opoint (point))
+ (unless replace-all
+ (el-search-hl-sexp)
+ (unless (eq this-command last-command)
+ (el-search-hl-other-matches pattern)))
+ (let* ((read-mapping (el-search--create-read-map))
+ (region (list (point) (el-search--end-of-sexp)))
+ (substring (apply #'buffer-substring-no-properties region))
+ (expr (read substring))
+ (replaced-this nil)
+ (new-expr (funcall get-replacement expr))
+ (get-replacement-string
+ (lambda () (if (and splice (not (listp new-expr)))
+ (error "Expression to splice in is an atom")
+ (el-search--repair-replacement-layout
+ (if splice
+ (mapconcat #'el-search--print new-expr " ")
+ (el-search--print new-expr))
+ (append mapping read-mapping)))))
+ (to-insert (funcall get-replacement-string))
+ (do-replace (lambda ()
+ (atomic-change-group
+ (apply #'delete-region region)
+ (let ((inhibit-message t)
+ (opoint (point)))
+ (insert to-insert)
+ (indent-region opoint (point))
+ (el-search-hl-sexp (list opoint (point)))
+ (goto-char opoint)))
+ (cl-incf nbr-replaced)
+ (setq replaced-this t))))
+ (if replace-all
+ (funcall do-replace)
+ (while (not (pcase (if replaced-this
+ (read-char-choice "[SPC ! q] (? for
help)"
+ '(?\ ?! ?q ?n ??))
+ (read-char-choice
+ (concat "Replace this occurrence"
+ (if (or (string-match-p "\n"
to-insert)
+ (< 40 (length to-insert)))
+ "" (format " with `%s'"
to-insert))
+ "? "
+ (if splice "{splice} " "")
+ "[y SPC r ! s q] (? for help)" )
+ '(?y ?n ?r ?\ ?! ?q ?s ??)))
+ (?r (funcall do-replace)
+ nil)
+ (?y (funcall do-replace)
+ t)
+ ((or ?\ ?n)
+ (unless replaced-this (cl-incf nbr-skipped))
+ t)
+ (?! (unless replaced-this
+ (funcall do-replace))
+ (setq replace-all t)
+ t)
+ (?s (cl-callf not splice)
+ (setq to-insert (funcall
get-replacement-string))
+ nil)
+ (?q (setq done t)
+ t)
+ (?? (ignore (read-char
el-search-search-and-replace-help-string))
+ nil)))))
+ (unless (or done (eobp)) (el-search--skip-expression nil t)))))
+ (el-search-hl-remove)
+ (goto-char opoint)
+ (message "Replaced %d matches%s"
+ nbr-replaced
+ (if (zerop nbr-skipped) ""
+ (format " (%d skipped)" nbr-skipped)))))
+
+(defun el-search-query-replace-read-args ()
+ (barf-if-buffer-read-only)
+ (let* ((from (el-search--read-pattern "Replace from: "))
+ (to (let ((el-search--initial-mb-contents nil))
+ (el-search--read-pattern "Replace with result of evaluation
of: " from))))
+ (list (el-search--wrap-pattern (read from)) (read to)
+ (with-temp-buffer
+ (insert to)
+ (el-search--create-read-map 1)))))
+
+;;;###autoload
+(defun el-search-query-replace (from to &optional mapping)
+ "Replace some occurrences of FROM pattern with evaluated TO."
+ (interactive (el-search-query-replace-read-args))
+ (setq this-command 'el-search-query-replace) ;in case we come from isearch
+ (setq el-search-current-pattern from)
+ (barf-if-buffer-read-only)
+ (el-search-search-and-replace-pattern from to mapping))
+
+(defun el-search--take-over-from-isearch (&optional goto-left-end)
+ (let ((other-end (and goto-left-end isearch-other-end))
+ (input isearch-string))
+ (isearch-exit)
+ (when (and other-end (< other-end (point)))
+ (goto-char other-end))
+ input))
+
+;;;###autoload
+(defun el-search-search-from-isearch ()
+ ;; FIXME: an interesting alternative would be to really integrate it
+ ;; with Isearch, using `isearch-search-fun-function'.
+ ;; Alas, this is not trivial if we want to transfer our optimizations.
+ (interactive)
+ (let ((el-search--initial-mb-contents (concat "'"
(el-search--take-over-from-isearch))))
+ ;; use `call-interactively' so we get recorded in
`extended-command-history'
+ (call-interactively #'el-search-pattern)))
+
+;;;###autoload
+(defun el-search-replace-from-isearch ()
+ (interactive)
+ (let ((el-search--initial-mb-contents (concat "'"
(el-search--take-over-from-isearch t))))
+ (call-interactively #'el-search-query-replace)))
+
+
+
+(provide 'el-search)
+;;; el-search.el ends here
diff --git a/packages/excorporate/README b/packages/excorporate/README
new file mode 100644
index 0000000..7389a88
--- /dev/null
+++ b/packages/excorporate/README
@@ -0,0 +1,20 @@
+Excorporate provides Exchange integration for Emacs.
+
+To create a connection to a web service:
+
+M-x excorporate
+
+Excorporate will prompt for an email address that it will use to
+automatically discover settings. Then it will prompt you for your
+credentials two or three times depending on the server configuration.
+
+You should see a message indicating that the connection is ready
+either in the minibuffer or in the *Messages* buffer.
+
+Finally, run M-x calendar, and press 'e' to show today's meetings.
+
+If autodiscovery fails, customize `excorporate-configuration' to skip
+autodiscovery.
+
+For further information including connection troubleshooting, see the
+Excorporate Info node at C-h i d m Excorporate.
diff --git a/packages/excorporate/dir b/packages/excorporate/dir
new file mode 100644
index 0000000..c0433c3
--- /dev/null
+++ b/packages/excorporate/dir
@@ -0,0 +1,18 @@
+This is the file .../info/dir, which contains the
+topmost node of the Info hierarchy, called (dir)Top.
+The first time you invoke Info you start off looking at this node.
+
+File: dir, Node: Top This is the top of the INFO tree
+
+ This (the Directory node) gives a menu of major topics.
+ Typing "q" exits, "?" lists all Info commands, "d" returns here,
+ "h" gives a primer for first-timers,
+ "mEmacs<Return>" visits the Emacs manual, etc.
+
+ In Emacs, you can click mouse button 2 on a menu item or cross reference
+ to select it.
+
+* Menu:
+
+Emacs
+* Excorporate: (excorporate). Exchange Web Services integration for Emacs.
diff --git a/packages/excorporate/excorporate-calendar.el
b/packages/excorporate/excorporate-calendar.el
new file mode 100644
index 0000000..506ac72
--- /dev/null
+++ b/packages/excorporate/excorporate-calendar.el
@@ -0,0 +1,46 @@
+;;; excorporate-calendar.el --- Exchange for calendar -*- lexical-binding: t
-*-
+
+;; Copyright (C) 2014-2016 Free Software Foundation, Inc.
+
+;; Author: Thomas Fitzsimmons <address@hidden>
+;; Keywords: calendar
+
+;; 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:
+
+;; Add a calendar keybinding for Excorporate. Default to the
+;; excorporate-org interface.
+
+;;; Code:
+
+(require 'calendar)
+
+(defcustom excorporate-calendar-show-day-function 'exco-org-show-day
+ "A function to be called by pressing `e' in Calendar."
+ :type 'function
+ :group 'excorporate)
+
+(defun exco-calendar-show-day ()
+ "Show meetings for the selected date."
+ (interactive)
+ (apply excorporate-calendar-show-day-function (calendar-cursor-to-date t)))
+
+;; I arrogantly claim "e" for now, but irresponsibly reserve the right
+;; to change it later.
+(define-key calendar-mode-map "e" #'exco-calendar-show-day)
+
+(provide 'excorporate-calendar)
+
+;;; excorporate-calendar.el ends here
diff --git a/packages/excorporate/excorporate-calfw.el.txt
b/packages/excorporate/excorporate-calfw.el.txt
new file mode 100644
index 0000000..ad31ae9
--- /dev/null
+++ b/packages/excorporate/excorporate-calfw.el.txt
@@ -0,0 +1,128 @@
+;;; excorporate-calfw.el --- Exchange calendar view -*- lexical-binding: t
-*-
+
+;; Copyright (C) 2014-2016 Free Software Foundation, Inc.
+
+;; Author: Thomas Fitzsimmons <address@hidden>
+;; Keywords: calendar
+
+;; 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:
+
+;; Use the Calfw calendar framework to display daily meetings.
+
+;; To use this handler, set excorporate-calendar-show-day to
+;; exco-calfw-show-day using `customize-variable'.
+
+;; This Excorporate handler requires the Calfw package, which is not
+;; included in GNU ELPA because not all Calfw contributors have
+;; copyright assignment papers on file with the FSF.
+
+;;; Code:
+
+(require 'calfw)
+(require 'excorporate)
+
+(defvar excorporate-calfw-buffer-name "*Excorporate*"
+ "The buffer into which Calfw output is inserted.")
+
+(defun exco-calfw-initialize-buffer (month day year)
+ "Set up an initial blank Calfw buffer for date MONTH DAY YEAR."
+ (with-current-buffer (get-buffer-create excorporate-calfw-buffer-name)
+ (display-buffer (current-buffer))
+ (let ((status-source (make-cfw:source :name "Updating..."
+ :data (lambda (_b _e) nil))))
+ (cfw:create-calendar-component-buffer
+ :date (cfw:date month day year) :view 'day
+ :contents-sources (list status-source)
+ :buffer (current-buffer)))))
+
+(defun exco-calfw-add-meeting (subject start end location
+ main-invitees optional-invitees)
+ "Add a scheduled meeting to the event list.
+SUBJECT is a string, the subject of the meeting. START is the
+meeting start time in Emacs internal date time format, and END is
+the end of the meeting in the same format. LOCATION is a string
+representing the location. MAIN-INVITEES and OPTIONAL-INVITEES
+are the requested participants."
+ (let ((start-list (decode-time start))
+ (end-list (decode-time end)))
+ (make-cfw:event :title (concat
+ (format "\n\t%s" subject)
+ (format "\n\tLocation: %s" location)
+ (format "\n\tInvitees: %s"
+ (mapconcat 'identity
+ main-invitees
+ "; "))
+ (when optional-invitees
+ (format "\n\tOptional: %s"
+ (mapconcat 'identity
+ optional-invitees "; "))))
+ :start-date (list (elt start-list 4)
+ (elt start-list 3)
+ (elt start-list 5))
+ :start-time (list (elt start-list 2)
+ (elt start-list 1))
+ :end-date (list (elt end-list 4)
+ (elt end-list 3)
+ (elt end-list 5))
+ :end-time (list (elt end-list 2)
+ (elt end-list 1)))))
+
+(defun exco-calfw-add-meetings (identifier response)
+ "Add the connection IDENTIFIER's meetings from RESPONSE."
+ (let ((event-list (exco-calendar-item-iterate response
+ #'exco-calfw-add-meeting)))
+ (with-current-buffer (get-buffer-create excorporate-calfw-buffer-name)
+ (declare (special cfw:component))
+ (let* ((new-source (make-cfw:source
+ :name (format "%S (as of %s)"
+ identifier
+ (format-time-string "%F %H:%M"))
+ :data (lambda (_b _e)
+ event-list)))
+ (sources (cfw:cp-get-contents-sources cfw:component))
+ (new-sources (append sources (list new-source))))
+ (cfw:cp-set-contents-sources cfw:component new-sources)))))
+
+(defun exco-calfw-finalize-buffer ()
+ "Finalize the Calfw widget after retrievals have completed."
+ (with-current-buffer (get-buffer-create excorporate-calfw-buffer-name)
+ (declare (special cfw:component))
+ (let ((sources (cfw:cp-get-contents-sources cfw:component))
+ (status-source (make-cfw:source :name "Done."
+ :data (lambda (_b _e) nil))))
+ (cfw:cp-set-contents-sources cfw:component
+ (cons status-source (cdr sources))))
+ (cfw:cp-add-selection-change-hook cfw:component
+ (lambda ()
+ (apply #'exco-calfw-show-day
+ (cfw:cursor-to-nearest-date))))
+ (cfw:refresh-calendar-buffer nil)))
+
+;;;###autoload
+(defun exco-calfw-show-day (month day year)
+ "Show meetings for the date specified by MONTH DAY YEAR."
+ (exco-connection-iterate
+ (lambda ()
+ (exco-calfw-initialize-buffer month day year))
+ (lambda (identifier callback)
+ (exco-get-meetings-for-day identifier month day year
+ callback))
+ #'exco-calfw-add-meetings
+ #'exco-calfw-finalize-buffer))
+
+(provide 'excorporate-calfw)
+
+;;; excorporate-calfw.el ends here
diff --git a/packages/excorporate/excorporate-org.el
b/packages/excorporate/excorporate-org.el
new file mode 100644
index 0000000..8613f8e
--- /dev/null
+++ b/packages/excorporate/excorporate-org.el
@@ -0,0 +1,141 @@
+;;; excorporate-org.el --- Exchange Org Mode view -*- lexical-binding: t
-*-
+
+;; Copyright (C) 2016 Free Software Foundation, Inc.
+
+;; Author: Thomas Fitzsimmons <address@hidden>
+;; Keywords: calendar
+
+;; 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:
+
+;; Use the Org Mode to display daily meetings.
+
+;;; Code:
+
+(require 'org)
+(require 'excorporate)
+
+(defvar excorporate-org-buffer-name "*Excorporate*"
+ "The buffer into which Org Mode output is inserted.")
+
+(defun exco-org-initialize-buffer ()
+ "Add initial text to the destination buffer."
+ (with-current-buffer (get-buffer-create excorporate-org-buffer-name)
+ (setq buffer-read-only t)
+ (org-mode)
+ (display-buffer (current-buffer))
+ (let ((inhibit-read-only t))
+ (delete-region (point-min) (point-max))
+ (goto-char 1)
+ (insert "# Updated...\n"))))
+
+(defun exco-org-format-headline (identifier)
+ "Format an Org headline using IDENTIFIER."
+ (format "* Calendar (%s)\n" identifier))
+
+(defun exco-org-insert-meeting-headline (subject start-time end-time)
+ "Insert and schedule a meeting.
+SUBJECT is the meeting's subject, START-TIME and END-TIME are the
+meeting's start and end times in the same format as is returned
+by `current-time'."
+ (let* ((now (current-time))
+ (keyword (if (time-less-p now end-time)
+ "TODO"
+ "DONE")))
+ (insert (format "** %s %s\n" keyword subject))
+ (org-schedule nil (format-time-string "<%Y-%m-%d %a %H:%M>"
+ start-time))
+ (forward-line -1)
+ (end-of-line)
+ (insert "--" (format-time-string "<%Y-%m-%d %a %H:%M>" end-time))
+ (forward-line)
+ (org-insert-time-stamp (current-time) t t "+ Retrieved " "\n")))
+
+(defun exco-org-insert-invitees (invitees)
+ "Parse and insert a list of invitees, INVITEES."
+ (dolist (invitee invitees)
+ (insert (format " + %s\n" invitee))))
+
+(defun exco-org-insert-headline (identifier month day year)
+ "Insert Org headline for IDENTIFIER on date MONTH DAY YEAR."
+ (with-current-buffer (get-buffer-create excorporate-org-buffer-name)
+ (let ((inhibit-read-only t))
+ (insert (exco-org-format-headline identifier))
+ (org-insert-time-stamp (encode-time 0 0 0 day month year)
+ nil t " + Date " "\n"))))
+
+(defun exco-org-insert-meeting (subject start end location
+ main-invitees optional-invitees)
+ "Insert a scheduled meeting.
+SUBJECT is a string, the subject of the meeting. START is the
+meeting start time in Emacs internal date time format, and END is
+the end of the meeting in the same format. LOCATION is a string
+representing the location. MAIN-INVITEES and OPTIONAL-INVITEES
+are the requested participants."
+ (exco-org-insert-meeting-headline subject start end)
+ (insert (format "+ Duration: %d minutes\n"
+ (round (/ (float-time (time-subtract end start)) 60.0))))
+ (insert (format "+ Location: %s\n" location))
+ (insert "+ Invitees:\n")
+ (exco-org-insert-invitees main-invitees)
+ (when optional-invitees
+ (insert "+ Optional invitees:\n")
+ (exco-org-insert-invitees optional-invitees)))
+
+(defun exco-org-insert-meetings (identifier response)
+ "Insert the connection IDENTIFIER's meetings from RESPONSE."
+ (with-current-buffer (get-buffer-create excorporate-org-buffer-name)
+ (let ((inhibit-read-only t)
+ (name-regexp (concat "\\" (exco-org-format-headline identifier))))
+ (goto-char 1)
+ (end-of-line)
+ (insert (format "%s..." identifier))
+ (goto-char (point-max))
+ (re-search-backward name-regexp nil)
+ (forward-line 2)
+ (org-insert-time-stamp (current-time) t t " + Last checked " "\n")
+ (exco-calendar-item-iterate response #'exco-org-insert-meeting)
+ (re-search-backward name-regexp nil)
+ (if (save-excursion (org-goto-first-child))
+ (org-sort-entries t ?s)
+ (forward-line 3)
+ (insert "`♘")))))
+
+(defun exco-org-finalize-buffer ()
+ "Finalize text in buffer after all connections have responded."
+ (with-current-buffer (get-buffer-create excorporate-org-buffer-name)
+ ;; Sort top-level entries alphabetically.
+ (let ((inhibit-read-only t))
+ (goto-char (point-min))
+ (end-of-line)
+ (insert "done.")
+ (org-sort-entries t ?a))))
+
+;;;###autoload
+(defun exco-org-show-day (month day year)
+ "Show meetings for the date specified by MONTH DAY YEAR."
+ (exco-connection-iterate #'exco-org-initialize-buffer
+ (lambda (identifier callback)
+ (exco-org-insert-headline identifier
+ month day year)
+ (exco-get-meetings-for-day identifier
+ month day year
+ callback))
+ #'exco-org-insert-meetings
+ #'exco-org-finalize-buffer))
+
+(provide 'excorporate-org)
+
+;;; excorporate-org.el ends here
diff --git a/packages/excorporate/excorporate.el
b/packages/excorporate/excorporate.el
new file mode 100644
index 0000000..69585d6
--- /dev/null
+++ b/packages/excorporate/excorporate.el
@@ -0,0 +1,786 @@
+;;; excorporate.el --- Exchange integration -*- lexical-binding: t
-*-
+
+;; Copyright (C) 2014-2016 Free Software Foundation, Inc.
+
+;; Author: Thomas Fitzsimmons <address@hidden>
+;; Maintainer: Thomas Fitzsimmons <address@hidden>
+;; Created: 2014-09-19
+;; Version: 0.7.1
+;; Keywords: calendar
+;; Homepage: https://www.fitzsim.org/blog/
+;; Package-Requires: ((emacs "24.1") (fsm "0.2") (soap-client "3.0.2")
(url-http-ntlm "2.0.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:
+
+;; Excorporate provides Exchange integration for Emacs.
+
+;; To create a connection to a web service:
+
+;; M-x excorporate
+
+;; Excorporate will prompt for an email address that it will use to
+;; automatically discover settings. Then it will connect to two or
+;; three separate hosts: the autodiscovery host, the web service host
+;; or load balancer, and the actual server if there is a load
+;; balancer. Therefore you may be prompted for your credentials two
+;; or three times.
+
+;; You should see a message indicating that the connection is ready
+;; either in the minibuffer or failing that in the *Messages* buffer.
+
+;; Finally, run M-x calendar, and press 'e' to show today's meetings.
+
+;; Please try autodiscovery first and report issues not yet listed
+;; below. When autodiscovery works it is very convenient; the goal is
+;; to make it work for as many users as possible.
+
+;; If autodiscovery fails, customize `excorporate-configuration' to
+;; skip autodiscovery.
+
+;; Autodiscovery will fail if:
+
+;; - Excorporate is accessing the server through a proxy (Emacs
+;; bug#10).
+
+;; - The server is not configured to support autodiscovery.
+
+;; - The email address is at a different domain than the server, e.g.,
+;; address@hidden, autodiscover.domain2.com.
+
+;; - Authentication is Kerberos/GSSAPI.
+
+;; Excorporate does know about the special case where the mail address
+;; is at a subdomain, e.g., address@hidden, and the server is at
+;; the main domain, e.g., autodiscover.domain.com. Autodiscovery will
+;; work in that case.
+
+;; Excorporate must be loaded before any other package that requires
+;; `soap-client'. The version of `soap-client' that Excorporate
+;; bundles is backward compatible.
+
+;; Acknowledgments:
+
+;; Alexandru Harsanyi <address@hidden> provided help and
+;; guidance on how to extend soap-client.el's WSDL and XSD handling,
+;; enabling support for the full Exchange Web Services API.
+
+;; Alex Luccisano <address@hidden> tested early versions of
+;; this library against a corporate installation of Exchange.
+
+;; Jon Miller <address@hidden> tested against Exchange 2013. He
+;; also tracked down and reported a bad interaction with other
+;; packages that require soap-client.
+
+;; Nicolas Lamirault <address@hidden> tested the
+;; autodiscovery feature.
+
+;; Trey Jackson <address@hidden> confirmed autodiscovery worked
+;; for him.
+
+;; Joakim Verona <address@hidden> tested autodiscovery in a
+;; Kerberos/GSSAPI environment.
+
+;; Wilfred Hughes <address@hidden> tested on Exchange 2007 and
+;; suggested documentation improvements.
+
+;;; Code:
+
+;; Implementation-visible functions and variables.
+
+;; Add NTLM authorization scheme.
+(require 'url-http-ntlm)
+(require 'soap-client)
+(require 'fsm)
+(require 'excorporate-calendar)
+
+(defconst exco--autodiscovery-templates
+ '("https://%s/autodiscover/autodiscover.svc";
+ "https://autodiscover.%s/autodiscover/autodiscover.svc";)
+ "Autodiscovery URL templates.
+URL templates to be formatted with a domain name, then searched
+for autodiscovery files.")
+
+(defvar exco--connections nil
+ "A hash table of finite state machines.
+The key is the identifier passed to `exco-connect'. Each finite
+state machine represents a service connection.")
+
+(defvar exco--connection-identifiers nil
+ "An ordered list of connection identifiers.")
+
+(defun exco--parse-xml-in-current-buffer ()
+ "Decode and parse the XML contents of the current buffer."
+ (let ((mime-part (mm-dissect-buffer t t)))
+ (unless mime-part
+ (error "Failed to decode response from server"))
+ (unless (equal (car (mm-handle-type mime-part)) "text/xml")
+ (error "Server response is not an XML document"))
+ (with-temp-buffer
+ (mm-insert-part mime-part)
+ (prog1
+ (car (xml-parse-region (point-min) (point-max)))
+ (kill-buffer)
+ (mm-destroy-part mime-part)))))
+
+(defun exco--bind-wsdl (wsdl service-url port-name target-namespace
+ binding-name)
+ "Create a WSDL binding.
+Create a binding port for WSDL from SERVICE-URL, PORT-NAME,
+TARGET-NAMESPACE and BINDING-NAME."
+ (let* ((namespace (soap-wsdl-find-namespace target-namespace wsdl))
+ (port (make-soap-port
+ :name port-name
+ :binding (cons target-namespace binding-name)
+ :service-url service-url)))
+ (soap-namespace-put port namespace)
+ (push port (soap-wsdl-ports wsdl))
+ (soap-resolve-references port wsdl)
+ wsdl))
+
+(defun exco--handle-url-error (url status)
+ "Handle an error that occurred when retrieving URL.
+The details of the error are in STATUS, in the same format as the
+argument to a `url-retrieve' callback. Return non-nil to retry,
+nil to continue."
+ (if (eq (cl-third (plist-get status :error)) 500)
+ ;; The server reported an internal server error. Try to recover
+ ;; by re-requesting the target URL and its most recent redirect.
+ ;; I'm not sure what conditions cause the server to get into
+ ;; this state -- it might be because the server has stale
+ ;; knowledge of old keepalive connections -- but this should
+ ;; recover it. We need to disable ntlm in
+ ;; url-registered-auth-schemes so that it doesn't prevent
+ ;; setting keepalives to nil.
+ (let ((url-registered-auth-schemes nil)
+ (url-http-attempt-keepalives nil)
+ (redirect (plist-get status :redirect)))
+ (fsm-debug-output "exco--fsm received 500 error for %s" url)
+ (url-debug 'excorporate "Attempting 500 recovery")
+ (ignore-errors
+ ;; Emacs's url-retrieve does not respect the values of
+ ;; url-http-attempt-keepalives and
+ ;; url-registered-auth-schemes in asynchronous contexts.
+ ;; Unless url.el is eventually changed to do so, the
+ ;; following requests must be synchronous so that they run
+ ;; entirely within url-http-attempt-keepalives's dynamic
+ ;; extent. These calls block the main event loop,
+ ;; unfortunately, but only in this rare error recovery
+ ;; scenario.
+ (url-retrieve-synchronously url)
+ (when redirect (url-retrieve-synchronously redirect)))
+ (url-debug 'excorporate "Done 500 recovery attempt")
+ ;; Retry.
+ t)
+ ;; We received some other error, which just
+ ;; means we should try the next URL.
+ (fsm-debug-output "exco--fsm didn't find %s" url)
+ ;; Don't retry.
+ nil))
+
+(defun exco--retrieve-next-import (fsm state-data return-for next-state)
+ "Retrieve the next XML schema import.
+FSM is the finite state machine, STATE-DATA is FSM's state data,
+and RETURN-FOR is one of :enter or :event to indicate what return
+type the calling function expects. NEXT-STATE is the next state
+the FSM should transition to on success."
+ (let* ((url (plist-get state-data :service-url))
+ (xml (plist-get state-data :service-xml))
+ (wsdl (plist-get state-data :service-wsdl))
+ (imports (soap-wsdl-xmlschema-imports wsdl))
+ (next-state (if imports :parsing-service-wsdl next-state)))
+ (when imports
+ (let ((import-url (url-expand-file-name (pop imports) url)))
+ (let ((url-request-method "GET")
+ (url-package-name "soap-client.el")
+ (url-package-version "1.0")
+ (url-mime-charset-string "utf-8;q=1, iso-8859-1;q=0.5")
+ (url-http-attempt-keepalives t))
+ (url-retrieve
+ import-url
+ (lambda (status)
+ (let ((data-buffer (current-buffer)))
+ (unwind-protect
+ (progn
+ (url-debug 'excorporate "Processing import %s" status)
+ (if (eq (car status) :error)
+ ;; There is an error. It may be recoverable
+ ;; if it's HTTP 500 (internal server error).
+ (if (and (exco--handle-url-error import-url status)
+ ;; Only retry once.
+ (not (plist-get state-data :retrying)))
+ ;; We should retry. Don't save the
+ ;; popped urls list to state-data, so
+ ;; that this :try-next-url will
+ ;; re-attempt to retrieve the same car as
+ ;; before. Set the retry flag.
+ (progn
+ (plist-put state-data :retrying t))
+ ;; Save the popped urls list so that the next url
+ ;; is attempted, and clear the retry flag.
+ (plist-put state-data :retrying nil)
+ (setf (soap-wsdl-xmlschema-imports wsdl) imports)
+ (plist-put state-data :failure-message
+ (format "Failed to retrieve %s"
+ import-url))
+ (fsm-send fsm :unrecoverable-error))
+ ;; Success, parse WSDL.
+ (plist-put state-data :retrying nil)
+ (setf (soap-wsdl-xmlschema-imports wsdl) imports)
+ (soap-with-local-xmlns xml
+ (soap-wsdl-add-namespace
+ (soap-parse-schema (soap-parse-server-response) wsdl)
+ wsdl))
+ (plist-put state-data :service-wsdl wsdl)))
+ (and (buffer-live-p data-buffer)
+ (kill-buffer data-buffer))))
+ (fsm-send fsm t))))))
+ (if (eq return-for :enter)
+ (list state-data nil)
+ (list next-state state-data nil))))
+
+(define-state-machine exco--fsm :start
+ ((identifier)
+ "Start an Excorporate finite state machine."
+ (if (stringp identifier)
+ (let ((domain (cadr (split-string identifier "@"))))
+ (unless (and domain (not (equal domain "")))
+ (error "Invalid domain for address %s" identifier))
+ (list :retrieving-autodiscovery-xml
+ (list
+ ;; State machine data.
+ ;; Unique finite state machine identifier. Either mail-address
+ ;; or (mail-address . service-url). The latter allows multiple
+ ;; state machines to operate on the same service URL. Login
+ ;; credentials are handled separately by auth-source and url,
+ ;; so these should be the only two identifier types needed here.
+ :identifier identifier
+ ;; User data.
+ :mail-address identifier
+ ;; Error recovery data.
+ :retrying nil
+ ;; Autodiscovery data.
+ :autodiscovery-urls
+ (append (mapcar (lambda (template)
+ (format template domain))
+ exco--autodiscovery-templates)
+ ;; Handle the address@hidden =>
+ ;; autodiscover.domain.com case reported by a
+ ;; user. Only try one extra level.
+ (let ((domain-parts (split-string domain "\\.")))
+ (when (> (length domain-parts) 2)
+ (mapcar (lambda (template)
+ (format template
+ (mapconcat
+ 'identity
+ (cdr domain-parts) ".")))
+ exco--autodiscovery-templates))))
+ ;; Service data.
+ :service-url nil
+ :service-xml nil
+ :service-wsdl nil
+ ;; State data.
+ :next-state-after-success nil
+ :failure-message nil
+ :server-version nil)
+ ;; No timeout.
+ nil))
+ ;; Go directly to :retrieving-service-xml, skipping autodiscovery.
+ (list :retrieving-service-xml
+ (list
+ :identifier identifier
+ :mail-address (car identifier)
+ :retrying nil
+ :autodiscovery-urls nil
+ ;; Use service-url field from identifier.
+ :service-url (cdr identifier)
+ :service-xml nil
+ :service-wsdl nil
+ :next-state-after-success nil
+ :failure-message nil
+ :server-version nil)
+ ;; No timeout.
+ nil))))
+
+(define-state exco--fsm :retrieving-autodiscovery-xml
+ (fsm state-data event _callback)
+ (cl-case event
+ (:try-next-url
+ (let ((urls (plist-get state-data :autodiscovery-urls)))
+ (if urls
+ (let ((url (pop urls)))
+ (fsm-debug-output "exco--fsm will probe %s" url)
+ (condition-case nil
+ (url-retrieve
+ url
+ (lambda (status)
+ (let ((data-buffer (current-buffer)))
+ (unwind-protect
+ (progn
+ (url-debug 'excorporate
+ "Processing status: %s" status)
+ (if (eq (car status) :error)
+ (progn
+ (if (and
+ (exco--handle-url-error url status)
+ ;; Only retry once.
+ (not (plist-get state-data :retrying)))
+ ;; We should retry. Don't save the popped
+ ;; urls list to state-data, so that this
+ ;; :try-next-url will re-attempt to
+ ;; retrieve the same car as before. Set
+ ;; the retry flag.
+ (plist-put state-data :retrying t)
+ ;; Save the popped urls list so that the
+ ;; next url is attempted, and clear the
+ ;; retry flag.
+ (plist-put state-data :retrying nil)
+ (plist-put state-data
+ :autodiscovery-urls urls))
+ ;; Try next or retry.
+ (fsm-send fsm :try-next-url))
+ ;; Success, save URL and parse returned XML.
+ (message
+ "Excorporate: Found autodiscovery URL for %S: %s"
+ (plist-get state-data :identifier) url)
+ (plist-put state-data :retrying nil)
+ (plist-put state-data :service-url url)
+ (plist-put state-data :service-xml
+ (exco--parse-xml-in-current-buffer))
+ (fsm-send fsm :success))
+ (url-debug 'excorporate "Done processing status"))
+ (and (buffer-live-p data-buffer)
+ (kill-buffer data-buffer))))))
+ (error
+ (fsm-debug-output "exco--fsm connection refused for %s" url)
+ (plist-put state-data :retrying nil)
+ (plist-put state-data :autodiscovery-urls urls)
+ (fsm-send fsm :try-next-url)))
+ (list :retrieving-autodiscovery-xml state-data nil))
+ (plist-put state-data :failure-message
+ "Autodiscovery ran out of URLs to try")
+ (list :shutting-down-on-error state-data nil))))
+ (:success
+ (plist-put state-data :next-state-after-success :retrieving-service-xml)
+ (list :parsing-service-wsdl state-data nil))))
+
+(define-enter-state exco--fsm :shutting-down-on-error
+ (_fsm state-data)
+ (let ((failure-message (plist-get state-data :failure-message)))
+ (exco-disconnect (plist-get state-data :identifier))
+ (message "Excorporate: %s" failure-message)
+ (url-debug 'excorporate "Failed: %s" failure-message)
+ (fsm-debug-output "exco--fsm failed: %s" failure-message))
+ (list state-data nil))
+
+(define-state exco--fsm :shutting-down-on-error
+ (_fsm state-data _event _callback)
+ (list :shutting-down-on-error state-data nil))
+
+(define-enter-state exco--fsm :retrieving-service-xml
+ (fsm state-data)
+ (when (stringp (plist-get state-data :identifier))
+ (let* ((xml (plist-get state-data :service-xml))
+ (unbound-wsdl (plist-get state-data :service-wsdl))
+ (wsdl
+ (progn
+ ;; Skip soap-parse-wsdl-phase-fetch-schema to avoid
+ ;; synchronous URL fetches.
+ (soap-parse-wsdl-phase-finish-parsing xml unbound-wsdl)
+ (exco--bind-wsdl
+ (soap-wsdl-resolve-references unbound-wsdl)
+ (plist-get state-data :service-url)
+ "AutodiscoverServicePort"
+ "http://schemas.microsoft.com/exchange/2010/Autodiscover";
+ "DefaultBinding_Autodiscover"))))
+ (soap-invoke-async
+ (lambda (response)
+ (let ((result-url
+ (exco-extract-value '(Response
+ UserResponses
+ UserResponse
+ UserSettings
+ UserSetting
+ Value)
+ response)))
+ (if result-url
+ (progn
+ (plist-put state-data :service-url result-url)
+ (message "Excorporate: Found service URL for %S: %s"
+ (plist-get state-data :identifier)
+ (plist-get state-data :service-url)))
+ ;; No result. Check for error.
+ (let ((error-message
+ (exco-extract-value '(Response
+ UserResponses
+ UserResponse
+ ErrorMessage)
+ response)))
+ (if error-message
+ (message "Excorporate: %s" error-message)
+ (message "Excorporate: Failed to find service URL"))))
+ (fsm-send fsm :retrieve-xml)))
+ nil
+ wsdl
+ "AutodiscoverServicePort"
+ "GetUserSettings"
+ `((RequestedServerVersion . "Exchange2010")
+ (Request
+ (Users
+ (User
+ (Mailbox . ,(plist-get state-data :mail-address))))
+ (RequestedSettings
+ (Setting . "InternalEwsUrl")))))))
+ (list state-data nil))
+
+(define-state exco--fsm :retrieving-service-xml
+ (fsm state-data event _callback)
+ (cl-case event
+ (:unrecoverable-error
+ (list :shutting-down-on-error state-data nil))
+ (:retrieve-xml
+ (let ((service-url (plist-get state-data :service-url)))
+ (url-retrieve (concat service-url "?wsdl")
+ (lambda (status)
+ (let ((data-buffer (current-buffer)))
+ (unwind-protect
+ (if (eq (car status) :error)
+ (progn
+ (plist-put state-data :failure-message
+ (format "Failed to retrieve %s"
+ service-url))
+ (fsm-send fsm :unrecoverable-error))
+ (plist-put state-data
+ :service-xml
+ (exco--parse-xml-in-current-buffer))
+ (fsm-send fsm :success))
+ (and (buffer-live-p data-buffer)
+ (kill-buffer data-buffer)))))))
+ (list :retrieving-service-xml state-data nil))
+ (:success
+ (plist-put state-data :next-state-after-success :retrieving-data)
+ (list :parsing-service-wsdl state-data nil))))
+
+(define-enter-state exco--fsm :parsing-service-wsdl
+ (fsm state-data)
+ (let* ((url (plist-get state-data :service-url))
+ (xml (plist-get state-data :service-xml))
+ (next-state (plist-get state-data :next-state-after-success))
+ (wsdl (soap-make-wsdl url)))
+ (soap-parse-wsdl-phase-validate-node xml)
+ ;; Skip soap-parse-wsdl-phase-fetch-imports to avoid synchronous
+ ;; fetches of import URLs.
+ (soap-parse-wsdl-phase-parse-schema xml wsdl)
+ (plist-put state-data :service-wsdl wsdl)
+ (exco--retrieve-next-import fsm state-data :enter next-state)))
+
+(define-state exco--fsm :parsing-service-wsdl
+ (fsm state-data event _callback)
+ (if (eq event :unrecoverable-error)
+ (list :shutting-down-on-error state-data nil)
+ (let ((next-state (plist-get state-data :next-state-after-success)))
+ (exco--retrieve-next-import fsm state-data :event next-state))))
+
+(defun exco--get-server-version (wsdl)
+ "Extract server version from WSDL."
+ (catch 'found
+ (dolist (attribute
+ (soap-xs-type-attributes
+ (soap-xs-element-type
+ (soap-wsdl-get
+ '("http://schemas.microsoft.com/exchange/services/2006/types";
+ . "RequestServerVersion")
+ wsdl 'soap-xs-element-p))))
+ (when (equal (soap-xs-attribute-name attribute) "Version")
+ (throw 'found (soap-xs-attribute-default attribute))))
+ (warn "Excorporate: Failed to determine server version")
+ nil))
+
+(define-enter-state exco--fsm :retrieving-data
+ (_fsm state-data)
+ (let ((wsdl (plist-get state-data :service-wsdl))
+ (identifier (plist-get state-data :identifier)))
+ ;; Skip soap-parse-wsdl-phase-fetch-schema to avoid synchronous
+ ;; URL fetches.
+ (soap-parse-wsdl-phase-finish-parsing (plist-get state-data :service-xml)
+ wsdl)
+ (exco--bind-wsdl
+ (soap-wsdl-resolve-references wsdl)
+ (plist-get state-data :service-url)
+ "ExchangeServicePort"
+ "http://schemas.microsoft.com/exchange/services/2006/messages";
+ "ExchangeServiceBinding")
+ (plist-put state-data :server-version (exco--get-server-version wsdl))
+ (fsm-debug-output "exco--fsm %s server version is %s"
+ identifier (exco-server-version identifier))
+ (message "Excorporate: Connection %S is ready" identifier))
+ (list state-data nil))
+
+(define-state exco--fsm :retrieving-data
+ (_fsm state-data event _callback)
+ (let* ((identifier (plist-get state-data :identifier))
+ (wsdl (plist-get state-data :service-wsdl))
+ (name (pop event))
+ (arguments (pop event))
+ (callback (pop event)))
+ (apply #'soap-invoke-async
+ (lambda (response)
+ (funcall callback identifier response))
+ nil
+ wsdl
+ "ExchangeServicePort"
+ name
+ arguments))
+ (list :retrieving-data state-data nil))
+
+(defun exco--ensure-connection ()
+ "Ensure at least one connection exists or throw an error."
+ (unless exco--connection-identifiers
+ (error "Excorporate: No connections exist. Run M-x excorporate")))
+
+(defmacro exco--with-fsm (identifier &rest body)
+ "With `fsm' set to IDENTIFIER, run BODY.
+Run BODY with `fsm' set to the finite state machine specified by
+IDENTIFIER."
+ (declare (indent 1) (debug t))
+ `(progn
+ (exco--ensure-connection)
+ (let ((fsm (gethash ,identifier exco--connections)))
+ (unless fsm
+ (error "Excorporate: Connection %S does not exist" ,identifier))
+ ,@body)))
+
+;; Developer-visible functions and variables.
+
+(defun exco-api-version ()
+ "Return the Excorporate API version.
+Return a non-negative integer representing the current
+Excorporate application programming interface version. Version 0
+is subject to change."
+ 0)
+
+(defun exco-connect (identifier)
+ "Connect or reconnect to a web service.
+IDENTIFIER is the mail address to use for autodiscovery or a
+pair (mail-address . service-url)."
+ (if (stringp identifier)
+ (message "Excorporate: Starting autodiscovery for %S"
+ identifier))
+ (let ((fsm (start-exco--fsm identifier)))
+ (unless exco--connections
+ (setq exco--connections (make-hash-table :test 'equal)))
+ (when (gethash identifier exco--connections)
+ (exco-disconnect identifier))
+ (puthash identifier fsm exco--connections)
+ (push identifier exco--connection-identifiers)
+ (if (stringp identifier)
+ (fsm-send fsm :try-next-url)
+ (fsm-send fsm :retrieve-xml))
+ nil))
+
+(defun exco-operate (identifier name arguments callback)
+ "Execute a service operation asynchronously.
+IDENTIFIER is the connection identifier. Execute operation NAME
+with ARGUMENTS then call CALLBACK with two arguments, IDENTIFIER
+and the server's response."
+ (exco--with-fsm identifier
+ (fsm-send fsm (list name arguments callback)))
+ nil)
+
+(defun exco-server-version (identifier)
+ "Return the server version for connection IDENTIFIER, as a string.
+Examples are \"Exchange2010\", \"Exchange2010_SP1\",
+\"Exchange2013\"."
+ (exco--with-fsm identifier
+ (plist-get (fsm-get-state-data fsm) :server-version)))
+
+(defun exco-disconnect (identifier)
+ "Disconnect from a web service.
+IDENTIFIER is the mail address used to look up the connection."
+ (exco--with-fsm identifier
+ (setq exco--connection-identifiers
+ (delete identifier exco--connection-identifiers))
+ (remhash identifier exco--connections))
+ nil)
+
+(defun exco-extract-value (path result)
+ "Extract the value at PATH from RESULT.
+PATH is an ordered list of node names."
+ (let ((values (nreverse (car result))))
+ (dolist (path-element path)
+ (setq values (assoc path-element values)))
+ (cdr values)))
+
+(defun exco-calendar-item-iterate (response callback)
+ "Iterate through calendar items in RESPONSE, calling CALLBACK on each.
+Returns a list of results from callback. CALLBACK takes arguments:
+SUBJECT, a string, the subject of the meeting.
+START, the start date and time in Emacs internal representation.
+END, the start date and time in Emacs internal representation.
+LOCATION, the location of the meeting.
+MAIN-INVITEES, a list of strings representing required participants.
+OPTIONAL-INVITEES, a list of strings representing optional participants."
+ (let ((result-list '()))
+ (dolist (calendar-item (exco-extract-value '(ResponseMessages
+ FindItemResponseMessage
+ RootFolder
+ Items)
+ response))
+ (let* ((subject (cdr (assoc 'Subject calendar-item)))
+ (start (cdr (assoc 'Start calendar-item)))
+ (start-internal (apply #'encode-time
+ (soap-decode-date-time
+ start 'dateTime)))
+ (end (cdr (assoc 'End calendar-item)))
+ (end-internal (apply #'encode-time
+ (soap-decode-date-time
+ end 'dateTime)))
+ (location (cdr (assoc 'Location calendar-item)))
+ (to-invitees (cdr (assoc 'DisplayTo calendar-item)))
+ (main-invitees (mapcar 'org-trim (split-string to-invitees ";")))
+ (cc-invitees (cdr (assoc 'DisplayCc calendar-item)))
+ (optional-invitees (when cc-invitees
+ (mapcar 'org-trim
+ (split-string cc-invitees ";")))))
+ (push (funcall callback subject start-internal end-internal
+ location main-invitees optional-invitees)
+ result-list)))
+ (nreverse result-list)))
+
+;; Date-time utility functions.
+(defun exco-extend-timezone (date-time-string)
+ "Add a colon to the timezone in DATE-TIME-STRING.
+DATE-TIME-STRING must be formatted as if returned by
+`format-time-string' with FORMAT-STRING \"%FT%T%z\". Web
+services require the ISO8601 extended format of timezone, which
+includes the colon."
+ (concat
+ (substring date-time-string 0 22) ":" (substring date-time-string 22)))
+
+(defun exco-format-date-time (time-internal)
+ "Convert TIME-INTERNAL to an XSD compatible date-time string."
+ (exco-extend-timezone
+ (format-time-string "%FT%T%z" time-internal)))
+
+;; Use month day year order to be compatible with
+;; calendar-cursor-to-date. I wish I could instead use the ISO 8601
+;; ordering, year month day.
+(defun exco-get-meetings-for-day (identifier month day year callback)
+ "Return the meetings for the specified day.
+IDENTIFIER is the connection identifier. MONTH, DAY and YEAR are
+the meeting month, day and year. Call CALLBACK with two
+arguments, IDENTIFIER and the server's response."
+ (let* ((start-of-day-time-internal
+ (apply #'encode-time `(0 0 0 ,day ,month ,year)))
+ (start-of-day-date-time
+ (exco-format-date-time start-of-day-time-internal))
+ (start-of-next-day-date-time
+ (exco-extend-timezone
+ (format-time-string "%FT00:00:00%z"
+ (time-add start-of-day-time-internal
+ (seconds-to-time 86400))))))
+ (exco-operate
+ identifier
+ "FindItem"
+ `(;; Main arguments.
+ ((Traversal . "Shallow")
+ (ItemShape
+ (BaseShape . "AllProperties"))
+ ;; To aid productivity, excorporate-calfw automatically prunes your
+ ;; meetings to a maximum of 100 per day.
+ (CalendarView (MaxEntriesReturned . "100")
+ (StartDate . ,start-of-day-date-time)
+ (EndDate . ,start-of-next-day-date-time))
+ (ParentFolderIds
+ (DistinguishedFolderId (Id . "calendar"))))
+ ;; Empty arguments.
+ ,@(let ((server-major-version
+ (string-to-number
+ (substring (exco-server-version identifier) 8 12))))
+ (cond
+ ((<= server-major-version 2007)
+ '(nil nil nil nil))
+ ((< server-major-version 2013)
+ '(nil nil nil nil nil))
+ (t
+ '(nil nil nil nil nil nil)))))
+ callback)))
+
+(defun exco-connection-iterate (initialize-function
+ per-connection-function
+ per-connection-callback
+ finalize-function)
+ "Iterate Excorporate connections.
+Call INITIALIZE-FUNCTION once before iterating.
+Call PER-CONNECTION-FUNCTION for each connection.
+Pass PER-CONNECTION-CALLBACK to PER-CONNECTION-FUNCTION.
+Call FINALIZE-FUNCTION after all operations have responded."
+ (exco--ensure-connection)
+ (funcall initialize-function)
+ (let ((responses 0)
+ (connection-count (length exco--connection-identifiers)))
+ (dolist (identifier exco--connection-identifiers)
+ (funcall per-connection-function identifier
+ (lambda (&rest arguments)
+ (setq responses (1+ responses))
+ (apply per-connection-callback arguments)
+ (when (equal responses connection-count)
+ (funcall finalize-function)))))))
+
+;; User-visible functions and variables.
+(defgroup excorporate nil
+ "Exchange support."
+ :version "25.1"
+ :group 'comm
+ :group 'calendar)
+
+;; Name the excorporate-configuration variable vaguely. It is currently a
+;; MAIL-ADDRESS string, a pair (MAIL-ADDRESS . SERVICE-URL), or nil. In the
+;; future it could allow a list of strings and pairs.
+(defcustom excorporate-configuration nil
+ "Excorporate configuration.
+The mail address to use for autodiscovery."
+ :type '(choice
+ (const
+ :tag "Prompt for Exchange mail address to use for autodiscovery" nil)
+ (string :tag "Exchange mail address to use for autodiscovery")
+ (cons :tag "Skip autodiscovery"
+ (string :tag "Exchange mail address (e.g., address@hidden)")
+ (string :tag "Exchange Web Services URL\
+ (e.g., https://mail.gnu.org/ews/exchange.asmx)"))))
+
+;;;###autoload
+(defun excorporate ()
+ "Start Excorporate.
+Prompt for a mail address to use for autodiscovery, with an
+initial suggestion of `user-mail-address'. However, if
+`excorporate-configuration' is non-nil, `excorporate' will use
+that without prompting."
+ (interactive)
+ (cond
+ ((eq excorporate-configuration nil)
+ (exco-connect (completing-read "Exchange mail address: "
+ (list user-mail-address)
+ nil nil user-mail-address)))
+ ((stringp excorporate-configuration)
+ (exco-connect excorporate-configuration))
+ ((null (consp (cdr excorporate-configuration)))
+ (exco-connect excorporate-configuration))
+ (t
+ (error "Excorporate: Invalid configuration"))))
+
+(provide 'excorporate)
+
+;;; excorporate.el ends here
diff --git a/packages/excorporate/excorporate.info
b/packages/excorporate/excorporate.info
new file mode 100644
index 0000000..3111930
--- /dev/null
+++ b/packages/excorporate/excorporate.info
@@ -0,0 +1,150 @@
+This is excorporate.info, produced by makeinfo version 6.0 from
+excorporate.texi.
+
+Copyright (C) 2016 Free Software Foundation, Inc.
+
+ Permission is granted to copy, distribute and/or modify this
+ document under the terms of the GNU Free Documentation License,
+ Version 1.2 or any later version published by the Free Software
+ Foundation; with no Invariant Sections, with the Front-Cover, or
+ Back-Cover Texts. A copy of the license is included in the section
+ entitled "GNU Free Documentation License" in the Emacs manual.
+
+ This document is part of a collection distributed under the GNU
+ Free Documentation License. If you want to distribute this
+ document separately from the collection, you can do so by adding a
+ copy of the license to the document, as described in section 6 of
+ the license.
+
+ All Emacs Lisp code contained in this document may be used,
+ distributed, and modified without restriction.
+INFO-DIR-SECTION Emacs
+START-INFO-DIR-ENTRY
+* Excorporate: (excorporate). Exchange Web Services integration for Emacs.
+END-INFO-DIR-ENTRY
+
+
+File: excorporate.info, Node: Top, Next: Installation, Up: (dir)
+
+Excorporate Manual
+******************
+
+Excorporate provides Exchange Web Services (EWS) support for Emacs.
+
+ If the Exchange server you access is configured to provide EWS
+support, then there's a 76% chance that Excorporate will enable you to
+retrieve your calendar entries from the comfort of Emacs.
+
+ The 24% failure rate is because accessing - in particular,
+authenticating against - an Exchange server can be challenging.
+
+ Known to fail are Kerberos/GSSAPI authentication and accessing the
+server through a proxy
+(<https://debbugs.gnu.org/cgi/bugreport.cgi?bug=10>).
+
+ Patches are welcome to enable more of these access scenarios.
+
+* Menu:
+
+* Installation:: Getting and installing 'excorporate'.
+* Configuration:: Configuring 'excorporate'.
+* Usage:: Using 'excorporate'.
+* Troubleshooting:: Debugging why a connection failed
+
+
+File: excorporate.info, Node: Installation, Next: Configuration, Prev: Top,
Up: Top
+
+1 Installation
+**************
+
+Excorporate works on Emacs versions >= 24.1.
+
+Install 'excorporate' from the GNU ELPA repository:
+
+ 'M-x package-install RET excorporate'
+
+
+File: excorporate.info, Node: Configuration, Next: Usage, Prev:
Installation, Up: Top
+
+2 Configuration
+***************
+
+Ideally you won't need to configure Excorporate at all. On friendly
+Exchange setups, Excorporate can discover the EWS URL automatically.
+
+First try:
+
+ 'M-x excorporate'
+
+which will prompt you for the Exchange account email address. Follow
+the prompts and if all goes well, you'll see a message in the minibuffer
+or in *Messages* saying that the connection is ready.
+
+ If autodiscovery runs out of URLs to try, then customize
+'excorporate-configuration':
+
+ 'M-x customize-variable RET excorporate-configuration'
+
+ From the value menu select "Skip autodiscovery". This allows you to
+enter the Exchange account email address and the EWS URL directly. The
+EWS URL is of the form 'https://mail.gnu.org/ews/exchange.asmx'.
+
+ After saving the configuration, try 'M-x excorporate' again.
+
+ If that doesn't work, then you're probably out of luck, or you'll
+have to start a troubleshooting deep dive (*note Troubleshooting::).
+
+
+File: excorporate.info, Node: Usage, Next: Troubleshooting, Prev:
Configuration, Up: Top
+
+3 Usage
+*******
+
+Excorporate binds 'e' in '*Calendar*' buffers. Open the calendar with:
+
+ 'M-x calendar'
+
+move the cursor to the date you want to see meetings for, and press 'e'.
+This will show the meetings in a temporary read-only Org Mode buffer
+named '*Excorporate*'.
+
+
+File: excorporate.info, Node: Troubleshooting, Prev: Usage, Up: Top
+
+4 Troubleshooting
+*****************
+
+First, you'll want to double-check that the Exchange server you're
+trying to access provides EWS support. If it doesn't, Excorporate can't
+do anything for you. Before asking your Exchange administrator, check
+intranet wikis and so forth; other users of non-standard clients may
+have already found the EWS URL.
+
+ The buffer '*fsm-debug*' shows 'excorporate' state transitions and
+should provide details of where things went wrong.
+
+ Also check '*Messages*' for anything obvious.
+
+ If you suspect something wrong with accessing the EWS URL, try
+setting 'url-debug' to t and retry 'M-x excorporate', then check the
+'*URL-DEBUG*' buffer for output.
+
+ If you suspect NTLM authentication is failing, as a long shot, you
+might try setting 'ntlm-compatibility-level' to 0 and retrying 'M-x
+excorporate'.
+
+ Excorporate's dependencies implement the tricky elements of
+asynchronous Exchange access: a state machine ('fsm'), TLS negotiation
+('gnutls'), NTLM authentication ('ntlm' and 'url-http-ntlm') and SOAP
+communication ('soap-client').
+
+
+
+Tag Table:
+Node: Top1103
+Node: Installation2077
+Node: Configuration2340
+Node: Usage3400
+Node: Troubleshooting3771
+
+End Tag Table
diff --git a/packages/excorporate/excorporate.texi
b/packages/excorporate/excorporate.texi
new file mode 100644
index 0000000..1683b9f
--- /dev/null
+++ b/packages/excorporate/excorporate.texi
@@ -0,0 +1,146 @@
+\input texinfo
address@hidden excorporate.info
address@hidden Excorporate Manual
+
address@hidden Emacs
address@hidden
+* Excorporate: (excorporate). Exchange Web Services integration for Emacs.
address@hidden direntry
+
address@hidden
+Copyright @copyright{} 2016 Free Software Foundation, Inc.
+
address@hidden
+Permission is granted to copy, distribute and/or modify this document
+under the terms of the GNU Free Documentation License, Version 1.2 or
+any later version published by the Free Software Foundation; with no
+Invariant Sections, with the Front-Cover, or Back-Cover Texts. A copy of
+the license is included in the section entitled ``GNU Free Documentation
+License'' in the Emacs manual.
+
+This document is part of a collection distributed under the GNU Free
+Documentation License. If you want to distribute this document
+separately from the collection, you can do so by adding a copy of the
+license to the document, as described in section 6 of the license.
+
+All Emacs Lisp code contained in this document may be used, distributed,
+and modified without restriction.
address@hidden quotation
address@hidden copying
+
address@hidden
address@hidden Excorporate Manual
address@hidden Thomas Fitzsimmons
address@hidden
address@hidden
address@hidden titlepage
+
address@hidden
+
address@hidden Top
address@hidden Excorporate Manual
+
+Excorporate provides Exchange Web Services (EWS) support for Emacs.
+
+If the Exchange server you access is configured to provide EWS
+support, then there's a 76% chance that Excorporate will enable you to
+retrieve your calendar entries from the comfort of Emacs.
+
+The 24% failure rate is because accessing -- in particular,
+authenticating against -- an Exchange server can be challenging.
+
+Known to fail are Kerberos/GSSAPI authentication and accessing the
+server through a proxy
+(@uref{https://debbugs.gnu.org/cgi/bugreport.cgi?bug=10}).
+
+Patches are welcome to enable more of these access scenarios.
+
address@hidden
+* Installation:: Getting and installing @code{excorporate}.
+* Configuration:: Configuring @code{excorporate}.
+* Usage:: Using @code{excorporate}.
+* Troubleshooting:: Debugging why a connection failed
address@hidden menu
+
address@hidden Installation
address@hidden Installation
+
+Excorporate works on Emacs versions >= 24.1.
+
address@hidden
+Install @code{excorporate} from the GNU ELPA repository:
+
address@hidden package-install RET excorporate}
+
address@hidden Configuration
address@hidden Configuration
+
+Ideally you won't need to configure Excorporate at all. On friendly
+Exchange setups, Excorporate can discover the EWS URL automatically.
+
address@hidden
+First try:
+
address@hidden excorporate}
+
address@hidden
+which will prompt you for the Exchange account email address. Follow
+the prompts and if all goes well, you'll see a message in the
+minibuffer or in *Messages* saying that the connection is ready.
+
+If autodiscovery runs out of URLs to try, then customize
address@hidden:
+
address@hidden customize-variable RET excorporate-configuration}
+
+From the value menu select ``Skip autodiscovery''. This allows you to
+enter the Exchange account email address and the EWS URL directly.
+The EWS URL is of the form
address@hidden://mail.gnu.org/ews/exchange.asmx}.
+
+After saving the configuration, try @code{M-x excorporate} again.
+
+If that doesn't work, then you're probably out of luck, or you'll have
+to start a troubleshooting deep dive (@pxref{Troubleshooting}).
+
address@hidden Usage
address@hidden Usage
+
+Excorporate binds `e' in @code{*Calendar*} buffers. Open the calendar
+with:
+
address@hidden calendar}
+
address@hidden
+move the cursor to the date you want to see meetings for, and press
+`e'. This will show the meetings in a temporary read-only Org Mode
+buffer named @code{*Excorporate*}.
+
address@hidden Troubleshooting
address@hidden Troubleshooting
+
+First, you'll want to double-check that the Exchange server you're
+trying to access provides EWS support. If it doesn't, Excorporate
+can't do anything for you. Before asking your Exchange administrator,
+check intranet wikis and so forth; other users of non-standard clients
+may have already found the EWS URL.
+
+The buffer @code{*fsm-debug*} shows @code{excorporate} state
+transitions and should provide details of where things went wrong.
+
+Also check @code{*Messages*} for anything obvious.
+
+If you suspect something wrong with accessing the EWS URL, try setting
address@hidden to t and retry @code{M-x excorporate}, then check the
address@hidden buffer for output.
+
+If you suspect NTLM authentication is failing, as a long shot, you
+might try setting @code{ntlm-compatibility-level} to 0 and retrying
address@hidden excorporate}.
+
+Excorporate's dependencies implement the tricky elements of
+asynchronous Exchange access: a state machine (@code{fsm}), TLS
+negotiation (@code{gnutls}), NTLM authentication (@code{ntlm} and
address@hidden) and SOAP communication (@code{soap-client}).
+
address@hidden
diff --git a/packages/f90-interface-browser/f90-interface-browser.el
b/packages/f90-interface-browser/f90-interface-browser.el
index 604c2f1..8113a8b 100644
--- a/packages/f90-interface-browser/f90-interface-browser.el
+++ b/packages/f90-interface-browser/f90-interface-browser.el
@@ -1,6 +1,6 @@
;;; f90-interface-browser.el --- Parse and browse f90 interfaces
-;; Copyright (C) 2011, 2012, 2013, 2014 Free Software Foundation, Inc
+;; Copyright (C) 2011, 2012, 2013, 2014, 2015 Free Software Foundation, Inc
;; Author: Lawrence Mitchell <address@hidden>
;; Created: 2011-07-06
@@ -165,7 +165,10 @@ unqualified filename."
"Hash table populated with all known f90 interfaces.")
(defvar f90-types (make-hash-table :test 'equal)
- "Hash table populated with all known f90 derived types.")
+ "Hash table populated with all known f90 derived types.
+The keys are type names and the values are lists of pairs of the form
+\(NAME . REST) where NAME is the name of a slot of that type and REST
+describes that slot.")
;;; Inlineable utility functions
(defsubst f90-specialisers (name interfaces)
@@ -201,10 +204,7 @@ level. For example, a LEVEL of 0 counts top-level commas."
(defsubst f90-get-slot-type (slot type)
"Get the type of SLOT in TYPE."
- (let ((fn (intern-soft (format "f90-type.%s.%s"
- (f90-get-parsed-type-typename type) slot))))
- (when fn
- (funcall fn (f90-get-type type)))))
+ (assoc slot (f90-get-type type)))
(defsubst f90-merge-into-tags-completion-table (ctable)
"Merge completions in CTABLE into the tags completion table."
@@ -272,7 +272,8 @@ an alphanumeric character."
(loop for file in (directory-files dir t
(rx-to-string
`(and "." (or ,@f90-file-extensions)
- eos) t))
+ eos)
+ t))
do (f90-parse-interfaces file f90-all-interfaces)))
(defun f90-find-tag-interface (name &optional match-sublist)
@@ -283,7 +284,7 @@ the word at point. If MATCH-SUBLIST is non-nil, only check
if
the arglist is a sublist of the specialiser's arglist. For more
details see `f90-approx-arglist-match' and
`f90-browse-interface-specialisers'."
- (interactive (let ((def (word-at-point)))
+ (interactive (let ((def (thing-at-point 'symbol)))
(list (completing-read
(format "Find interface/tag (default %s): " def)
(f90-lazy-completion-table)
@@ -308,7 +309,7 @@ which ARGLIST-TO-MATCH is a sublist of the specialiser's
arglist.
If INVOCATION-POINT is non-nil it should be a `point-marker'
indicating where we were called from, for jumping back to with
`pop-tag-mark'."
- (interactive (let ((def (word-at-point)))
+ (interactive (let ((def (thing-at-point 'symbol)))
(list (completing-read
(format "Interface%s: "
(if def
@@ -506,26 +507,16 @@ default is the type of the variable."
(fundamental-mode)
(erase-buffer)
(let* ((tname (format "type(%s)" type))
- (type-struct (f90-get-type (list nil tname)))
- fns)
- (when type-struct
- (setq fns (loop for name in (funcall (intern-soft
- (format "f90-type.%s.-varnames"
- tname))
- type-struct)
- collect (intern-soft (format "f90-type.%s.%s"
- tname name)))))
- (if (null type-struct)
+ (slots (f90-get-type (list nil tname))))
+ (if (null slots)
(insert (format "The type %s is not a known derived type."
type))
(insert (format "type %s\n" type))
- (loop for fn in fns
- for parsed = (funcall fn type-struct)
- then (funcall fn type-struct)
+ (loop for slot in slots
do
(insert (format " %s :: %s\n"
- (f90-format-parsed-slot-type parsed)
- (f90-get-parsed-type-varname parsed))))
+ (f90-format-parsed-slot-type slot)
+ (f90-get-parsed-type-varname slot))))
(insert (format "end type %s\n" type))
(f90-mode))
(goto-char (point-min))
@@ -540,11 +531,11 @@ default is the type of the variable."
"UNION-TYPE"
;; Ignore name
(setq type (cdr type))
- (mapconcat 'identity (loop for a in type
+ (mapconcat #'identity (loop for a in type
if (and (consp a)
(string= (car a) "dimension"))
collect (format "dimension(%s)"
- (mapconcat 'identity
+ (mapconcat #'identity
(make-list (cdr a)
":")
","))
@@ -565,9 +556,10 @@ default is the type of the variable."
arglist "\n")))
(f90-mode)
(if (fboundp 'font-lock-ensure)
- (font-lock-ensure) (font-lock-fontify-buffer))
+ (font-lock-ensure)
+ (with-no-warnings (font-lock-fontify-buffer)))
(goto-char (point-min))
- (mapconcat 'identity
+ (mapconcat #'identity
(loop while (not (eobp))
collect (buffer-substring (line-beginning-position)
(- (line-end-position)
@@ -827,36 +819,17 @@ needs a reference count interface, so insert one."
(defun f90-parse-type-definition ()
"Parse a type definition at (or in front of) `point'."
- (let (type slots slot fn)
- (goto-char (point-min))
- (unless (re-search-forward "^[ \t]*type[ \t]+\\(.+?\\)[ \t]*$" nil t)
- (error "Trying parse a type but no type found"))
- (setq type (format "type(%s)" (f90-normalise-string (match-string 1))))
+ (goto-char (point-min))
+ (unless (re-search-forward "^[ \t]*type[ \t]+\\(.+?\\)[ \t]*$" nil t)
+ (error "Trying parse a type but no type found"))
+ (let ((type (format "type(%s)" (f90-normalise-string (match-string 1))))
+ (slots ()))
(while (not (eobp))
- (setq slot (f90-parse-single-type-declaration))
- (when slot
- (setf slots (nconc slot slots)))
- (forward-line 1))
- (eval (f90-make-type-struct type slots))
- (setq fn (intern-soft (format "make-f90-type.%s" type)))
- (unless fn
- (error "Something bad went wrong parsing type definition %s" type))
- (setf (gethash type f90-types) (funcall fn))))
-
-(defun f90-make-type-struct (type slots)
- "Create a struct describing TYPE with SLOTS."
- (let ((struct-name (make-symbol (format "f90-type.%s" type)))
- (varnames (reverse (mapcar (lambda (x)
- (setq x (car x))
- (if (string-match "\\([^(]+\\)(" x)
- (match-string 1 x)
- x)) slots))))
- `(defstruct (,struct-name
- (:conc-name ,(make-symbol (format "f90-type.%s." type))))
- (-varnames ',varnames :read-only t)
- ,@(loop for (name . rest) in slots
- collect `(,(make-symbol name) (cons ',name ',rest)
- :read-only t)))))
+ (let ((slot (f90-parse-single-type-declaration)))
+ (when slot
+ (setf slots (nconc slot slots)))
+ (forward-line 1)))
+ (setf (gethash type f90-types) slots)))
(defun f90-arglist-types ()
"Return the types of the arguments to the function at `point'."
@@ -939,7 +912,7 @@ with slot B of type REAL, then A%B is returned being a
REAL)."
collect (save-excursion
(save-restriction
(when (re-search-forward
- (format "^[ \t]*\\([^!\n].+?\\)[ \t]*::.*\\<%s\\>"
+ (format "^[ \t]*\\([^!\n].+?\\)[ \t]*::.*\\_<%s\\_>"
arg) nil t)
(goto-char (match-beginning 0))
(let ((type (assoc arg
diff --git a/packages/fsm/fsm.el b/packages/fsm/fsm.el
new file mode 100644
index 0000000..42dda15
--- /dev/null
+++ b/packages/fsm/fsm.el
@@ -0,0 +1,436 @@
+;;; fsm.el --- state machine library -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2006, 2007, 2008, 2015 Free Software Foundation, Inc.
+
+;; Author: Magnus Henoch <address@hidden>
+;; Maintainer: Thomas Fitzsimmons <address@hidden>
+;; Version: 0.2
+;; Package-Requires: ((emacs "24.1") (cl-lib "0.5"))
+;; Keywords: extensions
+
+;; 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 2, 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; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Commentary:
+
+;; fsm.el is an exercise in metaprogramming inspired by gen_fsm of
+;; Erlang/OTP. It aims to make asynchronous programming in Emacs Lisp
+;; easy and fun. By "asynchronous" I mean that long-lasting tasks
+;; don't interfer with normal editing.
+
+;; Some people say that it would be nice if Emacs Lisp had threads
+;; and/or continuations. They are probably right, but there are few
+;; things that can't be made to run in the background using facilities
+;; already available: timers, filters and sentinels. As the code can
+;; become a bit messy when using such means, with callbacks everywhere
+;; and such things, it can be useful to structure the program as a
+;; state machine.
+
+;; In this model, a state machine passes between different "states",
+;; which are actually only different event handler functions. The
+;; state machine receives "events" (from timers, filters, user
+;; requests, etc) and reacts to them, possibly entering another state,
+;; possibly returning a value.
+
+;; The essential macros/functions are:
+;;
+;; define-state-machine - create start-FOO function
+;; define-state - event handler for each state (required)
+;; define-enter-state - called when entering a state (optional)
+;; define-fsm - encapsulates the above three (more sugar!)
+;; fsm-send - send an event to a state machine
+;; fsm-call - send an event and wait for reply
+
+;; fsm.el is similar to but different from Distel:
+;; <URL:http://fresh.homeunix.net/~luke/distel/>
+;; Emacs' tq library is a similar idea.
+
+;; Here is a simple (not using all the features of fsm.el) example:
+;;
+;; ;; -*- lexical-binding: t; -*-
+;; (require 'fsm)
+;; (cl-labels ((hey (n ev)
+;; (message "%d (%s)\tp%sn%s!" n ev
+;; (if (zerop (% n 4)) "o" "i")
+;; (make-string (max 1 (abs n)) ?g))))
+;; (cl-macrolet ((zow (next timeout)
+;; `(progn (hey (cl-incf count) event)
+;; (list ,next count ,timeout))))
+;; (define-fsm pingpong
+;; :start ((init) "Start a pingpong fsm."
+;; (interactive "nInit (number, negative to auto-terminate): ")
+;; (list :ping (ash (ash init -2) 2) ; 4 is death
+;; (when (interactive-p) 0)))
+;; :state-data-name count
+;; :states
+;; ((:ping
+;; (:event (zow :pingg 0.1)))
+;; (:pingg
+;; (:event (zow :pinggg 0.1)))
+;; (:pinggg
+;; (:event (zow :pong 1)))
+;; (:pong
+;; (:event (zow :ping (if (= 0 count)
+;; (fsm-goodbye-cruel-world 'pingpong)
+;; 3))))))))
+;; (fsm-send (start-pingpong -16) t)
+;;
+;; Copy into a buffer, uncomment, and type M-x eval-buffer RET.
+;; Alternatively, you can replace the `fsm-goodbye-cruel-world'
+;; form with `nil', eval just the `cl-labels' form and then type
+;; M-x start-pingpong RET -16 RET.
+
+;; Version 0.2:
+;; -- Delete trailing whitespace.
+;; -- Fix formatting.
+;; -- Use lexical binding.
+;; -- Port to cl-lib.
+;; -- Remove unnecessary fsm-debug-output message.
+;; -- Add FSM name to fsm-debug-output messages that were not including it.
+;; -- Fix checkdoc errors.
+;; -- Change FSMs from plists to uninterned symbols.
+
+;; NOTE: This is version 0.1ttn4 of fsm.el, with the following
+;; mods (an exercise in meta-meta-programming ;-) by ttn:
+;; -- Refill for easy (traditional 80-column) perusal.
+;; -- New var `fsm-debug-timestamp-format'.
+;; -- Make variables satisfy `user-variable-p'.
+;; -- Use `format' instead of `concat'.
+;; -- New func `fsm-goodbye-cruel-world'.
+;; -- Make start-function respect `interactive' spec.
+;; -- Make enter-/event-functions anonymous.
+;; -- New macro `define-fsm'.
+;; -- Example usage in Commentary.
+
+;;; Code:
+
+;; We require cl-lib at runtime, since we insert `cl-destructuring-bind' into
+;; modules that use fsm.el.
+(require 'cl-lib)
+
+(defvar fsm-debug "*fsm-debug*"
+ "*Name of buffer for fsm debug messages.
+If nil, don't output debug messages.")
+
+(defvar fsm-debug-timestamp-format nil
+ "*Timestamp format (a string) for `fsm-debug-output'.
+Default format is whatever `current-time-string' returns
+followed by a colon and a space.")
+
+(defun fsm-debug-output (format &rest args)
+ "Append debug output to buffer named by the variable `fsm-debug'.
+FORMAT and ARGS are passed to `format'."
+ (when fsm-debug
+ (with-current-buffer (get-buffer-create fsm-debug)
+ (save-excursion
+ (goto-char (point-max))
+ (insert (if fsm-debug-timestamp-format
+ (format-time-string fsm-debug-timestamp-format)
+ (concat (current-time-string) ": "))
+ (apply 'format format args) "\n")))))
+
+(cl-defmacro define-state-machine (name &key start sleep)
+ "Define a state machine class called NAME.
+A function called start-NAME is created, which uses the argument
+list and body specified in the :start argument. BODY should
+return a list of the form (STATE STATE-DATA [TIMEOUT]), where
+STATE is the initial state (defined by `define-state'),
+STATE-DATA is any object, and TIMEOUT is the number of seconds
+before a :timeout event will be sent to the state machine. BODY
+may refer to the instance being created through the dynamically
+bound variable `fsm'.
+
+SLEEP-FUNCTION, if provided, takes one argument, the number of
+seconds to sleep while allowing events concerning this state
+machine to happen. There is probably no reason to change the
+default, which is accept-process-output with rearranged
+arguments.
+
+\(fn NAME :start ((ARG ...) DOCSTRING BODY) [:sleep SLEEP-FUNCTION])"
+ (declare (debug (&define name :name start
+ &rest
+ &or [":start"
+ (lambda-list
+ [&optional ("interactive" interactive)]
+ stringp def-body)]
+ [":sleep" function-form])))
+ (let ((start-name (intern (format "start-%s" name)))
+ interactive-spec)
+ (cl-destructuring-bind (arglist docstring &body body) start
+ (when (and (consp (car body)) (eq 'interactive (caar body)))
+ (setq interactive-spec (list (pop body))))
+ (unless (stringp docstring)
+ (error "Docstring is not a string"))
+ `(progn
+ (put ',name :fsm-enter (make-hash-table :size 11 :test 'eq))
+ (put ',name :fsm-event (make-hash-table :size 11 :test 'eq))
+ (defun ,start-name ,arglist
+ ,docstring
+ ,@interactive-spec
+ (fsm-debug-output "Starting %s" ',name)
+ (let ((fsm (cl-gensym (concat "fsm-" ,(symbol-name name) "-"))))
+ (cl-destructuring-bind (state state-data &optional timeout)
+ (progn ,@body)
+ (put fsm :name ',name)
+ (put fsm :state nil)
+ (put fsm :state-data nil)
+ (put fsm :sleep ,(or sleep (lambda (secs)
+ (accept-process-output
+ nil secs))))
+ (put fsm :deferred nil)
+ (fsm-update fsm state state-data timeout)
+ fsm)))))))
+
+(cl-defmacro define-state (fsm-name state-name arglist &body body)
+ "Define a state called STATE-NAME in the state machine FSM-NAME.
+ARGLIST and BODY make a function that gets called when the state
+machine receives an event in this state. The arguments are:
+
+FSM the state machine instance (treat it as opaque)
+STATE-DATA An object
+EVENT The occurred event, an object.
+CALLBACK A function of one argument that expects the response
+ to this event, if any (often `ignore' is used)
+
+If the event should return a response, the state machine should
+arrange to call CALLBACK at some point in the future (not necessarily
+in this handler).
+
+The function should return a list of the form (NEW-STATE
+NEW-STATE-DATA TIMEOUT):
+
+NEW-STATE The next state, a symbol
+NEW-STATE-DATA An object
+TIMEOUT A number: send timeout event after this many seconds
+ nil: cancel existing timer
+ :keep: let existing timer continue
+
+Alternatively, the function may return the keyword :defer, in
+which case the event will be resent when the state machine enters
+another state."
+ (declare (debug (&define name name :name handler lambda-list def-body)))
+ `(setf (gethash ',state-name (get ',fsm-name :fsm-event))
+ (lambda ,arglist ,@body)))
+
+(cl-defmacro define-enter-state (fsm-name state-name arglist &body body)
+ "Define a function to call when FSM-NAME enters the state STATE-NAME.
+ARGLIST and BODY make a function that gets called when the state
+machine enters this state. The arguments are:
+
+FSM the state machine instance (treat it as opaque)
+STATE-DATA An object
+
+The function should return a list of the form (NEW-STATE-DATA
+TIMEOUT):
+
+NEW-STATE-DATA An object
+TIMEOUT A number: send timeout event after this many seconds
+ nil: cancel existing timer
+ :keep: let existing timer continue"
+ (declare (debug (&define name name :name enter lambda-list def-body)))
+ `(setf (gethash ',state-name (get ',fsm-name :fsm-enter))
+ (lambda ,arglist ,@body)))
+
+(cl-defmacro define-fsm (name &key
+ start sleep states
+ (fsm-name 'fsm)
+ (state-data-name 'state-data)
+ (callback-name 'callback)
+ (event-name 'event))
+ "Define a state machine class called NAME, along with its STATES.
+This macro is (further) syntatic sugar for `define-state-machine',
+`define-state' and `define-enter-state' macros, q.v.
+
+NAME is a symbol. Everything else is specified with a keyword arg.
+
+START and SLEEP are the same as for `define-state-machine'.
+
+STATES is a list, each element having the form (STATE-NAME . STATE-SPEC).
+STATE-NAME is a symbol. STATE-SPEC is an alist with keys `:event' or
+`:enter', and values a series of expressions representing the BODY of
+a `define-state' or `define-enter-state' call, respectively.
+
+FSM-NAME, STATE-DATA-NAME, CALLBACK-NAME, and EVENT-NAME are symbols,
+used to construct the state functions' arglists."
+ `(progn
+ (define-state-machine ,name :start ,start :sleep ,sleep)
+ ,@(cl-loop for (state-name . spec) in states
+ if (assq :enter spec) collect
+ `(define-enter-state ,name ,state-name
+ (,fsm-name ,state-data-name)
+ ,@(cdr it))
+ end
+ if (assq :event spec) collect
+ `(define-state ,name ,state-name
+ (,fsm-name ,state-data-name
+ ,event-name
+ ,callback-name)
+ ,@(cdr it))
+ end)))
+
+(defun fsm-goodbye-cruel-world (name)
+ "Unbind functions related to fsm NAME (a symbol).
+Includes start-NAME, and each fsm-NAME-STATE and fsm-NAME-enter-STATE.
+Functions are `fmakunbound', which will probably give (fatal) pause to
+any state machines using them. Return nil."
+ (interactive "SUnbind function definitions for fsm named: ")
+ (fmakunbound (intern (format "start-%s" name)))
+ (let (ht)
+ (when (hash-table-p (setq ht (get name :fsm-event)))
+ (clrhash ht)
+ (cl-remprop name :fsm-event))
+ (when (hash-table-p (setq ht (get name :fsm-enter)))
+ (clrhash ht)
+ (cl-remprop name :fsm-enter)))
+ nil)
+
+(defun fsm-start-timer (fsm secs)
+ "Send a timeout event to FSM after SECS seconds.
+The timer is canceled if another event occurs before, unless the
+event handler explicitly asks to keep the timer."
+ (fsm-stop-timer fsm)
+ (put fsm
+ :timeout (run-with-timer
+ secs nil
+ #'fsm-send-sync fsm :timeout)))
+
+(defun fsm-stop-timer (fsm)
+ "Stop the timeout timer of FSM."
+ (let ((timer (get fsm :timeout)))
+ (when (timerp timer)
+ (cancel-timer timer)
+ (put fsm :timeout nil))))
+
+(defun fsm-maybe-change-timer (fsm timeout)
+ "Change the timer of FSM according to TIMEOUT."
+ (cond
+ ((numberp timeout)
+ (fsm-start-timer fsm timeout))
+ ((null timeout)
+ (fsm-stop-timer fsm))
+ ;; :keep needs no timer change
+ ))
+
+(defun fsm-send (fsm event &optional callback)
+ "Send EVENT to FSM asynchronously.
+If the state machine generates a response, eventually call
+CALLBACK with the response as only argument."
+ (run-with-timer 0 nil #'fsm-send-sync fsm event callback))
+
+(defun fsm-update (fsm new-state new-state-data timeout)
+ "Update FSM with NEW-STATE, NEW-STATE-DATA and TIMEOUT."
+ (let ((fsm-name (get fsm :name))
+ (old-state (get fsm :state)))
+ (put fsm :state new-state)
+ (put fsm :state-data new-state-data)
+ (fsm-maybe-change-timer fsm timeout)
+
+ ;; On state change, call enter function and send deferred events
+ ;; again.
+ (unless (eq old-state new-state)
+ (fsm-debug-output "%s enters %s" fsm-name new-state)
+ (let ((enter-fn (gethash new-state (get fsm-name :fsm-enter))))
+ (when (functionp enter-fn)
+ (fsm-debug-output "Found enter function for %s/%s" fsm-name new-state)
+ (condition-case e
+ (cl-destructuring-bind (newer-state-data newer-timeout)
+ (funcall enter-fn fsm new-state-data)
+ (put fsm :state-data newer-state-data)
+ (fsm-maybe-change-timer fsm newer-timeout))
+ ((debug error)
+ (fsm-debug-output "%s/%s update didn't work: %S"
+ fsm-name new-state e)))))
+
+ (let ((deferred (nreverse (get fsm :deferred))))
+ (put fsm :deferred nil)
+ (dolist (event deferred)
+ (apply 'fsm-send-sync fsm event))))))
+
+(defun fsm-send-sync (fsm event &optional callback)
+ "Send EVENT to FSM synchronously.
+If the state machine generates a response, eventually call
+CALLBACK with the response as only argument."
+ (save-match-data
+ (let* ((fsm-name (get fsm :name))
+ (state (get fsm :state))
+ (state-data (get fsm :state-data))
+ (state-fn (gethash state (get fsm-name :fsm-event))))
+ ;; If the event is a list, output only the car, to avoid an
+ ;; overflowing debug buffer.
+ (fsm-debug-output "Sent %S to %s in state %s"
+ (or (car-safe event) event) fsm-name state)
+ (let ((result (condition-case e
+ (funcall state-fn fsm state-data event
+ (or callback 'ignore))
+ ((debug error) (cons :error-signaled e)))))
+ ;; Special case for deferring an event until next state change.
+ (cond
+ ((eq result :defer)
+ (let ((deferred (get fsm :deferred)))
+ (put fsm :deferred (cons (list event callback) deferred))))
+ ((null result)
+ (fsm-debug-output "Warning: event %S ignored in state %s/%s"
+ event fsm-name state))
+ ((eq (car-safe result) :error-signaled)
+ (fsm-debug-output "Error in %s/%s: %s"
+ fsm-name state
+ (error-message-string (cdr result))))
+ ((and (listp result)
+ (<= 2 (length result))
+ (<= (length result) 3))
+ (cl-destructuring-bind (new-state new-state-data &optional timeout)
+ result
+ (fsm-update fsm new-state new-state-data timeout)))
+ (t
+ (fsm-debug-output "Incorrect return value in %s/%s: %S"
+ fsm-name state
+ result)))))))
+
+(defun fsm-call (fsm event)
+ "Send EVENT to FSM synchronously, and wait for a reply.
+Return the reply. `with-timeout' might be useful."
+ (let (reply)
+ (fsm-send-sync fsm event (lambda (r) (setq reply (list r))))
+ (while (null reply)
+ (fsm-sleep fsm 1))
+ (car reply)))
+
+(defun fsm-make-filter (fsm)
+ "Return a filter function that sends events to FSM.
+Events sent are of the form (:filter PROCESS STRING)."
+ (let ((fsm fsm))
+ (lambda (process string)
+ (fsm-send-sync fsm (list :filter process string)))))
+
+(defun fsm-make-sentinel (fsm)
+ "Return a sentinel function that sends events to FSM.
+Events sent are of the form (:sentinel PROCESS STRING)."
+ (let ((fsm fsm))
+ (lambda (process string)
+ (fsm-send-sync fsm (list :sentinel process string)))))
+
+(defun fsm-sleep (fsm secs)
+ "Sleep up to SECS seconds in a way that lets FSM receive events."
+ (funcall (get fsm :sleep) secs))
+
+(defun fsm-get-state-data (fsm)
+ "Return the state data of FSM.
+Note the absence of a set function. The fsm should manage its
+state data itself; other code should just send messages to it."
+ (get fsm :state-data))
+
+(provide 'fsm)
+
+;;; fsm.el ends here
diff --git a/packages/ggtags/README.rst b/packages/ggtags/README.rst
index f7ed951..eda0427 100644
--- a/packages/ggtags/README.rst
+++ b/packages/ggtags/README.rst
@@ -4,7 +4,7 @@
This package is part of `GNU ELPA <http://elpa.gnu.org>`_ (``M-x
list-packages``) and is also available on `MELPA
-<http://melpa.milkbox.net/#/ggtags>`_.
+<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
@@ -61,10 +61,11 @@ Install Global and plugins
./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/README`` in GNU
- Global source for further information.
+ 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
@@ -222,7 +223,7 @@ turned on to facilitate locating the right match.
Miscellaneous commands
++++++++++++++++++++++
-Commands are avaiable from the ``Ggtags`` menu in ``ggtags-mode``.
+Commands are available from the ``Ggtags`` menu in ``ggtags-mode``.
ggtags-prev-mark
@@ -264,10 +265,14 @@ 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 porject in a browser with cross-references.
+ browsing the project in a browser with cross-references.
Integration with other packages
+++++++++++++++++++++++++++++++
@@ -308,6 +313,23 @@ Integration with other packages
NEWS
~~~~
+[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
++++++++++++++++++++++
diff --git a/packages/ggtags/ggtags.el b/packages/ggtags/ggtags.el
index d3973b2..08fb4c8 100644
--- a/packages/ggtags/ggtags.el
+++ b/packages/ggtags/ggtags.el
@@ -3,7 +3,7 @@
;; Copyright (C) 2013-2015 Free Software Foundation, Inc.
;; Author: Leo Liu <address@hidden>
-;; Version: 0.8.9
+;; Version: 0.8.11
;; Keywords: tools, convenience
;; Created: 2013-01-29
;; URL: https://github.com/leoliu/ggtags
@@ -36,10 +36,11 @@
;;
;; All commands are available from the `Ggtags' menu in `ggtags-mode'.
-;;; NEWS 0.8.9 (2015-01-16):
+;;; NEWS 0.8.11 (2015-12-15):
-;; - `ggtags-visit-project-root' can visit past projects.
-;; - `eldoc' support enabled for emacs 24.4+.
+;; - `ggtags-highlight-tag-delay' is renamed to `ggtags-highlight-tag'
+;; - Tag highlighting can be disabled by setting
+;; `ggtags-highlight-tag' to nil.
;;
;; See full NEWS on https://github.com/leoliu/ggtags#news
@@ -206,6 +207,21 @@ isn't built with sqlite3 support."
:safe 'booleanp
:group 'ggtags)
+(defcustom ggtags-sort-by-nearness nil
+ "Sort tags by nearness to current directory.
+GNU Global 6.5+ required."
+ :type 'boolean
+ :safe #'booleanp
+ :group 'ggtags)
+
+(defcustom ggtags-update-on-save t
+ "Non-nil to update tags for current buffer on saving."
+ ;; It is reported that `global --single-update' can be slow in sshfs
+ ;; directories. See https://github.com/leoliu/ggtags/issues/85.
+ :safe #'booleanp
+ :type 'boolean
+ :group 'ggtags)
+
(defcustom ggtags-global-output-format 'grep
"Global output format: path, ctags, ctags-x, grep or cscope."
:type '(choice (const path)
@@ -313,13 +329,17 @@ Nil means using the value of `completing-read-function'."
function)
:group 'ggtags)
-(defcustom ggtags-highlight-tag-delay 0.25
- "Time in seconds before highlighting tag at point."
+(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 (bound-and-true-p ggtags-highlight-tag-timer)
- (timer-set-idle-time ggtags-highlight-tag-timer value t))
+ (when (fboundp 'ggtags-setup-highlight-tag-at-point)
+ (ggtags-setup-highlight-tag-at-point value))
(set-default sym value))
- :type 'number
+ :type '(choice (const :tag "Disable" nil) number)
:group 'ggtags)
(defcustom ggtags-bounds-of-tag-function (lambda ()
@@ -629,7 +649,7 @@ When called with a prefix \\[universal-argument], choose
from past projects."
(ggtags-ensure-localname
(directory-file-name
(ggtags-current-project-root)))))
(process-environment
- (append (let ((process-environment process-environment))
+ (append (let ((process-environment (copy-sequence
process-environment)))
(and ,gtagsroot (setenv "GTAGSROOT" ,gtagsroot))
(mapcar #'substitute-env-vars
ggtags-process-environment))
process-environment
@@ -685,7 +705,7 @@ 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 process-environment))
+ (let ((process-environment (copy-sequence process-environment)))
(when (zerop (length root)) (error "No root directory provided"))
(setenv "GTAGSROOT" (ggtags-ensure-localname
(expand-file-name
@@ -721,6 +741,16 @@ source trees. See Info node `(global)gtags' for details."
(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.
@@ -850,6 +880,10 @@ blocking emacs."
(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"))
@@ -860,6 +894,7 @@ blocking emacs."
(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")
@@ -896,7 +931,8 @@ blocking emacs."
(let* ((default-directory (or directory (ggtags-current-project-root)))
(split-window-preferred-function ggtags-split-window-function)
(env ggtags-process-environment))
- (unless (markerp ggtags-global-start-marker)
+ (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)
@@ -921,7 +957,8 @@ blocking emacs."
(defun ggtags-find-tag (cmd &rest args)
(ggtags-check-project)
- (ggtags-global-start (apply #'ggtags-global-build-command cmd args)))
+ (ggtags-global-start (apply #'ggtags-global-build-command cmd args)
+ (and (ggtags-sort-by-nearness-p) default-directory)))
(defun ggtags-include-file ()
"Calculate the include file based on `ggtags-include-pattern'."
@@ -961,13 +998,16 @@ definition tags."
(not (ggtags-project-has-refs (ggtags-find-project)))
(not (ggtags-project-file-p buffer-file-name)))
(ggtags-find-definition name))
- (t (ggtags-find-tag (format "--from-here=%d:%s"
- (line-number-at-pos)
- (shell-quote-argument
- ;; Note `ggtags-global-start' binds
- ;; default-directory to project root.
- (ggtags-project-relative-file
buffer-file-name)))
- (shell-quote-argument name)))))
+ (t (ggtags-find-tag
+ (format "--from-here=%d:%s"
+ (line-number-at-pos)
+ (shell-quote-argument
+ ;; Note `ggtags-find-tag' may bind `default-directory'
+ ;; to project root.
+ (funcall (if (ggtags-sort-by-nearness-p)
+ #'file-relative-name
#'ggtags-project-relative-file)
+ buffer-file-name)))
+ (shell-quote-argument name)))))
(defun ggtags-find-tag-mouse (event)
(interactive "e")
@@ -1585,19 +1625,23 @@ commands `next-error' and `previous-error'.
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)
- ;;
- ;; Can't call `compile-goto-error' here becuase
+ (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
- (ggtags-delay-finish-functions
- (let
((compilation-auto-jump-to-first-error t))
- (with-display-buffer-no-window
- (compilation-auto-jump buf
pt)))))))
- (current-buffer) (point)))
+ (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)
@@ -1937,7 +1981,7 @@ commands `next-error' and `previous-error'.
(defun ggtags-after-save-function ()
(when (ggtags-find-project)
(ggtags-project-update-mtime-maybe)
- (and buffer-file-name
+ (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)
@@ -1985,6 +2029,7 @@ When finished invoke CALLBACK in BUFFER with process exit
status."
(delay-mode-hooks (funcall mode))
(setq font-lock-mode t)
(funcall font-lock-function font-lock-mode)
+ (setq jit-lock-mode nil)
(current-buffer))))
(with-current-buffer (prepare-buffer)
(let ((inhibit-read-only t))
@@ -2161,10 +2206,7 @@ to nil disables displaying this information.")
;;;###autoload
(define-minor-mode ggtags-mode nil
:lighter (:eval (if ggtags-navigation-mode "" " GG"))
- (unless (timerp ggtags-highlight-tag-timer)
- (setq ggtags-highlight-tag-timer
- (run-with-idle-timer
- ggtags-highlight-tag-delay t #'ggtags-highlight-tag-at-point)))
+ (ggtags-setup-highlight-tag-at-point ggtags-highlight-tag)
(if ggtags-mode
(progn
(add-hook 'after-save-hook 'ggtags-after-save-function nil t)
@@ -2187,9 +2229,7 @@ to nil disables displaying this information.")
(remove-function (local 'eldoc-documentation-function)
'ggtags-eldoc-function)
(setq mode-line-buffer-identification
(delq 'ggtags-mode-line-project-name
mode-line-buffer-identification))
- (and (overlayp ggtags-highlight-tag-overlay)
- (delete-overlay ggtags-highlight-tag-overlay))
- (setq ggtags-highlight-tag-overlay nil)))
+ (ggtags-cancel-highlight-tag-at-point 'keep-timer)))
(defvar ggtags-highlight-tag-map
(let ((map (make-sparse-keymap)))
@@ -2209,6 +2249,22 @@ to nil disables displaying this information.")
(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)
@@ -2256,7 +2312,13 @@ to nil disables displaying this information.")
;; Prevent multiple runs of ggtags-show-definition
;; for the same tag.
(setq ggtags-eldoc-cache (list tag))
- (ggtags-show-definition 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
diff --git a/packages/gnome-c-style/.gitignore
b/packages/gnome-c-style/.gitignore
new file mode 100644
index 0000000..7c5214c
--- /dev/null
+++ b/packages/gnome-c-style/.gitignore
@@ -0,0 +1,2 @@
+*.elc
+
diff --git a/packages/gnome-c-style/Makefile b/packages/gnome-c-style/Makefile
new file mode 100644
index 0000000..571841e
--- /dev/null
+++ b/packages/gnome-c-style/Makefile
@@ -0,0 +1,16 @@
+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
new file mode 120000
index 0000000..42061c0
--- /dev/null
+++ b/packages/gnome-c-style/README
@@ -0,0 +1 @@
+README.md
\ No newline at end of file
diff --git a/packages/gnome-c-style/README.md b/packages/gnome-c-style/README.md
new file mode 100644
index 0000000..69532eb
--- /dev/null
+++ b/packages/gnome-c-style/README.md
@@ -0,0 +1,88 @@
+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
new file mode 100644
index 0000000..734800a
--- /dev/null
+++ b/packages/gnome-c-style/gnome-c-align.el
@@ -0,0 +1,547 @@
+;; gnome-c-align.el --- GNOME-style code alignment -*- lexical-binding: t; -*-
+;; Copyright (C) 2016 Free Software Foundation, Inc.
+
+;; Author: Daiki Ueno <address@hidden>
+;; 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
new file mode 100644
index 0000000..95c5f6d
--- /dev/null
+++ b/packages/gnome-c-style/gnome-c-snippet.el
@@ -0,0 +1,703 @@
+;;; gnome-c-snippet.el --- GNOME-style code generation -*- lexical-binding: t;
-*-
+;; Copyright (C) 2016 Free Software Foundation, Inc.
+
+;; Author: Daiki Ueno <address@hidden>
+;; 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
new file mode 100644
index 0000000..66c6578
--- /dev/null
+++ b/packages/gnome-c-style/gnome-c-style.el
@@ -0,0 +1,74 @@
+;;; 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 <address@hidden>
+;; Keywords: GNOME, C, coding style
+;; Version: 0.1
+;; Maintainer: Daiki Ueno <address@hidden>
+
+;; 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
new file mode 100644
index 0000000..17dbfe1
--- /dev/null
+++ b/packages/gnome-c-style/gnome-c-tests.el
@@ -0,0 +1,284 @@
+;;; gnome-c-tests.el --- tests for gnome-c-style -*- lexical-binding: t; -*-
+;; Copyright (C) 2016 Free Software Foundation, Inc.
+
+;; Author: Daiki Ueno <address@hidden>
+;; 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/gnorb/NEWS b/packages/gnorb/NEWS
index 59bc343..623f685 100644
--- a/packages/gnorb/NEWS
+++ b/packages/gnorb/NEWS
@@ -1,5 +1,15 @@
GNU Emacs Gnorb NEWS -- history of user-visible changes. -*- org -*-
+* Version 1.1.0 [2015-04-23 Thu]
+** New trigger actions
+Two new trigger actions allow you to capture a new sibling or child
+heading relative to the heading you're triggering.
+** Persistent Gnorb groups
+Give a prefix argument to `gnorb-org-view' to create a named,
+persistent group containing tracked headings.
+** Gnorb registry usage reports
+Call `gnorb-report-tracking-usage' to see how much of the Gnus
+registry Gnorb is occupying, and run cleaning routines.
* Version 1.0.1 [2014-10-22 Wed]
** Deleting associations
It's now possible to delete associations between messages and
diff --git a/packages/gnorb/README.org b/packages/gnorb/README.org
index 1f8f82f..9e2f9bd 100644
--- a/packages/gnorb/README.org
+++ b/packages/gnorb/README.org
@@ -16,7 +16,31 @@ mini mailboxes.
*Note for previous users*: If you were using Gnorb from Github before
it shifted to the Elpa repository, the email tracking mechanism has
changed, please see the manual for details.
+** Known bugs/issues
+*** Gnus Registry
+Prior to late December, 2014, the Gnus registry had some issues with
+preserving "precious" entries while pruning.
+When the registry approaches its maximum size it will delete excess
+entries, a process referred to as "pruning". "Precious" entries are
+those that contain important information: they should not be pruned.
+
+Gnorb uses the registry to track associations between messages and Org
+headings, and marks those entries as precious. The entire process of
+tracking, in fact, relies on these entries being preserved, and Gnorb
+goes to some lengths to protect this information. Older versions of
+the registry could nevertheless delete those entries.
+
+These issues are fixed circa the end of December, 2014, around "Ma
+Gnus v0.12", whatever that means. If you think there's a possibility
+your registry is full, and associations are being deleted, you might
+consider upgrading to a recent Gnus.
+*** Multiple Associations
+Gnorb theoretically supports email messages being associated with
+multiple Org headings. In practice, however, this situation hasn't
+been thought through completely, and you may experience weirdness. If
+you do, and you have some ideas about how it should be handled, please
+contact the author and suggest them.
** Installation
It's easiest to install Gnorb from Elpa: run `list-packages' and look
@@ -60,7 +84,10 @@ composing messages from... Or maybe it's just a case of NIH.
Provide an Org Agenda command that does an email search for messages
received in the visible date span, or day under point, etc. Make it
work in the calendar, as well?
-*** TODO Capture to child/subtree trigger actions
+*** DONE Capture to child/subtree trigger actions
+:LOGBOOK:
+- State "DONE" from "TODO" [2015-03-17 Tue 17:42]
+:END:
Add trigger actions that create new sibling or child headings on the
original Org heading.
*** TODO Gnus message tagging
diff --git a/packages/gnorb/gnorb-bbdb.el b/packages/gnorb/gnorb-bbdb.el
index 572a4b9..306ea01 100644
--- a/packages/gnorb/gnorb-bbdb.el
+++ b/packages/gnorb/gnorb-bbdb.el
@@ -150,8 +150,6 @@ be composed, just as in `gnus-posting-styles'.
An example value might look like:"
:group 'gnorb-bbdb)
-(defvar message-mode-hook)
-
(when (fboundp 'bbdb-record-xfield-string)
(fset (intern (format "bbdb-read-xfield-%s"
gnorb-bbdb-org-tag-field))
@@ -207,6 +205,8 @@ Org tags are stored in the `gnorb-bbdb-org-tags-field'."
(insert
(bbdb-indent-string (concat val "\n") indent)))))))
+(defvar message-mode-hook)
+
;;;###autoload
(defun gnorb-bbdb-mail (records &optional subject n verbose)
"\\<bbdb-mode-map>Acts just like `bbdb-mail', except runs
@@ -255,24 +255,34 @@ is non-nil (as in interactive calls) be verbose."
(unless (fboundp field)
;; what's the record's existing value for this field?
(setq rec-val (bbdb-record-field r field)))
- (when (cond
- ((eq field 'address)
- (dolist (a rec-val)
- (unless (and label
- (not (string-match label (car a))))
- (string-match val (bbdb-format-address-default a)))))
- ((eq field 'phone)
- (dolist (p rec-val)
- (unless (and label
- (not (string-match label (car p))))
- (string-match val (bbdb-phone-string p)))))
- ((consp rec-val)
- (dolist (f rec-val)
- (string-match val f)))
- ((fboundp field)
- (funcall field r))
- ((stringp rec-val)
- (string-match val rec-val)))
+ (when (catch 'match
+ (cond
+ ((eq field 'address)
+ (dolist (a rec-val)
+ (unless (and label
+ (not (string-match label (car a))))
+ (when
+ (string-match-p
+ val
+ (bbdb-format-address-default a))
+ (throw 'match t)))))
+ ((eq field 'phone)
+ (dolist (p rec-val)
+ (unless (and label
+ (not (string-match label (car p))))
+ (when
+ (string-match-p val (bbdb-phone-string p))
+ (throw 'match t)))))
+ ((consp rec-val)
+ (dolist (f rec-val)
+ (when (string-match-p val f)
+ (throw 'match t))))
+ ((fboundp field)
+ (when (string-match-p (funcall field r))
+ (throw 'match t)))
+ ((stringp rec-val)
+ (when (string-match-p val rec-val)
+ (throw 'match t)))))
;; there are matches, run through the field setters in last
;; element of the sexp
(dolist (attribute style)
@@ -392,14 +402,16 @@ both, use \"C-u\" before the \"*\"."
(mapconcat
'identity
(delete-dups
- (cl-mapcan (lambda (r)
- (bbdb-record-xfield-split r gnorb-bbdb-org-tag-field))
- records))
+ (cl-mapcan
+ (lambda (r)
+ (bbdb-record-xfield-split r gnorb-bbdb-org-tag-field))
+ records))
"|")))
(if tag-string
;; C-u = all headings, not just todos
- (org-tags-view (not (equal current-prefix-arg '(4)))
- tag-string)
+ (if (equal current-prefix-arg '(4))
+ (org-tags-view nil tag-string)
+ (org-tags-view t tag-string))
(error "No org-tags field present"))))
;;;###autoload
@@ -424,9 +436,9 @@ a prefix arg and \"*\", the prefix arg must come first."
(when (equal current-prefix-arg '(4))
(setq search-string
(read-from-minibuffer
- (format "%s search string: " (cl-first backend)) search-string)))
+ (format "%s search string: " (first backend)) search-string)))
(funcall (cl-third backend) search-string)
- (delete-other-windows)))
+ (delete-other-windows)))
;;;###autoload
(defun gnorb-bbdb-cite-contact (rec)
@@ -437,9 +449,8 @@ a prefix arg and \"*\", the prefix arg must come first."
mail-string)))
;;; Field containing links to recent messages
-
(when (boundp 'bbdb-xfield-label-list)
- (add-to-list 'bbdb-xfield-label-list gnorb-bbdb-messages-field nil 'eq))
+ (add-to-list 'bbdb-xfield-label-list gnorb-bbdb-messages-field nil 'eq))
(defun gnorb-bbdb-display-messages (record format)
"Show links to the messages collected in the
@@ -594,16 +605,10 @@ to a message into the record's
`gnorb-bbdb-messages-field'."
(parse-time-string (mail-header-date heads))))
(subject (mail-header-subject heads))
(id (mail-header-id heads))
- (group gnus-newsgroup-name)
+ (group (gnorb-get-real-group-name
+ gnus-newsgroup-name
+ art-no))
link)
- ;; check for both nnvirtual and nnir, and link to the real
- ;; group in those cases
- (when (eq (car (gnus-find-method-for-group group))
- 'nnvirtual)
- (setq group (car (nnvirtual-map-article art-no))))
- (when (eq (car (gnus-find-method-for-group group))
- 'nnir)
- (setq group (nnir-article-group art-no)))
(if (not (and date subject id group))
(message "Could not save a link to this message")
(setq link (make-gnorb-bbdb-link :subject subject :date date
@@ -617,7 +622,7 @@ to a message into the record's `gnorb-bbdb-messages-field'."
(time-less-p
(gnorb-bbdb-link-date b)
(gnorb-bbdb-link-date a))))))
- (setq val (cl-subseq val 0 gnorb-bbdb-collect-N-messages))
+ (setq val (cl-subseq val 0 (min (length val)
gnorb-bbdb-collect-N-messages)))
(bbdb-record-set-xfield record
gnorb-bbdb-messages-field
(delq nil val))
diff --git a/packages/gnorb/gnorb-gnus.el b/packages/gnorb/gnorb-gnus.el
index 2d3c5b0..e425ca2 100644
--- a/packages/gnorb/gnorb-gnus.el
+++ b/packages/gnorb/gnorb-gnus.el
@@ -107,6 +107,12 @@ Basically behave as if all attachments have
\":gnus-attachments t\"."
:group 'gnorb-gnus
:type 'string)
+(defcustom gnorb-gnus-summary-tracked-mark "&"
+ "Default mark to insert in the summary format line of articles
+ that are already tracked by TODO headings."
+ :group 'gnorb-gnus
+ :type 'string)
+
(defcustom gnorb-gnus-trigger-refile-targets
'((org-agenda-files :maxlevel . 4))
"A value to use as an equivalent of `org-refile-targets' (which
@@ -189,7 +195,7 @@ save them into `gnorb-tmp-dir'."
(set-buffer (org-capture-get :original-buffer)))
(unless (memq major-mode '(gnus-summary-mode gnus-article-mode))
(error "Only works in Gnus summary or article buffers"))
- (let ((article (gnus-summary-article-number))
+ (let ((article (gnus-summary-article-number))
mime-handles)
(when (or (null gnus-current-article)
(null gnus-article-current)
@@ -233,18 +239,20 @@ save them into `gnorb-tmp-dir'."
(add-hook 'org-capture-mode-hook 'gnorb-gnus-capture-attach)
+(defvar org-note-abort)
+
(defun gnorb-gnus-capture-abort-cleanup ()
- (when (and org-note-abort
- (org-capture-get :gnus-attachments))
- ;; FIXME: Yuck: setting `abort-note' will fail as soon as org-capture.el is
- ;; compiled with lexical-binding!
- (condition-case nil
- (progn (org-attach-delete-all)
- (setq abort-note 'clean)
- ;; remove any gnorb-mail-header values here
- )
- (error
- (setq abort-note 'dirty)))))
+ (with-no-warnings ; For `org-note-abort'
+ (when (and org-note-abort
+ (or gnorb-gnus-capture-always-attach
+ (org-capture-get :gnus-attachments)))
+ (condition-case error
+ (progn (org-attach-delete-all)
+ (setq abort-note 'clean)
+ ;; remove any gnorb-mail-header values here
+ )
+ (error
+ (setq abort-note 'dirty))))))
(add-hook 'org-capture-prepare-finalize-hook
'gnorb-gnus-capture-abort-cleanup)
@@ -297,11 +305,11 @@ information about the outgoing message into
;; `gnorb-org-setup-message' may have put this here, but
;; if we're working from a draft, or triggering this from
;; a reply, it might not be there yet.
- (add-to-list 'message-exit-actions
+ (add-to-list 'message-send-actions
'gnorb-org-restore-after-send t))
(setq gnorb-message-org-ids nil)))))
-(add-hook 'message-header-hook 'gnorb-gnus-check-outgoing-headers)
+(add-hook 'message-sent-hook 'gnorb-gnus-check-outgoing-headers t)
;;;###autoload
(defun gnorb-gnus-outgoing-do-todo (&optional arg)
@@ -379,10 +387,9 @@ work."
(save-excursion
(save-restriction
(widen)
- (setq message-exit-actions
- (remove 'gnorb-org-restore-after-send
- (remove 'gnorb-gnus-outgoing-make-todo-1
- message-exit-actions)))
+ (setq message-send-actions
+ (remove 'gnorb-gnus-outgoing-make-todo-1
+ message-send-actions))
(message-narrow-to-headers-or-head)
(message-remove-header
gnorb-mail-header)
@@ -422,12 +429,9 @@ work."
;; message
(push h header-ids)))))
(goto-char compose-marker)
- (add-to-list
- 'message-exit-actions
- (if header-ids
- 'gnorb-org-restore-after-send
- 'gnorb-gnus-outgoing-make-todo-1)
- t)
+ (unless header-ids
+ (add-to-list 'message-send-actions
+ 'gnorb-gnus-outgoing-make-todo-1 t))
(message
(if header-ids
"Message will trigger TODO state-changes after sending"
@@ -486,18 +490,21 @@ work."
(defun gnorb-gnus-incoming-do-todo (arg &optional id)
"Call this function from a received gnus message to store a
link to the message, prompt for a related Org heading, visit the
-heading, and either add a note or trigger a TODO state change.
-Set `gnorb-trigger-todo-default' to 'note or 'todo (you can
-get the non-default behavior by calling this function with a
-prefix argument), or to 'prompt to always be prompted.
-
-In some cases, Gnorb can guess for you which Org heading you
-probably want to trigger, which can save some time. It does this
-by looking in the References header, and seeing if any of the IDs
-there match the value of the `gnorb-org-msg-id-key' property for
-any headings. In order for this to work, you will have to have
-loaded org-id, and have the variable `org-id-track-globally' set
-to t (it is, by default)."
+heading, and trigger an action on it \(see
+`gnorb-org-trigger-actions'\).
+
+If you've set up message tracking \(with
+`gnorb-tracking-initialize'\), Gnorb can guess which Org heading
+you probably want to trigger, which can save some time. It does
+this by looking in the References header, and seeing if any of
+the messages referenced there are already being tracked by any
+headings.
+
+If you mark several messages before calling this function, or
+call it with a numerical prefix arg, those messages will be
+\"bulk associated\" with the chosen Org heading: associations
+will be made, but you won't be prompted to trigger an action, and
+you'll stay in the Gnus summary buffer."
(interactive "P")
(when (not (memq major-mode '(gnus-summary-mode gnus-article-mode)))
(user-error "Only works in gnus summary or article mode"))
@@ -507,15 +514,18 @@ to t (it is, by default)."
(setq gnorb-window-conf (current-window-configuration))
(move-marker gnorb-return-marker (point))
(setq gnorb-gnus-message-info nil)
- (let* ((headers (gnus-data-header
- (gnus-data-find
- (gnus-summary-article-number))))
+ (let* ((articles (gnus-summary-work-articles arg))
+ (art-no (gnus-summary-article-number))
+ (headers (gnus-data-header
+ (gnus-data-find art-no)))
(msg-id (mail-header-id headers))
(from (mail-header-from headers))
(subject (mail-header-subject headers))
(date (mail-header-date headers))
(to (cdr (assoc 'To (mail-header-extra headers))))
- (group gnus-newsgroup-name)
+ (group (gnorb-get-real-group-name
+ gnus-newsgroup-name
+ art-no))
(link (call-interactively 'org-store-link))
(org-refile-targets gnorb-gnus-trigger-refile-targets)
(ref-msg-ids (concat (mail-header-references headers) " "
@@ -532,37 +542,111 @@ to t (it is, by default)."
:link ,link :date ,date :refs ,ref-msg-ids
:group ,group))
(gnorb-gnus-collect-all-attachments nil t)
- ;; Delete other windows, users can restore with
- ;; `gnorb-restore-layout'.
- (delete-other-windows)
- (if id
- (gnorb-trigger-todo-action arg id)
- ;; Flush out zombies (dead associations).
- (setq related-headings
- (cl-remove-if
- (lambda (h)
- (when (null (org-id-find-id-file h))
- (when (y-or-n-p
- (format
- "ID %s no longer exists, disassociate message?"
- h))
- (gnorb-delete-association msg-id h))))
- related-headings))
- (if (catch 'target
- (dolist (h related-headings nil)
- (when (yes-or-no-p
- (format "Trigger action on %s"
- (gnorb-pretty-outline h)))
- (throw 'target (setq targ h)))))
- (gnorb-trigger-todo-action arg targ)
- (setq targ (org-refile-get-location
- "Trigger heading" nil t))
- (find-file (nth 1 targ))
- (goto-char (nth 3 targ))
- (gnorb-trigger-todo-action arg)))))
+ (condition-case err
+ (if id
+ (progn
+ (delete-other-windows)
+ (gnorb-trigger-todo-action nil id))
+ ;; Flush out zombies (dead associations).
+ (setq related-headings
+ (cl-remove-if
+ (lambda (h)
+ (when (null (org-id-find-id-file h))
+ (when (y-or-n-p
+ (format
+ "ID %s no longer exists, disassociate message?"
+ h))
+ (gnorb-delete-association msg-id h))))
+ related-headings))
+ ;; See if one of the related headings is chosen.
+ (unless (catch 'target
+ (dolist (h related-headings nil)
+ (when (yes-or-no-p
+ (format "Trigger action on %s"
+ (gnorb-pretty-outline h)))
+ (throw 'target (setq targ h)))))
+ ;; If not, use the refile interface to choose one.
+ (setq targ (org-refile-get-location
+ "Trigger heading" nil t))
+ (setq targ
+ (save-window-excursion
+ (find-file (nth 1 targ))
+ (goto-char (nth 3 targ))
+ (org-id-get-create))))
+ ;; Either bulk associate multiple messages...
+ (if (> (length articles) 1)
+ (progn
+ (dolist (a articles)
+ (gnorb-registry-make-entry
+ (mail-header-id
+ (gnus-data-header
+ (gnus-data-find a)))
+ from subject targ group)
+ (gnus-summary-remove-process-mark a))
+ (message "Associated %d messages with %s"
+ (length articles) (gnorb-pretty-outline targ)))
+ ;; ...or just trigger the one.
+ (delete-other-windows)
+ (gnorb-trigger-todo-action nil targ)))
+ (error
+ ;; If these are left populated after an error, it plays hell
+ ;; with future trigger processes.
+ (setq gnorb-gnus-message-info nil)
+ (setq gnorb-gnus-capture-attachments nil)
+ (signal (car err) (cdr err))))))
+
+;;;###autoload
+(defun gnorb-gnus-quick-reply ()
+ "Compose a reply to the message under point, and associate both
+the original message and the reply with the selected heading.
+Take no other action.
+
+Use this when you want to compose a reply to a message on the
+spot, and track both messages, without having to go through the
+hassle of triggering an action on a heading, and then starting a
+reply."
+ (interactive)
+ (when (not (memq major-mode '(gnus-summary-mode gnus-article-mode)))
+ (user-error "Only works in gnus summary or article mode"))
+ (let* ((art-no (gnus-summary-article-number))
+ (headers (gnus-data-header
+ (gnus-data-find art-no)))
+ (msg-id (mail-header-id headers))
+ (from (mail-header-from headers))
+ (subject (mail-header-subject headers))
+ (group (gnorb-get-real-group-name
+ gnus-newsgroup-name
+ art-no))
+ (ref-msg-ids (concat (mail-header-references headers) " "
+ msg-id))
+ (related-headings
+ (when ref-msg-ids
+ (gnorb-find-tracked-headings headers t)))
+ (targ (car-safe related-headings)))
+ (if targ
+ (let ((ret (make-marker)))
+ (setq gnorb-window-conf (current-window-configuration))
+ (move-marker gnorb-return-marker (point))
+ ;; Assume the first heading is the one we want.
+ (gnorb-registry-make-entry
+ msg-id from subject targ group)
+ (gnus-summary-wide-reply-with-original 1)
+ (move-marker ret (point))
+ (save-restriction
+ (widen)
+ (message-narrow-to-headers-or-head)
+ (goto-char (point-min))
+ (open-line 1)
+ (message-insert-header
+ (intern gnorb-mail-header) targ))
+ (goto-char ret)
+ (message
+ (format "Original message and reply will be associated with %s"
+ (gnorb-pretty-outline targ))))
+ (message "No associated headings found"))))
;;;###autoload
-(defun gnorb-gnus-search-messages (str &optional ret)
+(defun gnorb-gnus-search-messages (str persist &optional head-text ret)
"Initiate a search for gnus message links in an org subtree.
The arg STR can be one of two things: an Org heading id value
\(IDs should be prefixed with \"id+\"\), in which case links will
@@ -579,31 +663,46 @@ work."
(let ((nnir-address
(or (gnus-method-to-server '(nngnorb))
(user-error
- "Please add a \"nngnorb\" backend to your gnus installation."))))
+ "Please add a \"nngnorb\" backend to your gnus installation.")))
+ name method spec)
(when (version= "5.13" gnus-version-number)
(with-no-warnings ; All these variables are available.
(setq nnir-current-query nil
nnir-current-server nil
nnir-current-group-marked nil
nnir-artlist nil)))
- (gnus-group-read-ephemeral-group
- ;; in 24.4, the group name is mostly decorative. in 24.3, the
- ;; query itself is read from there. It should look like (concat
- ;; "nnir:" (prin1-to-string '((query str))))
- (if (version= "5.13" gnus-version-number)
- (concat "nnir:" (prin1-to-string `((query ,str))))
- (concat "gnorb-" str))
- (if (version= "5.13" gnus-version-number)
- (list 'nnir nnir-address)
- (list 'nnir "nnir"))
- nil
- ret
- nil nil
- ;; the following seems to simply be ignored under gnus 5.13
- (list (cons 'nnir-specs (list (cons 'nnir-query-spec `((query . ,str)))
+ ;; In 24.4, the group name is mostly decorative, but in 24.3, the
+ ;; actual query is held there.
+ (setq name (if (version= "5.13" gnus-version-number)
+ (concat "nnir:" (prin1-to-string `((query ,str))))
+ (if persist
+ (read-string
+ (format "Name for group (default %s): " head-text)
+ nil head-text t)
+ (concat "gnorb-" str))))
+ (setq method (if (version= "5.13" gnus-version-number)
+ (list 'nnir nnir-address)
+ (list 'nnir "Gnorb")))
+ (setq spec
+ (list
+ (cons 'nnir-specs (list (cons 'nnir-query-spec `((query . ,str)))
(cons 'nnir-group-spec `((,nnir-address
nil)))))
(cons 'nnir-artlist nil)))
- (gnorb-summary-minor-mode)))
+ (if persist
+ (progn
+ (switch-to-buffer gnus-group-buffer)
+ (gnus-group-make-group name method nil spec)
+ (gnus-group-select-group))
+ (gnus-group-read-ephemeral-group name method nil ret nil nil spec))))
+
+(defun gnorb-gnus-summary-mode-hook ()
+ "Check if we've entered a Gnorb-generated group, and activate
+ `gnorb-summary-minor-mode', if so."
+ (let ((method (gnus-find-method-for-group gnus-newsgroup-name)))
+ (when (string-match-p "Gnorb" (cadr method))
+ (gnorb-summary-minor-mode))))
+
+(add-hook 'gnus-summary-mode-hook #'gnorb-gnus-summary-mode-hook)
;;; Automatic noticing of relevant messages
@@ -633,8 +732,7 @@ option `gnorb-gnus-hint-relevant-article' is non-nil."
(tracked-headings (gnorb-find-tracked-headings headers))
(key
(where-is-internal 'gnorb-gnus-incoming-do-todo
- nil t))
- rel-headings)
+ nil t)))
(cond (assoc-heading
(message "Message is associated with %s"
(gnorb-pretty-outline (car assoc-heading) t)))
@@ -652,9 +750,12 @@ option `gnorb-gnus-hint-relevant-article' is non-nil."
(if (not (memq (car (gnus-find-method-for-group
gnus-newsgroup-name))
'(nnvirtual nnir)))
- (if (gnorb-find-tracked-headings header)
- gnorb-gnus-summary-mark
- " ")
+ (cond ((gnus-registry-get-id-key
+ (mail-header-message-id header) 'gnorb-ids)
+ gnorb-gnus-summary-tracked-mark)
+ ((gnorb-find-tracked-headings header)
+ gnorb-gnus-summary-mark)
+ (t " "))
" "))
(fset (intern (concat "gnus-user-format-function-"
@@ -669,8 +770,8 @@ option `gnorb-gnus-hint-relevant-article' is non-nil."
(let* ((headers (gnus-data-header
(gnus-data-find
(gnus-summary-article-number))))
- (tracked-headings
- (gnorb-find-tracked-headings headers)))
+ (tracked-headings
+ (gnorb-find-tracked-headings headers)))
(when tracked-headings
(setq gnorb-window-conf (current-window-configuration))
(move-marker gnorb-return-marker (point))
diff --git a/packages/gnorb/gnorb-org.el b/packages/gnorb/gnorb-org.el
index 6d3772d..34cd803 100644
--- a/packages/gnorb/gnorb-org.el
+++ b/packages/gnorb/gnorb-org.el
@@ -43,9 +43,8 @@
("take note" . note)
("don't associate" . no-associate)
("only associate" . associate)
-; ("capture to child" . cap-child)
-; ("capture to sibling" . cap-sib)
-)
+ ("capture to child" . cap-child)
+ ("capture to sibling" . cap-sib))
"List of potential actions that can be taken on headings.
When triggering an Org heading after receiving or sending a
@@ -56,8 +55,8 @@ todo state: Associate the message, and change TODO state.
take note: Associate the message, and take a note.
don't associate: Do nothing at all, don't connect the message and TODO.
only associate: Associate the message with this heading, do nothing else.
-capture to child: [not yet implemented] Associate this message with a new
child heading.
-capture to sibling: [not yet implemented] Associate this message with a new
sibling heading.
+capture to child: Associate this message with a new child heading.
+capture to sibling: Associate this message with a new sibling heading.
You can reorder this list or remove items as suits your workflow.
The two \"capture\" options will use the value of
@@ -165,7 +164,7 @@ we came from."
:raw-value
head)
strings)
- (org-element-map tree 'paragraph
+ (org-element-map tree '(paragraph drawer)
(lambda (p)
(push (org-element-interpret-data p)
strings))
@@ -177,9 +176,11 @@ we came from."
(cond ((eq gnorb-org-mail-scan-scope 'all)
strings)
((numberp gnorb-org-mail-scan-scope)
- (delq nil
- (cl-subseq
- strings 0 (1+ gnorb-org-mail-scan-scope))))
+ (cl-subseq
+ (nreverse strings)
+ 0 (min
+ (length strings)
+ (1+ gnorb-org-mail-scan-scope))))
;; We could provide more options here. 'tree vs
;; 'subtree, for instance.
(t
@@ -271,10 +272,14 @@ headings."
(when messages
(insert ", "))
(insert (mapconcat 'identity mails ", ")))
- ;; Return us after message is sent.
- (add-to-list 'message-exit-actions
- 'gnorb-org-restore-after-send t)
- ;; Set headers from MAIL_* properties (from, cc, and bcc).
+ ;; Commenting this out because
+ ;; `gnorb-gnus-check-outgoing-headers' is set unconditionally in the
+ ;; `message-send-hook, so this should be redundant. Also, we've
+ ;; switched to using message-send-actions.
+
+ ;; (add-to-list
+ ;; 'message-exit-actions 'gnorb-org-restore-after-send t) Set
+ ;; headers from MAIL_* properties (from, cc, and bcc).
(cl-flet ((sh (h)
(when (cdr h)
(funcall (intern (format "message-goto-%s" (car h))))
@@ -298,7 +303,7 @@ headings."
;; insert text, if any
(when text
(message-goto-body)
- (insert"\n")
+ (insert "\n")
(if (bufferp text)
(insert-buffer-substring text)
(insert text)))
@@ -498,13 +503,17 @@ default set of parameters."
;; got too much hard-coded stuff.
(interactive "P")
(org-back-to-heading t)
- (let* ((backend-string
+ (let* ((bkend-var
+ (if (boundp 'org-export--registered-backends)
+ org-export--registered-backends
+ org-export-registered-backends))
+ (backend-string
(org-completing-read
"Export backend: "
(mapcar (lambda (b)
(symbol-name (org-export-backend-name b)))
- org-export--registered-backends)
- nil t))
+ bkend-var)
+ nil t))
(backend-symbol (intern backend-string))
(f-or-t (org-completing-read "Export as file or text? "
'("file" "text") nil t))
@@ -527,8 +536,6 @@ default set of parameters."
,@opts
,gnorb-org-email-subtree-file-parameters))))
text file)
- (setq gnorb-window-conf (current-window-configuration))
- (move-marker gnorb-return-marker (point))
(if (bufferp result)
(setq text result)
(setq file result))
@@ -614,7 +621,9 @@ search."
(let ((rec-tags (bbdb-record-xfield
r gnorb-bbdb-org-tag-field)))
(and rec-tags
- (let ((tags-list (org-split-string rec-tags ":"))
+ (let ((tags-list (if (stringp rec-tags)
+ (org-split-string rec-tags
":")
+ rec-tags))
(case-fold-search t)
(org-trust-scanner-tags t))
(eval tag-clause)))))
@@ -646,14 +655,17 @@ search."
;;; Groups from the gnorb gnus server backend
;;;###autoload
-(defun gnorb-org-view ()
+(defun gnorb-org-view (arg)
"Search the subtree at point for links to gnus messages, and
-then show them in an ephemeral group, in gnus.
+then show them in an ephemeral group, in Gnus.
+
+With a prefix arg, create a search group that will persist across
+Gnus sessions, and can be refreshed.
This won't work unless you've added a \"nngnorb\" server to
your gnus select methods."
;; this should also work on the active region, if there is one.
- (interactive)
+ (interactive "P")
(require 'gnorb-gnus)
(setq gnorb-window-conf (current-window-configuration))
(move-marker gnorb-return-marker (point))
@@ -672,7 +684,10 @@ your gnus select methods."
(org-back-to-heading)
(setq id (concat "id+" (org-id-get-create)))
(gnorb-gnus-search-messages
- id
+ id arg
+ (replace-regexp-in-string
+ org-bracket-link-regexp "\\3"
+ (nth 4 (org-heading-components)))
`(when (and (window-configuration-p gnorb-window-conf)
gnorb-return-marker)
(set-window-configuration gnorb-window-conf)
diff --git a/packages/gnorb/gnorb-registry.el b/packages/gnorb/gnorb-registry.el
index f7b402c..9220565 100644
--- a/packages/gnorb/gnorb-registry.el
+++ b/packages/gnorb/gnorb-registry.el
@@ -49,6 +49,7 @@
;;; Code:
(require 'gnus-registry)
+(require 'gnorb-utils)
(require 'cl-lib)
(defgroup gnorb-registry nil
@@ -85,32 +86,27 @@ to the message's registry entry, under the 'gnorb-ids key."
(memq major-mode '(gnus-summary-mode gnus-article-mode)))
(not org-note-abort))
(let* ((msg-id
- (format "<%s>" (plist-get org-store-link-plist :message-id)))
- (entry (gnus-registry-get-or-make-entry msg-id))
- (org-ids
- (gnus-registry-get-id-key msg-id 'gnorb-ids))
- (new-org-id (org-id-get-create)))
- (plist-put org-capture-plist :gnorb-id new-org-id)
- (setq org-ids (cons new-org-id org-ids))
- (setq org-ids (delete-dups org-ids))
- (gnus-registry-set-id-key msg-id 'gnorb-ids org-ids))))
+ (gnorb-bracket-message-id
+ (plist-get org-store-link-plist :message-id)))
+ (org-id (org-id-get-create)))
+ (plist-put org-capture-plist :gnorb-id org-id)
+ (gnorb-registry-make-entry msg-id nil nil org-id nil))))
(defun gnorb-registry-capture-abort-cleanup ()
(when (and (org-capture-get :gnorb-id)
org-note-abort)
- (condition-case nil
- (let* ((msg-id (format "<%s>" (plist-get org-store-link-plist
:message-id)))
- (existing-org-ids (gnus-registry-get-id-key msg-id 'gnorb-ids))
- (org-id (org-capture-get :gnorb-id)))
- (when (member org-id existing-org-ids)
- (gnus-registry-set-id-key msg-id 'gnorb-ids
- (remove org-id existing-org-ids)))
- ;; FIXME: Yuck! This will fail as soon as org-capture.el is compiled
- ;; with lexical-binding.
- (setq abort-note 'clean))
- (error
- (setq abort-note 'dirty)))))
+ (with-no-warnings ; For `abort-note'
+ (condition-case error
+ (let* ((msg-id (format "<%s>" (plist-get org-store-link-plist
:message-id)))
+ (existing-org-ids (gnus-registry-get-id-key msg-id 'gnorb-ids))
+ (org-id (org-capture-get :gnorb-id)))
+ (when (member org-id existing-org-ids)
+ (gnus-registry-set-id-key msg-id 'gnorb-ids
+ (remove org-id existing-org-ids)))
+ (setq abort-note 'clean))
+ (error
+ (setq abort-note 'dirty))))))
(defun gnorb-find-visit-candidates (ids &optional include-zombies)
"For all message-ids in IDS (which should be a list of
@@ -150,25 +146,115 @@ the MSG-ID."
(gnus-registry-set-id-key msg-id 'gnorb-ids
(remove org-id org-ids)))))
-(defun gnorb-delete-all-assocations (org-id)
+(defun gnorb-delete-all-associations (org-id)
"Delete all message associations for an Org heading.
The heading is identified by ORG-ID. This is suitable for use
after an Org heading is deleted, for instance."
- (let ((assoc-msgs (gnorb-registry-org-id-search org-id)))
+ (let ((assoc-msgs (gnorb-registry-org-id-search org-id))
+ (gnorb-id-tracker
+ (registry-lookup-secondary gnus-registry-db 'gnorb-ids)))
(mapcar
(lambda (msg-id)
(let ((org-ids
(gnus-registry-get-id-key msg-id 'gnorb-ids)))
(gnus-registry-set-id-key
msg-id 'gnorb-ids (remove org-id org-ids))))
- assoc-msgs)))
+ assoc-msgs)
+ (remhash org-id gnorb-id-tracker)))
+
+(defun gnorb-flush-dead-associations (&optional clean-archived)
+ "Clean the registry of associations with nonexistent headings.
+
+Gnus will not prune registry entries that appear to be associated
+with an Org heading. If your registry is limited to a very small
+size, you may end up with a full registry. Use this function to
+remove dead associations, and free up more entries for possible
+pruning.
+
+By default, associations are considered \"live\" if the Org
+heading exists in an Org file or in an Org archive file. When
+optional CLEAN_ARCHIVED is non-nil, delete associations from
+archived headings as well."
+ (interactive "P")
+ (let ((gnorb-id-tracker
+ (registry-lookup-secondary gnus-registry-db 'gnorb-ids))
+ (deleted-count 0))
+ (require 'org-id)
+ (maphash
+ (lambda (k _)
+ (let ((file (org-id-find-id-file k)))
+ (when (or (not file)
+ (and clean-archived
+ (string-match-p "org_archive$" file)))
+ (gnorb-delete-all-associations k)
+ (incf deleted-count))))
+ gnorb-id-tracker)
+ (message "Deleted %d invalid associations"
+ deleted-count)))
(defun gnorb-registry-org-id-search (id)
"Find all messages that have the org ID in their 'gnorb-ids
key."
(registry-search gnus-registry-db :member `((gnorb-ids ,id))))
+(defun gnorb-registry-tracked-messages ()
+ "Return all message-ids that have non-empty 'gnorb-ids keys."
+ (registry-search gnus-registry-db :regex `((gnorb-ids ".+"))))
+
+(defun gnorb-registry-tracked-headings ()
+ "Return all Org heading ids that are associated with messages."
+ (hash-table-keys
+ (registry-lookup-secondary gnus-registry-db 'gnorb-ids)))
+
+(defun gnorb-report-tracking-usage ()
+ "Pop up a temporary window reporting on Gnorb usage of the Gnus
+registry to track message/heading associations. Reports the
+number of tracked messages, the number of tracked headings, and how much of
the registry is occupied."
+ (interactive)
+ (progn
+ (pop-to-buffer
+ (get-buffer-create "*Gnorb Usage*")
+ '(nil . ((window-height . 10))))
+ (gnorb-refresh-usage-status)
+ (special-mode)
+ (setq revert-buffer-function #'gnorb-refresh-usage-status)
+ (local-set-key (kbd "d") (lambda ()
+ (interactive)
+ (progn
+ (gnorb-flush-dead-associations)
+ (gnorb-refresh-usage-status))))
+ (local-set-key (kbd "D") (lambda ()
+ (interactive)
+ (progn
+ (gnorb-flush-dead-associations t)
+ (gnorb-refresh-usage-status))))))
+
+(defun gnorb-refresh-usage-status (&optional ignore-auto noconfirm)
+ "Clear and re-format the *Gnorb Usage* buffer."
+ (let ((messages (length (gnorb-registry-tracked-messages)))
+ (headings (length (gnorb-registry-tracked-headings)))
+ (reg-size (registry-size gnus-registry-db))
+ (reg-max-size (if (slot-exists-p gnus-registry-db 'max-size)
+ (oref gnus-registry-db max-size)
+ (oref gnus-registry-db max-hard))))
+ (with-current-buffer "*Gnorb Usage*"
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (insert
+ (format
+ "Tracking %d Gnus messages associated with %d Org headings."
+ messages headings))
+ (insert "\n\n")
+ (insert
+ (format
+ "Occupying %.2f%% (%d/%d) of the registry (max %d)."
+ (* 100 (/ (float messages) reg-size))
+ messages reg-size reg-max-size))
+ (insert "\n\n")
+ (insert "Press 'd' to delete associations for non-existent Org
headings.\n")
+ (insert "Press 'D' to delete associations for both non-existent and
archived Org headings.")))))
+
(defun gnorb-registry-transition-from-props (arg)
"Helper function for transitioning the old tracking system to the new.
diff --git a/packages/gnorb/gnorb-utils.el b/packages/gnorb/gnorb-utils.el
index 29185a1..4d473f1 100644
--- a/packages/gnorb/gnorb-utils.el
+++ b/packages/gnorb/gnorb-utils.el
@@ -24,6 +24,8 @@
;;; Code:
+(require 'cl-lib)
+
(require 'mailcap)
(mailcap-parse-mimetypes)
@@ -72,6 +74,11 @@ are sent, or Org headings triggered.")
"Return point here after various actions, to be used together
with `gnorb-window-conf'.")
+(defvar gnorb-trigger-capture-location nil
+ "Marker pointing at the location where we want to place capture
+ templates, for the capture-to-child and capture-to-sibling
+ trigger actions.")
+
(defcustom gnorb-mail-header "X-Org-ID"
"Name of the mail header used to store the ID of a related Org
heading. Only used locally: always stripped when the mail is
@@ -211,38 +218,32 @@ window."
we were in the agenda when this was called, then keep us in the
agenda. Then let the user choose an action from the value of
`gnorb-org-trigger-actions'."
- (let ((agenda-p (eq major-mode 'org-agenda-mode))
- (action (cdr (assoc
- (org-completing-read
- "Action to take: "
- gnorb-org-trigger-actions nil t)
- gnorb-org-trigger-actions)))
- (root-marker (make-marker)))
- ;; Place the marker for the relevant TODO heading.
- (cond (agenda-p
- (setq root-marker
+ (let* ((agenda-p (eq major-mode 'org-agenda-mode))
+ (root-marker
+ (cond (agenda-p
(copy-marker
- (org-get-at-bol 'org-hd-marker))))
- ((derived-mode-p 'org-mode)
- (move-marker root-marker (point-at-bol)))
- (id
- (save-excursion
- (org-id-goto id)
- (move-marker root-marker (point-at-bol)))))
+ (org-get-at-bol 'org-hd-marker)))
+ ((derived-mode-p 'org-mode)
+ (save-excursion
+ (org-back-to-heading)
+ (point-marker)))
+ (id
+ (save-excursion
+ (org-id-goto id)
+ (org-back-to-heading)
+ (point-marker)))))
+ (id (or id
+ (org-with-point-at root-marker
+ (org-id-get-create))))
+ (action (cdr (assoc
+ (org-completing-read
+ (format
+ "Trigger action on %s: "
+ (gnorb-pretty-outline id))
+ gnorb-org-trigger-actions nil t)
+ gnorb-org-trigger-actions))))
(unless agenda-p
(org-reveal))
- ;; Query about attaching email attachments. No matter what
- ;; happens, clear `gnorb-gnus-capture-attachments'.
- (unwind-protect
- (org-with-point-at root-marker
- (map-y-or-n-p
- (lambda (a)
- (format "Attach %s to heading? "
- (file-name-nondirectory a)))
- (lambda (a) (org-attach-attach a nil 'mv))
- gnorb-gnus-capture-attachments
- '("file" "files" "attach")))
- (setq gnorb-gnus-capture-attachments nil))
(cl-labels
((make-entry
(id)
@@ -253,51 +254,107 @@ agenda. Then let the user choose an action from the
value of
id
(plist-get gnorb-gnus-message-info :group))))
;; Handle our action.
- (cond ((eq action 'note)
- (org-with-point-at root-marker
- (make-entry (org-id-get-create))
- (call-interactively 'org-add-note)))
- ((eq action 'todo)
- (if agenda-p
- (progn
- (org-with-point-at root-marker
- (make-entry (org-id-get-create)))
- (call-interactively 'org-agenda-todo))
- (org-with-point-at root-marker
- (make-entry (org-id-get-create))
- (call-interactively 'org-todo))))
- ((eq action 'no-associate)
- nil)
- ((eq action 'associate)
- (org-with-point-at root-marker
- (make-entry (org-id-get-create))))
- ((fboundp action)
+ (if (fboundp action)
+ (org-with-point-at root-marker
+ (make-entry (org-id-get-create))
+ (funcall action gnorb-gnus-message-info))
+ (cl-case action
+ (note
+ (org-with-point-at root-marker
+ (make-entry (org-id-get-create))
+ (call-interactively 'org-add-note)))
+ (todo
+ (if agenda-p
+ (progn
+ (org-with-point-at root-marker
+ (make-entry (org-id-get-create)))
+ (call-interactively 'org-agenda-todo))
(org-with-point-at root-marker
(make-entry (org-id-get-create))
- (funcall action gnorb-gnus-message-info)))))))
+ (call-interactively 'org-todo))))
+ (no-associate
+ nil)
+ (associate
+ (org-with-point-at root-marker
+ (make-entry (org-id-get-create))))
+ ;; We're going to capture a new heading
+ ((cap-child cap-sib)
+ (org-with-point-at root-marker
+ (setq gnorb-trigger-capture-location (point-marker)))
+ (let ((entry
+ ;; Pick a template.
+ (copy-sequence (org-capture-select-template))))
+ ;; Do surgery on that template so that it finds its
+ ;; location using our function.
+ (setf (nth 3 entry)
+ `(function
+ ,(if (eq action 'cap-child)
+ #'gnorb-trigger-capture-child
+ #'gnorb-trigger-capture-sibling)))
+ ;; This will likely fail horribly for capture templates
+ ;; that aren't entries or list items.
+ (let ((org-capture-entry entry))
+ ;; When org-capture-entry is let-bound, the capture
+ ;; process will use that template instead of
+ ;; prompting the user. Also, `gnorb-registry-capture'
+ ;; will take care of making the registry entry for us.
+ (call-interactively 'org-capture)))))))
+ ;; Lastly, query about attaching email attachments. No matter what
+ ;; happens, clear `gnorb-gnus-capture-attachments'.
+ (unwind-protect
+ (org-with-point-at
+ (if (memq action '(cap-child cap-sib))
+ (point)
+ root-marker)
+ (map-y-or-n-p
+ (lambda (a)
+ (format "Attach %s to heading? "
+ (file-name-nondirectory a)))
+ (lambda (a)
+ (with-demoted-errors
+ (org-attach-attach a nil 'mv)))
+ gnorb-gnus-capture-attachments
+ '("file" "files" "attach")))
+ (setq gnorb-gnus-capture-attachments nil))))
+
+(defun gnorb-trigger-capture-child ()
+ ;; The capture process creates a child by default
+ (org-goto-marker-or-bmk gnorb-trigger-capture-location)
+ (org-back-to-heading))
+
+(defun gnorb-trigger-capture-sibling ()
+ ;; This only works if we're not trying to create a sibling for a
+ ;; top-level heading, there appears to be no way to do that. But in
+ ;; that case this trigger action isn't really necessary, just
+ ;; handle it with a regular capture.
+ (org-goto-marker-or-bmk gnorb-trigger-capture-location)
+ (org-up-heading-safe))
(defun gnorb-pretty-outline (id &optional kw)
"Return pretty outline path of the Org heading indicated by ID.
If the KW argument is true, add the TODO keyword into the path."
- (org-with-point-at (org-id-find id t)
- (let ((el (org-element-at-point)))
- (concat
- (if kw
- (format "(%s): "
- (org-element-property :todo-keyword el))
- "")
- (org-format-outline-path
- (append
- (list
- (file-name-nondirectory
- (buffer-file-name
- (org-base-buffer (current-buffer)))))
- (org-get-outline-path)
- (list
- (replace-regexp-in-string
- org-bracket-link-regexp
- "\\3" (org-element-property :raw-value el)))))))))
+ (let ((pt (org-id-find id t)))
+ (if pt
+ (org-with-point-at pt
+ (let ((el (org-element-at-point)))
+ (concat
+ (if kw
+ (format "(%s): "
+ (org-element-property :todo-keyword el))
+ "")
+ (org-format-outline-path
+ (append
+ (list
+ (file-name-nondirectory
+ (buffer-file-name
+ (org-base-buffer (current-buffer)))))
+ (org-get-outline-path)
+ (list
+ (replace-regexp-in-string
+ org-bracket-link-regexp
+ "\\3" (org-element-property :raw-value el))))))))
+ "[none]")))
(defun gnorb-scan-links (bound &rest types)
"Scan from point to BOUND looking for links of type in TYPES.
@@ -383,6 +440,16 @@ child headings."
;; Common functions for extracting references and relevant headings
;; from the message under point. For use in gnorb-gnus.el functions.
+(defun gnorb-get-real-group-name (group art-no)
+ "Find the original group name of a message in a virtual or nnir
+group."
+ (cl-case (car (gnus-find-method-for-group group))
+ (nnvirtual
+ (setq group (car (nnvirtual-map-article art-no))))
+ (nnir
+ (setq group (nnir-article-group art-no))))
+ group)
+
(defun gnorb-find-tracked-headings (headers &optional include-zombies)
"Check HEADERS for message references and return relevant heading IDs.
diff --git a/packages/gnorb/gnorb.el b/packages/gnorb/gnorb.el
index 22531d2..d7e9289 100644
--- a/packages/gnorb/gnorb.el
+++ b/packages/gnorb/gnorb.el
@@ -2,7 +2,7 @@
;; Copyright (C) 2014 Free Software Foundation, Inc.
-;; Version: 1.0.1
+;; Version: 1.1.2
;; Package-Requires: ((cl-lib "0.5"))
;; Maintainer: Eric Abrahamsen <address@hidden>
@@ -32,13 +32,13 @@
;;; Code:
(with-eval-after-load 'gnus
- (require 'nngnorb)
- (require 'gnorb-gnus)
- (require 'gnorb-registry))
+ (require 'nngnorb)
+ (require 'gnorb-gnus)
+ (require 'gnorb-registry))
(with-eval-after-load 'bbdb
(require 'gnorb-bbdb))
(with-eval-after-load 'org
- (require 'gnorb-org))
+ (require 'gnorb-org))
(provide 'gnorb)
;;; gnorb.el ends here
diff --git a/packages/gnorb/gnorb.info b/packages/gnorb/gnorb.info
index 08085e1..52ca072 100644
--- a/packages/gnorb/gnorb.info
+++ b/packages/gnorb/gnorb.info
@@ -30,11 +30,13 @@ Gnorb Manual
Email Tracking
+* Basic Usage::
* Email-Related Commands::
* Trigger Actions::
* Viewing Tracked Messages in *Summary* Buffers::
* Hinting in Gnus::
* Message Attachments::
+* Registry Usage::
* Likely Workflow::
Misc BBDB
@@ -138,29 +140,56 @@ IDs are associated with Org heading ids. As a
conversation develops,
messages are collected on a heading (and/or its children). You can
compose new messages directly from the Org heading, and Gnorb will
automatically associate your sent message with the conversation. You
-can open temporary Gnus *Summary* buffers holding all the messages
-associated with an Org subtree, and reply from there. When you receive
-new messages relevant to a conversation, Gnorb will notice them and
-prompt you to associate them with the appropriate Org heading.
-Attachments on incoming messages can be automatically saved as
-attachments on Org headings, using org-attach.
+can open Gnus *Summary* buffers holding all the messages associated with
+an Org subtree, and reply from there – these groups can be made
+persistent, if you like. When you receive new messages relevant to a
+conversation, Gnorb will notice them and prompt you to associate them
+with the appropriate Org heading. Attachments on incoming messages can
+be automatically saved as attachments on Org headings, using org-attach.
In general, the goal is to keep track of whole conversations, reduce
friction when moving between Gnus and Org, and keep you in the Org
agenda rather than in Gnus.
* Menu:
+* Basic Usage::
* Email-Related Commands::
* Trigger Actions::
* Viewing Tracked Messages in *Summary* Buffers::
* Hinting in Gnus::
* Message Attachments::
+* Registry Usage::
* Likely Workflow::
-File: gnorb.info, Node: Email-Related Commands, Next: Trigger Actions, Up:
Email Tracking
+File: gnorb.info, Node: Basic Usage, Next: Email-Related Commands, Up:
Email Tracking
+
+4.1 Basic Usage
+===============
+
+The following sections might be a bit confusing to read if you haven’t
+actually tried using Gnorb. If you don’t want to dive in all the way
+just yet, you can just dabble your toes. First set up email tracking as
+specified in *note Setup: Setup, then do the following:
+
+ 1. Add “%ug” somewhere appropriate in your ‘gnus-summary-line-format’
+ variable.
+ 2. If you don’t use a local archive method, add your sent message
+ groups to ‘gnorb-gnus-sent-groups’ (see the docstring).
+ 3. Use Org capture from Gnus summary buffers to create reminders for
+ emails you need to reply to.
+ 4. Reply to those emails by pressing “C-c t” on the TODO heading in
+ either the Agenda, or in regular Org files.
+ 5. If you ever get confused about what’s associated with an Org
+ heading, press “C-c v” on the heading (works in either the Agenda,
+ or regular Org files).
+
+ That should be enough to get started.
-4.1 Email-Related Commands
+
+File: gnorb.info, Node: Email-Related Commands, Next: Trigger Actions,
Prev: Basic Usage, Up: Email Tracking
+
+4.2 Email-Related Commands
==========================
Email tracking starts in one of three ways:
@@ -178,11 +207,14 @@ Email tracking starts in one of three ways:
1. ‘gnorb-org-handle-mail’ is called on an Org heading to compose a
new message. By default, this will begin a reply to the most
recent message in the conversation. If there are no associated
- messages to reply to (or you call the function with a double prefix
+ messages to reply to (or you call the function with a single prefix
arg), Gnorb will look for mailto: or bbdb: links in the heading,
and compose a new message to them.
- The sent message will be associated with the Org heading, and
+ Calling the function with a double prefix arg will ignore all
+ associated messages and links, and compose a blank message.
+
+ Once sent, the message will be associated with the Org heading, and
you’ll be brought back to the heading and asked to trigger an
action on it.
@@ -190,7 +222,7 @@ Email tracking starts in one of three ways:
‘gnorb-org-handle-mail’. It does the same thing as the latter, but
first exports the body of the subtree as either text or a file,
then inserts the text into the message body, or attaches the file
- to the message, depending on what you’ve chosen.
+ to the message, respectively.
2. ‘gnorb-gnus-incoming-do-todo’ is called on a message in a Gnus
*Summary* buffer. You’ll be prompted for an Org heading, taken to
that heading, and asked to trigger an action on it.
@@ -218,39 +250,54 @@ Email tracking starts in one of three ways:
Because these three commands all express a similar intent, but are
called in different modes, it can make sense to give each of them the
same keybinding in the keymaps for Org mode, Gnus summary mode, and
-Message mode, respectively.
+Message mode.
+
+ An additional convenience command is available for use in Gnus
+summary buffers: ‘gnorb-gnus-quick-reply’. If you don’t want to go
+through the whole round trip of triggering an action and then starting a
+new reply, call this command on an incoming message to associate it with
+a heading, start a reply, and associate your reply with the same
+heading.
File: gnorb.info, Node: Trigger Actions, Next: Viewing Tracked Messages in
*Summary* Buffers, Prev: Email-Related Commands, Up: Email Tracking
-4.2 Trigger Actions
+4.3 Trigger Actions
===================
After calling ‘gnorb-gnus-incoming-do-todo’ on a message, or after
sending a message associated with an Org heading, you’ll be taken to the
heading and asked to “trigger an action” on it. At the moment there are
-four different possibilities: triggering a TODO state-change on the
+six different possibilities: triggering a TODO state-change on the
heading, taking a note on the heading (both these options will associate
the message with the heading), associating the message but doing nothing
-else, and lastly, doing nothing at all.
+else, capturing a new Org heading as a sibling to the tracked heading,
+capturing a new Org heading as a child, and lastly, doing nothing at
+all.
- More actions will be added in the future; it’s also possible to
+ More actions may be added in the future; it’s also possible to
rearrange or delete existing actions, and add your own: see the
docstring of ‘gnorb-org-trigger-actions’.
File: gnorb.info, Node: Viewing Tracked Messages in *Summary* Buffers, Next:
Hinting in Gnus, Prev: Trigger Actions, Up: Email Tracking
-4.3 Viewing Tracked Messages in *Summary* Buffers
+4.4 Viewing Tracked Messages in *Summary* Buffers
=================================================
-Call ‘gnorb-org-view’ on an Org heading to open an nnir *Summary* buffer
-showing all the messages associated with that heading (this requires
-that you’ve added an nngnorb server to your Gnus backends). A minor
-mode will be in effect, ensuring that any replies you send to messages
-in this buffer will automatically be associated with the original Org
-heading. You can also invoke ‘gnorb-summary-disassociate-message’ (“C-c
-d”) to disassociate the message with the Org heading.
+Call ‘gnorb-org-view’ on an Org heading to open an nnir summary buffer
+showing all the messages associated with that heading and child headings
+(this requires you to have added an nngnorb server to your Gnus
+backends). A minor mode is in effect, ensuring that any replies you
+send to messages in this buffer will automatically be associated with
+the original Org heading. You can also invoke
+‘gnorb-summary-disassociate-message’ (“C-c d”) to disassociate the
+message with the Org heading.
+
+ If you call ‘gnorb-org-view’ with a prefix argument, the search group
+will be made persistent across Gnus sessions. You can re-run the search
+and update the group contents by hitting “M-g” on the group in the Gnus
+*Group* buffer.
As a bonus, it’s possible to go into Gnus’ *Server* buffer, find the
line specifying your nngnorb server, and hit “G” (aka
@@ -263,7 +310,7 @@ linked messages. This is dog-slow at the moment; it will
get faster.
File: gnorb.info, Node: Hinting in Gnus, Next: Message Attachments, Prev:
Viewing Tracked Messages in *Summary* Buffers, Up: Email Tracking
-4.4 Hinting in Gnus
+4.5 Hinting in Gnus
===================
When you receive new mails that might be relevant to existing Org TODOs,
@@ -273,18 +320,19 @@ display a message in the minibuffer when opening
potentially relevant
messages. You can then use ‘gnorb-gnus-incoming-to-todo’ to trigger an
action on the relevant TODO.
- This hinting can happen in the Gnus summary buffer as well. If you
-use the escape indicated by ‘gnorb-gnus-summary-mark-format-letter” as
-part of your ‘gnus-summary-line-format’, articles that are relevant to
-TODOs will be marked with a special character in the Summary buffer, as
-determined by ‘gnorb-gnus-summary-mark’. By default, the format letter
-is “g” (meaning it is used as “%ug” in the format line), and the mark is
-“¡”.
+ This hinting can happen in the Gnus summary buffer as well. If you
+use the escape indicated by ‘gnorb-gnus-summary-mark-format-letter’ as
+part of your ‘gnus-summary-line-format’, articles that may be relevant
+to TODOs will be marked with a special character in the Summary
+buffer, as determined by ‘gnorb-gnus-summary-mark’. By default, the
+format letter is “g” (meaning it is used as “%ug” in the format line),
+and the mark is “&” for messages that are already tracked, and “¡” for
+messages that may be relevant.
-File: gnorb.info, Node: Message Attachments, Next: Likely Workflow, Prev:
Hinting in Gnus, Up: Email Tracking
+File: gnorb.info, Node: Message Attachments, Next: Registry Usage, Prev:
Hinting in Gnus, Up: Email Tracking
-4.5 Message Attachments
+4.6 Message Attachments
=======================
Gnorb simplifies the handling of attachments that you receive in emails.
@@ -309,9 +357,21 @@ attach the files in the heading’s org-attach directory to
the outgoing
message.
-File: gnorb.info, Node: Likely Workflow, Prev: Message Attachments, Up:
Email Tracking
+File: gnorb.info, Node: Registry Usage, Next: Likely Workflow, Prev:
Message Attachments, Up: Email Tracking
+
+4.7 Registry Usage
+==================
+
+You can see how many associations you’ve got stored in the registry by
+calling ‘gnorb-report-tracking-usage’. This will pop up a buffer
+showing how much of the registry you’re using, and offering keybindings
+for ‘gnorb-flush-dead-associations’, to help Gnorb clean up after
+itself.
+
+
+File: gnorb.info, Node: Likely Workflow, Prev: Registry Usage, Up: Email
Tracking
-4.6 Likely Workflow
+4.8 Likely Workflow
===================
You receive an email from Jimmy, who wants to rent a room in your house.
@@ -635,9 +695,13 @@ File: gnorb.info, Node: User Optionsxx, Prev: Viewing
Org headlines relevant t
relevant to Org TODOs. Defaults to “g”, meaning it should be used
as “%ug” in the format line.
‘`gnorb-gnus-summary-mark'’
- The mark used to indicate relevant messages in the Summary buffer,
- when ‘gnorb-gnus-summary-mark-format-letter’ is present in the
- format line. Defaults to “¡”.
+ The mark used to indicate potentially relevant messages in the
+ Summary buffer, when ‘gnorb-gnus-summary-mark-format-letter’ is
+ present in the format line. Defaults to “¡”.
+‘`gnorb-gnus-summary-tracked-mark'’
+ The mark used to indicate already-tracked messages in the Summary
+ buffer, when ‘gnorb-gnus-summary-mark-format-letter’ is present in
+ the format line. Defaults to “&”.
File: gnorb.info, Node: Suggested Keybindings, Prev: Misc Gnus, Up: Top
@@ -662,8 +726,9 @@ File: gnorb.info, Node: Suggested Keybindings, Prev: Misc
Gnus, Up: Top
(org-defkey org-mode-map (kbd "C-c V") 'gnorb-org-popup-bbdb)
(setq gnorb-org-agenda-popup-bbdb t)
(eval-after-load "org-agenda"
- '(progn (org-defkey org-agenda-mode-map (kbd "H")
'gnorb-org-handle-mail)
- (org-defkey org-agenda-mode-map (kbd "V")
'gnorb-org-popup-bbdb)))))
+ '(progn (org-defkey org-agenda-mode-map (kbd "C-c t")
'gnorb-org-handle-mail)
+ (org-defkey org-agenda-mode-map (kbd "C-c v")
'gnorb-org-popup-bbdb)
+ (org-defkey org-agenda-mode-map (kbd "V")
'gnorb-org-view)))))
(eval-after-load "gnorb-gnus"
'(progn
@@ -692,31 +757,33 @@ File: gnorb.info, Node: Suggested Keybindings, Prev:
Misc Gnus, Up: Top
Tag Table:
Node: Top194
-Node: Introduction1009
-Node: Installation2118
-Node: Setup2532
-Node: Email Tracking3899
-Node: Email-Related Commands5430
-Node: Trigger Actions8440
-Node: Viewing Tracked Messages in *Summary* Buffers9289
-Node: Hinting in Gnus10523
-Node: Message Attachments11531
-Node: Likely Workflow12713
-Node: Restoring Window Layout15518
-Node: Recent Mails From BBDB Contacts15882
-Node: BBDB posting styles16878
-Node: BBDB Org tagging17794
-Node: Misc BBDB18540
-Node: Searching for messages from BBDB contacts18753
-Node: Citing BBDB contacts19199
-Node: User Options19520
-Node: Misc Org21059
-Node: Inserting BBDB links21234
-Node: User Optionsx21489
-Node: Misc Gnus24226
-Node: Viewing Org headlines relevant to a message24439
-Node: User Optionsxx24754
-Node: Suggested Keybindings27518
+Node: Introduction1044
+Node: Installation2153
+Node: Setup2567
+Node: Email Tracking3934
+Node: Basic Usage5544
+Node: Email-Related Commands6617
+Node: Trigger Actions10112
+Node: Viewing Tracked Messages in *Summary* Buffers11064
+Node: Hinting in Gnus12551
+Node: Message Attachments13647
+Node: Registry Usage14828
+Node: Likely Workflow15279
+Node: Restoring Window Layout18079
+Node: Recent Mails From BBDB Contacts18443
+Node: BBDB posting styles19439
+Node: BBDB Org tagging20355
+Node: Misc BBDB21101
+Node: Searching for messages from BBDB contacts21314
+Node: Citing BBDB contacts21760
+Node: User Options22081
+Node: Misc Org23620
+Node: Inserting BBDB links23795
+Node: User Optionsx24050
+Node: Misc Gnus26787
+Node: Viewing Org headlines relevant to a message27000
+Node: User Optionsxx27315
+Node: Suggested Keybindings30322
End Tag Table
diff --git a/packages/gnorb/gnorb.org b/packages/gnorb/gnorb.org
index e19422d..58b0365 100644
--- a/packages/gnorb/gnorb.org
+++ b/packages/gnorb/gnorb.org
@@ -35,6 +35,9 @@ https://github.com/girzel/gnorb, and put the "gnorb"
directory on your
load-path. The Github site is also a good place to report bugs and
other issues.
* Setup
+:PROPERTIES:
+:ID: 9da59609-bb3c-4970-88f6-bddca18d2ad4
+:END:
Loading "gnorb" will make the basic functions available. Using Gnorb
for email tracking takes a bit more setup, however:
@@ -68,16 +71,36 @@ message IDs are associated with Org heading ids. As a
conversation
develops, messages are collected on a heading (and/or its children).
You can compose new messages directly from the Org heading, and Gnorb
will automatically associate your sent message with the conversation.
-You can open temporary Gnus *Summary* buffers holding all the messages
-associated with an Org subtree, and reply from there. When you receive
-new messages relevant to a conversation, Gnorb will notice them and
-prompt you to associate them with the appropriate Org heading.
-Attachments on incoming messages can be automatically saved as
-attachments on Org headings, using org-attach.
+You can open Gnus *Summary* buffers holding all the messages
+associated with an Org subtree, and reply from there -- these groups
+can be made persistent, if you like. When you receive new messages
+relevant to a conversation, Gnorb will notice them and prompt you to
+associate them with the appropriate Org heading. Attachments on
+incoming messages can be automatically saved as attachments on Org
+headings, using org-attach.
In general, the goal is to keep track of whole conversations, reduce
friction when moving between Gnus and Org, and keep you in the Org
agenda rather than in Gnus.
+** Basic Usage
+The following sections might be a bit confusing to read if you haven't
+actually tried using Gnorb. If you don't want to dive in all the way
+just yet, you can just dabble your toes. First set up email tracking
+as specified in [[id:9da59609-bb3c-4970-88f6-bddca18d2ad4][Setup]], then do
the following:
+
+1. Add "%ug" somewhere appropriate in your `gnus-summary-line-format'
+ variable.
+2. If you don't use a local archive method, add your sent message
+ groups to `gnorb-gnus-sent-groups' (see the docstring).
+3. Use Org capture from Gnus summary buffers to create reminders for
+ emails you need to reply to.
+4. Reply to those emails by pressing "C-c t" on the TODO heading in
+ either the Agenda, or in regular Org files.
+5. If you ever get confused about what's associated with an Org
+ heading, press "C-c v" on the heading (works in either the Agenda,
+ or regular Org files).
+
+That should be enough to get started.
** Email-Related Commands
Email tracking starts in one of three ways:
@@ -94,11 +117,14 @@ There are three main email-related commands:
1. `gnorb-org-handle-mail' is called on an Org heading to compose a
new message. By default, this will begin a reply to the most recent
message in the conversation. If there are no associated messages to
- reply to (or you call the function with a double prefix arg), Gnorb
+ reply to (or you call the function with a single prefix arg), Gnorb
will look for mailto: or bbdb: links in the heading, and compose a
new message to them.
+
+ Calling the function with a double prefix arg will ignore all
+ associated messages and links, and compose a blank message.
- The sent message will be associated with the Org heading, and
+ Once sent, the message will be associated with the Org heading, and
you'll be brought back to the heading and asked to trigger an
action on it.
@@ -106,7 +132,7 @@ There are three main email-related commands:
`gnorb-org-handle-mail'. It does the same thing as the latter, but
first exports the body of the subtree as either text or a file,
then inserts the text into the message body, or attaches the file
- to the message, depending on what you've chosen.
+ to the message, respectively.
2. `gnorb-gnus-incoming-do-todo' is called on a message in a Gnus
*Summary* buffer. You'll be prompted for an Org heading, taken to
that heading, and asked to trigger an action on it.
@@ -134,31 +160,45 @@ There are three main email-related commands:
Because these three commands all express a similar intent, but are
called in different modes, it can make sense to give each of them the
same keybinding in the keymaps for Org mode, Gnus summary mode, and
-Message mode, respectively.
+Message mode.
+
+An additional convenience command is available for use in Gnus summary
+buffers: `gnorb-gnus-quick-reply'. If you don't want to go through the
+whole round trip of triggering an action and then starting a new
+reply, call this command on an incoming message to associate it with a
+heading, start a reply, and associate your reply with the same
+heading.
** Trigger Actions
After calling `gnorb-gnus-incoming-do-todo' on a message, or after
sending a message associated with an Org heading, you'll be taken to
the heading and asked to "trigger an action" on it. At the moment
-there are four different possibilities: triggering a TODO state-change
+there are six different possibilities: triggering a TODO state-change
on the heading, taking a note on the heading (both these options will
associate the message with the heading), associating the message but
-doing nothing else, and lastly, doing nothing at all.
+doing nothing else, capturing a new Org heading as a sibling to the
+tracked heading, capturing a new Org heading as a child, and lastly,
+doing nothing at all.
-More actions will be added in the future; it's also possible to
+More actions may be added in the future; it's also possible to
rearrange or delete existing actions, and add your own: see the
docstring of `gnorb-org-trigger-actions'.
** Viewing Tracked Messages in *Summary* Buffers
:PROPERTIES:
:END:
-Call `gnorb-org-view' on an Org heading to open an nnir *Summary*
-buffer showing all the messages associated with that heading (this
-requires that you've added an nngnorb server to your Gnus backends). A
-minor mode will be in effect, ensuring that any replies you send to
-messages in this buffer will automatically be associated with the
-original Org heading. You can also invoke
+Call `gnorb-org-view' on an Org heading to open an nnir summary buffer
+showing all the messages associated with that heading and child
+headings (this requires you to have added an nngnorb server to your
+Gnus backends). A minor mode is in effect, ensuring that any replies
+you send to messages in this buffer will automatically be associated
+with the original Org heading. You can also invoke
`gnorb-summary-disassociate-message' ("C-c d") to disassociate the
message with the Org heading.
+If you call `gnorb-org-view' with a prefix argument, the search group
+will be made persistent across Gnus sessions. You can re-run the
+search and update the group contents by hitting "M-g" on the group in
+the Gnus *Group* buffer.
+
As a bonus, it's possible to go into Gnus' *Server* buffer, find the
line specifying your nngnorb server, and hit "G" (aka
`gnus-group-make-nnir-group'). At the query prompt, enter an Org-style
@@ -179,11 +219,12 @@ action on the relevant TODO.
This hinting can happen in the Gnus summary buffer as well. If you use
the escape indicated by `gnorb-gnus-summary-mark-format-letter" as
-part of your `gnus-summary-line-format', articles that are relevant to
-TODOs will be marked with a special character in the Summary buffer,
-as determined by `gnorb-gnus-summary-mark'. By default, the format
-letter is "g" (meaning it is used as "%ug" in the format line), and
-the mark is "¡".
+part of your `gnus-summary-line-format', articles that may be relevant
+to TODOs will be marked with a special character in the Summary
+buffer, as determined by `gnorb-gnus-summary-mark'. By default, the
+format letter is "g" (meaning it is used as "%ug" in the format line),
+and the mark is "&" for messages that are already tracked, and "¡" for
+messages that may be relevant.
** Message Attachments
:PROPERTIES:
:END:
@@ -207,6 +248,12 @@ The same process works in reverse: when you send a message
from an Org
heading using `gnorb-org-handle-mail', Gnorb will ask if you want to
attach the files in the heading's org-attach directory to the outgoing
message.
+** Registry Usage
+You can see how many associations you've got stored in the registry by
+calling `gnorb-report-tracking-usage'. This will pop up a buffer
+showing how much of the registry you're using, and offering
+keybindings for `gnorb-flush-dead-associations', to help Gnorb clean
+up after itself.
** Likely Workflow
You receive an email from Jimmy, who wants to rent a room in your
house. "I'll respond to this later," you think.
@@ -437,10 +484,14 @@ heading to jump to that heading.
use as part of your `gnus-summary-line-format', to indicate
messages which might be relevant to Org TODOs. Defaults to "g",
meaning it should be used as "%ug" in the format line.
-- `gnorb-gnus-summary-mark' :: The mark used to indicate relevant
- messages in the Summary buffer, when
+- `gnorb-gnus-summary-mark' :: The mark used to indicate potentially
+ relevant messages in the Summary buffer, when
`gnorb-gnus-summary-mark-format-letter' is present in the format
line. Defaults to "¡".
+- `gnorb-gnus-summary-tracked-mark' :: The mark used to indicate
+ already-tracked messages in the Summary buffer, when
+ `gnorb-gnus-summary-mark-format-letter' is present in the format
+ line. Defaults to "&".
* Suggested Keybindings
:PROPERTIES:
:ID: de1b2579-86c2-4bb1-b77e-3467a3d2b3c7
@@ -463,8 +514,9 @@ heading to jump to that heading.
(org-defkey org-mode-map (kbd "C-c V") 'gnorb-org-popup-bbdb)
(setq gnorb-org-agenda-popup-bbdb t)
(eval-after-load "org-agenda"
- '(progn (org-defkey org-agenda-mode-map (kbd "H")
'gnorb-org-handle-mail)
- (org-defkey org-agenda-mode-map (kbd "V")
'gnorb-org-popup-bbdb)))))
+ '(progn (org-defkey org-agenda-mode-map (kbd "C-c t")
'gnorb-org-handle-mail)
+ (org-defkey org-agenda-mode-map (kbd "C-c v")
'gnorb-org-popup-bbdb)
+ (org-defkey org-agenda-mode-map (kbd "V") 'gnorb-org-view)))))
(eval-after-load "gnorb-gnus"
'(progn
diff --git a/packages/gnorb/gnorb.texi b/packages/gnorb/gnorb.texi
index f1fccc5..cdd7576 100644
--- a/packages/gnorb/gnorb.texi
+++ b/packages/gnorb/gnorb.texi
@@ -42,11 +42,13 @@
Email Tracking
+* Basic Usage::
* Email-Related Commands::
* Trigger Actions::
* Viewing Tracked Messages in *Summary* Buffers::
* Hinting in Gnus::
* Message Attachments::
+* Registry Usage::
* Likely Workflow::
Misc BBDB
@@ -146,25 +148,57 @@ message IDs are associated with Org heading ids. As a
conversation
develops, messages are collected on a heading (and/or its children).
You can compose new messages directly from the Org heading, and Gnorb
will automatically associate your sent message with the conversation.
-You can open temporary Gnus *Summary* buffers holding all the messages
-associated with an Org subtree, and reply from there. When you receive
-new messages relevant to a conversation, Gnorb will notice them and
-prompt you to associate them with the appropriate Org heading.
-Attachments on incoming messages can be automatically saved as
-attachments on Org headings, using org-attach.
+You can open Gnus *Summary* buffers holding all the messages
+associated with an Org subtree, and reply from there -- these groups
+can be made persistent, if you like. When you receive new messages
+relevant to a conversation, Gnorb will notice them and prompt you to
+associate them with the appropriate Org heading. Attachments on
+incoming messages can be automatically saved as attachments on Org
+headings, using org-attach.
In general, the goal is to keep track of whole conversations, reduce
friction when moving between Gnus and Org, and keep you in the Org
agenda rather than in Gnus.
@menu
+* Basic Usage::
* Email-Related Commands::
* Trigger Actions::
* Viewing Tracked Messages in *Summary* Buffers::
* Hinting in Gnus::
* Message Attachments::
+* Registry Usage::
* Likely Workflow::
@end menu
address@hidden Basic Usage
address@hidden Basic Usage
+
+The following sections might be a bit confusing to read if you haven't
+actually tried using Gnorb. If you don't want to dive in all the way
+just yet, you can just dabble your toes. First set up email tracking
+as specified in @ref{Setup,Setup}, then do the following:
+
address@hidden
address@hidden
+Add ``%ug'' somewhere appropriate in your `gnus-summary-line-format'
+variable.
address@hidden
+If you don't use a local archive method, add your sent message
+groups to `gnorb-gnus-sent-groups' (see the docstring).
address@hidden
+Use Org capture from Gnus summary buffers to create reminders for
+emails you need to reply to.
address@hidden
+Reply to those emails by pressing ``C-c t'' on the TODO heading in
+either the Agenda, or in regular Org files.
address@hidden
+If you ever get confused about what's associated with an Org
+heading, press ``C-c v'' on the heading (works in either the Agenda,
+or regular Org files).
address@hidden enumerate
+
+That should be enough to get started.
+
@node Email-Related Commands
@section Email-Related Commands
@@ -190,11 +224,14 @@ There are three main email-related commands:
`gnorb-org-handle-mail' is called on an Org heading to compose a
new message. By default, this will begin a reply to the most recent
message in the conversation. If there are no associated messages to
-reply to (or you call the function with a double prefix arg), Gnorb
+reply to (or you call the function with a single prefix arg), Gnorb
will look for mailto: or bbdb: links in the heading, and compose a
new message to them.
-The sent message will be associated with the Org heading, and
+Calling the function with a double prefix arg will ignore all
+associated messages and links, and compose a blank message.
+
+Once sent, the message will be associated with the Org heading, and
you'll be brought back to the heading and asked to trigger an
action on it.
@@ -202,7 +239,7 @@ action on it.
`gnorb-org-handle-mail'. It does the same thing as the latter, but
first exports the body of the subtree as either text or a file,
then inserts the text into the message body, or attaches the file
-to the message, depending on what you've chosen.
+to the message, respectively.
@item
`gnorb-gnus-incoming-do-todo' is called on a message in a Gnus
*Summary* buffer. You'll be prompted for an Org heading, taken to
@@ -233,7 +270,14 @@ sent message for this purpose.
Because these three commands all express a similar intent, but are
called in different modes, it can make sense to give each of them the
same keybinding in the keymaps for Org mode, Gnus summary mode, and
-Message mode, respectively.
+Message mode.
+
+An additional convenience command is available for use in Gnus summary
+buffers: `gnorb-gnus-quick-reply'. If you don't want to go through the
+whole round trip of triggering an action and then starting a new
+reply, call this command on an incoming message to associate it with a
+heading, start a reply, and associate your reply with the same
+heading.
@node Trigger Actions
@section Trigger Actions
@@ -241,27 +285,34 @@ Message mode, respectively.
After calling `gnorb-gnus-incoming-do-todo' on a message, or after
sending a message associated with an Org heading, you'll be taken to
the heading and asked to ``trigger an action'' on it. At the moment
-there are four different possibilities: triggering a TODO state-change
+there are six different possibilities: triggering a TODO state-change
on the heading, taking a note on the heading (both these options will
associate the message with the heading), associating the message but
-doing nothing else, and lastly, doing nothing at all.
+doing nothing else, capturing a new Org heading as a sibling to the
+tracked heading, capturing a new Org heading as a child, and lastly,
+doing nothing at all.
-More actions will be added in the future; it's also possible to
+More actions may be added in the future; it's also possible to
rearrange or delete existing actions, and add your own: see the
docstring of `gnorb-org-trigger-actions'.
@node Viewing Tracked Messages in *Summary* Buffers
@section Viewing Tracked Messages in *Summary* Buffers
-Call `gnorb-org-view' on an Org heading to open an nnir *Summary*
-buffer showing all the messages associated with that heading (this
-requires that you've added an nngnorb server to your Gnus backends). A
-minor mode will be in effect, ensuring that any replies you send to
-messages in this buffer will automatically be associated with the
-original Org heading. You can also invoke
+Call `gnorb-org-view' on an Org heading to open an nnir summary buffer
+showing all the messages associated with that heading and child
+headings (this requires you to have added an nngnorb server to your
+Gnus backends). A minor mode is in effect, ensuring that any replies
+you send to messages in this buffer will automatically be associated
+with the original Org heading. You can also invoke
`gnorb-summary-disassociate-message' (``C-c d'') to disassociate the
message with the Org heading.
+If you call `gnorb-org-view' with a prefix argument, the search group
+will be made persistent across Gnus sessions. You can re-run the
+search and update the group contents by hitting ``M-g'' on the group in
+the Gnus *Group* buffer.
+
As a bonus, it's possible to go into Gnus' *Server* buffer, find the
line specifying your nngnorb server, and hit ``G'' (aka
`gnus-group-make-nnir-group'). At the query prompt, enter an Org-style
@@ -281,12 +332,13 @@ messages. You can then use `gnorb-gnus-incoming-to-todo'
to trigger an
action on the relevant TODO.
This hinting can happen in the Gnus summary buffer as well. If you use
-the escape indicated by `gnorb-gnus-summary-mark-format-letter'' as
-part of your `gnus-summary-line-format', articles that are relevant to
-TODOs will be marked with a special character in the Summary buffer,
-as determined by `gnorb-gnus-summary-mark'. By default, the format
-letter is ``g'' (meaning it is used as ``%ug'' in the format line), and
-the mark is ``¡''.
+the escape indicated by `gnorb-gnus-summary-mark-format-letter`` as
+part of your `gnus-summary-line-format', articles that may be relevant
+to TODOs will be marked with a special character in the Summary
+buffer, as determined by `gnorb-gnus-summary-mark'. By default, the
+format letter is ``g'' (meaning it is used as ``%ug'' in the format line),
+and the mark is ``&'' for messages that are already tracked, and ``¡'' for
+messages that may be relevant.
@node Message Attachments
@section Message Attachments
@@ -312,6 +364,15 @@ heading using `gnorb-org-handle-mail', Gnorb will ask if
you want to
attach the files in the heading's org-attach directory to the outgoing
message.
address@hidden Registry Usage
address@hidden Registry Usage
+
+You can see how many associations you've got stored in the registry by
+calling `gnorb-report-tracking-usage'. This will pop up a buffer
+showing how much of the registry you're using, and offering
+keybindings for `gnorb-flush-dead-associations', to help Gnorb clean
+up after itself.
+
@node Likely Workflow
@section Likely Workflow
@@ -618,10 +679,15 @@ use as part of your `gnus-summary-line-format', to
indicate
messages which might be relevant to Org TODOs. Defaults to ``g'',
meaning it should be used as ``%ug'' in the format line.
@item `gnorb-gnus-summary-mark'
-The mark used to indicate relevant
-messages in the Summary buffer, when
+The mark used to indicate potentially
+relevant messages in the Summary buffer, when
`gnorb-gnus-summary-mark-format-letter' is present in the format
line. Defaults to ``¡''.
address@hidden `gnorb-gnus-summary-tracked-mark'
+The mark used to indicate
+already-tracked messages in the Summary buffer, when
+`gnorb-gnus-summary-mark-format-letter' is present in the format
+line. Defaults to ``&''.
@end table
@node Suggested Keybindings
@@ -645,8 +711,9 @@ line. Defaults to ``¡''.
(org-defkey org-mode-map (kbd "C-c V") 'gnorb-org-popup-bbdb)
(setq gnorb-org-agenda-popup-bbdb t)
(eval-after-load "org-agenda"
- '(progn (org-defkey org-agenda-mode-map (kbd "H")
'gnorb-org-handle-mail)
- (org-defkey org-agenda-mode-map (kbd "V")
'gnorb-org-popup-bbdb)))))
+ '(progn (org-defkey org-agenda-mode-map (kbd "C-c t")
'gnorb-org-handle-mail)
+ (org-defkey org-agenda-mode-map (kbd "C-c v")
'gnorb-org-popup-bbdb)
+ (org-defkey org-agenda-mode-map (kbd "V") 'gnorb-org-view)))))
(eval-after-load "gnorb-gnus"
'(progn
@@ -672,5 +739,8 @@ line. Defaults to ``¡''.
(define-key message-mode-map (kbd "C-c t") 'gnorb-gnus-outgoing-do-todo)))
@end lisp
address@hidden Emacs 25.0.50.8 (Org mode 8.3beta)
address@hidden
\ No newline at end of file
address@hidden
address@hidden Local Variables:
address@hidden mode: texinfo
address@hidden TeX-master: t
address@hidden End:
diff --git a/packages/gnorb/nngnorb.el b/packages/gnorb/nngnorb.el
index d1ed896..bb0ddfd 100644
--- a/packages/gnorb/nngnorb.el
+++ b/packages/gnorb/nngnorb.el
@@ -52,7 +52,7 @@
(make-variable-buffer-local 'nngnorb-attachment-file-list)
-(gnus-declare-backend "nngnorb" 'none)
+(gnus-declare-backend "nngnorb" 'post-mail 'virtual)
(add-to-list 'nnir-method-default-engines '(nngnorb . gnorb))
@@ -79,14 +79,14 @@ be scanned for gnus messages, and those messages displayed."
;; a property, and the new registry-based system, we're going to use
;; both methods to collect relevant messages. This could be a little
;; slower, but for the time being it will be safer.
- (save-excursion
+ (save-window-excursion
(let ((q (cdr (assq 'query query)))
(buf (get-buffer-create nnir-tmp-buffer))
msg-ids org-ids links vectors)
(with-current-buffer buf
(erase-buffer)
(setq nngnorb-attachment-file-list nil))
- (when (equal "5.13" gnus-version-number)
+ (when (and (equal "5.13" gnus-version-number) (version< emacs-version
"24.4"))
(setq q (car q)))
(cond ((string-match "id\\+\\([[:alnum:]-]+\\)$" q)
(with-demoted-errors "Error: %S"
@@ -142,7 +142,7 @@ be scanned for gnus messages, and those messages displayed."
(dolist (i (delq nil org-ids))
(let ((rel-msg-id (gnorb-registry-org-id-search i)))
(when rel-msg-id
- (setq msg-ids (append rel-msg-id msg-ids)))))
+ (setq msg-ids (append (delq nil rel-msg-id) msg-ids)))))
(when msg-ids
(dolist (id msg-ids)
(let ((link (gnorb-msg-id-to-link id)))
@@ -183,7 +183,7 @@ continue to provide tracking of sent messages."
;; this summary buffer.
(buffer-local-value
'nngnorb-attachment-file-list
- (get-buffer nnir-tmp-buffer))))
+ (get-buffer-create nnir-tmp-buffer))))
(define-key gnorb-summary-minor-mode-map
[remap gnus-summary-exit]
@@ -278,8 +278,12 @@ continue to provide tracking of sent messages."
(message-insert-header
(intern gnorb-mail-header)
org-id)
- (add-to-list 'message-exit-actions
- 'gnorb-org-restore-after-send t))
+ ;; As with elsewhere, this should be redundant with
+ ;; `gnorb-gnus-check-outgoing-headers.' Even if not, it
+ ;; should be switched to use `message-send-actions'
+ ;; (add-to-list 'message-exit-actions
+ ;; 'gnorb-org-restore-after-send t)
+ )
(goto-char compose-marker))
(when attachments
(map-y-or-n-p
@@ -309,7 +313,7 @@ the message being included in this search."
(gnus-summary-article-number)))
(let* ((msg-id (gnus-fetch-original-field "message-id"))
(org-ids (gnus-registry-get-id-key msg-id 'gnorb-ids))
- chosen)
+ chosen multiple-alist)
(if org-ids
(progn
(if (= (length org-ids) 1)
@@ -317,14 +321,18 @@ the message being included in this search."
(progn (gnus-registry-set-id-key msg-id 'gnorb-ids nil)
(setq chosen (car org-ids)))
;; Multiple associated TODOs, prompt to choose one.
+ (setq multiple-alist
+ (mapcar
+ (lambda (h)
+ (cons (gnorb-pretty-outline h) h))
+ org-ids))
(setq chosen
(cdr
- (org-completing-read
- "Choose a TODO to disassociate from: "
- (mapcar
- (lambda (h)
- (cons (gnorb-pretty-outline h) h))
- org-ids))))
+ (assoc
+ (org-completing-read
+ "Choose a TODO to disassociate from: "
+ multiple-alist)
+ multiple-alist)))
(gnus-registry-set-id-key msg-id 'gnorb-ids
(remove chosen org-ids)))
(message "Message disassociated from %s"
diff --git a/packages/html5-schema/.htaccess b/packages/html5-schema/.htaccess
new file mode 100644
index 0000000..8727307
--- /dev/null
+++ b/packages/html5-schema/.htaccess
@@ -0,0 +1,10 @@
+AddDescription "RelaxNG Schema for HTML 5 Core (XML)" xhtml5core.rnc
+AddDescription "RelaxNG Schema for HTML 5 Core (HTML)" html5core.rnc
+AddDescription "RelaxNG Schema for HTML 5 Exclusions" html5exclusions.rnc
+
+AddDescription "RelaxNG Schema for HTML 5: Common Definitions" common.rnc
+AddDescription "RelaxNG Schema for HTML 5: Global Structure & Meta Data"
meta.rnc
+AddDescription "RelaxNG Schema for HTML 5: (Inline) Phrase Markup" phrase.rnc
+AddDescription "RelaxNG Schema for HTML 5: Basic Block Markup" block.rnc
+AddDescription "Schema Testing Scripts and Instances" tests
+
diff --git a/packages/html5-schema/LICENSE b/packages/html5-schema/LICENSE
new file mode 100644
index 0000000..0a2a5e0
--- /dev/null
+++ b/packages/html5-schema/LICENSE
@@ -0,0 +1,23 @@
+The RELAX NG Schema for (X)HTML 5 is licensed under the MIT open source
license.
+The following legal notice applies to all files in this directory:
+
+Copyright (c) 2005-2007 Elika J. Etemad (fantasai) and Henri Sivonen (hsivonen)
+Copyright (c) 2007-2012 Mozilla Foundation
+
+Permission is hereby granted, free of charge, to any person obtaining a copy of
+this software and associated documentation files (the "Software"), to deal in
+the Software without restriction, including without limitation the rights to
+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
+of the Software, and to permit persons to whom the Software is furnished to do
+so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+THE SOFTWARE.
diff --git a/packages/html5-schema/applications.rnc
b/packages/html5-schema/applications.rnc
new file mode 100644
index 0000000..618814d
--- /dev/null
+++ b/packages/html5-schema/applications.rnc
@@ -0,0 +1,405 @@
+datatypes w = "http://whattf.org/datatype-draft";
+
+# #####################################################################
+## RELAX NG Schema for HTML 5: Web Application Features #
+# #####################################################################
+
+## Additions to Common Attributes
+
+ common.attrs.interact &=
+ ( common.attrs.contextmenu?
+ & common.attrs.contenteditable?
+ & common.attrs.draggable?
+ & common.attrs.dropzone?
+ & common.attrs.hidden?
+ & common.attrs.spellcheck?
+ )
+
+ common.attrs.other &= common.attrs.interact
+
+## Context Menu: contextmenu
+
+ common.attrs.contextmenu =
+ attribute contextmenu {
+ common.data.idref
+ }
+
+## Editable Content: contenteditable
+
+ common.attrs.contenteditable =
+ attribute contenteditable {
+ w:string "true" | w:string "false" | w:string ""
+ }
+
+## Draggable Element: draggable
+
+ common.attrs.draggable =
+ attribute draggable {
+ w:string "true" | w:string "false"
+ }
+
+## Dropzone: dropzone
+
+ common.attrs.dropzone =
+ attribute dropzone {
+ list {
+ ( xsd:string { pattern =
"[sS][tT][rR][iI][nN][gG]:.+" }
+ | xsd:string { pattern =
"[fF][iI][lL][eE]:.+" }
+ )*
+ ,
+ ( w:string "copy"
+ | w:string "move"
+ | w:string "link"
+ )?
+ ,
+ ( xsd:string { pattern =
"[sS][tT][rR][iI][nN][gG]:.+" }
+ | xsd:string { pattern =
"[fF][iI][lL][eE]:.+" }
+ )*
+ }
+ }
+
+## Hidden Element: hidden
+
+ common.attrs.hidden =
+ attribute hidden {
+ w:string "hidden" | w:string ""
+ }
+
+## Spellchecking and grammar checking: spellcheck
+
+ common.attrs.spellcheck =
+ attribute spellcheck{
+ w:string "true" | w:string "false" | w:string ""
+ }
+
+## Application Cache: manifest
+
+ html.attrs.manifest =
+ attribute manifest {
+ common.data.uri.non-empty
+ }
+
+ html.attrs &= html.attrs.manifest?
+
+## Progess Indicator: <progress>
+
+ progress.elem =
+ element progress { progress.inner & progress.attrs }
+ progress.attrs =
+ ( common.attrs
+ & progress.attrs.value?
+ & progress.attrs.max?
+ & ( common.attrs.aria.implicit.progressbar
+ | common.attrs.aria.role.progressbar
+ )?
+ )
+ progress.attrs.value =
+ attribute value {
+ common.data.float.non-negative
+ }
+ progress.attrs.max =
+ attribute max {
+ common.data.float.positive
+ }
+ progress.inner =
+ ( common.inner.phrasing ) #Cannot enforce textContent format
here
+
+ common.elem.phrasing |= progress.elem
+
+## Dialog box, inspector, or window: <dialog>
+ dialog.elem =
+ element dialog { dialog.inner & dialog.attrs }
+ dialog.attrs =
+ ( common.attrs
+ & dialog.attrs.open?
+ & ( common.attrs.aria.implicit.dialog
+ | common.attrs.aria.role.alert
+ | common.attrs.aria.role.alertdialog
+ | common.attrs.aria.role.contentinfo
+ | common.attrs.aria.role.dialog
+ | common.attrs.aria.role.log
+ | common.attrs.aria.role.marquee
+ | common.attrs.aria.role.region
+ | common.attrs.aria.role.status
+ | common.attrs.aria.landmark.application
+ | common.attrs.aria.landmark.document
+ | common.attrs.aria.landmark.main
+ | common.attrs.aria.landmark.search
+ )?
+ )
+ dialog.attrs.open =
+ attribute open {
+ w:string "open" | w:string ""
+ }
+ dialog.inner =
+ ( common.inner.flow )
+ common.elem.flow |= dialog.elem
+
+## Toolbar: <menu type=toolbar>
+
+ menu.toolbar.elem =
+ element menu { menu.toolbar.inner & menu.toolbar.attrs }
+ menu.toolbar.attrs =
+ ( common.attrs
+ & menu.toolbar.attrs.type?
+ & ( common.attrs.aria.implicit.toolbar
+ | common.attrs.aria.role.directory
+ | common.attrs.aria.role.list
+ | common.attrs.aria.role.listbox
+ | common.attrs.aria.role.menu
+ | common.attrs.aria.role.menubar
+ | common.attrs.aria.role.tablist
+ | common.attrs.aria.role.toolbar
+ | common.attrs.aria.role.tree
+ | common.attrs.aria.role.presentation
+ )?
+ )
+ menu.toolbar.attrs.type =
+ attribute type {
+ w:string "toolbar"
+ }
+ menu.toolbar.inner =
+ ( mli.elem*
+ | common.inner.flow
+ )
+ menu.elem |= menu.toolbar.elem
+
+## Toolbar item: <li>
+
+ mli.elem =
+ element li { mli.inner & mli.attrs }
+ mli.attrs =
+ ( common.attrs
+ & ( ( common.attrs.aria.role.listitem
+ | common.attrs.aria.role.menuitem
+ | common.attrs.aria.role.menuitemcheckbox
+ | common.attrs.aria.role.menuitemradio
+ | common.attrs.aria.role.option
+ | common.attrs.aria.role.tab
+ | common.attrs.aria.role.treeitem
+ | common.attrs.aria.role.presentation
+ )
+ )?
+ )
+ mli.inner =
+ ( common.inner.flow )
+
+## Popup menu: <menu type=popup>
+
+ menu.popup.elem =
+ element menu { menu.popup.inner & menu.popup.attrs }
+ menu.popup.attrs =
+ ( common.attrs
+ & menu.popup.attrs.type?
+ & menu.attrs.label?
+ & common.attrs.aria?
+ )
+ menu.popup.attrs.type =
+ attribute type {
+ w:string "popup"
+ }
+ menu.attrs.label =
+ attribute label {
+ string
+ }
+ menu.popup.inner =
+ ( menuitem.elem*
+ & hr.elem*
+ & menu.popup.elem*
+ & common.elem.script-supporting*
+ )
+ menu.elem |= menu.popup.elem
+
+## Ambiguous menu: <menu> (with no "type" attribute)
+ menu.ambiguous.elem =
+ element menu { menu.ambiguous.inner & menu.ambiguous.attrs }
+ menu.ambiguous.attrs =
+ ( common.attrs
+ & menu.attrs.label?
+ & common.attrs.aria?
+ )
+ menu.ambiguous.inner =
+ ( ( menuitem.elem*
+ & hr.elem*
+ & menu.ambiguous.elem*
+ & common.elem.script-supporting*
+ )
+ | ( mli.elem*
+ | common.inner.flow
+ )
+ )
+ menu.elem |= menu.ambiguous.elem
+
+ common.elem.flow |= menu.elem
+ # REVISIT allow nested menus
+
+## Explicit command in popup menu: <menuitem type=command>
+ menuitem.explicit.command.elem =
+ element menuitem { menuitem.inner &
menuitem.explicit.command.attrs }
+ menuitem.explicit.command.attrs =
+ ( common.attrs
+ & menuitem.explicit.command.attrs.type?
+ & menuitem.attrs.label?
+ & menuitem.attrs.icon?
+ & menuitem.attrs.disabled?
+ & menuitem.attrs.default?
+ & common.attrs.aria?
+ )
+ menuitem.explicit.command.attrs.type =
+ attribute type {
+ w:string "command"
+ }
+ menuitem.attrs.label =
+ attribute label {
+ w:non-empty-string
+ }
+ menuitem.attrs.icon =
+ attribute icon {
+ common.data.uri.non-empty
+ }
+ menuitem.attrs.disabled =
+ attribute disabled {
+ w:string "" | w:string "disabled"
+ }
+ menuitem.attrs.default =
+ attribute default {
+ w:string "" | w:string "default"
+ }
+ menuitem.elem |= menuitem.explicit.command.elem
+
+## Checkbox in popup menu: <menuitem type=checkbox>
+ menuitem.checkbox.elem =
+ element menuitem { menuitem.inner & menuitem.checkbox.attrs }
+ menuitem.checkbox.attrs =
+ ( common.attrs
+ & menuitem.checkbox.attrs.type
+ & menuitem.attrs.label?
+ & menuitem.attrs.icon?
+ & menuitem.attrs.disabled?
+ & menuitem.attrs.checked?
+ & menuitem.attrs.radiogroup?
+ & menuitem.attrs.default?
+ & common.attrs.aria?
+ )
+ menuitem.checkbox.attrs.type =
+ attribute type {
+ w:string "checkbox"
+ }
+ menuitem.attrs.checked =
+ attribute checked {
+ w:string "checked" | w:string ""
+ }
+ menuitem.attrs.radiogroup =
+ attribute radiogroup {
+ string
+ }
+ menuitem.elem |= menuitem.checkbox.elem
+
+## Radio button in popup menu: <menuitem type=radio>
+ menuitem.radio.elem =
+ element menuitem { menuitem.inner & menuitem.radio.attrs }
+ menuitem.radio.attrs =
+ ( common.attrs
+ & menuitem.radio.attrs.type
+ & menuitem.attrs.label?
+ & menuitem.attrs.icon?
+ & menuitem.attrs.disabled?
+ & menuitem.attrs.checked?
+ & menuitem.attrs.radiogroup?
+ & menuitem.attrs.default?
+ & common.attrs.aria?
+ )
+ menuitem.radio.attrs.type =
+ attribute type {
+ w:string "radio"
+ }
+ menuitem.elem |= menuitem.radio.elem
+
+## Indirect command in popup menu: <menuitem command>
+ menuitem.indirect.command.elem =
+ element menuitem { menuitem.inner &
menuitem.indirect.command.attrs }
+ menuitem.indirect.command.attrs =
+ ( common.attrs
+ & menuitem.attrs.default?
+ & menuitem.attrs.command
+ & common.attrs.aria?
+ )
+ menuitem.attrs.command =
+ attribute command {
+ common.data.idref
+ }
+ menuitem.elem |= menuitem.indirect.command.elem
+
+ menuitem.inner =
+ ( empty )
+
+## Canvas for Dynamic Graphics: <canvas>
+
+ canvas.elem.flow =
+ element canvas { canvas.inner.flow & canvas.attrs }
+ canvas.elem.phrasing =
+ element canvas { canvas.inner.phrasing & canvas.attrs }
+ canvas.attrs =
+ ( common.attrs
+ & canvas.attrs.height?
+ & canvas.attrs.width?
+ & common.attrs.aria?
+ )
+ canvas.attrs.height =
+ attribute height {
+ common.data.integer.non-negative
+ }
+ canvas.attrs.width =
+ attribute width {
+ common.data.integer.non-negative
+ }
+ canvas.inner.flow =
+ ( common.inner.transparent.flow )
+ canvas.inner.phrasing =
+ ( common.inner.phrasing )
+
+ common.elem.flow |= canvas.elem.flow
+ common.elem.phrasing |= canvas.elem.phrasing
+
+## Additional On-Demand Information: <details>
+
+ details.elem =
+ element details { details.inner & details.attrs }
+ details.attrs =
+ ( common.attrs
+ & details.attrs.open?
+ & ( common.attrs.aria.implicit.group #
aria-expanded must be true if open attr present; check by assertions
+ | common.attrs.aria.role.group
+ )?
+ )
+ details.attrs.open =
+ attribute open {
+ w:string "open" | w:string ""
+ }
+ details.inner =
+ ( summary.elem
+ , common.inner.flow
+ )
+
+ common.elem.flow |= details.elem
+
+## Caption/summary for details element: <summary>
+
+ summary.elem =
+ element summary { summary.inner & summary.attrs }
+ summary.attrs =
+ ( common.attrs
+ & ( common.attrs.aria.implicit.button
+ | common.attrs.aria.role.button
+ )?
+ )
+ summary.inner =
+ ( common.inner.phrasing
+ | h1.elem
+ | h2.elem
+ | h3.elem
+ | h4.elem
+ | h5.elem
+ | h6.elem
+ | hgroup.elem
+ )
diff --git a/packages/html5-schema/aria.rnc b/packages/html5-schema/aria.rnc
new file mode 100644
index 0000000..61e007b
--- /dev/null
+++ b/packages/html5-schema/aria.rnc
@@ -0,0 +1,1251 @@
+# #####################################################################
+## RELAX NG Schema for HTML 5: Accessible Rich Internet Applications #
+# #####################################################################
+#
+# history: http://hsivonen.iki.fi/aria-html5-bis/
+
+# #####################################################################
+## ARIA
+
+## Global states and properties
+
+aria.global =
+ ( aria.prop.atomic?
+ & aria.state.busy?
+ & aria.prop.controls?
+ & aria.prop.describedby?
+ & aria.state.disabled?
+ & aria.state.dropeffect?
+ & aria.prop.flowto?
+ & aria.state.grabbed?
+ & aria.prop.haspopup?
+ & aria.state.hidden?
+ & aria.state.invalid?
+ & aria.prop.label?
+ & aria.prop.labelledby?
+ & aria.prop.live?
+ & aria.prop.owns?
+ & aria.prop.relevant?
+ )
+
+common.attrs.other &= aria.global?
+
+## States and Properties for Native Roles
+
+common.attrs.aria.implicit.button |=
+ ( aria.state.expanded?
+ & aria.state.pressed?
+ )
+
+common.attrs.aria.implicit.checkbox |=
+ ( aria.state.checked? )
+
+common.attrs.aria.implicit.combobox |=
+ ( aria.state.expanded?
+ & aria.prop.autocomplete?
+ & aria.prop.required?
+ & aria.prop.activedescendant?
+ )
+
+common.attrs.aria.implicit.dialog |=
+ ( aria.state.expanded? )
+
+common.attrs.aria.implicit.document |=
+ ( aria.state.expanded? )
+
+common.attrs.aria.implicit.form |=
+ ( aria.state.expanded? )
+
+common.attrs.aria.implicit.group |=
+ ( aria.state.expanded?
+ & aria.prop.activedescendant?
+ )
+
+common.attrs.aria.implicit.heading |=
+ ( aria.state.expanded?
+ & aria.prop.level?
+ )
+
+common.attrs.aria.implicit.img |=
+ ( aria.state.expanded? )
+
+common.attrs.aria.implicit.link |=
+ ( aria.state.expanded? )
+
+common.attrs.aria.implicit.listbox |=
+ ( aria.prop.multiselectable?
+ & aria.prop.required?
+ & aria.prop.activedescendant?
+ & aria.state.expanded?
+ )
+
+common.attrs.aria.implicit.listitem |=
+ ( aria.prop.level?
+ & aria.prop.posinset?
+ & aria.prop.setsize?
+ & aria.state.expanded?
+ )
+
+common.attrs.aria.implicit.option |=
+ ( aria.prop.posinset?
+ & aria.prop.setsize?
+ & aria.state.checked?
+ & aria.state.selected?
+ )
+
+common.attrs.aria.implicit.progressbar |=
+ ( aria.prop.valuemax?
+ & aria.prop.valuemin?
+ & aria.prop.valuenow?
+ & aria.prop.valuetext?
+ )
+
+common.attrs.aria.implicit.radio |=
+ ( aria.prop.posinset?
+ & aria.prop.setsize?
+ & aria.state.checked?
+ & aria.state.selected?
+ )
+
+common.attrs.aria.implicit.slider |=
+ ( aria.prop.valuemax?
+ & aria.prop.valuemin?
+ & aria.prop.valuenow?
+ & aria.prop.valuetext?
+ & aria.prop.orientation?
+ )
+
+common.attrs.aria.implicit.spinbutton |=
+ ( aria.prop.valuemax?
+ & aria.prop.valuemin?
+ & aria.prop.valuenow?
+ & aria.prop.valuetext?
+ & aria.prop.required?
+ )
+
+common.attrs.aria.implicit.textbox |=
+ ( aria.prop.activedescendant?
+ & aria.prop.autocomplete?
+ & aria.prop.multiline?
+ & aria.prop.readonly?
+ & aria.prop.required?
+ )
+
+common.attrs.aria.implicit.toolbar |=
+ ( aria.state.expanded?
+ & aria.prop.activedescendant?
+ )
+
+common.attrs.aria.implicit.column-or-row-header |=
+ ( aria.prop.sort?
+ & aria.prop.readonly?
+ & aria.prop.required?
+ & aria.state.selected?
+ & aria.state.expanded?
+ )
+
+#common.attrs.aria.implicit.select |=
+# ( aria.state.invalid?
+# & aria.prop.required?
+# & aria.prop.atomic?
+# & aria.state.busy?
+# & aria.prop.channel?
+# & aria.prop.controls?
+# & aria.prop.live?
+# & aria.prop.relevant?
+# )
+
+# section
+# |
+# |_ region
+# |
+# |_ article
+# |
+# |_ landmark
+# | |_ banner
+# | |_ complementary
+# | |_ contentinfo
+# | |_ main
+# | |_ navigation
+# |
+# |_ list
+# |
+# |_ status
+
+common.attrs.aria.implicit.section |=
+ ( aria.state.expanded? )
+
+common.attrs.aria.implicit.region |= common.attrs.aria.implicit.section
+
+common.attrs.aria.implicit.article |= common.attrs.aria.implicit.region
+common.attrs.aria.implicit.landmark |= common.attrs.aria.implicit.region
+common.attrs.aria.implicit.list |= common.attrs.aria.implicit.region
+common.attrs.aria.implicit.status |= common.attrs.aria.implicit.region
+
+common.attrs.aria.implicit.banner |= common.attrs.aria.implicit.landmark
+common.attrs.aria.implicit.complementary |= common.attrs.aria.implicit.landmark
+common.attrs.aria.implicit.contentinfo |= common.attrs.aria.implicit.landmark
+common.attrs.aria.implicit.main |= common.attrs.aria.implicit.landmark
+common.attrs.aria.implicit.navigation |= common.attrs.aria.implicit.landmark
+
+# #####################################################################
+## States
+
+## busy
+ aria.state.busy =
+ attribute aria-busy
+ { string "true"
+ | string "false" #default
+ }
+
+## checked
+ aria.state.checked =
+ attribute aria-checked
+ { string "true"
+ | string "false"
+ | string "mixed"
+ | string "undefined" #default
+ }
+
+## disabled
+ aria.state.disabled =
+ attribute aria-disabled
+ { string "true"
+ | string "false" #default
+ }
+
+## dropeffect
+ aria.state.dropeffect =
+ attribute aria-dropeffect
+ { token "none" #default
+ | token "popup"
+ | token "execute"
+ | list
+ { ( string "copy" )
+ , ( string "execute" )?
+ }
+ | list
+ { ( string "move" )
+ , ( string "execute" )?
+ }
+ | list
+ { ( string "link" )
+ , ( string "execute" )?
+ }
+ | list
+ { ( string "execute" )
+ , ( string "copy" )
+ }
+ | list
+ { ( string "execute" )
+ , ( string "move" )
+ }
+ | list
+ { ( string "execute" )
+ , ( string "link" )
+ }
+ }
+
+## expanded
+ aria.state.expanded =
+ attribute aria-expanded
+ { string "true"
+ | string "false"
+ | string "undefined" #default
+ }
+
+## grabbed
+ aria.state.grabbed =
+ attribute aria-grabbed
+ { string "true"
+ | string "false"
+ | string "undefined" #default
+ }
+
+## hidden
+ aria.state.hidden =
+ attribute aria-hidden
+ { string "true"
+ | string "false" #default
+ }
+
+## invalid
+ aria.state.invalid =
+ attribute aria-invalid
+ { string "true"
+ | string "false" #default
+ | string "grammar"
+ | string "spelling"
+ }
+
+## pressed
+ aria.state.pressed =
+ attribute aria-pressed
+ { string "true"
+ | string "false"
+ | string "mixed"
+ | string "undefined" #default
+ }
+
+## selected
+ aria.state.selected =
+ attribute aria-selected
+ { string "true"
+ | string "false"
+ | string "undefined" #default
+ }
+
+
+
+# #####################################################################
+## Properties
+
+## activedescendant
+ aria.prop.activedescendant =
+ attribute aria-activedescendant {
+ common.data.idref #REVISIT add Schematron check
+ }
+
+## atomic
+ aria.prop.atomic =
+ attribute aria-atomic
+ { string "true"
+ | string "false" #default
+ }
+
+## autocomplete
+ aria.prop.autocomplete =
+ attribute aria-autocomplete
+ { string "inline"
+ | string "list"
+ | string "both"
+ | string "none" #default
+ }
+
+## controls
+ aria.prop.controls =
+ attribute aria-controls {
+ common.data.idrefs #REVISIT add Schematron check
+ }
+
+## describedby
+ aria.prop.describedby =
+ attribute aria-describedby {
+ common.data.idrefs #REVISIT add Schematron check
+ }
+
+## flowto
+ aria.prop.flowto =
+ attribute aria-flowto {
+ common.data.idrefs #REVISIT add Schematron check
+ }
+
+## haspopup
+ aria.prop.haspopup =
+ attribute aria-haspopup
+ { string "true" #REVISIT check owns or descendant
+ | string "false" #default
+ }
+
+## label
+ aria.prop.label =
+ attribute aria-label {
+ string
+ }
+
+## labelledby
+ aria.prop.labelledby =
+ attribute aria-labelledby {
+ common.data.idrefs #REVISIT add Schematron check
+ }
+
+## level
+ aria.prop.level =
+ attribute aria-level {
+ common.data.integer.positive
+ }
+
+## live
+ aria.prop.live =
+ attribute aria-live
+ { string "off" #default
+ | string "polite"
+ | string "assertive"
+ }
+
+## multiline
+ aria.prop.multiline =
+ attribute aria-multiline
+ { string "true"
+ | string "false" #default
+ }
+
+## multiselectable
+ aria.prop.multiselectable =
+ attribute aria-multiselectable
+ { string "true"
+ | string "false" #default
+ }
+
+## orientation
+ aria.prop.orientation =
+ attribute aria-orientation
+ { string "vertical"
+ | string "horizontal" #default
+ }
+
+## owns
+ aria.prop.owns =
+ attribute aria-owns {
+ common.data.idrefs #REVISIT add Schematron check
+ }
+
+## posinset
+ aria.prop.posinset =
+ attribute aria-posinset {
+ common.data.integer.positive
+ }
+
+## readonly
+ aria.prop.readonly =
+ attribute aria-readonly
+ { string "true"
+ | string "false" #default
+ }
+ common.attrs.aria.prop.readonly |= aria.prop.readonly
+
+## relevant
+ aria.prop.relevant =
+ attribute aria-relevant
+ { token "all"
+ | list
+ { ( string "additions" )
+ , ( string "removals" )?
+ , ( string "text" )?
+ }
+ | list
+ { ( string "additions" )
+ , ( string "text" )?
+ , ( string "removals" )?
+ }
+ | list
+ { ( string "removals" )
+ , ( string "additions" )?
+ , ( string "text" )?
+ }
+ | list
+ { ( string "removals" )
+ , ( string "text" )?
+ , ( string "additions" )?
+ }
+ | list
+ { ( string "text" )
+ , ( string "additions" )?
+ , ( string "removals" )?
+ }
+ | list
+ { ( string "text" )
+ , ( string "removals" )?
+ , ( string "additions" )?
+ }
+ }
+
+## required
+ aria.prop.required =
+ attribute aria-required
+ { string "true"
+ | string "false" #default
+ }
+
+## setsize
+ aria.prop.setsize =
+ attribute aria-setsize {
+ common.data.integer.non-negative
+ }
+
+## sort
+ aria.prop.sort =
+ attribute aria-sort
+ { string "ascending"
+ | string "descending"
+ | string "none" #default
+ | string "other"
+ }
+
+## valuemax
+ aria.prop.valuemax =
+ attribute aria-valuemax {
+ common.data.float #REVISIT
+ }
+
+## valuemin
+ aria.prop.valuemin =
+ attribute aria-valuemin {
+ common.data.float #REVISIT
+ }
+
+## valuenow
+ aria.prop.valuenow =
+ attribute aria-valuenow {
+ common.data.float #REVISIT
+ }
+
+## valuetext
+ aria.prop.valuetext =
+ attribute aria-valuetext {
+ string
+ }
+
+# #####################################################################
+## Roles
+
+## alert
+ aria.alert =
+ ( aria.role.alert
+ & aria.state.expanded?
+ )
+ aria.role.alert =
+ attribute role { string "alert" }
+
+ common.attrs.aria |= aria.alert
+ common.attrs.aria.role.alert |= aria.alert
+
+## alertdialog
+ aria.alertdialog =
+ ( aria.role.alertdialog
+ & aria.state.expanded?
+ )
+ aria.role.alertdialog =
+ attribute role { string "alertdialog" }
+
+ common.attrs.aria |= aria.alertdialog
+ common.attrs.aria.role.alertdialog |= aria.alertdialog
+
+## application
+ aria.application =
+ ( aria.role.application
+ & aria.state.expanded?
+ )
+ aria.role.application =
+ attribute role { string "application" }
+
+ common.attrs.aria |= aria.application
+ common.attrs.aria.landmark.application |= aria.application
+
+## article
+ aria.article =
+ ( aria.role.article
+ & aria.state.expanded?
+ )
+ aria.role.article =
+ attribute role { string "article" }
+
+ common.attrs.aria |= aria.article
+ common.attrs.aria.landmark.article |= aria.article
+
+## banner
+ aria.banner =
+ ( aria.role.banner
+ & aria.state.expanded?
+ )
+ aria.role.banner =
+ attribute role { string "banner" }
+
+ common.attrs.aria |= aria.banner
+ common.attrs.aria.landmark.banner |= aria.banner
+
+## button
+ aria.button =
+ ( aria.role.button
+ & aria.state.expanded?
+ & aria.state.pressed? # not inherited
+ )
+ aria.role.button =
+ attribute role { string "button" }
+
+ common.attrs.aria |= aria.button
+ common.attrs.aria.role.button |= aria.button
+
+## checkbox
+ aria.checkbox =
+ ( aria.role.checkbox
+ & aria.state.checked #required!
+ )
+ aria.role.checkbox =
+ attribute role { string "checkbox" }
+
+ common.attrs.aria |= aria.checkbox
+ common.attrs.aria.role.checkbox |= aria.checkbox
+
+# columnheader
+ aria.columnheader =
+ ( aria.role.columnheader
+ & aria.prop.sort? # not inherited
+ & aria.prop.readonly? # not inherited
+ & aria.state.selected? # not inherited
+ & aria.state.expanded?
+ & aria.prop.required?
+ )
+ aria.role.columnheader =
+ attribute role { string "columnheader" }
+
+ common.attrs.aria |= aria.columnheader
+
+## combobox
+ aria.combobox =
+ ( aria.role.combobox
+ & aria.prop.activedescendant?
+ & aria.state.expanded #required!
+ & aria.prop.autocomplete?
+ & aria.prop.required?
+ )
+ aria.role.combobox =
+ attribute role { string "combobox" }
+
+ common.attrs.aria |= aria.combobox
+ common.attrs.aria.role.combobox |= aria.combobox
+
+## complementary
+ aria.complementary =
+ ( aria.role.complementary
+ & aria.state.expanded?
+ )
+ aria.role.complementary =
+ attribute role { string "complementary" }
+
+ common.attrs.aria |= aria.complementary
+ common.attrs.aria.landmark.complementary |= aria.complementary
+
+## contentinfo
+ aria.contentinfo =
+ ( aria.role.contentinfo
+ & aria.state.expanded?
+ )
+ aria.role.contentinfo =
+ attribute role { string "contentinfo" }
+
+ common.attrs.aria |= aria.contentinfo
+ common.attrs.aria.landmark.contentinfo |= aria.contentinfo
+
+## definition
+ aria.definition =
+ ( aria.role.definition
+ & aria.state.expanded?
+ )
+ aria.role.definition =
+ attribute role { string "definition" }
+
+ common.attrs.aria |= aria.definition
+
+## dialog
+ aria.dialog =
+ ( aria.role.dialog
+ & aria.state.expanded?
+ )
+ aria.role.dialog =
+ attribute role { string "dialog" }
+
+ common.attrs.aria |= aria.dialog
+ common.attrs.aria.role.dialog |= aria.dialog
+
+## directory
+ aria.directory =
+ ( aria.role.directory
+ & aria.state.expanded?
+ )
+ aria.role.directory =
+ attribute role { string "directory" }
+
+ common.attrs.aria |= aria.directory
+ common.attrs.aria.role.directory |= aria.directory
+
+## document
+ aria.document =
+ ( aria.role.document
+ & aria.state.expanded?
+ )
+ aria.role.document =
+ attribute role { string "document" }
+
+ common.attrs.aria |= aria.document
+ common.attrs.aria.landmark.document |= aria.document
+
+## form
+ aria.form =
+ ( aria.role.form
+ & aria.state.expanded?
+ )
+ aria.role.form =
+ attribute role { string "form" }
+
+ common.attrs.aria |= aria.form
+ common.attrs.aria.landmark.form |= aria.form
+
+## grid
+ aria.grid =
+ ( aria.role.grid
+ & aria.prop.level? # not inherited
+ & aria.prop.multiselectable? # not inherited
+ & aria.prop.readonly? # not inherited
+ & aria.prop.activedescendant?
+ & aria.state.expanded?
+ )
+ aria.role.grid =
+ attribute role { string "grid" }
+
+ common.attrs.aria |= aria.grid
+
+## gridcell
+ aria.gridcell =
+ ( aria.role.gridcell
+ & aria.prop.level? # net inherited
+ & aria.prop.readonly? # not inherited
+ & aria.state.selected? # not inherited
+ & aria.state.expanded?
+ & aria.prop.required?
+ )
+ aria.role.gridcell =
+ attribute role { string "gridcell" }
+
+ common.attrs.aria |= aria.gridcell
+
+## group
+ aria.group =
+ ( aria.role.group
+ & aria.prop.activedescendant? # not inherited
+ & aria.state.expanded? # not inherited
+ )
+ aria.role.group =
+ attribute role { string "group" }
+
+ common.attrs.aria |= aria.group
+ common.attrs.aria.role.group |= aria.group
+
+## heading
+ aria.heading =
+ ( aria.role.heading
+ & aria.prop.level ? # not inherited
+ & aria.state.expanded?
+ )
+ aria.role.heading =
+ attribute role { string "heading" }
+
+ common.attrs.aria |= aria.heading
+ common.attrs.aria.role.heading |= aria.heading
+
+## img
+ aria.img =
+ ( aria.role.img
+ & aria.state.expanded?
+ )
+ aria.role.img =
+ attribute role { string "img" }
+
+ common.attrs.aria |= aria.img
+ common.attrs.aria.role.img |= aria.img
+
+## link
+ aria.link =
+ ( aria.role.link
+ & aria.state.expanded?
+ )
+ aria.role.link =
+ attribute role { string "link" }
+
+ common.attrs.aria |= aria.link
+ common.attrs.aria.role.link |= aria.link
+
+## list
+ aria.list =
+ ( aria.role.list
+ & aria.state.expanded?
+ )
+ aria.role.list =
+ attribute role { string "list" }
+
+ common.attrs.aria |= aria.list
+ common.attrs.aria.role.list |= aria.list
+
+## listbox
+ aria.listbox =
+ ( aria.role.listbox
+ & aria.prop.multiselectable? # not inherited
+ & aria.prop.required?
+ & aria.prop.activedescendant?
+ & aria.state.expanded?
+ )
+ aria.role.listbox =
+ attribute role { string "listbox" }
+
+ common.attrs.aria |= aria.listbox
+ common.attrs.aria.role.listbox |= aria.listbox
+
+## listitem
+ aria.listitem =
+ ( aria.role.listitem
+ & aria.prop.posinset? # not inherited
+ & aria.prop.setsize? # not inherited
+ & aria.prop.level? # not inherited
+ & aria.state.expanded?
+ )
+ aria.role.listitem =
+ attribute role { string "listitem" }
+
+ common.attrs.aria |= aria.listitem
+ common.attrs.aria.role.listitem |= aria.listitem
+
+## log
+ aria.log =
+ ( aria.role.log
+ & aria.state.expanded?
+ )
+ aria.role.log =
+ attribute role { string "log" }
+
+ common.attrs.aria |= aria.log
+ common.attrs.aria.role.log |= aria.log
+
+## main
+ aria.main =
+ ( aria.role.main
+ & aria.state.expanded?
+ )
+ aria.role.main =
+ attribute role { string "main" }
+
+ common.attrs.aria |= aria.main
+ common.attrs.aria.landmark.main |= aria.main
+
+## marquee
+ aria.marquee =
+ ( aria.role.marquee
+ & aria.state.expanded?
+ )
+ aria.role.marquee =
+ attribute role { string "marquee" }
+
+ common.attrs.aria |= aria.marquee
+ common.attrs.aria.role.marquee |= aria.marquee
+
+## math
+ aria.math =
+ ( aria.role.math
+ & aria.state.expanded?
+ )
+ aria.role.math =
+ attribute role { string "math" }
+
+ common.attrs.aria |= aria.math
+
+## menu
+ aria.menu =
+ ( aria.role.menu
+ & aria.prop.activedescendant?
+ & aria.state.expanded?
+ )
+ aria.role.menu =
+ attribute role { string "menu" }
+
+ common.attrs.aria |= aria.menu
+ common.attrs.aria.role.menu |= aria.menu
+
+## menubar
+ aria.menubar =
+ ( aria.role.menubar
+ & aria.prop.activedescendant?
+ & aria.state.expanded?
+ )
+ aria.role.menubar =
+ attribute role { string "menubar" }
+
+ common.attrs.aria |= aria.menubar
+ common.attrs.aria.role.menubar |= aria.menubar
+
+
+## menuitem
+ aria.menuitem =
+ ( aria.role.menuitem )
+ aria.role.menuitem =
+ attribute role { string "menuitem" }
+
+ common.attrs.aria |= aria.menuitem
+ common.attrs.aria.role.menuitem |= aria.menuitem
+
+## menuitemcheckbox
+ aria.menuitemcheckbox =
+ ( aria.role.menuitemcheckbox
+ & aria.state.checked #required
+ )
+ aria.role.menuitemcheckbox =
+ attribute role { string "menuitemcheckbox" }
+
+ common.attrs.aria |= aria.menuitemcheckbox
+ common.attrs.aria.role.menuitemcheckbox |= aria.menuitemcheckbox
+
+## menuitemradio
+ aria.menuitemradio =
+ ( aria.role.menuitemradio
+ & aria.state.checked #required
+ & aria.state.selected?
+ & aria.prop.posinset?
+ & aria.prop.setsize?
+ )
+ aria.role.menuitemradio =
+ attribute role { string "menuitemradio" }
+
+ common.attrs.aria |= aria.menuitemradio
+ common.attrs.aria.role.menuitemradio |= aria.menuitemradio
+
+## navigation
+ aria.navigation =
+ ( aria.role.navigation
+ & aria.state.expanded?
+ )
+ aria.role.navigation =
+ attribute role { string "navigation" }
+
+ common.attrs.aria |= aria.navigation
+ common.attrs.aria.landmark.navigation |= aria.navigation
+
+## note
+ aria.note =
+ ( aria.role.note
+ & aria.state.expanded?
+ )
+ aria.role.note =
+ attribute role { string "note" }
+
+ common.attrs.aria |= aria.note
+ common.attrs.aria.landmark.note |= aria.note
+
+## option
+ aria.option =
+ ( aria.role.option
+ & aria.state.checked? # not inherited
+ & aria.state.selected? # not inherited
+ & aria.prop.posinset?
+ & aria.prop.setsize?
+ )
+ aria.role.option =
+ attribute role { string "option" }
+
+ common.attrs.aria |= aria.option
+ common.attrs.aria.role.option |= aria.option
+
+
+## presentation
+ aria.presentation =
+ ( aria.role.presentation
+ & aria.state.expanded?
+ )
+ aria.role.presentation =
+ attribute role { string "presentation" }
+
+ common.attrs.aria |= aria.presentation
+ common.attrs.aria.role.presentation |= aria.presentation
+
+## progressbar
+ aria.progressbar =
+ ( aria.role.progressbar
+ & aria.prop.valuemax? # not inherited
+ & aria.prop.valuemin? # not inherited
+ & aria.prop.valuenow? # not inherited
+ & aria.prop.valuetext? # not inherited
+ )
+ aria.role.progressbar =
+ attribute role { string "progressbar" }
+
+ common.attrs.aria |= aria.progressbar
+ common.attrs.aria.role.progressbar |= aria.progressbar
+
+## radio
+ aria.radio =
+ ( aria.role.radio
+ & aria.state.checked #required!
+ & aria.state.selected?
+ & aria.prop.posinset?
+ & aria.prop.setsize?
+ )
+ aria.role.radio =
+ attribute role { string "radio" }
+
+ common.attrs.aria |= aria.radio
+ common.attrs.aria.role.radio |= aria.radio
+
+## radiogroup
+ aria.radiogroup =
+ ( aria.role.radiogroup
+ & aria.prop.activedescendant?
+ & aria.state.expanded?
+ & aria.prop.required?
+ )
+ aria.role.radiogroup =
+ attribute role { string "radiogroup" }
+
+ common.attrs.aria |= aria.radiogroup
+
+## region
+ aria.region =
+ ( aria.role.region
+ & aria.state.expanded?
+ )
+ aria.role.region =
+ attribute role { string "region" }
+
+ common.attrs.aria |= aria.region
+ common.attrs.aria.role.region |= aria.region
+
+## row
+ aria.row =
+ ( aria.role.row
+ & aria.prop.level? # not inherited
+ & aria.state.selected? # not inherited
+ & aria.prop.activedescendant?
+ & aria.state.expanded?
+ )
+ aria.role.row =
+ attribute role { string "row" }
+
+ common.attrs.aria |= aria.row
+
+## rowgroup
+ aria.rowgroup =
+ ( aria.role.rowgroup
+ & aria.prop.activedescendant?
+ & aria.state.expanded?
+ )
+ aria.role.rowgroup =
+ attribute role { string "rowgroup" }
+
+ common.attrs.aria |= aria.rowgroup
+
+# rowheader
+ aria.rowheader =
+ ( aria.role.rowheader
+ & aria.prop.sort? # not inherited
+ & aria.prop.readonly? # not inherited
+ & aria.state.selected? # not inherited
+ & aria.state.expanded?
+ & aria.prop.required?
+ )
+ aria.role.rowheader =
+ attribute role { string "rowheader" }
+
+ common.attrs.aria |= aria.rowheader
+
+## scrollbar
+ aria.scrollbar =
+ ( aria.role.scrollbar
+ & aria.prop.orientation
+ & aria.prop.valuemax
+ & aria.prop.valuemin
+ & aria.prop.valuenow
+ & aria.prop.valuetext?
+ )
+ aria.role.scrollbar =
+ attribute role { string "scrollbar" }
+
+ common.attrs.aria |= aria.scrollbar
+
+## search
+ aria.search =
+ ( aria.role.search
+ & aria.state.expanded?
+ )
+ aria.role.search =
+ attribute role { string "search" }
+
+ common.attrs.aria |= aria.search
+ common.attrs.aria.landmark.search |= aria.search
+
+## separator
+ aria.separator =
+ ( aria.role.separator
+ & aria.state.expanded?
+ & aria.prop.orientation?
+ )
+ aria.role.separator =
+ attribute role { string "separator" }
+
+ common.attrs.aria |= aria.separator
+ common.attrs.aria.role.separator |= aria.separator
+
+## slider
+ aria.slider =
+ ( aria.role.slider
+ & aria.prop.valuemax
+ & aria.prop.valuemin
+ & aria.prop.valuenow
+ & aria.prop.valuetext?
+ & aria.prop.orientation?
+ )
+ aria.role.slider =
+ attribute role { string "slider" }
+
+ common.attrs.aria |= aria.slider
+ common.attrs.aria.role.slider |= aria.slider
+
+## spinbutton
+ aria.spinbutton =
+ ( aria.role.spinbutton
+ & aria.prop.valuemax
+ & aria.prop.valuemin
+ & aria.prop.valuenow
+ & aria.prop.valuetext?
+ & aria.prop.required?
+ )
+ aria.role.spinbutton =
+ attribute role { string "spinbutton" }
+
+ common.attrs.aria |= aria.spinbutton
+ common.attrs.aria.role.spinbutton |= aria.spinbutton
+
+## status
+ aria.status =
+ ( aria.role.status
+ & aria.state.expanded?
+ )
+ aria.role.status =
+ attribute role { string "status" }
+
+ common.attrs.aria |= aria.status
+ common.attrs.aria.role.status |= aria.status
+
+## switch
+ aria.switch =
+ ( aria.role.switch
+ & aria.state.checked #required!
+ )
+ aria.role.switch =
+ attribute role { string "switch" }
+
+ common.attrs.aria |= aria.switch
+ common.attrs.aria.role.switch |= aria.switch
+
+## tab
+ aria.tab =
+ ( aria.role.tab
+ & aria.state.selected?
+ & aria.state.expanded?
+ )
+ aria.role.tab =
+ attribute role { string "tab" }
+
+ common.attrs.aria |= aria.tab
+ common.attrs.aria.role.tab |= aria.tab
+
+## tablist
+ aria.tablist =
+ ( aria.role.tablist
+ & aria.prop.activedescendant?
+ & aria.state.expanded?
+ & aria.prop.level?
+ & aria.prop.multiselectable?
+ )
+ aria.role.tablist =
+ attribute role { string "tablist" }
+ common.attrs.aria |= aria.tablist
+ common.attrs.aria.role.tablist |= aria.tablist
+
+## tabpanel
+ aria.tabpanel =
+ ( aria.role.tabpanel
+ & aria.state.expanded?
+ )
+ aria.role.tabpanel =
+ attribute role { string "tabpanel" }
+
+ common.attrs.aria |= aria.tabpanel
+ common.attrs.aria.role.tabpanel |= aria.tabpanel
+
+## textbox
+ aria.textbox =
+ ( aria.role.textbox
+ & aria.prop.activedescendant?
+ & aria.prop.autocomplete? # not inherited
+ & aria.prop.multiline? # not inherited
+ & aria.prop.readonly? # not inherited
+ & aria.prop.required?
+ )
+ aria.role.textbox =
+ attribute role { string "textbox" }
+
+ common.attrs.aria |= aria.textbox
+ common.attrs.aria.role.textbox |= aria.textbox
+
+## timer
+ aria.timer =
+ ( aria.role.timer
+ & aria.state.expanded?
+ )
+ aria.role.timer =
+ attribute role { string "timer" }
+
+ common.attrs.aria |= aria.timer
+
+## toolbar
+ aria.toolbar =
+ ( aria.role.toolbar
+ & aria.prop.activedescendant?
+ & aria.state.expanded?
+ )
+ aria.role.toolbar =
+ attribute role { string "toolbar" }
+
+ common.attrs.aria |= aria.toolbar
+ common.attrs.aria.role.toolbar |= aria.toolbar
+
+## tooltip
+ aria.tooltip =
+ ( aria.role.tooltip
+ & aria.state.expanded?
+ )
+ aria.role.tooltip =
+ attribute role { string "tooltip" }
+
+ common.attrs.aria |= aria.tooltip
+
+## tree
+ aria.tree =
+ ( aria.role.tree
+ & aria.prop.multiselectable? # not inherited
+ & aria.prop.activedescendant?
+ & aria.state.expanded?
+ & aria.prop.required?
+ )
+ aria.role.tree =
+ attribute role { string "tree" }
+
+ common.attrs.aria |= aria.tree
+ common.attrs.aria.role.tree |= aria.tree
+
+## treegrid
+ aria.treegrid =
+ ( aria.role.treegrid
+ & aria.prop.activedescendant?
+ & aria.state.expanded?
+ & aria.prop.level?
+ & aria.prop.multiselectable?
+ & aria.prop.readonly?
+ & aria.prop.required?
+ )
+ aria.role.treegrid =
+ attribute role { string "treegrid" }
+
+ common.attrs.aria |= aria.treegrid
+
+## treeitem
+ aria.treeitem =
+ ( aria.role.treeitem
+ & aria.state.checked?
+ & aria.state.expanded?
+ & aria.prop.level?
+ & aria.prop.posinset?
+ & aria.state.selected?
+ & aria.prop.setsize?
+ )
+ aria.role.treeitem =
+ attribute role { string "treeitem" }
+
+ common.attrs.aria |= aria.treeitem
+ common.attrs.aria.role.treeitem |= aria.treeitem
diff --git a/packages/html5-schema/assertions.sch
b/packages/html5-schema/assertions.sch
new file mode 100644
index 0000000..2b34fcc
--- /dev/null
+++ b/packages/html5-schema/assertions.sch
@@ -0,0 +1,1235 @@
+<?xml version="1.0"?>
+<!-- * *********************************************************************
-->
+<!-- * WARNING: This file is no longer maintained and hasn't been updated in
-->
+<!-- * years. There are numerous requirements in the HTML spec which should -->
+<!-- * rightly be captured by assertions in this schema but that aren't. So -->
+<!-- * don't consider the set of assertions here to be thorough or complete.
-->
+<!-- * *********************************************************************
-->
+
+<!-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-->
+<!-- Schematron assertions for HTML5
-->
+<!-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
+
+Copyright (c) 2005-2007 Elika J. Etemad (fantasai) and Henri Sivonen (hsivonen)
+Copyright (c) 2007-2012 Mozilla Foundation
+
+Permission is hereby granted, free of charge, to any person obtaining a copy of
+this software and associated documentation files (the "Software"), to deal in
+the Software without restriction, including without limitation the rights to
+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
+of the Software, and to permit persons to whom the Software is furnished to do
+so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+THE SOFTWARE.
+- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -->
+
+<schema xmlns='http://www.ascc.net/xml/schematron'>
+ <ns prefix='h' uri='http://www.w3.org/1999/xhtml'/>
+
+ <pattern name="required attributes">
+ <rule context='h:bdo'>
+ <assert test='@dir'>
+ A “bdo” element must have a
+ “dir” attribute.
+ </assert>
+ </rule>
+ <rule context='h:img[not(@alt)]'>
+ <assert test='(@title and not(@title = ""))
+ or //h:meta[(translate(@name,
+ "GENERATOR", "generator") = "generator")]
+ or (ancestor::h:figure
+ and (ancestor::h:figure[1]/h:figcaption
+ and
not(ancestor::h:figure[1]/h:figcaption = ""))
+ and normalize-space(ancestor::h:figure[1])
+ =
normalize-space(ancestor::h:figure[1]/h:figcaption)
+ and not(ancestor::h:figure[1]//*[
+ local-name() = "audio"
+ or local-name() = "canvas"
+ or local-name() = "embed"
+ or local-name() = "iframe"
+ or local-name() = "math"
+ or local-name() = "object"
+ or local-name() = "svg"
+ or local-name() = "video"])
+ and not(count(ancestor::h:figure[1]//h:img) >
1))'>
+ An “img” element must have an
+ “alt” attribute, except under
certain
+ conditions. For details, consult guidance on
+ providing text alternatives for images.
+
http://www.w3.org/wiki/HTML/Usage/TextAlternatives
+ </assert>
+ </rule>
+ </pattern>
+
+ <pattern name='Triggered on mutually exclusive elements and
prohibited-descendant cases'>
+
+ <!-- Exclusions and prohibited-descendant contraints - - - - - - - - -
- - -->
+
+ <rule context='h:form|h:dfn|h:noscript|h:address'>
+ <report test='ancestor::*[name() = name(current())]'>
+ The “<name/>” element must not
contain any nested
+ “<name/>” elements.
+ </report>
+ </rule>
+
+ <rule context='h:label'>
+ <report test='ancestor::*[name() = name(current())]'>
+ The “<name/>” element must not
contain any nested
+ “<name/>” elements.
+ </report>
+ <report test='count(descendant::h:input
+ | descendant::h:button
+ | descendant::h:select
+ | descendant::h:keygen
+ | descendant::h:textarea) > 1'>
+ The “label” element may contain
at most one descendant
+ “input” element,
+ “button” element,
+ “select” element,
+ or “textarea” element.
+ </report>
+ <report test='@for and
+ not(//h:input[not(translate(@type,
"HIDEN", "hiden")="hidden")address@hidden = current()/@for] or
+ //h:address@hidden = current()/@for] or
+ //h:address@hidden = current()/@for] or
+ //h:address@hidden = current()/@for] or
+ //h:address@hidden = current()/@for] or
+ //h:address@hidden = current()/@for])'>
+ The “for” attribute of the
“label”
+ element must refer to a form control.
+ </report>
+ </rule>
+
+ <rule context='h:section|h:nav|h:article|h:aside'>
+ <report test='ancestor::h:address'>
+ The sectioning element “<name/>”
must not
+ appear as a descendant of the
“address” element.
+ </report>
+ </rule>
+
+ <rule context='h:footer'>
+ <report test='ancestor::h:header'>
+ The element “footer” must not
+ appear as a descendant of the
“header” element.
+ </report>
+ <report test='ancestor::h:footer'>
+ The element “footer” must not
+ appear as a descendant of the
“footer” element.
+ </report>
+ <report test='ancestor::h:address'>
+ The element “footer” must not
+ appear as a descendant of the
“address” element.
+ </report>
+ </rule>
+
+ <rule context='h:h1|h:h2|h:h3|h:h4|h:h5|h:h6'>
+ <report test='ancestor::h:address'>
+ The “<name/>” element must not
appear as a
+ descendant of the “address”
element.
+ </report>
+ </rule>
+
+ <rule context='h:header'>
+ <report test='ancestor::h:footer'>
+ The “<name/>” element must not
appear as a
+ descendant of the “footer”
element.
+ </report>
+ <report test='ancestor::h:address'>
+ The “<name/>” element must not
appear as a
+ descendant of the “address”
element.
+ </report>
+ <report test='ancestor::h:header'>
+ The “header” element must not
appear as a
+ descendant of the “header”
element.
+ </report>
+ </rule>
+
+ <rule context='h:table'>
+ <report test='ancestor::h:caption'>
+ The element “table” must not
appear as a
+ descendant of the “caption”
element.
+ </report>
+ <report test='@summary' role='warning'>
+ The “summary” attribute on the
+ “table” element is obsolete.
+ Consider describing the structure of the table
+ in a “caption” element or
+ in a “figure” element containing
+ the “table” element; or, simplify
+ the structue of the table so that no
+ description is needed.
+ </report>
+ </rule>
+ </pattern>
+
+ <!-- Interactive element exclusions -->
+ <pattern name='interactive element exclusions'>
+
+ <!--
+ - Interactive descendants:
+ - a
+ - video[controls]
+ - audio[controls]
+ - details
+ - menu[type=toolbar]
+ - button
+ - input[type!=hidden]
+ - textarea
+ - select
+ - img[usemap]
+ - embed
+ - iframe
+ - keygen
+ - label
+ - object[usemap]
+
+ - Interactive ancestors
+ - a
+ - button
+ -->
+
+ <rule context='h:a|h:details|h:embed|h:iframe|h:label'>
+ <report test='ancestor::h:a'>
+ The interactive element “<name/>”
must not
+ appear as a descendant of the “a”
element.
+ </report>
+ <report test='ancestor::h:button'>
+ The interactive element “<name/>”
must not
+ appear as a descendant of the
“button” element.
+ </report>
+ </rule>
+
+ <rule
context='h:button|h:textarea|h:select|h:keygen|h:input[not(translate(@type,
"HIDEN", "hiden")="hidden")]'>
+ <report test='ancestor::h:a'>
+ The interactive element “<name/>”
must not
+ appear as a descendant of the “a”
element.
+ </report>
+ <report test='ancestor::h:button'>
+ The interactive element “<name/>”
must not
+ appear as a descendant of the
“button” element.
+ </report>
+ <report test='ancestor::h:address@hidden and
not(ancestor::h:address@hidden = current()/@id])'>
+ Any “<name/>” element descendant
of a “label” element
+ with a “for” attribute must have
an
+ ID value that matches that “for”
attribute.
+ </report>
+ </rule>
+
+ <rule context='h:address@hidden|h:address@hidden'>
+ <report test='ancestor::h:a'>
+ The interactive element “<name/>”
+ with the attribute “controls”
must not
+ appear as a descendant of the “a”
element.
+ </report>
+ <report test='ancestor::h:button'>
+ The interactive element “<name/>”
+ with the attribute “controls”
must not
+ appear as a descendant of the
“button” element.
+ </report>
+ </rule>
+
+ <rule context='h:menu[translate(@type, "TOLBAR",
"tolbar")="toolbar"]'>
+ <report test='ancestor::h:a'>
+ The element “menu”
+ with the attribute “type” whose
value is “toolbar” must not
+ appear as a descendant of the “a”
element.
+ </report>
+ <report test='ancestor::h:button'>
+ The element “menu”
+ with the attribute “type” whose
value is “toolbar” must not
+ appear as a descendant of the
“button” element.
+ </report>
+ </rule>
+
+ <rule context='h:address@hidden'>
+ <report test='ancestor::h:a'>
+ The element “img”
+ with the attribute “usemap” must
not
+ appear as a descendant of the “a”
element.
+ </report>
+ <report test='ancestor::h:button'>
+ The element “img”
+ with the attribute “usemap” must
not
+ appear as a descendant of the
“button” element.
+ </report>
+ </rule>
+
+ <rule context='h:address@hidden'>
+ <report test='ancestor::h:a'>
+ The element “object”
+ with the attribute “usemap” must
not
+ appear as a descendant of the “a”
element.
+ </report>
+ <report test='ancestor::h:button'>
+ The element “object”
+ with the attribute “usemap” must
not
+ appear as a descendant of the
“button” element.
+ </report>
+ </rule>
+ </pattern>
+
+ <!-- REVISIT fieldset
http://lists.whatwg.org/pipermail/whatwg-whatwg.org/2006-April/006181.html -->
+
+ <!-- Misc requirements -->
+
+ <pattern name="miscellaneous requirements">
+ <rule context='h:area'>
+ <assert test='ancestor::h:map'>
+ The “area” element must have an
ancestor
+ “map” element.
+ </assert>
+ </rule>
+
+ <rule context='h:address@hidden'>
+ <assert test='ancestor::h:address@hidden'>
+ The “img” element with the
+ “ismap” attribute set must have
an ancestor
+ “a” element with the
“href” attribute.
+ </assert>
+ </rule>
+
+ <rule context='h:input'>
+ <report test='@list and not(//h:address@hidden =
current()/@list])'>
+ The “list” attribute of the
“input”
+ element must refer to a
“datalist” element.
+ </report>
+ <report test='@type = "button" and (not(@value) or
@value = "")'>
+ Element “input” with attribute
“type”
+ whose value is “button” must have
non-empty attribute
+ “value”.
+ </report>
+ </rule>
+
+ <rule context='h:track'>
+ <report test='@label = ""'>
+ Attribute “label” for element
“track”
+ must have non-empty value.
+ </report>
+ <report test='@default and
preceding-sibling::h:address@hidden'>
+ The “default” attribute must not
occur on more than one
+ “track” element within the same
“audio”
+ element or “video” element.
+ </report>
+ </rule>
+
+ <rule context='h:address@hidden and @name]'>
+ <assert test='@id = @name'>
+ The “id” attribute on a
“map” element must have
+ the same value as the “name”
attribute.
+ </assert>
+ </rule>
+
+ <rule context='h:select'>
+ <report test='not(@multiple) and
count(descendant::h:address@hidden) > 1'>
+ The “select” element cannot have
more than one
+ selected “option” element
descendant unless the
+ “multiple” attribute is specified.
+ </report>
+ <report test='@required and not(@multiple)
+ and (not(@size)
+ or (starts-with(normalize-space(@size),
"+")
+ and substring-after(@size,"+") = 1)
+ or @size = 1)
+ and not(h:option)'>
+ A “select” element with
+ a “required” attribute and without
+ a “multiple” attribute, and whose
+ size is “1”, must have a child
+ “option” element.
+ </report>
+ </rule>
+
+ <rule context='h:address@hidden and not(@multiple)
+ and (not(@size)
+ or (starts-with(normalize-space(@size), "+")
+ and substring-after(@size,"+") = 1)
+ or @size = 1)]/h:option[1]'>
+ <assert test='(@value and @value = "")
+ or ((not(@value) or @value = "") and . = "")'>
+ The first child “option” element
+ of a “select” element with
+ a “required” attribute and without
+ a “multiple” attribute, and whose
+ size is “1”, must have either an
+ empty “value” attribute, or must
+ have no text content.
+ </assert>
+ </rule>
+
+ <rule context='h:script'>
+ <report test='@language and translate(@language,
"JAVSCRIPT", "javscript")="javascript"
+ and @type and not(translate(@type,
"EXJAVSCRIPT", "exjavscript")="text/javascript")'>
+ Element “script” with attribute
+ “language” whose value is
“JavaScript”
+ must not have attribute “type”
whose value is not
+ “text/javascript”.
+ </report>
+ <report test='not(@src) and @charset'>
+ Element “script” must not have
attribute
+ “charset” unless attribute
“src” is
+ also specified.
+ </report>
+ <report test='not(@src) and @defer'>
+ Element “script” must not have
attribute
+ “defer” unless attribute
“src” is
+ also specified.
+ </report>
+ <report test='not(@src) and @async'>
+ Element “script” must not have
attribute
+ “async” unless attribute
“src” is
+ also specified.
+ </report>
+ </rule>
+
+ <rule context='h:time'>
+ <report test='ancestor::h:time'>
+ The element “time” must not
+ appear as a descendant of the
“time” element.
+ </report>
+ </rule>
+
+ <rule context='h:progress'>
+ <report test='ancestor::h:progress'>
+ The element “progress” must not
+ appear as a descendant of the
“progress” element.
+ </report>
+ <assert test='@max and @value and number(@value) <=
number(@max)'>
+ The value of the “value”
attribute must be less than or equal to
+ the value of the “max” attribute.
+ </assert>
+ <assert test='not(@max) and @value and number(@value)
<= 1'>
+ The value of the “value”
attribute must be less than or equal to
+ one when the “max” attribute is
absent.
+ </assert>
+ </rule>
+
+ <!--
+ min <= value <= max
+ min <= low <= high <= max
+ min <= optimum <= max
+ -->
+
+ <rule context='h:meter'>
+ <report test='ancestor::h:meter'>
+ The element “meter” must not
+ appear as a descendant of the
“meter” element.
+ </report>
+ <report test='@min and @value and not(number(@min)
<= number(@value))'>
+ The value of the “min” attribute
must be less than or equal to
+ the value of the “value”
attribute.
+ </report>
+ <report test='not(@min) and @value and not(0 <=
number(@value))'>
+ The value of the “value”
attribute must be greater than or equal to
+ zero when the “min” attribute is
absent.
+ </report>
+ <report test='@value and @max and not(number(@value)
<= number(@max))'>
+ The value of the “value”
attribute must be less than or equal to
+ the value of the “max” attribute.
+ </report>
+ <report test='@value and not(@max) and
not(number(@value) <= 1)'>
+ The value of the “value”
attribute must be less than or equal to
+ one when the “max” attribute is
absent.
+ </report>
+ <report test='@min and @max and not(number(@min) <=
number(@max))'>
+ The value of the “min” attribute
must be less than or equal to
+ the value of the “max” attribute.
+ </report>
+ <report test='not(@min) and @max and not(0 <=
number(@max))'>
+ The value of the “max” attribute
must be greater than or equal to
+ zero when the “min” attribute is
absent.
+ </report>
+ <report test='@min and not(@max) and not(number(@min)
<= 1)'>
+ The value of the “min” attribute
must be less than or equal to
+ one when the “max” attribute is
absent.
+ </report>
+ <report test='@min and @low and not(number(@min) <=
number(@low))'>
+ The value of the “min” attribute
must be less than or equal to
+ the value of the “low” attribute.
+ </report>
+ <report test='not(@min) and @low and not(0 <=
number(@low))'>
+ The value of the “low” attribute
must be greater than or equal to
+ zero when the “min” attribute is
absent.
+ </report>
+ <report test='@min and @high and not(number(@min) <=
number(@high))'>
+ The value of the “min” attribute
must be less than or equal to
+ the value of the “high” attribute.
+ </report>
+ <report test='not(@min) and @high and not(0 <=
number(@high))'>
+ The value of the “high” attribute
must be greater than or equal to
+ zero when the “min” attribute is
absent.
+ </report>
+ <report test='@low and @high and not(number(@low) <=
number(@high))'>
+ The value of the “low” attribute
must be less than or equal to
+ the value of the “high” attribute.
+ </report>
+ <report test='@high and @max and not(number(@high)
<= number(@max))'>
+ The value of the “high”
attribute must be less than or equal to
+ the value of the “max” attribute.
+ </report>
+ <report test='@high and not(@max) and not(number(@high)
<= 1)'>
+ The value of the “high”
attribute must be less than or equal to
+ one when the “max” attribute is
absent.
+ </report>
+ <report test='@low and @max and not(number(@low) <=
number(@max))'>
+ The value of the “low” attribute
must be less than or equal to
+ the value of the “max” attribute.
+ </report>
+ <report test='@low and not(@max) and not(number(@low)
<= 1)'>
+ The value of the “low” attribute
must be less than or equal to
+ one when the “max” attribute is
absent.
+ </report>
+ <report test='@min and @optimum and not(number(@min)
<= number(@optimum))'>
+ The value of the “min” attribute
must be less than or equal to
+ the value of the “optimum”
attribute.
+ </report>
+ <report test='not(@min) and @optimum and not(0 <=
number(@optimum))'>
+ The value of the “optimum”
attribute must be greater than or equal to
+ zero when the “min” attribute is
absent.
+ </report>
+ <report test='@optimum and @max and
not(number(@optimum) <= number(@max))'>
+ The value of the “optimum”
attribute must be less than or equal to
+ the value of the “max” attribute.
+ </report>
+ <report test='@optimum and not(@max) and
not(number(@optimum) <= 1)'>
+ The value of the “optimum”
attribute must be less than or equal to
+ one when the “max” attribute is
absent.
+ </report>
+ </rule>
+ </pattern>
+
+ <!-- Obsolete Elements - - - - - - - - - - - - - - - - - - - - - - -->
+ <pattern name="obsolete elements">
+ <rule context='h:acronym'>
+ <report test='true()'>
+ The “acronym” element is
obsolete. Use the “abbr” element instead.
+ </report>
+ </rule>
+
+ <rule context='h:applet'>
+ <report test='true()'>
+ The “applet” element is obsolete.
Use the “object” element instead.
+ </report>
+ </rule>
+
+ <rule context='h:center|h:font|h:big|h:strike|h:tt|h:basefont'>
+ <report test='true()'>
+ The “<name/>” element is obsolete.
+ Use CSS instead.
http://wiki.whatwg.org/wiki/Presentational_elements_and_attributes
+ </report>
+ </rule>
+
+ <rule context='h:dir'>
+ <report test='true()'>
+ The “dir” element is obsolete.
Use the “ul” element instead.
+ </report>
+ </rule>
+
+ <rule context='h:frameset|h:noframes'>
+ <report test='true()'>
+ The “<name/>” element is obsolete.
+ Use the “iframe” element and CSS
instead, or use server-side includes.
+ </report>
+ </rule>
+ </pattern>
+
+ <!-- Obsolete Attributes- - - - - - - - - - - - - - - - - - - - - - -->
+
+ <pattern name="obsolete attributes">
+ <rule context='h:a'>
+ <report test='@coords'>
+ The “coords” attribute on the
“<name/>” element is obsolete.
+ For image maps, use the “area”
element instead of the “a” element.
+ </report>
+ <report test='@shape'>
+ The “shape” attribute on the
“<name/>” element is obsolete.
+ For image maps, use the “area”
element instead of the “a” element.
+ </report>
+ <report test='@urn'>
+ The “urn” attribute on the
“<name/>” element is obsolete.
+ Specify the preferred persistent identifier
using the “href” attribute instead.
+ </report>
+ <report test='@charset'>
+ The “charset” attribute on the
“<name/>” element is obsolete.
+ Use an HTTP Content-Type header on the linked
resource instead.
+ </report>
+ <report test='@methods'>
+ The “methods” attribute on the
“<name/>” element is obsolete.
+ Use the HTTP OPTIONS feature instead.
+ </report>
+ <report test='@rev'>
+ The “rev” attribute on the
“<name/>” element is obsolete.
+ Use the “rel” attribute instead,
with a term having the opposite meaning.
+ </report>
+ </rule>
+
+ <rule context='h:link'>
+ <report test='@target'>
+ The “target” attribute on the
“<name/>” element is obsolete.
+ You can safely omit it.
+ </report>
+ <report test='@urn'>
+ The “urn” attribute on the
“<name/>” element is obsolete.
+ Specify the preferred persistent identifier
using the “href” attribute instead.
+ </report>
+ <report test='@charset'>
+ The “charset” attribute on the
“<name/>” element is obsolete.
+ Use an HTTP Content-Type header on the linked
resource instead.
+ </report>
+ <report test='@methods'>
+ The “methods” attribute on the
“<name/>” element is obsolete.
+ Use the HTTP OPTIONS feature instead.
+ </report>
+ <report test='@rev'>
+ The “rev” attribute on the
“<name/>” element is obsolete.
+ Use the “rel” attribute instead,
with a term having the opposite meaning.
+ </report>
+ </rule>
+
+ <rule context="h:area">
+ <report test='@nohref'>
+ The “nohref” attribute on the
“<name/>” element is obsolete.
+ Omitting the “href” attribute is
sufficient.
+ </report>
+ </rule>
+
+ <rule context='h:embed'>
+ <report test='@name'>
+ The “name” attribute on the
“<name/>” element is obsolete.
+ Use the “id” attribute instead.
+ </report>
+ </rule>
+
+ <rule context='h:head'>
+ <report test='@profile'>
+ The “profile” attribute on the
“<name/>” element is obsolete.
+ To declare which “meta” element
terms are used in the document, instead register the
+ names as meta extensions.
<http://wiki.whatwg.org/wiki/MetaExtensions>
+ To trigger specific UA behaviors, use a
“link” element instead.
+ </report>
+ </rule>
+
+ <rule context='h:html'>
+ <report test='@version'>
+ The “version” attribute on the
“<name/>” element is obsolete.
+ You can safely omit it.
+ </report>
+ </rule>
+
+ <rule context='h:iframe'>
+ <report test='@longdesc'>
+ The “longdesc” attribute on the
“<name/>” element is obsolete.
+ Use a regular “a” element to link
to the description.
+ </report>
+ </rule>
+
+ <rule context='h:img'>
+ <report test='@longdesc'>
+ The “longdesc” attribute on the
“<name/>” element is obsolete.
+ Use a regular “a” element to link
to the description.
+ </report>
+ <report test='@name'>
+ The “name” attribute on the
“<name/>” element is obsolete.
+ Use the “id” attribute instead.
+ </report>
+ </rule>
+
+ <rule context='h:input'>
+ <report test='@usemap'>
+ The “usemap” attribute on the
“<name/>” element is obsolete.
+ Use the “img” element instead of
the “input” element for image maps.
+ </report>
+ </rule>
+
+ <rule context='h:li|h:ul'>
+ <report test='@type'>
+ The “type” attribute on the
“<name/>” element is obsolete.
+ Use CSS instead.
http://wiki.whatwg.org/wiki/Presentational_elements_and_attributes
+ </report>
+ </rule>
+
+ <rule context='h:meta'>
+ <report test='@scheme'>
+ The “scheme” attribute on the
“<name/>” element is obsolete.
+ Use only one scheme per field, or make the
scheme declaration part of the value.
+ </report>
+ <report test='translate(@http-equiv,"CONTELAGUA",
"contelagua")="content-language"' role='warning'>
+ Using the “meta” element to
specify the document-wide default language is obsolete.
+ Consider specifying the language on the root
element instead.
+ </report>
+ </rule>
+
+ <rule context='h:object'>
+ <report test='@archive'>
+ The “archive” attribute on the
“<name/>” element is obsolete.
+ Use the “data” attribute and
“type” attribute to invoke plugins.
+ To set a parameter with the name
“archive”, use the “param” element.
+ </report>
+ <report test='@classid'>
+ The “classid” attribute on the
“<name/>” element is obsolete.
+ Use the “data” attribute and
“type” attribute to invoke plugins.
+ To set a parameter with the name
“classid”, use the “param” element.
+ </report>
+ <report test='@code'>
+ The “code” attribute on the
“<name/>” element is obsolete.
+ Use the “data” attribute and
“type” attribute to invoke plugins.
+ To set a parameter with the name
“code”, use the “param” element.
+ </report>
+ <report test='@codebase'>
+ The “codebase” attribute on the
“<name/>” element is obsolete.
+ Use the “data” attribute and
“type” attribute to invoke plugins.
+ To set a parameter with the name
“codebase”, use the “param” element.
+ </report>
+ <report test='@codetype'>
+ The “codetype” attribute on the
“<name/>” element is obsolete.
+ Use the “data” attribute and
“type” attribute to invoke plugins.
+ To set a parameter with the name
“codetype”, use the “param” element.
+ </report>
+ <report test='@declare'>
+ The “declare” attribute on the
“<name/>” element is obsolete.
+ Repeat the “object” element
completely each time the resource is to be reused.
+ </report>
+ <report test='@standby'>
+ The “standby” attribute on the
“<name/>” element is obsolete.
+ Optimize the linked resource so that it loads
quickly or, at least, incrementally.
+ </report>
+ </rule>
+
+ <rule context='h:option'>
+ <report test='@name'>
+ The “name” attribute on the
“<name/>” element is obsolete.
+ Use the “id” attribute instead.
+ </report>
+ </rule>
+
+ <rule context='h:param'>
+ <report test='@type'>
+ The “type” attribute on the
“<name/>” element is obsolete.
+ Use the “name” attribute and
“value” attribute without declaring value types.
+ </report>
+ <report test='@valuetype'>
+ The “valuetype” attribute on the
“<name/>” element is obsolete.
+ Use the “name” attribute and
“value” attribute without declaring value types.
+ </report>
+ </rule>
+
+ <rule context='h:address@hidden and not(translate(@language,
"JAVSCRIPT", "javscript")="javascript")]'>
+ <report test='true()'>
+ The “language” attribute on the
“script” element is obsolete.
+ Use the “type” attribute instead.
+ </report>
+ </rule>
+
+ <rule context='h:td|h:th'>
+ <report test='@scope and self::h:td'>
+ The “scope” attribute on the
“td” element is obsolete.
+ Use the “scope” attribute on a
“th” element instead.
+ </report>
+ <report test='@abbr'>
+ The “abbr” attribute on the
“<name/>” element is obsolete.
+ Consider instead beginning the cell contents
with concise text, followed by further elaboration if needed.
+ </report>
+ <report test='@axis'>
+ The “axis” attribute on the
“<name/>” element is obsolete.
+ Use the “scope” attribute instead.
+ </report>
+ </rule>
+ </pattern>
+
+ <pattern name="obsolete presentational align attribute">
+ <rule
context='h:caption|h:iframe|h:img|h:input|h:object|h:embed|h:legend
+
|h:table|h:hr|h:div|h:h1|h:h2|h:h3|h:h4|h:h5|h:h6|h:p|h:col|h:colgroup
+ |h:tbody|h:td|h:tfoot|h:th|h:thead|h:tr'>
+ <report test='@align'>
+ The “align” attribute on the
“<name/>” element is obsolete.
+ Use CSS instead.
http://wiki.whatwg.org/wiki/Presentational_elements_and_attributes
+ </report>
+ </rule>
+ </pattern>
+
+ <pattern name="obsolete presentational width attribute">
+ <rule context='h:col|h:colgroup|h:hr|h:pre|h:table|h:td|h:th'>
+ <report test='@width'>
+ The “width” attribute on the
“<name/>” element is obsolete.
+ Use CSS instead.
http://wiki.whatwg.org/wiki/Presentational_elements_and_attributes
+ </report>
+ </rule>
+ </pattern>
+
+ <pattern name="obsolete presentational table attributes">
+ <rule
context='h:col|h:colgroup|h:tbody|h:td|h:tfoot|h:th|h:thead|h:tr'>
+ <report test='@char'>
+ The “char” attribute on the
“<name/>” element is obsolete.
+ Use CSS instead.
http://wiki.whatwg.org/wiki/Presentational_elements_and_attributes
+ </report>
+ <report test='@charoff'>
+ The “charoff” attribute on the
“<name/>” element is obsolete.
+ Use CSS instead.
http://wiki.whatwg.org/wiki/Presentational_elements_and_attributes
+ </report>
+ <report test='@valign'>
+ The “valign” attribute on the
“<name/>” element is obsolete.
+ Use CSS instead.
http://wiki.whatwg.org/wiki/Presentational_elements_and_attributes
+ </report>
+ </rule>
+ </pattern>
+
+ <pattern name="obsolete presentational attributes">
+ <rule context='h:body'>
+ <report test='@alink'>
+ The “alink” attribute on the
“<name/>” element is obsolete.
+ Use CSS instead.
http://wiki.whatwg.org/wiki/Presentational_elements_and_attributes
+ </report>
+ <report test='@background'>
+ The “background” attribute on the
“<name/>” element is obsolete.
+ Use CSS instead.
http://wiki.whatwg.org/wiki/Presentational_elements_and_attributes
+ </report>
+ <report test='@bgcolor'>
+ The “bgcolor” attribute on the
“<name/>” element is obsolete.
+ Use CSS instead.
http://wiki.whatwg.org/wiki/Presentational_elements_and_attributes
+ </report>
+ <report test='@link'>
+ The “link” attribute on the
“<name/>” element is obsolete.
+ Use CSS instead.
http://wiki.whatwg.org/wiki/Presentational_elements_and_attributes
+ </report>
+ <report test='@marginbottom'>
+ The “marginbottom” attribute on
the “<name/>” element is obsolete.
+ Use CSS instead.
http://wiki.whatwg.org/wiki/Presentational_elements_and_attributes
+ </report>
+ <report test='@marginheight'>
+ The “marginheight” attribute on
the “<name/>” element is obsolete.
+ Use CSS instead.
http://wiki.whatwg.org/wiki/Presentational_elements_and_attributes
+ </report>
+ <report test='@marginleft'>
+ The “marginleft” attribute on the
“<name/>” element is obsolete.
+ Use CSS instead.
http://wiki.whatwg.org/wiki/Presentational_elements_and_attributes
+ </report>
+ <report test='@marginright'>
+ The “marginright” attribute on
the “<name/>” element is obsolete.
+ Use CSS instead.
http://wiki.whatwg.org/wiki/Presentational_elements_and_attributes
+ </report>
+ <report test='@margintop'>
+ The “margintop” attribute on the
“<name/>” element is obsolete.
+ Use CSS instead.
http://wiki.whatwg.org/wiki/Presentational_elements_and_attributes
+ </report>
+ <report test='@marginwidth'>
+ The “marginwidth” attribute on
the “<name/>” element is obsolete.
+ Use CSS instead.
http://wiki.whatwg.org/wiki/Presentational_elements_and_attributes
+ </report>
+ <report test='@text'>
+ The “text” attribute on the
“<name/>” element is obsolete.
+ Use CSS instead.
http://wiki.whatwg.org/wiki/Presentational_elements_and_attributes
+ </report>
+ <report test='@vlink'>
+ The “vlink” attribute on the
“<name/>” element is obsolete.
+ Use CSS instead.
http://wiki.whatwg.org/wiki/Presentational_elements_and_attributes
+ </report>
+ </rule>
+
+ <rule context='h:br'>
+ <report test='@clear'>
+ The “clear” attribute on the
“<name/>” element is obsolete.
+ Use CSS instead.
http://wiki.whatwg.org/wiki/Presentational_elements_and_attributes
+ </report>
+ </rule>
+
+ <rule context='h:embed'>
+ <report test='@hspace'>
+ The “hspace” attribute on the
“<name/>” element is obsolete.
+ Use CSS instead.
http://wiki.whatwg.org/wiki/Presentational_elements_and_attributes
+ </report>
+ <report test='@vspace'>
+ The “vspace” attribute on the
“<name/>” element is obsolete.
+ Use CSS instead.
http://wiki.whatwg.org/wiki/Presentational_elements_and_attributes
+ </report>
+ </rule>
+
+ <rule context='h:hr'>
+ <report test='@noshade'>
+ The “noshade” attribute on the
“<name/>” element is obsolete.
+ Use CSS instead.
http://wiki.whatwg.org/wiki/Presentational_elements_and_attributes
+ </report>
+ <report test='@size'>
+ The “size” attribute on the
“<name/>” element is obsolete.
+ Use CSS instead.
http://wiki.whatwg.org/wiki/Presentational_elements_and_attributes
+ </report>
+ <report test='@color'>
+ The “color” attribute on the
“<name/>” element is obsolete.
+ Use CSS instead.
http://wiki.whatwg.org/wiki/Presentational_elements_and_attributes
+ </report>
+ </rule>
+
+ <rule context='h:dl|h:menu|h:ol|h:ul'>
+ <report test='@compact'>
+ The “compact” attribute on the
“<name/>” element is obsolete.
+ Use CSS instead.
http://wiki.whatwg.org/wiki/Presentational_elements_and_attributes
+ </report>
+ </rule>
+
+ <rule context='h:iframe'>
+ <report test='@allowtransparency'>
+ The “allowtransparency” attribute
on the “<name/>” element is obsolete.
+ Use CSS instead.
http://wiki.whatwg.org/wiki/Presentational_elements_and_attributes
+ </report>
+ <report test='@frameborder'>
+ The “frameborder” attribute on
the “<name/>” element is obsolete.
+ Use CSS instead.
http://wiki.whatwg.org/wiki/Presentational_elements_and_attributes
+ </report>
+ <report test='@marginheight'>
+ The “marginheight” attribute on
the “<name/>” element is obsolete.
+ Use CSS instead.
http://wiki.whatwg.org/wiki/Presentational_elements_and_attributes
+ </report>
+ <report test='@marginwidth'>
+ The “marginwidth” attribute on
the “<name/>” element is obsolete.
+ Use CSS instead.
http://wiki.whatwg.org/wiki/Presentational_elements_and_attributes
+ </report>
+ <report test='@scrolling'>
+ The “scrolling” attribute on the
“<name/>” element is obsolete.
+ Use CSS instead.
http://wiki.whatwg.org/wiki/Presentational_elements_and_attributes
+ </report>
+ </rule>
+
+ <rule context='h:img|h:object'>
+ <report test='@hspace'>
+ The “hspace” attribute on the
“<name/>” element is obsolete.
+ Use CSS instead.
http://wiki.whatwg.org/wiki/Presentational_elements_and_attributes
+ </report>
+ <report test='@vspace'>
+ The “vspace” attribute on the
“<name/>” element is obsolete.
+ Use CSS instead.
http://wiki.whatwg.org/wiki/Presentational_elements_and_attributes
+ </report>
+ <report test='@border and self::h:object'>
+ The “border” attribute on the
“<name/>” element is obsolete.
+ Use CSS instead.
http://wiki.whatwg.org/wiki/Presentational_elements_and_attributes
+ </report>
+ </rule>
+
+ <rule context='h:table'>
+ <report test='@bgcolor'>
+ The “bgcolor” attribute on the
“<name/>” element is obsolete.
+ Use CSS instead.
http://wiki.whatwg.org/wiki/Presentational_elements_and_attributes
+ </report>
+ <report test='@border and not(@border = "" or @border =
"1")'>
+ The value of the “border”
attribute on the “<name/>” element
+ must be either “1” or the empty
string. To regulate the thickness of table borders,
+ Use CSS instead.
http://wiki.whatwg.org/wiki/Presentational_elements_and_attributes
+ </report>
+ <report test='@cellpadding'>
+ The “cellpadding” attribute on
the “<name/>” element is obsolete.
+ Use CSS instead.
http://wiki.whatwg.org/wiki/Presentational_elements_and_attributes
+ </report>
+ <report test='@cellspacing'>
+ The “cellspacing” attribute on
the “<name/>” element is obsolete.
+ Use CSS instead.
http://wiki.whatwg.org/wiki/Presentational_elements_and_attributes
+ </report>
+ <report test='@frame'>
+ The “frame” attribute on the
“<name/>” element is obsolete.
+ Use CSS instead.
http://wiki.whatwg.org/wiki/Presentational_elements_and_attributes
+ </report>
+ <report test='@rules'>
+ The “rules” attribute on the
“<name/>” element is obsolete.
+ Use CSS instead.
http://wiki.whatwg.org/wiki/Presentational_elements_and_attributes
+ </report>
+ </rule>
+
+ <rule context='h:td|h:th'>
+ <report test='@bgcolor'>
+ The “bgcolor” attribute on the
“<name/>” element is obsolete.
+ Use CSS instead.
http://wiki.whatwg.org/wiki/Presentational_elements_and_attributes
+ </report>
+ <report test='@height'>
+ The “height” attribute on the
“<name/>” element is obsolete.
+ Use CSS instead.
http://wiki.whatwg.org/wiki/Presentational_elements_and_attributes
+ </report>
+ <report test='@nowrap'>
+ The “nowrap” attribute on the
“<name/>” element is obsolete.
+ Use CSS instead.
http://wiki.whatwg.org/wiki/Presentational_elements_and_attributes
+ </report>
+ </rule>
+
+ <rule context='h:tr'>
+ <report test='@bgcolor'>
+ The “bgcolor” attribute on the
“<name/>” element is obsolete.
+ Use CSS instead.
http://wiki.whatwg.org/wiki/Presentational_elements_and_attributes
+ </report>
+ </rule>
+ </pattern>
+
+<!-- lang and xml:lang in XHTML - - - - - - - - - - - - - - - - - -->
+
+ <pattern name='lang and xml:lang in XHTML'>
+ <rule context='h:address@hidden and @xml:lang]'>
+ <assert test='translate(@lang,
"ABCDEFGHIJKLMNOPQRSTUVWXYZ", "abcdefghijklmnopqrstuvwxyz") =
translate(@xml:lang, "ABCDEFGHIJKLMNOPQRSTUVWXYZ",
"abcdefghijklmnopqrstuvwxyz")'>
+ When the attribute “lang” in no
namespace and the attribute “lang”
+ in the XML namespace are both present, they
must have the same value.
+ </assert>
+ </rule>
+ </pattern>
+
+<!-- IDREFs - - - - - - - - - - - - - - - - - - - - - - - - - - - -->
+
+ <!-- Assuming that ID uniqueness is already enforced. -->
+
+ <pattern name='contextmenu must refer to a menu'>
+ <rule context='h:address@hidden'>
+ <assert test='//h:address@hidden = current()/@contextmenu]'>
+ The “contextmenu” attribute must
refer to a
+ “menu” element.
+ </assert>
+ </rule>
+ </pattern>
+
+ <!-- FIXME form attribute -->
+
+ <!-- FIXME output for -->
+
+<!-- Unique Definitions - - - - - - - - - - - - - - - - - - - - - -->
+
+ <!-- Only one definition per term per document' -->
+
+<!-- ARIA containment - - - - - - - - - - - - - - - - - - - - - -->
+
+ <pattern name='Mutually Exclusive Role triggers'>
+
+ <!-- XXX columnheader and rowheader require row parent -->
+
+ <rule context='address@hidden"option"]'>
+ <assert test='../@role="listbox"'>
+ An element with “role=option”
requires
+ “role=listbox” on the parent.
+ </assert>
+ </rule>
+
+ <rule context='address@hidden"menuitem"]'>
+ <assert test='../@role="menu"'>
+ An element with “role=menuitem”
requires
+ “role=menu” on the parent.
+ </assert>
+ </rule>
+
+ <rule context='address@hidden"menuitemcheckbox"]'>
+ <assert test='../@role="menu"'>
+ An element with
“role=menuitemcheckbox” requires
+ “role=menu” on the parent.
+ </assert>
+ </rule>
+
+ <rule context='address@hidden"menuitemradio"]'>
+ <assert test='../@role="menu"'>
+ An element with
“role=menuitemradio” requires
+ “role=menu” on the parent.
+ </assert>
+ </rule>
+
+ <rule context='address@hidden"tab"]'>
+ <assert test='../@role="tablist"'>
+ An element with “role=tab”
requires
+ “role=tablist” on the parent.
+ </assert>
+ </rule>
+
+ <rule context='address@hidden"treeitem"]'>
+ <assert test='../@role="tree"'>
+ An element with “role=treeitem”
requires
+ “role=tree” on the parent.
+ </assert>
+ </rule>
+
+ <rule context='address@hidden"listitem"]'>
+ <assert test='../@role="list"'>
+ An element with “role=listitem”
requires
+ “role=list” on the parent.
+ </assert>
+ </rule>
+
+ <rule context='address@hidden"row"]'>
+ <assert test='../@role="grid" or
+ ../../@role="grid" or
+ ../@role="treegrid" or
+ ../../@role="treegrid"'>
+ An element with “role=row”
requires
+ “role=treegrid” or
“role=grid” on the parent or grandparent.
+ </assert>
+ </rule>
+ <!-- XXX hoping for a spec change so not bothering with the
reciprocal case -->
+
+ <rule context='address@hidden"gridcell"]'>
+ <assert test='../@role="row"'>
+ An element with “role=gridcell”
requires
+ “role=row” on the parent.
+ </assert>
+ </rule>
+ <!-- XXX hoping for a spec change so not bothering with the
reciprocal case -->
+
+ </pattern>
+
+ <pattern name='Not Option'>
+ <rule context='*[not(@role="option")]'>
+ <report test='../@role="listbox"'>
+ An element must not be a child of
+ “role=listbox” unless it has
“role=option”.
+ </report>
+ </rule>
+ </pattern>
+
+ <pattern name='Not menuitem*'>
+ <rule context='*[not(@role="menuitem" or
+ @role="menuitemcheckbox" or
+ @role="menuitemradio")]'>
+ <report test='../@role="menu"'>
+ An element must not be a child of
+ “role=menu” unless it has
+ “role=menuitem”,
+ “role=menuitemcheckbox” or
+ “role=menuitemradio”.
+ </report>
+ </rule>
+ </pattern>
+
+ <pattern name='Not treeitem'>
+ <rule context='*[not(@role="treeitem")]'>
+ <report test='../@role="tree"'>
+ An element must not be a child of
+ “role=tree” unless it has
+ “role=treeitem”.
+ </report>
+ </rule>
+ </pattern>
+
+ <pattern name='Not listitem'>
+ <rule context='*[not(@role="listitem")]'>
+ <report test='../@role="list"'>
+ An element must not be a child of
+ “role=list” unless it has
+ “role=listitem”.
+ </report>
+ </rule>
+ <!-- XXX role=group omitted due to lack of detail in spec -->
+ </pattern>
+
+ <pattern name='Not radio'>
+ <rule context='*[not(@role="radio")]'>
+ <report test='../@role="radiogroup"'>
+ An element must not be a child of
+ “role=radiogroup” unless it has
+ “role=radio”.
+ </report>
+ </rule>
+ </pattern>
+
+ <pattern name='Not gridcell'>
+ <rule context='*[not(@role="gridcell")]'>
+ <report test='../@role="row"'>
+ An element must not be a child of
+ “role=row” unless it has
+ “role=gridcell”.
+ </report>
+ </rule>
+ </pattern>
+
+ <pattern name='Not tab'>
+ <rule context='*[not(@role="tab")]'>
+ <report test='../@role="tablist"'>
+ An element must not be a child of
+ “role=tablist” unless it has
+ “role=role”.
+ </report>
+ </rule>
+ </pattern>
+
+ <!-- XXX combobox requires a listbox child -->
+
+ <pattern name='aria-activedescendant must refer to a descendant'>
+ <rule context='address@hidden'>
+ <assert test='descendant::address@hidden =
current()/@aria-activedescendant]'>
+ The “aria-activedescendant”
attribute must refer to a
+ descendant element.
+ </assert>
+ </rule>
+ </pattern>
+
+ <pattern name='controls must not dangle'>
+ <rule context='address@hidden'>
+ <assert test='//address@hidden = current()/@aria-controls]'>
+ The “aria-controls” attribute
must point to an element in the
+ same document.
+ </assert>
+ </rule>
+ </pattern>
+
+ <pattern name='describedby must not dangle'>
+ <rule context='address@hidden'>
+ <assert test='//address@hidden =
current()/@aria-describedby]'>
+ The “aria-describedby” attribute
must point to an element in the
+ same document.
+ </assert>
+ </rule>
+ </pattern>
+
+ <pattern name='flowto must not dangle'>
+ <rule context='address@hidden'>
+ <assert test='//address@hidden = current()/@aria-flowto]'>
+ The “aria-flowto” attribute must
point to an element in the
+ same document.
+ </assert>
+ </rule>
+ </pattern>
+
+ <pattern name='labelledby must not dangle'>
+ <rule context='address@hidden'>
+ <assert test='//address@hidden = current()/@aria-labelledby]'>
+ The “aria-labelledby” attribute
must point to an element in the
+ same document.
+ </assert>
+ </rule>
+ </pattern>
+
+ <pattern name='owns must not dangle'>
+ <rule context='address@hidden'>
+ <assert test='//address@hidden = current()/@aria-owns]'>
+ The “aria-owns” attribute must
point to an element in the
+ same document.
+ </assert>
+ </rule>
+ </pattern>
+
+<!-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-->
+<!-- Warnings
-->
+<!-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-->
+ <pattern name="Warnings for HTML5 attributes that are obsolete but
conforming">
+ <rule context='h:img'>
+ <report test='@border' role='warning'>
+ The “border” attribute on the
“img” element is obsolete.
+ Consider specifying “img { border: 0;
}“ in CSS instead.
+ </report>
+ </rule>
+ <rule context='h:script[translate(@language, "JAVSCRIPT",
"javscript")="javascript"]'>
+ <report test='not(@type) or translate(@type,
"EXJAVSCRIPT", "exjavscript")="text/javascript"' role='warning'>
+ The “language” attribute on the
“script” element is obsolete. You can safely omit it.
+ </report>
+ </rule>
+ <rule context='h:a'>
+ <report test='@name' role='warning'>
+ The “name” attribute on the
“a” element is obsolete. Consider putting an
+ “id” attribute on the nearest
container instead.
+ </report>
+ </rule>
+ </pattern>
+
+ <pattern name="Other warnings">
+ <rule context='h:video|h:audio'>
+ <report test='count(h:address@hidden) > 1'
role='warning'>
+ “<name/>” element has more than
one “track”
+ child element with a “default”
attribute.
+ </report>
+ </rule>
+ </pattern>
+
+</schema>
diff --git a/packages/html5-schema/block.rnc b/packages/html5-schema/block.rnc
new file mode 100644
index 0000000..6d0eb0d
--- /dev/null
+++ b/packages/html5-schema/block.rnc
@@ -0,0 +1,250 @@
+datatypes w = "http://whattf.org/datatype-draft";
+
+# #####################################################################
+## RELAX NG Schema for HTML 5: Basic Prose Markup #
+# #####################################################################
+
+# #####################################################################
+## Paragraph-Level
+
+## Paragraph: <p>
+
+ p.elem =
+ element p { p.inner & p.attrs }
+ p.attrs =
+ ( common.attrs
+ & common.attrs.aria?
+ )
+ p.inner =
+ ( common.inner.phrasing ) # REVISIT lists in span?
+
+ common.elem.flow |= p.elem
+
+## Hint Transition: <hr>
+
+ hr.elem =
+ element hr { hr.inner & hr.attrs }
+ hr.attrs =
+ ( common.attrs
+ & common.attrs.aria.role.separator?
+ )
+ hr.inner =
+ ( empty )
+
+ common.elem.flow |= hr.elem
+
+# #####################################################################
+## Preformatting Blocks
+
+## Preformatted Text: <pre>
+
+ pre.elem =
+ element pre { pre.inner & pre.attrs }
+ pre.attrs =
+ ( common.attrs
+ & common.attrs.aria?
+ )
+ pre.inner =
+ ( common.inner.phrasing )
+
+ common.elem.flow |= pre.elem
+
+# #####################################################################
+## Simple Lists
+
+## Unordered List: <ul>
+
+ ul.elem =
+ element ul { ul.inner & ul.attrs }
+ ul.attrs =
+ ( common.attrs
+ & ( ( common.attrs.aria.role.directory
+ | common.attrs.aria.role.group
+ | common.attrs.aria.role.list
+ | common.attrs.aria.role.listbox
+ | common.attrs.aria.role.menu
+ | common.attrs.aria.role.menubar
+ | common.attrs.aria.role.tablist
+ | common.attrs.aria.role.toolbar
+ | common.attrs.aria.role.tree
+ | common.attrs.aria.role.presentation
+ )
+ | common.attrs.aria.implicit.list
+ )?
+ )
+ ul.inner =
+ ( li.elem*
+ & common.elem.script-supporting*
+ )
+
+ common.elem.flow |= ul.elem
+
+## Unordered List Item: <li>
+
+ li.elem =
+ element li { li.inner & li.attrs }
+ li.attrs =
+ ( common.attrs
+ & ( common.attrs.aria.implicit.listitem
+ | common.attrs.aria.role.listitem
+ | common.attrs.aria.role.menuitem
+ | common.attrs.aria.role.menuitemcheckbox
+ | common.attrs.aria.role.menuitemradio
+ | common.attrs.aria.role.option
+ | common.attrs.aria.role.tab
+ | common.attrs.aria.role.treeitem
+ | common.attrs.aria.role.separator
+ | common.attrs.aria.role.presentation
+ )?
+ )
+ li.inner =
+ ( common.inner.flow )
+
+## Ordered List: <ol>
+
+ ol.elem =
+ element ol { ol.inner & ol.attrs }
+ ol.attrs =
+ ( common.attrs
+ & ol.attrs.start?
+ & ol.attrs.reversed?
+ & ol.attrs.type?
+ & ( ( common.attrs.aria.role.directory
+ | common.attrs.aria.role.group
+ | common.attrs.aria.role.list
+ | common.attrs.aria.role.listbox
+ | common.attrs.aria.role.menu
+ | common.attrs.aria.role.menubar
+ | common.attrs.aria.role.tablist
+ | common.attrs.aria.role.toolbar
+ | common.attrs.aria.role.tree
+ | common.attrs.aria.role.presentation
+ )
+ | common.attrs.aria.implicit.list
+ )?
+ )
+ ol.attrs.start =
+ attribute start {
+ common.data.integer
+ }
+ ol.attrs.reversed =
+ attribute reversed {
+ w:string "reversed" | w:string ""
+ }
+ ol.attrs.type =
+ attribute type {
+ w:string "1" | w:string "a" | w:string "A" |
w:string "i" | w:string "I"
+ }
+ ol.inner =
+ ( oli.elem*
+ & common.elem.script-supporting*
+ )
+
+ common.elem.flow |= ol.elem
+
+## Ordered List Item: <li>
+
+ oli.elem =
+ element li { oli.inner & oli.attrs }
+ oli.attrs =
+ ( common.attrs
+ & oli.attrs.value?
+ & ( common.attrs.aria.implicit.listitem
+ | common.attrs.aria.role.listitem
+ | common.attrs.aria.role.menuitem
+ | common.attrs.aria.role.menuitemcheckbox
+ | common.attrs.aria.role.menuitemradio
+ | common.attrs.aria.role.option
+ | common.attrs.aria.role.tab
+ | common.attrs.aria.role.treeitem
+ | common.attrs.aria.role.separator
+ | common.attrs.aria.role.presentation
+ )?
+ )
+ oli.attrs.value =
+ attribute value {
+ common.data.integer
+ }
+ oli.inner =
+ ( common.inner.flow )
+
+# #####################################################################
+## Definition Lists
+
+## Definition List: <dl>
+
+ dl.elem =
+ element dl { dl.inner & dl.attrs }
+ dl.attrs =
+ ( common.attrs
+ & ( common.attrs.aria.implicit.list
+ | common.attrs.aria.role.list
+ )?
+ )
+ dl.inner =
+ ( ( ( dt.elem
+ & common.elem.script-supporting*
+ )+
+ ,
+ ( dd.elem
+ & common.elem.script-supporting*
+ )+
+ )*
+ )
+
+ common.elem.flow |= dl.elem
+
+## Definition Term: <dt>
+
+ dt.elem =
+ element dt { dt.inner & dt.attrs }
+ dt.attrs =
+ ( common.attrs
+ & common.attrs.aria?
+ )
+ dt.inner =
+ ( common.inner.flow )
+
+## Definition Description: <dd>
+
+ dd.elem =
+ element dd { dd.inner & dd.attrs }
+ dd.elem.phrasing =
+ element dd { dd.inner.phrasing & dd.attrs }
+ dd.attrs =
+ ( common.attrs
+ & common.attrs.aria?
+ )
+ dd.inner =
+ ( common.inner.flow )
+ dd.inner.phrasing =
+ ( common.inner.phrasing )
+
+# #####################################################################
+## Miscellaneous Elements
+
+## Generic Container: <div>
+
+ div.elem =
+ element div { div.inner & div.attrs }
+ div.attrs =
+ ( common.attrs
+ & common.attrs.aria?
+ )
+ div.inner =
+ ( common.inner.flow )
+
+ common.elem.flow |= div.elem
+
+## Title or Explanatory Caption: <legend>
+
+ legend.elem =
+ element legend { legend.inner & legend.attrs }
+ legend.attrs =
+ ( common.attrs
+ & ( common.attrs.aria.role.presentation
+ | common.attrs.aria.role.menuitem
+ )?
+ )
+ legend.inner =
+ ( common.inner.phrasing )
diff --git a/packages/html5-schema/common.rnc b/packages/html5-schema/common.rnc
new file mode 100644
index 0000000..68d9acc
--- /dev/null
+++ b/packages/html5-schema/common.rnc
@@ -0,0 +1,526 @@
+datatypes w = "http://whattf.org/datatype-draft";
+
+# #####################################################################
+## RELAX NG Schema for HTML 5: Common Definitions #
+# #####################################################################
+
+
+# #####################################################################
+## Language Parameters - redefine in inclusion block as necessary #
+# #####################################################################
+
+## HTML vs. XHTML restrictions
+
+ XMLonly = empty
+ HTMLonly = notAllowed
+
+## HTML 4 Compatibility - set to notAllowed to disallow markup introduced in
HTML 5
+# (This only affects mixed-version modules; wholly
HTML5
+# modules should simply be left out of the inclusion
list.)
+
+ v5only = empty
+
+## HTML Compatibility Switches - set to notAllowed to disallow
+
+ ## XML features that can't be roundtripped HTML <-> XHTML
+ # (xml:base on elements other than <html>)
+ nonRoundtrippable = empty
+
+ ## XML features that can't be serialized as HTML
+ nonHTMLizable = empty
+
+## features that are not part of the W3C HTML spec
+ nonW3C = empty
+
+# #####################################################################
+## Wildcards #
+# #####################################################################
+
+## Any attribute from any namespace
+
+ common.attr.anything =
+ attribute * { text }*
+
+## Any element from any namespace
+
+ common.elem.anything =
+ element * { common.inner.anything & common.attr.anything }
+
+## Any content from any namespace
+
+ common.inner.anything =
+ ( text
+ & common.elem.anything*
+ )
+
+# #####################################################################
+## Common Element Classes #
+# #####################################################################
+
+## Metadata Elements
+
+ common.elem.metadata =
+ ( notAllowed )
+
+## Phrase Elements
+
+ common.elem.phrasing =
+ ( notAllowed )
+
+## Prose Elements
+
+ common.elem.flow =
+ ( common.elem.phrasing )
+
+
+# #####################################################################
+## Common Content Models #
+# #####################################################################
+
+## Metadata Content
+
+ common.inner.metadata =
+ ( common.elem.metadata* )
+
+## Phrase Content
+
+ common.inner.phrasing =
+ ( text & common.elem.phrasing* )
+
+## Prose Content
+
+ common.inner.transparent.flow =
+ ( text & common.elem.flow* )
+
+ common.inner.flow =
+ ( style.elem.scoped*,
+ ( text
+ & common.elem.flow*
+ )
+ )
+
+# #####################################################################
+## Common Attributes #
+# #####################################################################
+
+# When updating, check <bdo> definition too
+
+common.attrs =
+ ( common.attrs.basic
+ & common.attrs.i18n
+ & common.attrs.present
+ & common.attrs.other
+ )
+
+common.attrs.basic =
+ ( common.attrs.id?
+ & common.attrs.class?
+ & common.attrs.title?
+ & common.attrs.base?
+ & common.attrs.space?
+ )
+ common.attrs.id =
+ attribute id {
+ common.data.id
+ }
+ common.attrs.class =
+ attribute class {
+ common.data.tokens
+ }
+ common.attrs.title =
+ attribute title {
+ text
+ }
+ common.attrs.base =
+ common.attrs.xmlbase
+ & nonRoundtrippable
+ common.attrs.xmlbase =
+ attribute xml:base {
+ common.data.uri
+ } & XMLonly
+ common.attrs.space =
+ common.attrs.xmlspace
+ common.attrs.xmlspace =
+ attribute xml:space {
+ string "preserve" | string "default"
+ } & XMLonly
+
+common.attrs.i18n =
+ ( common.attrs.dir?
+ & common.attrs.language?
+ & common.attrs.translate?
+ )
+ common.attrs.dir =
+ attribute dir {
+ w:string "ltr" | w:string "rtl" | w:string "auto"
+ }
+ # This lang definition is a hack for enviroments where
+ # the HTML5 parser maps lang to xml:lang.
+ # Sameness check left to Schematron
+ common.attrs.language =
+ ( common.attrs.xmllang?
+ & common.attrs.lang?
+ )
+ common.attrs.lang =
+ attribute lang {
+ common.data.langcode
+ } & XMLonly
+ common.attrs.xmllang =
+ attribute xml:lang {
+ common.data.langcode
+ }
+# common.attrs.language =
+# ( common.attrs.lang
+# | common.attrs.xmllang
+# )
+# common.attrs.lang =
+# attribute lang {
+# common.data.langcode
+# } & HTMLonly
+# common.attrs.xmllang =
+# attribute xml:lang {
+# common.data.langcode
+# } & XMLonly
+ common.attrs.translate =
+ attribute translate {
+ w:string "" | w:string "yes" | w:string "no"
+ }
+
+common.attrs.present =
+ ( common.attrs.style?
+ & common.attrs.tabindex?
+ & common.attrs.accesskey?
+ )
+ common.attrs.style =
+ attribute style {
+ string
+ }
+ common.attrs.tabindex =
+ attribute tabindex {
+ common.data.integer
+ }
+ # REVISIT move style to a module and bundle tabindex with ARIA
+ common.attrs.accesskey =
+ attribute accesskey {
+ common.data.keylabellist
+ }
+
+common.attrs.other =
+ empty
+
+# #####################################################################
+## Common Datatypes #
+# #####################################################################
+
+## Names and Tokens
+
+ common.data.tokens =
+ list { token* }
+
+ common.data.browsing-context =
+ w:browsing-context
+
+ common.data.browsing-context-or-keyword =
+ w:browsing-context-or-keyword
+# xsd:string {
+# pattern =
"()|([^_].*)|(_[bB][lL][aA][nN][kK])|(_[sS][eE][lL][fF])|(_[pP][aA][rR][eE][nN][tT])|(_[tT][oO][pP])"
+# }
+
+
+## IDs and IDREFs
+
+ common.data.id =
+ w:ID
+# xsd:string {
+# pattern = "\S+"
+# }
+
+ common.data.idref =
+ w:IDREF
+
+ common.data.idrefs =
+ w:IDREFS
+
+ common.data.name =
+ w:ID #FIXME
+
+ common.data.hash-name =
+ w:hash-name
+# xsd:string {
+# pattern = "#.+"
+# }
+
+## Numerical
+
+ common.data.integer =
+ w:integer
+# xsd:string {
+# pattern = "-?[0-9]+"
+# }
+
+ common.data.integer.positive =
+ w:integer-positive
+# xsd:string {
+# pattern = "0*[1-9][0-9]*"
+# }
+
+ common.data.integer.non-negative =
+ w:integer-non-negative
+# xsd:string {
+# pattern = "[0-9]+"
+# }
+
+# common.data.percent =
+# xsd:string {
+# pattern = "(100)|([1-9]?[0-9](\.[0-9]+)?)%"
+# }
+
+ common.data.float =
+ w:float
+# xsd:string {
+# pattern = "-?[0-9]+(\.[0-9]+)?([eE]-?[0-9]+)?"
+# }
+
+ common.data.float.positive =
+ w:float-positive
+# xsd:string {
+# pattern =
"(0*[1-9][0-9]*(\.[0-9]+)?)|([0-9]+(\.0*[1-9][0-9]*)?)([eE]-?[0-9]+)?"
+# }
+
+ common.data.float.non-negative =
+ w:float-non-negative
+# xsd:string {
+# pattern = "[0-9]+(\.[0-9]+)?([eE]-?[0-9]+)?"
+# }
+
+## Temporal
+
+ common.data.datetime =
+ w:datetime-tz
+
+ common.data.date-or-time =
+ w:date-or-time
+
+ common.data.date =
+ w:date
+
+ common.data.time-datetime =
+ w:time-datetime
+
+## IRIs
+
+ common.data.uri =
+ # allow either a non-empty IRI ref or zero or more HTML
+ # space characters (which are: space, tab, LF, FF, CR)
+ ( w:iri-ref
+ | xsd:string {
+ pattern = "[ \x{0A}-\x{0D}]*"
+ # NOTE The range above incorrectly allows U+000B
+ # in addition to the HTML space characters; but
+ # that's not a problem in practice because HTML
+ # and XML parsers will both catch any U+000B
+ # and report an error for it before that pattern
+ # ever gets evaluated.
+ }
+ )
+
+ common.data.uri.non-empty =
+ w:iri-ref
+
+ common.data.uris =
+ list { w:iri-ref* }
+
+ common.data.uri.absolute =
+ w:iri
+
+## <link type='icon'> sizes
+
+ common.data.sizes =
+# list { w:sizes }
+ list {
+ xsd:string {
+ pattern = "[1-9][0-9]*x[1-9][0-9]*"
+ }+
+ }
+
+## MIME types
+
+ common.data.mimetype =
+ w:mime-type
+
+## Encodings
+
+ common.data.charset =
+ w:charset
+
+ common.data.meta-charset =
+ w:meta-charset
+
+## Refresh
+
+ common.data.refresh =
+ w:refresh
+
+## Default style
+
+ common.data.default-style =
+ string
+# w:default-style
+
+## X-UA-Compatible
+
+ common.data.x-ua-compatible =
+ string
+
+## Media Queries
+
+ common.data.mediaquery =
+ w:media-query
+
+## Language Codes
+
+ common.data.langcode =
+ w:string "" | w:language
+
+## List of Key Labels
+ common.data.keylabellist =
+ w:keylabellist
+
+## List of Source Sizes
+ common.data.source.size.list =
+ w:source-size-list
+
+## Subresource Integrity
+ common.data.integrity =
+ w:integrity-metadata
+
+## Content Security Policy
+ common.data.content-security-policy =
+ w:content-security-policy
+
+## List of sandbox keywords
+ common.data.sandbox-allow-list =
+ w:string "" | w:sandbox-allow-list
+
+## Microdata Properties
+ common.data.microdata-properties =
+ list { w:microdata-property+ }
+
+## Zero
+ common.data.zero =
+ w:zero
+
+## ECMAScript FunctionBody
+ common.data.functionbody =
+ w:functionbody
+
+# #####################################################################
+## WF2 Module Hook #
+# #####################################################################
+
+common-form.attrs.form = ( notAllowed )
+
+# #####################################################################
+## Script-supporting elements
+# #####################################################################
+
+common.elem.script-supporting = ( notAllowed )
+
+# #####################################################################
+## ARIA Module Hooks #
+# #####################################################################
+
+common.attrs.aria = ( notAllowed )
+common.attrs.aria.role.alert = ( notAllowed )
+common.attrs.aria.role.alertdialog = ( notAllowed )
+common.attrs.aria.role.application = ( notAllowed )
+common.attrs.aria.role.article = ( notAllowed )
+common.attrs.aria.role.banner = ( notAllowed )
+common.attrs.aria.role.button = ( notAllowed )
+common.attrs.aria.role.checkbox = ( notAllowed )
+common.attrs.aria.role.combobox = ( notAllowed )
+common.attrs.aria.role.complementary = ( notAllowed )
+common.attrs.aria.role.contentinfo = ( notAllowed )
+common.attrs.aria.role.dialog = ( notAllowed )
+common.attrs.aria.role.directory = ( notAllowed )
+common.attrs.aria.role.document = ( notAllowed )
+common.attrs.aria.role.group = ( notAllowed )
+common.attrs.aria.role.heading = ( notAllowed )
+common.attrs.aria.role.img = ( notAllowed )
+common.attrs.aria.role.link = ( notAllowed )
+common.attrs.aria.role.list = ( notAllowed )
+common.attrs.aria.role.listitem = ( notAllowed )
+common.attrs.aria.role.log = ( notAllowed )
+common.attrs.aria.role.listbox = ( notAllowed )
+common.attrs.aria.role.main = ( notAllowed )
+common.attrs.aria.role.marquee = ( notAllowed )
+common.attrs.aria.role.menu = ( notAllowed )
+common.attrs.aria.role.menubar = ( notAllowed )
+common.attrs.aria.role.menuitem = ( notAllowed )
+common.attrs.aria.role.menuitemcheckbox = ( notAllowed )
+common.attrs.aria.role.menuitemradio = ( notAllowed )
+common.attrs.aria.role.note = ( notAllowed )
+common.attrs.aria.role.option = ( notAllowed )
+common.attrs.aria.role.presentation = ( notAllowed )
+common.attrs.aria.role.progressbar = ( notAllowed )
+common.attrs.aria.role.radio = ( notAllowed )
+common.attrs.aria.role.region = ( notAllowed )
+common.attrs.aria.role.search = ( notAllowed )
+common.attrs.aria.role.separator = ( notAllowed )
+common.attrs.aria.role.slider = ( notAllowed )
+common.attrs.aria.role.spinbutton = ( notAllowed )
+common.attrs.aria.role.status = ( notAllowed )
+common.attrs.aria.role.switch = ( notAllowed )
+common.attrs.aria.role.tab = ( notAllowed )
+common.attrs.aria.role.tablist = ( notAllowed )
+common.attrs.aria.role.tabpanel = ( notAllowed )
+common.attrs.aria.role.textbox = ( notAllowed )
+common.attrs.aria.role.toolbar = ( notAllowed )
+common.attrs.aria.role.tree = ( notAllowed )
+common.attrs.aria.role.treeitem = ( notAllowed )
+common.attrs.aria.implicit.article = ( notAllowed )
+common.attrs.aria.implicit.banner = ( notAllowed )
+common.attrs.aria.implicit.button = ( notAllowed )
+common.attrs.aria.implicit.checkbox = ( notAllowed )
+common.attrs.aria.implicit.column-or-row-header = ( notAllowed )
+common.attrs.aria.implicit.combobox = ( notAllowed )
+common.attrs.aria.implicit.complementary = ( notAllowed )
+common.attrs.aria.implicit.contentinfo = ( notAllowed )
+common.attrs.aria.implicit.dialog = ( notAllowed )
+common.attrs.aria.implicit.document = ( notAllowed )
+common.attrs.aria.implicit.form = ( notAllowed )
+common.attrs.aria.implicit.group = ( notAllowed )
+common.attrs.aria.implicit.heading = ( notAllowed )
+common.attrs.aria.implicit.img = ( notAllowed )
+common.attrs.aria.implicit.landmark = ( notAllowed )
+common.attrs.aria.implicit.link = ( notAllowed )
+common.attrs.aria.implicit.list = ( notAllowed )
+common.attrs.aria.implicit.listbox = ( notAllowed )
+common.attrs.aria.implicit.listitem = ( notAllowed )
+common.attrs.aria.implicit.main = ( notAllowed )
+common.attrs.aria.implicit.navigation = ( notAllowed )
+common.attrs.aria.implicit.option = ( notAllowed )
+common.attrs.aria.implicit.progressbar = ( notAllowed )
+common.attrs.aria.implicit.radio = ( notAllowed )
+common.attrs.aria.implicit.region = ( notAllowed )
+common.attrs.aria.implicit.section = ( notAllowed )
+common.attrs.aria.implicit.select = ( notAllowed )
+common.attrs.aria.implicit.slider = ( notAllowed )
+common.attrs.aria.implicit.spinbutton = ( notAllowed )
+common.attrs.aria.implicit.status = ( notAllowed )
+common.attrs.aria.implicit.structure = ( notAllowed )
+common.attrs.aria.implicit.textbox = ( notAllowed )
+common.attrs.aria.implicit.toolbar = ( notAllowed )
+common.attrs.aria.prop.readonly = ( notAllowed )
+common.attrs.aria.landmark.application = ( notAllowed )
+common.attrs.aria.landmark.banner = ( notAllowed )
+common.attrs.aria.landmark.complementary = ( notAllowed )
+common.attrs.aria.landmark.contentinfo = ( notAllowed )
+common.attrs.aria.landmark.form = ( notAllowed )
+common.attrs.aria.landmark.main = ( notAllowed )
+common.attrs.aria.landmark.navigation = ( notAllowed )
+common.attrs.aria.landmark.search = ( notAllowed )
+# per ARIA spec: article, document, and note are not actually landmarks
+common.attrs.aria.landmark.article = ( notAllowed )
+common.attrs.aria.landmark.document = ( notAllowed )
+common.attrs.aria.landmark.note = ( notAllowed )
diff --git a/packages/html5-schema/core-scripting.rnc
b/packages/html5-schema/core-scripting.rnc
new file mode 100644
index 0000000..33e8ff7
--- /dev/null
+++ b/packages/html5-schema/core-scripting.rnc
@@ -0,0 +1,386 @@
+datatypes w = "http://whattf.org/datatype-draft";
+
+# #####################################################################
+## RELAX NG Schema for HTML 5: Core Scripting #
+# #####################################################################
+
+# #####################################################################
+## Scripting Elements
+
+## Inline Scripts: <script>
+
+ script.elem.embedded =
+ element script { script.inner.embedded & script.attrs.embedded }
+ script.attrs.embedded =
+ ( common.attrs
+ & script.attrs.type?
+ & script.attrs.language? # restricted in Schematron
+ & script.attrs.integrity?
+ & script.attrs.nonce?
+ & embedded.content.attrs.crossorigin?
+ & ( common.attrs.aria.role.presentation
+ | common.attrs.aria.role.menuitem
+ )?
+ )
+ script.elem.imported =
+ element script { script.inner.imported & script.attrs.imported }
+ script.attrs.imported =
+ ( common.attrs
+ & script.attrs.src?
+ & script.attrs.defer?
+ & script.attrs.async?
+ & script.attrs.type?
+ & script.attrs.charset?
+ & script.attrs.language? # restricted in Schematron
+ & script.attrs.integrity?
+ & script.attrs.nonce?
+ & embedded.content.attrs.crossorigin?
+ & ( common.attrs.aria.role.presentation
+ | common.attrs.aria.role.menuitem
+ )?
+ )
+ script.attrs.src =
+ attribute src {
+ common.data.uri.non-empty
+ }
+ script.attrs.defer =
+ attribute defer {
+ w:string "defer" | w:string ""
+ }
+ script.attrs.async =
+ attribute async {
+ w:string "async" | w:string ""
+ } & v5only
+ script.attrs.type =
+ attribute type {
+ common.data.mimetype # XXX without charset
parameter!
+ }
+ script.attrs.charset =
+ attribute charset {
+ common.data.charset
+ }
+ script.attrs.language =
+ attribute language {
+ string
+ }
+ script.attrs.integrity =
+ attribute integrity {
+ common.data.integrity
+ }
+ script.attrs.nonce =
+ attribute nonce{
+ string
+ }
+ script.inner.embedded =
+ ( common.inner.anything )
+ script.inner.imported =
+ ( common.inner.anything )
+
+ script.elem =
+ ( script.elem.embedded
+ | script.elem.imported
+ )
+
+ common.elem.metadata |= script.elem
+ common.elem.phrasing |= script.elem
+
+## Fallback Unscripted Content: <noscript>
+
+ noscript.elem.head =
+ element noscript { noscript.inner.head & noscript.attrs }
+ & HTMLonly
+ noscript.inner.head =
+ ( link.elem
+ | meta.http-equiv.default-style.elem
+ | meta.http-equiv.refresh.elem
+ | style.elem
+ )*
+ noscript.elem.phrasing =
+ element noscript { noscript.inner.phrasing & noscript.attrs }
+ & HTMLonly
+ noscript.inner.phrasing =
+ ( common.inner.phrasing )
+ noscript.elem.flow =
+ element noscript { noscript.inner.flow & noscript.attrs }
+ & HTMLonly
+ noscript.inner.flow =
+ ( common.inner.flow )
+ noscript.attrs =
+ ( common.attrs
+ & ( common.attrs.aria.role.presentation
+ | common.attrs.aria.role.menuitem
+ )?
+ )
+
+ common.elem.metadata |= noscript.elem.head
+ common.elem.phrasing |= noscript.elem.phrasing
+ common.elem.flow |= noscript.elem.flow
+
+# #####################################################################
+## Event Handler Attribute Definitions
+
+ common.attrs.scripting &=
+ ( scripting.attr.onabort?
+ & scripting.attr.onautocomplete?
+ & scripting.attr.onautocompleteerror?
+ & scripting.attr.onblur?
+ & scripting.attr.oncancel?
+ & scripting.attr.oncanplay?
+ & scripting.attr.oncanplaythrough?
+ & scripting.attr.onchange?
+ & scripting.attr.onclick?
+ & scripting.attr.onclose?
+ & scripting.attr.oncuechange?
+ & scripting.attr.oncontextmenu?
+ & scripting.attr.ondblclick?
+ & scripting.attr.ondrag?
+ & scripting.attr.ondragend?
+ & scripting.attr.ondragenter?
+ & scripting.attr.ondragexit?
+ & scripting.attr.ondragleave?
+ & scripting.attr.ondragover?
+ & scripting.attr.ondragstart?
+ & scripting.attr.ondrop?
+ & scripting.attr.ondurationchange?
+ & scripting.attr.onemptied?
+ & scripting.attr.onended?
+ & scripting.attr.onerror?
+ & scripting.attr.onfocus?
+ & scripting.attr.oninput?
+ & scripting.attr.oninvalid?
+ & scripting.attr.onkeydown?
+ & scripting.attr.onkeypress?
+ & scripting.attr.onkeyup?
+ & scripting.attr.onload?
+ & scripting.attr.onloadeddata?
+ & scripting.attr.onloadedmetadata?
+ & scripting.attr.onloadstart?
+ & scripting.attr.onmousedown?
+ & scripting.attr.onmouseenter?
+ & scripting.attr.onmouseleave?
+ & scripting.attr.onmousemove?
+ & scripting.attr.onmouseout?
+ & scripting.attr.onmouseover?
+ & scripting.attr.onmouseup?
+ & scripting.attr.onwheel?
+ & scripting.attr.onpause?
+ & scripting.attr.onplay?
+ & scripting.attr.onplaying?
+ & scripting.attr.onprogress?
+ & scripting.attr.onratechange?
+ & scripting.attr.onreset?
+ & scripting.attr.onresize?
+ & scripting.attr.onscroll?
+ & scripting.attr.onseeked?
+ & scripting.attr.onseeking?
+ & scripting.attr.onselect?
+ & scripting.attr.onshow?
+ & scripting.attr.onsort?
+ & scripting.attr.onstalled?
+ & scripting.attr.onsubmit?
+ & scripting.attr.onsuspend?
+ & scripting.attr.ontimeupdate?
+ & scripting.attr.ontoggle?
+ & scripting.attr.onvolumechange?
+ & scripting.attr.onwaiting?
+ )
+
+ common.attrs.other &= common.attrs.scripting
+
+ scripting.attr.onabort =
+ attribute onabort { common.data.functionbody }
+ scripting.attr.onautocomplete =
+ attribute onautocomplete { common.data.functionbody }
+ scripting.attr.onautocompleteerror =
+ attribute onautocompleteerror { common.data.functionbody }
+ scripting.attr.onblur =
+ attribute onblur { common.data.functionbody }
+ scripting.attr.oncanplay =
+ attribute oncanplay { common.data.functionbody }
+ scripting.attr.oncancel =
+ attribute oncancel { common.data.functionbody }
+ scripting.attr.oncanplaythrough =
+ attribute oncanplaythrough { common.data.functionbody }
+ scripting.attr.onchange =
+ attribute onchange { common.data.functionbody }
+ scripting.attr.onclick =
+ attribute onclick { common.data.functionbody }
+ scripting.attr.onclose =
+ attribute onclose { common.data.functionbody }
+ scripting.attr.oncontextmenu =
+ attribute oncontextmenu { common.data.functionbody }
+ scripting.attr.oncuechange =
+ attribute oncuechange { common.data.functionbody }
+ scripting.attr.ondblclick =
+ attribute ondblclick { common.data.functionbody }
+ scripting.attr.ondrag =
+ attribute ondrag { common.data.functionbody }
+ scripting.attr.ondragend =
+ attribute ondragend { common.data.functionbody }
+ scripting.attr.ondragenter =
+ attribute ondragenter { common.data.functionbody }
+ scripting.attr.ondragexit =
+ attribute ondragexit { common.data.functionbody }
+ scripting.attr.ondragleave =
+ attribute ondragleave { common.data.functionbody }
+ scripting.attr.ondragover =
+ attribute ondragover { common.data.functionbody }
+ scripting.attr.ondragstart =
+ attribute ondragstart { common.data.functionbody }
+ scripting.attr.ondrop =
+ attribute ondrop { common.data.functionbody }
+ scripting.attr.ondurationchange =
+ attribute ondurationchange { common.data.functionbody }
+ scripting.attr.onemptied =
+ attribute onemptied { common.data.functionbody }
+ scripting.attr.onended =
+ attribute onended { common.data.functionbody }
+ scripting.attr.onerror =
+ attribute onerror { common.data.functionbody }
+ scripting.attr.onfocus =
+ attribute onfocus { common.data.functionbody }
+ scripting.attr.onformchange =
+ attribute onformchange { common.data.functionbody }
+ scripting.attr.onforminput =
+ attribute onforminput { common.data.functionbody }
+ scripting.attr.oninput =
+ attribute oninput { common.data.functionbody }
+ scripting.attr.oninvalid =
+ attribute oninvalid { common.data.functionbody }
+ scripting.attr.onkeydown =
+ attribute onkeydown { common.data.functionbody }
+ scripting.attr.onkeypress =
+ attribute onkeypress { common.data.functionbody }
+ scripting.attr.onkeyup =
+ attribute onkeyup { common.data.functionbody }
+ scripting.attr.onload =
+ attribute onload { common.data.functionbody }
+ scripting.attr.onloadeddata =
+ attribute onloadeddata { common.data.functionbody }
+ scripting.attr.onloadedmetadata =
+ attribute onloadedmetadata { common.data.functionbody }
+ scripting.attr.onloadstart =
+ attribute onloadstart { common.data.functionbody }
+ scripting.attr.onmousedown =
+ attribute onmousedown { common.data.functionbody }
+ scripting.attr.onmouseenter =
+ attribute onmouseenter { common.data.functionbody }
+ scripting.attr.onmouseleave =
+ attribute onmouseleave { common.data.functionbody }
+ scripting.attr.onmousemove =
+ attribute onmousemove { common.data.functionbody }
+ scripting.attr.onmouseout =
+ attribute onmouseout { common.data.functionbody }
+ scripting.attr.onmouseover =
+ attribute onmouseover { common.data.functionbody }
+ scripting.attr.onmouseup =
+ attribute onmouseup { common.data.functionbody }
+ scripting.attr.onwheel =
+ attribute onwheel { common.data.functionbody }
+ scripting.attr.onpause =
+ attribute onpause { common.data.functionbody }
+ scripting.attr.onplay =
+ attribute onplay { common.data.functionbody }
+ scripting.attr.onplaying =
+ attribute onplaying { common.data.functionbody }
+ scripting.attr.onprogress =
+ attribute onprogress { common.data.functionbody }
+ scripting.attr.onratechange =
+ attribute onratechange { common.data.functionbody }
+ scripting.attr.onreset =
+ attribute onreset { common.data.functionbody }
+ scripting.attr.onresize =
+ attribute onresize { common.data.functionbody }
+ scripting.attr.onscroll =
+ attribute onscroll { common.data.functionbody }
+ scripting.attr.onseeked =
+ attribute onseeked { common.data.functionbody }
+ scripting.attr.onseeking =
+ attribute onseeking { common.data.functionbody }
+ scripting.attr.onselect =
+ attribute onselect { common.data.functionbody }
+ scripting.attr.onshow =
+ attribute onshow { common.data.functionbody }
+ scripting.attr.onsort =
+ attribute onsort { common.data.functionbody }
+ scripting.attr.onstalled =
+ attribute onstalled { common.data.functionbody }
+ scripting.attr.onsubmit =
+ attribute onsubmit { common.data.functionbody }
+ scripting.attr.onsuspend =
+ attribute onsuspend { common.data.functionbody }
+ scripting.attr.ontimeupdate =
+ attribute ontimeupdate { common.data.functionbody }
+ scripting.attr.ontoggle =
+ attribute ontoggle { common.data.functionbody }
+ scripting.attr.onvolumechange =
+ attribute onvolumechange { common.data.functionbody }
+ scripting.attr.onwaiting =
+ attribute onwaiting { common.data.functionbody }
+
+# scripting.attr.common =
+# ( scripting.attr.mouse
+# & scripting.attr.keyboard
+# & scripting.attr.focus
+# )
+#
+# scripting.attr.mouse =
+# ( scripting.attr.mouse.click?
+# & scripting.attr.mouse.dblclick?
+# & scripting.attr.mouse.down?
+# & scripting.attr.mouse.up?
+# & scripting.attr.mouse.over?
+# & scripting.attr.mouse.move?
+# & scripting.attr.mouse.out?
+# )
+# scripting.attr.mouse.click =
+# attribute onclick { string }
+# scripting.attr.mouse.dblclick =
+# attribute ondblclick { string }
+# scripting.attr.mouse.down =
+# attribute onmousedown { string }
+# scripting.attr.mouse.up =
+# attribute onmouseup { string }
+# scripting.attr.mouse.over =
+# attribute onmouseover { string }
+# scripting.attr.mouse.move =
+# attribute onmousemove { string }
+# scripting.attr.mouse.out =
+# attribute onmouseout { string }
+#
+# scripting.attr.keyboard =
+# ( scripting.attr.keyboard.press?
+# & scripting.attr.keyboard.down?
+# & scripting.attr.keyboard.up?
+# )
+# scripting.attr.keyboard.press =
+# attribute onkeypress { string }
+# scripting.attr.keyboard.down =
+# attribute onkeydown { string }
+# scripting.attr.keyboard.up =
+# attribute onkeyup { string }
+#
+#
+# scripting.attr.focus =
+# ( scripting.attr.focus.gain?
+# & scripting.attr.focus.lose?
+# )
+# scripting.attr.focus.gain =
+# attribute onfocus { string }
+# scripting.attr.focus.lose =
+# attribute onblur { string }
+#
+# scripting.attr.loading =
+# ( scripting.attr.loading.load?
+# & scripting.attr.loading.unload?
+# )
+# scripting.attr.loading.load =
+# attribute onload { string }
+# scripting.attr.loading.unload =
+# attribute onunload { string }
+
+
+# #####################################################################
+# Event Handler Attribute Assignments
+
+# body.attrs &= scripting.attr.loading
diff --git a/packages/html5-schema/data.rnc b/packages/html5-schema/data.rnc
new file mode 100644
index 0000000..991f698
--- /dev/null
+++ b/packages/html5-schema/data.rnc
@@ -0,0 +1,94 @@
+datatypes w = "http://whattf.org/datatype-draft";
+
+# #####################################################################
+## RELAX NG Schema for HTML 5: Static Data Markup #
+# #####################################################################
+
+## Time: <time>
+
+ time.elem =
+ element time { time.inner & time.attrs }
+ time.attrs =
+ ( common.attrs
+ & time.attrs.datetime?
+ & common.attrs.aria?
+ )
+ time.attrs.datetime =
+ attribute datetime {
+ common.data.time-datetime
+ }
+ time.attrs.datetime.dateonly =
+ attribute datetime {
+ common.data.date
+ }
+ time.attrs.datetime.tz =
+ attribute datetime {
+ common.data.datetime
+ }
+ time.inner =
+ ( common.inner.phrasing ) #Cannot enforce textContent format
here
+
+ common.elem.phrasing |= time.elem
+
+## Data: <data>
+
+ data.elem =
+ element data { data.inner & data.attrs }
+ data.attrs =
+ ( common.attrs
+ & data.attrs.value
+ & common.attrs.aria?
+ )
+ data.attrs.value =
+ attribute value {
+ string
+ }
+ data.inner =
+ ( common.inner.phrasing )
+
+ common.elem.phrasing |= data.elem
+
+## Scalar Gauge: <meter>
+
+ meter.elem =
+ element meter { meter.inner & meter.attrs }
+ meter.attrs =
+ ( common.attrs
+ & meter.attrs.value
+ & meter.attrs.min?
+ & meter.attrs.low?
+ & meter.attrs.high?
+ & meter.attrs.max?
+ & meter.attrs.optimum?
+ & ( common.attrs.aria.implicit.progressbar
+ | common.attrs.aria.role.progressbar
+ )?
+ )
+ meter.attrs.value =
+ attribute value {
+ common.data.float
+ }
+ meter.attrs.min =
+ attribute min {
+ common.data.float
+ }
+ meter.attrs.low =
+ attribute low {
+ common.data.float
+ }
+ meter.attrs.high =
+ attribute high {
+ common.data.float
+ }
+ meter.attrs.max =
+ attribute max {
+ common.data.float
+ }
+ meter.attrs.optimum =
+ attribute optimum {
+ common.data.float
+ }
+ meter.inner =
+ ( common.inner.phrasing ) #Cannot enforce textContent format
here
+
+ common.elem.phrasing |= meter.elem
diff --git a/packages/html5-schema/embed.rnc b/packages/html5-schema/embed.rnc
new file mode 100644
index 0000000..a46b982
--- /dev/null
+++ b/packages/html5-schema/embed.rnc
@@ -0,0 +1,586 @@
+datatypes w = "http://whattf.org/datatype-draft";
+namespace local = ""
+
+# #####################################################################
+## RELAX NG Schema for HTML 5: Embedded Content #
+# #####################################################################
+
+#######################################################################
+## Replaced Content
+
+## Images: <img>
+
+ img.elem =
+ element img { img.inner & img.attrs }
+ img.attrs =
+ ( common.attrs
+ & img.attrs.src
+ & img.attrs.srcset?
+ & img.attrs.sizes?
+ & img.attrs.alt? # ARIA: if alt empty, only allowed role
value is "presentation"; check in assertions
+ & img.attrs.height?
+ & img.attrs.width?
+ & img.attrs.usemap?
+ & img.attrs.ismap?
+ & img.attrs.border? # obsolete
+ & embedded.content.attrs.crossorigin?
+ & ( common.attrs.aria.implicit.img
+ | common.attrs.aria
+ )?
+ )
+ img.attrs.src =
+ attribute src {
+ common.data.uri.non-empty
+ }
+ img.attrs.srcset =
+ attribute srcset {
+ string
+ } & v5only
+ img.attrs.sizes =
+ attribute sizes {
+ common.data.source.size.list
+ } & v5only
+ img.attrs.alt =
+ attribute alt {
+ text
+ }
+ img.attrs.height =
+ attribute height {
+ common.data.integer.non-negative
+ }
+ img.attrs.width =
+ attribute width {
+ common.data.integer.non-negative
+ }
+ img.attrs.usemap =
+ attribute usemap {
+ common.data.hash-name
+ }
+ img.attrs.ismap =
+ attribute ismap {
+ w:string "ismap" | w:string ""
+ }
+ img.attrs.border =
+ attribute border {
+ common.data.zero
+ }
+ img.inner =
+ empty
+
+ common.elem.phrasing |= img.elem
+
+## Image with multiple sources: <picture>
+
+ picture.elem =
+ element picture { picture.inner & picture.attrs }
+ & v5only
+ picture.attrs =
+ ( common.attrs )
+ picture.inner =
+ ( ( source.picture.elem*
+ & common.elem.script-supporting*
+ ),
+ ( img.elem
+ & common.elem.script-supporting*
+ )
+ )
+
+ common.elem.phrasing |= picture.elem
+
+## Picture source: <source srcset>
+
+ source.picture.elem =
+ element source { source.picture.inner & source.picture.attrs }
+ source.picture.attrs =
+ ( common.attrs
+ & source.picture.attrs.media?
+ & source.picture.attrs.srcset
+ & source.picture.attrs.sizes?
+ & source.picture.attrs.type?
+ )
+ source.picture.attrs.media =
+ attribute media {
+ common.data.mediaquery
+ }
+ source.picture.attrs.srcset =
+ attribute srcset {
+ string
+ }
+ source.picture.attrs.sizes =
+ attribute sizes {
+ common.data.source.size.list
+ }
+ source.picture.attrs.type =
+ attribute type {
+ common.data.mimetype
+ }
+ source.picture.inner =
+ ( empty )
+
+## Plug-ins: <embed>
+
+ embed.elem =
+ element embed { embed.inner & embed.attrs }
+ embed.attrs =
+ ( common.attrs
+ & embed.attrs.src?
+ & embed.attrs.type?
+ & embed.attrs.height?
+ & embed.attrs.width?
+ & embed.attrs.other*
+ & ( common.attrs.aria.landmark.application
+ | common.attrs.aria.landmark.document
+ | common.attrs.aria.role.img
+ | common.attrs.aria.role.presentation
+ )?
+ )
+ embed.attrs.src =
+ attribute src {
+ common.data.uri.non-empty
+ }
+ embed.attrs.type =
+ attribute type {
+ common.data.mimetype
+ }
+ embed.attrs.height =
+ attribute height {
+ common.data.integer.non-negative
+ }
+ embed.attrs.width =
+ attribute width {
+ common.data.integer.non-negative
+ }
+ embed.attrs.other = # REVISIT common.attrs
+ attribute local:* - ( src
+ | type
+ | height
+ | width
+ | id
+ | class
+ | title
+ | dir
+ | lang
+ | translate
+ | style
+ | tabindex
+ | contextmenu
+ | contenteditable
+ | draggable
+ | dropzone
+ | hidden
+ | onabort
+ | onautocomplete
+ | onautocompleteerror
+ | onblur
+ | oncancel
+ | oncanplay
+ | oncanplaythrough
+ | onchange
+ | onclick
+ | onclose
+ | oncontextmenu
+ | oncuechange
+ | ondblclick
+ | ondrag
+ | ondragend
+ | ondragenter
+ | ondragexit
+ | ondragleave
+ | ondragover
+ | ondragstart
+ | ondrop
+ | ondurationchange
+ | onemptied
+ | onended
+ | onerror
+ | onfocus
+ | oninput
+ | oninvalid
+ | onkeydown
+ | onkeypress
+ | onkeyup
+ | onload
+ | onloadeddata
+ | onloadedmetadata
+ | onloadstart
+ | onmousedown
+ | onmouseenter
+ | onmouseleave
+ | onmousemove
+ | onmouseout
+ | onmouseover
+ | onmouseup
+ | onwheel
+ | onpause
+ | onplay
+ | onplaying
+ | onprogress
+ | onratechange
+ | onreset
+ | onresize
+ | onscroll
+ | onseeked
+ | onseeking
+ | onselect
+ | onshow
+ | onsort
+ | onstalled
+ | onsubmit
+ | onsuspend
+ | ontimeupdate
+ | ontoggle
+ | onvolumechange
+ | onwaiting
+ | role
+ | aria-atomic
+ | aria-busy
+ | aria-controls
+ | aria-describedby
+ | aria-disabled
+ | aria-dropeffect
+ | aria-expanded
+ | aria-flowto
+ | aria-grabbed
+ | aria-haspopup
+ | aria-hidden
+ | aria-invalid
+ | aria-label
+ | aria-labelledby
+ | aria-live
+ | aria-owns
+ | aria-relevant
+ | aria-required
+ | spellcheck
+ | accesskey
+ | itemref
+ | itemprop
+ | itemscope
+ | itemtype
+ | itemid
+ | name
+ | align
+ | about
+ | prefix
+ | property
+ | typeof
+ | vocab
+ | content
+ | datatype
+ | href
+ | rel
+ | resource
+ | rev
+ | inlist
+ | its-loc-note
+ | its-loc-note-type
+ | its-loc-note-ref
+ | its-term-info-ref
+ | its-term
+ | its-term-confidence
+ | its-within-text
+ | its-domain-mapping
+ | its-ta-confidence
+ | its-ta-class-ref
+ | its-ta-ident
+ | its-ta-ident-ref
+ | its-ta-source
+ | its-locale-filter-list
+ | its-locale-filter-type
+ | its-person
+ | its-person-ref
+ | its-org
+ | its-org-ref
+ | its-tool
+ | its-tool-ref
+ | its-rev-person
+ | its-rev-person-ref
+ | its-rev-org
+ | its-rev-org-ref
+ | its-rev-tool
+ | its-rev-tool-ref
+ | its-prov-ref
+ | its-provenance-records-ref
+ | its-loc-quality-issues-ref
+ | its-loc-quality-issue-type
+ | its-loc-quality-issue-comment
+ | its-loc-quality-issue-severity
+ | its-loc-quality-issue-profile-ref
+ | its-loc-quality-issue-enabled
+ | its-loc-quality-rating-score
+ | its-loc-quality-rating-vote
+ |
its-loc-quality-rating-score-threshold
+ |
its-loc-quality-rating-vote-threshold
+ |
its-loc-quality-rating-profile-ref
+ | its-mt-confidence
+ | its-allowed-characters
+ | its-storage-size
+ | its-storage-encoding
+ | its-line-break-type
+ | its-annotators-ref
+ )
+ {
+ string
+ }
+ embed.inner =
+ empty
+
+ common.elem.phrasing |= embed.elem
+
+## Generic Objects: <object>
+
+ object.elem.flow =
+ element object { object.inner.flow & object.attrs }
+ object.elem.phrasing =
+ element object { object.inner.phrasing & object.attrs }
+ object.attrs =
+ ( common.attrs
+ & ( ( object.attrs.data
+ & object.attrs.type?
+ )
+ | object.attrs.type
+ )
+ & object.attrs.typemustmatch?
+# & object.attrs.classid?
+# & object.attrs.codebase?
+# & object.attrs.codetype?
+ & object.attrs.height?
+ & object.attrs.width?
+ & object.attrs.usemap?
+ & object.attrs.name?
+ & common-form.attrs.form?
+ & ( common.attrs.aria.landmark.application
+ | common.attrs.aria.landmark.document
+ | common.attrs.aria.role.img
+ | common.attrs.aria.role.presentation
+ )?
+ )
+ object.attrs.data =
+ attribute data {
+ common.data.uri.non-empty
+ }
+ object.attrs.type =
+ attribute type {
+ common.data.mimetype
+ }
+ object.attrs.typemustmatch =
+ attribute typemustmatch {
+ w:string "typemustmatch" | w:string ""
+ } & v5only
+ object.attrs.height =
+ attribute height {
+ common.data.integer.non-negative
+ }
+ object.attrs.width =
+ attribute width {
+ common.data.integer.non-negative
+ }
+ object.attrs.usemap =
+ attribute usemap {
+ common.data.hash-name
+ }
+ object.attrs.name =
+ attribute name {
+ common.data.browsing-context
+ }
+ object.inner.flow =
+ ( param.elem*
+ , common.inner.transparent.flow
+ )
+ object.inner.phrasing =
+ ( param.elem*
+ , common.inner.phrasing
+ )
+
+ common.elem.flow |= object.elem.flow
+ common.elem.phrasing |= object.elem.phrasing
+
+## Initialization Parameters: <param>
+
+ param.elem =
+ element param { param.inner & param.attrs }
+ param.attrs =
+ ( common.attrs
+ & param.attrs.name
+ & param.attrs.value
+ & ( common.attrs.aria.role.presentation
+ | common.attrs.aria.role.menuitem
+ )?
+ )
+ param.attrs.name =
+ attribute name {
+ string
+ }
+ param.attrs.value =
+ attribute value {
+ string
+ }
+ param.inner =
+ ( empty )
+
+## Inline Frame: <iframe>
+
+ iframe.elem =
+ element iframe { iframe.inner & iframe.attrs }
+ iframe.attrs =
+ ( common.attrs
+ & iframe.attrs.src?
+ & iframe.attrs.srcdoc?
+ & iframe.attrs.name?
+ & iframe.attrs.width?
+ & iframe.attrs.height?
+ & iframe.attrs.sandbox?
+ & iframe.attrs.seamless?
+ & iframe.attrs.allowfullscreen?
+ & ( common.attrs.aria.landmark.application
+ | common.attrs.aria.landmark.document
+ | common.attrs.aria.role.img
+ | common.attrs.aria.role.presentation
+ )?
+ )
+ iframe.attrs.src =
+ attribute src {
+ common.data.uri.non-empty
+ }
+ iframe.attrs.srcdoc =
+ attribute srcdoc {
+ string #FIXME
+ }
+ iframe.attrs.name =
+ attribute name {
+ common.data.browsing-context
+ }
+ iframe.attrs.height =
+ attribute height {
+ common.data.integer.non-negative
+ }
+ iframe.attrs.width =
+ attribute width {
+ common.data.integer.non-negative
+ }
+ iframe.attrs.seamless =
+ attribute seamless {
+ w:string "seamless" | w:string ""
+ } & v5only
+ iframe.attrs.sandbox =
+ attribute sandbox {
+ common.data.sandbox-allow-list
+ } & v5only
+ iframe.attrs.allowfullscreen =
+ attribute allowfullscreen {
+ w:string "allowfullscreen" | w:string ""
+ } & v5only
+ iframe.inner =
+ ( ( text & HTMLonly ) | empty )
+
+ common.elem.phrasing |= iframe.elem
+
+#######################################################################
+## Image Maps
+
+## Map Definition: <map>
+
+ map.elem.flow =
+ element map { map.inner.flow & map.attrs }
+ map.elem.phrasing =
+ element map { map.inner.phrasing & map.attrs }
+ map.attrs =
+ ( common.attrs
+ & map.attrs.name
+ & ( common.attrs.aria.role.presentation
+ | common.attrs.aria.role.menuitem
+ )?
+ ) # REVISIT make id required in Schematron
+ map.attrs.name =
+ attribute name {
+ common.data.name
+ }
+ map.inner.flow =
+ ( common.inner.transparent.flow )
+ map.inner.phrasing =
+ ( common.inner.phrasing )
+
+ common.elem.flow |= map.elem.flow
+ common.elem.phrasing |= map.elem.phrasing
+
+## Map Area Definition: <area>
+
+ area.elem =
+ element area { area.inner & area.attrs }
+ area.attrs =
+ ( common.attrs.basic
+ & common.attrs.i18n
+ & common.attrs.present
+ & common.attrs.other
+ & shared-hyperlink.attrs.download?
+ & ( area.attrs.alt
+ & shared-hyperlink.attrs.href
+ )?
+ & shared-hyperlink.attrs.target?
+ & shared-hyperlink.attrs.ping?
+ & shared-hyperlink.attrs.rel?
+ & shared-hyperlink.attrs.hreflang?
+ & shared-hyperlink.attrs.type?
+ & area.attrs.shape?
+ & ( common.attrs.aria.role.link
+ | common.attrs.aria.role.presentation
+ | common.attrs.aria.role.menuitem
+ )?
+ )
+ area.attrs.alt =
+ attribute alt {
+ text
+ }
+ area.attrs.shape =
+ ( ( area.attrs.shape.rect? &
area.attrs.coords.rect )
+ | ( area.attrs.shape.circle &
area.attrs.coords.circle )
+ | ( area.attrs.shape.poly &
area.attrs.coords.poly )
+ | ( area.attrs.shape.default )
+ )
+ area.attrs.shape.rect =
+ attribute shape {
+ w:string "rect"
+ }
+ area.attrs.coords.rect =
+ attribute coords {
+ w:rectangle
+# xsd:token {
+# pattern =
"-?[0-9]+,-?[0-9]+,-?[0-9]+,-?[0-9]+"
+# }
+ }
+ area.attrs.shape.circle =
+ attribute shape {
+ w:string "circle"
+ }
+ area.attrs.coords.circle =
+ attribute coords {
+ w:circle
+# xsd:token {
+# pattern = "-?[0-9]+,-?[0-9]+,[0-9]+"
+# }
+ }
+ area.attrs.shape.poly =
+ attribute shape {
+ w:string "poly"
+ }
+ area.attrs.coords.poly =
+ attribute coords {
+ w:polyline
+# xsd:token {
+# pattern =
"-?[0-9]+,-?[0-9]+,-?[0-9]+,-?[0-9]+,-?[0-9]+,-?[0-9]+(,-?[0-9]+,-?[0-9]+)*"
+# }
+ }
+ area.attrs.shape.default =
+ attribute shape {
+ w:string "default"
+ }
+ area.inner =
+ ( empty )
+
+ common.elem.phrasing |= area.elem
+
+## Attributes Common to Embedded Content
+
+ embedded.content.attrs.crossorigin =
+ attribute crossorigin {
+ w:string "anonymous" | w:string
"use-credentials" | w:string ""
+ } & v5only
diff --git a/packages/html5-schema/form-datatypes.rnc
b/packages/html5-schema/form-datatypes.rnc
new file mode 100644
index 0000000..db719f9
--- /dev/null
+++ b/packages/html5-schema/form-datatypes.rnc
@@ -0,0 +1,63 @@
+datatypes w = "http://whattf.org/datatype-draft";
+
+# #####################################################################
+## RELAX NG Schema for HTML 5: Datatypes related to forms #
+# #####################################################################
+
+## MIME types
+
+ form.data.mimetypelist =
+ w:mime-type-list
+
+ form.data.charsetlist =
+ string # FIXME should be a "a space- and/or comma-delimited
+ # list of charset values"
+
+## ECMAScript Regular Expression
+
+ form.data.pattern =
+ w:pattern
+
+## Temporal
+
+ form.data.datetime-local =
+ w:datetime-local
+
+ form.data.date =
+ w:date
+
+ form.data.month =
+ w:month
+
+ form.data.week =
+ w:week
+
+ form.data.time =
+ w:time
+
+## Email
+
+ form.data.emailaddress =
+ w:email-address
+
+ form.data.emailaddresslist =
+ w:email-address-list
+
+## Color
+
+ form.data.color =
+ w:simple-color
+# xsd:string {
+# pattern = "#[a-fA-F0-9]{6}"
+# }
+
+## Text without line breaks
+
+ form.data.stringwithoutlinebreaks =
+ w:string-without-line-breaks
+
+## Non-empty string
+
+ form.data.nonemptystring =
+ w:non-empty-string
+
diff --git a/packages/html5-schema/html5-schema.el
b/packages/html5-schema/html5-schema.el
new file mode 100644
index 0000000..5fff760
--- /dev/null
+++ b/packages/html5-schema/html5-schema.el
@@ -0,0 +1,67 @@
+;;; html5-schema.el --- Add HTML5 schemas for use by nXML -*-
lexical-binding: t; -*-
+
+;; Copyright (C) 2016 Free Software Foundation, Inc
+
+;; Author: Stefan Monnier <address@hidden>
+;; Keywords: html, xml
+;; Version: 0.1
+;; URL: https://github.com/validator/validator
+;; Package-Type: multi
+
+;; 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:
+
+;; The RelaxNG files are taken straight from
+;; https://github.com/validator/validator.git's via:
+;;
+;; git subtree -P schema/html5 split
+;;
+;; To which we manually add `locating-rules.xml` and this file.
+
+;;; Code:
+
+;;;###autoload
+(when load-file-name
+ (let* ((dir (file-name-directory load-file-name))
+ (file (expand-file-name "locating-rules.xml" dir)))
+ (eval-after-load 'rng-loc
+ `(progn
+ (add-to-list 'rng-schema-locating-files-default 'file)
+ ;; FIXME: We should only push to rng-schema-locating-files-default,
+ ;; since rng-schema-locating-files is a custom var, but by the time
+ ;; we run, rng-schema-locating-files has already been initialized
+ ;; from rng-schema-locating-files-default, so setting
+ ;; rng-schema-locating-files-default doesn't have any effect
+ ;; any more!
+ (add-to-list 'rng-schema-locating-files ,file)
+ (put 'http://whattf.org/datatype-draft 'rng-dt-compile
+ #'nxml-html5-dt-compile)))))
+
+;;;###autoload
+(add-to-list 'auto-mode-alist '("\\.html?\\'" . nxml-mode))
+
+(defvar nxml-html5-dt-params nil)
+(defvar nxml-html5-dt-names nil)
+
+;;;###autoload
+(defun nxml-html5-dt-compile (name params)
+ ;; FIXME: How/when is `params' ever used? It seems to always be nil!
+ (add-to-list 'nxml-html5-dt-params params)
+ (add-to-list 'nxml-html5-dt-names name)
+ ;; FIXME: We currently don't do any actual validation of datatypes!
+ '(t identity))
+
+(provide 'html5-schema)
+;;; html5-schema.el ends here
diff --git a/packages/html5-schema/html5.rnc b/packages/html5-schema/html5.rnc
new file mode 100644
index 0000000..0d8cef8
--- /dev/null
+++ b/packages/html5-schema/html5.rnc
@@ -0,0 +1,56 @@
+default namespace = "http://www.w3.org/1999/xhtml";
+# #####################################################################
+## RELAX NG Schema for HTML 5 #
+# #####################################################################
+
+ # To validate an HTML 5 document, you must first validate against #
+ # this schema and then ALSO validate against assertions.sch #
+
+ ## HTML flavor RELAX NG schemas can only be used after the #
+ ## document has been transformed to well-formed XML. #
+ ## - Insert closing slashes in all empty element tags #
+ ## - Insert all optional start and end tags #
+ ## - Add xmlns "http://www.w3.org/1999/xhtml"; #
+ ## - Properly escape <script> and <style> CDATA #
+ ## - Parse and transform all HTML-only entities to numeric #
+ ## character references #
+ ## Obviously, syntax-checking involving these features cannot be #
+ ## done by the RELAX NG schema and must be checked, along with the #
+ ## <!DOCTYPE> requirement, by some other application. #
+
+# #####################################################################
+## Schema Framework & Parameters
+
+include "common.rnc" {
+ # XHTML flavor #
+ XMLonly = notAllowed
+ HTMLonly = empty
+ # HTML 4 compat #
+ v5only = empty
+ # HTML-serializability #
+ nonHTMLizable = notAllowed
+ # HTML-roundtrippability #
+ nonRoundtrippable = notAllowed
+}
+
+# #####################################################################
+## Language Definitions
+
+start = html.elem
+
+include "meta.rnc"
+include "phrase.rnc"
+include "block.rnc"
+include "sectional.rnc"
+include "structural.rnc"
+include "revision.rnc"
+include "embed.rnc"
+include "ruby.rnc"
+include "media.rnc"
+include "core-scripting.rnc"
+include "tables.rnc"
+include "form-datatypes.rnc"
+include "web-forms.rnc"
+include "web-forms2.rnc"
+include "applications.rnc"
+include "data.rnc"
diff --git a/packages/html5-schema/html5exclusions.rnc
b/packages/html5-schema/html5exclusions.rnc
new file mode 100644
index 0000000..1fa0915
--- /dev/null
+++ b/packages/html5-schema/html5exclusions.rnc
@@ -0,0 +1,63 @@
+default namespace = "http://www.w3.org/1999/xhtml";
+# #####################################################################
+## RELAX NG Schema for (X)HTML 5: Exclusions #
+# #####################################################################
+
+ ## This file is unmaintained. Please use assertions.sch instead.
+
+# #####################################################################
+## Schema Framework & Parameters
+
+ start = normal.elem.all-inclusive
+
+# #####################################################################
+## Normal Element Patterns
+
+## Any attribute from any namespace
+
+ normal.attr.anything =
+ attribute * { text }*
+
+## Any element from any namespace except exceptional elements,
+## but allowing those elements as descendants
+
+ normal.elem.all =
+ element * - (dfn) {
+ normal.elem.all-inclusive
+ }
+
+## Any element from any namespace including exceptional elements
+
+ normal.elem.all-inclusive =
+ wildcard.elem.exclude-all | dfn.elem.exclude-self
+
+
+# #####################################################################
+## Exclusion Element Patterns
+
+ # exclude all exceptional elements from the name classes;
+ # list them explicitly in content models instead
+
+normal.elem.exclude-dfn =
+ element * - (dfn) {
+ normal.elem.exclude-dfn
+ }
+
+dfn.elem.exclude-self =
+ element dfn {
+ ( normal.attr.anything
+ & normal.elem.exclude-dfn
+ )
+ }
+
+# FIXME this part was cut off -- hsivonen
+wildcard.elem.exclude-all =
+ notAllowed
+
+#FIXME no nested forms in HTML-serializable docs
+
+#FIXME no nested labels
+
+#FIXME no blockquote inside header or footer
+
+#FIXME exactly one hn in header
diff --git a/packages/html5-schema/locating-rules.xml
b/packages/html5-schema/locating-rules.xml
new file mode 100644
index 0000000..86b2bb1
--- /dev/null
+++ b/packages/html5-schema/locating-rules.xml
@@ -0,0 +1,9 @@
+<!-- <?xml version="1.0"?> -->
+<locatingRules xmlns="http://thaiopensource.com/ns/locating-rules/1.0";>
+ <uri pattern="*.html" typeId="HTML5" />
+ <uri pattern="*.xhtml" typeId="XHTML5" />
+ <namespace ns="http://www.w3.org/1999/xhtml"; typeId="XHTML5"/>
+ <documentElement localName="html" typeId="HTML5" />
+ <typeId id="XHTML5" uri="xhtml5.rnc" />
+ <typeId id="HTML5" uri="html5.rnc" />
+</locatingRules>
diff --git a/packages/html5-schema/media.rnc b/packages/html5-schema/media.rnc
new file mode 100644
index 0000000..28cbb63
--- /dev/null
+++ b/packages/html5-schema/media.rnc
@@ -0,0 +1,210 @@
+datatypes w = "http://whattf.org/datatype-draft";
+
+# #####################################################################
+## RELAX NG Schema for HTML 5: Advanced Embedded Content #
+# #####################################################################
+
+## Attributes Common to Media Elements
+
+ # src not included
+ media.attrs =
+ ( media.attrs.autoplay?
+ & media.attrs.preload?
+ & media.attrs.controls?
+ & media.attrs.loop?
+ & media.attrs.mediagroup?
+ & media.attrs.muted?
+ & embedded.content.attrs.crossorigin?
+ )
+ media.attrs.autoplay =
+ attribute autoplay {
+ w:string "autoplay" | w:string ""
+ }
+ media.attrs.preload =
+ attribute preload {
+ w:string "none" | w:string "metadata" |
w:string "auto" | w:string ""
+ }
+ media.attrs.controls =
+ attribute controls {
+ w:string "controls" | w:string ""
+ }
+ media.attrs.loop =
+ attribute loop {
+ w:string "loop" | w:string ""
+ }
+ media.attrs.mediagroup =
+ attribute mediagroup {
+ string
+ }
+ media.attrs.muted =
+ attribute muted {
+ w:string "muted" | w:string ""
+ }
+
+## Source: <source>
+
+ source.elem =
+ element source { source.inner & source.attrs }
+ source.attrs =
+ ( common.attrs
+ & source.attrs.src
+ & source.attrs.type?
+ & ( common.attrs.aria.role.presentation
+ | common.attrs.aria.role.menuitem
+ )?
+ )
+ source.attrs.src =
+ attribute src {
+ common.data.uri.non-empty
+ }
+ source.attrs.type =
+ attribute type {
+ common.data.mimetype
+ }
+ source.inner =
+ ( empty )
+
+## Media Source
+
+ media.source =
+ ( media.attrs.src
+ | source.elem*
+ )
+
+ media.attrs.src =
+ attribute src {
+ common.data.uri.non-empty
+ }
+
+## Video: <video>
+
+ video.elem.flow =
+ element video { video.inner.flow & video.attrs }
+ video.elem.phrasing =
+ element video { video.inner.phrasing & video.attrs }
+ video.attrs =
+ ( common.attrs
+ & media.attrs
+ & video.attrs.poster?
+ & video.attrs.height?
+ & video.attrs.width?
+ & common.attrs.aria.landmark.application?
+ )
+ video.attrs.poster =
+ attribute poster {
+ common.data.uri.non-empty
+ }
+ video.attrs.height =
+ attribute height {
+ common.data.integer.non-negative
+ }
+ video.attrs.width =
+ attribute width {
+ common.data.integer.non-negative
+ }
+ video.inner.flow =
+ ( media.source
+ , track.elem*
+ , common.inner.transparent.flow
+ )
+ video.inner.phrasing =
+ ( media.source
+ , track.elem*
+ , common.inner.phrasing
+ )
+
+ common.elem.flow |= video.elem.flow
+ common.elem.phrasing |= video.elem.phrasing
+
+## Audio: <audio>
+
+ audio.elem.flow =
+ element audio { audio.inner.flow & audio.attrs }
+ audio.elem.phrasing =
+ element audio { audio.inner.phrasing & audio.attrs }
+ audio.attrs =
+ ( common.attrs
+ & media.attrs
+ & common.attrs.aria.landmark.application?
+ )
+ audio.inner.flow =
+ ( media.source
+ , track.elem*
+ , common.inner.transparent.flow
+ )
+ audio.inner.phrasing =
+ ( media.source
+ , track.elem*
+ , common.inner.phrasing
+ )
+
+ common.elem.flow |= audio.elem.flow
+ common.elem.phrasing |= audio.elem.phrasing
+
+## supplementary media track: <track>
+#
+ track.elem =
+ element track { track.inner & track.attrs }
+
+ track.attrs =
+ ( common.attrs
+ & track.attrs.kind?
+ & track.attrs.src
+ & track.attrs.srclang?
+ & track.attrs.label?
+ & track.attrs.default?
+ & ( common.attrs.aria.role.presentation
+ | common.attrs.aria.role.menuitem
+ )?
+ )
+ track.attrs.kind =
+ attribute kind {
+ w:string "subtitles" | w:string "captions" |
w:string "descriptions" | w:string "chapters" | w:string "metadata"
+ }
+ track.attrs.src =
+ attribute src {
+ common.data.uri.non-empty
+ }
+ track.attrs.srclang =
+ attribute srclang {
+ common.data.langcode
+ }
+ track.attrs.label =
+ attribute label {
+ string # must be non-empty value; check is in
assertions code
+ }
+ track.attrs.default =
+ attribute default {
+ w:string "default" | w:string ""
+ }
+
+ track.inner =
+ ( empty )
+
+## Captioned Content: <figure>
+
+ figure.elem =
+ element figure { figure.inner & figure.attrs }
+ figure.attrs =
+ ( common.attrs
+ & common.attrs.aria?
+ )
+ figure.inner =
+ ( ( figcaption.elem?, common.inner.flow )
+ | ( common.inner.flow, figcaption.elem? )
+ )
+
+ common.elem.flow |= figure.elem
+
+## Figure caption: <figcaption>
+
+ figcaption.elem =
+ element figcaption { figcaption.inner & figcaption.attrs }
+ figcaption.attrs =
+ ( common.attrs
+ & ( common.attrs.aria.role.presentation
+ | common.attrs.aria.role.menuitem
+ )?
+ )
+ figcaption.inner =
+ ( common.inner.flow )
diff --git a/packages/html5-schema/meta.rnc b/packages/html5-schema/meta.rnc
new file mode 100644
index 0000000..ff67c2d
--- /dev/null
+++ b/packages/html5-schema/meta.rnc
@@ -0,0 +1,424 @@
+datatypes w = "http://whattf.org/datatype-draft";
+
+# #####################################################################
+## RELAX NG Schema for HTML 5: Global Structure & Metadata #
+# #####################################################################
+
+## Root Element: <html>
+
+ html.elem =
+ element html { html.inner & html.attrs }
+ html.attrs =
+ ( common.attrs
+ & ( common.attrs.aria.role.presentation
+ | common.attrs.aria.role.menuitem
+ )?
+ )
+ html.inner =
+ ( head.elem
+ , body.elem
+ )
+
+## Metadata Container: <head>
+
+ head.elem =
+ element head { head.inner & head.attrs }
+ head.attrs =
+ ( common.attrs
+# & head.attrs.profile?
+ & ( common.attrs.aria.role.presentation
+ | common.attrs.aria.role.menuitem
+ )?
+ )
+# head.attrs.profile =
+# attribute profile {
+# common.data.uris #REVISIT should these be
absolute (zero or more)
+# }
+ head.inner =
+ ( title.elem
+ & base.elem? # REVISIT need a non-schema checker or
Schematron
+ & common.inner.metadata # Limit encoding decl position in
Schematron
+ )
+# head.inner =
+# ( meta.elem.encoding?
+# , ( title.elem
+# & base.elem? # REVISIT need a non-schema checker
or Schematron
+# & common.inner.metadata
+# )
+# )
+
+## Content Container: <body>
+
+ body.elem =
+ element body { body.inner & body.attrs }
+ body.attrs =
+ ( common.attrs
+ & ( common.attrs.aria.landmark.application
+ | common.attrs.aria.landmark.document
+ | common.attrs.aria.role.presentation
+ | common.attrs.aria.implicit.document
+ )?
+ & body.attrs.onafterprint?
+ & body.attrs.onbeforeprint?
+ & body.attrs.onbeforeunload?
+ & body.attrs.onhashchange?
+ & body.attrs.onmessage?
+ & body.attrs.onoffline?
+ & body.attrs.ononline?
+ & body.attrs.onpagehide?
+ & body.attrs.onpageshow?
+ & body.attrs.onpopstate?
+ & body.attrs.onstorage?
+ & body.attrs.onunload?
+ )
+ body.inner =
+ ( common.inner.flow )
+
+ body.attrs.onafterprint =
+ attribute onafterprint { common.data.functionbody }
+ body.attrs.onbeforeprint =
+ attribute onbeforeprint { common.data.functionbody }
+ body.attrs.onbeforeunload =
+ attribute onbeforeunload { common.data.functionbody }
+ body.attrs.onhashchange =
+ attribute onhashchange { common.data.functionbody }
+ body.attrs.onmessage =
+ attribute onmessage { common.data.functionbody }
+ body.attrs.onoffline =
+ attribute onoffline { common.data.functionbody }
+ body.attrs.ononline =
+ attribute ononline { common.data.functionbody }
+ body.attrs.onpopstate =
+ attribute onpopstate { common.data.functionbody }
+ body.attrs.onpagehide =
+ attribute onpagehide { common.data.functionbody }
+ body.attrs.onpageshow =
+ attribute onpageshow { common.data.functionbody }
+ body.attrs.onredo =
+ attribute onredo { common.data.functionbody }
+ body.attrs.onresize =
+ attribute onresize { common.data.functionbody }
+ body.attrs.onstorage =
+ attribute onstorage { common.data.functionbody }
+ body.attrs.onundo =
+ attribute onundo { common.data.functionbody }
+ body.attrs.onunload =
+ attribute onunload { common.data.functionbody }
+
+## Document Title: <title>
+
+ title.elem =
+ element title { title.inner & title.attrs }
+ title.attrs =
+ ( common.attrs
+ & ( common.attrs.aria.role.presentation
+ | common.attrs.aria.role.menuitem
+ )?
+ )
+ title.inner =
+ ( text )
+
+## Base URI: <base>
+
+ base.elem =
+ element base { base.inner & base.attrs }
+ base.attrs =
+ ( common.attrs.basic
+ & common.attrs.i18n
+ & common.attrs.present
+ & common.attrs.other
+ & ( ( base.attrs.href
+ & base.attrs.target?
+ )
+ | base.attrs.target
+ )
+ & ( common.attrs.aria.role.presentation
+ | common.attrs.aria.role.menuitem
+ )?
+ )
+ base.attrs.href =
+ attribute href {
+ common.data.uri
+ }
+ base.attrs.target =
+ attribute target {
+ common.data.browsing-context-or-keyword
+ }
+ base.inner =
+ ( empty )
+
+## Global Relationships: <link>
+
+ link.elem =
+ element link { link.inner & link.attrs }
+ link.attrs =
+ ( common.attrs.basic
+ & common.attrs.i18n
+ & common.attrs.present
+ & common.attrs.other
+ & link.attrs.href
+ & link.attrs.rel
+ & link.attrs.integrity?
+ & shared-hyperlink.attrs.hreflang?
+ & shared-hyperlink.attrs.media?
+ & shared-hyperlink.attrs.type?
+ & link.attrs.sizes?
+ # link.attrs.title included in common.attrs
+ & embedded.content.attrs.crossorigin?
+ & ( common.attrs.aria.role.link
+ | common.attrs.aria.role.presentation
+ | common.attrs.aria.role.menuitem
+ )?
+ )
+ link.attrs.href =
+ attribute href {
+ common.data.uri.non-empty
+ }
+ link.attrs.rel =
+ attribute rel {
+ w:link-rel
+ }
+ link.attrs.integrity =
+ attribute integrity {
+ common.data.integrity
+ }
+ link.attrs.sizes =
+ attribute sizes {
+ w:string "any" | common.data.sizes
+ }
+ link.inner =
+ ( empty )
+
+ common.elem.metadata |= link.elem
+
+## Global Style: <style>
+
+ style.elem =
+ element style { style.inner & style.attrs }
+ style.attrs =
+ ( common.attrs
+ & style.attrs.type?
+ & style.attrs.media?
+ & style.attrs.nonce?
+ # style.attrs.title included in common.attrs
+ & ( common.attrs.aria.role.presentation
+ | common.attrs.aria.role.menuitem
+ )?
+ )
+ style.attrs.type =
+ attribute type {
+ common.data.mimetype
+ }
+ style.attrs.media =
+ attribute media {
+ common.data.mediaquery
+ }
+ style.attrs.nonce =
+ attribute nonce{
+ string
+ }
+ style.inner =
+ ( common.inner.anything )
+
+ common.elem.metadata |= style.elem
+
+## Scoped Style: <style scoped>
+
+ style.elem.scoped =
+ element style { style.inner & style.scoped.attrs }
+ style.scoped.attrs =
+ ( common.attrs
+ & style.attrs.type?
+ & style.attrs.media?
+ & style.attrs.scoped
+ # style.attrs.title included in common.attrs
+ & ( common.attrs.aria.role.presentation
+ | common.attrs.aria.role.menuitem
+ )?
+ )
+ style.attrs.scoped =
+ attribute scoped {
+ w:string "scoped" | w:string ""
+ }
+
+## Name-Value Metadata: <meta name>
+
+ meta.name.elem =
+ element meta { meta.inner & meta.name.attrs }
+ meta.name.attrs =
+ ( common.attrs.basic
+ & common.attrs.i18n
+ & common.attrs.present
+ & common.attrs.other
+ & meta.name.attrs.name
+ & meta.name.attrs.content
+ & ( common.attrs.aria.role.presentation
+ | common.attrs.aria.role.menuitem
+ )?
+ )
+ meta.name.attrs.name =
+ attribute name {
+ w:non-empty-string
+ }
+ meta.name.attrs.content =
+ attribute content {
+ string
+ }
+ meta.inner =
+ ( empty )
+
+ common.elem.metadata |= meta.name.elem
+
+## "refresh" pragma directive: <meta http-equiv='refresh'>
+
+ meta.http-equiv.refresh.elem =
+ element meta { meta.inner & meta.http-equiv.refresh.attrs }
+ meta.http-equiv.refresh.attrs =
+ ( common.attrs.basic
+ & common.attrs.i18n
+ & common.attrs.present
+ & common.attrs.other
+ & meta.http-equiv.attrs.http-equiv.refresh
+ & meta.http-equiv.attrs.content.refresh
+ & ( common.attrs.aria.role.presentation
+ | common.attrs.aria.role.menuitem
+ )?
+ )
+ meta.http-equiv.attrs.http-equiv.refresh =
+ attribute http-equiv {
+ w:string "refresh"
+ }
+ meta.http-equiv.attrs.content.refresh =
+ attribute content {
+ common.data.refresh
+ }
+ common.elem.metadata |= meta.http-equiv.refresh.elem # not quite right
per spec
+ # if the definition is
+ # reused in another
language
+
+## "default-style" pragma directive: <meta http-equiv='default-style'>
+
+ meta.http-equiv.default-style.elem =
+ element meta { meta.inner & meta.http-equiv.default-style.attrs
}
+ meta.http-equiv.default-style.attrs =
+ ( common.attrs.basic
+ & common.attrs.i18n
+ & common.attrs.present
+ & common.attrs.other
+ & meta.http-equiv.attrs.http-equiv.default-style
+ & meta.http-equiv.attrs.content.default-style
+ & ( common.attrs.aria.role.presentation
+ | common.attrs.aria.role.menuitem
+ )?
+ )
+ meta.http-equiv.attrs.http-equiv.default-style =
+ attribute http-equiv {
+ w:string "default-style"
+ }
+ meta.http-equiv.attrs.content.default-style =
+ attribute content {
+ common.data.default-style
+ }
+
+ common.elem.metadata |= meta.http-equiv.default-style.elem # not quite
right per spec
+ # if the
definition is
+ # reused in
another language
+
+## Content Security Policy pragma directive: <meta
http-equiv='content-security-policy'>
+
+ meta.http-equiv.content-security-policy.elem =
+ element meta { meta.inner &
meta.http-equiv.content-security-policy.attrs }
+ meta.http-equiv.content-security-policy.attrs =
+ ( common.attrs.basic
+ & common.attrs.i18n
+ & common.attrs.present
+ & common.attrs.other
+ & meta.http-equiv.attrs.http-equiv.content-security-policy
+ & meta.http-equiv.attrs.content.content-security-policy
+ & ( common.attrs.aria.role.presentation
+ | common.attrs.aria.role.menuitem
+ )?
+ )
+ meta.http-equiv.attrs.http-equiv.content-security-policy =
+ attribute http-equiv {
+ w:string "content-security-policy"
+ }
+ meta.http-equiv.attrs.content.content-security-policy =
+ attribute content {
+ common.data.content-security-policy
+ }
+ common.elem.metadata |= meta.http-equiv.content-security-policy.elem
+
+## "x-ua-compatible" pragma directive: <meta http-equiv='x-ua-compatible'>
+
+ meta.http-equiv.x-ua-compatible.elem =
+ element meta { meta.inner &
meta.http-equiv.x-ua-compatible.attrs }
+ meta.http-equiv.x-ua-compatible.attrs =
+ ( common.attrs.basic
+ & common.attrs.i18n
+ & common.attrs.present
+ & common.attrs.other
+ & meta.http-equiv.attrs.http-equiv.x-ua-compatible
+ & meta.http-equiv.attrs.content.x-ua-compatible
+ & ( common.attrs.aria.role.presentation
+ | common.attrs.aria.role.menuitem
+ )?
+ )
+ meta.http-equiv.attrs.http-equiv.x-ua-compatible =
+ attribute http-equiv {
+ w:string "x-ua-compatible"
+ }
+ meta.http-equiv.attrs.content.x-ua-compatible =
+ attribute content {
+ common.data.x-ua-compatible
+ }
+ common.elem.metadata |= meta.http-equiv.x-ua-compatible.elem
+
+## Inline Character Encoding Statement for HTML: <meta charset>
+
+ meta.charset.elem =
+ element meta { meta.inner & meta.charset.attrs }
+ meta.charset.attrs =
+ ( common.attrs.basic
+ & common.attrs.i18n
+ & common.attrs.present
+ & common.attrs.other
+ & meta.charset.attrs.charset
+ & ( common.attrs.aria.role.presentation
+ | common.attrs.aria.role.menuitem
+ )?
+ )
+ meta.charset.attrs.charset =
+ attribute charset {
+ (common.data.charset & HTMLonly)
+ | (xsd:string {
+ pattern = "[uU][tT][fF]-8"
+ } & XMLonly )
+ }
+
+## Inline Character Encoding Statement for HTML: <meta
http-equiv='content-type'>
+
+ meta.http-equiv.content-type.elem =
+ element meta { meta.inner & meta.http-equiv.content-type.attrs }
+ & HTMLonly
+ meta.http-equiv.content-type.attrs =
+ ( common.attrs.basic
+ & common.attrs.i18n
+ & common.attrs.present
+ & common.attrs.other
+ & meta.http-equiv.attrs.http-equiv.content-type
+ & meta.http-equiv.attrs.content.content-type
+ & ( common.attrs.aria.role.presentation
+ | common.attrs.aria.role.menuitem
+ )?
+ )
+ meta.http-equiv.attrs.http-equiv.content-type =
+ attribute http-equiv {
+ w:string "content-type"
+ }
+ meta.http-equiv.attrs.content.content-type =
+ attribute content {
+ common.data.meta-charset
+ }
+
+ common.elem.metadata |= ( meta.charset.elem |
meta.http-equiv.content-type.elem )
diff --git a/packages/html5-schema/microdata.rnc
b/packages/html5-schema/microdata.rnc
new file mode 100644
index 0000000..91616c8
--- /dev/null
+++ b/packages/html5-schema/microdata.rnc
@@ -0,0 +1,101 @@
+datatypes w = "http://whattf.org/datatype-draft";
+
+# #####################################################################
+## RELAX NG Schema for HTML 5: Microdata #
+# #####################################################################
+
+common.attrs.microdata =
+ ( common.attrs.microdata.itemref?
+ & common.attrs.microdata.itemprop?
+ & common.attrs.microdata.itemscope?
+ & common.attrs.microdata.itemtype?
+ & common.attrs.microdata.itemid?
+ )
+ common.attrs.microdata.itemref =
+ attribute itemref {
+ common.data.idrefs
+ }
+ common.attrs.microdata.itemprop =
+ attribute itemprop {
+ common.data.microdata-properties
+ }
+ common.attrs.microdata.itemscope =
+ attribute itemscope {
+ w:string "itemscope" | w:string ""
+ }
+ common.attrs.microdata.itemtype =
+ attribute itemtype {
+ list { common.data.uri.absolute+ }
+ }
+ common.attrs.microdata.itemid =
+ attribute itemid {
+ common.data.uri
+ }
+
+common.attrs &= common.attrs.microdata
+
+a.attrs &= common.attrs.microdata
+area.attrs &= common.attrs.microdata
+base.attrs &= common.attrs.microdata
+
+## URL-valued Property Metadata: <link itemprop>
+
+ link.elem.phrasing =
+ element link { link.inner & link.phrasing.attrs }
+ link.phrasing.attrs =
+ ( common.attrs.basic
+ & common.attrs.i18n
+ & common.attrs.present
+ & common.attrs.other
+ & common.attrs.microdata.itemprop
+ & common.attrs.microdata.itemref?
+ & common.attrs.microdata.itemscope?
+ & common.attrs.microdata.itemtype?
+ & common.attrs.microdata.itemid?
+ & shared-hyperlink.attrs.href
+ & shared-hyperlink.attrs.hreflang?
+ & shared-hyperlink.attrs.media?
+ & shared-hyperlink.attrs.type?
+ & link.attrs.sizes?
+ # link.attrs.title included in common.attrs
+ & embedded.content.attrs.crossorigin?
+ & ( common.attrs.aria.role.link
+ | common.attrs.aria.role.presentation
+ | common.attrs.aria.role.menuitem
+ )?
+ )
+ common.elem.phrasing |= link.elem.phrasing
+
+## <link> element in head, extensions
+
+link.attrs.rel |= common.attrs.microdata.itemprop
+link.attrs &= common.attrs.microdata.itemref?
+link.attrs &= common.attrs.microdata.itemscope?
+link.attrs &= common.attrs.microdata.itemtype?
+link.attrs &= common.attrs.microdata.itemid?
+
+## Property Metadata: <meta itemprop>
+
+ meta.itemprop.elem =
+ element meta { meta.inner & meta.itemprop.attrs }
+ meta.itemprop.attrs =
+ ( common.attrs.basic
+ & common.attrs.i18n
+ & common.attrs.present
+ & common.attrs.other
+ & common.attrs.microdata.itemprop
+ & common.attrs.microdata.itemref?
+ & common.attrs.microdata.itemscope?
+ & common.attrs.microdata.itemtype?
+ & common.attrs.microdata.itemid?
+ & meta.itemprop.attrs.content
+ & ( common.attrs.aria.role.presentation
+ | common.attrs.aria.role.menuitem
+ )?
+ )
+ meta.itemprop.attrs.content =
+ attribute content {
+ string
+ }
+ common.elem.metadata |= meta.itemprop.elem
+ common.elem.phrasing |= meta.itemprop.elem
diff --git a/packages/html5-schema/phrase.rnc b/packages/html5-schema/phrase.rnc
new file mode 100644
index 0000000..f8fa725
--- /dev/null
+++ b/packages/html5-schema/phrase.rnc
@@ -0,0 +1,400 @@
+datatypes w = "http://whattf.org/datatype-draft";
+
+# #####################################################################
+## RELAX NG Schema for HTML 5: Phrase Markup #
+# #####################################################################
+
+## Contextual Hyperlink: <a>
+
+ a.elem.phrasing =
+ element a { a.inner.phrasing & a.attrs }
+ a.elem.flow =
+ element a { a.inner.flow & a.attrs }
+ a.attrs =
+ ( common.attrs.basic
+ & common.attrs.i18n
+ & common.attrs.present
+ & common.attrs.other
+ & a.attrs.name?
+ & shared-hyperlink.attrs.download?
+ & shared-hyperlink.attrs.href?
+ & shared-hyperlink.attrs.target?
+ & shared-hyperlink.attrs.rel?
+ & shared-hyperlink.attrs.hreflang?
+ & shared-hyperlink.attrs.type?
+ & shared-hyperlink.attrs.ping?
+ & ( common.attrs.aria.implicit.link
+ | common.attrs.aria.role.button
+ | common.attrs.aria.role.checkbox
+ | common.attrs.aria.role.link
+ | common.attrs.aria.role.menuitem
+ | common.attrs.aria.role.menuitemcheckbox
+ | common.attrs.aria.role.menuitemradio
+ | common.attrs.aria.role.switch
+ | common.attrs.aria.role.tab
+ | common.attrs.aria.role.treeitem
+ )?
+ )
+ a.attrs.name =
+ attribute name {
+ common.data.id # XXX not what the spec says
+ }
+ a.inner.phrasing =
+ ( common.inner.phrasing )
+ a.inner.flow =
+ ( common.inner.transparent.flow )
+
+ common.elem.phrasing |= a.elem.phrasing
+ common.elem.flow |= a.elem.flow
+
+## Shared hyperlink attributes
+
+ shared-hyperlink.attrs.download =
+ attribute download {
+ string
+ }
+ shared-hyperlink.attrs.href =
+ attribute href {
+ common.data.uri
+ }
+ shared-hyperlink.attrs.target =
+ attribute target {
+ common.data.browsing-context-or-keyword
+ }
+ shared-hyperlink.attrs.rel =
+ attribute rel {
+ w:a-rel
+ }
+ shared-hyperlink.attrs.hreflang =
+ attribute hreflang {
+ common.data.langcode
+ }
+ shared-hyperlink.attrs.media =
+ attribute media {
+ common.data.mediaquery
+ }
+ shared-hyperlink.attrs.type =
+ attribute type {
+ common.data.mimetype
+ }
+ shared-hyperlink.attrs.ping =
+ attribute ping {
+ common.data.uris
+ } & v5only
+
+## Emphatic Stress: <em>
+
+ em.elem =
+ element em { em.inner & em.attrs }
+ em.attrs =
+ ( common.attrs
+ & common.attrs.aria?
+ )
+ em.inner =
+ ( common.inner.phrasing )
+
+ common.elem.phrasing |= em.elem
+
+## Strong Importance: <strong>
+
+ strong.elem =
+ element strong { strong.inner & strong.attrs }
+ strong.attrs =
+ ( common.attrs
+ & common.attrs.aria?
+ )
+ strong.inner =
+ ( common.inner.phrasing )
+
+ common.elem.phrasing |= strong.elem
+
+## Small Print and Side Comments: <small>
+
+ small.elem =
+ element small { small.inner & small.attrs }
+ small.attrs =
+ ( common.attrs
+ & common.attrs.aria?
+ )
+ small.inner =
+ ( common.inner.phrasing )
+
+ common.elem.phrasing |= small.elem
+
+## Marked (Highlighted) Text: <mark>
+
+ mark.elem =
+ element mark { mark.inner & mark.attrs }
+ & v5only
+ mark.attrs =
+ ( common.attrs
+ & ( common.attrs.aria.role.presentation
+ | common.attrs.aria.role.menuitem
+ )?
+ )
+ mark.inner =
+ ( common.inner.phrasing )
+
+ common.elem.phrasing |= mark.elem
+
+## Abbreviation: <abbr>
+
+ abbr.elem =
+ element abbr { abbr.inner & abbr.attrs }
+ abbr.attrs =
+ ( common.attrs
+ # abbr.attrs.title included in common.attrs
+ & common.attrs.aria?
+ )
+ abbr.inner =
+ ( common.inner.phrasing )
+
+ common.elem.phrasing |= abbr.elem
+
+## Defining Instance: <dfn>
+
+ dfn.elem =
+ element dfn { dfn.inner & dfn.attrs }
+ dfn.attrs =
+ ( common.attrs
+ # dfn.attrs.title included in common.attrs
+ & common.attrs.aria?
+ )
+ dfn.inner =
+ ( common.inner.phrasing )
+
+ common.elem.phrasing |= dfn.elem
+
+## Italic: <i>
+
+ i.elem =
+ element i { i.inner & i.attrs }
+ i.attrs =
+ ( common.attrs
+ & common.attrs.aria?
+ )
+ i.inner =
+ ( common.inner.phrasing )
+
+ common.elem.phrasing |= i.elem
+
+## Bold: <b>
+
+ b.elem =
+ element b { b.inner & b.attrs }
+ b.attrs =
+ ( common.attrs
+ & common.attrs.aria?
+ )
+ b.inner =
+ ( common.inner.phrasing )
+
+ common.elem.phrasing |= b.elem
+
+## Struck Text: <s>
+
+ s.elem =
+ element s { s.inner & s.attrs }
+ s.attrs =
+ ( common.attrs
+ & common.attrs.aria?
+ )
+ s.inner =
+ ( common.inner.phrasing )
+
+ common.elem.phrasing |= s.elem
+
+## Underline: <u>
+
+ u.elem =
+ element u { u.inner & u.attrs }
+ u.attrs =
+ ( common.attrs
+ & common.attrs.aria?
+ )
+ u.inner =
+ ( common.inner.phrasing )
+
+ common.elem.phrasing |= u.elem
+
+## Code Fragment: <code>
+
+ code.elem =
+ element code { code.inner & code.attrs }
+ code.attrs =
+ ( common.attrs
+ & common.attrs.aria?
+ )
+ code.inner =
+ ( common.inner.phrasing )
+
+ common.elem.phrasing |= code.elem
+
+## Variable or Placeholder: <var>
+
+ var.elem =
+ element var { var.inner & var.attrs }
+ var.attrs =
+ ( common.attrs
+ & common.attrs.aria?
+ )
+ var.inner =
+ ( common.inner.phrasing )
+
+ common.elem.phrasing |= var.elem
+
+## (Sample) Output: <samp>
+
+ samp.elem =
+ element samp { samp.inner & samp.attrs }
+ samp.attrs =
+ ( common.attrs
+ & common.attrs.aria?
+ )
+ samp.inner =
+ ( common.inner.phrasing )
+
+ common.elem.phrasing |= samp.elem
+
+## User Input: <kbd>
+
+ kbd.elem =
+ element kbd { kbd.inner & kbd.attrs }
+ kbd.attrs =
+ ( common.attrs
+ & common.attrs.aria?
+ )
+ kbd.inner =
+ ( common.inner.phrasing )
+
+ common.elem.phrasing |= kbd.elem
+
+## Superscript: <sup>
+
+ sup.elem =
+ element sup { sup.inner & sup.attrs }
+ sup.attrs =
+ ( common.attrs
+ & common.attrs.aria?
+ )
+ sup.inner =
+ ( common.inner.phrasing )
+
+ common.elem.phrasing |= sup.elem
+
+## Subscript: <sub>
+
+ sub.elem =
+ element sub { sub.inner & sub.attrs }
+ sub.attrs =
+ ( common.attrs
+ & common.attrs.aria?
+ )
+ sub.inner =
+ ( common.inner.phrasing )
+
+ common.elem.phrasing |= sub.elem
+
+## Quotation: <q>
+
+ q.elem =
+ element q { q.inner & q.attrs }
+ q.attrs =
+ ( common.attrs
+ & q.attrs.cite?
+ & common.attrs.aria?
+ )
+ q.attrs.cite =
+ attribute cite {
+ common.data.uri
+ }
+ q.inner =
+ ( common.inner.phrasing )
+
+ common.elem.phrasing |= q.elem
+
+## Title of Work: <cite>
+
+ cite.elem =
+ element cite { cite.inner & cite.attrs }
+ cite.attrs =
+ ( common.attrs
+ & common.attrs.aria?
+ )
+ cite.inner =
+ ( common.inner.phrasing )
+
+ common.elem.phrasing |= cite.elem
+
+## Generic Span: <span>
+
+ span.elem =
+ element span { span.inner & span.attrs }
+ span.attrs =
+ ( common.attrs
+ & common.attrs.aria?
+ )
+ span.inner =
+ ( common.inner.phrasing ) # REVISIT allow ol and ul?
+
+ common.elem.phrasing |= span.elem
+
+## Bidirectional Override: <bdo>
+
+ bdo.elem =
+ element bdo { bdo.inner & bdo.attrs }
+ bdo.attrs =
+ ( common.attrs # dir required in Schematron
+ & ( common.attrs.aria.role.presentation
+ | common.attrs.aria.role.menuitem
+ )?
+ )
+ bdo.inner =
+ ( common.inner.phrasing )
+
+ common.elem.phrasing |= bdo.elem
+
+## Bidirectional Isolate: <bdi>
+
+ bdi.elem =
+ element bdi { bdi.inner & bdi.attrs }
+ bdi.attrs =
+ ( common.attrs
+ & ( common.attrs.aria.role.presentation
+ | common.attrs.aria.role.menuitem
+ )?
+ )
+ bdi.inner =
+ ( common.inner.phrasing )
+
+ common.elem.phrasing |= bdi.elem
+
+## Line Break: <br>
+
+ br.elem =
+ element br { br.inner & br.attrs }
+ br.attrs =
+ ( common.attrs
+ & ( common.attrs.aria.role.presentation
+ | common.attrs.aria.role.menuitem
+ )?
+ )
+ br.inner =
+ ( empty )
+
+ common.elem.phrasing |= br.elem
+
+## Line-break opportunity: <wbr>
+
+ wbr.elem =
+ element wbr { wbr.inner & wbr.attrs }
+ wbr.attrs =
+ ( common.attrs
+ & ( common.attrs.aria.role.presentation
+ | common.attrs.aria.role.menuitem
+ )?
+ )
+ wbr.inner =
+ ( empty )
+
+ common.elem.phrasing |= wbr.elem
diff --git a/packages/html5-schema/rdfa.rnc b/packages/html5-schema/rdfa.rnc
new file mode 100644
index 0000000..3c849d9
--- /dev/null
+++ b/packages/html5-schema/rdfa.rnc
@@ -0,0 +1,285 @@
+nonRDFaLite = empty
+# #####################################################################
+## RELAX NG Schema for HTML 5: RDFa 1.1 and RDFa Lite 1.1 #
+# #####################################################################
+
+# #####################################################################
+## RDFa Datatypes #
+# #####################################################################
+
+common.data.rdfa.safecurie =
+ xsd:string {
+ pattern = "\[(([\i-[:]][\c-[:]]*)?:?)[^\s]*\]"
+ minLength = "2"
+ }
+common.data.rdfa.curie =
+ xsd:string {
+ pattern = "(([\i-[:]][\c-[:]]*)?:)[^\s]*"
+ minLength = "1"
+ }
+common.data.rdfa.term =
+ xsd:string {
+ pattern = "[\i-[:]][/\c-[:]]*"
+ }
+
+# #####################################################################
+## RDFa Attributes #
+# #####################################################################
+
+common.attrs.rdfa &=
+ ( common.attrs.rdfa.about?
+ & common.attrs.rdfa.prefix?
+ & common.attrs.rdfa.property?
+ & common.attrs.rdfa.typeof?
+ & common.attrs.rdfa.vocab?
+ & common.attrs.rdfa.content?
+ & common.attrs.rdfa.datatype?
+ & common.attrs.rdfa.rel?
+ & common.attrs.rdfa.resource?
+ & common.attrs.rdfa.rev?
+ & common.attrs.rdfa.inlist?
+ )
+ common.attrs.rdfa.prefix =
+ attribute prefix {
+ (
+ xsd:string {
+ pattern = "\s*([\i-[:]][\c-[:]]*: [^
]+)(\s+[\i-[:]][\c-[:]]*: [^ ]+)*\s*"
+ }
+ | string ""
+ )
+ }
+ common.attrs.rdfa.property =
+ attribute property {
+ (
+ list {
+ ( common.data.rdfa.term
+ | common.data.rdfa.curie
+ | common.data.uri.absolute
+ )+
+ }
+ | string ""
+ )
+ }
+ common.attrs.rdfa.resource =
+ attribute resource {
+ ( common.data.rdfa.safecurie
+ | common.data.rdfa.curie
+ | common.data.uri
+ )
+ }
+ common.attrs.rdfa.typeof =
+ attribute typeof {
+ (
+ list {
+ ( common.data.rdfa.term
+ | common.data.rdfa.curie
+ | common.data.uri.absolute
+ )+
+ }
+ | string ""
+ )
+ }
+ common.attrs.rdfa.vocab =
+ attribute vocab {
+ ( common.data.uri.absolute
+ | string ""
+ )
+ }
+ common.attrs.rdfa.about =
+ attribute about {
+ ( common.data.rdfa.safecurie
+ | common.data.rdfa.curie
+ | common.data.uri
+ )
+ } & nonRDFaLite
+ common.attrs.rdfa.content =
+ attribute content {
+ string
+ } & nonRDFaLite
+ common.attrs.rdfa.datatype =
+ attribute datatype {
+ ( common.data.rdfa.term
+ | common.data.rdfa.curie
+ | common.data.uri.absolute
+ | string ""
+ )
+ } & nonRDFaLite
+ common.attrs.rdfa.rel =
+ attribute rel {
+ (
+ list {
+ ( common.data.rdfa.term
+ | common.data.rdfa.curie
+ | common.data.uri.absolute
+ )+
+ }
+ | string ""
+ )
+ } & nonRDFaLite
+ common.attrs.rdfa.rev =
+ attribute rev {
+ (
+ list {
+ ( common.data.rdfa.term
+ | common.data.rdfa.curie
+ | common.data.uri.absolute
+ )+
+ }
+ | string ""
+ )
+ } & nonRDFaLite
+ common.attrs.rdfa.inlist =
+ attribute inlist {
+ string
+ } & nonRDFaLite
+
+common.attrs.rdfa.no-rel &=
+ ( common.attrs.rdfa.about?
+ & common.attrs.rdfa.prefix?
+ & common.attrs.rdfa.property?
+ & common.attrs.rdfa.typeof?
+ & common.attrs.rdfa.vocab?
+ & common.attrs.rdfa.content?
+ & common.attrs.rdfa.datatype?
+ & common.attrs.rdfa.resource?
+ & common.attrs.rdfa.rev?
+ & common.attrs.rdfa.inlist?
+ )
+common.attrs.rdfa.no-rel-rev &=
+ ( common.attrs.rdfa.about?
+ & common.attrs.rdfa.prefix?
+ & common.attrs.rdfa.property?
+ & common.attrs.rdfa.typeof?
+ & common.attrs.rdfa.vocab?
+ & common.attrs.rdfa.content?
+ & common.attrs.rdfa.datatype?
+ & common.attrs.rdfa.resource?
+ & common.attrs.rdfa.inlist?
+ )
+common.attrs.rdfa.no-content-noproperty &=
+ ( common.attrs.rdfa.about?
+ & common.attrs.rdfa.prefix?
+ & common.attrs.rdfa.typeof?
+ & common.attrs.rdfa.vocab?
+ & common.attrs.rdfa.datatype?
+ & common.attrs.rdfa.resource?
+ & common.attrs.rdfa.inlist?
+ )
+
+common.attrs &= common.attrs.rdfa
+
+a.attrs &= common.attrs.rdfa.no-rel-rev
+area.attrs &= common.attrs.rdfa.no-rel
+base.attrs &= common.attrs.rdfa.no-rel
+
+link.rdfa.elem.metadata =
+ element link { link.inner & link.rdfa.attrs.metadata }
+link.rdfa.elem.phrasing =
+ element link { link.inner & link.rdfa.attrs.phrasing }
+link.rdfa.attrs.metadata =
+ ( common.attrs.basic
+ & common.attrs.i18n
+ & common.attrs.present
+ & common.attrs.other
+ & ( ( common.attrs.rdfa.property
+ & link.attrs.rel?
+ )
+ |
+ ( common.attrs.rdfa.property?
+ & link.attrs.rel
+ )
+ )
+ & link.attrs.href
+ & common.attrs.rdfa.about?
+ & common.attrs.rdfa.prefix?
+ & common.attrs.rdfa.typeof?
+ & common.attrs.rdfa.vocab?
+ & common.attrs.rdfa.content?
+ & common.attrs.rdfa.datatype?
+ & common.attrs.rdfa.resource?
+ & common.attrs.rdfa.rev?
+ & common.attrs.rdfa.inlist?
+ & shared-hyperlink.attrs.hreflang?
+ & shared-hyperlink.attrs.media?
+ & shared-hyperlink.attrs.type?
+ & link.attrs.sizes?
+ # link.attrs.title included in common.attrs
+ & embedded.content.attrs.crossorigin?
+ & ( common.attrs.aria.role.link
+ | common.attrs.aria.role.presentation
+ | common.attrs.aria.role.menuitem
+ )?
+ )
+link.rdfa.attrs.phrasing =
+ ( common.attrs.basic
+ & common.attrs.i18n
+ & common.attrs.present
+ & common.attrs.other
+ & common.attrs.rdfa.property
+ & link.attrs.rel?
+ & ( ( common.attrs.rdfa.resource
+ & link.attrs.href?
+ )
+ |
+ ( common.attrs.rdfa.resource?
+ & link.attrs.href
+ )
+ )
+ & common.attrs.rdfa.about?
+ & common.attrs.rdfa.prefix?
+ & common.attrs.rdfa.typeof?
+ & common.attrs.rdfa.vocab?
+ & common.attrs.rdfa.content?
+ & common.attrs.rdfa.datatype?
+ & common.attrs.rdfa.rev?
+ & common.attrs.rdfa.inlist?
+ & shared-hyperlink.attrs.hreflang?
+ & shared-hyperlink.attrs.media?
+ & shared-hyperlink.attrs.type?
+ & link.attrs.sizes?
+ # link.attrs.title included in common.attrs
+ & embedded.content.attrs.crossorigin?
+ & ( common.attrs.aria.role.link
+ | common.attrs.aria.role.presentation
+ | common.attrs.aria.role.menuitem
+ )?
+ )
+ common.elem.metadata |= link.rdfa.elem.metadata
+ common.elem.phrasing |= link.rdfa.elem.phrasing
+
+## <meta property=foo content=bar> in head ("name" attribute optional)
+ meta.property.elem =
+ element meta { meta.inner & meta.property.attrs }
+ meta.property.attrs =
+ ( common.attrs.basic
+ & common.attrs.i18n
+ & common.attrs.present
+ & common.attrs.other
+ & meta.name.attrs.name?
+ & common.attrs.rdfa.property
+ & meta.name.attrs.content
+ & ( common.attrs.aria.role.presentation
+ | common.attrs.aria.role.menuitem
+ )?
+ )
+ common.elem.metadata |= meta.property.elem
+
+## <meta property=foo content=bar> in body ("name" attribute disallowed)
+ meta.property-no-name.elem =
+ element meta { meta.inner & meta.property-no-name.attrs }
+ meta.property-no-name.attrs =
+ ( common.attrs.basic
+ & common.attrs.i18n
+ & common.attrs.present
+ & common.attrs.other
+ & common.attrs.rdfa.property
+ & meta.name.attrs.content
+ & ( common.attrs.aria.role.presentation
+ | common.attrs.aria.role.menuitem
+ )?
+ )
+ common.elem.phrasing |= meta.property-no-name.elem
+
+meta.property.attrs &= common.attrs.rdfa.no-content-noproperty
+meta.property-no-name.attrs &= common.attrs.rdfa.no-content-noproperty
+meta.name.attrs &= common.attrs.rdfa.no-content-noproperty
diff --git a/packages/html5-schema/revision.rnc
b/packages/html5-schema/revision.rnc
new file mode 100644
index 0000000..a357bd4
--- /dev/null
+++ b/packages/html5-schema/revision.rnc
@@ -0,0 +1,54 @@
+# #####################################################################
+## RELAX NG Schema for HTML 5: Revision Annotations #
+# #####################################################################
+
+## Common Attributes
+
+ edit.attrs.cite =
+ attribute cite {
+ common.data.uri
+ }
+ edit.attrs.datetime =
+ attribute datetime {
+ common.data.datetime | common.data.date
+ }
+
+## Inserts: <ins>
+
+ ins.elem.flow =
+ element ins { ins.inner.flow & ins.attrs }
+ ins.elem.phrasing =
+ element ins { ins.inner.phrasing & ins.attrs }
+ ins.attrs =
+ ( common.attrs
+ & edit.attrs.cite?
+ & edit.attrs.datetime?
+ & common.attrs.aria?
+ )
+ ins.inner.flow =
+ ( common.inner.transparent.flow )
+ ins.inner.phrasing =
+ ( common.inner.phrasing )
+
+ common.elem.flow |= ins.elem.flow
+ common.elem.phrasing |= ins.elem.phrasing
+
+## Deletions: <del>
+
+ del.elem.flow =
+ element del { del.inner.flow & del.attrs }
+ del.elem.phrasing =
+ element del { del.inner.phrasing & del.attrs }
+ del.attrs =
+ ( common.attrs
+ & edit.attrs.cite?
+ & edit.attrs.datetime?
+ & common.attrs.aria?
+ )
+ del.inner.flow =
+ ( common.inner.transparent.flow )
+ del.inner.phrasing =
+ ( common.inner.phrasing )
+
+ common.elem.flow |= del.elem.flow
+ common.elem.phrasing |= del.elem.phrasing
diff --git a/packages/html5-schema/ruby.rnc b/packages/html5-schema/ruby.rnc
new file mode 100644
index 0000000..dfd0e3f
--- /dev/null
+++ b/packages/html5-schema/ruby.rnc
@@ -0,0 +1,81 @@
+datatypes w = "http://whattf.org/datatype-draft";
+namespace local = ""
+
+# #####################################################################
+## RELAX NG Schema for HTML 5: Ruby #
+# #####################################################################
+
+#######################################################################
+
+## Ruby Annotation: <ruby>
+
+ ruby.elem =
+ element ruby { ruby.inner & ruby.attrs }
+ ruby.attrs =
+ ( common.attrs
+ & common.attrs.aria?
+ )
+ ruby.inner =
+ ( ( common.inner.phrasing
+ | rb.elem
+ )+
+ , ( ( rt.elem
+ | rtc.elem
+ )+
+ | ( rp.elem
+ , ( rt.elem
+ | rtc.elem
+ )+
+ , rp.elem
+ )
+ )
+ )+
+
+ common.elem.phrasing |= ruby.elem
+
+## Ruby Text: <rt>
+
+ rt.elem =
+ element rt { rt.inner & rt.attrs }
+ rt.attrs =
+ ( common.attrs
+ & common.attrs.aria?
+ )
+ rt.inner =
+ ( common.inner.phrasing )
+
+## Ruby Text Container: <rtc>
+
+ rtc.elem =
+ element rtc { rtc.inner & rtc.attrs }
+ rtc.attrs =
+ ( common.attrs
+ & common.attrs.aria?
+ )
+ rtc.inner =
+ ( common.inner.phrasing
+ | rt.elem
+ | rp.elem
+ )*
+
+## Ruby Base: <rb>
+
+ rb.elem =
+ element rb { rb.inner & rb.attrs }
+ rb.attrs =
+ ( common.attrs
+ & common.attrs.aria?
+ )
+ rb.inner =
+ ( common.inner.phrasing )
+
+## Ruby Parenthesis: <rp>
+
+ rp.elem =
+ element rp { rp.inner & rp.attrs }
+ rp.attrs =
+ ( common.attrs
+ & common.attrs.aria?
+ )
+ rp.inner =
+ ( common.inner.phrasing )
diff --git a/packages/html5-schema/sectional.rnc
b/packages/html5-schema/sectional.rnc
new file mode 100644
index 0000000..afbac8f
--- /dev/null
+++ b/packages/html5-schema/sectional.rnc
@@ -0,0 +1,172 @@
+# #####################################################################
+## RELAX NG Schema for HTML 5: Sectioning Markup #
+# #####################################################################
+
+# #####################################################################
+## Headings
+
+## Heading (Rank 1): <h1>
+
+ h1.elem =
+ element h1 { h1.inner & h1.attrs }
+ h1.attrs =
+ ( common.attrs
+ & ( common.attrs.aria.implicit.heading
+ | common.attrs.aria.role.heading
+ | common.attrs.aria.role.tab
+ | common.attrs.aria.role.presentation
+ )?
+ )
+ h1.inner =
+ ( common.inner.phrasing )
+
+ common.elem.flow |= h1.elem
+
+## Heading (Rank 2): <h2>
+
+ h2.elem =
+ element h2 { h2.inner & h2.attrs }
+ h2.attrs =
+ ( common.attrs
+ & ( common.attrs.aria.implicit.heading
+ | common.attrs.aria.role.heading
+ | common.attrs.aria.role.tab
+ | common.attrs.aria.role.presentation
+ )?
+ )
+ h2.inner =
+ ( common.inner.phrasing )
+
+ common.elem.flow |= h2.elem
+
+## Heading (Rank 3): <h3>
+
+ h3.elem =
+ element h3 { h3.inner & h3.attrs }
+ h3.attrs =
+ ( common.attrs
+ & ( common.attrs.aria.implicit.heading
+ | common.attrs.aria.role.heading
+ | common.attrs.aria.role.tab
+ | common.attrs.aria.role.presentation
+ )?
+ )
+ h3.inner =
+ ( common.inner.phrasing )
+
+ common.elem.flow |= h3.elem
+
+## Heading (Rank 4): <h4>
+
+ h4.elem =
+ element h4 { h4.inner & h4.attrs }
+ h4.attrs =
+ ( common.attrs
+ & ( common.attrs.aria.implicit.heading
+ | common.attrs.aria.role.heading
+ | common.attrs.aria.role.tab
+ | common.attrs.aria.role.presentation
+ )?
+ )
+ h4.inner =
+ ( common.inner.phrasing )
+
+ common.elem.flow |= h4.elem
+
+## Heading (Rank 5): <h5>
+
+ h5.elem =
+ element h5 { h5.inner & h5.attrs }
+ h5.attrs =
+ ( common.attrs
+ & ( common.attrs.aria.implicit.heading
+ | common.attrs.aria.role.heading
+ | common.attrs.aria.role.tab
+ | common.attrs.aria.role.presentation
+ )?
+ )
+ h5.inner =
+ ( common.inner.phrasing )
+
+ common.elem.flow |= h5.elem
+
+## Heading (Rank 6): <h6>
+
+ h6.elem =
+ element h6 { h6.inner & h6.attrs }
+ h6.attrs =
+ ( common.attrs
+ & ( common.attrs.aria.implicit.heading
+ | common.attrs.aria.role.heading
+ | common.attrs.aria.role.tab
+ | common.attrs.aria.role.presentation
+ )?
+ )
+ h6.inner =
+ ( common.inner.phrasing )
+
+ common.elem.flow |= h6.elem
+
+## Heading Group: <hgroup>
+
+ hgroup.elem =
+ element hgroup { hgroup.inner & hgroup.attrs } & nonW3C
+ hgroup.attrs =
+ ( common.attrs
+ & ( common.attrs.aria.implicit.heading
+ | common.attrs.aria.role.heading
+ | common.attrs.aria.role.tab
+ | common.attrs.aria.role.presentation
+ )?
+ )
+ hgroup.inner =
+ ( ( h1.elem
+ | h2.elem
+ | h3.elem
+ | h4.elem
+ | h5.elem
+ | h6.elem
+ )
+ & common.elem.script-supporting*
+ )+
+
+ common.elem.flow |= hgroup.elem
+
+# #####################################################################
+## Section Meta
+
+## Contact Info: <address>
+
+ address.elem =
+ element address { address.inner & address.attrs }
+ address.attrs =
+ ( common.attrs
+ & ( common.attrs.aria.role.contentinfo
+ | common.attrs.aria.role.presentation
+ )?
+ )
+ address.inner =
+ ( common.inner.flow )
+
+ common.elem.flow |= address.elem
+
+# #####################################################################
+## Quotations
+
+## Block Quotes: <blockquote>
+
+ blockquote.elem =
+ element blockquote { blockquote.inner & blockquote.attrs }
+ blockquote.attrs =
+ ( common.attrs
+ & blockquote.attrs.cite?
+ & common.attrs.aria?
+ )
+ blockquote.attrs.cite =
+ attribute cite {
+ common.data.uri
+ }
+ blockquote.inner =
+ ( common.inner.flow )
+
+ common.elem.flow |= blockquote.elem
diff --git a/packages/html5-schema/structural.rnc
b/packages/html5-schema/structural.rnc
new file mode 100644
index 0000000..410f34d
--- /dev/null
+++ b/packages/html5-schema/structural.rnc
@@ -0,0 +1,135 @@
+# #####################################################################
+## RELAX NG Schema for HTML 5: Block Markup Added in HTML5 #
+# #####################################################################
+
+## Section: <section>
+
+ section.elem =
+ element section { section.inner & section.attrs }
+ section.attrs =
+ ( common.attrs
+ & ( common.attrs.aria.implicit.region
+ | common.attrs.aria.role.alert
+ | common.attrs.aria.role.alertdialog
+ | common.attrs.aria.role.contentinfo
+ | common.attrs.aria.role.dialog
+ | common.attrs.aria.role.log
+ | common.attrs.aria.role.marquee
+ | common.attrs.aria.role.region
+ | common.attrs.aria.role.status
+ | common.attrs.aria.role.presentation
+ | common.attrs.aria.landmark.application
+ | common.attrs.aria.landmark.document
+ | common.attrs.aria.landmark.main
+ | common.attrs.aria.landmark.search
+ )?
+ )
+ section.inner =
+ ( common.inner.flow )
+
+ common.elem.flow |= section.elem
+
+## Navigational Links: <nav>
+
+ nav.elem =
+ element nav { nav.inner & nav.attrs }
+ nav.attrs =
+ ( common.attrs
+ & ( common.attrs.aria.implicit.navigation
+ | common.attrs.aria.landmark.navigation
+ )?
+ )
+ nav.inner =
+ ( common.inner.flow )
+
+ common.elem.flow |= nav.elem
+
+## Article: <article>
+
+ article.elem =
+ element article { article.inner & article.attrs }
+ article.attrs =
+ ( common.attrs
+ & ( common.attrs.aria.implicit.article
+ | common.attrs.aria.landmark.article
+ | common.attrs.aria.landmark.document
+ | common.attrs.aria.landmark.application
+ | common.attrs.aria.landmark.main
+ | common.attrs.aria.role.presentation
+ )?
+ )
+ article.inner =
+ ( style.elem*
+ , common.inner.flow
+ )
+
+ common.elem.flow |= article.elem
+
+## Tangential Aside: <aside>
+
+ aside.elem =
+ element aside { aside.inner & aside.attrs }
+ aside.attrs =
+ ( common.attrs
+ & ( common.attrs.aria.implicit.complementary
+ | common.attrs.aria.landmark.note
+ | common.attrs.aria.landmark.complementary
+ | common.attrs.aria.landmark.search
+ | common.attrs.aria.role.presentation
+ )?
+ )
+ aside.inner =
+ ( style.elem*
+ , common.inner.flow
+ )
+
+ common.elem.flow |= aside.elem
+
+## Header: <header>
+
+ header.elem =
+ element header { header.inner & header.attrs }
+ header.attrs =
+ ( common.attrs
+ & ( common.attrs.aria.implicit.banner
+ | common.attrs.aria.landmark.banner
+ | common.attrs.aria.role.group
+ | common.attrs.aria.role.presentation
+ )?
+ )
+ header.inner =
+ ( common.inner.flow )
+
+ common.elem.flow |= header.elem
+
+## Footer: <footer>
+
+ footer.elem =
+ element footer { footer.inner & footer.attrs }
+ footer.attrs =
+ ( common.attrs
+ & ( common.attrs.aria.implicit.contentinfo
+ | common.attrs.aria.landmark.contentinfo
+ | common.attrs.aria.role.group
+ | common.attrs.aria.role.presentation
+ )?
+ )
+ footer.inner =
+ ( common.inner.flow )
+
+ common.elem.flow |= footer.elem
+
+## main content: <main>
+
+ main.elem =
+ element main { main.inner & main.attrs }
+ main.attrs =
+ ( common.attrs
+ & ( common.attrs.aria.implicit.main
+ | common.attrs.aria.landmark.main
+ )?
+ )
+ main.inner =
+ ( common.inner.flow )
+
+ common.elem.flow |= main.elem
diff --git a/packages/html5-schema/tables.rnc b/packages/html5-schema/tables.rnc
new file mode 100644
index 0000000..b6021da
--- /dev/null
+++ b/packages/html5-schema/tables.rnc
@@ -0,0 +1,244 @@
+datatypes w = "http://whattf.org/datatype-draft";
+
+# #####################################################################
+## RELAX NG Schema for HTML 5: Tables #
+# #####################################################################
+
+# #####################################################################
+## Table Envelope
+
+## Table Datatypes
+
+# tables.data.multilen =
+# ( common.data.integer.positive
+# | common.data.percent
+# | xsd:token { pattern = "[0-9]+\*" } #REVISIT should this
one be string?
+# )
+
+## Table Alignment Attributes
+
+ tables.attrs.alignment =
+ ( tables.attrs.align?
+ & tables.attrs.char?
+ & tables.attrs.valign?
+ )
+ tables.attrs.align =
+ attribute align {
+ ( w:string "left"
+ | w:string "center"
+ | w:string "right"
+ | w:string "justify"
+ | w:string "char"
+ )
+ }
+ tables.attrs.char =
+ attribute char {
+ xsd:string { pattern = "." }
+ }
+ tables.attrs.valign =
+ attribute valign {
+ ( w:string "top"
+ | w:string "middle"
+ | w:string "bottom"
+ | w:string "baseline"
+ )
+ }
+
+## Data Table: <table>
+
+ table.elem =
+ element table { table.inner & table.attrs }
+ table.attrs =
+ ( common.attrs
+ & common.attrs.aria?
+ )
+ table.inner =
+ ( caption.elem?
+ , common.elem.script-supporting*
+ , colgroup.elem*
+ , common.elem.script-supporting*
+ , thead.elem?
+ , common.elem.script-supporting*
+ , ( ( tfoot.elem
+ , common.elem.script-supporting*
+ , ( tbody.elem* | tr.elem+ )
+ , common.elem.script-supporting*
+ )
+ | ( ( tbody.elem* | tr.elem+ )
+ , common.elem.script-supporting*
+ , tfoot.elem?
+ )
+ )
+ )
+
+ common.elem.flow |= table.elem
+
+## Table Caption: <caption>
+
+ caption.elem =
+ element caption { caption.inner & caption.attrs }
+ caption.attrs =
+ ( common.attrs
+ & common.attrs.aria?
+ )
+ caption.inner =
+ ( common.inner.flow )
+
+# #####################################################################
+## Table Super Structure
+
+## Table Column Group: <colgroup>
+
+ colgroup.elem =
+ element colgroup { colgroup.inner & colgroup.attrs }
+ colgroup.attrs =
+ ( common.attrs
+ & common.attrs.aria?
+ )
+ colgroup.attrs.span =
+ attribute span {
+ common.data.integer.positive
+ }
+ colgroup.inner =
+ ( ( col.elem*
+ & common.elem.script-supporting*
+ )
+ | colgroup.attrs.span?
+ )
+
+## Table Column: <col>
+
+ col.elem =
+ element col { col.inner & col.attrs }
+ col.attrs =
+ ( common.attrs
+ & col.attrs.span?
+ & common.attrs.aria?
+ )
+ col.attrs.span =
+ attribute span {
+ common.data.integer.positive
+ }
+ col.inner =
+ ( empty )
+
+## Table Header Row Group
+
+ thead.elem =
+ element thead { thead.inner & thead.attrs }
+ thead.attrs =
+ ( common.attrs
+ & common.attrs.aria?
+ )
+ thead.inner =
+ ( tr.elem*
+ & common.elem.script-supporting*
+ )
+
+## Table Footer Row Group
+
+ tfoot.elem =
+ element tfoot { tfoot.inner & tfoot.attrs }
+ tfoot.attrs =
+ ( common.attrs
+ & common.attrs.aria?
+ )
+ tfoot.inner =
+ ( tr.elem*
+ & common.elem.script-supporting*
+ )
+
+## Table Row Group
+
+ tbody.elem =
+ element tbody { tbody.inner & tbody.attrs }
+ tbody.attrs =
+ ( common.attrs
+ & common.attrs.aria?
+ )
+ tbody.inner =
+ ( tr.elem*
+ & common.elem.script-supporting*
+ )
+
+# #####################################################################
+## Cell Structure
+
+## Table Row
+
+ tr.elem =
+ element tr { tr.inner & tr.attrs }
+ tr.attrs =
+ ( common.attrs
+ & common.attrs.aria?
+ )
+ tr.inner =
+ ( ( td.elem | th.elem | common.elem.script-supporting )* )
+
+## Common Table Cell Attributes
+
+ tables.attrs.cell-structure =
+ ( tables.attrs.colspan?
+ & tables.attrs.rowspan?
+ )
+ tables.attrs.colspan =
+ attribute colspan {
+ common.data.integer.positive
+ }
+ tables.attrs.rowspan =
+ attribute rowspan {
+ common.data.integer.non-negative
+ }
+
+ tables.attrs.access-headers =
+ ( tables.attrs.headers? )
+ tables.attrs.headers =
+ attribute headers {
+ common.data.idrefs
+ }
+
+ tables.attrs.define-headers =
+ ( tables.attrs.scope? )
+ tables.attrs.scope =
+ attribute scope {
+ ( w:string "row"
+ | w:string "col"
+ | w:string "rowgroup"
+ | w:string "colgroup"
+ )
+ }
+ tables.attrs.abbr =
+ attribute abbr {
+ text
+ }
+
+## Table Data Cell: <td>
+
+ td.elem =
+ element td { td.inner & td.attrs }
+ td.attrs =
+ ( common.attrs
+ & tables.attrs.cell-structure
+ & tables.attrs.headers?
+# & tables.attrs.alignment
+ & common.attrs.aria?
+ )
+ td.inner =
+ ( common.inner.flow )
+
+## Table Header Cells: <th>
+
+ th.elem =
+ element th { th.inner & th.attrs }
+ th.attrs =
+ ( common.attrs
+ & tables.attrs.cell-structure
+ & tables.attrs.scope?
+ & tables.attrs.headers?
+# & tables.attrs.alignment
+ & ( common.attrs.aria?
+ | common.attrs.aria.implicit.column-or-row-header
+ )
+ )
+ th.inner =
+ ( common.inner.flow )
diff --git a/packages/html5-schema/web-components.rnc
b/packages/html5-schema/web-components.rnc
new file mode 100644
index 0000000..bf45715
--- /dev/null
+++ b/packages/html5-schema/web-components.rnc
@@ -0,0 +1,43 @@
+datatypes w = "http://whattf.org/datatype-draft";
+
+# #####################################################################
+## RELAX NG Schema for HTML 5: Web Components
+# #####################################################################
+
+## Templates: <template>
+
+ template.elem =
+ element template { template.inner & template.attrs }
+ template.attrs =
+ ( common.attrs )
+ template.inner =
+ ( common.inner.metadata
+ | common.inner.flow
+ | ol.inner
+ | ul.inner
+ | dl.inner
+ | figure.inner
+ | ruby.inner
+ | object.inner.flow
+ | object.inner.phrasing
+ | video.inner.flow
+ | video.inner.phrasing
+ | audio.inner.flow
+ | audio.inner.phrasing
+ | table.inner
+ | colgroup.inner
+ | thead.inner
+ | tbody.inner
+ | tfoot.inner
+ | tr.inner
+ | fieldset.inner
+ | select.inner
+ | details.inner
+ | menu.popup.inner
+ )
+ common.elem.metadata |= template.elem
+ common.elem.phrasing |= template.elem
+ common.elem.script-supporting |= template.elem
+
+# also allow <script> wherever <template> is allowed
+ common.elem.script-supporting |= script.elem
diff --git a/packages/html5-schema/web-forms-scripting.rnc
b/packages/html5-schema/web-forms-scripting.rnc
new file mode 100644
index 0000000..63fe1c4
--- /dev/null
+++ b/packages/html5-schema/web-forms-scripting.rnc
@@ -0,0 +1,27 @@
+# #####################################################################
+## RELAX NG Schema for HTML 5: Web Forms 1.0 Scripting #
+# #####################################################################
+
+ scripting.attr.form.select =
+ attribute onselect { string }
+ scripting.attr.form.change =
+ attribute onchange { string }
+
+# input.text.attrs &=
+# ( scripting.attr.form.select?
+# )
+
+# shared-form.attrs &=
+# ( scripting.attr.form.change?
+# )
+
+# form.attrs &=
+# ( scripting.attr.form.reset?
+# & scripting.attr.form.submit?
+# )
+ scripting.attr.form.submit =
+ attribute onsubmit { string }
+ scripting.attr.form.reset =
+ attribute onreset { string }
+
+
diff --git a/packages/html5-schema/web-forms.rnc
b/packages/html5-schema/web-forms.rnc
new file mode 100644
index 0000000..c58e652
--- /dev/null
+++ b/packages/html5-schema/web-forms.rnc
@@ -0,0 +1,607 @@
+datatypes w = "http://whattf.org/datatype-draft";
+
+# #####################################################################
+## RELAX NG Schema for HTML 5: Web Forms 1.0 markup #
+# #####################################################################
+
+## Shared attributes for form controls
+
+ common-form.attrs =
+ ( common-form.attrs.name?
+ & common-form.attrs.disabled?
+ )
+
+ common-form.attrs.name =
+ attribute name {
+ form.data.nonemptystring
+ }
+
+ common-form.attrs.disabled =
+ attribute disabled {
+ w:string "disabled" | w:string ""
+ }
+
+ shared-form.attrs.readonly =
+ attribute readonly {
+ w:string "readonly" | w:string ""
+ }
+
+ shared-form.attrs.maxlength =
+ attribute maxlength {
+ common.data.integer.non-negative
+ }
+
+ shared-form.attrs.size =
+ attribute size {
+ common.data.integer.positive
+ }
+
+ # REVISIT tabindex goes in common.attrs
+
+## Shared attributes for <input>
+
+ input.attrs.checked =
+ attribute checked {
+ w:string "checked" | w:string ""
+ }
+
+## Text Field: <input type='text'>
+
+ input.text.elem =
+ element input { input.text.attrs }
+ input.text.attrs =
+ ( common.attrs
+ & common-form.attrs
+ & input.text.attrs.type?
+ & shared-form.attrs.maxlength?
+ & shared-form.attrs.readonly?
+ & shared-form.attrs.size?
+ & input.text.attrs.value?
+ & ( common.attrs.aria.implicit.textbox
+ | common.attrs.aria.implicit.combobox
+ | common.attrs.aria.role.textbox
+ | common.attrs.aria.role.combobox
+ )?
+ )
+ input.text.attrs.type =
+ attribute type {
+ w:string "text"
+ }
+ input.text.attrs.value =
+ attribute value {
+ form.data.stringwithoutlinebreaks
+ }
+
+ input.elem = input.text.elem
+
+## Password Field: <input type='password'>
+
+ input.password.elem =
+ element input { input.password.attrs }
+ input.password.attrs =
+ ( common.attrs
+ & common-form.attrs
+ & input.password.attrs.type
+ & shared-form.attrs.maxlength?
+ & shared-form.attrs.readonly?
+ & shared-form.attrs.size?
+ & input.password.attrs.value?
+ & ( common.attrs.aria.implicit.textbox
+ | common.attrs.aria.role.textbox
+ )?
+ )
+ input.password.attrs.type =
+ attribute type {
+ w:string "password"
+ }
+ input.password.attrs.value =
+ attribute value {
+ form.data.stringwithoutlinebreaks
+ }
+
+ input.elem |= input.password.elem
+
+## Checkbox: <input type='checkbox'>
+
+ input.checkbox.elem =
+ element input { input.checkbox.attrs }
+ input.checkbox.attrs =
+ ( common.attrs
+ & common-form.attrs
+ & input.checkbox.attrs.type
+ & input.attrs.checked?
+ & input.checkbox.attrs.value?
+ & ( common.attrs.aria.implicit.checkbox
+ | common.attrs.aria.role.checkbox
+ | common.attrs.aria.role.menuitemcheckbox
+ | common.attrs.aria.role.switch
+ )?
+ )
+ input.checkbox.attrs.type =
+ attribute type {
+ w:string "checkbox"
+ }
+ input.checkbox.attrs.value =
+ attribute value {
+ string #REVISIT require non-empty value?
+ }
+
+ input.elem |= input.checkbox.elem
+
+## Radiobutton: <input type='radio'>
+
+ input.radio.elem =
+ element input { input.radio.attrs }
+ input.radio.attrs =
+ ( common.attrs
+ & common-form.attrs
+ & input.radio.attrs.type
+ & input.attrs.checked?
+ & input.radio.attrs.value?
+ & ( common.attrs.aria.implicit.radio
+ | common.attrs.aria.role.radio
+ | common.attrs.aria.role.menuitemradio
+ )?
+ )
+ input.radio.attrs.type =
+ attribute type {
+ w:string "radio"
+ }
+ input.radio.attrs.value =
+ attribute value {
+ string #REVISIT require non-empty value?
+ }
+
+ input.elem |= input.radio.elem
+
+## Scripting Hook Button: <input type='button'>
+
+ input.button.elem =
+ element input { input.button.attrs }
+ input.button.attrs =
+ ( common.attrs
+ & common-form.attrs
+ & input.button.attrs.type
+ & input.button.attrs.value?
+ & ( common.attrs.aria.implicit.button
+ | common.attrs.aria.role.button
+ | common.attrs.aria.role.link
+ | common.attrs.aria.role.menuitem
+ | common.attrs.aria.role.menuitemcheckbox
+ | common.attrs.aria.role.menuitemradio
+ | common.attrs.aria.role.radio
+ | common.attrs.aria.role.switch
+ )?
+ )
+ input.button.attrs.type =
+ attribute type {
+ w:string "button"
+ }
+ input.button.attrs.value =
+ attribute value {
+ string #REVISIT require non-empty value?
+ }
+
+ input.elem |= input.button.elem
+ #REVISIT should this be enabled by a scripting module only?
+
+## Submit Button: <input type='submit'>
+
+ input.submit.elem =
+ element input { input.submit.attrs }
+ input.submit.attrs =
+ ( common.attrs
+ & common-form.attrs
+ & input.submit.attrs.type
+ & input.submit.attrs.value?
+ & ( common.attrs.aria.implicit.button
+ | common.attrs.aria.role.button
+ )?
+ )
+ input.submit.attrs.type =
+ attribute type {
+ w:string "submit"
+ }
+ input.submit.attrs.value =
+ attribute value {
+ string #REVISIT require non-empty value?
+ }
+
+ input.elem |= input.submit.elem
+
+## Reset Button: <input type='reset'>
+
+ input.reset.elem =
+ element input { input.reset.attrs }
+ input.reset.attrs =
+ ( common.attrs
+ & common-form.attrs
+ & input.reset.attrs.type
+ & input.reset.attrs.value?
+ & ( common.attrs.aria.implicit.button
+ | common.attrs.aria.role.button
+ )?
+ )
+ input.reset.attrs.type =
+ attribute type {
+ w:string "reset"
+ }
+ input.reset.attrs.value =
+ attribute value {
+ string #REVISIT require non-empty value?
+ }
+
+ input.elem |= input.reset.elem
+ # REVISIT does reset make sense outside a form?
+
+## File Upload: <input type='file'>
+
+ input.file.elem =
+ element input { input.file.attrs }
+ input.file.attrs =
+ ( common.attrs
+ & common-form.attrs
+ & input.file.attrs.type
+ & input.file.attrs.accept?
+ & common.attrs.aria?
+ )
+ input.file.attrs.type =
+ attribute type {
+ w:string "file"
+ }
+ input.file.attrs.accept =
+ attribute accept {
+ form.data.mimetypelist
+ }
+
+ input.elem |= input.file.elem
+
+## Hidden String: <input type='hidden'>
+
+ input.hidden.elem =
+ element input { input.hidden.attrs }
+ input.hidden.attrs =
+ ( common.attrs
+ & common-form.attrs
+ & input.hidden.attrs.type
+ & input.hidden.attrs.value?
+ & common.attrs.aria?
+ )
+ input.hidden.attrs.type =
+ attribute type {
+ w:string "hidden"
+ }
+ input.hidden.attrs.value =
+ attribute value {
+ string
+ }
+
+ input.elem |= input.hidden.elem
+
+## Image Submit Button: <input type='image'>
+
+ input.image.elem =
+ element input { input.image.attrs }
+ input.image.attrs =
+ ( common.attrs
+ & common-form.attrs
+ & input.image.attrs.type
+ & input.image.attrs.alt
+ & input.image.attrs.src?
+ & ( common.attrs.aria.implicit.button
+ | common.attrs.aria.role.button
+ | common.attrs.aria.role.link
+ | common.attrs.aria.role.menuitem
+ | common.attrs.aria.role.menuitemcheckbox
+ | common.attrs.aria.role.menuitemradio
+ | common.attrs.aria.role.radio
+ | common.attrs.aria.role.switch
+ )?
+ )
+ input.image.attrs.type =
+ attribute type {
+ w:string "image"
+ }
+ input.image.attrs.alt =
+ attribute alt {
+ form.data.nonemptystring
+ }
+ input.image.attrs.src =
+ attribute src {
+ common.data.uri.non-empty
+ }
+
+ input.elem |= input.image.elem
+
+ common.elem.phrasing |= input.elem
+
+## Text Area: <textarea>
+
+ textarea.elem =
+ element textarea { textarea.inner & textarea.attrs }
+ textarea.attrs =
+ ( common.attrs
+ & common-form.attrs
+ & shared-form.attrs.readonly?
+ & textarea.attrs.rows-and-cols-wf1
+ & ( common.attrs.aria.implicit.textbox
+ | common.attrs.aria.role.textbox
+ )?
+ #FIXME onfocus, onblur, onselect,onchange
+ )
+ # This is ugly.
+ textarea.attrs.rows-and-cols-wf1 =
+ textarea.attrs.rows-and-cols-wf1.inner
+ textarea.attrs.rows-and-cols-wf1.inner =
+ ( textarea.attrs.cols
+ & textarea.attrs.rows
+ )
+ textarea.attrs.cols =
+ attribute cols {
+ common.data.integer.positive
+ }
+ textarea.attrs.rows =
+ attribute rows {
+ common.data.integer.positive
+ }
+ textarea.inner =
+ ( text )
+
+ common.elem.phrasing |= textarea.elem
+
+# Due to limitations with interleave, handling single/multiple selection
+# enforcement in RELAX NG seems to be possible but really awkward.
+# Tried it. Leaving it to Schematron.
+
+## Select menu option: <option selected>
+
+ option.elem =
+ element option { option.inner & option.attrs }
+ option.attrs =
+ ( common.attrs
+ & common-form.attrs.disabled?
+ & option.attrs.selected?
+ & option.attrs.label?
+ & option.attrs.value?
+ & ( common.attrs.aria.implicit.option
+ | common.attrs.aria.role.option
+ )?
+ )
+ option.attrs.selected =
+ attribute selected {
+ w:string "selected" | w:string ""
+ }
+ option.attrs.label =
+ attribute label {
+ form.data.nonemptystring
+ }
+ option.attrs.value =
+ attribute value {
+ string
+ }
+ option.inner =
+ ( text )
+
+## Option Group: <optgroup>
+
+ optgroup.elem =
+ element optgroup { optgroup.inner & optgroup.attrs }
+ optgroup.attrs =
+ ( common.attrs
+ & optgroup.attrs.label
+ & common-form.attrs.disabled?
+ & ( common.attrs.aria.role.presentation
+ | common.attrs.aria.role.menuitem
+ )?
+ )
+ optgroup.attrs.label =
+ attribute label {
+ string
+ }
+ optgroup.inner =
+ ( option.elem*
+ & common.elem.script-supporting*
+ )
+
+## Selection Menu: <select>
+
+ select.elem =
+ element select { select.inner & select.attrs }
+ select.attrs =
+ ( common.attrs
+ & common-form.attrs
+ & select.attrs.size?
+ & select.attrs.multiple?
+ # FIXME onfocus, onblur, onchange
+ & ( common.attrs.aria.implicit.listbox
+ | common.attrs.aria.role.listbox #
aria-multiselectable depends on "multiple" value; check in assertions
+ )?
+ )
+ select.attrs.size =
+ attribute size {
+ common.data.integer.positive
+ }
+ select.attrs.multiple =
+ attribute multiple {
+ w:string "multiple" | w:string ""
+ }
+ select.inner =
+ ( optgroup.elem*
+ & option.elem*
+ & common.elem.script-supporting*
+ )
+
+ common.elem.phrasing |= select.elem
+
+## Shared Definitions for Complex Button
+
+ button.attrs.value =
+ attribute value {
+ string
+ }
+ button.inner =
+ ( common.inner.phrasing )
+
+## Complex Submit Button: <button type='submit'>
+
+ button.submit.elem =
+ element button { button.inner & button.submit.attrs }
+ button.submit.attrs =
+ ( common.attrs
+ & common-form.attrs
+ & button.submit.attrs.type?
+ & button.attrs.value?
+ & ( common.attrs.aria.implicit.button
+ | common.attrs.aria.role.button
+ | common.attrs.aria.role.checkbox
+ | common.attrs.aria.role.link
+ | common.attrs.aria.role.menuitem
+ | common.attrs.aria.role.menuitemcheckbox
+ | common.attrs.aria.role.menuitemradio
+ | common.attrs.aria.role.radio
+ )?
+ )
+ button.submit.attrs.type =
+ attribute type {
+ w:string "submit"
+ }
+
+ button.elem = button.submit.elem
+
+## Complex Reset Button: <button type='reset'>
+
+ button.reset.elem =
+ element button { button.inner & button.reset.attrs }
+ button.reset.attrs =
+ ( common.attrs
+ & common-form.attrs
+ & button.reset.attrs.type
+ & button.attrs.value? #REVISIT I guess this still affects
the DOM
+ & ( common.attrs.aria.implicit.button
+ | common.attrs.aria.role.button
+ | common.attrs.aria.role.checkbox
+ | common.attrs.aria.role.link
+ | common.attrs.aria.role.menuitem
+ | common.attrs.aria.role.menuitemcheckbox
+ | common.attrs.aria.role.menuitemradio
+ | common.attrs.aria.role.radio
+ | common.attrs.aria.role.switch
+ )?
+ )
+ button.reset.attrs.type =
+ attribute type {
+ w:string "reset"
+ }
+
+ button.elem |= button.reset.elem
+
+## Complex Push Button: <button type='button'>
+
+ button.button.elem =
+ element button { button.inner & button.button.attrs }
+ button.button.attrs =
+ ( common.attrs
+ & common-form.attrs
+ & button.button.attrs.type
+ & button.attrs.value? #REVISIT I guess this still affects
the DOM
+ & ( common.attrs.aria.implicit.button
+ | common.attrs.aria.role.button
+ | common.attrs.aria.role.checkbox
+ | common.attrs.aria.role.link
+ | common.attrs.aria.role.menuitem
+ | common.attrs.aria.role.menuitemcheckbox
+ | common.attrs.aria.role.menuitemradio
+ | common.attrs.aria.role.radio
+ | common.attrs.aria.role.switch
+ )?
+ )
+ button.button.attrs.type =
+ attribute type {
+ w:string "button"
+ }
+
+ button.elem |= button.button.elem
+
+ common.elem.phrasing |= button.elem
+
+## Form: <form>
+
+ form.elem =
+ element form { form.inner & form.attrs }
+ form.attrs =
+ ( common.attrs
+ & form.attrs.action? #REVISIT Should this be required
anyway?
+ & form.attrs.method?
+ & form.attrs.enctype?
+ & common-form.attrs.name?
+ & form.attrs.accept-charset?
+ & ( common.attrs.aria.implicit.form
+ | common.attrs.aria.landmark.form
+ | common.attrs.aria.role.search
+ | common.attrs.aria.role.presentation
+ )?
+ )
+ form.attrs.action =
+ attribute action {
+ common.data.uri.non-empty
+ }
+ form.attrs.method =
+ attribute method {
+ form.attrs.method.data
+ }
+ form.attrs.method.data =
+ ( w:string "get" | w:string "post" )
+ form.attrs.enctype =
+ attribute enctype {
+ form.attrs.enctype.data
+ }
+ form.attrs.enctype.data =
+ ( w:string
"application/x-www-form-urlencoded"
+ | w:string "multipart/form-data"
+ )
+ form.attrs.accept-charset =
+ attribute accept-charset {
+ form.data.charsetlist
+ }
+ form.inner =
+ ( common.inner.flow )
+
+ common.elem.flow |= form.elem
+
+## Fieldset: <fieldset>
+
+ fieldset.elem =
+ element fieldset { fieldset.inner & fieldset.attrs }
+ fieldset.attrs =
+ ( common.attrs
+ & ( common.attrs.aria.implicit.group
+ | common.attrs.aria
+ )?
+ )
+ fieldset.inner =
+ ( legend.elem? #REVISIT should this be required?
+ , common.inner.flow
+ )
+
+ common.elem.flow |= fieldset.elem
+
+## Label: <label>
+
+ label.elem =
+ element label { label.inner & label.attrs }
+ label.attrs =
+ ( common.attrs
+ & label.attrs.for?
+ & ( common.attrs.aria.role.presentation
+ | common.attrs.aria.role.menuitem
+ )?
+ )
+ label.attrs.for =
+ attribute for {
+ common.data.idref
+ }
+ label.inner =
+ ( common.inner.phrasing ) #REVISIT making obvious guess
+
+ common.elem.phrasing |= label.elem
+
diff --git a/packages/html5-schema/web-forms2-scripting.rnc
b/packages/html5-schema/web-forms2-scripting.rnc
new file mode 100644
index 0000000..e0f6a38
--- /dev/null
+++ b/packages/html5-schema/web-forms2-scripting.rnc
@@ -0,0 +1,9 @@
+# #####################################################################
+## RELAX NG Schema for HTML 5: Web Forms 2.0 Scripting #
+# #####################################################################
+
+# output.attrs &=
+# ( scripting.attr.form.formchange?
+# & scripting.attr.form.forminput?
+# & scripting.attr.form.change?
+# )
diff --git a/packages/html5-schema/web-forms2.rnc
b/packages/html5-schema/web-forms2.rnc
new file mode 100644
index 0000000..ebd3ee4
--- /dev/null
+++ b/packages/html5-schema/web-forms2.rnc
@@ -0,0 +1,789 @@
+datatypes w = "http://whattf.org/datatype-draft";
+
+# #####################################################################
+## RELAX NG Schema for HTML 5: Web Forms 2.0 markup #
+# #####################################################################
+
+## Shared attributes for form controls
+
+ common-form.attrs &=
+ ( common-form.attrs.form? )
+
+ common-form.attrs.form |=
+ attribute form {
+ common.data.idref
+ }
+
+ shared-form.attrs.formaction =
+ attribute formaction {
+ common.data.uri.non-empty
+ }
+
+ shared-form.attrs.formenctype =
+ attribute formenctype {
+ shared-form.attrs.formenctype.data
+ }
+ shared-form.attrs.formenctype.data =
+ ( w:string "application/x-www-form-urlencoded"
+ | w:string "multipart/form-data"
+ | w:string "text/plain"
+ )
+
+ shared-form.attrs.formmethod =
+ attribute formmethod {
+ shared-form.attrs.formmethod.data
+ }
+ shared-form.attrs.formmethod.data =
+ ( w:string "get"
+ | w:string "post"
+ )
+
+ shared-form.attrs.formtarget =
+ attribute formtarget {
+ common.data.browsing-context-or-keyword
+ }
+
+ shared-form.attrs.formnovalidate =
+ attribute formnovalidate {
+ w:string "formnovalidate" | w:string ""
+ }
+
+ shared-form.attrs.autofocus =
+ attribute autofocus {
+ w:string "autofocus" | w:string ""
+ }
+
+ shared-form.attrs.pattern =
+ attribute pattern {
+ form.data.pattern
+ }
+
+ shared-form.attrs.template =
+ attribute template {
+ common.data.idref
+ }
+
+ shared-form.attrs.required =
+ attribute required {
+ w:string "required" | w:string ""
+ }
+
+ shared-form.attrs.placeholder =
+ attribute placeholder {
+ form.data.stringwithoutlinebreaks
+ }
+
+ shared-form.attrs.dirname =
+ attribute dirname {
+ form.data.nonemptystring
+ }
+
+ shared-form.attrs.inputmode =
+ attribute inputmode {
+ string
+ }
+
+ shared-form.attrs.minlength =
+ attribute minlength {
+ common.data.integer.non-negative
+ }
+
+## Shared attributes for <input>
+
+ shared-input.attrs =
+ ( input.attrs.autocomplete?
+ & shared-form.attrs.autofocus?
+ & input.attrs.list?
+ & shared-form.attrs.maxlength?
+ & shared-form.attrs.minlength?
+ & shared-form.attrs.pattern?
+ & shared-form.attrs.placeholder?
+ & shared-form.attrs.readonly?
+ & shared-form.attrs.required?
+ & shared-form.attrs.size?
+ )
+
+ input.attrs.autocomplete =
+ attribute autocomplete {
+ w:string "on" | w:string "off"
+ }
+
+ input.attrs.list =
+ attribute list {
+ common.data.idref
+ }
+
+ input.attrs.step.float =
+ attribute step {
+ w:string "any" | common.data.float.positive
+ }
+
+ input.attrs.step.integer =
+ attribute step {
+ w:string "any" | common.data.integer.positive
+ }
+
+ input.attrs.multiple =
+ attribute multiple {
+ w:string "multiple" | w:string ""
+ }
+
+## Text Field: <input type='text'>, Extensions
+
+ input.text.attrs &=
+ ( input.attrs.autocomplete?
+ & shared-form.attrs.autofocus?
+ & shared-form.attrs.dirname?
+ & input.attrs.list?
+ & shared-form.attrs.pattern?
+ & shared-form.attrs.required?
+ & shared-form.attrs.placeholder?
+ & shared-form.attrs.inputmode?
+ & shared-form.attrs.minlength?
+ )
+
+## Password Field: <input type='password'>, Extensions
+
+ input.password.attrs &=
+ ( input.attrs.autocomplete?
+ & shared-form.attrs.autofocus?
+ & input.attrs.list?
+ & shared-form.attrs.pattern?
+ & shared-form.attrs.placeholder?
+ & shared-form.attrs.required?
+ & shared-form.attrs.minlength?
+ )
+
+## Checkbox <input type='checkbox'>, Extensions
+
+ input.checkbox.attrs &=
+ ( shared-input.attrs )
+
+## Radiobutton: <input type='radio'>, Extensions
+
+ input.radio.attrs &=
+ ( shared-input.attrs )
+
+## Scripting Hook Button: <input type='button'>, Extensions
+
+ input.button.attrs &=
+ ( shared-input.attrs )
+
+## Submit Button: <input type='submit'>, Extensions
+
+ input.submit.attrs &=
+ ( shared-input.attrs
+ & shared-form.attrs.formaction?
+ & shared-form.attrs.formenctype?
+ & shared-form.attrs.formmethod?
+ & shared-form.attrs.formtarget?
+ & shared-form.attrs.formnovalidate?
+ )
+
+## Reset Button: <input type='reset'>, Extensions
+
+ input.reset.attrs &=
+ ( shared-input.attrs )
+
+## File Upload: <input type='file'>, Extensions
+
+ input.file.attrs &=
+ ( shared-input.attrs
+ & input.attrs.multiple?
+ )
+
+## Image Submit Button: <input type='image'>, Extensions
+
+ input.image.attrs &=
+ ( shared-input.attrs
+ & shared-form.attrs.formaction?
+ & shared-form.attrs.formenctype?
+ & shared-form.attrs.formmethod?
+ & shared-form.attrs.formtarget?
+ & shared-form.attrs.formnovalidate?
+ & input.image.attrs.height?
+ & input.image.attrs.width?
+ )
+ input.image.attrs.height =
+ attribute height {
+ common.data.integer.non-negative
+ }
+ input.image.attrs.width =
+ attribute width {
+ common.data.integer.non-negative
+ }
+
+## Global Date and Time: <input type='datetime'>
+
+ input.datetime.elem =
+ element input { input.datetime.attrs }
+ input.datetime.attrs =
+ ( common.attrs
+ & common-form.attrs
+ & shared-input.attrs
+ & input.datetime.attrs.type
+ & input.datetime.attrs.min?
+ & input.datetime.attrs.max?
+ & input.attrs.step.float?
+ & input.datetime.attrs.value?
+ & common.attrs.aria?
+ )
+ input.datetime.attrs.type =
+ attribute type {
+ w:string "datetime"
+ }
+ input.datetime.attrs.min =
+ attribute min {
+ common.data.datetime
+ }
+ input.datetime.attrs.max =
+ attribute max {
+ common.data.datetime
+ }
+ input.datetime.attrs.value =
+ attribute value {
+ w:string "" | common.data.datetime
+ }
+
+ input.elem |= input.datetime.elem
+
+## Date and Time with No Time Zone Information: <input type='datetime-local'>
+
+ input.datetime-local.elem =
+ element input { input.datetime-local.attrs }
+ input.datetime-local.attrs =
+ ( common.attrs
+ & common-form.attrs
+ & shared-input.attrs
+ & input.datetime-local.attrs.type
+ & input.datetime-local.attrs.min?
+ & input.datetime-local.attrs.max?
+ & input.attrs.step.float?
+ & input.datetime-local.attrs.value?
+ & common.attrs.aria?
+ )
+ input.datetime-local.attrs.type =
+ attribute type {
+ w:string "datetime-local"
+ }
+ input.datetime-local.attrs.min =
+ attribute min {
+ form.data.datetime-local
+ }
+ input.datetime-local.attrs.max =
+ attribute max {
+ form.data.datetime-local
+ }
+ input.datetime-local.attrs.value =
+ attribute value {
+ w:string "" | form.data.datetime-local
+ }
+
+ input.elem |= input.datetime-local.elem
+
+## Date: <input type='date'>
+
+ input.date.elem =
+ element input { input.date.attrs }
+ input.date.attrs =
+ ( common.attrs
+ & common-form.attrs
+ & shared-input.attrs
+ & input.date.attrs.type
+ & input.date.attrs.min?
+ & input.date.attrs.max?
+ & input.attrs.step.integer?
+ & input.date.attrs.value?
+ & common.attrs.aria?
+ )
+ input.date.attrs.type =
+ attribute type {
+ w:string "date"
+ }
+ input.date.attrs.min =
+ attribute min {
+ form.data.date
+ }
+ input.date.attrs.max =
+ attribute max {
+ form.data.date
+ }
+ input.date.attrs.value =
+ attribute value {
+ w:string "" | form.data.date
+ }
+
+ input.elem |= input.date.elem
+
+## Year and Month: <input type='month'>
+
+ input.month.elem =
+ element input { input.month.attrs }
+ input.month.attrs =
+ ( common.attrs
+ & common-form.attrs
+ & shared-input.attrs
+ & input.month.attrs.type
+ & input.month.attrs.min?
+ & input.month.attrs.max?
+ & input.attrs.step.integer?
+ & input.month.attrs.value?
+ & common.attrs.aria?
+ )
+ input.month.attrs.type =
+ attribute type {
+ w:string "month"
+ }
+ input.month.attrs.min =
+ attribute min {
+ form.data.month
+ }
+ input.month.attrs.max =
+ attribute max {
+ form.data.month
+ }
+ input.month.attrs.value =
+ attribute value {
+ w:string "" | form.data.month
+ }
+
+ input.elem |= input.month.elem
+
+## Time without Time Zone Information: <input type='time'>
+
+ input.time.elem =
+ element input { input.time.attrs }
+ input.time.attrs =
+ ( common.attrs
+ & common-form.attrs
+ & shared-input.attrs
+ & input.time.attrs.type
+ & input.time.attrs.min?
+ & input.time.attrs.max?
+ & input.attrs.step.float?
+ & input.time.attrs.value?
+ & common.attrs.aria?
+ )
+ input.time.attrs.type =
+ attribute type {
+ w:string "time"
+ }
+ input.time.attrs.min =
+ attribute min {
+ form.data.time
+ }
+ input.time.attrs.max =
+ attribute max {
+ form.data.time
+ }
+ input.time.attrs.value =
+ attribute value {
+ w:string "" | form.data.time
+ }
+
+ input.elem |= input.time.elem
+
+## Year and Week: <input type='week'>
+
+ input.week.elem =
+ element input { input.week.attrs }
+ input.week.attrs =
+ ( common.attrs
+ & common-form.attrs
+ & shared-input.attrs
+ & input.week.attrs.type
+ & input.week.attrs.min?
+ & input.week.attrs.max?
+ & input.attrs.step.integer?
+ & input.week.attrs.value?
+ & common.attrs.aria?
+ )
+ input.week.attrs.type =
+ attribute type {
+ w:string "week"
+ }
+ input.week.attrs.min =
+ attribute min {
+ form.data.week
+ }
+ input.week.attrs.max =
+ attribute max {
+ form.data.week
+ }
+ input.week.attrs.value =
+ attribute value {
+ w:string "" | form.data.week
+ }
+
+ input.elem |= input.week.elem
+
+## Number: <input type='number'>
+
+ input.number.elem =
+ element input { input.number.attrs }
+ input.number.attrs =
+ ( common.attrs
+ & common-form.attrs
+ & shared-input.attrs
+ & input.number.attrs.type
+ & input.number.attrs.min?
+ & input.number.attrs.max?
+ & input.attrs.step.float?
+ & input.number.attrs.value?
+ & ( common.attrs.aria.implicit.spinbutton
+ | common.attrs.aria.role.spinbutton
+ )?
+ )
+ input.number.attrs.type =
+ attribute type {
+ w:string "number"
+ }
+ input.number.attrs.min =
+ attribute min {
+ common.data.float
+ }
+ input.number.attrs.max =
+ attribute max {
+ common.data.float
+ }
+ input.number.attrs.value =
+ attribute value {
+ w:string "" | common.data.float
+ }
+
+ input.elem |= input.number.elem
+
+## Imprecise Number: <input type='range'>
+
+ input.range.elem =
+ element input { input.range.attrs }
+ input.range.attrs =
+ ( common.attrs
+ & common-form.attrs
+ & shared-input.attrs
+ & input.range.attrs.type
+ & input.range.attrs.min?
+ & input.range.attrs.max?
+ & input.attrs.step.float?
+ & input.range.attrs.value?
+ & ( common.attrs.aria.implicit.slider
+ | common.attrs.aria.role.slider
+ )?
+ )
+ input.range.attrs.type =
+ attribute type {
+ w:string "range"
+ }
+ input.range.attrs.min =
+ attribute min {
+ common.data.float
+ }
+ input.range.attrs.max =
+ attribute max {
+ common.data.float
+ }
+ input.range.attrs.value =
+ attribute value {
+ common.data.float
+ }
+
+ input.elem |= input.range.elem
+
+## Email Address: <input type='email'>
+
+ input.email.elem =
+ element input { input.email.attrs }
+ input.email.attrs =
+ ( common.attrs
+ & common-form.attrs
+ & shared-input.attrs
+ & input.email.attrs.type
+ & ( ( input.attrs.multiple
+ & input.email.attrs.value.multiple?
+ )
+ | input.email.attrs.value.single?
+ )?
+ & ( common.attrs.aria.implicit.textbox
+ | common.attrs.aria.implicit.combobox
+ | common.attrs.aria.role.textbox
+ | common.attrs.aria.role.combobox
+ )?
+ )
+ input.email.attrs.type =
+ attribute type {
+ w:string "email"
+ }
+ input.email.attrs.value.single =
+ attribute value {
+ form.data.emailaddress
+ }
+ input.email.attrs.value.multiple =
+ attribute value {
+ form.data.emailaddresslist
+ }
+
+ input.elem |= input.email.elem
+
+## IRI: <input type='url'>
+
+ input.url.elem =
+ element input { input.url.attrs }
+ input.url.attrs =
+ ( common.attrs
+ & common-form.attrs
+ & shared-input.attrs
+ & input.url.attrs.type
+ & input.url.attrs.value?
+ & ( common.attrs.aria.implicit.textbox
+ | common.attrs.aria.implicit.combobox
+ | common.attrs.aria.role.textbox
+ | common.attrs.aria.role.combobox
+ )?
+ )
+ input.url.attrs.type =
+ attribute type {
+ w:string "url"
+ }
+ input.url.attrs.value =
+ attribute value {
+ w:string "" | common.data.uri.absolute
+ }
+
+ input.elem |= input.url.elem
+
+## Search: <input type='search'>
+
+ input.search.elem =
+ element input { input.search.attrs }
+ input.search.attrs =
+ ( common.attrs
+ & common-form.attrs
+ & shared-input.attrs
+ & input.search.attrs.type
+ & input.search.attrs.value?
+ & shared-form.attrs.dirname?
+ & ( common.attrs.aria.implicit.textbox
+ | common.attrs.aria.implicit.combobox
+ | common.attrs.aria.role.textbox
+ | common.attrs.aria.role.combobox
+ )?
+ )
+ input.search.attrs.type =
+ attribute type {
+ w:string "search"
+ }
+ input.search.attrs.value =
+ attribute value {
+ form.data.stringwithoutlinebreaks
+ }
+
+ input.elem |= input.search.elem
+
+## Telephone Number: <input type='tel'>
+
+ input.tel.elem =
+ element input { input.tel.attrs }
+ input.tel.attrs =
+ ( common.attrs
+ & common-form.attrs
+ & shared-input.attrs
+ & input.tel.attrs.type
+ & input.tel.attrs.value?
+ & ( common.attrs.aria.implicit.textbox
+ | common.attrs.aria.implicit.combobox
+ | common.attrs.aria.role.textbox
+ | common.attrs.aria.role.combobox
+ )?
+ )
+ input.tel.attrs.type =
+ attribute type {
+ w:string "tel"
+ }
+ input.tel.attrs.value =
+ attribute value {
+ form.data.stringwithoutlinebreaks
+ }
+
+ input.elem |= input.tel.elem
+
+## Color: <input type='color'>
+
+ input.color.elem =
+ element input { input.color.attrs }
+ input.color.attrs =
+ ( common.attrs
+ & common-form.attrs
+ & input.color.attrs.type
+ & input.color.attrs.value?
+ & shared-input.attrs
+ & common.attrs.aria?
+ )
+ input.color.attrs.type =
+ attribute type {
+ w:string "color"
+ }
+ input.color.attrs.value =
+ attribute value {
+ w:string "" | form.data.color
+ }
+
+ input.elem |= input.color.elem
+
+## Form Output: <output>
+
+ output.elem =
+ element output { output.inner & output.attrs }
+ output.attrs =
+ ( common.attrs
+ & common-form.attrs.name?
+ & common-form.attrs.form?
+ & output.attrs.for?
+ & ( common.attrs.aria.implicit.status
+ | common.attrs.aria
+ )?
+ )
+ output.attrs.for =
+ attribute for {
+ common.data.idrefs #REVISIT spec says
space--not whitespace
+ }
+ output.inner =
+ ( common.inner.phrasing )
+
+ common.elem.phrasing |= output.elem
+
+## Text Area: <textarea>, extensions
+
+ textarea.attrs.rows-and-cols-wf1.inner &=
+ notAllowed
+ textarea.attrs.rows-and-cols-wf1 |=
+ empty
+ textarea.attrs &=
+ ( shared-form.attrs.maxlength?
+ & shared-form.attrs.minlength?
+ & shared-form.attrs.autofocus?
+ & shared-form.attrs.required?
+ & shared-form.attrs.placeholder?
+ & shared-form.attrs.dirname?
+ & textarea.attrs.rows?
+ & ( ( textarea.attrs.wrap.hard
+ & textarea.attrs.cols
+ )
+ | ( textarea.attrs.wrap.soft?
+ & textarea.attrs.cols?
+ )
+ )
+ & shared-form.attrs.inputmode?
+ )
+ textarea.attrs.wrap.hard =
+ attribute wrap {
+ w:string "hard"
+ }
+ textarea.attrs.wrap.soft =
+ attribute wrap {
+ w:string "soft"
+ }
+
+## List of Prefill Data: <datalist>
+
+ #REVISIT should the options in datalist be non-selectable?
+
+ datalist.elem =
+ element datalist { datalist.inner & datalist.attrs }
+ datalist.inner =
+ ( option.elem* & common.inner.phrasing )
+ datalist.attrs =
+ ( common.attrs
+ & ( common.attrs.aria.role.listbox #
aria-multiselectable must be false; check by assertions
+ | common.attrs.aria.role.presentation
+ | common.attrs.aria.role.menuitem
+ )?
+ )
+
+ common.elem.phrasing |= datalist.elem
+
+## Complex Submit Button: <button type='submit'>, extensions
+
+ button.submit.attrs &=
+ ( shared-form.attrs.formaction?
+ & shared-form.attrs.autofocus?
+ & shared-form.attrs.formenctype?
+ & shared-form.attrs.formmethod?
+ & shared-form.attrs.formtarget?
+ & shared-form.attrs.formnovalidate?
+ )
+
+## Complex Reset Button: <button type='reset'>, extensions
+
+ button.reset.attrs &=
+ ( shared-form.attrs.autofocus? )
+
+## Complex Push Button: <button type='button'>, extensions
+
+ button.button.attrs &=
+ ( shared-form.attrs.autofocus? )
+
+## Form: <form>, extensions
+ form.attrs &=
+ ( form.attrs.novalidate?
+ & form.attrs.target?
+ & form.attrs.autocomplete?
+ )
+ form.attrs.novalidate =
+ attribute novalidate {
+ w:string "novalidate" | w:string ""
+ }
+ form.attrs.target =
+ attribute target {
+ common.data.browsing-context-or-keyword
+ }
+ form.attrs.autocomplete =
+ attribute autocomplete {
+ w:string "on" | w:string "off"
+ }
+ # REVISIT should this be case-insensitive in conforming XHTML
documents?
+ form.attrs.enctype.data |=
+ ( w:string "text/plain" )
+
+## Fieldset: <fieldset>, extensions
+
+ fieldset.attrs &=
+ ( common-form.attrs )
+
+## Label: <label>, extensions
+
+ label.attrs &=
+ ( common-form.attrs.form? )
+
+## Key-pair generator/input control: <keygen>
+
+ keygen.elem =
+ element keygen { keygen.inner & keygen.attrs }
+ keygen.attrs =
+ ( common.attrs
+ & keygen.attrs.challenge?
+ & keygen.attrs.keytype?
+ & shared-form.attrs.autofocus?
+ & common-form.attrs?
+ & ( common.attrs.aria.role.presentation
+ | common.attrs.aria.role.menuitem
+ )?
+ )
+ keygen.attrs.challenge =
+ attribute challenge {
+ string
+ }
+ keygen.attrs.keytype =
+ attribute keytype {
+ w:string "rsa"
+ }
+ keygen.inner =
+ ( empty )
+
+ common.elem.phrasing |= keygen.elem
+
+## Selection Menu: <select>, Extensions
+
+ select.attrs &=
+ ( shared-form.attrs.autofocus?
+ & shared-form.attrs.required?
+ )
diff --git a/packages/html5-schema/xhtml5.rnc b/packages/html5-schema/xhtml5.rnc
new file mode 100644
index 0000000..1c6c524
--- /dev/null
+++ b/packages/html5-schema/xhtml5.rnc
@@ -0,0 +1,40 @@
+default namespace = "http://www.w3.org/1999/xhtml";
+# #####################################################################
+## RELAX NG Schema for XHTML 5 #
+# #####################################################################
+
+ # To validate an XHTML 5 document, you must first validate against #
+ # this schema and then ALSO validate against assertions.sch #
+
+# #####################################################################
+## Schema Framework & Parameters
+
+include "common.rnc" {
+ # XHTML flavor #
+ XMLonly = empty
+ HTMLonly = notAllowed
+ # HTML 4 compat #
+ v5only = empty
+}
+
+# #####################################################################
+## Language Definitions
+
+start = html.elem
+
+include "meta.rnc"
+include "phrase.rnc"
+include "block.rnc"
+include "sectional.rnc"
+include "structural.rnc"
+include "revision.rnc"
+include "embed.rnc"
+include "ruby.rnc"
+include "media.rnc"
+include "core-scripting.rnc"
+include "tables.rnc"
+include "form-datatypes.rnc"
+include "web-forms.rnc"
+include "web-forms2.rnc"
+include "applications.rnc"
+include "data.rnc"
diff --git a/packages/hydra/.dir-locals.el b/packages/hydra/.dir-locals.el
new file mode 100644
index 0000000..eb08357
--- /dev/null
+++ b/packages/hydra/.dir-locals.el
@@ -0,0 +1,6 @@
+;;; Directory Local Variables
+;;; For more information see (info "(emacs) Directory Variables")
+
+((emacs-lisp-mode
+ (bug-reference-url-format . "https://github.com/abo-abo/hydra/issues/%s";)
+ (indent-tabs-mode . nil)))
diff --git a/packages/hydra/.travis.yml b/packages/hydra/.travis.yml
index 1f5dbc7..e97acdb 100644
--- a/packages/hydra/.travis.yml
+++ b/packages/hydra/.travis.yml
@@ -1,12 +1,14 @@
language: emacs-lisp
env:
matrix:
- - EMACS=emacs24
+ - emacs=emacs24
+ - emacs=emacs-snapshot
before_install:
- sudo add-apt-repository -y ppa:cassou/emacs
+ - sudo add-apt-repository -y ppa:ubuntu-elisp
- sudo apt-get update -qq
- - sudo apt-get install -qq $EMACS
+ - sudo apt-get install -qq $emacs
script:
- make test
diff --git a/packages/hydra/Makefile b/packages/hydra/Makefile
index 35709e1..13fd618 100644
--- a/packages/hydra/Makefile
+++ b/packages/hydra/Makefile
@@ -8,11 +8,15 @@ LOAD = -l lv.el -l hydra.el -l hydra-test.el
all: test
test:
+ @echo "Using $(shell which $(emacs))..."
$(emacs) -batch $(LOAD) -f ert-run-tests-batch-and-exit
-compile:
- $(emacs) -q $(LOAD) -l hydra-init.el
+run:
+ $(emacs) -q $(LOAD) -l targets/hydra-init.el
make clean
+compile:
+ $(emacs) -batch $(LOAD) -l targets/hydra-init.el
+
clean:
rm -f *.elc
diff --git a/packages/hydra/README.md b/packages/hydra/README.md
index 172524e..d2237d8 100644
--- a/packages/hydra/README.md
+++ b/packages/hydra/README.md
@@ -5,6 +5,8 @@ bindings with a common prefix - a Hydra.
+## Description for Poets
+
Once you summon the Hydra through the prefixed binding (the body + any one
head), all heads can be
called in succession with only a short extension.
@@ -13,6 +15,22 @@ Hercules, besides vanquishing the Hydra, will still serve
his original purpose,
command. This makes the Hydra very seamless, it's like a minor mode that
disables itself
auto-magically.
+## Description for Pragmatics
+
+Imagine that you have bound <kbd>C-c j</kbd> and <kbd>C-c k</kbd> in your
+config. You want to call <kbd>C-c j</kbd> and <kbd>C-c k</kbd> in some
+(arbitrary) sequence. Hydra allows you to:
+
+- Bind your functions in a way that pressing <kbd>C-c jjkk3j5k</kbd> is
+equivalent to pressing <kbd>C-c j C-c j C-c k C-c k M-3 C-c j M-5 C-c
+k</kbd>. Any key other than <kbd>j</kbd> or <kbd>k</kbd> exits this state.
+
+- Assign a custom hint to this group of functions, so that you know immediately
+after pressing <kbd>C-c</kbd> that you can follow up with <kbd>j</kbd> or
+<kbd>k</kbd>.
+
+If you want to quickly understand the concept, see [the video
demo](https://www.youtube.com/watch?v=_qZliI1BKzI).
+
<!-- markdown-toc start - Don't edit this section. Run M-x
markdown-toc/generate-toc again -->
**Table of Contents**
@@ -158,41 +176,21 @@ Here's what `hydra-zoom/body` looks like, if you're
interested:
The body can be accessed via `hydra-zoom/body'."
(interactive)
- (hydra-disable)
- (catch (quote hydra-disable)
- (when hydra-is-helpful (hydra-zoom/hint))
- (setq hydra-last
- (hydra-set-transient-map
- (setq hydra-curr-map
- (quote
- (keymap (7 . hydra-keyboard-quit)
- (108 . hydra-zoom/text-scale-decrease)
- (103 . hydra-zoom/text-scale-increase)
- (kp-subtract . hydra--negative-argument)
- (kp-9 . hydra--digit-argument)
- (kp-8 . hydra--digit-argument)
- (kp-7 . hydra--digit-argument)
- (kp-6 . hydra--digit-argument)
- (kp-5 . hydra--digit-argument)
- (kp-4 . hydra--digit-argument)
- (kp-3 . hydra--digit-argument)
- (kp-2 . hydra--digit-argument)
- (kp-1 . hydra--digit-argument)
- (kp-0 . hydra--digit-argument)
- (57 . hydra--digit-argument)
- (56 . hydra--digit-argument)
- (55 . hydra--digit-argument)
- (54 . hydra--digit-argument)
- (53 . hydra--digit-argument)
- (52 . hydra--digit-argument)
- (51 . hydra--digit-argument)
- (50 . hydra--digit-argument)
- (49 . hydra--digit-argument)
- (48 . hydra--digit-argument)
- (45 . hydra--negative-argument)
- (21 . hydra--universal-argument))))
- t (lambda nil (hydra-cleanup))))
- (setq prefix-arg current-prefix-arg)))
+ (hydra-default-pre)
+ (when hydra-is-helpful
+ (if hydra-lv
+ (lv-message
+ (eval hydra-zoom/hint))
+ (message
+ (eval hydra-zoom/hint))))
+ (hydra-set-transient-map
+ hydra-zoom/keymap
+ (lambda nil
+ (hydra-keyboard-quit)
+ nil)
+ nil)
+ (setq prefix-arg
+ current-prefix-arg))
```
## `awesome-map` and `awesome-binding`
diff --git a/packages/hydra/hydra-examples.el b/packages/hydra/hydra-examples.el
index 67aaffd..1468f3f 100644
--- a/packages/hydra/hydra-examples.el
+++ b/packages/hydra/hydra-examples.el
@@ -224,6 +224,8 @@ _~_: modified ^ ^ ^ ^ ^^
;;** Example 9: s-expressions in the docstring
;; You can inline s-expresssions into the docstring like this:
+(defvar dired-mode-map)
+(declare-function dired-mark "dired")
(when (bound-and-true-p hydra-examples-verbatim)
(require 'dired)
(defhydra hydra-marked-items (dired-mode-map "")
diff --git a/packages/hydra/hydra-ox.el b/packages/hydra/hydra-ox.el
index 1dc7088..e8d48e3 100644
--- a/packages/hydra/hydra-ox.el
+++ b/packages/hydra/hydra-ox.el
@@ -24,6 +24,8 @@
;; This shows how a complex dispatch menu can be built with Hydra.
;;; Code:
+
+(require 'hydra)
(require 'org)
(require 'hydra) ;`defhydradio' is not autoloaded!
diff --git a/packages/hydra/hydra-test.el b/packages/hydra/hydra-test.el
index f876e36..a40a0ca 100644
--- a/packages/hydra/hydra-test.el
+++ b/packages/hydra/hydra-test.el
@@ -26,6 +26,8 @@
(require 'ert)
(require 'hydra)
+(setq text-quoting-style 'grave)
+(message "Emacs version: %s" emacs-version)
(ert-deftest hydra-red-error ()
(should
@@ -38,7 +40,71 @@
("k" previous-error "prev")
("SPC" hydra-repeat "rep" :bind nil)))
'(progn
- (defun hydra-error/first-error nil "Create a hydra with a \"M-g\" body
and the heads:
+ (set
+ (defvar hydra-error/keymap nil
+ "Keymap for hydra-error.")
+ (quote
+ (keymap
+ (32 . hydra-repeat)
+ (107 . hydra-error/previous-error)
+ (106 . hydra-error/next-error)
+ (104 . hydra-error/first-error)
+ (kp-subtract . hydra--negative-argument)
+ (kp-9 . hydra--digit-argument)
+ (kp-8 . hydra--digit-argument)
+ (kp-7 . hydra--digit-argument)
+ (kp-6 . hydra--digit-argument)
+ (kp-5 . hydra--digit-argument)
+ (kp-4 . hydra--digit-argument)
+ (kp-3 . hydra--digit-argument)
+ (kp-2 . hydra--digit-argument)
+ (kp-1 . hydra--digit-argument)
+ (kp-0 . hydra--digit-argument)
+ (57 . hydra--digit-argument)
+ (56 . hydra--digit-argument)
+ (55 . hydra--digit-argument)
+ (54 . hydra--digit-argument)
+ (53 . hydra--digit-argument)
+ (52 . hydra--digit-argument)
+ (51 . hydra--digit-argument)
+ (50 . hydra--digit-argument)
+ (49 . hydra--digit-argument)
+ (48 . hydra--digit-argument)
+ (45 . hydra--negative-argument)
+ (21 . hydra--universal-argument))))
+ (set
+ (defvar hydra-error/heads nil
+ "Heads for hydra-error.")
+ (quote
+ (("h"
+ first-error
+ "first"
+ :exit nil)
+ ("j"
+ next-error
+ "next"
+ :exit nil)
+ ("k"
+ previous-error
+ "prev"
+ :exit nil)
+ ("SPC"
+ hydra-repeat
+ "rep"
+ :bind nil
+ :exit nil))))
+ (set
+ (defvar hydra-error/hint nil
+ "Dynamic hint for hydra-error.")
+ (quote
+ (format
+ #("error: [h]: first, [j]: next, [k]: prev, [SPC]: rep."
+ 8 9 (face hydra-face-red)
+ 20 21 (face hydra-face-red)
+ 31 32 (face hydra-face-red)
+ 42 45 (face hydra-face-red)))))
+ (defun hydra-error/first-error nil
+ "Create a hydra with a \"M-g\" body and the heads:
\"h\": `first-error',
\"j\": `next-error',
@@ -48,50 +114,35 @@
The body can be accessed via `hydra-error/body'.
Call the head: `first-error'."
- (interactive)
- (hydra-default-pre)
- (hydra-disable)
- (catch (quote hydra-disable)
- (condition-case err (prog1 t (call-interactively (function
first-error)))
- ((quit error)
- (message "%S" err)
- (unless hydra-lv (sit-for 0.8))
- nil))
- (when hydra-is-helpful (hydra-error/hint))
- (setq hydra-last
- (hydra-set-transient-map
- (setq hydra-curr-map
- (quote (keymap (7 . hydra-keyboard-quit)
- (32 . hydra-repeat)
- (107 . hydra-error/previous-error)
- (106 . hydra-error/next-error)
- (104 . hydra-error/first-error)
- (switch-frame .
hydra--handle-switch-frame)
- (kp-subtract .
hydra--negative-argument)
- (kp-9 . hydra--digit-argument)
- (kp-8 . hydra--digit-argument)
- (kp-7 . hydra--digit-argument)
- (kp-6 . hydra--digit-argument)
- (kp-5 . hydra--digit-argument)
- (kp-4 . hydra--digit-argument)
- (kp-3 . hydra--digit-argument)
- (kp-2 . hydra--digit-argument)
- (kp-1 . hydra--digit-argument)
- (kp-0 . hydra--digit-argument)
- (57 . hydra--digit-argument)
- (56 . hydra--digit-argument)
- (55 . hydra--digit-argument)
- (54 . hydra--digit-argument)
- (53 . hydra--digit-argument)
- (52 . hydra--digit-argument)
- (51 . hydra--digit-argument)
- (50 . hydra--digit-argument)
- (49 . hydra--digit-argument)
- (48 . hydra--digit-argument)
- (45 . hydra--negative-argument)
- (21 . hydra--universal-argument))))
- t (lambda nil (hydra-cleanup))))))
- (defun hydra-error/next-error nil "Create a hydra with a \"M-g\" body
and the heads:
+ (interactive)
+ (hydra-default-pre)
+ (let ((hydra--ignore t))
+ (hydra-keyboard-quit)
+ (setq hydra-curr-body-fn
+ (quote hydra-error/body)))
+ (condition-case err
+ (progn
+ (setq this-command
+ (quote first-error))
+ (call-interactively
+ (function first-error)))
+ ((quit error)
+ (message "%S" err)
+ (unless hydra-lv (sit-for 0.8))))
+ (when hydra-is-helpful
+ (if hydra-lv
+ (lv-message
+ (eval hydra-error/hint))
+ (message
+ (eval hydra-error/hint))))
+ (hydra-set-transient-map
+ hydra-error/keymap
+ (lambda nil
+ (hydra-keyboard-quit)
+ nil)
+ nil))
+ (defun hydra-error/next-error nil
+ "Create a hydra with a \"M-g\" body and the heads:
\"h\": `first-error',
\"j\": `next-error',
@@ -101,50 +152,35 @@ Call the head: `first-error'."
The body can be accessed via `hydra-error/body'.
Call the head: `next-error'."
- (interactive)
- (hydra-default-pre)
- (hydra-disable)
- (catch (quote hydra-disable)
- (condition-case err (prog1 t (call-interactively (function
next-error)))
- ((quit error)
- (message "%S" err)
- (unless hydra-lv (sit-for 0.8))
- nil))
- (when hydra-is-helpful (hydra-error/hint))
- (setq hydra-last
- (hydra-set-transient-map
- (setq hydra-curr-map
- (quote (keymap (7 . hydra-keyboard-quit)
- (32 . hydra-repeat)
- (107 . hydra-error/previous-error)
- (106 . hydra-error/next-error)
- (104 . hydra-error/first-error)
- (switch-frame .
hydra--handle-switch-frame)
- (kp-subtract .
hydra--negative-argument)
- (kp-9 . hydra--digit-argument)
- (kp-8 . hydra--digit-argument)
- (kp-7 . hydra--digit-argument)
- (kp-6 . hydra--digit-argument)
- (kp-5 . hydra--digit-argument)
- (kp-4 . hydra--digit-argument)
- (kp-3 . hydra--digit-argument)
- (kp-2 . hydra--digit-argument)
- (kp-1 . hydra--digit-argument)
- (kp-0 . hydra--digit-argument)
- (57 . hydra--digit-argument)
- (56 . hydra--digit-argument)
- (55 . hydra--digit-argument)
- (54 . hydra--digit-argument)
- (53 . hydra--digit-argument)
- (52 . hydra--digit-argument)
- (51 . hydra--digit-argument)
- (50 . hydra--digit-argument)
- (49 . hydra--digit-argument)
- (48 . hydra--digit-argument)
- (45 . hydra--negative-argument)
- (21 . hydra--universal-argument))))
- t (lambda nil (hydra-cleanup))))))
- (defun hydra-error/previous-error nil "Create a hydra with a \"M-g\"
body and the heads:
+ (interactive)
+ (hydra-default-pre)
+ (let ((hydra--ignore t))
+ (hydra-keyboard-quit)
+ (setq hydra-curr-body-fn
+ (quote hydra-error/body)))
+ (condition-case err
+ (progn
+ (setq this-command
+ (quote next-error))
+ (call-interactively
+ (function next-error)))
+ ((quit error)
+ (message "%S" err)
+ (unless hydra-lv (sit-for 0.8))))
+ (when hydra-is-helpful
+ (if hydra-lv
+ (lv-message
+ (eval hydra-error/hint))
+ (message
+ (eval hydra-error/hint))))
+ (hydra-set-transient-map
+ hydra-error/keymap
+ (lambda nil
+ (hydra-keyboard-quit)
+ nil)
+ nil))
+ (defun hydra-error/previous-error nil
+ "Create a hydra with a \"M-g\" body and the heads:
\"h\": `first-error',
\"j\": `next-error',
@@ -154,68 +190,48 @@ Call the head: `next-error'."
The body can be accessed via `hydra-error/body'.
Call the head: `previous-error'."
- (interactive)
- (hydra-default-pre)
- (hydra-disable)
- (catch (quote hydra-disable)
- (condition-case err (prog1 t (call-interactively (function
previous-error)))
- ((quit error)
- (message "%S" err)
- (unless hydra-lv (sit-for 0.8))
- nil))
- (when hydra-is-helpful (hydra-error/hint))
- (setq hydra-last
- (hydra-set-transient-map
- (setq hydra-curr-map
- (quote (keymap (7 . hydra-keyboard-quit)
- (32 . hydra-repeat)
- (107 . hydra-error/previous-error)
- (106 . hydra-error/next-error)
- (104 . hydra-error/first-error)
- (switch-frame .
hydra--handle-switch-frame)
- (kp-subtract .
hydra--negative-argument)
- (kp-9 . hydra--digit-argument)
- (kp-8 . hydra--digit-argument)
- (kp-7 . hydra--digit-argument)
- (kp-6 . hydra--digit-argument)
- (kp-5 . hydra--digit-argument)
- (kp-4 . hydra--digit-argument)
- (kp-3 . hydra--digit-argument)
- (kp-2 . hydra--digit-argument)
- (kp-1 . hydra--digit-argument)
- (kp-0 . hydra--digit-argument)
- (57 . hydra--digit-argument)
- (56 . hydra--digit-argument)
- (55 . hydra--digit-argument)
- (54 . hydra--digit-argument)
- (53 . hydra--digit-argument)
- (52 . hydra--digit-argument)
- (51 . hydra--digit-argument)
- (50 . hydra--digit-argument)
- (49 . hydra--digit-argument)
- (48 . hydra--digit-argument)
- (45 . hydra--negative-argument)
- (21 . hydra--universal-argument))))
- t (lambda nil (hydra-cleanup))))))
- (unless (keymapp (lookup-key global-map (kbd "M-g")))
+ (interactive)
+ (hydra-default-pre)
+ (let ((hydra--ignore t))
+ (hydra-keyboard-quit)
+ (setq hydra-curr-body-fn
+ (quote hydra-error/body)))
+ (condition-case err
+ (progn
+ (setq this-command
+ (quote previous-error))
+ (call-interactively
+ (function previous-error)))
+ ((quit error)
+ (message "%S" err)
+ (unless hydra-lv (sit-for 0.8))))
+ (when hydra-is-helpful
+ (if hydra-lv
+ (lv-message
+ (eval hydra-error/hint))
+ (message
+ (eval hydra-error/hint))))
+ (hydra-set-transient-map
+ hydra-error/keymap
+ (lambda nil
+ (hydra-keyboard-quit)
+ nil)
+ nil))
+ (unless (keymapp
+ (lookup-key
+ global-map
+ (kbd "M-g")))
(define-key global-map (kbd "M-g")
nil))
(define-key global-map [134217831 104]
- (function hydra-error/first-error))
+ (quote hydra-error/first-error))
(define-key global-map [134217831 106]
- (function hydra-error/next-error))
+ (quote hydra-error/next-error))
(define-key global-map [134217831 107]
- (function hydra-error/previous-error))
- (defun hydra-error/hint nil
- (if hydra-lv (lv-message (format #("error: [h]: first, [j]: next, [k]:
prev, [SPC]: rep." 8 9 (face hydra-face-red)
- 20 21 (face hydra-face-red)
- 31 32 (face hydra-face-red)
- 42 45 (face hydra-face-red))))
- (message (format #("error: [h]: first, [j]: next, [k]: prev, [SPC]:
rep." 8 9 (face hydra-face-red)
- 20 21 (face hydra-face-red)
- 31 32 (face hydra-face-red)
- 42 45 (face hydra-face-red))))))
- (defun hydra-error/body nil "Create a hydra with a \"M-g\" body and the
heads:
+ (quote
+ hydra-error/previous-error))
+ (defun hydra-error/body nil
+ "Create a hydra with a \"M-g\" body and the heads:
\"h\": `first-error',
\"j\": `next-error',
@@ -223,45 +239,26 @@ Call the head: `previous-error'."
\"SPC\": `hydra-repeat'
The body can be accessed via `hydra-error/body'."
- (interactive)
- (hydra-default-pre)
- (hydra-disable)
- (catch (quote hydra-disable)
- (when hydra-is-helpful (hydra-error/hint))
- (setq hydra-last
- (hydra-set-transient-map
- (setq hydra-curr-map
- (quote (keymap (7 . hydra-keyboard-quit)
- (32 . hydra-repeat)
- (107 . hydra-error/previous-error)
- (106 . hydra-error/next-error)
- (104 . hydra-error/first-error)
- (switch-frame .
hydra--handle-switch-frame)
- (kp-subtract .
hydra--negative-argument)
- (kp-9 . hydra--digit-argument)
- (kp-8 . hydra--digit-argument)
- (kp-7 . hydra--digit-argument)
- (kp-6 . hydra--digit-argument)
- (kp-5 . hydra--digit-argument)
- (kp-4 . hydra--digit-argument)
- (kp-3 . hydra--digit-argument)
- (kp-2 . hydra--digit-argument)
- (kp-1 . hydra--digit-argument)
- (kp-0 . hydra--digit-argument)
- (57 . hydra--digit-argument)
- (56 . hydra--digit-argument)
- (55 . hydra--digit-argument)
- (54 . hydra--digit-argument)
- (53 . hydra--digit-argument)
- (52 . hydra--digit-argument)
- (51 . hydra--digit-argument)
- (50 . hydra--digit-argument)
- (49 . hydra--digit-argument)
- (48 . hydra--digit-argument)
- (45 . hydra--negative-argument)
- (21 . hydra--universal-argument))))
- t (lambda nil (hydra-cleanup))))
- (setq prefix-arg current-prefix-arg)))))))
+ (interactive)
+ (hydra-default-pre)
+ (let ((hydra--ignore nil))
+ (hydra-keyboard-quit)
+ (setq hydra-curr-body-fn
+ (quote hydra-error/body)))
+ (when hydra-is-helpful
+ (if hydra-lv
+ (lv-message
+ (eval hydra-error/hint))
+ (message
+ (eval hydra-error/hint))))
+ (hydra-set-transient-map
+ hydra-error/keymap
+ (lambda nil
+ (hydra-keyboard-quit)
+ nil)
+ nil)
+ (setq prefix-arg
+ current-prefix-arg))))))
(ert-deftest hydra-blue-toggle ()
(should
@@ -274,7 +271,67 @@ The body can be accessed via `hydra-error/body'."
("a" abbrev-mode "abbrev")
("q" nil "cancel")))
'(progn
- (defun hydra-toggle/toggle-truncate-lines-and-exit nil "Create a hydra
with no body and the heads:
+ (set
+ (defvar hydra-toggle/keymap nil
+ "Keymap for hydra-toggle.")
+ (quote
+ (keymap
+ (113 . hydra-toggle/nil)
+ (97 . hydra-toggle/abbrev-mode-and-exit)
+ (102 . hydra-toggle/auto-fill-mode-and-exit)
+ (116 . hydra-toggle/toggle-truncate-lines-and-exit)
+ (kp-subtract . hydra--negative-argument)
+ (kp-9 . hydra--digit-argument)
+ (kp-8 . hydra--digit-argument)
+ (kp-7 . hydra--digit-argument)
+ (kp-6 . hydra--digit-argument)
+ (kp-5 . hydra--digit-argument)
+ (kp-4 . hydra--digit-argument)
+ (kp-3 . hydra--digit-argument)
+ (kp-2 . hydra--digit-argument)
+ (kp-1 . hydra--digit-argument)
+ (kp-0 . hydra--digit-argument)
+ (57 . hydra--digit-argument)
+ (56 . hydra--digit-argument)
+ (55 . hydra--digit-argument)
+ (54 . hydra--digit-argument)
+ (53 . hydra--digit-argument)
+ (52 . hydra--digit-argument)
+ (51 . hydra--digit-argument)
+ (50 . hydra--digit-argument)
+ (49 . hydra--digit-argument)
+ (48 . hydra--digit-argument)
+ (45 . hydra--negative-argument)
+ (21 . hydra--universal-argument))))
+ (set
+ (defvar hydra-toggle/heads nil
+ "Heads for hydra-toggle.")
+ (quote
+ (("t"
+ toggle-truncate-lines
+ "truncate"
+ :exit t)
+ ("f"
+ auto-fill-mode
+ "fill"
+ :exit t)
+ ("a"
+ abbrev-mode
+ "abbrev"
+ :exit t)
+ ("q" nil "cancel" :exit t))))
+ (set
+ (defvar hydra-toggle/hint nil
+ "Dynamic hint for hydra-toggle.")
+ (quote
+ (format
+ #("toggle: [t]: truncate, [f]: fill, [a]: abbrev, [q]: cancel."
+ 9 10 (face hydra-face-blue)
+ 24 25 (face hydra-face-blue)
+ 35 36 (face hydra-face-blue)
+ 48 49 (face hydra-face-blue)))))
+ (defun hydra-toggle/toggle-truncate-lines-and-exit nil
+ "Create a hydra with no body and the heads:
\"t\": `toggle-truncate-lines',
\"f\": `auto-fill-mode',
@@ -284,13 +341,19 @@ The body can be accessed via `hydra-error/body'."
The body can be accessed via `hydra-toggle/body'.
Call the head: `toggle-truncate-lines'."
- (interactive)
- (hydra-default-pre)
- (hydra-disable)
- (hydra-cleanup)
- (catch (quote hydra-disable)
- (call-interactively (function toggle-truncate-lines))))
- (defun hydra-toggle/auto-fill-mode-and-exit nil "Create a hydra with no
body and the heads:
+ (interactive)
+ (hydra-default-pre)
+ (hydra-keyboard-quit)
+ (setq hydra-curr-body-fn
+ (quote hydra-toggle/body))
+ (progn
+ (setq this-command
+ (quote toggle-truncate-lines))
+ (call-interactively
+ (function
+ toggle-truncate-lines))))
+ (defun hydra-toggle/auto-fill-mode-and-exit nil
+ "Create a hydra with no body and the heads:
\"t\": `toggle-truncate-lines',
\"f\": `auto-fill-mode',
@@ -300,13 +363,18 @@ Call the head: `toggle-truncate-lines'."
The body can be accessed via `hydra-toggle/body'.
Call the head: `auto-fill-mode'."
- (interactive)
- (hydra-default-pre)
- (hydra-disable)
- (hydra-cleanup)
- (catch (quote hydra-disable)
- (call-interactively (function auto-fill-mode))))
- (defun hydra-toggle/abbrev-mode-and-exit nil "Create a hydra with no
body and the heads:
+ (interactive)
+ (hydra-default-pre)
+ (hydra-keyboard-quit)
+ (setq hydra-curr-body-fn
+ (quote hydra-toggle/body))
+ (progn
+ (setq this-command
+ (quote auto-fill-mode))
+ (call-interactively
+ (function auto-fill-mode))))
+ (defun hydra-toggle/abbrev-mode-and-exit nil
+ "Create a hydra with no body and the heads:
\"t\": `toggle-truncate-lines',
\"f\": `auto-fill-mode',
@@ -316,13 +384,18 @@ Call the head: `auto-fill-mode'."
The body can be accessed via `hydra-toggle/body'.
Call the head: `abbrev-mode'."
- (interactive)
- (hydra-default-pre)
- (hydra-disable)
- (hydra-cleanup)
- (catch (quote hydra-disable)
- (call-interactively (function abbrev-mode))))
- (defun hydra-toggle/nil nil "Create a hydra with no body and the heads:
+ (interactive)
+ (hydra-default-pre)
+ (hydra-keyboard-quit)
+ (setq hydra-curr-body-fn
+ (quote hydra-toggle/body))
+ (progn
+ (setq this-command
+ (quote abbrev-mode))
+ (call-interactively
+ (function abbrev-mode))))
+ (defun hydra-toggle/nil nil
+ "Create a hydra with no body and the heads:
\"t\": `toggle-truncate-lines',
\"f\": `auto-fill-mode',
@@ -332,21 +405,13 @@ Call the head: `abbrev-mode'."
The body can be accessed via `hydra-toggle/body'.
Call the head: `nil'."
- (interactive)
- (hydra-default-pre)
- (hydra-disable)
- (hydra-cleanup)
- (catch (quote hydra-disable)))
- (defun hydra-toggle/hint nil
- (if hydra-lv (lv-message (format #("toggle: [t]: truncate, [f]: fill,
[a]: abbrev, [q]: cancel." 9 10 (face hydra-face-blue)
- 24 25 (face hydra-face-blue)
- 35 36 (face hydra-face-blue)
- 48 49 (face hydra-face-blue))))
- (message (format #("toggle: [t]: truncate, [f]: fill, [a]: abbrev,
[q]: cancel." 9 10 (face hydra-face-blue)
- 24 25 (face hydra-face-blue)
- 35 36 (face hydra-face-blue)
- 48 49 (face hydra-face-blue))))))
- (defun hydra-toggle/body nil "Create a hydra with no body and the heads:
+ (interactive)
+ (hydra-default-pre)
+ (hydra-keyboard-quit)
+ (setq hydra-curr-body-fn
+ (quote hydra-toggle/body)))
+ (defun hydra-toggle/body nil
+ "Create a hydra with no body and the heads:
\"t\": `toggle-truncate-lines',
\"f\": `auto-fill-mode',
@@ -354,45 +419,26 @@ Call the head: `nil'."
\"q\": `nil'
The body can be accessed via `hydra-toggle/body'."
- (interactive)
- (hydra-default-pre)
- (hydra-disable)
- (catch (quote hydra-disable)
- (when hydra-is-helpful (hydra-toggle/hint))
- (setq hydra-last
- (hydra-set-transient-map
- (setq hydra-curr-map
- (quote (keymap (7 . hydra-keyboard-quit)
- (113 . hydra-toggle/nil)
- (97 .
hydra-toggle/abbrev-mode-and-exit)
- (102 .
hydra-toggle/auto-fill-mode-and-exit)
- (116 .
hydra-toggle/toggle-truncate-lines-and-exit)
- (switch-frame .
hydra--handle-switch-frame)
- (kp-subtract .
hydra--negative-argument)
- (kp-9 . hydra--digit-argument)
- (kp-8 . hydra--digit-argument)
- (kp-7 . hydra--digit-argument)
- (kp-6 . hydra--digit-argument)
- (kp-5 . hydra--digit-argument)
- (kp-4 . hydra--digit-argument)
- (kp-3 . hydra--digit-argument)
- (kp-2 . hydra--digit-argument)
- (kp-1 . hydra--digit-argument)
- (kp-0 . hydra--digit-argument)
- (57 . hydra--digit-argument)
- (56 . hydra--digit-argument)
- (55 . hydra--digit-argument)
- (54 . hydra--digit-argument)
- (53 . hydra--digit-argument)
- (52 . hydra--digit-argument)
- (51 . hydra--digit-argument)
- (50 . hydra--digit-argument)
- (49 . hydra--digit-argument)
- (48 . hydra--digit-argument)
- (45 . hydra--negative-argument)
- (21 . hydra--universal-argument))))
- t (lambda nil (hydra-cleanup))))
- (setq prefix-arg current-prefix-arg)))))))
+ (interactive)
+ (hydra-default-pre)
+ (let ((hydra--ignore nil))
+ (hydra-keyboard-quit)
+ (setq hydra-curr-body-fn
+ (quote hydra-toggle/body)))
+ (when hydra-is-helpful
+ (if hydra-lv
+ (lv-message
+ (eval hydra-toggle/hint))
+ (message
+ (eval hydra-toggle/hint))))
+ (hydra-set-transient-map
+ hydra-toggle/keymap
+ (lambda nil
+ (hydra-keyboard-quit)
+ nil)
+ nil)
+ (setq prefix-arg
+ current-prefix-arg))))))
(ert-deftest hydra-amaranth-vi ()
(should
@@ -409,27 +455,59 @@ The body can be accessed via `hydra-toggle/body'."
("k" previous-line)
("q" nil "quit")))
'(progn
- (defun hydra-vi/hydra-keyboard-quit-and-exit nil "Create a hydra with no
body and the heads:
+ (set
+ (defvar hydra-vi/keymap nil
+ "Keymap for hydra-vi.")
+ (quote
+ (keymap
+ (113 . hydra-vi/nil)
+ (107 . hydra-vi/previous-line)
+ (106 . hydra-vi/next-line)
+ (kp-subtract . hydra--negative-argument)
+ (kp-9 . hydra--digit-argument)
+ (kp-8 . hydra--digit-argument)
+ (kp-7 . hydra--digit-argument)
+ (kp-6 . hydra--digit-argument)
+ (kp-5 . hydra--digit-argument)
+ (kp-4 . hydra--digit-argument)
+ (kp-3 . hydra--digit-argument)
+ (kp-2 . hydra--digit-argument)
+ (kp-1 . hydra--digit-argument)
+ (kp-0 . hydra--digit-argument)
+ (57 . hydra--digit-argument)
+ (56 . hydra--digit-argument)
+ (55 . hydra--digit-argument)
+ (54 . hydra--digit-argument)
+ (53 . hydra--digit-argument)
+ (52 . hydra--digit-argument)
+ (51 . hydra--digit-argument)
+ (50 . hydra--digit-argument)
+ (49 . hydra--digit-argument)
+ (48 . hydra--digit-argument)
+ (45 . hydra--negative-argument)
+ (21 . hydra--universal-argument))))
+ (set
+ (defvar hydra-vi/heads nil
+ "Heads for hydra-vi.")
+ (quote
+ (("j" next-line "" :exit nil)
+ ("k"
+ previous-line
+ ""
+ :exit nil)
+ ("q" nil "quit" :exit t))))
+ (set
+ (defvar hydra-vi/hint nil
+ "Dynamic hint for hydra-vi.")
+ (quote
+ (format
+ #("vi: j, k, [q]: quit."
+ 4 5 (face hydra-face-amaranth)
+ 7 8 (face hydra-face-amaranth)
+ 11 12 (face hydra-face-teal)))))
+ (defun hydra-vi/next-line nil
+ "Create a hydra with no body and the heads:
-\"\": `hydra-keyboard-quit',
-\"j\": `next-line',
-\"k\": `previous-line',
-\"q\": `nil'
-
-The body can be accessed via `hydra-vi/body'.
-
-Call the head: `hydra-keyboard-quit'."
- (interactive)
- (hydra-default-pre)
- (set-cursor-color "#e52b50")
- (hydra-disable)
- (hydra-cleanup)
- (catch (quote hydra-disable)
- (call-interactively (function hydra-keyboard-quit))
- (set-cursor-color "#ffffff")))
- (defun hydra-vi/next-line nil "Create a hydra with no body and the heads:
-
-\"\": `hydra-keyboard-quit',
\"j\": `next-line',
\"k\": `previous-line',
\"q\": `nil'
@@ -437,57 +515,36 @@ Call the head: `hydra-keyboard-quit'."
The body can be accessed via `hydra-vi/body'.
Call the head: `next-line'."
- (interactive)
- (hydra-default-pre)
- (set-cursor-color "#e52b50")
- (hydra-disable)
- (catch (quote hydra-disable)
- (condition-case err (prog1 t (call-interactively (function
next-line)))
- ((quit error)
- (message "%S" err)
- (unless hydra-lv (sit-for 0.8))
- nil))
- (when hydra-is-helpful (hydra-vi/hint))
- (setq hydra-last
- (hydra-set-transient-map
- (setq hydra-curr-map
- (quote (keymap (t lambda nil (interactive)
- (message "An amaranth Hydra can
only exit through a blue head")
- (hydra-set-transient-map
hydra-curr-map t)
- (when hydra-is-helpful (unless
hydra-lv (sit-for 0.8))
- (hydra-vi/hint)))
- (113 . hydra-vi/nil)
- (107 . hydra-vi/previous-line)
- (106 . hydra-vi/next-line)
- (7 .
hydra-vi/hydra-keyboard-quit-and-exit)
- (switch-frame .
hydra--handle-switch-frame)
- (kp-subtract .
hydra--negative-argument)
- (kp-9 . hydra--digit-argument)
- (kp-8 . hydra--digit-argument)
- (kp-7 . hydra--digit-argument)
- (kp-6 . hydra--digit-argument)
- (kp-5 . hydra--digit-argument)
- (kp-4 . hydra--digit-argument)
- (kp-3 . hydra--digit-argument)
- (kp-2 . hydra--digit-argument)
- (kp-1 . hydra--digit-argument)
- (kp-0 . hydra--digit-argument)
- (57 . hydra--digit-argument)
- (56 . hydra--digit-argument)
- (55 . hydra--digit-argument)
- (54 . hydra--digit-argument)
- (53 . hydra--digit-argument)
- (52 . hydra--digit-argument)
- (51 . hydra--digit-argument)
- (50 . hydra--digit-argument)
- (49 . hydra--digit-argument)
- (48 . hydra--digit-argument)
- (45 . hydra--negative-argument)
- (21 . hydra--universal-argument))))
- t (lambda nil (hydra-cleanup))))))
- (defun hydra-vi/previous-line nil "Create a hydra with no body and the
heads:
-
-\"\": `hydra-keyboard-quit',
+ (interactive)
+ (hydra-default-pre)
+ (set-cursor-color "#e52b50")
+ (let ((hydra--ignore t))
+ (hydra-keyboard-quit)
+ (setq hydra-curr-body-fn
+ (quote hydra-vi/body)))
+ (condition-case err
+ (progn
+ (setq this-command
+ (quote next-line))
+ (call-interactively
+ (function next-line)))
+ ((quit error)
+ (message "%S" err)
+ (unless hydra-lv (sit-for 0.8))))
+ (when hydra-is-helpful
+ (if hydra-lv
+ (lv-message
+ (eval hydra-vi/hint))
+ (message (eval hydra-vi/hint))))
+ (hydra-set-transient-map
+ hydra-vi/keymap
+ (lambda nil
+ (hydra-keyboard-quit)
+ (set-cursor-color "#ffffff"))
+ (quote warn)))
+ (defun hydra-vi/previous-line nil
+ "Create a hydra with no body and the heads:
+
\"j\": `next-line',
\"k\": `previous-line',
\"q\": `nil'
@@ -495,57 +552,36 @@ Call the head: `next-line'."
The body can be accessed via `hydra-vi/body'.
Call the head: `previous-line'."
- (interactive)
- (hydra-default-pre)
- (set-cursor-color "#e52b50")
- (hydra-disable)
- (catch (quote hydra-disable)
- (condition-case err (prog1 t (call-interactively (function
previous-line)))
- ((quit error)
- (message "%S" err)
- (unless hydra-lv (sit-for 0.8))
- nil))
- (when hydra-is-helpful (hydra-vi/hint))
- (setq hydra-last
- (hydra-set-transient-map
- (setq hydra-curr-map
- (quote (keymap (t lambda nil (interactive)
- (message "An amaranth Hydra can
only exit through a blue head")
- (hydra-set-transient-map
hydra-curr-map t)
- (when hydra-is-helpful (unless
hydra-lv (sit-for 0.8))
- (hydra-vi/hint)))
- (113 . hydra-vi/nil)
- (107 . hydra-vi/previous-line)
- (106 . hydra-vi/next-line)
- (7 .
hydra-vi/hydra-keyboard-quit-and-exit)
- (switch-frame .
hydra--handle-switch-frame)
- (kp-subtract .
hydra--negative-argument)
- (kp-9 . hydra--digit-argument)
- (kp-8 . hydra--digit-argument)
- (kp-7 . hydra--digit-argument)
- (kp-6 . hydra--digit-argument)
- (kp-5 . hydra--digit-argument)
- (kp-4 . hydra--digit-argument)
- (kp-3 . hydra--digit-argument)
- (kp-2 . hydra--digit-argument)
- (kp-1 . hydra--digit-argument)
- (kp-0 . hydra--digit-argument)
- (57 . hydra--digit-argument)
- (56 . hydra--digit-argument)
- (55 . hydra--digit-argument)
- (54 . hydra--digit-argument)
- (53 . hydra--digit-argument)
- (52 . hydra--digit-argument)
- (51 . hydra--digit-argument)
- (50 . hydra--digit-argument)
- (49 . hydra--digit-argument)
- (48 . hydra--digit-argument)
- (45 . hydra--negative-argument)
- (21 . hydra--universal-argument))))
- t (lambda nil (hydra-cleanup))))))
- (defun hydra-vi/nil nil "Create a hydra with no body and the heads:
-
-\"\": `hydra-keyboard-quit',
+ (interactive)
+ (hydra-default-pre)
+ (set-cursor-color "#e52b50")
+ (let ((hydra--ignore t))
+ (hydra-keyboard-quit)
+ (setq hydra-curr-body-fn
+ (quote hydra-vi/body)))
+ (condition-case err
+ (progn
+ (setq this-command
+ (quote previous-line))
+ (call-interactively
+ (function previous-line)))
+ ((quit error)
+ (message "%S" err)
+ (unless hydra-lv (sit-for 0.8))))
+ (when hydra-is-helpful
+ (if hydra-lv
+ (lv-message
+ (eval hydra-vi/hint))
+ (message (eval hydra-vi/hint))))
+ (hydra-set-transient-map
+ hydra-vi/keymap
+ (lambda nil
+ (hydra-keyboard-quit)
+ (set-cursor-color "#ffffff"))
+ (quote warn)))
+ (defun hydra-vi/nil nil
+ "Create a hydra with no body and the heads:
+
\"j\": `next-line',
\"k\": `previous-line',
\"q\": `nil'
@@ -553,72 +589,342 @@ Call the head: `previous-line'."
The body can be accessed via `hydra-vi/body'.
Call the head: `nil'."
- (interactive)
- (hydra-default-pre)
- (set-cursor-color "#e52b50")
- (hydra-disable)
- (hydra-cleanup)
- (catch (quote hydra-disable)
- (set-cursor-color "#ffffff")))
- (defun hydra-vi/hint nil
- (if hydra-lv (lv-message (format #("vi: j, k, [q]: quit." 4 5 (face
hydra-face-amaranth)
- 7 8 (face hydra-face-amaranth)
- 11 12 (face hydra-face-blue))))
- (message (format #("vi: j, k, [q]: quit." 4 5 (face
hydra-face-amaranth)
- 7 8 (face hydra-face-amaranth)
- 11 12 (face hydra-face-blue))))))
- (defun hydra-vi/body nil "Create a hydra with no body and the heads:
-
-\"\": `hydra-keyboard-quit',
+ (interactive)
+ (hydra-default-pre)
+ (set-cursor-color "#e52b50")
+ (hydra-keyboard-quit)
+ (setq hydra-curr-body-fn
+ (quote hydra-vi/body)))
+ (defun hydra-vi/body nil
+ "Create a hydra with no body and the heads:
+
\"j\": `next-line',
\"k\": `previous-line',
\"q\": `nil'
The body can be accessed via `hydra-vi/body'."
- (interactive)
- (hydra-default-pre)
- (set-cursor-color "#e52b50")
- (hydra-disable)
- (catch (quote hydra-disable)
- (when hydra-is-helpful (hydra-vi/hint))
- (setq hydra-last
- (hydra-set-transient-map
- (setq hydra-curr-map
- (quote (keymap (t lambda nil (interactive)
- (message "An amaranth Hydra can
only exit through a blue head")
- (hydra-set-transient-map
hydra-curr-map t)
- (when hydra-is-helpful (unless
hydra-lv (sit-for 0.8))
- (hydra-vi/hint)))
- (113 . hydra-vi/nil)
- (107 . hydra-vi/previous-line)
- (106 . hydra-vi/next-line)
- (7 .
hydra-vi/hydra-keyboard-quit-and-exit)
- (switch-frame .
hydra--handle-switch-frame)
- (kp-subtract .
hydra--negative-argument)
- (kp-9 . hydra--digit-argument)
- (kp-8 . hydra--digit-argument)
- (kp-7 . hydra--digit-argument)
- (kp-6 . hydra--digit-argument)
- (kp-5 . hydra--digit-argument)
- (kp-4 . hydra--digit-argument)
- (kp-3 . hydra--digit-argument)
- (kp-2 . hydra--digit-argument)
- (kp-1 . hydra--digit-argument)
- (kp-0 . hydra--digit-argument)
- (57 . hydra--digit-argument)
- (56 . hydra--digit-argument)
- (55 . hydra--digit-argument)
- (54 . hydra--digit-argument)
- (53 . hydra--digit-argument)
- (52 . hydra--digit-argument)
- (51 . hydra--digit-argument)
- (50 . hydra--digit-argument)
- (49 . hydra--digit-argument)
- (48 . hydra--digit-argument)
- (45 . hydra--negative-argument)
- (21 . hydra--universal-argument))))
- t (lambda nil (hydra-cleanup))))
- (setq prefix-arg current-prefix-arg)))))))
+ (interactive)
+ (hydra-default-pre)
+ (set-cursor-color "#e52b50")
+ (let ((hydra--ignore nil))
+ (hydra-keyboard-quit)
+ (setq hydra-curr-body-fn
+ (quote hydra-vi/body)))
+ (when hydra-is-helpful
+ (if hydra-lv
+ (lv-message
+ (eval hydra-vi/hint))
+ (message (eval hydra-vi/hint))))
+ (hydra-set-transient-map
+ hydra-vi/keymap
+ (lambda nil
+ (hydra-keyboard-quit)
+ (set-cursor-color "#ffffff"))
+ (quote warn))
+ (setq prefix-arg
+ current-prefix-arg))))))
+
+(ert-deftest hydra-zoom-duplicate-1 ()
+ (should
+ (equal
+ (macroexpand
+ '(defhydra hydra-zoom ()
+ "zoom"
+ ("r" (text-scale-set 0) "reset")
+ ("0" (text-scale-set 0) :bind nil :exit t)
+ ("1" (text-scale-set 0) nil :bind nil :exit t)))
+ '(progn
+ (set
+ (defvar hydra-zoom/keymap nil
+ "Keymap for hydra-zoom.")
+ (quote
+ (keymap
+ (114 . hydra-zoom/lambda-r)
+ (kp-subtract . hydra--negative-argument)
+ (kp-9 . hydra--digit-argument)
+ (kp-8 . hydra--digit-argument)
+ (kp-7 . hydra--digit-argument)
+ (kp-6 . hydra--digit-argument)
+ (kp-5 . hydra--digit-argument)
+ (kp-4 . hydra--digit-argument)
+ (kp-3 . hydra--digit-argument)
+ (kp-2 . hydra--digit-argument)
+ (kp-1 . hydra--digit-argument)
+ (kp-0 . hydra--digit-argument)
+ (57 . hydra--digit-argument)
+ (56 . hydra--digit-argument)
+ (55 . hydra--digit-argument)
+ (54 . hydra--digit-argument)
+ (53 . hydra--digit-argument)
+ (52 . hydra--digit-argument)
+ (51 . hydra--digit-argument)
+ (50 . hydra--digit-argument)
+ (49 . hydra-zoom/lambda-0-and-exit)
+ (48 . hydra-zoom/lambda-0-and-exit)
+ (45 . hydra--negative-argument)
+ (21 . hydra--universal-argument))))
+ (set
+ (defvar hydra-zoom/heads nil
+ "Heads for hydra-zoom.")
+ (quote
+ (("r"
+ (text-scale-set 0)
+ "reset"
+ :exit nil)
+ ("0"
+ (text-scale-set 0)
+ ""
+ :bind nil
+ :exit t)
+ ("1"
+ (text-scale-set 0)
+ nil
+ :bind nil
+ :exit t))))
+ (set
+ (defvar hydra-zoom/hint nil
+ "Dynamic hint for hydra-zoom.")
+ (quote
+ (format
+ #("zoom: [r 0]: reset."
+ 7 8 (face hydra-face-red)
+ 9 10 (face hydra-face-blue)))))
+ (defun hydra-zoom/lambda-r nil
+ "Create a hydra with no body and the heads:
+
+\"r\": `(text-scale-set 0)',
+\"0\": `(text-scale-set 0)',
+\"1\": `(text-scale-set 0)'
+
+The body can be accessed via `hydra-zoom/body'.
+
+Call the head: `(text-scale-set 0)'."
+ (interactive)
+ (hydra-default-pre)
+ (let ((hydra--ignore t))
+ (hydra-keyboard-quit)
+ (setq hydra-curr-body-fn
+ (quote hydra-zoom/body)))
+ (condition-case err
+ (call-interactively
+ (function
+ (lambda nil
+ (interactive)
+ (text-scale-set 0))))
+ ((quit error)
+ (message "%S" err)
+ (unless hydra-lv (sit-for 0.8))))
+ (when hydra-is-helpful
+ (if hydra-lv
+ (lv-message
+ (eval hydra-zoom/hint))
+ (message
+ (eval hydra-zoom/hint))))
+ (hydra-set-transient-map
+ hydra-zoom/keymap
+ (lambda nil
+ (hydra-keyboard-quit)
+ nil)
+ nil))
+ (defun hydra-zoom/lambda-0-and-exit nil
+ "Create a hydra with no body and the heads:
+
+\"r\": `(text-scale-set 0)',
+\"0\": `(text-scale-set 0)',
+\"1\": `(text-scale-set 0)'
+
+The body can be accessed via `hydra-zoom/body'.
+
+Call the head: `(text-scale-set 0)'."
+ (interactive)
+ (hydra-default-pre)
+ (hydra-keyboard-quit)
+ (setq hydra-curr-body-fn
+ (quote hydra-zoom/body))
+ (call-interactively
+ (function
+ (lambda nil
+ (interactive)
+ (text-scale-set 0)))))
+ (defun hydra-zoom/body nil
+ "Create a hydra with no body and the heads:
+
+\"r\": `(text-scale-set 0)',
+\"0\": `(text-scale-set 0)',
+\"1\": `(text-scale-set 0)'
+
+The body can be accessed via `hydra-zoom/body'."
+ (interactive)
+ (hydra-default-pre)
+ (let ((hydra--ignore nil))
+ (hydra-keyboard-quit)
+ (setq hydra-curr-body-fn
+ (quote hydra-zoom/body)))
+ (when hydra-is-helpful
+ (if hydra-lv
+ (lv-message
+ (eval hydra-zoom/hint))
+ (message
+ (eval hydra-zoom/hint))))
+ (hydra-set-transient-map
+ hydra-zoom/keymap
+ (lambda nil
+ (hydra-keyboard-quit)
+ nil)
+ nil)
+ (setq prefix-arg
+ current-prefix-arg))))))
+
+(ert-deftest hydra-zoom-duplicate-2 ()
+ (should
+ (equal
+ (macroexpand
+ '(defhydra hydra-zoom ()
+ "zoom"
+ ("r" (text-scale-set 0) "reset")
+ ("0" (text-scale-set 0) :bind nil :exit t)
+ ("1" (text-scale-set 0) nil :bind nil)))
+ '(progn
+ (set
+ (defvar hydra-zoom/keymap nil
+ "Keymap for hydra-zoom.")
+ (quote
+ (keymap
+ (114 . hydra-zoom/lambda-r)
+ (kp-subtract . hydra--negative-argument)
+ (kp-9 . hydra--digit-argument)
+ (kp-8 . hydra--digit-argument)
+ (kp-7 . hydra--digit-argument)
+ (kp-6 . hydra--digit-argument)
+ (kp-5 . hydra--digit-argument)
+ (kp-4 . hydra--digit-argument)
+ (kp-3 . hydra--digit-argument)
+ (kp-2 . hydra--digit-argument)
+ (kp-1 . hydra--digit-argument)
+ (kp-0 . hydra--digit-argument)
+ (57 . hydra--digit-argument)
+ (56 . hydra--digit-argument)
+ (55 . hydra--digit-argument)
+ (54 . hydra--digit-argument)
+ (53 . hydra--digit-argument)
+ (52 . hydra--digit-argument)
+ (51 . hydra--digit-argument)
+ (50 . hydra--digit-argument)
+ (49 . hydra-zoom/lambda-r)
+ (48 . hydra-zoom/lambda-0-and-exit)
+ (45 . hydra--negative-argument)
+ (21 . hydra--universal-argument))))
+ (set
+ (defvar hydra-zoom/heads nil
+ "Heads for hydra-zoom.")
+ (quote
+ (("r"
+ (text-scale-set 0)
+ "reset"
+ :exit nil)
+ ("0"
+ (text-scale-set 0)
+ ""
+ :bind nil
+ :exit t)
+ ("1"
+ (text-scale-set 0)
+ nil
+ :bind nil
+ :exit nil))))
+ (set
+ (defvar hydra-zoom/hint nil
+ "Dynamic hint for hydra-zoom.")
+ (quote
+ (format
+ #("zoom: [r 0]: reset."
+ 7 8 (face hydra-face-red)
+ 9 10 (face hydra-face-blue)))))
+ (defun hydra-zoom/lambda-r nil
+ "Create a hydra with no body and the heads:
+
+\"r\": `(text-scale-set 0)',
+\"0\": `(text-scale-set 0)',
+\"1\": `(text-scale-set 0)'
+
+The body can be accessed via `hydra-zoom/body'.
+
+Call the head: `(text-scale-set 0)'."
+ (interactive)
+ (hydra-default-pre)
+ (let ((hydra--ignore t))
+ (hydra-keyboard-quit)
+ (setq hydra-curr-body-fn
+ (quote hydra-zoom/body)))
+ (condition-case err
+ (call-interactively
+ (function
+ (lambda nil
+ (interactive)
+ (text-scale-set 0))))
+ ((quit error)
+ (message "%S" err)
+ (unless hydra-lv (sit-for 0.8))))
+ (when hydra-is-helpful
+ (if hydra-lv
+ (lv-message
+ (eval hydra-zoom/hint))
+ (message
+ (eval hydra-zoom/hint))))
+ (hydra-set-transient-map
+ hydra-zoom/keymap
+ (lambda nil
+ (hydra-keyboard-quit)
+ nil)
+ nil))
+ (defun hydra-zoom/lambda-0-and-exit nil
+ "Create a hydra with no body and the heads:
+
+\"r\": `(text-scale-set 0)',
+\"0\": `(text-scale-set 0)',
+\"1\": `(text-scale-set 0)'
+
+The body can be accessed via `hydra-zoom/body'.
+
+Call the head: `(text-scale-set 0)'."
+ (interactive)
+ (hydra-default-pre)
+ (hydra-keyboard-quit)
+ (setq hydra-curr-body-fn
+ (quote hydra-zoom/body))
+ (call-interactively
+ (function
+ (lambda nil
+ (interactive)
+ (text-scale-set 0)))))
+ (defun hydra-zoom/body nil
+ "Create a hydra with no body and the heads:
+
+\"r\": `(text-scale-set 0)',
+\"0\": `(text-scale-set 0)',
+\"1\": `(text-scale-set 0)'
+
+The body can be accessed via `hydra-zoom/body'."
+ (interactive)
+ (hydra-default-pre)
+ (let ((hydra--ignore nil))
+ (hydra-keyboard-quit)
+ (setq hydra-curr-body-fn
+ (quote hydra-zoom/body)))
+ (when hydra-is-helpful
+ (if hydra-lv
+ (lv-message
+ (eval hydra-zoom/hint))
+ (message
+ (eval hydra-zoom/hint))))
+ (hydra-set-transient-map
+ hydra-zoom/keymap
+ (lambda nil
+ (hydra-keyboard-quit)
+ nil)
+ nil)
+ (setq prefix-arg
+ current-prefix-arg))))))
(ert-deftest defhydradio ()
(should (equal
@@ -741,7 +1047,7 @@ _f_ auto-fill-mode: %`auto-fill-function
'(concat (format "%s abbrev-mode: %S
%s debug-on-error: %S
%s auto-fill-mode: %S
-" "{a}" abbrev-mode "{d}" debug-on-error "{f}" auto-fill-function) "[[q]]:
quit"))))
+" "{a}" abbrev-mode "{d}" debug-on-error "{f}" auto-fill-function) "[{q}]:
quit."))))
(ert-deftest hydra-format-2 ()
(should (equal
@@ -751,9 +1057,9 @@ _f_ auto-fill-mode: %`auto-fill-function
'bar
nil
"\n bar %s`foo\n"
- '(("a" (quote t) "" :cmd-name bar/lambda-a)
- ("q" nil "" :cmd-name bar/nil))))
- '(concat (format " bar %s\n" foo) "{a}, [q]"))))
+ '(("a" (quote t) "" :cmd-name bar/lambda-a :exit nil)
+ ("q" nil "" :cmd-name bar/nil :exit t))))
+ '(concat (format " bar %s\n" foo) "{a}, [q]."))))
(ert-deftest hydra-format-3 ()
(should (equal
@@ -772,11 +1078,65 @@ _f_ auto-fill-mode: %`auto-fill-function
nil
'(nil nil :hint nil)
"\n_j_,_k_"
- '(("j" nil) ("k" nil)))
+ '(("j" nil nil :exit t) ("k" nil nil :exit t)))
'(concat (format "%s,%s"
#("j" 0 1 (face hydra-face-blue))
#("k" 0 1 (face hydra-face-blue))) ""))))
+(ert-deftest hydra-format-5 ()
+ (should
+ (equal (hydra--format
+ nil nil "\n_-_: mark _u_: unmark\n"
+ '(("-" Buffer-menu-mark)
+ ("u" Buffer-menu-unmark)))
+ '(concat
+ (format
+ "%s: mark %s: unmark\n"
+ #("-" 0 1 (face hydra-face-red))
+ #("u" 0 1 (face hydra-face-red)))
+ ""))))
+
+(ert-deftest hydra-format-6 ()
+ (should
+ (equal (hydra--format
+ nil nil "\n[_]_] forward [_[_] backward\n"
+ '(("]" forward-char)
+ ("[" backward-char)))
+ '(concat
+ (format
+ "[%s] forward [%s] backward\n"
+ #("]"
+ 0 1 (face
+ hydra-face-red))
+ #("["
+ 0 1 (face
+ hydra-face-red)))
+ ""))))
+
+(ert-deftest hydra-format-7 ()
+ (should
+ (equal
+ (hydra--format nil nil "test"
+ '(("%" forward-char "" :exit nil)
+ ("b" backward-char "" :exit nil)))
+ '(format
+ #("test: %%%%, b."
+ 6 7 (face hydra-face-red)
+ 7 8 (face hydra-face-red)
+ 8 9 (face hydra-face-red)
+ 9 10 (face hydra-face-red)
+ 12 13 (face hydra-face-red)))))
+ (should
+ (equal
+ (hydra--format nil nil "\n_%_ forward\n"
+ '(("%" forward-char nil :exit nil)))
+ '(concat
+ (format
+ "%s forward\n"
+ #("%%"
+ 0 2 (face hydra-face-red)))
+ ""))))
+
(ert-deftest hydra-format-with-sexp-1 ()
(should (equal
(let ((hydra-fontify-head-function
@@ -784,13 +1144,13 @@ _f_ auto-fill-mode: %`auto-fill-function
(hydra--format
'hydra-toggle nil
"\n_n_ narrow-or-widen-dwim %(progn (message
\"checking\")(buffer-narrowed-p))asdf\n"
- '(("n" narrow-to-region nil) ("q" nil "cancel"))))
+ '(("n" narrow-to-region nil) ("q" nil "cancel" :exit t))))
'(concat (format "%s narrow-or-widen-dwim %Sasdf\n"
"{n}"
(progn
(message "checking")
(buffer-narrowed-p)))
- "[[q]]: cancel"))))
+ "[[q]]: cancel."))))
(ert-deftest hydra-format-with-sexp-2 ()
(should (equal
@@ -799,43 +1159,13 @@ _f_ auto-fill-mode: %`auto-fill-function
(hydra--format
'hydra-toggle nil
"\n_n_ narrow-or-widen-dwim %s(progn (message
\"checking\")(buffer-narrowed-p))asdf\n"
- '(("n" narrow-to-region nil) ("q" nil "cancel"))))
+ '(("n" narrow-to-region nil) ("q" nil "cancel" :exit t))))
'(concat (format "%s narrow-or-widen-dwim %sasdf\n"
"{n}"
(progn
(message "checking")
(buffer-narrowed-p)))
- "[[q]]: cancel"))))
-
-(ert-deftest hydra-compat-colors-1 ()
- (should (equal (hydra--head-color
- '("e" (message "Exiting now") "blue")
- '(nil nil :color blue))
- 'blue))
- (should (equal (hydra--head-color
- '("c" (message "Continuing") "red" :color red)
- '(nil nil :color blue))
- 'red))
- (should (equal (hydra--head-color
- '("e" (message "Exiting now") "blue")
- '(nil nil :exit t))
- 'blue))
- (should (equal (hydra--head-color
- '("j" next-line "" :exit t)
- '(nil nil))
- 'blue))
- (should (equal (hydra--head-color
- '("c" (message "Continuing") "red" :exit nil)
- '(nil nil :exit t))
- 'red))
- (equal (hydra--head-color
- '("a" abbrev-mode nil)
- '(nil nil :color teal))
- 'teal)
- (equal (hydra--head-color
- '("a" abbrev-mode :exit nil)
- '(nil nil :color teal))
- 'amaranth))
+ "[[q]]: cancel."))))
(ert-deftest hydra-compat-colors-2 ()
(should
@@ -897,256 +1227,6 @@ _f_ auto-fill-mode: %`auto-fill-function
("e" fun-e)
("f" fun-f))))))
-(ert-deftest hydra-zoom-duplicate-1 ()
- (should
- (equal
- (macroexpand
- '(defhydra hydra-zoom ()
- "zoom"
- ("r" (text-scale-set 0) "reset")
- ("0" (text-scale-set 0) :bind nil :exit t)
- ("1" (text-scale-set 0) nil :bind nil :exit t)))
- '(progn
- (defun hydra-zoom/lambda-r nil "Create a hydra with no body and the
heads:
-
-\"r\": `(text-scale-set 0)',
-\"0\": `(text-scale-set 0)',
-\"1\": `(text-scale-set 0)'
-
-The body can be accessed via `hydra-zoom/body'.
-
-Call the head: `(text-scale-set 0)'."
- (interactive)
- (hydra-default-pre)
- (hydra-disable)
- (catch (quote hydra-disable)
- (condition-case err (prog1 t (call-interactively (function
(lambda nil (interactive)
-
(text-scale-set 0)))))
- ((quit error)
- (message "%S" err)
- (unless hydra-lv (sit-for 0.8))
- nil))
- (when hydra-is-helpful (hydra-zoom/hint))
- (setq hydra-last
- (hydra-set-transient-map
- (setq hydra-curr-map
- (quote (keymap (7 . hydra-keyboard-quit)
- (114 . hydra-zoom/lambda-r)
- (switch-frame .
hydra--handle-switch-frame)
- (kp-subtract .
hydra--negative-argument)
- (kp-9 . hydra--digit-argument)
- (kp-8 . hydra--digit-argument)
- (kp-7 . hydra--digit-argument)
- (kp-6 . hydra--digit-argument)
- (kp-5 . hydra--digit-argument)
- (kp-4 . hydra--digit-argument)
- (kp-3 . hydra--digit-argument)
- (kp-2 . hydra--digit-argument)
- (kp-1 . hydra--digit-argument)
- (kp-0 . hydra--digit-argument)
- (57 . hydra--digit-argument)
- (56 . hydra--digit-argument)
- (55 . hydra--digit-argument)
- (54 . hydra--digit-argument)
- (53 . hydra--digit-argument)
- (52 . hydra--digit-argument)
- (51 . hydra--digit-argument)
- (50 . hydra--digit-argument)
- (49 . hydra-zoom/lambda-0-and-exit)
- (48 . hydra-zoom/lambda-0-and-exit)
- (45 . hydra--negative-argument)
- (21 . hydra--universal-argument))))
- t (lambda nil (hydra-cleanup))))))
- (defun hydra-zoom/lambda-0-and-exit nil "Create a hydra with no body and
the heads:
-
-\"r\": `(text-scale-set 0)',
-\"0\": `(text-scale-set 0)',
-\"1\": `(text-scale-set 0)'
-
-The body can be accessed via `hydra-zoom/body'.
-
-Call the head: `(text-scale-set 0)'."
- (interactive)
- (hydra-default-pre)
- (hydra-disable)
- (hydra-cleanup)
- (catch (quote hydra-disable)
- (call-interactively (function (lambda nil (interactive)
- (text-scale-set 0))))))
- (defun hydra-zoom/hint nil
- (if hydra-lv (lv-message (format #("zoom: [r 0]: reset." 7 8 (face
hydra-face-red)
- 9 10 (face hydra-face-blue))))
- (message (format #("zoom: [r 0]: reset." 7 8 (face hydra-face-red)
- 9 10 (face hydra-face-blue))))))
- (defun hydra-zoom/body nil "Create a hydra with no body and the heads:
-
-\"r\": `(text-scale-set 0)',
-\"0\": `(text-scale-set 0)',
-\"1\": `(text-scale-set 0)'
-
-The body can be accessed via `hydra-zoom/body'."
- (interactive)
- (hydra-default-pre)
- (hydra-disable)
- (catch (quote hydra-disable)
- (when hydra-is-helpful (hydra-zoom/hint))
- (setq hydra-last
- (hydra-set-transient-map
- (setq hydra-curr-map
- (quote (keymap (7 . hydra-keyboard-quit)
- (114 . hydra-zoom/lambda-r)
- (switch-frame .
hydra--handle-switch-frame)
- (kp-subtract .
hydra--negative-argument)
- (kp-9 . hydra--digit-argument)
- (kp-8 . hydra--digit-argument)
- (kp-7 . hydra--digit-argument)
- (kp-6 . hydra--digit-argument)
- (kp-5 . hydra--digit-argument)
- (kp-4 . hydra--digit-argument)
- (kp-3 . hydra--digit-argument)
- (kp-2 . hydra--digit-argument)
- (kp-1 . hydra--digit-argument)
- (kp-0 . hydra--digit-argument)
- (57 . hydra--digit-argument)
- (56 . hydra--digit-argument)
- (55 . hydra--digit-argument)
- (54 . hydra--digit-argument)
- (53 . hydra--digit-argument)
- (52 . hydra--digit-argument)
- (51 . hydra--digit-argument)
- (50 . hydra--digit-argument)
- (49 . hydra-zoom/lambda-0-and-exit)
- (48 . hydra-zoom/lambda-0-and-exit)
- (45 . hydra--negative-argument)
- (21 . hydra--universal-argument))))
- t (lambda nil (hydra-cleanup))))
- (setq prefix-arg current-prefix-arg)))))))
-
-(ert-deftest hydra-zoom-duplicate-2 ()
- (should
- (equal
- (macroexpand
- '(defhydra hydra-zoom ()
- "zoom"
- ("r" (text-scale-set 0) "reset")
- ("0" (text-scale-set 0) :bind nil :exit t)
- ("1" (text-scale-set 0) nil :bind nil)))
- '(progn
- (defun hydra-zoom/lambda-r nil "Create a hydra with no body and the
heads:
-
-\"r\": `(text-scale-set 0)',
-\"0\": `(text-scale-set 0)',
-\"1\": `(text-scale-set 0)'
-
-The body can be accessed via `hydra-zoom/body'.
-
-Call the head: `(text-scale-set 0)'."
- (interactive)
- (hydra-default-pre)
- (hydra-disable)
- (catch (quote hydra-disable)
- (condition-case err (prog1 t (call-interactively (function
(lambda nil (interactive)
-
(text-scale-set 0)))))
- ((quit error)
- (message "%S" err)
- (unless hydra-lv (sit-for 0.8))
- nil))
- (when hydra-is-helpful (hydra-zoom/hint))
- (setq hydra-last
- (hydra-set-transient-map
- (setq hydra-curr-map
- (quote (keymap (7 . hydra-keyboard-quit)
- (114 . hydra-zoom/lambda-r)
- (switch-frame .
hydra--handle-switch-frame)
- (kp-subtract .
hydra--negative-argument)
- (kp-9 . hydra--digit-argument)
- (kp-8 . hydra--digit-argument)
- (kp-7 . hydra--digit-argument)
- (kp-6 . hydra--digit-argument)
- (kp-5 . hydra--digit-argument)
- (kp-4 . hydra--digit-argument)
- (kp-3 . hydra--digit-argument)
- (kp-2 . hydra--digit-argument)
- (kp-1 . hydra--digit-argument)
- (kp-0 . hydra--digit-argument)
- (57 . hydra--digit-argument)
- (56 . hydra--digit-argument)
- (55 . hydra--digit-argument)
- (54 . hydra--digit-argument)
- (53 . hydra--digit-argument)
- (52 . hydra--digit-argument)
- (51 . hydra--digit-argument)
- (50 . hydra--digit-argument)
- (49 . hydra-zoom/lambda-r)
- (48 . hydra-zoom/lambda-0-and-exit)
- (45 . hydra--negative-argument)
- (21 . hydra--universal-argument))))
- t (lambda nil (hydra-cleanup))))))
- (defun hydra-zoom/lambda-0-and-exit nil "Create a hydra with no body and
the heads:
-
-\"r\": `(text-scale-set 0)',
-\"0\": `(text-scale-set 0)',
-\"1\": `(text-scale-set 0)'
-
-The body can be accessed via `hydra-zoom/body'.
-
-Call the head: `(text-scale-set 0)'."
- (interactive)
- (hydra-default-pre)
- (hydra-disable)
- (hydra-cleanup)
- (catch (quote hydra-disable)
- (call-interactively (function (lambda nil (interactive)
- (text-scale-set 0))))))
- (defun hydra-zoom/hint nil
- (if hydra-lv (lv-message (format #("zoom: [r 0]: reset." 7 8 (face
hydra-face-red)
- 9 10 (face hydra-face-blue))))
- (message (format #("zoom: [r 0]: reset." 7 8 (face hydra-face-red)
- 9 10 (face hydra-face-blue))))))
- (defun hydra-zoom/body nil "Create a hydra with no body and the heads:
-
-\"r\": `(text-scale-set 0)',
-\"0\": `(text-scale-set 0)',
-\"1\": `(text-scale-set 0)'
-
-The body can be accessed via `hydra-zoom/body'."
- (interactive)
- (hydra-default-pre)
- (hydra-disable)
- (catch (quote hydra-disable)
- (when hydra-is-helpful (hydra-zoom/hint))
- (setq hydra-last
- (hydra-set-transient-map
- (setq hydra-curr-map
- (quote (keymap (7 . hydra-keyboard-quit)
- (114 . hydra-zoom/lambda-r)
- (switch-frame .
hydra--handle-switch-frame)
- (kp-subtract .
hydra--negative-argument)
- (kp-9 . hydra--digit-argument)
- (kp-8 . hydra--digit-argument)
- (kp-7 . hydra--digit-argument)
- (kp-6 . hydra--digit-argument)
- (kp-5 . hydra--digit-argument)
- (kp-4 . hydra--digit-argument)
- (kp-3 . hydra--digit-argument)
- (kp-2 . hydra--digit-argument)
- (kp-1 . hydra--digit-argument)
- (kp-0 . hydra--digit-argument)
- (57 . hydra--digit-argument)
- (56 . hydra--digit-argument)
- (55 . hydra--digit-argument)
- (54 . hydra--digit-argument)
- (53 . hydra--digit-argument)
- (52 . hydra--digit-argument)
- (51 . hydra--digit-argument)
- (50 . hydra--digit-argument)
- (49 . hydra-zoom/lambda-r)
- (48 . hydra-zoom/lambda-0-and-exit)
- (45 . hydra--negative-argument)
- (21 . hydra--universal-argument))))
- t (lambda nil (hydra-cleanup))))
- (setq prefix-arg current-prefix-arg)))))))
-
(ert-deftest hydra--pad ()
(should (equal (hydra--pad '(a b c) 3)
'(a b c)))
@@ -1200,6 +1280,140 @@ _w_ Worf: % -8`hydra-tng/worf^^
_h_ Set phasers to
body-pre)
'(funcall (function foo)))))
+(defhydra hydra-simple-1 (global-map "C-c")
+ ("a" (insert "j"))
+ ("b" (insert "k"))
+ ("q" nil))
+
+(defhydra hydra-simple-2 (global-map "C-c" :color amaranth)
+ ("c" self-insert-command)
+ ("d" self-insert-command)
+ ("q" nil))
+
+(defhydra hydra-simple-3 (global-map "C-c")
+ ("g" goto-line)
+ ("1" find-file)
+ ("q" nil))
+
+(defmacro hydra-with (in &rest body)
+ `(let ((temp-buffer (generate-new-buffer " *temp*")))
+ (save-window-excursion
+ (unwind-protect
+ (progn
+ (switch-to-buffer temp-buffer)
+ (transient-mark-mode 1)
+ (insert ,in)
+ (goto-char (point-min))
+ (when (search-forward "~" nil t)
+ (backward-delete-char 1)
+ (set-mark (point)))
+ (goto-char (point-max))
+ (search-backward "|")
+ (delete-char 1)
+ (setq current-prefix-arg nil)
+ ,@body
+ (insert "|")
+ (when (region-active-p)
+ (exchange-point-and-mark)
+ (insert "~"))
+ (buffer-substring-no-properties
+ (point-min)
+ (point-max)))
+ (and (buffer-name temp-buffer)
+ (kill-buffer temp-buffer))))))
+
+(ert-deftest hydra-integration-1 ()
+ (should (string= (hydra-with "|"
+ (execute-kbd-macro
+ (kbd "C-c aabbaaqaabbaa")))
+ "jjkkjjaabbaa|"))
+ (should (string= (hydra-with "|"
+ (condition-case nil
+ (execute-kbd-macro
+ (kbd "C-c aabb C-g"))
+ (quit nil))
+ (execute-kbd-macro "aaqaabbaa"))
+ "jjkkaaqaabbaa|")))
+
+(ert-deftest hydra-integration-2 ()
+ (should (string= (hydra-with "|"
+ (execute-kbd-macro
+ (kbd "C-c c 1 c 2 d 4 c q")))
+ "ccddcccc|"))
+ (should (string= (hydra-with "|"
+ (execute-kbd-macro
+ (kbd "C-c c 1 c C-u d C-u 10 c q")))
+ "ccddddcccccccccc|")))
+
+(ert-deftest hydra-integration-3 ()
+ (should (string= (hydra-with "foo\nbar|"
+ (execute-kbd-macro
+ (kbd "C-c g 1 RET q")))
+ "|foo\nbar")))
+
+(ert-deftest hydra-columns-1 ()
+ (should (equal (eval
+ (cadr
+ (nth 2
+ (nth 3
+ (macroexpand
+ '(defhydra hydra-info (:color blue
+ :columns 3)
+ "Info-mode"
+ ("?" Info-summary "summary")
+ ("]" Info-forward-node "forward")
+ ("[" Info-backward-node "backward")
+ ("<" Info-top-node "top node")
+ (">" Info-final-node "final node")
+ ("h" Info-help "help")
+ ("d" Info-directory "info dir")
+ ("f" Info-follow-reference "follow ref")
+ ("g" Info-goto-node "goto node")
+ ("l" Info-history-back "hist back")
+ ("r" Info-history-forward "hist forward")
+ ("i" Info-index "index")
+ ("I" Info-virtual-index "virtual index")
+ ("L" Info-history "hist")
+ ("n" Info-next "next")
+ ("p" Info-prev "previous")
+ ("s" Info-search "search")
+ ("S" Info-search-case-sensitively
"case-search")
+ ("T" Info-toc "TOC")
+ ("u" Info-up "up")
+ ("m" Info-menu "menu")
+ ("t" hydra-info-to/body "info-to")))))))
+ #("Info-mode:
+?: summary ]: forward [: backward
+<: top node >: final node h: help
+d: info dir f: follow ref g: goto node
+l: hist back r: hist forward i: index
+I: virtual index L: hist n: next
+p: previous s: search S: case-search
+T: TOC u: up m: menu
+t: info-to"
+ 11 12 (face hydra-face-blue)
+ 28 29 (face hydra-face-blue)
+ 45 46 (face hydra-face-blue)
+ 57 58 (face hydra-face-blue)
+ 74 75 (face hydra-face-blue)
+ 91 92 (face hydra-face-blue)
+ 99 100 (face hydra-face-blue)
+ 116 117 (face hydra-face-blue)
+ 133 134 (face hydra-face-blue)
+ 146 147 (face hydra-face-blue)
+ 163 164 (face hydra-face-blue)
+ 180 181 (face hydra-face-blue)
+ 189 190 (face hydra-face-blue)
+ 206 207 (face hydra-face-blue)
+ 223 224 (face hydra-face-blue)
+ 231 232 (face hydra-face-blue)
+ 248 249 (face hydra-face-blue)
+ 265 266 (face hydra-face-blue)
+ 280 281 (face hydra-face-blue)
+ 297 298 (face hydra-face-blue)
+ 314 315 (face hydra-face-blue)
+ 322 323 (face hydra-face-blue)))))
+
(provide 'hydra-test)
;;; hydra-test.el ends here
diff --git a/packages/hydra/hydra.el b/packages/hydra/hydra.el
index 7195e36..1516c85 100644
--- a/packages/hydra/hydra.el
+++ b/packages/hydra/hydra.el
@@ -5,7 +5,7 @@
;; Author: Oleh Krehel <address@hidden>
;; Maintainer: Oleh Krehel <address@hidden>
;; URL: https://github.com/abo-abo/hydra
-;; Version: 0.12.1
+;; Version: 0.13.4
;; Keywords: bindings
;; Package-Requires: ((cl-lib "0.5"))
@@ -79,24 +79,107 @@
(require 'cl-lib)
(require 'lv)
-(defalias 'hydra-set-transient-map
- (if (fboundp 'set-transient-map)
- 'set-transient-map
- (lambda (map _keep-pred &optional on-exit)
- (with-no-warnings
- (set-temporary-overlay-map map (hydra--pred on-exit))))))
-
-(defun hydra--pred (on-exit)
- "Generate a predicate on whether to continue the Hydra state.
-Call ON-EXIT for clean-up.
-This is a compatibility code for Emacs older than 24.4."
- `(lambda ()
- (if (lookup-key hydra-curr-map (this-command-keys-vector))
- t
- (hydra-cleanup)
- ,(when on-exit
- `(funcall ,(hydra--make-callable on-exit)))
- nil)))
+(defvar hydra-curr-map nil
+ "The keymap of the current Hydra called.")
+
+(defvar hydra-curr-on-exit nil
+ "The on-exit predicate for the current Hydra.")
+
+(defvar hydra-curr-foreign-keys nil
+ "The current :foreign-keys behavior.")
+
+(defvar hydra-curr-body-fn nil
+ "The current hydra-.../body function.")
+
+(defvar hydra-deactivate nil
+ "If a Hydra head sets this to t, exit the Hydra.
+This will be done even if the head wasn't designated for exiting.")
+
+(defun hydra-set-transient-map (keymap on-exit &optional foreign-keys)
+ "Set KEYMAP to the highest priority.
+
+Call ON-EXIT when the KEYMAP is deactivated.
+
+FOREIGN-KEYS determines the deactivation behavior, when a command
+that isn't in KEYMAP is called:
+
+nil: deactivate KEYMAP and run the command.
+run: keep KEYMAP and run the command.
+warn: keep KEYMAP and issue a warning instead of running the command."
+ (if hydra-deactivate
+ (hydra-keyboard-quit)
+ (setq hydra-curr-map keymap)
+ (setq hydra-curr-on-exit on-exit)
+ (setq hydra-curr-foreign-keys foreign-keys)
+ (add-hook 'pre-command-hook 'hydra--clearfun)
+ (internal-push-keymap keymap 'overriding-terminal-local-map)))
+
+(defun hydra--clearfun ()
+ "Disable the current Hydra unless `this-command' is a head."
+ (unless (eq this-command 'hydra-pause-resume)
+ (when (or
+ (memq this-command '(handle-switch-frame
+ keyboard-quit))
+ (null overriding-terminal-local-map)
+ (not (or (eq this-command
+ (lookup-key hydra-curr-map (this-single-command-keys)))
+ (cl-case hydra-curr-foreign-keys
+ (warn
+ (setq this-command 'hydra-amaranth-warn))
+ (run
+ t)
+ (t nil)))))
+ (hydra-disable))))
+
+(defvar hydra--ignore nil
+ "When non-nil, don't call `hydra-curr-on-exit'.")
+
+(defvar hydra--input-method-function nil
+ "Store overridden `input-method-function' here.")
+
+(defun hydra-disable ()
+ "Disable the current Hydra."
+ (setq hydra-deactivate nil)
+ (remove-hook 'pre-command-hook 'hydra--clearfun)
+ (if (fboundp 'remove-function)
+ (remove-function input-method-function #'hydra--imf)
+ (when hydra--input-method-function
+ (setq input-method-function hydra--input-method-function)
+ (setq hydra--input-method-function nil)))
+ (dolist (frame (frame-list))
+ (with-selected-frame frame
+ (when overriding-terminal-local-map
+ (internal-pop-keymap hydra-curr-map 'overriding-terminal-local-map))))
+ (unless hydra--ignore
+ (when hydra-curr-on-exit
+ (let ((on-exit hydra-curr-on-exit))
+ (setq hydra-curr-on-exit nil)
+ (funcall on-exit)))))
+
+(unless (fboundp 'internal-push-keymap)
+ (defun internal-push-keymap (keymap symbol)
+ (let ((map (symbol-value symbol)))
+ (unless (memq keymap map)
+ (unless (memq 'add-keymap-witness (symbol-value symbol))
+ (setq map (make-composed-keymap nil (symbol-value symbol)))
+ (push 'add-keymap-witness (cdr map))
+ (set symbol map))
+ (push keymap (cdr map))))))
+
+(unless (fboundp 'internal-pop-keymap)
+ (defun internal-pop-keymap (keymap symbol)
+ (let ((map (symbol-value symbol)))
+ (when (memq keymap map)
+ (setf (cdr map) (delq keymap (cdr map))))
+ (let ((tail (cddr map)))
+ (and (or (null tail) (keymapp tail))
+ (eq 'add-keymap-witness (nth 1 map))
+ (set symbol tail))))))
+
+(defun hydra-amaranth-warn ()
+ "Issue a warning that the current input was ignored."
+ (interactive)
+ (message "An amaranth Hydra can only exit through a blue head"))
;;* Customize
(defgroup hydra nil
@@ -109,11 +192,6 @@ This is a compatibility code for Emacs older than 24.4."
:type 'boolean
:group 'hydra)
-(defcustom hydra-keyboard-quit ""
- "This binding will quit an amaranth Hydra.
-It's the only other way to quit it besides though a blue head.
-It's possible to set this to nil.")
-
(defcustom hydra-lv t
"When non-nil, `lv-message' (not `message') will be used to display hints."
:type 'boolean)
@@ -126,29 +204,39 @@ It's possible to set this to nil.")
"Default `format'-style specifier for _a_ syntax in docstrings.
When nil, you can specify your own at each location like this: _ 5a_.")
+(make-obsolete-variable
+ 'hydra-key-format-spec
+ "Since the docstrings are aligned by hand anyway, this isn't very useful."
+ "0.13.1")
+
(defface hydra-face-red
- '((t (:foreground "#FF0000" :bold t)))
- "Red Hydra heads will persist indefinitely."
+ '((t (:foreground "#FF0000" :bold t)))
+ "Red Hydra heads don't exit the Hydra.
+Every other command exits the Hydra."
:group 'hydra)
(defface hydra-face-blue
- '((t (:foreground "#0000FF" :bold t)))
- "Blue Hydra heads will vanquish the Hydra.")
+ '((((class color) (background light))
+ :foreground "#0000FF" :bold t)
+ (((class color) (background dark))
+ :foreground "#8ac6f2" :bold t))
+ "Blue Hydra heads exit the Hydra.
+Every other command exits as well.")
(defface hydra-face-amaranth
- '((t (:foreground "#E52B50" :bold t)))
+ '((t (:foreground "#E52B50" :bold t)))
"Amaranth body has red heads and warns on intercepting non-heads.
-Vanquishable only through a blue head.")
+Exitable only through a blue head.")
(defface hydra-face-pink
- '((t (:foreground "#FF6EB4" :bold t)))
- "Pink body has red heads and on intercepting non-heads calls them without
quitting.
-Vanquishable only through a blue head.")
+ '((t (:foreground "#FF6EB4" :bold t)))
+ "Pink body has red heads and runs intercepted non-heads.
+Exitable only through a blue head.")
(defface hydra-face-teal
- '((t (:foreground "#367588" :bold t)))
- "Teal body has blue heads an warns on intercepting non-heads.
-Vanquishable only through a blue head.")
+ '((t (:foreground "#367588" :bold t)))
+ "Teal body has blue heads and warns on intercepting non-heads.
+Exitable only through a blue head.")
;;* Fontification
(defun hydra-add-font-lock ()
@@ -162,6 +250,25 @@ Vanquishable only through a blue head.")
(1 font-lock-keyword-face)
(2 font-lock-type-face)))))
+;;* Find Function
+(eval-after-load 'find-func
+ '(defadvice find-function-search-for-symbol
+ (around hydra-around-find-function-search-for-symbol-advice
+ (symbol type library) activate)
+ "Navigate to hydras with `find-function-search-for-symbol'."
+ ad-do-it
+ ;; The orignial function returns (cons (current-buffer) (point))
+ ;; if it found the point.
+ (unless (cdr ad-return-value)
+ (with-current-buffer (find-file-noselect library)
+ (let ((sn (symbol-name symbol)))
+ (when (and (null type)
+ (string-match "\\`\\(hydra-[a-z-A-Z0-9]+\\)/\\(.*\\)\\'"
sn)
+ (re-search-forward (concat "(defhydra " (match-string 1
sn))
+ nil t))
+ (goto-char (match-beginning 0)))
+ (cons (current-buffer) (point)))))))
+
;;* Universal Argument
(defvar hydra-base-map
(let ((map (make-sparse-keymap)))
@@ -188,20 +295,9 @@ Vanquishable only through a blue head.")
(define-key map [kp-8] 'hydra--digit-argument)
(define-key map [kp-9] 'hydra--digit-argument)
(define-key map [kp-subtract] 'hydra--negative-argument)
- (define-key map [switch-frame] 'hydra--handle-switch-frame)
map)
"Keymap that all Hydras inherit. See `universal-argument-map'.")
-(defvar hydra-curr-map
- (make-sparse-keymap)
- "Keymap of the current Hydra called.")
-
-(defun hydra--handle-switch-frame (evt)
- "Quit hydra and call old switch-frame event handler for EVT."
- (interactive "e")
- (hydra-keyboard-quit)
- (funcall (lookup-key (current-global-map) [switch-frame]) evt))
-
(defun hydra--universal-argument (arg)
"Forward to (`universal-argument' ARG)."
(interactive "P")
@@ -209,20 +305,34 @@ Vanquishable only through a blue head.")
(list (* 4 (car arg)))
(if (eq arg '-)
(list -4)
- '(4))))
- (hydra-set-transient-map hydra-curr-map t))
+ '(4)))))
(defun hydra--digit-argument (arg)
"Forward to (`digit-argument' ARG)."
(interactive "P")
- (let ((universal-argument-map hydra-curr-map))
- (digit-argument arg)))
+ (let* ((char (if (integerp last-command-event)
+ last-command-event
+ (get last-command-event 'ascii-character)))
+ (digit (- (logand char ?\177) ?0)))
+ (setq prefix-arg (cond ((integerp arg)
+ (+ (* arg 10)
+ (if (< arg 0)
+ (- digit)
+ digit)))
+ ((eq arg '-)
+ (if (zerop digit)
+ '-
+ (- digit)))
+ (t
+ digit)))))
(defun hydra--negative-argument (arg)
"Forward to (`negative-argument' ARG)."
(interactive "P")
- (let ((universal-argument-map hydra-curr-map))
- (negative-argument arg)))
+ (setq prefix-arg (cond ((integerp arg) (- arg))
+ ((eq arg '-) nil)
+ (t '-))))
+
;;* Repeat
(defvar hydra-repeat--prefix-arg nil
"Prefix arg to use with `hydra-repeat'.")
@@ -243,9 +353,6 @@ When ARG is non-nil, use that instead."
(funcall hydra-repeat--command))
;;* Misc internals
-(defvar hydra-last nil
- "The result of the last `hydra-set-transient-map' call.")
-
(defun hydra--callablep (x)
"Test if X is callable."
(or (functionp x)
@@ -256,11 +363,14 @@ When ARG is non-nil, use that instead."
"Generate a callable symbol from X.
If X is a function symbol or a lambda, return it. Otherwise, it
should be a single statement. Wrap it in an interactive lambda."
- (if (or (symbolp x) (functionp x))
- x
- `(lambda ()
- (interactive)
- ,x)))
+ (cond ((or (symbolp x) (functionp x))
+ x)
+ ((and (consp x) (eq (car x) 'function))
+ (cadr x))
+ (t
+ `(lambda ()
+ (interactive)
+ ,x))))
(defun hydra-plist-get-default (plist prop default)
"Extract a value from a property list.
@@ -278,72 +388,6 @@ one of the properties on the list."
Return DEFAULT if PROP is not in H."
(hydra-plist-get-default (cl-cdddr h) prop default))
-(defun hydra--aggregate-color (head-color body-color)
- "Return the resulting head color for HEAD-COLOR and BODY-COLOR."
- (cond ((eq head-color 'red)
- (cl-case body-color
- (red 'red)
- (blue 'red)
- (amaranth 'amaranth)
- (pink 'pink)
- (cyan 'amaranth)))
- ((eq head-color 'blue)
- (cl-case body-color
- (red 'blue)
- (blue 'blue)
- (amaranth 'teal)
- (pink 'blue)
- (cyan 'teal)))
- (t
- (error "Can't aggregate head %S to body %S"
- head-color body-color))))
-
-(defun hydra--head-color (h body)
- "Return the color of a Hydra head H with BODY."
- (let* ((exit (hydra--head-property h :exit 'default))
- (color (hydra--head-property h :color))
- (foreign-keys (hydra--body-foreign-keys body))
- (head-color
- (cond ((eq exit 'default)
- (cl-case color
- (blue 'blue)
- (red 'red)
- (t
- (unless (null color)
- (error "Use only :blue or :red for heads: %S" h)))))
- ((null exit)
- (if color
- (error "Don't mix :color and :exit - they are aliases:
%S" h)
- (cl-case foreign-keys
- (run 'pink)
- (warn 'amaranth)
- (t 'red))))
- ((eq exit t)
- (if color
- (error "Don't mix :color and :exit - they are aliases:
%S" h)
- 'blue))
- (t
- (error "Unknown :exit %S" exit)))))
- (cond ((null (cadr h))
- (when head-color
- (hydra--complain
- "Doubly specified blue head - nil cmd is already blue: %S" h))
- 'blue)
- ((null head-color)
- (hydra--body-color body))
- ((null foreign-keys)
- head-color)
- ((eq foreign-keys 'run)
- (if (eq head-color 'red)
- 'pink
- 'blue))
- ((eq foreign-keys 'warn)
- (if (memq head-color '(red amaranth))
- 'amaranth
- 'teal))
- (t
- (error "Unexpected %S %S" h body)))))
-
(defun hydra--body-foreign-keys (body)
"Return what BODY does with a non-head binding."
(or
@@ -353,90 +397,65 @@ Return DEFAULT if PROP is not in H."
((amaranth teal) 'warn)
(pink 'run)))))
-(defun hydra--body-color (body)
- "Return the color of BODY.
-BODY is the second argument to `defhydra'"
- (let ((color (plist-get (cddr body) :color))
- (exit (plist-get (cddr body) :exit))
- (foreign-keys (plist-get (cddr body) :foreign-keys)))
- (cond ((eq foreign-keys 'warn)
- (if exit 'teal 'amaranth))
- ((eq foreign-keys 'run) 'pink)
- (exit 'blue)
- (color color)
- (t 'red))))
-
-(defun hydra--face (h body)
- "Return the face for a Hydra head H with BODY."
- (cl-case (hydra--head-color h body)
- (blue 'hydra-face-blue)
- (red 'hydra-face-red)
- (amaranth 'hydra-face-amaranth)
- (pink 'hydra-face-pink)
- (teal 'hydra-face-teal)
- (t (error "Unknown color for %S" h))))
+(defun hydra--body-exit (body)
+ "Return the exit behavior of BODY."
+ (or
+ (plist-get (cddr body) :exit)
+ (let ((color (plist-get (cddr body) :color)))
+ (cl-case color
+ ((blue teal) t)
+ (t nil)))))
-(defvar hydra--input-method-function nil
- "Store overridden `input-method-function' here.")
+(defalias 'hydra--imf #'list)
(defun hydra-default-pre ()
"Default setup that happens in each head before :pre."
(when (eq input-method-function 'key-chord-input-method)
- (unless hydra--input-method-function
- (setq hydra--input-method-function input-method-function)
- (setq input-method-function nil))))
-
-(defun hydra-cleanup ()
- "Clean up after a Hydra."
- (when hydra--input-method-function
- (setq input-method-function hydra--input-method-function)
- (setq hydra--input-method-function nil))
- (when (window-live-p lv-wnd)
- (let ((buf (window-buffer lv-wnd)))
- (delete-window lv-wnd)
- (kill-buffer buf))))
-
-(defvar hydra-timer (timer-create)
+ (if (fboundp 'add-function)
+ (add-function :override input-method-function #'hydra--imf)
+ (unless hydra--input-method-function
+ (setq hydra--input-method-function input-method-function)
+ (setq input-method-function nil)))))
+
+(defvar hydra-timeout-timer (timer-create)
"Timer for `hydra-timeout'.")
+(defvar hydra-message-timer (timer-create)
+ "Timer for the hint.")
+
+(defvar hydra--work-around-dedicated t
+ "When non-nil, assume there's no bug in `pop-to-buffer'.
+`pop-to-buffer' should not select a dedicated window.")
+
(defun hydra-keyboard-quit ()
"Quitting function similar to `keyboard-quit'."
(interactive)
(hydra-disable)
- (hydra-cleanup)
- (cancel-timer hydra-timer)
- (unless hydra-lv
- (message ""))
+ (cancel-timer hydra-timeout-timer)
+ (cancel-timer hydra-message-timer)
+ (setq hydra-curr-map nil)
+ (unless (and hydra--ignore
+ (null hydra--work-around-dedicated))
+ (if hydra-lv
+ (lv-delete-window)
+ (message "")))
nil)
-(defun hydra-disable ()
- "Disable the current Hydra."
- (cond
- ;; Emacs 25
- ((functionp hydra-last)
- (funcall hydra-last))
-
- ;; Emacs 24.3 or older
- ((< emacs-minor-version 4)
- (setq emulation-mode-map-alists
- (cl-remove-if
- (lambda (x)
- (and (consp x)
- (consp (car x))
- (equal (cdar x) hydra-curr-map)))
- emulation-mode-map-alists)))
-
- ;; Emacs 24.4.1
- (t
- (setq overriding-terminal-local-map nil))))
-
-(defun hydra--unalias-var (str prefix)
- "Return the symbol named STR if it's bound as a variable.
-Otherwise, add PREFIX to the symbol name."
- (let ((sym (intern-soft str)))
- (if (boundp sym)
- sym
- (intern (concat prefix "/" str)))))
+(defvar hydra-head-format "[%s]: "
+ "The formatter for each head of a plain docstring.")
+
+(defvar hydra-key-doc-function 'hydra-key-doc-function-default
+ "The function for formatting key-doc pairs.")
+
+(defun hydra-key-doc-function-default (key key-width doc doc-width)
+ "Doc"
+ (format (format "%%%ds: %%%ds" key-width (- -1 doc-width))
+ key doc))
+
+(defun hydra--to-string (x)
+ (if (stringp x)
+ x
+ (eval x)))
(defun hydra--hint (body heads)
"Generate a hint for the echo area.
@@ -453,15 +472,48 @@ BODY, and HEADS are parameters to `defhydra'."
(cons (cadr h)
(cons pstr (cl-caddr h)))
alist)))))
- (mapconcat
- (lambda (x)
- (format
- (if (> (length (cdr x)) 0)
- (concat "[%s]: " (cdr x))
- "%s")
- (car x)))
- (nreverse (mapcar #'cdr alist))
- ", ")))
+ (let ((keys (nreverse (mapcar #'cdr alist)))
+ (n-cols (plist-get (cddr body) :columns))
+ res)
+ (setq res
+ (if n-cols
+ (let ((n-rows (1+ (/ (length keys) n-cols)))
+ (max-key-len (apply #'max (mapcar (lambda (x) (length
(car x))) keys)))
+ (max-doc-len (apply #'max (mapcar (lambda (x)
+ (length
(hydra--to-string (cdr x)))) keys))))
+ `(concat
+ "\n"
+ (mapconcat #'identity
+ (mapcar
+ (lambda (x)
+ (mapconcat
+ (lambda (y)
+ (and y
+ (funcall hydra-key-doc-function
+ (car y)
+ ,max-key-len
+ (hydra--to-string (cdr y))
+ ,max-doc-len))) x ""))
+ ',(hydra--matrix keys n-cols n-rows))
+ "\n")))
+
+
+ `(concat
+ (mapconcat
+ (lambda (x)
+ (let ((str (hydra--to-string (cdr x))))
+ (format
+ (if (> (length str) 0)
+ (concat hydra-head-format str)
+ "%s")
+ (car x))))
+ ',keys
+ ", ")
+ ,(if keys "." ""))))
+ (if (cl-every #'stringp
+ (mapcar 'cddr alist))
+ (eval res)
+ res))))
(defvar hydra-fontify-head-function nil
"Possible replacement for `hydra-fontify-head-default'.")
@@ -469,38 +521,75 @@ BODY, and HEADS are parameters to `defhydra'."
(defun hydra-fontify-head-default (head body)
"Produce a pretty string from HEAD and BODY.
HEAD's binding is returned as a string with a colored face."
- (propertize (car head) 'face (hydra--face head body)))
-
-(defun hydra-fontify-head-greyscale (head body)
+ (let* ((foreign-keys (hydra--body-foreign-keys body))
+ (head-exit (hydra--head-property head :exit))
+ (head-color
+ (if head-exit
+ (if (eq foreign-keys 'warn)
+ 'teal
+ 'blue)
+ (cl-case foreign-keys
+ (warn 'amaranth)
+ (run 'pink)
+ (t 'red)))))
+ (when (and (null (cadr head))
+ (not head-exit))
+ (hydra--complain "nil cmd can only be blue"))
+ (propertize (if (string= (car head) "%")
+ "%%"
+ (car head))
+ 'face
+ (or (hydra--head-property head :face)
+ (cl-case head-color
+ (blue 'hydra-face-blue)
+ (red 'hydra-face-red)
+ (amaranth 'hydra-face-amaranth)
+ (pink 'hydra-face-pink)
+ (teal 'hydra-face-teal)
+ (t (error "Unknown color for %S" head)))))))
+
+(defun hydra-fontify-head-greyscale (head _body)
"Produce a pretty string from HEAD and BODY.
HEAD's binding is returned as a string wrapped with [] or {}."
- (let ((color (hydra--head-color head body)))
- (format
- (if (eq color 'blue)
- "[%s]"
- "{%s}") (car head))))
+ (format
+ (if (hydra--head-property head :exit)
+ "[%s]"
+ "{%s}") (car head)))
(defun hydra-fontify-head (head body)
"Produce a pretty string from HEAD and BODY."
(funcall (or hydra-fontify-head-function 'hydra-fontify-head-default)
head body))
+(defun hydra--strip-align-markers (str)
+ "Remove ^ from STR, unless they're escaped: \\^."
+ (let ((start 0))
+ (while (setq start (string-match "\\\\?\\^" str start))
+ (if (eq (- (match-end 0) (match-beginning 0)) 2)
+ (progn
+ (setq str (replace-match "^" nil nil str))
+ (cl-incf start))
+ (setq str (replace-match "" nil nil str))))
+ str))
+
(defun hydra--format (_name body docstring heads)
"Generate a `format' statement from STR.
\"%`...\" expressions are extracted into \"%S\".
_NAME, BODY, DOCSTRING and HEADS are parameters of `defhydra'.
The expressions can be auto-expanded according to NAME."
- (setq docstring (replace-regexp-in-string "\\^" "" docstring))
+ (setq docstring (hydra--strip-align-markers docstring))
+ (setq docstring (replace-regexp-in-string "___" "_β_" docstring))
(let ((rest (hydra--hint body heads))
(start 0)
varlist
offset)
(while (setq start
(string-match
- "\\(?:%\\(
?-?[0-9]*s?\\)\\(`[a-z-A-Z/0-9]+\\|(\\)\\)\\|\\(?:_\\(
?-?[0-9]*\\)\\([a-z-A-Z~.,;:0-9/|?<>={}]+\\)_\\)"
+ "\\(?:%\\(
?-?[0-9]*s?\\)\\(`[a-z-A-Z/0-9]+\\|(\\)\\)\\|\\(?:_\\(
?-?[0-9]*?\\)\\(\\[\\|]\\|[-[:alnum:] ~.,;:/|?<>address@hidden&]+?\\)_\\)"
docstring start))
(cond ((eq ?_ (aref (match-string 0 docstring) 0))
(let* ((key (match-string 4 docstring))
+ (key (if (equal key "β") "_" key))
(head (assoc key heads)))
(if head
(progn
@@ -535,21 +624,20 @@ The expressions can be auto-expanded according to NAME."
(if (eq ?\n (aref docstring 0))
`(concat (format ,(substring docstring 1) ,@(nreverse varlist))
,rest)
- `(format ,(concat docstring ": " rest ".")))))
-
-(defun hydra--message (name body docstring heads)
- "Generate code to display the hint in the preferred echo area.
-Set `hydra-lv' to choose the echo area.
-NAME, BODY, DOCSTRING, and HEADS are parameters of `defhydra'."
- (let ((format-expr (hydra--format name body docstring heads)))
- `(if hydra-lv
- (lv-message ,format-expr)
- (message ,format-expr))))
+ (let ((r `(replace-regexp-in-string
+ " +$" ""
+ (concat ,docstring ": "
+ (replace-regexp-in-string
+ "\\(%\\)" "\\1\\1" ,rest)))))
+ (if (stringp rest)
+ `(format ,(eval r))
+ `(format ,r))))))
(defun hydra--complain (format-string &rest args)
"Forward to (`message' FORMAT-STRING ARGS) unless `hydra-verbose' is nil."
- (when hydra-verbose
- (apply #'warn format-string args)))
+ (if hydra-verbose
+ (apply #'error format-string args)
+ (apply #'message format-string args)))
(defun hydra--doc (body-key body-name heads)
"Generate a part of Hydra docstring.
@@ -567,149 +655,95 @@ HEADS is a list of heads."
heads ",\n")
(format "The body can be accessed via `%S'." body-name)))
+(defun hydra--call-interactively (cmd name)
+ "Generate a `call-interactively' statement for CMD.
+Set `this-command' to NAME."
+ (if (and (symbolp name)
+ (not (memq name '(nil body))))
+ `(progn
+ (setq this-command ',name)
+ (call-interactively #',cmd))
+ `(call-interactively #',cmd)))
+
(defun hydra--make-defun (name body doc head
- keymap body-pre body-post &optional other-post)
+ keymap body-pre body-before-exit
+ &optional body-after-exit)
"Make a defun wrapper, using NAME, BODY, DOC, HEAD, and KEYMAP.
NAME and BODY are the arguments to `defhydra'.
DOC was generated with `hydra--doc'.
HEAD is one of the HEADS passed to `defhydra'.
-BODY-PRE and BODY-POST are pre-processed in `defhydra'.
-OTHER-POST is an optional extension to the :post key of BODY."
- (let ((name (hydra--head-name head name body))
+BODY-PRE is added to the start of the wrapper.
+BODY-BEFORE-EXIT will be called before the hydra quits.
+BODY-AFTER-EXIT is added to the end of the wrapper."
+ (let ((cmd-name (hydra--head-name head name))
(cmd (when (car head)
(hydra--make-callable
(cadr head))))
- (color (when (car head)
- (hydra--head-color head body)))
(doc (if (car head)
(format "%s\n\nCall the head: `%S'." doc (cadr head))
doc))
(hint (intern (format "%S/hint" name)))
- (body-color (hydra--body-color body))
- (body-timeout (plist-get body :timeout)))
- `(defun ,name ()
+ (body-foreign-keys (hydra--body-foreign-keys body))
+ (body-timeout (plist-get body :timeout))
+ (body-idle (plist-get body :idle)))
+ `(defun ,cmd-name ()
,doc
(interactive)
(hydra-default-pre)
,@(when body-pre (list body-pre))
- (hydra-disable)
- ,@(when (memq color '(blue teal)) '((hydra-cleanup)))
- (catch 'hydra-disable
- ,@(delq nil
- (if (memq color '(blue teal))
- `(,(when cmd `(call-interactively #',cmd))
- ,body-post)
- `(,(when cmd
- `(condition-case err
- (prog1 t
- (call-interactively #',cmd))
- ((quit error)
- (message "%S" err)
- (unless hydra-lv
- (sit-for 0.8))
- nil)))
- (when hydra-is-helpful
- (,hint))
- (setq hydra-last
- (hydra-set-transient-map
- (setq hydra-curr-map ',keymap)
- t
- ,(if (and
- (not (memq body-color
- '(amaranth pink teal)))
- body-post)
- `(lambda () (hydra-cleanup) ,body-post)
- `(lambda () (hydra-cleanup)))))
- ,(or other-post
- (when body-timeout
- (list 'hydra-timeout
- body-timeout
- (when body-post
- (hydra--make-callable
body-post))))))))))))
-
-(defun hydra-pink-fallback ()
- "On intercepting a non-head, try to run it."
- (let ((keys (this-command-keys))
- kb)
- (when (equal keys [backspace])
- (setq keys ""))
- (setq kb (key-binding keys))
- (if kb
- (if (commandp kb)
- (condition-case err
- (call-interactively kb)
- ((quit error)
- (message "%S" err)
- (unless hydra-lv
- (sit-for 0.8))))
- (message "Pink Hydra can't currently handle prefixes, continuing"))
- (message "Pink Hydra could not resolve: %S" keys))))
-
-(defun hydra--modify-keymap (keymap def)
- "In KEYMAP, add DEF to each sub-keymap."
- (cl-labels
- ((recur (map)
- (if (atom map)
- map
- (if (eq (car map) 'keymap)
- (cons 'keymap
- (cons
- def
- (recur (cdr map))))
- (cons
- (recur (car map))
- (recur (cdr map)))))))
- (recur keymap)))
+ ,@(if (hydra--head-property head :exit)
+ `((hydra-keyboard-quit)
+ (setq hydra-curr-body-fn ',(intern (format "%S/body" name)))
+ ,@(if body-after-exit
+ `((unwind-protect
+ ,(when cmd
+ (hydra--call-interactively cmd (cadr head)))
+ ,body-after-exit))
+ (when cmd
+ `(,(hydra--call-interactively cmd (cadr head))))))
+ (delq
+ nil
+ `((let ((hydra--ignore ,(not (eq (cadr head) 'body))))
+ (hydra-keyboard-quit)
+ (setq hydra-curr-body-fn ',(intern (format "%S/body" name))))
+ ,(when cmd
+ `(condition-case err
+ ,(hydra--call-interactively cmd (cadr head))
+ ((quit error)
+ (message "%S" err)
+ (unless hydra-lv
+ (sit-for 0.8)))))
+ ,(if (and body-idle (eq (cadr head) 'body))
+ `(hydra-idle-message ,body-idle ,hint)
+ `(when hydra-is-helpful
+ (if hydra-lv
+ (lv-message (eval ,hint))
+ (message (eval ,hint)))))
+ (hydra-set-transient-map
+ ,keymap
+ (lambda () (hydra-keyboard-quit) ,body-before-exit)
+ ,(when body-foreign-keys
+ (list 'quote body-foreign-keys)))
+ ,body-after-exit
+ ,(when body-timeout
+ `(hydra-timeout ,body-timeout))))))))
(defmacro hydra--make-funcall (sym)
- "Transform SYM into a `funcall' that calls it."
+ "Transform SYM into a `funcall' to call it."
`(when (and ,sym (symbolp ,sym))
(setq ,sym `(funcall #',,sym))))
-(defun hydra--handle-nonhead (keymap name body heads)
- "Setup KEYMAP for intercepting non-head bindings.
-NAME, BODY and HEADS are parameters to `defhydra'."
- (let ((body-color (hydra--body-color body))
- (body-post (plist-get (cddr body) :post)))
- (if body-post
- (hydra--make-funcall body-post)
- (when hydra-keyboard-quit
- (define-key keymap hydra-keyboard-quit #'hydra-keyboard-quit)))
- (when (memq body-color '(amaranth pink teal))
- (if (cl-some (lambda (h)
- (memq (hydra--head-color h body) '(blue teal)))
- heads)
- (progn
- (setcdr
- keymap
- (cdr
- (hydra--modify-keymap
- keymap
- (cons t
- `(lambda ()
- (interactive)
- ,(cond
- ((memq body-color '(amaranth teal))
- '(message "An amaranth Hydra can only exit through
a blue head"))
- (t
- '(hydra-pink-fallback)))
- (hydra-set-transient-map hydra-curr-map t)
- (when hydra-is-helpful
- (unless hydra-lv
- (sit-for 0.8))
- (,(intern (format "%S/hint" name))))))))))
- (unless (eq body-color 'teal)
- (error
- "An %S Hydra must have at least one blue head in order to exit"
- body-color))))))
-
-(defun hydra--head-name (h name body)
- "Return the symbol for head H of hydra with NAME and BODY."
+(defun hydra--head-name (h name)
+ "Return the symbol for head H of hydra with NAME."
(let ((str (format "%S/%s" name
- (if (symbolp (cadr h))
- (cadr h)
- (concat "lambda-" (car h))))))
- (when (and (memq (hydra--head-color h body) '(blue teal))
+ (cond ((symbolp (cadr h))
+ (cadr h))
+ ((and (consp (cadr h))
+ (eq (cl-caadr h) 'function))
+ (cadr (cadr h)))
+ (t
+ (concat "lambda-" (car h)))))))
+ (when (and (hydra--head-property h :exit)
(not (memq (cadr h) '(body nil))))
(setq str (concat str "-and-exit")))
(intern str)))
@@ -717,15 +751,15 @@ NAME, BODY and HEADS are parameters to `defhydra'."
(defun hydra--delete-duplicates (heads)
"Return HEADS without entries that have the same CMD part.
In duplicate HEADS, :cmd-name is modified to whatever they duplicate."
- (let ((ali '(((hydra-repeat . red) . hydra-repeat)))
+ (let ((ali '(((hydra-repeat . nil) . hydra-repeat)))
res entry)
(dolist (h heads)
(if (setq entry (assoc (cons (cadr h)
- (hydra--head-color h '(nil nil)))
+ (hydra--head-property h :exit))
ali))
(setf (cl-cdddr h) (plist-put (cl-cdddr h) :cmd-name (cdr entry)))
(push (cons (cons (cadr h)
- (hydra--head-color h '(nil nil)))
+ (hydra--head-property h :exit))
(plist-get (cl-cdddr h) :cmd-name))
ali)
(push h res)))
@@ -793,9 +827,8 @@ JOINER is a function similar to `concat'."
strs))
"\n"))
-(defcustom hydra-cell-format "% -20s %% -8`%s"
- "The default format for docstring cells."
- :type 'string)
+(defvar hydra-cell-format "% -20s %% -8`%s"
+ "The default format for docstring cells.")
(defun hydra--table (names rows cols &optional cell-formats)
"Format a `format'-style table from variables in NAMES.
@@ -824,20 +857,36 @@ NAMES should be defined by `defhydradio' or similar."
(dolist (n names)
(set n (aref (get n 'range) 0))))
+(defun hydra-idle-message (secs hint)
+ "In SECS seconds display HINT."
+ (cancel-timer hydra-message-timer)
+ (setq hydra-message-timer (timer-create))
+ (timer-set-time hydra-message-timer
+ (timer-relative-time (current-time) secs))
+ (timer-set-function
+ hydra-message-timer
+ (lambda ()
+ (when hydra-is-helpful
+ (if hydra-lv
+ (lv-message (eval hint))
+ (message (eval hint))))
+ (cancel-timer hydra-message-timer)))
+ (timer-activate hydra-message-timer))
+
(defun hydra-timeout (secs &optional function)
"In SECS seconds call FUNCTION, then function `hydra-keyboard-quit'.
Cancel the previous `hydra-timeout'."
- (cancel-timer hydra-timer)
- (setq hydra-timer (timer-create))
- (timer-set-time hydra-timer
+ (cancel-timer hydra-timeout-timer)
+ (setq hydra-timeout-timer (timer-create))
+ (timer-set-time hydra-timeout-timer
(timer-relative-time (current-time) secs))
(timer-set-function
- hydra-timer
+ hydra-timeout-timer
`(lambda ()
,(when function
- `(funcall ,function))
+ `(funcall ,function))
(hydra-keyboard-quit)))
- (timer-activate hydra-timer))
+ (timer-activate hydra-timeout-timer))
;;* Macros
;;;###autoload
@@ -864,7 +913,7 @@ BODY-MAP is a keymap; `global-map' is used quite often.
Each
function generated from HEADS will be bound in BODY-MAP to
BODY-KEY + KEY (both are strings passed to `kbd'), and will set
the transient map so that all following heads can be called
-though KEY only. BODY-KEY can be an empty string.
+though KEY only. BODY-KEY can be an empty string.
CMD is a callable expression: either an interactive function
name, or an interactive lambda, or a single sexp (it will be
@@ -900,94 +949,143 @@ result of `defhydra'."
(setq docstring "hydra")))
(when (keywordp (car body))
(setq body (cons nil (cons nil body))))
- (let* ((keymap (copy-keymap hydra-base-map))
- (body-name (intern (format "%S/body" name)))
- (body-key (cadr body))
- (body-plist (cddr body))
- (body-map (or (car body)
- (plist-get body-plist :bind)))
- (body-pre (plist-get body-plist :pre))
- (body-body-pre (plist-get body-plist :body-pre))
- (body-post (plist-get body-plist :post)))
- (hydra--make-funcall body-post)
- (when body-post
- (setq heads (cons (list hydra-keyboard-quit #'hydra-keyboard-quit nil
:exit t)
- heads)))
- (dolist (h heads)
- (let ((len (length h)))
- (cond ((< len 2)
- (error "Each head should have at least two items: %S" h))
- ((= len 2)
- (setcdr (cdr h)
- (list
- (hydra-plist-get-default body-plist :hint "")))
- (setcdr (nthcdr 2 h)
- (list :cmd-name (hydra--head-name h name body))))
- (t
- (let ((hint (cl-caddr h)))
- (unless (or (null hint)
- (stringp hint))
- (setcdr (cdr h) (cons
- (hydra-plist-get-default body-plist :hint
"")
- (cddr h))))
- (setcdr (cddr h)
- `(:cmd-name
- ,(hydra--head-name h name body)
- ,@(cl-cdddr h))))))))
- (let ((doc (hydra--doc body-key body-name heads))
- (heads-nodup (hydra--delete-duplicates heads)))
- (mapc
- (lambda (x)
- (define-key keymap (kbd (car x))
- (plist-get (cl-cdddr x) :cmd-name)))
- heads)
- (hydra--make-funcall body-pre)
- (hydra--make-funcall body-body-pre)
- (hydra--handle-nonhead keymap name body heads)
- `(progn
- ;; create defuns
- ,@(mapcar
- (lambda (head)
- (hydra--make-defun name body doc head keymap
- body-pre body-post))
- heads-nodup)
- ;; free up keymap prefix
- ,@(unless (or (null body-key)
- (null body-map)
- (hydra--callablep body-map))
- `((unless (keymapp (lookup-key ,body-map (kbd ,body-key)))
- (define-key ,body-map (kbd ,body-key) nil))))
- ;; bind keys
- ,@(delq nil
- (mapcar
- (lambda (head)
- (let ((name (hydra--head-property head :cmd-name)))
- (when (and (cadr head)
- (not (eq (cadr head) 'hydra-keyboard-quit))
- (or body-key body-map))
- (let ((bind (hydra--head-property head :bind body-map))
- (final-key
- (if body-key
- (vconcat (kbd body-key) (kbd (car head)))
- (kbd (car head)))))
- (cond ((null bind) nil)
- ((hydra--callablep bind)
- `(funcall ,bind ,final-key (function ,name)))
- ((and (symbolp bind)
- (if (boundp bind)
- (keymapp (symbol-value bind))
- t))
- `(define-key ,bind ,final-key (function
,name)))
- (t
- (error "Invalid :bind property `%S' for head
%S" bind head)))))))
- heads))
- (defun ,(intern (format "%S/hint" name)) ()
- ,(hydra--message name body docstring heads))
- ,(hydra--make-defun
- name body doc '(nil body)
- keymap
- (or body-body-pre body-pre) body-post
- '(setq prefix-arg current-prefix-arg))))))
+ (condition-case-unless-debug err
+ (let* ((keymap (copy-keymap hydra-base-map))
+ (keymap-name (intern (format "%S/keymap" name)))
+ (body-name (intern (format "%S/body" name)))
+ (body-key (cadr body))
+ (body-plist (cddr body))
+ (body-map (or (car body)
+ (plist-get body-plist :bind)))
+ (body-pre (plist-get body-plist :pre))
+ (body-body-pre (plist-get body-plist :body-pre))
+ (body-before-exit (or (plist-get body-plist :post)
+ (plist-get body-plist :before-exit)))
+ (body-after-exit (plist-get body-plist :after-exit))
+ (body-inherit (plist-get body-plist :inherit))
+ (body-foreign-keys (hydra--body-foreign-keys body))
+ (body-exit (hydra--body-exit body)))
+ (dolist (base body-inherit)
+ (setq heads (append heads (copy-sequence (eval base)))))
+ (dolist (h heads)
+ (let ((len (length h)))
+ (cond ((< len 2)
+ (error "Each head should have at least two items: %S" h))
+ ((= len 2)
+ (setcdr (cdr h)
+ (list
+ (hydra-plist-get-default body-plist :hint "")))
+ (setcdr (nthcdr 2 h) (list :exit body-exit)))
+ (t
+ (let ((hint (cl-caddr h)))
+ (unless (or (null hint)
+ (stringp hint)
+ (stringp (eval hint)))
+ (setcdr (cdr h) (cons
+ (hydra-plist-get-default body-plist
:hint "")
+ (cddr h)))))
+ (let ((hint-and-plist (cddr h)))
+ (if (null (cdr hint-and-plist))
+ (setcdr hint-and-plist (list :exit body-exit))
+ (let* ((plist (cl-cdddr h))
+ (h-color (plist-get plist :color)))
+ (if h-color
+ (progn
+ (plist-put plist :exit
+ (cl-case h-color
+ ((blue teal) t)
+ (t nil)))
+ (cl-remf (cl-cdddr h) :color))
+ (let ((h-exit (hydra-plist-get-default plist :exit
'default)))
+ (plist-put plist :exit
+ (if (eq h-exit 'default)
+ body-exit
+ h-exit))))))))))
+ (plist-put (cl-cdddr h) :cmd-name (hydra--head-name h name))
+ (when (null (cadr h)) (plist-put (cl-cdddr h) :exit t)))
+ (let ((doc (hydra--doc body-key body-name heads))
+ (heads-nodup (hydra--delete-duplicates heads)))
+ (mapc
+ (lambda (x)
+ (define-key keymap (kbd (car x))
+ (plist-get (cl-cdddr x) :cmd-name)))
+ heads)
+ (hydra--make-funcall body-pre)
+ (hydra--make-funcall body-body-pre)
+ (hydra--make-funcall body-before-exit)
+ (hydra--make-funcall body-after-exit)
+ (when (memq body-foreign-keys '(run warn))
+ (unless (cl-some
+ (lambda (h)
+ (hydra--head-property h :exit))
+ heads)
+ (error
+ "An %S Hydra must have at least one blue head in order to exit"
+ body-foreign-keys)))
+ `(progn
+ ;; create keymap
+ (set (defvar ,keymap-name
+ nil
+ ,(format "Keymap for %S." name))
+ ',keymap)
+ ;; declare heads
+ (set (defvar ,(intern (format "%S/heads" name))
+ nil
+ ,(format "Heads for %S." name))
+ ',(mapcar (lambda (h)
+ (let ((j (copy-sequence h)))
+ (cl-remf (cl-cdddr j) :cmd-name)
+ j))
+ heads))
+ (set
+ (defvar ,(intern (format "%S/hint" name)) nil
+ ,(format "Dynamic hint for %S." name))
+ ',(hydra--format name body docstring heads))
+ ;; create defuns
+ ,@(mapcar
+ (lambda (head)
+ (hydra--make-defun name body doc head keymap-name
+ body-pre
+ body-before-exit
+ body-after-exit))
+ heads-nodup)
+ ;; free up keymap prefix
+ ,@(unless (or (null body-key)
+ (null body-map)
+ (hydra--callablep body-map))
+ `((unless (keymapp (lookup-key ,body-map (kbd ,body-key)))
+ (define-key ,body-map (kbd ,body-key) nil))))
+ ;; bind keys
+ ,@(delq nil
+ (mapcar
+ (lambda (head)
+ (let ((name (hydra--head-property head :cmd-name)))
+ (when (and (cadr head)
+ (or body-key body-map))
+ (let ((bind (hydra--head-property head :bind
body-map))
+ (final-key
+ (if body-key
+ (vconcat (kbd body-key) (kbd (car
head)))
+ (kbd (car head)))))
+ (cond ((null bind) nil)
+ ((hydra--callablep bind)
+ `(funcall ,bind ,final-key (function
,name)))
+ ((and (symbolp bind)
+ (if (boundp bind)
+ (keymapp (symbol-value bind))
+ t))
+ `(define-key ,bind ,final-key (quote
,name)))
+ (t
+ (error "Invalid :bind property `%S' for
head %S" bind head)))))))
+ heads))
+ ,(hydra--make-defun
+ name body doc '(nil body)
+ keymap-name
+ (or body-body-pre body-pre) body-before-exit
+ '(setq prefix-arg current-prefix-arg)))))
+ (error
+ (hydra--complain "Error in defhydra %S: %s" name (cdr err))
+ nil)))
(defmacro defhydradio (name _body &rest heads)
"Create radios with prefix NAME.
@@ -1050,10 +1148,29 @@ DOC defaults to TOGGLE-NAME split and capitalized."
0
i)))))
-(provide 'hydra)
+(require 'ring)
+
+(defvar hydra-pause-ring (make-ring 10)
+ "Ring for paused hydras.")
-;;; Local Variables:
-;;; outline-regexp: ";;\\*+"
-;;; End:
+(defun hydra-pause-resume ()
+ "Quit the current hydra and save it to the stack.
+If there's no active hydra, pop one from the stack and call its body.
+If the stack is empty, call the last hydra's body."
+ (interactive)
+ (cond (hydra-curr-map
+ (ring-insert hydra-pause-ring hydra-curr-body-fn)
+ (hydra-keyboard-quit))
+ ((zerop (ring-length hydra-pause-ring))
+ (funcall hydra-curr-body-fn))
+ (t
+ (funcall (ring-remove hydra-pause-ring 0)))))
+
+;; Local Variables:
+;; outline-regexp: ";;\\([;*]+ [^\s\t\n]\\|###autoload\\)\\|("
+;; indent-tabs-mode: nil
+;; End:
+
+(provide 'hydra)
;;; hydra.el ends here
diff --git a/packages/hydra/lv.el b/packages/hydra/lv.el
index f51d185..8d6192f 100644
--- a/packages/hydra/lv.el
+++ b/packages/hydra/lv.el
@@ -33,6 +33,24 @@
;;; Code:
+(defgroup lv nil
+ "The other echo area."
+ :group 'minibuffer
+ :group 'hydra)
+
+(defcustom lv-use-separator nil
+ "Whether to draw a line between the LV window and the Echo Area."
+ :group 'lv
+ :type 'boolean)
+
+(defface lv-separator
+ '((((class color) (background light)) :background "grey80")
+ (((class color) (background dark)) :background "grey30"))
+ "Face used to draw line between the lv window and the echo area.
+This is only used if option `lv-use-separator' is non-nil.
+Only the background color is significant."
+ :group 'lv)
+
(defvar lv-wnd nil
"Holds the current LV window.")
@@ -44,12 +62,14 @@
buf)
(prog1 (setq lv-wnd
(select-window
- (split-window
- (frame-root-window) -1 'below)))
+ (let ((ignore-window-parameters t))
+ (split-window
+ (frame-root-window) -1 'below))))
(if (setq buf (get-buffer "*LV*"))
(switch-to-buffer buf)
(switch-to-buffer "*LV*")
(set-window-hscroll lv-wnd 0)
+ (setq window-size-fixed t)
(setq mode-line-format nil)
(setq cursor-type nil)
(set-window-dedicated-p lv-wnd t)
@@ -58,22 +78,39 @@
(defvar golden-ratio-mode)
+(defvar lv-force-update nil
+ "When non-nil, `lv-message' will refresh even for the same string.")
+
(defun lv-message (format-string &rest args)
"Set LV window contents to (`format' FORMAT-STRING ARGS)."
- (let* ((ori (selected-window))
- (str (apply #'format format-string args))
+ (let* ((str (apply #'format format-string args))
(n-lines (cl-count ?\n str))
deactivate-mark
golden-ratio-mode)
- (select-window (lv-window))
- (unless (string= (buffer-string) str)
- (delete-region (point-min) (point-max))
- (insert str)
- (setq-local window-min-height n-lines)
- (setq truncate-lines (> n-lines 1))
- (fit-window-to-buffer nil nil 1))
- (goto-char (point-min))
- (select-window ori)))
+ (with-selected-window (lv-window)
+ (unless (and (string= (buffer-string) str)
+ (null lv-force-update))
+ (delete-region (point-min) (point-max))
+ (insert str)
+ (when (and (window-system) lv-use-separator)
+ (unless (looking-back "\n" nil)
+ (insert "\n"))
+ (insert
+ (propertize "__" 'face 'lv-separator 'display '(space :height (1)))
+ (propertize "\n" 'face 'lv-separator 'line-height t)))
+ (setq-local window-min-height n-lines)
+ (setq truncate-lines (> n-lines 1))
+ (let ((window-resize-pixelwise t)
+ (window-size-fixed nil))
+ (fit-window-to-buffer nil nil 1)))
+ (goto-char (point-min)))))
+
+(defun lv-delete-window ()
+ "Delete LV window and kill its buffer."
+ (when (window-live-p lv-wnd)
+ (let ((buf (window-buffer lv-wnd)))
+ (delete-window lv-wnd)
+ (kill-buffer buf))))
(provide 'lv)
diff --git a/packages/hydra/hydra-init.el b/packages/hydra/targets/hydra-init.el
similarity index 90%
rename from packages/hydra/hydra-init.el
rename to packages/hydra/targets/hydra-init.el
index 80b4159..881ceb6 100644
--- a/packages/hydra/hydra-init.el
+++ b/packages/hydra/targets/hydra-init.el
@@ -24,6 +24,4 @@
(setq hydra-examples-verbatim t)
(require 'hydra-examples)
(require 'hydra-test)
-(mapc #'byte-compile-file '("hydra.el"))
-(switch-to-buffer "*Compile-Log*")
-(ert t)
+(mapc #'byte-compile-file '("hydra.el" "hydra-examples.el" "hydra-ox.el"
"hydra-test.el" "lv.el"))
diff --git a/packages/ioccur/ioccur.el b/packages/ioccur/ioccur.el
index 521d3de..aa2b23d 100644
--- a/packages/ioccur/ioccur.el
+++ b/packages/ioccur/ioccur.el
@@ -1,8 +1,8 @@
;;; ioccur.el --- Incremental occur
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2013, 2016 Free Software Foundation, Inc.
-;; Author: Thierry Volpiatto <thierry dot volpiatto at gmail dot com>
+;; Author: Thierry Volpiatto <address@hidden>
;; X-URL: https://github.com/thierryvolpiatto/ioccur
;; Version: 2.4
;; Compatibility: GNU Emacs >=22.3
diff --git a/packages/iterators/iterators.el b/packages/iterators/iterators.el
index 5eff8df..d9cb96b 100644
--- a/packages/iterators/iterators.el
+++ b/packages/iterators/iterators.el
@@ -28,15 +28,21 @@
;;; Commentary:
;;
;; This package extends "generator.el" with higher-level functions.
+;;
+;;
+;; TODO:
+;;
+;; - hook ilists into seq.el via `cl-defgeneric'
+
;;; Code:
-(require 'cl-lib)
+(eval-when-compile (require 'cl-lib))
(require 'generator)
-;; Basic stuff
+;;;; Basic stuff
(defmacro iterator-make (&rest body)
"Create an anonymous iterator.
@@ -44,7 +50,7 @@ This is equivalent to (funcall (iter-lambda () BODY...))"
`(funcall (iter-lambda () ,@body)))
-;; Special simple iterators
+;;;; Special simple iterators
(defun iterator-from-elts (&rest elements)
"Return an iterator generating the ELEMENTS."
@@ -91,8 +97,43 @@ used between the numbers and defaults to 1."
(iter-yield (prog1 i (cl-incf i inc))))))
(iterator-make (while t (iter-yield (prog1 i (cl-incf i))))))))
-
-;; Operations on iterators, transducers
+(iter-defun iterator-of-directory-files-1 (directory &optional match nosort
recurse follow-links)
+ "Helper for `iterator-of-directory-files'."
+ (when (file-accessible-directory-p directory)
+ (let ((files (directory-files directory t match nosort)) file)
+ (while (setq file (pop files))
+ (cond
+ ((not (file-directory-p file))
+ (iter-yield file))
+ ((member (file-name-nondirectory (directory-file-name file))
+ '("." "..")))
+ (t
+ (iter-yield file)
+ (when (and (or follow-links (not (file-symlink-p file)))
+ (if (functionp recurse) (funcall recurse file) recurse))
+ (iter-yield-from (iterator-of-directory-files-1
+ file match nosort recurse follow-links)))))))))
+
+(defun iterator-of-directory-files (directory &optional full match nosort
recurse follow-links)
+ "Return an iterator of names of files in DIRECTORY.
+Don't include files named \".\" or \"..\". The arguments FULL,
+MATCH and NOSORT are like in `directory-files'.
+
+Optional argument RECURSE non-nil means recurse on
+subdirectories. If RECURSE is a function, it should be a
+predicate accepting one argument, an absolute file name of a
+directory, and return non-nil when the returned iterator should
+recurse into that directory. Any other non-nil value means
+recurse into every readable subdirectory.
+
+Even with recurse non-nil, don't descent into directories by
+following symlinks unless FOLLOW-LINKS is non-nil."
+ (iterator-map
+ (lambda (file) (if full file (file-relative-name file directory)))
+ (iterator-of-directory-files-1 directory match nosort recurse
follow-links)))
+
+
+;;;; Operations on iterators, transducers
(defun iterator-filter (predicate iterator)
"Return an iterator filtering ITERATOR with PREDICATE.
@@ -174,7 +215,7 @@ returns an iterator of the factorials."
iterator))))
-;; Iteration
+;;;; Iteration
(defun iterator-flush (iterator)
"Request all elements from ITERATOR, for side effects only."
@@ -183,7 +224,7 @@ returns an iterator of the factorials."
(iter-end-of-sequence nil)))
-;; Processing elements
+;;;; Processing elements
(defun iterator-reduce (function init iterator)
"Reduce two-argument FUNCTION across ITERATOR starting with INIT.
@@ -264,7 +305,7 @@ like `mapconcat', but for iterators."
(iterator-map function iterator))))
-;;; ILists - "Delayed" lists via iterators
+;;;; ILists - "Delayed" lists via iterators
(defconst ilist--last-link-tag 'ilist--last-link-tag)
@@ -371,14 +412,14 @@ argument ilists are not modified."
(defun ilist-setcar (ilist object)
"Set the first element of ILIST to OBJECT.
-Error if ILIST is empty. Returns OBJECT."
+Error if ILIST is empty. Return OBJECT."
(if (ilist-empty-p ilist)
(signal 'empty-ilist nil)
(setcar ilist object)))
(defun ilist-setcdr (ilist newcdr)
"Set the `ilist-cdr' of ILIST to NEWCDR.
-Error if ILIST is empty. Returns NEWCDR."
+Error if ILIST is empty. Return NEWCDR."
(if (ilist-empty-p ilist)
(signal 'empty-ilist nil)
(setcdr ilist newcdr)))
diff --git a/packages/javaimp/javaimp.el b/packages/javaimp/javaimp.el
index ca1a710..df402ce 100644
--- a/packages/javaimp/javaimp.el
+++ b/packages/javaimp/javaimp.el
@@ -4,7 +4,7 @@
;; Author: Filipp Gunbin <address@hidden>
;; Maintainer: Filipp Gunbin <address@hidden>
-;; Version: 0.5
+;; Version: 0.6
;; Keywords: java, maven, programming
;;; Commentary:
@@ -40,6 +40,10 @@
;;
;; `javaimp-jdk-home' is a path for JDK. It is used to scan JDK jars.
;; Usually you will need to set this.
+;;
+;; `javaimp-additional-source-dirs' is a list specifying directories where
+;; additional (e.g. generated) source files reside. Each directory is a
+;; relative path from ${project.build.directory} project property value.
;;
;; `javaimp-mvn-program' defines path of the `mvn' program. Use if it's
;; not on `exec-path'.
@@ -65,9 +69,13 @@
;; Sample setup (put this into your .emacs):
;;
;; (require 'javaimp)
-;; (add-to-list
-;; 'javaimp-import-group-alist '("\\`\\(ru\\.yota\\.\\|tv\\.okko\\.\\)" .
80))
-;; (setq javaimp-jdk-home "/opt/java")
+;;
+;; (add-to-list 'javaimp-import-group-alist
'("\\`\\(ru\\.yota\\.\\|tv\\.okko\\.\\)" . 80))
+;;
+;; (setq javaimp-jdk-home (getenv "JAVA_HOME"))
+;; (setq javaimp-include-current-project-classes t)
+;; (setq javaimp-additional-source-dirs '("generated-sources/thrift"))
+;;
;; (add-hook 'java-mode-hook
;; (lambda ()
;; (local-set-key "\C-ci" 'javaimp-add-import)
@@ -94,10 +102,14 @@
"Add and reorder Java import statements in Maven projects.")
(defcustom javaimp-import-group-alist '(("\\`javax?\\." . 10))
- "Specifies how to group classes and how to order resulting groups in the
-imports list. Each element should be of the form `(CLASSNAME-REGEXP
-. ORDER)' where `CLASSNAME-REGEXP' is a regexp matching the fully qualified
-class name. The order of classes which were not matched is defined by
+ "Specifies how to group classes and how to order resulting
+groups in the imports list.
+
+Each element should be of the form `(CLASSNAME-REGEXP . ORDER)'
+where `CLASSNAME-REGEXP' is a regexp matching the fully qualified
+class name.
+
+The order of classes which were not matched is defined by
`javaimp-import-default-order'.")
(defcustom javaimp-import-default-order 50
@@ -107,6 +119,23 @@ class name. The order of classes which were not matched
is defined by
(defcustom javaimp-jdk-home nil
"Path to the JDK")
+(defcustom javaimp-additional-source-dirs nil
+ "List of directories where additional (e.g. generated)
+source files reside.
+
+Each directory is a relative path from ${project.build.directory} project
+property value.
+
+Typically you would check documentation for a Maven plugin, look
+at the parameter's default value there and add it to this list.
+
+E.g. \"${project.build.directory}/generated-sources/<plugin_name>\"
+becomes \"generated-sources/<plugin_name>\" (note the absence
+of the leading slash.
+
+Custom values set in plugin configuration in pom.xml are not
+supported yet.")
+
(defcustom javaimp-mvn-program "mvn"
"Path to the `mvn' program")
@@ -117,8 +146,10 @@ class name. The order of classes which were not matched
is defined by
"Path to the `jar' program")
(defcustom javaimp-include-current-project-classes t
- "If non-nil, current project's classes are included into
- completion alternatives. Only top-level classes are included.")
+ "If non-nil, current project's classes are included into completion
+alternatives.
+
+Only top-level classes are included.")
;;; Variables and constants
@@ -152,11 +183,13 @@ class name. The order of classes which were not matched
is defined by
;; A module is represented as a list of the form `(ARTIFACT POM-FILE
-;; SOURCE-DIR TEST-SOURCE-DIR POM-FILE-MOD-TS PARENT PARENT-TS)'.
+;; SOURCE-DIR TEST-SOURCE-DIR BUILD-DIR POM-FILE-MOD-TS PARENT PARENT-TS)'.
-(defsubst javaimp-make-mod (artifact pom-file source-dir test-source-dir
- pom-file-mod-ts jars-list parent parent-ts)
- (list artifact pom-file source-dir test-source-dir
+(defsubst javaimp-make-mod (artifact pom-file source-dir
+ test-source-dir build-dir
+ pom-file-mod-ts jars-list
+ parent parent-ts)
+ (list artifact pom-file source-dir test-source-dir build-dir
pom-file-mod-ts jars-list parent parent-ts))
(defsubst javaimp-get-mod-artifact (module)
@@ -171,25 +204,28 @@ class name. The order of classes which were not matched
is defined by
(defsubst javaimp-get-mod-test-source-dir (module)
(nth 3 module))
-(defsubst javaimp-get-mod-pom-mod-ts (module)
+(defsubst javaimp-get-mod-build-dir (module)
(nth 4 module))
+
+(defsubst javaimp-get-mod-pom-mod-ts (module)
+ (nth 5 module))
(defsubst javaimp-set-mod-pom-mod-ts (module value)
- (setcar (nthcdr 4 module) value))
+ (setcar (nthcdr 5 module) value))
(defsubst javaimp-get-mod-pom-deps (module)
- (nth 5 module))
+ (nth 6 module))
(defsubst javaimp-set-mod-pom-deps (module value)
- (setcar (nthcdr 5 module) value))
+ (setcar (nthcdr 6 module) value))
(defsubst javaimp-get-mod-parent (module)
- (nth 6 module))
+ (nth 7 module))
(defsubst javaimp-set-mod-parent (module value)
- (setcar (nthcdr 6 module) value))
+ (setcar (nthcdr 7 module) value))
(defsubst javaimp-get-mod-parent-ts (module)
- (nth 7 module))
+ (nth 8 module))
(defsubst javaimp-set-mod-parent-ts (module value)
- (setcar (nthcdr 7 module) value))
+ (setcar (nthcdr 8 module) value))
;; An artifact is represented as a list: (GROUP-ID ARTIFACT-ID VERSION).
@@ -268,7 +304,7 @@ PATH. PATH should point to a directory."
(list (assq 'project xml-tree)))
(t
(error "Cannot find projects in mvn output"))))
-
+
(defun javaimp-maven-load-module-tree (pom)
"Returns an alist of all Maven modules in a hierarchy starting
with POM"
@@ -279,7 +315,7 @@ with POM"
(let (xml-start-pos xml-end-pos)
;; find where we should start parsing XML
(goto-char (point-min))
- (re-search-forward "<\\?xml\\|<projects?>")
+ (re-search-forward "<\\?xml\\|<projects?")
(setq xml-start-pos (match-beginning 0))
;; determine the start tag
(goto-char (point-min))
@@ -320,6 +356,8 @@ with POM"
(test-source-dir (javaimp-xml-first-child
(javaimp-xml-child 'testSourceDirectory
build)))
+ (build-dir (javaimp-xml-first-child
+ (javaimp-xml-child 'directory build)))
(parent (javaimp-make-artifact-from-xml
(javaimp-xml-child 'parent proj))))
(push (javaimp-make-mod
@@ -335,6 +373,11 @@ with POM"
(car (process-lines javaimp-cygpath-program "-u"
test-source-dir))
test-source-dir))
+ (file-name-as-directory
+ (if (eq system-type 'cygwin)
+ (car (process-lines javaimp-cygpath-program "-u"
+ build-dir))
+ build-dir))
nil nil parent nil)
result)))))
@@ -394,8 +437,8 @@ the temporary buffer and returns its result"
(process-file javaimp-mvn-program nil t nil "-f" pom-file
target)))
(output-buf (current-buffer)))
(with-current-buffer (get-buffer-create javaimp-debug-buf-name)
- (erase-buffer)
- (insert-buffer-substring output-buf))
+ (erase-buffer)
+ (insert-buffer-substring output-buf))
(unless (and (numberp status) (= status 0))
(error "Maven target \"%s\" failed with status \"%s\""
target status))
@@ -431,7 +474,7 @@ the temporary buffer and returns its result"
(or (null last-ts) ; reading for the first time?
(not (equal (float-time curr-ts) (float-time last-ts)))
(javaimp-any-file-ts-updated (cdr files))))))
-
+
(defun javaimp-get-dep-jars-cached (module parent)
"Returns a list of dependency jar file paths for a MODULE.
Both MODULE and PARENT poms are checked for updates because
@@ -443,9 +486,9 @@ MODULE."
(when parent
(cons
(javaimp-get-mod-pom-file parent)
- ;; here we check the saved parent ts because it
- ;; matters what version we had when we were
- ;; reloading this pom the last time
+ ;; here we check the saved parent ts because it
+ ;; matters what version we had when we were
+ ;; reloading this pom the last time
(javaimp-get-mod-parent-ts module))))))
;; (re-)fetch dependencies
(javaimp-set-mod-pom-deps
@@ -491,7 +534,7 @@ directory"
(push (replace-regexp-in-string "[/$]" "." (match-string 1))
result))
result)))
-
+
(defun javaimp-collect-jar-classes (jar-paths)
(let (result jar)
(dolist (jar-path jar-paths result)
@@ -515,7 +558,7 @@ directory"
(car modules))
(t
(javaimp-get-module (cdr modules) predicate))))
-
+
(defun javaimp-get-module-by-file (file)
(javaimp-get-module-from-root
javaimp-maven-root-modules
@@ -528,7 +571,7 @@ directory"
javaimp-maven-root-modules
(lambda (mod)
(equal (javaimp-get-mod-artifact mod) artifact))))
-
+
;;; Adding and organizing imports
@@ -561,11 +604,20 @@ module."
"Scans current project and returns a list of top-level classes in both the
source directory and test source directory"
(let ((src-dir (javaimp-get-mod-source-dir module))
- (test-src-dir (javaimp-get-mod-test-source-dir module)))
- (append (and (file-accessible-directory-p src-dir)
- (javaimp-get-directory-classes src-dir nil))
- (and (file-accessible-directory-p test-src-dir)
- (javaimp-get-directory-classes test-src-dir nil)))))
+ (test-src-dir (javaimp-get-mod-test-source-dir module))
+ (build-dir (javaimp-get-mod-build-dir module)))
+ (append
+ (and javaimp-additional-source-dirs
+ (seq-mapcat
+ (lambda (rel-dir)
+ (let ((dir (file-name-as-directory (concat build-dir rel-dir))))
+ (and (file-accessible-directory-p dir)
+ (javaimp-get-directory-classes dir nil))))
+ javaimp-additional-source-dirs))
+ (and (file-accessible-directory-p test-src-dir)
+ (javaimp-get-directory-classes test-src-dir nil))
+ (and (file-accessible-directory-p src-dir)
+ (javaimp-get-directory-classes src-dir nil)))))
(defun javaimp-get-directory-classes (dir prefix)
"Returns the list of classes found in the directory DIR. PREFIX is the
diff --git a/packages/js2-mode/Makefile b/packages/js2-mode/Makefile
index f86786f..08b1e48 100644
--- a/packages/js2-mode/Makefile
+++ b/packages/js2-mode/Makefile
@@ -22,5 +22,5 @@ js2-imenu-extras.elc: js2-mode.elc
${EMACS} $(BATCHFLAGS) -l ./js2-mode.elc -f batch-byte-compile $*.el
test:
- ${EMACS} $(BATCHFLAGS) -l js2-mode.el -l tests/parser.el\
+ ${EMACS} $(BATCHFLAGS) -L . -l js2-mode.el -l js2-old-indent.el -l
tests/parser.el\
-l tests/indent.el -l tests/externs.el -f ert-run-tests-batch-and-exit
diff --git a/packages/js2-mode/NEWS.md b/packages/js2-mode/NEWS.md
index eea51d3..2984e91 100644
--- a/packages/js2-mode/NEWS.md
+++ b/packages/js2-mode/NEWS.md
@@ -1,5 +1,29 @@
# History of user-visible changes
+## 20150909
+
+* `js2-mode` now derives from `js-mode`. That means the former
+ function will run `js-mode-hook`, as well as `js2-mode-hook`. The
+ key bindings will default to `js-mode-map` where they're not set in
+ `js2-mode-map`. And in Emacs 25 or later (including the snapshot
+ builds), `js2-mode` uses the indentation code from `js-mode`. Where
+ feasible, the user options (and functions) now have aliases, but if
+ you're using Emacs 25 and you see an indentation-related setting
+ that stopped working, try looking for a corresponding one in the
+ `js` group: `M-x customize-group RET js RET`.
+
+* New command: `js2-jump-to-definition`. It's bound to `M-.` by
+ default, via remapping `js-find-symbol`. To get back to the default
+ `M-.` binding (e.g. `find-tag`), put this in your init file:
+
+ (eval-after-load 'js (define-key js-mode-map (kbd "M-.") nil))
+
+## 20150713
+
+* More comprehensive strict mode warnings and syntax errors.
+* New minor mode: `js2-highlight-unused-variables-mode`.
+* `js2-pretty-multiline-declarations` can take the value `dynamic` now.
+
## 20150202
Support for:
diff --git a/packages/js2-mode/js2-mode.el b/packages/js2-mode/js2-mode.el
index 6ab7cb9..2d6f336 100644
--- a/packages/js2-mode/js2-mode.el
+++ b/packages/js2-mode/js2-mode.el
@@ -7,7 +7,7 @@
;; Dmitry Gutov <address@hidden>
;; URL: https://github.com/mooz/js2-mode/
;; http://code.google.com/p/js2-mode/
-;; Version: 20150202
+;; Version: 20150909
;; Keywords: languages, javascript
;; Package-Requires: ((emacs "24.1") (cl-lib "0.5"))
@@ -87,13 +87,16 @@
(require 'cl-lib)
(require 'imenu)
-(require 'cc-cmds) ; for `c-fill-paragraph'
+(require 'js)
+(require 'etags)
(eval-and-compile
- (require 'cc-mode) ; (only) for `c-populate-syntax-table'
- (require 'cc-engine)) ; for `c-paragraph-start' et. al.
-
-(defvar electric-layout-rules)
+ (if (version< emacs-version "25.0")
+ (require 'js2-old-indent)
+ (defvaralias 'js2-basic-offset 'js-indent-level nil)
+ (defalias 'js2-proper-indentation 'js--proper-indentation)
+ (defalias 'js2-indent-line 'js-indent-line)
+ (defalias 'js2-re-search-forward 'js--re-search-forward)))
;;; Externs (variables presumed to be defined by the host system)
@@ -188,7 +191,8 @@ Set `js2-include-rhino-externs' to t to include them.")
(defvar js2-node-externs
(mapcar 'symbol-name
'(__dirname __filename Buffer clearInterval clearTimeout require
- console exports global module process setInterval setTimeout))
+ console exports global module process setInterval setTimeout
+ querystring))
"Node.js externs.
Set `js2-include-node-externs' to t to include them.")
@@ -234,55 +238,6 @@ variable with predicate PRED."
"An improved JavaScript mode."
:group 'languages)
-(defcustom js2-basic-offset (if (and (boundp 'c-basic-offset)
- (numberp c-basic-offset))
- c-basic-offset
- 4)
- "Number of spaces to indent nested statements.
-Similar to `c-basic-offset'."
- :group 'js2-mode
- :type 'integer)
-(js2-mark-safe-local 'js2-basic-offset 'integerp)
-
-(defcustom js2-bounce-indent-p nil
- "Non-nil to have indent-line function choose among alternatives.
-If nil, the indent-line function will indent to a predetermined column
-based on heuristic guessing. If non-nil, then if the current line is
-already indented to that predetermined column, indenting will choose
-another likely column and indent to that spot. Repeated invocation of
-the indent-line function will cycle among the computed alternatives.
-See the function `js2-bounce-indent' for details. When it is non-nil,
-js2-mode also binds `js2-bounce-indent-backwards' to Shift-Tab."
- :type 'boolean
- :group 'js2-mode)
-
-(defcustom js2-pretty-multiline-declarations t
- "Non-nil to line up multiline declarations vertically:
-
- var a = 10,
- b = 20,
- c = 30;
-
-If the value is not `all', and the first assigned value in
-declaration is a function/array/object literal spanning several
-lines, it won't be indented additionally:
-
- var o = { var bar = 2,
- foo: 3 vs. o = {
- }, foo: 3
- bar = 2; };"
- :group 'js2-mode
- :type 'symbol)
-(js2-mark-safe-local 'js2-pretty-multiline-declarations 'symbolp)
-
-(defcustom js2-indent-switch-body nil
- "When nil, case labels are indented on the same level as the
-containing switch statement. Otherwise, all lines inside
-switch statement body are indented one additional level."
- :type 'boolean
- :group 'js2-mode)
-(js2-mark-safe-local 'js2-indent-case-same-as-switch 'booleanp)
-
(defcustom js2-idle-timer-delay 0.2
"Delay in secs before re-parsing after user makes changes.
Multiplied by `js2-dynamic-idle-timer-adjust', which see."
@@ -650,11 +605,10 @@ which doesn't seem particularly useful, but Rhino permits
it."
(defvar js2-ARROW 162) ; function arrow (=>)
(defvar js2-CLASS 163)
(defvar js2-EXTENDS 164)
-(defvar js2-STATIC 165)
-(defvar js2-SUPER 166)
-(defvar js2-TEMPLATE_HEAD 167) ; part of template literal before
substitution
-(defvar js2-NO_SUBS_TEMPLATE 168) ; template literal without substitutions
-(defvar js2-TAGGED_TEMPLATE 169) ; tagged template literal
+(defvar js2-SUPER 165)
+(defvar js2-TEMPLATE_HEAD 166) ; part of template literal before
substitution
+(defvar js2-NO_SUBS_TEMPLATE 167) ; template literal without substitutions
+(defvar js2-TAGGED_TEMPLATE 168) ; tagged template literal
(defconst js2-num-tokens (1+ js2-TAGGED_TEMPLATE))
@@ -713,6 +667,7 @@ List of chars built up while scanning various tokens.")
(end -1)
(string "")
number
+ number-base
regexp-flags
comment-type
follows-eol-p)
@@ -810,6 +765,9 @@ Will only be used when we finish implementing the
interpreter.")
(js2-deflocal js2-is-in-destructuring nil
"True while parsing destructuring expression.")
+(js2-deflocal js2-in-use-strict-directive nil
+ "True while inside a script or function under strict mode.")
+
(defcustom js2-global-externs nil
"A list of any extern names you'd like to consider always declared.
This list is global and is used by all `js2-mode' files.
@@ -1133,6 +1091,11 @@ another file, or you've got a potential bug."
:type 'boolean
:group 'js2-mode)
+(defcustom js2-warn-about-unused-function-arguments nil
+ "Non-nil to treat function arguments like declared-but-unused variables."
+ :type 'booleanp
+ :group 'js2-mode)
+
(defcustom js2-include-jslint-globals t
"Non-nil to include the identifiers from JSLint global
declaration (see http://www.jslint.com/lint.html#global) in the
@@ -1153,8 +1116,7 @@ information."
(define-key map (kbd "C-c C-o") #'js2-mode-toggle-element)
(define-key map (kbd "C-c C-w") #'js2-mode-toggle-warnings-and-errors)
(define-key map [down-mouse-3] #'js2-down-mouse-3)
- (when js2-bounce-indent-p
- (define-key map (kbd "<backtab>") #'js2-indent-bounce-backwards))
+ (define-key map [remap js-find-symbol] #'js2-jump-to-definition)
(define-key map [menu-bar javascript]
(cons "JavaScript" (make-sparse-keymap "JavaScript")))
@@ -1217,6 +1179,24 @@ information."
map)
"Keymap used in `js2-mode' buffers.")
+(defcustom js2-bounce-indent-p nil
+ "Non-nil to bind `js2-indent-bounce' and `js2-indent-bounce-backward'.
+They will augment the default indent-line behavior with cycling
+among several computed alternatives. See the function
+`js2-bounce-indent' for details. The above commands will be
+bound to TAB and backtab."
+ :type 'boolean
+ :group 'js2-mode
+ :set (lambda (sym value)
+ (set-default sym value)
+ (let ((map js2-mode-map))
+ (if (not value)
+ (progn
+ (define-key map "\t" nil)
+ (define-key map (kbd "<backtab>") nil))
+ (define-key map "\t" #'js2-indent-bounce)
+ (define-key map (kbd "<backtab>")
#'js2-indent-bounce-backward)))))
+
(defconst js2-mode-identifier-re "[[:alpha:]_$][[:alnum:]_$]*")
(defvar js2-mode-//-comment-re "^\\(\\s-*\\)//.+"
@@ -1239,32 +1219,6 @@ First match-group is the leading whitespace.")
(js2-deflocal js2-imenu-recorder nil "Private variable")
(js2-deflocal js2-imenu-function-map nil "Private variable")
-(defvar js2-paragraph-start
- "\\(@[[:alpha:]]+\\>\\|$\\)")
-
-;; Note that we also set a 'c-in-sws text property in html comments,
-;; so that `c-forward-sws' and `c-backward-sws' work properly.
-(defvar js2-syntactic-ws-start
- "\\s \\|/[*/]\\|[\n\r]\\|\\\\[\n\r]\\|\\s!\\|<!--\\|^\\s-*-->")
-
-(defvar js2-syntactic-ws-end
- "\\s \\|[\n\r/]\\|\\s!")
-
-(defvar js2-syntactic-eol
- (concat "\\s *\\(/\\*[^*\n\r]*"
- "\\(\\*+[^*\n\r/][^*\n\r]*\\)*"
- "\\*+/\\s *\\)*"
- "\\(//\\|/\\*[^*\n\r]*"
- "\\(\\*+[^*\n\r/][^*\n\r]*\\)*$"
- "\\|\\\\$\\|$\\)")
- "Copied from `java-mode'. Needed for some cc-engine functions.")
-
-(defvar js2-comment-prefix-regexp
- "//+\\|\\**")
-
-(defvar js2-comment-start-skip
- "\\(//+\\|/\\*+\\)\\s *")
-
(defvar js2-mode-verbose-parse-p js2-mode-dev-mode-p
"Non-nil to emit status messages during parsing.")
@@ -1274,6 +1228,7 @@ First match-group is the leading whitespace.")
(defvar js2-mode-syntax-table
(let ((table (make-syntax-table)))
(c-populate-syntax-table table)
+ (modify-syntax-entry ?` "\"" table)
table)
"Syntax table used in `js2-mode' buffers.")
@@ -1384,7 +1339,7 @@ the correct number of ARGS must be provided."
"Invalid assignment left-hand side.")
(js2-msg "msg.bad.decr"
- "Invalid decerement operand.")
+ "Invalid decrement operand.")
(js2-msg "msg.bad.incr"
"Invalid increment operand.")
@@ -1639,6 +1594,9 @@ the correct number of ARGS must be provided."
(js2-msg "msg.no.paren.after.with"
"missing ) after with-statement object")
+(js2-msg "msg.no.with.strict"
+ "with statements not allowed in strict mode")
+
(js2-msg "msg.no.paren.after.let"
"missing ( after let")
@@ -1754,6 +1712,18 @@ the correct number of ARGS must be provided."
(js2-msg "msg.destruct.assign.no.init"
"Missing = in destructuring declaration")
+(js2-msg "msg.no.octal.strict"
+ "Octal numbers prohibited in strict mode.")
+
+(js2-msg "msg.dup.obj.lit.prop.strict"
+ "Property '%s' already defined in this object literal.")
+
+(js2-msg "msg.dup.param.strict"
+ "Parameter '%s' already declared in this function.")
+
+(js2-msg "msg.bad.id.strict"
+ "'%s' is not a valid identifier for this use in strict mode.")
+
;; ScriptRuntime
(js2-msg "msg.no.properties"
"%s has no properties.")
@@ -1770,6 +1740,12 @@ the correct number of ARGS must be provided."
(js2-msg "msg.undeclared.variable" ; added by js2-mode
"Undeclared variable or function '%s'")
+(js2-msg "msg.unused.variable" ; added by js2-mode
+ "Unused variable or function '%s'")
+
+(js2-msg "msg.uninitialized.variable" ; added by js2-mode
+ "Variable '%s' referenced but never initialized")
+
(js2-msg "msg.ref.undefined.prop"
"Reference to undefined property '%s'")
@@ -2150,17 +2126,6 @@ Returns nil if element is not found in the list."
(defsubst js2-flag-not-set-p (flags flag)
(zerop (logand flags flag)))
-(defmacro js2-with-underscore-as-word-syntax (&rest body)
- "Evaluate BODY with the _ character set to be word-syntax."
- (declare (indent 0) (debug t))
- (let ((old-syntax (make-symbol "old-syntax")))
- `(let ((,old-syntax (string (char-syntax ?_))))
- (unwind-protect
- (progn
- (modify-syntax-entry ?_ "w" js2-mode-syntax-table)
- ,@body)
- (modify-syntax-entry ?_ ,old-syntax js2-mode-syntax-table)))))
-
;;; AST struct and function definitions
;; flags for ast node property 'member-type (used for e4x operators)
@@ -2308,24 +2273,29 @@ If any given node in NODES is nil, doesn't record that
link."
(defun js2-node-get-enclosing-scope (node)
"Return the innermost `js2-scope' node surrounding NODE.
Returns nil if there is no enclosing scope node."
- (let ((parent (js2-node-parent node)))
- (while (not (js2-scope-p parent))
- (setq parent (js2-node-parent parent)))
- parent))
+ (while (and (setq node (js2-node-parent node))
+ (not (js2-scope-p node))))
+ node)
-(defun js2-get-defining-scope (scope name)
+(defun js2-get-defining-scope (scope name &optional point)
"Search up scope chain from SCOPE looking for NAME, a string or symbol.
-Returns `js2-scope' in which NAME is defined, or nil if not found."
+Returns `js2-scope' in which NAME is defined, or nil if not found.
+
+If POINT is non-nil, and if the found declaration type is
+`js2-LET', also check that the declaration node is before POINT."
(let ((sym (if (symbolp name)
name
(intern name)))
- table
result
(continue t))
(while (and scope continue)
(if (or
- (and (setq table (js2-scope-symbol-table scope))
- (assq sym table))
+ (let ((entry (cdr (assq sym (js2-scope-symbol-table scope)))))
+ (and entry
+ (or (not point)
+ (not (eq js2-LET (js2-symbol-decl-type entry)))
+ (>= point
+ (js2-node-abs-pos (js2-symbol-ast-node entry))))))
(and (eq sym 'arguments)
(js2-function-node-p scope)))
(setq continue nil
@@ -2506,7 +2476,7 @@ NAME can be a Lisp symbol or string. SYMBOL is a
`js2-symbol'."
(:include js2-node)
(:constructor nil)
(:constructor make-js2-export-node (&key (type js2-EXPORT)
- (pos)
(js2-current-token-beg)
+ (pos
(js2-current-token-beg))
len
exports-list
from-clause
@@ -2764,7 +2734,7 @@ different, visit the extern-name."
(when (not (equal local-name extern-name))
(js2-visit-ast extern-name v))))
-(defun js2-print-extern-binding (n i)
+(defun js2-print-extern-binding (n _i)
"Print a representation of a single extern binding. E.g. 'foo' or
'foo as bar'."
(let ((local-name (js2-export-binding-node-local-name n))
@@ -3714,10 +3684,13 @@ Returns 0 if NODE is nil or its identifier field is
nil."
(js2-current-token-beg)))
(value
(js2-current-token-string))
(num-value
(js2-token-number
-
(js2-current-token))))))
+
(js2-current-token)))
+ (num-base
(js2-token-number-base
+
(js2-current-token))))))
"AST node for a number literal."
value ; the original string, e.g. "6.02e23"
- num-value) ; the parsed number value
+ num-value ; the parsed number value
+ num-base) ; the number's base
(put 'cl-struct-js2-number-node 'js2-visitor 'js2-visit-none)
(put 'cl-struct-js2-number-node 'js2-printer 'js2-print-number-node)
@@ -3914,16 +3887,18 @@ optional `js2-expr-node'"
len left
right op-pos)))
"AST node for an object literal prop:value entry.
-The `left' field is the property: a name node, string node or number node.
-The `right' field is a `js2-node' representing the initializer value.
-If the property is abbreviated, the node's `SHORTHAND' property is non-nil
-and both fields have the same value.")
+The `left' field is the property: a name node, string node,
+number node or expression node. The `right' field is a
+`js2-node' representing the initializer value. If the property
+is abbreviated, the node's `SHORTHAND' property is non-nil and
+both fields have the same value.")
(put 'cl-struct-js2-object-prop-node 'js2-visitor 'js2-visit-infix-node)
(put 'cl-struct-js2-object-prop-node 'js2-printer 'js2-print-object-prop-node)
(defun js2-print-object-prop-node (n i)
(let* ((left (js2-object-prop-node-left n))
+ (right (js2-object-prop-node-right n))
(computed (not (or (js2-string-node-p left)
(js2-number-node-p left)
(js2-name-node-p left)))))
@@ -3936,7 +3911,7 @@ and both fields have the same value.")
(if (not (js2-node-get-prop n 'SHORTHAND))
(progn
(insert ": ")
- (js2-print-ast (js2-object-prop-node-right n) 0)))))
+ (js2-print-ast right 0)))))
(cl-defstruct (js2-getter-setter-node
(:include js2-infix-node)
@@ -3953,13 +3928,23 @@ property `GETTER_SETTER' set to js2-GET, js2-SET, or
js2-FUNCTION. ")
(put 'cl-struct-js2-getter-setter-node 'js2-printer 'js2-print-getter-setter)
(defun js2-print-getter-setter (n i)
- (let ((pad (js2-make-pad i))
- (left (js2-getter-setter-node-left n))
- (right (js2-getter-setter-node-right n)))
+ (let* ((pad (js2-make-pad i))
+ (left (js2-getter-setter-node-left n))
+ (right (js2-getter-setter-node-right n))
+ (computed (not (or (js2-string-node-p left)
+ (js2-number-node-p left)
+ (js2-name-node-p left)))))
(insert pad)
(if (/= (js2-node-type n) js2-FUNCTION)
(insert (if (= (js2-node-type n) js2-GET) "get " "set ")))
+ (when (and (js2-function-node-p right)
+ (eq 'STAR (js2-function-node-generator-type right)))
+ (insert "*"))
+ (when computed
+ (insert "["))
(js2-print-ast left 0)
+ (when computed
+ (insert "]"))
(js2-print-ast right 0)))
(cl-defstruct (js2-prop-get-node
@@ -5360,7 +5345,7 @@ Returns logical OR of END_* flags."
(let* ((rv js2-END_DROPS_OFF)
(kids (js2-block-node-kids node))
(n (car kids)))
- ;; Check each statment. If the statement can continue onto the next
+ ;; Check each statement. If the statement can continue onto the next
;; one (i.e. END_DROPS_OFF is set), then check the next statement.
(while (and n (js2-flag-set-p rv js2-END_DROPS_OFF))
(js2-clear-flag rv js2-END_DROPS_OFF)
@@ -5684,7 +5669,7 @@ into temp buffers."
let
new null
return
- static super switch
+ super switch
this throw true try typeof
var void
while with
@@ -5705,7 +5690,7 @@ into temp buffers."
js2-LET
js2-NEW js2-NULL
js2-RETURN
- js2-STATIC js2-SUPER js2-SWITCH
+ js2-SUPER js2-SWITCH
js2-THIS js2-THROW js2-TRUE js2-TRY js2-TYPEOF
js2-VAR
js2-WHILE js2-WITH
@@ -5730,7 +5715,7 @@ The values are default faces to use for highlighting the
keywords.")
;; FIXME: Support strict mode-only future reserved words, after we know
;; which parts scopes are in strict mode, and which are not.
-(defconst js2-reserved-words '(class enum export extends import super)
+(defconst js2-reserved-words '(class enum export extends import static super)
"Future reserved keywords in ECMAScript 5.1.")
(defconst js2-keyword-names
@@ -5870,7 +5855,7 @@ its relevant fields and puts it into `js2-ti-tokens'."
(let (identifier-start
is-unicode-escape-start c
contains-escape escape-val str result base
- quote-char look-for-slash continue tt
+ look-for-slash continue tt
(token (js2-new-token 0)))
(setq
tt
@@ -6050,8 +6035,8 @@ its relevant fields and puts it into `js2-ti-tokens'."
while (js2-digit-p c))))
(js2-unget-char)
(let ((str (js2-set-string-from-buffer token)))
- (setf (js2-token-number token)
- (js2-string-to-number str base)))
+ (setf (js2-token-number token) (js2-string-to-number str base)
+ (js2-token-number-base token) base))
(throw 'return js2-NUMBER))
;; is it a string?
(when (or (memq c '(?\" ?\'))
@@ -6158,8 +6143,11 @@ its relevant fields and puts it into `js2-ti-tokens'."
(setf (js2-token-beg token) (- js2-ts-cursor 2))
(js2-skip-line)
(setf (js2-token-comment-type token) 'line)
- ;; include newline so highlighting goes to end of
window
- (cl-incf (js2-token-end token))
+ ;; include newline so highlighting goes to end of
+ ;; window, if there actually is a newline; if we
+ ;; hit eof, then implicitly there isn't
+ (unless js2-ts-hit-eof
+ (cl-incf (js2-token-end token)))
(throw 'return js2-COMMENT))
;; is it a /* comment?
(when (js2-match-char ?*)
@@ -6623,6 +6611,7 @@ its relevant fields and puts it into `js2-ti-tokens'."
(remove-text-properties beg end '(font-lock-face nil
help-echo nil
point-entered nil
+ cursor-sensor-functions nil
c-in-sws nil)))
(defconst js2-ecma-global-props
@@ -6773,7 +6762,7 @@ Shown at or above `js2-highlight-level' 3.")
(defun js2-parse-highlight-member-expr-node (node)
"Perform syntax highlighting of EcmaScript built-in properties.
-The variable `js2-highlight-level' governs this highighting."
+The variable `js2-highlight-level' governs this highlighting."
(let (face target prop name pos end parent call-p callee)
(cond
;; case 1: simple name, e.g. foo
@@ -6832,11 +6821,11 @@ of a simple name. Called before EXPR has a parent
node."
(defconst js2-jsdoc-param-tag-regexp
(concat "^\\s-*\\*+\\s-*\\(@"
- "\\(?:param\\|argument\\)"
+ "\\(?:param\\|arg\\(?:ument\\)?\\|prop\\(?:erty\\)?\\)"
"\\)"
"\\s-*\\({[^}]+}\\)?" ; optional type
"\\s-*\\[?\\([[:alnum:]_$\.]+\\)?\\]?" ; name
- "\\>")
+ "\\_>")
"Matches jsdoc tags with optional type and optional param name.")
(defconst js2-jsdoc-typed-tag-regexp
@@ -6874,7 +6863,6 @@ of a simple name. Called before EXPR has a parent node."
"memberOf"
"name"
"namespace"
- "property"
"since"
"suppress"
"this"
@@ -7034,10 +7022,163 @@ it is considered declared."
(unless (or (member name js2-global-externs)
(member name js2-default-externs)
(member name js2-additional-externs)
- (js2-get-defining-scope scope name))
+ (js2-get-defining-scope scope name pos))
(js2-report-warning "msg.undeclared.variable" name pos (- end pos)
- 'js2-external-variable))))
- (setq js2-recorded-identifiers nil)))
+ 'js2-external-variable))))))
+
+(defun js2--add-or-update-symbol (symbol inition used vars)
+ "Add or update SYMBOL entry in VARS, an hash table.
+SYMBOL is a js2-name-node, INITION either nil, t, or ?P,
+respectively meaning that SYMBOL is a mere declaration, an
+assignment or a function parameter; when USED is t, the symbol
+node is assumed to be an usage and thus added to the list stored
+in the cdr of the entry.
+"
+ (let* ((nm (js2-name-node-name symbol))
+ (es (js2-node-get-enclosing-scope symbol))
+ (ds (js2-get-defining-scope es nm)))
+ (when (and ds (not (equal nm "arguments")))
+ (let* ((sym (js2-scope-get-symbol ds nm))
+ (var (gethash sym vars))
+ (err-var-p (js2-catch-node-p ds)))
+ (unless inition
+ (setq inition err-var-p))
+ (if var
+ (progn
+ (when (and inition (not (equal (car var) ?P)))
+ (setcar var inition))
+ (when used
+ (push symbol (cdr var))))
+ ;; do not consider the declaration of catch parameter as an usage
+ (when (and err-var-p used)
+ (setq used nil))
+ (puthash sym (cons inition (if used (list symbol))) vars))))))
+
+(defun js2--classify-variables ()
+ "Collect and classify variables declared or used within js2-mode-ast.
+Traverse the whole ast tree returning a summary of the variables
+usage as an hash-table, keyed by their corresponding symbol table
+entry.
+Each variable is described by a tuple where the car is a flag
+indicating whether the variable has been initialized and the cdr
+is a possibly empty list of name nodes where it is used. External
+symbols, i.e. those not present in the whole scopes hierarchy,
+are ignored."
+ (let ((vars (make-hash-table :test #'eq :size 100)))
+ (js2-visit-ast
+ js2-mode-ast
+ (lambda (node end-p)
+ (when (null end-p)
+ (cond
+ ((js2-var-init-node-p node)
+ ;; take note about possibly initialized declarations
+ (let ((target (js2-var-init-node-target node))
+ (initializer (js2-var-init-node-initializer node)))
+ (when target
+ (let* ((parent (js2-node-parent node))
+ (grandparent (if parent (js2-node-parent parent)))
+ (inited (not (null initializer))))
+ (unless inited
+ (setq inited
+ (and grandparent
+ (js2-for-in-node-p grandparent)
+ (memq target
+ (mapcar #'js2-var-init-node-target
+ (js2-var-decl-node-kids
+ (js2-for-in-node-iterator
grandparent)))))))
+ (js2--add-or-update-symbol target inited nil vars)))))
+
+ ((js2-assign-node-p node)
+ ;; take note about assignments
+ (let ((left (js2-assign-node-left node)))
+ (when (js2-name-node-p left)
+ (js2--add-or-update-symbol left t nil vars))))
+
+ ((js2-prop-get-node-p node)
+ ;; handle x.y.z nodes, considering only x
+ (let ((left (js2-prop-get-node-left node)))
+ (when (js2-name-node-p left)
+ (js2--add-or-update-symbol left nil t vars))))
+
+ ((js2-name-node-p node)
+ ;; take note about used variables
+ (let ((parent (js2-node-parent node)))
+ (when parent
+ (unless (or (and (js2-var-init-node-p parent) ; handled above
+ (eq node (js2-var-init-node-target parent)))
+ (and (js2-assign-node-p parent)
+ (eq node (js2-assign-node-left parent)))
+ (js2-prop-get-node-p parent))
+ (let ((used t) inited)
+ (cond
+ ((and (js2-function-node-p parent)
+ (js2-wrapper-function-p parent))
+ (setq inited (if (memq node (js2-function-node-params
parent)) ?P t)))
+
+ ((js2-for-in-node-p parent)
+ (if (eq node (js2-for-in-node-iterator parent))
+ (setq inited t used nil)))
+
+ ((js2-function-node-p parent)
+ (setq inited (if (memq node (js2-function-node-params
parent)) ?P t)
+ used nil)))
+
+ (unless used
+ (let ((grandparent (js2-node-parent parent)))
+ (when grandparent
+ (setq used (js2-return-node-p grandparent)))))
+
+ (js2--add-or-update-symbol node inited used vars))))))))
+ t))
+ vars))
+
+(defun js2--get-name-node (node)
+ (cond
+ ((js2-name-node-p node) node)
+ ((js2-function-node-p node)
+ (js2-function-node-name node))
+ ((js2-class-node-p node)
+ (js2-class-node-name node))
+ ((js2-comp-loop-node-p node)
+ (js2-comp-loop-node-iterator node))
+ (t node)))
+
+(defun js2--highlight-unused-variable (symbol info)
+ (let ((name (js2-symbol-name symbol))
+ (inited (car info))
+ (refs (cdr info))
+ pos len)
+ (unless (and inited refs)
+ (if refs
+ (dolist (ref refs)
+ (setq pos (js2-node-abs-pos ref))
+ (setq len (js2-name-node-len ref))
+ (js2-report-warning "msg.uninitialized.variable" name pos len
+ 'js2-warning))
+ (when (or js2-warn-about-unused-function-arguments
+ (not (eq inited ?P)))
+ (let* ((symn (js2-symbol-ast-node symbol))
+ (namen (js2--get-name-node symn)))
+ (unless (js2-node-top-level-decl-p namen)
+ (setq pos (js2-node-abs-pos namen))
+ (setq len (js2-name-node-len namen))
+ (js2-report-warning "msg.unused.variable" name pos len
+ 'js2-warning))))))))
+
+(defun js2-highlight-unused-variables ()
+ "Highlight unused variables."
+ (let ((vars (js2--classify-variables)))
+ (maphash #'js2--highlight-unused-variable vars)))
+
+;;;###autoload
+(define-minor-mode js2-highlight-unused-variables-mode
+ "Toggle highlight of unused variables."
+ :lighter ""
+ (if js2-highlight-unused-variables-mode
+ (add-hook 'js2-post-parse-callbacks
+ #'js2-highlight-unused-variables nil t)
+ (remove-hook 'js2-post-parse-callbacks
+ #'js2-highlight-unused-variables t)))
(defun js2-set-default-externs ()
"Set the value of `js2-default-externs' based on the various
@@ -7654,6 +7795,15 @@ Returns t on match, nil if no match."
(defsubst js2-exit-switch ()
(pop js2-loop-and-switch-set))
+(defsubst js2-get-directive (node)
+ "Return NODE's value if it is a directive, nil otherwise.
+
+A directive is an otherwise-meaningless expression statement
+consisting of a string literal, such as \"use strict\"."
+ (and (js2-expr-stmt-node-p node)
+ (js2-string-node-p (setq node (js2-expr-stmt-node-expr node)))
+ (js2-string-node-value node)))
+
(defun js2-parse (&optional buf cb)
"Tell the js2 parser to parse a region of JavaScript.
@@ -7715,14 +7865,18 @@ leaving a statement, an expression, or a function
definition."
Scanner should be initialized."
(let ((pos js2-ts-cursor)
(end js2-ts-cursor) ; in case file is empty
- root n tt)
+ root n tt
+ (in-directive-prologue t)
+ (js2-in-use-strict-directive js2-in-use-strict-directive)
+ directive)
;; initialize buffer-local parsing vars
(setf root (make-js2-ast-root :buffer (buffer-name) :pos pos)
js2-current-script-or-fn root
js2-current-scope root
js2-nesting-of-function 0
js2-labeled-stmt nil
- js2-recorded-identifiers nil) ; for js2-highlight
+ js2-recorded-identifiers nil ; for js2-highlight
+ js2-in-use-strict-directive nil)
(while (/= (setq tt (js2-get-token)) js2-EOF)
(if (= tt js2-FUNCTION)
(progn
@@ -7731,7 +7885,14 @@ Scanner should be initialized."
(js2-parse-function-stmt))))
;; not a function - parse a statement
(js2-unget-token)
- (setq n (js2-parse-statement)))
+ (setq n (js2-parse-statement))
+ (when in-directive-prologue
+ (setq directive (js2-get-directive n))
+ (cond
+ ((null directive)
+ (setq in-directive-prologue nil))
+ ((string= directive "use strict")
+ (setq js2-in-use-strict-directive t)))))
;; add function or statement to script
(setq end (js2-node-end n))
(js2-block-node-push root n))
@@ -7769,16 +7930,34 @@ Scanner should be initialized."
(let ((pos (js2-current-token-beg)) ; LC position
(pn (make-js2-block-node)) ; starts at LC position
tt
- end)
+ end
+ not-in-directive-prologue
+ node
+ directive)
(cl-incf js2-nesting-of-function)
(unwind-protect
(while (not (or (= (setq tt (js2-peek-token)) js2-ERROR)
(= tt js2-EOF)
(= tt js2-RC)))
- (js2-block-node-push pn (if (/= tt js2-FUNCTION)
- (js2-parse-statement)
- (js2-get-token)
- (js2-parse-function-stmt))))
+ (js2-block-node-push
+ pn
+ (if (/= tt js2-FUNCTION)
+ (if not-in-directive-prologue
+ (js2-parse-statement)
+ (setq node (js2-parse-statement)
+ directive (js2-get-directive node))
+ (cond
+ ((null directive)
+ (setq not-in-directive-prologue t))
+ ((string= directive "use strict")
+ ;; Back up and reparse the function, because new rules apply
+ ;; to the function name and parameters.
+ (when (not js2-in-use-strict-directive)
+ (setq js2-in-use-strict-directive t)
+ (throw 'reparse t))))
+ node)
+ (js2-get-token)
+ (js2-parse-function-stmt))))
(cl-decf js2-nesting-of-function))
(setq end (js2-current-token-end)) ; assume no curly and leave at current
token
(if (js2-must-match js2-RC "msg.no.brace.after.body" pos)
@@ -7791,35 +7970,76 @@ Scanner should be initialized."
(defun js2-define-destruct-symbols (node decl-type face &optional
ignore-not-in-block)
"Declare and fontify destructuring parameters inside NODE.
-NODE is either `js2-array-node', `js2-object-node', or `js2-name-node'."
- (cond
- ((js2-name-node-p node)
- (let (leftpos)
- (js2-define-symbol decl-type (js2-name-node-name node)
- node ignore-not-in-block)
- (when face
- (js2-set-face (setq leftpos (js2-node-abs-pos node))
- (+ leftpos (js2-node-len node))
- face 'record))))
- ((js2-object-node-p node)
- (dolist (elem (js2-object-node-elems node))
- (js2-define-destruct-symbols
- ;; In abbreviated destructuring {a, b}, right == left.
- (js2-object-prop-node-right elem)
- decl-type face ignore-not-in-block)))
- ((js2-array-node-p node)
- (dolist (elem (js2-array-node-elems node))
- (when elem
- (js2-define-destruct-symbols elem decl-type face
ignore-not-in-block))))
- (t (js2-report-error "msg.no.parm" nil (js2-node-abs-pos node)
- (js2-node-len node)))))
+NODE is either `js2-array-node', `js2-object-node', or `js2-name-node'.
+
+Return a list of `js2-name-node' nodes representing the symbols
+declared; probably to check them for errors."
+ (let (name-nodes)
+ (cond
+ ((js2-name-node-p node)
+ (let (leftpos)
+ (js2-define-symbol decl-type (js2-name-node-name node)
+ node ignore-not-in-block)
+ (when face
+ (js2-set-face (setq leftpos (js2-node-abs-pos node))
+ (+ leftpos (js2-node-len node))
+ face 'record))
+ (list node)))
+ ((js2-object-node-p node)
+ (dolist (elem (js2-object-node-elems node))
+ (when (js2-object-prop-node-p elem)
+ (push (js2-define-destruct-symbols
+ ;; In abbreviated destructuring {a, b}, right == left.
+ (js2-object-prop-node-right elem)
+ decl-type face ignore-not-in-block)
+ name-nodes)))
+ (apply #'append (nreverse name-nodes)))
+ ((js2-array-node-p node)
+ (dolist (elem (js2-array-node-elems node))
+ (when elem
+ (push (js2-define-destruct-symbols
+ elem decl-type face ignore-not-in-block)
+ name-nodes)))
+ (apply #'append (nreverse name-nodes)))
+ (t (js2-report-error "msg.no.parm" nil (js2-node-abs-pos node)
+ (js2-node-len node))
+ nil))))
+
+(defvar js2-illegal-strict-identifiers
+ '("eval" "arguments")
+ "Identifiers not allowed as variables in strict mode.")
+
+(defun js2-check-strict-identifier (name-node)
+ "Check that NAME-NODE makes a legal strict mode identifier."
+ (when js2-in-use-strict-directive
+ (let ((param-name (js2-name-node-name name-node)))
+ (when (member param-name js2-illegal-strict-identifiers)
+ (js2-report-error "msg.bad.id.strict" param-name
+ (js2-node-abs-pos name-node) (js2-node-len
name-node))))))
+
+(defun js2-check-strict-function-params (preceding-params params)
+ "Given PRECEDING-PARAMS in a function's parameter list, check
+for strict mode errors caused by PARAMS."
+ (when js2-in-use-strict-directive
+ (dolist (param params)
+ (let ((param-name (js2-name-node-name param)))
+ (js2-check-strict-identifier param)
+ (when (cl-some (lambda (param)
+ (string= (js2-name-node-name param) param-name))
+ preceding-params)
+ (js2-report-error "msg.dup.param.strict" param-name
+ (js2-node-abs-pos param) (js2-node-len param)))))))
(defun js2-parse-function-params (function-type fn-node pos)
+ "Parse the parameters of a function of FUNCTION-TYPE
+represented by FN-NODE at POS."
(if (js2-match-token js2-RP)
(setf (js2-function-node-rp fn-node) (- (js2-current-token-beg) pos))
(let ((paren-free-arrow (and (eq function-type 'FUNCTION_ARROW)
(eq (js2-current-token-type) js2-NAME)))
- params param default-found rest-param-at)
+ params param
+ param-name-nodes new-param-name-nodes
+ rest-param-at)
(when paren-free-arrow
(js2-unget-token))
(cl-loop for tt = (js2-peek-token)
@@ -7829,12 +8049,11 @@ NODE is either `js2-array-node', `js2-object-node', or
`js2-name-node'."
((and (not paren-free-arrow)
(or (= tt js2-LB) (= tt js2-LC)))
(js2-get-token)
- (when default-found
- (js2-report-error "msg.no.default.after.default.param"))
- (setq param (js2-parse-destruct-primary-expr))
- (js2-define-destruct-symbols param
- js2-LP
- 'js2-function-param)
+ (setq param (js2-parse-destruct-primary-expr)
+ new-param-name-nodes (js2-define-destruct-symbols
+ param js2-LP 'js2-function-param))
+ (js2-check-strict-function-params param-name-nodes
new-param-name-nodes)
+ (setq param-name-nodes (append param-name-nodes
new-param-name-nodes))
(push param params))
;; variable name
(t
@@ -7848,15 +8067,11 @@ NODE is either `js2-array-node', `js2-object-node', or
`js2-name-node'."
(js2-record-face 'js2-function-param)
(setq param (js2-create-name-node))
(js2-define-symbol js2-LP (js2-current-token-string) param)
+ (js2-check-strict-function-params param-name-nodes (list
param))
+ (setq param-name-nodes (append param-name-nodes (list param)))
;; default parameter value
- (when (or (and default-found
- (not rest-param-at)
- (js2-must-match js2-ASSIGN
-
"msg.no.default.after.default.param"
- (js2-node-pos param)
- (js2-node-len param)))
- (and (>= js2-language-version 200)
- (js2-match-token js2-ASSIGN)))
+ (when (and (>= js2-language-version 200)
+ (js2-match-token js2-ASSIGN))
(cl-assert (not paren-free-arrow))
(let* ((pos (js2-node-pos param))
(tt (js2-current-token-type))
@@ -7866,8 +8081,7 @@ NODE is either `js2-array-node', `js2-object-node', or
`js2-name-node'."
(len (- (js2-node-end right) pos)))
(setq param (make-js2-assign-node
:type tt :pos pos :len len :op-pos op-pos
- :left left :right right)
- default-found t)
+ :left left :right right))
(js2-node-add-children param left right)))
(push param params)))
(when (and rest-param-at (> (length params) (1+ rest-param-at)))
@@ -7931,10 +8145,7 @@ Last token scanned is the close-curly for the function
body."
(js2-must-match js2-LP "msg.no.paren.parms")
(js2-parse-function 'FUNCTION_EXPRESSION pos star-p name)))
-(defun js2-parse-function (function-type pos star-p &optional name)
- "Function parser. FUNCTION-TYPE is a symbol, POS is the
-beginning of the first token (function keyword, unless it's an
-arrow function), NAME is js2-name-node."
+(defun js2-parse-function-internal (function-type pos star-p &optional name)
(let (fn-node lp)
(if (= (js2-current-token-type) js2-LP) ; eventually matched LP?
(setq lp (js2-current-token-beg)))
@@ -7949,7 +8160,9 @@ arrow function), NAME is js2-name-node."
(when (and (eq function-type 'FUNCTION_STATEMENT)
(cl-plusp (js2-name-node-length name)))
;; Function statements define a symbol in the enclosing scope
- (js2-define-symbol js2-FUNCTION (js2-name-node-name name) fn-node)))
+ (js2-define-symbol js2-FUNCTION (js2-name-node-name name) fn-node))
+ (when js2-in-use-strict-directive
+ (js2-check-strict-identifier name)))
(if (or (js2-inside-function) (cl-plusp js2-nesting-of-with))
;; 1. Nested functions are not affected by the dynamic scope flag
;; as dynamic scope is already a parent of their scope.
@@ -7995,6 +8208,29 @@ arrow function), NAME is js2-name-node."
(setf (js2-scope-parent-scope fn-node) js2-current-scope)
fn-node))
+(defun js2-parse-function (function-type pos star-p &optional name)
+ "Function parser. FUNCTION-TYPE is a symbol, POS is the
+beginning of the first token (function keyword, unless it's an
+arrow function), NAME is js2-name-node."
+ (let ((continue t)
+ ts-state
+ fn-node
+ ;; Preserve strict state outside this function.
+ (js2-in-use-strict-directive js2-in-use-strict-directive))
+ ;; Parse multiple times if a new strict mode directive is discovered in the
+ ;; function body, as new rules will be retroactively applied to the
legality
+ ;; of function names and parameters.
+ (while continue
+ (setq ts-state (make-js2-ts-state))
+ (setq continue (catch 'reparse
+ (setq fn-node (js2-parse-function-internal
+ function-type pos star-p name))
+ ;; Don't continue.
+ nil))
+ (when continue
+ (js2-ts-seek ts-state)))
+ fn-node))
+
(defun js2-parse-statements (&optional parent)
"Parse a statement list. Last token consumed must be js2-LC.
@@ -8088,7 +8324,8 @@ node are given relative start positions and correct
lengths."
js2-ERROR
js2-SEMI
js2-CLASS
- js2-FUNCTION)
+ js2-FUNCTION
+ js2-EXPORT)
"List of tokens that don't do automatic semicolon insertion.")
(defconst js2-autoinsert-semi-and-warn
@@ -8523,9 +8760,13 @@ invalid export statements."
(when from-clause
(push from-clause children))
(when declaration
- (push declaration children))
+ (push declaration children)
+ (when (not (js2-function-node-p declaration))
+ (js2-auto-insert-semicolon declaration)))
(when default
- (push default children))
+ (push default children)
+ (when (not (js2-function-node-p default))
+ (js2-auto-insert-semicolon default)))
(let ((node (make-js2-export-node
:pos beg
:len (- (js2-current-token-end) beg)
@@ -8540,6 +8781,7 @@ invalid export statements."
"Parse a for, for-in or for each-in statement.
Last matched token must be js2-FOR."
(let ((for-pos (js2-current-token-beg))
+ (tmp-scope (make-js2-scope))
pn is-for-each is-for-in-or-of is-for-of
in-pos each-pos tmp-pos
init ; Node init is also foo in 'foo in object'.
@@ -8557,78 +8799,83 @@ Last matched token must be js2-FOR."
(if (js2-must-match js2-LP "msg.no.paren.for")
(setq lp (- (js2-current-token-beg) for-pos)))
(setq tt (js2-get-token))
- ;; 'for' makes local scope
- (js2-push-scope (make-js2-scope))
+ ;; Capture identifiers inside parens. We can't create the node
+ ;; (and use it as the current scope) until we know its type.
+ (js2-push-scope tmp-scope)
(unwind-protect
- ;; parse init clause
- (let ((js2-in-for-init t)) ; set as dynamic variable
- (cond
- ((= tt js2-SEMI)
- (js2-unget-token)
- (setq init (make-js2-empty-expr-node)))
- ((or (= tt js2-VAR) (= tt js2-LET))
- (setq init (js2-parse-variables tt (js2-current-token-beg))))
- (t
- (js2-unget-token)
- (setq init (js2-parse-expr)))))
- (if (or (js2-match-token js2-IN)
- (and (>= js2-language-version 200)
- (js2-match-contextual-kwd "of")
- (setq is-for-of t)))
- (setq is-for-in-or-of t
- in-pos (- (js2-current-token-beg) for-pos)
- ;; scope of iteration target object is not the scope we've
created above.
- ;; stash current scope temporary.
- cond (let ((js2-current-scope (js2-scope-parent-scope
js2-current-scope)))
- (js2-parse-expr))) ; object over which we're iterating
- ;; else ordinary for loop - parse cond and incr
- (js2-must-match js2-SEMI "msg.no.semi.for")
- (setq cond (if (= (js2-peek-token) js2-SEMI)
- (make-js2-empty-expr-node) ; no loop condition
- (js2-parse-expr)))
- (js2-must-match js2-SEMI "msg.no.semi.for.cond")
- (setq tmp-pos (js2-current-token-end)
- incr (if (= (js2-peek-token) js2-RP)
- (make-js2-empty-expr-node :pos tmp-pos)
- (js2-parse-expr))))
- (if (js2-must-match js2-RP "msg.no.paren.for.ctrl")
- (setq rp (- (js2-current-token-beg) for-pos)))
- (if (not is-for-in-or-of)
- (setq pn (make-js2-for-node :init init
- :condition cond
- :update incr
- :lp lp
- :rp rp))
- ;; cond could be null if 'in obj' got eaten by the init node.
- (if (js2-infix-node-p init)
- ;; it was (foo in bar) instead of (var foo in bar)
- (setq cond (js2-infix-node-right init)
- init (js2-infix-node-left init))
- (if (and (js2-var-decl-node-p init)
- (> (length (js2-var-decl-node-kids init)) 1))
- (js2-report-error "msg.mult.index")))
- (setq pn (make-js2-for-in-node :iterator init
- :object cond
- :in-pos in-pos
- :foreach-p is-for-each
- :each-pos each-pos
- :forof-p is-for-of
- :lp lp
- :rp rp)))
- (unwind-protect
- (progn
- (js2-enter-loop pn)
- ;; We have to parse the body -after- creating the loop node,
- ;; so that the loop node appears in the js2-loop-set, allowing
- ;; break/continue statements to find the enclosing loop.
- (setf body (js2-parse-statement)
- (js2-loop-node-body pn) body
- (js2-node-pos pn) for-pos
- (js2-node-len pn) (- (js2-node-end body) for-pos))
- (js2-node-add-children pn init cond incr body))
- ;; finally
- (js2-exit-loop))
+ (progn
+ ;; parse init clause
+ (let ((js2-in-for-init t)) ; set as dynamic variable
+ (cond
+ ((= tt js2-SEMI)
+ (js2-unget-token)
+ (setq init (make-js2-empty-expr-node)))
+ ((or (= tt js2-VAR) (= tt js2-LET))
+ (setq init (js2-parse-variables tt (js2-current-token-beg))))
+ (t
+ (js2-unget-token)
+ (setq init (js2-parse-expr)))))
+ (if (or (js2-match-token js2-IN)
+ (and (>= js2-language-version 200)
+ (js2-match-contextual-kwd "of")
+ (setq is-for-of t)))
+ (setq is-for-in-or-of t
+ in-pos (- (js2-current-token-beg) for-pos)
+ ;; scope of iteration target object is not the scope we've
created above.
+ ;; stash current scope temporary.
+ cond (let ((js2-current-scope (js2-scope-parent-scope
js2-current-scope)))
+ (js2-parse-expr))) ; object over which we're
iterating
+ ;; else ordinary for loop - parse cond and incr
+ (js2-must-match js2-SEMI "msg.no.semi.for")
+ (setq cond (if (= (js2-peek-token) js2-SEMI)
+ (make-js2-empty-expr-node) ; no loop condition
+ (js2-parse-expr)))
+ (js2-must-match js2-SEMI "msg.no.semi.for.cond")
+ (setq tmp-pos (js2-current-token-end)
+ incr (if (= (js2-peek-token) js2-RP)
+ (make-js2-empty-expr-node :pos tmp-pos)
+ (js2-parse-expr)))))
(js2-pop-scope))
+ (if (js2-must-match js2-RP "msg.no.paren.for.ctrl")
+ (setq rp (- (js2-current-token-beg) for-pos)))
+ (if (not is-for-in-or-of)
+ (setq pn (make-js2-for-node :init init
+ :condition cond
+ :update incr
+ :lp lp
+ :rp rp))
+ ;; cond could be null if 'in obj' got eaten by the init node.
+ (if (js2-infix-node-p init)
+ ;; it was (foo in bar) instead of (var foo in bar)
+ (setq cond (js2-infix-node-right init)
+ init (js2-infix-node-left init))
+ (if (and (js2-var-decl-node-p init)
+ (> (length (js2-var-decl-node-kids init)) 1))
+ (js2-report-error "msg.mult.index")))
+ (setq pn (make-js2-for-in-node :iterator init
+ :object cond
+ :in-pos in-pos
+ :foreach-p is-for-each
+ :each-pos each-pos
+ :forof-p is-for-of
+ :lp lp
+ :rp rp)))
+ ;; Transplant the declarations.
+ (setf (js2-scope-symbol-table pn)
+ (js2-scope-symbol-table tmp-scope))
+ (unwind-protect
+ (progn
+ (js2-enter-loop pn)
+ ;; We have to parse the body -after- creating the loop node,
+ ;; so that the loop node appears in the js2-loop-set, allowing
+ ;; break/continue statements to find the enclosing loop.
+ (setf body (js2-parse-statement)
+ (js2-loop-node-body pn) body
+ (js2-node-pos pn) for-pos
+ (js2-node-len pn) (- (js2-node-end body) for-pos))
+ (js2-node-add-children pn init cond incr body))
+ ;; finally
+ (js2-exit-loop))
pn))
(defun js2-parse-try ()
@@ -8671,7 +8918,8 @@ Last matched token must be js2-FOR."
(t
(js2-must-match-name "msg.bad.catchcond")
(setq param (js2-create-name-node))
- (js2-define-symbol js2-LET (js2-current-token-string) param))))
+ (js2-define-symbol js2-LET (js2-current-token-string) param)
+ (js2-check-strict-identifier param))))
;; Catch condition.
(if (js2-match-token js2-IF)
(setq guard-kwd (- (js2-current-token-beg) catch-pos)
@@ -8801,6 +9049,8 @@ does not match an existing label, reports an error and
returns nil."
(defun js2-parse-with ()
"Parser for with-statement. Last matched token must be js2-WITH."
+ (when js2-in-use-strict-directive
+ (js2-report-error "msg.no.with.strict"))
(let ((pos (js2-current-token-beg))
obj body pn lp rp)
(if (js2-must-match js2-LP "msg.no.paren.with")
@@ -9117,7 +9367,8 @@ Returns the parsed `js2-var-decl-node' expression node."
nbeg (js2-current-token-beg)
nend (js2-current-token-end)
end nend)
- (js2-define-symbol decl-type (js2-current-token-string) name
js2-in-for-init)))
+ (js2-define-symbol decl-type (js2-current-token-string) name
js2-in-for-init)
+ (js2-check-strict-identifier name)))
(when (js2-match-token js2-ASSIGN)
(setq init (js2-parse-assign-expr)
end (js2-node-end init))
@@ -9150,7 +9401,7 @@ Returns the parsed `js2-var-decl-node' expression node."
(defun js2-parse-let (pos &optional stmt-p)
"Parse a let expression or statement.
A let-expression is of the form `let (vars) expr'.
-A let-statment is of the form `let (vars) {statements}'.
+A let-statement is of the form `let (vars) {statements}'.
The third form of let is a variable declaration list, handled
by `js2-parse-variables'."
(let ((pn (make-js2-let-node :pos pos))
@@ -9198,8 +9449,12 @@ If NODE is non-nil, it is the AST node associated with
the symbol."
(len (if node (js2-node-len node))))
(cond
((and symbol ; already defined
- (or (= sdt js2-CONST) ; old version is const
- (= decl-type js2-CONST) ; new version is const
+ (or (if js2-in-use-strict-directive
+ ;; two const-bound vars in this block have same name
+ (and (= sdt js2-CONST)
+ (eq defining-scope js2-current-scope))
+ (or (= sdt js2-CONST) ; old version is const
+ (= decl-type js2-CONST))) ; new version is const
;; two let-bound vars in this block have same name
(and (= sdt js2-LET)
(eq defining-scope js2-current-scope))))
@@ -9211,15 +9466,21 @@ If NODE is non-nil, it is the AST node associated with
the symbol."
((= sdt js2-FUNCTION) "msg.function.redecl")
(t "msg.parm.redecl"))
name pos len))
- ((= decl-type js2-LET)
- (if (and (not ignore-not-in-block)
+ ((or (= decl-type js2-LET)
+ ;; strict mode const is scoped to the current LexicalEnvironment
+ (and js2-in-use-strict-directive
+ (= decl-type js2-CONST)))
+ (if (and (= decl-type js2-LET)
+ (not ignore-not-in-block)
(or (= (js2-node-type js2-current-scope) js2-IF)
(js2-loop-node-p js2-current-scope)))
(js2-report-error "msg.let.decl.not.in.block")
(js2-define-new-symbol decl-type name node)))
((or (= decl-type js2-VAR)
- (= decl-type js2-CONST)
- (= decl-type js2-FUNCTION))
+ (= decl-type js2-FUNCTION)
+ ;; sloppy mode const is scoped to the current VariableEnvironment
+ (and (not js2-in-use-strict-directive)
+ (= decl-type js2-CONST)))
(if symbol
(if (and js2-strict-var-redeclaration-warning (= sdt js2-VAR))
(js2-add-strict-warning "msg.var.redecl" name)
@@ -9255,11 +9516,10 @@ If NODE is non-nil, it is the AST node associated with
the symbol."
(let* ((js2-in-for-init nil)
(expr (js2-parse-expr))
(pn (make-js2-paren-node :pos px-pos
- :expr expr
- :len (- (js2-current-token-end)
- px-pos))))
+ :expr expr)))
(js2-node-add-children pn (js2-paren-node-expr pn))
(js2-must-match js2-RP "msg.no.paren")
+ (setf (js2-node-len pn) (- (js2-current-token-end) px-pos))
pn)))))
(defun js2-parse-expr (&optional oneshot)
@@ -9305,6 +9565,10 @@ If NODE is non-nil, it is the AST node associated with
the symbol."
;; tt express assignment (=, |=, ^=, ..., %=)
(setq op-pos (- (js2-current-token-beg) pos) ; relative
left pn)
+ ;; The assigned node could be a js2-prop-get-node (foo.bar = 0), we
only
+ ;; care about assignment to strict variable names.
+ (when (js2-name-node-p left)
+ (js2-check-strict-identifier left))
(setq right (js2-parse-assign-expr)
pn (make-js2-assign-node :type tt
:pos pos
@@ -9934,8 +10198,7 @@ For instance, @[expr], @*::[expr], or ns::[expr]."
"Parse a literal (leaf) expression of some sort.
Includes complex literals such as functions, object-literals,
array-literals, array comprehensions and regular expressions."
- (let (pn ; parent node (usually return value)
- tt)
+ (let (tt node)
(setq tt (js2-current-token-type))
(cond
((= tt js2-CLASS)
@@ -9956,7 +10219,11 @@ array-literals, array comprehensions and regular
expressions."
((= tt js2-NAME)
(js2-parse-name tt))
((= tt js2-NUMBER)
- (make-js2-number-node))
+ (setq node (make-js2-number-node))
+ (when (and js2-in-use-strict-directive
+ (= (js2-number-node-num-base node) 8))
+ (js2-report-error "msg.no.octal.strict"))
+ node)
((or (= tt js2-STRING) (= tt js2-NO_SUBS_TEMPLATE))
(make-js2-string-node :type tt))
((= tt js2-TEMPLATE_HEAD)
@@ -10149,6 +10416,9 @@ We should have just parsed the 'for' keyword before
calling this function."
:loops (nreverse loops)
:filters (and filter (list (car filter)))
:form 'LEGACY_ARRAY))
+ ;; Set comp loop's parent to the last loop.
+ ;; TODO: Get rid of the bogus expr scope.
+ (setf (js2-scope-parent-scope result) first)
(apply #'js2-node-add-children result expr (car filter)
(js2-comp-node-loops result))
result))
@@ -10170,7 +10440,7 @@ We should have just parsed the 'for' keyword before
calling this function."
pn))
(defun js2-parse-comprehension (pos form)
- (let (loops filters expr result)
+ (let (loops filters expr result last)
(unwind-protect
(progn
(js2-unget-token)
@@ -10181,7 +10451,8 @@ We should have just parsed the 'for' keyword before
calling this function."
(js2-parse-comp-loop loop)))
(while (js2-match-token js2-IF)
(push (car (js2-parse-condition)) filters))
- (setq expr (js2-parse-assign-expr)))
+ (setq expr (js2-parse-assign-expr))
+ (setq last (car loops)))
(dolist (_ loops)
(js2-pop-scope)))
(setq result (make-js2-comp-node :pos pos
@@ -10192,6 +10463,7 @@ We should have just parsed the 'for' keyword before
calling this function."
:form form))
(apply #'js2-node-add-children result (js2-comp-node-loops result))
(apply #'js2-node-add-children result expr (js2-comp-node-filters result))
+ (setf (js2-scope-parent-scope result) last)
result))
(defun js2-parse-comp-loop (pn &optional only-of-p)
@@ -10296,37 +10568,61 @@ If ONLY-OF-P is non-nil, only the 'for (foo of bar)'
form is allowed."
(apply #'js2-node-add-children result (js2-object-node-elems result))
result))
+(defun js2-property-key-string (property-node)
+ "Return the key of PROPERTY-NODE (a `js2-object-prop-node' or
+`js2-getter-setter-node') as a string, or nil if it can't be
+represented as a string (e.g., the key is computed by an
+expression)."
+ (let ((key (js2-infix-node-left property-node)))
+ (cond
+ ((js2-name-node-p key)
+ (js2-name-node-name key))
+ ((js2-string-node-p key)
+ (js2-string-node-value key))
+ ((js2-number-node-p key)
+ (js2-number-node-value key)))))
+
(defun js2-parse-object-literal-elems (&optional class-p)
(let ((pos (js2-current-token-beg))
(static nil)
(continue t)
- tt elems elem after-comma)
+ tt elems elem
+ elem-key-string previous-elem-key-string
+ after-comma previous-token)
(while continue
- (setq static (and class-p (js2-match-token js2-STATIC))
- tt (js2-get-prop-name-token)
- elem nil)
+ (setq tt (js2-get-prop-name-token)
+ static nil
+ elem nil
+ previous-token nil)
+ ;; Handle 'static' keyword only if we're in a class
+ (when (and class-p (= js2-NAME tt)
+ (string= "static" (js2-current-token-string)))
+ (js2-record-face 'font-lock-keyword-face)
+ (setq static t
+ tt (js2-get-prop-name-token)))
+ ;; Handle generator * before the property name for in-line functions
+ (when (and (>= js2-language-version 200)
+ (= js2-MUL tt))
+ (setq previous-token (js2-current-token)
+ tt (js2-get-prop-name-token)))
+ ;; Handle 'get' or 'set' keywords
+ (let ((prop (js2-current-token-string)))
+ (when (and (>= js2-language-version 200)
+ (= js2-NAME tt)
+ (or (string= prop "get")
+ (string= prop "set"))
+ (member (js2-peek-token)
+ (list js2-NAME js2-STRING js2-NUMBER js2-LB)))
+ (setq previous-token (js2-current-token)
+ tt (js2-get-prop-name-token))))
(cond
- ;; {foo: ...}, {'foo': ...}, {foo, bar, ...},
- ;; {get foo() {...}}, {set foo(x) {...}}, or {foo(x) {...}}
- ;; TODO(sdh): support *foo() {...}
- ((or (= js2-NAME tt)
- (= tt js2-STRING))
+ ;; Found a property (of any sort)
+ ((member tt (list js2-NAME js2-STRING js2-NUMBER js2-LB))
(setq after-comma nil
- elem (js2-parse-named-prop tt))
+ elem (js2-parse-named-prop tt pos previous-token))
(if (and (null elem)
(not js2-recover-from-parse-errors))
(setq continue nil)))
- ;; {[Symbol.iterator]: ...}
- ((and (= tt js2-LB)
- (>= js2-language-version 200))
- (let ((expr (js2-parse-expr)))
- (js2-must-match js2-RB "msg.missing.computed.rb")
- (setq after-comma nil
- elem (js2-parse-plain-property expr))))
- ;; {12: x} or {10.7: x}
- ((= tt js2-NUMBER)
- (setq after-comma nil
- elem (js2-parse-plain-property (make-js2-number-node))))
;; Break out of loop, and handle trailing commas.
((or (= tt js2-RC)
(= tt js2-EOF))
@@ -10344,63 +10640,91 @@ If ONLY-OF-P is non-nil, only the 'for (foo of bar)'
form is allowed."
(if elem (js2-node-set-prop elem 'STATIC t)
(js2-report-error "msg.unexpected.static")))
;; Handle commas, depending on class-p.
- (let ((comma (js2-match-token js2-COMMA)))
- (if class-p
- (if comma
- (js2-report-error "msg.class.unexpected.comma"))
- (if comma
- (setq after-comma (js2-current-token-end))
- (setq continue nil))))
- ;; Append any parsed element.
- (if elem (push elem elems))) ; end loop
+ (let ((tok (js2-get-prop-name-token)))
+ (if (eq tok js2-COMMA)
+ (if class-p
+ (js2-report-error "msg.class.unexpected.comma")
+ (setq after-comma (js2-current-token-end)))
+ (js2-unget-token)
+ (unless class-p (setq continue nil))))
+ (when elem
+ (when (and js2-in-use-strict-directive
+ (setq elem-key-string (js2-property-key-string elem))
+ (cl-some
+ (lambda (previous-elem)
+ (and (setq previous-elem-key-string
+ (js2-property-key-string previous-elem))
+ (string= previous-elem-key-string elem-key-string)))
+ elems))
+ (js2-report-error "msg.dup.obj.lit.prop.strict"
+ elem-key-string
+ (js2-node-abs-pos (js2-infix-node-left elem))
+ (js2-node-len (js2-infix-node-left elem))))
+ ;; Append any parsed element.
+ (push elem elems))) ; end loop
(js2-must-match js2-RC "msg.no.brace.prop")
(nreverse elems)))
-(defun js2-parse-named-prop (tt)
+(defun js2-parse-named-prop (tt pos previous-token)
"Parse a name, string, or getter/setter object property.
When `js2-is-in-destructuring' is t, forms like {a, b, c} will be permitted."
- (let ((string-prop (and (= tt js2-STRING)
- (make-js2-string-node)))
- expr
- (ppos (js2-current-token-beg))
- (pend (js2-current-token-end))
- (name (js2-create-name-node))
- (prop (js2-current-token-string)))
+ (let ((key (cond
+ ;; Literal string keys: {'foo': 'bar'}
+ ((= tt js2-STRING)
+ (make-js2-string-node))
+ ;; Handle computed keys: {[Symbol.iterator]: ...}, *[1+2]()
{...}},
+ ;; {[foo + bar]() { ... }}, {[get ['x' + 1]() {...}}
+ ((and (= tt js2-LB)
+ (>= js2-language-version 200))
+ (prog1 (js2-parse-expr)
+ (js2-must-match js2-RB "msg.missing.computed.rb")))
+ ;; Numeric keys: {12: 'foo'}, {10.7: 'bar'}
+ ((= tt js2-NUMBER)
+ (make-js2-number-node))
+ ;; Unquoted names: {foo: 12}
+ ((= tt js2-NAME)
+ (js2-create-name-node))
+ ;; Anything else is an error
+ (t (js2-report-error "msg.bad.prop"))))
+ (prop (and previous-token (js2-token-string previous-token)))
+ (property-type (when previous-token
+ (if (= (js2-token-type previous-token) js2-MUL)
+ "*"
+ (js2-token-string previous-token)))))
+ (when (or (string= prop "get")
+ (string= prop "set"))
+ (js2-set-face (js2-token-beg previous-token)
+ (js2-token-end previous-token)
+ 'font-lock-keyword-face 'record)) ; get/set
(cond
- ;; getter/setter prop
- ((and (= tt js2-NAME)
- (= (js2-peek-token) js2-NAME)
- (or (string= prop "get")
- (string= prop "set")))
- (js2-get-token)
- (js2-set-face ppos pend 'font-lock-keyword-face 'record) ; get/set
- (js2-record-face 'font-lock-function-name-face) ; for peeked name
- (setq name (js2-create-name-node)) ; discard get/set & use peeked name
- (js2-parse-getter-setter-prop ppos name prop))
;; method definition: {f() {...}}
((and (= (js2-peek-token) js2-LP)
(>= js2-language-version 200))
- (js2-record-face 'font-lock-function-name-face) ; name
- (js2-parse-getter-setter-prop ppos name ""))
+ (when (js2-name-node-p key) ; highlight function name properties
+ (js2-record-face 'font-lock-function-name-face))
+ (js2-parse-getter-setter-prop pos key property-type))
;; regular prop
(t
- (prog1
- (setq expr (js2-parse-plain-property (or string-prop name)))
- (when (and (not string-prop)
+ (let ((beg (js2-current-token-beg))
+ (end (js2-current-token-end))
+ (expr (js2-parse-plain-property key)))
+ (when (and (= tt js2-NAME)
(not js2-is-in-destructuring)
js2-highlight-external-variables
(js2-node-get-prop expr 'SHORTHAND))
- (js2-record-name-node name))
- (js2-set-face ppos pend
+ (js2-record-name-node key))
+ (js2-set-face beg end
(if (js2-function-node-p
(js2-object-prop-node-right expr))
'font-lock-function-name-face
'font-lock-variable-name-face)
- 'record))))))
+ 'record)
+ expr)))))
(defun js2-parse-plain-property (prop)
"Parse a non-getter/setter property in an object literal.
-PROP is the node representing the property: a number, name or string."
+PROP is the node representing the property: a number, name,
+string or expression."
(let* ((tt (js2-get-token))
(pos (js2-node-pos prop))
colon expr result)
@@ -10450,7 +10774,7 @@ and expression closure style is also supported
POS is the start position of the `get' or `set' keyword.
PROP is the `js2-name-node' representing the property name.
-GET-P is non-nil if the keyword was `get'."
+TYPE-STRING is a string `get', `set', `*', or nil, indicating a found keyword."
(let ((type (cond
((string= "get" type-string) js2-GET)
((string= "set" type-string) js2-SET)
@@ -10463,6 +10787,8 @@ GET-P is non-nil if the keyword was `get'."
(if (cl-plusp (length (js2-function-name fn)))
(js2-report-error "msg.bad.prop")))
(js2-node-set-prop fn 'GETTER_SETTER type) ; for codegen
+ (when (string= type-string "*")
+ (setf (js2-function-node-generator-type fn) 'STAR))
(setq end (js2-node-end fn)
result (make-js2-getter-setter-node :type type
:pos pos
@@ -10489,22 +10815,19 @@ And, if CHECK-ACTIVATION-P is non-nil, use the value
of TOKEN."
(js2-check-activation-name s (or token js2-NAME)))
name))
-;;; Indentation support
+;;; Indentation support (bouncing)
-;; This indenter is based on Karl Landström's "javascript.el" indenter.
-;; Karl cleverly deduces that the desired indentation level is often a
-;; function of paren/bracket/brace nesting depth, which can be determined
-;; quickly via the built-in `parse-partial-sexp' function. His indenter
-;; then does some equally clever checks to see if we're in the context of a
-;; substatement of a possibly braceless statement keyword such as if, while,
-;; or finally. This approach yields pretty good results.
+;; In recent-enough Emacs, we reuse the indentation code from
+;; `js-mode'. To continue support for the older versions, some code
+;; that was here previously was moved to `js2-old-indent.el'.
-;; The indenter is often "wrong", however, and needs to be overridden.
-;; The right long-term solution is probably to emulate (or integrate
-;; with) cc-engine, but it's a nontrivial amount of coding. Even when a
-;; parse tree from `js2-parse' is present, which is not true at the
-;; moment the user is typing, computing indentation is still thousands
-;; of lines of code to handle every possible syntactic edge case.
+;; Whichever indenter is used, it's often "wrong", however, and needs
+;; to be overridden. The right long-term solution is probably to
+;; emulate (or integrate with) cc-engine, but it's a nontrivial amount
+;; of coding. Even when a parse tree from `js2-parse' is present,
+;; which is not true at the moment the user is typing, computing
+;; indentation is still thousands of lines of code to handle every
+;; possible syntactic edge case.
;; In the meantime, the compromise solution is that we offer a "bounce
;; indenter", configured with `js2-bounce-indent-p', which cycles the
@@ -10513,327 +10836,6 @@ And, if CHECK-ACTIVATION-P is non-nil, use the value
of TOKEN."
;; move the line towards its desired indentation when manually
;; overriding Karl's heuristic nesting guesser.
-;; I've made miscellaneous tweaks to Karl's code to handle some Ecma
-;; extensions such as `let' and Array comprehensions. Major kudos to
-;; Karl for coming up with the initial approach, which packs a lot of
-;; punch for so little code.
-
-(defconst js2-possibly-braceless-keywords-re
- (concat "else[ \t]+if\\|for[ \t]+each\\|"
- (regexp-opt '("catch" "do" "else" "finally" "for" "if"
- "try" "while" "with" "let")))
- "Regular expression matching keywords that are optionally
-followed by an opening brace.")
-
-(defconst js2-indent-operator-re
- (concat "[-+*/%<>&^|?:.]\\([^-+*/]\\|$\\)\\|!?=\\|"
- (regexp-opt '("in" "instanceof") 'words))
- "Regular expression matching operators that affect indentation
-of continued expressions.")
-
-(defconst js2-declaration-keyword-re
- (regexp-opt '("var" "let" "const") 'words)
- "Regular expression matching variable declaration keywords.")
-
-(defun js2-re-search-forward-inner (regexp &optional bound count)
- "Auxiliary function for `js2-re-search-forward'."
- (let (parse saved-point)
- (while (> count 0)
- (re-search-forward regexp bound)
- (setq parse (if saved-point
- (parse-partial-sexp saved-point (point))
- (syntax-ppss (point))))
- (cond ((nth 3 parse)
- (re-search-forward
- (concat "\\(\\=\\|[^\\]\\|^\\)" (string (nth 3 parse)))
- (save-excursion (end-of-line) (point)) t))
- ((nth 7 parse)
- (forward-line))
- ((or (nth 4 parse)
- (and (eq (char-before) ?\/) (eq (char-after) ?\*)))
- (re-search-forward "\\*/"))
- (t
- (setq count (1- count))))
- (setq saved-point (point))))
- (point))
-
-(defun js2-re-search-forward (regexp &optional bound noerror count)
- "Search forward but ignore strings and comments.
-Invokes `re-search-forward' but treats the buffer as if strings
-and comments have been removed."
- (let ((saved-point (point)))
- (condition-case err
- (cond ((null count)
- (js2-re-search-forward-inner regexp bound 1))
- ((< count 0)
- (js2-re-search-backward-inner regexp bound (- count)))
- ((> count 0)
- (js2-re-search-forward-inner regexp bound count)))
- (search-failed
- (goto-char saved-point)
- (unless noerror
- (error (error-message-string err)))))))
-
-(defun js2-re-search-backward-inner (regexp &optional bound count)
- "Auxiliary function for `js2-re-search-backward'."
- (let (parse)
- (while (> count 0)
- (re-search-backward regexp bound)
- (setq parse (syntax-ppss (point)))
- (cond ((nth 3 parse)
- (re-search-backward
- (concat "\\([^\\]\\|^\\)" (string (nth 3 parse)))
- (line-beginning-position) t))
- ((nth 7 parse)
- (goto-char (nth 8 parse)))
- ((or (nth 4 parse)
- (and (eq (char-before) ?/) (eq (char-after) ?*)))
- (re-search-backward "/\\*"))
- (t
- (setq count (1- count))))))
- (point))
-
-(defun js2-re-search-backward (regexp &optional bound noerror count)
- "Search backward but ignore strings and comments.
-Invokes `re-search-backward' but treats the buffer as if strings
-and comments have been removed."
- (let ((saved-point (point)))
- (condition-case err
- (cond ((null count)
- (js2-re-search-backward-inner regexp bound 1))
- ((< count 0)
- (js2-re-search-forward-inner regexp bound (- count)))
- ((> count 0)
- (js2-re-search-backward-inner regexp bound count)))
- (search-failed
- (goto-char saved-point)
- (unless noerror
- (error (error-message-string err)))))))
-
-(defun js2-looking-at-operator-p ()
- "Return non-nil if text after point is a non-comma operator."
- (and (looking-at js2-indent-operator-re)
- (or (not (looking-at ":"))
- (save-excursion
- (and (js2-re-search-backward "[?:{]\\|\\<case\\>" nil t)
- (looking-at "?"))))))
-
-(defun js2-continued-expression-p ()
- "Return non-nil if the current line continues an expression."
- (save-excursion
- (back-to-indentation)
- (or (js2-looking-at-operator-p)
- (when (catch 'found
- (while (and (re-search-backward "\n" nil t)
- (let ((state (syntax-ppss)))
- (when (nth 4 state)
- (goto-char (nth 8 state))) ;; skip comments
- (skip-chars-backward " \t")
- (if (bolp)
- t
- (throw 'found t))))))
- (backward-char)
- (when (js2-looking-at-operator-p)
- (backward-char)
- (not (looking-at "\\*\\|\\+\\+\\|--\\|/[/*]")))))))
-
-(defun js2-end-of-do-while-loop-p ()
- "Return non-nil if word after point is `while' of a do-while
-statement, else returns nil. A braceless do-while statement
-spanning several lines requires that the start of the loop is
-indented to the same column as the current line."
- (interactive)
- (save-excursion
- (when (looking-at "\\s-*\\<while\\>")
- (if (save-excursion
- (skip-chars-backward "[ \t\n]*}")
- (looking-at "[ \t\n]*}"))
- (save-excursion
- (backward-list) (backward-word 1) (looking-at "\\<do\\>"))
- (js2-re-search-backward "\\<do\\>" (point-at-bol) t)
- (or (looking-at "\\<do\\>")
- (let ((saved-indent (current-indentation)))
- (while (and (js2-re-search-backward "^[ \t]*\\<" nil t)
- (/= (current-indentation) saved-indent)))
- (and (looking-at "[ \t]*\\<do\\>")
- (not (js2-re-search-forward
- "\\<while\\>" (point-at-eol) t))
- (= (current-indentation) saved-indent))))))))
-
-(defun js2-multiline-decl-indentation ()
- "Return the declaration indentation column if the current line belongs
-to a multiline declaration statement. See
`js2-pretty-multiline-declarations'."
- (let (forward-sexp-function ; use Lisp version
- at-opening-bracket)
- (save-excursion
- (back-to-indentation)
- (when (not (looking-at js2-declaration-keyword-re))
- (when (looking-at js2-indent-operator-re)
- (goto-char (match-end 0))) ; continued expressions are ok
- (while (and (not at-opening-bracket)
- (not (bobp))
- (let ((pos (point)))
- (save-excursion
- (js2-backward-sws)
- (or (eq (char-before) ?,)
- (and (not (eq (char-before) ?\;))
- (prog2 (skip-syntax-backward ".")
- (looking-at js2-indent-operator-re)
- (js2-backward-sws))
- (not (eq (char-before) ?\;)))
- (js2-same-line pos)))))
- (condition-case _
- (backward-sexp)
- (scan-error (setq at-opening-bracket t))))
- (when (looking-at js2-declaration-keyword-re)
- (goto-char (match-end 0))
- (1+ (current-column)))))))
-
-(defun js2-ctrl-statement-indentation ()
- "Return the proper indentation of current line if it is a control statement.
-Returns an indentation if this line starts the body of a control
-statement without braces, else returns nil."
- (let (forward-sexp-function)
- (save-excursion
- (back-to-indentation)
- (when (and (not (js2-same-line (point-min)))
- (not (looking-at "{"))
- (js2-re-search-backward "[[:graph:]]" nil t)
- (not (looking-at "[{([]"))
- (progn
- (forward-char)
- (when (= (char-before) ?\))
- ;; scan-sexps sometimes throws an error
- (ignore-errors (backward-sexp))
- (skip-chars-backward " \t" (point-at-bol)))
- (let ((pt (point)))
- (back-to-indentation)
- (when (looking-at "}[ \t]*")
- (goto-char (match-end 0)))
- (and (looking-at js2-possibly-braceless-keywords-re)
- (= (match-end 0) pt)
- (not (js2-end-of-do-while-loop-p))))))
- (+ (current-indentation) js2-basic-offset)))))
-
-(defun js2-indent-in-array-comp (parse-status)
- "Return non-nil if we think we're in an array comprehension.
-In particular, return the buffer position of the first `for' kwd."
- (let ((bracket (nth 1 parse-status))
- (end (point)))
- (when bracket
- (save-excursion
- (goto-char bracket)
- (when (looking-at "\\[")
- (forward-char 1)
- (js2-forward-sws)
- (if (looking-at "[[{]")
- (let (forward-sexp-function) ; use Lisp version
- (forward-sexp) ; skip destructuring form
- (js2-forward-sws)
- (if (and (/= (char-after) ?,) ; regular array
- (looking-at "for"))
- (match-beginning 0)))
- ;; to skip arbitrary expressions we need the parser,
- ;; so we'll just guess at it.
- (if (and (> end (point)) ; not empty literal
- (re-search-forward "[^,]]* \\(for\\) " end t)
- ;; not inside comment or string literal
- (let ((state (parse-partial-sexp bracket (point))))
- (not (or (nth 3 state) (nth 4 state)))))
- (match-beginning 1))))))))
-
-(defun js2-array-comp-indentation (parse-status for-kwd)
- (if (js2-same-line for-kwd)
- ;; first continuation line
- (save-excursion
- (goto-char (nth 1 parse-status))
- (forward-char 1)
- (skip-chars-forward " \t")
- (current-column))
- (save-excursion
- (goto-char for-kwd)
- (current-column))))
-
-(defun js2-proper-indentation (parse-status)
- "Return the proper indentation for the current line."
- (save-excursion
- (back-to-indentation)
- (let* ((ctrl-stmt-indent (js2-ctrl-statement-indentation))
- (at-closing-bracket (looking-at "[]})]"))
- (same-indent-p (or at-closing-bracket
- (looking-at "\\<case\\>[^:]")
- (and (looking-at "\\<default:")
- (save-excursion
- (js2-backward-sws)
- (not (memq (char-before) '(?, ?{)))))))
- (continued-expr-p (js2-continued-expression-p))
- (declaration-indent (and js2-pretty-multiline-declarations
- (js2-multiline-decl-indentation)))
- (bracket (nth 1 parse-status))
- beg indent)
- (cond
- ;; indent array comprehension continuation lines specially
- ((and bracket
- (>= js2-language-version 170)
- (not (js2-same-line bracket))
- (setq beg (js2-indent-in-array-comp parse-status))
- (>= (point) (save-excursion
- (goto-char beg)
- (point-at-bol)))) ; at or after first loop?
- (js2-array-comp-indentation parse-status beg))
-
- (ctrl-stmt-indent)
-
- ((and declaration-indent continued-expr-p)
- (+ declaration-indent js2-basic-offset))
-
- (declaration-indent)
-
- (bracket
- (goto-char bracket)
- (cond
- ((looking-at "[({[][ \t]*\\(/[/*]\\|$\\)")
- (when (save-excursion (skip-chars-backward " \t)")
- (looking-at ")"))
- (backward-list))
- (back-to-indentation)
- (and (eq js2-pretty-multiline-declarations 'all)
- (looking-at js2-declaration-keyword-re)
- (goto-char (1+ (match-end 0))))
- (setq indent
- (cond (same-indent-p
- (current-column))
- (continued-expr-p
- (+ (current-column) (* 2 js2-basic-offset)))
- (t
- (+ (current-column) js2-basic-offset))))
- (if (and js2-indent-switch-body
- (not at-closing-bracket)
- (looking-at "\\_<switch\\_>"))
- (+ indent js2-basic-offset)
- indent))
- (t
- (unless same-indent-p
- (forward-char)
- (skip-chars-forward " \t"))
- (current-column))))
-
- (continued-expr-p js2-basic-offset)
-
- (t 0)))))
-
-(defun js2-lineup-comment (parse-status)
- "Indent a multi-line block comment continuation line."
- (let* ((beg (nth 8 parse-status))
- (first-line (js2-same-line beg))
- (offset (save-excursion
- (goto-char beg)
- (if (looking-at "/\\*")
- (+ 1 (current-column))
- 0))))
- (unless first-line
- (indent-line-to offset))))
-
(defun js2-backward-sws ()
"Move backward through whitespace and comments."
(interactive)
@@ -10844,15 +10846,6 @@ In particular, return the buffer position of the first
`for' kwd."
(interactive)
(while (forward-comment 1)))
-(defun js2-current-indent (&optional pos)
- "Return column of indentation on current line.
-If POS is non-nil, go to that point and return indentation for that line."
- (save-excursion
- (if pos
- (goto-char pos))
- (back-to-indentation)
- (current-column)))
-
(defun js2-arglist-close ()
"Return non-nil if we're on a line beginning with a close-paren/brace."
(save-excursion
@@ -10900,14 +10893,14 @@ If POS is non-nil, go to that point and return
indentation for that line."
(skip-chars-forward " \t")
(looking-at "case\\s-.+:")))
-(defun js2-bounce-indent (normal-col parse-status &optional backwards)
+(defun js2-bounce-indent (normal-col parse-status &optional backward)
"Cycle among alternate computed indentation positions.
PARSE-STATUS is the result of `parse-partial-sexp' from the beginning
of the buffer to the current point. NORMAL-COL is the indentation
column computed by the heuristic guesser based on current paren,
bracket, brace and statement nesting. If BACKWARDS, cycle positions
in reverse."
- (let ((cur-indent (js2-current-indent))
+ (let ((cur-indent (current-indentation))
(old-buffer-undo-list buffer-undo-list)
;; Emacs 21 only has `count-lines', not `line-number-at-pos'
(current-line (save-excursion
@@ -11010,8 +11003,8 @@ in reverse."
(js2-indent-objlit-arg-p parse-status))
(setq main-pos basic-offset))
- ;; if bouncing backwards, reverse positions list
- (if backwards
+ ;; if bouncing backward, reverse positions list
+ (if backward
(setq positions (reverse positions)))
;; record whether we're already sitting on one of the alternatives
@@ -11055,12 +11048,6 @@ in reverse."
;; see commentary for `js2-mode-last-indented-line'
(setq js2-mode-last-indented-line current-line))))
-(defun js2-indent-bounce-backwards ()
- "Calls `js2-indent-line'. When `js2-bounce-indent-p',
-cycles between the computed indentation positions in reverse order."
- (interactive)
- (js2-indent-line t))
-
(defun js2-1-line-comment-continuation-p ()
"Return t if we're in a 1-line comment continuation.
If so, we don't ever want to use bounce-indent."
@@ -11076,8 +11063,8 @@ If so, we don't ever want to use bounce-indent."
(forward-line 0))
(looking-at "\\s-*//")))))
-(defun js2-indent-line (&optional bounce-backwards)
- "Indent the current line as JavaScript source text."
+(defun js2-indent-bounce (&optional backward)
+ "Indent the current line, bouncing between several positions."
(interactive)
(let (parse-status offset indent-col
;; Don't whine about errors/warnings when we're indenting.
@@ -11088,22 +11075,24 @@ If so, we don't ever want to use bounce-indent."
offset (- (point) (save-excursion
(back-to-indentation)
(point))))
- (js2-with-underscore-as-word-syntax
- (if (nth 4 parse-status)
- (js2-lineup-comment parse-status)
- (setq indent-col (js2-proper-indentation parse-status))
- ;; See comments below about `js2-mode-last-indented-line'.
- (cond
- ;; bounce-indenting is disabled during electric-key indent.
- ;; It doesn't work well on first line of buffer.
- ((and js2-bounce-indent-p
- (not (js2-same-line (point-min)))
- (not (js2-1-line-comment-continuation-p)))
- (js2-bounce-indent indent-col parse-status bounce-backwards))
- ;; just indent to the guesser's likely spot
- (t (indent-line-to indent-col))))
- (when (cl-plusp offset)
- (forward-char offset)))))
+ ;; Don't touch multiline strings.
+ (unless (nth 3 parse-status)
+ (setq indent-col (js2-proper-indentation parse-status))
+ (cond
+ ;; It doesn't work well on first line of buffer.
+ ((and (not (nth 4 parse-status))
+ (not (js2-same-line (point-min)))
+ (not (js2-1-line-comment-continuation-p)))
+ (js2-bounce-indent indent-col parse-status backward))
+ ;; just indent to the guesser's likely spot
+ (t (indent-line-to indent-col)))
+ (when (cl-plusp offset)
+ (forward-char offset)))))
+
+(defun js2-indent-bounce-backward ()
+ "Indent the current line, bouncing between positions in reverse."
+ (interactive)
+ (js2-indent-bounce t))
(defun js2-indent-region (start end)
"Indent the region, but don't use bounce indenting."
@@ -11129,9 +11118,11 @@ such as `js-mode', while retaining the asynchronous
error/warning
highlighting features of `js2-mode'."
:group 'js2-mode
:lighter " js-lint"
- (if js2-minor-mode
- (js2-minor-mode-enter)
- (js2-minor-mode-exit)))
+ (if (derived-mode-p 'js2-mode)
+ (setq js2-minor-mode nil)
+ (if js2-minor-mode
+ (js2-minor-mode-enter)
+ (js2-minor-mode-exit))))
(defun js2-minor-mode-enter ()
"Initialization for `js2-minor-mode'."
@@ -11221,18 +11212,13 @@ highlighting features of `js2-mode'."
map)
"Keymap used for js2 diagnostics buffers.")
-(defun js2-error-buffer-mode ()
+(define-derived-mode js2-error-buffer-mode special-mode "JS Lint Diagnostics"
"Major mode for js2 diagnostics buffers.
Selecting an error will jump it to the corresponding source-buffer error.
\\{js2-error-buffer-mode-map}"
- (interactive)
- (setq major-mode 'js2-error-buffer-mode
- mode-name "JS Lint Diagnostics")
- (use-local-map js2-error-buffer-mode-map)
(setq truncate-lines t)
(set-buffer-modified-p nil)
- (setq buffer-read-only t)
- (run-hooks 'js2-error-buffer-mode-hook))
+ (setq buffer-read-only t))
(defun js2-error-buffer-next ()
"Move to next error and view it."
@@ -11261,7 +11247,7 @@ Selecting an error will jump it to the corresponding
source-buffer error.
"Scroll source buffer to show error at current line."
(interactive)
(cond
- ((not (eq major-mode 'js2-error-buffer-mode))
+ ((not (derived-mode-p 'js2-error-buffer-mode))
(message "Not in a js2 errors buffer"))
((not (buffer-live-p js2-source-buffer))
(message "Source buffer has been killed"))
@@ -11276,18 +11262,13 @@ Selecting an error will jump it to the corresponding
source-buffer error.
(message msg))))))
;;;###autoload
-(define-derived-mode js2-mode prog-mode "Javascript-IDE"
- ;; FIXME: Should derive from js-mode.
+(define-derived-mode js2-mode js-mode "Javascript-IDE"
"Major mode for editing JavaScript code."
- ;; Used by comment-region; don't change it.
- (set (make-local-variable 'comment-start) "//")
- (set (make-local-variable 'comment-end) "")
- (set (make-local-variable 'comment-start-skip) js2-comment-start-skip)
(set (make-local-variable 'max-lisp-eval-depth)
(max max-lisp-eval-depth 3000))
(set (make-local-variable 'indent-line-function) #'js2-indent-line)
(set (make-local-variable 'indent-region-function) #'js2-indent-region)
- (set (make-local-variable 'fill-paragraph-function) #'c-fill-paragraph)
+ (set (make-local-variable 'syntax-propertize-function) nil)
(set (make-local-variable 'comment-line-break-function) #'js2-line-break)
(set (make-local-variable 'beginning-of-defun-function)
#'js2-beginning-of-defun)
(set (make-local-variable 'end-of-defun-function) #'js2-end-of-defun)
@@ -11299,30 +11280,6 @@ Selecting an error will jump it to the corresponding
source-buffer error.
;; needed for M-x rgrep, among other things
(put 'js2-mode 'find-tag-default-function #'js2-mode-find-tag)
- (set (make-local-variable 'electric-indent-chars)
- (append "{}()[]:;,*." electric-indent-chars))
- (set (make-local-variable 'electric-layout-rules)
- '((?\; . after) (?\{ . after) (?\} . before)))
-
- ;; some variables needed by cc-engine for paragraph-fill, etc.
- (setq c-comment-prefix-regexp js2-comment-prefix-regexp
- c-comment-start-regexp "/[*/]\\|\\s|"
- c-line-comment-starter "//"
- c-paragraph-start js2-paragraph-start
- c-paragraph-separate "$"
- c-syntactic-ws-start js2-syntactic-ws-start
- c-syntactic-ws-end js2-syntactic-ws-end
- c-syntactic-eol js2-syntactic-eol)
-
- (let ((c-buffer-is-cc-mode t))
- ;; Copied from `js-mode'. Also see Bug#6071.
- (make-local-variable 'paragraph-start)
- (make-local-variable 'paragraph-separate)
- (make-local-variable 'paragraph-ignore-fill-prefix)
- (make-local-variable 'adaptive-fill-mode)
- (make-local-variable 'adaptive-fill-regexp)
- (c-setup-paragraph-variables))
-
(setq font-lock-defaults '(nil t))
;; Experiment: make reparse-delay longer for longer files.
@@ -11339,6 +11296,7 @@ Selecting an error will jump it to the corresponding
source-buffer error.
(add-to-invisibility-spec '(js2-outline . t))
(set (make-local-variable 'line-move-ignore-invisible) t)
(set (make-local-variable 'forward-sexp-function) #'js2-mode-forward-sexp)
+ (when (fboundp 'cursor-sensor-mode) (cursor-sensor-mode 1))
(setq js2-mode-functions-hidden nil
js2-mode-comments-hidden nil
@@ -11476,25 +11434,35 @@ buffer will only rebuild its `js2-mode-ast' if the
buffer is dirty."
(setq js2-mode-node-overlay (make-overlay beg end))
(overlay-put js2-mode-node-overlay 'font-lock-face 'highlight))
(with-silent-modifications
- (put-text-property beg end 'point-left #'js2-mode-hide-overlay))
+ (if (fboundp 'cursor-sensor-mode)
+ (put-text-property beg end 'cursor-sensor-functions
+ '(js2-mode-hide-overlay))
+ (put-text-property beg end 'point-left #'js2-mode-hide-overlay)))
(message "%s, parent: %s"
(js2-node-short-name node)
(if (js2-node-parent node)
(js2-node-short-name (js2-node-parent node))
"nil"))))))
-(defun js2-mode-hide-overlay (&optional _p1 p2)
- "Remove the debugging overlay when the point moves.
-P1 and P2 are the old and new values of point, respectively."
+(defun js2-mode-hide-overlay (&optional arg1 arg2 _arg3)
+ "Remove the debugging overlay when point moves.
+ARG1, ARG2 and ARG3 have different values depending on whether this function
+was found on `point-left' or in `cursor-sensor-functions'."
(when js2-mode-node-overlay
(let ((beg (overlay-start js2-mode-node-overlay))
- (end (overlay-end js2-mode-node-overlay)))
+ (end (overlay-end js2-mode-node-overlay))
+ (p2 (if (windowp arg1)
+ ;; Called from cursor-sensor-functions.
+ (window-point arg1)
+ ;; Called from point-left.
+ arg2)))
;; Sometimes we're called spuriously.
(unless (and p2
(>= p2 beg)
(<= p2 end))
(with-silent-modifications
- (remove-text-properties beg end '(point-left nil)))
+ (remove-text-properties beg end
+ '(point-left nil cursor-sensor-functions)))
(delete-overlay js2-mode-node-overlay)
(setq js2-mode-node-overlay nil)))))
@@ -11515,10 +11483,13 @@ The last element is optional. When present, use
instead of FACE."
(beg (max (point-min) (min beg (point-max))))
(end (max (point-min) (min end (point-max))))
(ovl (make-overlay beg end)))
+ ;; FIXME: Why a mix of overlays and text-properties?
(overlay-put ovl 'font-lock-face (or (cl-fourth e) face))
(overlay-put ovl 'js2-error t)
(put-text-property beg end 'help-echo (js2-get-msg key))
- (put-text-property beg end 'point-entered #'js2-echo-error)))
+ (if (fboundp 'cursor-sensor-mode)
+ (put-text-property beg end 'cursor-sensor-functions '(js2-echo-error))
+ (put-text-property beg end 'point-entered #'js2-echo-error))))
(defun js2-remove-overlays ()
"Remove overlays from buffer that have a `js2-error' property."
@@ -11529,13 +11500,6 @@ The last element is optional. When present, use
instead of FACE."
(when (overlay-get o 'js2-error)
(delete-overlay o))))))
-(defun js2-error-at-point (&optional pos)
- "Return non-nil if there's an error overlay at POS.
-Defaults to point."
- (cl-loop with pos = (or pos (point))
- for o in (overlays-at pos)
- thereis (overlay-get o 'js2-error)))
-
(defun js2-mode-apply-deferred-properties ()
"Apply fontifications and other text properties recorded during parsing."
(when (cl-plusp js2-highlight-level)
@@ -11590,16 +11554,21 @@ This ensures that the counts and `next-error' are
correct."
(dolist (e (js2-ast-root-warnings js2-mode-ast))
(js2-mode-show-warn-or-err e 'js2-warning))))
-(defun js2-echo-error (_old-point new-point)
- "Called by point-motion hooks."
- (let ((msg (get-text-property new-point 'help-echo)))
+(defun js2-echo-error (arg1 arg2 &optional _arg3)
+ "Called by point-motion hooks.
+ARG1, ARG2 and ARG3 have different values depending on whether this function
+was found on `point-entered' or in `cursor-sensor-functions'."
+ (let* ((new-point (if (windowp arg1)
+ ;; Called from cursor-sensor-functions.
+ (window-point arg1)
+ ;; Called from point-left.
+ arg2))
+ (msg (get-text-property new-point 'help-echo)))
(when (and (stringp msg)
(not (active-minibuffer-window))
(not (current-message)))
(message msg))))
-(defalias 'js2-echo-help #'js2-echo-error)
-
(defun js2-line-break (&optional _soft)
"Break line at point and indent, continuing comment if within one.
If inside a string, and `js2-concat-multiline-strings' is not
@@ -11656,8 +11625,7 @@ PARSE-STATUS is as documented in `parse-partial-sexp'."
;; comment.
(setq needs-close
(or
- (eq (get-text-property (1- (point)) 'point-entered)
- 'js2-echo-error)
+ (get-char-property (1- (point)) 'js2-error)
;; The heuristic above doesn't work well when we're
;; creating a comment and there's another one downstream,
;; as our parser thinks this one ends at the end of the
@@ -12064,7 +12032,7 @@ move backward across N balanced expressions."
(when (setq child (js2-node-closest-child node (point) rp))
(setq pos (js2-node-abs-end child)))
(setq pos (1+ rp))))
- ;; No parens or child nodes, looks for the end of the curren node.
+ ;; No parens or child nodes, looks for the end of the current
node.
(cl-incf pos (js2-node-len
(if (js2-expr-stmt-node-p (js2-node-parent node))
;; Stop after the semicolon.
@@ -12203,17 +12171,15 @@ destroying the region selection."
"Replacement for `find-tag-default'.
`find-tag-default' returns a ridiculous answer inside comments."
(let (beg end)
- (js2-with-underscore-as-word-syntax
- (save-excursion
- (if (and (not (looking-at "[[:alnum:]_$]"))
- (looking-back "[[:alnum:]_$]"))
- (setq beg (progn (forward-word -1) (point))
- end (progn (forward-word 1) (point)))
- (setq beg (progn (forward-word 1) (point))
- end (progn (forward-word -1) (point))))
- (replace-regexp-in-string
- "[\"']" ""
- (buffer-substring-no-properties beg end))))))
+ (save-excursion
+ (if (looking-at "\\_>")
+ (setq beg (progn (forward-symbol -1) (point))
+ end (progn (forward-symbol 1) (point)))
+ (setq beg (progn (forward-symbol 1) (point))
+ end (progn (forward-symbol -1) (point))))
+ (replace-regexp-in-string
+ "[\"']" ""
+ (buffer-substring-no-properties beg end)))))
(defun js2-mode-forward-sibling ()
"Move to the end of the sibling following point in parent.
@@ -12328,6 +12294,129 @@ it marks the next defun after the ones already
marked."
(unless (js2-ast-root-p fn)
(narrow-to-region beg (+ beg (js2-node-len fn))))))
+(defun js2-jump-to-definition (&optional arg)
+ "Jump to the definition of an object's property, variable or function."
+ (interactive "P")
+ (ring-insert find-tag-marker-ring (point-marker))
+ (let* ((node (js2-node-at-point))
+ (parent (js2-node-parent node))
+ (names (if (js2-prop-get-node-p parent)
+ (reverse (let ((temp (js2-compute-nested-prop-get parent)))
+ (cl-loop for n in temp
+ with result = '()
+ do (push n result)
+ until (equal node n)
+ finally return result)))))
+ node-init)
+ (unless (and (js2-name-node-p node)
+ (not (js2-var-init-node-p parent))
+ (not (js2-function-node-p parent)))
+ (error "Node is not a supported jump node"))
+ (push (or (and names (pop names))
+ (unless (and (js2-object-prop-node-p parent)
+ (eq node (js2-object-prop-node-left parent)))
+ node)) names)
+ (setq node-init (js2-search-scope node names))
+
+ ;; todo: display list of results in buffer
+ ;; todo: group found references by buffer
+ (unless node-init
+ (switch-to-buffer
+ (catch 'found
+ (unless arg
+ (mapc (lambda (b)
+ (with-current-buffer b
+ (when (derived-mode-p 'js2-mode)
+ (setq node-init (js2-search-scope js2-mode-ast names))
+ (if node-init
+ (throw 'found b)))))
+ (buffer-list)))
+ nil)))
+ (setq node-init (if (listp node-init) (car node-init) node-init))
+ (unless node-init
+ (pop-tag-mark)
+ (error "No jump location found"))
+ (goto-char (js2-node-abs-pos node-init))))
+
+(defun js2-search-object (node name-node)
+ "Check if object NODE contains element with NAME-NODE."
+ (cl-assert (js2-object-node-p node))
+ ;; Only support name-node and nodes for the time being
+ (cl-loop for elem in (js2-object-node-elems node)
+ for left = (js2-object-prop-node-left elem)
+ if (or (and (js2-name-node-p left)
+ (equal (js2-name-node-name name-node)
+ (js2-name-node-name left)))
+ (and (js2-string-node-p left)
+ (string= (js2-name-node-name name-node)
+ (js2-string-node-value left))))
+ return elem))
+
+(defun js2-search-object-for-prop (object prop-names)
+ "Return node in OBJECT that matches PROP-NAMES or nil.
+PROP-NAMES is a list of values representing a path to a value in OBJECT.
+i.e. ('name' 'value') = {name : { value: 3}}"
+ (let (node
+ (temp-object object)
+ (temp t) ;temporay node
+ (names prop-names))
+ (while (and temp names (js2-object-node-p temp-object))
+ (setq temp (js2-search-object temp-object (pop names)))
+ (and (setq node temp)
+ (setq temp-object (js2-object-prop-node-right temp))))
+ (unless names node)))
+
+(defun js2-search-scope (node names)
+ "Searches NODE scope for jump location matching NAMES.
+NAMES is a list of property values to search for. For functions
+and variables NAMES will contain one element."
+ (let (node-init
+ (val (js2-name-node-name (car names))))
+ (setq node-init (js2-get-symbol-declaration node val))
+
+ (when (> (length names) 1)
+
+ ;; Check var declarations
+ (when (and node-init (string= val (js2-name-node-name node-init)))
+ (let ((parent (js2-node-parent node-init))
+ (temp-names names))
+ (pop temp-names) ;; First element is var name
+ (setq node-init (when (js2-var-init-node-p parent)
+ (js2-search-object-for-prop
+ (js2-var-init-node-initializer parent)
+ temp-names)))))
+
+ ;; Check all assign nodes
+ (js2-visit-ast
+ js2-mode-ast
+ (lambda (node endp)
+ (unless endp
+ (if (js2-assign-node-p node)
+ (let ((left (js2-assign-node-left node))
+ (right (js2-assign-node-right node))
+ (temp-names names))
+ (when (js2-prop-get-node-p left)
+ (let* ((prop-list (js2-compute-nested-prop-get left))
+ (found (cl-loop for prop in prop-list
+ until (not (string=
(js2-name-node-name
+ (pop
temp-names))
+
(js2-name-node-name prop)))
+ if (not temp-names) return prop))
+ (found-node (or found
+ (when (js2-object-node-p right)
+ (js2-search-object-for-prop right
+
temp-names)))))
+ (if found-node (push found-node node-init))))))
+ t))))
+ node-init))
+
+(defun js2-get-symbol-declaration (node name)
+ "Find scope for NAME from NODE."
+ (let ((scope (js2-get-defining-scope
+ (or (js2-node-get-enclosing-scope node)
+ node) name)))
+ (if scope (js2-symbol-ast-node (js2-scope-get-symbol scope name)))))
+
(provide 'js2-mode)
;;; js2-mode.el ends here
diff --git a/packages/js2-mode/js2-old-indent.el
b/packages/js2-mode/js2-old-indent.el
new file mode 100644
index 0000000..efc9053
--- /dev/null
+++ b/packages/js2-mode/js2-old-indent.el
@@ -0,0 +1,489 @@
+;;; js2-old-indent.el --- Indentation code kept for compatibility
+
+;; Copyright (C) 2015 Free Software Foundation, Inc.
+
+;; 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:
+
+;; All features of this indentation code have been ported to Emacs's
+;; built-in `js-mode' by now, so we derive from it. An older
+;; commentary follows.
+
+;; This code is kept for Emacs 24.5 and ealier.
+
+;; This indenter is based on Karl Landström's "javascript.el" indenter.
+;; Karl cleverly deduces that the desired indentation level is often a
+;; function of paren/bracket/brace nesting depth, which can be determined
+;; quickly via the built-in `parse-partial-sexp' function. His indenter
+;; then does some equally clever checks to see if we're in the context of a
+;; substatement of a possibly braceless statement keyword such as if, while,
+;; or finally. This approach yields pretty good results.
+
+;; The indenter is often "wrong", however, and needs to be overridden.
+;; The right long-term solution is probably to emulate (or integrate
+;; with) cc-engine, but it's a nontrivial amount of coding. Even when a
+;; parse tree from `js2-parse' is present, which is not true at the
+;; moment the user is typing, computing indentation is still thousands
+;; of lines of code to handle every possible syntactic edge case.
+
+;; In the meantime, the compromise solution is that we offer a "bounce
+;; indenter", configured with `js2-bounce-indent-p', which cycles the
+;; current line indent among various likely guess points. This approach
+;; is far from perfect, but should at least make it slightly easier to
+;; move the line towards its desired indentation when manually
+;; overriding Karl's heuristic nesting guesser.
+
+;; I've made miscellaneous tweaks to Karl's code to handle some Ecma
+;; extensions such as `let' and Array comprehensions. Major kudos to
+;; Karl for coming up with the initial approach, which packs a lot of
+;; punch for so little code. -- Steve
+
+;;; Code:
+
+(defvar js2-language-version)
+
+(declare-function js2-mark-safe-local "js2-mode")
+(declare-function js2-backward-sws "js2-mode")
+(declare-function js2-forward-sws "js2-mode")
+(declare-function js2-same-line "js2-mode")
+
+(defcustom js2-basic-offset (if (and (boundp 'c-basic-offset)
+ (numberp c-basic-offset))
+ c-basic-offset
+ 4)
+ "Number of spaces to indent nested statements.
+Similar to `c-basic-offset'."
+ :group 'js2-mode
+ :safe 'integerp
+ :type 'integer)
+
+(defcustom js2-pretty-multiline-declarations t
+ "Non-nil to line up multiline declarations vertically:
+
+ var a = 10,
+ b = 20,
+ c = 30;
+
+If the value is t, and the first assigned value in the
+declaration is a function/array/object literal spanning several
+lines, it won't be indented additionally:
+
+ var o = { var bar = 2,
+ foo: 3 vs. o = {
+ }, foo: 3
+ bar = 2; };
+
+If the value is `all', it will always be indented additionally:
+
+ var o = {
+ foo: 3
+ };
+
+ var o = {
+ foo: 3
+ },
+ bar = 2;
+
+If the value is `dynamic', it will be indented additionally only
+if the declaration contains more than one variable:
+
+ var o = {
+ foo: 3
+ };
+
+ var o = {
+ foo: 3
+ },
+ bar = 2;"
+ :group 'js2-mode
+ :safe 'symbolp
+ :type 'symbol)
+
+(defcustom js2-indent-switch-body nil
+ "When nil, case labels are indented on the same level as the
+containing switch statement. Otherwise, all lines inside
+switch statement body are indented one additional level."
+ :type 'boolean
+ :safe 'booleanp
+ :group 'js2-mode)
+
+(defconst js2-possibly-braceless-keywords-re
+ (concat "else[ \t]+if\\|for[ \t]+each\\|"
+ (regexp-opt '("catch" "do" "else" "finally" "for" "if"
+ "try" "while" "with" "let")))
+ "Regular expression matching keywords that are optionally
+followed by an opening brace.")
+
+(defconst js2-indent-operator-re
+ (concat "[-+*/%<>&^|?:.]\\([^-+*/]\\|$\\)\\|!?=\\|"
+ (regexp-opt '("in" "instanceof") 'words))
+ "Regular expression matching operators that affect indentation
+of continued expressions.")
+
+(defconst js2-declaration-keyword-re
+ (regexp-opt '("var" "let" "const") 'words)
+ "Regular expression matching variable declaration keywords.")
+
+(defun js2-re-search-forward-inner (regexp &optional bound count)
+ "Auxiliary function for `js2-re-search-forward'."
+ (let (parse saved-point)
+ (while (> count 0)
+ (re-search-forward regexp bound)
+ (setq parse (if saved-point
+ (parse-partial-sexp saved-point (point))
+ (syntax-ppss (point))))
+ (cond ((nth 3 parse)
+ (re-search-forward
+ (concat "\\(\\=\\|[^\\]\\|^\\)" (string (nth 3 parse)))
+ (save-excursion (end-of-line) (point)) t))
+ ((nth 7 parse)
+ (forward-line))
+ ((or (nth 4 parse)
+ (and (eq (char-before) ?\/) (eq (char-after) ?\*)))
+ (re-search-forward "\\*/"))
+ (t
+ (setq count (1- count))))
+ (setq saved-point (point))))
+ (point))
+
+(defun js2-re-search-forward (regexp &optional bound noerror count)
+ "Search forward but ignore strings and comments.
+Invokes `re-search-forward' but treats the buffer as if strings
+and comments have been removed."
+ (let ((saved-point (point)))
+ (condition-case err
+ (cond ((null count)
+ (js2-re-search-forward-inner regexp bound 1))
+ ((< count 0)
+ (js2-re-search-backward-inner regexp bound (- count)))
+ ((> count 0)
+ (js2-re-search-forward-inner regexp bound count)))
+ (search-failed
+ (goto-char saved-point)
+ (unless noerror
+ (error (error-message-string err)))))))
+
+(defun js2-re-search-backward-inner (regexp &optional bound count)
+ "Auxiliary function for `js2-re-search-backward'."
+ (let (parse)
+ (while (> count 0)
+ (re-search-backward regexp bound)
+ (setq parse (syntax-ppss (point)))
+ (cond ((nth 3 parse)
+ (re-search-backward
+ (concat "\\([^\\]\\|^\\)" (string (nth 3 parse)))
+ (line-beginning-position) t))
+ ((nth 7 parse)
+ (goto-char (nth 8 parse)))
+ ((or (nth 4 parse)
+ (and (eq (char-before) ?/) (eq (char-after) ?*)))
+ (re-search-backward "/\\*"))
+ (t
+ (setq count (1- count))))))
+ (point))
+
+(defun js2-re-search-backward (regexp &optional bound noerror count)
+ "Search backward but ignore strings and comments.
+Invokes `re-search-backward' but treats the buffer as if strings
+and comments have been removed."
+ (let ((saved-point (point)))
+ (condition-case err
+ (cond ((null count)
+ (js2-re-search-backward-inner regexp bound 1))
+ ((< count 0)
+ (js2-re-search-forward-inner regexp bound (- count)))
+ ((> count 0)
+ (js2-re-search-backward-inner regexp bound count)))
+ (search-failed
+ (goto-char saved-point)
+ (unless noerror
+ (error (error-message-string err)))))))
+
+(defun js2-looking-at-operator-p ()
+ "Return non-nil if text after point is a non-comma operator."
+ (and (looking-at js2-indent-operator-re)
+ (or (not (looking-at ":"))
+ (save-excursion
+ (and (js2-re-search-backward "[?:{]\\|\\_<case\\_>" nil t)
+ (looking-at "?"))))))
+
+(defun js2-continued-expression-p ()
+ "Return non-nil if the current line continues an expression."
+ (save-excursion
+ (back-to-indentation)
+ (or (js2-looking-at-operator-p)
+ (when (catch 'found
+ (while (and (re-search-backward "\n" nil t)
+ (let ((state (syntax-ppss)))
+ (when (nth 4 state)
+ (goto-char (nth 8 state))) ;; skip comments
+ (skip-chars-backward " \t")
+ (if (bolp)
+ t
+ (throw 'found t))))))
+ (backward-char)
+ (when (js2-looking-at-operator-p)
+ (backward-char)
+ (not (looking-at "\\*\\|\\+\\+\\|--\\|/[/*]")))))))
+
+(defun js2-end-of-do-while-loop-p ()
+ "Return non-nil if word after point is `while' of a do-while
+statement, else returns nil. A braceless do-while statement
+spanning several lines requires that the start of the loop is
+indented to the same column as the current line."
+ (interactive)
+ (save-excursion
+ (when (looking-at "\\s-*\\_<while\\_>")
+ (if (save-excursion
+ (skip-chars-backward "[ \t\n]*}")
+ (looking-at "[ \t\n]*}"))
+ (save-excursion
+ (backward-list) (backward-word 1) (looking-at "\\_<do\\_>"))
+ (js2-re-search-backward "\\_<do\\_>" (point-at-bol) t)
+ (or (looking-at "\\_<do\\_>")
+ (let ((saved-indent (current-indentation)))
+ (while (and (js2-re-search-backward "^[ \t]*\\_<" nil t)
+ (/= (current-indentation) saved-indent)))
+ (and (looking-at "[ \t]*\\_<do\\_>")
+ (not (js2-re-search-forward
+ "\\_<while\\_>" (point-at-eol) t))
+ (= (current-indentation) saved-indent))))))))
+
+(defun js2-multiline-decl-indentation ()
+ "Return the declaration indentation column if the current line belongs
+to a multiline declaration statement. See
`js2-pretty-multiline-declarations'."
+ (let (forward-sexp-function ; use Lisp version
+ at-opening-bracket)
+ (save-excursion
+ (back-to-indentation)
+ (when (not (looking-at js2-declaration-keyword-re))
+ (when (looking-at js2-indent-operator-re)
+ (goto-char (match-end 0))) ; continued expressions are ok
+ (while (and (not at-opening-bracket)
+ (not (bobp))
+ (let ((pos (point)))
+ (save-excursion
+ (js2-backward-sws)
+ (or (eq (char-before) ?,)
+ (and (not (eq (char-before) ?\;))
+ (prog2 (skip-syntax-backward ".")
+ (looking-at js2-indent-operator-re)
+ (js2-backward-sws))
+ (not (eq (char-before) ?\;)))
+ (js2-same-line pos)))))
+ (condition-case _
+ (backward-sexp)
+ (scan-error (setq at-opening-bracket t))))
+ (when (looking-at js2-declaration-keyword-re)
+ (goto-char (match-end 0))
+ (1+ (current-column)))))))
+
+(defun js2-ctrl-statement-indentation ()
+ "Return the proper indentation of current line if it is a control statement.
+Returns an indentation if this line starts the body of a control
+statement without braces, else returns nil."
+ (let (forward-sexp-function)
+ (save-excursion
+ (back-to-indentation)
+ (when (and (not (js2-same-line (point-min)))
+ (not (looking-at "{"))
+ (js2-re-search-backward "[[:graph:]]" nil t)
+ (not (looking-at "[{([]"))
+ (progn
+ (forward-char)
+ (when (= (char-before) ?\))
+ ;; scan-sexps sometimes throws an error
+ (ignore-errors (backward-sexp))
+ (skip-chars-backward " \t" (point-at-bol)))
+ (let ((pt (point)))
+ (back-to-indentation)
+ (when (looking-at "}[ \t]*")
+ (goto-char (match-end 0)))
+ (and (looking-at js2-possibly-braceless-keywords-re)
+ (= (match-end 0) pt)
+ (not (js2-end-of-do-while-loop-p))))))
+ (+ (current-indentation) js2-basic-offset)))))
+
+(defun js2-indent-in-array-comp (parse-status)
+ "Return non-nil if we think we're in an array comprehension.
+In particular, return the buffer position of the first `for' kwd."
+ (let ((bracket (nth 1 parse-status))
+ (end (point)))
+ (when bracket
+ (save-excursion
+ (goto-char bracket)
+ (when (looking-at "\\[")
+ (forward-char 1)
+ (js2-forward-sws)
+ (if (looking-at "[[{]")
+ (let (forward-sexp-function) ; use Lisp version
+ (forward-sexp) ; skip destructuring form
+ (js2-forward-sws)
+ (if (and (/= (char-after) ?,) ; regular array
+ (looking-at "for"))
+ (match-beginning 0)))
+ ;; to skip arbitrary expressions we need the parser,
+ ;; so we'll just guess at it.
+ (if (and (> end (point)) ; not empty literal
+ (re-search-forward "[^,]]* \\(for\\) " end t)
+ ;; not inside comment or string literal
+ (let ((state (parse-partial-sexp bracket (point))))
+ (not (or (nth 3 state) (nth 4 state)))))
+ (match-beginning 1))))))))
+
+(defun js2-array-comp-indentation (parse-status for-kwd)
+ (if (js2-same-line for-kwd)
+ ;; first continuation line
+ (save-excursion
+ (goto-char (nth 1 parse-status))
+ (forward-char 1)
+ (skip-chars-forward " \t")
+ (current-column))
+ (save-excursion
+ (goto-char for-kwd)
+ (current-column))))
+
+(defun js2-maybe-goto-declaration-keyword-end (bracket)
+ "Helper function for `js2-proper-indentation'.
+Depending on the value of `js2-pretty-multiline-declarations',
+move point to the end of a variable declaration keyword so that
+indentation is aligned to that column."
+ (cond
+ ((eq js2-pretty-multiline-declarations 'all)
+ (when (looking-at js2-declaration-keyword-re)
+ (goto-char (1+ (match-end 0)))))
+ ((eq js2-pretty-multiline-declarations 'dynamic)
+ (let (declaration-keyword-end
+ at-closing-bracket-p
+ comma-p)
+ (when (looking-at js2-declaration-keyword-re)
+ ;; Preserve the match data lest it somehow be overridden.
+ (setq declaration-keyword-end (match-end 0))
+ (save-excursion
+ (goto-char bracket)
+ (setq at-closing-bracket-p
+ ;; Handle scan errors gracefully.
+ (condition-case nil
+ (progn
+ ;; Use the regular `forward-sexp-function' because the
+ ;; normal one for this mode uses the AST.
+ (let (forward-sexp-function)
+ (forward-sexp))
+ t)
+ (error nil)))
+ (when at-closing-bracket-p
+ (js2-forward-sws)
+ (setq comma-p (looking-at-p ","))))
+ (when comma-p
+ (goto-char (1+ declaration-keyword-end))))))))
+
+(cl-defun js2-proper-indentation (parse-status)
+ "Return the proper indentation for the current line."
+ (save-excursion
+ (back-to-indentation)
+ (when (nth 4 parse-status)
+ (cl-return-from js2-proper-indentation (js2--comment-indent
parse-status)))
+ (let* ((at-closing-bracket (looking-at "[]})]"))
+ (same-indent-p (or at-closing-bracket
+ (looking-at "\\_<case\\_>[^:]")
+ (and (looking-at "\\_<default:")
+ (save-excursion
+ (js2-backward-sws)
+ (not (memq (char-before) '(?, ?{)))))))
+ (continued-expr-p (js2-continued-expression-p))
+ (declaration-indent (and js2-pretty-multiline-declarations
+ (js2-multiline-decl-indentation)))
+ (bracket (nth 1 parse-status))
+ beg indent)
+ (cond
+ ;; indent array comprehension continuation lines specially
+ ((and bracket
+ (>= js2-language-version 170)
+ (not (js2-same-line bracket))
+ (setq beg (js2-indent-in-array-comp parse-status))
+ (>= (point) (save-excursion
+ (goto-char beg)
+ (point-at-bol)))) ; at or after first loop?
+ (js2-array-comp-indentation parse-status beg))
+
+ ((js2-ctrl-statement-indentation))
+
+ ((and declaration-indent continued-expr-p)
+ (+ declaration-indent js2-basic-offset))
+
+ (declaration-indent)
+
+ (bracket
+ (goto-char bracket)
+ (cond
+ ((looking-at "[({[][ \t]*\\(/[/*]\\|$\\)")
+ (when (save-excursion (skip-chars-backward " \t)")
+ (looking-at ")"))
+ (backward-list))
+ (back-to-indentation)
+ (js2-maybe-goto-declaration-keyword-end bracket)
+ (setq indent
+ (cond (same-indent-p
+ (current-column))
+ (continued-expr-p
+ (+ (current-column) (* 2 js2-basic-offset)))
+ (t
+ (+ (current-column) js2-basic-offset))))
+ (if (and js2-indent-switch-body
+ (not at-closing-bracket)
+ (looking-at "\\_<switch\\_>"))
+ (+ indent js2-basic-offset)
+ indent))
+ (t
+ (unless same-indent-p
+ (forward-char)
+ (skip-chars-forward " \t"))
+ (current-column))))
+
+ (continued-expr-p js2-basic-offset)
+
+ (t 0)))))
+
+(defun js2--comment-indent (parse-status)
+ "Indentation inside a multi-line block comment continuation line."
+ (save-excursion
+ (goto-char (nth 8 parse-status))
+ (if (looking-at "/\\*")
+ (+ 1 (current-column))
+ 0)))
+
+(defun js2-indent-line (&optional bounce-backwards)
+ "Indent the current line as JavaScript source text."
+ (interactive)
+ (let (parse-status offset
+ ;; Don't whine about errors/warnings when we're indenting.
+ ;; This has to be set before calling parse-partial-sexp below.
+ (inhibit-point-motion-hooks t))
+ (setq parse-status (save-excursion
+ (syntax-ppss (point-at-bol)))
+ offset (- (point) (save-excursion
+ (back-to-indentation)
+ (point))))
+ ;; Don't touch multiline strings.
+ (unless (nth 3 parse-status)
+ (indent-line-to (js2-proper-indentation parse-status))
+ (when (cl-plusp offset)
+ (forward-char offset)))))
+
+(provide 'js2-old-indent)
+
+;;; js2-old-indent.el ends here
diff --git a/packages/js2-mode/tests/indent.el
b/packages/js2-mode/tests/indent.el
index affbd58..27b6c5a 100644
--- a/packages/js2-mode/tests/indent.el
+++ b/packages/js2-mode/tests/indent.el
@@ -22,23 +22,27 @@
(require 'ert)
(require 'js2-mode)
(require 'cl-lib)
+(require 'js2-old-indent)
-(defun js2-test-indent (content)
+(defun js2-test-indent (content keep-indent)
(let ((s (replace-regexp-in-string "^ *|" "" content)))
(with-temp-buffer
- (insert (replace-regexp-in-string "^ *" "" s))
+ (insert
+ (if keep-indent
+ s
+ (replace-regexp-in-string "^ *" "" s)))
(js2-mode)
(indent-region (point-min) (point-max))
(should (string= s (buffer-substring-no-properties
(point-min) (point)))))))
-(cl-defmacro js2-deftest-indent (name content &key bind)
+(cl-defmacro js2-deftest-indent (name content &key bind keep-indent)
`(ert-deftest ,(intern (format "js2-%s" name)) ()
(let ,(append '((js2-basic-offset 2)
(js2-pretty-multiline-declarations t)
(inhibit-point-motion-hooks t))
bind)
- (js2-test-indent ,content))))
+ (js2-test-indent ,content ,keep-indent))))
(put 'js2-deftest-indent 'lisp-indent-function 'defun)
@@ -102,3 +106,37 @@
| default: 'donkey',
| tee: 'ornery'
|};")
+
+(js2-deftest-indent multiline-string-noop
+ "`multiline string
+ | contents
+ | are kept
+ | unchanged!`"
+ :keep-indent t)
+
+(js2-deftest-indent no-multiline-decl-first-arg-function-dynamic
+ "var foo = function() {
+ | return 7;
+ |};"
+ :bind ((js2-pretty-multiline-declarations 'dynamic)))
+
+(js2-deftest-indent multiline-decl-first-arg-function-indent-dynamic
+ "var foo = function() {
+ | return 7;
+ | },
+ | bar = 8;"
+ :bind ((js2-pretty-multiline-declarations 'dynamic)))
+
+(js2-deftest-indent multiline-decl-first-arg-function-indent-dynamic-comment
+ "var foo = function() {
+ | return 7;
+ | }/* MUAHAHAHA, ah ha! */,
+ | bar = 8;"
+ :bind ((js2-pretty-multiline-declarations 'dynamic)))
+
+(js2-deftest-indent multiline-decl-first-arg-function-indent-dynamic-scan-error
+ "var foo = function() {
+ | return 7;
+ | ,
+ | bar = 8;"
+ :bind ((js2-pretty-multiline-declarations 'dynamic)))
diff --git a/packages/js2-mode/tests/navigation.el
b/packages/js2-mode/tests/navigation.el
new file mode 100644
index 0000000..d7a8314
--- /dev/null
+++ b/packages/js2-mode/tests/navigation.el
@@ -0,0 +1,60 @@
+;;; tests/navigation.el --- Some tests for js2-mode.
+
+;; Copyright (C) 2009, 2011-2015 Free Software Foundation, Inc.
+
+;; 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 'ert)
+(require 'js2-mode)
+
+(cl-defun js2-navigation-helper (buffer-content &optional expected-point
(point-offset 1))
+ (with-temp-buffer
+ (insert buffer-content)
+ (let ((start-point (or (- (point) point-offset))))
+ (js2-mode)
+ (goto-char start-point)
+ (ignore-errors (js2-jump-to-definition))
+ (print (format "%d %d" (point) start-point))
+ (should (= (point) (or expected-point start-point))))))
+
+(ert-deftest js2-jump-to-var ()
+ (js2-navigation-helper "var soup = 2; soup" 5))
+
+(ert-deftest js2-jump-to-function ()
+ (js2-navigation-helper "function aFunction() {}; aFunction" 1))
+
+(ert-deftest js2-jump-to-function-parameters ()
+ (js2-navigation-helper "var p1 = 4; function aFunction(p1, p2) {p1};" 32 4))
+
+(ert-deftest js2-jump-to-object-property ()
+ (js2-navigation-helper "var aObject = {prop1: 3, prop2: \"hello\"};
aObject.prop1" 16))
+
+(ert-deftest js2-no-jump-to-object-property ()
+ (js2-navigation-helper "var aObject = {prop1: 3, prop2: \"hello\"};
anotherObject.prop1"))
+
+(ert-deftest js2-jump-to-nested-property ()
+ (js2-navigation-helper "var aObject = {prop1: {prop2: { prop3: 4}}};
aObject.prop1.prop2.prop3" 33))
+
+(ert-deftest js2-jump-to-object ()
+ (js2-navigation-helper "var aObject = {prop1: 3, prop2: \"hello\"};
aObject.prop1" 5 13))
+
+(ert-deftest js2-jump-to-property ()
+ (js2-navigation-helper "aObject.func = functon(){};aObject.func" 9))
+
+(ert-deftest js2-jump-to-property-object-property ()
+ (js2-navigation-helper "aObject.value = {prop:1};aObject.value.prop" 18))
diff --git a/packages/js2-mode/tests/parser.el
b/packages/js2-mode/tests/parser.el
index b4f2d8f..dc8c001 100644
--- a/packages/js2-mode/tests/parser.el
+++ b/packages/js2-mode/tests/parser.el
@@ -198,6 +198,18 @@ the test."
(js2-deftest-parse object-literal-computed-keys
"var x = {[Symbol.iterator]: function() {}};")
+(js2-deftest-parse object-literal-computed-function-keys
+ "var x = {[foo + bar](y) { return y;\n}};")
+
+(js2-deftest-parse object-literal-computed-getter-key
+ "var x = {get [foo + bar]() { return 42;\n}};")
+
+(js2-deftest-parse object-literal-generator
+ "var x = {*foo() { yield 42;\n}};")
+
+(js2-deftest-parse object-literal-computed-generator-key
+ "var x = {*[foo + bar]() { yield 42;\n}};")
+
;;; Function definition
(js2-deftest function-redeclaring-var "var gen = 3; function gen() {};"
@@ -214,12 +226,10 @@ the test."
"function foo(a = 1, b = a + 1) {\n}")
(js2-deftest-parse function-with-no-default-after-default
- "function foo(a = 1, b) {\n}"
- :syntax-error "b")
+ "function foo(a = 1, b) {\n}")
(js2-deftest-parse function-with-destruct-after-default
- "function foo(a = 1, {b, c}) {\n}"
- :syntax-error "{")
+ "function foo(a = 1, {b, c}) {\n}")
(js2-deftest-parse function-with-rest-parameter
"function foo(a, b, ...rest) {\n}")
@@ -235,6 +245,59 @@ the test."
(js2-deftest-parse function-with-rest-after-default-parameter
"function foo(a = 1, ...rest) {\n}")
+;;; Strict mode errors
+
+(js2-deftest-parse function-bad-strict-parameters
+ "'use strict';\nfunction foo(eval, {arguments}, bar) {\n}"
+ :syntax-error "eval" :errors-count 2)
+
+(js2-deftest-parse function-retroactive-bad-strict-parameters
+ "function foo(arguments) {'use strict';}"
+ :syntax-error "arguments" :errors-count 1)
+
+(js2-deftest-parse function-duplicate-strict-parameters
+ "'use strict';\nfunction foo(a, a) {\n}"
+ :syntax-error "a" :errors-count 1)
+
+(js2-deftest-parse function-bad-strict-function-name
+ "'use strict';\nfunction eval() {\n}"
+ :syntax-error "eval" :errors-count 1)
+
+(js2-deftest-parse function-bad-retroactive-strict-function-name
+ "function arguments() {'use strict';}"
+ :syntax-error "arguments" :errors-count 1)
+
+(js2-deftest-parse function-bad-strict-catch-name
+ "'use strict';\ntry {} catch (eval) {}"
+ :syntax-error "eval" :errors-count 1)
+
+(js2-deftest-parse function-bad-strict-variable-name
+ "'use strict';\nvar eval = 'kekeke';"
+ :syntax-error "eval" :errors-count 1)
+
+(js2-deftest-parse function-bad-strict-assignment
+ "'use strict';\narguments = 'fufufu';"
+ :syntax-error "arguments" :errors-count 1)
+
+(js2-deftest-parse function-property-strict-assignment
+ "'use strict';\narguments.okay = 'alright';")
+
+(js2-deftest-parse function-strict-with
+ "'use strict';\nwith ({}) {}"
+ :syntax-error "with" :errors-count 1)
+
+(js2-deftest-parse function-strict-octal
+ "'use strict';\nvar number = 0644;"
+ :syntax-error "0644" :errors-count 1)
+
+(js2-deftest-parse function-strict-duplicate-keys
+ "'use strict';\nvar object = {a: 1, a: 2, 'a': 3, ['a']: 4, 1: 5, '1': 6, [1
+ 1]: 7};"
+ :syntax-error "a" :errors-count 4) ; "a" has 3 dupes, "1" has 1 dupe.
+
+;; errors... or lackthereof.
+(js2-deftest-parse function-strict-const-scope
+ "'use strict';\nconst a;\nif (1) {\n const a;\n}")
+
;;; Spread operator
(js2-deftest-parse spread-in-array-literal
@@ -608,6 +671,16 @@ the test."
(should export-node)
(should (js2-export-node-default export-node))))
+(js2-deftest export-function-no-semicolon "export default function foo() {}"
+ (js2-mode)
+ (should (equal nil js2-parsed-warnings)))
+(js2-deftest export-default-function-no-semicolon "export function foo() {}"
+ (js2-mode)
+ (should (equal nil js2-parsed-warnings)))
+(js2-deftest export-anything-else-does-require-a-semicolon "export var obj =
{}"
+ (js2-mode)
+ (should (not (equal nil js2-parsed-warnings))))
+
(js2-deftest-parse parse-export-rexport "export * from 'other/lib';")
(js2-deftest-parse parse-export-export-named-list "export {foo, bar as bang};")
(js2-deftest-parse parse-re-export-named-list "export {foo, bar as bang} from
'other/lib';")
@@ -673,6 +746,9 @@ the test."
(js2-deftest-parse parse-super-keyword
"class Foo {\n constructor() { super(42);\n}\n foo() {
super.foo();\n}\n}")
+(js2-deftest-parse parse-class-keywordlike-method
+ "class C {\n delete() {}\n if() {}\n}")
+
;;; Scopes
(js2-deftest ast-symbol-table-includes-fn-node "function foo() {}"
@@ -696,6 +772,50 @@ the test."
(should (= (js2-symbol-decl-type var-entry) js2-VAR))
(should (js2-name-node-p (js2-symbol-ast-node var-entry)))))
+(defun js2-test-scope-of-nth-variable-satisifies-predicate (variable nth
predicate)
+ (goto-char (point-min))
+ (dotimes (n (1+ nth)) (search-forward variable))
+ (forward-char -1)
+ (let ((scope (js2-node-get-enclosing-scope (js2-node-at-point))))
+ (should (funcall predicate (js2-get-defining-scope scope variable)))))
+
+(js2-deftest for-node-is-declaration-scope "for (let i = 0; i; ++i) {};"
+ (js2-mode)
+ (js2-test-scope-of-nth-variable-satisifies-predicate "i" 0 #'js2-for-node-p))
+
+(js2-deftest const-scope-sloppy-script "{const a;} a;"
+ (js2-mode)
+ (js2-test-scope-of-nth-variable-satisifies-predicate "a" 0
#'js2-script-node-p)
+ (js2-test-scope-of-nth-variable-satisifies-predicate "a" 1
#'js2-script-node-p))
+
+(js2-deftest const-scope-strict-script "'use strict'; { const a; } a;"
+ (js2-mode)
+ (js2-test-scope-of-nth-variable-satisifies-predicate "a" 0
#'js2-block-node-p)
+ (js2-test-scope-of-nth-variable-satisifies-predicate "a" 1 #'null))
+
+(js2-deftest const-scope-sloppy-function "function f() { { const a; } a; }"
+ (js2-mode)
+ (js2-test-scope-of-nth-variable-satisifies-predicate "a" 0
#'js2-function-node-p)
+ (js2-test-scope-of-nth-variable-satisifies-predicate "a" 1
#'js2-function-node-p))
+
+(js2-deftest const-scope-strict-function "function f() { 'use strict'; { const
a; } a; }"
+ (js2-mode)
+ (js2-test-scope-of-nth-variable-satisifies-predicate "a" 0
#'js2-block-node-p)
+ (js2-test-scope-of-nth-variable-satisifies-predicate "a" 1 #'null))
+
+(js2-deftest array-comp-is-result-scope "[x * 2 for (x in y)];"
+ (js2-mode)
+ (js2-test-scope-of-nth-variable-satisifies-predicate "x" 0
#'js2-comp-loop-node-p))
+
+(js2-deftest array-comp-has-parent-scope
+ "var a,b=[for (i of [[1,2]]) for (j of i) j * a];"
+ (js2-mode)
+ (search-forward "for")
+ (forward-char -3)
+ (let ((node (js2-node-at-point)))
+ (should (js2-scope-parent-scope node))
+ (should (js2-get-defining-scope node "j"))))
+
;;; Tokenizer
(js2-deftest get-token "(1+1)"
@@ -766,3 +886,151 @@ the test."
(js2-deftest function-without-parens-error "function b {}"
;; Should finish the parse.
(js2-mode))
+
+;;; Comments
+
+(js2-deftest comment-node-length "//"
+ (js2-mode)
+ (let ((node (js2-node-at-point (point-min))))
+ (should (= (js2-node-len node) 2))))
+
+(js2-deftest comment-node-length-newline "//\n"
+ (js2-mode)
+ (let ((node (js2-node-at-point (point-min))))
+ (should (= (js2-node-len node) 3))))
+
+;;; Variables classification
+
+(defun js2--variables-summary (vars)
+ (let (r)
+ (setq vars (let (aslist)
+ (maphash (lambda (k v) (push (cons k v) aslist)) vars)
+ aslist))
+ (dolist (v (sort vars (lambda (a b) (< (js2-node-abs-pos
(js2-symbol-ast-node (car a)))
+ (js2-node-abs-pos (js2-symbol-ast-node
(car b)))))))
+ (let* ((symbol (car v))
+ (inition (cadr v))
+ (uses (cddr v))
+ (symn (js2-symbol-ast-node symbol))
+ (namen (js2--get-name-node symn)))
+ (push (format "address@hidden:%s"
+ (js2-symbol-name symbol)
+ (js2-node-abs-pos namen)
+ (if (eq inition ?P)
+ "P"
+ (if uses
+ (if inition "I" "N")
+ "U"))) r)
+ (dolist (u (sort (cddr v) (lambda (a b) (< (js2-node-abs-pos a)
+ (js2-node-abs-pos b)))))
+ (push (js2-node-abs-pos u) r))))
+ (reverse r)))
+
+(defmacro js2-deftest-classify-variables (name buffer-contents summary)
+ (declare (indent defun))
+ `(ert-deftest ,(intern (format "js2-classify-variables-%s" name)) ()
+ (with-temp-buffer
+ (save-excursion
+ (insert ,buffer-contents))
+ (unwind-protect
+ (progn
+ (js2-mode)
+ (should (equal ,summary (js2--variables-summary
+ (js2--classify-variables)))))
+ (fundamental-mode)))))
+
+(js2-deftest-classify-variables incomplete-var-statement
+ "var"
+ '())
+
+(js2-deftest-classify-variables unused-variable
+ "function foo () { var x; return 42; }"
+ '("address@hidden:U" "address@hidden:U"))
+
+(js2-deftest-classify-variables unused-variable-declared-twice
+ "function foo (a) { var x; function bar () { var x; x=42; }; return a;}"
+ '("address@hidden:U" "address@hidden:P" 68 "address@hidden:U"
"address@hidden:U" "address@hidden:U"))
+
+(js2-deftest-classify-variables assigned-variable
+ "function foo () { var x; x=42; return x; }"
+ '("address@hidden:U" "address@hidden:I" 39))
+
+(js2-deftest-classify-variables assignment-in-nested-function
+ "function foo () { var x; function bar () { x=42; }; }"
+ '("address@hidden:U" "address@hidden:U" "address@hidden:U"))
+
+(js2-deftest-classify-variables unused-nested-function
+ "function foo() { var i, j=1; function bar() { var x, y=42, z=i; return y; }
return i; }"
+ '("address@hidden:U" "address@hidden:N" 62 84 "address@hidden:U"
"address@hidden:U" "address@hidden:U" "address@hidden:I" 72 "address@hidden:U"))
+
+(js2-deftest-classify-variables prop-get-initialized
+ "function foo () { var x, y={}; y.a=x; }"
+ '("address@hidden:U" "address@hidden:N" 36 "address@hidden:I" 32))
+
+(js2-deftest-classify-variables prop-get-uninitialized
+ "function foo () { var x; if(x.foo) alert('boom'); }"
+ '("address@hidden:U" "address@hidden:N" 29))
+
+(js2-deftest-classify-variables prop-get-function-assignment
+ "(function(w) { w.f = function() { var a=42, m; return a; }; })(window);"
+ '("address@hidden:P" 11 16 "address@hidden:I" 55 "address@hidden:U"))
+
+(js2-deftest-classify-variables let-declaration
+ "function foo () { let x,y=1; return x; }"
+ '("address@hidden:U" "address@hidden:N" 37 "address@hidden:U"))
+
+(js2-deftest-classify-variables external-function-call
+ "function foo (m) { console.log(m, arguments); }"
+ '("address@hidden:U" "address@hidden:P" 32))
+
+(js2-deftest-classify-variables global-function-call
+ "function bar () { return 42; } function foo (a) { return bar(); }"
+ '("address@hidden:I" 58 "address@hidden:U" "address@hidden:P"))
+
+(js2-deftest-classify-variables let-declaration-for-scope
+ "function foo () { for(let x=1,y; x<y; y++) {} }"
+ '("address@hidden:U" "address@hidden:I" 34 "address@hidden:N" 36 39))
+
+(js2-deftest-classify-variables arguments-implicit-var
+ "function foo () { var p; for(p in arguments) { return p; } }"
+ '("address@hidden:U" "address@hidden:I" 55))
+
+(js2-deftest-classify-variables catch-error-variable
+ "function foo () { try { throw 'Foo'; } catch (e) { console.log(e); }"
+ '("address@hidden:U" "address@hidden:I" 64))
+
+(js2-deftest-classify-variables prop-get-assignment
+ "function foo () { var x={y:{z:{}}}; x.y.z=42; }"
+ '("address@hidden:U" "address@hidden:I" 37))
+
+(js2-deftest-classify-variables unused-function-argument
+ "function foo (a) { return 42; }"
+ '("address@hidden:U" "address@hidden:P"))
+
+(js2-deftest-classify-variables used-function-argument
+ "function foo (a) { a=42; return a; }"
+ '("address@hidden:U" "address@hidden:P" 33))
+
+(js2-deftest-classify-variables prop-get
+ "function foo (a) { a=navigator.x||navigator.y; return a; }"
+ '("address@hidden:U" "address@hidden:P" 55))
+
+(js2-deftest-classify-variables for-in-loop
+ "function foo () { var d={}; for(var k in d) {var v=d[k]; } }"
+ '("address@hidden:U" "address@hidden:I" 42 52 "address@hidden:I" 54
"address@hidden:U"))
+
+(js2-deftest-classify-variables array-comprehension-legacy
+ "function foo() { var j,a=[for (i of [1,2,3]) i*j]; }"
+ '("address@hidden:U" "address@hidden:N" 48 "address@hidden:U"
"address@hidden:I" 46))
+
+(js2-deftest-classify-variables array-comprehension
+ "function foo() { var j,a=[[i,j] for (i of [1,2,3])]; }"
+ '("address@hidden:U" "address@hidden:N" 30 "address@hidden:U"
"address@hidden:I" 28))
+
+(js2-deftest-classify-variables return-named-function
+ "function foo() { var a=42; return function bar() { return a; } }"
+ '("address@hidden:U" "address@hidden:I" 59 "address@hidden:I" 44))
+
+(js2-deftest-classify-variables named-wrapper-function
+ "function foo() { var a; (function bar() { a=42; })(); return a; }"
+ '("address@hidden:U" "address@hidden:I" 62 "address@hidden:I" 35))
diff --git a/packages/landmark/landmark.el b/packages/landmark/landmark.el
new file mode 100644
index 0000000..f3b5b8c
--- /dev/null
+++ b/packages/landmark/landmark.el
@@ -0,0 +1,1685 @@
+;;; landmark.el --- Neural-network robot that learns landmarks -*-
lexical-binding:t -*-
+
+;; Copyright (C) 1996-1997, 2000-2015 Free Software Foundation, Inc.
+
+;; Author: Terrence Brannon (was: <address@hidden>)
+;; Created: December 16, 1996 - first release to usenet
+;; Keywords: games, neural network, adaptive search, chemotaxis
+;; Maintainer: No maintainer - help wanted.
+;; Version: 1.0
+
+;; 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:
+
+;; To try this, just type: M-x landmark-test-run
+
+;; Landmark is a relatively non-participatory game in which a robot
+;; attempts to maneuver towards a tree at the center of the window
+;; based on unique olfactory cues from each of the 4 directions. If
+;; the smell of the tree increases, then the weights in the robot's
+;; brain are adjusted to encourage this odor-driven behavior in the
+;; future. If the smell of the tree decreases, the robots weights are
+;; adjusted to discourage a correct move.
+
+;; In laymen's terms, the search space is initially flat. The point
+;; of training is to "turn up the edges of the search space" so that
+;; the robot rolls toward the center.
+
+;; Further, do not become alarmed if the robot appears to oscillate
+;; back and forth between two or a few positions. This simply means
+;; it is currently caught in a local minimum and is doing its best to
+;; work its way out.
+
+;; The version of this program as described has a small problem. a
+;; move in a net direction can produce gross credit assignment. for
+;; example, if moving south will produce positive payoff, then, if in
+;; a single move, one moves east,west and south, then both east and
+;; west will be improved when they shouldn't
+
+;; Many thanks to Yuri Pryadkin <address@hidden> for this
+;; concise problem description.
+
+;;;_* Require
+(eval-when-compile (require 'cl-lib))
+
+;;;_* From Gomoku
+
+;;; Code:
+
+(defgroup landmark nil
+ "Neural-network robot that learns landmarks."
+ :prefix "landmark-"
+ :group 'games)
+
+;;;_ + THE BOARD.
+
+;; The board is a rectangular grid. We code empty squares with 0, X's with 1
+;; and O's with 6. The rectangle is recorded in a one dimensional vector
+;; containing padding squares (coded with -1). These squares allow us to
+;; detect when we are trying to move out of the board. We denote a square by
+;; its (X,Y) coords, or by the INDEX corresponding to them in the vector. The
+;; leftmost topmost square has coords (1,1) and index landmark-board-width + 2.
+;; Similarly, vectors between squares may be given by two DX, DY coords or by
+;; one DEPL (the difference between indexes).
+
+(defvar landmark-board-width nil
+ "Number of columns on the Landmark board.")
+(defvar landmark-board-height nil
+ "Number of lines on the Landmark board.")
+
+(defvar landmark-board nil
+ "Vector recording the actual state of the Landmark board.")
+
+(defvar landmark-vector-length nil
+ "Length of landmark-board vector.")
+
+(defvar landmark-draw-limit nil
+ ;; This is usually set to 70% of the number of squares.
+ "After how many moves will Emacs offer a draw?")
+
+(defvar landmark-cx 0
+ "This is the x coordinate of the center of the board.")
+
+(defvar landmark-cy 0
+ "This is the y coordinate of the center of the board.")
+
+(defvar landmark-m 0
+ "This is the x dimension of the playing board.")
+
+(defvar landmark-n 0
+ "This is the y dimension of the playing board.")
+
+
+(defun landmark-xy-to-index (x y)
+ "Translate X, Y cartesian coords into the corresponding board index."
+ (+ (* y landmark-board-width) x y))
+
+(defun landmark-index-to-x (index)
+ "Return corresponding x-coord of board INDEX."
+ (% index (1+ landmark-board-width)))
+
+(defun landmark-index-to-y (index)
+ "Return corresponding y-coord of board INDEX."
+ (/ index (1+ landmark-board-width)))
+
+(defun landmark-init-board ()
+ "Create the landmark-board vector and fill it with initial values."
+ (setq landmark-board (make-vector landmark-vector-length 0))
+ ;; Every square is 0 (i.e. empty) except padding squares:
+ (let ((i 0) (ii (1- landmark-vector-length)))
+ (while (<= i landmark-board-width) ; The squares in [0..width] and in
+ (aset landmark-board i -1) ; [length - width -
1..length - 1]
+ (aset landmark-board ii -1) ; are padding squares.
+ (setq i (1+ i)
+ ii (1- ii))))
+ (let ((i 0))
+ (while (< i landmark-vector-length)
+ (aset landmark-board i -1) ; and also all k*(width+1)
+ (setq i (+ i landmark-board-width 1)))))
+
+;;;_ + DISPLAYING THE BOARD.
+
+;; You may change these values if you have a small screen or if the squares
+;; look rectangular, but spacings SHOULD be at least 2 (MUST BE at least 1).
+
+(defconst landmark-square-width 2
+ "Horizontal spacing between squares on the Landmark board.")
+
+(defconst landmark-square-height 1
+ "Vertical spacing between squares on the Landmark board.")
+
+(defconst landmark-x-offset 3
+ "Number of columns between the Landmark board and the side of the window.")
+
+(defconst landmark-y-offset 1
+ "Number of lines between the Landmark board and the top of the window.")
+
+
+;;;_ + LANDMARK MODE AND KEYMAP.
+
+(defcustom landmark-mode-hook nil
+ "If non-nil, its value is called on entry to Landmark mode."
+ :type 'hook
+ :group 'landmark)
+
+(defvar landmark-mode-map
+ (let ((map (make-sparse-keymap)))
+ ;; Key bindings for cursor motion.
+ (define-key map "y" 'landmark-move-nw) ; y
+ (define-key map "u" 'landmark-move-ne) ; u
+ (define-key map "b" 'landmark-move-sw) ; b
+ (define-key map "n" 'landmark-move-se) ; n
+ (define-key map "h" 'backward-char) ; h
+ (define-key map "l" 'forward-char) ; l
+ (define-key map "j" 'landmark-move-down) ; j
+ (define-key map "k" 'landmark-move-up) ; k
+
+ (define-key map [kp-7] 'landmark-move-nw)
+ (define-key map [kp-9] 'landmark-move-ne)
+ (define-key map [kp-1] 'landmark-move-sw)
+ (define-key map [kp-3] 'landmark-move-se)
+ (define-key map [kp-4] 'backward-char)
+ (define-key map [kp-6] 'forward-char)
+ (define-key map [kp-2] 'landmark-move-down)
+ (define-key map [kp-8] 'landmark-move-up)
+
+ (define-key map "\C-n" 'landmark-move-down) ; C-n
+ (define-key map "\C-p" 'landmark-move-up) ; C-p
+
+ ;; Key bindings for entering Human moves.
+ (define-key map "X" 'landmark-human-plays) ; X
+ (define-key map "x" 'landmark-human-plays) ; x
+
+ (define-key map " " 'landmark-start-robot) ; SPC
+ (define-key map [down-mouse-1] 'landmark-start-robot)
+ (define-key map [drag-mouse-1] 'landmark-click)
+ (define-key map [mouse-1] 'landmark-click)
+ (define-key map [down-mouse-2] 'landmark-click)
+ (define-key map [mouse-2] 'landmark-mouse-play)
+ (define-key map [drag-mouse-2] 'landmark-mouse-play)
+
+ (define-key map [remap previous-line] 'landmark-move-up)
+ (define-key map [remap next-line] 'landmark-move-down)
+ (define-key map [remap beginning-of-line] 'landmark-beginning-of-line)
+ (define-key map [remap end-of-line] 'landmark-end-of-line)
+ (define-key map [remap undo] 'landmark-human-takes-back)
+ (define-key map [remap advertised-undo] 'landmark-human-takes-back)
+ map)
+ "Local keymap to use in Landmark mode.")
+
+
+
+(defvar landmark-emacs-won ()
+ "For making font-lock use the winner's face for the line.")
+
+(defface landmark-font-lock-face-O '((((class color)) :foreground "red")
+ (t :weight bold))
+ "Face to use for Emacs's O."
+ :version "22.1"
+ :group 'landmark)
+
+(defface landmark-font-lock-face-X '((((class color)) :foreground "green")
+ (t :weight bold))
+ "Face to use for your X."
+ :version "22.1"
+ :group 'landmark)
+
+(defvar landmark-font-lock-keywords
+ '(("O" . 'landmark-font-lock-face-O)
+ ("X" . 'landmark-font-lock-face-X)
+ ("[-|/\\]" 0 (if landmark-emacs-won
+ 'landmark-font-lock-face-O
+ 'landmark-font-lock-face-X)))
+ "Font lock rules for Landmark.")
+
+;; This one is for when they set view-read-only to t: Landmark cannot
+;; allow View Mode to be activated in its buffer.
+(define-derived-mode landmark-mode special-mode "Lm"
+ "Major mode for playing Lm against Emacs.
+You and Emacs play in turn by marking a free square. You mark it with X
+and Emacs marks it with O. The winner is the first to get five contiguous
+marks horizontally, vertically or in diagonal.
+
+You play by moving the cursor over the square you choose and hitting
\\[landmark-human-plays].
+
+Other useful commands:
+\\{landmark-mode-map}
+Entry to this mode calls the value of `landmark-mode-hook' if that value
+is non-nil. One interesting value is `turn-on-font-lock'."
+ (landmark-display-statistics)
+ (setq-local font-lock-defaults '(landmark-font-lock-keywords t))
+ (setq buffer-read-only t)
+ (add-hook 'post-command-hook #'landmark--intangible nil t))
+
+
+;;;_ + THE SCORE TABLE.
+
+
+;; Every (free) square has a score associated to it, recorded in the
+;; LANDMARK-SCORE-TABLE vector. The program always plays in the square having
+;; the highest score.
+
+(defvar landmark-score-table nil
+ "Vector recording the actual score of the free squares.")
+
+
+;; The key point point about the algorithm is that, rather than considering
+;; the board as just a set of squares, we prefer to see it as a "space" of
+;; internested 5-tuples of contiguous squares (called qtuples).
+;;
+;; The aim of the program is to fill one qtuple with its O's while preventing
+;; you from filling another one with your X's. To that effect, it computes a
+;; score for every qtuple, with better qtuples having better scores. Of
+;; course, the score of a qtuple (taken in isolation) is just determined by
+;; its contents as a set, i.e. not considering the order of its elements. The
+;; highest score is given to the "OOOO" qtuples because playing in such a
+;; qtuple is winning the game. Just after this comes the "XXXX" qtuple because
+;; not playing in it is just losing the game, and so on. Note that a
+;; "polluted" qtuple, i.e. one containing at least one X and at least one O,
+;; has score zero because there is no more any point in playing in it, from
+;; both an attacking and a defending point of view.
+;;
+;; Given the score of every qtuple, the score of a given free square on the
+;; board is just the sum of the scores of all the qtuples to which it belongs,
+;; because playing in that square is playing in all its containing qtuples at
+;; once. And it is that function which takes into account the internesting of
+;; the qtuples.
+;;
+;; This algorithm is rather simple but anyway it gives a not so dumb level of
+;; play. It easily extends to "n-dimensional Landmark", where a win should not
+;; be obtained with as few as 5 contiguous marks: 6 or 7 (depending on n !)
+;; should be preferred.
+
+
+;; Here are the scores of the nine "non-polluted" configurations. Tuning
+;; these values will change (hopefully improve) the strength of the program
+;; and may change its style (rather aggressive here).
+
+(defconst landmark-nil-score 7 "Score of an empty qtuple.")
+
+(defconst landmark-score-trans-table
+ (let ((Xscore 15) ; Score of a qtuple containing one X.
+ (XXscore 400) ; Score of a qtuple containing two X's.
+ (XXXscore 1800) ; Score of a qtuple containing three X's.
+ (XXXXscore 100000) ; Score of a qtuple containing four X's.
+ (Oscore 35) ; Score of a qtuple containing one O.
+ (OOscore 800) ; Score of a qtuple containing two O's.
+ (OOOscore 15000) ; Score of a qtuple containing three O's.
+ (OOOOscore 800000)) ; Score of a qtuple containing four O's.
+
+ ;; These values are not just random: if, given the following situation:
+ ;;
+ ;; . . . . . . . O .
+ ;; . X X a . . . X .
+ ;; . . . X . . . X .
+ ;; . . . X . . . X .
+ ;; . . . . . . . b .
+ ;;
+ ;; you want Emacs to play in "a" and not in "b", then the parameters must
+ ;; satisfy the inequality:
+ ;;
+ ;; 6 * XXscore > XXXscore + XXscore
+ ;;
+ ;; because "a" mainly belongs to six "XX" qtuples (the others are less
+ ;; important) while "b" belongs to one "XXX" and one "XX" qtuples.
+ ;; Other conditions are required to obtain sensible moves, but the
+ ;; previous example should illustrate the point. If you manage to
+ ;; improve on these values, please send me a note. Thanks.
+
+
+ ;; As we chose values 0, 1 and 6 to denote empty, X and O squares,
+ ;; the contents of a qtuple are uniquely determined by the sum of
+ ;; its elements and we just have to set up a translation table.
+ (vector landmark-nil-score Xscore XXscore XXXscore XXXXscore 0
+ Oscore 0 0 0 0 0
+ OOscore 0 0 0 0 0
+ OOOscore 0 0 0 0 0
+ OOOOscore 0 0 0 0 0
+ 0))
+ "Vector associating qtuple contents to their score.")
+
+
+;; If you do not modify drastically the previous constants, the only way for a
+;; square to have a score higher than OOOOscore is to belong to a "OOOO"
+;; qtuple, thus to be a winning move. Similarly, the only way for a square to
+;; have a score between XXXXscore and OOOOscore is to belong to a "XXXX"
+;; qtuple. We may use these considerations to detect when a given move is
+;; winning or losing.
+
+(defconst landmark-winning-threshold
+ (aref landmark-score-trans-table (+ 6 6 6 6)) ;; OOOOscore
+ "Threshold score beyond which an Emacs move is winning.")
+
+(defconst landmark-losing-threshold
+ (aref landmark-score-trans-table (+ 1 1 1 1)) ;; XXXXscore
+ "Threshold score beyond which a human move is winning.")
+
+
+(defun landmark-strongest-square ()
+ "Compute index of free square with highest score, or nil if none."
+ ;; We just have to loop other all squares. However there are two problems:
+ ;; 1/ The SCORE-TABLE only gives correct scores to free squares. To speed
+ ;; up future searches, we set the score of padding or occupied squares
+ ;; to -1 whenever we meet them.
+ ;; 2/ We want to choose randomly between equally good moves.
+ (let ((score-max 0)
+ (count 0) ; Number of equally good moves
+ (square (landmark-xy-to-index 1 1)) ; First square
+ (end (landmark-xy-to-index landmark-board-width
landmark-board-height))
+ best-square score)
+ (while (<= square end)
+ (cond
+ ;; If score is lower (i.e. most of the time), skip to next:
+ ((< (aref landmark-score-table square) score-max))
+ ;; If score is better, beware of non free squares:
+ ((> (setq score (aref landmark-score-table square)) score-max)
+ (if (zerop (aref landmark-board square)) ; is it free ?
+ (setq count 1 ; yes: take it !
+ best-square square
+ score-max score)
+ (aset landmark-score-table square -1))) ; no: kill it !
+ ;; If score is equally good, choose randomly. But first check freedom:
+ ((not (zerop (aref landmark-board square)))
+ (aset landmark-score-table square -1))
+ ((zerop (random (setq count (1+ count))))
+ (setq best-square square
+ score-max score)))
+ (setq square (1+ square))) ; try next square
+ best-square))
+
+;;;_ - INITIALIZING THE SCORE TABLE.
+
+;; At initialization the board is empty so that every qtuple amounts for
+;; nil-score. Therefore, the score of any square is nil-score times the number
+;; of qtuples that pass through it. This number is 3 in a corner and 20 if you
+;; are sufficiently far from the sides. As computing the number is time
+;; consuming, we initialize every square with 20*nil-score and then only
+;; consider squares at less than 5 squares from one side. We speed this up by
+;; taking symmetry into account.
+;; Also, as it is likely that successive games will be played on a board with
+;; same size, it is a good idea to save the initial SCORE-TABLE configuration.
+
+(defvar landmark-saved-score-table nil
+ "Recorded initial value of previous score table.")
+
+(defvar landmark-saved-board-width nil
+ "Recorded value of previous board width.")
+
+(defvar landmark-saved-board-height nil
+ "Recorded value of previous board height.")
+
+
+(defun landmark-init-score-table ()
+ "Create the score table vector and fill it with initial values."
+ (if (and landmark-saved-score-table ; Has it been stored last time ?
+ (= landmark-board-width landmark-saved-board-width)
+ (= landmark-board-height landmark-saved-board-height))
+ (setq landmark-score-table (copy-sequence landmark-saved-score-table))
+ ;; No, compute it:
+ (setq landmark-score-table
+ (make-vector landmark-vector-length (* 20 landmark-nil-score)))
+ (let (i j maxi maxj maxi2 maxj2)
+ (setq maxi (/ (1+ landmark-board-width) 2)
+ maxj (/ (1+ landmark-board-height) 2)
+ maxi2 (min 4 maxi)
+ maxj2 (min 4 maxj))
+ ;; We took symmetry into account and could use it more if the board
+ ;; would have been square and not rectangular !
+ ;; In our case we deal with all (i,j) in the set [1..maxi2]*[1..maxj] U
+ ;; [maxi2+1..maxi]*[1..maxj2]. Maxi2 and maxj2 are used because the
+ ;; board may well be less than 8 by 8 !
+ (setq i 1)
+ (while (<= i maxi2)
+ (setq j 1)
+ (while (<= j maxj)
+ (landmark-init-square-score i j)
+ (setq j (1+ j)))
+ (setq i (1+ i)))
+ (while (<= i maxi)
+ (setq j 1)
+ (while (<= j maxj2)
+ (landmark-init-square-score i j)
+ (setq j (1+ j)))
+ (setq i (1+ i))))
+ (setq landmark-saved-score-table (copy-sequence landmark-score-table)
+ landmark-saved-board-width landmark-board-width
+ landmark-saved-board-height landmark-board-height)))
+
+(defun landmark-nb-qtuples (i j)
+ "Return the number of qtuples containing square I,J."
+ ;; This function is complicated because we have to deal
+ ;; with ugly cases like 3 by 6 boards, but it works.
+ ;; If you have a simpler (and correct) solution, send it to me. Thanks !
+ (let ((left (min 4 (1- i)))
+ (right (min 4 (- landmark-board-width i)))
+ (up (min 4 (1- j)))
+ (down (min 4 (- landmark-board-height j))))
+ (+ -12
+ (min (max (+ left right) 3) 8)
+ (min (max (+ up down) 3) 8)
+ (min (max (+ (min left up) (min right down)) 3) 8)
+ (min (max (+ (min right up) (min left down)) 3) 8))))
+
+(defun landmark-init-square-score (i j)
+ "Give initial score to square I,J and to its mirror images."
+ (let ((ii (1+ (- landmark-board-width i)))
+ (jj (1+ (- landmark-board-height j)))
+ (sc (* (landmark-nb-qtuples i j) (aref landmark-score-trans-table 0))))
+ (aset landmark-score-table (landmark-xy-to-index i j) sc)
+ (aset landmark-score-table (landmark-xy-to-index ii j) sc)
+ (aset landmark-score-table (landmark-xy-to-index i jj) sc)
+ (aset landmark-score-table (landmark-xy-to-index ii jj) sc)))
+;;;_ - MAINTAINING THE SCORE TABLE.
+
+
+;; We do not provide functions for computing the SCORE-TABLE given the
+;; contents of the BOARD. This would involve heavy nested loops, with time
+;; proportional to the size of the board. It is better to update the
+;; SCORE-TABLE after each move. Updating needs not modify more than 36
+;; squares: it is done in constant time.
+
+(defun landmark-update-score-table (square dval)
+ "Update score table after SQUARE received a DVAL increment."
+ ;; The board has already been updated when this function is called.
+ ;; Updating scores is done by looking for qtuples boundaries in all four
+ ;; directions and then calling update-score-in-direction.
+ ;; Finally all squares received the right increment, and then are up to
+ ;; date, except possibly for SQUARE itself if we are taking a move back for
+ ;; its score had been set to -1 at the time.
+ (let* ((x (landmark-index-to-x square))
+ (y (landmark-index-to-y square))
+ (imin (max -4 (- 1 x)))
+ (jmin (max -4 (- 1 y)))
+ (imax (min 0 (- landmark-board-width x 4)))
+ (jmax (min 0 (- landmark-board-height y 4))))
+ (landmark-update-score-in-direction imin imax
+ square 1 0 dval)
+ (landmark-update-score-in-direction jmin jmax
+ square 0 1 dval)
+ (landmark-update-score-in-direction (max imin jmin) (min imax jmax)
+ square 1 1 dval)
+ (landmark-update-score-in-direction (max (- 1 y) -4
+ (- x landmark-board-width))
+ (min 0 (- x 5)
+ (- landmark-board-height y 4))
+ square -1 1 dval)))
+
+(defun landmark-update-score-in-direction (left right square dx dy dval)
+ "Update scores for all squares in the qtuples in range.
+That is, those between the LEFTth square and the RIGHTth after SQUARE,
+along the DX, DY direction, considering that DVAL has been added on SQUARE."
+ ;; We always have LEFT <= 0, RIGHT <= 0 and DEPL > 0 but we may very well
+ ;; have LEFT > RIGHT, indicating that no qtuple contains SQUARE along that
+ ;; DX,DY direction.
+ (cond
+ ((> left right)) ; Quit
+ (t ; Else ..
+ (let (depl square0 square1 square2 count delta)
+ (setq depl (landmark-xy-to-index dx dy)
+ square0 (+ square (* left depl))
+ square1 (+ square (* right depl))
+ square2 (+ square0 (* 4 depl)))
+ ;; Compute the contents of the first qtuple:
+ (setq square square0
+ count 0)
+ (while (<= square square2)
+ (setq count (+ count (aref landmark-board square))
+ square (+ square depl)))
+ (while (<= square0 square1)
+ ;; Update the squares of the qtuple beginning in SQUARE0 and ending
+ ;; in SQUARE2.
+ (setq delta (- (aref landmark-score-trans-table count)
+ (aref landmark-score-trans-table (- count dval))))
+ (cond ((not (zerop delta)) ; or else nothing to update
+ (setq square square0)
+ (while (<= square square2)
+ (if (zerop (aref landmark-board square)) ; only for free
squares
+ (aset landmark-score-table square
+ (+ (aref landmark-score-table square) delta)))
+ (setq square (+ square depl)))))
+ ;; Then shift the qtuple one square along DEPL, this only requires
+ ;; modifying SQUARE0 and SQUARE2.
+ (setq square2 (+ square2 depl)
+ count (+ count (- (aref landmark-board square0))
+ (aref landmark-board square2))
+ square0 (+ square0 depl)))))))
+
+;;;
+;;; GAME CONTROL.
+;;;
+
+;; Several variables are used to monitor a game, including a GAME-HISTORY (the
+;; list of all (SQUARE . PREVSCORE) played) that allows to take moves back
+;; (anti-updating the score table) and to compute the table from scratch in
+;; case of an interruption.
+
+(defvar landmark-game-in-progress nil
+ "Non-nil if a game is in progress.")
+
+(defvar landmark-game-history nil
+ "A record of all moves that have been played during current game.")
+
+(defvar landmark-number-of-moves nil
+ "Number of moves already played in current game.")
+
+(defvar landmark-number-of-human-moves nil
+ "Number of moves already played by human in current game.")
+
+(defvar landmark-emacs-played-first nil
+ "Non-nil if Emacs played first.")
+
+(defvar landmark-human-took-back nil
+ "Non-nil if Human took back a move during the game.")
+
+(defvar landmark-human-refused-draw nil
+ "Non-nil if Human refused Emacs offer of a draw.")
+
+(defvar landmark-emacs-is-computing nil
+ ;; This is used to detect interruptions. Hopefully, it should not be needed.
+ "Non-nil if Emacs is in the middle of a computation.")
+
+
+(defun landmark-start-game (n m)
+ "Initialize a new game on an N by M board."
+ (setq landmark-emacs-is-computing t) ; Raise flag
+ (setq landmark-game-in-progress t)
+ (setq landmark-board-width n
+ landmark-board-height m
+ landmark-vector-length (1+ (* (+ m 2) (1+ n)))
+ landmark-draw-limit (/ (* 7 n m) 10))
+ (setq landmark-emacs-won nil
+ landmark-game-history nil
+ landmark-number-of-moves 0
+ landmark-number-of-human-moves 0
+ landmark-emacs-played-first nil
+ landmark-human-took-back nil
+ landmark-human-refused-draw nil)
+ (landmark-init-display n m) ; Display first: the rest takes time
+ (landmark-init-score-table) ; INIT-BOARD requires that the score
+ (landmark-init-board) ; table be already created.
+ (setq landmark-emacs-is-computing nil))
+
+(defun landmark-play-move (square val &optional dont-update-score)
+ "Go to SQUARE, play VAL and update everything."
+ (setq landmark-emacs-is-computing t) ; Raise flag
+ (cond ((= 1 val) ; a Human move
+ (setq landmark-number-of-human-moves (1+
landmark-number-of-human-moves)))
+ ((zerop landmark-number-of-moves) ; an Emacs move. Is it first ?
+ (setq landmark-emacs-played-first t)))
+ (setq landmark-game-history
+ (cons (cons square (aref landmark-score-table square))
+ landmark-game-history)
+ landmark-number-of-moves (1+ landmark-number-of-moves))
+ (landmark-plot-square square val)
+ (aset landmark-board square val) ; *BEFORE* UPDATE-SCORE !
+ (if dont-update-score nil
+ (landmark-update-score-table square val) ; previous val was 0: dval = val
+ (aset landmark-score-table square -1))
+ (setq landmark-emacs-is-computing nil))
+
+(defun landmark-take-back ()
+ "Take back last move and update everything."
+ (setq landmark-emacs-is-computing t)
+ (let* ((last-move (car landmark-game-history))
+ (square (car last-move))
+ (oldval (aref landmark-board square)))
+ (if (= 1 oldval)
+ (setq landmark-number-of-human-moves (1-
landmark-number-of-human-moves)))
+ (setq landmark-game-history (cdr landmark-game-history)
+ landmark-number-of-moves (1- landmark-number-of-moves))
+ (landmark-plot-square square 0)
+ (aset landmark-board square 0) ; *BEFORE* UPDATE-SCORE !
+ (landmark-update-score-table square (- oldval))
+ (aset landmark-score-table square (cdr last-move)))
+ (setq landmark-emacs-is-computing nil))
+
+
+;;;_ + SESSION CONTROL.
+
+(defvar landmark-number-of-trials 0
+ "The number of times that landmark has been run.")
+
+(defvar landmark-sum-of-moves 0
+ "The total number of moves made in all games.")
+
+(defvar landmark-number-of-emacs-wins 0
+ "Number of games Emacs won in this session.")
+
+(defvar landmark-number-of-human-wins 0
+ "Number of games you won in this session.")
+
+(defvar landmark-number-of-draws 0
+ "Number of games already drawn in this session.")
+
+
+(defun landmark-terminate-game (result)
+ "Terminate the current game with RESULT."
+ (setq landmark-number-of-trials (1+ landmark-number-of-trials))
+ (setq landmark-sum-of-moves (+ landmark-sum-of-moves
landmark-number-of-moves))
+ (if (eq result 'crash-game)
+ (message
+ "Sorry, I have been interrupted and cannot resume that game..."))
+ (landmark-display-statistics)
+ ;;(ding)
+ (setq landmark-game-in-progress nil))
+
+(defun landmark-crash-game ()
+ "What to do when Emacs detects it has been interrupted."
+ (setq landmark-emacs-is-computing nil)
+ (landmark-terminate-game 'crash-game)
+ (sit-for 4) ; Let's see the message
+ (landmark-prompt-for-other-game))
+
+
+;;;_ + INTERACTIVE COMMANDS.
+
+(defun landmark-emacs-plays ()
+ "Compute Emacs next move and play it."
+ (interactive)
+ (landmark-switch-to-window)
+ (cond
+ (landmark-emacs-is-computing
+ (landmark-crash-game))
+ ((not landmark-game-in-progress)
+ (landmark-prompt-for-other-game))
+ (t
+ (message "Let me think...")
+ (let ((square (landmark-strongest-square))
+ score)
+ (cond ((null square)
+ (landmark-terminate-game 'nobody-won))
+ (t
+ (setq score (aref landmark-score-table square))
+ (landmark-play-move square 6)
+ (cond ((>= score landmark-winning-threshold)
+ (setq landmark-emacs-won t) ; for font-lock
+ (landmark-find-filled-qtuple square 6)
+ (landmark-terminate-game 'emacs-won))
+ ((zerop score)
+ (landmark-terminate-game 'nobody-won))
+ ((and (> landmark-number-of-moves landmark-draw-limit)
+ (not landmark-human-refused-draw)
+ (landmark-offer-a-draw))
+ (landmark-terminate-game 'draw-agreed))
+ (t
+ (landmark-prompt-for-move)))))))))
+
+;; For small square dimensions this is approximate, since though measured in
+;; pixels, event's (X . Y) is a character's top-left corner.
+(defun landmark-click (click)
+ "Position at the square where you click."
+ (interactive "e")
+ (and (windowp (posn-window (setq click (event-end click))))
+ (numberp (posn-point click))
+ (select-window (posn-window click))
+ (setq click (posn-col-row click))
+ (landmark-goto-xy
+ (min (max (/ (+ (- (car click)
+ landmark-x-offset
+ 1)
+ (window-hscroll)
+ landmark-square-width
+ (% landmark-square-width 2)
+ (/ landmark-square-width 2))
+ landmark-square-width)
+ 1)
+ landmark-board-width)
+ (min (max (/ (+ (- (cdr click)
+ landmark-y-offset
+ 1)
+ (count-lines (point-min) (window-start))
+ landmark-square-height
+ (% landmark-square-height 2)
+ (/ landmark-square-height 2))
+ landmark-square-height)
+ 1)
+ landmark-board-height))))
+
+(defun landmark-mouse-play (click)
+ "Play at the square where you click."
+ (interactive "e")
+ (if (landmark-click click)
+ (landmark-human-plays)))
+
+(defun landmark-human-plays ()
+ "Signal to the Landmark program that you have played.
+You must have put the cursor on the square where you want to play.
+If the game is finished, this command requests for another game."
+ (interactive)
+ (landmark-switch-to-window)
+ (cond
+ (landmark-emacs-is-computing
+ (landmark-crash-game))
+ ((not landmark-game-in-progress)
+ (landmark-prompt-for-other-game))
+ (t
+ (let ((square (landmark-point-square))
+ score)
+ (cond ((null square)
+ (error "Your point is not on a square. Retry!"))
+ ((not (zerop (aref landmark-board square)))
+ (error "Your point is not on a free square. Retry!"))
+ (t
+ (setq score (aref landmark-score-table square))
+ (landmark-play-move square 1)
+ (cond ((and (>= score landmark-losing-threshold)
+ ;; Just testing SCORE > THRESHOLD is not enough for
+ ;; detecting wins, it just gives an indication that
+ ;; we confirm with LANDMARK-FIND-FILLED-QTUPLE.
+ (landmark-find-filled-qtuple square 1))
+ (landmark-terminate-game 'human-won))
+ (t
+ (landmark-emacs-plays)))))))))
+
+(defun landmark-human-takes-back ()
+ "Signal to the Landmark program that you wish to take back your last move."
+ (interactive)
+ (landmark-switch-to-window)
+ (cond
+ (landmark-emacs-is-computing
+ (landmark-crash-game))
+ ((not landmark-game-in-progress)
+ (message "Too late for taking back...")
+ (sit-for 4)
+ (landmark-prompt-for-other-game))
+ ((zerop landmark-number-of-human-moves)
+ (message "You have not played yet... Your move?"))
+ (t
+ (message "One moment, please...")
+ ;; It is possible for the user to let Emacs play several consecutive
+ ;; moves, so that the best way to know when to stop taking back moves is
+ ;; to count the number of human moves:
+ (setq landmark-human-took-back t)
+ (let ((number landmark-number-of-human-moves))
+ (while (= number landmark-number-of-human-moves)
+ (landmark-take-back)))
+ (landmark-prompt-for-move))))
+
+(defun landmark-human-resigns ()
+ "Signal to the Landmark program that you may want to resign."
+ (interactive)
+ (landmark-switch-to-window)
+ (cond
+ (landmark-emacs-is-computing
+ (landmark-crash-game))
+ ((not landmark-game-in-progress)
+ (message "There is no game in progress"))
+ ((y-or-n-p "You mean, you resign? ")
+ (landmark-terminate-game 'human-resigned))
+ ((y-or-n-p "You mean, we continue? ")
+ (landmark-prompt-for-move))
+ (t
+ (landmark-terminate-game 'human-resigned)))) ; OK. Accept it
+
+;;;_ + PROMPTING THE HUMAN PLAYER.
+
+(defun landmark-prompt-for-move ()
+ "Display a message asking for Human's move."
+ (message (if (zerop landmark-number-of-human-moves)
+ "Your move? (move to a free square and hit X, RET ...)"
+ "Your move?")))
+
+(defun landmark-prompt-for-other-game ()
+ "Ask for another game, and start it."
+ (if (y-or-n-p "Another game? ")
+ (if (y-or-n-p "Retain learned weights ")
+ (landmark 2)
+ (landmark 1))
+ (message "Chicken!")))
+
+(defun landmark-offer-a-draw ()
+ "Offer a draw and return t if Human accepted it."
+ (or (y-or-n-p "I offer you a draw. Do you accept it? ")
+ (not (setq landmark-human-refused-draw t))))
+
+
+(defun landmark-max-width ()
+ "Largest possible board width for the current window."
+ (1+ (/ (- (window-width)
+ landmark-x-offset landmark-x-offset 1)
+ landmark-square-width)))
+
+(defun landmark-max-height ()
+ "Largest possible board height for the current window."
+ (1+ (/ (- (window-height)
+ landmark-y-offset landmark-y-offset 2)
+ ;; 2 instead of 1 because WINDOW-HEIGHT includes the mode line !
+ landmark-square-height)))
+
+(defun landmark-point-y ()
+ "Return the board row where point is."
+ (1+ (/ (- (count-lines (point-min) (point))
+ landmark-y-offset (if (bolp) 0 1))
+ landmark-square-height)))
+
+(defun landmark-point-square ()
+ "Return the index of the square point is on."
+ (landmark-xy-to-index (1+ (/ (- (current-column) landmark-x-offset)
+ landmark-square-width))
+ (landmark-point-y)))
+
+(defun landmark-goto-square (index)
+ "Move point to square number INDEX."
+ (landmark-goto-xy (landmark-index-to-x index) (landmark-index-to-y index)))
+
+(defun landmark-goto-xy (x y)
+ "Move point to square at X, Y coords."
+ (goto-char (point-min))
+ (forward-line (+ landmark-y-offset (* landmark-square-height (1- y))))
+ (move-to-column (+ landmark-x-offset (* landmark-square-width (1- x)))))
+
+(defun landmark-plot-square (square value)
+ "Draw 'X', 'O' or '.' on SQUARE depending on VALUE, leave point there."
+ (or (= value 1)
+ (landmark-goto-square square))
+ (let ((inhibit-read-only t))
+ (insert (cond ((= value 1) ?.)
+ ((= value 2) ?N)
+ ((= value 3) ?S)
+ ((= value 4) ?E)
+ ((= value 5) ?W)
+ ((= value 6) ?^)))
+
+ (and (zerop value)
+ (add-text-properties (1- (point)) (point)
+ '(mouse-face highlight
+ help-echo "\
+mouse-1: get robot moving, mouse-2: play on this square")))
+ (delete-char 1)
+ (backward-char 1))
+ (sit-for 0)) ; Display NOW
+
+(defun landmark-init-display (n m)
+ "Display an N by M Landmark board."
+ (buffer-disable-undo (current-buffer))
+ (let ((inhibit-read-only t)
+ (point (point-min)) opoint
+ (i m) j x)
+ ;; Try to minimize number of chars (because of text properties)
+ (setq tab-width
+ (if (zerop (% landmark-x-offset landmark-square-width))
+ landmark-square-width
+ (max (/ (+ (% landmark-x-offset landmark-square-width)
+ landmark-square-width 1) 2) 2)))
+ (erase-buffer)
+ (insert-char ?\n landmark-y-offset)
+ (while (progn
+ (setq j n
+ x (- landmark-x-offset landmark-square-width))
+ (while (>= (setq j (1- j)) 0)
+ (insert-char ?\t (/ (- (setq x (+ x landmark-square-width))
+ (current-column))
+ tab-width))
+ (insert-char ?\s (- x (current-column)))
+ (and (zerop j)
+ (= i (- m 2))
+ (progn
+ (while (>= i 3)
+ (append-to-buffer (current-buffer) opoint (point))
+ (setq i (- i 2)))
+ (goto-char (point-max))))
+ (setq point (point))
+ (insert ?=)
+ (add-text-properties point (point)
+ '(mouse-face highlight help-echo "\
+mouse-1: get robot moving, mouse-2: play on this square")))
+ (> (setq i (1- i)) 0))
+ (if (= i (1- m))
+ (setq opoint point))
+ (insert-char ?\n landmark-square-height))
+ (insert-char ?\n))
+ (landmark-goto-xy (/ (1+ n) 2) (/ (1+ m) 2)) ; center of the board
+ (sit-for 0)) ; Display NOW
+
+(defun landmark-display-statistics ()
+ "Obnoxiously display some statistics about previous games in mode line."
+ ;; We store this string in the mode-line-process local variable.
+ ;; This is certainly not the cleanest way out ...
+ (setq mode-line-process
+ (format ": Trials: %d, Avg#Moves: %d"
+ landmark-number-of-trials
+ (if (zerop landmark-number-of-trials)
+ 0
+ (/ landmark-sum-of-moves landmark-number-of-trials))))
+ (force-mode-line-update))
+
+(defun landmark-switch-to-window ()
+ "Find or create the Landmark buffer, and display it."
+ (interactive)
+ (let ((buff (get-buffer "*Landmark*")))
+ (if buff ; Buffer exists:
+ (switch-to-buffer buff) ; no problem.
+ (if landmark-game-in-progress
+ (landmark-crash-game)) ; buffer has been killed or
something
+ (switch-to-buffer "*Landmark*") ; Anyway, start anew.
+ (landmark-mode))))
+
+
+;;;_ + CROSSING WINNING QTUPLES.
+
+;; When someone succeeds in filling a qtuple, we draw a line over the five
+;; corresponding squares. One problem is that the program does not know which
+;; squares ! It only knows the square where the last move has been played and
+;; who won. The solution is to scan the board along all four directions.
+
+(defun landmark-find-filled-qtuple (square value)
+ "Return t if SQUARE belongs to a qtuple filled with VALUEs."
+ (or (landmark-check-filled-qtuple square value 1 0)
+ (landmark-check-filled-qtuple square value 0 1)
+ (landmark-check-filled-qtuple square value 1 1)
+ (landmark-check-filled-qtuple square value -1 1)))
+
+(defun landmark-check-filled-qtuple (square value dx dy)
+ "Return t if SQUARE belongs to a qtuple filled with VALUEs along DX, DY."
+ (let ((a 0) (b 0)
+ (left square) (right square)
+ (depl (landmark-xy-to-index dx dy)))
+ (while (and (> a -4) ; stretch tuple left
+ (= value (aref landmark-board (setq left (- left depl)))))
+ (setq a (1- a)))
+ (while (and (< b (+ a 4)) ; stretch tuple right
+ (= value (aref landmark-board (setq right (+ right depl)))))
+ (setq b (1+ b)))
+ (cond ((= b (+ a 4)) ; tuple length = 5 ?
+ (landmark-cross-qtuple (+ square (* a depl)) (+ square (* b depl))
+ dx dy)
+ t))))
+
+(defun landmark-cross-qtuple (square1 square2 dx dy)
+ "Cross every square between SQUARE1 and SQUARE2 in the DX, DY direction."
+ (save-excursion ; Not moving point from last square
+ (let ((depl (landmark-xy-to-index dx dy))
+ (inhibit-read-only t))
+ ;; WARNING: this function assumes DEPL > 0 and SQUARE2 > SQUARE1
+ (while (/= square1 square2)
+ (landmark-goto-square square1)
+ (setq square1 (+ square1 depl))
+ (cond
+ ((= dy 0) ; Horizontal
+ (forward-char 1)
+ (insert-char ?- (1- landmark-square-width) t)
+ (delete-region (point) (progn
+ (skip-chars-forward " \t")
+ (point))))
+ ((= dx 0) ; Vertical
+ (let ((landmark-n 1)
+ (column (current-column)))
+ (while (< landmark-n landmark-square-height)
+ (setq landmark-n (1+ landmark-n))
+ (forward-line 1)
+ (indent-to column)
+ (insert ?|))))
+ ((= dx -1) ; 1st Diagonal
+ (indent-to (prog1 (- (current-column) (/ landmark-square-width 2))
+ (forward-line (/ landmark-square-height 2))))
+ (insert ?/))
+ (t ; 2nd Diagonal
+ (indent-to (prog1 (+ (current-column) (/ landmark-square-width 2))
+ (forward-line (/ landmark-square-height 2))))
+ (insert ?\\))))))
+ (sit-for 0)) ; Display NOW
+
+
+;;;_ + CURSOR MOTION.
+
+(defvar-local landmark--last-pos 0)
+
+(defconst landmark--intangible-chars "- \t\n|/\\\\")
+
+(defun landmark--intangible ()
+ (when (or (eobp)
+ (save-excursion
+ (not (zerop (skip-chars-forward landmark--intangible-chars)))))
+ (if (<= landmark--last-pos (point)) ;Moving forward.
+ (progn
+ (skip-chars-forward landmark--intangible-chars)
+ (when (eobp)
+ (skip-chars-backward landmark--intangible-chars)
+ (forward-char -1)))
+ (skip-chars-backward landmark--intangible-chars)
+ (if (bobp)
+ (skip-chars-forward landmark--intangible-chars)
+ (forward-char -1))))
+ (setq landmark--last-pos (point)))
+
+;; previous-line and next-line don't work right with intangible newlines
+(defun landmark-move-down ()
+ "Move point down one row on the Landmark board."
+ (interactive)
+ (if (< (landmark-point-y) landmark-board-height)
+ (let ((col (current-column)))
+ (forward-line 1) ;;; landmark-square-height
+ (move-to-column col))))
+
+(defun landmark-move-up ()
+ "Move point up one row on the Landmark board."
+ (interactive)
+ (if (> (landmark-point-y) 1)
+ (let ((col (current-column)))
+ (forward-line (- landmark-square-height))
+ (move-to-column col))))
+
+(defun landmark-move-ne ()
+ "Move point North East on the Landmark board."
+ (interactive)
+ (landmark-move-up)
+ (forward-char))
+
+(defun landmark-move-se ()
+ "Move point South East on the Landmark board."
+ (interactive)
+ (landmark-move-down)
+ (forward-char))
+
+(defun landmark-move-nw ()
+ "Move point North West on the Landmark board."
+ (interactive)
+ (landmark-move-up)
+ (backward-char))
+
+(defun landmark-move-sw ()
+ "Move point South West on the Landmark board."
+ (interactive)
+ (landmark-move-down)
+ (backward-char))
+
+(defun landmark-beginning-of-line ()
+ "Move point to first square on the Landmark board row."
+ (interactive)
+ (move-to-column landmark-x-offset))
+
+(defun landmark-end-of-line ()
+ "Move point to last square on the Landmark board row."
+ (interactive)
+ (move-to-column (+ landmark-x-offset
+ (* landmark-square-width (1- landmark-board-width)))))
+
+
+;;;_ + Simulation variables
+
+;;;_ - landmark-nvar
+(defvar landmark-nvar 0.0075
+ "Not used.
+Affects a noise generator which was used in an earlier incarnation of
+this program to add a random element to the way moves were made.")
+;;;_ - lists of cardinal directions
+;;;_ :
+(defvar landmark-ns '(landmark-n landmark-s)
+ "Used when doing something relative to the north and south axes.")
+(defvar landmark-ew '(landmark-e landmark-w)
+ "Used when doing something relative to the east and west axes.")
+(defvar landmark-directions '(landmark-n landmark-s landmark-e landmark-w)
+ "The cardinal directions.")
+(defvar landmark-8-directions
+ '((landmark-n) (landmark-n landmark-w) (landmark-w) (landmark-s landmark-w)
+ (landmark-s) (landmark-s landmark-e) (landmark-e) (landmark-n landmark-e))
+ "The full 8 possible directions.")
+
+(defvar landmark-number-of-moves
+ "The number of moves made by the robot so far.")
+
+
+;;;_* Terry's mods to create lm.el
+
+;;;(setq landmark-debug nil)
+(defvar landmark-debug nil
+ "If non-nil, debugging is printed.")
+(defcustom landmark-one-moment-please nil
+ "If non-nil, print \"One moment please\" when a new board is generated.
+The drawback of this is you don't see how many moves the last run took
+because it is overwritten by \"One moment please\"."
+ :type 'boolean
+ :group 'landmark)
+(defcustom landmark-output-moves t
+ "If non-nil, output number of moves so far on a move-by-move basis."
+ :type 'boolean
+ :group 'landmark)
+
+
+(defun landmark-weights-debug ()
+ (if landmark-debug
+ (progn (landmark-print-wts) (landmark-blackbox)
(landmark-print-y-s-noise)
+ (landmark-print-smell))))
+
+;;;_ - Printing various things
+(defun landmark-print-distance-int (direction)
+ (interactive)
+ (insert (format "%S %S " direction (get direction 'distance))))
+
+
+(defun landmark-print-distance ()
+ (insert (format "tree: %S \n" (landmark-calc-distance-of-robot-from
'landmark-tree)))
+ (mapc 'landmark-print-distance-int landmark-directions))
+
+
+;;(setq direction 'landmark-n)
+;;(get 'landmark-n 'landmark-s)
+(defun landmark-nslify-wts-int (direction)
+ (mapcar (lambda (target-direction)
+ (get direction target-direction))
+ landmark-directions))
+
+
+(defun landmark-nslify-wts ()
+ (interactive)
+ (let ((l (apply 'append (mapcar 'landmark-nslify-wts-int
landmark-directions))))
+ (insert (format "set data_value WTS \n %s \n" l))
+ (insert (format "/* max: %S min: %S */"
+ (eval (cons 'max l)) (eval (cons 'min l))))))
+
+(defun landmark-print-wts-int (direction)
+ (mapc (lambda (target-direction)
+ (insert (format "%S %S %S "
+ direction
+ target-direction
+ (get direction target-direction))))
+ landmark-directions)
+ (insert "\n"))
+
+(defun landmark-print-wts ()
+ (interactive)
+ (with-current-buffer "*landmark-wts*"
+ (insert "==============================\n")
+ (mapc 'landmark-print-wts-int landmark-directions)))
+
+(defun landmark-print-moves (moves)
+ (interactive)
+ (with-current-buffer "*landmark-moves*"
+ (insert (format "%S\n" moves))))
+
+
+(defun landmark-print-y-s-noise-int (direction)
+ (insert (format "%S:landmark-y %S, s %S, noise %S \n"
+ (symbol-name direction)
+ (get direction 'y_t)
+ (get direction 's)
+ (get direction 'noise)
+ )))
+
+(defun landmark-print-y-s-noise ()
+ (interactive)
+ (with-current-buffer "*landmark-y,s,noise*"
+ (insert "==============================\n")
+ (mapc 'landmark-print-y-s-noise-int landmark-directions)))
+
+(defun landmark-print-smell-int (direction)
+ (insert (format "%S: smell: %S \n"
+ (symbol-name direction)
+ (get direction 'smell))))
+
+(defun landmark-print-smell ()
+ (interactive)
+ (with-current-buffer "*landmark-smell*"
+ (insert "==============================\n")
+ (insert (format "tree: %S \n" (get 'z 't)))
+ (mapc 'landmark-print-smell-int landmark-directions)))
+
+(defun landmark-print-w0-int (direction)
+ (insert (format "%S: w0: %S \n"
+ (symbol-name direction)
+ (get direction 'w0))))
+
+(defun landmark-print-w0 ()
+ (interactive)
+ (with-current-buffer "*landmark-w0*"
+ (insert "==============================\n")
+ (mapc 'landmark-print-w0-int landmark-directions)))
+
+(defun landmark-blackbox ()
+ (with-current-buffer "*landmark-blackbox*"
+ (insert "==============================\n")
+ (insert "I smell: ")
+ (mapc (lambda (direction)
+ (if (> (get direction 'smell) 0)
+ (insert (format "%S " direction))))
+ landmark-directions)
+ (insert "\n")
+
+ (insert "I move: ")
+ (mapc (lambda (direction)
+ (if (> (get direction 'y_t) 0)
+ (insert (format "%S " direction))))
+ landmark-directions)
+ (insert "\n")
+ (landmark-print-wts-blackbox)
+ (insert (format "z_t-z_t-1: %S" (- (get 'z 't) (get 'z 't-1))))
+ (landmark-print-distance)
+ (insert "\n")))
+
+(defun landmark-print-wts-blackbox ()
+ (interactive)
+ (mapc 'landmark-print-wts-int landmark-directions))
+
+;;;_ - learning parameters
+(defcustom landmark-bound 0.005
+ "The maximum that w0j may be."
+ :type 'number
+ :group 'landmark)
+(defcustom landmark-c 1.0
+ "A factor applied to modulate the increase in wij.
+Used in the function landmark-update-normal-weights."
+ :type 'number
+ :group 'landmark)
+(defcustom landmark-c-naught 0.5
+ "A factor applied to modulate the increase in w0j.
+Used in the function landmark-update-naught-weights."
+ :type 'number
+ :group 'landmark)
+(defvar landmark-initial-w0 0.0)
+(defvar landmark-initial-wij 0.0)
+(defcustom landmark-no-payoff 0
+ "The amount of simulation cycles that have occurred with no movement.
+Used to move the robot when he is stuck in a rut for some reason."
+ :type 'integer
+ :group 'landmark)
+(defcustom landmark-max-stall-time 2
+ "The maximum number of cycles that the robot can remain stuck in a place.
+After this limit is reached, landmark-random-move is called to push him out of
it."
+ :type 'integer
+ :group 'landmark)
+
+
+;;;_ + Randomizing functions
+;;;_ - landmark-flip-a-coin ()
+(defun landmark-flip-a-coin ()
+ (if (> (random 5000) 2500)
+ -1
+ 1))
+;;;_ : landmark-very-small-random-number ()
+;(defun landmark-very-small-random-number ()
+; (/
+; (* (/ (random 900000) 900000.0) .0001)))
+;;;_ : landmark-randomize-weights-for (direction)
+(defun landmark-randomize-weights-for (direction)
+ (mapc (lambda (target-direction)
+ (put direction
+ target-direction
+ (* (landmark-flip-a-coin) (/ (random 10000) 10000.0))))
+ landmark-directions))
+;;;_ : landmark-noise ()
+(defun landmark-noise ()
+ (* (- (/ (random 30001) 15000.0) 1) landmark-nvar))
+
+;;;_ : landmark-fix-weights-for (direction)
+(defun landmark-fix-weights-for (direction)
+ (mapc (lambda (target-direction)
+ (put direction
+ target-direction
+ landmark-initial-wij))
+ landmark-directions))
+
+
+;;;_ + Plotting functions
+;;;_ - landmark-plot-internal (sym)
+(defun landmark-plot-internal (sym)
+ (landmark-plot-square (landmark-xy-to-index
+ (get sym 'x)
+ (get sym 'y))
+ (get sym 'sym)))
+;;;_ - landmark-plot-landmarks ()
+(defun landmark-plot-landmarks ()
+ (setq landmark-cx (/ landmark-board-width 2))
+ (setq landmark-cy (/ landmark-board-height 2))
+
+ (put 'landmark-n 'x landmark-cx)
+ (put 'landmark-n 'y 1)
+ (put 'landmark-n 'sym 2)
+
+ (put 'landmark-tree 'x landmark-cx)
+ (put 'landmark-tree 'y landmark-cy)
+ (put 'landmark-tree 'sym 6)
+
+ (put 'landmark-s 'x landmark-cx)
+ (put 'landmark-s 'y landmark-board-height)
+ (put 'landmark-s 'sym 3)
+
+ (put 'landmark-w 'x 1)
+ (put 'landmark-w 'y (/ landmark-board-height 2))
+ (put 'landmark-w 'sym 5)
+
+ (put 'landmark-e 'x landmark-board-width)
+ (put 'landmark-e 'y (/ landmark-board-height 2))
+ (put 'landmark-e 'sym 4)
+
+ (mapc 'landmark-plot-internal '(landmark-n landmark-s landmark-e landmark-w
landmark-tree)))
+
+
+
+;;;_ + Distance-calculation functions
+
+;;;_ - distance (x x0 y y0)
+(defun landmark--distance (x x0 y y0)
+ (let ((dx (- x x0)) (dy (- y y0)))
+ (sqrt (+ (* dx dx) (* dy dy)))))
+
+;;;_ - landmark-calc-distance-of-robot-from (direction)
+(defun landmark-calc-distance-of-robot-from (direction)
+ (put direction 'distance
+ (landmark--distance (get direction 'x)
+ (landmark-index-to-x (landmark-point-square))
+ (get direction 'y)
+ (landmark-index-to-y (landmark-point-square)))))
+
+;;;_ - landmark-calc-smell-internal (sym)
+(defun landmark-calc-smell-internal (sym)
+ (let ((r (get sym 'r))
+ (d (landmark-calc-distance-of-robot-from sym)))
+ (if (> (* 0.5 (- 1 (/ d r))) 0)
+ (* 0.5 (- 1 (/ d r)))
+ 0)))
+
+
+;;;_ + Learning (neural) functions
+(defun landmark-f (x)
+ (cond
+ ((> x landmark-bound) landmark-bound)
+ ((< x 0.0) 0.0)
+ (t x)))
+
+(defun landmark-y (direction)
+ (put direction 'noise (landmark-noise))
+ (put direction 'y_t
+ (if (> (get direction 's) 0.0)
+ 1.0
+ 0.0)))
+
+(defun landmark-update-normal-weights (direction)
+ (mapc (lambda (target-direction)
+ (put direction target-direction
+ (+
+ (get direction target-direction)
+ (* landmark-c
+ (- (get 'z 't) (get 'z 't-1))
+ (get target-direction 'y_t)
+ (get direction 'smell)))))
+ landmark-directions))
+
+(defun landmark-update-naught-weights (direction)
+ (mapc (lambda (_target-direction)
+ (put direction 'w0
+ (landmark-f
+ (+
+ (get direction 'w0)
+ (* landmark-c-naught
+ (- (get 'z 't) (get 'z 't-1))
+ (get direction 'y_t))))))
+ landmark-directions))
+
+
+;;;_ + Statistics gathering and creating functions
+
+(defun landmark-calc-current-smells ()
+ (mapc (lambda (direction)
+ (put direction 'smell (landmark-calc-smell-internal direction)))
+ landmark-directions))
+
+(defun landmark-calc-payoff ()
+ (put 'z 't-1 (get 'z 't))
+ (put 'z 't (landmark-calc-smell-internal 'landmark-tree))
+ (if (= (- (get 'z 't) (get 'z 't-1)) 0.0)
+ (cl-incf landmark-no-payoff)
+ (setf landmark-no-payoff 0)))
+
+(defun landmark-store-old-y_t ()
+ (mapc (lambda (direction)
+ (put direction 'y_t-1 (get direction 'y_t)))
+ landmark-directions))
+
+
+;;;_ + Functions to move robot
+
+(defun landmark-confidence-for (target-direction)
+ (apply '+
+ (get target-direction 'w0)
+ (mapcar (lambda (direction)
+ (*
+ (get direction target-direction)
+ (get direction 'smell)))
+ landmark-directions)))
+
+
+(defun landmark-calc-confidences ()
+ (mapc (lambda (direction)
+ (put direction 's (landmark-confidence-for direction)))
+ landmark-directions))
+
+(defun landmark-move ()
+ (if (and (= (get 'landmark-n 'y_t) 1.0) (= (get 'landmark-s 'y_t) 1.0))
+ (progn
+ (mapc (lambda (dir) (put dir 'y_t 0)) landmark-ns)
+ (if landmark-debug
+ (message "n-s normalization."))))
+ (if (and (= (get 'landmark-w 'y_t) 1.0) (= (get 'landmark-e 'y_t) 1.0))
+ (progn
+ (mapc (lambda (dir) (put dir 'y_t 0)) landmark-ew)
+ (if landmark-debug
+ (message "e-w normalization"))))
+
+ (mapc (lambda (pair)
+ (when (> (get (car pair) 'y_t) 0)
+ (funcall (car (cdr pair)))
+ (landmark--intangible)))
+ '(
+ (landmark-n landmark-move-up)
+ (landmark-s landmark-move-down)
+ (landmark-e forward-char)
+ (landmark-w backward-char)))
+ (landmark-plot-square (landmark-point-square) 1)
+ (cl-incf landmark-number-of-moves)
+ (if landmark-output-moves
+ (message "Moves made: %d" landmark-number-of-moves)))
+
+
+(defun landmark-random-move ()
+ (mapc
+ (lambda (direction) (put direction 'y_t 0))
+ landmark-directions)
+ (dolist (direction (nth (random 8) landmark-8-directions))
+ (put direction 'y_t 1.0))
+ (landmark-move))
+
+(defun landmark-amble-robot ()
+ (interactive)
+ (while (> (landmark-calc-distance-of-robot-from 'landmark-tree) 0)
+
+ (landmark-store-old-y_t)
+ (landmark-calc-current-smells)
+
+ (if (> landmark-no-payoff landmark-max-stall-time)
+ (landmark-random-move)
+ (progn
+ (landmark-calc-confidences)
+ (mapc 'landmark-y landmark-directions)
+ (landmark-move)))
+
+ (landmark-calc-payoff)
+
+ (mapc 'landmark-update-normal-weights landmark-directions)
+ (mapc 'landmark-update-naught-weights landmark-directions)
+ (if landmark-debug
+ (landmark-weights-debug)))
+ (landmark-terminate-game nil))
+
+
+;;;_ - landmark-start-robot ()
+(defun landmark-start-robot ()
+ "Signal to the Landmark program that you have played.
+You must have put the cursor on the square where you want to play.
+If the game is finished, this command requests for another game."
+ (interactive)
+ (landmark-switch-to-window)
+ (cond
+ (landmark-emacs-is-computing
+ (landmark-crash-game))
+ ((not landmark-game-in-progress)
+ (landmark-prompt-for-other-game))
+ (t
+ (let ((square (landmark-point-square)))
+ (cond ((null square)
+ (error "Your point is not on a square. Retry!"))
+ ((not (zerop (aref landmark-board square)))
+ (error "Your point is not on a free square. Retry!"))
+ (t
+ (progn
+ (landmark-plot-square square 1)
+
+ (landmark-store-old-y_t)
+ (landmark-calc-current-smells)
+ (put 'z 't (landmark-calc-smell-internal 'landmark-tree))
+
+ (landmark-random-move)
+
+ (landmark-calc-payoff)
+
+ (mapc 'landmark-update-normal-weights landmark-directions)
+ (mapc 'landmark-update-naught-weights landmark-directions)
+ (landmark-amble-robot)
+ )))))))
+
+
+;;;_ + Misc functions
+;;;_ - landmark-init (auto-start save-weights)
+(defvar landmark-tree-r "")
+
+(defun landmark-init (auto-start save-weights)
+
+ (setq landmark-number-of-moves 0)
+
+ (landmark-plot-landmarks)
+
+ (if landmark-debug
+ (save-current-buffer
+ (set-buffer (get-buffer-create "*landmark-w0*"))
+ (erase-buffer)
+ (set-buffer (get-buffer-create "*landmark-moves*"))
+ (set-buffer (get-buffer-create "*landmark-wts*"))
+ (erase-buffer)
+ (set-buffer (get-buffer-create "*landmark-y,s,noise*"))
+ (erase-buffer)
+ (set-buffer (get-buffer-create "*landmark-smell*"))
+ (erase-buffer)
+ (set-buffer (get-buffer-create "*landmark-blackbox*"))
+ (erase-buffer)
+ (set-buffer (get-buffer-create "*landmark-distance*"))
+ (erase-buffer)))
+
+
+ (landmark-set-landmark-signal-strengths)
+
+ (dolist (direction landmark-directions)
+ (put direction 'y_t 0.0))
+
+ (if (not save-weights)
+ (progn
+ (mapc 'landmark-fix-weights-for landmark-directions)
+ (dolist (direction landmark-directions)
+ (put direction 'w0 landmark-initial-w0)))
+ (message "Weights preserved for this run."))
+
+ (if auto-start
+ (progn
+ (landmark-goto-xy (1+ (random landmark-board-width)) (1+ (random
landmark-board-height)))
+ (landmark-start-robot))))
+
+
+;;;_ - something which doesn't work
+; no-a-worka!!
+;(defun landmark-sum-list (list)
+; (if (> (length list) 0)
+; (+ (car list) (landmark-sum-list (cdr list)))
+; 0))
+; this a worka!
+; (eval (cons '+ list))
+;;;_ - landmark-set-landmark-signal-strengths ()
+;; on a screen higher than wide, I noticed that the robot would amble
+;; left and right and not move forward. examining *landmark-blackbox*
+;; revealed that there was no scent from the north and south
+;; landmarks, hence, they need less factoring down of the effect of
+;; distance on scent.
+
+(defun landmark-set-landmark-signal-strengths ()
+ (setq landmark-tree-r (* (sqrt (+ (* landmark-cx landmark-cx)
+ (* landmark-cy landmark-cy)))
+ 1.5))
+ (mapc (lambda (direction)
+ (put direction 'r (* landmark-cx 1.1)))
+ landmark-ew)
+ (mapc (lambda (direction)
+ (put direction 'r (* landmark-cy 1.1)))
+ landmark-ns)
+ (put 'landmark-tree 'r landmark-tree-r))
+
+
+;;;_ + landmark-test-run ()
+
+;;;###autoload
+(defalias 'landmark-repeat 'landmark-test-run)
+;;;###autoload
+(defun landmark-test-run ()
+ "Run 100 Landmark games, each time saving the weights from the previous
game."
+ (interactive)
+ (landmark 1)
+ (dotimes (_ 100)
+ (landmark 2)))
+
+;;;###autoload
+(defun landmark (parg)
+ "Start or resume an Landmark game.
+If a game is in progress, this command allows you to resume it.
+Here is the relation between prefix args and game options:
+
+prefix arg | robot is auto-started | weights are saved from last game
+---------------------------------------------------------------------
+none / 1 | yes | no
+ 2 | yes | yes
+ 3 | no | yes
+ 4 | no | no
+
+You start by moving to a square and typing \\[landmark-start-robot],
+if you did not use a prefix arg to ask for automatic start.
+Use \\[describe-mode] for more info."
+ (interactive "p")
+
+ (setf landmark-n nil landmark-m nil)
+ (landmark-switch-to-window)
+ (cond
+ (landmark-emacs-is-computing
+ (landmark-crash-game))
+ ((or (not landmark-game-in-progress)
+ (<= landmark-number-of-moves 2))
+ (let ((max-width (landmark-max-width))
+ (max-height (landmark-max-height)))
+ (or landmark-n (setq landmark-n max-width))
+ (or landmark-m (setq landmark-m max-height))
+ (cond ((< landmark-n 1)
+ (error "I need at least 1 column"))
+ ((< landmark-m 1)
+ (error "I need at least 1 row"))
+ ((> landmark-n max-width)
+ (error "I cannot display %d columns in that window" landmark-n)))
+ (if (and (> landmark-m max-height)
+ (not (eq landmark-m landmark-saved-board-height))
+ ;; Use EQ because SAVED-BOARD-HEIGHT may be nil
+ (not (y-or-n-p (format "Do you really want %d rows? "
landmark-m))))
+ (setq landmark-m max-height)))
+ (if landmark-one-moment-please
+ (message "One moment, please..."))
+ (landmark-start-game landmark-n landmark-m)
+ (eval (cons 'landmark-init
+ (cond
+ ((= parg 1) '(t nil))
+ ((= parg 2) '(t t))
+ ((= parg 3) '(nil t))
+ ((= parg 4) '(nil nil))
+ (t '(nil t))))))))
+
+
+;;;_ + Local variables
+
+;;; The following `allout-layout' local variable setting:
+;;; - closes all topics from the first topic to just before the third-to-last,
+;;; - shows the children of the third to last (config vars)
+;;; - and the second to last (code section),
+;;; - and closes the last topic (this local-variables section).
+;;;Local variables:
+;;;allout-layout: (0 : -1 -1 0)
+;;;End:
+
+(provide 'landmark)
+
+;;; landmark.el ends here
diff --git a/packages/let-alist/let-alist.el b/packages/let-alist/let-alist.el
deleted file mode 100644
index c490a9f..0000000
--- a/packages/let-alist/let-alist.el
+++ /dev/null
@@ -1,142 +0,0 @@
-;;; let-alist.el --- Easily let-bind values of an assoc-list by their names
-*- lexical-binding: t; -*-
-
-;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
-
-;; Author: Artur Malabarba <address@hidden>
-;; Maintainer: Artur Malabarba <address@hidden>
-;; Version: 1.0.3
-;; Keywords: extensions lisp
-;; Prefix: let-alist
-;; Separator: -
-
-;; 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 offers a single macro, `let-alist'. This macro takes a
-;; first argument (whose value must be an alist) and a body.
-;;
-;; The macro expands to a let form containing body, where each dotted
-;; symbol inside body is let-bound to their cdrs in the alist. Dotted
-;; symbol is any symbol starting with a `.'. Only those present in
-;; the body are let-bound and this search is done at compile time.
-;;
-;; For instance, the following code
-;;
-;; (let-alist alist
-;; (if (and .title .body)
-;; .body
-;; .site
-;; .site.contents))
-;;
-;; essentially expands to
-;;
-;; (let ((.title (cdr (assq 'title alist)))
-;; (.body (cdr (assq 'body alist)))
-;; (.site (cdr (assq 'site alist)))
-;; (.site.contents (cdr (assq 'contents (cdr (assq 'site alist))))))
-;; (if (and .title .body)
-;; .body
-;; .site
-;; .site.contents))
-;;
-;; If you nest `let-alist' invocations, the inner one can't access
-;; the variables of the outer one. You can, however, access alists
-;; inside the original alist by using dots inside the symbol, as
-;; displayed in the example above by the `.site.contents'.
-;;
-;;; Code:
-
-
-(defun let-alist--deep-dot-search (data)
- "Return alist of symbols inside DATA that start with a `.'.
-Perform a deep search and return an alist where each car is the
-symbol, and each cdr is the same symbol without the `.'."
- (cond
- ((symbolp data)
- (let ((name (symbol-name data)))
- (when (string-match "\\`\\." name)
- ;; Return the cons cell inside a list, so it can be appended
- ;; with other results in the clause below.
- (list (cons data (intern (replace-match "" nil nil name)))))))
- ((not (listp data)) nil)
- (t (apply #'append
- (mapcar #'let-alist--deep-dot-search data)))))
-
-(defun let-alist--access-sexp (symbol variable)
- "Return a sexp used to acess SYMBOL inside VARIABLE."
- (let* ((clean (let-alist--remove-dot symbol))
- (name (symbol-name clean)))
- (if (string-match "\\`\\." name)
- clean
- (let-alist--list-to-sexp
- (mapcar #'intern (nreverse (split-string name "\\.")))
- variable))))
-
-(defun let-alist--list-to-sexp (list var)
- "Turn symbols LIST into recursive calls to `cdr' `assq' on VAR."
- `(cdr (assq ',(car list)
- ,(if (cdr list) (let-alist--list-to-sexp (cdr list) var)
- var))))
-
-(defun let-alist--remove-dot (symbol)
- "Return SYMBOL, sans an initial dot."
- (let ((name (symbol-name symbol)))
- (if (string-match "\\`\\." name)
- (intern (replace-match "" nil nil name))
- symbol)))
-
-
-;;; The actual macro.
-;;;###autoload
-(defmacro let-alist (alist &rest body)
- "Let-bind dotted symbols to their cdrs in ALIST and execute BODY.
-Dotted symbol is any symbol starting with a `.'. Only those present
-in BODY are let-bound and this search is done at compile time.
-
-For instance, the following code
-
- (let-alist alist
- (if (and .title .body)
- .body
- .site
- .site.contents))
-
-essentially expands to
-
- (let ((.title (cdr (assq 'title alist)))
- (.body (cdr (assq 'body alist)))
- (.site (cdr (assq 'site alist)))
- (.site.contents (cdr (assq 'contents (cdr (assq 'site alist))))))
- (if (and .title .body)
- .body
- .site
- .site.contents))
-
-If you nest `let-alist' invocations, the inner one can't access
-the variables of the outer one. You can, however, access alists
-inside the original alist by using dots inside the symbol, as
-displayed in the example above."
- (declare (indent 1) (debug t))
- (let ((var (make-symbol "alist")))
- `(let ((,var ,alist))
- (let ,(mapcar (lambda (x) `(,(car x) ,(let-alist--access-sexp (car x)
var)))
- (delete-dups (let-alist--deep-dot-search body)))
- ,@body))))
-
-(provide 'let-alist)
-
-;;; let-alist.el ends here
diff --git a/packages/lex/lex.el b/packages/lex/lex.el
index bd84f58..6ba8123 100644
--- a/packages/lex/lex.el
+++ b/packages/lex/lex.el
@@ -1,6 +1,6 @@
;;; lex.el --- Lexical analyser construction -*- lexical-binding:t -*-
-;; Copyright (C) 2008,2013,2014 Free Software Foundation, Inc.
+;; Copyright (C) 2008,2013,2014,2015 Free Software Foundation, Inc.
;; Author: Stefan Monnier <address@hidden>
;; Keywords:
@@ -918,7 +918,15 @@ Returns a new NFA."
res))
+;;;###autoload
(defun lex-compile (alist)
+ "Compile a set of regular expressions.
+ALIST is a list of elements of the form (REGEXP . VALUE).
+The compiled automaton will match all those regexps at the same time
+and will return the VALUE fof the leftmost longest match.
+
+Each REGEXP object should be in the sexp form described in the
+Commentary section."
(lex--dfa-wrapper
(lambda ()
(let* ((lex--char-equiv-table
diff --git a/packages/load-relative/ChangeLog b/packages/load-relative/ChangeLog
index 5f20404..ff5aa1a 100644
--- a/packages/load-relative/ChangeLog
+++ b/packages/load-relative/ChangeLog
@@ -1,3 +1,8 @@
+2015-04-26 Stefan Monnier <address@hidden>
+
+ * load-relative.el (__FILE__): Mention the bytecomp-filename problem.
+ Fix other details mentioned by `checkdoc-current-buffer'.
+
2010-09-30 rocky <address@hidden>
* .gitignore: git Administrivia.
@@ -9,7 +14,7 @@
2010-09-30 rocky <address@hidden>
- * .gitignore, COPYING, Makefile.am, README, configure.ac:
+ * .gitignore, COPYING, Makefile.am, README, configure.ac:
Administrivia. Add COPYING, update README and .gitignore, bump
version number.
diff --git a/packages/load-relative/load-relative.el
b/packages/load-relative/load-relative.el
index a57748a..2c96135 100644
--- a/packages/load-relative/load-relative.el
+++ b/packages/load-relative/load-relative.el
@@ -26,12 +26,12 @@
;; Here we provide functions which facilitate writing multi-file Emacs
;; packages and facilitate running from the source tree without having
-;; to "install" code or fiddle with evil `load-path'. See
+;; to "install" code or fiddle with evil `load-path'. See
;; https://github.com/rocky/emacs-load-relative/wiki/NYC-Lisp-talk for
;; the the rationale behind this.
;;
;; The functions we add are relative versions of `load', `require' and
-;; `find-file-no-select' and versions which take list arguments. We also add a
+;; `find-file-no-select' and versions which take list arguments. We also add a
;; `__FILE__' function and a `provide-me' macro.
;; The latest version of this code is at:
@@ -39,13 +39,13 @@
;; `__FILE__' returns the file name that that the calling program is
;; running. If you are `eval''ing a buffer then the file name of that
-;; buffer is used. The name was selected to be analogous to the name
+;; buffer is used. The name was selected to be analogous to the name
;; used in C, Perl, Python, and Ruby.
;; `load-relative' loads an Emacs Lisp file relative to another
-;; (presumably currently running) Emacs Lisp file. For example suppose
+;; (presumably currently running) Emacs Lisp file. For example suppose
;; you have Emacs Lisp files "foo.el" and "bar.el" in the same
-;; directory. To load "bar.el" from inside Emacs lisp file "foo.el":
+;; directory. To load "bar.el" from inside Emacs Lisp file "foo.el":
;;
;; (require 'load-relative)
;; (load-relative "baz")
@@ -70,7 +70,7 @@
;; `load_relative'.
;;
;; Use `require-relative-list' when you have a list of files you want
-;; to `require'. To `require-relative' them all in one shot:
+;; to `require'. To `require-relative' them all in one shot:
;;
;; (require-relative-list '("dbgr-init" "dbgr-fringe"))
;;
@@ -83,9 +83,9 @@
;; the filename, but I consider that a good thing.
;;
;; The function `find-file-noselect-relative' provides a way of accessing
-;; resources which are located relative to the currently running Emacs lisp
-;; file. This is probably most useful when running Emacs as a scripting engine
-;; for batch processing or with tests cases. For example, this form will find
+;; resources which are located relative to the currently running Emacs Lisp
+;; file. This is probably most useful when running Emacs as a scripting engine
+;; for batch processing or with tests cases. For example, this form will find
;; the README file for this package.
;;
;; (find-file-noselect-relative "README.md")
@@ -110,15 +110,15 @@
"Return the string name of file/buffer that is currently begin executed.
The first approach for getting this information is perhaps the
-most pervasive and reliable. But it the most low-level and not
+most pervasive and reliable. But it the most low-level and not
part of a public API, so it might change in future
-implementations. This method uses the name that is recorded by
+implementations. This method uses the name that is recorded by
readevalloop of `lread.c' as the car of variable
`current-load-list'.
Failing that, we use `load-file-name' which should work in some
-subset of the same places that the first method works. However
-`load-file-name' will be nil for code that is eval'd. To cover
+subset of the same places that the first method works. However
+`load-file-name' will be nil for code that is eval'd. To cover
those cases, we try `buffer-file-name' which is initially
correct, for eval'd code, but will change and may be wrong if the
code sets or switches buffers after the initial execution.
@@ -158,6 +158,7 @@ methods work we will use the file-name value find via
;; When byte compiling. FIXME: use a more thorough precondition like
;; byte-compile-file is somehwere in the backtrace or that
;; bytecomp-filename comes from that routine?
+ ;; FIXME: `bytecomp-filename' doesn't exist any more (since Emacs-24.1).
((boundp 'bytecomp-filename) bytecomp-filename)
(t (symbol-file symbol)) ;; last resort
@@ -170,7 +171,7 @@ methods work we will use the file-name value find via
the process of being loaded or eval'd.
-Define FUNCTION to autoload from FILE. FUNCTION is a symbol.
+Define FUNCTION to autoload from FILE. FUNCTION is a symbol.
FILE is a string to pass to `load'.
@@ -232,7 +233,7 @@ in this buffer."
the process of being loaded or eval'd.
FILE-OR-LIST is either a string or a list of strings containing
-files that you want to loaded. If SYMBOL is given, the location of
+files that you want to loaded. If SYMBOL is given, the location of
of the file of where that was defined (as given by `symbol-file' is used
if other methods of finding __FILE__ don't work."
@@ -247,11 +248,13 @@ if other methods of finding __FILE__ don't work."
"Expand RELATIVE-FILE relative to the Emacs Lisp code that is in
the process of being loaded or eval'd.
-WARNING: it is best to to run this function before any
+WARNING: it is best to run this function before any
buffer-setting or buffer changing operations."
(let ((file (or opt-file (__FILE__) default-directory))
(prefix))
(unless file
+ ;; FIXME: Since default-directory should basically never be nil, this
+ ;; should basically never trigger!
(error "Can't expand __FILE__ here and no file name given"))
(setq prefix (file-name-directory file))
(expand-file-name (concat prefix relative-file))))
@@ -259,7 +262,7 @@ buffer-setting or buffer changing operations."
;;;###autoload
(defun require-relative (relative-file &optional opt-file opt-prefix)
"Run `require' on an Emacs Lisp file relative to the Emacs Lisp code
-that is in the process of being loaded or eval'd. The symbol used in require
+that is in the process of being loaded or eval'd. The symbol used in require
is the base file name (without directory or file extension) treated as a
symbol.
@@ -286,14 +289,13 @@ strings, each string being the relative name of file you
want to run."
;;;###autoload
(defmacro provide-me ( &optional prefix )
"Call `provide' with the feature's symbol name made from
-source-code's file basename sans extension. For example if you
+source-code's file basename sans extension. For example if you
write (provide-me) inside file ~/lisp/foo.el, this is the same as
writing: (provide 'foo).
With a prefix, that prefix is prepended to the `provide' So in
the previous example, if you write (provide-me \"bar-\") this is the
-same as writing (provide 'bar-foo)
-"
+same as writing (provide 'bar-foo)."
`(provide (intern (concat ,prefix (file-name-sans-extension
(file-name-nondirectory (__FILE__)))))))
diff --git a/packages/loccur/README.md b/packages/loccur/README.md
new file mode 100644
index 0000000..cea09cd
--- /dev/null
+++ b/packages/loccur/README.md
@@ -0,0 +1,50 @@
+# Loccur
+## Introduction
+**Loccur** is an amazing tool to quickly navigate in a file. It is a minor
mode for Emacs acting like **occur** but w/o creating a new window. It just
hides all the text excepting lines containing matches.
+## Installation
+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/";)))
+```
+
+Press `M-x` in GNU Emacs and write `list-packages`. Find the `loccur` in the
list of packages and press `i` to select this package, `x` to install the
package.
+
+
+## Screenshots
+Better to see it once:
+
+
+
+
+
+## Usage
+
+To use it, add the following to your .emacs file:
+
+```scheme
+(require 'loccur)
+;; defines shortcut for loccur of the current word
+(define-key global-map [(control o)] 'loccur-current)
+;; defines shortcut for the interactive loccur command
+(define-key global-map [(control meta o)] 'loccur)
+;; defines shortcut for the loccur of the previously found word
+(define-key global-map [(control shift o)] 'loccur-previous-match)
+```
+
+Now you can point the cursor to the word and press `Ctrl+o` to hide all lines
except those containing this word. Moving cursor to the required line and
pressing `Ctrl+o` again will shows all the text. The good thing about this mode
is what you can navigate through the buffer easily. `Ctrl+Shift+o` will repeat
last search.
+
+### Available commands
+Below is the list of interactive commands available for user:
+
+* `loccur` interactively asks user for regexp to search or toggle search off
(if `loccur-mode` is already enabled)
+* `loccur-current` searches for the current word under the cursor
+* `loccur-previous-match` repeat previous `loccur` command
+* `loccur-no-highlight` is the same as `loccur` but not highlighting matches
+* `loccur-toggle-highlight` toggles highlighting of matches
+
+### Customization
+* `loccur-jump-beginning-of-line` variable specifies if move the cursor to the
beginning of the matching line. Default `nil`
+* `loccur-highlight-matching-regexp` variable whenever `loccur` should
highlight matching words. Default `t`.
+* `loccur-face` face to be used while highlighting. Default points to
`isearch` face.
diff --git a/packages/loccur/loccur.el b/packages/loccur/loccur.el
new file mode 100644
index 0000000..2921ba0
--- /dev/null
+++ b/packages/loccur/loccur.el
@@ -0,0 +1,323 @@
+;;; loccur.el --- Perform an occur-like folding in current buffer -*-
lexical-binding: t; -*-
+
+;; Copyright (C) 2009-2016 Free Software Foundation, Inc
+;;
+;; Author: Alexey Veretennikov <address@hidden>
+;;
+;; Created: 2009-09-08
+;; Version: 1.2.2
+;; Package-Requires: ((cl-lib "0"))
+;; Keywords: matching
+;; URL: https://github.com/fourier/loccur
+;; Compatibility: GNU Emacs 23.x, 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:
+;;
+;; (require 'loccur)
+;; ;; defines shortcut for loccur of the current word
+;; (define-key global-map [(control o)] 'loccur-current)
+;; ;; defines shortcut for the interactive loccur command
+;; (define-key global-map [(control meta o)] 'loccur)
+;; ;; defines shortcut for the loccur of the previously found word
+;; (define-key global-map [(control shift o)] 'loccur-previous-match)
+;;
+;;; Issues:
+;; Using with smooth-scrolling.el sometimes
+;; gives unexpected jumps in loccur mode
+;;
+;;; TODO:
+;;
+;;; Change Log:
+;;
+;; 2015-12-27 (1.2.2)
+;; + Preparation for GNU ELPA submission. Removed contributions
+;; without signed papers
+;; + added loccur-face - face to highlight text, by default isearch
+;;
+;; 2013-10-22 (1.2.1)
+;; + Added custom option loccur-jump-beginning-of-line; removed some
+;; of cl dependencies
+;;
+;; 2010-03-07 (1.1.1)
+;; + Default value is taken from prompt instead of an edit area
+;; (thanks to Nathaniel Flath)
+;;
+;; 2009-10-05 (1.1.0)
+;; + Added highlighting of the matched strings
+;; + Now inserts selected region to the prompt
+;; + Added defun for applying last found regexp(loccur-previous-match)
+;; + Added intangible property together with invisibility
+;;
+;; 2009-09-08 (1.0.0)
+;; Initial Release.
+;;
+;;; Code:
+
+(require 'cl-lib)
+
+(defgroup loccur nil
+ "Perform an occur-like folding in current buffer."
+ :group 'tools)
+
+;; should be defined before define-minor-mode
+(defvar loccur-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "RET") '(lambda () (interactive) (loccur nil)))
+ ;; redefine Ctrl+Up/Down to Up/Down, since it looks like some problem
+ ;; with backward-paragraph and forward-paragraph with invisible overlays
+ (define-key map (kbd "<C-up>") 'previous-line)
+ (define-key map (kbd "<C-down>") 'next-line)
+ map)
+ "Keymap for the variable `loccur-mode'.")
+
+;;;###autoload
+(define-minor-mode loccur-mode
+ "Minor mode for navigating through the file.
+Hides all lines without matches like `occur' does, but without opening
+a new window."
+ :lighter " loccur"
+ (if loccur-mode
+ (loccur-1 loccur-current-search)
+ (loccur-remove-overlays)
+ (recenter)))
+
+(defface loccur-face
+ '((t (:inherit isearch)))
+ "Loccur face")
+
+
+(defconst loccur-overlay-invisible-property-name 'loccur-invisible-overlay
+ "Property name of the overlay for all invisible text.")
+
+(defconst loccur-overlay-visible-property-name 'loccur-visible-overlay
+ "Property name of the overlay for all visible text.")
+
+(defcustom loccur-jump-beginning-of-line nil
+ "Set cursor to the beginning of the line when the loccur function is called.
+Default: nil"
+ :type '(boolean)
+ :group 'loccur)
+
+(defcustom loccur-highlight-matching-regexp t
+ "If set to nil, do not highlight matching words.
+Default: t"
+ :type '(boolean)
+ :group 'loccur)
+
+(defvar loccur-history nil
+ "History of previously searched expressions for the prompt.")
+
+(defvar-local loccur-last-match nil
+ "Last match found.")
+
+(defvar-local loccur-overlay-list nil
+ "A list of currently active overlays.")
+
+(defvar-local loccur-current-search nil
+ "The expression to search in the current active mode.")
+
+(defun loccur-current ()
+ "Call `loccur' for the current word."
+ (interactive)
+ (loccur (current-word)))
+
+
+(defun loccur-previous-match ()
+ "Call `loccur' for the previously found word."
+ (interactive)
+ (loccur loccur-last-match))
+
+(defun loccur-no-highlight (regex)
+ "Perform search like loccur, but temporary removing match highlight.
+REGEX is regexp to search"
+ (interactive
+ (if loccur-mode
+ nil
+ (list (read-string "Loccur: " (loccur-prompt) 'loccur-history))))
+ (let ((loccur-highlight-matching-regexp nil))
+ (loccur regex)))
+
+(defun loccur-toggle-highlight ()
+ "Toggle the highlighting of the match."
+ (interactive)
+ (setq loccur-highlight-matching-regexp (not
loccur-highlight-matching-regexp))
+ (when loccur-mode
+ (dolist (ovl loccur-overlay-list)
+ (when (overlay-get ovl loccur-overlay-visible-property-name)
+ (overlay-put ovl 'face (if loccur-highlight-matching-regexp
'loccur-face nil))))))
+
+(defun loccur (regex)
+ "Perform a simple grep in current buffer.
+
+This command hides all lines from the current buffer except those
+containing the regular expression REGEX. A second call of the function
+unhides lines again"
+ (interactive
+ (if loccur-mode
+ (list nil)
+ (list (read-string "Loccur: " (loccur-prompt) 'loccur-history))))
+ (if (or loccur-mode
+ (= (length regex) 0))
+ (progn
+ ;; remove current search and turn off loccur mode
+ ;; to allow to call `loccur' multiple times
+ (setf loccur-current-search nil)
+ (loccur-mode 0))
+ ;; otherwise do as usual
+ ;; if the regex argument is not equal to previous search
+ (when (not (string-equal regex loccur-current-search))
+ (cl-pushnew regex loccur-history)
+ (setf loccur-current-search regex)
+ (loccur-mode)
+ (when loccur-jump-beginning-of-line
+ (beginning-of-line))))) ; optionally jump to the beginning of line
+
+
+(defun loccur-prompt ()
+ "Return the default value of the prompt.
+
+Default value for prompt is a current word or active region(selection),
+if its size is 1 line"
+ (let ((prompt
+ (if (and transient-mark-mode
+ mark-active)
+ (let ((pos1 (region-beginning))
+ (pos2 (region-end)))
+ ;; Check if the start and the end of an active region is on
+ ;; the same line
+ (when (save-excursion
+ (goto-char pos1)
+ (<= pos2 (line-end-position)))
+ (buffer-substring-no-properties pos1 pos2)))
+ (current-word))))
+ prompt))
+
+
+(defun loccur-1 (regex)
+ "Implementation of the `loccur' functionality.
+
+REGEX is an argument to `loccur'."
+ (let* ((buffer-matches (loccur-find-matches regex))
+ (ovl-bounds (loccur-create-overlay-bounds-btw-lines buffer-matches)))
+ (setq loccur-overlay-list
+ (loccur-create-invisible-overlays ovl-bounds))
+
+ (setq loccur-overlay-list
+ (append loccur-overlay-list
+ (loccur-create-highlighted-overlays buffer-matches)))
+ (setq loccur-last-match regex)
+ (recenter)))
+
+(defun loccur-create-highlighted-overlays (buffer-matches)
+ "Create the list of overlays for BUFFER-MATCHES."
+ (let ((overlays
+ (mapcar (lambda (match)
+ (make-overlay
+ (nth 1 match)
+ (nth 2 match)
+ (current-buffer) t nil))
+ buffer-matches)))
+ (mapc (lambda (ovl)
+ (overlay-put ovl loccur-overlay-visible-property-name t)
+ (when loccur-highlight-matching-regexp
+ (overlay-put ovl 'face 'loccur-face)))
+ overlays)))
+
+
+(defun loccur-create-invisible-overlays (ovl-bounds)
+ "Create a list of invisible overlays by given OVL-BOUNDS."
+ (let ((overlays
+ (mapcar (lambda (bnd)
+ (make-overlay
+ (car bnd)
+ (cadr bnd)
+ (current-buffer) t nil))
+ ovl-bounds)))
+ (mapc (lambda (ovl)
+ (overlay-put ovl loccur-overlay-invisible-property-name t)
+ (overlay-put ovl 'invisible t)
+ ;; force intangible property if invisible property
+ ;; does not automatically set it
+ (overlay-put ovl 'intangible t))
+ overlays)))
+
+
+(defun loccur-remove-overlays ()
+ "Remove all overlays."
+ (remove-overlays (point-min) (point-max)
loccur-overlay-visible-property-name t)
+ (remove-overlays (point-min) (point-max)
loccur-overlay-invisible-property-name t)
+ (setq loccur-overlay-list nil))
+
+
+(defun loccur-create-overlay-bounds-btw-lines (buffer-matches)
+ "Create a list of overlays between matched lines BUFFER-MATCHES."
+ (let ((prev-end (point-min))
+ (overlays (list)))
+ (when buffer-matches
+ (mapc (lambda (line)
+ (let ((beginning (car line)))
+ (unless ( = (- beginning prev-end) 1)
+ (let ((ovl-end (1- beginning)))
+ (push (list prev-end ovl-end) overlays)))
+ (setq prev-end (nth 3 line))))
+ buffer-matches)
+ (push (list (1+ prev-end) (point-max)) overlays)
+ (setq overlays (nreverse overlays)))))
+
+
+(defun loccur-find-matches (regex)
+ "Find all occurences in the current buffer for given REGEX.
+
+Returns a list of 4-number tuples, specifying begnning of the line,
+1st match begin of a line, 1st match end of a line, end of a line
+containing match"
+ (save-excursion
+ ;; Go to the beginnig of buffer
+ (goto-char (point-min))
+ ;; Set initial values for variables
+ (let ((endpoint nil)
+ (lines (list)))
+ ;; Search loop
+ (while (not (eobp))
+ ;; if something found
+ (when (setq endpoint (re-search-forward regex nil t))
+ (save-excursion
+ (let ((found-begin (match-beginning 0))
+ (found-end (match-end 0)))
+ ;; Get the start and the and of the matching line
+ ;; and store it to the overlays array
+ (goto-char found-begin)
+ (setq endpoint (line-end-position))
+ (push (list (line-beginning-position)
+ found-begin
+ found-end
+ endpoint) lines)))
+ ;; maybe add some code to highlight matches like in occur-mode?
+ ;; goto the end of line for any case
+ (goto-char endpoint))
+ (forward-line 1))
+ (setq lines (nreverse lines)))))
+
+
+
+
+
+(provide 'loccur)
+;;; loccur.el ends here
diff --git a/packages/math-symbol-lists/.dir-locals.el
b/packages/math-symbol-lists/.dir-locals.el
new file mode 100644
index 0000000..064a938
--- /dev/null
+++ b/packages/math-symbol-lists/.dir-locals.el
@@ -0,0 +1,3 @@
+
+((emacs-lisp-mode
+ (indent-tabs-mode)))
diff --git a/packages/math-symbol-lists/.gitignore
b/packages/math-symbol-lists/.gitignore
new file mode 100644
index 0000000..10facf0
--- /dev/null
+++ b/packages/math-symbol-lists/.gitignore
@@ -0,0 +1,5 @@
+# Compiled
+*.elc
+# Packaging
+.cask
+data/
\ No newline at end of file
diff --git a/packages/math-symbol-lists/math-symbol-lists.el
b/packages/math-symbol-lists/math-symbol-lists.el
new file mode 100644
index 0000000..4502c9c
--- /dev/null
+++ b/packages/math-symbol-lists/math-symbol-lists.el
@@ -0,0 +1,3102 @@
+;;; math-symbol-lists.el --- Lists of Unicode math symbols and latex commands
+;;
+;; Copyright (C) 2014, 2015 Free Software Foundation, Inc.
+;; Author: Vitalie Spinu <address@hidden>
+;; URL: https://github.com/vspinu/math-symbol-lists
+;; Keywords: Unicode, symbols, mathematics
+;; Version: 1.1
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; 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:
+;;
+;; This is a "storage" package used by completion engines such as
+;; `company-math.el` and `ac-math.el`.
+;;
+;; Defined (a)lists are:
+;;
+;; symbols-math-basic
+;; symbols-math-extended
+;; symbols-latex-commands
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(defconst math-symbol-list-basic
+ '(("Greek Lowercase" "\\alpha" #X3B1)
+ ("Greek Lowercase" "\\beta" #X3B2)
+ ("Greek Lowercase" "\\gamma" #X3B3)
+ ("Greek Lowercase" "\\delta" #X3B4)
+ ("Greek Lowercase" "\\epsilon" #X3F5)
+ ("Greek Lowercase" "\\zeta" #X3B6)
+ ("Greek Lowercase" "\\eta" #X3B7)
+ ("Greek Lowercase" "\\theta" #X3B8)
+ ("Greek Lowercase" "\\iota" #X3B9)
+ ("Greek Lowercase" "\\kappa" #X3BA)
+ ("Greek Lowercase" "\\lambda" #X3BB)
+ ("Greek Lowercase" "\\mu" #X3BC)
+ ("Greek Lowercase" "\\nu" #X3BD)
+ ("Greek Lowercase" "\\xi" #X3BE)
+ ("Greek Lowercase" "\\pi" #X3C0)
+ ("Greek Lowercase" "\\rho" #X3C1)
+ ("Greek Lowercase" "\\sigma" #X3C3)
+ ("Greek Lowercase" "\\tau" #X3C4)
+ ("Greek Lowercase" "\\upsilon" #X3C5)
+ ("Greek Lowercase" "\\phi" #X3D5)
+ ("Greek Lowercase" "\\chi" #X3C7)
+ ("Greek Lowercase" "\\psi" #X3C8)
+ ("Greek Lowercase" "\\omega" #X3C9)
+ ("Greek Lowercase" "\\varepsilon" #X3B5)
+ ("Greek Lowercase" "\\vartheta" #X3D1)
+ ("Greek Lowercase" "\\varpi" #X3D6)
+ ("Greek Lowercase" "\\varrho" #X3F1)
+ ("Greek Lowercase" "\\varsigma" #X3C2)
+ ("Greek Lowercase" "\\varphi" #X3C6)
+ ("Greek Uppercase" "\\Gamma" #X393)
+ ("Greek Uppercase" "\\Delta" #X394)
+ ("Greek Uppercase" "\\Theta" #X398)
+ ("Greek Uppercase" "\\Lambda" #X39B)
+ ("Greek Uppercase" "\\Xi" #X39E)
+ ("Greek Uppercase" "\\Pi" #X3A0)
+ ("Greek Uppercase" "\\Sigma" #X3A3)
+ ("Greek Uppercase" "\\Upsilon" #X3D2)
+ ("Greek Uppercase" "\\Phi" #X3A6)
+ ("Greek Uppercase" "\\Psi" #X3A8)
+ ("Greek Uppercase" "\\Omega" #X3A9)
+ ("Binary Op" "\\pm" #XB1)
+ ("Binary Op" "\\mp" #X2213)
+ ("Binary Op" "\\times" #XD7)
+ ("Binary Op" "\\div" #XF7)
+ ("Binary Op" "\\ast" #X2217)
+ ("Binary Op" "\\star" #X22C6)
+ ("Binary Op" "\\circ" #X2218)
+ ("Binary Op" "\\bullet" #X2219)
+ ("Binary Op" "\\cdot" #X22C5)
+ ("Binary Op" "\\cap" #X2229)
+ ("Binary Op" "\\cup" #X222A)
+ ("Binary Op" "\\uplus" #X228E)
+ ("Binary Op" "\\sqcap" #X2293)
+ ("Binary Op" "\\vee" #X2228)
+ ("Binary Op" "\\wedge" #X2227)
+ ("Binary Op" "\\setminus" #X2216)
+ ("Binary Op" "\\wr" #X2240)
+ ("Binary Op" "\\diamond" #X22C4)
+ ("Binary Op" "\\bigtriangleup" #X25B3)
+ ("Binary Op" "\\bigtriangledown" #X25BD)
+ ("Binary Op" "\\triangleleft" #X25C1)
+ ("Binary Op" "\\triangleright" #X25B7)
+ ("Binary Op" "\\lhd")
+ ("Binary Op" "\\rhd")
+ ("Binary Op" "\\unlhd")
+ ("Binary Op" "\\unrhd")
+ ("Binary Op" "\\oplus" #X2295)
+ ("Binary Op" "\\ominus" #X2296)
+ ("Binary Op" "\\otimes" #X2297)
+ ("Binary Op" "\\oslash" #X2205)
+ ("Binary Op" "\\odot" #X2299)
+ ("Binary Op" "\\bigcirc" #X25CB)
+ ("Binary Op" "\\dagger" #X2020)
+ ("Binary Op" "\\ddagger" #X2021)
+ ("Binary Op" "\\amalg" #X2A3F)
+ ("Relational" "\\leq" #X2264)
+ ("Relational" "\\geq" #X2265)
+ ("Relational" "\\qed" #X220E)
+ ("Relational" "\\equiv" #X2261)
+ ("Relational" "\\models" #X22A7)
+ ("Relational" "\\prec" #X227A)
+ ("Relational" "\\succ" #X227B)
+ ("Relational" "\\sim" #X223C)
+ ("Relational" "\\perp" #X27C2)
+ ("Relational" "\\preceq" #X2AAF)
+ ("Relational" "\\succeq" #X2AB0)
+ ("Relational" "\\simeq" #X2243)
+ ("Relational" "\\mid" #X2223)
+ ("Relational" "\\ll" #X226A)
+ ("Relational" "\\gg" #X226B)
+ ("Relational" "\\asymp" #X224D)
+ ("Relational" "\\parallel" #X2225)
+ ("Relational" "\\subset" #X2282)
+ ("Relational" "\\supset" #X2283)
+ ("Relational" "\\approx" #X2248)
+ ("Relational" "\\bowtie" #X22C8)
+ ("Relational" "\\subseteq" #X2286)
+ ("Relational" "\\supseteq" #X2287)
+ ("Relational" "\\cong" #X2245)
+ ("Relational" "\\Join" #X2A1D)
+ ("Relational" "\\sqsubset" #X228F)
+ ("Relational" "\\sqsupset" #X2290)
+ ("Relational" "\\neq" #X2260)
+ ("Relational" "\\smile" #X2323)
+ ("Relational" "\\sqsubseteq" #X2291)
+ ("Relational" "\\sqsupseteq" #X2292)
+ ("Relational" "\\doteq" #X2250)
+ ("Relational" "\\frown" #X2322)
+ ("Relational" "\\in" #X2208)
+ ("Relational" "\\ni" #X220B)
+ ("Relational" "\\propto" #X221D)
+ ("Relational" "\\vdash" #X22A2)
+ ("Relational" "\\dashv" #X22A3)
+ ("Arrows" "\\leftarrow" #X2190)
+ ("Arrows" "\\Leftarrow" #X21D0)
+ ("Arrows" "\\rightarrow" #X2192)
+ ("Arrows" "\\Rightarrow" #X21D2)
+ ("Arrows" "\\leftrightarrow" #X2194)
+ ("Arrows" "\\Leftrightarrow" #X21D4)
+ ("Arrows" "\\mapsto" #X21A6)
+ ("Arrows" "\\hookleftarrow" #X21A9)
+ ("Arrows" "\\leftharpoonup" #X21BC)
+ ("Arrows" "\\leftharpoondown" #X21BD)
+ ("Arrows" "\\longleftarrow" #X27F5)
+ ("Arrows" "\\Longleftarrow" #X27F8)
+ ("Arrows" "\\longrightarrow" #X27F6)
+ ("Arrows" "\\Longrightarrow" #X27F9)
+ ("Arrows" "\\longleftrightarrow" #X27F7)
+ ("Arrows" "\\Longleftrightarrow" #X27FA)
+ ("Arrows" "\\longmapsto" #X27FC)
+ ("Arrows" "\\hookrightarrow" #X21AA)
+ ("Arrows" "\\rightharpoonup" #X21C0)
+ ("Arrows" "\\rightharpoondown" #X21C1)
+ ("Arrows" "\\uparrow" #X2191)
+ ("Arrows" "\\Uparrow" #X21D1)
+ ("Arrows" "\\downarrow" #X2193)
+ ("Arrows" "\\Downarrow" #X21D3)
+ ("Arrows" "\\updownarrow" #X2195)
+ ("Arrows" "\\Updownarrow" #X21D5)
+ ("Arrows" "\\nearrow" #X2197)
+ ("Arrows" "\\searrow" #X2198)
+ ("Arrows" "\\swarrow" #X2199)
+ ("Arrows" "\\nwarrow" #X2196)
+ ("Punctuation" "\\ldots" #X2026)
+ ("Punctuation" "\\cdots" #X22EF)
+ ("Punctuation" "\\vdots" #X22EE)
+ ("Punctuation" "\\ddots" #X22F1)
+ ("Punctuation" "\\colon" #X3A)
+ ("Misc Symbol" "\\nabla" #X2207)
+ ("Misc Symbol" "\\aleph" #X2135)
+ ("Misc Symbol" "\\prime" #X2032)
+ ("Misc Symbol" "\\forall" #X2200)
+ ("Misc Symbol" "\\infty" #X221E)
+ ("Misc Symbol" "\\hbar" #X210F)
+ ("Misc Symbol" "\\emptyset" #X2205)
+ ("Misc Symbol" "\\exists" #X2203)
+ ("Misc Symbol" "\\surd" #X221A)
+ ("Misc Symbol" "\\Box")
+ ("Misc Symbol" "\\triangle" #X25B3)
+ ("Misc Symbol" "\\Diamond")
+ ("Misc Symbol" "\\imath" #X131)
+ ("Misc Symbol" "\\jmath" #X1D6A5)
+ ("Misc Symbol" "\\ell" #X2113)
+ ("Misc Symbol" "\\neg" #XAC)
+ ("Misc Symbol" "\\not" #X338)
+ ("Misc Symbol" "\\top" #X22A4)
+ ("Misc Symbol" "\\flat" #X266D)
+ ("Misc Symbol" "\\natural" #X266E)
+ ("Misc Symbol" "\\sharp" #X266F)
+ ("Misc Symbol" "\\wp" #X2118)
+ ("Misc Symbol" "\\bot" #X22A5)
+ ("Misc Symbol" "\\clubsuit" #X2663)
+ ("Misc Symbol" "\\diamondsuit" #X2662)
+ ("Misc Symbol" "\\heartsuit" #X2661)
+ ("Misc Symbol" "\\spadesuit" #X2660)
+ ("Misc Symbol" "\\mho" #X2127)
+ ("Misc Symbol" "\\Re" #X211C)
+ ("Misc Symbol" "\\Im" #X2111)
+ ("Misc Symbol" "\\angle" #X2220)
+ ("Misc Symbol" "\\partial" #X2202)
+ ("Var Symbol" "\\sum" #X2211)
+ ("Var Symbol" "\\prod" #X220F)
+ ("Var Symbol" "\\coprod" #X2210)
+ ("Var Symbol" "\\int" #X222B)
+ ("Var Symbol" "\\oint" #X222E)
+ ("Var Symbol" "\\bigcap" #X22C2)
+ ("Var Symbol" "\\bigcup" #X22C3)
+ ("Var Symbol" "\\bigsqcup" #X2A06)
+ ("Var Symbol" "\\bigvee" #X22C1)
+ ("Var Symbol" "\\bigwedge" #X22C0)
+ ("Var Symbol" "\\bigodot" #X2A00)
+ ("Var Symbol" "\\bigotimes" #X2A02)
+ ("Var Symbol" "\\bigoplus" #X2A01)
+ ("Var Symbol" "\\biguplus" #X2A04)
+ ("Log-like" "\\arccos")
+ ("Log-like" "\\arcsin")
+ ("Log-like" "\\arctan")
+ ("Log-like" "\\arg")
+ ("Log-like" "\\cos")
+ ("Log-like" "\\cosh")
+ ("Log-like" "\\cot")
+ ("Log-like" "\\coth")
+ ("Log-like" "\\csc")
+ ("Log-like" "\\deg")
+ ("Log-like" "\\det")
+ ("Log-like" "\\dim")
+ ("Log-like" "\\exp")
+ ("Log-like" "\\gcd")
+ ("Log-like" "\\hom")
+ ("Log-like" "\\inf")
+ ("Log-like" "\\ker")
+ ("Log-like" "\\lg")
+ ("Log-like" "\\lim")
+ ("Log-like" "\\liminf")
+ ("Log-like" "\\limsup")
+ ("Log-like" "\\ln")
+ ("Log-like" "\\log")
+ ("Log-like" "\\max")
+ ("Log-like" "\\min")
+ ("Log-like" "\\Pr")
+ ("Log-like" "\\sec")
+ ("Log-like" "\\sin")
+ ("Log-like" "\\sinh")
+ ("Log-like" "\\sup")
+ ("Log-like" "\\tan")
+ ("Log-like" "\\tanh")
+ ("Delimiters" "\\{")
+ ("Delimiters" "\\}")
+ ("Delimiters" "\\lfloor" #X230A)
+ ("Delimiters" "\\rfloor" #X230B)
+ ("Delimiters" "\\lceil" #X2308)
+ ("Delimiters" "\\rceil" #X2309)
+ ("Delimiters" "\\langle" #X27E8)
+ ("Delimiters" "\\rangle" #X27E9)
+ ("Delimiters" "\\rmoustache" #X23B1)
+ ("Delimiters" "\\lmoustache" #X23B0)
+ ("Delimiters" "\\rgroup")
+ ("Delimiters" "\\lgroup")
+ ("Delimiters" "\\backslash" #X5C)
+ ("Delimiters" "\\|")
+ ("Delimiters" "\\arrowvert")
+ ("Delimiters" "\\Arrowvert")
+ ("Delimiters" "\\bracevert")
+ ("Constructs" "\\widetilde" #X303)
+ ("Constructs" "\\widehat" #X302)
+ ("Constructs" "\\overleftarrow" #X20D6)
+ ("Constructs" "\\overrightarrow")
+ ("Constructs" "\\overline")
+ ("Constructs" "\\underline")
+ ("Constructs" "\\overbrace" #XFE37)
+ ("Constructs" "\\underbrace" #XFE38)
+ ("Constructs" "\\sqrt" #X221A)
+ ("Constructs" "\\frac")
+ ("Accents" "\\hat" #X302)
+ ("Accents" "\\acute" #X301)
+ ("Accents" "\\bar" #X304)
+ ("Accents" "\\dot" #X307)
+ ("Accents" "\\breve" #X306)
+ ("Accents" "\\check" #X30C)
+ ("Accents" "\\grave" #X300)
+ ("Accents" "\\vec" #X20D7)
+ ("Accents" "\\ddot" #X308)
+ ("Accents" "\\tilde" #X303)
+ ("AMS/Hebrew" "\\digamma" #X3DD)
+ ("AMS/Hebrew" "\\varkappa" #X3F0)
+ ("AMS/Hebrew" "\\beth" #X2136)
+ ("AMS/Hebrew" "\\daleth" #X2138)
+ ("AMS/Hebrew" "\\gimel" #X2137)
+ ("AMS/Greek Uppercase" "\\varGamma")
+ ("AMS/Greek Uppercase" "\\varDelta")
+ ("AMS/Greek Uppercase" "\\varTheta")
+ ("AMS/Greek Uppercase" "\\varLambda")
+ ("AMS/Greek Uppercase" "\\varXi")
+ ("AMS/Greek Uppercase" "\\varPi")
+ ("AMS/Greek Uppercase" "\\varSigma")
+ ("AMS/Greek Uppercase" "\\varUpsilon")
+ ("AMS/Greek Uppercase" "\\varPhi")
+ ("AMS/Greek Uppercase" "\\varPsi")
+ ("AMS/Greek Uppercase" "\\varOmega")
+ ("AMS/Arrows" "\\dashrightarrow")
+ ("AMS/Arrows" "\\dashleftarrow")
+ ("AMS/Arrows" "\\leftleftarrows" #X21C7)
+ ("AMS/Arrows" "\\leftrightarrows" #X21C6)
+ ("AMS/Arrows" "\\Lleftarrow" #X21DA)
+ ("AMS/Arrows" "\\twoheadleftarrow" #X219E)
+ ("AMS/Arrows" "\\leftarrowtail" #X21A2)
+ ("AMS/Arrows" "\\looparrowleft" #X21AB)
+ ("AMS/Arrows" "\\leftrightharpoons" #X21CB)
+ ("AMS/Arrows" "\\curvearrowleft" #X21B6)
+ ("AMS/Arrows" "\\circlearrowleft")
+ ("AMS/Arrows" "\\Lsh" #X21B0)
+ ("AMS/Arrows" "\\upuparrows" #X21C8)
+ ("AMS/Arrows" "\\upharpoonleft" #X21BF)
+ ("AMS/Arrows" "\\downharpoonleft" #X21C3)
+ ("AMS/Arrows" "\\multimap" #X22B8)
+ ("AMS/Arrows" "\\leftrightsquigarrow" #X21AD)
+ ("AMS/Arrows" "\\looparrowright" #X21AC)
+ ("AMS/Arrows" "\\rightleftharpoons" #X21CC)
+ ("AMS/Arrows" "\\curvearrowright" #X21B7)
+ ("AMS/Arrows" "\\circlearrowright")
+ ("AMS/Arrows" "\\Rsh" #X21B1)
+ ("AMS/Arrows" "\\downdownarrows" #X21CA)
+ ("AMS/Arrows" "\\upharpoonright" #X21BE)
+ ("AMS/Arrows" "\\downharpoonright" #X21C2)
+ ("AMS/Arrows" "\\rightsquigarrow" #X219D)
+ ("AMS/Neg Arrows" "\\nleftarrow" #X219A)
+ ("AMS/Neg Arrows" "\\nrightarrow" #X219B)
+ ("AMS/Neg Arrows" "\\nLeftarrow" #X21CD)
+ ("AMS/Neg Arrows" "\\nRightarrow" #X21CF)
+ ("AMS/Neg Arrows" "\\nleftrightarrow" #X21AE)
+ ("AMS/Neg Arrows" "\\nLeftrightarrow" #X21CE)
+ ("AMS/Relational I" "\\leqq" #X2266)
+ ("AMS/Relational I" "\\leqslant" #X2A7D)
+ ("AMS/Relational I" "\\eqslantless" #X2A95)
+ ("AMS/Relational I" "\\lesssim" #X2272)
+ ("AMS/Relational I" "\\lessapprox" #X2A85)
+ ("AMS/Relational I" "\\approxeq" #X224A)
+ ("AMS/Relational I" "\\lessdot" #X22D6)
+ ("AMS/Relational I" "\\lll" #X22D8)
+ ("AMS/Relational I" "\\lessgtr" #X2276)
+ ("AMS/Relational I" "\\lesseqgtr" #X22DA)
+ ("AMS/Relational I" "\\lesseqqgtr" #X2A8B)
+ ("AMS/Relational I" "\\doteqdot")
+ ("AMS/Relational I" "\\risingdotseq" #X2253)
+ ("AMS/Relational I" "\\fallingdotseq" #X2252)
+ ("AMS/Relational I" "\\backsim" #X223D)
+ ("AMS/Relational I" "\\backsimeq" #X22CD)
+ ("AMS/Relational I" "\\subseteqq" #X2AC5)
+ ("AMS/Relational I" "\\Subset" #X22D0)
+ ("AMS/Relational I" "\\sqsubset" #X228F)
+ ("AMS/Relational I" "\\preccurlyeq" #X227C)
+ ("AMS/Relational I" "\\curlyeqprec" #X22DE)
+ ("AMS/Relational I" "\\precsim" #X227E)
+ ("AMS/Relational I" "\\precapprox" #X2AB7)
+ ("AMS/Relational I" "\\vartriangleleft" #X22B2)
+ ("AMS/Relational I" "\\trianglelefteq" #X22B4)
+ ("AMS/Relational I" "\\vDash" #X22A8)
+ ("AMS/Relational I" "\\Vvdash" #X22AA)
+ ("AMS/Relational I" "\\smallsmile" #X2323)
+ ("AMS/Relational I" "\\smallfrown" #X2322)
+ ("AMS/Relational I" "\\bumpeq" #X224F)
+ ("AMS/Relational I" "\\Bumpeq" #X224E)
+ ("AMS/Relational II" "\\geqq" #X2267)
+ ("AMS/Relational II" "\\geqslant" #X2A7E)
+ ("AMS/Relational II" "\\eqslantgtr" #X2A96)
+ ("AMS/Relational II" "\\gtrsim" #X2273)
+ ("AMS/Relational II" "\\gtrapprox" #X2A86)
+ ("AMS/Relational II" "\\gtrdot" #X22D7)
+ ("AMS/Relational II" "\\ggg" #X22D9)
+ ("AMS/Relational II" "\\gtrless" #X2277)
+ ("AMS/Relational II" "\\gtreqless" #X22DB)
+ ("AMS/Relational II" "\\gtreqqless" #X2A8C)
+ ("AMS/Relational II" "\\eqcirc" #X2256)
+ ("AMS/Relational II" "\\circeq" #X2257)
+ ("AMS/Relational II" "\\triangleq" #X225C)
+ ("AMS/Relational II" "\\thicksim" #X223C)
+ ("AMS/Relational II" "\\thickapprox" #X2248)
+ ("AMS/Relational II" "\\supseteqq" #X2AC6)
+ ("AMS/Relational II" "\\Supset" #X22D1)
+ ("AMS/Relational II" "\\sqsupset" #X2290)
+ ("AMS/Relational II" "\\succcurlyeq" #X227D)
+ ("AMS/Relational II" "\\curlyeqsucc" #X22DF)
+ ("AMS/Relational II" "\\succsim" #X227F)
+ ("AMS/Relational II" "\\succapprox" #X2AB8)
+ ("AMS/Relational II" "\\vartriangleright" #X22B3)
+ ("AMS/Relational II" "\\trianglerighteq" #X22B5)
+ ("AMS/Relational II" "\\Vdash" #X22A9)
+ ("AMS/Relational II" "\\shortmid" #X2223)
+ ("AMS/Relational II" "\\shortparallel" #X2225)
+ ("AMS/Relational II" "\\between" #X226C)
+ ("AMS/Relational II" "\\pitchfork" #X22D4)
+ ("AMS/Relational II" "\\varpropto" #X221D)
+ ("AMS/Relational II" "\\blacktriangleleft" #X25C0)
+ ("AMS/Relational II" "\\therefore" #X2234)
+ ("AMS/Relational II" "\\backepsilon" #X3F6)
+ ("AMS/Relational II" "\\blacktriangleright" #X25B6)
+ ("AMS/Relational II" "\\because" #X2235)
+ ("AMS/Neg Rel I" "\\nless" #X226E)
+ ("AMS/Neg Rel I" "\\nleq" #X2270)
+ ("AMS/Neg Rel I" "\\nleqslant")
+ ("AMS/Neg Rel I" "\\nleqq")
+ ("AMS/Neg Rel I" "\\lneq" #X2A87)
+ ("AMS/Neg Rel I" "\\lneqq" #X2268)
+ ("AMS/Neg Rel I" "\\lvertneqq")
+ ("AMS/Neg Rel I" "\\lnsim" #X22E6)
+ ("AMS/Neg Rel I" "\\lnapprox" #X2A89)
+ ("AMS/Neg Rel I" "\\nprec" #X2280)
+ ("AMS/Neg Rel I" "\\npreceq")
+ ("AMS/Neg Rel I" "\\precnsim" #X22E8)
+ ("AMS/Neg Rel I" "\\precnapprox" #X2AB9)
+ ("AMS/Neg Rel I" "\\nsim" #X2241)
+ ("AMS/Neg Rel I" "\\nshortmid" #X2224)
+ ("AMS/Neg Rel I" "\\nmid" #X2224)
+ ("AMS/Neg Rel I" "\\nvdash" #X22AC)
+ ("AMS/Neg Rel I" "\\nvDash" #X22AD)
+ ("AMS/Neg Rel I" "\\ntriangleleft" #X22EA)
+ ("AMS/Neg Rel I" "\\ntrianglelefteq" #X22EC)
+ ("AMS/Neg Rel I" "\\nsubseteq" #X2288)
+ ("AMS/Neg Rel I" "\\subsetneq" #X228A)
+ ("AMS/Neg Rel I" "\\varsubsetneq")
+ ("AMS/Neg Rel I" "\\subsetneqq" #X2ACB)
+ ("AMS/Neg Rel I" "\\varsubsetneqq")
+ ("AMS/Neg Rel II" "\\ngtr" #X226F)
+ ("AMS/Neg Rel II" "\\ngeq" #X2271)
+ ("AMS/Neg Rel II" "\\ngeqslant")
+ ("AMS/Neg Rel II" "\\ngeqq")
+ ("AMS/Neg Rel II" "\\gneq" #X2A88)
+ ("AMS/Neg Rel II" "\\gneqq" #X2269)
+ ("AMS/Neg Rel II" "\\gvertneqq")
+ ("AMS/Neg Rel II" "\\gnsim" #X22E7)
+ ("AMS/Neg Rel II" "\\gnapprox" #X2A8A)
+ ("AMS/Neg Rel II" "\\nsucc" #X2281)
+ ("AMS/Neg Rel II" "\\nsucceq")
+ ("AMS/Neg Rel II" "\\succnsim" #X22E9)
+ ("AMS/Neg Rel II" "\\succnapprox" #X2ABA)
+ ("AMS/Neg Rel II" "\\ncong" #X2247)
+ ("AMS/Neg Rel II" "\\nshortparallel" #X2226)
+ ("AMS/Neg Rel II" "\\nparallel" #X2226)
+ ("AMS/Neg Rel II" "\\nvDash" #X22AD)
+ ("AMS/Neg Rel II" "\\nVDash" #X22AF)
+ ("AMS/Neg Rel II" "\\ntriangleright" #X22EB)
+ ("AMS/Neg Rel II" "\\ntrianglerighteq" #X22ED)
+ ("AMS/Neg Rel II" "\\nsupseteq" #X2289)
+ ("AMS/Neg Rel II" "\\nsupseteqq")
+ ("AMS/Neg Rel II" "\\supsetneq" #X228B)
+ ("AMS/Neg Rel II" "\\varsupsetneq")
+ ("AMS/Neg Rel II" "\\supsetneqq" #X2ACC)
+ ("AMS/Neg Rel II" "\\varsupsetneqq")
+ ("AMS/Binary Op" "\\dotplus" #X2214)
+ ("AMS/Binary Op" "\\smallsetminus" #X2216)
+ ("AMS/Binary Op" "\\Cap" #X22D2)
+ ("AMS/Binary Op" "\\Cup" #X22D3)
+ ("AMS/Binary Op" "\\barwedge" #X22BC)
+ ("AMS/Binary Op" "\\veebar" #X22BB)
+ ("AMS/Binary Op" "\\doublebarwedge" #X2306)
+ ("AMS/Binary Op" "\\boxminus" #X229F)
+ ("AMS/Binary Op" "\\boxtimes" #X22A0)
+ ("AMS/Binary Op" "\\boxdot" #X22A1)
+ ("AMS/Binary Op" "\\boxplus" #X229E)
+ ("AMS/Binary Op" "\\divideontimes" #X22C7)
+ ("AMS/Binary Op" "\\ltimes" #X22C9)
+ ("AMS/Binary Op" "\\rtimes" #X22CA)
+ ("AMS/Binary Op" "\\leftthreetimes" #X22CB)
+ ("AMS/Binary Op" "\\rightthreetimes" #X22CC)
+ ("AMS/Binary Op" "\\curlywedge" #X22CF)
+ ("AMS/Binary Op" "\\curlyvee" #X22CE)
+ ("AMS/Binary Op" "\\circleddash" #X229D)
+ ("AMS/Binary Op" "\\circledast" #X229B)
+ ("AMS/Binary Op" "\\circledcirc" #X229A)
+ ("AMS/Binary Op" "\\centerdot")
+ ("AMS/Binary Op" "\\intercal" #X22BA)
+ ("AMS/Misc" "\\hbar" #X210F)
+ ("AMS/Misc" "\\hslash" #X210F)
+ ("AMS/Misc" "\\vartriangle" #X25B5)
+ ("AMS/Misc" "\\triangledown" #X25BF)
+ ("AMS/Misc" "\\square" #X25A1)
+ ("AMS/Misc" "\\lozenge" #X25CA)
+ ("AMS/Misc" "\\circledS" #X24C8)
+ ("AMS/Misc" "\\angle" #X2220)
+ ("AMS/Misc" "\\measuredangle" #X2221)
+ ("AMS/Misc" "\\nexists" #X2204)
+ ("AMS/Misc" "\\mho" #X2127)
+ ("AMS/Misc" "\\Finv" #X2132)
+ ("AMS/Misc" "\\Game" #X2141)
+ ("AMS/Misc" "\\Bbbk" #X1D55C)
+ ("AMS/Misc" "\\backprime" #X2035)
+ ("AMS/Misc" "\\varnothing" #X2205)
+ ("AMS/Misc" "\\blacktriangle" #X25B4)
+ ("AMS/Misc" "\\blacktriangledown" #X25BE)
+ ("AMS/Misc" "\\blacksquare" #X25A0)
+ ("AMS/Misc" "\\blacklozenge" #X29EB)
+ ("AMS/Misc" "\\bigstar" #X2605)
+ ("AMS/Misc" "\\sphericalangle" #X2222)
+ ("AMS/Misc" "\\complement" #X2201)
+ ("AMS/Misc" "\\eth" #XF0)
+ ("AMS/Misc" "\\diagup" #X2571)
+ ("AMS/Misc" "\\diagdown" #X2572)
+ ("AMS/Accents" "\\dddot" #X20DB)
+ ("AMS/Accents" "\\ddddot" #X20DC)
+ ("AMS/Delimiters" "\\bigl")
+ ("AMS/Delimiters" "\\bigr")
+ ("AMS/Delimiters" "\\Bigl")
+ ("AMS/Delimiters" "\\Bigr")
+ ("AMS/Delimiters" "\\biggl")
+ ("AMS/Delimiters" "\\biggr")
+ ("AMS/Delimiters" "\\Biggl")
+ ("AMS/Delimiters" "\\Biggr")
+ ("AMS/Delimiters" "\\lvert")
+ ("AMS/Delimiters" "\\rvert")
+ ("AMS/Delimiters" "\\lVert")
+ ("AMS/Delimiters" "\\rVert")
+ ("AMS/Delimiters" "\\ulcorner" #X231C)
+ ("AMS/Delimiters" "\\urcorner" #X231D)
+ ("AMS/Delimiters" "\\llcorner" #X231E)
+ ("AMS/Delimiters" "\\lrcorner" #X231F)
+ ("AMS/Special" "\\nobreakdash")
+ ("AMS/Special" "\\leftroot")
+ ("AMS/Special" "\\uproot")
+ ("AMS/Special" "\\accentedsymbol")
+ ("AMS/Special" "\\xleftarrow")
+ ("AMS/Special" "\\xrightarrow")
+ ("AMS/Special" "\\overset")
+ ("AMS/Special" "\\underset")
+ ("AMS/Special" "\\dfrac")
+ ("AMS/Special" "\\genfrac")
+ ("AMS/Special" "\\tfrac")
+ ("AMS/Special" "\\binom")
+ ("AMS/Special" "\\dbinom")
+ ("AMS/Special" "\\tbinom")
+ ("AMS/Special" "\\smash")
+ ("AMS/Special" "\\eucal")
+ ("AMS/Special" "\\boldsymbol")
+ ("AMS/Special" "\\text")
+ ("AMS/Special" "\\intertext")
+ ("AMS/Special" "\\substack")
+ ("AMS/Special" "\\subarray")
+ ("AMS/Special" "\\sideset"))
+ "List of basic mathematical symbols.
+Processed from `LaTeX-math-default' in AucTeX/latex.el. This list
+contains a mapping of standard LaTeX math commands to unicode
+characters. See also `math-symbol-list-extended'.")
+
+(defconst math-symbol-list-extended
+ '(("mathaccent" "\\acute" #X00301 "́")
+ ("mathaccent" "\\annuity" #X020E7 "⃧")
+ ("mathaccent" "\\asteraccent" #X020F0 "⃰")
+ ("mathaccent" "\\bar" #X00304 "̄")
+ ("mathaccent" "\\breve" #X00306 "̆")
+ ("mathaccent" "\\candra" #X00310 "̐")
+ ("mathaccent" "\\check" #X0030C "̌")
+ ("mathaccent" "\\ddddot" #X020DC "⃜")
+ ("mathaccent" "\\dddot" #X020DB "⃛")
+ ("mathaccent" "\\ddot" #X00308 "̈")
+ ("mathaccent" "\\dot" #X00307 "̇")
+ ("mathaccent" "\\droang" #X0031A "̚")
+ ("mathaccent" "\\enclosecircle" #X020DD "⃝")
+ ("mathaccent" "\\enclosediamond" #X020DF "⃟")
+ ("mathaccent" "\\enclosesquare" #X020DE "⃞")
+ ("mathaccent" "\\enclosetriangle" #X020E4 "⃤")
+ ("mathaccent" "\\grave" #X00300 "̀")
+ ("mathaccent" "\\hat" #X00302 "̂")
+ ("mathaccent" "\\leftharpoonaccent" #X020D0 "⃐")
+ ("mathaccent" "\\not" #X00338 "̸")
+ ("mathaccent" "\\ocirc" #X0030A "̊")
+ ("mathaccent" "\\ocommatopright" #X00315 "̕")
+ ("mathaccent" "\\oturnedcomma" #X00312 "̒")
+ ("mathaccent" "\\overbar" #X00305 "̅")
+ ("mathaccent" "\\overleftarrow" #X020D6 "⃖")
+ ("mathaccent" "\\overleftrightarrow" #X020E1 "⃡")
+ ("mathaccent" "\\ovhook" #X00309 "̉")
+ ("mathaccent" "\\rightharpoonaccent" #X020D1 "⃑")
+ ("mathaccent" "\\threeunderdot" #X020E8 "⃨")
+ ("mathaccent" "\\tilde" #X00303 "̃")
+ ("mathaccent" "\\underbar" #X00331 "̱")
+ ("mathaccent" "\\underleftarrow" #X020EE "⃮")
+ ("mathaccent" "\\underleftharpoondown" #X020ED "⃭")
+ ("mathaccent" "\\underrightarrow" #X020EF "⃯")
+ ("mathaccent" "\\underrightharpoondown" #X020EC "⃬")
+ ("mathaccent" "\\vec" #X020D7 "⃗")
+ ("mathaccent" "\\vertoverlay" #X020D2 "⃒")
+ ("mathaccent" "\\widebridgeabove" #X020E9 "⃩")
+ ("mathaccent" "\\wideutilde" #X00330 "̰")
+ ("mathalpha" "\\Angstrom" #X0212B "Å")
+ ("mathalpha" "\\BbbA" #X1D538 "𝔸")
+ ("mathalpha" "\\BbbB" #X1D539 "𝔹")
+ ("mathalpha" "\\BbbC" #X02102 "ℂ")
+ ("mathalpha" "\\BbbD" #X1D53B "𝔻")
+ ("mathalpha" "\\BbbE" #X1D53C "𝔼")
+ ("mathalpha" "\\BbbF" #X1D53D "𝔽")
+ ("mathalpha" "\\BbbG" #X1D53E "𝔾")
+ ("mathalpha" "\\BbbGamma" #X0213E "ℾ")
+ ("mathalpha" "\\BbbH" #X0210D "ℍ")
+ ("mathalpha" "\\BbbI" #X1D540 "𝕀")
+ ("mathalpha" "\\BbbJ" #X1D541 "𝕁")
+ ("mathalpha" "\\BbbK" #X1D542 "𝕂")
+ ("mathalpha" "\\BbbL" #X1D543 "𝕃")
+ ("mathalpha" "\\BbbM" #X1D544 "𝕄")
+ ("mathalpha" "\\BbbN" #X02115 "ℕ")
+ ("mathalpha" "\\BbbO" #X1D546 "𝕆")
+ ("mathalpha" "\\BbbP" #X02119 "ℙ")
+ ("mathalpha" "\\BbbPi" #X0213F "ℿ")
+ ("mathalpha" "\\BbbQ" #X0211A "ℚ")
+ ("mathalpha" "\\BbbR" #X0211D "ℝ")
+ ("mathalpha" "\\BbbS" #X1D54A "𝕊")
+ ("mathalpha" "\\BbbT" #X1D54B "𝕋")
+ ("mathalpha" "\\BbbU" #X1D54C "𝕌")
+ ("mathalpha" "\\BbbV" #X1D54D "𝕍")
+ ("mathalpha" "\\BbbW" #X1D54E "𝕎")
+ ("mathalpha" "\\BbbX" #X1D54F "𝕏")
+ ("mathalpha" "\\BbbY" #X1D550 "𝕐")
+ ("mathalpha" "\\BbbZ" #X02124 "ℤ")
+ ("mathalpha" "\\Bbba" #X1D552 "𝕒")
+ ("mathalpha" "\\Bbbb" #X1D553 "𝕓")
+ ("mathalpha" "\\Bbbc" #X1D554 "𝕔")
+ ("mathalpha" "\\Bbbd" #X1D555 "𝕕")
+ ("mathalpha" "\\Bbbe" #X1D556 "𝕖")
+ ("mathalpha" "\\Bbbf" #X1D557 "𝕗")
+ ("mathalpha" "\\Bbbg" #X1D558 "𝕘")
+ ("mathalpha" "\\Bbbgamma" #X0213D "ℽ")
+ ("mathalpha" "\\Bbbh" #X1D559 "𝕙")
+ ("mathalpha" "\\Bbbi" #X1D55A "𝕚")
+ ("mathalpha" "\\Bbbj" #X1D55B "𝕛")
+ ("mathalpha" "\\Bbbk" #X1D55C "𝕜")
+ ("mathalpha" "\\Bbbl" #X1D55D "𝕝")
+ ("mathalpha" "\\Bbbm" #X1D55E "𝕞")
+ ("mathalpha" "\\Bbbn" #X1D55F "𝕟")
+ ("mathalpha" "\\Bbbo" #X1D560 "𝕠")
+ ("mathalpha" "\\Bbbp" #X1D561 "𝕡")
+ ("mathalpha" "\\Bbbq" #X1D562 "𝕢")
+ ("mathalpha" "\\Bbbr" #X1D563 "𝕣")
+ ("mathalpha" "\\Bbbs" #X1D564 "𝕤")
+ ("mathalpha" "\\Bbbt" #X1D565 "𝕥")
+ ("mathalpha" "\\Bbbu" #X1D566 "𝕦")
+ ("mathalpha" "\\Bbbv" #X1D567 "𝕧")
+ ("mathalpha" "\\Bbbw" #X1D568 "𝕨")
+ ("mathalpha" "\\Bbbx" #X1D569 "𝕩")
+ ("mathalpha" "\\Bbby" #X1D56A "𝕪")
+ ("mathalpha" "\\Bbbz" #X1D56B "𝕫")
+ ("mathalpha" "\\Im" #X02111 "ℑ")
+ ("mathalpha" "\\Re" #X0211C "ℜ")
+ ("mathalpha" "\\aleph" #X02135 "ℵ")
+ ("mathalpha" "\\beth" #X02136 "ℶ")
+ ("mathalpha" "\\daleth" #X02138 "ℸ")
+ ("mathalpha" "\\ell" #X02113 "ℓ")
+ ("mathalpha" "\\gimel" #X02137 "ℷ")
+ ("mathalpha" "\\hslash" #X0210F "ℏ")
+ ("mathalpha" "\\imath" #X1D6A4 "𝚤")
+ ("mathalpha" "\\jmath" #X1D6A5 "𝚥")
+ ("mathalpha" "\\matheth" #X000F0 "ð")
+ ("mathalpha" "\\mbfA" #X1D400 "𝐀")
+ ("mathalpha" "\\mbfAlpha" #X1D6A8 "𝚨")
+ ("mathalpha" "\\mbfB" #X1D401 "𝐁")
+ ("mathalpha" "\\mbfBeta" #X1D6A9 "𝚩")
+ ("mathalpha" "\\mbfC" #X1D402 "𝐂")
+ ("mathalpha" "\\mbfChi" #X1D6BE "𝚾")
+ ("mathalpha" "\\mbfD" #X1D403 "𝐃")
+ ("mathalpha" "\\mbfDelta" #X1D6AB "𝚫")
+ ("mathalpha" "\\mbfDigamma" #X1D7CA "𝟊")
+ ("mathalpha" "\\mbfE" #X1D404 "𝐄")
+ ("mathalpha" "\\mbfEpsilon" #X1D6AC "𝚬")
+ ("mathalpha" "\\mbfEta" #X1D6AE "𝚮")
+ ("mathalpha" "\\mbfF" #X1D405 "𝐅")
+ ("mathalpha" "\\mbfG" #X1D406 "𝐆")
+ ("mathalpha" "\\mbfGamma" #X1D6AA "𝚪")
+ ("mathalpha" "\\mbfH" #X1D407 "𝐇")
+ ("mathalpha" "\\mbfI" #X1D408 "𝐈")
+ ("mathalpha" "\\mbfIota" #X1D6B0 "𝚰")
+ ("mathalpha" "\\mbfJ" #X1D409 "𝐉")
+ ("mathalpha" "\\mbfK" #X1D40A "𝐊")
+ ("mathalpha" "\\mbfKappa" #X1D6B1 "𝚱")
+ ("mathalpha" "\\mbfL" #X1D40B "𝐋")
+ ("mathalpha" "\\mbfLambda" #X1D6B2 "𝚲")
+ ("mathalpha" "\\mbfM" #X1D40C "𝐌")
+ ("mathalpha" "\\mbfMu" #X1D6B3 "𝚳")
+ ("mathalpha" "\\mbfN" #X1D40D "𝐍")
+ ("mathalpha" "\\mbfNu" #X1D6B4 "𝚴")
+ ("mathalpha" "\\mbfO" #X1D40E "𝐎")
+ ("mathalpha" "\\mbfOmega" #X1D6C0 "𝛀")
+ ("mathalpha" "\\mbfOmicron" #X1D6B6 "𝚶")
+ ("mathalpha" "\\mbfP" #X1D40F "𝐏")
+ ("mathalpha" "\\mbfPhi" #X1D6BD "𝚽")
+ ("mathalpha" "\\mbfPi" #X1D6B7 "𝚷")
+ ("mathalpha" "\\mbfPsi" #X1D6BF "𝚿")
+ ("mathalpha" "\\mbfQ" #X1D410 "𝐐")
+ ("mathalpha" "\\mbfR" #X1D411 "𝐑")
+ ("mathalpha" "\\mbfRho" #X1D6B8 "𝚸")
+ ("mathalpha" "\\mbfS" #X1D412 "𝐒")
+ ("mathalpha" "\\mbfSigma" #X1D6BA "𝚺")
+ ("mathalpha" "\\mbfT" #X1D413 "𝐓")
+ ("mathalpha" "\\mbfTau" #X1D6BB "𝚻")
+ ("mathalpha" "\\mbfTheta" #X1D6AF "𝚯")
+ ("mathalpha" "\\mbfU" #X1D414 "𝐔")
+ ("mathalpha" "\\mbfUpsilon" #X1D6BC "𝚼")
+ ("mathalpha" "\\mbfV" #X1D415 "𝐕")
+ ("mathalpha" "\\mbfW" #X1D416 "𝐖")
+ ("mathalpha" "\\mbfX" #X1D417 "𝐗")
+ ("mathalpha" "\\mbfXi" #X1D6B5 "𝚵")
+ ("mathalpha" "\\mbfY" #X1D418 "𝐘")
+ ("mathalpha" "\\mbfZ" #X1D419 "𝐙")
+ ("mathalpha" "\\mbfZeta" #X1D6AD "𝚭")
+ ("mathalpha" "\\mbfa" #X1D41A "𝐚")
+ ("mathalpha" "\\mbfalpha" #X1D6C2 "𝛂")
+ ("mathalpha" "\\mbfb" #X1D41B "𝐛")
+ ("mathalpha" "\\mbfbeta" #X1D6C3 "𝛃")
+ ("mathalpha" "\\mbfc" #X1D41C "𝐜")
+ ("mathalpha" "\\mbfchi" #X1D6D8 "𝛘")
+ ("mathalpha" "\\mbfd" #X1D41D "𝐝")
+ ("mathalpha" "\\mbfdelta" #X1D6C5 "𝛅")
+ ("mathalpha" "\\mbfdigamma" #X1D7CB "𝟋")
+ ("mathalpha" "\\mbfe" #X1D41E "𝐞")
+ ("mathalpha" "\\mbfepsilon" #X1D6C6 "𝛆")
+ ("mathalpha" "\\mbfeta" #X1D6C8 "𝛈")
+ ("mathalpha" "\\mbff" #X1D41F "𝐟")
+ ("mathalpha" "\\mbffrakA" #X1D56C "𝕬")
+ ("mathalpha" "\\mbffrakB" #X1D56D "𝕭")
+ ("mathalpha" "\\mbffrakC" #X1D56E "𝕮")
+ ("mathalpha" "\\mbffrakD" #X1D56F "𝕯")
+ ("mathalpha" "\\mbffrakE" #X1D570 "𝕰")
+ ("mathalpha" "\\mbffrakF" #X1D571 "𝕱")
+ ("mathalpha" "\\mbffrakG" #X1D572 "𝕲")
+ ("mathalpha" "\\mbffrakH" #X1D573 "𝕳")
+ ("mathalpha" "\\mbffrakI" #X1D574 "𝕴")
+ ("mathalpha" "\\mbffrakJ" #X1D575 "𝕵")
+ ("mathalpha" "\\mbffrakK" #X1D576 "𝕶")
+ ("mathalpha" "\\mbffrakL" #X1D577 "𝕷")
+ ("mathalpha" "\\mbffrakM" #X1D578 "𝕸")
+ ("mathalpha" "\\mbffrakN" #X1D579 "𝕹")
+ ("mathalpha" "\\mbffrakO" #X1D57A "𝕺")
+ ("mathalpha" "\\mbffrakP" #X1D57B "𝕻")
+ ("mathalpha" "\\mbffrakQ" #X1D57C "𝕼")
+ ("mathalpha" "\\mbffrakR" #X1D57D "𝕽")
+ ("mathalpha" "\\mbffrakS" #X1D57E "𝕾")
+ ("mathalpha" "\\mbffrakT" #X1D57F "𝕿")
+ ("mathalpha" "\\mbffrakU" #X1D580 "𝖀")
+ ("mathalpha" "\\mbffrakV" #X1D581 "𝖁")
+ ("mathalpha" "\\mbffrakW" #X1D582 "𝖂")
+ ("mathalpha" "\\mbffrakX" #X1D583 "𝖃")
+ ("mathalpha" "\\mbffrakY" #X1D584 "𝖄")
+ ("mathalpha" "\\mbffrakZ" #X1D585 "𝖅")
+ ("mathalpha" "\\mbffraka" #X1D586 "𝖆")
+ ("mathalpha" "\\mbffrakb" #X1D587 "𝖇")
+ ("mathalpha" "\\mbffrakc" #X1D588 "𝖈")
+ ("mathalpha" "\\mbffrakd" #X1D589 "𝖉")
+ ("mathalpha" "\\mbffrake" #X1D58A "𝖊")
+ ("mathalpha" "\\mbffrakf" #X1D58B "𝖋")
+ ("mathalpha" "\\mbffrakg" #X1D58C "𝖌")
+ ("mathalpha" "\\mbffrakh" #X1D58D "𝖍")
+ ("mathalpha" "\\mbffraki" #X1D58E "𝖎")
+ ("mathalpha" "\\mbffrakj" #X1D58F "𝖏")
+ ("mathalpha" "\\mbffrakk" #X1D590 "𝖐")
+ ("mathalpha" "\\mbffrakl" #X1D591 "𝖑")
+ ("mathalpha" "\\mbffrakm" #X1D592 "𝖒")
+ ("mathalpha" "\\mbffrakn" #X1D593 "𝖓")
+ ("mathalpha" "\\mbffrako" #X1D594 "𝖔")
+ ("mathalpha" "\\mbffrakp" #X1D595 "𝖕")
+ ("mathalpha" "\\mbffrakq" #X1D596 "𝖖")
+ ("mathalpha" "\\mbffrakr" #X1D597 "𝖗")
+ ("mathalpha" "\\mbffraks" #X1D598 "𝖘")
+ ("mathalpha" "\\mbffrakt" #X1D599 "𝖙")
+ ("mathalpha" "\\mbffraku" #X1D59A "𝖚")
+ ("mathalpha" "\\mbffrakv" #X1D59B "𝖛")
+ ("mathalpha" "\\mbffrakw" #X1D59C "𝖜")
+ ("mathalpha" "\\mbffrakx" #X1D59D "𝖝")
+ ("mathalpha" "\\mbffraky" #X1D59E "𝖞")
+ ("mathalpha" "\\mbffrakz" #X1D59F "𝖟")
+ ("mathalpha" "\\mbfg" #X1D420 "𝐠")
+ ("mathalpha" "\\mbfgamma" #X1D6C4 "𝛄")
+ ("mathalpha" "\\mbfh" #X1D421 "𝐡")
+ ("mathalpha" "\\mbfi" #X1D422 "𝐢")
+ ("mathalpha" "\\mbfiota" #X1D6CA "𝛊")
+ ("mathalpha" "\\mbfitA" #X1D468 "𝑨")
+ ("mathalpha" "\\mbfitAlpha" #X1D71C "𝜜")
+ ("mathalpha" "\\mbfitB" #X1D469 "𝑩")
+ ("mathalpha" "\\mbfitBeta" #X1D71D "𝜝")
+ ("mathalpha" "\\mbfitC" #X1D46A "𝑪")
+ ("mathalpha" "\\mbfitChi" #X1D732 "𝜲")
+ ("mathalpha" "\\mbfitD" #X1D46B "𝑫")
+ ("mathalpha" "\\mbfitDelta" #X1D71F "𝜟")
+ ("mathalpha" "\\mbfitE" #X1D46C "𝑬")
+ ("mathalpha" "\\mbfitEpsilon" #X1D720 "𝜠")
+ ("mathalpha" "\\mbfitEta" #X1D722 "𝜢")
+ ("mathalpha" "\\mbfitF" #X1D46D "𝑭")
+ ("mathalpha" "\\mbfitG" #X1D46E "𝑮")
+ ("mathalpha" "\\mbfitGamma" #X1D71E "𝜞")
+ ("mathalpha" "\\mbfitH" #X1D46F "𝑯")
+ ("mathalpha" "\\mbfitI" #X1D470 "𝑰")
+ ("mathalpha" "\\mbfitIota" #X1D724 "𝜤")
+ ("mathalpha" "\\mbfitJ" #X1D471 "𝑱")
+ ("mathalpha" "\\mbfitK" #X1D472 "𝑲")
+ ("mathalpha" "\\mbfitKappa" #X1D725 "𝜥")
+ ("mathalpha" "\\mbfitL" #X1D473 "𝑳")
+ ("mathalpha" "\\mbfitLambda" #X1D726 "𝜦")
+ ("mathalpha" "\\mbfitM" #X1D474 "𝑴")
+ ("mathalpha" "\\mbfitMu" #X1D727 "𝜧")
+ ("mathalpha" "\\mbfitN" #X1D475 "𝑵")
+ ("mathalpha" "\\mbfitNu" #X1D728 "𝜨")
+ ("mathalpha" "\\mbfitO" #X1D476 "𝑶")
+ ("mathalpha" "\\mbfitOmega" #X1D734 "𝜴")
+ ("mathalpha" "\\mbfitOmicron" #X1D72A "𝜪")
+ ("mathalpha" "\\mbfitP" #X1D477 "𝑷")
+ ("mathalpha" "\\mbfitPhi" #X1D731 "𝜱")
+ ("mathalpha" "\\mbfitPi" #X1D72B "𝜫")
+ ("mathalpha" "\\mbfitPsi" #X1D733 "𝜳")
+ ("mathalpha" "\\mbfitQ" #X1D478 "𝑸")
+ ("mathalpha" "\\mbfitR" #X1D479 "𝑹")
+ ("mathalpha" "\\mbfitRho" #X1D72C "𝜬")
+ ("mathalpha" "\\mbfitS" #X1D47A "𝑺")
+ ("mathalpha" "\\mbfitSigma" #X1D72E "𝜮")
+ ("mathalpha" "\\mbfitT" #X1D47B "𝑻")
+ ("mathalpha" "\\mbfitTau" #X1D72F "𝜯")
+ ("mathalpha" "\\mbfitTheta" #X1D723 "𝜣")
+ ("mathalpha" "\\mbfitU" #X1D47C "𝑼")
+ ("mathalpha" "\\mbfitUpsilon" #X1D730 "𝜰")
+ ("mathalpha" "\\mbfitV" #X1D47D "𝑽")
+ ("mathalpha" "\\mbfitW" #X1D47E "𝑾")
+ ("mathalpha" "\\mbfitX" #X1D47F "𝑿")
+ ("mathalpha" "\\mbfitXi" #X1D729 "𝜩")
+ ("mathalpha" "\\mbfitY" #X1D480 "𝒀")
+ ("mathalpha" "\\mbfitZ" #X1D481 "𝒁")
+ ("mathalpha" "\\mbfitZeta" #X1D721 "𝜡")
+ ("mathalpha" "\\mbfita" #X1D482 "𝒂")
+ ("mathalpha" "\\mbfitalpha" #X1D736 "𝜶")
+ ("mathalpha" "\\mbfitb" #X1D483 "𝒃")
+ ("mathalpha" "\\mbfitbeta" #X1D737 "𝜷")
+ ("mathalpha" "\\mbfitc" #X1D484 "𝒄")
+ ("mathalpha" "\\mbfitchi" #X1D74C "𝝌")
+ ("mathalpha" "\\mbfitd" #X1D485 "𝒅")
+ ("mathalpha" "\\mbfitdelta" #X1D739 "𝜹")
+ ("mathalpha" "\\mbfite" #X1D486 "𝒆")
+ ("mathalpha" "\\mbfitepsilon" #X1D73A "𝜺")
+ ("mathalpha" "\\mbfiteta" #X1D73C "𝜼")
+ ("mathalpha" "\\mbfitf" #X1D487 "𝒇")
+ ("mathalpha" "\\mbfitg" #X1D488 "𝒈")
+ ("mathalpha" "\\mbfitgamma" #X1D738 "𝜸")
+ ("mathalpha" "\\mbfith" #X1D489 "𝒉")
+ ("mathalpha" "\\mbfiti" #X1D48A "𝒊")
+ ("mathalpha" "\\mbfitiota" #X1D73E "𝜾")
+ ("mathalpha" "\\mbfitj" #X1D48B "𝒋")
+ ("mathalpha" "\\mbfitk" #X1D48C "𝒌")
+ ("mathalpha" "\\mbfitkappa" #X1D73F "𝜿")
+ ("mathalpha" "\\mbfitl" #X1D48D "𝒍")
+ ("mathalpha" "\\mbfitlambda" #X1D740 "𝝀")
+ ("mathalpha" "\\mbfitm" #X1D48E "𝒎")
+ ("mathalpha" "\\mbfitmu" #X1D741 "𝝁")
+ ("mathalpha" "\\mbfitn" #X1D48F "𝒏")
+ ("mathalpha" "\\mbfitnu" #X1D742 "𝝂")
+ ("mathalpha" "\\mbfito" #X1D490 "𝒐")
+ ("mathalpha" "\\mbfitomega" #X1D74E "𝝎")
+ ("mathalpha" "\\mbfitomicron" #X1D744 "𝝄")
+ ("mathalpha" "\\mbfitp" #X1D491 "𝒑")
+ ("mathalpha" "\\mbfitphi" #X1D74B "𝝋")
+ ("mathalpha" "\\mbfitpi" #X1D745 "𝝅")
+ ("mathalpha" "\\mbfitpsi" #X1D74D "𝝍")
+ ("mathalpha" "\\mbfitq" #X1D492 "𝒒")
+ ("mathalpha" "\\mbfitr" #X1D493 "𝒓")
+ ("mathalpha" "\\mbfitrho" #X1D746 "𝝆")
+ ("mathalpha" "\\mbfits" #X1D494 "𝒔")
+ ("mathalpha" "\\mbfitsansA" #X1D63C "𝘼")
+ ("mathalpha" "\\mbfitsansAlpha" #X1D790 "𝞐")
+ ("mathalpha" "\\mbfitsansB" #X1D63D "𝘽")
+ ("mathalpha" "\\mbfitsansBeta" #X1D791 "𝞑")
+ ("mathalpha" "\\mbfitsansC" #X1D63E "𝘾")
+ ("mathalpha" "\\mbfitsansChi" #X1D7A6 "𝞦")
+ ("mathalpha" "\\mbfitsansD" #X1D63F "𝘿")
+ ("mathalpha" "\\mbfitsansDelta" #X1D793 "𝞓")
+ ("mathalpha" "\\mbfitsansE" #X1D640 "𝙀")
+ ("mathalpha" "\\mbfitsansEpsilon" #X1D794 "𝞔")
+ ("mathalpha" "\\mbfitsansEta" #X1D796 "𝞖")
+ ("mathalpha" "\\mbfitsansF" #X1D641 "𝙁")
+ ("mathalpha" "\\mbfitsansG" #X1D642 "𝙂")
+ ("mathalpha" "\\mbfitsansGamma" #X1D792 "𝞒")
+ ("mathalpha" "\\mbfitsansH" #X1D643 "𝙃")
+ ("mathalpha" "\\mbfitsansI" #X1D644 "𝙄")
+ ("mathalpha" "\\mbfitsansIota" #X1D798 "𝞘")
+ ("mathalpha" "\\mbfitsansJ" #X1D645 "𝙅")
+ ("mathalpha" "\\mbfitsansK" #X1D646 "𝙆")
+ ("mathalpha" "\\mbfitsansKappa" #X1D799 "𝞙")
+ ("mathalpha" "\\mbfitsansL" #X1D647 "𝙇")
+ ("mathalpha" "\\mbfitsansLambda" #X1D79A "𝞚")
+ ("mathalpha" "\\mbfitsansM" #X1D648 "𝙈")
+ ("mathalpha" "\\mbfitsansMu" #X1D79B "𝞛")
+ ("mathalpha" "\\mbfitsansN" #X1D649 "𝙉")
+ ("mathalpha" "\\mbfitsansNu" #X1D79C "𝞜")
+ ("mathalpha" "\\mbfitsansO" #X1D64A "𝙊")
+ ("mathalpha" "\\mbfitsansOmega" #X1D7A8 "𝞨")
+ ("mathalpha" "\\mbfitsansOmicron" #X1D79E "𝞞")
+ ("mathalpha" "\\mbfitsansP" #X1D64B "𝙋")
+ ("mathalpha" "\\mbfitsansPhi" #X1D7A5 "𝞥")
+ ("mathalpha" "\\mbfitsansPi" #X1D79F "𝞟")
+ ("mathalpha" "\\mbfitsansPsi" #X1D7A7 "𝞧")
+ ("mathalpha" "\\mbfitsansQ" #X1D64C "𝙌")
+ ("mathalpha" "\\mbfitsansR" #X1D64D "𝙍")
+ ("mathalpha" "\\mbfitsansRho" #X1D7A0 "𝞠")
+ ("mathalpha" "\\mbfitsansS" #X1D64E "𝙎")
+ ("mathalpha" "\\mbfitsansSigma" #X1D7A2 "𝞢")
+ ("mathalpha" "\\mbfitsansT" #X1D64F "𝙏")
+ ("mathalpha" "\\mbfitsansTau" #X1D7A3 "𝞣")
+ ("mathalpha" "\\mbfitsansTheta" #X1D797 "𝞗")
+ ("mathalpha" "\\mbfitsansU" #X1D650 "𝙐")
+ ("mathalpha" "\\mbfitsansUpsilon" #X1D7A4 "𝞤")
+ ("mathalpha" "\\mbfitsansV" #X1D651 "𝙑")
+ ("mathalpha" "\\mbfitsansW" #X1D652 "𝙒")
+ ("mathalpha" "\\mbfitsansX" #X1D653 "𝙓")
+ ("mathalpha" "\\mbfitsansXi" #X1D79D "𝞝")
+ ("mathalpha" "\\mbfitsansY" #X1D654 "𝙔")
+ ("mathalpha" "\\mbfitsansZ" #X1D655 "𝙕")
+ ("mathalpha" "\\mbfitsansZeta" #X1D795 "𝞕")
+ ("mathalpha" "\\mbfitsansa" #X1D656 "𝙖")
+ ("mathalpha" "\\mbfitsansalpha" #X1D7AA "𝞪")
+ ("mathalpha" "\\mbfitsansb" #X1D657 "𝙗")
+ ("mathalpha" "\\mbfitsansbeta" #X1D7AB "𝞫")
+ ("mathalpha" "\\mbfitsansc" #X1D658 "𝙘")
+ ("mathalpha" "\\mbfitsanschi" #X1D7C0 "𝟀")
+ ("mathalpha" "\\mbfitsansd" #X1D659 "𝙙")
+ ("mathalpha" "\\mbfitsansdelta" #X1D7AD "𝞭")
+ ("mathalpha" "\\mbfitsanse" #X1D65A "𝙚")
+ ("mathalpha" "\\mbfitsansepsilon" #X1D7AE "𝞮")
+ ("mathalpha" "\\mbfitsanseta" #X1D7B0 "𝞰")
+ ("mathalpha" "\\mbfitsansf" #X1D65B "𝙛")
+ ("mathalpha" "\\mbfitsansg" #X1D65C "𝙜")
+ ("mathalpha" "\\mbfitsansgamma" #X1D7AC "𝞬")
+ ("mathalpha" "\\mbfitsansh" #X1D65D "𝙝")
+ ("mathalpha" "\\mbfitsansi" #X1D65E "𝙞")
+ ("mathalpha" "\\mbfitsansiota" #X1D7B2 "𝞲")
+ ("mathalpha" "\\mbfitsansj" #X1D65F "𝙟")
+ ("mathalpha" "\\mbfitsansk" #X1D660 "𝙠")
+ ("mathalpha" "\\mbfitsanskappa" #X1D7B3 "𝞳")
+ ("mathalpha" "\\mbfitsansl" #X1D661 "𝙡")
+ ("mathalpha" "\\mbfitsanslambda" #X1D7B4 "𝞴")
+ ("mathalpha" "\\mbfitsansm" #X1D662 "𝙢")
+ ("mathalpha" "\\mbfitsansmu" #X1D7B5 "𝞵")
+ ("mathalpha" "\\mbfitsansn" #X1D663 "𝙣")
+ ("mathalpha" "\\mbfitsansnu" #X1D7B6 "𝞶")
+ ("mathalpha" "\\mbfitsanso" #X1D664 "𝙤")
+ ("mathalpha" "\\mbfitsansomega" #X1D7C2 "𝟂")
+ ("mathalpha" "\\mbfitsansomicron" #X1D7B8 "𝞸")
+ ("mathalpha" "\\mbfitsansp" #X1D665 "𝙥")
+ ("mathalpha" "\\mbfitsansphi" #X1D7BF "𝞿")
+ ("mathalpha" "\\mbfitsanspi" #X1D7B9 "𝞹")
+ ("mathalpha" "\\mbfitsanspsi" #X1D7C1 "𝟁")
+ ("mathalpha" "\\mbfitsansq" #X1D666 "𝙦")
+ ("mathalpha" "\\mbfitsansr" #X1D667 "𝙧")
+ ("mathalpha" "\\mbfitsansrho" #X1D7BA "𝞺")
+ ("mathalpha" "\\mbfitsanss" #X1D668 "𝙨")
+ ("mathalpha" "\\mbfitsanssigma" #X1D7BC "𝞼")
+ ("mathalpha" "\\mbfitsanst" #X1D669 "𝙩")
+ ("mathalpha" "\\mbfitsanstau" #X1D7BD "𝞽")
+ ("mathalpha" "\\mbfitsanstheta" #X1D7B1 "𝞱")
+ ("mathalpha" "\\mbfitsansu" #X1D66A "𝙪")
+ ("mathalpha" "\\mbfitsansupsilon" #X1D7BE "𝞾")
+ ("mathalpha" "\\mbfitsansv" #X1D66B "𝙫")
+ ("mathalpha" "\\mbfitsansvarTheta" #X1D7A1 "𝞡")
+ ("mathalpha" "\\mbfitsansvarepsilon" #X1D7C4 "𝟄")
+ ("mathalpha" "\\mbfitsansvarkappa" #X1D7C6 "𝟆")
+ ("mathalpha" "\\mbfitsansvarphi" #X1D7C7 "𝟇")
+ ("mathalpha" "\\mbfitsansvarpi" #X1D7C9 "𝟉")
+ ("mathalpha" "\\mbfitsansvarrho" #X1D7C8 "𝟈")
+ ("mathalpha" "\\mbfitsansvarsigma" #X1D7BB "𝞻")
+ ("mathalpha" "\\mbfitsansvartheta" #X1D7C5 "𝟅")
+ ("mathalpha" "\\mbfitsansw" #X1D66C "𝙬")
+ ("mathalpha" "\\mbfitsansx" #X1D66D "𝙭")
+ ("mathalpha" "\\mbfitsansxi" #X1D7B7 "𝞷")
+ ("mathalpha" "\\mbfitsansy" #X1D66E "𝙮")
+ ("mathalpha" "\\mbfitsansz" #X1D66F "𝙯")
+ ("mathalpha" "\\mbfitsanszeta" #X1D7AF "𝞯")
+ ("mathalpha" "\\mbfitsigma" #X1D748 "𝝈")
+ ("mathalpha" "\\mbfitt" #X1D495 "𝒕")
+ ("mathalpha" "\\mbfittau" #X1D749 "𝝉")
+ ("mathalpha" "\\mbfittheta" #X1D73D "𝜽")
+ ("mathalpha" "\\mbfitu" #X1D496 "𝒖")
+ ("mathalpha" "\\mbfitupsilon" #X1D74A "𝝊")
+ ("mathalpha" "\\mbfitv" #X1D497 "𝒗")
+ ("mathalpha" "\\mbfitvarTheta" #X1D72D "𝜭")
+ ("mathalpha" "\\mbfitvarepsilon" #X1D750 "𝝐")
+ ("mathalpha" "\\mbfitvarkappa" #X1D752 "𝝒")
+ ("mathalpha" "\\mbfitvarphi" #X1D753 "𝝓")
+ ("mathalpha" "\\mbfitvarpi" #X1D755 "𝝕")
+ ("mathalpha" "\\mbfitvarrho" #X1D754 "𝝔")
+ ("mathalpha" "\\mbfitvarsigma" #X1D747 "𝝇")
+ ("mathalpha" "\\mbfitvartheta" #X1D751 "𝝑")
+ ("mathalpha" "\\mbfitw" #X1D498 "𝒘")
+ ("mathalpha" "\\mbfitx" #X1D499 "𝒙")
+ ("mathalpha" "\\mbfitxi" #X1D743 "𝝃")
+ ("mathalpha" "\\mbfity" #X1D49A "𝒚")
+ ("mathalpha" "\\mbfitz" #X1D49B "𝒛")
+ ("mathalpha" "\\mbfitzeta" #X1D73B "𝜻")
+ ("mathalpha" "\\mbfj" #X1D423 "𝐣")
+ ("mathalpha" "\\mbfk" #X1D424 "𝐤")
+ ("mathalpha" "\\mbfkappa" #X1D6CB "𝛋")
+ ("mathalpha" "\\mbfl" #X1D425 "𝐥")
+ ("mathalpha" "\\mbflambda" #X1D6CC "𝛌")
+ ("mathalpha" "\\mbfm" #X1D426 "𝐦")
+ ("mathalpha" "\\mbfmu" #X1D6CD "𝛍")
+ ("mathalpha" "\\mbfn" #X1D427 "𝐧")
+ ("mathalpha" "\\mbfnu" #X1D6CE "𝛎")
+ ("mathalpha" "\\mbfo" #X1D428 "𝐨")
+ ("mathalpha" "\\mbfomega" #X1D6DA "𝛚")
+ ("mathalpha" "\\mbfomicron" #X1D6D0 "𝛐")
+ ("mathalpha" "\\mbfp" #X1D429 "𝐩")
+ ("mathalpha" "\\mbfphi" #X1D6DF "𝛟")
+ ("mathalpha" "\\mbfpi" #X1D6D1 "𝛑")
+ ("mathalpha" "\\mbfpsi" #X1D6D9 "𝛙")
+ ("mathalpha" "\\mbfq" #X1D42A "𝐪")
+ ("mathalpha" "\\mbfr" #X1D42B "𝐫")
+ ("mathalpha" "\\mbfrho" #X1D6D2 "𝛒")
+ ("mathalpha" "\\mbfs" #X1D42C "𝐬")
+ ("mathalpha" "\\mbfsansA" #X1D5D4 "𝗔")
+ ("mathalpha" "\\mbfsansAlpha" #X1D756 "𝝖")
+ ("mathalpha" "\\mbfsansB" #X1D5D5 "𝗕")
+ ("mathalpha" "\\mbfsansBeta" #X1D757 "𝝗")
+ ("mathalpha" "\\mbfsansC" #X1D5D6 "𝗖")
+ ("mathalpha" "\\mbfsansChi" #X1D76C "𝝬")
+ ("mathalpha" "\\mbfsansD" #X1D5D7 "𝗗")
+ ("mathalpha" "\\mbfsansDelta" #X1D759 "𝝙")
+ ("mathalpha" "\\mbfsansE" #X1D5D8 "𝗘")
+ ("mathalpha" "\\mbfsansEpsilon" #X1D75A "𝝚")
+ ("mathalpha" "\\mbfsansEta" #X1D75C "𝝜")
+ ("mathalpha" "\\mbfsansF" #X1D5D9 "𝗙")
+ ("mathalpha" "\\mbfsansG" #X1D5DA "𝗚")
+ ("mathalpha" "\\mbfsansGamma" #X1D758 "𝝘")
+ ("mathalpha" "\\mbfsansH" #X1D5DB "𝗛")
+ ("mathalpha" "\\mbfsansI" #X1D5DC "𝗜")
+ ("mathalpha" "\\mbfsansIota" #X1D75E "𝝞")
+ ("mathalpha" "\\mbfsansJ" #X1D5DD "𝗝")
+ ("mathalpha" "\\mbfsansK" #X1D5DE "𝗞")
+ ("mathalpha" "\\mbfsansKappa" #X1D75F "𝝟")
+ ("mathalpha" "\\mbfsansL" #X1D5DF "𝗟")
+ ("mathalpha" "\\mbfsansLambda" #X1D760 "𝝠")
+ ("mathalpha" "\\mbfsansM" #X1D5E0 "𝗠")
+ ("mathalpha" "\\mbfsansMu" #X1D761 "𝝡")
+ ("mathalpha" "\\mbfsansN" #X1D5E1 "𝗡")
+ ("mathalpha" "\\mbfsansNu" #X1D762 "𝝢")
+ ("mathalpha" "\\mbfsansO" #X1D5E2 "𝗢")
+ ("mathalpha" "\\mbfsansOmega" #X1D76E "𝝮")
+ ("mathalpha" "\\mbfsansOmicron" #X1D764 "𝝤")
+ ("mathalpha" "\\mbfsansP" #X1D5E3 "𝗣")
+ ("mathalpha" "\\mbfsansPhi" #X1D76B "𝝫")
+ ("mathalpha" "\\mbfsansPi" #X1D765 "𝝥")
+ ("mathalpha" "\\mbfsansPsi" #X1D76D "𝝭")
+ ("mathalpha" "\\mbfsansQ" #X1D5E4 "𝗤")
+ ("mathalpha" "\\mbfsansR" #X1D5E5 "𝗥")
+ ("mathalpha" "\\mbfsansRho" #X1D766 "𝝦")
+ ("mathalpha" "\\mbfsansS" #X1D5E6 "𝗦")
+ ("mathalpha" "\\mbfsansSigma" #X1D768 "𝝨")
+ ("mathalpha" "\\mbfsansT" #X1D5E7 "𝗧")
+ ("mathalpha" "\\mbfsansTau" #X1D769 "𝝩")
+ ("mathalpha" "\\mbfsansTheta" #X1D75D "𝝝")
+ ("mathalpha" "\\mbfsansU" #X1D5E8 "𝗨")
+ ("mathalpha" "\\mbfsansUpsilon" #X1D76A "𝝪")
+ ("mathalpha" "\\mbfsansV" #X1D5E9 "𝗩")
+ ("mathalpha" "\\mbfsansW" #X1D5EA "𝗪")
+ ("mathalpha" "\\mbfsansX" #X1D5EB "𝗫")
+ ("mathalpha" "\\mbfsansXi" #X1D763 "𝝣")
+ ("mathalpha" "\\mbfsansY" #X1D5EC "𝗬")
+ ("mathalpha" "\\mbfsansZ" #X1D5ED "𝗭")
+ ("mathalpha" "\\mbfsansZeta" #X1D75B "𝝛")
+ ("mathalpha" "\\mbfsansa" #X1D5EE "𝗮")
+ ("mathalpha" "\\mbfsansalpha" #X1D770 "𝝰")
+ ("mathalpha" "\\mbfsansb" #X1D5EF "𝗯")
+ ("mathalpha" "\\mbfsansbeta" #X1D771 "𝝱")
+ ("mathalpha" "\\mbfsansc" #X1D5F0 "𝗰")
+ ("mathalpha" "\\mbfsanschi" #X1D786 "𝞆")
+ ("mathalpha" "\\mbfsansd" #X1D5F1 "𝗱")
+ ("mathalpha" "\\mbfsansdelta" #X1D773 "𝝳")
+ ("mathalpha" "\\mbfsanse" #X1D5F2 "𝗲")
+ ("mathalpha" "\\mbfsansepsilon" #X1D774 "𝝴")
+ ("mathalpha" "\\mbfsanseta" #X1D776 "𝝶")
+ ("mathalpha" "\\mbfsansf" #X1D5F3 "𝗳")
+ ("mathalpha" "\\mbfsansg" #X1D5F4 "𝗴")
+ ("mathalpha" "\\mbfsansgamma" #X1D772 "𝝲")
+ ("mathalpha" "\\mbfsansh" #X1D5F5 "𝗵")
+ ("mathalpha" "\\mbfsansi" #X1D5F6 "𝗶")
+ ("mathalpha" "\\mbfsansiota" #X1D778 "𝝸")
+ ("mathalpha" "\\mbfsansj" #X1D5F7 "𝗷")
+ ("mathalpha" "\\mbfsansk" #X1D5F8 "𝗸")
+ ("mathalpha" "\\mbfsanskappa" #X1D779 "𝝹")
+ ("mathalpha" "\\mbfsansl" #X1D5F9 "𝗹")
+ ("mathalpha" "\\mbfsanslambda" #X1D77A "𝝺")
+ ("mathalpha" "\\mbfsansm" #X1D5FA "𝗺")
+ ("mathalpha" "\\mbfsansmu" #X1D77B "𝝻")
+ ("mathalpha" "\\mbfsansn" #X1D5FB "𝗻")
+ ("mathalpha" "\\mbfsansnu" #X1D77C "𝝼")
+ ("mathalpha" "\\mbfsanso" #X1D5FC "𝗼")
+ ("mathalpha" "\\mbfsansomega" #X1D788 "𝞈")
+ ("mathalpha" "\\mbfsansomicron" #X1D77E "𝝾")
+ ("mathalpha" "\\mbfsansp" #X1D5FD "𝗽")
+ ("mathalpha" "\\mbfsansphi" #X1D785 "𝞅")
+ ("mathalpha" "\\mbfsanspi" #X1D77F "𝝿")
+ ("mathalpha" "\\mbfsanspsi" #X1D787 "𝞇")
+ ("mathalpha" "\\mbfsansq" #X1D5FE "𝗾")
+ ("mathalpha" "\\mbfsansr" #X1D5FF "𝗿")
+ ("mathalpha" "\\mbfsansrho" #X1D780 "𝞀")
+ ("mathalpha" "\\mbfsanss" #X1D600 "𝘀")
+ ("mathalpha" "\\mbfsanssigma" #X1D782 "𝞂")
+ ("mathalpha" "\\mbfsanst" #X1D601 "𝘁")
+ ("mathalpha" "\\mbfsanstau" #X1D783 "𝞃")
+ ("mathalpha" "\\mbfsanstheta" #X1D777 "𝝷")
+ ("mathalpha" "\\mbfsansu" #X1D602 "𝘂")
+ ("mathalpha" "\\mbfsansupsilon" #X1D784 "𝞄")
+ ("mathalpha" "\\mbfsansv" #X1D603 "𝘃")
+ ("mathalpha" "\\mbfsansvarTheta" #X1D767 "𝝧")
+ ("mathalpha" "\\mbfsansvarepsilon" #X1D78A "𝞊")
+ ("mathalpha" "\\mbfsansvarkappa" #X1D78C "𝞌")
+ ("mathalpha" "\\mbfsansvarphi" #X1D78D "𝞍")
+ ("mathalpha" "\\mbfsansvarpi" #X1D78F "𝞏")
+ ("mathalpha" "\\mbfsansvarrho" #X1D78E "𝞎")
+ ("mathalpha" "\\mbfsansvarsigma" #X1D781 "𝞁")
+ ("mathalpha" "\\mbfsansvartheta" #X1D78B "𝞋")
+ ("mathalpha" "\\mbfsansw" #X1D604 "𝘄")
+ ("mathalpha" "\\mbfsansx" #X1D605 "𝘅")
+ ("mathalpha" "\\mbfsansxi" #X1D77D "𝝽")
+ ("mathalpha" "\\mbfsansy" #X1D606 "𝘆")
+ ("mathalpha" "\\mbfsansz" #X1D607 "𝘇")
+ ("mathalpha" "\\mbfsanszeta" #X1D775 "𝝵")
+ ("mathalpha" "\\mbfscrA" #X1D4D0 "𝓐")
+ ("mathalpha" "\\mbfscrB" #X1D4D1 "𝓑")
+ ("mathalpha" "\\mbfscrC" #X1D4D2 "𝓒")
+ ("mathalpha" "\\mbfscrD" #X1D4D3 "𝓓")
+ ("mathalpha" "\\mbfscrE" #X1D4D4 "𝓔")
+ ("mathalpha" "\\mbfscrF" #X1D4D5 "𝓕")
+ ("mathalpha" "\\mbfscrG" #X1D4D6 "𝓖")
+ ("mathalpha" "\\mbfscrH" #X1D4D7 "𝓗")
+ ("mathalpha" "\\mbfscrI" #X1D4D8 "𝓘")
+ ("mathalpha" "\\mbfscrJ" #X1D4D9 "𝓙")
+ ("mathalpha" "\\mbfscrK" #X1D4DA "𝓚")
+ ("mathalpha" "\\mbfscrL" #X1D4DB "𝓛")
+ ("mathalpha" "\\mbfscrM" #X1D4DC "𝓜")
+ ("mathalpha" "\\mbfscrN" #X1D4DD "𝓝")
+ ("mathalpha" "\\mbfscrO" #X1D4DE "𝓞")
+ ("mathalpha" "\\mbfscrP" #X1D4DF "𝓟")
+ ("mathalpha" "\\mbfscrQ" #X1D4E0 "𝓠")
+ ("mathalpha" "\\mbfscrR" #X1D4E1 "𝓡")
+ ("mathalpha" "\\mbfscrS" #X1D4E2 "𝓢")
+ ("mathalpha" "\\mbfscrT" #X1D4E3 "𝓣")
+ ("mathalpha" "\\mbfscrU" #X1D4E4 "𝓤")
+ ("mathalpha" "\\mbfscrV" #X1D4E5 "𝓥")
+ ("mathalpha" "\\mbfscrW" #X1D4E6 "𝓦")
+ ("mathalpha" "\\mbfscrX" #X1D4E7 "𝓧")
+ ("mathalpha" "\\mbfscrY" #X1D4E8 "𝓨")
+ ("mathalpha" "\\mbfscrZ" #X1D4E9 "𝓩")
+ ("mathalpha" "\\mbfscra" #X1D4EA "𝓪")
+ ("mathalpha" "\\mbfscrb" #X1D4EB "𝓫")
+ ("mathalpha" "\\mbfscrc" #X1D4EC "𝓬")
+ ("mathalpha" "\\mbfscrd" #X1D4ED "𝓭")
+ ("mathalpha" "\\mbfscre" #X1D4EE "𝓮")
+ ("mathalpha" "\\mbfscrf" #X1D4EF "𝓯")
+ ("mathalpha" "\\mbfscrg" #X1D4F0 "𝓰")
+ ("mathalpha" "\\mbfscrh" #X1D4F1 "𝓱")
+ ("mathalpha" "\\mbfscri" #X1D4F2 "𝓲")
+ ("mathalpha" "\\mbfscrj" #X1D4F3 "𝓳")
+ ("mathalpha" "\\mbfscrk" #X1D4F4 "𝓴")
+ ("mathalpha" "\\mbfscrl" #X1D4F5 "𝓵")
+ ("mathalpha" "\\mbfscrm" #X1D4F6 "𝓶")
+ ("mathalpha" "\\mbfscrn" #X1D4F7 "𝓷")
+ ("mathalpha" "\\mbfscro" #X1D4F8 "𝓸")
+ ("mathalpha" "\\mbfscrp" #X1D4F9 "𝓹")
+ ("mathalpha" "\\mbfscrq" #X1D4FA "𝓺")
+ ("mathalpha" "\\mbfscrr" #X1D4FB "𝓻")
+ ("mathalpha" "\\mbfscrs" #X1D4FC "𝓼")
+ ("mathalpha" "\\mbfscrt" #X1D4FD "𝓽")
+ ("mathalpha" "\\mbfscru" #X1D4FE "𝓾")
+ ("mathalpha" "\\mbfscrv" #X1D4FF "𝓿")
+ ("mathalpha" "\\mbfscrw" #X1D500 "𝔀")
+ ("mathalpha" "\\mbfscrx" #X1D501 "𝔁")
+ ("mathalpha" "\\mbfscry" #X1D502 "𝔂")
+ ("mathalpha" "\\mbfscrz" #X1D503 "𝔃")
+ ("mathalpha" "\\mbfsigma" #X1D6D4 "𝛔")
+ ("mathalpha" "\\mbft" #X1D42D "𝐭")
+ ("mathalpha" "\\mbftau" #X1D6D5 "𝛕")
+ ("mathalpha" "\\mbftheta" #X1D6C9 "𝛉")
+ ("mathalpha" "\\mbfu" #X1D42E "𝐮")
+ ("mathalpha" "\\mbfupsilon" #X1D6D6 "𝛖")
+ ("mathalpha" "\\mbfv" #X1D42F "𝐯")
+ ("mathalpha" "\\mbfvarTheta" #X1D6B9 "𝚹")
+ ("mathalpha" "\\mbfvarepsilon" #X1D6DC "𝛜")
+ ("mathalpha" "\\mbfvarkappa" #X1D6DE "𝛞")
+ ("mathalpha" "\\mbfvarphi" #X1D6D7 "𝛗")
+ ("mathalpha" "\\mbfvarpi" #X1D6E1 "𝛡")
+ ("mathalpha" "\\mbfvarrho" #X1D6E0 "𝛠")
+ ("mathalpha" "\\mbfvarsigma" #X1D6D3 "𝛓")
+ ("mathalpha" "\\mbfvartheta" #X1D6DD "𝛝")
+ ("mathalpha" "\\mbfw" #X1D430 "𝐰")
+ ("mathalpha" "\\mbfx" #X1D431 "𝐱")
+ ("mathalpha" "\\mbfxi" #X1D6CF "𝛏")
+ ("mathalpha" "\\mbfy" #X1D432 "𝐲")
+ ("mathalpha" "\\mbfz" #X1D433 "𝐳")
+ ("mathalpha" "\\mbfzeta" #X1D6C7 "𝛇")
+ ("mathalpha" "\\mfrakA" #X1D504 "𝔄")
+ ("mathalpha" "\\mfrakB" #X1D505 "𝔅")
+ ("mathalpha" "\\mfrakC" #X0212D "ℭ")
+ ("mathalpha" "\\mfrakD" #X1D507 "𝔇")
+ ("mathalpha" "\\mfrakE" #X1D508 "𝔈")
+ ("mathalpha" "\\mfrakF" #X1D509 "𝔉")
+ ("mathalpha" "\\mfrakG" #X1D50A "𝔊")
+ ("mathalpha" "\\mfrakH" #X0210C "ℌ")
+ ("mathalpha" "\\mfrakJ" #X1D50D "𝔍")
+ ("mathalpha" "\\mfrakK" #X1D50E "𝔎")
+ ("mathalpha" "\\mfrakL" #X1D50F "𝔏")
+ ("mathalpha" "\\mfrakM" #X1D510 "𝔐")
+ ("mathalpha" "\\mfrakN" #X1D511 "𝔑")
+ ("mathalpha" "\\mfrakO" #X1D512 "𝔒")
+ ("mathalpha" "\\mfrakP" #X1D513 "𝔓")
+ ("mathalpha" "\\mfrakQ" #X1D514 "𝔔")
+ ("mathalpha" "\\mfrakS" #X1D516 "𝔖")
+ ("mathalpha" "\\mfrakT" #X1D517 "𝔗")
+ ("mathalpha" "\\mfrakU" #X1D518 "𝔘")
+ ("mathalpha" "\\mfrakV" #X1D519 "𝔙")
+ ("mathalpha" "\\mfrakW" #X1D51A "𝔚")
+ ("mathalpha" "\\mfrakX" #X1D51B "𝔛")
+ ("mathalpha" "\\mfrakY" #X1D51C "𝔜")
+ ("mathalpha" "\\mfrakZ" #X02128 "ℨ")
+ ("mathalpha" "\\mfraka" #X1D51E "𝔞")
+ ("mathalpha" "\\mfrakb" #X1D51F "𝔟")
+ ("mathalpha" "\\mfrakc" #X1D520 "𝔠")
+ ("mathalpha" "\\mfrakd" #X1D521 "𝔡")
+ ("mathalpha" "\\mfrake" #X1D522 "𝔢")
+ ("mathalpha" "\\mfrakf" #X1D523 "𝔣")
+ ("mathalpha" "\\mfrakg" #X1D524 "𝔤")
+ ("mathalpha" "\\mfrakh" #X1D525 "𝔥")
+ ("mathalpha" "\\mfraki" #X1D526 "𝔦")
+ ("mathalpha" "\\mfrakj" #X1D527 "𝔧")
+ ("mathalpha" "\\mfrakk" #X1D528 "𝔨")
+ ("mathalpha" "\\mfrakl" #X1D529 "𝔩")
+ ("mathalpha" "\\mfrakm" #X1D52A "𝔪")
+ ("mathalpha" "\\mfrakn" #X1D52B "𝔫")
+ ("mathalpha" "\\mfrako" #X1D52C "𝔬")
+ ("mathalpha" "\\mfrakp" #X1D52D "𝔭")
+ ("mathalpha" "\\mfrakq" #X1D52E "𝔮")
+ ("mathalpha" "\\mfrakr" #X1D52F "𝔯")
+ ("mathalpha" "\\mfraks" #X1D530 "𝔰")
+ ("mathalpha" "\\mfrakt" #X1D531 "𝔱")
+ ("mathalpha" "\\mfraku" #X1D532 "𝔲")
+ ("mathalpha" "\\mfrakv" #X1D533 "𝔳")
+ ("mathalpha" "\\mfrakw" #X1D534 "𝔴")
+ ("mathalpha" "\\mfrakx" #X1D535 "𝔵")
+ ("mathalpha" "\\mfraky" #X1D536 "𝔶")
+ ("mathalpha" "\\mfrakz" #X1D537 "𝔷")
+ ("mathalpha" "\\mitA" #X1D434 "𝐴")
+ ("mathalpha" "\\mitAlpha" #X1D6E2 "𝛢")
+ ("mathalpha" "\\mitB" #X1D435 "𝐵")
+ ("mathalpha" "\\mitBeta" #X1D6E3 "𝛣")
+ ("mathalpha" "\\mitC" #X1D436 "𝐶")
+ ("mathalpha" "\\mitChi" #X1D6F8 "𝛸")
+ ("mathalpha" "\\mitD" #X1D437 "𝐷")
+ ("mathalpha" "\\mitDelta" #X1D6E5 "𝛥")
+ ("mathalpha" "\\mitE" #X1D438 "𝐸")
+ ("mathalpha" "\\mitEpsilon" #X1D6E6 "𝛦")
+ ("mathalpha" "\\mitEta" #X1D6E8 "𝛨")
+ ("mathalpha" "\\mitF" #X1D439 "𝐹")
+ ("mathalpha" "\\mitG" #X1D43A "𝐺")
+ ("mathalpha" "\\mitGamma" #X1D6E4 "𝛤")
+ ("mathalpha" "\\mitH" #X1D43B "𝐻")
+ ("mathalpha" "\\mitI" #X1D43C "𝐼")
+ ("mathalpha" "\\mitIota" #X1D6EA "𝛪")
+ ("mathalpha" "\\mitJ" #X1D43D "𝐽")
+ ("mathalpha" "\\mitK" #X1D43E "𝐾")
+ ("mathalpha" "\\mitKappa" #X1D6EB "𝛫")
+ ("mathalpha" "\\mitL" #X1D43F "𝐿")
+ ("mathalpha" "\\mitLambda" #X1D6EC "𝛬")
+ ("mathalpha" "\\mitM" #X1D440 "𝑀")
+ ("mathalpha" "\\mitMu" #X1D6ED "𝛭")
+ ("mathalpha" "\\mitN" #X1D441 "𝑁")
+ ("mathalpha" "\\mitNu" #X1D6EE "𝛮")
+ ("mathalpha" "\\mitO" #X1D442 "𝑂")
+ ("mathalpha" "\\mitOmega" #X1D6FA "𝛺")
+ ("mathalpha" "\\mitOmicron" #X1D6F0 "𝛰")
+ ("mathalpha" "\\mitP" #X1D443 "𝑃")
+ ("mathalpha" "\\mitPhi" #X1D6F7 "𝛷")
+ ("mathalpha" "\\mitPi" #X1D6F1 "𝛱")
+ ("mathalpha" "\\mitPsi" #X1D6F9 "𝛹")
+ ("mathalpha" "\\mitQ" #X1D444 "𝑄")
+ ("mathalpha" "\\mitR" #X1D445 "𝑅")
+ ("mathalpha" "\\mitRho" #X1D6F2 "𝛲")
+ ("mathalpha" "\\mitS" #X1D446 "𝑆")
+ ("mathalpha" "\\mitSigma" #X1D6F4 "𝛴")
+ ("mathalpha" "\\mitT" #X1D447 "𝑇")
+ ("mathalpha" "\\mitTau" #X1D6F5 "𝛵")
+ ("mathalpha" "\\mitTheta" #X1D6E9 "𝛩")
+ ("mathalpha" "\\mitU" #X1D448 "𝑈")
+ ("mathalpha" "\\mitUpsilon" #X1D6F6 "𝛶")
+ ("mathalpha" "\\mitV" #X1D449 "𝑉")
+ ("mathalpha" "\\mitW" #X1D44A "𝑊")
+ ("mathalpha" "\\mitX" #X1D44B "𝑋")
+ ("mathalpha" "\\mitXi" #X1D6EF "𝛯")
+ ("mathalpha" "\\mitY" #X1D44C "𝑌")
+ ("mathalpha" "\\mitZ" #X1D44D "𝑍")
+ ("mathalpha" "\\mitZeta" #X1D6E7 "𝛧")
+ ("mathalpha" "\\mita" #X1D44E "𝑎")
+ ("mathalpha" "\\mitalpha" #X1D6FC "𝛼")
+ ("mathalpha" "\\mitb" #X1D44F "𝑏")
+ ("mathalpha" "\\mitbeta" #X1D6FD "𝛽")
+ ("mathalpha" "\\mitc" #X1D450 "𝑐")
+ ("mathalpha" "\\mitchi" #X1D712 "𝜒")
+ ("mathalpha" "\\mitd" #X1D451 "𝑑")
+ ("mathalpha" "\\mitdelta" #X1D6FF "𝛿")
+ ("mathalpha" "\\mite" #X1D452 "𝑒")
+ ("mathalpha" "\\mitepsilon" #X1D700 "𝜀")
+ ("mathalpha" "\\miteta" #X1D702 "𝜂")
+ ("mathalpha" "\\mitf" #X1D453 "𝑓")
+ ("mathalpha" "\\mitg" #X1D454 "𝑔")
+ ("mathalpha" "\\mitgamma" #X1D6FE "𝛾")
+ ("mathalpha" "\\miti" #X1D456 "𝑖")
+ ("mathalpha" "\\mitiota" #X1D704 "𝜄")
+ ("mathalpha" "\\mitj" #X1D457 "𝑗")
+ ("mathalpha" "\\mitk" #X1D458 "𝑘")
+ ("mathalpha" "\\mitkappa" #X1D705 "𝜅")
+ ("mathalpha" "\\mitl" #X1D459 "𝑙")
+ ("mathalpha" "\\mitlambda" #X1D706 "𝜆")
+ ("mathalpha" "\\mitm" #X1D45A "𝑚")
+ ("mathalpha" "\\mitmu" #X1D707 "𝜇")
+ ("mathalpha" "\\mitn" #X1D45B "𝑛")
+ ("mathalpha" "\\mitnu" #X1D708 "𝜈")
+ ("mathalpha" "\\mito" #X1D45C "𝑜")
+ ("mathalpha" "\\mitomega" #X1D714 "𝜔")
+ ("mathalpha" "\\mitomicron" #X1D70A "𝜊")
+ ("mathalpha" "\\mitp" #X1D45D "𝑝")
+ ("mathalpha" "\\mitphi" #X1D711 "𝜑")
+ ("mathalpha" "\\mitpi" #X1D70B "𝜋")
+ ("mathalpha" "\\mitpsi" #X1D713 "𝜓")
+ ("mathalpha" "\\mitq" #X1D45E "𝑞")
+ ("mathalpha" "\\mitr" #X1D45F "𝑟")
+ ("mathalpha" "\\mitrho" #X1D70C "𝜌")
+ ("mathalpha" "\\mits" #X1D460 "𝑠")
+ ("mathalpha" "\\mitsansA" #X1D608 "𝘈")
+ ("mathalpha" "\\mitsansB" #X1D609 "𝘉")
+ ("mathalpha" "\\mitsansC" #X1D60A "𝘊")
+ ("mathalpha" "\\mitsansD" #X1D60B "𝘋")
+ ("mathalpha" "\\mitsansE" #X1D60C "𝘌")
+ ("mathalpha" "\\mitsansF" #X1D60D "𝘍")
+ ("mathalpha" "\\mitsansG" #X1D60E "𝘎")
+ ("mathalpha" "\\mitsansH" #X1D60F "𝘏")
+ ("mathalpha" "\\mitsansI" #X1D610 "𝘐")
+ ("mathalpha" "\\mitsansJ" #X1D611 "𝘑")
+ ("mathalpha" "\\mitsansK" #X1D612 "𝘒")
+ ("mathalpha" "\\mitsansL" #X1D613 "𝘓")
+ ("mathalpha" "\\mitsansM" #X1D614 "𝘔")
+ ("mathalpha" "\\mitsansN" #X1D615 "𝘕")
+ ("mathalpha" "\\mitsansO" #X1D616 "𝘖")
+ ("mathalpha" "\\mitsansP" #X1D617 "𝘗")
+ ("mathalpha" "\\mitsansQ" #X1D618 "𝘘")
+ ("mathalpha" "\\mitsansR" #X1D619 "𝘙")
+ ("mathalpha" "\\mitsansS" #X1D61A "𝘚")
+ ("mathalpha" "\\mitsansT" #X1D61B "𝘛")
+ ("mathalpha" "\\mitsansU" #X1D61C "𝘜")
+ ("mathalpha" "\\mitsansV" #X1D61D "𝘝")
+ ("mathalpha" "\\mitsansW" #X1D61E "𝘞")
+ ("mathalpha" "\\mitsansX" #X1D61F "𝘟")
+ ("mathalpha" "\\mitsansY" #X1D620 "𝘠")
+ ("mathalpha" "\\mitsansZ" #X1D621 "𝘡")
+ ("mathalpha" "\\mitsansa" #X1D622 "𝘢")
+ ("mathalpha" "\\mitsansb" #X1D623 "𝘣")
+ ("mathalpha" "\\mitsansc" #X1D624 "𝘤")
+ ("mathalpha" "\\mitsansd" #X1D625 "𝘥")
+ ("mathalpha" "\\mitsanse" #X1D626 "𝘦")
+ ("mathalpha" "\\mitsansf" #X1D627 "𝘧")
+ ("mathalpha" "\\mitsansg" #X1D628 "𝘨")
+ ("mathalpha" "\\mitsansh" #X1D629 "𝘩")
+ ("mathalpha" "\\mitsansi" #X1D62A "𝘪")
+ ("mathalpha" "\\mitsansj" #X1D62B "𝘫")
+ ("mathalpha" "\\mitsansk" #X1D62C "𝘬")
+ ("mathalpha" "\\mitsansl" #X1D62D "𝘭")
+ ("mathalpha" "\\mitsansm" #X1D62E "𝘮")
+ ("mathalpha" "\\mitsansn" #X1D62F "𝘯")
+ ("mathalpha" "\\mitsanso" #X1D630 "𝘰")
+ ("mathalpha" "\\mitsansp" #X1D631 "𝘱")
+ ("mathalpha" "\\mitsansq" #X1D632 "𝘲")
+ ("mathalpha" "\\mitsansr" #X1D633 "𝘳")
+ ("mathalpha" "\\mitsanss" #X1D634 "𝘴")
+ ("mathalpha" "\\mitsanst" #X1D635 "𝘵")
+ ("mathalpha" "\\mitsansu" #X1D636 "𝘶")
+ ("mathalpha" "\\mitsansv" #X1D637 "𝘷")
+ ("mathalpha" "\\mitsansw" #X1D638 "𝘸")
+ ("mathalpha" "\\mitsansx" #X1D639 "𝘹")
+ ("mathalpha" "\\mitsansy" #X1D63A "𝘺")
+ ("mathalpha" "\\mitsansz" #X1D63B "𝘻")
+ ("mathalpha" "\\mitsigma" #X1D70E "𝜎")
+ ("mathalpha" "\\mitt" #X1D461 "𝑡")
+ ("mathalpha" "\\mittau" #X1D70F "𝜏")
+ ("mathalpha" "\\mittheta" #X1D703 "𝜃")
+ ("mathalpha" "\\mitu" #X1D462 "𝑢")
+ ("mathalpha" "\\mitupsilon" #X1D710 "𝜐")
+ ("mathalpha" "\\mitv" #X1D463 "𝑣")
+ ("mathalpha" "\\mitvarTheta" #X1D6F3 "𝛳")
+ ("mathalpha" "\\mitvarepsilon" #X1D716 "𝜖")
+ ("mathalpha" "\\mitvarkappa" #X1D718 "𝜘")
+ ("mathalpha" "\\mitvarphi" #X1D719 "𝜙")
+ ("mathalpha" "\\mitvarpi" #X1D71B "𝜛")
+ ("mathalpha" "\\mitvarrho" #X1D71A "𝜚")
+ ("mathalpha" "\\mitvarsigma" #X1D70D "𝜍")
+ ("mathalpha" "\\mitvartheta" #X1D717 "𝜗")
+ ("mathalpha" "\\mitw" #X1D464 "𝑤")
+ ("mathalpha" "\\mitx" #X1D465 "𝑥")
+ ("mathalpha" "\\mitxi" #X1D709 "𝜉")
+ ("mathalpha" "\\mity" #X1D466 "𝑦")
+ ("mathalpha" "\\mitz" #X1D467 "𝑧")
+ ("mathalpha" "\\mitzeta" #X1D701 "𝜁")
+ ("mathalpha" "\\msansA" #X1D5A0 "𝖠")
+ ("mathalpha" "\\msansB" #X1D5A1 "𝖡")
+ ("mathalpha" "\\msansC" #X1D5A2 "𝖢")
+ ("mathalpha" "\\msansD" #X1D5A3 "𝖣")
+ ("mathalpha" "\\msansE" #X1D5A4 "𝖤")
+ ("mathalpha" "\\msansF" #X1D5A5 "𝖥")
+ ("mathalpha" "\\msansG" #X1D5A6 "𝖦")
+ ("mathalpha" "\\msansH" #X1D5A7 "𝖧")
+ ("mathalpha" "\\msansI" #X1D5A8 "𝖨")
+ ("mathalpha" "\\msansJ" #X1D5A9 "𝖩")
+ ("mathalpha" "\\msansK" #X1D5AA "𝖪")
+ ("mathalpha" "\\msansL" #X1D5AB "𝖫")
+ ("mathalpha" "\\msansM" #X1D5AC "𝖬")
+ ("mathalpha" "\\msansN" #X1D5AD "𝖭")
+ ("mathalpha" "\\msansO" #X1D5AE "𝖮")
+ ("mathalpha" "\\msansP" #X1D5AF "𝖯")
+ ("mathalpha" "\\msansQ" #X1D5B0 "𝖰")
+ ("mathalpha" "\\msansR" #X1D5B1 "𝖱")
+ ("mathalpha" "\\msansS" #X1D5B2 "𝖲")
+ ("mathalpha" "\\msansT" #X1D5B3 "𝖳")
+ ("mathalpha" "\\msansU" #X1D5B4 "𝖴")
+ ("mathalpha" "\\msansV" #X1D5B5 "𝖵")
+ ("mathalpha" "\\msansW" #X1D5B6 "𝖶")
+ ("mathalpha" "\\msansX" #X1D5B7 "𝖷")
+ ("mathalpha" "\\msansY" #X1D5B8 "𝖸")
+ ("mathalpha" "\\msansZ" #X1D5B9 "𝖹")
+ ("mathalpha" "\\msansa" #X1D5BA "𝖺")
+ ("mathalpha" "\\msansb" #X1D5BB "𝖻")
+ ("mathalpha" "\\msansc" #X1D5BC "𝖼")
+ ("mathalpha" "\\msansd" #X1D5BD "𝖽")
+ ("mathalpha" "\\msanse" #X1D5BE "𝖾")
+ ("mathalpha" "\\msansf" #X1D5BF "𝖿")
+ ("mathalpha" "\\msansg" #X1D5C0 "𝗀")
+ ("mathalpha" "\\msansh" #X1D5C1 "𝗁")
+ ("mathalpha" "\\msansi" #X1D5C2 "𝗂")
+ ("mathalpha" "\\msansj" #X1D5C3 "𝗃")
+ ("mathalpha" "\\msansk" #X1D5C4 "𝗄")
+ ("mathalpha" "\\msansl" #X1D5C5 "𝗅")
+ ("mathalpha" "\\msansm" #X1D5C6 "𝗆")
+ ("mathalpha" "\\msansn" #X1D5C7 "𝗇")
+ ("mathalpha" "\\msanso" #X1D5C8 "𝗈")
+ ("mathalpha" "\\msansp" #X1D5C9 "𝗉")
+ ("mathalpha" "\\msansq" #X1D5CA "𝗊")
+ ("mathalpha" "\\msansr" #X1D5CB "𝗋")
+ ("mathalpha" "\\msanss" #X1D5CC "𝗌")
+ ("mathalpha" "\\msanst" #X1D5CD "𝗍")
+ ("mathalpha" "\\msansu" #X1D5CE "𝗎")
+ ("mathalpha" "\\msansv" #X1D5CF "𝗏")
+ ("mathalpha" "\\msansw" #X1D5D0 "𝗐")
+ ("mathalpha" "\\msansx" #X1D5D1 "𝗑")
+ ("mathalpha" "\\msansy" #X1D5D2 "𝗒")
+ ("mathalpha" "\\msansz" #X1D5D3 "𝗓")
+ ("mathalpha" "\\mscrA" #X1D49C "𝒜")
+ ("mathalpha" "\\mscrB" #X0212C "ℬ")
+ ("mathalpha" "\\mscrC" #X1D49E "𝒞")
+ ("mathalpha" "\\mscrD" #X1D49F "𝒟")
+ ("mathalpha" "\\mscrE" #X02130 "ℰ")
+ ("mathalpha" "\\mscrF" #X02131 "ℱ")
+ ("mathalpha" "\\mscrG" #X1D4A2 "𝒢")
+ ("mathalpha" "\\mscrH" #X0210B "ℋ")
+ ("mathalpha" "\\mscrI" #X02110 "ℐ")
+ ("mathalpha" "\\mscrJ" #X1D4A5 "𝒥")
+ ("mathalpha" "\\mscrK" #X1D4A6 "𝒦")
+ ("mathalpha" "\\mscrL" #X02112 "ℒ")
+ ("mathalpha" "\\mscrM" #X02133 "ℳ")
+ ("mathalpha" "\\mscrN" #X1D4A9 "𝒩")
+ ("mathalpha" "\\mscrO" #X1D4AA "𝒪")
+ ("mathalpha" "\\mscrP" #X1D4AB "𝒫")
+ ("mathalpha" "\\mscrQ" #X1D4AC "𝒬")
+ ("mathalpha" "\\mscrR" #X0211B "ℛ")
+ ("mathalpha" "\\mscrS" #X1D4AE "𝒮")
+ ("mathalpha" "\\mscrT" #X1D4AF "𝒯")
+ ("mathalpha" "\\mscrU" #X1D4B0 "𝒰")
+ ("mathalpha" "\\mscrV" #X1D4B1 "𝒱")
+ ("mathalpha" "\\mscrW" #X1D4B2 "𝒲")
+ ("mathalpha" "\\mscrX" #X1D4B3 "𝒳")
+ ("mathalpha" "\\mscrY" #X1D4B4 "𝒴")
+ ("mathalpha" "\\mscrZ" #X1D4B5 "𝒵")
+ ("mathalpha" "\\mscra" #X1D4B6 "𝒶")
+ ("mathalpha" "\\mscrb" #X1D4B7 "𝒷")
+ ("mathalpha" "\\mscrc" #X1D4B8 "𝒸")
+ ("mathalpha" "\\mscrd" #X1D4B9 "𝒹")
+ ("mathalpha" "\\mscre" #X0212F "ℯ")
+ ("mathalpha" "\\mscrf" #X1D4BB "𝒻")
+ ("mathalpha" "\\mscrg" #X0210A "ℊ")
+ ("mathalpha" "\\mscrh" #X1D4BD "𝒽")
+ ("mathalpha" "\\mscri" #X1D4BE "𝒾")
+ ("mathalpha" "\\mscrj" #X1D4BF "𝒿")
+ ("mathalpha" "\\mscrk" #X1D4C0 "𝓀")
+ ("mathalpha" "\\mscrl" #X1D4C1 "𝓁")
+ ("mathalpha" "\\mscrm" #X1D4C2 "𝓂")
+ ("mathalpha" "\\mscrn" #X1D4C3 "𝓃")
+ ("mathalpha" "\\mscro" #X02134 "ℴ")
+ ("mathalpha" "\\mscrp" #X1D4C5 "𝓅")
+ ("mathalpha" "\\mscrq" #X1D4C6 "𝓆")
+ ("mathalpha" "\\mscrr" #X1D4C7 "𝓇")
+ ("mathalpha" "\\mscrs" #X1D4C8 "𝓈")
+ ("mathalpha" "\\mscrt" #X1D4C9 "𝓉")
+ ("mathalpha" "\\mscru" #X1D4CA "𝓊")
+ ("mathalpha" "\\mscrv" #X1D4CB "𝓋")
+ ("mathalpha" "\\mscrw" #X1D4CC "𝓌")
+ ("mathalpha" "\\mscrx" #X1D4CD "𝓍")
+ ("mathalpha" "\\mscry" #X1D4CE "𝓎")
+ ("mathalpha" "\\mscrz" #X1D4CF "𝓏")
+ ("mathalpha" "\\mttA" #X1D670 "𝙰")
+ ("mathalpha" "\\mttB" #X1D671 "𝙱")
+ ("mathalpha" "\\mttC" #X1D672 "𝙲")
+ ("mathalpha" "\\mttD" #X1D673 "𝙳")
+ ("mathalpha" "\\mttE" #X1D674 "𝙴")
+ ("mathalpha" "\\mttF" #X1D675 "𝙵")
+ ("mathalpha" "\\mttG" #X1D676 "𝙶")
+ ("mathalpha" "\\mttH" #X1D677 "𝙷")
+ ("mathalpha" "\\mttI" #X1D678 "𝙸")
+ ("mathalpha" "\\mttJ" #X1D679 "𝙹")
+ ("mathalpha" "\\mttK" #X1D67A "𝙺")
+ ("mathalpha" "\\mttL" #X1D67B "𝙻")
+ ("mathalpha" "\\mttM" #X1D67C "𝙼")
+ ("mathalpha" "\\mttN" #X1D67D "𝙽")
+ ("mathalpha" "\\mttO" #X1D67E "𝙾")
+ ("mathalpha" "\\mttP" #X1D67F "𝙿")
+ ("mathalpha" "\\mttQ" #X1D680 "𝚀")
+ ("mathalpha" "\\mttR" #X1D681 "𝚁")
+ ("mathalpha" "\\mttS" #X1D682 "𝚂")
+ ("mathalpha" "\\mttT" #X1D683 "𝚃")
+ ("mathalpha" "\\mttU" #X1D684 "𝚄")
+ ("mathalpha" "\\mttV" #X1D685 "𝚅")
+ ("mathalpha" "\\mttW" #X1D686 "𝚆")
+ ("mathalpha" "\\mttX" #X1D687 "𝚇")
+ ("mathalpha" "\\mttY" #X1D688 "𝚈")
+ ("mathalpha" "\\mttZ" #X1D689 "𝚉")
+ ("mathalpha" "\\mtta" #X1D68A "𝚊")
+ ("mathalpha" "\\mttb" #X1D68B "𝚋")
+ ("mathalpha" "\\mttc" #X1D68C "𝚌")
+ ("mathalpha" "\\mttd" #X1D68D "𝚍")
+ ("mathalpha" "\\mtte" #X1D68E "𝚎")
+ ("mathalpha" "\\mttf" #X1D68F "𝚏")
+ ("mathalpha" "\\mttg" #X1D690 "𝚐")
+ ("mathalpha" "\\mtth" #X1D691 "𝚑")
+ ("mathalpha" "\\mtti" #X1D692 "𝚒")
+ ("mathalpha" "\\mttj" #X1D693 "𝚓")
+ ("mathalpha" "\\mttk" #X1D694 "𝚔")
+ ("mathalpha" "\\mttl" #X1D695 "𝚕")
+ ("mathalpha" "\\mttm" #X1D696 "𝚖")
+ ("mathalpha" "\\mttn" #X1D697 "𝚗")
+ ("mathalpha" "\\mtto" #X1D698 "𝚘")
+ ("mathalpha" "\\mttp" #X1D699 "𝚙")
+ ("mathalpha" "\\mttq" #X1D69A "𝚚")
+ ("mathalpha" "\\mttr" #X1D69B "𝚛")
+ ("mathalpha" "\\mtts" #X1D69C "𝚜")
+ ("mathalpha" "\\mttt" #X1D69D "𝚝")
+ ("mathalpha" "\\mttu" #X1D69E "𝚞")
+ ("mathalpha" "\\mttv" #X1D69F "𝚟")
+ ("mathalpha" "\\mttw" #X1D6A0 "𝚠")
+ ("mathalpha" "\\mttx" #X1D6A1 "𝚡")
+ ("mathalpha" "\\mtty" #X1D6A2 "𝚢")
+ ("mathalpha" "\\mttz" #X1D6A3 "𝚣")
+ ("mathalpha" "\\period" #X0002E ".")
+ ("mathalpha" "\\turnediota" #X02129 "℩")
+ ("mathalpha" "\\upAlpha" #X00391 "Α")
+ ("mathalpha" "\\upBeta" #X00392 "Β")
+ ("mathalpha" "\\upChi" #X003A7 "Χ")
+ ("mathalpha" "\\upDelta" #X00394 "Δ")
+ ("mathalpha" "\\upDigamma" #X003DC "Ϝ")
+ ("mathalpha" "\\upEpsilon" #X00395 "Ε")
+ ("mathalpha" "\\upEta" #X00397 "Η")
+ ("mathalpha" "\\upGamma" #X00393 "Γ")
+ ("mathalpha" "\\upIota" #X00399 "Ι")
+ ("mathalpha" "\\upKappa" #X0039A "Κ")
+ ("mathalpha" "\\upKoppa" #X003DE "Ϟ")
+ ("mathalpha" "\\upLambda" #X0039B "Λ")
+ ("mathalpha" "\\upMu" #X0039C "Μ")
+ ("mathalpha" "\\upNu" #X0039D "Ν")
+ ("mathalpha" "\\upOmega" #X003A9 "Ω")
+ ("mathalpha" "\\upOmicron" #X0039F "Ο")
+ ("mathalpha" "\\upPhi" #X003A6 "Φ")
+ ("mathalpha" "\\upPi" #X003A0 "Π")
+ ("mathalpha" "\\upPsi" #X003A8 "Ψ")
+ ("mathalpha" "\\upRho" #X003A1 "Ρ")
+ ("mathalpha" "\\upSampi" #X003E0 "Ϡ")
+ ("mathalpha" "\\upSigma" #X003A3 "Σ")
+ ("mathalpha" "\\upStigma" #X003DA "Ϛ")
+ ("mathalpha" "\\upTau" #X003A4 "Τ")
+ ("mathalpha" "\\upTheta" #X00398 "Θ")
+ ("mathalpha" "\\upUpsilon" #X003A5 "Υ")
+ ("mathalpha" "\\upUpsilon" #X003D2 "ϒ")
+ ("mathalpha" "\\upXi" #X0039E "Ξ")
+ ("mathalpha" "\\upZeta" #X00396 "Ζ")
+ ("mathalpha" "\\upalpha" #X003B1 "α")
+ ("mathalpha" "\\upbeta" #X003B2 "β")
+ ("mathalpha" "\\upchi" #X003C7 "χ")
+ ("mathalpha" "\\updelta" #X003B4 "δ")
+ ("mathalpha" "\\updigamma" #X003DD "ϝ")
+ ("mathalpha" "\\upepsilon" #X003B5 "ε")
+ ("mathalpha" "\\upeta" #X003B7 "η")
+ ("mathalpha" "\\upgamma" #X003B3 "γ")
+ ("mathalpha" "\\upiota" #X003B9 "ι")
+ ("mathalpha" "\\upkappa" #X003BA "κ")
+ ("mathalpha" "\\upkoppa" #X003DF "ϟ")
+ ("mathalpha" "\\uplambda" #X003BB "λ")
+ ("mathalpha" "\\upmu" #X003BC "μ")
+ ("mathalpha" "\\upnu" #X003BD "ν")
+ ("mathalpha" "\\upomega" #X003C9 "ω")
+ ("mathalpha" "\\upomicron" #X003BF "ο")
+ ("mathalpha" "\\upphi" #X003D5 "ϕ")
+ ("mathalpha" "\\uppi" #X003C0 "π")
+ ("mathalpha" "\\uppsi" #X003C8 "ψ")
+ ("mathalpha" "\\uprho" #X003C1 "ρ")
+ ("mathalpha" "\\upsampi" #X003E1 "ϡ")
+ ("mathalpha" "\\upsigma" #X003C3 "σ")
+ ("mathalpha" "\\upstigma" #X003DB "ϛ")
+ ("mathalpha" "\\uptau" #X003C4 "τ")
+ ("mathalpha" "\\uptheta" #X003B8 "θ")
+ ("mathalpha" "\\upupsilon" #X003C5 "υ")
+ ("mathalpha" "\\upvarTheta" #X003F4 "ϴ")
+ ("mathalpha" "\\upvarbeta" #X003D0 "ϐ")
+ ("mathalpha" "\\upvarepsilon" #X003F5 "ϵ")
+ ("mathalpha" "\\upvarkappa" #X003F0 "ϰ")
+ ("mathalpha" "\\upvarphi" #X003C6 "φ")
+ ("mathalpha" "\\upvarpi" #X003D6 "ϖ")
+ ("mathalpha" "\\upvarrho" #X003F1 "ϱ")
+ ("mathalpha" "\\upvarsigma" #X003C2 "ς")
+ ("mathalpha" "\\upvartheta" #X003D1 "ϑ")
+ ("mathalpha" "\\upxi" #X003BE "ξ")
+ ("mathalpha" "\\upzeta" #X003B6 "ζ")
+ ("mathalpha" "\\wp" #X02118 "℘")
+ ("mathbin" "\\Cap" #X022D2 "⋒")
+ ("mathbin" "\\Cup" #X022D3 "⋓")
+ ("mathbin" "\\Otimes" #X02A37 "⨷")
+ ("mathbin" "\\Sqcap" #X02A4E "⩎")
+ ("mathbin" "\\Sqcup" #X02A4F "⩏")
+ ("mathbin" "\\Vee" #X02A54 "⩔")
+ ("mathbin" "\\Wedge" #X02A53 "⩓")
+ ("mathbin" "\\amalg" #X02A3F "⨿")
+ ("mathbin" "\\ast" #X02217 "∗")
+ ("mathbin" "\\barcap" #X02A43 "⩃")
+ ("mathbin" "\\barcup" #X02A42 "⩂")
+ ("mathbin" "\\barvee" #X022BD "⊽")
+ ("mathbin" "\\barwedge" #X022BC "⊼")
+ ("mathbin" "\\bigslopedvee" #X02A57 "⩗")
+ ("mathbin" "\\bigslopedwedge" #X02A58 "⩘")
+ ("mathbin" "\\bigtriangledown" #X025BD "▽")
+ ("mathbin" "\\bigtriangleup" #X025B3 "△")
+ ("mathbin" "\\blackhourglass" #X029D7 "⧗")
+ ("mathbin" "\\blacktriangle" #X025B4 "▴")
+ ("mathbin" "\\blacktriangledown" #X025BE "▾")
+ ("mathbin" "\\blacktriangleleft" #X025C0 "◀")
+ ("mathbin" "\\blacktriangleright" #X025B6 "▶")
+ ("mathbin" "\\boxast" #X029C6 "⧆")
+ ("mathbin" "\\boxbar" #X025EB "◫")
+ ("mathbin" "\\boxbox" #X029C8 "⧈")
+ ("mathbin" "\\boxbslash" #X029C5 "⧅")
+ ("mathbin" "\\boxcircle" #X029C7 "⧇")
+ ("mathbin" "\\boxdiag" #X029C4 "⧄")
+ ("mathbin" "\\boxdot" #X022A1 "⊡")
+ ("mathbin" "\\boxminus" #X0229F "⊟")
+ ("mathbin" "\\boxplus" #X0229E "⊞")
+ ("mathbin" "\\boxtimes" #X022A0 "⊠")
+ ("mathbin" "\\btimes" #X02A32 "⨲")
+ ("mathbin" "\\cap" #X02229 "∩")
+ ("mathbin" "\\capbarcup" #X02A49 "⩉")
+ ("mathbin" "\\capdot" #X02A40 "⩀")
+ ("mathbin" "\\capovercup" #X02A47 "⩇")
+ ("mathbin" "\\capwedge" #X02A44 "⩄")
+ ("mathbin" "\\cdot" #X022C5 "⋅")
+ ("mathbin" "\\cdotp" #X000B7 "·")
+ ("mathbin" "\\circledast" #X0229B "⊛")
+ ("mathbin" "\\circledcirc" #X0229A "⊚")
+ ("mathbin" "\\circleddash" #X0229D "⊝")
+ ("mathbin" "\\circledequal" #X0229C "⊜")
+ ("mathbin" "\\circledparallel" #X029B7 "⦷")
+ ("mathbin" "\\circledvert" #X029B6 "⦶")
+ ("mathbin" "\\circlehbar" #X029B5 "⦵")
+ ("mathbin" "\\closedvarcap" #X02A4D "⩍")
+ ("mathbin" "\\closedvarcup" #X02A4C "⩌")
+ ("mathbin" "\\closedvarcupsmashprod" #X02A50 "⩐")
+ ("mathbin" "\\commaminus" #X02A29 "⨩")
+ ("mathbin" "\\concavediamond" #X027E1 "⟡")
+ ("mathbin" "\\concavediamondtickleft" #X027E2 "⟢")
+ ("mathbin" "\\concavediamondtickright" #X027E3 "⟣")
+ ("mathbin" "\\cup" #X0222A "∪")
+ ("mathbin" "\\cupbarcap" #X02A48 "⩈")
+ ("mathbin" "\\cupdot" #X0228D "⊍")
+ ("mathbin" "\\cupleftarrow" #X0228C "⊌")
+ ("mathbin" "\\cupovercap" #X02A46 "⩆")
+ ("mathbin" "\\cupvee" #X02A45 "⩅")
+ ("mathbin" "\\curlyvee" #X022CE "⋎")
+ ("mathbin" "\\curlywedge" #X022CF "⋏")
+ ("mathbin" "\\dagger" #X02020 "†")
+ ("mathbin" "\\ddagger" #X02021 "‡")
+ ("mathbin" "\\div" #X000F7 "÷")
+ ("mathbin" "\\divideontimes" #X022C7 "⋇")
+ ("mathbin" "\\divslash" #X02215 "∕")
+ ("mathbin" "\\dotminus" #X02238 "∸")
+ ("mathbin" "\\dotplus" #X02214 "∔")
+ ("mathbin" "\\dottimes" #X02A30 "⨰")
+ ("mathbin" "\\doublebarvee" #X02A62 "⩢")
+ ("mathbin" "\\doublebarwedge" #X02A5E "⩞")
+ ("mathbin" "\\doubleplus" #X029FA "⧺")
+ ("mathbin" "\\dsol" #X029F6 "⧶")
+ ("mathbin" "\\dsub" #X02A64 "⩤")
+ ("mathbin" "\\eqqplus" #X02A71 "⩱")
+ ("mathbin" "\\fcmp" #X02A3E "⨾")
+ ("mathbin" "\\fracslash" #X02044 "⁄")
+ ("mathbin" "\\hourglass" #X029D6 "⧖")
+ ("mathbin" "\\intercal" #X022BA "⊺")
+ ("mathbin" "\\interleave" #X02AF4 "⫴")
+ ("mathbin" "\\intprod" #X02A3C "⨼")
+ ("mathbin" "\\intprodr" #X02A3D "⨽")
+ ("mathbin" "\\invlazys" #X0223E "∾")
+ ("mathbin" "\\leftthreetimes" #X022CB "⋋")
+ ("mathbin" "\\lozengeminus" #X027E0 "⟠")
+ ("mathbin" "\\ltimes" #X022C9 "⋉")
+ ("mathbin" "\\mdlgblklozenge" #X029EB "⧫")
+ ("mathbin" "\\mdlgwhtcircle" #X025CB "○")
+ ("mathbin" "\\midbarvee" #X02A5D "⩝")
+ ("mathbin" "\\midbarwedge" #X02A5C "⩜")
+ ("mathbin" "\\minus" #X02212 "−")
+ ("mathbin" "\\minusdot" #X02A2A "⨪")
+ ("mathbin" "\\minusfdots" #X02A2B "⨫")
+ ("mathbin" "\\minusrdots" #X02A2C "⨬")
+ ("mathbin" "\\mp" #X02213 "∓")
+ ("mathbin" "\\nhVvert" #X02AF5 "⫵")
+ ("mathbin" "\\obar" #X0233D "⌽")
+ ("mathbin" "\\obslash" #X029B8 "⦸")
+ ("mathbin" "\\odiv" #X02A38 "⨸")
+ ("mathbin" "\\odot" #X02299 "⊙")
+ ("mathbin" "\\ogreaterthan" #X029C1 "⧁")
+ ("mathbin" "\\olessthan" #X029C0 "⧀")
+ ("mathbin" "\\ominus" #X02296 "⊖")
+ ("mathbin" "\\operp" #X029B9 "⦹")
+ ("mathbin" "\\oplus" #X02295 "⊕")
+ ("mathbin" "\\opluslhrim" #X02A2D "⨭")
+ ("mathbin" "\\oplusrhrim" #X02A2E "⨮")
+ ("mathbin" "\\oslash" #X02298 "⊘")
+ ("mathbin" "\\otimes" #X02297 "⊗")
+ ("mathbin" "\\otimeshat" #X02A36 "⨶")
+ ("mathbin" "\\otimeslhrim" #X02A34 "⨴")
+ ("mathbin" "\\otimesrhrim" #X02A35 "⨵")
+ ("mathbin" "\\plus" #X0002B "+")
+ ("mathbin" "\\plusdot" #X02A25 "⨥")
+ ("mathbin" "\\pluseqq" #X02A72 "⩲")
+ ("mathbin" "\\plushat" #X02A23 "⨣")
+ ("mathbin" "\\plussim" #X02A26 "⨦")
+ ("mathbin" "\\plussubtwo" #X02A27 "⨧")
+ ("mathbin" "\\plustrif" #X02A28 "⨨")
+ ("mathbin" "\\pm" #X000B1 "±")
+ ("mathbin" "\\rightthreetimes" #X022CC "⋌")
+ ("mathbin" "\\ringplus" #X02A22 "⨢")
+ ("mathbin" "\\rsolbar" #X029F7 "⧷")
+ ("mathbin" "\\rsub" #X02A65 "⩥")
+ ("mathbin" "\\rtimes" #X022CA "⋊")
+ ("mathbin" "\\setminus" #X029F5 "⧵")
+ ("mathbin" "\\shuffle" #X029E2 "⧢")
+ ("mathbin" "\\simplus" #X02A24 "⨤")
+ ("mathbin" "\\smallblacktriangleleft" #X025C2 "◂")
+ ("mathbin" "\\smallblacktriangleright" #X025B8 "▸")
+ ("mathbin" "\\smallsetminus" #X02216 "∖")
+ ("mathbin" "\\smalltriangleleft" #X025C3 "◃")
+ ("mathbin" "\\smalltriangleright" #X025B9 "▹")
+ ("mathbin" "\\smashtimes" #X02A33 "⨳")
+ ("mathbin" "\\smblkcircle" #X02022 "•")
+ ("mathbin" "\\smwhtdiamond" #X022C4 "⋄")
+ ("mathbin" "\\sqcap" #X02293 "⊓")
+ ("mathbin" "\\sqcup" #X02294 "⊔")
+ ("mathbin" "\\sslash" #X02AFD "⫽")
+ ("mathbin" "\\star" #X022C6 "⋆")
+ ("mathbin" "\\talloblong" #X02AFE "⫾")
+ ("mathbin" "\\threedotcolon" #X02AF6 "⫶")
+ ("mathbin" "\\tieconcat" #X02040 "⁀")
+ ("mathbin" "\\times" #X000D7 "×")
+ ("mathbin" "\\timesbar" #X02A31 "⨱")
+ ("mathbin" "\\tminus" #X029FF "⧿")
+ ("mathbin" "\\tplus" #X029FE "⧾")
+ ("mathbin" "\\triangledown" #X025BF "▿")
+ ("mathbin" "\\triangleleft" #X025C1 "◁")
+ ("mathbin" "\\triangleminus" #X02A3A "⨺")
+ ("mathbin" "\\triangleplus" #X02A39 "⨹")
+ ("mathbin" "\\triangleright" #X025B7 "▷")
+ ("mathbin" "\\triangleserifs" #X029CD "⧍")
+ ("mathbin" "\\triangletimes" #X02A3B "⨻")
+ ("mathbin" "\\tripleplus" #X029FB "⧻")
+ ("mathbin" "\\trslash" #X02AFB "⫻")
+ ("mathbin" "\\twocaps" #X02A4B "⩋")
+ ("mathbin" "\\twocups" #X02A4A "⩊")
+ ("mathbin" "\\typecolon" #X02982 "⦂")
+ ("mathbin" "\\uminus" #X02A41 "⩁")
+ ("mathbin" "\\upand" #X0214B "⅋")
+ ("mathbin" "\\uplus" #X0228E "⊎")
+ ("mathbin" "\\varbarwedge" #X02305 "⌅")
+ ("mathbin" "\\vardoublebarwedge" #X02306 "⌆")
+ ("mathbin" "\\vartriangle" #X025B5 "▵")
+ ("mathbin" "\\varveebar" #X02A61 "⩡")
+ ("mathbin" "\\vectimes" #X02A2F "⨯")
+ ("mathbin" "\\vee" #X02228 "∨")
+ ("mathbin" "\\veebar" #X022BB "⊻")
+ ("mathbin" "\\veedot" #X027C7 "⟇")
+ ("mathbin" "\\veedoublebar" #X02A63 "⩣")
+ ("mathbin" "\\veemidvert" #X02A5B "⩛")
+ ("mathbin" "\\veeodot" #X02A52 "⩒")
+ ("mathbin" "\\veeonvee" #X02A56 "⩖")
+ ("mathbin" "\\vysmblkcircle" #X02219 "∙")
+ ("mathbin" "\\vysmwhtcircle" #X02218 "∘")
+ ("mathbin" "\\wedge" #X02227 "∧")
+ ("mathbin" "\\wedgebar" #X02A5F "⩟")
+ ("mathbin" "\\wedgedot" #X027D1 "⟑")
+ ("mathbin" "\\wedgedoublebar" #X02A60 "⩠")
+ ("mathbin" "\\wedgemidvert" #X02A5A "⩚")
+ ("mathbin" "\\wedgeodot" #X02A51 "⩑")
+ ("mathbin" "\\wedgeonwedge" #X02A55 "⩕")
+ ("mathbin" "\\whitesquaretickleft" #X027E4 "⟤")
+ ("mathbin" "\\whitesquaretickright" #X027E5 "⟥")
+ ("mathbin" "\\wr" #X02240 "≀")
+ ("mathclose" "\\Rbrbrak" #X027ED "⟭")
+ ("mathclose" "\\Rbrbrak" #X03019 "〙")
+ ("mathclose" "\\Rparenless" #X02996 "⦖")
+ ("mathclose" "\\Rvzigzag" #X029DB "⧛")
+ ("mathclose" "\\lrcorner" #X0231F "⌟")
+ ("mathclose" "\\rAngle" #X027EB "⟫")
+ ("mathclose" "\\rBrace" #X02984 "⦄")
+ ("mathclose" "\\rBrack" #X027E7 "⟧")
+ ("mathclose" "\\rParen" #X02986 "⦆")
+ ("mathclose" "\\rangle" #X027E9 "⟩")
+ ("mathclose" "\\rangledot" #X02992 "⦒")
+ ("mathclose" "\\rbag" #X027C6 "⟆")
+ ("mathclose" "\\rblkbrbrak" #X02998 "⦘")
+ ("mathclose" "\\rbrace" #X0007D "}")
+ ("mathclose" "\\rbrack" #X0005D "]")
+ ("mathclose" "\\rbracklrtick" #X0298E "⦎")
+ ("mathclose" "\\rbrackubar" #X0298C "⦌")
+ ("mathclose" "\\rbrackurtick" #X02990 "⦐")
+ ("mathclose" "\\rbrbrak" #X02773 "❳")
+ ("mathclose" "\\rbrbrak" #X03015 "〕")
+ ("mathclose" "\\rceil" #X02309 "⌉")
+ ("mathclose" "\\rcurvyangle" #X029FD "⧽")
+ ("mathclose" "\\rfloor" #X0230B "⌋")
+ ("mathclose" "\\rparen" #X00029 ")")
+ ("mathclose" "\\rparengtr" #X02994 "⦔")
+ ("mathclose" "\\rrangle" #X0298A "⦊")
+ ("mathclose" "\\rrparenthesis" #X02988 "⦈")
+ ("mathclose" "\\rvzigzag" #X029D9 "⧙")
+ ("mathclose" "\\urcorner" #X0231D "⌝")
+ ("mathfence" "\\Vert" #X02016 "‖")
+ ("mathfence" "\\Vvert" #X02980 "⦀")
+ ("mathfence" "\\vert" #X0007C "|")
+ ("mathop" "\\Bbbsum" #X02140 "⅀")
+ ("mathop" "\\Join" #X02A1D "⨝")
+ ("mathop" "\\awint" #X02A11 "⨑")
+ ("mathop" "\\bigbot" #X027D8 "⟘")
+ ("mathop" "\\bigcap" #X022C2 "⋂")
+ ("mathop" "\\bigcup" #X022C3 "⋃")
+ ("mathop" "\\bigcupdot" #X02A03 "⨃")
+ ("mathop" "\\biginterleave" #X02AFC "⫼")
+ ("mathop" "\\bigodot" #X02A00 "⨀")
+ ("mathop" "\\bigoplus" #X02A01 "⨁")
+ ("mathop" "\\bigotimes" #X02A02 "⨂")
+ ("mathop" "\\bigsqcap" #X02A05 "⨅")
+ ("mathop" "\\bigsqcup" #X02A06 "⨆")
+ ("mathop" "\\bigtalloblong" #X02AFF "⫿")
+ ("mathop" "\\bigtimes" #X02A09 "⨉")
+ ("mathop" "\\bigtop" #X027D9 "⟙")
+ ("mathop" "\\bigtriangleleft" #X02A1E "⨞")
+ ("mathop" "\\biguplus" #X02A04 "⨄")
+ ("mathop" "\\bigvee" #X022C1 "⋁")
+ ("mathop" "\\bigwedge" #X022C0 "⋀")
+ ("mathop" "\\cirfnint" #X02A10 "⨐")
+ ("mathop" "\\conjquant" #X02A07 "⨇")
+ ("mathop" "\\coprod" #X02210 "∐")
+ ("mathop" "\\disjquant" #X02A08 "⨈")
+ ("mathop" "\\fint" #X02A0F "⨏")
+ ("mathop" "\\fullouterjoin" #X027D7 "⟗")
+ ("mathop" "\\iiiint" #X02A0C "⨌")
+ ("mathop" "\\iiint" #X0222D "∭")
+ ("mathop" "\\iint" #X0222C "∬")
+ ("mathop" "\\int" #X0222B "∫")
+ ("mathop" "\\intBar" #X02A0E "⨎")
+ ("mathop" "\\intbar" #X02A0D "⨍")
+ ("mathop" "\\intcap" #X02A19 "⨙")
+ ("mathop" "\\intclockwise" #X02231 "∱")
+ ("mathop" "\\intcup" #X02A1A "⨚")
+ ("mathop" "\\intlarhk" #X02A17 "⨗")
+ ("mathop" "\\intx" #X02A18 "⨘")
+ ("mathop" "\\leftouterjoin" #X027D5 "⟕")
+ ("mathop" "\\lowint" #X02A1C "⨜")
+ ("mathop" "\\npolint" #X02A14 "⨔")
+ ("mathop" "\\oiiint" #X02230 "∰")
+ ("mathop" "\\oiint" #X0222F "∯")
+ ("mathop" "\\oint" #X0222E "∮")
+ ("mathop" "\\ointctrclockwise" #X02233 "∳")
+ ("mathop" "\\pointint" #X02A15 "⨕")
+ ("mathop" "\\prod" #X0220F "∏")
+ ("mathop" "\\rightouterjoin" #X027D6 "⟖")
+ ("mathop" "\\rppolint" #X02A12 "⨒")
+ ("mathop" "\\scpolint" #X02A13 "⨓")
+ ("mathop" "\\sqint" #X02A16 "⨖")
+ ("mathop" "\\sum" #X02211 "∑")
+ ("mathop" "\\sumint" #X02A0B "⨋")
+ ("mathop" "\\upint" #X02A1B "⨛")
+ ("mathop" "\\varointclockwise" #X02232 "∲")
+ ("mathop" "\\xbsol" #X029F9 "⧹")
+ ("mathop" "\\xsol" #X029F8 "⧸")
+ ("mathop" "\\zcmp" #X02A1F "⨟")
+ ("mathop" "\\zpipe" #X02A20 "⨠")
+ ("mathop" "\\zproject" #X02A21 "⨡")
+ ("mathopen" "\\Lbrbrak" #X027EC "⟬")
+ ("mathopen" "\\Lbrbrak" #X03018 "〘")
+ ("mathopen" "\\Lparengtr" #X02995 "⦕")
+ ("mathopen" "\\Lvzigzag" #X029DA "⧚")
+ ("mathopen" "\\lAngle" #X027EA "⟪")
+ ("mathopen" "\\lBrace" #X02983 "⦃")
+ ("mathopen" "\\lBrack" #X027E6 "⟦")
+ ("mathopen" "\\lParen" #X02985 "⦅")
+ ("mathopen" "\\langle" #X027E8 "⟨")
+ ("mathopen" "\\langledot" #X02991 "⦑")
+ ("mathopen" "\\lbag" #X027C5 "⟅")
+ ("mathopen" "\\lblkbrbrak" #X02997 "⦗")
+ ("mathopen" "\\lbrace" #X0007B "{")
+ ("mathopen" "\\lbrack" #X0005B "[")
+ ("mathopen" "\\lbracklltick" #X0298F "⦏")
+ ("mathopen" "\\lbrackubar" #X0298B "⦋")
+ ("mathopen" "\\lbrackultick" #X0298D "⦍")
+ ("mathopen" "\\lbrbrak" #X02772 "❲")
+ ("mathopen" "\\lbrbrak" #X03014 "〔")
+ ("mathopen" "\\lceil" #X02308 "⌈")
+ ("mathopen" "\\lcurvyangle" #X029FC "⧼")
+ ("mathopen" "\\lfloor" #X0230A "⌊")
+ ("mathopen" "\\llangle" #X02989 "⦉")
+ ("mathopen" "\\llcorner" #X0231E "⌞")
+ ("mathopen" "\\llparenthesis" #X02987 "⦇")
+ ("mathopen" "\\longdivision" #X027CC "⟌")
+ ("mathopen" "\\lparen" #X00028 "(")
+ ("mathopen" "\\lparenless" #X02993 "⦓")
+ ("mathopen" "\\lvzigzag" #X029D8 "⧘")
+ ("mathopen" "\\ulcorner" #X0231C "⌜")
+ ("mathord" "\\APLboxquestion" #X02370 "⍰")
+ ("mathord" "\\APLboxupcaret" #X02353 "⍓")
+ ("mathord" "\\APLnotbackslash" #X02340 "⍀")
+ ("mathord" "\\Bbbeight" #X1D7E0 "𝟠")
+ ("mathord" "\\Bbbfive" #X1D7DD "𝟝")
+ ("mathord" "\\Bbbfour" #X1D7DC "𝟜")
+ ("mathord" "\\Bbbnine" #X1D7E1 "𝟡")
+ ("mathord" "\\Bbbone" #X1D7D9 "𝟙")
+ ("mathord" "\\Bbbpi" #X0213C "ℼ")
+ ("mathord" "\\Bbbseven" #X1D7DF "𝟟")
+ ("mathord" "\\Bbbsix" #X1D7DE "𝟞")
+ ("mathord" "\\Bbbthree" #X1D7DB "𝟛")
+ ("mathord" "\\Bbbtwo" #X1D7DA "𝟚")
+ ("mathord" "\\Bbbzero" #X1D7D8 "𝟘")
+ ("mathord" "\\Eulerconst" #X02107 "ℇ")
+ ("mathord" "\\Exclam" #X0203C "‼")
+ ("mathord" "\\Finv" #X02132 "Ⅎ")
+ ("mathord" "\\Game" #X02141 "⅁")
+ ("mathord" "\\Hermaphrodite" #X026A5 "⚥")
+ ("mathord" "\\Planckconst" #X0210E "ℎ")
+ ("mathord" "\\PropertyLine" #X0214A "⅊")
+ ("mathord" "\\QED" #X0220E "∎")
+ ("mathord" "\\Question" #X02047 "⁇")
+ ("mathord" "\\Yup" #X02144 "⅄")
+ ("mathord" "\\Zbar" #X001B5 "Ƶ")
+ ("mathord" "\\accurrent" #X023E6 "⏦")
+ ("mathord" "\\acidfree" #X0267E "♾")
+ ("mathord" "\\acwopencirclearrow" #X021BA "↺")
+ ("mathord" "\\ampersand" #X00026 "&")
+ ("mathord" "\\angdnr" #X0299F "⦟")
+ ("mathord" "\\angle" #X02220 "∠")
+ ("mathord" "\\angles" #X0299E "⦞")
+ ("mathord" "\\angleubar" #X029A4 "⦤")
+ ("mathord" "\\astrosun" #X02609 "☉")
+ ("mathord" "\\atsign" #X00040 "@")
+ ("mathord" "\\backdprime" #X02036 "‶")
+ ("mathord" "\\backprime" #X02035 "‵")
+ ("mathord" "\\backslash" #X0005C "\\")
+ ("mathord" "\\backtrprime" #X02037 "‷")
+ ("mathord" "\\barleftarrowrightarrowba" #X021B9 "↹")
+ ("mathord" "\\barovernorthwestarrow" #X021B8 "↸")
+ ("mathord" "\\bbrktbrk" #X023B6 "⎶")
+ ("mathord" "\\bdtriplevdash" #X02506 "┆")
+ ("mathord" "\\because" #X02235 "∵")
+ ("mathord" "\\benzenr" #X023E3 "⏣")
+ ("mathord" "\\bigblacktriangledown" #X025BC "▼")
+ ("mathord" "\\bigblacktriangleup" #X025B2 "▲")
+ ("mathord" "\\bigstar" #X02605 "★")
+ ("mathord" "\\bigwhitestar" #X02606 "☆")
+ ("mathord" "\\blackcircledownarrow" #X029ED "⧭")
+ ("mathord" "\\blackcircledrightdot" #X02688 "⚈")
+ ("mathord" "\\blackcircledtwodots" #X02689 "⚉")
+ ("mathord" "\\blackcircleulquadwhite" #X025D5 "◕")
+ ("mathord" "\\blackdiamonddownarrow" #X029EA "⧪")
+ ("mathord" "\\blackinwhitediamond" #X025C8 "◈")
+ ("mathord" "\\blackinwhitesquare" #X025A3 "▣")
+ ("mathord" "\\blacklefthalfcircle" #X025D6 "◖")
+ ("mathord" "\\blackpointerleft" #X025C4 "◄")
+ ("mathord" "\\blackpointerright" #X025BA "►")
+ ("mathord" "\\blackrighthalfcircle" #X025D7 "◗")
+ ("mathord" "\\blacksmiley" #X0263B "☻")
+ ("mathord" "\\blkhorzoval" #X02B2C "⬬")
+ ("mathord" "\\blkvertoval" #X02B2E "⬮")
+ ("mathord" "\\blockfull" #X02588 "█")
+ ("mathord" "\\blockhalfshaded" #X02592 "▒")
+ ("mathord" "\\blocklefthalf" #X0258C "▌")
+ ("mathord" "\\blocklowhalf" #X02584 "▄")
+ ("mathord" "\\blockqtrshaded" #X02591 "░")
+ ("mathord" "\\blockrighthalf" #X02590 "▐")
+ ("mathord" "\\blockthreeqtrshaded" #X02593 "▓")
+ ("mathord" "\\blockuphalf" #X02580 "▀")
+ ("mathord" "\\bot" #X022A5 "⊥")
+ ("mathord" "\\botsemicircle" #X025E1 "◡")
+ ("mathord" "\\boxonbox" #X029C9 "⧉")
+ ("mathord" "\\bullseye" #X025CE "◎")
+ ("mathord" "\\caretinsert" #X02038 "‸")
+ ("mathord" "\\carriagereturn" #X021B5 "↵")
+ ("mathord" "\\checkmark" #X02713 "✓")
+ ("mathord" "\\cirE" #X029C3 "⧃")
+ ("mathord" "\\circlebottomhalfblack" #X025D2 "◒")
+ ("mathord" "\\circledbullet" #X029BF "⦿")
+ ("mathord" "\\circledownarrow" #X029EC "⧬")
+ ("mathord" "\\circledrightdot" #X02686 "⚆")
+ ("mathord" "\\circledstar" #X0272A "✪")
+ ("mathord" "\\circledtwodots" #X02687 "⚇")
+ ("mathord" "\\circledwhitebullet" #X029BE "⦾")
+ ("mathord" "\\circlelefthalfblack" #X025D0 "◐")
+ ("mathord" "\\circlellquad" #X025F5 "◵")
+ ("mathord" "\\circlelrquad" #X025F6 "◶")
+ ("mathord" "\\circlerighthalfblack" #X025D1 "◑")
+ ("mathord" "\\circletophalfblack" #X025D3 "◓")
+ ("mathord" "\\circleulquad" #X025F4 "◴")
+ ("mathord" "\\circleurquad" #X025F7 "◷")
+ ("mathord" "\\circleurquadblack" #X025D4 "◔")
+ ("mathord" "\\circlevertfill" #X025CD "◍")
+ ("mathord" "\\cirscir" #X029C2 "⧂")
+ ("mathord" "\\clubsuit" #X02663 "♣")
+ ("mathord" "\\complement" #X02201 "∁")
+ ("mathord" "\\conictaper" #X02332 "⌲")
+ ("mathord" "\\cwopencirclearrow" #X021BB "↻")
+ ("mathord" "\\danger" #X02621 "☡")
+ ("mathord" "\\diameter" #X02300 "⌀")
+ ("mathord" "\\diamondbotblack" #X02B19 "⬙")
+ ("mathord" "\\diamondcdot" #X027D0 "⟐")
+ ("mathord" "\\diamondleftblack" #X02B16 "⬖")
+ ("mathord" "\\diamondrightblack" #X02B17 "⬗")
+ ("mathord" "\\diamondsuit" #X02662 "♢")
+ ("mathord" "\\diamondtopblack" #X02B18 "⬘")
+ ("mathord" "\\dicei" #X02680 "⚀")
+ ("mathord" "\\diceii" #X02681 "⚁")
+ ("mathord" "\\diceiii" #X02682 "⚂")
+ ("mathord" "\\diceiv" #X02683 "⚃")
+ ("mathord" "\\dicev" #X02684 "⚄")
+ ("mathord" "\\dicevi" #X02685 "⚅")
+ ("mathord" "\\dingasterisk" #X0273D "✽")
+ ("mathord" "\\dottedcircle" #X025CC "◌")
+ ("mathord" "\\dottedsquare" #X02B1A "⬚")
+ ("mathord" "\\downdasharrow" #X021E3 "⇣")
+ ("mathord" "\\downrightcurvedarrow" #X02935 "⤵")
+ ("mathord" "\\downtriangleleftblack" #X029E8 "⧨")
+ ("mathord" "\\downtrianglerightblack" #X029E9 "⧩")
+ ("mathord" "\\downwhitearrow" #X021E9 "⇩")
+ ("mathord" "\\dprime" #X02033 "″")
+ ("mathord" "\\draftingarrow" #X0279B "➛")
+ ("mathord" "\\eighthnote" #X0266A "♪")
+ ("mathord" "\\elinters" #X023E7 "⏧")
+ ("mathord" "\\emptysetoarr" #X029B3 "⦳")
+ ("mathord" "\\emptysetoarrl" #X029B4 "⦴")
+ ("mathord" "\\emptysetobar" #X029B1 "⦱")
+ ("mathord" "\\emptysetocirc" #X029B2 "⦲")
+ ("mathord" "\\enleadertwodots" #X02025 "‥")
+ ("mathord" "\\errbarblackcircle" #X029F3 "⧳")
+ ("mathord" "\\errbarblackdiamond" #X029F1 "⧱")
+ ("mathord" "\\errbarblacksquare" #X029EF "⧯")
+ ("mathord" "\\errbarcircle" #X029F2 "⧲")
+ ("mathord" "\\errbardiamond" #X029F0 "⧰")
+ ("mathord" "\\errbarsquare" #X029EE "⧮")
+ ("mathord" "\\euro" #X020AC "€")
+ ("mathord" "\\exists" #X02203 "∃")
+ ("mathord" "\\fdiagovnearrow" #X0292F "⤯")
+ ("mathord" "\\fdiagovrdiag" #X0292C "⤬")
+ ("mathord" "\\female" #X02640 "♀")
+ ("mathord" "\\fisheye" #X025C9 "◉")
+ ("mathord" "\\flat" #X0266D "♭")
+ ("mathord" "\\fltns" #X023E5 "⏥")
+ ("mathord" "\\forall" #X02200 "∀")
+ ("mathord" "\\fourvdots" #X02999 "⦙")
+ ("mathord" "\\gtlpar" #X029A0 "⦠")
+ ("mathord" "\\harrowextender" #X023AF "⎯")
+ ("mathord" "\\heartsuit" #X02661 "♡")
+ ("mathord" "\\hermitmatrix" #X022B9 "⊹")
+ ("mathord" "\\hexagon" #X02394 "⎔")
+ ("mathord" "\\hexagonblack" #X02B23 "⬣")
+ ("mathord" "\\horizbar" #X02015 "―")
+ ("mathord" "\\house" #X02302 "⌂")
+ ("mathord" "\\hrectangle" #X025AD "▭")
+ ("mathord" "\\hrectangleblack" #X025AC "▬")
+ ("mathord" "\\hyphenbullet" #X02043 "⁃")
+ ("mathord" "\\hzigzag" #X03030 "〰")
+ ("mathord" "\\iinfin" #X029DC "⧜")
+ ("mathord" "\\increment" #X02206 "∆")
+ ("mathord" "\\infty" #X0221E "∞")
+ ("mathord" "\\intbottom" #X02321 "⌡")
+ ("mathord" "\\intextender" #X023AE "⎮")
+ ("mathord" "\\inttop" #X02320 "⌠")
+ ("mathord" "\\inversebullet" #X025D8 "◘")
+ ("mathord" "\\inversewhitecircle" #X025D9 "◙")
+ ("mathord" "\\invnot" #X02310 "⌐")
+ ("mathord" "\\invwhitelowerhalfcircle" #X025DB "◛")
+ ("mathord" "\\invwhiteupperhalfcircle" #X025DA "◚")
+ ("mathord" "\\laplac" #X029E0 "⧠")
+ ("mathord" "\\lbracelend" #X023A9 "⎩")
+ ("mathord" "\\lbracemid" #X023A8 "⎨")
+ ("mathord" "\\lbraceuend" #X023A7 "⎧")
+ ("mathord" "\\lbrackextender" #X023A2 "⎢")
+ ("mathord" "\\lbracklend" #X023A3 "⎣")
+ ("mathord" "\\lbrackuend" #X023A1 "⎡")
+ ("mathord" "\\leftdasharrow" #X021E0 "⇠")
+ ("mathord" "\\leftmoon" #X0263E "☾")
+ ("mathord" "\\leftwhitearrow" #X021E6 "⇦")
+ ("mathord" "\\lgblkcircle" #X02B24 "⬤")
+ ("mathord" "\\lgblksquare" #X02B1B "⬛")
+ ("mathord" "\\lgwhtcircle" #X025EF "◯")
+ ("mathord" "\\lgwhtsquare" #X02B1C "⬜")
+ ("mathord" "\\linefeed" #X021B4 "↴")
+ ("mathord" "\\llarc" #X025DF "◟")
+ ("mathord" "\\llblacktriangle" #X025E3 "◣")
+ ("mathord" "\\lltriangle" #X025FA "◺")
+ ("mathord" "\\lmoustache" #X023B0 "⎰")
+ ("mathord" "\\lparenextender" #X0239C "⎜")
+ ("mathord" "\\lparenlend" #X0239D "⎝")
+ ("mathord" "\\lparenuend" #X0239B "⎛")
+ ("mathord" "\\lrarc" #X025DE "◞")
+ ("mathord" "\\lrblacktriangle" #X025E2 "◢")
+ ("mathord" "\\lrtriangle" #X025FF "◿")
+ ("mathord" "\\lvboxline" #X023B8 "⎸")
+ ("mathord" "\\male" #X02642 "♂")
+ ("mathord" "\\maltese" #X02720 "✠")
+ ("mathord" "\\mathdollar" #X00024 "$")
+ ("mathord" "\\mathslash" #X0002F "/")
+ ("mathord" "\\mbfitnabla" #X1D735 "𝜵")
+ ("mathord" "\\mbfitpartial" #X1D74F "𝝏")
+ ("mathord" "\\mbfitsansnabla" #X1D7A9 "𝞩")
+ ("mathord" "\\mbfitsanspartial" #X1D7C3 "𝟃")
+ ("mathord" "\\mbfnabla" #X1D6C1 "𝛁")
+ ("mathord" "\\mbfpartial" #X1D6DB "𝛛")
+ ("mathord" "\\mbfsanseight" #X1D7F4 "𝟴")
+ ("mathord" "\\mbfsansfive" #X1D7F1 "𝟱")
+ ("mathord" "\\mbfsansfour" #X1D7F0 "𝟰")
+ ("mathord" "\\mbfsansnabla" #X1D76F "𝝯")
+ ("mathord" "\\mbfsansnine" #X1D7F5 "𝟵")
+ ("mathord" "\\mbfsansone" #X1D7ED "𝟭")
+ ("mathord" "\\mbfsanspartial" #X1D789 "𝞉")
+ ("mathord" "\\mbfsansseven" #X1D7F3 "𝟳")
+ ("mathord" "\\mbfsanssix" #X1D7F2 "𝟲")
+ ("mathord" "\\mbfsansthree" #X1D7EF "𝟯")
+ ("mathord" "\\mbfsanstwo" #X1D7EE "𝟮")
+ ("mathord" "\\mbfsanszero" #X1D7EC "𝟬")
+ ("mathord" "\\mdblkcircle" #X026AB "⚫")
+ ("mathord" "\\mdblkdiamond" #X02B25 "⬥")
+ ("mathord" "\\mdblklozenge" #X02B27 "⬧")
+ ("mathord" "\\mdblksquare" #X025FC "◼")
+ ("mathord" "\\mdlgblkcircle" #X025CF "●")
+ ("mathord" "\\mdlgblkdiamond" #X025C6 "◆")
+ ("mathord" "\\mdlgblksquare" #X025A0 "■")
+ ("mathord" "\\mdlgwhtdiamond" #X025C7 "◇")
+ ("mathord" "\\mdlgwhtlozenge" #X025CA "◊")
+ ("mathord" "\\mdlgwhtsquare" #X025A1 "□")
+ ("mathord" "\\mdsmblkcircle" #X02981 "⦁")
+ ("mathord" "\\mdsmblksquare" #X025FE "◾")
+ ("mathord" "\\mdsmwhtcircle" #X026AC "⚬")
+ ("mathord" "\\mdsmwhtsquare" #X025FD "◽")
+ ("mathord" "\\mdwhtcircle" #X026AA "⚪")
+ ("mathord" "\\mdwhtdiamond" #X02B26 "⬦")
+ ("mathord" "\\mdwhtlozenge" #X02B28 "⬨")
+ ("mathord" "\\mdwhtsquare" #X025FB "◻")
+ ("mathord" "\\measangledltosw" #X029AF "⦯")
+ ("mathord" "\\measangledrtose" #X029AE "⦮")
+ ("mathord" "\\measangleldtosw" #X029AB "⦫")
+ ("mathord" "\\measanglelutonw" #X029A9 "⦩")
+ ("mathord" "\\measanglerdtose" #X029AA "⦪")
+ ("mathord" "\\measanglerutone" #X029A8 "⦨")
+ ("mathord" "\\measangleultonw" #X029AD "⦭")
+ ("mathord" "\\measangleurtone" #X029AC "⦬")
+ ("mathord" "\\measuredangle" #X02221 "∡")
+ ("mathord" "\\measuredangleleft" #X0299B "⦛")
+ ("mathord" "\\measuredrightangle" #X022BE "⊾")
+ ("mathord" "\\medblackstar" #X02B51 "⭑")
+ ("mathord" "\\medwhitestar" #X02B50 "⭐")
+ ("mathord" "\\mho" #X02127 "℧")
+ ("mathord" "\\mitBbbD" #X02145 "ⅅ")
+ ("mathord" "\\mitBbbd" #X02146 "ⅆ")
+ ("mathord" "\\mitBbbe" #X02147 "ⅇ")
+ ("mathord" "\\mitBbbi" #X02148 "ⅈ")
+ ("mathord" "\\mitBbbj" #X02149 "ⅉ")
+ ("mathord" "\\mitnabla" #X1D6FB "𝛻")
+ ("mathord" "\\mitpartial" #X1D715 "𝜕")
+ ("mathord" "\\modtwosum" #X02A0A "⨊")
+ ("mathord" "\\msanseight" #X1D7EA "𝟪")
+ ("mathord" "\\msansfive" #X1D7E7 "𝟧")
+ ("mathord" "\\msansfour" #X1D7E6 "𝟦")
+ ("mathord" "\\msansnine" #X1D7EB "𝟫")
+ ("mathord" "\\msansone" #X1D7E3 "𝟣")
+ ("mathord" "\\msansseven" #X1D7E9 "𝟩")
+ ("mathord" "\\msanssix" #X1D7E8 "𝟨")
+ ("mathord" "\\msansthree" #X1D7E5 "𝟥")
+ ("mathord" "\\msanstwo" #X1D7E4 "𝟤")
+ ("mathord" "\\msanszero" #X1D7E2 "𝟢")
+ ("mathord" "\\mtteight" #X1D7FE "𝟾")
+ ("mathord" "\\mttfive" #X1D7FB "𝟻")
+ ("mathord" "\\mttfour" #X1D7FA "𝟺")
+ ("mathord" "\\mttnine" #X1D7FF "𝟿")
+ ("mathord" "\\mttone" #X1D7F7 "𝟷")
+ ("mathord" "\\mttseven" #X1D7FD "𝟽")
+ ("mathord" "\\mttsix" #X1D7FC "𝟼")
+ ("mathord" "\\mttthree" #X1D7F9 "𝟹")
+ ("mathord" "\\mtttwo" #X1D7F8 "𝟸")
+ ("mathord" "\\mttzero" #X1D7F6 "𝟶")
+ ("mathord" "\\nHdownarrow" #X021DF "⇟")
+ ("mathord" "\\nHuparrow" #X021DE "⇞")
+ ("mathord" "\\nabla" #X02207 "∇")
+ ("mathord" "\\natural" #X0266E "♮")
+ ("mathord" "\\neg" #X000AC "¬")
+ ("mathord" "\\neovnwarrow" #X02931 "⤱")
+ ("mathord" "\\neovsearrow" #X0292E "⤮")
+ ("mathord" "\\neuter" #X026B2 "⚲")
+ ("mathord" "\\nexists" #X02204 "∄")
+ ("mathord" "\\nvinfty" #X029DE "⧞")
+ ("mathord" "\\nwovnearrow" #X02932 "⤲")
+ ("mathord" "\\obot" #X029BA "⦺")
+ ("mathord" "\\obrbrak" #X023E0 "⏠")
+ ("mathord" "\\octothorpe" #X00023 "#")
+ ("mathord" "\\odotslashdot" #X029BC "⦼")
+ ("mathord" "\\olcross" #X029BB "⦻")
+ ("mathord" "\\parallelogram" #X025B1 "▱")
+ ("mathord" "\\parallelogramblack" #X025B0 "▰")
+ ("mathord" "\\partial" #X02202 "∂")
+ ("mathord" "\\pentagon" #X02B20 "⬠")
+ ("mathord" "\\pentagonblack" #X02B1F "⬟")
+ ("mathord" "\\percent" #X00025 "%")
+ ("mathord" "\\perps" #X02AE1 "⫡")
+ ("mathord" "\\postalmark" #X03012 "〒")
+ ("mathord" "\\prime" #X02032 "′")
+ ("mathord" "\\profline" #X02312 "⌒")
+ ("mathord" "\\profsurf" #X02313 "⌓")
+ ("mathord" "\\qprime" #X02057 "⁗")
+ ("mathord" "\\quarternote" #X02669 "♩")
+ ("mathord" "\\question" #X0003F "?")
+ ("mathord" "\\rangledownzigzagarrow" #X0237C "⍼")
+ ("mathord" "\\rbracelend" #X023AD "⎭")
+ ("mathord" "\\rbracemid" #X023AC "⎬")
+ ("mathord" "\\rbraceuend" #X023AB "⎫")
+ ("mathord" "\\rbrackextender" #X023A5 "⎥")
+ ("mathord" "\\rbracklend" #X023A6 "⎦")
+ ("mathord" "\\rbrackuend" #X023A4 "⎤")
+ ("mathord" "\\rdiagovfdiag" #X0292B "⤫")
+ ("mathord" "\\rdiagovsearrow" #X02930 "⤰")
+ ("mathord" "\\revangle" #X029A3 "⦣")
+ ("mathord" "\\revangleubar" #X029A5 "⦥")
+ ("mathord" "\\revemptyset" #X029B0 "⦰")
+ ("mathord" "\\rightangle" #X0221F "∟")
+ ("mathord" "\\rightanglemdot" #X0299D "⦝")
+ ("mathord" "\\rightanglesqr" #X0299C "⦜")
+ ("mathord" "\\rightdasharrow" #X021E2 "⇢")
+ ("mathord" "\\rightmoon" #X0263D "☽")
+ ("mathord" "\\rightpentagon" #X02B54 "⭔")
+ ("mathord" "\\rightpentagonblack" #X02B53 "⭓")
+ ("mathord" "\\rightwhitearrow" #X021E8 "⇨")
+ ("mathord" "\\rmoustache" #X023B1 "⎱")
+ ("mathord" "\\rparenextender" #X0239F "⎟")
+ ("mathord" "\\rparenlend" #X023A0 "⎠")
+ ("mathord" "\\rparenuend" #X0239E "⎞")
+ ("mathord" "\\rvboxline" #X023B9 "⎹")
+ ("mathord" "\\sansLmirrored" #X02143 "⅃")
+ ("mathord" "\\sansLturned" #X02142 "⅂")
+ ("mathord" "\\seovnearrow" #X0292D "⤭")
+ ("mathord" "\\sharp" #X0266F "♯")
+ ("mathord" "\\sinewave" #X0223F "∿")
+ ("mathord" "\\smblkdiamond" #X02B29 "⬩")
+ ("mathord" "\\smblklozenge" #X02B2A "⬪")
+ ("mathord" "\\smblksquare" #X025AA "▪")
+ ("mathord" "\\smwhitestar" #X02B52 "⭒")
+ ("mathord" "\\smwhtcircle" #X025E6 "◦")
+ ("mathord" "\\smwhtlozenge" #X02B2B "⬫")
+ ("mathord" "\\smwhtsquare" #X025AB "▫")
+ ("mathord" "\\spadesuit" #X02660 "♠")
+ ("mathord" "\\sphericalangle" #X02222 "∢")
+ ("mathord" "\\sphericalangleup" #X029A1 "⦡")
+ ("mathord" "\\sqlozenge" #X02311 "⌑")
+ ("mathord" "\\sqrtbottom" #X023B7 "⎷")
+ ("mathord" "\\squarebotblack" #X02B13 "⬓")
+ ("mathord" "\\squarecrossfill" #X025A9 "▩")
+ ("mathord" "\\squarehfill" #X025A4 "▤")
+ ("mathord" "\\squarehvfill" #X025A6 "▦")
+ ("mathord" "\\squareleftblack" #X025E7 "◧")
+ ("mathord" "\\squarellblack" #X02B15 "⬕")
+ ("mathord" "\\squarellquad" #X025F1 "◱")
+ ("mathord" "\\squarelrblack" #X025EA "◪")
+ ("mathord" "\\squarelrquad" #X025F2 "◲")
+ ("mathord" "\\squareneswfill" #X025A8 "▨")
+ ("mathord" "\\squarenwsefill" #X025A7 "▧")
+ ("mathord" "\\squarerightblack" #X025E8 "◨")
+ ("mathord" "\\squaretopblack" #X02B12 "⬒")
+ ("mathord" "\\squareulblack" #X025E9 "◩")
+ ("mathord" "\\squareulquad" #X025F0 "◰")
+ ("mathord" "\\squareurblack" #X02B14 "⬔")
+ ("mathord" "\\squareurquad" #X025F3 "◳")
+ ("mathord" "\\squarevfill" #X025A5 "▥")
+ ("mathord" "\\squoval" #X025A2 "▢")
+ ("mathord" "\\sterling" #X000A3 "£")
+ ("mathord" "\\strns" #X023E4 "⏤")
+ ("mathord" "\\subsetcirc" #X027C3 "⟃")
+ ("mathord" "\\sumbottom" #X023B3 "⎳")
+ ("mathord" "\\sumtop" #X023B2 "⎲")
+ ("mathord" "\\sun" #X0263C "☼")
+ ("mathord" "\\supsetcirc" #X027C4 "⟄")
+ ("mathord" "\\therefore" #X02234 "∴")
+ ("mathord" "\\thermod" #X029E7 "⧧")
+ ("mathord" "\\threedangle" #X027C0 "⟀")
+ ("mathord" "\\tieinfty" #X029DD "⧝")
+ ("mathord" "\\top" #X022A4 "⊤")
+ ("mathord" "\\topbot" #X02336 "⌶")
+ ("mathord" "\\topcir" #X02AF1 "⫱")
+ ("mathord" "\\topsemicircle" #X025E0 "◠")
+ ("mathord" "\\trapezium" #X023E2 "⏢")
+ ("mathord" "\\trianglecdot" #X025EC "◬")
+ ("mathord" "\\triangleleftblack" #X025ED "◭")
+ ("mathord" "\\triangleodot" #X029CA "⧊")
+ ("mathord" "\\trianglerightblack" #X025EE "◮")
+ ("mathord" "\\triangles" #X029CC "⧌")
+ ("mathord" "\\triangleubar" #X029CB "⧋")
+ ("mathord" "\\trprime" #X02034 "‴")
+ ("mathord" "\\turnangle" #X029A2 "⦢")
+ ("mathord" "\\turnednot" #X02319 "⌙")
+ ("mathord" "\\twolowline" #X02017 "‗")
+ ("mathord" "\\twonotes" #X0266B "♫")
+ ("mathord" "\\ubrbrak" #X023E1 "⏡")
+ ("mathord" "\\ularc" #X025DC "◜")
+ ("mathord" "\\ulblacktriangle" #X025E4 "◤")
+ ("mathord" "\\ultriangle" #X025F8 "◸")
+ ("mathord" "\\unicodecdots" #X022EF "⋯")
+ ("mathord" "\\unicodeellipsis" #X02026 "…")
+ ("mathord" "\\uparrowoncircle" #X029BD "⦽")
+ ("mathord" "\\upbackepsilon" #X003F6 "϶")
+ ("mathord" "\\updasharrow" #X021E1 "⇡")
+ ("mathord" "\\updownarrowbar" #X021A8 "↨")
+ ("mathord" "\\upoldKoppa" #X003D8 "Ϙ")
+ ("mathord" "\\upoldkoppa" #X003D9 "ϙ")
+ ("mathord" "\\uprightcurvearrow" #X02934 "⤴")
+ ("mathord" "\\upwhitearrow" #X021E7 "⇧")
+ ("mathord" "\\urarc" #X025DD "◝")
+ ("mathord" "\\urblacktriangle" #X025E5 "◥")
+ ("mathord" "\\urtriangle" #X025F9 "◹")
+ ("mathord" "\\varcarriagereturn" #X023CE "⏎")
+ ("mathord" "\\varclubsuit" #X02667 "♧")
+ ("mathord" "\\vardiamondsuit" #X02666 "♦")
+ ("mathord" "\\varheartsuit" #X02665 "♥")
+ ("mathord" "\\varhexagon" #X02B21 "⬡")
+ ("mathord" "\\varhexagonblack" #X02B22 "⬢")
+ ("mathord" "\\varhexagonlrbonds" #X0232C "⌬")
+ ("mathord" "\\varlrtriangle" #X022BF "⊿")
+ ("mathord" "\\varnothing" #X02205 "∅")
+ ("mathord" "\\varspadesuit" #X02664 "♤")
+ ("mathord" "\\varstar" #X02736 "✶")
+ ("mathord" "\\vbraceextender" #X023AA "⎪")
+ ("mathord" "\\viewdata" #X02317 "⌗")
+ ("mathord" "\\vrectangle" #X025AF "▯")
+ ("mathord" "\\vrectangleblack" #X025AE "▮")
+ ("mathord" "\\vysmblksquare" #X02B1D "⬝")
+ ("mathord" "\\vysmwhtsquare" #X02B1E "⬞")
+ ("mathord" "\\vzigzag" #X0299A "⦚")
+ ("mathord" "\\whitearrowupfrombar" #X021EA "⇪")
+ ("mathord" "\\whiteinwhitetriangle" #X027C1 "⟁")
+ ("mathord" "\\whitepointerleft" #X025C5 "◅")
+ ("mathord" "\\whitepointerright" #X025BB "▻")
+ ("mathord" "\\whthorzoval" #X02B2D "⬭")
+ ("mathord" "\\whtvertoval" #X02B2F "⬯")
+ ("mathord" "\\wideangledown" #X029A6 "⦦")
+ ("mathord" "\\wideangleup" #X029A7 "⦧")
+ ("mathord" "\\yen" #X000A5 "¥")
+ ("mathover" "\\overbrace" #X023DE "⏞")
+ ("mathover" "\\overbracket" #X023B4 "⎴")
+ ("mathover" "\\overparen" #X023DC "⏜")
+ ("mathpunct" "\\comma" #X0002C ",")
+ ("mathpunct" "\\exclam" #X00021 "!")
+ ("mathpunct" "\\mathcolon" #X0003A ":")
+ ("mathpunct" "\\semicolon" #X0003B ";")
+ ("mathradical" "\\cuberoot" #X0221B "∛")
+ ("mathradical" "\\fourthroot" #X0221C "∜")
+ ("mathradical" "\\sqrt" #X0221A "√")
+ ("mathrel" "\\APLnotslash" #X0233F "⌿")
+ ("mathrel" "\\Barv" #X02AE7 "⫧")
+ ("mathrel" "\\Bumpeq" #X0224E "≎")
+ ("mathrel" "\\Colon" #X02237 "∷")
+ ("mathrel" "\\Coloneq" #X02A74 "⩴")
+ ("mathrel" "\\DDownarrow" #X027F1 "⟱")
+ ("mathrel" "\\DashV" #X02AE5 "⫥")
+ ("mathrel" "\\DashVDash" #X027DA "⟚")
+ ("mathrel" "\\Dashv" #X02AE4 "⫤")
+ ("mathrel" "\\Ddownarrow" #X0290B "⤋")
+ ("mathrel" "\\Doteq" #X02251 "≑")
+ ("mathrel" "\\Downarrow" #X021D3 "⇓")
+ ("mathrel" "\\Equiv" #X02263 "≣")
+ ("mathrel" "\\Gt" #X02AA2 "⪢")
+ ("mathrel" "\\LLeftarrow" #X02B45 "⭅")
+ ("mathrel" "\\Ldsh" #X021B2 "↲")
+ ("mathrel" "\\Leftarrow" #X021D0 "⇐")
+ ("mathrel" "\\Leftrightarrow" #X021D4 "⇔")
+ ("mathrel" "\\Lleftarrow" #X021DA "⇚")
+ ("mathrel" "\\Longleftarrow" #X027F8 "⟸")
+ ("mathrel" "\\Longleftrightarrow" #X027FA "⟺")
+ ("mathrel" "\\Longmapsfrom" #X027FD "⟽")
+ ("mathrel" "\\Longmapsto" #X027FE "⟾")
+ ("mathrel" "\\Longrightarrow" #X027F9 "⟹")
+ ("mathrel" "\\Lsh" #X021B0 "↰")
+ ("mathrel" "\\Lt" #X02AA1 "⪡")
+ ("mathrel" "\\Mapsfrom" #X02906 "⤆")
+ ("mathrel" "\\Mapsto" #X02907 "⤇")
+ ("mathrel" "\\Nearrow" #X021D7 "⇗")
+ ("mathrel" "\\Not" #X02AEC "⫬")
+ ("mathrel" "\\Nwarrow" #X021D6 "⇖")
+ ("mathrel" "\\Prec" #X02ABB "⪻")
+ ("mathrel" "\\RRightarrow" #X02B46 "⭆")
+ ("mathrel" "\\Rdsh" #X021B3 "↳")
+ ("mathrel" "\\Rightarrow" #X021D2 "⇒")
+ ("mathrel" "\\Rrightarrow" #X021DB "⇛")
+ ("mathrel" "\\Rsh" #X021B1 "↱")
+ ("mathrel" "\\Searrow" #X021D8 "⇘")
+ ("mathrel" "\\Subset" #X022D0 "⋐")
+ ("mathrel" "\\Succ" #X02ABC "⪼")
+ ("mathrel" "\\Supset" #X022D1 "⋑")
+ ("mathrel" "\\Swarrow" #X021D9 "⇙")
+ ("mathrel" "\\UUparrow" #X027F0 "⟰")
+ ("mathrel" "\\Uparrow" #X021D1 "⇑")
+ ("mathrel" "\\Updownarrow" #X021D5 "⇕")
+ ("mathrel" "\\Uuparrow" #X0290A "⤊")
+ ("mathrel" "\\VDash" #X022AB "⊫")
+ ("mathrel" "\\Vbar" #X02AEB "⫫")
+ ("mathrel" "\\Vdash" #X022A9 "⊩")
+ ("mathrel" "\\Vvdash" #X022AA "⊪")
+ ("mathrel" "\\acwcirclearrow" #X02940 "⥀")
+ ("mathrel" "\\acwgapcirclearrow" #X027F2 "⟲")
+ ("mathrel" "\\acwleftarcarrow" #X02939 "⤹")
+ ("mathrel" "\\acwoverarcarrow" #X0293A "⤺")
+ ("mathrel" "\\acwunderarcarrow" #X0293B "⤻")
+ ("mathrel" "\\adots" #X022F0 "⋰")
+ ("mathrel" "\\approx" #X02248 "≈")
+ ("mathrel" "\\approxeq" #X0224A "≊")
+ ("mathrel" "\\approxeqq" #X02A70 "⩰")
+ ("mathrel" "\\approxident" #X0224B "≋")
+ ("mathrel" "\\arceq" #X02258 "≘")
+ ("mathrel" "\\assert" #X022A6 "⊦")
+ ("mathrel" "\\asteq" #X02A6E "⩮")
+ ("mathrel" "\\asymp" #X0224D "≍")
+ ("mathrel" "\\bNot" #X02AED "⫭")
+ ("mathrel" "\\backcong" #X0224C "≌")
+ ("mathrel" "\\backsim" #X0223D "∽")
+ ("mathrel" "\\backsimeq" #X022CD "⋍")
+ ("mathrel" "\\bagmember" #X022FF "⋿")
+ ("mathrel" "\\barV" #X02AEA "⫪")
+ ("mathrel" "\\bardownharpoonleft" #X02961 "⥡")
+ ("mathrel" "\\bardownharpoonright" #X0295D "⥝")
+ ("mathrel" "\\barleftarrow" #X021E4 "⇤")
+ ("mathrel" "\\barleftharpoondown" #X02956 "⥖")
+ ("mathrel" "\\barleftharpoonup" #X02952 "⥒")
+ ("mathrel" "\\barrightarrowdiamond" #X02920 "⤠")
+ ("mathrel" "\\barrightharpoondown" #X0295F "⥟")
+ ("mathrel" "\\barrightharpoonup" #X0295B "⥛")
+ ("mathrel" "\\baruparrow" #X02912 "⤒")
+ ("mathrel" "\\barupharpoonleft" #X02958 "⥘")
+ ("mathrel" "\\barupharpoonright" #X02954 "⥔")
+ ("mathrel" "\\between" #X0226C "≬")
+ ("mathrel" "\\bowtie" #X022C8 "⋈")
+ ("mathrel" "\\bsimilarleftarrow" #X02B41 "⭁")
+ ("mathrel" "\\bsimilarrightarrow" #X02B47 "⭇")
+ ("mathrel" "\\bsolhsub" #X027C8 "⟈")
+ ("mathrel" "\\bumpeq" #X0224F "≏")
+ ("mathrel" "\\bumpeqq" #X02AAE "⪮")
+ ("mathrel" "\\ccwundercurvearrow" #X0293F "⤿")
+ ("mathrel" "\\cirbot" #X027DF "⟟")
+ ("mathrel" "\\circeq" #X02257 "≗")
+ ("mathrel" "\\circleonleftarrow" #X02B30 "⬰")
+ ("mathrel" "\\circleonrightarrow" #X021F4 "⇴")
+ ("mathrel" "\\cirmid" #X02AEF "⫯")
+ ("mathrel" "\\closure" #X02050 "⁐")
+ ("mathrel" "\\coloneq" #X02254 "≔")
+ ("mathrel" "\\cong" #X02245 "≅")
+ ("mathrel" "\\congdot" #X02A6D "⩭")
+ ("mathrel" "\\csub" #X02ACF "⫏")
+ ("mathrel" "\\csube" #X02AD1 "⫑")
+ ("mathrel" "\\csup" #X02AD0 "⫐")
+ ("mathrel" "\\csupe" #X02AD2 "⫒")
+ ("mathrel" "\\curlyeqprec" #X022DE "⋞")
+ ("mathrel" "\\curlyeqsucc" #X022DF "⋟")
+ ("mathrel" "\\curvearrowleft" #X021B6 "↶")
+ ("mathrel" "\\curvearrowleftplus" #X0293D "⤽")
+ ("mathrel" "\\curvearrowright" #X021B7 "↷")
+ ("mathrel" "\\curvearrowrightminus" #X0293C "⤼")
+ ("mathrel" "\\cwcirclearrow" #X02941 "⥁")
+ ("mathrel" "\\cwgapcirclearrow" #X027F3 "⟳")
+ ("mathrel" "\\cwrightarcarrow" #X02938 "⤸")
+ ("mathrel" "\\cwundercurvearrow" #X0293E "⤾")
+ ("mathrel" "\\dashV" #X02AE3 "⫣")
+ ("mathrel" "\\dashVdash" #X027DB "⟛")
+ ("mathrel" "\\dashcolon" #X02239 "∹")
+ ("mathrel" "\\dashleftharpoondown" #X0296B "⥫")
+ ("mathrel" "\\dashrightharpoondown" #X0296D "⥭")
+ ("mathrel" "\\dashv" #X022A3 "⊣")
+ ("mathrel" "\\dbkarow" #X0290F "⤏")
+ ("mathrel" "\\ddots" #X022F1 "⋱")
+ ("mathrel" "\\ddotseq" #X02A77 "⩷")
+ ("mathrel" "\\diamondleftarrow" #X0291D "⤝")
+ ("mathrel" "\\diamondleftarrowbar" #X0291F "⤟")
+ ("mathrel" "\\disin" #X022F2 "⋲")
+ ("mathrel" "\\doteq" #X02250 "≐")
+ ("mathrel" "\\dotequiv" #X02A67 "⩧")
+ ("mathrel" "\\dotsim" #X02A6A "⩪")
+ ("mathrel" "\\dotsminusdots" #X0223A "∺")
+ ("mathrel" "\\downarrow" #X02193 "↓")
+ ("mathrel" "\\downarrowbar" #X02913 "⤓")
+ ("mathrel" "\\downarrowbarred" #X02908 "⤈")
+ ("mathrel" "\\downdownarrows" #X021CA "⇊")
+ ("mathrel" "\\downfishtail" #X0297F "⥿")
+ ("mathrel" "\\downharpoonleft" #X021C3 "⇃")
+ ("mathrel" "\\downharpoonleftbar" #X02959 "⥙")
+ ("mathrel" "\\downharpoonright" #X021C2 "⇂")
+ ("mathrel" "\\downharpoonrightbar" #X02955 "⥕")
+ ("mathrel" "\\downharpoonsleftright" #X02965 "⥥")
+ ("mathrel" "\\downuparrows" #X021F5 "⇵")
+ ("mathrel" "\\downupharpoonsleftright" #X0296F "⥯")
+ ("mathrel" "\\downzigzagarrow" #X021AF "↯")
+ ("mathrel" "\\drbkarow" #X02910 "⤐")
+ ("mathrel" "\\dualmap" #X029DF "⧟")
+ ("mathrel" "\\egsdot" #X02A98 "⪘")
+ ("mathrel" "\\elsdot" #X02A97 "⪗")
+ ("mathrel" "\\eparsl" #X029E3 "⧣")
+ ("mathrel" "\\eqcirc" #X02256 "≖")
+ ("mathrel" "\\eqcolon" #X02255 "≕")
+ ("mathrel" "\\eqdef" #X0225D "≝")
+ ("mathrel" "\\eqdot" #X02A66 "⩦")
+ ("mathrel" "\\eqeq" #X02A75 "⩵")
+ ("mathrel" "\\eqeqeq" #X02A76 "⩶")
+ ("mathrel" "\\eqgtr" #X022DD "⋝")
+ ("mathrel" "\\eqless" #X022DC "⋜")
+ ("mathrel" "\\eqqgtr" #X02A9A "⪚")
+ ("mathrel" "\\eqqless" #X02A99 "⪙")
+ ("mathrel" "\\eqqsim" #X02A73 "⩳")
+ ("mathrel" "\\eqqslantgtr" #X02A9C "⪜")
+ ("mathrel" "\\eqqslantless" #X02A9B "⪛")
+ ("mathrel" "\\eqsim" #X02242 "≂")
+ ("mathrel" "\\eqslantgtr" #X02A96 "⪖")
+ ("mathrel" "\\eqslantless" #X02A95 "⪕")
+ ("mathrel" "\\equal" #X0003D "=")
+ ("mathrel" "\\equalleftarrow" #X02B40 "⭀")
+ ("mathrel" "\\equalparallel" #X022D5 "⋕")
+ ("mathrel" "\\equalrightarrow" #X02971 "⥱")
+ ("mathrel" "\\equiv" #X02261 "≡")
+ ("mathrel" "\\equivDD" #X02A78 "⩸")
+ ("mathrel" "\\equivVert" #X02A68 "⩨")
+ ("mathrel" "\\equivVvert" #X02A69 "⩩")
+ ("mathrel" "\\eqvparsl" #X029E5 "⧥")
+ ("mathrel" "\\fallingdotseq" #X02252 "≒")
+ ("mathrel" "\\fbowtie" #X029D3 "⧓")
+ ("mathrel" "\\forks" #X02ADC "⫝̸")
+ ("mathrel" "\\forksnot" #X02ADD "⫝")
+ ("mathrel" "\\forkv" #X02AD9 "⫙")
+ ("mathrel" "\\frown" #X02322 "⌢")
+ ("mathrel" "\\geq" #X02265 "≥")
+ ("mathrel" "\\geqq" #X02267 "≧")
+ ("mathrel" "\\geqqslant" #X02AFA "⫺")
+ ("mathrel" "\\geqslant" #X02A7E "⩾")
+ ("mathrel" "\\gescc" #X02AA9 "⪩")
+ ("mathrel" "\\gesdot" #X02A80 "⪀")
+ ("mathrel" "\\gesdoto" #X02A82 "⪂")
+ ("mathrel" "\\gesdotol" #X02A84 "⪄")
+ ("mathrel" "\\gesles" #X02A94 "⪔")
+ ("mathrel" "\\gg" #X0226B "≫")
+ ("mathrel" "\\ggg" #X022D9 "⋙")
+ ("mathrel" "\\gggnest" #X02AF8 "⫸")
+ ("mathrel" "\\glE" #X02A92 "⪒")
+ ("mathrel" "\\gla" #X02AA5 "⪥")
+ ("mathrel" "\\gleichstark" #X029E6 "⧦")
+ ("mathrel" "\\glj" #X02AA4 "⪤")
+ ("mathrel" "\\gnapprox" #X02A8A "⪊")
+ ("mathrel" "\\gneq" #X02A88 "⪈")
+ ("mathrel" "\\gneqq" #X02269 "≩")
+ ("mathrel" "\\gnsim" #X022E7 "⋧")
+ ("mathrel" "\\greater" #X0003E ">")
+ ("mathrel" "\\gsime" #X02A8E "⪎")
+ ("mathrel" "\\gsiml" #X02A90 "⪐")
+ ("mathrel" "\\gtcc" #X02AA7 "⪧")
+ ("mathrel" "\\gtcir" #X02A7A "⩺")
+ ("mathrel" "\\gtquest" #X02A7C "⩼")
+ ("mathrel" "\\gtrapprox" #X02A86 "⪆")
+ ("mathrel" "\\gtrarr" #X02978 "⥸")
+ ("mathrel" "\\gtrdot" #X022D7 "⋗")
+ ("mathrel" "\\gtreqless" #X022DB "⋛")
+ ("mathrel" "\\gtreqqless" #X02A8C "⪌")
+ ("mathrel" "\\gtrless" #X02277 "≷")
+ ("mathrel" "\\gtrsim" #X02273 "≳")
+ ("mathrel" "\\hatapprox" #X02A6F "⩯")
+ ("mathrel" "\\hknearrow" #X02924 "⤤")
+ ("mathrel" "\\hknwarrow" #X02923 "⤣")
+ ("mathrel" "\\hksearow" #X02925 "⤥")
+ ("mathrel" "\\hkswarow" #X02926 "⤦")
+ ("mathrel" "\\hookleftarrow" #X021A9 "↩")
+ ("mathrel" "\\hookrightarrow" #X021AA "↪")
+ ("mathrel" "\\imageof" #X022B7 "⊷")
+ ("mathrel" "\\in" #X02208 "∈")
+ ("mathrel" "\\isinE" #X022F9 "⋹")
+ ("mathrel" "\\isindot" #X022F5 "⋵")
+ ("mathrel" "\\isinobar" #X022F7 "⋷")
+ ("mathrel" "\\isins" #X022F4 "⋴")
+ ("mathrel" "\\isinvb" #X022F8 "⋸")
+ ("mathrel" "\\kernelcontraction" #X0223B "∻")
+ ("mathrel" "\\lat" #X02AAB "⪫")
+ ("mathrel" "\\late" #X02AAD "⪭")
+ ("mathrel" "\\leftarrow" #X02190 "←")
+ ("mathrel" "\\leftarrowapprox" #X02B4A "⭊")
+ ("mathrel" "\\leftarrowbackapprox" #X02B42 "⭂")
+ ("mathrel" "\\leftarrowbsimilar" #X02B4B "⭋")
+ ("mathrel" "\\leftarrowless" #X02977 "⥷")
+ ("mathrel" "\\leftarrowonoplus" #X02B32 "⬲")
+ ("mathrel" "\\leftarrowplus" #X02946 "⥆")
+ ("mathrel" "\\leftarrowshortrightarrow" #X02943 "⥃")
+ ("mathrel" "\\leftarrowsimilar" #X02973 "⥳")
+ ("mathrel" "\\leftarrowsubset" #X0297A "⥺")
+ ("mathrel" "\\leftarrowtail" #X021A2 "↢")
+ ("mathrel" "\\leftarrowtriangle" #X021FD "⇽")
+ ("mathrel" "\\leftarrowx" #X02B3E "⬾")
+ ("mathrel" "\\leftbkarrow" #X0290C "⤌")
+ ("mathrel" "\\leftcurvedarrow" #X02B3F "⬿")
+ ("mathrel" "\\leftdbkarrow" #X0290E "⤎")
+ ("mathrel" "\\leftdbltail" #X0291B "⤛")
+ ("mathrel" "\\leftdotarrow" #X02B38 "⬸")
+ ("mathrel" "\\leftdowncurvedarrow" #X02936 "⤶")
+ ("mathrel" "\\leftfishtail" #X0297C "⥼")
+ ("mathrel" "\\leftharpoondown" #X021BD "↽")
+ ("mathrel" "\\leftharpoondownbar" #X0295E "⥞")
+ ("mathrel" "\\leftharpoonsupdown" #X02962 "⥢")
+ ("mathrel" "\\leftharpoonup" #X021BC "↼")
+ ("mathrel" "\\leftharpoonupbar" #X0295A "⥚")
+ ("mathrel" "\\leftharpoonupdash" #X0296A "⥪")
+ ("mathrel" "\\leftleftarrows" #X021C7 "⇇")
+ ("mathrel" "\\leftrightarrow" #X02194 "↔")
+ ("mathrel" "\\leftrightarrowcircle" #X02948 "⥈")
+ ("mathrel" "\\leftrightarrows" #X021C6 "⇆")
+ ("mathrel" "\\leftrightarrowtriangle" #X021FF "⇿")
+ ("mathrel" "\\leftrightharpoondowndown" #X02950 "⥐")
+ ("mathrel" "\\leftrightharpoondownup" #X0294B "⥋")
+ ("mathrel" "\\leftrightharpoons" #X021CB "⇋")
+ ("mathrel" "\\leftrightharpoonsdown" #X02967 "⥧")
+ ("mathrel" "\\leftrightharpoonsup" #X02966 "⥦")
+ ("mathrel" "\\leftrightharpoonupdown" #X0294A "⥊")
+ ("mathrel" "\\leftrightharpoonupup" #X0294E "⥎")
+ ("mathrel" "\\leftrightsquigarrow" #X021AD "↭")
+ ("mathrel" "\\leftsquigarrow" #X021DC "⇜")
+ ("mathrel" "\\lefttail" #X02919 "⤙")
+ ("mathrel" "\\leftthreearrows" #X02B31 "⬱")
+ ("mathrel" "\\leftwavearrow" #X0219C "↜")
+ ("mathrel" "\\leq" #X02264 "≤")
+ ("mathrel" "\\leqq" #X02266 "≦")
+ ("mathrel" "\\leqqslant" #X02AF9 "⫹")
+ ("mathrel" "\\leqslant" #X02A7D "⩽")
+ ("mathrel" "\\lescc" #X02AA8 "⪨")
+ ("mathrel" "\\lesdot" #X02A7F "⩿")
+ ("mathrel" "\\lesdoto" #X02A81 "⪁")
+ ("mathrel" "\\lesdotor" #X02A83 "⪃")
+ ("mathrel" "\\lesges" #X02A93 "⪓")
+ ("mathrel" "\\less" #X0003C "<")
+ ("mathrel" "\\lessapprox" #X02A85 "⪅")
+ ("mathrel" "\\lessdot" #X022D6 "⋖")
+ ("mathrel" "\\lesseqgtr" #X022DA "⋚")
+ ("mathrel" "\\lesseqqgtr" #X02A8B "⪋")
+ ("mathrel" "\\lessgtr" #X02276 "≶")
+ ("mathrel" "\\lesssim" #X02272 "≲")
+ ("mathrel" "\\lfbowtie" #X029D1 "⧑")
+ ("mathrel" "\\lftimes" #X029D4 "⧔")
+ ("mathrel" "\\lgE" #X02A91 "⪑")
+ ("mathrel" "\\ll" #X0226A "≪")
+ ("mathrel" "\\lll" #X022D8 "⋘")
+ ("mathrel" "\\lllnest" #X02AF7 "⫷")
+ ("mathrel" "\\lnapprox" #X02A89 "⪉")
+ ("mathrel" "\\lneq" #X02A87 "⪇")
+ ("mathrel" "\\lneqq" #X02268 "≨")
+ ("mathrel" "\\lnsim" #X022E6 "⋦")
+ ("mathrel" "\\longdashv" #X027DE "⟞")
+ ("mathrel" "\\longleftarrow" #X027F5 "⟵")
+ ("mathrel" "\\longleftrightarrow" #X027F7 "⟷")
+ ("mathrel" "\\longleftsquigarrow" #X02B33 "⬳")
+ ("mathrel" "\\longmapsfrom" #X027FB "⟻")
+ ("mathrel" "\\longmapsto" #X027FC "⟼")
+ ("mathrel" "\\longrightarrow" #X027F6 "⟶")
+ ("mathrel" "\\longrightsquigarrow" #X027FF "⟿")
+ ("mathrel" "\\looparrowleft" #X021AB "↫")
+ ("mathrel" "\\looparrowright" #X021AC "↬")
+ ("mathrel" "\\lrtriangleeq" #X029E1 "⧡")
+ ("mathrel" "\\lsime" #X02A8D "⪍")
+ ("mathrel" "\\lsimg" #X02A8F "⪏")
+ ("mathrel" "\\lsqhook" #X02ACD "⫍")
+ ("mathrel" "\\ltcc" #X02AA6 "⪦")
+ ("mathrel" "\\ltcir" #X02A79 "⩹")
+ ("mathrel" "\\ltlarr" #X02976 "⥶")
+ ("mathrel" "\\ltquest" #X02A7B "⩻")
+ ("mathrel" "\\ltrivb" #X029CF "⧏")
+ ("mathrel" "\\mapsdown" #X021A7 "↧")
+ ("mathrel" "\\mapsfrom" #X021A4 "↤")
+ ("mathrel" "\\mapsto" #X021A6 "↦")
+ ("mathrel" "\\mapsup" #X021A5 "↥")
+ ("mathrel" "\\mathratio" #X02236 "∶")
+ ("mathrel" "\\measeq" #X0225E "≞")
+ ("mathrel" "\\mid" #X02223 "∣")
+ ("mathrel" "\\midcir" #X02AF0 "⫰")
+ ("mathrel" "\\mlcp" #X02ADB "⫛")
+ ("mathrel" "\\models" #X022A7 "⊧")
+ ("mathrel" "\\multimap" #X022B8 "⊸")
+ ("mathrel" "\\multimapinv" #X027DC "⟜")
+ ("mathrel" "\\nLeftarrow" #X021CD "⇍")
+ ("mathrel" "\\nLeftrightarrow" #X021CE "⇎")
+ ("mathrel" "\\nRightarrow" #X021CF "⇏")
+ ("mathrel" "\\nVDash" #X022AF "⊯")
+ ("mathrel" "\\nVdash" #X022AE "⊮")
+ ("mathrel" "\\nVleftarrow" #X021FA "⇺")
+ ("mathrel" "\\nVleftarrowtail" #X02B3A "⬺")
+ ("mathrel" "\\nVleftrightarrow" #X021FC "⇼")
+ ("mathrel" "\\nVrightarrow" #X021FB "⇻")
+ ("mathrel" "\\nVrightarrowtail" #X02915 "⤕")
+ ("mathrel" "\\nVtwoheadleftarrow" #X02B35 "⬵")
+ ("mathrel" "\\nVtwoheadleftarrowtail" #X02B3D "⬽")
+ ("mathrel" "\\nVtwoheadrightarrow" #X02901 "⤁")
+ ("mathrel" "\\nVtwoheadrightarrowtail" #X02918 "⤘")
+ ("mathrel" "\\napprox" #X02249 "≉")
+ ("mathrel" "\\nasymp" #X0226D "≭")
+ ("mathrel" "\\ncong" #X02247 "≇")
+ ("mathrel" "\\ne" #X02260 "≠")
+ ("mathrel" "\\nearrow" #X02197 "↗")
+ ("mathrel" "\\nequiv" #X02262 "≢")
+ ("mathrel" "\\neswarrow" #X02922 "⤢")
+ ("mathrel" "\\ngeq" #X02271 "≱")
+ ("mathrel" "\\ngtr" #X0226F "≯")
+ ("mathrel" "\\ngtrless" #X02279 "≹")
+ ("mathrel" "\\ngtrsim" #X02275 "≵")
+ ("mathrel" "\\nhpar" #X02AF2 "⫲")
+ ("mathrel" "\\ni" #X0220B "∋")
+ ("mathrel" "\\niobar" #X022FE "⋾")
+ ("mathrel" "\\nis" #X022FC "⋼")
+ ("mathrel" "\\nisd" #X022FA "⋺")
+ ("mathrel" "\\nleftarrow" #X0219A "↚")
+ ("mathrel" "\\nleftrightarrow" #X021AE "↮")
+ ("mathrel" "\\nleq" #X02270 "≰")
+ ("mathrel" "\\nless" #X0226E "≮")
+ ("mathrel" "\\nlessgtr" #X02278 "≸")
+ ("mathrel" "\\nlesssim" #X02274 "≴")
+ ("mathrel" "\\nmid" #X02224 "∤")
+ ("mathrel" "\\nni" #X0220C "∌")
+ ("mathrel" "\\notin" #X02209 "∉")
+ ("mathrel" "\\nparallel" #X02226 "∦")
+ ("mathrel" "\\nprec" #X02280 "⊀")
+ ("mathrel" "\\npreccurlyeq" #X022E0 "⋠")
+ ("mathrel" "\\nrightarrow" #X0219B "↛")
+ ("mathrel" "\\nsim" #X02241 "≁")
+ ("mathrel" "\\nsime" #X02244 "≄")
+ ("mathrel" "\\nsqsubseteq" #X022E2 "⋢")
+ ("mathrel" "\\nsqsupseteq" #X022E3 "⋣")
+ ("mathrel" "\\nsubset" #X02284 "⊄")
+ ("mathrel" "\\nsubseteq" #X02288 "⊈")
+ ("mathrel" "\\nsucc" #X02281 "⊁")
+ ("mathrel" "\\nsucccurlyeq" #X022E1 "⋡")
+ ("mathrel" "\\nsupset" #X02285 "⊅")
+ ("mathrel" "\\nsupseteq" #X02289 "⊉")
+ ("mathrel" "\\ntriangleleft" #X022EA "⋪")
+ ("mathrel" "\\ntrianglelefteq" #X022EC "⋬")
+ ("mathrel" "\\ntriangleright" #X022EB "⋫")
+ ("mathrel" "\\ntrianglerighteq" #X022ED "⋭")
+ ("mathrel" "\\nvDash" #X022AD "⊭")
+ ("mathrel" "\\nvLeftarrow" #X02902 "⤂")
+ ("mathrel" "\\nvLeftrightarrow" #X02904 "⤄")
+ ("mathrel" "\\nvRightarrow" #X02903 "⤃")
+ ("mathrel" "\\nvdash" #X022AC "⊬")
+ ("mathrel" "\\nvleftarrow" #X021F7 "⇷")
+ ("mathrel" "\\nvleftarrowtail" #X02B39 "⬹")
+ ("mathrel" "\\nvleftrightarrow" #X021F9 "⇹")
+ ("mathrel" "\\nvrightarrow" #X021F8 "⇸")
+ ("mathrel" "\\nvrightarrowtail" #X02914 "⤔")
+ ("mathrel" "\\nvtwoheadleftarrow" #X02B34 "⬴")
+ ("mathrel" "\\nvtwoheadleftarrowtail" #X02B3C "⬼")
+ ("mathrel" "\\nvtwoheadrightarrow" #X02900 "⤀")
+ ("mathrel" "\\nvtwoheadrightarrowtail" #X02917 "⤗")
+ ("mathrel" "\\nwarrow" #X02196 "↖")
+ ("mathrel" "\\nwsearrow" #X02921 "⤡")
+ ("mathrel" "\\origof" #X022B6 "⊶")
+ ("mathrel" "\\parallel" #X02225 "∥")
+ ("mathrel" "\\parsim" #X02AF3 "⫳")
+ ("mathrel" "\\partialmeetcontraction" #X02AA3 "⪣")
+ ("mathrel" "\\perp" #X027C2 "⟂")
+ ("mathrel" "\\pitchfork" #X022D4 "⋔")
+ ("mathrel" "\\prec" #X0227A "≺")
+ ("mathrel" "\\precapprox" #X02AB7 "⪷")
+ ("mathrel" "\\preccurlyeq" #X0227C "≼")
+ ("mathrel" "\\preceq" #X02AAF "⪯")
+ ("mathrel" "\\preceqq" #X02AB3 "⪳")
+ ("mathrel" "\\precnapprox" #X02AB9 "⪹")
+ ("mathrel" "\\precneq" #X02AB1 "⪱")
+ ("mathrel" "\\precneqq" #X02AB5 "⪵")
+ ("mathrel" "\\precnsim" #X022E8 "⋨")
+ ("mathrel" "\\precsim" #X0227E "≾")
+ ("mathrel" "\\propto" #X0221D "∝")
+ ("mathrel" "\\prurel" #X022B0 "⊰")
+ ("mathrel" "\\pullback" #X027D3 "⟓")
+ ("mathrel" "\\pushout" #X027D4 "⟔")
+ ("mathrel" "\\questeq" #X0225F "≟")
+ ("mathrel" "\\revnmid" #X02AEE "⫮")
+ ("mathrel" "\\rfbowtie" #X029D2 "⧒")
+ ("mathrel" "\\rftimes" #X029D5 "⧕")
+ ("mathrel" "\\rightarrow" #X02192 "→")
+ ("mathrel" "\\rightarrowapprox" #X02975 "⥵")
+ ("mathrel" "\\rightarrowbackapprox" #X02B48 "⭈")
+ ("mathrel" "\\rightarrowbar" #X021E5 "⇥")
+ ("mathrel" "\\rightarrowbsimilar" #X02B4C "⭌")
+ ("mathrel" "\\rightarrowdiamond" #X0291E "⤞")
+ ("mathrel" "\\rightarrowgtr" #X02B43 "⭃")
+ ("mathrel" "\\rightarrowonoplus" #X027F4 "⟴")
+ ("mathrel" "\\rightarrowplus" #X02945 "⥅")
+ ("mathrel" "\\rightarrowshortleftarrow" #X02942 "⥂")
+ ("mathrel" "\\rightarrowsimilar" #X02974 "⥴")
+ ("mathrel" "\\rightarrowsupset" #X02B44 "⭄")
+ ("mathrel" "\\rightarrowtail" #X021A3 "↣")
+ ("mathrel" "\\rightarrowtriangle" #X021FE "⇾")
+ ("mathrel" "\\rightarrowx" #X02947 "⥇")
+ ("mathrel" "\\rightbkarrow" #X0290D "⤍")
+ ("mathrel" "\\rightcurvedarrow" #X02933 "⤳")
+ ("mathrel" "\\rightdbltail" #X0291C "⤜")
+ ("mathrel" "\\rightdotarrow" #X02911 "⤑")
+ ("mathrel" "\\rightdowncurvedarrow" #X02937 "⤷")
+ ("mathrel" "\\rightfishtail" #X0297D "⥽")
+ ("mathrel" "\\rightharpoondown" #X021C1 "⇁")
+ ("mathrel" "\\rightharpoondownbar" #X02957 "⥗")
+ ("mathrel" "\\rightharpoonsupdown" #X02964 "⥤")
+ ("mathrel" "\\rightharpoonup" #X021C0 "⇀")
+ ("mathrel" "\\rightharpoonupbar" #X02953 "⥓")
+ ("mathrel" "\\rightharpoonupdash" #X0296C "⥬")
+ ("mathrel" "\\rightimply" #X02970 "⥰")
+ ("mathrel" "\\rightleftarrows" #X021C4 "⇄")
+ ("mathrel" "\\rightleftharpoons" #X021CC "⇌")
+ ("mathrel" "\\rightleftharpoonsdown" #X02969 "⥩")
+ ("mathrel" "\\rightleftharpoonsup" #X02968 "⥨")
+ ("mathrel" "\\rightrightarrows" #X021C9 "⇉")
+ ("mathrel" "\\rightsquigarrow" #X021DD "⇝")
+ ("mathrel" "\\righttail" #X0291A "⤚")
+ ("mathrel" "\\rightthreearrows" #X021F6 "⇶")
+ ("mathrel" "\\rightwavearrow" #X0219D "↝")
+ ("mathrel" "\\risingdotseq" #X02253 "≓")
+ ("mathrel" "\\rsqhook" #X02ACE "⫎")
+ ("mathrel" "\\rtriltri" #X029CE "⧎")
+ ("mathrel" "\\ruledelayed" #X029F4 "⧴")
+ ("mathrel" "\\scurel" #X022B1 "⊱")
+ ("mathrel" "\\searrow" #X02198 "↘")
+ ("mathrel" "\\shortdowntack" #X02ADF "⫟")
+ ("mathrel" "\\shortlefttack" #X02ADE "⫞")
+ ("mathrel" "\\shortrightarrowleftarrow" #X02944 "⥄")
+ ("mathrel" "\\shortuptack" #X02AE0 "⫠")
+ ("mathrel" "\\sim" #X0223C "∼")
+ ("mathrel" "\\simeq" #X02243 "≃")
+ ("mathrel" "\\simgE" #X02AA0 "⪠")
+ ("mathrel" "\\simgtr" #X02A9E "⪞")
+ ("mathrel" "\\similarleftarrow" #X02B49 "⭉")
+ ("mathrel" "\\similarrightarrow" #X02972 "⥲")
+ ("mathrel" "\\simlE" #X02A9F "⪟")
+ ("mathrel" "\\simless" #X02A9D "⪝")
+ ("mathrel" "\\simminussim" #X02A6C "⩬")
+ ("mathrel" "\\simneqq" #X02246 "≆")
+ ("mathrel" "\\simrdots" #X02A6B "⩫")
+ ("mathrel" "\\smallin" #X0220A "∊")
+ ("mathrel" "\\smallni" #X0220D "∍")
+ ("mathrel" "\\smeparsl" #X029E4 "⧤")
+ ("mathrel" "\\smile" #X02323 "⌣")
+ ("mathrel" "\\smt" #X02AAA "⪪")
+ ("mathrel" "\\smte" #X02AAC "⪬")
+ ("mathrel" "\\sqsubset" #X0228F "⊏")
+ ("mathrel" "\\sqsubseteq" #X02291 "⊑")
+ ("mathrel" "\\sqsubsetneq" #X022E4 "⋤")
+ ("mathrel" "\\sqsupset" #X02290 "⊐")
+ ("mathrel" "\\sqsupseteq" #X02292 "⊒")
+ ("mathrel" "\\sqsupsetneq" #X022E5 "⋥")
+ ("mathrel" "\\stareq" #X0225B "≛")
+ ("mathrel" "\\subedot" #X02AC3 "⫃")
+ ("mathrel" "\\submult" #X02AC1 "⫁")
+ ("mathrel" "\\subrarr" #X02979 "⥹")
+ ("mathrel" "\\subset" #X02282 "⊂")
+ ("mathrel" "\\subsetapprox" #X02AC9 "⫉")
+ ("mathrel" "\\subsetdot" #X02ABD "⪽")
+ ("mathrel" "\\subseteq" #X02286 "⊆")
+ ("mathrel" "\\subseteqq" #X02AC5 "⫅")
+ ("mathrel" "\\subsetneq" #X0228A "⊊")
+ ("mathrel" "\\subsetneqq" #X02ACB "⫋")
+ ("mathrel" "\\subsetplus" #X02ABF "⪿")
+ ("mathrel" "\\subsim" #X02AC7 "⫇")
+ ("mathrel" "\\subsub" #X02AD5 "⫕")
+ ("mathrel" "\\subsup" #X02AD3 "⫓")
+ ("mathrel" "\\succ" #X0227B "≻")
+ ("mathrel" "\\succapprox" #X02AB8 "⪸")
+ ("mathrel" "\\succcurlyeq" #X0227D "≽")
+ ("mathrel" "\\succeq" #X02AB0 "⪰")
+ ("mathrel" "\\succeqq" #X02AB4 "⪴")
+ ("mathrel" "\\succnapprox" #X02ABA "⪺")
+ ("mathrel" "\\succneq" #X02AB2 "⪲")
+ ("mathrel" "\\succneqq" #X02AB6 "⪶")
+ ("mathrel" "\\succnsim" #X022E9 "⋩")
+ ("mathrel" "\\succsim" #X0227F "≿")
+ ("mathrel" "\\supdsub" #X02AD8 "⫘")
+ ("mathrel" "\\supedot" #X02AC4 "⫄")
+ ("mathrel" "\\suphsol" #X027C9 "⟉")
+ ("mathrel" "\\suphsub" #X02AD7 "⫗")
+ ("mathrel" "\\suplarr" #X0297B "⥻")
+ ("mathrel" "\\supmult" #X02AC2 "⫂")
+ ("mathrel" "\\supset" #X02283 "⊃")
+ ("mathrel" "\\supsetapprox" #X02ACA "⫊")
+ ("mathrel" "\\supsetdot" #X02ABE "⪾")
+ ("mathrel" "\\supseteq" #X02287 "⊇")
+ ("mathrel" "\\supseteqq" #X02AC6 "⫆")
+ ("mathrel" "\\supsetneq" #X0228B "⊋")
+ ("mathrel" "\\supsetneqq" #X02ACC "⫌")
+ ("mathrel" "\\supsetplus" #X02AC0 "⫀")
+ ("mathrel" "\\supsim" #X02AC8 "⫈")
+ ("mathrel" "\\supsub" #X02AD4 "⫔")
+ ("mathrel" "\\supsup" #X02AD6 "⫖")
+ ("mathrel" "\\swarrow" #X02199 "↙")
+ ("mathrel" "\\toea" #X02928 "⤨")
+ ("mathrel" "\\tona" #X02927 "⤧")
+ ("mathrel" "\\topfork" #X02ADA "⫚")
+ ("mathrel" "\\tosa" #X02929 "⤩")
+ ("mathrel" "\\towa" #X0292A "⤪")
+ ("mathrel" "\\trianglelefteq" #X022B4 "⊴")
+ ("mathrel" "\\triangleq" #X0225C "≜")
+ ("mathrel" "\\trianglerighteq" #X022B5 "⊵")
+ ("mathrel" "\\twoheaddownarrow" #X021A1 "↡")
+ ("mathrel" "\\twoheadleftarrow" #X0219E "↞")
+ ("mathrel" "\\twoheadleftarrowtail" #X02B3B "⬻")
+ ("mathrel" "\\twoheadleftdbkarrow" #X02B37 "⬷")
+ ("mathrel" "\\twoheadmapsfrom" #X02B36 "⬶")
+ ("mathrel" "\\twoheadmapsto" #X02905 "⤅")
+ ("mathrel" "\\twoheadrightarrow" #X021A0 "↠")
+ ("mathrel" "\\twoheadrightarrowtail" #X02916 "⤖")
+ ("mathrel" "\\twoheaduparrow" #X0219F "↟")
+ ("mathrel" "\\twoheaduparrowcircle" #X02949 "⥉")
+ ("mathrel" "\\uparrow" #X02191 "↑")
+ ("mathrel" "\\uparrowbarred" #X02909 "⤉")
+ ("mathrel" "\\updownarrow" #X02195 "↕")
+ ("mathrel" "\\updownarrows" #X021C5 "⇅")
+ ("mathrel" "\\updownharpoonleftleft" #X02951 "⥑")
+ ("mathrel" "\\updownharpoonleftright" #X0294D "⥍")
+ ("mathrel" "\\updownharpoonrightleft" #X0294C "⥌")
+ ("mathrel" "\\updownharpoonrightright" #X0294F "⥏")
+ ("mathrel" "\\updownharpoonsleftright" #X0296E "⥮")
+ ("mathrel" "\\upfishtail" #X0297E "⥾")
+ ("mathrel" "\\upharpoonleft" #X021BF "↿")
+ ("mathrel" "\\upharpoonleftbar" #X02960 "⥠")
+ ("mathrel" "\\upharpoonright" #X021BE "↾")
+ ("mathrel" "\\upharpoonrightbar" #X0295C "⥜")
+ ("mathrel" "\\upharpoonsleftright" #X02963 "⥣")
+ ("mathrel" "\\upin" #X027D2 "⟒")
+ ("mathrel" "\\upuparrows" #X021C8 "⇈")
+ ("mathrel" "\\vBar" #X02AE8 "⫨")
+ ("mathrel" "\\vBarv" #X02AE9 "⫩")
+ ("mathrel" "\\vDash" #X022A8 "⊨")
+ ("mathrel" "\\vDdash" #X02AE2 "⫢")
+ ("mathrel" "\\varVdash" #X02AE6 "⫦")
+ ("mathrel" "\\varisinobar" #X022F6 "⋶")
+ ("mathrel" "\\varisins" #X022F3 "⋳")
+ ("mathrel" "\\varniobar" #X022FD "⋽")
+ ("mathrel" "\\varnis" #X022FB "⋻")
+ ("mathrel" "\\vartriangleleft" #X022B2 "⊲")
+ ("mathrel" "\\vartriangleright" #X022B3 "⊳")
+ ("mathrel" "\\vbrtri" #X029D0 "⧐")
+ ("mathrel" "\\vdash" #X022A2 "⊢")
+ ("mathrel" "\\vdots" #X022EE "⋮")
+ ("mathrel" "\\veeeq" #X0225A "≚")
+ ("mathrel" "\\veeonwedge" #X02A59 "⩙")
+ ("mathrel" "\\vlongdash" #X027DD "⟝")
+ ("mathrel" "\\wedgeq" #X02259 "≙")
+ ("mathunder" "\\underbrace" #X023DF "⏟")
+ ("mathunder" "\\underbracket" #X023B5 "⎵")
+ ("mathunder" "\\underparen" #X023DD "⏝"))
+ "Extended list of mathematical symbols.
+Taken from http://milde.users.sourceforge.net/LUCR/Math/ and
+prepared with `msl--read-LUCR-list' function. This list does not
+contain some (about 190) of the standard LaTeX math commands in
+`math-symbol-list-basic' because they are named differently in
+unicode-math standard.")
+
+(defconst math-symbol-list-latex-commands
+ '("address" "addtocounter" "addtolength" "addvspace" "Alph" "alph" "Alph
+ example" "alsoname" "and for author" "appendix" "arabic" "arraycolsep"
+ "arrayrulewidth" "arraystretch" "baselineskip"
+ "baselinestretch" "begin" "bf" "bfseries" "bibitem" "bibliography"
+ "bibliographystyle" "bigskip" "bigskipamount" "bmod" "boldmath"
+ "bottomfraction" "cal" "caption" "cc" "centering"
+ "chapter" "circle" "cite" "cleardoublepage" "clearpage" "cline" "closing"
+ "columnsep" "columnseprule" "columnwidth" "contentsline" "copyright"
+ "dag" "dashbox" "day" "dblfloatpagefraction"
+ "dblfloatsep" "dbltextfloatsep" "dbltopfraction" "ddag" "depth"
+ "displaystyle" "documentclass" "dotfill" "doublerulesep" "emph" "encl"
+ "enlargethispage" "enumi" "enumii" "enumiii" "enumiv" "evensidemargin"
+ "fbox" "fboxrule" "fboxsep" "fill" "floatpagefraction" "floatsep"
+ "flushbottom" "fnsymbol" "fontencoding" "fontfamily" "fontseries"
+ "fontshape" "fontsize" "footnote" "footnotemark" "footnoterule"
+ "footnotesep" "footnotesize" "footnotetext" "footskip" "frame" "framebox"
+ "fussy" "gets" "glossary" "glossaryentry"
+ "headheight" "headsep" "height" "hfill" "hline" "hrulefill" "hspace"
+ "Huge" "huge" "hyphenation" "iff" "include" "includeonly"
+ "indent" "index" "indexentry" "input" "intextsep"
+ "item" "itemindent" "itemsep" "itshape" "kill"
+ "label" "labelenumi" "labelenumii" "labelenumiii" "labelenumiv"
+ "labelitemi" "labelitemii" "labelitemiii" "labelitemiv" "labelsep"
+ "labelwidth" "land" "LARGE" "Large" "large" "LaTeX" "le" "left" "leadsto"
+ "lefteqn" "leftmargin" "leftmargini" "leftmarginii" "leftmarginiii"
+ "leftmarginiv" "leftmarginv" "leftmarginvi" "line" "linebreak"
+ "linethickness" "linewidth" "listoffigures" "listoftables" "listparindent"
+ "lnot" "location" "lor" "lq" "makebox" "makebox " "makeglossary"
+ "makeindex" "makelabels" "maketitle" "marginpar" "marginparpush"
+ "marginparsep" "marginparwidth" "mathbf" "mathcal" "mathnormal" "mathrm"
+ "mathsf" "mathtt" "mathversion" "mbox" "mdseries" "medskip"
+ "medskipamount" "month" "multicolumn" "multiput" "name" "newcommand"
+ "newcounter" "newenvironment" "newfont" "newlength" "NEWLINE" "newline"
+ "newpage" "newsavebox" "newtheorem" "nocite" "nofiles" "noindent"
+ "nolinebreak" "nonumber" "nopagebreak" "normalfont" "normalmarginpar"
+ "normalsize" "oe" "onecolumn" "opening" "oval" "owns" "P" "pagebreak"
"pagenumbering"
+ "pageref" "pagestyle" "paragraph" "parbox" "parindent"
+ "parsep" "parskip" "parskip example" "part" "partopsep" "pmod" "poptabs"
+ "pounds" "protect" "ps" "pushtabs" "put" "raggedbottom" "raggedleft"
+ "raggedright" "raisebox" "ref" "refstepcounter" "renewenvironment"
+ "restorecr" "reversemarginpar" "right" "rightmargin" "rm" "rmfamily"
+ "roman" "rq" "rule" "savebox" "sbox" "sc" "scriptsize" "scshape"
+ "section" "seename" "selectfont" "setcounter" "setlength" "settodepth"
+ "settoheight" "settowidth" "sf" "sffamily" "shortstack" "signature" "sl"
+ "slshape" "small" "smallint" "smallskip" "smallskipamount" "SPACE" "ss"
+ "startbreaks" "stepcounter" "stop" "stopbreaks" "subparagraph"
+ "subsection" "subsubsection" "symbol" "TAB"
+ "tabbingsep" "tabcolsep" "tableofcontents" "telephone" "TeX" "textbf"
+ "textfloatsep" "textfraction" "textheight" "textit" "textmd" "textnormal"
+ "textrm" "textsc" "textsf" "textsl" "texttt" "textup" "textwidth"
+ "thicklines" "thinlines" "thinspace" "thispagestyle" "tiny" "to" "today"
+ "topfraction" "topmargin" "topsep" "topskip" "totalheight" "tt" "ttfamily"
+ "twocolumn" "typein" "typeout" "u " "unboldmath"
+ "unitlength" "upshape" "usebox" "usecounter" "usefont" "usepackage"
+ "value" "vector" "verb" "vert" "vfill" "vline" "vspace"
+ "width" "year")
+ "List of the latex commands.")
+
+
+;; IMPORT UTILITIES
+
+(defun msl--read-LUCR-list (file &optional print)
+ "Read in LUCR list from [1] and optionally PRINT.
+LUCR list is a super-set of unicode-math list [2]. FILE is a
+local file from [3].
+
+ [1] http://milde.users.sourceforge.net/LUCR/Math/
+ [2] https://github.com/wspr/unicode-math/blob/master/unicode-math-table.tex
+ [3] http://milde.users.sourceforge.net/LUCR/Math/data/unimathsymbols.txt
+"
+ (let* ((lines (with-temp-buffer
+ (insert-file-contents file)
+ (split-string (buffer-string) "\n" t)))
+ (symb (cl-loop for l in lines
+ unless (string-match-p "^#" l)
+ for words = (split-string l "\\^")
+ if (> (length (nth 3 words)) 0)
+ collect (list (nth 5 words) (nth 3 words) (nth 0
words) (substring (nth 1 words) -1))
+ ;; if (and (> (length (nth 3 words)) 0)
+ ;; (not (string= (nth 2 words) (nth 3 words))))
+ ;; collect (list (nth 5 words) (nth 2 words) (nth 0
words) (substring (nth 1 words) -1))
+ ))
+ (symb (cl-sort symb (lambda (a b) (string-lessp (concat (car a) (cadr
a)) (concat (car b) (cadr b)))))))
+ (if print
+ (let ((out-buff (get-buffer-create "*symbol-list*")))
+ (with-current-buffer out-buff
+ (erase-buffer)
+ (insert "(")
+ (dolist (w symb)
+ (insert (apply 'format "(\"%s\" \"\\%s\" #X%s \"%s\")\n" w )))
+ (insert ")")
+ (goto-char (point-min)))
+ (switch-to-buffer out-buff))
+ symb)))
+
+(provide 'math-symbol-lists)
+;;; math-symbol-lists.el ends here
diff --git a/packages/math-symbol-lists/readme.md
b/packages/math-symbol-lists/readme.md
new file mode 100644
index 0000000..ca45e5f
--- /dev/null
+++ b/packages/math-symbol-lists/readme.md
@@ -0,0 +1,4 @@
+This is a "storage" package used by completion engines such as
`company-math.el` and `ac-math.el`.
+
+Defined (a)lists are: `math-symbol-list-basic`, `math-symbol-list-extended`,
+`math-symbol-list-latex-commands`.
diff --git a/packages/metar/metar.el b/packages/metar/metar.el
index 7b78f07..b6989ea 100644
--- a/packages/metar/metar.el
+++ b/packages/metar/metar.el
@@ -1,9 +1,9 @@
;;; metar.el --- Retrieve and decode METAR weather information
-;; Copyright (C) 2007, 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2007, 2014-2016 Free Software Foundation, Inc.
;; Author: Mario Lang <address@hidden>
-;; Version: 0.1
+;; Version: 0.2
;; Package-Requires: ((cl-lib "0.5"))
;; Keywords: comm
@@ -239,45 +239,46 @@ If no match if found, nil is returned."
(when station-code
(cons station-code (round best-distance))))))
-(defun metar-convert-unit (value new-unit)
+(defun metar-convert-unit (value new-unit &optional convert-units-function)
"Convert VALUE to NEW-UNIT.
VALUE is a string with the value followed by the unit, like \"5 knot\"
-and NEW-UNIT should be a unit name like \"kph\" or similar."
+and NEW-UNIT should be a unit name like \"kph\" or similar.
+CONVERT-UNITS-FUNCTION designates the function actually doing the conversion.
+It must have the signature of `math-convert-units', which is the default."
(cl-check-type value string)
- (cl-check-type new-unit (or string symbol))
- (cl-multiple-value-bind (value unit)
- (split-string
- (math-format-value
- (math-convert-units (math-simplify (math-read-expr value))
- (math-read-expr
- (cl-etypecase new-unit
- (string new-unit)
- (symbol (symbol-name new-unit))))))
- " ")
- (cons (string-to-number value) (intern unit))))
+ (unless (symbolp new-unit)
+ (setq new-unit (intern new-unit)))
+ (let ((expr (math-simplify (math-read-expr value))))
+ ;; Sneakily work around bug#19582.
+ (when (eq (car-safe expr) 'neg)
+ (setq expr `(* -1 ,(cadr expr))))
+ (cl-assert (or (math-zerop expr)
+ (not (memq (math-single-units-in-expr-p expr) '(nil wrong))))
+ nil
+ "Metar: Not exactly one unit in expression: %S" expr)
+ (let ((res (math-simplify-units
+ (funcall (or convert-units-function 'math-convert-units)
+ expr
+ (math-build-var-name new-unit)
+ t))))
+ (cl-assert (math-realp res) nil
+ "Metar: Not a Calc real number: %S" res)
+ (cons (string-to-number (math-format-value (if (integerp res)
+ res
+ (math-float res))))
+ new-unit))))
(defun metar-convert-temperature (string &optional unit)
- (let* ((value (concat (if (= (aref string 0) ?M)
- (concat "-" (substring string 1))
- string)
- "degC"))
- (expr (math-read-expr value))
- (old-unit (math-single-units-in-expr-p expr))
- (new-unit (or unit (cdr (assq 'temperature metar-units)))))
- (if old-unit
- (cl-multiple-value-bind (value unit)
- (split-string
- (math-format-value
- (math-simplify-units
- (math-convert-temperature
- expr
- (list 'var
- (car old-unit)
- (intern (concat "var-" (symbol-name (car old-unit)))))
- (math-read-expr (cl-etypecase new-unit
- (string new-unit)
- (symbol (symbol-name new-unit))))))) " ")
- (cons (string-to-number value) (intern unit))))))
+ (metar-convert-unit (concat (if (= (aref string 0) ?M)
+ (concat "-" (substring string 1))
+ string)
+ "degC")
+ (or unit (cdr (assq 'temperature metar-units)))
+ (lambda (expr new-unit-var pure)
+ (math-convert-temperature expr
+ (math-build-var-name 'degC)
+ new-unit-var
+ pure))))
(defcustom metar-url
"http://weather.noaa.gov/pub/data/observations/metar/stations/%s.TXT";
diff --git a/packages/midi-kbd/midi-kbd.el b/packages/midi-kbd/midi-kbd.el
new file mode 100644
index 0000000..5bdcc55
--- /dev/null
+++ b/packages/midi-kbd/midi-kbd.el
@@ -0,0 +1,283 @@
+;;; midi-kbd.el --- Create keyboard events from Midi input -*-
lexical-binding: t; -*-
+
+;; Copyright (C) 2015 Free Software Foundation, Inc.
+
+;; Author: David Kastrup <address@hidden>
+;; Keywords: convenience, hardware, multimedia
+;; Version: 0.2
+;; Maintainer: David Kastrup <address@hidden>
+;; Package-Requires: ((emacs "25"))
+
+;; 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:
+
+;; Entry point of this package is M-x midikbd-open RET
+;;
+;; It opens a raw ALSA midi device (see its documentation for how to
+;; deal with non-raw devices) and feeds MIDI note-on and note-off
+;; events into the Emacs input queue associated with the terminal from
+;; which midikbd-open has been called. Macro recording and replay is
+;; possible. The interpretation of such events is left to
+;; applications establishing appropriate key bindings.
+;;
+;; Since macro recording and replay makes it very desirable to have
+;; every generated event be interpretable standalone rather than split
+;; into several Emacs events, every MIDI event is encoded into one
+;; mouse-like event similar to <Ch1 C_4>. Consequently, the following
+;; functions are applicable to such events:
+;;
+;; (event-start EVENT) returns the down event part
+;; (event-end EVENT) returns the up event part
+;;
+;; The up event is only available with bindings of <Ch1 up-C-4> and
+;; similar, whereas the down event is available for all bindings.
+;;
+;; up/down event parts may be further split with
+;;
+;; (posn-area EV) returns a channel symbol Ch1..Ch16
+;;
+;; (posn-x-y EV) returns numeric values 0..127 for pitch and velocity
+;;
+;; (posn-timestamp EV) returns a millisecond time value that will wrap
+;; around when reaching most-positive-fixnum, about every 12 days on a
+;; 32bit system.
+;;
+;; Note events (omitting the channel modifier) are
+;; <C_-1> <Csharp_-1> ... <G_9>
+;;
+;; Since Midi does not encode enharmonics, there are no *flat_* key
+;; names: it is the job of the key bindings to give a higher level
+;; interpretation to the basic pitch.
+
+;;; Code:
+
+
+(defconst midikbd-notenames
+ (vconcat
+ (cl-loop for i from 0 to 127
+ collect (intern
+ (format "%s_%d"
+ (aref ["C" "Csharp" "D" "Dsharp" "E" "F"
+ "Fsharp" "G" "Gsharp" "A" "Asharp" "B"]
+ (mod i 12))
+ (1- (/ i 12)))))))
+
+;; Necessary to allow bindings to <Ch1 C_4> without splitting events
+(cl-loop for key across midikbd-notenames do
+ (put key 'event-kind 'mouse-click))
+
+;; We have `midikbd-notenames' for looking up the basic note name
+;; events, `midikbd-upnames' for the keyrelease events, and
+;; `midikbd-downnames' for the keypress events. Those will, for now,
+;; produce the likes of `C_-1', `up-C_-1', and `C_-1': we don't
+;; actually use `down-C_-1' since the down-event is the principally
+;; important one most likely to be bound to keys.
+
+(defconst midikbd-downnames midikbd-notenames)
+
+(defconst midikbd-upnames
+ (vconcat
+ (cl-loop for i across midikbd-notenames
+ collect
+ (intern (concat "up-" (symbol-name i))))))
+
+;; Emacs can deal with up-events like with down-events since the patch
+;; in <URL:http://debbugs.gnu.org/cgi/bugreport.cgi?bug=19746> has
+;; been committed to Emacs.
+;;
+;; Older versions will erupt in violence when forced to deal with an
+;; uncached "up-" event, so we need to put the full cache in place
+;; ourselves. We do this only if we find Emacs unable to identify
+;; up-events.
+
+;; Calling event-modifiers may poison the cache for up-C_-1 but since
+;; we overwrite it first thing afterwards, this is not really an
+;; issue.
+
+(unless (event-modifiers 'up-C_-1)
+ (cl-loop for key across midikbd-upnames for base across midikbd-notenames
+ do
+ (put key 'event-symbol-element-mask (list base 1))
+ (put key 'event-symbol-elements (list base 'up))
+ (let ((modc (get base 'modifier-cache)))
+ (unless (assq 1 modc)
+ (put base 'modifier-cache (cons (cons 1 key) modc))))))
+
+
+(defconst midikbd-channelnames
+ [Ch1 Ch2 Ch3 Ch4 Ch5 Ch6 Ch7 Ch8
+ Ch9 Ch10 Ch11 Ch12 Ch13 Ch14 Ch15 Ch16])
+
+;; CCL programs used in coding systems apparently don't save registers
+;; across suspension so we don't use a coding system. Instead our CCL
+;; program is run using ccl-execute-on-string in the filter routine.
+;; That allows us to interpret all _completed_ Midi commands without
+;; getting confused, and it also gives us a well-defined internal
+;; state (namely one for every call of midikbd-filter-create).
+
+;; Decoding Midi is a positive nuisance because of "running status":
+;; if a Midi command byte is the same as the last one, it can be
+;; omitted and just the data sent.
+;; So we keep the current command in r0, the currently read byte in r1,
+;; the channel in r6.
+
+(define-ccl-program midikbd-decoder
+ '(2
+ (loop
+ (loop
+ ;; central message receiver loop here.
+ ;; When it exits, the command to deal with is in r0
+ ;; Any arguments are in r1 and r2
+ ;; r3 contains: 0 if no arguments are accepted
+ ;; 1 if 1 argument can be accepted
+ ;; 2 if 2 arguments can be accepted
+ ;; 3 if the first of two arguments has been accepted
+ ;; Arguments are read into r1 and r2.
+ ;; r4 contains the current running status byte if any.
+ (read-if (r0 < #x80)
+ (branch r3
+ (repeat)
+ ((r1 = r0) (r0 = r4) (break))
+ ((r1 = r0) (r3 = 3) (repeat))
+ ((r2 = r0) (r3 = 2) (r0 = r4) (break))))
+ (if (r0 >= #xf8) ; real time message
+ (break))
+ (if (r0 < #xf0) ; channel command
+ ((r4 = r0)
+ (if ((r0 & #xe0) == #xc0)
+ ;; program change and channel pressure take only 1 argument
+ (r3 = 1)
+ (r3 = 2))
+ (repeat)))
+ ;; system common message, we swallow those for now
+ (r3 = 0)
+ (repeat))
+ (if ((r0 & #xf0) == #x90)
+ (if (r2 == 0) ; Some Midi devices use velocity 0
+ ; for switching notes off,
+ ; so translate into note-off
+ ; and fall through
+ (r0 -= #x10)
+ ((r0 &= #xf)
+ (write 0)
+ (write r0 r1 r2)
+ (repeat))))
+ (if ((r0 & #xf0) == #x80)
+ ((r0 &= #xf)
+ (write 1)
+ (write r0 r1 r2)
+ (repeat)))
+ (repeat))))
+
+(defun midikbd-get-ts-lessp (pivot)
+ "Return a comparison operator for timestamps close to PIVOT.
+
+Timestamps are just a millisecond count that wraps around
+eventually. To compare two timestamps TS1 and TS2, one can
+generally just look at the sign of their difference. However,
+this relation is not really transitive when given input spanning
+more than half of the given number range (should only happen in
+degenerate cases since the overall range spans several days).
+
+Sort algorithms may require transitivity in order to complete, so
+this routine creates a transitive comparison operator when given
+a \"pivot\" from within the sorted range."
+ (lambda (ts1 ts2)
+ (< (- ts1 pivot) (- ts2 pivot))))
+
+(defun midikbd-filter-create ()
+ "Create one Midi process filter keeping state across calls."
+ (let* ((state (make-vector 9 nil))
+ (keypress (make-vector 2048 nil))
+ (param-len [3 3])
+ (hooks (vector
+ (lambda (ts ch pitch velocity)
+ (let ((res
+ (list (aref midikbd-downnames pitch)
+ (list nil
+ (aref midikbd-channelnames ch)
+ (cons pitch velocity)
+ ts))))
+ (aset keypress (+ (* ch 128) pitch) res)
+ (list res)))
+ (lambda (ts ch pitch velocity)
+ (let* ((idx (+ (* ch 128) pitch))
+ (oldpress (prog1 (aref keypress idx)
+ (aset keypress idx nil))))
+ (and oldpress
+ (list
+ (list (aref midikbd-upnames pitch)
+ (cadr oldpress)
+ (list nil
+ (aref midikbd-channelnames ch)
+ (cons pitch velocity)
+ ts)))))))))
+ (lambda (_process string)
+ (let* ((ct (current-time))
+ (ts (+ (* (nth 0 ct) 65536000)
+ (* (nth 1 ct) 1000)
+ (/ (nth 2 ct) 1000)))
+ (str (ccl-execute-on-string 'midikbd-decoder
+ state string t t)))
+ (setq unread-command-events
+ (append unread-command-events
+ (cl-loop with i = 0 while (< i (length str))
+ nconc
+ (let* ((code (aref str i))
+ (beg (1+ i)))
+ (setq i (+ beg (aref param-len code)))
+ (apply (aref hooks code)
+ ts
+ (append (substring str beg i)
+ nil))))))))))
+
+(defcustom midikbd-default-device
+ "/dev/snd/midiC1D0"
+ "Default MIDI raw device for midikbd."
+ :type '(file)
+ :group 'midi-kbd
+ :package-version '(midi-kbd . "0.2"))
+
+;;;###autoload
+(defun midikbd-open (file)
+ "Open the raw Midi device FILE as a source for Midi input.
+This should be an ALSA device like \"/dev/snd/midiC1D0\". If your
+Midi producing device is a software Midi device, you might need to
+call
+
+ sudo modprobe snd-virmidi
+
+in order to have some virtual ALSA ports available as such raw Midi
+devices."
+ (interactive (list (read-file-name "Midi device: "
+ (file-name-directory
midikbd-default-device)
+ (file-name-nondirectory
midikbd-default-device)
+ t nil
+ #'file-readable-p)))
+ (let* ((file (expand-file-name file
+ (file-name-directory midikbd-default-device)))
+ (buffer (get-buffer-create (concat " *Midi process " file " *")))
+ (oldproc (get-buffer-process buffer)))
+ (if (processp oldproc) (delete-process oldproc))
+ (make-serial-process :port file
+ :speed nil
+ :buffer buffer
+ :coding 'raw-text
+ :filter (midikbd-filter-create)
+ :sentinel #'ignore
+ :noquery t)))
+
+(provide 'midi-kbd)
+;;; midi-kbd.el ends here
diff --git a/packages/minibuffer-line/minibuffer-line.el
b/packages/minibuffer-line/minibuffer-line.el
new file mode 100644
index 0000000..0e44318
--- /dev/null
+++ b/packages/minibuffer-line/minibuffer-line.el
@@ -0,0 +1,78 @@
+;;; minibuffer-line.el --- Display status info in the minibuffer window -*-
lexical-binding: t; -*-
+
+;; Copyright (C) 2015 Free Software Foundation, Inc.
+
+;; Author: Stefan Monnier <address@hidden>
+;; Keywords:
+;; Version: 0.1
+
+;; 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 lets you display various status information in the minibuffer
+;; window instead of the mode-line. Of course, this is only displayed when the
+;; minibuffer window is not already used for other things (e.g. a minibuffer or
+;; an each area message).
+;;
+;; The contents and aspect is controlled by the `minibuffer-line-format'
+;; variable and the `minibuffer-line' face. Their current default kind of
+;; sucks: suggestions for improvements welcome.
+
+;;; Code:
+
+(defgroup minibuffer-line ()
+ "Use the idle minibuffer window to display status information."
+ :group 'mode-line)
+
+(defcustom minibuffer-line-format
+ '("" (:eval system-name) " | " (:eval (format-time-string "%F %R")))
+ "Specification of the contents of the minibuffer-line.
+Uses the same format as `mode-line-format'."
+ :type 'sexp)
+
+(defface minibuffer-line
+ '((t :inherit mode-line-inactive))
+ "Face to use for the minibuffer-line.")
+
+(defcustom minibuffer-line-refresh-interval 60
+ "The frequency at which the minibuffer-line is updated, in seconds."
+ :type 'integer)
+
+(defconst minibuffer-line--buffer " *Minibuf-0*")
+
+(defvar minibuffer-line--timer nil)
+
+;;;###autoload
+(define-minor-mode minibuffer-line-mode
+ "Display status info in the minibuffer window."
+ :global t
+ (with-current-buffer minibuffer-line--buffer
+ (erase-buffer))
+ (when minibuffer-line--timer
+ (cancel-timer minibuffer-line--timer)
+ (setq minibuffer-line--timer nil))
+ (when minibuffer-line-mode
+ (setq minibuffer-line--timer
+ (run-with-timer t minibuffer-line-refresh-interval
+ #'minibuffer-line--update))
+ (minibuffer-line--update)))
+
+(defun minibuffer-line--update ()
+ (with-current-buffer minibuffer-line--buffer
+ (erase-buffer)
+ (insert (format-mode-line minibuffer-line-format 'minibuffer-line))))
+
+(provide 'minibuffer-line)
+;;; minibuffer-line.el ends here
diff --git a/packages/multishell/.gitignore b/packages/multishell/.gitignore
new file mode 100644
index 0000000..1c17549
--- /dev/null
+++ b/packages/multishell/.gitignore
@@ -0,0 +1,2 @@
+# Compiled
+*.elc
diff --git a/packages/multishell/LICENSE b/packages/multishell/LICENSE
new file mode 100644
index 0000000..ef7e7ef
--- /dev/null
+++ b/packages/multishell/LICENSE
@@ -0,0 +1,674 @@
+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/multishell/README.md b/packages/multishell/README.md
new file mode 100644
index 0000000..4004e51
--- /dev/null
+++ b/packages/multishell/README.md
@@ -0,0 +1,57 @@
+multishell.el
+=============
+
+Facilitate use of multiple local and remote Emacs shell buffers.
+
+Multishell is available via Emacs package manager, [in
ELPA](https://elpa.gnu.org/packages/multishell.html). Install "multishell" from
the `M-x package-list-packages` listing.
+
+I use the emacs shell a *lot*, including separate shells for separate
+project, and more shells for access to remote systems (which I do a lot, as
+a systems administrator). On top of emacs' powerful shell and tramp
+facilities, use a `multishell` (customization-activated) key binding to:
+
+* Get to the input point from wherever you are in a shell buffer,
+ ... or to any of your shell buffers, from anywhere inside emacs.
+
+* Use universal arguments to launch and choose among alternate shell buffers,
+ ... and change which is the current default.
+
+* Easily restart disconnected shells, or shells from prior sessions
+ ... the latter from Emacs builtin savehist minibuf history persistence
+
+* Append a path to a new shell name to launch a shell in that directory,
+ ... and use a path with Emacs tramp syntax to launch a remote shell -
+ for example:
+
+ * `#root/sudo:address@hidden:/etc` for a buffer named "#root" with a
+ root shell starting in /etc.
+
+ * `/ssh:example.net:/` for a shell buffer in / on example.net.
+ The buffer will be named "*example.net*".
+
+ * `#ex/ssh:example.net|sudo:address@hidden:/etc` for a root shell
+ starting in /etc on example.net named "*#ex*".
+
+ * `interior/ssh:gateway.corp.com|ssh:interior.corp.com:` to go via
+ gateway.corp.com to your homedir on interior.corp.com. The buffer
+ will be named "*interior*". You could append a sudo hop, and so on.
+
+* Thanks to tramp, file visits from the shell will seamlessly be on the
+ host where the shell is running, in the auspices of the target account.
+
+See the `multishell-pop-to-shell` docstring (in
+[multishell.el](multishell.el)) for details, and
+[getting-to-a-shell.md](getting-to-a-shell.md) for the nitty-gritty
+decision tree that determines where the keybinding according to the various
+conditions.
+
+Customize-group `multishell' to select and activate a keybinding and set
+various behaviors. Customize-group `savehist' to preserve buffer
+names/paths across emacs restarts.
+
+Please use
+[the multishell repository](https://github.com/kenmanheimer/EmacsMultishell)
+issue tracker to report problems, suggestions, etc.
+
+See the [multishell.el](multishell.el) file commentary for a change log and
+Todo list.
diff --git a/packages/multishell/getting-to-a-shell.md
b/packages/multishell/getting-to-a-shell.md
new file mode 100644
index 0000000..a2ad649
--- /dev/null
+++ b/packages/multishell/getting-to-a-shell.md
@@ -0,0 +1,41 @@
+Multishell enables you to get to the input prompt in the shell you want
+with as few keystrokes as possible.
+
+* One keybinding, unmodified, gets you to the your current default shell, if
+ not in a shell, or to the input prompt of the current shell, if you're in
+ one.
+
+* Use the universal argument to select a specific shell buffer, wherever
+ point happens to be residing. Enter an empty line to the prompt to go to
+ your current default shell, or use completing read to go to a shell from
+ your multishell history, or start a new shell at the path you specify -
+ including remote paths, using tramp syntax. (See the
+ multishell-pop-to-shell docstring in [multishell.el](multishell.el) for
+ details.)
+
+* Use a doubled universal argument to set the shell you choose to be the
+ current default. (The prompt will indicate that mode with a "<==".)
+
+Here's the decision tree:
+
+* No universal argument - use:
+
+ * From-buffer is shell buffer: use from-buffer current name/path
+ - if shell/connection is stopped, restart/reconnect
+ - if not at input prompt, go there
+ * From-buffer is not shell buffer:
+ - Go to multishell-primary-name current name/path, creating or
+ restarting and/or reconnecting if that shell is not currently running.
+
+* Universal argument provided - use:
+
+ - No name is specified - use current multishell-primary-name path
+ * Name is specified - use named buffer (creating if not already present):
+ * Path is also specified:
+ - shell is running - ignore new path
+ - shell will be started or restarted - use new path
+ * No path is specified:
+ - Name has history: use path from history
+ - Name has no history: use path that target buffer already has or
inherits
+ - If the universal argument is doubled, set the selected shell as the
+ default one, going forwards.
diff --git a/packages/multishell/multishell-list.el
b/packages/multishell/multishell-list.el
new file mode 100644
index 0000000..dc7529b
--- /dev/null
+++ b/packages/multishell/multishell-list.el
@@ -0,0 +1,312 @@
+;;; multishell-list.el --- tabulated-list-mode for multishell shell buffers
+
+;; Copyright (C) 2016 Free Software Foundation, Inc. and Ken Manheimer
+
+;; Author: Ken Manheimer <address@hidden>
+;; Version: 1.1.5
+;; Created: 2016 -- first public availability
+;; Keywords: processes
+;; URL: https://github.com/kenmanheimer/EmacsMultishell
+
+;; See multishell.el for commentary, change log, etc.
+
+(require 'tabulated-list)
+
+(defgroup multishell-list nil
+ "Show a menu of all shell buffers in a buffer."
+ :group 'multishell)
+
+(defface multishell-list-name
+ '((t (:weight bold)))
+ "Face for shell names in the Multishell List."
+ :group 'multishell-list)
+
+(defun multishell-list-open-pop (&optional arg)
+ "Pop to current entry's shell in separate window.
+
+The shell is started if it's not already going, unless this is
+invoked with optional `universal-argument'. In that case we
+pop to the buffer but don't change its run state."
+ (interactive "P")
+ (let ((list-buffer (current-buffer))
+ (entry (tabulated-list-get-id)))
+ (if arg
+ (pop-to-buffer
+ (multishell-bracket (multishell-name-from-entry entry)))
+ (multishell-list-dispatch-selected entry t))
+ (with-current-buffer list-buffer
+ (revert-buffer)
+ (multishell-list-goto-item-by-entry entry))))
+
+(defun multishell-list-open-as-default ()
+ "Pop to current entry's shell, and set as the default shell."
+ (interactive)
+ (let ((list-buffer (current-buffer))
+ (entry (tabulated-list-get-id)))
+ (message "%s <==" (multishell-name-from-entry entry))
+ (multishell-list-dispatch-selected entry t t)
+ (with-current-buffer list-buffer
+ (revert-buffer)
+ (multishell-list-goto-item-by-entry entry))))
+
+(defun multishell-list-open-here (&optional arg)
+ "Switch to current entry's shell buffer.
+
+The shell is started if it's not already going, unless this is
+invoked with optional `universal-argument'. In that case we
+switch to the buffer but don't activate (or deactivate) it it."
+ (interactive "P")
+ (let* ((list-buffer (current-buffer))
+ (entry (tabulated-list-get-id)))
+ (if arg
+ (switch-to-buffer
+ (multishell-bracket (multishell-name-from-entry entry)))
+ (multishell-list-dispatch-selected entry nil))
+ (with-current-buffer list-buffer
+ (revert-buffer))))
+
+(defun multishell-list-delete (&optional arg)
+ "Remove current shell entry, and prompt for buffer-removal if present."
+ (interactive "P")
+ (let* ((entry (tabulated-list-get-id))
+ (name (multishell-name-from-entry entry))
+ (name-bracketed (multishell-bracket name))
+ (buffer (get-buffer name-bracketed)))
+ (when (multishell-delete-history-name name)
+ (and buffer
+ ;; If the process is live, let shell-mode get confirmation:
+ (or (comint-check-proc (current-buffer))
+ (y-or-n-p (format "Kill buffer %s? " name-bracketed)))
+ (kill-buffer name-bracketed)))
+ (tabulated-list-delete-entry)))
+
+(defun multishell-list-edit-entry (&optional arg)
+ "Edit the value of current shell entry.
+
+Submitting the change will not launch the entry, unless this is
+invoked with optional `universal-argument'. In the latter case,
+submitting the entry will pop to the shell in a new window,
+starting it if it's not already going."
+
+ (interactive "P")
+ (let* ((list-buffer (current-buffer))
+ (entry (tabulated-list-get-id))
+ (name (multishell-name-from-entry entry))
+ (revised (multishell-read-unbracketed-entry
+ (format "Edit shell spec for %s: " name)
+ entry
+ 'no-record))
+ (revised-name (multishell-name-from-entry revised))
+ buffer)
+ (when (not (string= revised entry))
+ (multishell-replace-entry entry revised)
+ (when (and (not (string= name revised-name))
+ (setq buffer (get-buffer (multishell-bracket name))))
+ (with-current-buffer buffer
+ (rename-buffer (multishell-bracket revised-name)))))
+ (when arg
+ (multishell-list-dispatch-selected revised-name t))
+ (with-current-buffer list-buffer
+ (revert-buffer)
+ (multishell-list-goto-item-by-entry revised))))
+
+(defun multishell-list-clone-entry (&optional arg)
+ "Create a new list entry, edited from the current one, ready to launch.
+
+If you provide an optional `universal-argument', the new entry
+will be launched when it's created.
+
+The already existing original entry is left untouched."
+ (interactive "P")
+ (let* ((prototype (tabulated-list-get-id))
+ (name (multishell-name-from-entry prototype))
+ (new (multishell-read-unbracketed-entry
+ (format "Clone new shell spec from %s: " name)
+ prototype
+ 'no-record))
+ (new-name (multishell-name-from-entry new))
+ (new-path (cadr (multishell-split-entry new))))
+ (when (not (string= new prototype))
+ (multishell-register-name-to-path new-name new-path)
+ (revert-buffer)
+ (multishell-list-goto-item-by-entry new)
+ (when arg
+ (multishell-list-dispatch-selected new-name t)))))
+
+(defun multishell-list-mouse-select (event)
+ "Select the shell whose line is clicked."
+ (interactive "e")
+ (select-window (posn-window (event-end event)))
+ (let ((entry (tabulated-list-get-id (posn-point (event-end event)))))
+ (multishell-list-dispatch-selected entry nil)))
+
+(defun multishell-list-dispatch-selected (entry pop &optional set-primary)
+ "Go to multishell ENTRY, popping to window if POP is non-nil.
+
+Optional arg SET-PRIMARY non-nil sets `multishell-primary-name' to entry.
+
+Provide for concluding minibuffer interaction if we're in completing mode."
+ (let ((set-primary-as-arg (and set-primary '(16))))
+ (if multishell-completing-read
+ ;; In multishell completing-read, arrange to conclude minibuffer input:
+ (throw 'multishell-minibuffer-exit (list entry pop set-primary-as-arg))
+ (multishell-pop-to-shell set-primary-as-arg entry (not pop)))))
+
+(defun multishell-list-placeholder (value default)
+ "Return VALUE if non-empty string, else DEFAULT."
+ (if (or (not value) (string= value ""))
+ default
+ value))
+(defconst multishell-list-active-flag "+")
+(defconst multishell-list-inactive-flag ".")
+(defconst multishell-list-absent-flag "x")
+
+(defun multishell-list-entries ()
+ "Generate multishell name/path-spec entries list for tabulated-list."
+ (let ((recency 0))
+ (mapcar #'(lambda (entry)
+ (setq recency (1+ recency))
+ (let* ((splat (multishell-split-entry entry))
+ (name (car splat))
+ (buffer (and name
+ (get-buffer
+ (multishell-bracket name))))
+ (status (cond ((not buffer)
+ multishell-list-absent-flag)
+ ((comint-check-proc buffer)
+ multishell-list-active-flag)
+ (t multishell-list-inactive-flag)))
+ (rest (cadr splat))
+ (dir (and rest (or (file-remote-p rest 'localname)
+ rest)))
+ (hops (and dir
+ (file-remote-p rest 'localname)
+ (substring
+ rest 0 (- (length rest) (length dir))))))
+ (when (not name)
+ (setq name (multishell-name-from-entry entry)))
+ (list entry
+ (vector (format "%d" recency)
+ status
+ (multishell-list--decorate-name name)
+ (multishell-list-placeholder hops "-")
+ (multishell-list-placeholder dir "~")))))
+ (multishell-all-entries))))
+
+(defun multishell-list-goto-item-by-entry (entry)
+ "Position at beginning of line of tabulated list item for ENTRY."
+ (goto-char (point-min))
+ (while (and (not (eobp))
+ (not (string= (tabulated-list-get-id) entry)))
+ (forward-line 1)))
+
+(defun multishell-collate-row-strings-as-numbers (a b)
+ (let ((a (aref (cadr a) 0))
+ (b (aref (cadr b) 0)))
+ (> (string-to-number a) (string-to-number b))))
+
+(defun multishell-list--decorate-name (name)
+ (propertize name
+ 'font-lock-face 'multishell-list-name
+ 'mouse-face 'highlight))
+
+(defvar multishell-list-mode-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map tabulated-list-mode-map)
+ (define-key map (kbd "c") 'multishell-list-clone-entry)
+ (define-key map (kbd "d") 'multishell-list-delete)
+ (define-key map (kbd "\C-k") 'multishell-list-delete)
+ (define-key map (kbd "k") 'multishell-list-delete)
+ (define-key map (kbd "e") 'multishell-list-edit-entry)
+ (define-key map (kbd "o") 'multishell-list-open-pop)
+ (define-key map (kbd " ") 'multishell-list-open-pop)
+ (define-key map (kbd "O") 'multishell-list-open-as-default)
+ (define-key map (kbd "RET") 'multishell-list-open-here)
+ (define-key map [mouse-2] 'multishell-list-mouse-select)
+ (define-key map [follow-link] 'mouse-face)
+ map))
+(define-derived-mode multishell-list-mode
+ tabulated-list-mode "Shells"
+ "Major mode for listing current and historically registered shells.
+
+Initial sort is from most to least recently used:
+
+- First active shells, flagged with '+' a plus sign
+- Then, inactive shells, flagged with '.' a period
+- Then historical shells that currently have no buffer, flagged with 'x' an ex
+
+\\{multishell-list-mode-map\}"
+ (setq tabulated-list-format
+ [;; (name width sort '(:right-align nil :pad-right nil))
+ ("#" 0 multishell-collate-row-strings-as-numbers :pad-right 1)
+ ("! " 1 t :pad-right 1)
+ ("Name" 15 t)
+ ("Hops" 30 t)
+ ("Directory" 30 t)]
+ tabulated-list-sort-key '("#" . t)
+ tabulated-list-entries #'multishell-list-entries)
+ (tabulated-list-init-header))
+
+(defun multishell-list-cull-dups (entries)
+ "Return list of multishell ENTRIES sans ones with duplicate names.
+
+For duplicates, we prefer the ones that have paths."
+ (let ((tally (make-hash-table :test #'equal))
+ got name name-order-reversed already)
+ (mapcar #'(lambda (entry)
+ (setq name (multishell-name-from-entry entry)
+ already (gethash name tally nil))
+ (when (not already)
+ (push name name-order-reversed))
+ (when (or (not already) (< (length already) (length entry)))
+ ;; Add new or replace shorter prior entry for name:
+ (puthash name entry tally)))
+ entries)
+ (dolist (name name-order-reversed)
+ (push (gethash name tally) got))
+ got))
+
+;;;###autoload
+(defun multishell-list (&optional completing)
+ "Edit your current and historic list of shell buffers.
+
+If optional COMPLETING is nil, we present the full
+`multishell-history' list in a popped buffer named '*Shells*'.
+
+In the buffer, hit ? or h for a list of commands.
+
+When optional COMPLETING is non-nil, it must be a list of
+multishell-history completion candidate entries, as provided by
+`completing-read'. Then we present the list as a part of
+minibuffer completion.
+
+You can get to the shells listing by recursively invoking
+\\[multishell-pop-to-shell] at the `multishell-pop-to-shell'
+`universal-argument' prompts."
+ (interactive)
+ (let ((from-entry (car (multishell-history-entries
+ (multishell-unbracket (buffer-name
+ (current-buffer))))))
+ (buffer (get-buffer-create (if completing
+ "*Completions*"
+ "*Shells*"))))
+ (if completing
+ (set-buffer buffer)
+ (pop-to-buffer buffer))
+ (multishell-list-mode)
+ (progv
+ ;; Temporarily assign multishell-history only when completing:
+ (when completing '(multishell-history))
+ (when completing
+ (list (multishell-list-cull-dups (mapcar 'substring-no-properties
+ completing))))
+ (tabulated-list-print))
+ (when completing
+ )
+ (when from-entry
+ (multishell-list-goto-item-by-entry from-entry))))
+
+(provide 'multishell-list)
+(require 'multishell)
+
+;;; multishell-list.el ends here
diff --git a/packages/multishell/multishell.el
b/packages/multishell/multishell.el
new file mode 100644
index 0000000..51bad08
--- /dev/null
+++ b/packages/multishell/multishell.el
@@ -0,0 +1,812 @@
+;;; multishell.el --- Easily use multiple shell buffers, local and remote.
+
+;; Copyright (C) 1999-2016 Free Software Foundation, Inc.
+
+;; Author: Ken Manheimer <address@hidden>
+;; Version: 1.1.5
+;; Created: 1999 -- first public availability
+;; Keywords: processes
+;; URL: https://github.com/kenmanheimer/EmacsMultishell
+;;
+;;; Commentary:
+;;
+;; Easily use and navigate multiple shell buffers, including remote shells.
+;; Fundamentally, multishell is the function `multishell-pop-to-shell' -
+;; a la `pop-to-buffer' - plus a keybinding. Together, they enable you to:
+;;
+;; * Get to the input point from wherever you are in a shell buffer,
+;; ... or to any of your shell buffers, from anywhere inside emacs.
+;;
+;; * Use universal arguments to launch and choose among alternate shell
buffers,
+;; ... and change which is the current default.
+;;
+;; * Easily restart disconnected shells, or shells from prior sessions
+;; ... the latter from Emacs builtin savehist minibuf history persistence
+;;
+;; * Append a path to a new shell name to launch a shell in that directory,
+;; ... and use a path with Emacs tramp syntax to launch a remote shell -
+;; for example:
+;;
+;; * `#root/sudo:address@hidden:/etc` for a buffer named "*#root*" with a
+;; root shell starting in /etc.
+;;
+;; * `/ssh:example.net:` for a shell buffer in your homedir on example.net.
+;; The buffer will be named "*example.net*".
+;;
+;; * `#ex/ssh:example.net|sudo:address@hidden:/var/log` for a root shell
+;; starting in /var/log on example.net named "*#ex*".
+;;
+;; * 'interior/ssh:gateway.corp.com|ssh:interior.corp.com:' to go via
+;; gateway.corp.com to your homedir on interior.corp.com. The buffer
+;; will be named "*interior*". You could append a sudo hop, and so on.
+;;
+;; * Thanks to tramp, file visits from the shell will seamlessly be in
+;; the auspices of the target account, and relative to the current
+;; directory, on the host where the shell is running.
+;;
+;; * Manage your list of shells, current and past, as a collection.
+;;
+;; See the `multishell-pop-to-shell` docstring for details.
+;;
+;; Customize-group `multishell' to select and activate a keybinding and set
+;; various behaviors. Customize-group `savehist' to preserve buffer
+;; names/paths across emacs restarts.
+;;
+;; Please use
+;; [the multishell repository](https://github.com/kenmanheimer/EmacsMultishell)
+;; issue tracker to report problems, suggestions, etc, and see that
+;; repository for a bit more documentation.
+;;
+;; Change Log:
+;;
+;; * 2016-02-11 1.1.5 Ken Manheimer:
+;; - Rectify multishell list sorting to preserve recentness
+;; - Increment the actual multishell-version setting, neglected for 1.1.4.
+;; * 2016-02-11 1.1.4 Ken Manheimer:
+;; - hookup multishell-list as completion help buffer.
+;; Mouse and keyboard selections from help listing properly exits
+;; minibuffer.
+;; * 2016-02-09 1.1.3 Ken Manheimer:
+;; multishell-list:
+;; - add some handy operations, like cloning new entry from existing
+;; - add optional behaviors to existing operations for returning to
+;; stopped shells without restarting them.
+;; - solidify maintaining focus on current entry
+;; - fix miscellaneous.
+;; * 2016-01-31 1.1.2 Ken Manheimer:
+;; - Settle puzzling instability of multishell-all-entries
+;; - The accumulations was putting items going from more to less active
+;; categories to be put at the end, not beginning.
+;; - Also, using history for prompting changes history - implement
+;; no-record option to avoid this when needed.
+;; - Implement simple edit-in-place multishell-replace-entry and use in
+;; multishell-list-edit-entry.
+;; - Remove now unnecessary multishell-list-revert-buffer-kludge.
+;; - Rectify byte compiler offenses, and other fixes - thanks to Stefan
+;; Monnier for pointing out many of the corrections.
+;; - Avoid directly calling tramp functions unnecessarily.
+;; * 2016-01-30 1.1.1 Ken Manheimer:
+;; - shake out initial multishell-list glitches:
+;; - (Offer to) delete shell buffer, if present, when deleting entry.
+;; - Set recency (numeric rank) as initial sort field
+;; - Recompute list on most operations that affect the order, and try to
+;; preserve stability. (Kludgy solution, needs work.)
+;; - Set version to 1.1.1 - multishell-list addition should have been 1.1.0.
+;; * 2016-01-30 1.0.9 Ken Manheimer:
+;; - Add multishell-list for managing the collection of current and
+;; history-registered shells: edit, delete, and switch/pop to entries.
+;; Easy access by invoking `multishell-pop-to-shell' from in the
+;; `multishell-pop-to-shell' universal arg prompts.
+;; - Duplicate existing shell buffer names in completions, for distinction.
+;; - Add paths to buffers started without one, when multishell history dir
+;; tracking is enabled.
+;; - Major code cleanup:
+;; - Simplify multishell-start-shell-in-buffer, in particular using
+;; shell function, rather than unnecessarily going underneath it.
+;; - Establish multishell-name-from-entry as canonical name resolver.
+;; - Fallback to eval-after-load in emacs versions that lack
+;; with-eval-after-load (eg, emacs 23).
+;; - save-match-data, where match-string is used
+;; - resituate some helpers
+;; * 2016-01-24 1.0.8 Ken Manheimer:
+;; - Work around the shell/tramp mishandling of remote+sudo+homedir problem!
+;; The work around is clean and simple, basically using high-level `cd'
+;; API and not messing with the low-level default-directory setting.
+;; (Turns out the problem was not in my local config. Good riddance to the
+;; awkward failure handler!)
+;; - Clean up code resolving the destination shell, starting to document the
+;; decision tree in the process. See getting-to-a-shell.md in the
+;; multishell repository, https://github.com/kenmanheimer/EmacsMultishell
+;; - There may be some shake-out on resolving the destination shell, but
+;; this release gets the fundamental functionality soundly in place.
+;; * 2016-01-23 1.0.7 Ken Manheimer:
+;; - Remove notes about tramp remote+sudo+homedir problem. Apparently it's
+;; due to something in my local site configuration (happens with -q but
+;; not -Q).
+;; * 2016-01-22 1.0.6 Ken Manheimer:
+;; - Add multishell-version function.
+;; - Tweak commentary/comments/docstrings.
+;; - Null old multishell-buffer-name-history var, if present.
+;; * 2016-01-16 1.0.5 Ken Manheimer:
+;; - History now includes paths, when designated.
+;; - Actively track current directory in history entries that have a path.
+;; Custom control: multishell-history-entry-tracks-current-directory
+;; - Offer to remove shell's history entry when buffer is killed.
+;; (Currently the only UI mechanism to remove history entries.)
+;; - Fix - prevent duplicate entries for same name but different paths
+;; - Fix - recognize and respect tramp path syntax to start in home dir
+;; - Simplify history var name, migrate existing history if any from old name
+;; * 2016-01-04 1.0.4 Ken Manheimer - Released to ELPA
+;; * 2016-01-02 Ken Manheimer - working on this in public, but not yet
released.
+;;
+;; TODO and Known Issues:
+;;
+;; * Add custom shell launch prep actions
+;; - for, eg, port knocking, interface activations
+;; - shell commands to execute when shell name or path matches a regexp
+;; - list of (regexp, which - name, path, or both, command)
+;; * Investigate whether we can recognize and provide for failed hops.
+;; - Tramp doesn't provide useful reactions for any hop but the first
+;; - Might be stuff we can do to detect and convey failures?
+;; - Might be no recourse but to seek tramp changes.
+;; * Try minibuffer field boundary at beginning of tramp path, to see whether
+;; the field boundary magically enables tramp path completion.
+
+;;; Code:
+
+(require 'comint)
+(require 'shell)
+(require 'savehist)
+(require 'multishell-list)
+
+(defvar multishell-version "1.1.5")
+(defun multishell-version (&optional here)
+ "Return string describing the loaded multishell version."
+ (interactive "P")
+ (let ((msg (concat "Multishell " multishell-version)))
+ (if here (insert msg)
+ (if (called-interactively-p 'interactive)
+ (message "%s" msg)
+ msg))))
+
+(defgroup multishell nil
+ "Allout extension that highlights outline structure graphically.
+
+Customize `allout-widgets-auto-activation' to activate allout-widgets
+with allout-mode."
+ :group 'shell)
+
+(defcustom multishell-command-key "\M- "
+ "The key to use if `multishell-activate-command-key' is true.
+
+You can instead manually bind `multishell-pop-to-shell` using emacs
+lisp, eg: (global-set-key \"\\M- \" 'multishell-pop-to-shell)."
+ :type 'key-sequence)
+
+(defvar multishell--responsible-for-command-key nil
+ "Coordination for multishell key assignment.")
+(defun multishell-activate-command-key-setter (symbol setting)
+ "Implement `multishell-activate-command-key' choice."
+ (set-default symbol setting)
+ (when (or setting multishell--responsible-for-command-key)
+ (multishell-implement-command-key-choice (not setting))))
+(defun multishell-implement-command-key-choice (&optional unbind)
+ "If settings dicate, implement binding of multishell command key.
+
+If optional UNBIND is true, globally unbind the key.
+
+* `multishell-activate-command-key' - Set this to get the binding or not.
+* `multishell-command-key' - The key to use for the binding, if appropriate."
+ (cond (unbind
+ (when (and (boundp 'multishell-command-key) multishell-command-key)
+ (global-unset-key multishell-command-key)))
+ ((not (and (boundp 'multishell-activate-command-key)
+ (boundp 'multishell-command-key)))
+ nil)
+ ((and multishell-activate-command-key multishell-command-key)
+ (setq multishell--responsible-for-command-key t)
+ (global-set-key multishell-command-key 'multishell-pop-to-shell))))
+
+(defcustom multishell-activate-command-key nil
+ "Set this to impose the `multishell-command-key' binding.
+
+You can instead manually bind `multishell-pop-to-shell` using emacs
+lisp, eg: (global-set-key \"\\M- \" 'multishell-pop-to-shell)."
+ :type 'boolean
+ :set 'multishell-activate-command-key-setter)
+
+;; Implement the key customization whenever the package is loaded:
+(if (fboundp 'with-eval-after-load)
+ (with-eval-after-load "multishell"
+ (multishell-implement-command-key-choice))
+ (eval-after-load "multishell"
+ '(multishell-implement-command-key-choice)))
+
+(defcustom multishell-pop-to-frame nil
+ "*If non-nil, jump to a frame already showing the shell, if another one is.
+
+Otherwise, disregard already-open windows on the shell if they're
+in another frame, and open a new window on the shell in the
+current frame.
+
+\(Use `pop-up-windows' to change multishell other-window vs
+current-window behavior.)"
+ :type 'boolean)
+
+(defcustom multishell-history-entry-tracks-current-directory t
+ "Maintain shell's current directory in its multishell history entry.
+
+When set, the history entry for shells started with explicit
+paths will track the shell's current working directory.
+
+If `savehist-save-minibuffer-history' is enabled, the current
+working directory of shells will be conveyed between emacs
+sessions."
+ :type 'boolean)
+
+(defvar multishell-history nil
+ "Name/path entries, most recent first.")
+;; Migrate the few pre 1.0.5 users to changed history var:
+(when (and (not multishell-history)
+ (boundp 'multishell-buffer-name-history)
+ multishell-buffer-name-history)
+ (setq multishell-history multishell-buffer-name-history
+ multishell-buffer-name-history nil))
+
+(defvar multishell-primary-name "*shell*"
+ "Default shell name for un-modified multishell-pop-to-shell buffer target.
+
+This is set by `multishell-pop-to-shell' as the current default,
+when invoked with doubled universal argument.
+
+If you want the designated primary that you have at the end of
+one emacs session to be resumed at the next, customize
+`savehist-additional-variables' to include the
+`multishell-primary-name'.")
+
+(defvar multishell-completing-read nil
+ "Internal use, conveying whether or not we're in the midst of a multishell
+completing-read.")
+
+;; Multiple entries happen because completion also adds name to history.
+(defun multishell-register-name-to-path (name path)
+ "Add or replace entry associating NAME with PATH in `multishell-history'.
+
+If NAME already had a PATH and new PATH is empty, retain the prior one.
+
+Promote added/changed entry to the front of the list."
+ ;; Add or promote to the front, tracking path changes in the process.
+ (let* ((entries (multishell-history-entries name))
+ (path (or path "")))
+ (dolist (entry entries)
+ (when (string= path "")
+ ;; Retain explicit established path.
+ (setq path (cadr (multishell-split-entry entry))))
+ (setq multishell-history (delete entry multishell-history)))
+ (setq multishell-history (push (concat name path)
+ multishell-history))))
+
+(defun multishell-replace-entry (entry revised)
+ "Replace every instance of ENTRY in `multishell-history' with REVISED.
+
+Revised entry is situated where former one was.
+
+Returns non-nil iff any changes were made."
+ (let ((candidates multishell-history)
+ did-revisions)
+ (while (setq candidates (member entry candidates))
+ (setcar candidates revised)
+ (setq candidates (cdr candidates)
+ did-revisions t))
+ did-revisions))
+
+(defun multishell-history-entries (name)
+ "Return `multishell-history' entry that starts with NAME, or nil if none."
+ (let (got)
+ (dolist (entry multishell-history)
+ (when (and (string-equal name (multishell-name-from-entry entry))
+ (not (member entry got)))
+ (push entry got)))
+ got))
+
+;;;###autoload
+(defun multishell-pop-to-shell (&optional arg name here)
+ "Easily navigate to and within multiple shell buffers, local and remote.
+
+Use a single `universal-argument' (\\[universal-argument]) to launch and
choose between
+nalternate shell buffers, and a doubled universal argument to also set your
+choice as the ongoing default. Append a path to a new shell name to launch
+a shell in that directory, and use Emacs tramp syntax to launch a remote
+shell. There is a shortcut to manage your list of current and
+historical shells, collectively, using `multishell-list' - see below.
+
+Customize-group `multishell' to set up a key binding and tweak behaviors.
+
+Manage your collection of current and historical shells by
+recursively invoking \\[multishell-pop-to-shell] at the
+`multishell-pop-to-shell' universal argument prompts, eg:
+
+ \\[universal-argument] \\[multishell-pop-to-shell]
\\[multishell-pop-to-shell]
+
+\(That will be just a few keys if you do the above
+customization.) Hit ? in the listing buffer for editing commands.
+
+==== Basic operation:
+
+ - If the current buffer is shell-mode (or shell-mode derived)
+ buffer then focus is moved to the process input point.
+
+ \(You can use a universal argument go to a different shell
+ buffer when already in a buffer that has a process - see
+ below.)
+
+ - If not in a shell buffer (or with universal argument), go to a
+ window that is already showing the (a) shell buffer, if any.
+
+ In this case, the cursor is left in its prior position in the
+ shell buffer. Repeating the command will then go to the
+ process input point, per the first item in this list.
+
+ We respect `pop-up-windows', so you can adjust it to set the
+ other-buffer/same-buffer behavior.
+
+ - Otherwise, start a new shell buffer, using the current
+ directory as the working directory.
+
+If a buffer with the resulting name exists and its shell process
+was disconnected or otherwise stopped, it's resumed.
+
+===== Universal arg to start and select between named shell buffers:
+
+You can name alternate shell buffers to create or return to, by
+prefixing your \\[multishell-pop-to-shell] invocation with single or double
+`universal-argument', \\[universal-argument]:
+
+ - With a single universal argument, prompt for the buffer name
+ to use (without the asterisks that shell mode will put around
+ the name), defaulting to 'shell'.
+
+ Completion is available.
+
+ This combination makes it easy to start and switch across
+ multiple shell restarts.
+
+ - A double universal argument will prompt for the name *and* set
+ the default to that name, so the target shell becomes the
+ primary.
+
+ See `multishell-primary-name' for info about preserving the
+ setting across emacs restarts.
+
+ - Manage your collection of current and historical shells by
+ recursively invoking \\[multishell-pop-to-shell] at either of the
+ `multishell-pop-to-shell' universal argument prompts, or at any
+ time via \\[multishell-list]. Hit ? in the listing buffer for
+ editing commands.
+
+===== Select starting directory and remote host:
+
+The shell buffer name you give to the prompt for a universal arg
+can include an appended path. That will be used for the startup
+directory. You can use tramp remote syntax to specify a remote
+shell. If there is an element after a final '/', that's used for
+the buffer name. Otherwise, the host, domain, or path is used.
+
+For example:
+
+* '#root/sudo:address@hidden:/etc' for a buffer named \"*#root*\" with a
+ root shell starting in /etc.
+
+* '/ssh:example.net:' for a shell buffer in your homedir on example.net.
+ The buffer will be named \"*example.net*\".
+
+* '#ex/ssh:example.net|sudo:address@hidden:/var/log' for a root shell
+ starting in /var/log on example.net named \"*#ex*\".
+
+* 'interior/ssh:gateway.corp.com|ssh:interior.corp.com:' to go
+ via gateway.corp.com to your homedir on interior.corp.com. The
+ buffer will be named \"*interior*\". You could append a sudo
+ hop to the path, combining the previous example, and so on.
+
+File visits from the shell, and many common emacs activities like
+dired, will be on the host where the shell is running, in the
+auspices of the target account, and relative to the current
+directory.
+
+You can change the startup path for a shell buffer by editing it
+at the completion prompt. The new path will not take effect for
+an already-running shell.
+
+To remove a shell buffer's history entry, kill the buffer and
+affirm removal of the entry when prompted.
+
+===== Activate savehist to retain shell buffer names and paths across Emacs
restarts:
+
+To have emacs maintain your history of shell buffer names and paths,
+customize the savehist group to activate savehist."
+
+ (interactive "P")
+
+ (let ((token '(token)))
+ (if (window-minibuffer-p)
+ (throw 'multishell-minibuffer-exit token)
+ (let ((got (catch 'multishell-minibuffer-exit
+ (multishell-pop-to-shell-worker arg name here))))
+ ;; Handle catch or plain fall-through - see cond comments for protocol.
+ (cond
+ ;; Caught token from recursive invocation in minibuffer:
+ ((equal token got) (multishell-list))
+ ;; Caught specifaction of multishell args, eg from multishell-list:
+ ((listp got) (multishell-pop-to-shell-worker (nth 2 got)
+ (nth 0 got)
+ (nth 1 got)))
+ ;; Regular fallthrough - just relay the result:
+ (t got))))))
+
+(defun multishell-pop-to-shell-worker (&optional arg name here)
+ "Do real work of `multishell-pop-to-shell', which see."
+ (let* ((from-buffer (current-buffer))
+ (from-buffer-is-shell (derived-mode-p 'shell-mode))
+ (primary-name-unbracketed (multishell-unbracket
+ multishell-primary-name))
+ (fallthrough-name (if from-buffer-is-shell
+ (buffer-name from-buffer)
+ primary-name-unbracketed))
+ (doublearg (equal arg '(16)))
+ (target-name-and-path
+ (multishell-resolve-target-name-and-path
+ (cond (name name)
+ (arg
+ (or (multishell-read-unbracketed-entry
+ (format "Shell buffer name [%s]%s "
+ primary-name-unbracketed
+ (if doublearg " <==" ":")))
+ primary-name-unbracketed))
+ (t fallthrough-name))))
+ (use-path (cadr target-name-and-path))
+ (target-shell-buffer-name (car target-name-and-path))
+ (target-buffer (get-buffer target-shell-buffer-name))
+ (curr-buff-proc (get-buffer-process from-buffer))
+ inwin
+ already-there)
+
+ ;; Register early so the entry is pushed to the front:
+ (multishell-register-name-to-path (multishell-unbracket
+ target-shell-buffer-name)
+ use-path)
+
+ (when doublearg
+ (setq multishell-primary-name target-shell-buffer-name))
+
+ ;; Situate:
+
+ (cond
+
+ ((and (or curr-buff-proc from-buffer-is-shell)
+ (not arg)
+ (eq from-buffer target-buffer)
+ (not (eq target-shell-buffer-name (buffer-name from-buffer))))
+ ;; In a shell buffer, but not named - stay in buffer, but go to end.
+ (setq already-there t))
+
+ ((string= (buffer-name) target-shell-buffer-name)
+ ;; Already in the specified shell buffer:
+ (setq already-there t))
+
+ ((or (not target-buffer)
+ (not (setq inwin
+ (multishell-get-visible-window-for-buffer
target-buffer))))
+ ;; No preexisting shell buffer, or not in a visible window:
+ (when (not (get-buffer target-shell-buffer-name))
+ (message "Creating new shell buffer '%s'" target-shell-buffer-name))
+ (if here
+ (switch-to-buffer target-shell-buffer-name)
+ (pop-to-buffer target-shell-buffer-name pop-up-windows)))
+
+ ;; Buffer exists and already has a window - jump to it:
+ (t (if (and multishell-pop-to-frame
+ inwin
+ (not (equal (window-frame (selected-window))
+ (window-frame inwin))))
+ (select-frame-set-input-focus (window-frame inwin)))
+ (if (not (string= (buffer-name (current-buffer))
+ target-shell-buffer-name))
+ (if here
+ (switch-to-buffer target-shell-buffer-name)
+ (pop-to-buffer target-shell-buffer-name t)))))
+
+ ;; We're in the buffer. Activate:
+
+ (if (not (comint-check-proc (current-buffer)))
+ (multishell-start-shell-in-buffer use-path))
+
+ ;; If the destination buffer has a stopped process, resume it:
+ (let ((process (get-buffer-process (current-buffer))))
+ (if (and process (equal 'stop (process-status process)))
+ (continue-process process)))
+
+ (when (or already-there
+ (equal (current-buffer) from-buffer))
+ (goto-char (point-max))
+ (and (get-buffer-process from-buffer)
+ (goto-char (process-mark (get-buffer-process from-buffer)))))))
+
+(defun multishell-delete-history-name (name &optional ask)
+ "Remove all multishell history entries for NAME.
+
+if optional ask is non-nil (default nil), ask before each deletion.
+
+Return the last entry deleted."
+ (let (got)
+ (dolist (entry (multishell-history-entries name) got)
+ (when (and entry
+ (or (not ask)
+ (y-or-n-p (format "Remove multishell history entry `%s'? "
+ entry))))
+ (setq got entry
+ multishell-history (delete entry multishell-history))))))
+
+(defun multishell-kill-buffer-query-function ()
+ "Offer to remove multishell-history entry for buffer."
+ ;; Removal choice is crucial, so users can, eg, kill a shell with huge
+ ;; output backlog, while keeping the history entry to easily restart it.
+ ;;
+ ;; We use kill-buffer-query-functions instead of kill-buffer-hook because:
+ ;;
+ ;; 1. It enables the user to remove the history without actually killing a
+ ;; running buffer, by not confirming the subsequent running-proc query.
+ ;; 2. kill-buffer-hooks often fails to run when killing shell buffers!
+ ;; It's probably due to failures in other hooks - beyond our control -
+ ;; and anyway, I like the first reason well enough.
+
+ ;; (Use condition-case to avoid inadvertant disruption of kill-buffer
+ ;; activity. kill-buffer happens behind the scenes a whole lot.)
+ (condition-case err
+ (and (derived-mode-p 'shell-mode)
+ (multishell-delete-history-name
+ (multishell-unbracket (buffer-name))
+ t))
+ (error
+ (message "multishell-kill-buffer-query-function error: %s" err)))
+ t)
+(add-hook 'kill-buffer-query-functions 'multishell-kill-buffer-query-function)
+
+(defun multishell-get-visible-window-for-buffer (buffer)
+ "Return visible window containing buffer."
+ (catch 'got-a-vis
+ (walk-windows
+ (function (lambda (win)
+ (if (and (eq (window-buffer win) buffer)
+ (equal (frame-parameter
+ (selected-frame) 'display)
+ (frame-parameter
+ (window-frame win) 'display)))
+ (throw 'got-a-vis win))))
+ nil 'visible)
+ nil))
+
+(defun multishell-all-entries (&optional active-duplicated)
+ "Return multishell history, with active buffers listed first.
+
+Optional ACTIVE-DUPLICATED will return a copy of
+`multishell-history' with unbracketed names of active buffers,
+sans paths, appended to the list, so they have short and long
+completions."
+ ;; Reorder so active lead present lead historical entries:
+ (let (active-entries active-names present past splat name buffer)
+ (dolist (entry multishell-history)
+ (setq splat (multishell-split-entry entry)
+ name (car splat)
+ buffer (and name (get-buffer (multishell-bracket name))))
+ (if (buffer-live-p buffer)
+ (if (comint-check-proc buffer)
+ (setq active-entries (push entry active-entries)
+ active-names (push name active-names))
+ (setq present (push entry present)))
+ (setq past (push entry past))))
+ ;; Reverse present and past lists
+ (setq multishell-history (append (reverse active-entries)
+ (reverse present)
+ (reverse past)))
+ (if active-duplicated
+ (append multishell-history active-names)
+ multishell-history)))
+
+(defun multishell-read-unbracketed-entry (prompt &optional initial no-record)
+ "PROMPT for shell buffer name, sans asterisks.
+
+Optional INITIAL is preliminary value to be edited.
+
+Optional NO-RECORD prevents changes to `multishell-history'
+across the activity.
+
+Input and completion can include associated path, if any.
+
+Return what's provided, if anything, else nil."
+ (let* ((was-multishell-history multishell-history)
+ (candidates (multishell-all-entries 'active-duplicated))
+ (multishell-completing-read t)
+ (got
+ ;; Use `cl-letf' to dynamically bind multishell-list to
+ ;; display-completion-list, so multishell-list is used when doing
+ ;; minibuffer-completion-help.
+ (cl-letf (((symbol-function 'display-completion-list)
+ #'multishell-list))
+ (completing-read prompt
+ ;; COLLECTION:
+ (reverse candidates)
+ ;; PREDICATE:
+ nil
+ ;; REQUIRE-MATCH:
+ 'confirm
+ ;; INITIAL-INPUT
+ initial
+ ;; HIST:
+ 'multishell-history))))
+ (when no-record
+ (setq multishell-history was-multishell-history))
+ (if (not (string= got ""))
+ got
+ nil)))
+
+(defun multishell-resolve-target-name-and-path (shell-spec)
+ "Given name/tramp-style address shell spec, resolve buffer name and
directory.
+
+The name is the part of the string up to the first '/' slash, if
+any. Missing pieces are filled in from remote path elements, if
+any, and multishell history. Given a tramp-style remote address
+and no name part, either the address@hidden is used for the buffer
+name, if a user is specified, or just the host.
+
+Return them as a list: (name path), with name asterisk-bracketed
+and path nil if none is resolved."
+ (let* ((splat (multishell-split-entry (or shell-spec "")))
+ (path (cadr splat))
+ (name (or (car splat) (multishell-name-from-entry path))))
+ (when (not path)
+ ;; Get path from history, if present.
+ (dolist (entry
+ (multishell-history-entries
+ (multishell-unbracket name)))
+ (when (or (not path) (string= path ""))
+ (setq path (cadr (multishell-split-entry entry))))))
+ (list (multishell-bracket name) path)))
+
+(defun multishell-name-from-entry (entry)
+ "Derive a name for a shell buffer according to ENTRY."
+ (if (not entry)
+ (multishell-unbracket multishell-primary-name)
+ (let* ((splat (multishell-split-entry entry))
+ (name (car splat))
+ (path (cadr splat)))
+ (or name
+ (if (file-remote-p path)
+ (let ((host (file-remote-p path 'host))
+ (user (file-remote-p path 'user)))
+ (cond ((and host user)
+ (format "address@hidden" user host))
+ (host host)
+ (user user)
+ ((system-name))))
+ (multishell-unbracket multishell-primary-name))))))
+
+(declare-function tramp-dissect-file-name "tramp")
+(declare-function tramp-cleanup-connection "tramp")
+
+(defun multishell-start-shell-in-buffer (path)
+ "Start, restart, or continue a shell in BUFFER-NAME on PATH."
+ (let* ((is-active (comint-check-proc (current-buffer))))
+
+ (when (and path (not is-active))
+
+ (when (and (derived-mode-p 'shell-mode) (file-remote-p path))
+ ;; Returning to disconnected remote shell - do some tidying.
+ ;; Without this cleanup, occasionally restarting a disconnected
+ ;; remote session, particularly one that includes sudo, results in
+ ;; an untraceable "Args out of range" error. That never happens if
+ ;; we precedeed connection attempts with this cleanup -
+ ;; prophylactic.
+ (tramp-cleanup-connection
+ (tramp-dissect-file-name default-directory 'noexpand)
+ 'keep-debug 'keep-password))
+
+ (when (file-remote-p path) (message "Connecting to %s" path))
+ (cd path))
+
+ (shell (current-buffer))))
+
+(defun multishell-homedir-shorthand-p (dirpath)
+ "t if dirpath is an unexpanded remote homedir spec."
+ ;; Workaround to recognize tramp-style homedir shorthand, "...:" and "...:~".
+ (let ((localname (file-remote-p dirpath 'localname)))
+ (and localname
+ (or
+ ;; No directory path and no connection to expand homedir:
+ (string= localname "")
+ ;; Original path doesn't equal expanded homedir:
+ (save-match-data
+ (not (string-match (concat (regexp-quote localname) "/?$")
+ dirpath)))))))
+;; (assert (multishell-homedir-shorthand-p "/ssh:myhost.net:")
+;; (assert (not (multishell-homedir-shorthand-p "/home/klm")))
+;; (assert (not (multishell-homedir-shorthand-p "/ssh:myhost.net:/home/me")))
+
+(defun multishell-track-dirchange (name newpath)
+ "Change multishell history entry to track current directory."
+ (let* ((entries (multishell-history-entries name)))
+ (dolist (entry entries)
+ (let* ((name-path (multishell-split-entry entry))
+ (name (car name-path))
+ (path (or (cadr name-path) "")))
+ (when path
+ (let* ((old-localname (or (file-remote-p path 'localname)
+ path))
+ (newentry
+ (if (multishell-homedir-shorthand-p path)
+ (concat entry newpath)
+ (replace-regexp-in-string (concat (regexp-quote
+ old-localname)
+ "$")
+ ;; REPLACEMENT
+ newpath
+ ;; STRING
+ entry
+ ;; FIXEDCASE
+ t
+ ;; LITERAL
+ t
+ )))
+ (membership (member entry multishell-history)))
+ (when membership
+ (setcar membership newentry))))))))
+
+(defvar multishell-was-default-directory ()
+ "Provide for tracking directory changes.")
+(make-variable-buffer-local 'multishell-was-default-directory)
+(defun multishell-post-command-business ()
+ "Do multishell bookkeeping."
+ ;; Update multishell-history with dir changes.
+ (condition-case err
+ (when (and multishell-history-entry-tracks-current-directory
+ (derived-mode-p 'shell-mode))
+ (let ((curdir (if (file-remote-p default-directory)
+ (file-remote-p default-directory 'localname)
+ default-directory)))
+ (when (not (string= curdir (or multishell-was-default-directory "")))
+ (multishell-track-dirchange (multishell-unbracket (buffer-name))
+ curdir))
+ (setq multishell-was-default-directory curdir)))
+ ;; To avoid disruption as a pervasive hook function, swallow all errors:
+ (error
+ (message "multishell-post-command-business error: %s" err))))
+(add-hook 'post-command-hook #'multishell-post-command-business)
+
+(defun multishell-split-entry (entry)
+ "Given multishell name/path ENTRY, return the separated name and path pair.
+
+Returns nil for empty parts, rather than the empty string."
+ (save-match-data
+ (string-match "^\\([^/]*\\)\\(/?.*\\)?" entry)
+ (let ((name (match-string 1 entry))
+ (path (match-string 2 entry)))
+ (and (string= name "") (setq name nil))
+ (and (string= path "") (setq path nil))
+ (list name path))))
+(defun multishell-bracket (name)
+ "Return a copy of name, ensuring it has an asterisk at the beginning and
end."
+ (if (not (string= (substring name 0 1) "*"))
+ (setq name (concat "*" name)))
+ (if (not (string= (substring name -1) "*"))
+ (setq name (concat name "*")))
+ name)
+(defun multishell-unbracket (name)
+ "Return a copy of name, removing asterisks, if any, at beginning and end."
+ (if (string= (substring name 0 1) "*")
+ (setq name (substring name 1)))
+ (if (string= (substring name -1) "*")
+ (setq name (substring name 0 -1)))
+ name)
+
+(provide 'multishell)
+
+;;; multishell.el ends here
diff --git a/packages/nameless/LICENSE b/packages/nameless/LICENSE
new file mode 100644
index 0000000..8cdb845
--- /dev/null
+++ b/packages/nameless/LICENSE
@@ -0,0 +1,340 @@
+ 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
new file mode 100644
index 0000000..9d8b7eb
--- /dev/null
+++ b/packages/nameless/README.org
@@ -0,0 +1,129 @@
+#+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-from-hook)
+#+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
new file mode 100644
index 0000000..38bea2d
Binary files /dev/null and b/packages/nameless/example-nameless.png differ
diff --git a/packages/nameless/nameless.el b/packages/nameless/nameless.el
new file mode 100644
index 0000000..183b46d
--- /dev/null
+++ b/packages/nameless/nameless.el
@@ -0,0 +1,291 @@
+;;; nameless.el --- Hide package namespace in your emacs-lisp code -*-
lexical-binding: t; -*-
+
+;; Copyright (C) 2015 Free Software Foundation, Inc.
+
+;; Author: Artur Malabarba <address@hidden>
+;; URL: https://github.com/Malabarba/nameless
+;; Keywords: convenience, lisp
+;; Version: 0.5.1
+;; 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
+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."
+ (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))
+
+
+;;; 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\\)?\\.[^.]*\\'" ""
(lm-get-package-name))))
+ (add-function :filter-return (local 'filter-buffer-substring-function)
+ #'nameless--filter-string)
+ (apply #'nameless--add-keywords
+ `(,@(when nameless-current-name
+ `((nil . ,nameless-current-name)))
+ ,@nameless-global-aliases
+ ,@nameless-aliases)))
+ (remove-function (local 'filter-buffer-substring-function)
+ #'nameless--filter-string)
+ (setq nameless-current-name nil)
+ (nameless--remove-keywords)))
+
+;;;###autoload
+(defun nameless-mode-from-hook ()
+ "Turn on `nameless-mode'.
+Designed to be added to `emacs-lisp-mode-hook'.
+Interactively, just invoke `nameless-mode' directly."
+ (add-hook 'find-file-hook #'nameless-mode nil 'local))
+
+(provide 'nameless)
+;;; nameless.el ends here
diff --git a/packages/names/TheNittyGritty.org
b/packages/names/TheNittyGritty.org
index 78bf88b..84bf6b8 100644
--- a/packages/names/TheNittyGritty.org
+++ b/packages/names/TheNittyGritty.org
@@ -139,6 +139,41 @@ need to worry about, it should just do what you expect
from it.
This is only relevant if you write your own macros. If you do,
remember to add a debug declaration in them.
+
+*** The theading macros (~->~ and ~-->~)
+
+The threading macros would require special treatment to namespace
+correctly. However, you can use the ~:functionlike-macros~ keyword to
+tell *Names* to treat them as regular functions.
+
+For example, in the following snippet:
+#+BEGIN_SRC emacs-lisp
+(require 'dash)
+(define-namespace foo-
+:functionlike-macros (-> ->>)
+
+(defvar var nil)
+(defun fun (x &optional y)
+ (concat x y))
+
+(-> "some string"
+ (fun var)
+ fun)
+)
+#+END_SRC
+the ~(fun var)~ part would be namespaced prefectly fine (~fun~ and
+~var~ will be identified as a function and variable respectively),
+because it looks like a regular function call. However, the second use
+of ~fun~ will not be correctly namespaced, because that ~fun~ looks
+like a variable.
+
+In other words, you should use these macros like this instead:
+#+BEGIN_SRC emacs-lisp
+(-> "some string"
+ (fun var)
+ (fun))
+#+END_SRC
+
** Accessing Global Symbols
If one of your definitions shadows a global definition, you can still
access it by prefixing it with =::=.
diff --git a/packages/names/UsageExample.org b/packages/names/UsageExample.org
index b27160e..5730966 100644
--- a/packages/names/UsageExample.org
+++ b/packages/names/UsageExample.org
@@ -14,7 +14,10 @@ The important items are already listed in the Readme:
;;; Code:
-;; `define-namespace' is autoloaded, so there's no need to require `names'.
+;; `define-namespace' is autoloaded, so there's no need to require
+;; `names'. However, requiring it here means it will also work for
+;; people who don't install through package.el.
+(eval-when-compile (require 'names))
;;;###autoload
(define-namespace example-
diff --git a/packages/names/names-dev.el b/packages/names/names-dev.el
index 0133604..c139d64 100644
--- a/packages/names/names-dev.el
+++ b/packages/names/names-dev.el
@@ -2,9 +2,6 @@
;; Copyright (C) 2014 Free Software Foundation, Inc.
-;; Author: Artur Malabarba <address@hidden>
-;; Maintainer: Artur Malabarba <address@hidden>
-;; URL: http://github.com/Bruce-Connor/names
;; Prefix: names
;; Separator: -
@@ -62,11 +59,11 @@
(defmacro names-print (name &rest forms)
"Return the expanded results of (namespace NAME :global :verbose FORMS).
Ideal for determining why a specific form isn't being parsed
-correctly."
+correctly. You may need to set `eval-expression-print-level' and
+`eval-expression-print-length' to nil in order to see your full
+expansion."
(declare (indent (lambda (&rest x) 0)) (debug 0))
- `(let ((eval-expression-print-level (max eval-expression-print-level 300))
- (eval-expression-print-length (max eval-expression-print-length 300)))
- (macroexpand '(define-namespace ,name :global :verbose ,@forms))))
+ `(define-namespace ,name :global :verbose ,@forms))
(defvar names-font-lock
'(("^:autoload\\_>" 0 'font-lock-warning-face prepend)
@@ -152,12 +149,17 @@ If KILL is non-nil, kill the temp buffer afterwards."
(kill-buffer b))))))
(defun names--top-of-namespace ()
- ""
- (progn
- (beginning-of-defun)
- (ignore-errors
- (backward-up-list)
- (names--looking-at-namespace))))
+ "Move to the top of current namespace, and return non-nil.
+If not inside a namespace, return nil and don't move point."
+ (let ((top (save-excursion
+ (beginning-of-defun)
+ (ignore-errors
+ (backward-up-list))
+ (when (names--looking-at-namespace)
+ (point)))))
+ (when top
+ (goto-char top)
+ t)))
(defun names-eval-defun (edebug-it)
"Identical to `eval-defun', except it works for forms inside namespaces.
@@ -176,7 +178,9 @@ to be edebugged."
;;; eval-last-sexp
(defalias 'names--preceding-sexp-original
- (symbol-function 'elisp--preceding-sexp))
+ (if (fboundp 'elisp--preceding-sexp)
+ (symbol-function 'elisp--preceding-sexp)
+ (symbol-function 'preceding-sexp)))
(defun names--preceding-sexp ()
"Like `elisp--preceding-sexp', but expand namespaces."
@@ -188,19 +192,28 @@ to be edebugged."
"Identical to `eval-last-sexp', except it works for forms inside namespaces.
Argument EVAL-LAST-SEXP-ARG-INTERNAL is the same as `eval-last-sexp'."
(interactive "P")
- (cl-letf (((symbol-function 'elisp--preceding-sexp)
- #'names--preceding-sexp))
+ (cl-letf (((symbol-function 'elisp--preceding-sexp) #'names--preceding-sexp)
+ ((symbol-function 'preceding-sexp) #'names--preceding-sexp))
(eval-last-sexp eval-last-sexp-arg-internal)))
(defun names-eval-print-last-sexp (eval-last-sexp-arg-internal)
"Identical to `eval-print-last-sexp', except it works for forms inside
namespaces.
Argument EVAL-LAST-SEXP-ARG-INTERNAL is the same as `eval-print-last-sexp'."
(interactive "P")
- (cl-letf (((symbol-function 'elisp--preceding-sexp)
- #'names--preceding-sexp))
+ (cl-letf (((symbol-function 'elisp--preceding-sexp) #'names--preceding-sexp)
+ ((symbol-function 'preceding-sexp) #'names--preceding-sexp))
(eval-print-last-sexp eval-last-sexp-arg-internal)))
-;; (pp (symbol-function 'names-eval-defun) (current-buffer))
+;; (pp (symbol-function 'names--preceding-sexp-original) (current-buffer))
+
+(defun names-pprint ()
+ "Pretty-print an expansion of the namespace around point."
+ (interactive)
+ (save-excursion
+ (when (names--top-of-namespace)
+ (let ((ns (cdr (read (current-buffer)))))
+ (pp-macroexpand-expression
+ (macroexpand (cons 'names-print ns)))))))
;;; Find stuff
diff --git a/packages/names/names.el b/packages/names/names.el
index 5cc70e2..62aafdf 100644
--- a/packages/names/names.el
+++ b/packages/names/names.el
@@ -1,22 +1,19 @@
-;;; names.el --- Namespaces for emacs-lisp. Avoid name clobbering without
hiding symbols.
+;;; names.el --- Namespaces for emacs-lisp. Avoid name clobbering without
hiding symbols. -*- lexical-binding:t -*-
-;; Copyright (C) 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
-;; Author: Artur Malabarba <address@hidden>
-;; Maintainer: Artur Malabarba <address@hidden>
-;; URL: http://github.com/Bruce-Connor/names
-;; Version: 20150115.1
+;; Author: Artur Malabarba <address@hidden>
+;; URL: https://github.com/Malabarba/names
+;; Version: 20151201.0
;; Package-Requires: ((emacs "24.1") (cl-lib "0.5"))
;; Keywords: extensions lisp
-;; Prefix: names
-;; Separator: -
;;; Commentary:
;;
;; The description is way too large to sanely write here, below is a
;; summary. For a complete description, please visit the package's
;; frontpage with `M-x names-view-manual', or see the Readme file on
-;; https://raw.githubusercontent.com/Bruce-Connor/names/master/Readme.org
+;; https://raw.githubusercontent.com/Malabarba/names/master/Readme.org
;;; License:
;;
@@ -44,10 +41,13 @@
;; If `C-x' is not a prefix.
(unless (consp (key-binding "\C-x"))
;; Disable the `C-xC-a' binds.
+ (defvar edebug-inhibit-emacs-lisp-mode-bindings)
(setq edebug-inhibit-emacs-lisp-mode-bindings t)
;; And the `C-xX' binds.
- (when (or (null (boundp 'global-edebug-prefix))
- (eq 24 (elt global-edebug-prefix 0)))
+ (defvar global-edebug-prefix)
+ (when (ignore-errors
+ (or (null (boundp 'global-edebug-prefix))
+ (eq ?\C-x (elt global-edebug-prefix 0))))
(setq global-edebug-prefix "")))
(require 'edebug)
(require 'bytecomp)
@@ -55,43 +55,46 @@
;;; Support
(declare-function names--autoload-do-load "names" 2)
-(if (fboundp 'function-get)
- (defalias 'names--function-get #'function-get)
- (defun names--function-get (f prop &rest _)
- "Return the value of property PROP of function F.
+(defalias 'names--function-get
+ (if (fboundp 'function-get) #'function-get
+
+ (defun names--autoload-do-load (def name)
+ "Load autoloaded definition DEF from function named NAME."
+ (unless (load (cadr def) 'noerror)
+ (error "Macro `%s' is autoloaded, but its file (%s) couldn't be loaded"
+ name (cadr def)))
+ (symbol-function name))
+
+ (lambda (f prop &rest _)
+ "Return the value of property PROP of function F.
If F is an autoloaded macro, try to autoload it in the hope that
it will set PROP."
- (let ((val nil))
- (while (and (symbolp f)
- (null (setq val (get f prop)))
- (fboundp f))
- (let ((fundef (symbol-function f)))
- (if (and (names--autoloadp fundef)
- (not (equal fundef (names--autoload-do-load fundef f))))
- nil ;Re-try `get' on the same `f'.
- (setq f fundef))))
- val))
- (defun names--autoload-do-load (def name)
- "Load autoloaded definition DEF from function named NAME."
- (unless (load (cadr def) 'noerror)
- (error "Macro `%s' is autoloaded, but its file (%s) couldn't be loaded"
- name (cadr def)))
- (symbol-function name)))
-
-(if (fboundp 'macrop)
- (defalias 'names--compat-macrop #'macrop)
- (defun names--compat-macrop (object)
- "Non-nil if and only if OBJECT is a macro."
- (let ((def (indirect-function object t)))
- (when (consp def)
- (or (eq 'macro (car def))
- (and (names--autoloadp def) (memq (nth 4 def) '(macro t))))))))
-
-(if (fboundp 'autoloadp)
- (defalias 'names--autoloadp #'autoloadp)
- (defsubst names--autoloadp (object)
- "Non-nil if OBJECT is an autoload."
- (eq 'autoload (car-safe object))))
+ (let ((val nil))
+ (while (and (symbolp f)
+ (null (setq val (get f prop)))
+ (fboundp f))
+ (let ((fundef (symbol-function f)))
+ (if (and (names--autoloadp fundef)
+ (not (equal fundef (names--autoload-do-load fundef f))))
+ nil ;Re-try `get' on the same `f'.
+ (setq f fundef))))
+ val))))
+
+(defalias 'names--compat-macrop
+ (if (fboundp 'macrop) #'macrop
+ (lambda (object)
+ "Non-nil if and only if OBJECT is a macro."
+ (let ((def (or (ignore-errors (indirect-function object t))
+ (ignore-errors (indirect-function object)))))
+ (when (consp def)
+ (or (eq 'macro (car def))
+ (and (names--autoloadp def) (memq (nth 4 def) '(macro t)))))))))
+
+(defalias 'names--autoloadp
+ (if (fboundp 'autoloadp) #'autoloadp
+ (lambda (object)
+ "Non-nil if OBJECT is an autoload."
+ (eq 'autoload (car-safe object)))))
(unless (get-edebug-spec 'cl-defun)
(def-edebug-spec cl-defun defun*))
@@ -120,7 +123,7 @@ it will set PROP."
;;; ---------------------------------------------------------------
;;; Variables
-(defconst names-version "20150115.1" "Version of the names.el package.")
+(defconst names-version "20151201.0" "Version of the names.el package.")
(defvar names--name nil
"Name of the current namespace inside the `define-namespace' macro.")
@@ -182,6 +185,22 @@ Is only non-nil if the :group keyword is passed to
`define-namespace'.")
"The version number given by :version.
Used to define a constant and a command.")
+(defvar names--functionlike-macros nil
+ "Function-like macros, even if their debug-spec says otherwise.
+When expanding the namespace, these macros will be treated
+exactly like functions. This means that their contents will be
+namespaced like regular function arguments.
+
+To add macros to this list, pass the :functionlike-macros keyword
+to your namespace along with a list of macro names (as unquoted
+symbols).
+Example:
+
+ (define-namespace foo-
+ :functionlike-macros (-> ->> thread-first thread-last)
+ ;; Rest of code
+ )")
+
(defconst names--keyword-list
`((:group
1 ,(lambda (x)
@@ -240,6 +259,12 @@ needed by the :version and :group keywords.")
(format "\\`%s" (regexp-quote val)))))
"Change the value of the `names--protection' variable.")
+ (:functionlike-macros
+ 1
+ ,(lambda (x) (setq names--functionlike-macros
+ (append x names--functionlike-macros)))
+ "A list of values to be appended to `names--functionlike-macros'.")
+
(:no-let-vars
0 nil
"Indicates variables assigned in let-bind are NOT candidates for
namespacing.")
@@ -291,9 +316,9 @@ behaviour.")
`(when (boundp ',var)
(remove
nil
- (mapcar (lambda (x) (when (funcall (or ,pred 'identity) (or (car-safe x)
x))
- (or (car-safe x) x)))
- ,var))))
+ (mapcar (lambda (x) (when (funcall (or ,pred #'identity) (or (car-safe
x) x))
+ (or (car-safe x) x)))
+ ,var))))
(defmacro names--next-keyword (body)
"If car of BODY is a known keyword, `pop' it (and its arguments) from body.
@@ -305,7 +330,7 @@ Returns a list (KEYWORD . ARGUMENTLIST)."
(keywordp kar)
(setq n (assoc kar names--keyword-list))
(setq n (cadr n))
- (dotimes (it (1+ n) out)
+ (dotimes (_ (1+ n) out)
(push (pop ,body) out))
(nreverse out))))
@@ -407,6 +432,7 @@ See `define-namespace' for more information."
(names--remove-namespace-from-list
(names--filter-if-bound byte-compile-macro-environment (lambda
(x) (not (names--compat-macrop x))))
(names--filter-if-bound byte-compile-function-environment
(lambda (x) (not (names--compat-macrop x))))))
+ (names--functionlike-macros names--functionlike-macros)
names--keywords names--local-vars key-and-args
names--version names--package names--group-parent)
;; Read keywords
@@ -415,8 +441,15 @@ See `define-namespace' for more information."
(push key-and-args names--keywords))
;; First have to populate the bound and fbound lists. So we read
- ;; the entire form (without evaluating it).
- (mapc 'names-convert-form body)
+ ;; the entire form (without return it).
+ (if names--inside-make-autoload
+ ;; Dependencies haven't been loaded during autoload
+ ;; generation, so we better ignore errors here. Ideally we
+ ;; would only go through the forms marked for autoloading,
+ ;; but then we wouldn't know what symbols are var/function
+ ;; names.
+ (mapc (lambda (form) (ignore-errors (names-convert-form form)))
body)
+ (mapc #'names-convert-form body))
(setq names--current-run (1+ names--current-run))
;; Then we go back and actually namespace the entire form, which
@@ -534,7 +567,7 @@ Either it's an undefined macro, a macro with a bad debug
declaration, or we have
(defun names-view-manual ()
"Call `browse-url' to view the manual of the Names package."
(interactive)
- (browse-url "http://github.com/Bruce-Connor/names";))
+ (browse-url "http://github.com/Malabarba/names";))
(defun names--package-name ()
"Return the package name as a symbol.
@@ -593,28 +626,29 @@ Also adds `version' to `names--fbound' and
`names--bound'."
byte-compile-macro-environment))))))))
;;;###autoload
-(defadvice find-function-search-for-symbol
- (around names-around-find-function-search-for-symbol-advice
- (symbol type library) activate)
- "Make sure `find-function-search-for-symbol' understands namespaces."
- ad-do-it
- (ignore-errors
- (unless (cdr ad-return-value)
- (with-current-buffer (car ad-return-value)
- (search-forward-regexp "^(define-namespace\\_>")
- (skip-chars-forward "\r\n[:blank:]")
- (let* ((names--regexp
- (concat "\\`" (regexp-quote
- (symbol-name (read (current-buffer))))))
- (short-symbol
- ;; We manually implement `names--remove-namespace'
- ;; because it might not be loaded.
- (let ((name (symbol-name symbol)))
- (when (string-match names--regexp name)
- (intern (replace-match "" nil nil name))))))
- (when short-symbol
- (ad-set-arg 0 short-symbol)
- ad-do-it))))))
+(eval-after-load 'find-func
+ '(defadvice find-function-search-for-symbol
+ (around names-around-find-function-search-for-symbol-advice
+ (symbol type library) activate)
+ "Make sure `find-function-search-for-symbol' understands namespaces."
+ ad-do-it
+ (ignore-errors
+ (unless (cdr ad-return-value)
+ (with-current-buffer (car ad-return-value)
+ (search-forward-regexp "^(define-namespace\\_>")
+ (skip-chars-forward "\r\n[:blank:]")
+ (let* ((names--regexp
+ (concat "\\`" (regexp-quote
+ (symbol-name (read (current-buffer))))))
+ (short-symbol
+ ;; We manually implement `names--remove-namespace'
+ ;; because it might not be loaded.
+ (let ((name (symbol-name symbol)))
+ (when (string-match names--regexp name)
+ (intern (replace-match "" nil nil name))))))
+ (when short-symbol
+ (ad-set-arg 0 short-symbol)
+ ad-do-it)))))))
(defun names--extract-autoloads (body)
"Return a list of the forms in BODY preceded by :autoload."
@@ -673,14 +707,14 @@ Use the `names--inside-make-autoload' variable to
indicate to
(defun names--message (f &rest rest)
"If :verbose is on, pass F and REST to `message'."
(when (names--keyword :verbose)
- (apply 'message (concat "[names] " f) rest)))
+ (apply #'message (concat "[names] " f) rest)))
(defun names--warn (f &rest rest)
"Pass F and REST to `message', unless byte-compiling or non-interactive."
(unless (and (null (names--keyword :verbose))
(and (boundp 'byte-compile-function-environment)
byte-compile-function-environment))
- (apply 'message (concat "[names] " f) rest)))
+ (apply #'message (concat "[names] " f) rest)))
(defun names--error-if-using-vars ()
"Remind the developer that variables are not customizable."
@@ -695,7 +729,7 @@ Use the `names--inside-make-autoload' variable to indicate
to
"Return a concatenated un-namespaced version of LISTS.
Symbols in LISTS that aren't namespaced are removed, symbols that
are namespaced become un-namespaced."
- (delq nil (mapcar 'names--remove-namespace (apply 'append lists))))
+ (delq nil (mapcar 'names--remove-namespace (apply #'append lists))))
(defun names--remove-namespace (symbol)
"Return SYMBOL with namespace removed, or nil if it wasn't namespaced."
@@ -741,7 +775,10 @@ returns nil."
(and (names--keyword :global)
(boundp (names--prepend sbl))))))
-;;; This is calling edebug even on `when' and `unless'
+(defvar names--verbose nil
+ "If non-nil, verbose message are printed regardless of the :verbose keyword.
+Use this to easily turn on verbosity during tests.")
+
(defun names--args-of-function-or-macro (function args macro)
"Namespace FUNCTION's arguments ARGS, with special treatment if MACRO is
non-nil."
(if macro
@@ -749,7 +786,8 @@ returns nil."
(names--verbose (eq function 'push)))
(names--message "Edebug-spec of `%s' is %s" function it)
;; Macros where we evaluate all arguments are like functions.
- (if (equal it t)
+ (if (or (equal it t)
+ (memq function names--functionlike-macros))
(names--args-of-function-or-macro function args nil)
;; Macros where nothing is evaluated we can just return.
(if (equal it 0)
@@ -833,14 +871,10 @@ phenomenally. So we hack into edebug instead."
(symbol-function 'message))
"Where names stores `message's definition while overriding it.")
-(defvar names--verbose nil
- "If non-nil, verbose message are printed regardless of the :verbose keyword.
-Use this to easily turn on verbosity during tests.")
-
-(defun names--edebug-message (&rest _)
+(defun names--edebug-message (&rest args)
(if (or (names--keyword :verbose) names--verbose)
- (apply names--message-backup _)
- (when _ (apply 'format _))))
+ (apply names--message-backup args)
+ (when args (apply #'format args))))
(defun names--edebug-make-enter-wrapper (forms)
(setq edebug-def-name
@@ -946,11 +980,10 @@ the keyword arguments, if any."
;; lines of the functions defined below. It will be automatically used
;; whenever that form is found.
-;;; Defun, defmacro, and defsubst macros are pretty predictable.
+;; Defun, defmacro, and defsubst macros are pretty predictable.
(defun names--convert-defmacro (form)
"Special treatment for `defmacro' FORM."
- (let* ((names--name-already-prefixed t)
- (name (cadr form))
+ (let* ((name (cadr form))
(spaced-name (names--prepend name))
decl)
(add-to-list 'names--macro name)
@@ -1114,9 +1147,9 @@ quoted symbols)."
(names--handle-symbol-as-function (pop copy))
(names--handle-symbol-as-function (pop copy)))
(mapcar #'names-convert-form copy)))))
-(defalias #'names--convert-define-global-minor-mode
+(defalias 'names--convert-define-global-minor-mode
#'names--convert-define-globalized-minor-mode)
-(defalias #'names--convert-easy-mmode-define-global-mode
+(defalias 'names--convert-easy-mmode-define-global-mode
#'names--convert-define-globalized-minor-mode)
(defun names--convert-quote (form)
@@ -1128,8 +1161,7 @@ logically namespaced and is never parsed for namespacing
When FORM is (function form), a symbol is namespaced as a
function name, a list is namespaced as a lambda form."
(let ((kadr (cadr form))
- (this-name (car form))
- func)
+ (this-name (car form)))
(if (and (eq this-name 'function)
(listp kadr))
(list this-name (names-convert-form kadr))
@@ -1194,8 +1226,7 @@ Return (macro . (names-convert-form (cdr FORM)))."
(names--warn "Found a `closure'! You should use `lambda's instead")
(let ((names--local-vars
(append (names--vars-from-arglist (cadr form))
- names--local-vars))
- (forms (cdr (cdr form))))
+ names--local-vars)))
(cons
(car form)
(names--convert-lambda (cdr form)))))
diff --git a/packages/nlinum/nlinum.el b/packages/nlinum/nlinum.el
index 2505c98..98c9cbc 100644
--- a/packages/nlinum/nlinum.el
+++ b/packages/nlinum/nlinum.el
@@ -82,18 +82,36 @@ Linum mode is a buffer-local minor mode."
width)))))
(defun nlinum--setup-window ()
- (let ((width (if (display-graphic-p)
- (ceiling
- (let ((width (nlinum--face-width 'linum)))
- (if width
- (/ (* nlinum--width 1.0 width)
- (frame-char-width))
- (/ (* nlinum--width 1.0
- (nlinum--face-height 'linum))
- (frame-char-height)))))
- nlinum--width)))
- (set-window-margins nil (if nlinum-mode width)
- (cdr (window-margins)))))
+ ;; FIXME: The interaction between different uses of the margin is
+ ;; problematic. We should have a way for different packages to indicate (and
+ ;; change) their preference independently.
+ (let* ((width (if (display-graphic-p)
+ (ceiling
+ (let ((width (nlinum--face-width 'linum)))
+ (if width
+ (/ (* nlinum--width 1.0 width)
+ (frame-char-width))
+ (/ (* nlinum--width 1.0
+ (nlinum--face-height 'linum))
+ (frame-char-height)))))
+ nlinum--width))
+ (cur-margins (window-margins))
+ (cur-margin (car cur-margins))
+ ;; (EXT . OURS) keeps track of the size of the margin, where EXT is
the
+ ;; size chosen by external code and OURS is the size we last set.
+ ;; OURS is used to detect when someone else modifies the margin.
+ (margin-settings (window-parameter nil 'linum--margin)))
+ (if margin-settings
+ (unless (eq (cdr margin-settings) cur-margin)
+ ;; Damn! The margin is not what it used to be! => Update EXT!
+ (setcar margin-settings cur-margin))
+ (set-window-parameter nil 'linum--margin
+ (setq margin-settings (list cur-margin))))
+ (and (car margin-settings) width
+ (setq width (max width (car margin-settings))))
+ (setcdr margin-settings width)
+ (set-window-margins nil (if nlinum-mode width (car margin-settings))
+ (cdr cur-margins))))
(defun nlinum--setup-windows ()
(dolist (win (get-buffer-window-list nil nil t))
diff --git a/packages/omn-mode/omn-mode.el b/packages/omn-mode/omn-mode.el
deleted file mode 100644
index 1e3e7a6..0000000
--- a/packages/omn-mode/omn-mode.el
+++ /dev/null
@@ -1,240 +0,0 @@
-;;; omn-mode.el --- Support for OWL Manchester Notation
-
-;; Copyright (C) 2013 Free Software Foundation, Inc.
-
-;; Author: Phillip Lord <address@hidden>
-;; Maintainer: Phillip Lord <address@hidden>
-;; Website: http://www.russet.org.uk/blog
-;; 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/>.
-
-;;; Commentary:
-;;
-;; Defines a major mode for editing the Manchester OWL syntax.
-;; Basically, this is just a bit of font locking.
-
-;;; Code:
-
-;; (defgroup omn-mode nil
-;; "Major mode to edit OWL Manchester Notation."
-;; :group 'languages)
-
-(defvar omn-obsolete-electric-indent nil
- "Set to t to use the old electric indent. Better use
`electric-indent-mode'.")
-
-(defvar omn-imenu-generic-expression
- '(
- ("Class" "Class: \\([a-zA-Z:_]+\\)" 1)
- ("ObjectProperty" "ObjectProperty: \\([a-zA-Z:_]+\\)" 1)
- ("Individual" "Individual: \\([a-zA-Z:_]+\\)" 1)
- )
-
- "Imenu support for OMN.
-See `imenu-generic-expression' for details")
-
-
-(defvar omn-mode-entity-keywords
- '(
- "Ontology:"
- "Namespace:"
- "Class:"
- "Individual:"
- "ObjectProperty:"
- "Import:"
- "Datatype:"
- "AnnotationProperty:"
- "DisjointClasses:"
- "Prefix:"
- "owl:Thing"))
-
-(defvar omn-mode-property-keywords
- '(
- "EquivalentTo:"
- "SubClassOf:"
- "Annotations:"
- "Characteristics:"
- "DisjointUnion:"
- "DisjointWith:"
- "Domain:"
- "Range:"
- "InverseOf:"
- "SubPropertyOf:"
- "Types:"
- "Facts:"
- ))
-
-
-;; indentation engine
-(defun omn-indent-line()
- (indent-line-to
- (omn-determine-line-indent)))
-
-(defun omn-determine-line-indent()
- (save-excursion
- (beginning-of-line)
- ;; check the first word
-
- (let* ((match (re-search-forward "\\w+" (line-end-position) t))
- (word (if match
- (match-string 0)
- "")))
-
- (cond
- ;; ((not match)
- ;; (progn
- ;; (if (not (forward-line -1))
- ;; (omn-determine-line-indent)
- ;; 0)))
-
- ;; if it is string, ident should be 0.
- ((nth 3 (syntax-ppss (point)))
- 0)
-
- ;; if it is a comment
- ((nth 4 (syntax-ppss (point)))
- ;; if there is a next line, indent the same as that
- (cond
- ((eq 0 (forward-line 1))
- (omn-determine-line-indent))
- ;; if there isn't return the same as the line before
- ((eq 0 (forward-line -1))
- (omn-determine-line-indent))
- ;; who knows?
- (t 0)))
-
- ;; if it is one of Class:, Prefix: or so on, then indent should be 0
- ((member word omn-mode-entity-keywords)
- 0)
- ;; if it is Annotations:, SubClassOf: or so on, then indent should be 4
- ((member word omn-mode-property-keywords)
- 4)
-
- ;; if it is something else, then 8
- (t 8)))))
-
-(add-to-list 'auto-mode-alist '("\\.pomn\\'" . omn-mode))
-
-(add-to-list 'auto-mode-alist '("\\.omn\\'" . omn-mode))
-
-(defvar omn-font-lock-defaults
- `(,(concat "\\_<"
- (regexp-opt omn-mode-entity-keywords t)
- "\\_>")
- (,(mapconcat
- (lambda(x) x)
- '("\\<some\\>"
- "\\<only\\>"
- "\\<and\\>"
- "\\<or\\>"
- "\\<exactly\\>"
- "\\<max\\>"
- "\\<min\\>"
- "Transitive"
- "Functional"
- "InverseFunctional"
- )
- "\\|")
- . font-lock-type-face)
- (,(regexp-opt omn-mode-property-keywords)
- . font-lock-builtin-face)
- ("\\w+:\\w+" . font-lock-function-name-face)))
-
-
-(defvar omn-mode-syntax-table
- (let ((st (make-syntax-table)))
- ;; string quotes
- (modify-syntax-entry ?\" "\"" st)
- ;; This is a bit underhand, but we define the < and > characters to be
- ;; "generic-string" delimiters. This results in fontification for URLs
- ;; which is no bad thing. Additionally, it makes the comment character
- ;; work, as "#" is a valid in a URL. The semantics of this isn't quite
- ;; right, because the two characters are not paired. So <url> is
- ;; recognised, but so is <url< or >url>.
- ;; We could use a syntax-propertize-function to do more carefully.
- (modify-syntax-entry ?\< "|" st)
- (modify-syntax-entry ?\> "|" st)
- ;; define comment characters for syntax
- (modify-syntax-entry ?\# "<" st)
- (modify-syntax-entry ?\n ">" st)
- ;; Let's not confuse "words" and "symbols": "_" should not be part of the
- ;; definition of a "word".
- ;;(modify-syntax-entry ?\_ "w" st)
- ;; For name space prefixes.
- (modify-syntax-entry ?\: "w" st)
- st))
-
-(defvar omn-mode-map
- (let ((map (make-sparse-keymap)))
- (when omn-obsolete-electric-indent
- (dolist (x `(" " "," ":"))
- (define-key map x 'omn-mode-electric-indent))
- ;; need to bind to return as well
- (define-key map (kbd "RET") 'omn-mode-electric-newline))
- map))
-
-(defun omn-mode-electric-indent()
- (interactive)
- (self-insert-command 1)
- (omn-mode-indent-here))
-
-(defun omn-mode-indent-here()
- (let ((m (point-marker)))
- (omn-indent-line)
- (goto-char (marker-position m))))
-
-(defun omn-mode-electric-newline()
- (interactive)
- (newline)
- (save-excursion
- (forward-line -1)
- (omn-indent-line)))
-
-(define-derived-mode omn-mode fundamental-mode "Omn"
- "Doc string to add"
-
- ;; font-lock stuff
- (setq font-lock-defaults
- '(omn-font-lock-defaults))
-
- (set (make-local-variable 'comment-start) "#")
- (set (make-local-variable 'comment-end) "")
- ;; no idea what this is about -- stolen from generic
- (set (make-local-variable 'comment-start-skip) "#+\\s-*")
-
- (set (make-local-variable 'imenu-generic-expression)
- omn-imenu-generic-expression)
-
- (set (make-local-variable 'electric-indent-chars)
- (append `(?\ ?\, ?\:)
- (if (boundp 'electric-indent-chars)
- (default-value 'electric-indent-chars)
- '(?\n))))
-
- (set (make-local-variable 'indent-line-function) 'omn-indent-line))
-
-
-;; interaction with a reasoner.....
-;; Define a struct using CL, which defines a command. Then send this to the
command line
-;; program as a single key-value pair line.
-;;
-;; Write a parser for this in Java.
-;; Write a "command" interface, use annotation to mark each of the command
setMethods.
-;;
-;; Have the command interface return results between tags as lisp. We can eval
-;; this, and get the result in that way.
-
-(provide 'omn-mode)
-
-;;; omn-mode.el ends here
diff --git a/packages/on-screen/.gitignore b/packages/on-screen/.gitignore
new file mode 100644
index 0000000..c531d98
--- /dev/null
+++ b/packages/on-screen/.gitignore
@@ -0,0 +1 @@
+*.elc
diff --git a/packages/on-screen/on-screen.el b/packages/on-screen/on-screen.el
new file mode 100644
index 0000000..e5c3977
--- /dev/null
+++ b/packages/on-screen/on-screen.el
@@ -0,0 +1,665 @@
+;;; on-screen.el --- guide your eyes while scrolling -*- lexical-binding: t
-*-
+
+;; Copyright (C) 2013-2015 Free Software Foundation, Inc
+
+;; Author: Michael Heerdegen <address@hidden>
+;; Maintainer: Michael Heerdegen <address@hidden>
+;; Created: 24 Jan 2013
+;; Keywords: convenience
+;; URL: https://github.com/michael-heerdegen/on-screen.el
+;; Version: 1.3.2
+;; Package-Requires: ((cl-lib "0"))
+
+
+;; This file is not 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:
+
+;; Scrolling can be distracting because your eyes may lose
+;; orientation. This library implements a minor mode that highlights
+;; the previously visible buffer part after each scroll.
+;;
+;; Installation: Put this library somewhere in your load-path, or
+;; install via M-x package-list-packages. Then add to your init-file:
+;;
+;; (require 'on-screen)
+;;
+;; To invoke on-screen globally for all buffers, also add
+;;
+;; (on-screen-global-mode +1)
+;;
+;; Alternatively you can use the buffer local version `on-screen-mode'.
+;; For example, add this line to your init file:
+;;
+;; (add-hook 'Info-mode-hook 'on-screen-mode)
+;;
+;; to enable it in all Info buffers.
+;;
+;; By default, fringe markers are used for highlighting - see
+;; `on-screen-highlight-method' to change that. Type M-x
+;; customize-group RET on-screen RET to see what else can be
+;; configured. If you use a configuration file (.emacs), you may also
+;; want to define mode specific settings by using buffer local
+;; variables. For example, to use non intrusive fringe markers by
+;; default, but transparent overlays in w3m, you would add
+;;
+;; (add-hook
+;; 'w3m-mode-hook
+;; (defun my-w3m-setup-on-screen ()
+;; (setq-local on-screen-highlight-method 'shadow)))
+;;
+;; to your .emacs.
+;;
+;; If you use transparent overlays for highlighting and there is the
+;; library "hexrgb.el" in your `load-path', it will be used to compute
+;; highlighting colors dynamically instead of using constant faces.
+;; I.e. if you use non-default background colors (e.g. from custom
+;; themes), on-screen will try to perform highlighting with a
+;; suitable, slightly different color. See
+;; `on-screen-highlighting-to-background-delta' to control this.
+;;
+;;
+;; Implementation notes (mainly for myself):
+;;
+;; Implementing this functionality is not as straightforward as one
+;; might think. There are commands that scroll other windows than the
+;; current one. Not only scrolling commands can scroll text - also
+;; editing or even redisplay can cause windows to scroll. There is
+;; weird stuff such as folding and narrowing, influencing the visible
+;; buffer part. And although highlighting is realized in the
+;; displayed buffers (with overlays), it must be organized on a
+;; per-window basis, because different buffer parts may be displayed
+;; in different windows, and their highlightings must not interfere.
+;;
+;; That all makes it necessary to observe windows via hacks in
+;; different hooks, and to manage information about buffers, visible
+;; parts and timers in a data structure (`on-screen-data'). It is
+;; realized as an association list whose keys are windows. There are
+;; some pitfalls - e.g. the data can be out of date if the window
+;; configuration has changed and windows display different buffers
+;; now. The data must be updated, but not simply be thrown away,
+;; because the highlightings in the old buffers must be removed
+;; nonetheless.
+;;
+;;
+;; Acknowledgments:
+;;
+;; This library was inspired by a similar feature of the "Conqueror"
+;; web browser.
+;;
+;; Thanks for Drew Adams for testing and contributions.
+
+
+
+
+;;; Code:
+
+;;;; Requirements
+
+(eval-when-compile
+ (require 'cl-lib))
+(require 'timer)
+(require 'hexrgb nil t)
+
+(declare-function hexrgb-saturation "hexrgb")
+(declare-function hexrgb-approx-equal "hexrgb")
+(declare-function hexrgb-increment-value "hexrgb")
+(declare-function hexrgb-increment-hue "hexrgb")
+
+
+;;;; Configuration stuff
+
+(defgroup on-screen nil
+ "Guide your eyes while scrolling."
+ :group 'convenience
+ :prefix "on-screen")
+
+(defcustom on-screen-inverse-flag nil
+ "What area to highlight.
+When nil, highlight the previously visible screenful. Else
+highlight the previously off-screen parts."
+ :type 'boolean)
+
+(defcustom on-screen-highlight-method 'fringe
+ "Type of highlighting used by `on-screen-mode'.
+The following values are valid:
+
+ fringe - graphical markers in the fringe
+ shadow - transparent overlay on the text
+ line - transparent overlay on the confining text lines
+ narrow-line - narrow horizontal lines
+
+The fringe and the narrow-line methods only work on graphical
+displays. narrow-line only works with Emacs 24 or higher.
+
+`on-screen-inverse-flag' defines which part(s) of the buffers are
+highlighted.
+
+The face used for \"shadow\" and \"line\" may be computed
+dynamically to support different background colors (color themes)
+- see `on-screen-highlighting-to-background-delta'."
+ :type '(choice
+ (const :tag "Fringe markers" fringe)
+ (const :tag "Transparent overlay" shadow)
+ (const :tag "Overlay on confining text lines" line)
+ (const :tag "Narrow horizontal line" narrow-line)))
+
+(defcustom on-screen-fringe-marker-position t
+ "Where to display fringe markers.
+Ignored if highlighting doesn't use the fringe."
+ :type '(choice
+ (const :tag "Left fringe only" left)
+ (const :tag "Right fringe only" right)
+ (const :tag "Both sides" t)))
+
+(defface on-screen-shadow
+ '((((class color) (min-colors 88) (background light))
+ :background "#f2efcb" ; alternative: "#f5f4ff" is a bit less intrusive
+ )
+ (((class color) (min-colors 88) (background dark))
+ :background "#272620")
+ (((class color) (min-colors 8) (background light))
+ :background "green")
+ (((class color) (min-colors 8) (background dark))
+ :background "blue"))
+ "Face used for displaying a transparent overlay.")
+
+(defface on-screen-hl-line
+ '((((background light)) :background "#ffa0a0")
+ (((background dark)) :background "#300000"))
+ "Face used for displaying the \"line\" style overlay.")
+
+(defcustom on-screen-highlighting-to-background-delta .05
+ "How much shadow and line highlighting should differ from background.
+This should be a positive floating point number less than 1.
+Smaller values will lead to a highlighting color being more
+similar to the frame background. A value of nil means to use use
+just face `on-screen-shadow'.
+
+This variable is ignored if the library \"hexrgb\" is not
+available."
+ :type '(choice (const :tag "Use standard face" nil)
+ (float :tag "Delta")))
+
+(defface on-screen-fringe '((t (:inherit shadow)))
+ "Face used for fringe markers.")
+
+(defface on-screen-narrow-line
+ '((((background dark)) (:width extra-expanded :underline (:color "gray30"
:style wave)))
+ (((background light)) (:width extra-expanded :underline (:color "gray70"
:style wave))))
+ "Face used by the narrow-line highlighting method.")
+
+(defcustom on-screen-delay 5
+ "How long `on-screen-mode' should display optical aids."
+ :type 'number)
+
+(defcustom on-screen-auto-update t
+ "Whether to update highlighting for successive scrolls.
+When non-nil, every scroll action will cause a highlighting
+according to the previously visible screenful. When nil, a once
+drawn highlighting will remain fixed relative to the text even
+if you scroll further until `on-screen-delay' is over."
+ :type 'boolean)
+
+(defcustom on-screen-remove-when-edit nil
+ "Whether to instantly remove highlighting when editing.
+
+In those situations where a single command causes multiple
+changes to a buffer highlighting is always removed to avoid
+confusion."
+ :type 'boolean)
+
+(defvar on-screen-treat-cut-lines--default-fraction .3)
+
+(defcustom on-screen-treat-cut-lines nil
+ "Whether to care about vertically cut lines.
+If nil, always count lines at the window start or end that are
+only partially visible as part of the visible area. Else, a
+number between 0 and 1, meaning that lines will count as visible
+when the hidden part of them is less than this number. Note that
+a non-nil value may make scrolling stuttering on slow computers."
+ :type `(choice (const :tag "Count partially visible lines as visible" nil)
+ (const :tag "Count partially visible lines as not visible" t)
+ (float
+ :tag "Count lines with hidden part less than this as visible"
+ :value ,on-screen-treat-cut-lines--default-fraction)))
+
+(defcustom on-screen-drawing-threshold 2
+ "If set, highlight only when scrolled at least that many lines."
+ :type '(choice (const :tag "Off" nil)
+ (integer :value 2)))
+
+(defvar on-screen-inhibit-highlighting nil
+ "Disable highlighting if non-nil.
+This variable is checked before highlighting is actually being
+performed, with the according buffer being current.
+
+If a function, it will be called with zero arguments.
+Highlighting will be inhibited if the result is non-nil.")
+
+
+;;;; Other variables
+
+(defvar on-screen-overlay-priority 30 ; > stripe buffer, < ediff, isearch
+ "Priority for all on-screen overlays.")
+
+(defvar on-screen-initialized-p nil
+ "Whether we have already added stuff to the hooks.")
+
+(defvar on-screen-data nil
+ "Association list holding internal data.")
+
+(defvar on-screen-command-counter 0)
+(defvar on-screen-last-change 0)
+
+
+;;;; User Commands
+
+;;;###autoload
+(define-minor-mode on-screen-mode
+ "Buffer local minor mode guiding your eyes while scrolling.
+With a prefix argument ARG, enable the mode if ARG is positive,
+and disable it otherwise. If called from Lisp, enable the mode
+if ARG is omitted or nil.
+Type M-x customize-group on-screen RET for configuration."
+ :group 'on-screen
+ (when on-screen-mode
+ (unless on-screen-initialized-p
+ (on-screen-initialize))))
+
+;;;###autoload
+(define-minor-mode on-screen-global-mode
+ "Global minor mode guiding your eyes while scrolling.
+With a prefix argument ARG, enable the mode if ARG is positive,
+and disable it otherwise. If called from Lisp, enable the mode
+if ARG is omitted or nil.
+
+You can make use of `on-screen-inhibit-highlighting' to prevent
+highlighting on a per-buffer basis.
+
+Type M-x customize-group on-screen RET for configuration."
+ :group 'on-screen :global t
+ (when on-screen-global-mode
+ (unless on-screen-initialized-p
+ (on-screen-initialize))))
+
+;;;###autoload
+(defalias 'global-on-screen-mode 'on-screen-global-mode)
+
+
+;;;; Internal functions
+
+(defun on-screen--treat-cut-lines-get-fraction ()
+ (if (floatp on-screen-treat-cut-lines)
+ on-screen-treat-cut-lines
+ on-screen-treat-cut-lines--default-fraction))
+
+(defun on-screen-window-start (&optional window)
+ "Like `window-start', but exclude partially visible lines."
+ (let* ((start (window-start window))
+ (vis (and on-screen-treat-cut-lines (pos-visible-in-window-p start
window t))))
+ (if (not (cddr vis))
+ start
+ (cl-destructuring-bind (_x _y rtop _rbot rowh _vpos) vis
+ (if (< (/ (float rtop) (+ rtop rowh))
+ (on-screen--treat-cut-lines-get-fraction)) ; count as visible
+ start
+ (with-current-buffer (window-buffer window)
+ (save-excursion
+ (goto-char start)
+ (on-screen-beginning-of-line +2)
+ (point))))))))
+
+(defun on-screen-window-end (&optional window)
+ "Like `window-end', but exclude partially visible lines."
+ (let* ((end (window-end window))
+ (vis (and on-screen-treat-cut-lines (pos-visible-in-window-p (1- end)
window t))))
+ (if (not (cddr vis))
+ end
+ (cl-destructuring-bind (_x _y _rtop rbot rowh _vpos) vis
+ (if (< (/ (float rbot) (+ rbot rowh))
+ (on-screen--treat-cut-lines-get-fraction)) ; count as visible
+ end
+ (with-current-buffer (window-buffer window)
+ (save-excursion
+ (goto-char end)
+ (on-screen-beginning-of-line 0)
+ (point))))))))
+
+(defun on-screen-beginning-of-line (&optional n)
+ (cl-callf or n 1)
+ (forward-visible-line (- n 1)))
+
+(defun on-screen-end-of-line (&optional n)
+ (cl-callf or n 1)
+ (forward-visible-line (- n 1))
+ (end-of-visible-line))
+
+(defun on-screen-record-data (win area &optional timer overlays)
+ ;; The collected data has the form ((beg end) timer overlays), and
+ ;; this is what `on-screen-get-data' returns. Internally, this
+ ;; function also remembers the window-buffer of the window, to
+ ;; enable the mode to check if remembered data still belongs to the
+ ;; same buffer.
+ "Store information for window WIN in `on-screen-data'.
+AREA is a list (beg end). TIMER is the currently active timer
+object. OVERLAYS are the on-screen overlays currently visible in
+WIN.
+
+A nil value for AREA, TIMER or OVERLAYS means that the remembered
+values should not be changed. If TIMER is the symbol `finished',
+remember nil for the timer."
+ (let* ((entry (assoc win on-screen-data))
+ (data (cdr entry))
+ (same-buffer-p (eq (car data) (window-buffer win))))
+ (setq area (or area (and same-buffer-p (cadr data)))
+ timer (cond ((timerp timer) timer)
+ (timer nil)
+ (t (and same-buffer-p (cl-caddr data))))
+ overlays (or overlays (and same-buffer-p (cl-cadddr data)))
+ data `(,(window-buffer win) ,area ,timer ,overlays))
+ (if entry
+ (setcdr entry data)
+ (push (cons win data) on-screen-data))))
+
+(defun on-screen-get-data (win)
+ "Return stored data for WIN if existent and up-to-date."
+ (let ((data (cdr (assoc win on-screen-data))))
+ (if (eq (car data) (window-buffer win))
+ (cdr data)
+ nil)))
+
+(defun on-screen-cleanup-data ()
+ "Delete information stored for deleted windows."
+ (setq on-screen-data
+ (delq nil (mapcar (lambda (entry) (if (window-live-p (car entry))
entry nil))
+ on-screen-data))))
+
+(defun on-screen-derive-from-frame-bg
+ (win delta-brightness-dark-bg delta-brightness-light-bg delta-hue)
+ "Helper calculating a suitable background color for highlighting."
+ (let ((frame (window-frame win)))
+ (and (display-graphic-p frame) (featurep 'hexrgb)
+ (let* ((bg (or (let ((frame-bg (cdr (assq 'background-color
(frame-parameters frame)))))
+ (when (member frame-bg '(nil unspecified
"unspecified-bg"))
+ (setq frame-bg (if (eq (frame-parameter frame
'background-mode) 'dark)
+ "Black"
+ "White")))
+ (and frame-bg (x-color-defined-p frame-bg)
frame-bg))))
+ (sat (condition-case nil (hexrgb-saturation bg) (error nil))))
+ (and sat
+ (if (hexrgb-approx-equal sat 0.0)
+ ;; Grayscale - change bg value slightly.
+ (hexrgb-increment-value
+ bg (if (eq (frame-parameter frame 'background-mode) 'dark)
+ delta-brightness-dark-bg
+ delta-brightness-light-bg))
+ (hexrgb-increment-hue bg delta-hue)) ; Color - change bg hue
slightly.
+ )))))
+
+(defun on-screen-get-shadow-face (win)
+ "Return face for the transparent overlay in WIN."
+ (if (eq on-screen-highlight-method 'shadow)
+ (or (and on-screen-highlighting-to-background-delta
+ (let ((bg-col (apply #'on-screen-derive-from-frame-bg win
+ (mapcar (lambda (x) (* x
on-screen-highlighting-to-background-delta))
+ (list 1 -1 1)))))
+ (and bg-col `((t (:background ,bg-col))))))
+ 'on-screen-shadow)
+ 'on-screen-hl-line))
+
+(defun on-screen-make-fringe-overlays (pos topp &optional inversep)
+ "Create and return list of fringe overlays."
+ (let (ov1 ov2)
+ (unless (eq on-screen-fringe-marker-position 'left)
+ (setq ov1 (save-excursion (make-overlay (progn (goto-char pos)
+
(on-screen-beginning-of-line
+ (cond ((not inversep)
+1)
+ (topp
+2)
+ (t
0)))
+ (point))
+ (1+ (point)))))
+ (overlay-put ov1 'before-string (on-screen-fringe-string topp nil
inversep)))
+ (unless (eq on-screen-fringe-marker-position 'right)
+ (setq ov2 (save-excursion (make-overlay (progn (goto-char pos)
+
(on-screen-beginning-of-line
+ (cond ((not inversep)
+1)
+ (topp
+2)
+ (t
0)))
+ (point))
+ (1+ (point)))))
+ (overlay-put ov2 'before-string (on-screen-fringe-string topp t
inversep)))
+ (delq nil (list ov1 ov2))))
+
+(defun on-screen-fringe-string (topp leftp &optional inversep)
+ "Return a string suitable for displaying fringe markers."
+ (let ((xor (lambda (x y) (if x (not y) y))))
+ (propertize (purecopy " ")
+ 'display (list (if leftp 'left-fringe 'right-fringe)
+ (if (funcall xor topp (not inversep))
+ (if leftp 'top-left-angle 'top-right-angle)
+ (if leftp 'bottom-left-angle
'bottom-right-angle))
+ 'on-screen-fringe))))
+
+(defun on-screen-make-line-overlay (pos)
+ "Create an overlay around POS for the line method."
+ (save-excursion
+ (make-overlay (progn (goto-char pos) (on-screen-beginning-of-line)
(point))
+ (progn (goto-char pos) (on-screen-end-of-line) (1+
(point))))))
+
+(defun on-screen-make-narrow-line-overlay (win pos)
+ "Create an overlay around POS for the narrow-line method."
+ (let ((ov (save-excursion
+ (make-overlay (progn (goto-char pos)
(on-screen-beginning-of-line) (point))
+ (progn (goto-char pos) (on-screen-end-of-line)
(point))))))
+ (overlay-put ov 'face 'on-screen-narrow-line)
+ ;; The following is necessary to get a line spanning the entire
+ ;; window width, because underlining is only applied to text - a
+ ;; problem especially for empty lines. However this hides any
+ ;; other highlighting there, e.g. from stripe-buffer or
+ ;; hl-line-mode. I think there's nothing I can do about that.
+ (overlay-put ov 'after-string (propertize "foo"
+ 'face 'on-screen-narrow-line
+ 'display `(space :align-to
,(window-width win))
+ 'cursor 0))
+ ov))
+
+(defun on-screen-get-windows (&optional all-frames)
+ "Return a list of all windows.
+With ALL-FRAMES non-nil, include all windows of all frames, else
+only the windows of the selected frame."
+ (apply #'nconc
+ (mapcar (lambda (frame) (window-list frame))
+ (if all-frames (frame-list) (list (selected-frame))))))
+
+(defun on-screen-pre-command ()
+ "Remember visible buffer parts in the selected frame."
+ ;; This normally goes to `pre-command-hook'.
+ (cl-incf on-screen-command-counter)
+ (add-hook 'after-change-functions #'on-screen-after-change) ;$$$$ bug#16796
+ (condition-case nil
+ (mapc (lambda (win) (with-current-buffer (window-buffer win)
+ (when (on-screen-enabled-p)
+ (on-screen-record-data win (list
(on-screen-window-start win)
+ (on-screen-window-end
win))))))
+ (on-screen-get-windows))
+ ((debug error) nil)))
+
+(defun on-screen-after-scroll (win display-start)
+ "DTRT after scrolling.
+This should normally go to `window-scroll-functions'."
+ (condition-case nil
+ (with-current-buffer (window-buffer win)
+ (when (on-screen-enabled-p)
+ (let* ((win-data (on-screen-get-data win))
+ (area (car win-data))
+ (timer (cadr win-data))
+ (overlays (cl-caddr win-data))
+ (s1 (car area))
+ (s2 (cadr area)))
+ (when (and
+ on-screen-auto-update
+ (timerp timer)
+ ;; avoid removing highlighting when
`window-scroll-functions' is
+ ;; called multiple times in succession (follow-mode does
that)
+ (not (eq (car-safe area) (on-screen-window-start win))))
+ ;; do what the timer would do, and cancel timer
+ (on-screen-remove-highlighting win)
+ (cancel-timer timer)
+ (on-screen-record-data win area 'finished)
+ (setq timer nil))
+ (cond
+ ((timerp timer)
+ (timer-set-time timer (timer-relative-time (current-time)
on-screen-delay)))
+ ((or (not area)
+ (= display-start s1)))
+ ((and (numberp on-screen-drawing-threshold)
+ (< (abs (apply #'count-lines (sort (list display-start s1)
#'<)))
+ on-screen-drawing-threshold)))
+ (t
+ (setq
+ overlays
+ (let ((method `(,on-screen-highlight-method .
,on-screen-inverse-flag)))
+
+ ;; prevent highlighting in certain situations
+ ;; note that `window-end' must not be used here!
+
+ (when (and s1 s2
+ (pos-visible-in-window-p (point-min) win)
+ (pos-visible-in-window-p (point-max) win))
+ ;; after narrow
+ (setq s1 nil s2 nil))
+
+ (when (and s1 s2
+ (>= s2 (point-max))
+ (< s1 (on-screen-window-start win))
+ (pos-visible-in-window-p (point-max) win))
+ ;;scrolling down near buffer end
+ (setq s2 nil))
+
+ (cond
+ ((equal method '(shadow . nil))
+ (if (and s1 s2) (list (make-overlay s1 s2)) ()))
+ ((eq (car method) 'shadow)
+ (list (and s1 (make-overlay (point-min) s1))
+ (and s2 (make-overlay s2 (point-max)))))
+ ((eq (car method) 'fringe)
+ (append (and s1 (on-screen-make-fringe-overlays s1 nil
(cdr method)))
+ (and s2 (on-screen-make-fringe-overlays (1- s2) t
(cdr method)))))
+ ((equal method '(line . nil))
+ (list (and s1 (on-screen-make-line-overlay s1))
+ (and s2 (on-screen-make-line-overlay (1- s2)))))
+ ((eq (car method) 'line)
+ (list (and s1 (on-screen-make-line-overlay (1- s1)))
+ (and s2 (on-screen-make-line-overlay s2))))
+ ((eq (car method) 'narrow-line)
+ (list (and s1 (on-screen-make-narrow-line-overlay win (1-
s1)))
+ (and s2 (on-screen-make-narrow-line-overlay win (1-
s2)))))))
+ overlays (delq nil overlays))
+ (dolist (ov overlays)
+ (overlay-put ov 'window win) ; display only in selected window
+ (overlay-put ov 'priority on-screen-overlay-priority))
+ (when (memq on-screen-highlight-method '(shadow line))
+ (dolist (ov overlays)
+ (overlay-put ov 'face (on-screen-get-shadow-face win))))
+ (on-screen-record-data
+ win nil
+ (run-at-time (time-add (current-time) (seconds-to-time
on-screen-delay)) nil
+ (lambda (win)
+ (condition-case nil
+ (progn
+ (when (window-live-p win)
+ (with-current-buffer (window-buffer win)
+ (on-screen-remove-highlighting win)
+ (on-screen-record-data
+ win (list (on-screen-window-start win)
+ (on-screen-window-end win))
+ 'finished)))
+ (on-screen-cleanup-data))
+ ((debug error) nil)))
+ win)
+ overlays))))))
+ ((debug error) nil)))
+
+(defun on-screen-remove-highlighting (win)
+ "Delete all on-screen overlays in window WIN.
+This has to be done for a previously buffer if the window-buffer
+had changed."
+ (let* ((entry (assoc win on-screen-data))
+ (data (cdr entry))
+ (buffer (car data)))
+ (when (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (let* ((data (cdr data))
+ (timer (cadr data))
+ (overlays (cl-caddr data)))
+ (dolist (ov overlays) (delete-overlay ov))
+ (when (timerp timer) (cancel-timer timer))))
+ (setq on-screen-data (delq entry on-screen-data)))))
+
+(defun on-screen-after-change (&rest _)
+ "Reset highligting for current buffer after it was changed.
+This has to be done for all its windows. Goes to
+`after-change-functions'."
+ (when (or on-screen-remove-when-edit
+ (= on-screen-last-change on-screen-command-counter))
+ (let ((buf (current-buffer)))
+ (when (on-screen-enabled-p buf)
+ (dolist (win (on-screen-get-windows t))
+ (when (eq (window-buffer win) buf)
+ (on-screen-remove-highlighting win))))))
+ (setq on-screen-last-change on-screen-command-counter))
+
+(defun on-screen-after-wconf-change ()
+ "Clean up after the window configuration has changed.
+I.e., for all windows of the selected frame, remove all
+highlightings and clear all associated data."
+ (let ((wins (on-screen-get-windows)))
+ (dolist (win wins)
+ (on-screen-remove-highlighting win))))
+
+(defun on-screen-enabled-p (&optional buffer)
+ "Return non-nil if on-screen is enabled in BUFFER."
+ (with-current-buffer (or buffer (current-buffer))
+ (and
+ (or on-screen-global-mode on-screen-mode)
+ (cond
+ ((not on-screen-inhibit-highlighting) t)
+ ((functionp on-screen-inhibit-highlighting)
+ (not (funcall on-screen-inhibit-highlighting)))
+ (t nil)))))
+
+(defun on-screen-initialize ()
+ "Prepare for using on-screen."
+ (add-hook 'pre-command-hook #'on-screen-pre-command)
+ (add-hook 'window-scroll-functions #'on-screen-after-scroll)
+ (add-hook 'after-change-functions #'on-screen-after-change)
+ (add-hook 'window-configuration-change-hook #'on-screen-after-wconf-change)
+ (setq on-screen-initialized-p t))
+
+(defun on-screen-unload-function ()
+ "Function to run when unloading on-screen."
+ (remove-hook 'pre-command-hook #'on-screen-pre-command)
+ (remove-hook 'window-scroll-functions #'on-screen-after-scroll)
+ (remove-hook 'after-change-functions #'on-screen-after-change)
+ (remove-hook 'window-configuration-change-hook
#'on-screen-after-wconf-change)
+ nil)
+
+
+(provide 'on-screen)
+
+;;; on-screen.el ends here
diff --git a/packages/other-frame-window/other-frame-window.el
b/packages/other-frame-window/other-frame-window.el
new file mode 100755
index 0000000..2427ce6
--- /dev/null
+++ b/packages/other-frame-window/other-frame-window.el
@@ -0,0 +1,345 @@
+;;; other-frame-window.el --- Minor mode to enable global prefix keys for
other frame/window buffer placement -*- lexical-binding: t -*-
+;;
+;; Copyright (C) 2015 Free Software Foundation, Inc.
+;;
+;; Author: Stephen Leake <address@hidden>
+;; Maintainer: Stephen Leake <address@hidden>
+;; Keywords: frame window
+;; Version: 1.0.2
+;; Package-Requires: ((emacs "24.4"))
+;;
+;; 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:
+
+;;;; Usage:
+;;
+;; Enable the minor mode with:
+;;
+;; M-x other-frame-window-mode
+;;
+;; or, in your ~/.emacs:
+;;
+;; (other-frame-window-mode t)
+;;
+;; C-x 7 <command> causes a buffer displayed by <command> to appear in
+;; another window in the same frame; a window is created if necessary.
+;;
+;; C-x 9 <command> causes a buffer displayed by <command> to appear in
+;; another frame; a frame is created if necessary.
+
+;;;; Design:
+;;
+;; This uses C-x 7, 9 prefix because those keys are undefined in core
+;; Emacs. It could eventually switch to 4, 5, since those are
+;; currently used for -other-window, -other-frame bindings.
+;;
+;; (info "(emacs) Pop Up Window") (info "(emacs) Creating Frames")
+;;
+;; This adds advice to switch-to-buffer; eventually Emacs could
+;; reimplement switch-to-buffer to do the same.
+
+;;;; Todo:
+
+;; - Pay attention to bindings added to ctl-x-4-map and ctl-x-5-map
+;; - Should `C-x 7 C-h' display the transient map?
+;; - `C-x 7 C-h k f' should show `find-file' rather than `self-insert-command'.
+;; This should probably be fixed in set-transient-map.
+
+;;; Code:
+
+(defvar ofw--just-set nil
+ "Non-nil if we just set the prefix in the previous command.")
+
+(defvar ofw-transient-map
+ (let ((map (make-sparse-keymap)))
+ ;; This is basically the union of the default C-x 4 and C-x 5
+ ;; keymaps in Emacs-25.
+ (define-key map [?\C-f] #'find-file)
+ (define-key map [?\C-o] #'display-buffer)
+ (define-key map [?.]
+ (if (fboundp 'xref-find-definitions) ;Emacs≥25.
+ 'xref-find-definitions 'find-tag))
+ (define-key map [?0] #'ofw-dwim-delete-this)
+ (define-key map [?1] #'ofw-dwim-one)
+ (define-key map [?2] #'ofw-dwim-open-other)
+ (define-key map [?a] #'add-change-log-entry)
+ (define-key map [?b] #'switch-to-buffer)
+ (define-key map [?c] #'clone-indirect-buffer)
+ (define-key map [?d] #'dired)
+ (define-key map [?f] #'find-file)
+ (define-key map [?m] #'compose-mail)
+ (define-key map [?o] #'ofw-dwim-select-other)
+ (define-key map [?r] #'find-file-read-only)
+ map)
+ "Keymap used for one command right after setting the prefix.")
+
+(defun ofw--set-prefix (func)
+ "Add ofw prefix function FUNC."
+ (ofw-delete-from-overriding)
+ (let ((functions (car display-buffer-overriding-action))
+ (attrs (cdr display-buffer-overriding-action)))
+ (push func functions)
+ (setq display-buffer-overriding-action (cons functions attrs))
+ ;; C-u C-x 7 foo should pass C-u to foo, not to C-x 7, so
+ ;; pass the normal prefix to the next command.
+ (if (fboundp 'prefix-command-preserve-state)
+ (prefix-command-preserve-state)
+ ;; Make sure the next pre-command-hook doesn't immediately set
+ ;; display-buffer-overriding-action back to nil.
+ (setq ofw--just-set t)
+ (setq prefix-arg current-prefix-arg))
+ (set-transient-map ofw-transient-map)))
+
+(defun ofw--echo-keystrokes ()
+ (let ((funs (car display-buffer-overriding-action)))
+ (cond
+ ((memq #'ofw-display-buffer-other-frame funs) "[other-frame]")
+ ((memq #'ofw-display-buffer-other-window funs) "[other-window]"))))
+
+(when (boundp 'prefix-command-echo-keystrokes-functions)
+ (add-hook 'prefix-command-echo-keystrokes-functions
+ #'ofw--echo-keystrokes))
+
+(defun ofw--preserve-state () (setq ofw--just-set t))
+(when (boundp 'prefix-command-preserve-state-hook)
+ (add-hook 'prefix-command-preserve-state-hook
+ #'ofw--preserve-state))
+
+(defun ofw-delete-from-overriding ()
+ "Remove ourselves from 'display-buffer-overriding-action' action list, if
present."
+ (let ((functions (car display-buffer-overriding-action))
+ (attrs (cdr display-buffer-overriding-action)))
+ (setq functions (remq #'ofw-display-buffer-other-frame
+ (remq #'ofw-display-buffer-other-window functions)))
+ (setq display-buffer-overriding-action
+ (when (or functions attrs) (cons functions attrs)))))
+
+(defun ofw-other-window ()
+ "Set `display-buffer-overriding-action' to indicate other window."
+ (interactive)
+ (ofw--set-prefix #'ofw-display-buffer-other-window))
+
+(defun ofw-other-frame ()
+ "Set `display-buffer-overriding-action' to indicate other frame."
+ (interactive)
+ (ofw--set-prefix #'ofw-display-buffer-other-frame))
+
+(defun ofw-display-buffer-other-window (buffer alist)
+ "Show BUFFER in another window in the current frame,
+creating new window if needed and allowed.
+If successful, return window; else return nil.
+Intended for 'display-buffer-overriding-action'."
+ ;; Reset for next display-buffer call. Normally, this is taken care
+ ;; of by ofw--reset-prefix, but we do it here in case the user does
+ ;; two ofw prefixed commands consecutively.
+ (ofw-delete-from-overriding)
+
+ ;; We can't use display-buffer-use-some-window here, because
+ ;; that unconditionally allows another frame.
+ (or (display-buffer-use-some-frame
+ buffer
+ (append (list (cons 'frame-predicate
+ (lambda (frame) (eq frame (selected-frame))))
+ '(inhibit-same-window . t))
+ alist))
+ (display-buffer-pop-up-window buffer alist)))
+
+(defun ofw-display-buffer-other-frame (buffer alist)
+ "Show BUFFER in another frame, creating a new frame if needed.
+If successful, return window; else return nil.
+Intended for 'display-buffer-overriding-action'."
+ ;; Reset for next display-buffer call.
+ (ofw-delete-from-overriding)
+
+ ;; IMPROVEME: prompt for a frame if more than 2
+ (or (display-buffer-use-some-frame buffer alist)
+ (display-buffer-pop-up-frame buffer alist)))
+
+(defun ofw-switch-to-buffer-advice (orig-fun buffer
+ &optional norecord force-same-window)
+ "Change `switch-to-buffer' to call `pop-to-buffer'.
+This allows `switch-to-buffer' to respect `ofw-other-window',
+`ofw-other-frame'."
+ (if display-buffer-overriding-action
+ (pop-to-buffer buffer (list #'display-buffer-same-window) norecord)
+ (funcall orig-fun buffer norecord force-same-window)))
+
+(defun ofw--suspend-and-restore (orig-func &rest args)
+ "Call ORIG-FUNC without any ofw actions on
'display-buffer-overriding-action'."
+ (let ((display-buffer-overriding-action display-buffer-overriding-action))
+ (ofw-delete-from-overriding)
+ (apply orig-func args)))
+
+(defun ofw-move-to-other-window ()
+ "Move current buffer to another window in same frame.
+Point stays in moved buffer."
+ (interactive)
+ (let ((buffer (current-buffer)))
+ (switch-to-prev-buffer nil 'bury)
+ (pop-to-buffer
+ buffer
+ (cons '(display-buffer-use-some-frame display-buffer-pop-up-window)
+ (list (cons 'frame-predicate (lambda (frame) (eq frame
(selected-frame))))
+ '(inhibit-same-window . t)))
+ )))
+
+(defun ofw-move-to-other-frame ()
+ "Move current buffer to a window in another frame.
+Point stays in moved buffer."
+ (interactive)
+ (let ((buffer (current-buffer)))
+ (switch-to-prev-buffer nil 'bury)
+ (pop-to-buffer
+ buffer
+ (cons '(display-buffer-use-some-frame display-buffer-pop-up-frame)
+ '((reusable-frames . visible)))
+ )))
+
+(defvar other-frame-window-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\C-x7" #'ofw-other-window)
+ (define-key map "\C-x9" #'ofw-other-frame)
+ (define-key map "\C-xW" #'ofw-move-to-other-window)
+ (define-key map "\C-xF" #'ofw-move-to-other-frame)
+ map)
+ "Local keymap used for other-frame-window minor mode.")
+
+(defun ofw--reset-prefix ()
+ (if ofw--just-set
+ (setq ofw--just-set nil)
+ (ofw-delete-from-overriding)))
+
+;;;###autoload
+(define-minor-mode other-frame-window-mode
+ "Minor mode for other frame/window buffer placement.
+Enable mode if ARG is positive."
+ :global t
+
+ (remove-hook 'pre-command-hook #'ofw--reset-prefix)
+
+ (if other-frame-window-mode
+ ;; enable
+ (progn
+ (add-hook 'pre-command-hook #'ofw--reset-prefix)
+
+ ;; We assume Emacs code calls pop-to-buffer when there is a good
+ ;; reason to put the buffer in another window, so we don't mess
+ ;; with the default actions, except to allow
+ ;; display-buffer-reuse-window to use a window in another frame;
+ ;; add (reusable-frames . visible) to display-buffer-base-action
+ ;; attributes alist.
+ (let ((functions (car display-buffer-base-action))
+ (attrs (cdr display-buffer-base-action)))
+ (push '(reusable-frames . visible) attrs)
+ (setq display-buffer-base-action (cons functions attrs)))
+
+ ;; Change switch-to-buffer to use display-buffer
+ (advice-add 'switch-to-buffer :around #'ofw-switch-to-buffer-advice)
+
+ ;; Completing-read <tab> pops up a buffer listing completions;
+ ;; that should not respect or consume
+ ;; ofw-frame-window-prefix-arg.
+ (advice-add 'read-from-minibuffer :around #'ofw--suspend-and-restore)
+ )
+
+ ;; else disable
+ (let ((functions (car display-buffer-base-action))
+ (attrs (cdr display-buffer-base-action)))
+ (setq attrs (delq '(reusable-frames . visible) attrs))
+ (setq display-buffer-base-action (cons functions attrs)))
+
+ (advice-remove 'switch-to-buffer #'ofw-switch-to-buffer-advice)
+ (advice-remove 'read-from-minibuffer #'ofw--suspend-and-restore)
+ ))
+
+(unless (fboundp 'display-buffer-use-some-frame)
+ ;; in Emacs 25; define here for earlier
+
+(defun display-buffer-use-some-frame (buffer alist)
+ "Display BUFFER in an existing frame that meets a predicate
+\(by default any frame other than the current frame). If
+successful, return the window used; otherwise return nil.
+
+If ALIST has a non-nil `inhibit-switch-frame' entry, avoid
+raising the frame.
+
+If ALIST has a non-nil `frame-predicate' entry, its value is a
+function taking one argument (a frame), returning non-nil if the
+frame is a candidate; this function replaces the default
+predicate.
+
+If ALIST has a non-nil `inhibit-same-window' entry, avoid using
+the currently selected window (only useful with a frame-predicate
+that allows the selected frame)."
+ (let* ((predicate (or (cdr (assq 'frame-predicate alist))
+ (lambda (frame)
+ (and
+ (not (eq frame (selected-frame)))
+ (not (window-dedicated-p
+ (or
+ (get-lru-window frame)
+ (frame-first-window frame)))))
+ )))
+ (frame (car (filtered-frame-list predicate)))
+ (window (and frame (get-lru-window frame nil (cdr (assq
'inhibit-same-window alist))))))
+ (when window
+ (prog1
+ (window--display-buffer
+ buffer window 'frame alist display-buffer-mark-dedicated)
+ (unless (cdr (assq 'inhibit-switch-frame alist))
+ (window--maybe-raise-frame frame))))
+ ))
+ )
+
+;; Some of the commands on the transient keymap don't actually *display*
+;; in another window/frame but instead do something either at the level
+;; of windows or frames. I call those "ofw-dwim-*".
+
+(defun ofw-dwim--frame-p ()
+ "Return non-nil if the prefix is for \"other-frame\" rather than window."
+ ;; IMPROVEME: Comparing functions is ugly/hackish!
+ (memq #'ofw-display-buffer-other-frame
+ (car display-buffer-overriding-action)))
+
+(defun ofw-dwim-delete-this ()
+ "Delete this frame or window."
+ (interactive)
+ (call-interactively
+ (if (ofw-dwim--frame-p) #'delete-frame #'kill-buffer-and-window)))
+
+(defun ofw-dwim-one ()
+ "Delete all other frames or windows."
+ (interactive)
+ (call-interactively
+ (if (ofw-dwim--frame-p) #'delete-other-frames #'delete-other-windows)))
+
+(defun ofw-dwim-open-other ()
+ "Show current buffer in other frame or window."
+ (interactive)
+ (if (ofw-dwim--frame-p)
+ ;; IMPROVEME: This is the old C-x 5 2 behavior, but maybe it should just
use
+ ;; display-buffer instead!
+ (call-interactively #'make-frame-command)
+ (display-buffer (current-buffer))))
+
+(defun ofw-dwim-select-other ()
+ "Select other frame or window."
+ (interactive)
+ (call-interactively (if (ofw-dwim--frame-p) #'other-frame #'other-window)))
+
+(provide 'other-frame-window)
+;;; other-frame-window.el ends here
diff --git a/packages/package-fixes/package-fixes.el
b/packages/package-fixes/package-fixes.el
new file mode 100644
index 0000000..c0324e8
--- /dev/null
+++ b/packages/package-fixes/package-fixes.el
@@ -0,0 +1,148 @@
+;;; package-fixes.el --- package.el bug fixes ported to older Emacsen -*-
lexical-binding: t; -*-
+
+;; Copyright (C) 2015 Free Software Foundation, Inc.
+
+;; Author: Artur Malabarba <address@hidden>
+;; Keywords: tools
+;; Version: 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:
+
+;; This package fixes some critical bugs in package.el 1.0.1 which
+;; cause bad .elc files to be created during package upgrades when a
+;; macro changes. It is designed to be required as a dependency by
+;; packages whose installation is affected by these bugs.
+
+;; This package can be safely installed on Emacs >= 25, in which
+;; case it does nothing.
+
+;;; Code:
+
+
+;;; Emacs < 25
+(unless (fboundp 'package--list-loaded-files)
+ (require 'package)
+ (require 'find-func)
+
+ (declare-function package-fixes--autoloads-file-name "package-fixes")
+ (declare-function find-library-name "find-func")
+ (declare-function package-fixes--list-loaded-files "package-fixes")
+ (declare-function package-fixes--activate-autoloads-and-load-path
"package-fixes")
+
+ ;; None of these functions are defined in Emacs < 25.1. Defining
+ ;; them here doesn't actually do anything yet, they will be used by
+ ;; the advices below.
+ (defun package-fixes--autoloads-file-name (pkg-desc)
+ "Return the absolute name of the autoloads file, sans extension.
+PKG-DESC is a `package-desc' object."
+ (expand-file-name
+ (format "%s-autoloads" (package-desc-name pkg-desc))
+ (package-desc-dir pkg-desc)))
+
+ (defun package-fixes--activate-autoloads-and-load-path (pkg-desc)
+ "Load the autoloads file and add package dir to `load-path'.
+PKG-DESC is a `package-desc' object."
+ (let* ((old-lp load-path)
+ (pkg-dir (package-desc-dir pkg-desc))
+ (pkg-dir-dir (file-name-as-directory pkg-dir)))
+ (with-demoted-errors "Error loading autoloads: %s"
+ (load (package-fixes--autoloads-file-name pkg-desc) nil t))
+ (when (and (eq old-lp load-path)
+ (not (or (member pkg-dir load-path)
+ (member pkg-dir-dir load-path))))
+ ;; Old packages don't add themselves to the `load-path', so we have to
+ ;; do it ourselves.
+ (push pkg-dir load-path))))
+
+ (defun package-fixes--list-loaded-files (dir)
+ "Recursively list all files in DIR which correspond to loaded features.
+Returns the `file-name-sans-extension' of each file, relative to
+DIR, sorted by most recently loaded last."
+ (let* ((history (delq nil
+ (mapcar (lambda (x)
+ (let ((f (car x)))
+ (and f (file-name-sans-extension f))))
+ load-history)))
+ (dir (file-truename dir))
+ ;; List all files that have already been loaded.
+ (list-of-conflicts
+ (delq
+ nil
+ (mapcar
+ (lambda (x) (let* ((file (file-relative-name x dir))
+ ;; Previously loaded file, if any.
+ (previous
+ (ignore-errors
+ (file-name-sans-extension
+ (file-truename (find-library-name file)))))
+ (pos (when previous (member previous history))))
+ ;; Return (RELATIVE-FILENAME . HISTORY-POSITION)
+ (when pos
+ (cons (file-name-sans-extension file) (length pos)))))
+ (directory-files-recursively dir "\\`[^\\.].*\\.el\\'")))))
+ ;; Turn the list of (FILENAME . POS) back into a list of features.
Files in
+ ;; subdirectories are returned relative to DIR (so not actually
features).
+ (let ((default-directory (file-name-as-directory dir)))
+ (mapcar (lambda (x) (file-truename (car x)))
+ (sort list-of-conflicts
+ ;; Sort the files by ascending HISTORY-POSITION.
+ (lambda (x y) (< (cdr x) (cdr y))))))))
+
+ (defun package-fixes--load-files-for-activation (pkg-desc reload)
+ "Load files for activating a package given by PKG-DESC.
+Load the autoloads file, and ensure `load-path' is setup. If
+RELOAD is non-nil, also load all files in the package that
+correspond to previously loaded files."
+ (let* ((loaded-files-list (when reload
+ (package-fixes--list-loaded-files
(package-desc-dir pkg-desc)))))
+ ;; Add to load path, add autoloads, and activate the package.
+ (package-fixes--activate-autoloads-and-load-path pkg-desc)
+ ;; Call `load' on all files in `package-desc-dir' already present in
+ ;; `load-history'. This is done so that macros in these files are
updated
+ ;; to their new definitions. If another package is being installed which
+ ;; depends on this new definition, not doing this update would cause
+ ;; compilation errors and break the installation.
+ (with-demoted-errors "Error in package--load-files-for-activation: %s"
+ (mapc (lambda (feature) (load feature nil t))
+ ;; Skip autoloads file since we already evaluated it above.
+ (remove (file-truename (package-fixes--autoloads-file-name
pkg-desc))
+ loaded-files-list)))))
+
+
+;;; 24.1, 24.2, 24.3
+ (defadvice package--make-autoloads-and-compile (around
fix-package--make-autoloads-and-compile
+ (name pkg-dir)
activate)
+ "Fixed `package--make-autoloads-and-compile'.
+Behave the same as `package--make-autoloads-and-compile', except
+it uses `package-fixes--load-files-for-activation' instead of just
+loading the autoloads file."
+ (package-generate-autoloads name pkg-dir)
+ (package-fixes--load-files-for-activation pkg-desc :reload)
+ (let ((load-path (cons pkg-dir load-path)))
+ ;; We must load the autoloads file before byte compiling, in
+ ;; case there are magic cookies to set up non-trivial paths.
+ (byte-recompile-directory pkg-dir 0 t)))
+
+;;; 24.4, 24.5
+ (defadvice package--compile (after fix-package--compile (pkg-desc) activate)
+ "Like `package--compile', but reload package first.
+Uses `package-fixes--load-files-for-activation' to reload files."
+ (package-activate-1 pkg-desc)
+ (package-fixes--load-files-for-activation pkg-desc :reload)
+ (byte-recompile-directory (package-desc-dir pkg-desc) 0 t)))
+
+(provide 'package-fixes)
+;;; package-fixes.el ends here
diff --git a/packages/pinentry/pinentry.el b/packages/pinentry/pinentry.el
new file mode 100644
index 0000000..7cbe9f5
--- /dev/null
+++ b/packages/pinentry/pinentry.el
@@ -0,0 +1,397 @@
+;;; pinentry.el --- GnuPG Pinentry server implementation -*- lexical-binding:
t -*-
+
+;; Copyright (C) 2015 Free Software Foundation, Inc.
+
+;; Author: Daiki Ueno <address@hidden>
+;; Version: 0.1
+;; Keywords: GnuPG
+
+;; 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 allows GnuPG passphrase to be prompted through the
+;; minibuffer instead of graphical dialog.
+;;
+;; To use, add allow-emacs-pinentry to ~/.gnupg/gpg-agent.conf, and
+;; start the server with M-x pinentry-start.
+;;
+;; The actual communication path between the relevant components is
+;; as follows:
+;;
+;; gpg --> gpg-agent --> pinentry --> Emacs
+;;
+;; where pinentry and Emacs communicate through a Unix domain socket
+;; created at:
+;;
+;; ${TMPDIR-/tmp}/emacs$(id -u)/pinentry
+;;
+;; under the same directory which server.el uses. The protocol is a
+;; subset of the Pinentry Assuan protocol described in (info
+;; "(pinentry) Protocol").
+;;
+;; NOTE: As of June 2015, this feature requires newer versions of
+;; GnuPG (2.1.5+) and Pinentry (not yet released, possibly 0.9.5+).
+;; For details, see the discussion on gnupg-devel mailing list:
+;; <https://lists.gnupg.org/pipermail/gnupg-devel/2015-May/029875.html>.
+
+;;; Code:
+
+(defvar pinentry--server-process nil)
+(defvar pinentry--connection-process-list nil)
+
+(defvar pinentry--labels nil)
+(put 'pinentry-read-point 'permanent-local t)
+(defvar pinentry--read-point nil)
+(put 'pinentry--read-point 'permanent-local t)
+
+;; We use the same location as `server-socket-dir', when local sockets
+;; are supported.
+(defvar pinentry--socket-dir
+ (format "%s/emacs%d" (or (getenv "TMPDIR") "/tmp") (user-uid))
+ "The directory in which to place the server socket.
+If local sockets are not supported, this is nil.")
+
+(defconst pinentry--set-label-commands
+ '("SETPROMPT" "SETTITLE" "SETDESC"
+ "SETREPEAT" "SETREPEATERROR"
+ "SETOK" "SETCANCEL" "SETNOTOK"))
+
+;; These error codes are defined in libgpg-error/src/err-codes.h.in.
+(defmacro pinentry--error-code (code)
+ (logior (lsh 5 24) code))
+(defconst pinentry--error-not-implemented
+ (cons (pinentry--error-code 69) "not implemented"))
+(defconst pinentry--error-cancelled
+ (cons (pinentry--error-code 99) "cancelled"))
+(defconst pinentry--error-not-confirmed
+ (cons (pinentry--error-code 114) "not confirmed"))
+
+(autoload 'server-ensure-safe-dir "server")
+
+;;;###autoload
+(defun pinentry-start ()
+ "Start a Pinentry service.
+
+Once the environment is properly set, subsequent invocations of
+the gpg command will interact with Emacs for passphrase input."
+ (interactive)
+ (unless (featurep 'make-network-process '(:family local))
+ (error "local sockets are not supported"))
+ (if (process-live-p pinentry--server-process)
+ (message "Pinentry service is already running")
+ (let* ((server-file (expand-file-name "pinentry" pinentry--socket-dir)))
+ (server-ensure-safe-dir pinentry--socket-dir)
+ ;; Delete the socket files made by previous server invocations.
+ (ignore-errors
+ (let (delete-by-moving-to-trash)
+ (delete-file server-file)))
+ (setq pinentry--server-process
+ (make-network-process
+ :name "pinentry"
+ :server t
+ :noquery t
+ :sentinel #'pinentry--process-sentinel
+ :filter #'pinentry--process-filter
+ :coding 'no-conversion
+ :family 'local
+ :service server-file))
+ (process-put pinentry--server-process :server-file server-file))))
+
+(defun pinentry-stop ()
+ "Stop a Pinentry service."
+ (interactive)
+ (when (process-live-p pinentry--server-process)
+ (delete-process pinentry--server-process))
+ (setq pinentry--server-process nil)
+ (dolist (process pinentry--connection-process-list)
+ (when (buffer-live-p (process-buffer process))
+ (kill-buffer (process-buffer process))))
+ (setq pinentry--connection-process-list nil))
+
+(defun pinentry--labels-to-shortcuts (labels)
+ "Convert strings in LABEL by stripping mnemonics."
+ (mapcar (lambda (label)
+ (when label
+ (let (c)
+ (if (string-match "\\(?:\\`\\|[^_]\\)_\\([[:alnum:]]\\)" label)
+ (let ((key (match-string 1 label)))
+ (setq c (downcase (aref key 0)))
+ (setq label (replace-match
+ (propertize key 'face 'underline)
+ t t label)))
+ (setq c (if (= (length label) 0)
+ ??
+ (downcase (aref label 0)))))
+ ;; Double underscores mean a single underscore.
+ (when (string-match "__" label)
+ (setq label (replace-match "_" t t label)))
+ (cons c label))))
+ labels))
+
+(defun pinentry--escape-string (string)
+ "Escape STRING in the Assuan percent escape."
+ (let ((length (length string))
+ (index 0)
+ (count 0))
+ (while (< index length)
+ (if (memq (aref string index) '(?\n ?\r ?%))
+ (setq count (1+ count)))
+ (setq index (1+ index)))
+ (setq index 0)
+ (let ((result (make-string (+ length (* count 2)) ?\0))
+ (result-index 0)
+ c)
+ (while (< index length)
+ (setq c (aref string index))
+ (if (memq c '(?\n ?\r ?%))
+ (let ((hex (format "%02X" c)))
+ (aset result result-index ?%)
+ (setq result-index (1+ result-index))
+ (aset result result-index (aref hex 0))
+ (setq result-index (1+ result-index))
+ (aset result result-index (aref hex 1))
+ (setq result-index (1+ result-index)))
+ (aset result result-index c)
+ (setq result-index (1+ result-index)))
+ (setq index (1+ index)))
+ result)))
+
+(defun pinentry--unescape-string (string)
+ "Unescape STRING in the Assuan percent escape."
+ (let ((length (length string))
+ (index 0))
+ (let ((result (make-string length ?\0))
+ (result-index 0)
+ c)
+ (while (< index length)
+ (setq c (aref string index))
+ (if (and (eq c '?%) (< (+ index 2) length))
+ (progn
+ (aset result result-index
+ (string-to-number (substring string
+ (1+ index)
+ (+ index 3))
+ 16))
+ (setq result-index (1+ result-index))
+ (setq index (+ index 2)))
+ (aset result result-index c)
+ (setq result-index (1+ result-index)))
+ (setq index (1+ index)))
+ (substring result 0 result-index))))
+
+(defun pinentry--send-data (process escaped)
+ "Send a string ESCAPED to a process PROCESS.
+ESCAPED will be split if it exceeds the line length limit of the
+Assuan protocol."
+ (let ((length (length escaped))
+ (index 0))
+ (if (= length 0)
+ (process-send-string process "D \n")
+ (while (< index length)
+ ;; 997 = ASSUAN_LINELENGTH (= 1000) - strlen ("D \n")
+ (let* ((sub-length (min (- length index) 997))
+ (sub (substring escaped index (+ index sub-length))))
+ (unwind-protect
+ (progn
+ (process-send-string process "D ")
+ (process-send-string process sub)
+ (process-send-string process "\n"))
+ (clear-string sub))
+ (setq index (+ index sub-length)))))))
+
+(defun pinentry--send-error (process error)
+ (process-send-string process (format "ERR %d %s\n" (car error) (cdr error))))
+
+(defun pinentry--process-filter (process input)
+ (unless (buffer-live-p (process-buffer process))
+ (let ((buffer (generate-new-buffer " *pinentry*")))
+ (set-process-buffer process buffer)
+ (with-current-buffer buffer
+ (if (fboundp 'set-buffer-multibyte)
+ (set-buffer-multibyte nil))
+ (make-local-variable 'pinentry--read-point)
+ (setq pinentry--read-point (point-min))
+ (make-local-variable 'pinentry--labels))))
+ (with-current-buffer (process-buffer process)
+ (save-excursion
+ (goto-char (point-max))
+ (insert input)
+ (goto-char pinentry--read-point)
+ (beginning-of-line)
+ (while (looking-at ".*\n") ;the input line finished
+ (if (looking-at "\\([A-Z_]+\\) ?\\(.*\\)")
+ (let ((command (match-string 1))
+ (string (pinentry--unescape-string (match-string 2))))
+ (pcase command
+ ((and set (guard (member set pinentry--set-label-commands)))
+ (when (> (length string) 0)
+ (let* ((symbol (intern (downcase (substring set 3))))
+ (entry (assq symbol pinentry--labels))
+ (label (decode-coding-string string 'utf-8)))
+ (if entry
+ (setcdr entry label)
+ (push (cons symbol label) pinentry--labels))))
+ (ignore-errors
+ (process-send-string process "OK\n")))
+ ("NOP"
+ (ignore-errors
+ (process-send-string process "OK\n")))
+ ("GETPIN"
+ (let ((prompt
+ (or (cdr (assq 'desc pinentry--labels))
+ (cdr (assq 'prompt pinentry--labels))
+ ""))
+ (confirm (not (null (assq 'repeat pinentry--labels))))
+ entry)
+ (if (setq entry (assq 'error pinentry--labels))
+ (setq prompt (concat "Error: "
+ (propertize
+ (copy-sequence (cdr entry))
+ 'face 'error)
+ "\n"
+ prompt)))
+ (if (setq entry (assq 'title pinentry--labels))
+ (setq prompt (format "[%s] %s"
+ (cdr entry) prompt)))
+ (if (string-match ":?[ \n]*\\'" prompt)
+ (setq prompt (concat
+ (substring
+ prompt 0 (match-beginning 0)) ": ")))
+ (let (passphrase escaped-passphrase encoded-passphrase)
+ (unwind-protect
+ (condition-case nil
+ (progn
+ (setq passphrase
+ (read-passwd prompt confirm))
+ (setq escaped-passphrase
+ (pinentry--escape-string
+ passphrase))
+ (setq encoded-passphrase (encode-coding-string
+ escaped-passphrase
+ 'utf-8))
+ (ignore-errors
+ (pinentry--send-data
+ process encoded-passphrase)
+ (process-send-string process "OK\n")))
+ (error
+ (ignore-errors
+ (pinentry--send-error
+ process
+ pinentry--error-cancelled))))
+ (if passphrase
+ (clear-string passphrase))
+ (if escaped-passphrase
+ (clear-string escaped-passphrase))
+ (if encoded-passphrase
+ (clear-string encoded-passphrase))))
+ (setq pinentry--labels nil)))
+ ("CONFIRM"
+ (let ((prompt
+ (or (cdr (assq 'desc pinentry--labels))
+ ""))
+ (buttons
+ (pinentry--labels-to-shortcuts
+ (list (cdr (assq 'ok pinentry--labels))
+ (cdr (assq 'notok pinentry--labels))
+ (cdr (assq 'cancel pinentry--labels)))))
+ entry)
+ (if (setq entry (assq 'error pinentry--labels))
+ (setq prompt (concat "Error: "
+ (propertize
+ (copy-sequence (cdr entry))
+ 'face 'error)
+ "\n"
+ prompt)))
+ (if (setq entry (assq 'title pinentry--labels))
+ (setq prompt (format "[%s] %s"
+ (cdr entry) prompt)))
+ (if (remq nil buttons)
+ (progn
+ (setq prompt
+ (concat prompt " ("
+ (mapconcat #'cdr (remq nil buttons)
+ ", ")
+ ") "))
+ (condition-case nil
+ (let ((result (read-char prompt)))
+ (if (eq result (caar buttons))
+ (ignore-errors
+ (process-send-string process "OK\n"))
+ (if (eq result (car (nth 1 buttons)))
+ (ignore-errors
+ (pinentry--send-error
+ process
+ pinentry--error-not-confirmed))
+ (ignore-errors
+ (pinentry--send-error
+ process
+ pinentry--error-cancelled)))))
+ (error
+ (ignore-errors
+ (pinentry--send-error
+ process
+ pinentry--error-cancelled)))))
+ (if (string-match "[ \n]*\\'" prompt)
+ (setq prompt (concat
+ (substring
+ prompt 0 (match-beginning 0)) " ")))
+ (if (condition-case nil
+ (y-or-n-p prompt)
+ (quit))
+ (ignore-errors
+ (process-send-string process "OK\n"))
+ (ignore-errors
+ (pinentry--send-error
+ process
+ pinentry--error-not-confirmed))))
+ (setq pinentry--labels nil)))
+ (_ (ignore-errors
+ (pinentry--send-error
+ process
+ pinentry--error-not-implemented))))
+ (forward-line)
+ (setq pinentry--read-point (point))))))))
+
+(defun pinentry--process-sentinel (process _status)
+ "The process sentinel for Emacs server connections."
+ ;; If this is a new client process, set the query-on-exit flag to nil
+ ;; for this process (it isn't inherited from the server process).
+ (when (and (eq (process-status process) 'open)
+ (process-query-on-exit-flag process))
+ (push process pinentry--connection-process-list)
+ (set-process-query-on-exit-flag process nil)
+ (ignore-errors
+ (process-send-string process "OK Your orders please\n")))
+ ;; Kill the process buffer of the connection process.
+ (when (and (not (process-contact process :server))
+ (eq (process-status process) 'closed))
+ (when (buffer-live-p (process-buffer process))
+ (kill-buffer (process-buffer process)))
+ (setq pinentry--connection-process-list
+ (delq process pinentry--connection-process-list)))
+ ;; Delete the associated connection file, if applicable.
+ ;; Although there's no 100% guarantee that the file is owned by the
+ ;; running Emacs instance, server-start uses server-running-p to check
+ ;; for possible servers before doing anything, so it *should* be ours.
+ (and (process-contact process :server)
+ (eq (process-status process) 'closed)
+ (ignore-errors
+ (delete-file (process-get process :server-file)))))
+
+(provide 'pinentry)
+
+;;; pinentry.el ends here
diff --git a/packages/rainbow-mode/rainbow-mode.el
b/packages/rainbow-mode/rainbow-mode.el
index 93c99e3..15ae91c 100644
--- a/packages/rainbow-mode/rainbow-mode.el
+++ b/packages/rainbow-mode/rainbow-mode.el
@@ -4,7 +4,7 @@
;; Author: Julien Danjou <address@hidden>
;; Keywords: faces
-;; Version: 0.11
+;; Version: 0.12
;; This file is part of GNU Emacs.
@@ -1104,25 +1104,29 @@ Return a value between 0 and 1."
(defun rainbow-turn-on ()
"Turn on raibow-mode."
(font-lock-add-keywords nil
- rainbow-hexadecimal-colors-font-lock-keywords)
+ rainbow-hexadecimal-colors-font-lock-keywords
+ t)
;; Activate X colors?
(when (or (eq rainbow-x-colors t)
(and (eq rainbow-x-colors 'auto)
(memq major-mode rainbow-x-colors-major-mode-list)))
(font-lock-add-keywords nil
- rainbow-x-colors-font-lock-keywords))
+ rainbow-x-colors-font-lock-keywords
+ t))
;; Activate LaTeX colors?
(when (or (eq rainbow-latex-colors t)
(and (eq rainbow-latex-colors 'auto)
(memq major-mode rainbow-latex-colors-major-mode-list)))
(font-lock-add-keywords nil
- rainbow-latex-rgb-colors-font-lock-keywords))
+ rainbow-latex-rgb-colors-font-lock-keywords
+ t))
;; Activate ANSI colors?
(when (or (eq rainbow-ansi-colors t)
(and (eq rainbow-ansi-colors 'auto)
(memq major-mode rainbow-ansi-colors-major-mode-list)))
(font-lock-add-keywords nil
- rainbow-ansi-colors-font-lock-keywords))
+ rainbow-ansi-colors-font-lock-keywords
+ t))
;; Activate HTML colors?
(when (or (eq rainbow-html-colors t)
(and (eq rainbow-html-colors 'auto)
@@ -1132,7 +1136,8 @@ Return a value between 0 and 1."
(0 (rainbow-colorize-by-assoc rainbow-html-colors-alist)))))
(font-lock-add-keywords nil
`(,@rainbow-html-colors-font-lock-keywords
- ,@rainbow-html-rgb-colors-font-lock-keywords)))
+ ,@rainbow-html-rgb-colors-font-lock-keywords)
+ t))
;; Activate R colors?
(when (or (eq rainbow-r-colors t)
(and (eq rainbow-r-colors 'auto)
@@ -1142,7 +1147,7 @@ Return a value between 0 and 1."
(0 (rainbow-colorize-by-assoc rainbow-r-colors-alist)))))
(font-lock-add-keywords nil
rainbow-r-colors-font-lock-keywords
- )))
+ t)))
(defun rainbow-turn-off ()
"Turn off rainbow-mode."
diff --git a/packages/register-list/register-list.el
b/packages/register-list/register-list.el
index 1bbcb72..1c87d62 100755
--- a/packages/register-list/register-list.el
+++ b/packages/register-list/register-list.el
@@ -1,10 +1,10 @@
;;; register-list.el --- Interactively list/edit registers -*-
lexical-binding:t -*-
;;
-;; Copyright (C) 2011-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2015 Free Software Foundation, Inc.
;;
;; Filename: register-list.el
-;; Author: Bastien Guerry <bzg AT altern DOT org>
-;; Maintainer: Bastien Guerry <bzg AT altern DOT org>
+;; Author: Bastien Guerry <address@hidden>
+;; Maintainer: Bastien Guerry <address@hidden>
;; Keywords: register
;; Description: List and edit the register
;; Version: 0.1
@@ -220,11 +220,15 @@ If FORCE-LINE is non-nil, force moving to this line."
(goto-char (point-min))
(line-move (- line 2) t)))
+(defconst register-list--intangible
+ (if (fboundp 'cursor-intangible-mode)
+ 'cursor-intangible 'intangible))
+
(defun register-list-set-mark (mark)
"Set mark at the beginning of the line."
(let ((inhibit-read-only t))
(beginning-of-line)
- (unless (get-text-property (point) 'intangible)
+ (unless (get-text-property (point) register-list--intangible)
(delete-char 1)
(save-excursion (insert mark))
(unless (save-excursion (forward-line 1) (eobp))
@@ -320,6 +324,7 @@ copy the string to the kill ring or jump to the location.
\\[register-list-tab] -- cycle between the key, the type and the value.
\\[register-list-quit] -- quit the register menu."
(setq truncate-lines t)
+ (if (fboundp 'cursor-intangible-mode) (cursor-intangible-mode 1))
(setq buffer-read-only t))
;;\\[register-list-edit-key-or-value] -- edit the key for this register.
@@ -363,12 +368,12 @@ The list is displayed in a buffer named `*Register List*'
in
(setq register-alist ;; TODO better sorting.
(sort register-alist (lambda (a b) (< (car a) (car b)))))
(erase-buffer)
- ;; FIXME: Why `intangible'?
+ ;; FIXME: Why intangible?
(insert (concat (propertize "% Key Type Value\n"
'face 'font-lock-type-face
- 'intangible t) ;; 'front-sticky t)
+ register-list--intangible t) ;; 'front-sticky t)
(propertize "- --- ---- -----\n"
- 'intangible t
+ register-list--intangible t
'face 'font-lock-comment-delimiter-face)))
(dolist (register register-alist)
(let* ((key (char-to-string (car register)))
diff --git a/packages/rich-minority/LICENSE b/packages/rich-minority/LICENSE
new file mode 100644
index 0000000..d7f1051
--- /dev/null
+++ b/packages/rich-minority/LICENSE
@@ -0,0 +1,339 @@
+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
new file mode 100644
index 0000000..acac5bd
--- /dev/null
+++ b/packages/rich-minority/README.org
@@ -0,0 +1,50 @@
+#+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
new file mode 100644
index 0000000..78a4166
--- /dev/null
+++ b/packages/rich-minority/rich-minority.el
@@ -0,0 +1,283 @@
+;;; rich-minority.el --- Clean-up and Beautify the list of minor-modes.
+
+;; Copyright (C) 2014, 2015 Free Software Foundation, Inc.
+
+;; Author: Artur Malabarba <address@hidden>
+;; 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/rnc-mode/rnc-mode.el b/packages/rnc-mode/rnc-mode.el
new file mode 100644
index 0000000..81f891b
--- /dev/null
+++ b/packages/rnc-mode/rnc-mode.el
@@ -0,0 +1,153 @@
+;;; rnc-mode.el --- Emacs mode to edit Relax-NG Compact files -*-
lexical-binding:t -*-
+
+;; Copyright (C) 1994-1998, 2001-2016 Free Software Foundation, Inc.
+
+;; Author: Stefan Monnier <address@hidden>
+;; Keywords: xml relaxng
+;; Version: 0.1
+
+;; 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:
+
+(require 'smie)
+(require 'nxml-mode)
+
+;;; Code:
+
+;;;###autoload
+(add-to-list 'auto-mode-alist '("\\.rnc\\'" . rnc-mode))
+
+(defconst rnc-mode-syntax-table
+ (let ((st (make-syntax-table)))
+ (modify-syntax-entry ?# "<" st)
+ (modify-syntax-entry ?\n ">" st)
+ (modify-syntax-entry ?\" "\"" st)
+ (modify-syntax-entry ?- "_" st)
+ (modify-syntax-entry ?. "_" st)
+ (modify-syntax-entry ?: "_" st)
+ (modify-syntax-entry ?_ "_" st)
+ st))
+
+(defconst rnc--keywords
+ ;; Taken from the grammar in http://relaxng.org/compact-20021121.html,
+ ;; by order of appearance.
+ '("namespace" "default" "datatypes" "element" "attribute"
+ "list" "mixed" "parent" "empty" "text" "notAllowed" "external"
+ "grammar" "div" "include" ;; "start"
+ "string" "token" "inherit"))
+
+(defconst rnc--def-regexp "^[ \t]*\\([\\[:alpha:]][[:alnum:]-._]*\\)[ \t]*=")
+
+(defconst rnc-font-lock-keywords
+ `((,rnc--def-regexp (1 font-lock-function-name-face))
+ (,(concat "\\_<" (regexp-opt rnc--keywords) "\\_>")
+ (0 font-lock-keyword-face))
+ ("attribute[ \t\n]+\\([^ ]+\\)" (1 'nxml-attribute-local-name))
+ ;; FIXME: We'd like to use nxml-element-local-name for element names,
+ ;; but by default this looks exactly like font-lock-function-name-face,
+ ;; which we want to use for local pattern definitions.
+ ;; ("element[ \t\n]+\\([^ ]+\\)" (1 'nxml-element-local-name))
+ ))
+
+(defconst rnc-imenu-generic-expression `((nil ,rnc--def-regexp 1)))
+
+(defconst rnc-smie-grammar
+ ;; The body of an RNC file is a sequence of definitions.
+ ;; Problem is: these definitions are not separated by any special keyword.
+ ;; It's basically a repetition of (id "=" pattern), where
+ ;; patterns can end with:
+ ;; "}", ")" "*", "+", "?", id, stringliteral
+ ;; Since this is way beyond the power of SMIE, we resort to using a pseudo
+ ;; " ; " separator which is introduced by the tokenizer.
+ (smie-prec2->grammar
+ (smie-bnf->prec2
+ '((id) (atom) (args)
+ (header (header "include" atom))
+ (decls (id "=" pattern) (id "|=" pattern) (id "&=" pattern)
+ (decls " ; " decls))
+ (pattern ("element" args) ("attribute" args)
+ ("list" args) ("mixed" args)
+ ("parent" id) ("external" id)
+ ("grammar" atom)
+ ("{" pattern "}")
+ (pattern "," pattern)
+ (pattern "&" pattern)
+ (pattern "|" pattern)
+ (pattern "?")
+ (pattern "*")
+ (pattern "+")))
+ ;; The spec says "There is no notion of operator precedence".
+ '((assoc " ; "))
+ '((assoc "," "&" "|") (nonassoc "?" "*" "+"))
+ )))
+
+(defun rnc-smie-forward-token ()
+ (let ((start (point)))
+ (forward-comment (point-max))
+ (if (and (> (point) start)
+ (looking-at "\\(?:\\s_\\|\\sw\\)+[ \t\n]*[|&]?=")
+ (save-excursion
+ (goto-char start)
+ (forward-comment -1)
+ (= (point) start)))
+ " ; "
+ (smie-default-forward-token))))
+
+(defun rnc-smie-backward-token ()
+ (let ((start (point)))
+ (forward-comment (- (point)))
+ (if (and (< (point) start)
+ (let ((pos (point)))
+ (goto-char start)
+ (prog1
+ (looking-at "\\(?:\\s_\\|\\sw\\)+[ \t\n]*[|&]?=")
+ (goto-char pos))))
+ " ; "
+ (smie-default-backward-token))))
+
+(defun rnc-smie-rules (kind token)
+ (pcase (cons kind token)
+ (`(:list-intro . "element") t)
+ (`(:before . ,(or "include" "default" "namespace" "datatypes")) 0)
+ (`(:before . "{")
+ (save-excursion
+ (let ((offset (if (smie-rule-bolp) smie-indent-basic 0))
+ x)
+ (while (or (null (car-safe x))
+ (integerp (car-safe x)))
+ (setq x (smie-backward-sexp 'halfsexp)))
+ (goto-char (nth 1 x))
+ `(column . ,(+ (smie-indent-virtual) offset)))))
+ (`(:after . ,(or "=" "|=" "&=")) smie-indent-basic)
+ (`(:before . ,(or "|" "&" ","))
+ (and (smie-rule-bolp) (smie-rule-parent-p "(" "{") (smie-rule-parent)))
+ (`(,_ . " ; ") (smie-rule-separator kind))
+ ))
+
+;;;###autoload
+(define-derived-mode rnc-mode prog-mode "RNC"
+ "Major mode to edit Relax-NG Compact files."
+ (setq-local comment-start "#")
+ (setq-local font-lock-defaults '(rnc-font-lock-keywords))
+ (setq-local imenu-generic-expression rnc-imenu-generic-expression)
+ (smie-setup rnc-smie-grammar #'rnc-smie-rules
+ :forward-token #'rnc-smie-forward-token
+ :backward-token #'rnc-smie-backward-token))
+
+(provide 'rnc-mode)
+;;; rnc-mode.el ends here
diff --git a/packages/sed-mode/sed-mode.el b/packages/sed-mode/sed-mode.el
new file mode 100644
index 0000000..1b35c7a
--- /dev/null
+++ b/packages/sed-mode/sed-mode.el
@@ -0,0 +1,140 @@
+;;; sed-mode.el --- Major mode to edit sed scripts -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2016 Free Software Foundation, Inc.
+
+;; Author: Stefan Monnier <address@hidden>
+;; Version: 1.0
+;; 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:
+
+;; If you need this major mode, you might also want to
+;; consider spending some time with `M-x doctor'.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'smie)
+
+(defgroup sed-mode nil
+ "Major mode to edit sed code."
+ :group 'programming)
+
+
+(defvar sed-mode-syntax-table
+ (let ((st (make-syntax-table)))
+ (modify-syntax-entry ?# "<" st)
+ (modify-syntax-entry ?\n ">" st)
+ (modify-syntax-entry ?\\ "." st)
+ st))
+
+(defconst sed-commands ":=aiqQrRbcdDhHgGlnNpPstTwWxy")
+
+(eval-and-compile
+ (defconst sed-command-prefix-regexp "\\(?:^\\|[$/0-9;]\\)[ \t]*")
+ (defconst sed-address-prefix-regexp "\\(?:^\\|[,;]\\)[ \t]*"))
+
+(defconst sed-label-regexp "[[:alnum:]]+")
+
+(defun sed-syntax-propertize (beg end)
+ (goto-char beg)
+ (sed-syntax-propertize-string end)
+ (funcall
+ (syntax-propertize-rules
+ ("\\\\$"
+ (0 (unless (nth 8 (save-excursion (syntax-ppss (match-beginning 0))))
+ (put-text-property (match-beginning 0) (match-end 0)
+ 'syntax-table (string-to-syntax "|"))
+ (sed-syntax-propertize-string end)
+ nil)))
+ ((concat "\\(?:" sed-address-prefix-regexp
+ "\\(?:\\(?1:/\\)\\|\\\\\\(?1:.\\)\\)"
+ "\\|" sed-command-prefix-regexp "[sy]\\(?1:.\\)"
+ "\\)")
+ (0 (unless (nth 8 (save-excursion (syntax-ppss (match-beginning 0))))
+ (put-text-property (match-beginning 1) (match-end 1)
+ 'syntax-table (string-to-syntax "\""))
+ (sed-syntax-propertize-string end)
+ nil))))
+ (point) end))
+
+(defun sed-syntax-propertize-string (end)
+ (let* ((ppss (syntax-ppss))
+ (c (nth 3 ppss)))
+ (when c
+ (let ((count (cond
+ ((or (eq c t)
+ (not (memq (char-before (nth 8 ppss)) '(?s ?y))))
+ 1)
+ (t 2))))
+ (goto-char (1+ (nth 8 ppss)))
+ (when (re-search-forward
+ (if (eq c t) "[^\\]\n" (regexp-quote (string c)))
+ end 'move count)
+ (put-text-property (1- (match-end 0)) (match-end 0)
+ 'syntax-table
+ (if (eq c t) (string-to-syntax "|")
+ (string-to-syntax "\""))))))))
+
+(defun sed--font-lock-command (cmd)
+ (unless (nth 8 (syntax-ppss))
+ (pcase cmd
+ (?: (if (looking-at (concat "[ ]*\\(" sed-label-regexp "\\)"))
+ (put-text-property (match-beginning 1) (match-end 1) 'face
+ font-lock-function-name-face)))
+ ((or ?b ?t ?T)
+ (if (looking-at (concat "[ ]*\\(" sed-label-regexp "\\)"))
+ (put-text-property (match-beginning 1) (match-end 1) 'face
+ font-lock-constant-face))))
+ font-lock-keyword-face))
+
+(defconst sed-font-lock-keywords
+ `((,(concat sed-command-prefix-regexp "\\([" sed-commands "]\\)")
+ (1 (sed--font-lock-command (char-after (match-beginning 1)))))))
+
+(defconst sed-smie-grammar nil)
+
+(defun sed-smie-rules (kind token)
+ (pcase (cons kind token)
+ (`(:list-intro . ,_) t)
+ ))
+
+;;;###autoload (add-to-list 'auto-mode-alist '("\\.sed\\'" . sed-mode))
+;;;###autoload (add-to-list 'interpreter-mode-alist '("sed" . sed-mode))
+
+;;;###autoload
+(define-derived-mode sed-mode prog-mode "Sed"
+ "Sed editing mode."
+ ;; (setq-local font-lock-support-mode nil) ;; To help debugging.
+ (setq-local comment-start "# ")
+ (setq-local comment-end "")
+ (setq-local parse-sexp-lookup-properties t)
+ (setq-local open-paren-in-column-0-is-defun-start nil)
+ (setq-local syntax-propertize-function #'sed-syntax-propertize)
+ (setq-local font-lock-defaults '(sed-font-lock-keywords))
+ (smie-setup sed-smie-grammar #'sed-smie-rules
+ ;; :backward-token #'sm-c-smie-backward-token
+ ;; :forward-token #'sm-c-smie-forward-token
+ )
+ ;; Backslash auto-realign.
+ ;; (add-hook 'after-change-functions #'sm-c--bs-after-change nil t)
+ ;; (add-hook 'post-command-hook #'sm-c--bs-realign nil t)
+ ;; (setq-local add-log-current-defun-header-regexp sm-c--def-regexp)
+ ;; (setq-local imenu-generic-expression `((nil ,sm-c--def-regexp 1)))
+ )
+
+(provide 'sed-mode)
+;;; sed-mode.el ends here
diff --git a/packages/seq/seq.el b/packages/seq/seq.el
index c5f5906..58f6903 100644
--- a/packages/seq/seq.el
+++ b/packages/seq/seq.el
@@ -4,7 +4,7 @@
;; Author: Nicolas Petton <address@hidden>
;; Keywords: sequences
-;; Version: 1.3
+;; Version: 1.11
;; Package: seq
;; Maintainer: address@hidden
@@ -44,31 +44,59 @@
(defmacro seq-doseq (spec &rest body)
"Loop over a sequence.
-Similar to `dolist' but can be applied lists, strings and vectors.
+Similar to `dolist' but can be applied to lists, strings, and vectors.
Evaluate BODY with VAR bound to each element of SEQ, in turn.
-Then evaluate RESULT to get return value, default nil.
-\(fn (VAR SEQ [RESULT]) BODY...)"
+\(fn (VAR SEQ) BODY...)"
(declare (indent 1) (debug ((symbolp form &optional form) body)))
- (let ((is-list (make-symbol "is-list"))
+ (let ((length (make-symbol "length"))
(seq (make-symbol "seq"))
(index (make-symbol "index")))
`(let* ((,seq ,(cadr spec))
- (,is-list (listp ,seq))
- (,index (if ,is-list ,seq 0)))
- (while (if ,is-list
- (consp ,index)
- (< ,index (seq-length ,seq)))
- (let ((,(car spec) (if ,is-list
- (car ,index)
- (seq-elt ,seq ,index))))
- ,@body
- (setq ,index (if ,is-list
- (cdr ,index)
- (+ ,index 1)))))
- ,@(if (cddr spec)
- `((setq ,(car spec) nil) ,@(cddr spec))))))
+ (,length (if (listp ,seq) nil (seq-length ,seq)))
+ (,index (if ,length 0 ,seq)))
+ (while (if ,length
+ (< ,index ,length)
+ (consp ,index))
+ (let ((,(car spec) (if ,length
+ (prog1 (seq-elt ,seq ,index)
+ (setq ,index (+ ,index 1)))
+ (pop ,index))))
+ ,@body)))))
+
+(if (fboundp 'pcase-defmacro)
+ ;; Implementation of `seq-let' based on a `pcase'
+ ;; pattern. Requires Emacs>=25.1.
+ (progn
+ (pcase-defmacro seq (&rest args)
+ "pcase pattern matching sequence elements.
+Matches if the object is a sequence (list, string or vector), and
+binds each element of ARGS to the corresponding element of the
+sequence."
+ `(and (pred seq-p)
+ ,@(seq--make-pcase-bindings args)))
+
+ (defmacro seq-let (args seq &rest body)
+ "Bind the variables in ARGS to the elements of SEQ then evaluate BODY.
+
+ARGS can also include the `&rest' marker followed by a variable
+name to be bound to the rest of SEQ."
+ (declare (indent 2) (debug t))
+ `(pcase-let ((,(seq--make-pcase-patterns args) ,seq))
+ ,@body)))
+
+ ;; Implementation of `seq-let' compatible with Emacs<25.1.
+ (defmacro seq-let (args seq &rest body)
+ "Bind the variables in ARGS to the elements of SEQ then evaluate BODY.
+
+ARGS can also include the `&rest' marker followed by a variable
+name to be bound to the rest of SEQ."
+ (declare (indent 2) (debug t))
+ (let ((seq-var (make-symbol "seq")))
+ `(let* ((,seq-var ,seq)
+ ,@(seq--make-bindings args seq-var))
+ ,@body))))
(defun seq-drop (seq n)
"Return a subsequence of SEQ without its first N elements.
@@ -136,13 +164,27 @@ If SEQ is empty, return INITIAL-VALUE and FUNCTION is not
called."
(setq acc (funcall function acc elt)))
acc)))
-(defun seq-some-p (pred seq)
- "Return any element for which (PRED element) is non-nil in SEQ, nil
otherwise."
+(defun seq-some (pred seq)
+ "Return the first value for which if (PRED element) is non-nil for in SEQ."
+ (catch 'seq--break
+ (seq-doseq (elt seq)
+ (let ((result (funcall pred elt)))
+ (when result
+ (throw 'seq--break result))))
+ nil))
+
+(defun seq-find (pred seq &optional default)
+ "Return the first element for which (PRED element) is non-nil in SEQ.
+If no element is found, return DEFAULT.
+
+Note that `seq-find' has an ambiguity if the found element is
+identical to DEFAULT, as it cannot be known if an element was
+found or not."
(catch 'seq--break
(seq-doseq (elt seq)
(when (funcall pred elt)
(throw 'seq--break elt)))
- nil))
+ default))
(defun seq-every-p (pred seq)
"Return non-nil if (PRED element) is non-nil for all elements of the
sequence SEQ."
@@ -174,19 +216,30 @@ The result is a sequence of the same type as SEQ."
(let ((result (seq-sort pred (append seq nil))))
(seq-into result (type-of seq)))))
-(defun seq-contains-p (seq elt &optional testfn)
+(defun seq-contains (seq elt &optional testfn)
"Return the first element in SEQ that equals to ELT.
Equality is defined by TESTFN if non-nil or by `equal' if nil."
- (seq-some-p (lambda (e)
+ (seq-some (lambda (e)
(funcall (or testfn #'equal) elt e))
seq))
+(defun seq-position (seq elt &optional testfn)
+ "Return the index of the first element in SEQ that is equal to ELT.
+Equality is defined by TESTFN if non-nil or by `equal' if nil."
+ (let ((index 0))
+ (catch 'seq--break
+ (seq-doseq (e seq)
+ (when (funcall (or testfn #'equal) e elt)
+ (throw 'seq--break index))
+ (setq index (1+ index)))
+ nil)))
+
(defun seq-uniq (seq &optional testfn)
"Return a list of the elements of SEQ with duplicates removed.
TESTFN is used to compare elements, or `equal' if TESTFN is nil."
(let ((result '()))
(seq-doseq (elt seq)
- (unless (seq-contains-p result elt testfn)
+ (unless (seq-contains result elt testfn)
(setq result (cons elt result))))
(nreverse result)))
@@ -221,7 +274,7 @@ TYPE must be one of following symbols: vector, string or
list.
(`vector (apply #'vconcat seqs))
(`string (apply #'concat seqs))
(`list (apply #'append (append seqs '(nil))))
- (t (error "Not a sequence type name: %s" type))))
+ (t (error "Not a sequence type name: %S" type))))
(defun seq-mapcat (function seq &optional type)
"Concatenate the result of applying FUNCTION to each element of SEQ.
@@ -240,6 +293,26 @@ negative integer or 0, nil is returned."
(setq seq (seq-drop seq n)))
(nreverse result))))
+(defun seq-intersection (seq1 seq2 &optional testfn)
+ "Return a list of the elements that appear in both SEQ1 and SEQ2.
+Equality is defined by TESTFN if non-nil or by `equal' if nil."
+ (seq-reduce (lambda (acc elt)
+ (if (seq-contains seq2 elt testfn)
+ (cons elt acc)
+ acc))
+ (seq-reverse seq1)
+ '()))
+
+(defun seq-difference (seq1 seq2 &optional testfn)
+ "Return a list of the elements that appear in SEQ1 but not in SEQ2.
+Equality is defined by TESTFN if non-nil or by `equal' if nil."
+ (seq-reduce (lambda (acc elt)
+ (if (not (seq-contains seq2 elt testfn))
+ (cons elt acc)
+ acc))
+ (seq-reverse seq1)
+ '()))
+
(defun seq-group-by (function seq)
"Apply FUNCTION to each element of SEQ.
Separate the elements of SEQ into an alist using the results as
@@ -275,7 +348,17 @@ TYPE can be one of the following symbols: vector, string
or list."
(`vector (vconcat seq))
(`string (concat seq))
(`list (append seq nil))
- (t (error "Not a sequence type name: %s" type))))
+ (t (error "Not a sequence type name: %S" type))))
+
+(defun seq-min (seq)
+ "Return the smallest element of SEQ.
+SEQ must be a sequence of numbers or markers."
+ (apply #'min (seq-into seq 'list)))
+
+(defun seq-max (seq)
+ "Return the largest element of SEQ.
+SEQ must be a sequence of numbers or markers."
+ (apply #'max (seq-into seq 'list)))
(defun seq--drop-list (list n)
"Return a list from LIST without its first N elements.
@@ -318,12 +401,83 @@ This is an optimization for lists in `seq-take-while'."
(setq n (+ 1 n)))
n))
+(defun seq--make-pcase-bindings (args)
+ "Return a list of bindings of the variables in ARGS to the elements of a
sequence."
+ (let ((bindings '())
+ (index 0)
+ (rest-marker nil))
+ (seq-doseq (name args)
+ (unless rest-marker
+ (pcase name
+ (`&rest
+ (progn (push `(app (pcase--flip seq-drop ,index)
+ ,(seq--elt-safe args (1+ index)))
+ bindings)
+ (setq rest-marker t)))
+ (t
+ (push `(app (pcase--flip seq--elt-safe ,index) ,name) bindings))))
+ (setq index (1+ index)))
+ bindings))
+
+(defun seq--make-pcase-patterns (args)
+ "Return a list of `(seq ...)' pcase patterns from the argument list ARGS."
+ (cons 'seq
+ (seq-map (lambda (elt)
+ (if (seq-p elt)
+ (seq--make-pcase-patterns elt)
+ elt))
+ args)))
+
+;; Helper function for the Backward-compatible version of `seq-let'
+;; for Emacs<25.1.
+(defun seq--make-bindings (args seq &optional bindings)
+ "Return a list of bindings of the variables in ARGS to the elements of a
sequence.
+if BINDINGS is non-nil, append new bindings to it, and return
+BINDINGS."
+ (let ((index 0)
+ (rest-marker nil))
+ (seq-doseq (name args)
+ (unless rest-marker
+ (pcase name
+ ((pred seq-p)
+ (setq bindings (seq--make-bindings (seq--elt-safe args index)
+ `(seq--elt-safe ,seq ,index)
+ bindings)))
+ (`&rest
+ (progn (push `(,(seq--elt-safe args (1+ index))
+ (seq-drop ,seq ,index))
+ bindings)
+ (setq rest-marker t)))
+ (t
+ (push `(,name (seq--elt-safe ,seq ,index)) bindings))))
+ (setq index (1+ index)))
+ bindings))
+
+(defun seq--elt-safe (seq n)
+ "Return element of SEQ at the index N.
+If no element is found, return nil."
+ (when (or (listp seq)
+ (and (sequencep seq)
+ (> (seq-length seq) n)))
+ (seq-elt seq n)))
+
+(defun seq--activate-font-lock-keywords ()
+ "Activate font-lock keywords for some symbols defined in seq."
+ (font-lock-add-keywords 'emacs-lisp-mode
+ '("\\<seq-doseq\\>" "\\<seq-let\\>")))
+
(defalias 'seq-copy #'copy-sequence)
(defalias 'seq-elt #'elt)
(defalias 'seq-length #'length)
(defalias 'seq-do #'mapc)
(defalias 'seq-each #'seq-do)
(defalias 'seq-map #'mapcar)
+(defalias 'seq-p #'sequencep)
+
+(unless (fboundp 'elisp--font-lock-flush-elisp-buffers)
+ ;; In Emacs≥25, (via elisp--font-lock-flush-elisp-buffers and a few others)
+ ;; we automatically highlight macros.
+ (add-hook 'emacs-lisp-mode-hook #'seq--activate-font-lock-keywords))
(provide 'seq)
;;; seq.el ends here
diff --git a/packages/seq/tests/seq-tests.el b/packages/seq/tests/seq-tests.el
index d3536b6..8f2dfbb 100644
--- a/packages/seq/tests/seq-tests.el
+++ b/packages/seq/tests/seq-tests.el
@@ -124,21 +124,32 @@ Evaluate BODY for each created sequence.
(should (eq (seq-reduce #'+ seq 0) 0))
(should (eq (seq-reduce #'+ seq 7) 7))))
-(ert-deftest test-seq-some-p ()
+(ert-deftest test-seq-some ()
(with-test-sequences (seq '(4 3 2 1))
- (should (= (seq-some-p #'test-sequences-evenp seq) 4))
- (should (= (seq-some-p #'test-sequences-oddp seq) 3))
- (should-not (seq-some-p (lambda (elt) (> elt 10)) seq)))
+ (should (seq-some #'test-sequences-evenp seq))
+ (should (seq-some #'test-sequences-oddp seq))
+ (should-not (seq-some (lambda (elt) (> elt 10)) seq)))
(with-test-sequences (seq '())
- (should-not (seq-some-p #'test-sequences-oddp seq))))
+ (should-not (seq-some #'test-sequences-oddp seq)))
+ (should (seq-some #'null '(1 nil 2))))
-(ert-deftest test-seq-contains-p ()
+(ert-deftest test-seq-find ()
+ (with-test-sequences (seq '(4 3 2 1))
+ (should (= 4 (seq-find #'test-sequences-evenp seq)))
+ (should (= 3 (seq-find #'test-sequences-oddp seq)))
+ (should-not (seq-find (lambda (elt) (> elt 10)) seq)))
+ (should-not (seq-find #'null '(1 nil 2)))
+ (should-not (seq-find #'null '(1 nil 2) t))
+ (should-not (seq-find #'null '(1 2 3)))
+ (should (seq-find #'null '(1 2 3) 'sentinel)))
+
+(ert-deftest test-seq-contains ()
(with-test-sequences (seq '(3 4 5 6))
- (should (seq-contains-p seq 3))
- (should-not (seq-contains-p seq 7)))
+ (should (seq-contains seq 3))
+ (should-not (seq-contains seq 7)))
(with-test-sequences (seq '())
- (should-not (seq-contains-p seq 3))
- (should-not (seq-contains-p seq nil))))
+ (should-not (seq-contains seq 3))
+ (should-not (seq-contains seq nil))))
(ert-deftest test-seq-every-p ()
(with-test-sequences (seq '(43 54 22 1))
@@ -250,5 +261,66 @@ Evaluate BODY for each created sequence.
(should (same-contents-p list vector))
(should (vectorp vector))))
+(ert-deftest test-seq-intersection ()
+ (let ((v1 [2 3 4 5])
+ (v2 [1 3 5 6 7]))
+ (should (same-contents-p (seq-intersection v1 v2)
+ '(3 5))))
+ (let ((l1 '(2 3 4 5))
+ (l2 '(1 3 5 6 7)))
+ (should (same-contents-p (seq-intersection l1 l2)
+ '(3 5))))
+ (let ((v1 [2 4 6])
+ (v2 [1 3 5]))
+ (should (seq-empty-p (seq-intersection v1 v2)))))
+
+(ert-deftest test-seq-difference ()
+ (let ((v1 [2 3 4 5])
+ (v2 [1 3 5 6 7]))
+ (should (same-contents-p (seq-difference v1 v2)
+ '(2 4))))
+ (let ((l1 '(2 3 4 5))
+ (l2 '(1 3 5 6 7)))
+ (should (same-contents-p (seq-difference l1 l2)
+ '(2 4))))
+ (let ((v1 [2 4 6])
+ (v2 [2 4 6]))
+ (should (seq-empty-p (seq-difference v1 v2)))))
+
+(ert-deftest test-seq-let ()
+ (with-test-sequences (seq '(1 2 3 4))
+ (seq-let (a b c d e) seq
+ (should (= a 1))
+ (should (= b 2))
+ (should (= c 3))
+ (should (= d 4))
+ (should (null e)))
+ (seq-let (a b &rest others) seq
+ (should (= a 1))
+ (should (= b 2))
+ (should (same-contents-p others (seq-drop seq 2)))))
+ (let ((seq '(1 (2 (3 (4))))))
+ (seq-let (_ (_ (_ (a)))) seq
+ (should (= a 4))))
+ (let (seq)
+ (seq-let (a b c) seq
+ (should (null a))
+ (should (null b))
+ (should (null c)))))
+
+(ert-deftest test-seq-min-max ()
+ (with-test-sequences (seq '(4 5 3 2 0 4))
+ (should (= (seq-min seq) 0))
+ (should (= (seq-max seq) 5))))
+
+(ert-deftest test-seq-position ()
+ (with-test-sequences (seq '(2 4 6))
+ (should (null (seq-position seq 1)))
+ (should (= (seq-position seq 4) 1)))
+ (let ((seq '(a b c)))
+ (should (null (seq-position seq 'd #'eq)))
+ (should (= (seq-position seq 'a #'eq) 0))
+ (should (null (seq-position seq (make-symbol "a") #'eq)))))
+
(provide 'seq-tests)
;;; seq-tests.el ends here
diff --git a/packages/shell-quasiquote/shell-quasiquote.el
b/packages/shell-quasiquote/shell-quasiquote.el
new file mode 100644
index 0000000..a0bf7c8
--- /dev/null
+++ b/packages/shell-quasiquote/shell-quasiquote.el
@@ -0,0 +1,123 @@
+;;; shell-quasiquote.el --- Turn s-expressions into shell command strings.
+
+;; Copyright (C) 2015 Free Software Foundation, Inc.
+
+;; Author: Taylan Ulrich Bayırlı/Kammer <address@hidden>
+;; Keywords: extensions, unix
+;; Version: 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:
+
+;; "Shell quasiquote" -- turn s-expressions into POSIX shell command strings.
+;;
+;; Shells other than POSIX sh are not supported.
+;;
+;; Quoting is automatic and safe against injection.
+;;
+;; (let ((file1 "file one")
+;; (file2 "file two"))
+;; (shqq (cp -r ,file1 ,file2 "My Files")))
+;; => "cp -r 'file one' 'file two' 'My Files'"
+;;
+;; You can splice many arguments into place with ,@foo.
+;;
+;; (let ((files (list "file one" "file two")))
+;; (shqq (cp -r ,@files "My Files")))
+;; => "cp -r 'file one' 'file two' 'My Files'"
+;;
+;; Note that the quoting disables a variety of shell expansions like ~/foo,
+;; $ENV_VAR, and e.g. {x..y} in GNU Bash.
+;;
+;; You can use ,,foo to escape the quoting.
+;;
+;; (let ((files "file1 file2"))
+;; (shqq (cp -r ,,files "My Files")))
+;; => "cp -r file1 file2 'My Files'"
+;;
+;; And ,,@foo to splice and escape quoting.
+;;
+;; (let* ((arglist '("-x 'foo bar' -y baz"))
+;; (arglist (append arglist '("-z 'qux fux'"))))
+;; (shqq (command ,,@arglist)))
+;; => "command -x 'foo bar' -y baz -z 'qux fux'"
+;;
+;; Neat, eh?
+
+
+;;; Code:
+
+(defun shqq--atom-to-string (atom)
+ (cond
+ ((symbolp atom) (symbol-name atom))
+ ((stringp atom) atom)
+ ((numberp atom) (number-to-string atom))
+ (t (error "Bad shqq atom: %S" atom))))
+
+(defun shqq--quote-atom (atom)
+ (shell-quote-argument (shqq--atom-to-string atom)))
+
+(defmacro shqq (parts)
+ "First, PARTS is turned into a list of strings. For this,
+every element of PARTS must be one of:
+
+- a symbol, evaluating to its name,
+
+- a string, evaluating to itself,
+
+- a number, evaluating to its decimal representation,
+
+- \",expr\", where EXPR must evaluate to an atom that will be
+ interpreted according to the previous rules,
+
+- \",@list-expr\", where LIST-EXPR must evaluate to a list whose
+ elements will each be interpreted like the EXPR in an \",EXPR\"
+ form, and spliced into the list of strings,
+
+- \",,expr\", where EXPR is interpreted like in \",expr\",
+
+- or \",,@expr\", where EXPR is interpreted like in \",@expr\".
+
+In the resulting list of strings, all elements except the ones
+resulting from \",,expr\" and \",,@expr\" forms are quoted for
+shell grammar.
+
+Finally, the resulting list of strings is concatenated with
+separating spaces."
+ (let ((parts
+ (mapcar
+ (lambda (part)
+ (cond
+ ((atom part) (shqq--quote-atom part))
+ ;; We use the match-comma helpers because pcase can't match ,foo.
+ (t (pcase part
+ ;; ,,foo i.e. (, (, foo))
+ (`(,`\, (,`\, ,form)) form)
+ ;; ,,@foo i.e. (, (,@ foo))
+ (`(,`\, (,`\,@ ,form)) `(mapconcat #'identity ,form " "))
+ ;; ,foo
+ (`(,`\, ,form) `(shqq--quote-atom ,form))
+ ;; ,@foo
+ (`,@,form `(mapconcat #'shqq--quote-atom ,form " "))
+ (_
+ (error "Bad shqq part: %S" part))))))
+ parts)))
+ `(mapconcat #'identity (list ,@parts) " ")))
+
+(provide 'shell-quasiquote)
+;; Local Variables:
+;; coding: utf-8
+;; End:
+;;; shell-quasiquote.el ends here
diff --git a/packages/sisu-mode/sisu-mode.el b/packages/sisu-mode/sisu-mode.el
index 9d287f1..6bfbb4b 100644
--- a/packages/sisu-mode/sisu-mode.el
+++ b/packages/sisu-mode/sisu-mode.el
@@ -1,16 +1,17 @@
;;; sisu-mode.el --- Major mode for SiSU markup text
-;; Copyright (C) 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2011, 2016 Free Software Foundation, Inc.
-;; Author: Ambrose Kofi Laing (& Ralph Amissah)
-;; Keywords: text, processes, tools
-;; Version: 3.0.3
-;; License: GPLv3
-;; Home URL: SiSU: http://www.jus.uio.no/sisu
+;; Author: Ralph Amissah & Ambrose Kofi Laing
+;; Maintainer: Ralph Amissah <address@hidden>
+;; Keywords: text, syntax, processes, tools
+;; Version: 7.1.8
+;; URL: http://www.sisudoc.org/
;; originally looked at (based on) doc-mode, with kind permission of the author
;; Author: SUN, Tong <address@hidden>, (c)2001-6, all right reserved
;; Version: $Date: 2006/01/19 03:13:41 $ $Revision: 1.14 $
;; Home URL: http://xpt.sourceforge.net/
+;; with contributions from Kevin Ryde and Stefan Monnier
;; 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
@@ -110,19 +111,19 @@
(defvar sisu-title-3 'sisu-title-3-face)
(defvar sisu-title-4 'sisu-title-4-face)
-(defvar general-font-lock-red1 font-lock-warning-face)
-(defvar general-font-lock-red2 font-lock-comment-face)
-(defvar general-font-lock-red3 font-lock-string-face)
+(defvar sisu-general-font-lock-red1 font-lock-warning-face)
+(defvar sisu-general-font-lock-red2 font-lock-comment-face)
+(defvar sisu-general-font-lock-red3 font-lock-string-face)
-(defvar general-font-lock-green1 font-lock-type-face)
-(defvar general-font-lock-green2 font-lock-constant-face)
+(defvar sisu-general-font-lock-green1 font-lock-type-face)
+(defvar sisu-general-font-lock-green2 font-lock-constant-face)
-(defvar general-font-lock-blue1 font-lock-keyword-face)
-(defvar general-font-lock-blue2 font-lock-function-name-face)
-(defvar general-font-lock-blue3 font-lock-builtin-face)
+(defvar sisu-general-font-lock-blue1 font-lock-keyword-face)
+(defvar sisu-general-font-lock-blue2 font-lock-function-name-face)
+(defvar sisu-general-font-lock-blue3 font-lock-builtin-face)
-(defvar general-font-lock-yellow1 font-lock-variable-name-face)
-(defvar general-font-lock-yellow2 font-lock-comment-face)
+(defvar sisu-general-font-lock-yellow1 font-lock-variable-name-face)
+(defvar sisu-general-font-lock-yellow2 font-lock-comment-face)
;; == sisu-mode settings
@@ -136,200 +137,313 @@
(defconst sisu-font-lock-keywords
(eval-when-compile
(list
-
- ;;grouped text
- (cons "^group\{\\|^\}group" 'general-font-lock-red2)
- (cons "^block\{\\|^\}block" 'general-font-lock-red2)
- (cons "^code\{\\|^\}code" 'general-font-lock-red2)
- (cons "^poem\{\\|^\}poem" 'general-font-lock-red2)
- (cons "^alt\{\\|^\}alt" 'general-font-lock-red2)
- (cons "^table\{.+\\|^\}table" 'general-font-lock-red2)
- (cons "^\{table[^}]+\}" 'general-font-lock-red2)
-
- ;; footnote/endnote
- ;(cons "\~\{.+?\}\~" 'general-font-lock-green1)
- (cons "\~\{\\*\\*\\|\~\{\\*\\|\~\{\\|\}\~" 'general-font-lock-red2)
- (cons "\~\\[\\+\\|\~\\[\\*\\|\~\\[\\|\\]\~" 'general-font-lock-red2)
-
- (cons "\~\\^ \\|^\\^\~ " 'general-font-lock-red2)
-
- (list (concat
- "\\(\*\~\\)"
- "\\([^ \r\t\n]+\\)")
- '(1 general-font-lock-red1 t)
- '(2 general-font-lock-blue2 t))
-
- ;; emphasis (can be program configured to be bold italics or underscore)
- (list (concat
- "\\([*]\{\\)"
- "\\([^\}]+\\)"
- "\\(\}[*]\\)")
- '(1 general-font-lock-red1 t)
- '(2 general-font-lock-red1 t)
- '(3 general-font-lock-red1 t))
-
- ;; bold
- (list (concat
- "\\([!]\{\\)"
- "\\([^\}]+\\)"
- "\\(\}[!]\\)")
- '(1 general-font-lock-red1 t)
- '(2 general-font-lock-red1 t)
- '(3 general-font-lock-red1 t))
- (cons "\\*[^ ]+\\*" 'general-font-lock-red1)
- (cons "^!_ .+" 'general-font-lock-red1)
-
- ;;; italics
- (list (concat
- "\\([/]\{\\)"
- "\\([^\}]+\\)"
- "\\(\}[/]\\)")
- '(1 general-font-lock-red1 t)
- '(2 general-font-lock-blue1 t)
- '(3 general-font-lock-red1 t))
-
- ;; underscore
- (list (concat
- "\\([_]\{\\)"
- "\\([^\}]+\\)"
- "\\(\}[_]\\)")
- '(1 general-font-lock-red1 t)
- '(2 general-font-lock-red1 t)
- '(3 general-font-lock-red1 t))
-
- ;; monospace
- (list (concat
- "\\([#]\{\\)"
- "\\([^\}]+\\)"
- "\\(\}[#]\\)")
- '(1 general-font-lock-red1 t)
- '(2 general-font-lock-red1 t)
- '(3 general-font-lock-red1 t))
-
- ;; citation
- (list (concat
- "\\([\"]\{\\)"
- "\\([^\}]+\\)"
- "\\(\}[\"]\\)")
- '(1 general-font-lock-red1 t)
- '(2 general-font-lock-red1 t)
- '(3 general-font-lock-red1 t))
-
- ;; inserted text
- (list (concat
- "\\([\+]\{\\)"
- "\\([^\}]+\\)"
- "\\(\}[\+]\\)")
- '(1 general-font-lock-red1 t)
- '(2 general-font-lock-red1 t)
- '(3 general-font-lock-red1 t))
-
- ;; strike through
- (list (concat
- "\\(\\-\{\\)"
- "\\([^\}]+\\)"
- "\\(\}\\-\\)")
- '(1 general-font-lock-red1 t)
- '(2 general-font-lock-red1 t)
- '(3 general-font-lock-red1 t))
-
- ;; superscript
- (list (concat
- "\\(\\^\{\\)"
- "\\([^\}]+\\)"
- "\\(\}\\^\\)")
- '(1 general-font-lock-red1 t)
- '(2 general-font-lock-red1 t)
- '(3 general-font-lock-red1 t))
-
- ;; subscript
- (list (concat
- "\\([,]\{\\)"
- "\\([^\}]+\\)"
- "\\(\}[,]\\)")
- '(1 general-font-lock-red1 t)
- '(2 general-font-lock-red1 t)
- '(3 general-font-lock-red1 t))
-
- ;;numbered list
- (cons "^# \\|^_# " 'general-font-lock-red1)
-
- ;;bullet text
- (cons "^_\\*[1-9] \\|^_\\* " 'general-font-lock-red1)
-
- ;;indented text
- (cons "^_[1-9] " 'general-font-lock-red1)
-
- ;;url
- (cons "\\(^\\|[ ]\\)http:[/][/][^ \t\n\r<]+" 'general-font-lock-blue2)
-
-;; \\|\$
-
- ;; Comment Lines
- (cons "^% .*" 'general-font-lock-blue1)
- ;; line break
- (cons "<br>" 'general-font-lock-red1)
-
- ;; Section titles
- (list "^\\(\\([1-8]\\|:?[A-C]\\)\\~\\)\\(.*\\)"
- '(1 sisu-title-1 t)
- '(3 sisu-title-2 t))
-
- ;; hyper-links
- (list (concat
- "\\(\{~^\\|\{\\)"
- "\\([^\}\{]+\\)"
- "\\(\}http:[/][/][^ \r\n\t<]+\\)")
- '(1 general-font-lock-blue2 t)
- '(2 general-font-lock-red1 t)
- '(3 general-font-lock-blue2 t))
-
- ;; book index
- (cons "^\=\{.+\}" 'general-font-lock-green1)
-
- ;; numbers
- (cons "\\<[.0-9]+\\>" 'general-font-lock-green2)
-
- ;; bullets sisu_normal (nearly copied regexp)
- (cons "^_\\([1-9*]\\|[1-9]\\*\\) " 'general-font-lock-blue2)
-
- ;; image links
- (list (concat
- "\\(\{\\)"
- "\\([^\}\{]+\\)"
- "\\(\}image\\)")
- '(1 general-font-lock-blue2 t)
- '(2 general-font-lock-red1 t)
- '(3 general-font-lock-blue2 t))
-
- ;; insert file links
- (list (concat
- "\\(<< \\)"
- "\\([^ \r\t\n]+\\.ss\\)"
- "\\(i\\|t\\)")
- '(1 general-font-lock-blue2 t)
- '(2 general-font-lock-blue2 t)
- '(3 general-font-lock-blue2 t))
-
- ;; raw keywords
- (list (concat
- "^\\(address@hidden("
- "title\\|"
- "creator\\|"
- "date\\|"
- "publisher\\|"
- "rights\\|"
- "classify\\|"
- "original\\|"
- "notes\\|"
- "links\\|"
- "make\\|"
- "\\):\\)\\(.*\\)")
- '(1 sisu-title-2 keep)
- '(3 sisu-title-3 keep))
-
- ))
- "Default expressions to highlight in AsciiSisu mode.")
+ ;;grouped text ---------
+ ;(cons "^```[ ]code\\(.\\|\n\\)+?\n```\n"
'sisu-general-font-lock-red2)
+ (cons "^```[ ]+code.*?$\\|^```$" 'sisu-general-font-lock-red2)
+ (cons "^```[ ]+table.*?$\\|^```$" 'sisu-general-font-lock-red2)
+ (cons "^```[ ]+group$\\|^```$" 'sisu-general-font-lock-red2)
+ (cons "^```[ ]+block$\\|^```$" 'sisu-general-font-lock-red2)
+ (cons "^```[ ]+poem$\\|^```$" 'sisu-general-font-lock-red2)
+ (cons "^```[ ]+alt$\\|^```$" 'sisu-general-font-lock-red2)
+ ;;grouped text ---------
+ (cons "^group{\\|^}group" 'sisu-general-font-lock-red2)
+ (cons "^block{\\|^}block" 'sisu-general-font-lock-red2)
+ (cons "^code{\\|^}code" 'sisu-general-font-lock-red2)
+ (cons "^poem{\\|^}poem" 'sisu-general-font-lock-red2)
+ (cons "^alt{\\|^}alt" 'sisu-general-font-lock-red2)
+ (cons "^table{.+\\|^}table" 'sisu-general-font-lock-red2)
+ (cons "^{table[^}]+}" 'sisu-general-font-lock-red2)
+
+ (list
+ (concat
+ "^\`\\{3\\}[ ]+code.*?$"
+ "\\(.\\|\n\\)+?"
+ "\`\\{3\\}$"
+ )
+ '(1 sisu-general-font-lock-red2 t)
+ '(2 nil t)
+ '(3 sisu-general-font-lock-red2 t)
+ )
+ (list
+ (concat
+ "^\`\\{3\\}[ ]+table.*?$"
+ "\\(.\\|\n\\)+?"
+ "\`\\{3\\}$"
+ )
+ '(1 sisu-general-font-lock-red2 t)
+ '(2 nil t)
+ '(3 sisu-general-font-lock-red2 t)
+ )
+ (list
+ (concat
+ "^\`\\{3\\}[ ]+\\(group\\|block\\|alt\\|poem\\)$"
+ "\\(.\\|\n\\)+?"
+ "^\`\\{3\\}$"
+ )
+ '(1 sisu-general-font-lock-red2 t)
+ '(2 nil t)
+ '(3 sisu-general-font-lock-red2 t)
+ )
+
+ ;; footnote/endnote ----
+ ;(cons "\~{.+?}\~" 'sisu-general-font-lock-green1)
+ (cons "\~{\\*\\*\\|\~{\\*\\|\~{\\|}\~" 'sisu-general-font-lock-red2)
+ (cons "\~\\[\\+\\|\~\\[\\*\\|\~\\[\\|\\]\~"
'sisu-general-font-lock-red2)
+ (cons "\~\\^ \\|^\\^\~ " 'sisu-general-font-lock-red2)
+ (list
+ (concat
+ "\\(\*\~\\)"
+ "\\([^ \r\t\n]+\\)"
+ )
+ '(1 sisu-general-font-lock-red1 t)
+ '(2 sisu-general-font-lock-blue2 t)
+ )
+
+ ;; emphasis (can be program configured to be bold italics or underscore)
+ (list
+ (concat
+ "\\([*]{\\)"
+ "\\([^}]+\\)"
+ "\\(}[*]\\)"
+ )
+ '(1 sisu-general-font-lock-red1 t)
+ '(2 sisu-general-font-lock-red1 t)
+ '(3 sisu-general-font-lock-red1 t)
+ )
+
+ ;; bold ----------------
+ (list
+ (concat
+ "\\([!]{\\)"
+ "\\([^}]+\\)"
+ "\\(}[!]\\)"
+ )
+ '(1 sisu-general-font-lock-red1 t)
+ '(2 sisu-general-font-lock-red1 t)
+ '(3 sisu-general-font-lock-red1 t)
+ )
+ (cons "\\*[^ ]+\\*" 'sisu-general-font-lock-red1)
+ (cons "^!_ .+" 'sisu-general-font-lock-red1)
+
+ ;; italics -------------
+ (list
+ (concat
+ "\\([/]{\\)"
+ "\\([^}]+\\)"
+ "\\(}[/]\\)"
+ )
+ '(1 sisu-general-font-lock-red1 t)
+ '(2 sisu-general-font-lock-blue1 t)
+ '(3 sisu-general-font-lock-red1 t)
+ )
+
+ ;; underscore ----------
+ (list
+ (concat
+ "\\([_]{\\)"
+ "\\([^}]+\\)"
+ "\\(\}[_]\\)"
+ )
+ '(1 sisu-general-font-lock-red1 t)
+ '(2 sisu-general-font-lock-red1 t)
+ '(3 sisu-general-font-lock-red1 t)
+ )
+
+ ;; monospace -----------
+ (list
+ (concat
+ "\\([#]{\\)"
+ "\\([^}]+\\)"
+ "\\(}[#]\\)"
+ )
+ '(1 sisu-general-font-lock-red1 t)
+ '(2 sisu-general-font-lock-red1 t)
+ '(3 sisu-general-font-lock-red1 t)
+ )
+
+ ;; citation ------------
+ (list
+ (concat
+ "\\([\"]{\\)"
+ "\\([^}]+\\)"
+ "\\(}[\"]\\)"
+ )
+ '(1 sisu-general-font-lock-red1 t)
+ '(2 sisu-general-font-lock-red1 t)
+ '(3 sisu-general-font-lock-red1 t)
+ )
+
+ ;; inserted text -------
+ (list
+ (concat
+ "\\([\+]{\\)"
+ "\\([^}]+\\)"
+ "\\(}[\+]\\)"
+ )
+ '(1 sisu-general-font-lock-red1 t)
+ '(2 sisu-general-font-lock-red1 t)
+ '(3 sisu-general-font-lock-red1 t)
+ )
+
+ ;; strike through ------
+ (list
+ (concat
+ "\\(\\-{\\)"
+ "\\([^}]+\\)"
+ "\\(}\\-\\)"
+ )
+ '(1 sisu-general-font-lock-red1 t)
+ '(2 sisu-general-font-lock-red1 t)
+ '(3 sisu-general-font-lock-red1 t)
+ )
+
+ ;; superscript ---------
+ (list
+ (concat
+ "\\(\\^{\\)"
+ "\\([^}]+\\)"
+ "\\(}\\^\\)"
+ )
+ '(1 sisu-general-font-lock-red1 t)
+ '(2 sisu-general-font-lock-red1 t)
+ '(3 sisu-general-font-lock-red1 t)
+ )
+
+ ;; subscript -----------
+ (list
+ (concat
+ "\\([,]{\\)"
+ "\\([^}]+\\)"
+ "\\(}[,]\\)"
+ )
+ '(1 sisu-general-font-lock-red1 t)
+ '(2 sisu-general-font-lock-red1 t)
+ '(3 sisu-general-font-lock-red1 t)
+ )
+
+ ;; numbered list
+ (cons "^# \\|^_# " 'sisu-general-font-lock-red1)
+
+ ;; bullet text
+ (cons "^_\\*[1-9] \\|^_\\* " 'sisu-general-font-lock-red1)
+
+ ;; indented text
+ (cons "^_[1-9] " 'sisu-general-font-lock-red1)
+ (cons "^_[1-9]! " 'sisu-general-font-lock-red1)
+
+ ;; hanging indented text [proposed enable when implemented]
+ (cons "^__[1-9] " 'sisu-general-font-lock-red1)
+ (cons "^_[0-9]_[0-9] " 'sisu-general-font-lock-red1)
+ (cons "^__[1-9]! " 'sisu-general-font-lock-red1)
+ (cons "^_[0-9]_[0-9]! " 'sisu-general-font-lock-red1)
+
+ ;; url
+ (cons "\\(^\\|[ ]\\)http:[/][/][^ \t\n\r<]+"
'sisu-general-font-lock-blue2)
+
+ ;; Comment Lines
+ (cons "^% .*" 'sisu-general-font-lock-blue1)
+
+ ;; page break
+ (cons "^\\(-\\\\\\\\-\\|=\\\\\\\\=\\|-\\.\\.-\\)"
'sisu-general-font-lock-red2)
+
+ ;; line break
+ (cons " \\\\\\\\ " 'sisu-general-font-lock-red1)
+
+ ;; line break (depreciated)
+ (cons "<br>" 'sisu-general-font-lock-red1)
+
+ ;; Section titles
+ (list "^\\(\\([1-4]\\|:?[A-D]\\)\\~\\)\\(.*\\)"
+ '(1 sisu-title-1 t)
+ '(3 sisu-title-2 t)
+ )
+
+ ;; hyper-links
+ (list
+ (concat
+ "\\({~^\\|{\\)"
+ "\\([^}{]+\\)"
+ "\\(}http:[/][/][^ \r\n\t<]+\\)"
+ )
+ '(1 sisu-general-font-lock-blue2 t)
+ '(2 sisu-general-font-lock-red1 t)
+ '(3 sisu-general-font-lock-blue2 t)
+ )
+
+ ;; book index
+ (list
+ (concat
+ "^\\(\={\\)"
+ "\\([^}{]+\\)"
+ "\\(}\\)$"
+ )
+ '(1 sisu-general-font-lock-green1 t)
+ '(2 nil t)
+ '(3 sisu-general-font-lock-green1 t)
+ )
+
+ ;(cons "^\={.+}" 'sisu-general-font-lock-green1)
+
+ ;; numbers
+ (cons "\\<[.0-9]+\\>" 'sisu-general-font-lock-green2)
+
+ ;; bullets sisu_normal (nearly copied regexp)
+ (cons "^_\\([1-9*]\\|[1-9]\\*\\) " 'sisu-general-font-lock-blue2)
+
+ ;; image links
+ (list
+ (concat
+ "\\({\\)"
+ "\\([^}{]+\\)"
+ "\\(}image\\)"
+ )
+ '(1 sisu-general-font-lock-blue2 t)
+ '(2 sisu-general-font-lock-red1 t)
+ '(3 sisu-general-font-lock-blue2 t)
+ )
+
+ ;; insert file links
+ (list
+ (concat
+ "\\(<< \\)"
+ "\\([^ \r\t\n]+\\.ss\\)"
+ "\\(i\\|t\\)"
+ )
+ '(1 sisu-general-font-lock-blue2 t)
+ '(2 sisu-general-font-lock-blue2 t)
+ '(3 sisu-general-font-lock-blue2 t)
+ )
+
+ ;; raw keywords
+ (list
+ (concat
+ "^\\(address@hidden("
+ "creator\\|"
+ "title\\|"
+ "date\\|"
+ "rights\\|"
+ "publisher\\|"
+ "classify\\|"
+ "identifier\\|"
+ "original\\|"
+ "notes\\|"
+ "links\\|"
+ "make\\|"
+ "\\):\\)\\(.*\\)"
+ )
+ '(1 sisu-title-2 keep)
+ '(3 sisu-title-3 keep)
+ )
+ )
+ )
+ "Default expressions to highlight in AsciiSisu mode."
+)
+
+;; outline mode evil "folding" if available
+;; (define-key evil-normal-state-map ",0" 'show-all)
+;; (define-key evil-normal-state-map ",-" 'hide-body)
+;; (define-key evil-normal-state-map ",+" 'show-subtree)
+;; (define-key evil-normal-state-map ",=" 'show-subtree)
;;}}}
@@ -338,10 +452,10 @@
;;;###autoload
(define-derived-mode sisu-mode text-mode "SiSU"
"Major mode for editing SiSU files.
-SiSU (http://www.sisudoc.org/) is a document structuring and
-publishing framework. This major mode handles SiSU markup."
+SiSU document structuring, publishing in multiple formats and search.
+URL `http://www.sisudoc.org/'"
(modify-syntax-entry ?\' ".")
- ;(flyspell-mode nil)
+ ;;(flyspell-mode nil)
(make-local-variable 'paragraph-start)
(setq paragraph-start (concat "$\\|>" page-delimiter))
@@ -350,19 +464,25 @@ publishing framework. This major mode handles SiSU
markup."
(make-local-variable 'paragraph-ignore-fill-prefix)
(setq paragraph-ignore-fill-prefix t)
+ (set (make-local-variable 'outline-regexp)
+ "^\\(\\([1-4]\\|:?[A-D]\\)\\~\\|address@hidden:\\( \\|$\\)\\)")
+
(make-local-variable 'require-final-newline)
(setq require-final-newline t)
(make-local-variable 'font-lock-defaults)
(setq font-lock-defaults
- '(sisu-font-lock-keywords
- nil ; KEYWORDS-ONLY: no
- nil ; CASE-FOLD: no
- ((?_ . "w")) ; SYNTAX-ALIST
- ))
- (run-hooks 'sisu-mode-hook))
-
-;;;###autoload (add-to-list 'auto-mode-alist '("\\.sisu\\'" . sisu-mode))
+ '(sisu-font-lock-keywords
+ nil ; KEYWORDS-ONLY: no
+ nil ; CASE-FOLD: no
+ ((?_ . "w")) ; SYNTAX-ALIST
+ ))
+ ;; Enable outlining.
+ ;; TODO with outlining make sure linum (line numbering) is off,
+ ;; else performance penalty, sucks bigtime
+ (outline-minor-mode 1))
+
+;;;###autoload (add-to-list 'auto-mode-alist '("\\.ss[imt]\\'" . sisu-mode))
(provide 'sisu-mode)
diff --git a/packages/sm-c-mode/GNUmakefile b/packages/sm-c-mode/GNUmakefile
new file mode 100644
index 0000000..c9d648a
--- /dev/null
+++ b/packages/sm-c-mode/GNUmakefile
@@ -0,0 +1,28 @@
+
+EMACS=emacs
+DIFF=diff
+HIJACK=--eval "(defalias 'c-mode 'sm-c-mode)"
+
+test: sm-c-mode-test.c.test
+
+.PHONY: refresh
+refresh:
+
+%.elc : %.el
+ $(EMACS) --batch -L . --no-init-file -f batch-byte-compile $<
+
+%.test: % sm-c-mode.elc refresh
+ $(EMACS) --batch -l sm-c-mode-autoloads.el \
+ $< \
+ --eval '(setq indent-tabs-mode nil)' \
+ --eval '(setq create-lockfiles nil)' \
+ --eval '(indent-region (point-min) (point-max) nil)' \
+ --eval '(indent-region (point-min) (point-max) nil)' \
+ --eval '(write-region (point-min) (point-max) "$@")'
+ $(DIFF) $< $@ || true; $(RM) $@
+
+%.reindent: % sm-c-mode.elc refresh
+ $(EMACS) --batch -l sm-c-mode-autoloads.el $(HIJACK) \
+ $< \
+ --eval '(indent-region (point-min) (point-max) nil)' \
+ --eval '(save-buffer)'
diff --git a/packages/sm-c-mode/sm-c-mode-test.c
b/packages/sm-c-mode/sm-c-mode-test.c
new file mode 100644
index 0000000..4756064
--- /dev/null
+++ b/packages/sm-c-mode/sm-c-mode-test.c
@@ -0,0 +1,97 @@
+/* -*- sm-c -*- */
+
+#include <toto>
+
+#define toto(arg) /* bla
+ bla */ \
+ if (a) { /* toto
+ * titi
+ */ \
+ fs((arg) + 2); \
+ }
+
+#define test(arg) \
+ (hello + arg)
+
+struct foo
+ {
+ int field;
+ };
+
+struct foo {
+ int field;
+};
+
+typedef struct bar {
+ int field;
+} *BarPtr;
+
+struct foo *getfoo (void)
+{
+ return NULL;
+}
+
+#define titi(arg) { \
+ if (a) { \
+ f(arg + 1) \
+ } \
+ }
+
+DEFUN ()
+ ()
+{
+ return Qnil;
+}
+
+int main (void)
+{
+ if (a)
+ do
+ if (b)
+ if (c)
+ printf ("hello\n");
+ else
+ printf ("there\n");
+ else
+ printf ("elsewhere\n");
+ while (6);
+ else if (b)
+ printf ("wow\n");
+ else
+ if (c)
+ printf
+ ("weee\n");
+ else
+ printf ("wop\n");
+
+ if (a)
+ if (b) {
+ c;
+ }
+
+ *a = b;
+
+ if (pITORIG != pITCOPY)
+ *(pITORIG)
+ = *(pITCOPY);
+
+ switch (a)
+ {
+ case 1:
+ {
+ if (a)
+ {
+ y = 5;
+ case 2:
+ x = 3;
+ }
+ }
+ }
+}
+
+static struct myownspecialstruct *
+testfunction
+ (args)
+{
+ return NULL;
+}
diff --git a/packages/sm-c-mode/sm-c-mode.el b/packages/sm-c-mode/sm-c-mode.el
new file mode 100644
index 0000000..54b9a54
--- /dev/null
+++ b/packages/sm-c-mode/sm-c-mode.el
@@ -0,0 +1,917 @@
+;;; sm-c-mode.el --- Experimental C major mode based on SMIE -*-
lexical-binding: t; -*-
+
+;; Copyright (C) 2015 Free Software Foundation, Inc.
+
+;; Author: Stefan Monnier <address@hidden>
+;; Version: 0
+;; 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:
+
+;; ¡¡Don't use this!!
+;;
+;; This is an experiment to see concretely where&how SMIE falls down when
+;; trying to handle a language like C.
+;; So, strictly speaking, this does provide "SMIE-based indentation for C" and
+;; might even do it OK for simple cases, but it really doesn't benefit much
+;; from SMIE:
+;; - it does a lot of its own parsing by hand.
+;; - its smie-rules-function also does a lot of indentation by hand.
+;; Hopefully at some point, someone will find a way to extend SMIE such that
+;; it can handle C without having to constantly work around SMIE, e.g.
+;; it'd be nice to hook sm-c--while-to-do, sm-c--else-to-if, sm-c--boi,
+;; sm-c--boe, ... into SMIE at some level.
+
+;; Note that this mode makes no attempt to try and handle sanely K&R style
+;; function definitions.
+
+;;;; Benchmarks
+
+;; This code can't be compared to CC-mode since its scope is much more limited
+;; (only tries to handle the kind of code found in Emacs's source code, for
+;; example; does not intend to be extensible to handle C++ or ObjC; does not
+;; offer the same kind of customizability of indentation style, ...).
+;; But in order to make sure it's doing a good enough job on the code for which
+;; it was tuned, I did run some quick benchmarks against CC-mode:
+;;
+;; Benchmarks: reindent emacs/src/*.[ch] (skipping macuvs.h and globals.h
+;; because CC-mode gets pathologically slow on them).
+;; (cd src/emacs/work/; git reset --hard; mv src/macuvs.h src/globals.h ./);
+;; files=($(echo ~/src/emacs/work/src/*.[ch]));
+;; (cd src/emacs/work/; mv macuvs.h globals.h src/);
+;; time make -j4 ${^${files}}.reindent EMACS="emacs24 -Q";
+;; (cd src/emacs/work/; git diff|wc)
+;; - Default settings:
+;; diff|wc => 86800 379362 2879534
+;; make -j4 191.57s user 1.77s system 334% cpu 57.78 total
+;; - With (setq sm-c-indent-cpp-basic 0)
+;; diff|wc => 59909 275415 2034045
+;; make -j4 177.88s user 1.70s system 340% cpu 52.80 total
+;; - For reference, CC-mode gets:
+;; diff|wc => 79164 490894 3428542
+;; make -j4 804.83s user 2.79s system 277% cpu 4:51.08 total
+;;
+;; Again: take this with a large grain of salt, since this is testing sm-c-mode
+;; in the most favorable light (IOW it's a very strongly biased benchmark).
+;; All this says, is that sm-c-mode's indentation might actually be usable if
+;; you use it on C code that is sufficiently similar to Emacs's.
+
+;;;; FIXME:
+
+;; - We "use but don't use" SMIE.
+;; - CPP directives are treated as comments. To some extent this is OK, but in
+;; many other cases it isn't. See for instance the comment-only-p advice.
+;; - M-q in a comment doesn't do the right thing.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'smie)
+
+(defgroup sm-c-mode nil
+ "Major mode to edit C code, based on SMIE."
+ :group 'programming)
+
+(defcustom sm-c-indent-basic 2
+ "Basic step of indentation.
+Typically 2 for GNU style and `tab-width' for Linux style."
+ :type 'integer)
+
+(defcustom sm-c-indent-braces t
+ "If nil, braces in if/while/... are aligned with the if/while/...
+Else, they're indented by `sm-c-indent-basic' columns.
+For braces placed at the end of lines (which SMIE calls \"hanging\"), it makes
+no difference."
+ :type 'boolean)
+
+;;; Handling CPP directives.
+
+(defsubst sm-c--cpp-inside-p (ppss)
+ (eq 2 (nth 7 ppss)))
+
+(eval-and-compile
+ (defconst sm-c--cpp-regexp "^[ \t]*\\(\\(#\\)[ \t]*\\([a-z]+\\)\\)"))
+
+(defconst sm-c--cpp-syntax-table
+ (let ((st (make-syntax-table)))
+ (modify-syntax-entry ?/ ". 124" st)
+ (modify-syntax-entry ?* ". 23b" st)
+ (modify-syntax-entry ?\n ">" st)
+ st))
+
+(defun sm-c--cpp-goto-end (ppss &optional limit)
+ (cl-assert (sm-c--cpp-inside-p ppss))
+ (let (found)
+ (while
+ (and (setq found (re-search-forward "\\(?:\\\\\\\\\\)*\n" limit 'move))
+ ;; We could also check (nth 5 ppss) to figure out if we're
+ ;; after a backslash, but this is a very common case, so it's good
+ ;; to avoid calling parse-partial-sexp for that.
+ (or (eq ?\\ (char-before (match-beginning 0)))
+ (with-syntax-table sm-c--cpp-syntax-table
+ (nth 4 (parse-partial-sexp (1+ (nth 8 ppss)) (point)))))))
+ found))
+
+(defun sm-c--cpp-fontify-syntactically (ppss)
+ ;; FIXME: ¡¡BIG UGLY HACK!!
+ ;; Copied from font-lock.el's font-lock-fontify-syntactically-region.
+ (cl-assert (> (point) (nth 8 ppss)))
+ (save-excursion
+ (save-restriction
+ (sm-c--cpp-goto-end ppss)
+ (narrow-to-region (1+ (nth 8 ppss)) (point))
+ ;; FIXME: We should add some "with-local-syntax-ppss" macro to
+ ;; encapsulate this.
+ (let ((syntax-propertize-function nil)
+ (syntax-ppss-cache nil)
+ (syntax-ppss-last nil))
+ (font-lock-fontify-syntactically-region (point-min) (point-max))))))
+
+(defun sm-c--cpp-syntax-propertize (end)
+ (let ((ppss (syntax-ppss))
+ found)
+ (when (sm-c--cpp-inside-p ppss)
+ (while
+ (and (setq found (re-search-forward "\\(\\\\\\\\\\)*\n" end 'move))
+ (or (eq ?\\ (char-before (match-beginning 0)))
+ (with-syntax-table sm-c--cpp-syntax-table
+ (nth 4 (parse-partial-sexp (1+ (nth 8 ppss)) (point)))))))
+ (when found
+ (put-text-property (1- (point)) (point)
+ 'syntax-table (string-to-syntax "> c"))))))
+
+;;;; Indenting CPP directives.
+
+(defcustom sm-c-indent-cpp-basic 1
+ "Indent step for CPP directives.
+If non-zero, CPP directives are indented according to CPP depth.
+E.g. a #define nested within 2 #ifs will be turned into \"# define\"."
+ :type 'integer)
+
+(defun sm-c--cpp-prev (tok)
+ (let ((offset nil))
+ (while
+ (when (re-search-backward sm-c--cpp-regexp nil t)
+ (pcase (cons tok (match-string 3))
+ (`(,_ . "endif") (sm-c--cpp-prev "endif"))
+ ((or `(,(or "endif" "else" "elif") . ,(or "if" "ifdef" "ifndef"))
+ `(,(or "else" "elif") . "elif"))
+ (setq offset 0))
+ (`(,(or "endif" "else" "elif") . ,_) nil)
+ (`(,_ . ,(or "if" "ifdef" "ifndef" "elif" "else"))
+ (setq offset sm-c-indent-cpp-basic))
+ (_ (setq offset 0)))
+ (not offset)))
+ (when offset
+ (goto-char (match-beginning 3))
+ (+ offset (current-column)))))
+
+
+(defun sm-c--cpp-indent-line (&optional _arg)
+ ;; FIXME: Also align the terminating \, if any.
+ (when (> sm-c-indent-cpp-basic 0)
+ (let* ((pos (point-marker))
+ (beg)
+ (indent
+ (save-excursion
+ (forward-line 0)
+ (when (looking-at sm-c--cpp-regexp)
+ (setq beg (match-beginning 3))
+ (or (sm-c--cpp-prev (match-string 3)) 0)))))
+ (when indent
+ (let ((before (<= pos beg)))
+ (goto-char beg)
+ (unless (= (current-column) indent)
+ (skip-chars-backward " \t")
+ (delete-region (point)
+ (progn (skip-chars-forward " \t") (point)))
+ (indent-to indent))
+ (unless before (goto-char pos)))))))
+
+;;;; Indenting inside CPP #define.
+
+(defconst sm-c--cpp-smie-indent-functions
+ ;; FIXME: Don't just align line after #define with the "d"!
+ (mapcar
+ (lambda (f)
+ (cond
+ ((eq f #'smie-indent-comment-inside) #'sm-c--cpp-indent-comment-inside)
+ ;; ((eq f #'smie-indent-exps) #'sm-c--cpp-indent-exps)
+ (t f)))
+ (default-value 'smie-indent-functions)))
+
+(defun sm-c--cpp-indent-comment-inside ()
+ (let ((ppss (syntax-ppss)))
+ (when (nth 4 ppss)
+ ;; Indicate where's the comment start.
+ `(noindent . ,(nth 8 ppss)))))
+
+(defun sm-c--cpp-smie-indent ()
+ (let ((ppss (syntax-ppss)))
+ (cond
+ ((sm-c--cpp-inside-p ppss)
+ (save-restriction
+ (narrow-to-region (nth 8 ppss) (point-max))
+ (let ((indent
+ (let ((smie-indent-functions sm-c--cpp-smie-indent-functions)
+ (syntax-ppss-cache nil)
+ (syntax-ppss-last nil)
+ (parse-sexp-lookup-properties nil))
+ (smie-indent-calculate))))
+ (if (not (eq 'noindent (car-safe indent)))
+ (if (integerp indent)
+ (max (funcall smie-rules-function :elem 'basic) indent)
+ indent)
+ ;; We can't just return `noindent' if we're inside a comment,
+ ;; because the indent.el code would then be similarly confused,
+ ;; thinking the `noindent' is because we're inside the cpp
+ ;; pseudo-comment, and would hence align the code with the content
+ ;; of the psuedo-comment rather than the nested real comment!
+ ;;
+ ;; FIXME: Copy&paste from indent--default-inside-comment.
+ ;; FIXME: This will always re-indent inside these comments, even
+ ;; during indent-region.
+ (save-excursion
+ (forward-line -1)
+ (skip-chars-forward " \t")
+ (when (< (1- (point)) (cdr indent) (line-end-position))
+ (goto-char (cdr indent))
+ (when (looking-at comment-start-skip)
+ (goto-char (match-end 0))))
+ (current-column))))))
+
+ ((equal (syntax-after (point)) (string-to-syntax "< c")) 0)
+ )))
+
+;;; Syntax table
+
+(defvar sm-c-mode-syntax-table
+ (let ((st (make-syntax-table)))
+ (modify-syntax-entry ?/ ". 124" st)
+ (modify-syntax-entry ?* ". 23b" st)
+ (modify-syntax-entry ?\n ">" st)
+ (modify-syntax-entry ?\" "\"" st)
+ (modify-syntax-entry ?\' "\"" st)
+ (modify-syntax-entry ?= "." st)
+ (modify-syntax-entry ?< "." st)
+ (modify-syntax-entry ?> "." st)
+ st))
+
+(defun sm-c-syntax-propertize (start end)
+ (goto-char start)
+ (sm-c--cpp-syntax-propertize end)
+ (funcall
+ (syntax-propertize-rules
+ (sm-c--cpp-regexp
+ (2 (prog1 "< c"
+ (when (and (equal (match-string 3) "include")
+ (looking-at "[ \t]*\\(<\\)[^>\n]*\\(>\\)"))
+ (put-text-property (match-beginning 1) (match-end 1)
+ 'syntax-table (string-to-syntax "|"))
+ (put-text-property (match-beginning 2) (match-end 2)
+ 'syntax-table (string-to-syntax "|")))
+ (sm-c--cpp-syntax-propertize end)))))
+ (point) end))
+
+(defun sm-c-syntactic-face-function (ppss)
+ (if (sm-c--cpp-inside-p ppss)
+ (prog1 nil (sm-c--cpp-fontify-syntactically ppss))
+ (funcall (default-value 'font-lock-syntactic-face-function) ppss)))
+
+;;; SMIE support
+
+(defconst sm-c-paren-block-keywords '("if" "while" "for" "switch"))
+
+(defconst sm-c-smie-precedence-table
+ '((assoc ";")
+ ;; Compiled from https://en.wikipedia.org/wiki/Operators_in_C_and_C++.
+ (assoc ",") ;1
+ ;; (nonassoc "throw")
+ (nonassoc "=" "+=" "-=" "*=" "/=" "%=" "<<=" ">>=" "&=" "^=" "|=") ;2
+ ;; (nonassoc "?" ":") ;; Better handle it in the BNF.
+ (assoc "||") ;3
+ (assoc "&&") ;4
+ (assoc "|") ;5
+ (assoc "^") ;6
+ ;; (assoc "&") ;; Binary and. Confused with address-of.
+ (nonassoc "==" "!=") ;7
+ (nonassoc "<" "<=" ">" ">=") ;8
+ (nonassoc "<<" ">>") ;9
+ (assoc "+" "-") ;10
+ (assoc "/" "* mult" "%") ;11
+ ;; (nonassoc ".*" "->*") ;12 ;; Only C++
+ ;; (nonassoc "++" "--" "+" "-" "!" "~" "(type)" "*" "&"
+ ;; "sizeof" "new" "delete");13 ;; All prefix.
+ (left "." "->") ;; "++" "--" suffixes, "()", "[]", "typeid", "*_cast". ;14
+ ;; (noassoc "::") ;; Only C++
+ ))
+
+(defconst sm-c-smie-grammar
+ ;; `((:smie-closer-alist ("{" . "}")) ("{" (39) 0) ("}" 0 (40)) ("else" 27
26) ("," 38 38) ("do" (41) 22) ("while" (42) 23) ("for" (43) 24) (";" 11 11)
("if" (44) 25))
+ (let ((grm
+ (smie-prec2->grammar
+ (smie-merge-prec2s
+ (smie-bnf->prec2
+ '((decls ("typedef" decl) ("extern" decl)
+ (decls ";" decls))
+ (decl)
+ (id)
+ (insts ("{" insts "}")
+ (insts ";" insts)
+ ("return" exp)
+ ("goto" exp)
+ (":label")
+ ("case" subexp ": case")
+ ("else" exp-if))
+ (exp-if ("if" exp) ("do" exp) ("while" exp) ("switch" exp)
("for" exp)
+ (exp))
+ (exp ("(" exp ")") (exp "," exp) (subexp "?" exp ":" exp))
+ (subexp (subexp "||" subexp))
+ ;; Some of the precedence table deals with pre/postfixes, which
+ ;; smie-precs->prec2 can't handle, so handle it here instead.
+ (exp11 (exp12) (exp11 "/" exp11))
+ (exp12 (exp13)) ;C++ only.
+ (exp13 (exp14) ("++ prefix" exp13) ("-- prefix" exp13)
+ ("!" exp13) ("~" exp13) ("&" exp13) ("* deref" exp13))
+ (exp14 (id) (exp14 "++ postfix") (exp14 "-- postfix")
+ (exp14 "->" id) (exp14 "." id)))
+ '((assoc ";") (assoc ",") (nonassoc "?" ":"))
+ sm-c-smie-precedence-table)
+ (smie-precs->prec2 sm-c-smie-precedence-table)
+ (smie-precs->prec2 '((nonassoc ";") (nonassoc ":")))))))
+ ;; SMIE gives (":label" 261 262), but really this could just as well be
+ ;; (":label" nil nil) because labels don't have any argument to their left
+ ;; or right. They're like both openers and closers at the same time.
+ (mapcar (lambda (x)
+ (if (equal (car-safe x) ":label")
+ ;; Rather than (":label" (n1) (n2)) we use
+ ;; (":label" (n1) n2) because SMIE otherwise complains:
+ ;; cl--assertion-failed((numberp (funcall op-forw
toklevels)))
+ ;; in smie-next-sexp.
+ `(,(nth 0 x) (,(nth 1 x)) ,(nth 2 x)) x))
+ grm)))
+
+;; (defun sm-c--:-discriminate ()
+;; (save-excursion
+;; (and (null (smie-backward-sexp))
+;; (let ((prev (smie-indent-backward-token)))
+;; (cond
+;; ((equal prev "case" ) ": case")
+;; ((member prev '(";" "{" "}")) ":-label")
+;; (t ":"))))))
+
+(defconst sm-c-smie-operator-regexp
+ (let ((ops '()))
+ (pcase-dolist (`(,token . ,_) sm-c-smie-grammar)
+ (when (and (stringp token) (string-match "\\`[^ [:alnum:](){}]+" token))
+ (push (match-string 0 token) ops)))
+ (regexp-opt ops)))
+
+(defun sm-c-smie-forward-token ()
+ (forward-comment (point-max))
+ (let ((tok (if (looking-at sm-c-smie-operator-regexp)
+ (progn (goto-char (match-end 0)) (match-string 0))
+ (smie-default-forward-token))))
+ (cond
+ ((and (equal tok "") (looking-at "\\\\\n"))
+ (goto-char (match-end 0))
+ (sm-c-smie-forward-token))
+ ((member tok '(":" "*"))
+ (save-excursion (sm-c-smie-backward-token)))
+ ((looking-at "[ \t]*:")
+ (if (not (equal (save-excursion (sm-c-smie-forward-token)) ":label"))
+ tok
+ (looking-at "[ \t]*:")
+ (goto-char (match-end 0)) ":label"))
+ (t tok))))
+
+
+(defun sm-c-smie-backward-token ()
+ (forward-comment (- (point)))
+ (let ((tok (if (looking-back sm-c-smie-operator-regexp (- (point) 3) t)
+ (progn (goto-char (match-beginning 0)) (match-string 0))
+ (smie-default-backward-token))))
+ (cond
+ ((and (equal tok "") (looking-at "\n"))
+ (let ((pos (point)))
+ (if (not (= 0 (mod (skip-chars-backward "\\\\") 2)))
+ (sm-c-smie-backward-token)
+ (goto-char pos)
+ tok)))
+ ((equal tok "*") (sm-c-smie--*-token))
+ ((equal tok ":")
+ (let ((pos1 (point))
+ (prev (sm-c-smie-backward-token)))
+ (if (zerop (length prev))
+ (progn (goto-char pos1) tok)
+ (let ((pos2 (point)))
+ (pcase (car (smie-indent-backward-token))
+ ("case" (goto-char pos1) ": case")
+ ((or ";" "{" "}") (goto-char pos2) ":label")
+ (_ (goto-char pos1) tok))))))
+ (t tok))))
+
+(defun sm-c--prev-token ()
+ (car (smie-indent-backward-token)))
+
+(defun sm-c--else-to-if ()
+ (let ((pos (point)))
+ (unless (equal (sm-c--prev-token) ";")
+ (goto-char pos))
+ (while
+ (pcase (smie-backward-sexp)
+ (`(,_ ,pos "if") (goto-char pos) nil) ;Found it!
+ (`(,_ ,_ ";") nil) ;Can't find it!
+ (`(,_ ,pos "else") (goto-char pos) (sm-c--else-to-if) t)
+ (`(,_ ,pos "while")
+ (goto-char pos) (unless (sm-c--while-to-do) (goto-char pos)) t)
+ (`(t . ,_) nil) ;Can't find it!
+ (`(,_ ,pos . ,_) (goto-char pos) t)
+ (`nil t)))))
+
+(defun sm-c--while-to-do ()
+ "Jump to the matching `do' and return non-nil, if any. Return nil
otherwise."
+ (pcase (sm-c--prev-token)
+ ("}"
+ ;; The easy case!
+ (forward-char 1) (backward-sexp 1)
+ (equal (sm-c--prev-token) "do"))
+ (";"
+ (let ((found-do nil))
+ (while
+ (pcase (smie-backward-sexp)
+ (`(,_ ,pos "do") (goto-char pos) (setq found-do t) nil)
+ (`(,_ ,_ ";") nil) ;Can't find it!
+ (`(,_ ,pos "else") (goto-char pos) (sm-c--else-to-if) t)
+ (`(,_ ,pos "while")
+ (goto-char pos) (unless (sm-c--while-to-do) (goto-char pos)) t)
+ (`(t . ,_) nil) ;Can't find it!
+ (`(,_ ,pos . ,_) (goto-char pos) t)
+ (`nil (or (not (looking-at "{"))
+ (smie-rule-prev-p "=")))))
+ found-do))))
+
+(defun sm-c--skip-labels (max)
+ (while
+ (let ((start (point)))
+ (pcase (sm-c-smie-forward-token)
+ ("case"
+ (smie-forward-sexp "case")
+ (forward-comment (point-max))
+ (if (>= (point) max) (progn (goto-char start) nil)
+ t))
+ (":label"
+ (forward-comment (point-max))
+ (if (>= (point) max) (progn (goto-char start) nil)
+ t))
+ (_ (goto-char start) nil)))))
+
+(defun sm-c--boi (&optional inner)
+ "Jump to the beginning-of-instruction.
+By default for things like nested ifs, it jumps to the outer if, but
+if INNER is non-nil, it stops at the innermost one."
+ (while
+ (let ((pos (point)))
+ (pcase (smie-backward-sexp)
+ (`(,_ ,_ ";") nil) ;Found it!
+ (`(,_ ,pos "else") (goto-char pos) (sm-c--else-to-if) t)
+ (`(,_ ,pos "while")
+ (goto-char pos) (unless (sm-c--while-to-do) (goto-char pos)) t)
+ (`(,(pred numberp) ,pos . ,_) (goto-char pos) t)
+ ((or `nil `(nil . ,_))
+ (if (and (or (not (looking-at "{"))
+ (smie-rule-prev-p "="))
+ (not (bobp)))
+ t
+ (goto-char pos) nil))
+ (`(,_ ,_ ,(or "(" "{" "[")) nil) ;Found it!
+ (`(,_ ,pos ,(and tok
+ (guard (when inner
+ (or (member tok sm-c-paren-block-keywords)
+ (equal tok "do"))))))
+ (goto-char pos) nil) ;Found it!
+ (`(t ,(pred (eq (point-min))) . ,_) nil)
+ (`(,_ ,pos . ,_) (goto-char pos) t)))))
+
+;; (defun sm-c--if-tail-to-head ()
+;; (pcase (sm-c--prev-token)
+;; (")"
+;; (forward-char 1) (backward-sexp 1)
+;; (pcase (sm-c--prev-token)
+;; ("if" nil)
+;; ((or "while" "for") (sm-c--if-tail-to-head))))
+;; ("do" (sm-c--if-tail-to-head))))
+
+(defun sm-c--boe (tok)
+ (let ((start (point))
+ (res (smie-backward-sexp tok)))
+ (when (member (nth 2 res) '("if" "while" "do" "for" "else"))
+ (when (member (nth 2 res) '("if" "for"))
+ (let ((forward-sexp-function nil))
+ (forward-sexp 1))
+ (forward-comment (point-max)))
+ (when (looking-at "{")
+ (let ((forward-sexp-function nil))
+ (forward-sexp 1))
+ (forward-comment (point-max)))
+ (if (> (point) start) (goto-char start)))))
+
+(defun sm-c-smie--*-token ()
+ (save-excursion
+ (let ((pos (point)))
+ (pcase (car (smie-indent-backward-token))
+ (")"
+ ;; Can be a multiplication (as in "(a+b)*c"), or a deref
+ ;; (as in "if (stop) *a = 0;")
+ (if (and (goto-char (nth 1 (syntax-ppss)))
+ (eq ?\( (char-after))
+ (member (smie-default-backward-token) '("if" "for")))
+ "* deref"
+ "* mult"))
+ ("]" "* mult") ;Multiplication.
+ ((or "(" "[" "{" "}") "* deref")
+ (`nil
+ (goto-char pos)
+ (let ((res nil))
+ (while (not (or res (bobp)))
+ (pcase (smie-backward-sexp)
+ (`(,_ ,_ ,(or ";" "{")) (setq res "* deref"))
+ ((and `nil (guard (looking-at "{"))) (setq res "* deref"))
+ (`(,left ,_ ,op)
+ (if (and (numberp left)
+ (numberp (nth 2 (assoc op smie-grammar)))
+ (< (nth 2 (assoc op smie-grammar))
+ (nth 1 (assoc "* mult" smie-grammar))))
+ (smie-backward-sexp 'halfsexp)
+ (setq res "* mult")))))
+ (or res "* mult")))
+ (_ "* mult")))))
+
+(defun sm-c-smie-hanging-eolp ()
+ (let ((start (point))
+ (prev (smie-indent-backward-token)))
+ (if (and (not (numberp (nth 1 prev)))
+ (save-excursion (equal (sm-c-smie-backward-token) ";")))
+ ;; Treat instructions that start after ";" as always "hanging".
+ (end-of-line)
+ (goto-char start)))
+ (skip-chars-forward " \t")
+ (or (eolp)
+ (forward-comment (point-max))
+ (and (looking-at "\\\\\n")
+ (goto-char (match-end 0)))))
+
+(defvar sm-c-smie--inhibit-case/label-rule nil)
+
+(defun sm-c--smie-virtual ()
+ (if (and (smie-indent--bolp)
+ (not (save-excursion
+ (member (sm-c-smie-forward-token)
+ '("case" ":label")))))
+ (current-column)
+ (let ((sm-c-smie--inhibit-case/label-rule t))
+ (smie-indent-calculate))))
+
+(defun sm-c-smie-rules (kind token)
+ (pcase (cons kind token)
+ (`(:elem . basic) sm-c-indent-basic)
+ (`(:list-intro . ";")
+ (save-excursion
+ (forward-char 1)
+ (if (and (null (smie-forward-sexp))
+ ;; FIXME: Handle \\\n as well!
+ (progn (forward-comment (point-max))
+ (looking-at "(")))
+ nil
+ t)))
+ (`(:before . "else")
+ (save-excursion
+ (sm-c--else-to-if)
+ `(column . ,(smie-indent-virtual))))
+ (`(:before . "while")
+ (save-excursion
+ (when (sm-c--while-to-do)
+ `(column . ,(smie-indent-virtual)))))
+ (`(:before . ,(or "=" "+=" "-=" "*=" "/=" "%=" "<<=" ">>=" "&=" "^=" "|="))
+ (save-excursion
+ (sm-c--boe token)
+ `(column . ,(+ (funcall smie-rules-function :elem 'basic)
+ (smie-indent-virtual)))))
+ (`(:before . "if")
+ (when (and (not (smie-rule-bolp)) (smie-rule-prev-p "else"))
+ (save-excursion
+ (smie-indent-backward-token)
+ `(column . ,(sm-c--smie-virtual)))))
+ ;; (`(:after . ,(or "=" "+=" "-=" "*=" "/=" "%=" "<<=" ">>=" "&=" "^="
"|="))
+ ;; (funcall smie-rules-function :elem 'basic))
+ (`(:before . "{")
+ (cond
+ ((smie-rule-prev-p "=") nil) ;Not a block of instructions!
+ ((save-excursion
+ (let ((pos (point)))
+ (sm-c--boi 'inner) (sm-c--skip-labels (point-max))
+ (let ((tok (save-excursion (sm-c-smie-forward-token))))
+ (cond
+ ((or (equal tok "typedef")
+ (and (member tok '("enum" "struct"))
+ ;; Make sure that the {...} is about this struct/enum,
+ ;; as opposed to "struct foo *get_foo () {...}"!
+ (save-excursion
+ (smie-indent-forward-token)
+ (smie-indent-forward-token)
+ (forward-comment (point-max))
+ (>= (point) pos))))
+ `(column . ,(+ (if (save-excursion
+ (goto-char pos)
+ (smie-rule-hanging-p))
+ 0
+ (funcall smie-rules-function :elem 'basic))
+ (smie-indent-virtual))))
+ ((and (member tok '("enum" "struct"))
+ ;; Make sure that the {...} is about this struct/enum, as
+ ;; opposed to "struct foo *get_foo () {...}"!
+ (save-excursion
+ (smie-indent-forward-token)
+ (smie-indent-forward-token)
+ (forward-comment (point-max))
+ (>= (point) pos)))
+ `(column . ,(+ (funcall smie-rules-function :elem 'basic)
+ (smie-indent-virtual))))
+ ((or (member tok sm-c-paren-block-keywords)
+ (equal tok "do"))
+ nil)
+ ((save-excursion
+ (goto-char pos)
+ (when (and (> (car (syntax-ppss)) 0)
+ (equal ")" (car (smie-indent-backward-token))))
+ (up-list -1)
+ `(column . ,(sm-c--smie-virtual)))))
+ (t `(column . ,(smie-indent-virtual))))))))
+ ((smie-rule-hanging-p)
+ (cond
+ ((smie-rule-prev-p "do" "else")
+ (smie-indent-backward-token))
+ ((smie-rule-prev-p ")")
+ (smie-backward-sexp)
+ (smie-indent-backward-token))
+ (t (sm-c--boi 'inner)))
+ `(column . ,(sm-c--smie-virtual)))
+ (t
+ (let ((pos (point)))
+ (pcase (sm-c--prev-token)
+ ((or "do" "else")
+ (cond
+ (sm-c-indent-braces
+ `(column . ,(+ (funcall smie-rules-function :elem 'basic)
+ (smie-indent-virtual))))))
+ (")" nil)
+ (_ (goto-char pos) (sm-c--boi)
+ (if (< (point) pos)
+ `(column . ,(sm-c--smie-virtual)))))))))
+ (`(:before . "(")
+ (save-excursion
+ (let ((res (smie-backward-sexp)))
+ (pcase res
+ (`nil
+ (if (looking-at "(")
+ ;; (unless (save-excursion
+ ;; (member (sm-c-smie-backward-token)
+ ;; sm-c-paren-block-keywords))
+ ;; `(column . ,(sm-c--smie-virtual)))
+ nil
+ `(column . ,(+ (funcall smie-rules-function :elem 'basic)
+ (sm-c--smie-virtual)))))))))
+ (`(:after . "else")
+ (save-excursion
+ (funcall smie-rules-function :elem 'basic)))
+ (`(:after . ")")
+ (save-excursion
+ (let ((_ (progn (forward-char 1) (backward-sexp 1)))
+ (pos (point))
+ (prev (sm-c-smie-backward-token)))
+ (cond
+ ((member prev sm-c-paren-block-keywords)
+ `(column . ,(+ (funcall smie-rules-function :elem 'basic)
+ (smie-indent-virtual))))
+ ((and (looking-at "[[:alnum:]_]+(")
+ (save-excursion
+ (forward-line 0)
+ (and (bobp) (looking-at sm-c--cpp-regexp))))
+ ;; Will be bumped up presumably by the "max" in
+ ;; sm-c--cpp-smie-indent.
+ `(column . 0))
+ (t (goto-char pos) `(column . ,(sm-c--smie-virtual)))))))
+ (`(:after . "}")
+ (save-excursion
+ (forward-char 1) (backward-sexp 1)
+ (sm-c--boi)
+ `(column . ,(sm-c--smie-virtual))))
+ (`(:after . ";")
+ (save-excursion
+ (sm-c--boi)
+ `(column . ,(sm-c--smie-virtual))))
+ (`(:after . ":label")
+ ;; Yuck!
+ `(column . ,(sm-c--smie-virtual)))
+ (`(:after . ": case")
+ ;; Yuck!
+ (save-excursion
+ (smie-backward-sexp ": case")
+ `(column . ,(sm-c--smie-virtual))))
+ (`(:after . "* deref") `(column . ,(sm-c--smie-virtual)))
+ ((and `(:before . ":label") (guard (not
sm-c-smie--inhibit-case/label-rule)))
+ (let ((ppss (syntax-ppss)))
+ (when (nth 1 ppss)
+ (save-excursion
+ (goto-char (nth 1 ppss))
+ `(column . ,(smie-indent-virtual))))))
+ ((and `(:before . "case") (guard (not sm-c-smie--inhibit-case/label-rule)))
+ (catch 'found
+ (dolist (pos (reverse (nth 9 (syntax-ppss))))
+ (save-excursion
+ (goto-char pos)
+ (and (looking-at "{")
+ (null (car-safe (smie-backward-sexp)))
+ (equal "switch" (sm-c-smie-backward-token))
+ (goto-char pos)
+ (throw 'found `(column . ,(smie-indent-virtual))))))))))
+
+;;; Backslash alignment
+
+(defvar-local sm-c--bs-changed nil)
+
+(defun sm-c--bs-after-change (beg end _len)
+ (unless undo-in-progress
+ (if (null sm-c--bs-changed)
+ (setq sm-c--bs-changed (cons beg end))
+ (cl-callf (lambda (x) (min x beg)) (car sm-c--bs-changed))
+ (cl-callf (lambda (x) (max x end)) (cdr sm-c--bs-changed)))))
+
+(defun sm-c--bs-realign ()
+ (when sm-c--bs-changed
+ (sm-c--bs-realign-1 (car sm-c--bs-changed) (cdr sm-c--bs-changed))
+ (setq sm-c--bs-changed nil)))
+
+(defun sm-c--bs-realign-1 (from to)
+ (save-excursion
+ (goto-char from)
+ (end-of-line)
+ (unless (zerop (mod (skip-chars-backward "\\\\") 2))
+ (skip-chars-backward " \t")
+ (setq from (point))
+ (let ((col (current-column))
+ start end)
+ (while
+ (progn (setq start (point))
+ (end-of-line 0)
+ (and (< (point) start)
+ (not (zerop (mod (skip-chars-backward "\\\\") 2)))))
+ (skip-chars-backward " \t")
+ (setq col (max (current-column) col)))
+ (goto-char from)
+ (while
+ (progn (setq end (point))
+ (end-of-line 2)
+ (and (> (line-beginning-position) end)
+ (not (zerop (mod (skip-chars-backward "\\\\") 2)))))
+ (skip-chars-backward " \t")
+ (setq col (max (current-column) col)))
+ (goto-char to)
+ (beginning-of-line)
+ (unless (or (> (point) end) ;Don't realign if we changed outside!
+ (<= end start)) ;A lone \
+
+ (setq col (1+ col)) ;Add a space before the backslashes.
+ (goto-char end)
+ (end-of-line)
+ (while (>= (point) start)
+ (cl-assert (eq (char-before) ?\\))
+ (forward-char -1)
+ (let ((curcol (current-column)))
+ (cond
+ ((> col curcol) (indent-to col))
+ ((< col curcol)
+ (move-to-column col t)
+ (delete-region (point)
+ (progn (skip-chars-forward " \t") (point))))))
+ (end-of-line 0)))))))
+
+;;; Font-lock support
+
+(defconst sm-c--comment-regexp
+ "/\\(?:/.*\n\\|\\*\\(?:[^*]+\\(?:\\*+[^/*]\\)*\\)*\\*/\\)")
+
+(defconst sm-c--defun-regexp
+ (let* ((spc0 (concat "\\(?:\n?[ \t]\\|" sm-c--comment-regexp "\\)*"))
+ (spc1 (concat "\n?[ \t]" spc0))
+ (id "\\(?:\\sw\\|\\s_\\)+"))
+ (cl-flet ((repeat (repetition &rest res)
+ (concat "\\(?:" (apply #'concat res) "\\)"
+ (pcase repetition
+ ((pred symbolp) (symbol-name repetition))
+ (1 "")))))
+ (concat
+ "^\\(?:"
+ (repeat '* "\\*" spc0)
+ (repeat '* id (repeat 1 spc1 "\\|" spc0 "\\*" spc0))
+ "\\(" id "\\)[ \t\n]*("
+ "\\|"
+ "[ \t]*#[ \t]*define[ \t]+\\(?1:" id "\\)("
+ "\\)"))))
+
+(defconst sm-c-font-lock-keywords
+ `((,sm-c--cpp-regexp (1 font-lock-preprocessor-face))
+ ("\\_<\\(?:true\\|false\\)\\_>" (0 font-lock-constant-face))
+ ("\\_<\\(case\\)\\_>[ \t]*\\([^: \t]+\\)"
+ (1 font-lock-keyword-face)
+ (2 font-lock-constant-face))
+ ("\\(?:[{};]\\(\\)\\|^\\)[ \t]*\\([[:alpha:]_][[:alnum:]_]*\\)[ \t]*:"
+ (2 (if (or (match-beginning 1)
+ (save-excursion (equal ":label" (sm-c-smie-backward-token))))
+ font-lock-constant-face)))
+ (,(let ((kws (delq nil (mapcar (lambda (x)
+ (setq x (car x))
+ (and (stringp x)
+ (string-match "\\`[a-z]" x)
+ x))
+ sm-c-smie-grammar))))
+ (concat "\\_<" (regexp-opt
+ (append
+ ;; Elements not in SMIE's grammar. Either because
+ ;; they're uninteresting from a parsing point of view,
+ ;; or because SMIE's parsing engine can't handle them
+ ;; even poorly.
+ '("break" "continue" "struct" "enum" "union" "static")
+ ;; "case" already handled above.
+ (delete "case" kws)))
+ "\\_>"))
+ (0 font-lock-keyword-face))
+ (,sm-c--defun-regexp
+ (1
+ (prog1 font-lock-function-name-face
+ (if (< (match-beginning 0) (line-beginning-position))
+ (put-text-property (match-beginning 0) (match-end 0)
+ 'font-lock-multiline t)))))))
+
+(defconst sm-c--def-regexp
+ (let ((spc0 (concat "\\(?:[ \t\n]\\|" sm-c--comment-regexp "\\)*"))
+ (id "\\(?:\\sw\\|\\s_\\)+"))
+ (concat sm-c--defun-regexp
+ "\\|"
+ "\\_<\\(?1:\\(?:struct\\|enum\\)[ \t]+" id "\\)" spc0 "{")))
+
+;;;###autoload
+(define-derived-mode sm-c-mode prog-mode "smC"
+ "C editing mode based on SMIE."
+ ;; (setq-local font-lock-support-mode nil) ;; To help debugging.
+ (setq-local comment-start "/* ")
+ (setq-local comment-end " */")
+ (setq-local parse-sexp-lookup-properties t)
+ (setq-local open-paren-in-column-0-is-defun-start nil)
+ (setq-local syntax-propertize-function #'sm-c-syntax-propertize)
+ (setq-local font-lock-defaults '(sm-c-font-lock-keywords))
+ (setq-local font-lock-syntactic-face-function #'sm-c-syntactic-face-function)
+ (smie-setup sm-c-smie-grammar #'sm-c-smie-rules
+ :backward-token #'sm-c-smie-backward-token
+ :forward-token #'sm-c-smie-forward-token)
+ ;; FIXME: The stock SMIE forward-sexp-function is not good enough here, since
+ ;; our grammar is much too poor. We should setup another function instead
+ ;; (or ideally teach SMIE to use it).
+ (kill-local-variable 'forward-sexp-function)
+ (add-hook 'smie-indent-functions #'sm-c--cpp-smie-indent nil t)
+ (add-function :after (local 'indent-line-function)
+ #'sm-c--cpp-indent-line)
+ (setq-local smie--hanging-eolp-function #'sm-c-smie-hanging-eolp)
+ ;; Backslash auto-realign.
+ (add-hook 'after-change-functions #'sm-c--bs-after-change nil t)
+ (add-hook 'post-command-hook #'sm-c--bs-realign nil t)
+ (setq-local add-log-current-defun-header-regexp sm-c--def-regexp)
+ (setq-local imenu-generic-expression `((nil ,sm-c--def-regexp 1))))
+
+(defun sm-c--cpp-is-not-really-a-comment (&rest args)
+ ;; Without this, placing the region around a CPP directive and hitting
+ ;; M-; would just strip the leading "#" instead of commenting things out.
+ (if (not (derived-mode-p 'sm-c-mode))
+ (apply args)
+ (let ((parse-sexp-lookup-properties nil))
+ (apply args))))
+
+;; FIXME: Maybe we should change newcomment.el instead; or maybe CPP directives
+;; should not be defined as comments, or at least "not always"!
+(advice-add 'comment-only-p :around #'sm-c--cpp-is-not-really-a-comment)
+
+(provide 'sm-c-mode)
+;;; sm-c-mode.el ends here
diff --git a/packages/sotlisp/sotlisp.el b/packages/sotlisp/sotlisp.el
index 61d598e..a4cd9dc 100644
--- a/packages/sotlisp/sotlisp.el
+++ b/packages/sotlisp/sotlisp.el
@@ -2,10 +2,11 @@
;; Copyright (C) 2014, 2015 Free Software Foundation, Inc.
-;; Author: Artur Malabarba <address@hidden>
+;; Author: Artur Malabarba <address@hidden>
+;; URL: https://github.com/Malabarba/speed-of-thought-lisp
;; Keywords: convenience, lisp
;; Package-Requires: ((emacs "24.1"))
-;; Version: 0
+;; Version: 1.5.1
;; 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
@@ -79,7 +80,6 @@
;;
;; (with-temp-buffer (insert text))
-
;;; Code:
;;; Predicates
@@ -89,16 +89,42 @@
(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 (looking-back "(\\(defun\\s-+.*\\|lambda\\s-+\\)("))
+ (not (sotlisp--looking-back
"(\\(defun\\s-+.*\\|\\(lambda\\|dolist\\|dotimes\\)\\s-+\\)("))
+ (save-excursion
+ (forward-char -1)
+ (condition-case er
+ (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."
- (looking-back "#'"))
+ (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.
@@ -108,13 +134,19 @@ non-nil."
(save-excursion
(ignore-errors
(skip-chars-backward (rx alnum))
- (or (sotlisp--function-form-p)
- (sotlisp--function-quote-p)))))
+ (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 last-command-event))))
+ (string-match (rx space) (string char))))
;;; Expansion logic
@@ -139,6 +171,28 @@ Point is left where the `$' char was. Does nothing if
variable
(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.")
@@ -149,23 +203,18 @@ See `sotlisp-define-function-abbrev'."
(skip-chars-backward (rx alnum))
(let* ((name (buffer-substring (point) r))
(expansion (gethash name sotlisp--function-table)))
- (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))))
- ;; Inform `expand-abbrev' that `self-insert-command' should not
- ;; trigger, by returning non-nil on SPC.
- (when (sotlisp--whitespace-p)
- ;; And maybe move out of closing paren if expansion ends with $.
- (when (eq (char-before) ?$)
- (delete-char -1)
- (setq sotlisp--needs-moving nil)
- (sotlisp--maybe-skip-closing-paren))
- t)))
+ (if (not expansion)
+ (progn (goto-char r) nil)
+ (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)
@@ -187,6 +236,7 @@ The space char is not included. Any \"$\" are also
removed."
("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$")
@@ -212,10 +262,13 @@ The space char is not included. Any \"$\" are also
removed."
("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 \"$\"")
@@ -227,6 +280,7 @@ The space char is not included. Any \"$\" are also
removed."
("fp" . "functionp ")
("frp" . "file-readable-p ")
("fs" . "forward-sexp 1")
+ ("fu" . "funcall ")
("fw" . "forward-word 1")
("g" . "goto-char ")
("gc" . "goto-char ")
@@ -234,6 +288,7 @@ The space char is not included. Any \"$\" are also
removed."
("i" . "insert ")
("ie" . "ignore-errors ")
("ii" . "interactive")
+ ("il" . "if-let (($))")
("ir" . "indent-region ")
("jcl" . "justify-current-line ")
("jl" . "delete-indentation")
@@ -243,6 +298,7 @@ The space char is not included. Any \"$\" are also
removed."
("k" . "kbd \"$\"")
("kb" . "kill-buffer")
("kn" . "kill-new ")
+ ("kp" . "keywordp ")
("l" . "lambda ($)")
("la" . "looking-at \"$\"")
("lap" . "looking-at-p \"$\"")
@@ -253,11 +309,14 @@ The space char is not included. Any \"$\" are also
removed."
("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")
@@ -265,9 +324,11 @@ The space char is not included. Any \"$\" are also
removed."
("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$")
@@ -280,18 +341,18 @@ The space char is not included. Any \"$\" are also
removed."
("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")
+ ("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:]\"")
+ ("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" . "string<")
+ ("sl" . "setq-local ")
("sm" . "string-match \"$\"")
("smd" . "save-match-data")
("sn" . "symbol-name ")
@@ -305,6 +366,8 @@ The space char is not included. Any \"$\" are also
removed."
("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 $)")
@@ -313,7 +376,10 @@ The space char is not included. Any \"$\" are also
removed."
("wcb" . "with-current-buffer ")
("wf" . "write-file ")
("wh" . "while ")
- ("wl" . "window-list nil 'nominibuffer")
+ ("wl" . "when-let (($))")
+ ("we" . "window-end")
+ ("ws" . "window-start")
+ ("wsw" . "with-selected-window ")
("wtb" . "with-temp-buffer")
("wtf" . "with-temp-file ")
)
@@ -361,7 +427,7 @@ following way:
;;; The global minor-mode
-(defvar speed-of-thought-turn-on-hook '(sotlisp-turn-on-everywhere)
+(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.
@@ -369,7 +435,7 @@ 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 '(sotlisp-turn-off-everywhere)
+(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.
@@ -378,14 +444,33 @@ 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
+(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)))
+
(defun sotlisp-turn-on-everywhere ()
"Call-once function to turn on sotlisp everywhere.
Calls `sotlisp-mode' on all `emacs-lisp-mode' buffers, and sets
@@ -396,7 +481,7 @@ up a hook and abbrevs."
(with-current-buffer b
(when (derived-mode-p 'emacs-lisp-mode)
(sotlisp-mode 1))))
- (buffer-list)))
+ (buffer-list)))
(defun sotlisp-turn-off-everywhere ()
"Call-once function to turn off sotlisp everywhere.
@@ -408,13 +493,9 @@ removes hooks and abbrevs."
(with-current-buffer b
(when (derived-mode-p 'emacs-lisp-mode)
(sotlisp-mode -1))))
- (buffer-list)))
+ (buffer-list)))
-(define-minor-mode sotlisp-mode nil nil " SoT"
- '(([M-return] . sotlisp-newline-and-parentheses)
- ([C-return] . sotlisp-downlist-newline-and-parentheses)
- ("\C-cf" . sotlisp-find-or-define-function)
- ("\C-cv" . sotlisp-find-or-define-variable)))
+(speed-of-thought-hook-in #'sotlisp-turn-on-everywhere
#'sotlisp-turn-off-everywhere)
;;; Commands
@@ -453,8 +534,9 @@ removes hooks and abbrevs."
"`push-mark' and move above this defun."
(push-mark)
(beginning-of-defun)
- (when (looking-back "^;;;###autoload\\s-*\n")
- (forward-line -1)))
+ (forward-line -1)
+ (unless (looking-at "^;;;###autoload\\s-*\n")
+ (forward-line 1)))
(defun sotlisp--function-at-point ()
"Return name of `function-called-at-point'."
@@ -529,5 +611,97 @@ With a prefix argument, defines a `defvar' instead of a
`defcustom'."
(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
index 2f3dc39..4fb4a4a 100644
--- a/packages/spinner/README.org
+++ b/packages/spinner/README.org
@@ -2,16 +2,17 @@
Add spinners and progress-bars to the mode-line for ongoing operations.
-[[file:spinner.gif]]
-* Usage
+[[file:some-spinners.gif]]
-1. Add ~(spinner "1.0")~ to your package’s dependencies.
+[[file:all-spinners.gif]]
-2. Call ~(spinner-start)~ and a spinner will be added to the mode-line.
+* Usage
-3. Call ~(spinner-stop)~ on the same buffer when you want to remove it.
+First of all, don’t forget to add ~(spinner "VERSION")~ to your package’s
dependencies.
-* Behavior
+** 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
@@ -22,3 +23,54 @@ a few examples for you to try:
- ~(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
new file mode 100644
index 0000000..5540b68
Binary files /dev/null and b/packages/spinner/all-spinners.gif differ
diff --git a/packages/spinner/spinner.gif b/packages/spinner/some-spinners.gif
similarity index 100%
rename from packages/spinner/spinner.gif
rename to packages/spinner/some-spinners.gif
diff --git a/packages/spinner/spinner.el b/packages/spinner/spinner.el
index a21bf42..63ead1e 100644
--- a/packages/spinner/spinner.el
+++ b/packages/spinner/spinner.el
@@ -2,10 +2,9 @@
;; Copyright (C) 2015 Free Software Foundation, Inc.
-;; Author: Artur Malabarba <address@hidden>
-;; Version: 1.0
-;; Package-Requires: ((cl-lib "0.5"))
-;; URL: https://github.com/Bruce-Connor/spinner.el
+;; Author: Artur Malabarba <address@hidden>
+;; Version: 1.7
+;; URL: https://github.com/Malabarba/spinner.el
;; Keywords: processes mode-line
;; This program is free software; you can redistribute it and/or modify
@@ -22,34 +21,84 @@
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
+;;
;; 1 Usage
;; ═══════
;;
-;; 1. Add `(spinner "1.0")' to your package’s dependencies.
+;; 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
+;; ───────────────
;;
-;; 2. Call `(spinner-start)' and a spinner will be added to the
-;; mode-line.
+;; 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.
;;
-;; 3. Call `(spinner-stop)' on the same buffer when you want to remove
-;; it.
+;; 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.
;;
-;; 2 Behavior
-;; ══════════
+;; 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.
;;
-;; 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:
+;; ┌────
+;; │ (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))
+;; └────
;;
-;; • `(spinner-start 'vertical-breathing 10)'
-;; • `(spinner-start 'minibox)'
-;; • `(spinner-start 'moon)'
-;; • `(spinner-start 'triangle)'
+;; 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:
-(require 'cl-lib)
+(eval-when-compile
+ (require 'cl))
(defconst spinner-types
'((3-line-clock . ["┤" "┘" "┴" "└" "├" "┌" "┬" "┐"])
@@ -74,106 +123,212 @@
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))))
+ (thread-last (mapcar (lambda (n) (substring whole-string n (+ n width)))
+ (number-sequence (+ width 3) 0 -1))
+ (apply #'vector))))
+
(defvar spinner-current nil
- "Spinner curently being displayed on the mode-line.")
+ "Spinner curently being displayed on the `mode-line-process'.")
(make-variable-buffer-local 'spinner-current)
-(defvar spinner--counter 0
- "Current frame of the spinner.")
-(make-variable-buffer-local 'spinner--counter)
-
(defconst spinner--mode-line-construct
- '((spinner-current
- (" "
- (:eval (elt spinner-current
- (% spinner--counter
- (length spinner-current)))))
- (spinner--timer
- (:eval (spinner-stop)))))
- "Construct used to display the spinner.")
+ '(: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--timer nil
- "Holds the timer being used on the current buffer.")
-(make-variable-buffer-local 'spinner--timer)
-
-(defvar spinner-frames-per-second 5
+(defvar spinner-frames-per-second 10
"Default speed at which spinners spin, in frames per second.
-Applications can override this value.")
+Each spinner can override this value.")
-;;; The main function
+;;; 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) :read-only)
+ (active-p nil)
+ (buffer (when buffer-local
+ (if (bufferp buffer-local)
+ buffer-local
+ (current-buffer))))
+ (delay (or delay-before-start 0)))
+
;;;###autoload
-(defun spinner-start (&optional type fps)
- "Start a mode-line spinner of given TYPE.
-Spinners are buffer local. It is added to the mode-line in the
-buffer where `spinner-start' is called.
+(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'.
-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'.
+
+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'.
-If TYPE is nil, use the first element of `spinner-types'.
-If TYPE is `random', use a random element of `spinner-types'.
-If it is a symbol, it specifies an element of `spinner-types'.
-If it is a vector, it used as the spinner.
-If it is a list, it should be a list of symbols, and a random one
-is chosen as the spinner type."
- ;; Choose type.
- (setq spinner-current
- (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))))
- (setq spinner--counter 0)
-
- ;; Maybe add to mode-line.
- (unless (memq 'spinner--mode-line-construct mode-line-format)
- (setq mode-line-format (cl-copy-list mode-line-format))
- (let ((cell (memq 'mode-line-buffer-identification mode-line-format)))
- (if cell
- (setcdr cell (cons 'spinner--mode-line-construct (cdr cell)))
- (setcdr (last mode-line-format) '(spinner--mode-line-construct)))))
+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 (timerp spinner--timer)
- (cancel-timer spinner--timer))
- (let ((buffer (current-buffer))
- ;; Create the timer as a lex variable so it can cancel itself.
- (timer (run-at-time t
- (/ 1.0 (or fps spinner-frames-per-second))
- #'ignore)))
- (timer-set-function
- timer (lambda ()
- (if (buffer-live-p buffer)
- (with-current-buffer buffer
- (setq spinner--counter (1+ spinner--counter))
- (force-mode-line-update))
- (ignore-errors (cancel-timer timer)))))
- (setq spinner--timer timer)
- ;; Return a stopping function.
- (lambda () (when (buffer-live-p buffer)
- (with-current-buffer buffer
- (spinner-stop))))))
-
-(defun spinner-stop ()
- "Stop the current buffer's spinner."
- (when (timerp spinner--timer)
- (cancel-timer spinner--timer))
- (setq spinner--timer nil
- spinner-current nil)
- (setq mode-line-format
- (remove 'spinner--mode-line-construct mode-line-format)))
+ (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)
diff --git a/packages/stream/stream.el b/packages/stream/stream.el
new file mode 100644
index 0000000..567a9e3
--- /dev/null
+++ b/packages/stream/stream.el
@@ -0,0 +1,326 @@
+;;; stream.el --- Implementation of streams -*- lexical-binding: t -*-
+
+;; Copyright (C) 2015 Free Software Foundation, Inc.
+
+;; Author: Nicolas Petton <address@hidden>
+;; Keywords: stream, laziness, sequences
+;; Version: 2.1.0
+;; Package-Requires: ((emacs "25"))
+;; Package: stream
+
+;; Maintainer: address@hidden
+
+;; 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 library provides an implementation of streams. Streams are
+;; implemented as delayed evaluation of cons cells.
+;;
+;; Functions defined in `seq.el' can also take a stream as input.
+;;
+;; streams could be created from any sequential input data:
+;; - sequences, making operation on them lazy
+;; - a set of 2 forms (first and rest), making it easy to represent infinite
sequences
+;; - buffers (by character)
+;; - buffers (by line)
+;; - buffers (by page)
+;; - IO streams
+;; - orgmode table cells
+;; - ...
+;;
+;; All functions are prefixed with "stream-".
+;; All functions are tested in test/automated/stream-tests.el
+;;
+;; Here is an example implementation of the Fibonacci numbers
+;; implemented as in infinite stream:
+;;
+;; (defun fib (a b)
+;; (stream-cons a (fib b (+ a b))))
+;; (fib 0 1)
+
+;;; Code:
+
+(eval-when-compile (require 'cl-lib))
+(require 'seq)
+(require 'thunk)
+
+(eval-and-compile
+ (defconst stream--identifier '--stream--
+ "Symbol internally used to identify streams."))
+
+(defmacro stream-make (&rest body)
+ "Return a stream built from BODY.
+BODY must return nil or a cons cell whose cdr is itself a
+stream."
+ (declare (debug t))
+ `(list ',stream--identifier (thunk-delay ,@body)))
+
+(defmacro stream-cons (first rest)
+ "Return a stream built from the cons of FIRST and REST.
+FIRST and REST are forms and REST must return a stream."
+ (declare (debug t))
+ `(stream-make (cons ,first ,rest)))
+
+
+;;; Convenient functions for creating streams
+
+(cl-defgeneric stream (src)
+ "Return a new stream from SRC.")
+
+(cl-defmethod stream ((seq sequence))
+ "Return a stream built from the sequence SEQ.
+SEQ can be a list, vector or string."
+ (if (seq-empty-p seq)
+ (stream-empty)
+ (stream-cons
+ (seq-elt seq 0)
+ (stream (seq-subseq seq 1)))))
+
+(cl-defmethod stream ((list list))
+ "Return a stream built from the list LIST."
+ (if (null list)
+ (stream-empty)
+ (stream-cons
+ (car list)
+ (stream (cdr list)))))
+
+(cl-defmethod stream ((buffer buffer) &optional pos)
+ "Return a stream of the characters of the buffer BUFFER.
+BUFFER may be a buffer or a string (buffer name).
+The sequence starts at POS if non-nil, 1 otherwise."
+ (with-current-buffer buffer
+ (unless pos (setq pos (point-min)))
+ (if (>= pos (point-max))
+ (stream-empty))
+ (stream-cons
+ (with-current-buffer buffer
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char pos)
+ (char-after (point)))))
+ (stream buffer (1+ pos)))))
+
+(declare-function iter-next "generator")
+
+(defun stream-from-iterator (iterator)
+ "Return a stream generating new elements through ITERATOR.
+ITERATOR is an iterator object in terms of the \"generator\"
+package."
+ (stream-make
+ (condition-case nil
+ (cons (iter-next iterator) (stream-from-iterator iterator))
+ (iter-end-of-sequence nil))))
+
+(defun stream-regexp (buffer regexp)
+ (stream-make
+ (let (match)
+ (with-current-buffer buffer
+ (setq match (re-search-forward regexp nil t)))
+ (when match
+ (cons (match-data) (stream-regexp buffer regexp))))))
+
+(defun stream-range (&optional start end step)
+ "Return a stream of the integers from START to END, stepping by STEP.
+If START is nil, it defaults to 0. If STEP is nil, it defaults to
+1. START is inclusive and END is exclusive. If END is nil, the
+range is infinite."
+ (unless start (setq start 0))
+ (unless step (setq step 1))
+ (if (equal start end)
+ (stream-empty)
+ (stream-cons
+ start
+ (stream-range (+ start step) end step))))
+
+
+(defun streamp (stream)
+ "Return non-nil if STREAM is a stream, nil otherwise."
+ (and (consp stream)
+ (eq (car stream) stream--identifier)))
+
+(defun stream-empty ()
+ "Return an empty stream."
+ (list stream--identifier (thunk-delay nil)))
+
+(defun stream-empty-p (stream)
+ "Return non-nil is STREAM is empty, nil otherwise."
+ (null (thunk-force (cadr stream))))
+
+(defun stream-first (stream)
+ "Return the first element of STREAM."
+ (car (thunk-force (cadr stream))))
+
+(defun stream-rest (stream)
+ "Return a stream of all but the first element of STREAM."
+ (or (cdr (thunk-force (cadr stream)))
+ (stream-empty)))
+
+(defun stream-append (&rest streams)
+ "Concatenate the STREAMS.
+Requesting elements from the resulting stream will request the
+elements in the STREAMS in order."
+ (if (null streams)
+ (stream-empty)
+ (stream-make
+ (let ((first (pop streams)))
+ (while (and (stream-empty-p first) streams)
+ (setq first (pop streams)))
+ (if (stream-empty-p first)
+ nil
+ (cons (stream-first first)
+ (if streams (apply #'stream-append (stream-rest first) streams)
+ (stream-rest first))))))))
+
+(defmacro stream-pop (stream)
+ "Return the first element of STREAM and set the value of STREAM to its rest."
+ (unless (symbolp stream)
+ (error "STREAM must be a symbol"))
+ `(prog1
+ (stream-first ,stream)
+ (setq ,stream (stream-rest ,stream))))
+
+
+;;; cl-generic support for streams
+
+(cl-generic-define-generalizer stream--generalizer
+ 11
+ (lambda (name)
+ `(when (streamp ,name)
+ 'stream))
+ (lambda (tag)
+ (when (eq tag 'stream)
+ '(stream))))
+
+(cl-defmethod cl-generic-generalizers ((_specializer (eql stream)))
+ "Support for `stream' specializers."
+ (list stream--generalizer))
+
+
+;;; Implementation of seq.el generic functions
+
+(cl-defmethod seqp ((_stream stream))
+ t)
+
+(cl-defmethod seq-elt ((stream stream) n)
+ "Return the element of STREAM at index N."
+ (while (> n 0)
+ (setq stream (stream-rest stream))
+ (setq n (1- n)))
+ (stream-first stream))
+
+(cl-defmethod seq-length ((stream stream))
+ "Return the length of STREAM.
+This function will eagerly consume the entire stream."
+ (let ((len 0))
+ (while (not (stream-empty-p stream))
+ (setq len (1+ len))
+ (setq stream (stream-rest stream)))
+ len))
+
+(cl-defmethod seq-subseq ((stream stream) start end)
+ (seq-take (seq-drop stream start) (- end start)))
+
+(cl-defmethod seq-into-sequence ((stream stream))
+ "Convert STREAM into a sequence."
+ (let ((list))
+ (seq-doseq (elt stream)
+ (push elt list))
+ (nreverse list)))
+
+(cl-defmethod seq-into ((stream stream) type)
+ "Convert STREAM into a sequence of type TYPE."
+ (seq-into (seq-into-sequence stream) type))
+
+(cl-defmethod seq-into ((stream stream) (_type (eql stream)))
+ stream)
+
+(cl-defmethod seq-into ((seq sequence) (_type (eql stream)))
+ (stream seq))
+
+(cl-defmethod seq-take ((stream stream) n)
+ "Return a stream of the first N elements of STREAM."
+ (if (or (zerop n)
+ (stream-empty-p stream))
+ (stream-empty)
+ (stream-cons
+ (stream-first stream)
+ (seq-take (stream-rest stream) (1- n)))))
+
+(cl-defmethod seq-drop ((stream stream) n)
+ "Return a stream of STREAM without its first N elements."
+ (stream-make
+ (while (not (or (stream-empty-p stream) (zerop n)))
+ (setq n (1- n))
+ (setq stream (stream-rest stream)))
+ (unless (stream-empty-p stream)
+ (cons (stream-first stream)
+ (stream-rest stream)))))
+
+(cl-defmethod seq-take-while (pred (stream stream))
+ "Return a stream of the successive elements for which (PRED elt) is non-nil
in STREAM."
+ (stream-make
+ (when (funcall pred (stream-first stream))
+ (cons (stream-first stream)
+ (seq-take-while pred (stream-rest stream))))))
+
+(cl-defmethod seq-drop-while (pred (stream stream))
+ "Return a stream from the first element for which (PRED elt) is nil in
STREAM."
+ (stream-make
+ (while (not (or (stream-empty-p stream)
+ (funcall pred (stream-first stream))))
+ (setq stream (stream-rest stream)))
+ (unless (stream-empty-p stream)
+ (cons (stream-first stream)
+ (stream-rest stream)))))
+
+(cl-defmethod seq-map (function (stream stream))
+ "Return a stream representing the mapping of FUNCTION over STREAM.
+The elements of the produced stream are the results of the
+applications of FUNCTION on each element of STREAM in succession."
+ (stream-make
+ (when (not (stream-empty-p stream))
+ (cons (funcall function (stream-first stream))
+ (seq-map function (stream-rest stream))))))
+
+(cl-defmethod seq-do (function (stream stream))
+ "Evaluate FUNCTION for each element of STREAM eagerly, and return nil.
+
+`seq-do' should never be used on infinite streams without some
+kind of nonlocal exit."
+ (while (not (stream-empty-p stream))
+ (funcall function (stream-first stream))
+ (setq stream (stream-rest stream))))
+
+(cl-defmethod seq-filter (pred (stream stream))
+ "Return a stream of the elements for which (PRED element) is non-nil in
STREAM."
+ (if (stream-empty-p stream)
+ stream
+ (stream-make
+ (while (not (or (stream-empty-p stream)
+ (funcall pred (stream-first stream))))
+ (setq stream (stream-rest stream)))
+ (if (stream-empty-p stream)
+ nil
+ (cons (stream-first stream)
+ (seq-filter pred (stream-rest stream)))))))
+
+(cl-defmethod seq-copy ((stream stream))
+ "Return a shallow copy of STREAM."
+ (stream-cons (stream-first stream)
+ (stream-rest stream)))
+
+(provide 'stream)
+;;; stream.el ends here
diff --git a/packages/stream/tests/stream-tests.el
b/packages/stream/tests/stream-tests.el
new file mode 100644
index 0000000..88edf91
--- /dev/null
+++ b/packages/stream/tests/stream-tests.el
@@ -0,0 +1,216 @@
+;;; stream-tests.el --- Unit tests for stream.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2015 Free Software Foundation, Inc.
+
+;; Author: Nicolas Petton <address@hidden>
+
+;; Maintainer: address@hidden
+
+;; 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 'ert)
+(require 'stream)
+(require 'cl-lib)
+
+(defun stream-to-list (stream)
+ "Eagerly traverse STREAM and return a list of its elements."
+ (let (result)
+ (seq-do (lambda (elt)
+ (push elt result))
+ stream)
+ (reverse result)))
+
+(ert-deftest stream-empty-test ()
+ (should (streamp (stream-empty)))
+ (should (stream-empty-p (stream-empty))))
+
+(ert-deftest stream-make-test ()
+ (should (streamp (stream-range)))
+ (should (not (stream-empty-p (stream-range))))) ;; Should use stream-list or
something
+
+(ert-deftest stream-first-test ()
+ (should (= 3 (stream-first (stream-range 3))))
+ (should (null (stream-first (stream-empty)))))
+
+(ert-deftest stream-rest-test ()
+ (should (= 4 (stream-first (stream-rest (stream-range 3)))))
+ (should (= 5 (stream-first (stream-rest (stream-rest (stream-range 3)))))))
+
+(ert-deftest stream-from-iterator-test ()
+ (skip-unless (require 'generator nil t))
+ (should (equal '(1 2)
+ (seq-into-sequence
+ (stream-from-iterator
+ (funcall (iter-lambda ()
+ (iter-yield 1)
+ (iter-yield 2))))))))
+
+(ert-deftest stream-append-test ()
+ (should (stream-empty-p (stream-append)))
+ (should (let ((list '(1 2)))
+ (equal list (seq-into-sequence (stream-append (stream list))))))
+ (should (= (seq-elt (stream-append
+ (stream (list 0 1))
+ (stream-range 2))
+ 4)
+ 4))
+ (should (let ((stream (stream (list 0))))
+ (and (= (seq-elt (stream-append stream (stream-range 1)) 10)
+ 10)
+ (stream-empty-p (stream-rest stream)))))
+ (should (equal (seq-into-sequence
+ (stream-append
+ (stream '(1))
+ (stream '())
+ (stream '(2 3))))
+ '(1 2 3))))
+
+(ert-deftest stream-seqp-test ()
+ (should (seqp (stream-range))))
+
+(ert-deftest stream-seq-elt-test ()
+ (should (null (seq-elt (stream-empty) 0)))
+ (should (= 0 (seq-elt (stream-range) 0)))
+ (should (= 1 (seq-elt (stream-range) 1)))
+ (should (= 10 (seq-elt (stream-range) 10))))
+
+(ert-deftest stream-seq-length-test ()
+ (should (zerop (seq-length (stream-empty))))
+ (should (= 10 (seq-length (stream-range 0 10)))))
+
+(ert-deftest stream-seq-doseq-test ()
+ (let ((stream (stream '(a b c d)))
+ (lst '()))
+ (seq-doseq (elt stream)
+ (push elt lst))
+ (should (equal '(d c b a) lst))))
+
+(ert-deftest stream-seq-let-test ()
+ (seq-let (first _ third &rest rest) (stream-range 2 7)
+ (should (= first 2))
+ (should (= third 4))
+ ;; The rest of the stream shouldn't be consumed
+ (should (streamp rest))
+ (should (= 5 (stream-first rest)))
+ (should (= 6 (stream-first (stream-rest rest))))
+ (should (stream-empty-p (stream-rest (stream-rest rest))))))
+
+(ert-deftest stream-seq-subseq-test ()
+ ;; TODO
+ )
+
+(ert-deftest stream-seq-into-test ()
+ (should (streamp (seq-into (stream-empty) 'stream)))
+ (should (streamp (seq-into '(2 4 5) 'stream)))
+ (should (= 2 (stream-first (seq-into '(2 4 5) 'stream))))
+ (should (null (seq-into (stream-empty) 'list)))
+ (should (equal '(0 1 2 3 4 5 6 7 8 9) (seq-into (stream-range 0 10) 'list))))
+
+(ert-deftest stream-seq-take-test ()
+ (should (streamp (seq-take (stream-range) 2)))
+ (should (= 0 (stream-first (seq-take (stream-range) 2))))
+ (should (= 1 (stream-first (stream-rest (seq-take (stream-range) 2)))))
+ (should (null (stream-first (stream-rest (stream-rest (seq-take
(stream-range) 2))))))
+ (should (stream-empty-p (stream-rest (stream-rest (seq-take (stream-range)
2))))))
+
+(ert-deftest stream-seq-drop-test ()
+ (should (streamp (seq-drop (stream-range) 2)))
+ (should (= 2 (stream-first (seq-drop (stream-range) 2))))
+ (should (= 3 (stream-first (stream-rest (seq-drop (stream-range) 2)))))
+ (should (stream-empty-p (seq-drop (stream-empty) 2))))
+
+(ert-deftest stream-seq-take-while-test ()
+ (let ((stream (stream '(1 3 2 5))))
+ (should (stream-empty-p (seq-take-while #'identity (stream-empty))))
+ (should (streamp (seq-take-while #'cl-oddp stream)))
+ (should (= 1 (stream-first (seq-take-while #'cl-oddp stream))))
+ (should (= 3 (stream-first (stream-rest (seq-take-while #'cl-oddp
stream)))))
+ (should (stream-empty-p (stream-rest (stream-rest (seq-take-while
#'cl-oddp stream)))))))
+
+(ert-deftest stream-seq-drop-while-test ()
+ (let ((stream (stream '(1 3 2 5))))
+ (should (streamp (seq-drop-while #'cl-evenp stream)))
+ (should (stream-empty-p (seq-drop-while #'identity (stream-empty))))
+ (should (= 2 (stream-first (seq-drop-while #'cl-evenp stream))))
+ (should (= 5 (stream-first (stream-rest (seq-drop-while #'cl-evenp
stream)))))
+ (should (stream-empty-p (stream-rest (stream-rest (seq-drop-while
#'cl-evenp stream)))))))
+
+(ert-deftest stream-seq-map-test ()
+ (should (stream-empty-p (seq-map #'- (stream-empty))))
+ (should (= -1 (stream-first (seq-map #'- (stream-range 1)))))
+ (should (= -2 (stream-first (stream-rest (seq-map #'- (stream-range 1)))))))
+
+(ert-deftest stream-seq-do-test ()
+ (let ((result '()))
+ (seq-do
+ (lambda (elt)
+ (push elt result))
+ (stream-range 0 5))
+ (should (equal result '(4 3 2 1 0)))))
+
+(ert-deftest stream-seq-filter-test ()
+ (should (stream-empty-p (seq-filter #'cl-oddp (stream-empty))))
+ (should (stream-empty-p (seq-filter #'cl-oddp (stream-range 0 4 2))))
+ (should (= 1 (stream-first (seq-filter #'cl-oddp (stream-range 0 4)))))
+ (should (= 3 (stream-first (stream-rest (seq-filter #'cl-oddp (stream-range
0 4))))))
+ (should (stream-empty-p (stream-rest (stream-rest (seq-filter #'cl-oddp
(stream-range 0 4)))))))
+
+(ert-deftest stream-seq-copy-test ()
+ (should (streamp (seq-copy (stream-range))))
+ (should (= 0 (stream-first (seq-copy (stream-range)))))
+ (should (= 1 (stream-first (stream-rest (seq-copy (stream-range)))))))
+
+(ert-deftest stream-range-test ()
+ (should (stream-empty-p (stream-range 0 0)))
+ (should (stream-empty-p (stream-range 3 3)))
+ (should (= 0 (stream-first (stream-range 0 6 2))))
+ (should (= 2 (stream-first (stream-rest (stream-range 0 6 2)))))
+ (should (= 4 (stream-first (stream-rest (stream-rest (stream-range 0 6
2))))))
+ (should (stream-empty-p (stream-rest (stream-rest (stream-rest (stream-range
0 6 2))))))
+ (should (= -4 (stream-first (stream-rest (stream-rest (stream-range 0 nil
-2)))))))
+
+(ert-deftest stream-list-test ()
+ (dolist (list '(nil '(1 2 3) '(a . b)))
+ (should (equal list (stream-to-list (stream list))))))
+
+(ert-deftest stream-seq-subseq-test ()
+ (should (stream-empty-p (seq-subseq (stream-range 2 10) 0 0)))
+ (should (= (stream-first (seq-subseq (stream-range 2 10) 0 3)) 2))
+ (should (= (seq-length (seq-subseq (stream-range 2 10) 0 3)) 3))
+ (should (= (seq-elt (seq-subseq (stream-range 2 10) 0 3) 2) 4))
+ (should (= (stream-first (seq-subseq (stream-range 2 10) 1 3)) 3))
+ (should (= (seq-length (seq-subseq (stream-range 2 10) 1 3)) 2))
+ (should (= (seq-elt (seq-subseq (stream-range 2 10) 1 3) 1) 4)))
+
+(ert-deftest stream-seq-map-should-not-consume-stream-elements ()
+ (let* (consumed
+ (stream (stream-cons (setq consumed t) (stream-empty))))
+ (seq-map #'identity stream)
+ (should-not consumed)))
+
+(ert-deftest stream-pop-test ()
+ (let* ((str (stream '(1 2 3)))
+ (first (stream-pop str))
+ (stream-empty (stream-empty)))
+ (should (= 1 first))
+ (should (= 2 (stream-first str)))
+ (should (null (stream-pop stream-empty)))))
+
+(provide 'stream-tests)
+;;; stream-tests.el ends here
diff --git a/packages/svg-clock/svg-clock.el b/packages/svg-clock/svg-clock.el
index 438885e..3603651 100644
--- a/packages/svg-clock/svg-clock.el
+++ b/packages/svg-clock/svg-clock.el
@@ -6,7 +6,7 @@
;; Author: Ulf Jasper <address@hidden>
;; Created: 22. Sep. 2011
;; Keywords: demo, svg, clock
-;; Version: 0.5
+;; Version: 1.0
;; Package-Requires: ((svg "0.1") (emacs "25.0"))
;; This file is part of GNU Emacs.
@@ -43,7 +43,7 @@
;;; News:
-;; Version FIXME
+;; Version 1.0
;; New function `svg-clock-insert'. Removed customization
;; options.
diff --git a/packages/swiper/Makefile b/packages/swiper/Makefile
index 453f709..b3857c9 100644
--- a/packages/swiper/Makefile
+++ b/packages/swiper/Makefile
@@ -1,6 +1,6 @@
emacs ?= emacs
-LOAD = -l ivy.el -l swiper.el
+LOAD = -l colir.el -l ivy.el -l swiper.el
.PHONY: all compile clean
@@ -10,7 +10,7 @@ test:
$(emacs) -batch $(LOAD) -l ivy-test.el -f ert-run-tests-batch-and-exit
compile:
- $(emacs) -batch $(LOAD) --eval "(mapc #'byte-compile-file '(\"ivy.el\"
\"swiper.el\"))"
+ $(emacs) -batch $(LOAD) --eval "(mapc #'byte-compile-file '(\"ivy.el\"
\"swiper.el\" \"counsel.el\"))"
clean:
rm -f *.elc
diff --git a/packages/swiper/README.md b/packages/swiper/README.md
index 6482463..0d80f8d 100644
--- a/packages/swiper/README.md
+++ b/packages/swiper/README.md
@@ -13,4 +13,39 @@ The package uses the `ivy` back end for the overview, see
also
-There's also a one minute [video
demo](https://www.youtube.com/watch?v=s3qwiAtKjuA).
+There's also a ten minute [video
demo](https://www.youtube.com/watch?v=VvnJQpTFVDc).
+
+## Ivy
+
+Ivy is a generic completion method for Emacs, similar to
+`icomplete-mode`. It aims to be more efficient, more simple, and more
+pleasant to use than the alternatives. It's also highly customizable
+and very small.
+
+To try it, just call <kbd>M-x</kbd> `ivy-mode`, and all generic
+completion, including file and buffer names, will be done with Ivy.
+
+## Installation
+
+You can install the package from MELPA / GNU ELPA.
+Here is some typical configuration:
+
+```elisp
+(ivy-mode 1)
+(setq ivy-use-virtual-buffers t)
+(global-set-key "\C-s" 'swiper)
+(global-set-key (kbd "C-c C-r") 'ivy-resume)
+(global-set-key (kbd "<f6>") 'ivy-resume)
+(global-set-key (kbd "M-x") 'counsel-M-x)
+(global-set-key (kbd "C-x C-f") 'counsel-find-file)
+(global-set-key (kbd "<f1> f") 'counsel-describe-function)
+(global-set-key (kbd "<f1> v") 'counsel-describe-variable)
+(global-set-key (kbd "<f1> l") 'counsel-load-library)
+(global-set-key (kbd "<f2> i") 'counsel-info-lookup-symbol)
+(global-set-key (kbd "<f2> u") 'counsel-unicode-char)
+(global-set-key (kbd "C-c g") 'counsel-git)
+(global-set-key (kbd "C-c j") 'counsel-git-grep)
+(global-set-key (kbd "C-c k") 'counsel-ag)
+(global-set-key (kbd "C-x l") 'counsel-locate)
+(global-set-key (kbd "C-S-o") 'counsel-rhythmbox)
+```
diff --git a/packages/swiper/colir.el b/packages/swiper/colir.el
new file mode 100644
index 0000000..e11ef7d
--- /dev/null
+++ b/packages/swiper/colir.el
@@ -0,0 +1,102 @@
+;;; colir.el --- Color blending library -*- lexical-binding: t -*-
+
+;; Copyright (C) 2015 Free Software Foundation, Inc.
+
+;; Author: Oleh Krehel <address@hidden>
+
+;; 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, 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.
+
+;; For a full copy of the GNU General Public License
+;; see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; This package solves the problem of adding a face with a background
+;; to text which may already have a background. In all conflicting
+;; areas, instead of choosing either the original or the new
+;; background face, their blended sum is used.
+;;
+;; The blend mode functions are taken from
http://en.wikipedia.org/wiki/Blend_modes.
+
+;;; Code:
+
+(require 'color)
+
+(defcustom colir-compose-method 'colir-compose-alpha
+ "Select a method to compose two color channels."
+ :type '(choice
+ (const colir-compose-alpha)
+ (const colir-compose-overlay)
+ (const colir-compose-soft-light))
+ :group 'ivy)
+
+(defun colir-compose-soft-light (a b)
+ "Compose A and B channels."
+ (if (< b 0.5)
+ (+ (* 2 a b) (* a a (- 1 b b)))
+ (+ (* 2 a (- 1 b)) (* (sqrt a) (- (* 2 b) 1)))))
+
+(defun colir-compose-overlay (a b)
+ "Compose A and B channels."
+ (if (< a 0.5)
+ (* 2 a b)
+ (- 1 (* 2 (- 1 a) (- 1 b)))))
+
+(defun colir-compose-alpha (a b &optional alpha gamma)
+ "Compose A and B channels."
+ (setq alpha (or alpha 0.5))
+ (setq gamma (or gamma 2.2))
+ (+ (* (expt a gamma) alpha) (* (expt b gamma) (- 1 alpha))))
+
+(defun colir-blend (c1 c2)
+ "Blend the two colors C1 and C2 using `colir-compose-method'.
+C1 and C2 are triples of floats in [0.0 1.0] range."
+ (apply #'color-rgb-to-hex
+ (cl-mapcar
+ (if (eq (frame-parameter nil 'background-mode) 'dark)
+ ;; this method works nicely for dark themes
+ 'colir-compose-soft-light
+ colir-compose-method)
+ c1 c2)))
+
+(defun colir-blend-face-background (start end face &optional object)
+ "Append to the face property of the text from START to END the face FACE.
+When the text already has a face with a non-plain background,
+blend it with the background of FACE.
+Optional argument OBJECT is the string or buffer containing the text.
+See also `font-lock-append-text-property'."
+ (let (next prev)
+ (while (/= start end)
+ (setq next (next-single-property-change start 'face object end)
+ prev (get-text-property start 'face object))
+ (when (listp prev)
+ (setq prev (cl-find-if #'atom prev)))
+ (if prev
+ (let ((background-prev (face-background prev)))
+ (progn
+ (put-text-property
+ start next 'face
+ (if background-prev
+ (cons `(background-color
+ . ,(colir-blend
+ (color-name-to-rgb background-prev)
+ (color-name-to-rgb (face-background face nil
t))))
+ prev)
+ (list face prev))
+ object)))
+ (put-text-property start next 'face face object))
+ (setq start next))))
+
+(provide 'colir)
+
+;;; colir.el ends here
diff --git a/packages/swiper/counsel.el b/packages/swiper/counsel.el
index 28d10bd..9c86ec0 100644
--- a/packages/swiper/counsel.el
+++ b/packages/swiper/counsel.el
@@ -1,8 +1,12 @@
-;;; consel.el --- Elisp completion at point -*- lexical-binding: t -*-
+;;; counsel.el --- Various completion functions using Ivy -*- lexical-binding:
t -*-
;; Copyright (C) 2015 Free Software Foundation, Inc.
;; Author: Oleh Krehel <address@hidden>
+;; URL: https://github.com/abo-abo/swiper
+;; Version: 0.1.0
+;; Package-Requires: ((emacs "24.1") (swiper "0.4.0"))
+;; Keywords: completion, matching
;; This file is part of GNU Emacs.
@@ -21,20 +25,304 @@
;;; Commentary:
;;
-;; Just call `counsel' to start completing the `obarray'.
-;; The initial (optional) input is thing-at-point.
+;; Just call one of the interactive functions in this file to complete
+;; the corresponding thing using `ivy'.
+;;
+;; Currently available: Elisp symbols, Clojure symbols, Git files.
;;; Code:
-(require 'ivy)
+(require 'swiper)
+(require 'etags)
+
+(defvar counsel-completion-beg nil
+ "Completion bounds start.")
-(defun counsel ()
+(defvar counsel-completion-end nil
+ "Completion bounds end.")
+
+;;;###autoload
+(defun counsel-el ()
"Elisp completion at point."
(interactive)
- (counsel--generic
- (lambda (str) (all-completions str obarray))))
+ (let* ((bnd (unless (and (looking-at ")")
+ (eq (char-before) ?\())
+ (bounds-of-thing-at-point
+ 'symbol)))
+ (str (if bnd
+ (buffer-substring-no-properties
+ (car bnd)
+ (cdr bnd))
+ ""))
+ (ivy-height 7)
+ (funp (eq (char-before (car bnd)) ?\())
+ symbol-names)
+ (if bnd
+ (progn
+ (setq counsel-completion-beg
+ (move-marker (make-marker) (car bnd)))
+ (setq counsel-completion-end
+ (move-marker (make-marker) (cdr bnd))))
+ (setq counsel-completion-beg nil)
+ (setq counsel-completion-end nil))
+ (if (string= str "")
+ (mapatoms
+ (lambda (x)
+ (when (symbolp x)
+ (push (symbol-name x) symbol-names))))
+ (setq symbol-names
+ (all-completions str obarray
+ (and funp
+ (lambda (x)
+ (or (functionp x)
+ (macrop x)
+ (special-form-p x)))))))
+ (ivy-read "Symbol name: " symbol-names
+ :predicate (and funp #'functionp)
+ :initial-input str
+ :action #'counsel--el-action)))
+
+(declare-function slime-symbol-start-pos "ext:slime")
+(declare-function slime-symbol-end-pos "ext:slime")
+(declare-function slime-contextual-completions "ext:slime-c-p-c")
+
+;;;###autoload
+(defun counsel-cl ()
+ "Common Lisp completion at point."
+ (interactive)
+ (setq counsel-completion-beg (slime-symbol-start-pos))
+ (setq counsel-completion-end (slime-symbol-end-pos))
+ (ivy-read "Symbol name: "
+ (car (slime-contextual-completions
+ counsel-completion-beg
+ counsel-completion-end))
+ :action #'counsel--el-action))
+
+(defun counsel--el-action (symbol)
+ "Insert SYMBOL, erasing the previous one."
+ (when (stringp symbol)
+ (with-ivy-window
+ (when counsel-completion-beg
+ (delete-region
+ counsel-completion-beg
+ counsel-completion-end))
+ (setq counsel-completion-beg
+ (move-marker (make-marker) (point)))
+ (insert symbol)
+ (setq counsel-completion-end
+ (move-marker (make-marker) (point))))))
+
+(declare-function deferred:sync! "ext:deferred")
+(declare-function jedi:complete-request "ext:jedi-core")
+(declare-function jedi:ac-direct-matches "ext:jedi")
+
+(defun counsel-jedi ()
+ "Python completion at point."
+ (interactive)
+ (let ((bnd (bounds-of-thing-at-point 'symbol)))
+ (if bnd
+ (progn
+ (setq counsel-completion-beg (car bnd))
+ (setq counsel-completion-end (cdr bnd)))
+ (setq counsel-completion-beg nil)
+ (setq counsel-completion-end nil)))
+ (deferred:sync!
+ (jedi:complete-request))
+ (ivy-read "Symbol name: " (jedi:ac-direct-matches)
+ :action #'counsel--py-action))
+
+(defun counsel--py-action (symbol)
+ "Insert SYMBOL, erasing the previous one."
+ (when (stringp symbol)
+ (with-ivy-window
+ (when counsel-completion-beg
+ (delete-region
+ counsel-completion-beg
+ counsel-completion-end))
+ (setq counsel-completion-beg
+ (move-marker (make-marker) (point)))
+ (insert symbol)
+ (setq counsel-completion-end
+ (move-marker (make-marker) (point)))
+ (when (equal (get-text-property 0 'symbol symbol) "f")
+ (insert "()")
+ (setq counsel-completion-end
+ (move-marker (make-marker) (point)))
+ (backward-char 1)))))
+
+(defvar counsel-describe-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "C-.") #'counsel-find-symbol)
+ (define-key map (kbd "C-,") #'counsel--info-lookup-symbol)
+ map))
+
+(defun counsel-find-symbol ()
+ "Jump to the definition of the current symbol."
+ (interactive)
+ (ivy-exit-with-action #'counsel--find-symbol))
+
+(defun counsel--info-lookup-symbol ()
+ "Lookup the current symbol in the info docs."
+ (interactive)
+ (ivy-exit-with-action #'counsel-info-lookup-symbol))
+
+(defun counsel--find-symbol (x)
+ "Find symbol definition that corresponds to string X."
+ (with-no-warnings
+ (ring-insert find-tag-marker-ring (point-marker)))
+ (let ((full-name (get-text-property 0 'full-name x)))
+ (if full-name
+ (find-library full-name)
+ (let ((sym (read x)))
+ (cond ((and (eq (ivy-state-caller ivy-last)
+ 'counsel-describe-variable)
+ (boundp sym))
+ (find-variable sym))
+ ((fboundp sym)
+ (find-function sym))
+ ((boundp sym)
+ (find-variable sym))
+ ((or (featurep sym)
+ (locate-library
+ (prin1-to-string sym)))
+ (find-library
+ (prin1-to-string sym)))
+ (t
+ (error "Couldn't fild definition of %s"
+ sym)))))))
+
+(defvar counsel-describe-symbol-history nil
+ "History for `counsel-describe-variable' and `counsel-describe-function'.")
+
+(defun counsel-symbol-at-point ()
+ "Return current symbol at point as a string."
+ (let ((s (thing-at-point 'symbol)))
+ (and (stringp s)
+ (if (string-match "\\`[`']?\\(.*?\\)'?\\'" s)
+ (match-string 1 s)
+ s))))
+
+(defun counsel-variable-list ()
+ "Return the list of all currently bound variables."
+ (let (cands)
+ (mapatoms
+ (lambda (vv)
+ (when (or (get vv 'variable-documentation)
+ (and (boundp vv) (not (keywordp vv))))
+ (push (symbol-name vv) cands))))
+ cands))
+
+;;;###autoload
+(defun counsel-describe-variable ()
+ "Forward to `describe-variable'."
+ (interactive)
+ (let ((enable-recursive-minibuffers t))
+ (ivy-read
+ "Describe variable: "
+ (counsel-variable-list)
+ :keymap counsel-describe-map
+ :preselect (counsel-symbol-at-point)
+ :history 'counsel-describe-symbol-history
+ :require-match t
+ :sort t
+ :action (lambda (x)
+ (describe-variable
+ (intern x)))
+ :caller 'counsel-describe-variable)))
+
+(ivy-set-actions
+ 'counsel-describe-variable
+ '(("i" counsel-info-lookup-symbol "info")
+ ("d" counsel--find-symbol "definition")))
+
+(ivy-set-actions
+ 'counsel-describe-function
+ '(("i" counsel-info-lookup-symbol "info")
+ ("d" counsel--find-symbol "definition")))
+
+(ivy-set-actions
+ 'counsel-M-x
+ '(("d" counsel--find-symbol "definition")))
+
+;;;###autoload
+(defun counsel-describe-function ()
+ "Forward to `describe-function'."
+ (interactive)
+ (let ((enable-recursive-minibuffers t))
+ (ivy-read "Describe function: "
+ (let (cands)
+ (mapatoms
+ (lambda (x)
+ (when (fboundp x)
+ (push (symbol-name x) cands))))
+ cands)
+ :keymap counsel-describe-map
+ :preselect (counsel-symbol-at-point)
+ :history 'counsel-describe-symbol-history
+ :require-match t
+ :sort t
+ :action (lambda (x)
+ (describe-function
+ (intern x)))
+ :caller 'counsel-describe-function)))
-(defun couns-clj ()
+(defvar info-lookup-mode)
+(declare-function info-lookup->completions "info-look")
+(declare-function info-lookup->mode-value "info-look")
+(declare-function info-lookup-select-mode "info-look")
+(declare-function info-lookup-change-mode "info-look")
+(declare-function info-lookup "info-look")
+
+;;;###autoload
+(defun counsel-info-lookup-symbol (symbol &optional mode)
+ "Forward to (`info-describe-symbol' SYMBOL MODE) with ivy completion."
+ (interactive
+ (progn
+ (require 'info-look)
+ (let* ((topic 'symbol)
+ (mode (cond (current-prefix-arg
+ (info-lookup-change-mode topic))
+ ((info-lookup->mode-value
+ topic (info-lookup-select-mode))
+ info-lookup-mode)
+ ((info-lookup-change-mode topic))))
+ (completions (info-lookup->completions topic mode))
+ (enable-recursive-minibuffers t)
+ (value (ivy-read
+ "Describe symbol: "
+ (mapcar #'car completions)
+ :sort t)))
+ (list value info-lookup-mode))))
+ (require 'info-look)
+ (info-lookup 'symbol symbol mode))
+
+(defvar counsel-unicode-char-history nil
+ "History for `counsel-unicode-char'.")
+
+;;;###autoload
+(defun counsel-unicode-char ()
+ "Insert a Unicode character at point."
+ (interactive)
+ (let ((minibuffer-allow-text-properties t))
+ (setq counsel-completion-beg (point))
+ (setq counsel-completion-end (point))
+ (ivy-read "Unicode name: "
+ (mapcar (lambda (x)
+ (propertize
+ (format "% -60s%c" (car x) (cdr x))
+ 'result (cdr x)))
+ (ucs-names))
+ :action (lambda (char)
+ (with-ivy-window
+ (delete-region counsel-completion-beg
counsel-completion-end)
+ (setq counsel-completion-beg (point))
+ (insert-char (get-text-property 0 'result char))
+ (setq counsel-completion-end (point))))
+ :history 'counsel-unicode-char-history)))
+
+(declare-function cider-sync-request:complete "ext:cider-client")
+;;;###autoload
+(defun counsel-clj ()
"Clojure completion at point."
(interactive)
(counsel--generic
@@ -43,7 +331,8 @@
#'cl-caddr
(cider-sync-request:complete str ":same")))))
-(defun couns-git ()
+;;;###autoload
+(defun counsel-git ()
"Find file in the current Git repository."
(interactive)
(let* ((default-directory (locate-dominating-file
@@ -53,9 +342,329 @@
"git ls-files --full-name --")
"\n"
t))
- (file (ivy-read "Find file: " cands)))
- (when file
- (find-file file))))
+ (action `(lambda (x)
+ (let ((default-directory ,default-directory))
+ (find-file x)))))
+ (ivy-read "Find file: " cands
+ :action action)))
+
+(defvar counsel--git-grep-dir nil
+ "Store the base git directory.")
+
+(defvar counsel--git-grep-count nil
+ "Store the line count in current repository.")
+
+(defun counsel-more-chars (n)
+ "Return two fake candidates prompting for at least N input."
+ (list ""
+ (format "%d chars more" (- n (length ivy-text)))))
+
+(defvar counsel-git-grep-cmd "git --no-pager grep --full-name -n --no-color -i
-e %S"
+ "Store the command for `counsel-git-grep'.")
+
+(defun counsel-git-grep-function (string &optional _pred &rest _unused)
+ "Grep in the current git repository for STRING."
+ (if (and (> counsel--git-grep-count 20000)
+ (< (length string) 3))
+ (counsel-more-chars 3)
+ (let* ((default-directory counsel--git-grep-dir)
+ (cmd (format counsel-git-grep-cmd
+ (setq ivy--old-re (ivy--regex string t)))))
+ (if (<= counsel--git-grep-count 20000)
+ (split-string (shell-command-to-string cmd) "\n" t)
+ (counsel--gg-candidates (ivy--regex string))
+ nil))))
+
+(defvar counsel-git-grep-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "C-l") 'counsel-git-grep-recenter)
+ (define-key map (kbd "M-q") 'counsel-git-grep-query-replace)
+ map))
+
+(defun counsel-git-grep-query-replace ()
+ "Start `query-replace' with string to replace from last search string."
+ (interactive)
+ (if (null (window-minibuffer-p))
+ (user-error
+ "Should only be called in the minibuffer through
`counsel-git-grep-map'")
+ (let* ((enable-recursive-minibuffers t)
+ (from (ivy--regex ivy-text))
+ (to (query-replace-read-to from "Query replace" t)))
+ (ivy-exit-with-action
+ (lambda (_)
+ (let (done-buffers)
+ (dolist (cand ivy--old-cands)
+ (when (string-match "\\`\\(.*?\\):\\([0-9]+\\):\\(.*\\)\\'" cand)
+ (with-ivy-window
+ (let ((file-name (match-string-no-properties 1 cand)))
+ (setq file-name (expand-file-name file-name
counsel--git-grep-dir))
+ (unless (member file-name done-buffers)
+ (push file-name done-buffers)
+ (find-file file-name)
+ (goto-char (point-min)))
+ (perform-replace from to t t nil)))))))))))
+
+(defun counsel-git-grep-recenter ()
+ (interactive)
+ (with-ivy-window
+ (counsel-git-grep-action ivy--current)
+ (recenter-top-bottom)))
+
+(defun counsel-git-grep-action (x)
+ (when (string-match "\\`\\(.*?\\):\\([0-9]+\\):\\(.*\\)\\'" x)
+ (with-ivy-window
+ (let ((file-name (match-string-no-properties 1 x))
+ (line-number (match-string-no-properties 2 x)))
+ (find-file (expand-file-name file-name counsel--git-grep-dir))
+ (goto-char (point-min))
+ (forward-line (1- (string-to-number line-number)))
+ (re-search-forward (ivy--regex ivy-text t) (line-end-position) t)
+ (unless (eq ivy-exit 'done)
+ (swiper--cleanup)
+ (swiper--add-overlays (ivy--regex ivy-text)))))))
+
+(defvar counsel-git-grep-history nil
+ "History for `counsel-git-grep'.")
+
+(defvar counsel-git-grep-cmd-history
+ '("git --no-pager grep --full-name -n --no-color -i -e %S")
+ "History for `counsel-git-grep' shell commands.")
+
+;;;###autoload
+(defun counsel-git-grep (&optional cmd initial-input)
+ "Grep for a string in the current git repository.
+When CMD is a string, use it as a \"git grep\" command.
+When CMD is non-nil, prompt for a specific \"git grep\" command.
+INITIAL-INPUT can be given as the initial minibuffer input."
+ (interactive "P")
+ (cond
+ ((stringp cmd)
+ (setq counsel-git-grep-cmd cmd))
+ (cmd
+ (setq counsel-git-grep-cmd
+ (ivy-read "cmd: " counsel-git-grep-cmd-history
+ :history 'counsel-git-grep-cmd-history))
+ (setq counsel-git-grep-cmd-history
+ (delete-dups counsel-git-grep-cmd-history)))
+ (t
+ (setq counsel-git-grep-cmd "git --no-pager grep --full-name -n --no-color
-i -e %S")))
+ (setq counsel--git-grep-dir
+ (locate-dominating-file default-directory ".git"))
+ (if (null counsel--git-grep-dir)
+ (error "Not in a git repository")
+ (setq counsel--git-grep-count (counsel--gg-count "" t))
+ (ivy-read "git grep: " 'counsel-git-grep-function
+ :initial-input initial-input
+ :matcher #'counsel-git-grep-matcher
+ :dynamic-collection (> counsel--git-grep-count 20000)
+ :keymap counsel-git-grep-map
+ :action #'counsel-git-grep-action
+ :unwind #'swiper--cleanup
+ :history 'counsel-git-grep-history
+ :caller 'counsel-git-grep)))
+
+(defcustom counsel-find-file-at-point nil
+ "When non-nil, add file-at-point to the list of candidates."
+ :type 'boolean
+ :group 'ivy)
+
+(declare-function ffap-guesser "ffap")
+
+(defvar counsel-find-file-map (make-sparse-keymap))
+
+;;;###autoload
+(defun counsel-find-file ()
+ "Forward to `find-file'."
+ (interactive)
+ (ivy-read "Find file: " 'read-file-name-internal
+ :matcher #'counsel--find-file-matcher
+ :action
+ (lambda (x)
+ (with-ivy-window
+ (find-file (expand-file-name x ivy--directory))))
+ :preselect (when counsel-find-file-at-point
+ (require 'ffap)
+ (ffap-guesser))
+ :require-match 'confirm-after-completion
+ :history 'file-name-history
+ :keymap counsel-find-file-map))
+
+(defcustom counsel-find-file-ignore-regexp nil
+ "A regexp of files to ignore while in `counsel-find-file'.
+These files are un-ignored if `ivy-text' matches them.
+The common way to show all files is to start `ivy-text' with a dot.
+Possible value: \"\\(?:\\`[#.]\\)\\|\\(?:[#~]\\'\\)\"."
+ :group 'ivy)
+
+(defun counsel--find-file-matcher (regexp candidates)
+ "Return REGEXP-matching CANDIDATES.
+Skip some dotfiles unless `ivy-text' requires them."
+ (let ((res (cl-remove-if-not
+ (lambda (x)
+ (string-match regexp x))
+ candidates)))
+ (if (or (null counsel-find-file-ignore-regexp)
+ (string-match counsel-find-file-ignore-regexp ivy-text))
+ res
+ (cl-remove-if
+ (lambda (x)
+ (string-match counsel-find-file-ignore-regexp x))
+ res))))
+
+(defun counsel-git-grep-matcher (regexp candidates)
+ (or (and (equal regexp ivy--old-re)
+ ivy--old-cands)
+ (prog1
+ (setq ivy--old-cands
+ (cl-remove-if-not
+ (lambda (x)
+ (ignore-errors
+ (when (string-match "^[^:]+:[^:]+:" x)
+ (setq x (substring x (match-end 0)))
+ (if (stringp regexp)
+ (string-match regexp x)
+ (let ((res t))
+ (dolist (re regexp)
+ (setq res
+ (and res
+ (ignore-errors
+ (if (cdr re)
+ (string-match (car re) x)
+ (not (string-match (car re)
x)))))))
+ res)))))
+ candidates))
+ (setq ivy--old-re regexp))))
+
+(defvar counsel--async-time nil
+ "Store the time when a new process was started.
+Or the time of the last minibuffer update.")
+
+(defun counsel--async-command (cmd)
+ (let* ((counsel--process " *counsel*")
+ (proc (get-process counsel--process))
+ (buff (get-buffer counsel--process)))
+ (when proc
+ (delete-process proc))
+ (when buff
+ (kill-buffer buff))
+ (setq proc (start-process-shell-command
+ counsel--process
+ counsel--process
+ cmd))
+ (setq counsel--async-time (current-time))
+ (set-process-sentinel proc #'counsel--async-sentinel)
+ (set-process-filter proc #'counsel--async-filter)))
+
+(defun counsel--async-sentinel (process event)
+ (if (string= event "finished\n")
+ (progn
+ (with-current-buffer (process-buffer process)
+ (setq ivy--all-candidates
+ (ivy--sort-maybe
+ (split-string (buffer-string) "\n" t)))
+ (if (null ivy--old-cands)
+ (setq ivy--index
+ (or (ivy--preselect-index
+ (ivy-state-preselect ivy-last)
+ ivy--all-candidates)
+ 0))
+ (ivy--recompute-index
+ ivy-text
+ (funcall ivy--regex-function ivy-text)
+ ivy--all-candidates))
+ (setq ivy--old-cands ivy--all-candidates))
+ (ivy--exhibit))
+ (if (string= event "exited abnormally with code 1\n")
+ (progn
+ (setq ivy--all-candidates '("Error"))
+ (setq ivy--old-cands ivy--all-candidates)
+ (ivy--exhibit)))))
+
+(defun counsel--async-filter (process str)
+ "Receive from PROCESS the output STR.
+Update the minibuffer with the amount of lines collected every
+0.5 seconds since the last update."
+ (with-current-buffer (process-buffer process)
+ (insert str))
+ (let (size)
+ (when (time-less-p
+ ;; 0.5s
+ '(0 0 500000 0)
+ (time-since counsel--async-time))
+ (with-current-buffer (process-buffer process)
+ (goto-char (point-min))
+ (setq size (- (buffer-size) (forward-line (buffer-size)))))
+ (ivy--insert-minibuffer
+ (format "\ncollected: %d" size))
+ (setq counsel--async-time (current-time)))))
+
+(defun counsel-locate-action-extern (x)
+ "Use xdg-open shell command on X."
+ (call-process shell-file-name nil
+ nil nil
+ shell-command-switch
+ (format "%s %s"
+ (if (eq system-type 'darwin)
+ "open"
+ "xdg-open")
+ (shell-quote-argument x))))
+
+(declare-function dired-jump "dired-x")
+(defun counsel-locate-action-dired (x)
+ "Use `dired-jump' on X."
+ (dired-jump nil x))
+
+(defvar counsel-locate-history nil
+ "History for `counsel-locate'.")
+
+(defcustom counsel-locate-options (if (eq system-type 'darwin)
+ '("-i")
+ '("-i" "--regex"))
+ "Command line options for `locate`."
+ :group 'ivy
+ :type '(repeat string))
+
+(ivy-set-actions
+ 'counsel-locate
+ '(("x" counsel-locate-action-extern "xdg-open")
+ ("d" counsel-locate-action-dired "dired")))
+
+(defun counsel-unquote-regex-parens (str)
+ (replace-regexp-in-string
+ "\\\\)" ")"
+ (replace-regexp-in-string
+ "\\\\(" "("
+ str)))
+
+(defun counsel-locate-function (str &rest _u)
+ (if (< (length str) 3)
+ (counsel-more-chars 3)
+ (counsel--async-command
+ (format "locate %s '%s'"
+ (mapconcat #'identity counsel-locate-options " ")
+ (counsel-unquote-regex-parens
+ (ivy--regex str))))
+ '("" "working...")))
+
+(defun counsel-delete-process ()
+ (let ((process (get-process " *counsel*")))
+ (when process
+ (delete-process process))))
+
+;;;###autoload
+(defun counsel-locate (&optional initial-input)
+ "Call the \"locate\" shell command.
+INITIAL-INPUT can be given as the initial minibuffer input."
+ (interactive)
+ (ivy-read "Locate: " #'counsel-locate-function
+ :initial-input initial-input
+ :dynamic-collection t
+ :history 'counsel-locate-history
+ :action (lambda (file)
+ (with-ivy-window
+ (when file
+ (find-file file))))
+ :unwind #'counsel-delete-process))
(defun counsel--generic (completion-fn)
"Complete thing at point with COMPLETION-FN."
@@ -73,6 +682,620 @@
(delete-region (car bnd) (cdr bnd)))
(insert res))))
+(defun counsel-directory-parent (dir)
+ "Return the directory parent of directory DIR."
+ (concat (file-name-nondirectory
+ (directory-file-name dir)) "/"))
+
+(defun counsel-string-compose (prefix str)
+ "Make PREFIX the display prefix of STR though text properties."
+ (let ((str (copy-sequence str)))
+ (put-text-property
+ 0 1 'display
+ (concat prefix (substring str 0 1))
+ str)
+ str))
+
+;;;###autoload
+(defun counsel-load-library ()
+ "Load a selected the Emacs Lisp library.
+The libraries are offered from `load-path'."
+ (interactive)
+ (let ((dirs load-path)
+ (suffix (concat (regexp-opt '(".el" ".el.gz") t) "\\'"))
+ (cands (make-hash-table :test #'equal))
+ short-name
+ old-val
+ dir-parent
+ res)
+ (dolist (dir dirs)
+ (when (file-directory-p dir)
+ (dolist (file (file-name-all-completions "" dir))
+ (when (string-match suffix file)
+ (unless (string-match "pkg.elc?$" file)
+ (setq short-name (substring file 0 (match-beginning 0)))
+ (if (setq old-val (gethash short-name cands))
+ (progn
+ ;; assume going up directory once will resolve name clash
+ (setq dir-parent (counsel-directory-parent (cdr old-val)))
+ (puthash short-name
+ (cons
+ (counsel-string-compose dir-parent (car old-val))
+ (cdr old-val))
+ cands)
+ (setq dir-parent (counsel-directory-parent dir))
+ (puthash (concat dir-parent short-name)
+ (cons
+ (propertize
+ (counsel-string-compose
+ dir-parent short-name)
+ 'full-name (expand-file-name file dir))
+ dir)
+ cands))
+ (puthash short-name
+ (cons (propertize
+ short-name
+ 'full-name (expand-file-name file dir))
+ dir) cands)))))))
+ (maphash (lambda (_k v) (push (car v) res)) cands)
+ (ivy-read "Load library: " (nreverse res)
+ :action (lambda (x)
+ (load-library
+ (get-text-property 0 'full-name x)))
+ :keymap counsel-describe-map)))
+
+(defvar counsel-gg-state nil
+ "The current state of candidates / count sync.")
+
+(defun counsel--gg-candidates (regex)
+ "Return git grep candidates for REGEX."
+ (setq counsel-gg-state -2)
+ (counsel--gg-count regex)
+ (let* ((default-directory counsel--git-grep-dir)
+ (counsel-gg-process " *counsel-gg*")
+ (proc (get-process counsel-gg-process))
+ (buff (get-buffer counsel-gg-process)))
+ (when proc
+ (delete-process proc))
+ (when buff
+ (kill-buffer buff))
+ (setq proc (start-process-shell-command
+ counsel-gg-process
+ counsel-gg-process
+ (concat
+ (format counsel-git-grep-cmd regex)
+ " | head -n 200")))
+ (set-process-sentinel
+ proc
+ #'counsel--gg-sentinel)))
+
+(defun counsel--gg-sentinel (process event)
+ (if (string= event "finished\n")
+ (progn
+ (with-current-buffer (process-buffer process)
+ (setq ivy--all-candidates
+ (or (split-string (buffer-string) "\n" t)
+ '("")))
+ (setq ivy--old-cands ivy--all-candidates))
+ (when (= 0 (cl-incf counsel-gg-state))
+ (ivy--exhibit)))
+ (if (string= event "exited abnormally with code 1\n")
+ (progn
+ (setq ivy--all-candidates '("Error"))
+ (setq ivy--old-cands ivy--all-candidates)
+ (ivy--exhibit)))))
+
+(defun counsel--gg-count (regex &optional no-async)
+ "Quickly and asynchronously count the amount of git grep REGEX matches.
+When NO-ASYNC is non-nil, do it synchronously."
+ (let ((default-directory counsel--git-grep-dir)
+ (cmd
+ (concat
+ (format
+ (replace-regexp-in-string
+ "--full-name" "-c"
+ counsel-git-grep-cmd)
+ ;; "git grep -i -c '%s'"
+ (replace-regexp-in-string
+ "-" "\\\\-"
+ (replace-regexp-in-string "'" "''" regex)))
+ " | sed 's/.*:\\(.*\\)/\\1/g' | awk '{s+=$1} END {print s}'"))
+ (counsel-ggc-process " *counsel-gg-count*"))
+ (if no-async
+ (string-to-number (shell-command-to-string cmd))
+ (let ((proc (get-process counsel-ggc-process))
+ (buff (get-buffer counsel-ggc-process)))
+ (when proc
+ (delete-process proc))
+ (when buff
+ (kill-buffer buff))
+ (setq proc (start-process-shell-command
+ counsel-ggc-process
+ counsel-ggc-process
+ cmd))
+ (set-process-sentinel
+ proc
+ #'(lambda (process event)
+ (when (string= event "finished\n")
+ (with-current-buffer (process-buffer process)
+ (setq ivy--full-length (string-to-number (buffer-string))))
+ (when (= 0 (cl-incf counsel-gg-state))
+ (ivy--exhibit)))))))))
+
+(defun counsel--M-x-transformer (cand-pair)
+ "Add a binding to CAND-PAIR cdr if the car is bound in the current window.
+CAND-PAIR is (command-name . extra-info)."
+ (let* ((command-name (car cand-pair))
+ (extra-info (cdr cand-pair))
+ (binding (substitute-command-keys (format "\\[%s]" command-name))))
+ (setq binding (replace-regexp-in-string "C-x 6" "<f2>" binding))
+ (if (string-match "^M-x" binding)
+ cand-pair
+ (cons command-name
+ (if extra-info
+ (format " %s (%s)" extra-info (propertize binding 'face
'font-lock-keyword-face))
+ (format " (%s)" (propertize binding 'face
'font-lock-keyword-face)))))))
+
+(defvar smex-initialized-p)
+(defvar smex-ido-cache)
+(declare-function smex-initialize "ext:smex")
+(declare-function smex-detect-new-commands "ext:smex")
+(declare-function smex-update "ext:smex")
+(declare-function smex-rank "ext:smex")
+
+(defun counsel--M-x-prompt ()
+ "M-x plus the string representation of `current-prefix-arg'."
+ (if (not current-prefix-arg)
+ "M-x "
+ (concat
+ (if (eq current-prefix-arg '-)
+ "- "
+ (if (integerp current-prefix-arg)
+ (format "%d " current-prefix-arg)
+ (if (= (car current-prefix-arg) 4)
+ "C-u "
+ (format "%d " (car current-prefix-arg)))))
+ "M-x ")))
+
+;;;###autoload
+(defun counsel-M-x (&optional initial-input)
+ "Ivy version of `execute-extended-command'.
+Optional INITIAL-INPUT is the initial input in the minibuffer."
+ (interactive)
+ (unless initial-input
+ (setq initial-input (cdr (assoc this-command
+ ivy-initial-inputs-alist))))
+ (let* ((store ivy-format-function)
+ (ivy-format-function
+ (lambda (cand-pairs)
+ (funcall
+ store
+ (with-ivy-window
+ (mapcar #'counsel--M-x-transformer cand-pairs)))))
+ (cands obarray)
+ (pred 'commandp)
+ (sort t))
+ (when (require 'smex nil 'noerror)
+ (unless smex-initialized-p
+ (smex-initialize))
+ (smex-detect-new-commands)
+ (smex-update)
+ (setq cands smex-ido-cache)
+ (setq pred nil)
+ (setq sort nil))
+ (ivy-read (counsel--M-x-prompt) cands
+ :predicate pred
+ :require-match t
+ :history 'extended-command-history
+ :action
+ (lambda (cmd)
+ (when (featurep 'smex)
+ (smex-rank (intern cmd)))
+ (let ((prefix-arg current-prefix-arg)
+ (ivy-format-function store))
+ (command-execute (intern cmd) 'record)))
+ :sort sort
+ :keymap counsel-describe-map
+ :initial-input initial-input
+ :caller 'counsel-M-x)))
+
+(declare-function powerline-reset "ext:powerline")
+
+(defun counsel--load-theme-action (x)
+ "Disable current themes and load theme X."
+ (condition-case nil
+ (progn
+ (mapc #'disable-theme custom-enabled-themes)
+ (load-theme (intern x))
+ (when (fboundp 'powerline-reset)
+ (powerline-reset)))
+ (error "Problem loading theme %s" x)))
+
+;;;###autoload
+(defun counsel-load-theme ()
+ "Forward to `load-theme'.
+Usable with `ivy-resume', `ivy-next-line-and-call' and
+`ivy-previous-line-and-call'."
+ (interactive)
+ (ivy-read "Load custom theme: "
+ (mapcar 'symbol-name
+ (custom-available-themes))
+ :action #'counsel--load-theme-action))
+
+(defvar rhythmbox-library)
+(declare-function rhythmbox-load-library "ext:helm-rhythmbox")
+(declare-function dbus-call-method "dbus")
+(declare-function rhythmbox-song-uri "ext:helm-rhythmbox")
+(declare-function helm-rhythmbox-candidates "ext:helm-rhythmbox")
+
+(defun counsel-rhythmbox-enqueue-song (song)
+ "Let Rhythmbox enqueue SONG."
+ (let ((service "org.gnome.Rhythmbox3")
+ (path "/org/gnome/Rhythmbox3/PlayQueue")
+ (interface "org.gnome.Rhythmbox3.PlayQueue"))
+ (dbus-call-method :session service path interface
+ "AddToQueue" (rhythmbox-song-uri song))))
+
+(defvar counsel-rhythmbox-history nil
+ "History for `counsel-rhythmbox'.")
+
+;;;###autoload
+(defun counsel-rhythmbox ()
+ "Choose a song from the Rhythmbox library to play or enqueue."
+ (interactive)
+ (unless (require 'helm-rhythmbox nil t)
+ (error "Please install `helm-rhythmbox'"))
+ (unless rhythmbox-library
+ (rhythmbox-load-library)
+ (while (null rhythmbox-library)
+ (sit-for 0.1)))
+ (ivy-read "Rhythmbox: "
+ (helm-rhythmbox-candidates)
+ :history 'counsel-rhythmbox-history
+ :action
+ '(1
+ ("p" helm-rhythmbox-play-song "Play song")
+ ("e" counsel-rhythmbox-enqueue-song "Enqueue song"))
+ :caller 'counsel-rhythmbox))
+
+(defvar counsel-org-tags nil
+ "Store the current list of tags.")
+
+(defvar org-outline-regexp)
+(defvar org-indent-mode)
+(defvar org-indent-indentation-per-level)
+(defvar org-tags-column)
+(declare-function org-get-tags-string "org")
+(declare-function org-move-to-column "org-compat")
+
+(defun counsel-org-change-tags (tags)
+ (let ((current (org-get-tags-string))
+ (col (current-column))
+ level)
+ ;; Insert new tags at the correct column
+ (beginning-of-line 1)
+ (setq level (or (and (looking-at org-outline-regexp)
+ (- (match-end 0) (point) 1))
+ 1))
+ (cond
+ ((and (equal current "") (equal tags "")))
+ ((re-search-forward
+ (concat "\\([ \t]*" (regexp-quote current) "\\)[ \t]*$")
+ (point-at-eol) t)
+ (if (equal tags "")
+ (delete-region
+ (match-beginning 0)
+ (match-end 0))
+ (goto-char (match-beginning 0))
+ (let* ((c0 (current-column))
+ ;; compute offset for the case of org-indent-mode active
+ (di (if (bound-and-true-p org-indent-mode)
+ (* (1- org-indent-indentation-per-level) (1- level))
+ 0))
+ (p0 (if (equal (char-before) ?*) (1+ (point)) (point)))
+ (tc (+ org-tags-column (if (> org-tags-column 0) (- di) di)))
+ (c1 (max (1+ c0) (if (> tc 0) tc (- (- tc) (string-width
tags)))))
+ (rpl (concat (make-string (max 0 (- c1 c0)) ?\ ) tags)))
+ (replace-match rpl t t)
+ (and c0 indent-tabs-mode (tabify p0 (point)))
+ tags)))
+ (t (error "Tags alignment failed")))
+ (org-move-to-column col)))
+
+(defun counsel-org--set-tags ()
+ (counsel-org-change-tags
+ (if counsel-org-tags
+ (format ":%s:"
+ (mapconcat #'identity counsel-org-tags ":"))
+ "")))
+
+(defvar org-agenda-bulk-marked-entries)
+
+(declare-function org-get-at-bol "org")
+(declare-function org-agenda-error "org-agenda")
+
+(defun counsel-org-tag-action (x)
+ (if (member x counsel-org-tags)
+ (progn
+ (setq counsel-org-tags (delete x counsel-org-tags)))
+ (unless (equal x "")
+ (setq counsel-org-tags (append counsel-org-tags (list x)))
+ (unless (member x ivy--all-candidates)
+ (setq ivy--all-candidates (append ivy--all-candidates (list x))))))
+ (let ((prompt (counsel-org-tag-prompt)))
+ (setf (ivy-state-prompt ivy-last) prompt)
+ (setq ivy--prompt (concat "%-4d " prompt)))
+ (cond ((memq this-command '(ivy-done
+ ivy-alt-done
+ ivy-immediate-done))
+ (if (eq major-mode 'org-agenda-mode)
+ (if (null org-agenda-bulk-marked-entries)
+ (let ((hdmarker (or (org-get-at-bol 'org-hd-marker)
+ (org-agenda-error))))
+ (with-current-buffer (marker-buffer hdmarker)
+ (goto-char hdmarker)
+ (counsel-org--set-tags)))
+ (let ((add-tags (copy-sequence counsel-org-tags)))
+ (dolist (m org-agenda-bulk-marked-entries)
+ (with-current-buffer (marker-buffer m)
+ (save-excursion
+ (goto-char m)
+ (setq counsel-org-tags
+ (delete-dups
+ (append (split-string (org-get-tags-string) ":"
t)
+ add-tags)))
+ (counsel-org--set-tags))))))
+ (counsel-org--set-tags)))
+ ((eq this-command 'ivy-call)
+ (delete-minibuffer-contents))))
+
+(defun counsel-org-tag-prompt ()
+ (format "Tags (%s): "
+ (mapconcat #'identity counsel-org-tags ", ")))
+
+(defvar org-setting-tags)
+(defvar org-last-tags-completion-table)
+(defvar org-tag-persistent-alist)
+(defvar org-tag-alist)
+(defvar org-complete-tags-always-offer-all-agenda-tags)
+
+(declare-function org-at-heading-p "org")
+(declare-function org-back-to-heading "org")
+(declare-function org-get-buffer-tags "org")
+(declare-function org-global-tags-completion-table "org")
+(declare-function org-agenda-files "org")
+(declare-function org-agenda-set-tags "org-agenda")
+
+;;;###autoload
+(defun counsel-org-tag ()
+ "Add or remove tags in org-mode."
+ (interactive)
+ (save-excursion
+ (if (eq major-mode 'org-agenda-mode)
+ (if org-agenda-bulk-marked-entries
+ (setq counsel-org-tags nil)
+ (let ((hdmarker (or (org-get-at-bol 'org-hd-marker)
+ (org-agenda-error))))
+ (with-current-buffer (marker-buffer hdmarker)
+ (goto-char hdmarker)
+ (setq counsel-org-tags
+ (split-string (org-get-tags-string) ":" t)))))
+ (unless (org-at-heading-p)
+ (org-back-to-heading t))
+ (setq counsel-org-tags (split-string (org-get-tags-string) ":" t)))
+ (let ((org-setting-tags t)
+ (org-last-tags-completion-table
+ (append org-tag-persistent-alist
+ (or org-tag-alist (org-get-buffer-tags))
+ (and
+ (or org-complete-tags-always-offer-all-agenda-tags
+ (eq major-mode 'org-agenda-mode))
+ (org-global-tags-completion-table
+ (org-agenda-files))))))
+ (ivy-read (counsel-org-tag-prompt)
+ (lambda (str &rest _unused)
+ (delete-dups
+ (all-completions str 'org-tags-completion-function)))
+ :history 'org-tags-history
+ :action 'counsel-org-tag-action))))
+
+;;;###autoload
+(defun counsel-org-tag-agenda ()
+ "Set tags for the current agenda item."
+ (interactive)
+ (let ((store (symbol-function 'org-set-tags)))
+ (unwind-protect
+ (progn
+ (fset 'org-set-tags
+ (symbol-function 'counsel-org-tag))
+ (org-agenda-set-tags nil nil))
+ (fset 'org-set-tags store))))
+
+(defun counsel-ag-function (string &optional _pred &rest _unused)
+ "Grep in the current directory for STRING."
+ (if (< (length string) 3)
+ (counsel-more-chars 3)
+ (let ((default-directory counsel--git-grep-dir)
+ (regex (counsel-unquote-regex-parens
+ (setq ivy--old-re
+ (ivy--regex string)))))
+ (counsel--async-command
+ (format "ag --vimgrep %S" regex))
+ nil)))
+
+;;;###autoload
+(defun counsel-ag (&optional initial-input initial-directory)
+ "Grep for a string in the current directory using ag.
+INITIAL-INPUT can be given as the initial minibuffer input."
+ (interactive)
+ (setq counsel--git-grep-dir (or initial-directory default-directory))
+ (ivy-read "ag: " 'counsel-ag-function
+ :initial-input initial-input
+ :dynamic-collection t
+ :history 'counsel-git-grep-history
+ :action #'counsel-git-grep-action
+ :unwind (lambda ()
+ (counsel-delete-process)
+ (swiper--cleanup))))
+
+;;;###autoload
+(defun counsel-grep ()
+ "Grep for a string in the current file."
+ (interactive)
+ (setq counsel--git-grep-dir (buffer-file-name))
+ (ivy-read "grep: " 'counsel-grep-function
+ :dynamic-collection t
+ :preselect (format "%d:%s"
+ (line-number-at-pos)
+ (buffer-substring-no-properties
+ (line-beginning-position)
+ (line-end-position)))
+ :history 'counsel-git-grep-history
+ :update-fn (lambda ()
+ (counsel-grep-action ivy--current))
+ :action #'counsel-grep-action
+ :unwind (lambda ()
+ (counsel-delete-process)
+ (swiper--cleanup))
+ :caller 'counsel-grep))
+
+(defun counsel-grep-function (string &optional _pred &rest _unused)
+ "Grep in the current directory for STRING."
+ (if (< (length string) 3)
+ (counsel-more-chars 3)
+ (let ((regex (counsel-unquote-regex-parens
+ (setq ivy--old-re
+ (ivy--regex string)))))
+ (counsel--async-command
+ (format "grep -nP --ignore-case '%s' %s" regex counsel--git-grep-dir))
+ nil)))
+
+(defun counsel-grep-action (x)
+ (when (string-match "\\`\\([0-9]+\\):\\(.*\\)\\'" x)
+ (with-ivy-window
+ (let ((file-name counsel--git-grep-dir)
+ (line-number (match-string-no-properties 1 x)))
+ (find-file file-name)
+ (goto-char (point-min))
+ (forward-line (1- (string-to-number line-number)))
+ (re-search-forward (ivy--regex ivy-text t) (line-end-position) t)
+ (unless (eq ivy-exit 'done)
+ (swiper--cleanup)
+ (swiper--add-overlays (ivy--regex ivy-text)))))))
+
+(defun counsel-recoll-function (string &optional _pred &rest _unused)
+ "Grep in the current directory for STRING."
+ (if (< (length string) 3)
+ (counsel-more-chars 3)
+ (counsel--async-command
+ (format "recoll -t -b '%s'" string))
+ nil))
+
+;; This command uses the recollq command line tool that comes together
+;; with the recoll (the document indexing database) source:
+;; http://www.lesbonscomptes.com/recoll/download.html
+;; You need to build it yourself (together with recoll):
+;; cd ./query && make && sudo cp recollq /usr/local/bin
+;; You can try the GUI version of recoll with:
+;; sudo apt-get install recoll
+;; Unfortunately, that does not install recollq.
+(defun counsel-recoll (&optional initial-input)
+ "Search for a string in the recoll database.
+You'll be given a list of files that match.
+Selecting a file will launch `swiper' for that file.
+INITIAL-INPUT can be given as the initial minibuffer input."
+ (interactive)
+ (ivy-read "recoll: " 'counsel-recoll-function
+ :initial-input initial-input
+ :dynamic-collection t
+ :history 'counsel-git-grep-history
+ :action (lambda (x)
+ (when (string-match "file://\\(.*\\)\\'" x)
+ (let ((file-name (match-string 1 x)))
+ (find-file file-name)
+ (unless (string-match "pdf$" x)
+ (swiper ivy-text)))))))
+
+(defvar tmm-km-list nil)
+(declare-function tmm-get-keymap "tmm")
+(declare-function tmm--completion-table "tmm")
+(declare-function tmm-get-keybind "tmm")
+
+(defun counsel-tmm-prompt (menu)
+ "Select and call an item from the MENU keymap."
+ (let (out
+ choice
+ chosen-string)
+ (setq tmm-km-list nil)
+ (map-keymap (lambda (k v) (tmm-get-keymap (cons k v))) menu)
+ (setq tmm-km-list (nreverse tmm-km-list))
+ (setq out (ivy-read "Menu bar: " (tmm--completion-table tmm-km-list)
+ :require-match t
+ :sort nil))
+ (setq choice (cdr (assoc out tmm-km-list)))
+ (setq chosen-string (car choice))
+ (setq choice (cdr choice))
+ (cond ((keymapp choice)
+ (counsel-tmm-prompt choice))
+ ((and choice chosen-string)
+ (setq last-command-event chosen-string)
+ (call-interactively choice)))))
+
+(defun counsel-tmm ()
+ "Text-mode emulation of looking and choosing from a menubar."
+ (interactive)
+ (require 'tmm)
+ (run-hooks 'menu-bar-update-hook)
+ (counsel-tmm-prompt (tmm-get-keybind [menu-bar])))
+
+(defcustom counsel-yank-pop-truncate nil
+ "When non-nil, truncate the display of long strings."
+ :group 'ivy)
+
+;;;###autoload
+(defun counsel-yank-pop ()
+ "Ivy replacement for `yank-pop'."
+ (interactive)
+ (if (eq last-command 'yank)
+ (progn
+ (setq counsel-completion-end (point))
+ (setq counsel-completion-beg
+ (save-excursion
+ (search-backward (car kill-ring))
+ (point))))
+ (setq counsel-completion-beg (point))
+ (setq counsel-completion-end (point)))
+ (let ((candidates (cl-remove-if
+ (lambda (s)
+ (or (< (length s) 3)
+ (string-match "\\`[\n[:blank:]]+\\'" s)))
+ (delete-dups kill-ring))))
+ (when counsel-yank-pop-truncate
+ (setq candidates
+ (mapcar (lambda (s)
+ (if (string-match "\\`\\(.*\n.*\n.*\n.*\\)\n" s)
+ (progn
+ (let ((s (copy-sequence s)))
+ (put-text-property
+ (match-end 1)
+ (length s)
+ 'display
+ " [...]"
+ s)
+ s))
+ s))
+ candidates)))
+ (ivy-read "kill-ring: " candidates
+ :action 'counsel-yank-pop-action)))
+
+(defun counsel-yank-pop-action (s)
+ "Insert S into the buffer, overwriting the previous yank."
+ (with-ivy-window
+ (delete-region counsel-completion-beg
+ counsel-completion-end)
+ (insert (substring-no-properties s))
+ (setq counsel-completion-end (point))))
+
(provide 'counsel)
;;; counsel.el ends here
diff --git a/packages/swiper/doc/Changelog.org
b/packages/swiper/doc/Changelog.org
new file mode 100644
index 0000000..21076de
--- /dev/null
+++ b/packages/swiper/doc/Changelog.org
@@ -0,0 +1,616 @@
+#+OPTIONS: toc:nil
+* 0.6.0
+** Fixes
+*** =swiper-avy= should use only the current window
+Not all windows. See [[https://github.com/abo-abo/swiper/issues/117][#117]].
+*** fix wrap-around for =ivy-next-line=
+See [[https://github.com/abo-abo/swiper/issues/118][#118]].
+*** =swiper-avy= should do nothing for empty input
+See [[https://github.com/abo-abo/avy/issues/50][#50]].
+*** =ivy-alt-done= should require TRAMP if necessary
+See [[https://github.com/abo-abo/swiper/pull/145][#145]].
+*** =swiper-query-replace= shouldn't miss the first occurrence
+See [[https://github.com/abo-abo/swiper/pull/144][#144]].
+*** =swiper= should not deactivate mark
+*** =ivy-mode= should not switch to TRAMP for certain input
+See [[https://github.com/abo-abo/swiper/pull/145][#145]].
+*** =counsel-find-file= should work better with TRAMP
+"/ssh:foo" should not be cut off
+See [[https://github.com/abo-abo/swiper/pull/145][#145]].
+*** =counsel-find-file= supports Windows drive letters
+See [[https://github.com/abo-abo/swiper/pull/155][#155]].
+*** =counsel-file-file= should work better with files that contain "~"
+See [[https://github.com/abo-abo/swiper/pull/157][#157]].
+*** =counsel-M-x= should respect =ivy-format-function=
+See [[https://github.com/abo-abo/swiper/pull/150][#150]].
+*** =counsel-git-grep= should position better on exit
+See [[https://github.com/abo-abo/swiper/pull/153][#153]].
+*** =ivy-mode= should re-scale text to minibuffer height
+See [[https://github.com/abo-abo/swiper/pull/151][#151]].
+*** =counsel-unicode-char= should use action-style call
+See [[https://github.com/abo-abo/swiper/pull/160][#160]].
+*** =ivy-read= should allow % in prompt string
+See [[https://github.com/abo-abo/swiper/pull/171][#171]].
+*** =ivy-call= should execute in proper window
+See [[https://github.com/abo-abo/swiper/pull/176][#176]].
+** New Features
+*** =ivy-mode=
+**** Open an Info file on the file system
+When in =Info-mode=, press ~g~ and select either "(./)" or "(../)" to
+switch to file name completion. That file will be opened with Info.
+**** Account for =minibuffer-depth-indication-mode=
+If you have =minibuffer-depth-indication-mode= on, the minibuffer
+prompt will indicate the current depth.
+See [[https://github.com/abo-abo/swiper/pull/134][#134]].
+**** Add fuzzy matching function
+To enable fuzzy matching, set your =ivy-re-builders-alist= accordingly:
+#+begin_src elisp
+(setq ivy-re-builders-alist
+ '((t . ivy--regex-fuzzy)))
+#+end_src
+See [[https://github.com/abo-abo/swiper/pull/136][#136]].
+
+See also [[https://github.com/abo-abo/swiper/pull/142][#142]] for toggling
fuzzy matching with ~C-o m~.
+**** =case-fold-search= optimization
+Bind case-fold-search to t when the input is all lower-case:
+
+- input "the" matches both "the" and "The".
+- input "The" matches only "The".
+
+See [[https://github.com/abo-abo/swiper/pull/166][#166]].
+**** Allow to see the candidate index a la =anzu= via =ivy-count-format=
+To have this feature, use something like this:
+#+begin_src elisp
+(setq ivy-count-format "(%d/%d) ")
+#+end_src
+See [[https://github.com/abo-abo/swiper/pull/167][#167]].
+
+You can also set this to "", if you don't want any count, see
[[https://github.com/abo-abo/swiper/pull/188][#188]].
+**** Allow to add additional exit points for any command
+Example for =ivy-switch-to-buffer=:
+#+begin_src elisp
+(ivy-set-actions
+ 'ivy-switch-buffer
+ '(("k"
+ (lambda (x)
+ (kill-buffer x)
+ (ivy--reset-state ivy-last))
+ "kill")
+ ("j"
+ ivy--switch-buffer-other-window-action
+ "other")))
+#+end_src
+
+After this:
+
+- use ~M-o k~ to kill a buffer
+- use ~M-o j~ to switch to a buffer in other window
+
+You can always use ~M-o o~ to access the default action. When there is
+only one action, ~M-o~ does the same as ~C-m~.
+
+See [[https://github.com/abo-abo/swiper/pull/164][#164]].
+
+
+
+
+
+
+
+
+*** =counsel-describe-function= and =counsel-decribe-variable=
+**** Add a binding to look up the symbol in info
+Press ~C-,~ to look up the symbol in info, instead of the default
+describe action.
+See [[https://github.com/abo-abo/swiper/pull/121][#121]].
+**** Handle symbol-at-point better in non-Elisp buffers
+See [[https://github.com/abo-abo/swiper/pull/126][#126]].
+*** =ivy-switch-buffer=
+**** New face =ivy-virtual=
+See [[https://github.com/abo-abo/swiper/pull/129][#129]].
+**** Deal better with invisible buffers
+See [[https://github.com/abo-abo/swiper/pull/135][#135]].
+**** Add custom keymap
+You can customize =ivy-switch-buffer-map=.
+
+See [[https://github.com/abo-abo/swiper/pull/164][#164]].
+**** Add extra actions
+Add a =kill-buffer= action, and =switch-to-buffer-other-window= action.
+*** =counsel-git-grep=
+**** Add Async
+Make it fully async: the process =git grep= will be killed and
+restarted on new input. This results in almost no keyboard delay.
+**** Own history variable
+*** =swiper=
+**** Own history variable
+Having own history variable allows to get more use of ~M-p~, ~M-n~ and ~C-r~.
+*** =counsel-el=
+**** Switch to action-style call
+This allows to make use of ~C-M-n~ and ~C-M-p~.
+*** =counsel-locate=
+**** Add Async
+**** Add extra actions
+In addition to the default action of opening a file add:
+
+- =xdg-open= action
+- =dired= action
+
+Press ~M-o~ or ~C-o~ to access these actions.
+**** Add own history
+
+*** API
+**** Add :matcher
+A matcher is a function that accepts a regexp and a list of candidates
+and returns the filtered list of candidates.
+
+The default matcher is basically =cl-remove-if-not= + =string-match=.
+If you'd like to customize this, pass your own matcher.
+
+See =counsel-git-grep-matcher= for an example.
+**** Allow to customize the initial input for all commands
+Customize =ivy-initial-inputs-alist= for this.
+See [[https://github.com/abo-abo/swiper/pull/140][#140]].
+**** =ivy-sort-functions-alist= should also examine =this-command=
+**** :dynamic-collection is now a boolean
+Pass the collection function as the second var instead.
+
+** New Commands
+*** =ivy-call=
+Execute the current action for the current candidate without exiting
+the minibuffer. Bound to ~C-M-m~ or ~M-RET~ or ~C-o g~.
+
+
+*** =counsel-find-file=
+Forward to =find-file= with Ivy completion.
+
+=ivy-next-line-and-call= as well as =ivy-resume= should work for this command.
+
+The variable =counsel-find-file-ignore-regexp= allows to ignore
+certain files, like dot files. Input a leading dot to see all files.
+
+The variable =counsel-find-file-at-point= allows to automatically use
+=ffap=. You also can do it manually with ~M-n~ when the point is on a file
name.
+
+The variable =counsel-find-file-map= allows to customize the
+minibuffer key bindings for this command.
+
+Recommended binding:
+
+#+begin_src elisp
+(global-set-key (kbd "C-x C-f") 'counsel-find-file)
+#+end_src
+
+You can peek at files with ~C-M-n~ and ~C-M-p~.
+
+See [[https://github.com/abo-abo/swiper/issues/122][#122]] and
[[https://github.com/abo-abo/swiper/issues/123][#123]].
+
+See [[https://github.com/abo-abo/swiper/pull/152][#152]] about ~M-n~, ~M-p~
and ~M-i~ switching directories when necessary.
+
+*** =ivy-recentf=
+Find a file on =recentf-list=.
+
+Note that if your set =ivy-use-virtual-buffers=, =recentf-list= is
+merged into candidates list for =ivy-switch-buffer=. But if you want
+it separately, you can use this command.
+
+See [[https://github.com/abo-abo/swiper/issues/124][#124]].
+*** =ivy-yank-word=
+Add word at point to minibuffer input.
+
+This is similar to what ~C-w~ does for =isearch=. However it's bound
+to ~M-j~ instead of ~C-w~, since ~C-w~ is bound to =kill-region= - a
+useful command.
+
+See [[https://github.com/abo-abo/swiper/issues/125][#125]].
+*** =counsel-M-x=
+Forward to =execute-extended-command= with Ivy completion.
+The candidate list will also display the key binding for each bound command.
+
+This command will piggyback on =smex= for sorting, if =smex= is installed.
+
+Use =counsel-M-x-initial-input= to customize the initial input for
+this command. By default, it's "^" - the regex character that
+indicates beginning of string. This results in much faster matching,
+since you usually type the command name from the start.
+
+See [[https://github.com/abo-abo/swiper/pull/136][#136]] and
[[https://github.com/abo-abo/swiper/pull/138][#138]].
+
+*** =hydra-ivy=
+Press ~C-o~ to toggle the Hydra for Ivy.
+It gives access to shorter bindings and many customizable options.
+
+Use ~C-o >~ to grow the minibuffer.
+Use ~C-o <~ to shrink the minibuffer.
+
+See [[https://github.com/abo-abo/swiper/pull/151][#151]].
+
+*** =ivy-toggle-calling=
+Toggle executing the current action each time a new candidate is selected.
+
+This command is bound to ~C-o c~.
+
+To explain how this is useful: ~C-M-m C-M-f C-M-f C-M-f~ is equivalent to
~C-o cjjj~.
+
+*** =ivy-insert-current=
+Inserts the current candidate into the minibuffer.
+
+Press ~M-i~ if you want something close to the current candidate. You
+can follow up with an edit and select.
+
+I find this very useful when creating new files with a similar name to
+the existing file: ~C-x C-f M-i~ + a bit of editing is very fast.
+
+See [[https://github.com/abo-abo/swiper/pull/141][#141]].
+
+*** =counsel-load-theme=
+Forward to =load-theme= with Ivy completion. Allows to rapidly try themes
(e.g. with ~C-M-n~).
+
+*** =ivy-reverse-i-search=
+Allow to recursively match history with ~C-r~.
+
+I like this command from bash shell. The usual way to search through
+history is with ~M-p~ and ~M-n~. Using =ivy-reverse-i-search= will
+open a recursive completion session with the current history as the
+candidates.
+*** =counsel-rhythmbox=
+[[http://oremacs.com/2015/07/09/counsel-rhythmbox/][Control Rhythmbox from
Emacs.]]
+*** =ivy-dispatching-done=
+Select an action for the current candidate and execute it. Bound to ~M-o~.
+
+Some commands that support ~M-o~:
+
+- =counsel-rhythmbox=
+- =counsel-describe-function=
+- =counsel-describe-variable=
+- =ivy-switch-buffer=
+- =counsel-locate=
+
+*** =counsel-org-tag=
+Forward to =org-set-tags= with Ivy completion.
+
+Selecting any tag each time will toggle it on/off.
+The current list of selected tags will be displayed in the prompt.
+
+See [[https://github.com/abo-abo/swiper/pull/177][#177]] and
[[https://github.com/abo-abo/swiper/pull/91][#91]].
+
+*** =counsel-org-tag-agenda=
+Forward to =org-agenda-set-tags= with Ivy completion.
+See [[https://github.com/abo-abo/swiper/pull/177][#177]].
+
+*** =counsel-ag=
+Interactively =ag= using Ivy completion.
+
+*** =counsel-recoll=
+Use =recoll= with Ivy completion.
+See [[http://oremacs.com/2015/07/27/counsel-recoll/][Using Recoll desktop
search database with Emacs]].
+
+Install recoll with =sudo apt-get install recoll=.
+
+*** =swiper-from-isearch=
+Start =swiper= from the current =isearch= input.
+
+*** =ivy-immediate-done=
+Use this command to exit the minibuffer choosing not the current
+candidate, but the current text. Bound to ~C-M-j~ or ~C-u C-j~.
+
+See [[https://github.com/abo-abo/swiper/pull/183][#183]].
+
+* 0.7.0
+** Fixes
+*** Fix :dynamic-collection not being sorted
+*** When :initial-input contains a plus, escape it
+See [[https://github.com/abo-abo/swiper/issues/195][#195]].
+*** Set line-spacing to 0 in the minibuffer
+See [[https://github.com/abo-abo/swiper/issues/198][#198]].
+*** Enlarge the minibuffer window if the candidate list doesn't fit
+See [[https://github.com/abo-abo/swiper/issues/198][#198]] and
[[https://github.com/abo-abo/swiper/issues/161][#161]] and
[[https://github.com/abo-abo/swiper/issues/220][#220]].
+*** Fix minibuffer collapsing to one line
+See [[https://github.com/abo-abo/swiper/issues/237][#237]],
[[https://github.com/abo-abo/swiper/issues/229][#229]] and
[[https://github.com/abo-abo/swiper/issues/77][#77]].
+*** Use minibuffer-allow-text-properties
+Allows =ivy-read= to return a propertized string.
+*** Improve ~C-g~ out of a long-running async process
+Use =counsel-delete-process= as =:unwind=.
+*** Don't regexp-quote :preselect
+See [[https://github.com/abo-abo/swiper/issues/245][#245]].
+*** Fix ivy-partial for fuzzy completion
+See [[https://github.com/abo-abo/swiper/issues/266][#266]].
+*** ivy-resume should pass :caller
+See [[https://github.com/abo-abo/swiper/issues/245][#245]].
+*** Fix the regression in perfect match logic
+See [[https://github.com/abo-abo/swiper/issues/270][#270]].
+*** Fix pasting file paths on Windows
+*** ~C-j~ should no stop completion for a pasted file path
+*** ~C-M-j~ should use =ivy--directory=
+When completing file names, expand the file name properly.
+See [[https://github.com/abo-abo/swiper/issues/275][#275]].
+*** Use a specific blend method for dark themes
+See [[https://github.com/abo-abo/swiper/issues/278][#278]].
+*** Fix one-off bug in =ivy-scroll-up-command= and =ivy-scroll-down-command=
+*** ~M-o~ shouldn't set the action permanently
+So now it's possible to e.g. =counsel-describe-function= -> ~M-o d~ ->
+=ivy-resume= -> ~M-o o~ -> =ivy-resume= -> ~M-o i~.
+*** Fix swiper preselect issue with similar or identical lines
+See [[https://github.com/abo-abo/swiper/issues/290][#290]].
+*** Make ivy-completing-read handle history as cons
+See [[https://github.com/abo-abo/swiper/issues/295][#295]].
+*** Perform string-match in the original buffer
+The syntax for whitespace, separators etc. is different for modes. See
[[https://github.com/abo-abo/swiper/issues/298][#298]].
+** New Features
+*** =swiper=
+**** Make line numbers into display properties
+Each candidate is now a single space plus the original string. The
+display property of the single space holds the line number. This means
+that it's no longer possible to match line numbers in queries, which
+is a good thing if you're searching for numbers.
+**** Extend =swiper-font-lock-ensure=
+Add =mu4e-view-mode=, =mu4e-headers-mode=, =help-mode=,
+=elfeed-show-mode=, =emms-stream-mode=, =debbugs-gnu-mode=,
+=occur-mode=, =occur-edit-mode=, =bongo-mode=, =eww-mode=, =vc-dir-mode=.
+**** Add support for =evil-jumper/backward=
+See [[https://github.com/abo-abo/swiper/issues/268][#268]].
+**** Make compatible with =visual-line-mode=
+=swiper= will split the lines when =visual-line-mode= is on. This is
+convenient for small buffers. For large buffers, it can be very slow,
+since =visual-line-mode= is slow.
+See [[https://github.com/abo-abo/swiper/issues/227][#227]].
+**** Add =swiper-toggle-face-matching=
+Bound to ~C-c C-f~.
+At each start of =swiper=, the face at point will be stored.
+Use this command to toggle matching only the candidates with that face.
+See [[https://github.com/abo-abo/swiper/issues/288][#288]].
+**** =push-mark= only if exited the minibuffer
+~C-M-n~ and ~C-M-p~ will no longer push mark and annoy with messages.
+**** =ivy-resume= should restore the buffer for =swiper=
+See [[https://github.com/abo-abo/swiper/issues/302][#302]].
+**** Enable recursive =swiper= calls
+While you =swiper= buffer-1, you can switch out of the minibuffer into
+buffer-2 and call =swiper= again. Exiting the second minibuffer will
+restore the first minibuffer.
+
+To use this, you need to enable recursive minibuffers.
+#+begin_src elisp
+(setq enable-recursive-minibuffers t)
+#+end_src
+
+It's also useful to indicate the current depth:
+
+#+begin_src elisp
+(minibuffer-depth-indicate-mode 1)
+#+end_src
+
+See [[https://github.com/abo-abo/swiper/issues/309][#309]].
+**** Fix for =twittering-mode=
+The =field= text property is now removed before inserting text into
+the minibuffer. This fixes the =swiper= problems with
+=twittering-mode=. See [[https://github.com/abo-abo/swiper/issues/310][#310]].
+
+
+
+
+*** =ivy=
+**** Add manual
+In the current state, the manual covers the most basic topics, like
+the minibuffer key bindings and the regexp builders.
+**** Make <left> and <right> behave as in fundamental-mode
+**** Truncate minibuffer prompts longer than window-width
+See [[https://github.com/abo-abo/swiper/issues/240][#240]].
+**** ~C-M-n~ should not leave the minibuffer
+Make sure that the minibuffer window remains selected as long as the
+completion hasn't finished. For example, ~<f1> f~ to call
+=counsel-describe-function=, input "forward" and spam ~C-M-n~ to read
+the doc for each function that starts with "forward". The =*Help*=
+window popup would move the window focus, but this change moves it
+back to the minibuffer.
+**** Add =flx= sorting
+See [[https://github.com/abo-abo/swiper/issues/207][#207]].
+Since flx is costly, move the caching to an earlier point. This means
+immediate return for when the input hasn't changed, i.e. for ~C-n~ or
+~C-p~. When =flx= is installed, and =(eq ivy--regex-function
'ivy--regex-fuzzy)=
+for current function (through =ivy-re-builders-alist=), then sort the final
candidates with
+=ivy--flx-sort=.
+
+In the worst case, when some error pops up, return the same list. In
+the best case sort the =cands= that all match =name= by closeness to
+=name=.
+
+How to use:
+1. Have =flx= installed - =(require 'flx)= should succeed.
+2. Configure =ivy-re-builders-alist= appropriately to use =ivy--regex-fuzzy=.
+
+For example:
+
+#+begin_src elisp
+(setq ivy-re-builders-alist
+ '((t . ivy--regex-fuzzy)))
+#+end_src
+**** Support hash tables
+Since =all-completions= also works for hash tables, no reason not to support
them.
+**** Improve documentation of =ivy-count-format=
+Now possible to set it with Customize.
+**** Add =ivy-index-functions-alist=
+Customize this to decide how the index, i.e. the currently selected
+candidate, is updated with new input.
+For example, one strategy is not reset it to 0 after each change.
+
+Another strategy, used for =swiper=, is to try to select the first
+appropriate candidate after (inclusive) the first previously selected
+candidate. This way, if you're typing something that matches what is
+currently selected, the selection won't change.
+
+See [[https://github.com/abo-abo/swiper/issues/253][#253]].
+**** Add =ivy-virtual-abbreviate=
+The mode of abbreviation for virtual buffer names.
+**** Add =ivy-case-fold-search=
+Used to override =case-fold-search=. See
[[https://github.com/abo-abo/swiper/issues/259][#259]].
+**** Add feedback for long-running async processes
+Each time 0.5s pass after the last input, if the external process
+hasn't finished yet, update minibuffer with the amount of candidates
+collected so far. This is useful to see that long running commands
+like =counsel-locate= or =counsel-ag= (when in a very large directory)
+aren't stuck.
+**** Promote =ivy-extra-directories= to defcustom
+**** Promote =ivy-sort-function-alist= to defcustom
+**** ~M-n~ should prefer url at point to symbol at point
+**** ~C-x C-f M-n~ calls =ffap-url-fetcher= when at URL
+**** Highlight modified file buffers with =ivy-modified-buffer= face
+This new face is blank by default, but you can use e.g.:
+#+begin_src elisp
+(custom-set-faces
+ '(ivy-modified-buffer ((t (:background "#ff7777")))))
+#+end_src
+**** Work with =enable-recursive-minibuffers=
+Store the old =ivy-last= in case =ivy-read= is called while inside the
+minibuffer. Restore it after =ivy-call=.
+**** Allow user-specified matched candidate sorting
+New defcustom =ivy-sort-matches-functions-alist=.
+See [[https://github.com/abo-abo/swiper/issues/269][#269]]
[[https://github.com/abo-abo/swiper/issues/265][#265]]
[[https://github.com/abo-abo/swiper/issues/213][#213]].
+
+By default, Ivy doesn't sort the matched candidates, they remain in
+the same order as in the original collection. This option is the
+default, since it's fast and simple.
+
+A small problem with this approach is that we usually want prefix
+matches to be displayed first. One solution to this is to input "^" to
+see only the prefix matches.
+
+Now, another solution is to can set:
+#+begin_src elisp
+(setq ivy-sort-matches-functions-alist
+ '((t . ivy--prefix-sort)))
+#+end_src
+
+Here's another example of using this defcustom:
+#+begin_src elisp
+(add-to-list
+ 'ivy-sort-matches-functions-alist
+ '(read-file-name-internal . ivy--sort-files-by-date))
+#+end_src
+
+After this, during file name completion, most recently changed files
+will be ahead.
+**** =ivy-display-style=
+Adds fancy highlighting to the minibuffer.
+See [[https://github.com/abo-abo/swiper/issues/212][#212]],
[[https://github.com/abo-abo/swiper/issues/217][#217]], .
+*** =ivy-hydra=
+**** Bind ~t~ to =toggle-truncate-lines=
+See [[https://github.com/abo-abo/swiper/issues/214][#214]].
+**** Bind ~a~ to =ivy-read-action=
+*** =ivy-switch-buffer=
+**** Make ~M-o r~ rename the buffer instead of switching.
+See [[https://github.com/abo-abo/swiper/issues/233][#233]].
+*** =counsel-locate=
+**** Allow customizing locate options
+See =counsel-locate-options=.
+The current setting is:
+#+begin_src elisp
+(setq counsel-locate-options '("-i" "--regex"))
+#+end_src
+**** Support OSX
+Use =open= instead of =xdg-open=. Modify =counsel-locate-options= for
+OSX, since there =locate= doesn't support =--regex=.
+**** Use single quotes for the regex
+See [[https://github.com/abo-abo/swiper/issues/194][#194]].
+**** Add initial-input argument
+See [[https://github.com/abo-abo/swiper/issues/289][#289]].
+*** =counsel-org-tag=
+**** Now works in agenda
+See [[https://github.com/abo-abo/swiper/issues/200][#200]].
+*** =counsel-unicode-char=
+**** Add own history
+*** =counsel-M-x=
+**** Add "definition" action
+Use ~M-o d~ to jump to definition.
+**** Show =current-prefix-arg= in the prompt
+See [[https://github.com/abo-abo/swiper/issues/287][#287]].
+*** =counsel-find-file=
+**** Input '/sudo::' goes to current directory instead of root's home
+See [[https://github.com/abo-abo/swiper/issues/283][#283]].
+**** Fix directory validity check
+See [[https://github.com/abo-abo/swiper/issues/283][#283]]
[[https://github.com/abo-abo/swiper/issues/284][#284]].
+**** Improve TRAMP support
+Selecting items after ~//~ now works properly.
+*** =counsel-git-grep=
+**** Use prefix arg to specify the shell command.
+Remember to use ~M-i~ to insert the current candidate into the
+minibuffer.
+
+See [[https://github.com/abo-abo/swiper/issues/244][#244]].
+**** Allow =counsel-git-grep= -> =ivy-occur= -> =wgrep=
+Using ~C-c C-o~ (=ivy-occur=) while in =counsel-git-grep= will produce
+a =wgrep=-compatible buffer.
+**** =ivy-occur= gives full candidates
+This means that the =" | head -n 200"= speed-up isn't used and full
+candidates are returned.
+*** =counsel--find-symbol=
+**** Allow to jump back with pop-tag-mark
+Using ~C-.~ in:
+
+- =counsel-describe-function=
+- =counsel-describe-variable=
+- =counsel-load-library=
+
+will change the current buffer. The buffer and point can be restored
+with ~M-*~ (=pop-tag-mark=).
+
+I also recommend this binding:
+
+#+begin_src elisp
+(global-set-key (kbd "M-,") 'pop-tag-mark)
+#+end_src
+**** Resolve the name clash better
+When the symbol is both bound and fbound, prefer the fbound one,
+unless the =:caller= is =counsel-describe-variable=.
+*** =counsel-ag=
+**** Add =initial-directory=
+Support alternative initial directory which helps other packages call
+this function with their unique starting directory.
+**** Fix on Windows
+Using the "--vimgrep" argument improves things.
+** New Commands
+*** =ivy-occur=
+Bound to ~C-c C-o~. Store the current completion session to its own
+buffer. You can have an unlimited amount of these buffers.
+*** =ivy-avy=
+Bound to ~C-'~.
+
+Speeds up selecting a candidate that's currently visible in the minibuffer.
+*** =ivy-kill-ring-save=
+Bound to ~M-w~.
+
+When the region is active, call =kill-ring-save=. Otherwise, store
+all selected candidates to the kill ring.
+*** =ivy-dispatching-call=
+Bound to ~C-M-o~.
+
+This is a non-exiting version of ~M-o~ (=ivy-dispatching-done=).
+*** =ivy-read-action=
+Bound to ~C-M-a~. Select the current action. Don't call it yet.
+*** =swiper-multi=
+Use =swiper= in multiple buffers.
+See [[https://github.com/abo-abo/swiper/issues/182][#182]].
+
+Basic usage tips for selecting multiple buffers:
+
+- Use ~C-M-m~ (=ivy-call=) to add or remove one more buffer without exiting.
+- Use ~C-m~ (=ivy-done=) to add one last buffer.
+- Or use ~C-M-j~ (=ivy-immediate-done=) to finish without adding more buffers.
+- Hold ~C-M-n~ (=ivy-next-line-and-call=) to add a lot of buffers at once.
+*** =swiper-mc=
+Open multiple cursors at all selected candidates.
+*** =swiper-all=
+New command to launch =swiper= for all open file buffers. Note that
+this can be excruciatingly slow if you don't clean up your buffer list
+often.
+*** =counsel-grep=
+This is essentially =swiper= for huge files. It's not as smooth as
+=swiper= for small files, but has a faster startup and faster matching
+for files that measure in megabytes.
+*** =counsel-git-grep-query-replace=
+Bound to ~M-q~. Perform =query-replace= on all matches in all buffers.
+*** =counsel-jedi=
+Complete Python symbols using Jedi.
+*** =counsel-cl=
+Complete Common Lisp symbols using SLIME.
+*** =counsel-yank-pop=
+Give completion for inserting from the kill ring.
+See =counsel-yank-pop-truncate= defcustom and
[[https://github.com/abo-abo/swiper/issues/218][#218]].
diff --git a/packages/swiper/doc/ivy.org b/packages/swiper/doc/ivy.org
new file mode 100644
index 0000000..b26b00e
--- /dev/null
+++ b/packages/swiper/doc/ivy.org
@@ -0,0 +1,476 @@
+#+TITLE: Ivy User Manual
+#+AUTHOR: Oleh Krehel
+#+EMAIL: address@hidden
+#+DATE: 2015
+#+LANGUAGE: en
+
+#+TEXINFO_DIR_CATEGORY: Emacs
+#+TEXINFO_DIR_TITLE: Ivy: (ivy).
+#+TEXINFO_DIR_DESC: Using Ivy for completion.
+#+HTML_HEAD: <link rel="stylesheet" type="text/css" href="style.css"/>
+
+#+OPTIONS: H:6 num:6 toc:4
+#+STARTUP: indent
+* Macros
:noexport:
+#+MACRO: defopt #+TEXINFO: @defopt $1
+#+MACRO: endopt #+TEXINFO: @end defopt
+* Copying
+:PROPERTIES:
+:COPYING: t
+:END:
+
+#+BEGIN_TEXINFO
address@hidden
+Ivy manual, version 0.7.0
+
+Ivy is an interactive interface for completion in Emacs. Emacs uses
+completion mechanism in a variety of contexts: code, menus, commands,
+variables, functions, etc. Completion entails listing, sorting,
+filtering, previewing, and applying actions on selected items. When
+active, @code{ivy-mode} completes the selection process by narrowing
+available choices while previewing in the minibuffer. Selecting the
+final candidate is either through simple keyboard character inputs or
+through powerful regular expressions. @end ifnottex
+
+Copyright @copyright{} 2015 Free Software Foundation, Inc.
+
address@hidden
+Permission is granted to copy, distribute and/or modify this document
+under the terms of the GNU Free Documentation License, Version 1.3 or
+any later version published by the Free Software Foundation; with no
+Invariant Sections, with the Front-Cover Texts being ``A GNU Manual,''
+and with the Back-Cover Texts as in (a) below. A copy of the license
+is included in the section entitled ``GNU Free Documentation License.''
+
+(a) The FSF's Back-Cover Text is: ``You have the freedom to copy and
+modify this GNU manual.''
address@hidden quotation
+#+END_TEXINFO
+
+* Introduction
+Ivy is for quick and easy selection from a list. When Emacs prompts
+for a string from a list of several possible choices, Ivy springs into
+action to assist in narrowing and picking the right string from a vast
+number of choices.
+
+Ivy strives for minimalism, simplicity, customizability and
+discoverability.
+
+#+BEGIN_TEXINFO
address@hidden Minimalism
+#+END_TEXINFO
+Uncluttered minibuffer is minimalism. Ivy shows the completion
+defaults, the number of matches, and 10 candidate matches below the
+input line. Customize =ivy-length= to adjust the number of candidate
+matches displayed in the minibuffer.
+
+#+BEGIN_TEXINFO
address@hidden Simplicity
+#+END_TEXINFO
+Simplicity is about Ivy's behavior in the minibuffer. It is also about
+the code interface to extend Ivy's functionality. The minibuffer area
+behaves as close to =fundamental-mode= as possible. ~SPC~ inserts a
+space, for example, instead of being bound to the more complex
+=minibuffer-complete-word=. Ivy's code uses easy-to-examine global
+variables; avoids needless complications with branch-introducing
+custom macros.
+
+#+BEGIN_TEXINFO
address@hidden Customizability
+#+END_TEXINFO
+Customizability is about being able to use different methods and
+interfaces of completion to tailor the selection process. For example,
+adding a custom display function that points to a selected candidate
+with =->=, instead of highlighting the selected candidate with the
+=ivy-current-match= face. Or take the customization of actions, say
+after the candidate function is selected. ~RET~ uses
+=counsel-describe-function= to describe the function, whereas ~M-o d~
+jumps to that function's definition in the code. The ~M-o~ prefix can
+be uniformly used with characters like ~d~ to group similar actions.
+
+#+BEGIN_TEXINFO
address@hidden Discoverability
+#+END_TEXINFO
+Ivy displays easily discoverable commands through the hydra facility.
+~C-o~ in the minibuffer displays a hydra menu. It opens up within an
+expanded minibuffer area. Each menu item comes with short
+documentation strings and highlighted one-key completions. So
+discovering even seldom used keys is simply a matter of ~C-o~ in the
+minibuffer while in the midst of the Ivy interaction. This
+discoverability minimizes exiting Ivy interface for documentation
+look-ups.
+
+* Installation
+
+Install Ivy automatically through Emacs's package manager, or manually
+from Ivy's development repository.
+
+** Installing from Emacs Package Manager
+
+~M-x~ =package-install= ~RET~ =swiper= ~RET~
+
+Ivy is installed as part of =swiper= package. =swiper= is available
+from two different package archives, GNU ELPA and MELPA. For the
+latest stable version, use the GNU ELPA archives using the above M-x
+command.
+
+For current hourly builds, use the MELPA archives. See the code below
+for adding MELPA to the list of package archives:
+
+#+begin_src elisp
+(require 'package)
+(add-to-list 'package-archives
+ '("melpa" . "http://melpa.org/packages/";))
+#+end_src
+
+After this do ~M-x~ =package-refresh-contents= ~RET~, followed by
+~M-x~ =package-install= ~RET~ =swiper= ~RET~.
+
+For package manager details, see [[info:emacs#Packages]].
+
+** Installing from the Git repository
+
+Why install from Git?
+
+- No need to wait for MELPA's hourly builds
+- Easy to revert to previous versions
+- Contribute to Ivy's development; send patches; pull requests
+
+*Configuration steps*
+
+First clone the Swiper repository:
+#+begin_src sh
+cd ~/git && git clone https://github.com/abo-abo/swiper
+cd swiper && make compile
+#+end_src
+
+Then add this to Emacs init:
+#+begin_src elisp
+(add-to-list 'load-path "~/git/swiper/")
+(require 'ivy)
+#+end_src
+
+To update the code:
+#+begin_src sh
+git pull
+make
+#+end_src
+
+* Getting started
+
+First enable Ivy completion everywhere:
+
+#+begin_src elisp
+(ivy-mode 1)
+#+end_src
+
+Note: =ivy-mode= can be toggled on and off with ~M-x~ =ivy-mode=.
+** Basic customization
+Here are some basic settings particularly useful for new Ivy
+users:
+#+begin_src elisp
+(setq ivy-use-virtual-buffers t)
+(setq ivy-height 10)
+(setq ivy-display-style 'fancy)
+(setq ivy-count-format "(%d/%d) ")
+#+end_src
+
+For additional customizations, refer to =M-x describe-variable=
+documentation.
+
+* Key bindings
+** Global key bindings
+
+Recommended key bindings are:
+#+BEGIN_TEXINFO
address@hidden Ivy-based interface to standard commands
+#+END_TEXINFO
+#+begin_src elisp
+(global-set-key (kbd "C-s") 'swiper)
+(global-set-key (kbd "M-x") 'counsel-M-x)
+(global-set-key (kbd "C-x C-f") 'counsel-find-file)
+(global-set-key (kbd "<f1> f") 'counsel-describe-function)
+(global-set-key (kbd "<f1> v") 'counsel-describe-variable)
+(global-set-key (kbd "<f1> l") 'counsel-load-library)
+(global-set-key (kbd "<f2> i") 'counsel-info-lookup-symbol)
+(global-set-key (kbd "<f2> u") 'counsel-unicode-char)
+#+end_src
+#+BEGIN_TEXINFO
address@hidden Ivy-based interface to shell and system tools
+#+END_TEXINFO
+#+begin_src elisp
+(global-set-key (kbd "C-c g") 'counsel-git)
+(global-set-key (kbd "C-c j") 'counsel-git-grep)
+(global-set-key (kbd "C-c k") 'counsel-ag)
+(global-set-key (kbd "C-x l") 'counsel-locate)
+(global-set-key (kbd "C-S-o") 'counsel-rhythmbox)
+#+end_src
+#+BEGIN_TEXINFO
address@hidden Ivy-resume and other commands
+#+END_TEXINFO
+=ivy-resume= resumes the last Ivy-based completion.
+#+begin_src elisp
+(global-set-key (kbd "C-c C-r") 'ivy-resume)
+#+end_src
+
+** Minibuffer key bindings
+
+Ivy includes several minibuffer bindings, which are defined in the
+=ivy-minibuffer-map= keymap variable. The most frequently used ones
+are described here.
+
+=swiper= or =counsel-M-x= add more through the =keymap= argument to
+=ivy-read=. These keys, also active in the minibuffer, are described
+under their respective commands.
+
+*** Key bindings for navigation
+
+- ~C-n~ (=ivy-next-line=) selects the next candidate
+- ~C-p~ (=ivy-previous-line=) selects the previous candidate
+- ~M-<~ (=ivy-beginning-of-buffer=) selects the first candidate
+- ~M->~ (=ivy-end-of-buffer=) selects the last candidate
+- ~C-v~ (=ivy-scroll-up-command=) scrolls up by =ivy-height= lines
+- ~M-v~ (=ivy-scroll-down-command=) scrolls down by =ivy-height= lines
+
+{{{defopt(ivy-wrap)}}}
+This user option allows to get the wrap-around behavior for ~C-n~ and
+~C-p~. When set to =t=, =ivy-next-line= and =ivy-previous-line= will
+cycle past the last and the first candidates respectively.
+
+This behavior is off by default.
+{{{endopt}}}
+
+{{{defopt(ivy-height)}}}
+Use this variable to adjust the minibuffer height, and therefore the
+scroll size for ~C-v~ and ~M-v~.
+{{{endopt}}}
+
+*** Key bindings for single selection, action, then exit minibuffer
+
+Ivy can offer several actions from which to choose which action to
+run. This "calling an action" operates on the selected candidate. For
+example, when viewing a list of files, one action could open it for
+editing, one to view it, another to invoke a special function, and so
+on. Custom actions can be added to this interface. The precise action
+to call on the selected candidate can be delayed until after the
+narrowing is completed. No need to exit the interface if unsure which
+action to run. This delayed flexibility and customization of actions
+extends usability of lists in Emacs.
+
+~C-m~ or ~RET~ (=ivy-done=) calls the default action and exits the
+minibuffer.
+
+~M-o~ (=ivy-dispatching-done=) presents all available valid actions
+from which to choose. When there is only one action available, there
+is no difference between ~M-o~ and ~C-m~.
+
+~C-j~ (=ivy-alt-done=) calls the alternate action, such as completing
+a directory name in a file list whereas ~C-m~ will select that directory
+and exit the minibuffer.
+
+Exiting the minibuffer also closes the Ivy window (as specified by
+=ivy-height=). This closing and exiting sequence is conveniently off
+when applying multiple actions. Multiple actions and multiple
+selections as covered in the next section of this manual.
+
+~TAB~ (=ivy-partial-or-done=) attempts partial completion, extending
+current input as much as possible.
+
+~TAB TAB~ is the same as ~C-j~.
+
+~C-M-j~ (=ivy-immediate-done=) is useful when there is no match for
+the given input. Or there is an incorrect partial match. ~C-M-j~ with
+=find-file= lists ignores the partial match and instead takes the
+current input to create a new directory with =dired-create-directory=.
+
+=ivy-immediate-done= illustrates how Ivy distinguishes between calling
+an action on the /currently selected/ candidate and calling an action
+on the /current input/.
+
+#+BEGIN_TEXINFO
+Invoking avy completion with @kbd{C-'} (@code{ivy-avy}).
+#+END_TEXINFO
+~C-`~ uses avy's visible jump mechanism, which can further reduce
+Ivy's line-by-line scrolling that requires multiple ~C-n~ or ~C-p~
+keystrokes.
+
+*** Key bindings for multiple selections and actions, keep minibuffer open
+
+For repeatedly applying multiple actions or acting on multiple
+candidates, Ivy does not close the minibuffer between commands. It
+keeps the minibuffer open for applying subsequent actions.
+
+Adding an extra meta key to the normal key chord invokes the special
+version of the regular commands that enables applying multiple
+actions.
+
+~C-M-m~ (=ivy-call=) is the non-exiting version of the default action,
+~C-m~ (=ivy-done=). Instead of closing the minibuffer, ~C-M-m~ allows
+selecting another candidate or another action. For example, ~C-M-m~ on
+functions list invokes =describe-function=. When combined with ~C-n~,
+function descriptions can be invoked quickly in succession.
+
+~RET~ exits the minibuffer.
+
+=ivy-resume= recalls the state of the completion session just before
+its last exit. Useful after an accidental ~C-m~ (=ivy-done=).
+
+~C-M-o~ (=ivy-dispatching-call=) is a non-exiting version of ~M-o~
+(=ivy-dispatching-done=) that can accumulate candidates into a queue.
+For example, for playback in =counsel-rhythmbox=, ~C-M-o e~ en-queues
+the selected candidate, and ~C-n C-m~ plays the next one in the queue.
+
+~C-M-n~ (=ivy-next-line-and-call=) combines ~C-n~ and ~C-M-m~. Applies
+an action and moves to next line. Comes in handy when opening multiple
+files from =counsel-find-file=, =counsel-git-grep=, =counsel-ag=, or
+=counsel-locate= lists. Just hold ~C-M-n~ for rapid-fire default
+action on each successive element of the list.
+
+~C-M-p~ (=ivy-previous-line-and-call=) combines ~C-p~ and ~C-M-m~. Is
+the same as above except that it moves through the list in the other
+direction.
+
+*** Key bindings that alter minibuffer input
+
+~M-n~ (=ivy-next-history-element=) and ~M-p~
+(=ivy-previous-history-element=) cycle through the Ivy command
+history. Ivy updates an internal history list after each action. When
+this history list is empty, ~M-n~ inserts symbol (or URL) at point
+into the minibuffer.
+
+~M-i~ (=ivy-insert-current=) inserts the current candidate into the
+minibuffer. Useful for copying and renaming files, for example: ~M-i~
+to insert the original file name string, edit it, and then ~C-m~ to
+complete the renaming.
+
+~M-j~ (=ivy-yank-word=) inserts sub-word at point into minibuffer. This
+is similar to ~C-s C-w~ with =isearch=. Ivy reserves ~C-w~ for
+=kill-region=.
+
+~S-SPC~ (=ivy-restrict-to-matches=) deletes the current input, and
+resets the candidates list to the currently restricted matches. This
+is how Ivy provides narrowing in successive tiers.
+
+~C-r~ (=ivy-reverse-i-search=) works just like ~C-r~ at bash command
+prompt, where the completion candidates are the history items. Upon
+completion, the selected candidate string is inserted into the
+minibuffer.
+
+*** Other key bindings
+
+~M-w~ (=ivy-kill-ring-save=) copies selected candidates to the kill
+ring; when the region is active, copies active region.
+
+*** Hydra in the minibuffer
+
+~C-o~ (=hydra-ivy/body=) invokes Hydra menus with key shortcuts.
+
+~C-o~ or ~i~ resumes editing.
+
+Hydra reduces key strokes, for example: ~C-n C-n C-n C-n~ is ~C-o
+jjjj~ in Hydra. Hydra has other benefits besides certain shorter key
+bindings:
+- ~<~ and ~>~ to adjust height of minibuffer,
+- describes the current completion state, such as case folding and the
+ current action.
+
+Minibuffer editing is disabled when Hydra is active.
+
+*** Saving the current completion session to a buffer
+
+~C-c C-o~ (=ivy-occur=) saves the current candidates to a new buffer;
+the list is active in the new buffer.
+
+~RET~ or ~mouse-1~ in the new buffer calls the appropriate action on
+the selected candidate.
+
+Ivy has no limit on the number of active buffers like these.
+
+Ivy takes care of making these buffer names unique. It applies
+descriptive names, for example: =*ivy-occur counsel-describe-variable
+"function$*=.
+
+* Completion styles
+
+Ivy's completion functions rely on the highly configurable regex
+builder.
+
+The default is:
+#+begin_src elisp
+(setq ivy-re-builders-alist
+ '((t . ivy--regex-plus)))
+#+end_src
+
+The default =ivy--regex-plus= narrowing is always invoked unless
+specified otherwise. For example, file name completion may have a
+custom completion function:
+#+begin_src elisp
+(setq ivy-re-builders-alist
+ '((read-file-name-internal . ivy--regex-fuzzy)
+ (t . ivy--regex-plus)))
+#+end_src
+
+Ivy's flexibility extends to using different styles of completion
+mechanics (regex-builders) for different types of lists. Despite this
+flexibility, Ivy operates within a consistent and uniform interface.
+The main regex-builders currently in Ivy are:
+
+** ivy--regex-plus
+
+=ivy--regex-plus= is Ivy's default completion method.
+
+=ivy--regex-plus= matches by splitting the input by spaces and
+rebuilding it into a regex.
+
+As the search string is typed in Ivy's minibuffer, it is transformed
+into proper regex syntax. If the string is "for example", it is
+transformed into
+
+#+BEGIN_EXAMPLE
+"\\(for\\).*\\(example\\)"
+#+END_EXAMPLE
+
+which in regex terminology matches "for" followed by a wild card and
+then "example". Note how Ivy uses the space character to build
+wild cards. For literal white space matching in Ivy, use an extra space:
+to match one space type two spaces, to match two spaces type three
+spaces, and so on.
+
+As Ivy transforms typed characters into regex strings, it provides an
+intuitive feedback through font highlights.
+
+Ivy supports regexp negation with "!". For example, "define key ! ivy
+quit" first selects everything matching "define.*key", then removes
+everything matching "ivy", and finally removes everything matching
+"quit". What remains is the final result set of the negation regexp.
+
+#+BEGIN_EXAMPLE
+Standard regexp identifiers work:
+
+"^", "$", "\b" or "[a-z]"
+#+END_EXAMPLE
+
+Since Ivy treats minibuffer input as a regexp, standard regexp
+identifiers work as usual. The exceptions are spaces, which
+translate to ".*", and "!" that signal the beginning of a negation
+group.
+
+** ivy--regex-ignore-order
+
+=ivy--regex-ignore-order= ignores the order of regexp tokens when
+searching for matching candidates. For instance, the input "for
+example" will match "example test for". Otherwise =ivy--regex-plus=
+normal behavior is to honor the order of regexp tokens.
+
+** ivy--regex-fuzzy
+
+=ivy--regex-fuzzy= splits each character with a wild card. Searching
+for "for" returns all "f.*o.*r" matches, resulting in a large number
+of hits. Yet some searches need these extra hits. Ivy sorts such
+large lists using =flx= package's scoring mechanism, if it's
+installed.
+
+* Variable Index
+#+BEGIN_TEXINFO
address@hidden vr
+#+END_TEXINFO
diff --git a/packages/swiper/doc/ivy.texi b/packages/swiper/doc/ivy.texi
new file mode 100644
index 0000000..b06c68c
--- /dev/null
+++ b/packages/swiper/doc/ivy.texi
@@ -0,0 +1,591 @@
+\input texinfo @c -*- texinfo -*-
address@hidden %**start of header
address@hidden ./ivy.info
address@hidden Ivy User Manual
address@hidden UTF-8
address@hidden en
address@hidden %**end of header
+
address@hidden
address@hidden
+Ivy manual, version 0.7.0
+
+Ivy is an interactive interface for completion in Emacs. Emacs uses
+completion mechanism in a variety of contexts: code, menus, commands,
+variables, functions, etc. Completion entails listing, sorting,
+filtering, previewing, and applying actions on selected items. When
+active, @code{ivy-mode} completes the selection process by narrowing
+available choices while previewing in the minibuffer. Selecting the
+final candidate is either through simple keyboard character inputs or
+through powerful regular expressions. @end ifnottex
+
+Copyright @copyright{} 2015 Free Software Foundation, Inc.
+
address@hidden
+Permission is granted to copy, distribute and/or modify this document
+under the terms of the GNU Free Documentation License, Version 1.3 or
+any later version published by the Free Software Foundation; with no
+Invariant Sections, with the Front-Cover Texts being ``A GNU Manual,''
+and with the Back-Cover Texts as in (a) below. A copy of the license
+is included in the section entitled ``GNU Free Documentation License.''
+
+(a) The FSF's Back-Cover Text is: ``You have the freedom to copy and
+modify this GNU manual.''
address@hidden quotation
address@hidden copying
+
address@hidden Emacs
address@hidden
+* Ivy: (ivy). Using Ivy for completion.
address@hidden direntry
+
address@hidden
address@hidden
address@hidden Ivy User Manual
address@hidden Oleh Krehel
address@hidden
address@hidden 0pt plus 1filll
address@hidden
address@hidden titlepage
+
address@hidden
+
address@hidden
address@hidden Top
address@hidden Ivy User Manual
address@hidden
address@hidden ifnottex
+
address@hidden
+* Introduction::
+* Installation::
+* Getting started::
+* Key bindings::
+* Completion styles::
+* Variable Index::
+
address@hidden
+--- The Detailed Node Listing ---
+
+Installation
+
+* Installing from Emacs Package Manager::
+* Installing from the Git repository::
+
+Getting started
+
+* Basic customization::
+
+Key bindings
+
+* Global key bindings::
+* Minibuffer key bindings::
+
+Minibuffer key bindings
+
+* Key bindings for navigation::
+* Key bindings for single selection, action, then exit minibuffer: Key
bindings for single selection action then exit minibuffer.
+* Key bindings for multiple selections and actions, keep minibuffer open: Key
bindings for multiple selections and actions keep minibuffer open.
+* Key bindings that alter minibuffer input::
+* Other key bindings::
+* Hydra in the minibuffer::
+* Saving the current completion session to a buffer::
+Completion styles
+
+* ivy--regex-plus::
+* ivy--regex-ignore-order::
+* ivy--regex-fuzzy::
address@hidden detailmenu
address@hidden menu
+
address@hidden Introduction
address@hidden Introduction
+
+Ivy is for quick and easy selection from a list. When Emacs prompts
+for a string from a list of several possible choices, Ivy springs into
+action to assist in narrowing and picking the right string from a vast
+number of choices.
+
+Ivy strives for minimalism, simplicity, customizability and
+discoverability.
+
address@hidden Minimalism
+Uncluttered minibuffer is minimalism. Ivy shows the completion
+defaults, the number of matches, and 10 candidate matches below the
+input line. Customize @code{ivy-length} to adjust the number of candidate
+matches displayed in the minibuffer.
+
address@hidden Simplicity
+Simplicity is about Ivy's behavior in the minibuffer. It is also about
+the code interface to extend Ivy's functionality. The minibuffer area
+behaves as close to @code{fundamental-mode} as possible. @kbd{SPC} inserts a
+space, for example, instead of being bound to the more complex
address@hidden Ivy's code uses easy-to-examine global
+variables; avoids needless complications with branch-introducing
+custom macros.
+
address@hidden Customizability
+Customizability is about being able to use different methods and
+interfaces of completion to tailor the selection process. For example,
+adding a custom display function that points to a selected candidate
+with @code{->}, instead of highlighting the selected candidate with the
address@hidden face. Or take the customization of actions, say
+after the candidate function is selected. @kbd{RET} uses
address@hidden to describe the function, whereas @kbd{M-o d}
+jumps to that function's definition in the code. The @kbd{M-o} prefix can
+be uniformly used with characters like @kbd{d} to group similar actions.
+
address@hidden Discoverability
+Ivy displays easily discoverable commands through the hydra facility.
address@hidden in the minibuffer displays a hydra menu. It opens up within an
+expanded minibuffer area. Each menu item comes with short
+documentation strings and highlighted one-key completions. So
+discovering even seldom used keys is simply a matter of @kbd{C-o} in the
+minibuffer while in the midst of the Ivy interaction. This
+discoverability minimizes exiting Ivy interface for documentation
+look-ups.
+
address@hidden Installation
address@hidden Installation
+
+Install Ivy automatically through Emacs's package manager, or manually
+from Ivy's development repository.
address@hidden
+* Installing from Emacs Package Manager::
+* Installing from the Git repository::
address@hidden menu
+
address@hidden Installing from Emacs Package Manager
address@hidden Installing from Emacs Package Manager
+
address@hidden @code{package-install} @kbd{RET} @code{swiper} @kbd{RET}
+
+Ivy is installed as part of @code{swiper} package. @code{swiper} is available
+from two different package archives, GNU ELPA and MELPA. For the
+latest stable version, use the GNU ELPA archives using the above M-x
+command.
+
+For current hourly builds, use the MELPA archives. See the code below
+for adding MELPA to the list of package archives:
+
+
address@hidden
+(require 'package)
+(add-to-list 'package-archives
+ '("melpa" . "http://melpa.org/packages/";))
address@hidden lisp
+
+After this do @kbd{M-x} @code{package-refresh-contents} @kbd{RET}, followed by
address@hidden @code{package-install} @kbd{RET} @code{swiper} @kbd{RET}.
+
+For package manager details, see @ref{Packages,,,emacs,}.
+
address@hidden Installing from the Git repository
address@hidden Installing from the Git repository
+
+Why install from Git?
+
address@hidden
address@hidden
+No need to wait for MELPA's hourly builds
address@hidden
+Easy to revert to previous versions
address@hidden
+Contribute to Ivy's development; send patches; pull requests
address@hidden itemize
+
address@hidden steps}
+
+First clone the Swiper repository:
+
address@hidden
+cd ~/git && git clone https://github.com/abo-abo/swiper
+cd swiper && make compile
address@hidden example
+
+Then add this to Emacs init:
+
address@hidden
+(add-to-list 'load-path "~/git/swiper/")
+(require 'ivy)
address@hidden lisp
+
+To update the code:
+
address@hidden
+git pull
+make
address@hidden example
+
address@hidden Getting started
address@hidden Getting started
+
+First enable Ivy completion everywhere:
+
+
address@hidden
+(ivy-mode 1)
address@hidden lisp
+
+Note: @code{ivy-mode} can be toggled on and off with @kbd{M-x} @code{ivy-mode}.
address@hidden
+* Basic customization::
address@hidden menu
+
address@hidden Basic customization
address@hidden Basic customization
+
+Here are some basic settings particularly useful for new Ivy
+users:
+
address@hidden
+(setq ivy-use-virtual-buffers t)
+(setq ivy-height 10)
+(setq ivy-display-style 'fancy)
+(setq ivy-count-format "(%d/%d) ")
address@hidden lisp
+
+For additional customizations, refer to @code{M-x describe-variable}
+documentation.
+
address@hidden Key bindings
address@hidden Key bindings
+
address@hidden
+* Global key bindings::
+* Minibuffer key bindings::
address@hidden menu
+
address@hidden Global key bindings
address@hidden Global key bindings
+
+Recommended key bindings are:
address@hidden Ivy-based interface to standard commands
+
address@hidden
+(global-set-key (kbd "C-s") 'swiper)
+(global-set-key (kbd "M-x") 'counsel-M-x)
+(global-set-key (kbd "C-x C-f") 'counsel-find-file)
+(global-set-key (kbd "<f1> f") 'counsel-describe-function)
+(global-set-key (kbd "<f1> v") 'counsel-describe-variable)
+(global-set-key (kbd "<f1> l") 'counsel-load-library)
+(global-set-key (kbd "<f2> i") 'counsel-info-lookup-symbol)
+(global-set-key (kbd "<f2> u") 'counsel-unicode-char)
address@hidden lisp
address@hidden Ivy-based interface to shell and system tools
+
address@hidden
+(global-set-key (kbd "C-c g") 'counsel-git)
+(global-set-key (kbd "C-c j") 'counsel-git-grep)
+(global-set-key (kbd "C-c k") 'counsel-ag)
+(global-set-key (kbd "C-x l") 'counsel-locate)
+(global-set-key (kbd "C-S-o") 'counsel-rhythmbox)
address@hidden lisp
address@hidden Ivy-resume and other commands
address@hidden resumes the last Ivy-based completion.
+
address@hidden
+(global-set-key (kbd "C-c C-r") 'ivy-resume)
address@hidden lisp
+
address@hidden Minibuffer key bindings
address@hidden Minibuffer key bindings
+
+Ivy includes several minibuffer bindings, which are defined in the
address@hidden keymap variable. The most frequently used ones
+are described here.
+
address@hidden or @code{counsel-M-x} add more through the @code{keymap}
argument to
address@hidden These keys, also active in the minibuffer, are described
+under their respective commands.
address@hidden
+* Key bindings for navigation::
+* Key bindings for single selection, action, then exit minibuffer: Key
bindings for single selection action then exit minibuffer.
+* Key bindings for multiple selections and actions, keep minibuffer open: Key
bindings for multiple selections and actions keep minibuffer open.
+* Key bindings that alter minibuffer input::
+* Other key bindings::
+* Hydra in the minibuffer::
+* Saving the current completion session to a buffer::
address@hidden menu
+
address@hidden Key bindings for navigation
address@hidden Key bindings for navigation
+
address@hidden
address@hidden
address@hidden (@code{ivy-next-line}) selects the next candidate
address@hidden
address@hidden (@code{ivy-previous-line}) selects the previous candidate
address@hidden
address@hidden<} (@code{ivy-beginning-of-buffer}) selects the first candidate
address@hidden
address@hidden>} (@code{ivy-end-of-buffer}) selects the last candidate
address@hidden
address@hidden (@code{ivy-scroll-up-command}) scrolls up by @code{ivy-height}
lines
address@hidden
address@hidden (@code{ivy-scroll-down-command}) scrolls down by
@code{ivy-height} lines
address@hidden itemize
+
address@hidden ivy-wrap
+This user option allows to get the wrap-around behavior for @kbd{C-n} and
address@hidden When set to @code{t}, @code{ivy-next-line} and
@code{ivy-previous-line} will
+cycle past the last and the first candidates respectively.
+
+This behavior is off by default.
address@hidden defopt
+
address@hidden ivy-height
+Use this variable to adjust the minibuffer height, and therefore the
+scroll size for @kbd{C-v} and @kbd{M-v}.
address@hidden defopt
+
address@hidden Key bindings for single selection action then exit minibuffer
address@hidden Key bindings for single selection, action, then exit minibuffer
+
+Ivy can offer several actions from which to choose which action to
+run. This "calling an action" operates on the selected candidate. For
+example, when viewing a list of files, one action could open it for
+editing, one to view it, another to invoke a special function, and so
+on. Custom actions can be added to this interface. The precise action
+to call on the selected candidate can be delayed until after the
+narrowing is completed. No need to exit the interface if unsure which
+action to run. This delayed flexibility and customization of actions
+extends usability of lists in Emacs.
+
address@hidden or @kbd{RET} (@code{ivy-done}) calls the default action and
exits the
+minibuffer.
+
address@hidden (@code{ivy-dispatching-done}) presents all available valid
actions
+from which to choose. When there is only one action available, there
+is no difference between @kbd{M-o} and @kbd{C-m}.
+
address@hidden (@code{ivy-alt-done}) calls the alternate action, such as
completing
+a directory name in a file list whereas @kbd{C-m} will select that directory
+and exit the minibuffer.
+
+Exiting the minibuffer also closes the Ivy window (as specified by
address@hidden). This closing and exiting sequence is conveniently off
+when applying multiple actions. Multiple actions and multiple
+selections as covered in the next section of this manual.
+
address@hidden (@code{ivy-partial-or-done}) attempts partial completion,
extending
+current input as much as possible.
+
address@hidden TAB} is the same as @kbd{C-j}.
+
address@hidden (@code{ivy-immediate-done}) is useful when there is no match for
+the given input. Or there is an incorrect partial match. @kbd{C-M-j} with
address@hidden lists ignores the partial match and instead takes the
+current input to create a new directory with @code{dired-create-directory}.
+
address@hidden illustrates how Ivy distinguishes between calling
+an action on the @emph{currently selected} candidate and calling an action
+on the @emph{current input}.
+
+Invoking avy completion with @kbd{C-'} (@code{ivy-avy}).
address@hidden uses avy's visible jump mechanism, which can further reduce
+Ivy's line-by-line scrolling that requires multiple @kbd{C-n} or @kbd{C-p}
+keystrokes.
+
address@hidden Key bindings for multiple selections and actions keep minibuffer
open
address@hidden Key bindings for multiple selections and actions, keep
minibuffer open
+
+For repeatedly applying multiple actions or acting on multiple
+candidates, Ivy does not close the minibuffer between commands. It
+keeps the minibuffer open for applying subsequent actions.
+
+Adding an extra meta key to the normal key chord invokes the special
+version of the regular commands that enables applying multiple
+actions.
+
address@hidden (@code{ivy-call}) is the non-exiting version of the default
action,
address@hidden (@code{ivy-done}). Instead of closing the minibuffer,
@kbd{C-M-m} allows
+selecting another candidate or another action. For example, @kbd{C-M-m} on
+functions list invokes @code{describe-function}. When combined with @kbd{C-n},
+function descriptions can be invoked quickly in succession.
+
address@hidden exits the minibuffer.
+
address@hidden recalls the state of the completion session just before
+its last exit. Useful after an accidental @kbd{C-m} (@code{ivy-done}).
+
address@hidden (@code{ivy-dispatching-call}) is a non-exiting version of
@kbd{M-o}
+(@code{ivy-dispatching-done}) that can accumulate candidates into a queue.
+For example, for playback in @code{counsel-rhythmbox}, @kbd{C-M-o e} en-queues
+the selected candidate, and @kbd{C-n C-m} plays the next one in the queue.
+
address@hidden (@code{ivy-next-line-and-call}) combines @kbd{C-n} and
@kbd{C-M-m}. Applies
+an action and moves to next line. Comes in handy when opening multiple
+files from @code{counsel-find-file}, @code{counsel-git-grep},
@code{counsel-ag}, or
address@hidden lists. Just hold @kbd{C-M-n} for rapid-fire default
+action on each successive element of the list.
+
address@hidden (@code{ivy-previous-line-and-call}) combines @kbd{C-p} and
@kbd{C-M-m}. Is
+the same as above except that it moves through the list in the other
+direction.
+
address@hidden Key bindings that alter minibuffer input
address@hidden Key bindings that alter minibuffer input
+
address@hidden (@code{ivy-next-history-element}) and @kbd{M-p}
+(@code{ivy-previous-history-element}) cycle through the Ivy command
+history. Ivy updates an internal history list after each action. When
+this history list is empty, @kbd{M-n} inserts symbol (or URL) at point
+into the minibuffer.
+
address@hidden (@code{ivy-insert-current}) inserts the current candidate into
the
+minibuffer. Useful for copying and renaming files, for example: @kbd{M-i}
+to insert the original file name string, edit it, and then @kbd{C-m} to
+complete the renaming.
+
address@hidden (@code{ivy-yank-word}) inserts sub-word at point into
minibuffer. This
+is similar to @kbd{C-s C-w} with @code{isearch}. Ivy reserves @kbd{C-w} for
address@hidden
+
address@hidden (@code{ivy-restrict-to-matches}) deletes the current input, and
+resets the candidates list to the currently restricted matches. This
+is how Ivy provides narrowing in successive tiers.
+
address@hidden (@code{ivy-reverse-i-search}) works just like @kbd{C-r} at bash
command
+prompt, where the completion candidates are the history items. Upon
+completion, the selected candidate string is inserted into the
+minibuffer.
+
address@hidden Other key bindings
address@hidden Other key bindings
+
address@hidden (@code{ivy-kill-ring-save}) copies selected candidates to the
kill
+ring; when the region is active, copies active region.
+
address@hidden Hydra in the minibuffer
address@hidden Hydra in the minibuffer
+
address@hidden (@code{hydra-ivy/body}) invokes Hydra menus with key shortcuts.
+
address@hidden or @kbd{i} resumes editing.
+
+Hydra reduces key strokes, for example: @kbd{C-n C-n C-n C-n} is @kbd{C-o
+jjjj} in Hydra. Hydra has other benefits besides certain shorter key
+bindings:
address@hidden
address@hidden
address@hidden<} and @kbd{>} to adjust height of minibuffer,
address@hidden
+describes the current completion state, such as case folding and the
+current action.
address@hidden itemize
+
+Minibuffer editing is disabled when Hydra is active.
+
address@hidden Saving the current completion session to a buffer
address@hidden Saving the current completion session to a buffer
+
address@hidden C-o} (@code{ivy-occur}) saves the current candidates to a new
buffer;
+the list is active in the new buffer.
+
address@hidden or @kbd{mouse-1} in the new buffer calls the appropriate action
on
+the selected candidate.
+
+Ivy has no limit on the number of active buffers like these.
+
+Ivy takes care of making these buffer names unique. It applies
+descriptive names, for example: @code{*ivy-occur counsel-describe-variable
+"function$*}.
+
address@hidden Completion styles
address@hidden Completion styles
+
+Ivy's completion functions rely on the highly configurable regex
+builder.
+
+The default is:
+
address@hidden
+(setq ivy-re-builders-alist
+ '((t . ivy--regex-plus)))
address@hidden lisp
+
+The default @code{ivy--regex-plus} narrowing is always invoked unless
+specified otherwise. For example, file name completion may have a
+custom completion function:
+
address@hidden
+(setq ivy-re-builders-alist
+ '((read-file-name-internal . ivy--regex-fuzzy)
+ (t . ivy--regex-plus)))
address@hidden lisp
+
+Ivy's flexibility extends to using different styles of completion
+mechanics (regex-builders) for different types of lists. Despite this
+flexibility, Ivy operates within a consistent and uniform interface.
+The main regex-builders currently in Ivy are:
address@hidden
+* ivy--regex-plus::
+* ivy--regex-ignore-order::
+* ivy--regex-fuzzy::
address@hidden menu
+
address@hidden ivy--regex-plus
address@hidden ivy--regex-plus
+
address@hidden is Ivy's default completion method.
+
address@hidden matches by splitting the input by spaces and
+rebuilding it into a regex.
+
+As the search string is typed in Ivy's minibuffer, it is transformed
+into proper regex syntax. If the string is "for example", it is
+transformed into
+
address@hidden
+"\\(for\\).*\\(example\\)"
address@hidden verbatim
+
+which in regex terminology matches "for" followed by a wild card and
+then "example". Note how Ivy uses the space character to build
+wild cards. For literal white space matching in Ivy, use an extra space:
+to match one space type two spaces, to match two spaces type three
+spaces, and so on.
+
+As Ivy transforms typed characters into regex strings, it provides an
+intuitive feedback through font highlights.
+
+Ivy supports regexp negation with "!". For example, "define key ! ivy
+quit" first selects everything matching "define.*key", then removes
+everything matching "ivy", and finally removes everything matching
+"quit". What remains is the final result set of the negation regexp.
+
address@hidden
+Standard regexp identifiers work:
+
+"^", "$", "\b" or "[a-z]"
address@hidden verbatim
+
+Since Ivy treats minibuffer input as a regexp, standard regexp
+identifiers work as usual. The exceptions are spaces, which
+translate to ".*", and "!" that signal the beginning of a negation
+group.
+
address@hidden ivy--regex-ignore-order
address@hidden ivy--regex-ignore-order
+
address@hidden ignores the order of regexp tokens when
+searching for matching candidates. For instance, the input "for
+example" will match "example test for". Otherwise @code{ivy--regex-plus}
+normal behavior is to honor the order of regexp tokens.
+
address@hidden ivy--regex-fuzzy
address@hidden ivy--regex-fuzzy
+
address@hidden splits each character with a wild card. Searching
+for "for" returns all "f.*o.*r" matches, resulting in a large number
+of hits. Yet some searches need these extra hits. Ivy sorts such
+large lists using @code{flx} package's scoring mechanism, if it's
+installed.
+
address@hidden Variable Index
address@hidden Variable Index
+
address@hidden vr
+
address@hidden
diff --git a/packages/swiper/doc/style.css b/packages/swiper/doc/style.css
new file mode 100644
index 0000000..547b4f0
--- /dev/null
+++ b/packages/swiper/doc/style.css
@@ -0,0 +1,107 @@
+body {
+ color: #333;
+ background-color: #ffffff;
+ margin-left: 1em;
+ margin-right: auto;
+ font-family: 'Ubuntu Mono', sans-serif;
+ max-width: 50em;
+}
+
+body a {
+ color: blue;
+}
+
+h2 {
+ font-weight: normal;
+ text-indent: 0;
+ border-radius: 15px;
+ background-color: #d6d8ec;
+ text-align: left;
+ padding: 3px 3px 3px 3px;
+}
+
+h2 a[id^="unnumbered"] {
+ background-color: #d6d8ec;
+}
+
+h2 a {
+ color: white;
+ background-color:#777777;
+ font-size:18px;
+ border-radius:3px;
+ padding: 0px 5px 0px 5px;
+}
+
+kbd {
+ padding:0.1em 0.6em;
+ border:1px solid #ccc;
+ font-size:13px;
+ font-weight:bold;
+ font-family:monospace;
+ background-color:#d6d8ec;
+ color:#333;
+ -moz-box-shadow:0 1px 0px rgba(0, 0, 0, 0.2),0 0 0 2px #ffffff inset;
+ -webkit-box-shadow:0 1px 0px rgba(0, 0, 0, 0.2),0 0 0 2px #ffffff inset;
+ box-shadow:0 1px 0px rgba(0, 0, 0, 0.2),0 0 0 2px #ffffff inset;
+ -moz-border-radius:3px;
+ -webkit-border-radius:3px;
+ border-radius:3px;
+ display:inline-block;
+ margin:0 0.1em;
+ text-shadow:0 1px 0 #fff;
+ line-height:1.4;
+ white-space:nowrap;
+}
+
+body a code {
+ color: black;
+ border: 1px solid Blue;
+ border-radius:3px;
+}
+
+code {
+ font-size:13px;
+ border: 1px solid Silver;
+ background-color: #e3e4ec;
+}
+
+pre {
+ border: 1px solid Silver;
+ background-color: #eeeeee;
+ padding: 3px;
+ margin-left: 1em;
+}
+
+cursor {
+ color: #fff;
+ background-color: #000;
+ overflow: hidden;
+}
+
+h3 {
+ counter-reset: chapter;
+}
+
+h4 {
+ margin-left: auto;
+}
+
+table, td, th {
+ border: 0px;
+}
+
+th {
+ background-color:#d6d8ec;
+}
+
+tr:nth-child(odd) {
+ background-color:#fff;
+}
+tr:nth-child(even) {
+ background-color:#d6d8ec;
+}
+
+.region {
+ color: #ffffff;
+ background-color: #f9b593;
+}
diff --git a/packages/swiper/ivy-hydra.el b/packages/swiper/ivy-hydra.el
new file mode 100644
index 0000000..63755da
--- /dev/null
+++ b/packages/swiper/ivy-hydra.el
@@ -0,0 +1,90 @@
+;;; ivy-hydra.el --- Additional key bindings for Ivy -*- lexical-binding: t
-*-
+
+;; Copyright (C) 2015 Free Software Foundation, Inc.
+
+;; Author: Oleh Krehel
+
+;; 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, 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.
+
+;; For a full copy of the GNU General Public License
+;; see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; This package provides the `hydra-ivy/body' command, which is a
+;; quasi-prefix map, with many useful bindings. These bindings are
+;; shorter than usual, using mostly unprefixed keys.
+
+;;; Code:
+(require 'hydra nil t)
+(require 'ivy)
+
+(eval-when-compile
+ (unless (or (featurep 'hydra) (package-installed-p 'hydra))
+ (defmacro defhydra (name &rest _)
+ "This is a stub for the uninstalled `hydra' package."
+ `(defun ,(intern (format "%S/body" name)) ()
+ (interactive)
+ (let ((enable-recursive-minibuffers t))
+ (if (yes-or-no-p "Package `hydra' not installed. Install?")
+ (progn
+ (package-install 'hydra)
+ (save-window-excursion
+ (find-library "ivy-hydra")
+ (byte-compile-file (buffer-file-name) t)))
+ (error "Please install `hydra' and recompile/reinstall
`ivy-hydra'")))))))
+
+(defun ivy--matcher-desc ()
+ (if (eq ivy--regex-function
+ 'ivy--regex-fuzzy)
+ "fuzzy"
+ "ivy"))
+
+(defhydra hydra-ivy (:hint nil
+ :color pink)
+ "
+^^^^^^ ^Yes^ ^^ ^No^ ^Maybe^
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^Action^ ^
+^^^^^^^^^^^^^^^----------------------------------------------^^^^^^^^^^^^^^^^^^^^^^^^^^^^^-----------------------
+^ ^ _k_ ^ ^ _f_ollow occ_u_r _i_nsert _c_: calling %-5s(if ivy-calling
\"on\" \"off\") _w_/_s_/_a_: %-14s(ivy-action-name)
+_h_ ^+^ _l_ _d_one ^ ^ _o_ops _m_: matcher
%-5s(ivy--matcher-desc)^^^^^^^^^^^^ _C_ase-fold: %-10`ivy-case-fold-search
+^ ^ _j_ ^ ^ _g_o ^ ^ ^ ^ _<_/_>_:
shrink/grow^^^^^^^^^^^^^^^^^^^^^^^^^^^^ _t_runcate: %-11`truncate-lines
+"
+ ;; arrows
+ ("h" ivy-beginning-of-buffer)
+ ("j" ivy-next-line)
+ ("k" ivy-previous-line)
+ ("l" ivy-end-of-buffer)
+ ;; actions
+ ("o" keyboard-escape-quit :exit t)
+ ("C-g" keyboard-escape-quit :exit t)
+ ("i" nil)
+ ("C-o" nil)
+ ("f" ivy-alt-done :exit nil)
+ ("C-j" ivy-alt-done :exit nil)
+ ("d" ivy-done :exit t)
+ ("g" ivy-call)
+ ("C-m" ivy-done :exit t)
+ ("c" ivy-toggle-calling)
+ ("m" ivy-toggle-fuzzy)
+ (">" ivy-minibuffer-grow)
+ ("<" ivy-minibuffer-shrink)
+ ("w" ivy-prev-action)
+ ("s" ivy-next-action)
+ ("a" ivy-read-action)
+ ("t" (setq truncate-lines (not truncate-lines)))
+ ("C" ivy-toggle-case-fold)
+ ("u" ivy-occur :exit t))
+
+(provide 'ivy-hydra)
+
+;;; ivy-hydra.el ends here
diff --git a/packages/swiper/ivy-test.el b/packages/swiper/ivy-test.el
index a33f886..ec5857d 100644
--- a/packages/swiper/ivy-test.el
+++ b/packages/swiper/ivy-test.el
@@ -20,6 +20,7 @@
;; see <http://www.gnu.org/licenses/>.
(require 'ert)
+(require 'ivy)
(defvar ivy-expr nil
"Holds a test expression to evaluate with `ivy-eval'.")
@@ -44,12 +45,6 @@
(ert-deftest ivy-read ()
(should (equal
- (ivy-read "pattern: " nil)
- nil))
- (should (equal
- (ivy-read "pattern: " '("42"))
- "42"))
- (should (equal
(ivy-with '(ivy-read "pattern: " '("blue" "yellow"))
"C-m")
"blue"))
@@ -64,4 +59,82 @@
(should (equal
(ivy-with '(ivy-read "pattern: " '("blue" "yellow"))
"z C-m")
- nil)))
+ "z"))
+ (should (equal
+ (ivy-with '(ivy-read "pattern: " '("blue" "yellow"))
+ "y <backspace> C-m")
+ "blue"))
+ (should (equal
+ (ivy-with '(let ((ivy-re-builders-alist '((t . ivy--regex-fuzzy))))
+ (ivy-read "pattern: " '("package-list-packages"
"something-else")))
+ "plp C-m")
+ "package-list-packages"))
+ (should (equal
+ (ivy-with '(ivy-read "test" '("aaab" "aaac"))
+ "a C-n <tab> C-m")
+ "aaac"))
+ (should (equal
+ (ivy-with '(ivy-read "pattern: " '("can do" "can" "can't do"))
+ "can C-m")
+ "can")))
+
+(ert-deftest swiper--re-builder ()
+ (setq swiper--width 4)
+ (should (string= (swiper--re-builder "^")
+ "."))
+ (should (string= (swiper--re-builder "^a")
+ "^ ?\\(a\\)"))
+ (should (string= (swiper--re-builder "^a b")
+ "^ \\(a\\).*?\\(b\\)")))
+
+(ert-deftest ivy--split ()
+ (should (equal (ivy--split "King of the who?")
+ '("King" "of" "the" "who?")))
+ (should (equal (ivy--split "The Brittons.")
+ '("The Brittons.")))
+ (should (equal (ivy--split "Who are the Brittons?")
+ '("Who are" "the Brittons?")))
+ (should (equal (ivy--split "We're all Britons and I am your king.")
+ '("We're all Britons"
+ "and I am"
+ "your king."))))
+
+(ert-deftest ivy--regex-fuzzy ()
+ (should (string= (ivy--regex-fuzzy "tmux")
+ "\\(t\\).*\\(m\\).*\\(u\\).*\\(x\\)"))
+ (should (string= (ivy--regex-fuzzy "^tmux")
+ "^\\(t\\).*\\(m\\).*\\(u\\).*\\(x\\)"))
+ (should (string= (ivy--regex-fuzzy "^tmux$")
+ "^\\(t\\).*\\(m\\).*\\(u\\).*\\(x\\)$"))
+ (should (string= (ivy--regex-fuzzy "")
+ ""))
+ (should (string= (ivy--regex-fuzzy "^")
+ "^"))
+ (should (string= (ivy--regex-fuzzy "$")
+ "$")))
+
+(ert-deftest ivy--format ()
+ (should (string= (let ((ivy--index 10)
+ (ivy-format-function (lambda (x) (mapconcat (lambda
(y) (car y)) x "\n")))
+ (cands '("NAME"
+ "SYNOPSIS"
+ "DESCRIPTION"
+ "FUNCTION LETTERS"
+ "SWITCHES"
+ "DIAGNOSTICS"
+ "EXAMPLE 1"
+ "EXAMPLE 2"
+ "EXAMPLE 3"
+ "SEE ALSO"
+ "AUTHOR")))
+ (ivy--format cands))
+ #("\nDESCRIPTION\nFUNCTION
LETTERS\nSWITCHES\nDIAGNOSTICS\nEXAMPLE 1\nEXAMPLE 2\nEXAMPLE 3\nSEE
ALSO\nAUTHOR"
+ 0 90 (read-only nil)
+ 90 96 (face ivy-current-match read-only nil)))))
+
+(ert-deftest ivy--filter ()
+ (setq ivy-last (make-ivy-state))
+ (should (equal (ivy--filter "the" '("foo" "the" "The"))
+ '("the" "The")))
+ (should (equal (ivy--filter "The" '("foo" "the" "The"))
+ '("The"))))
diff --git a/packages/swiper/ivy.el b/packages/swiper/ivy.el
index 180f081..5127582 100644
--- a/packages/swiper/ivy.el
+++ b/packages/swiper/ivy.el
@@ -4,7 +4,6 @@
;; Author: Oleh Krehel <address@hidden>
;; URL: https://github.com/abo-abo/swiper
-;; Version: 0.2.0
;; Package-Requires: ((emacs "24.1"))
;; Keywords: matching
@@ -37,235 +36,1388 @@
;; So "for example" is transformed into "\\(for\\).*\\(example\\)".
;;; Code:
+(require 'cl-lib)
+(require 'ffap)
+
;;* Customization
(defgroup ivy nil
"Incremental vertical completion."
:group 'convenience)
+(defgroup ivy-faces nil
+ "Font-lock faces for `ivy'."
+ :group 'ivy)
+
(defface ivy-current-match
- '((t (:inherit highlight)))
- "Face used by Ivy for highlighting first match.")
+ '((((class color) (background light))
+ :background "#1a4b77" :foreground "white")
+ (((class color) (background dark))
+ :background "#65a7e2" :foreground "black"))
+ "Face used by Ivy for highlighting the current match.")
+
+(defface ivy-minibuffer-match-face-1
+ '((((class color) (background light))
+ :background "#d3d3d3")
+ (((class color) (background dark))
+ :background "#555555"))
+ "The background face for `ivy' minibuffer matches.")
+
+(defface ivy-minibuffer-match-face-2
+ '((((class color) (background light))
+ :background "#e99ce8" :weight bold)
+ (((class color) (background dark))
+ :background "#777777" :weight bold))
+ "Face for `ivy' minibuffer matches modulo 1.")
+
+(defface ivy-minibuffer-match-face-3
+ '((((class color) (background light))
+ :background "#bbbbff" :weight bold)
+ (((class color) (background dark))
+ :background "#7777ff" :weight bold))
+ "Face for `ivy' minibuffer matches modulo 2.")
+
+(defface ivy-minibuffer-match-face-4
+ '((((class color) (background light))
+ :background "#ffbbff" :weight bold)
+ (((class color) (background dark))
+ :background "#8a498a" :weight bold))
+ "Face for `ivy' minibuffer matches modulo 3.")
+
+(defface ivy-confirm-face
+ '((t :foreground "ForestGreen" :inherit minibuffer-prompt))
+ "Face used by Ivy for a confirmation prompt.")
+
+(defface ivy-match-required-face
+ '((t :foreground "red" :inherit minibuffer-prompt))
+ "Face used by Ivy for a match required prompt.")
+
+(setcdr (assoc load-file-name custom-current-group-alist) 'ivy)
+
+(defface ivy-subdir
+ '((t (:inherit 'dired-directory)))
+ "Face used by Ivy for highlighting subdirs in the alternatives.")
+
+(defface ivy-modified-buffer
+ '((t :inherit 'default))
+ "Face used by Ivy for highlighting modified file visiting buffers.")
+
+(defface ivy-remote
+ '((t (:foreground "#110099")))
+ "Face used by Ivy for highlighting remotes in the alternatives.")
+
+(defface ivy-virtual
+ '((t :inherit font-lock-builtin-face))
+ "Face used by Ivy for matching virtual buffer names.")
(defcustom ivy-height 10
"Number of lines for the minibuffer window."
:type 'integer)
(defcustom ivy-count-format "%-4d "
- "The style of showing the current candidate count for `ivy-read'.
-Set this to nil if you don't want the count."
- :type 'string)
+ "The style to use for displaying the current candidate count for `ivy-read'.
+Set this to \"\" to suppress the count visibility.
+Set this to \"(%d/%d) \" to display both the index and the count."
+ :type '(choice
+ (const :tag "Count disabled" "")
+ (const :tag "Count matches" "%-4d ")
+ (const :tag "Count matches and show current match" "(%d/%d) ")
+ string))
(defcustom ivy-wrap nil
- "Whether to wrap around after the first and last candidate."
+ "When non-nil, wrap around after the first and the last candidate."
:type 'boolean)
-;;* User Visible
-;;** Keymap
+(defcustom ivy-display-style (unless (version< emacs-version "24.5") 'fancy)
+ "The style for formatting the minibuffer.
+
+By default, the matched strings are copied as is.
+
+The fancy display style highlights matching parts of the regexp,
+a behavior similar to `swiper'.
+
+This setting depends on `add-face-text-property' - a C function
+available as of Emacs 24.5. Fancy style will render poorly in
+earlier versions of Emacs."
+ :type '(choice
+ (const :tag "Plain" nil)
+ (const :tag "Fancy" fancy)))
+
+(defcustom ivy-on-del-error-function 'minibuffer-keyboard-quit
+ "The handler for when `ivy-backward-delete-char' throws.
+Usually a quick exit out of the minibuffer."
+ :type 'function)
+
+(defcustom ivy-extra-directories '("../" "./")
+ "Add this to the front of the list when completing file names.
+Only \"./\" and \"../\" apply here. They appear in reverse order."
+ :type '(repeat :tag "Dirs"
+ (choice
+ (const :tag "Parent Directory" "../")
+ (const :tag "Current Directory" "./"))))
+
+(defcustom ivy-use-virtual-buffers nil
+ "When non-nil, add `recentf-mode' and bookmarks to `ivy-switch-buffer'."
+ :type 'boolean)
+
+(defvar ivy--actions-list nil
+ "A list of extra actions per command.")
+
+(defun ivy-set-actions (cmd actions)
+ "Set CMD extra exit points to ACTIONS."
+ (setq ivy--actions-list
+ (plist-put ivy--actions-list cmd actions)))
+
+;;* Keymap
(require 'delsel)
(defvar ivy-minibuffer-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "C-m") 'ivy-done)
+ (define-key map (kbd "C-M-m") 'ivy-call)
+ (define-key map (kbd "C-j") 'ivy-alt-done)
+ (define-key map (kbd "C-M-j") 'ivy-immediate-done)
+ (define-key map (kbd "TAB") 'ivy-partial-or-done)
(define-key map (kbd "C-n") 'ivy-next-line)
(define-key map (kbd "C-p") 'ivy-previous-line)
+ (define-key map (kbd "<down>") 'ivy-next-line)
+ (define-key map (kbd "<up>") 'ivy-previous-line)
(define-key map (kbd "C-s") 'ivy-next-line-or-history)
- (define-key map (kbd "C-r") 'ivy-previous-line-or-history)
+ (define-key map (kbd "C-r") 'ivy-reverse-i-search)
(define-key map (kbd "SPC") 'self-insert-command)
(define-key map (kbd "DEL") 'ivy-backward-delete-char)
+ (define-key map (kbd "M-DEL") 'ivy-backward-kill-word)
+ (define-key map (kbd "C-d") 'ivy-delete-char)
+ (define-key map (kbd "C-f") 'ivy-forward-char)
+ (define-key map (kbd "M-d") 'ivy-kill-word)
(define-key map (kbd "M-<") 'ivy-beginning-of-buffer)
(define-key map (kbd "M->") 'ivy-end-of-buffer)
(define-key map (kbd "M-n") 'ivy-next-history-element)
(define-key map (kbd "M-p") 'ivy-previous-history-element)
(define-key map (kbd "C-g") 'minibuffer-keyboard-quit)
+ (define-key map (kbd "C-v") 'ivy-scroll-up-command)
+ (define-key map (kbd "M-v") 'ivy-scroll-down-command)
+ (define-key map (kbd "C-M-n") 'ivy-next-line-and-call)
+ (define-key map (kbd "C-M-p") 'ivy-previous-line-and-call)
+ (define-key map (kbd "M-q") 'ivy-toggle-regexp-quote)
+ (define-key map (kbd "M-j") 'ivy-yank-word)
+ (define-key map (kbd "M-i") 'ivy-insert-current)
+ (define-key map (kbd "C-o") 'hydra-ivy/body)
+ (define-key map (kbd "M-o") 'ivy-dispatching-done)
+ (define-key map (kbd "C-M-o") 'ivy-dispatching-call)
+ (define-key map (kbd "C-k") 'ivy-kill-line)
+ (define-key map (kbd "S-SPC") 'ivy-restrict-to-matches)
+ (define-key map (kbd "M-w") 'ivy-kill-ring-save)
+ (define-key map (kbd "C-'") 'ivy-avy)
+ (define-key map (kbd "C-M-a") 'ivy-read-action)
+ (define-key map (kbd "C-c C-o") 'ivy-occur)
map)
"Keymap used in the minibuffer.")
+(autoload 'hydra-ivy/body "ivy-hydra" "" t)
+
+(defvar ivy-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [remap switch-to-buffer] 'ivy-switch-buffer)
+ map)
+ "Keymap for `ivy-mode'.")
+
+;;* Globals
+(cl-defstruct ivy-state
+ prompt collection
+ predicate require-match initial-input
+ history preselect keymap update-fn sort
+ ;; The window in which `ivy-read' was called
+ window
+ ;; The buffer in which `ivy-read' was called
+ buffer
+ ;; The value of `ivy-text' to be used by `ivy-occur'
+ text
+ action
+ unwind
+ re-builder
+ matcher
+ ;; When this is non-nil, call it for each input change to get new candidates
+ dynamic-collection
+ caller)
+
+(defvar ivy-last nil
+ "The last parameters passed to `ivy-read'.
+
+This should eventually become a stack so that you could use
+`ivy-read' recursively.")
+
+(defsubst ivy-set-action (action)
+ (setf (ivy-state-action ivy-last) action))
(defvar ivy-history nil
"History list of candidates entered in the minibuffer.
Maximum length of the history list is determined by the value
-of `history-length', which see.")
+of `history-length'.")
+
+(defvar ivy--directory nil
+ "Current directory when completing file names.")
+
+(defvar ivy--length 0
+ "Store the amount of viable candidates.")
+
+(defvar ivy-text ""
+ "Store the user's string as it is typed in.")
+
+(defvar ivy--current ""
+ "Current candidate.")
-;;** Commands
+(defvar ivy--index 0
+ "Store the index of the current candidate.")
+
+(defvar ivy-exit nil
+ "Store 'done if the completion was successfully selected.
+Otherwise, store nil.")
+
+(defvar ivy--all-candidates nil
+ "Store the candidates passed to `ivy-read'.")
+
+(defvar ivy--default nil
+ "Default initial input.")
+
+(defvar ivy--prompt nil
+ "Store the format-style prompt.
+When non-nil, it should contain at least one %d.")
+
+(defvar ivy--prompt-extra ""
+ "Temporary modifications to the prompt.")
+
+(defvar ivy--old-re nil
+ "Store the old regexp.")
+
+(defvar ivy--old-cands nil
+ "Store the candidates matched by `ivy--old-re'.")
+
+(defvar ivy--regex-function 'ivy--regex
+ "Current function for building a regex.")
+
+(defvar ivy--subexps 0
+ "Number of groups in the current `ivy--regex'.")
+
+(defvar ivy--full-length nil
+ "When :dynamic-collection is non-nil, this can be the total amount of
candidates.")
+
+(defvar ivy--old-text ""
+ "Store old `ivy-text' for dynamic completion.")
+
+(defvar ivy-case-fold-search 'auto
+ "Store the current overriding `case-fold-search'.")
+
+(defvar Info-current-file)
+
+(defmacro ivy-quit-and-run (&rest body)
+ "Quit the minibuffer and run BODY afterwards."
+ `(progn
+ (put 'quit 'error-message "")
+ (run-at-time nil nil
+ (lambda ()
+ (put 'quit 'error-message "Quit")
+ ,@body))
+ (minibuffer-keyboard-quit)))
+
+(defun ivy-exit-with-action (action)
+ "Quit the minibuffer and call ACTION afterwards."
+ (ivy-set-action
+ `(lambda (x)
+ (funcall ',action x)
+ (ivy-set-action ',(ivy-state-action ivy-last))))
+ (setq ivy-exit 'done)
+ (exit-minibuffer))
+
+(defmacro with-ivy-window (&rest body)
+ "Execute BODY in the window from which `ivy-read' was called."
+ (declare (indent 0)
+ (debug t))
+ `(with-selected-window (ivy--get-window ivy-last)
+ ,@body))
+
+(defun ivy--done (text)
+ "Insert TEXT and exit minibuffer."
+ (if (and ivy--directory
+ (not (eq (ivy-state-history ivy-last) 'grep-files-history)))
+ (insert (setq ivy--current (expand-file-name
+ text ivy--directory)))
+ (insert (setq ivy--current text)))
+ (setq ivy-exit 'done)
+ (exit-minibuffer))
+
+;;* Commands
(defun ivy-done ()
"Exit the minibuffer with the selected candidate."
(interactive)
(delete-minibuffer-contents)
- (unless (zerop ivy--length)
- (insert ivy--current)
- (setq ivy-exit 'done))
+ (cond ((> ivy--length 0)
+ (ivy--done ivy--current))
+ ((memq (ivy-state-collection ivy-last)
+ '(read-file-name-internal internal-complete-buffer))
+ (if (or (not (eq confirm-nonexistent-file-or-buffer t))
+ (equal " (confirm)" ivy--prompt-extra))
+ (ivy--done ivy-text)
+ (setq ivy--prompt-extra " (confirm)")
+ (insert ivy-text)
+ (ivy--exhibit)))
+ ((memq (ivy-state-require-match ivy-last)
+ '(nil confirm confirm-after-completion))
+ (ivy--done ivy-text))
+ (t
+ (setq ivy--prompt-extra " (match required)")
+ (insert ivy-text)
+ (ivy--exhibit))))
+
+(defun ivy-read-action ()
+ "Change the action to one of the available ones."
+ (interactive)
+ (let ((actions (ivy-state-action ivy-last)))
+ (unless (null (ivy--actionp actions))
+ (let* ((hint (concat ivy--current
+ "\n"
+ (mapconcat
+ (lambda (x)
+ (format "%s: %s"
+ (propertize
+ (car x)
+ 'face 'font-lock-builtin-face)
+ (nth 2 x)))
+ (cdr actions)
+ "\n")
+ "\n"))
+ (key (string (read-key hint)))
+ (action-idx (cl-position-if
+ (lambda (x) (equal (car x) key))
+ (cdr actions))))
+ (cond ((string= key ""))
+ ((null action-idx)
+ (error "%s is not bound" key))
+ (t
+ (message "")
+ (setcar actions (1+ action-idx))
+ (ivy-set-action actions)))))))
+
+(defun ivy-dispatching-done ()
+ "Select one of the available actions and call `ivy-done'."
+ (interactive)
+ (ivy-read-action)
+ (ivy-done))
+
+(defun ivy-dispatching-call ()
+ "Select one of the available actions and call `ivy-call'."
+ (interactive)
+ (let ((actions (copy-sequence (ivy-state-action ivy-last))))
+ (unwind-protect
+ (when (ivy-read-action)
+ (ivy-call))
+ (ivy-set-action actions))))
+
+(defun ivy-build-tramp-name (x)
+ "Reconstruct X into a path.
+Is is a cons cell, related to `tramp-get-completion-function'."
+ (let ((user (car x))
+ (domain (cadr x)))
+ (if user
+ (concat user "@" domain)
+ domain)))
+
+(declare-function tramp-get-completion-function "tramp")
+(declare-function Info-find-node "info")
+
+(defun ivy-alt-done (&optional arg)
+ "Exit the minibuffer with the selected candidate.
+When ARG is t, exit with current text, ignoring the candidates."
+ (interactive "P")
+ (cond (arg
+ (ivy-immediate-done))
+ (ivy--directory
+ (ivy--directory-done))
+ ((eq (ivy-state-collection ivy-last) 'Info-read-node-name-1)
+ (if (or (equal ivy--current "(./)")
+ (equal ivy--current "(../)"))
+ (ivy-quit-and-run
+ (ivy-read "Go to file: " 'read-file-name-internal
+ :action (lambda (x)
+ (Info-find-node
+ (expand-file-name x ivy--directory)
+ "Top"))))
+ (ivy-done)))
+ (t
+ (ivy-done))))
+
+(defun ivy--directory-done ()
+ "Handle exit from the minibuffer when completing file names."
+ (let (dir)
+ (cond
+ ((equal ivy-text "/sudo::")
+ (setq dir (concat ivy-text ivy--directory))
+ (ivy--cd dir)
+ (ivy--exhibit))
+ ((or
+ (and
+ (not (equal ivy-text ""))
+ (ignore-errors
+ (file-directory-p
+ (setq dir
+ (file-name-as-directory
+ (expand-file-name
+ ivy-text ivy--directory))))))
+ (and
+ (not (string= ivy--current "./"))
+ (cl-plusp ivy--length)
+ (ignore-errors
+ (file-directory-p
+ (setq dir (file-name-as-directory
+ (expand-file-name
+ ivy--current ivy--directory)))))))
+ (ivy--cd dir)
+ (ivy--exhibit))
+ ((or (and (equal ivy--directory "/")
+ (string-match "\\`[^/]+:.*:.*\\'" ivy-text))
+ (string-match "\\`/[^/]+:.*:.*\\'" ivy-text))
+ (ivy-done))
+ ((or (and (equal ivy--directory "/")
+ (cond ((string-match
+ "\\`\\([^/]+?\\):\\(?:\\(.*\\)@\\)?\\(.*\\)\\'"
+ ivy-text))
+ ((string-match
+ "\\`\\([^/]+?\\):\\(?:\\(.*\\)@\\)?\\(.*\\)\\'"
+ ivy--current)
+ (setq ivy-text ivy--current))))
+ (string-match
+ "\\`/\\([^/]+?\\):\\(?:\\(.*\\)@\\)?\\(.*\\)\\'"
+ ivy-text))
+ (let ((method (match-string 1 ivy-text))
+ (user (match-string 2 ivy-text))
+ (rest (match-string 3 ivy-text))
+ res)
+ (require 'tramp)
+ (dolist (x (tramp-get-completion-function method))
+ (setq res (append res (funcall (car x) (cadr x)))))
+ (setq res (delq nil res))
+ (when user
+ (dolist (x res)
+ (setcar x user)))
+ (setq res (cl-delete-duplicates res :test #'equal))
+ (let* ((old-ivy-last ivy-last)
+ (enable-recursive-minibuffers t)
+ (host (ivy-read "Find File: "
+ (mapcar #'ivy-build-tramp-name res)
+ :initial-input rest)))
+ (setq ivy-last old-ivy-last)
+ (when host
+ (setq ivy--directory "/")
+ (ivy--cd (concat "/" method ":" host ":"))))))
+ (t
+ (ivy-done)))))
+
+(defcustom ivy-tab-space nil
+ "When non-nil, `ivy-partial-or-done' should insert a space."
+ :type 'boolean)
+
+(defun ivy-partial-or-done ()
+ "Complete the minibuffer text as much as possible.
+If the text hasn't changed as a result, forward to `ivy-alt-done'."
+ (interactive)
+ (if (and (eq (ivy-state-collection ivy-last) #'read-file-name-internal)
+ (or (and (equal ivy--directory "/")
+ (string-match "\\`[^/]+:.*\\'" ivy-text))
+ (string-match "\\`/" ivy-text)))
+ (let ((default-directory ivy--directory))
+ (minibuffer-complete)
+ (setq ivy-text (ivy--input))
+ (when (file-directory-p
+ (expand-file-name ivy-text ivy--directory))
+ (ivy--cd (file-name-as-directory
+ (expand-file-name ivy-text ivy--directory)))))
+ (or (ivy-partial)
+ (when (or (eq this-command last-command)
+ (eq ivy--length 1))
+ (ivy-alt-done)))))
+
+(defun ivy-partial ()
+ "Complete the minibuffer text as much as possible."
+ (interactive)
+ (let* ((parts (or (split-string ivy-text " " t) (list "")))
+ (postfix (car (last parts)))
+ (completion-ignore-case t)
+ (startp (string-match "^\\^" postfix))
+ (new (try-completion (if startp
+ (substring postfix 1)
+ postfix)
+ (mapcar (lambda (str)
+ (let ((i (string-match postfix str)))
+ (when i
+ (substring str i))))
+ ivy--old-cands))))
+ (cond ((eq new t) nil)
+ ((string= new ivy-text) nil)
+ (new
+ (delete-region (minibuffer-prompt-end) (point-max))
+ (setcar (last parts)
+ (if startp
+ (concat "^" new)
+ new))
+ (insert (mapconcat #'identity parts " ")
+ (if ivy-tab-space " " ""))
+ t))))
+
+(defun ivy-immediate-done ()
+ "Exit the minibuffer with the current input."
+ (interactive)
+ (delete-minibuffer-contents)
+ (insert (setq ivy--current
+ (if ivy--directory
+ (expand-file-name ivy-text ivy--directory)
+ ivy-text)))
+ (setq ivy-exit 'done)
(exit-minibuffer))
+;;;###autoload
+(defun ivy-resume ()
+ "Resume the last completion session."
+ (interactive)
+ (when (eq (ivy-state-caller ivy-last) 'swiper)
+ (switch-to-buffer (ivy-state-buffer ivy-last)))
+ (with-current-buffer (ivy-state-buffer ivy-last)
+ (ivy-read
+ (ivy-state-prompt ivy-last)
+ (ivy-state-collection ivy-last)
+ :predicate (ivy-state-predicate ivy-last)
+ :require-match (ivy-state-require-match ivy-last)
+ :initial-input ivy-text
+ :history (ivy-state-history ivy-last)
+ :preselect (unless (eq (ivy-state-collection ivy-last)
+ 'read-file-name-internal)
+ ivy--current)
+ :keymap (ivy-state-keymap ivy-last)
+ :update-fn (ivy-state-update-fn ivy-last)
+ :sort (ivy-state-sort ivy-last)
+ :action (ivy-state-action ivy-last)
+ :unwind (ivy-state-unwind ivy-last)
+ :re-builder (ivy-state-re-builder ivy-last)
+ :matcher (ivy-state-matcher ivy-last)
+ :dynamic-collection (ivy-state-dynamic-collection ivy-last)
+ :caller (ivy-state-caller ivy-last))))
+
+(defvar ivy-calling nil
+ "When non-nil, call the current action when `ivy--index' changes.")
+
+(defun ivy-set-index (index)
+ "Set `ivy--index' to INDEX."
+ (setq ivy--index index)
+ (when ivy-calling
+ (ivy--exhibit)
+ (ivy-call)))
+
(defun ivy-beginning-of-buffer ()
"Select the first completion candidate."
(interactive)
- (setq ivy--index 0))
+ (ivy-set-index 0))
(defun ivy-end-of-buffer ()
"Select the last completion candidate."
(interactive)
- (setq ivy--index (1- ivy--length)))
+ (ivy-set-index (1- ivy--length)))
-(defun ivy-next-line ()
- "Select the next completion candidate."
+(defun ivy-scroll-up-command ()
+ "Scroll the candidates upward by the minibuffer height."
(interactive)
- (if (>= ivy--index (1- ivy--length))
- (when ivy-wrap
- (ivy-beginning-of-buffer))
- (cl-incf ivy--index)))
+ (ivy-set-index (min (1- (+ ivy--index ivy-height))
+ (1- ivy--length))))
-(defun ivy-next-line-or-history ()
- "Select the next completion candidate.
-If the input is empty, select the previous history element instead."
+(defun ivy-scroll-down-command ()
+ "Scroll the candidates downward by the minibuffer height."
+ (interactive)
+ (ivy-set-index (max (1+ (- ivy--index ivy-height))
+ 0)))
+
+(defun ivy-minibuffer-grow ()
+ "Grow the minibuffer window by 1 line."
+ (interactive)
+ (setq-local max-mini-window-height
+ (cl-incf ivy-height)))
+
+(defun ivy-minibuffer-shrink ()
+ "Shrink the minibuffer window by 1 line."
(interactive)
+ (unless (<= ivy-height 2)
+ (setq-local max-mini-window-height
+ (cl-decf ivy-height))
+ (window-resize (selected-window) -1)))
+
+(defun ivy-next-line (&optional arg)
+ "Move cursor vertically down ARG candidates."
+ (interactive "p")
+ (setq arg (or arg 1))
+ (let ((index (+ ivy--index arg)))
+ (if (> index (1- ivy--length))
+ (if ivy-wrap
+ (ivy-beginning-of-buffer)
+ (ivy-set-index (1- ivy--length)))
+ (ivy-set-index index))))
+
+(defun ivy-next-line-or-history (&optional arg)
+ "Move cursor vertically down ARG candidates.
+If the input is empty, select the previous history element instead."
+ (interactive "p")
(when (string= ivy-text "")
(ivy-previous-history-element 1))
- (if (>= ivy--index (1- ivy--length))
- (when ivy-wrap
- (ivy-beginning-of-buffer))
- (cl-incf ivy--index)))
+ (ivy-next-line arg))
-(defun ivy-previous-line ()
- "Select the previous completion candidate."
- (interactive)
- (if (zerop ivy--index)
- (when ivy-wrap
- (ivy-end-of-buffer))
- (cl-decf ivy--index)))
+(defun ivy-previous-line (&optional arg)
+ "Move cursor vertically up ARG candidates."
+ (interactive "p")
+ (setq arg (or arg 1))
+ (let ((index (- ivy--index arg)))
+ (if (< index 0)
+ (if ivy-wrap
+ (ivy-end-of-buffer)
+ (ivy-set-index 0))
+ (ivy-set-index index))))
-(defun ivy-previous-line-or-history ()
- "Select the previous completion candidate.
+(defun ivy-previous-line-or-history (arg)
+ "Move cursor vertically up ARG candidates.
If the input is empty, select the previous history element instead."
- (interactive)
+ (interactive "p")
(when (string= ivy-text "")
(ivy-previous-history-element 1))
- (if (zerop ivy--index)
- (when ivy-wrap
- (ivy-end-of-buffer))
- (cl-decf ivy--index)))
+ (ivy-previous-line arg))
+
+(defun ivy-toggle-calling ()
+ "Flip `ivy-calling'."
+ (interactive)
+ (when (setq ivy-calling (not ivy-calling))
+ (ivy-call)))
+
+(defun ivy--get-action (state)
+ "Get the action function from STATE."
+ (let ((action (ivy-state-action state)))
+ (when action
+ (if (functionp action)
+ action
+ (cadr (nth (car action) action))))))
+
+(defun ivy--get-window (state)
+ "Get the window from STATE."
+ (let ((window (ivy-state-window state)))
+ (if (window-live-p window)
+ window
+ (if (= (length (window-list)) 1)
+ (selected-window)
+ (next-window)))))
+
+(defun ivy--actionp (x)
+ "Return non-nil when X is a list of actions."
+ (and x (listp x) (not (eq (car x) 'closure))))
+
+(defun ivy-next-action ()
+ "When the current action is a list, scroll it forwards."
+ (interactive)
+ (let ((action (ivy-state-action ivy-last)))
+ (when (ivy--actionp action)
+ (unless (>= (car action) (1- (length action)))
+ (cl-incf (car action))))))
+
+(defun ivy-prev-action ()
+ "When the current action is a list, scroll it backwards."
+ (interactive)
+ (let ((action (ivy-state-action ivy-last)))
+ (when (ivy--actionp action)
+ (unless (<= (car action) 1)
+ (cl-decf (car action))))))
+
+(defun ivy-action-name ()
+ "Return the name associated with the current action."
+ (let ((action (ivy-state-action ivy-last)))
+ (if (ivy--actionp action)
+ (format "[%d/%d] %s"
+ (car action)
+ (1- (length action))
+ (nth 2 (nth (car action) action)))
+ "[1/1] default")))
+
+(defun ivy-call ()
+ "Call the current action without exiting completion."
+ (interactive)
+ (let ((action (ivy--get-action ivy-last)))
+ (when action
+ (let* ((collection (ivy-state-collection ivy-last))
+ (x (if (and (consp collection)
+ (consp (car collection)))
+ (cdr (assoc ivy--current collection))
+ (if (equal ivy--current "")
+ ivy-text
+ ivy--current))))
+ (prog1 (funcall action x)
+ (unless (or (eq ivy-exit 'done)
+ (equal (selected-window)
+ (active-minibuffer-window))
+ (null (active-minibuffer-window)))
+ (select-window (active-minibuffer-window))))))))
+
+(defun ivy-next-line-and-call (&optional arg)
+ "Move cursor vertically down ARG candidates.
+Call the permanent action if possible."
+ (interactive "p")
+ (ivy-next-line arg)
+ (ivy--exhibit)
+ (ivy-call))
+
+(defun ivy-previous-line-and-call (&optional arg)
+ "Move cursor vertically down ARG candidates.
+Call the permanent action if possible."
+ (interactive "p")
+ (ivy-previous-line arg)
+ (ivy--exhibit)
+ (ivy-call))
(defun ivy-previous-history-element (arg)
"Forward to `previous-history-element' with ARG."
(interactive "p")
(previous-history-element arg)
- (move-end-of-line 1))
+ (ivy--cd-maybe)
+ (move-end-of-line 1)
+ (ivy--maybe-scroll-history))
(defun ivy-next-history-element (arg)
"Forward to `next-history-element' with ARG."
(interactive "p")
(next-history-element arg)
- (move-end-of-line 1))
+ (ivy--cd-maybe)
+ (move-end-of-line 1)
+ (ivy--maybe-scroll-history))
+
+(defun ivy--cd-maybe ()
+ "Check if the current input points to a different directory.
+If so, move to that directory, while keeping only the file name."
+ (when ivy--directory
+ (let ((input (ivy--input))
+ url)
+ (if (setq url (ffap-url-p input))
+ (ivy-exit-with-action
+ (lambda (_)
+ (funcall ffap-url-fetcher url)))
+ (setq input (expand-file-name input))
+ (let ((file (file-name-nondirectory input))
+ (dir (expand-file-name (file-name-directory input))))
+ (if (string= dir ivy--directory)
+ (progn
+ (delete-minibuffer-contents)
+ (insert file))
+ (ivy--cd dir)
+ (insert file)))))))
+
+(defun ivy--maybe-scroll-history ()
+ "If the selected history element has an index, scroll there."
+ (let ((idx (ignore-errors
+ (get-text-property
+ (minibuffer-prompt-end)
+ 'ivy-index))))
+ (when idx
+ (ivy--exhibit)
+ (setq ivy--index idx))))
+
+(defun ivy--cd (dir)
+ "When completing file names, move to directory DIR."
+ (if (null ivy--directory)
+ (error "Unexpected")
+ (setq ivy--old-cands nil)
+ (setq ivy--old-re nil)
+ (setq ivy--index 0)
+ (setq ivy--all-candidates
+ (ivy--sorted-files (setq ivy--directory dir)))
+ (setq ivy-text "")
+ (delete-minibuffer-contents)))
(defun ivy-backward-delete-char ()
"Forward to `backward-delete-char'.
-On error (read-only), quit without selecting."
+On error (read-only), call `ivy-on-del-error-function'."
(interactive)
- (condition-case nil
- (backward-delete-char 1)
- (error
- (minibuffer-keyboard-quit))))
+ (if (and ivy--directory (= (minibuffer-prompt-end) (point)))
+ (progn
+ (ivy--cd (file-name-directory
+ (directory-file-name
+ (expand-file-name
+ ivy--directory))))
+ (ivy--exhibit))
+ (condition-case nil
+ (backward-delete-char 1)
+ (error
+ (when ivy-on-del-error-function
+ (funcall ivy-on-del-error-function))))))
+
+(defun ivy-delete-char (arg)
+ "Forward to `delete-char' ARG."
+ (interactive "p")
+ (unless (= (point) (line-end-position))
+ (delete-char arg)))
+
+(defun ivy-forward-char (arg)
+ "Forward to `forward-char' ARG."
+ (interactive "p")
+ (unless (= (point) (line-end-position))
+ (forward-char arg)))
+
+(defun ivy-kill-word (arg)
+ "Forward to `kill-word' ARG."
+ (interactive "p")
+ (unless (= (point) (line-end-position))
+ (kill-word arg)))
+
+(defun ivy-kill-line ()
+ "Forward to `kill-line'."
+ (interactive)
+ (if (eolp)
+ (kill-region (minibuffer-prompt-end) (point))
+ (kill-line)))
+
+(defun ivy-backward-kill-word ()
+ "Forward to `backward-kill-word'."
+ (interactive)
+ (if (and ivy--directory (= (minibuffer-prompt-end) (point)))
+ (progn
+ (ivy--cd (file-name-directory
+ (directory-file-name
+ (expand-file-name
+ ivy--directory))))
+ (ivy--exhibit))
+ (ignore-errors
+ (let ((pt (point)))
+ (forward-word -1)
+ (delete-region (point) pt)))))
+
+(defvar ivy--regexp-quote 'regexp-quote
+ "Store the regexp quoting state.")
+
+(defun ivy-toggle-regexp-quote ()
+ "Toggle the regexp quoting."
+ (interactive)
+ (setq ivy--old-re nil)
+ (cl-rotatef ivy--regex-function ivy--regexp-quote))
+
+(defvar avy-all-windows)
+(defvar avy-action)
+(defvar avy-keys)
+(defvar avy-keys-alist)
+(defvar avy-style)
+(defvar avy-styles-alist)
+(declare-function avy--process "ext:avy")
+(declare-function avy--style-fn "ext:avy")
+
+(eval-after-load 'avy
+ '(add-to-list 'avy-styles-alist '(ivy-avy . pre)))
+
+(defun ivy-avy ()
+ "Jump to one of the current ivy candidates."
+ (interactive)
+ (unless (require 'avy nil 'noerror)
+ (error "Package avy isn't installed"))
+ (let* ((avy-all-windows nil)
+ (avy-keys (or (cdr (assq 'ivy-avy avy-keys-alist))
+ avy-keys))
+ (avy-style (or (cdr (assq 'ivy-avy
+ avy-styles-alist))
+ avy-style))
+ (candidate
+ (let ((candidates))
+ (save-excursion
+ (save-restriction
+ (narrow-to-region
+ (window-start)
+ (window-end))
+ (goto-char (point-min))
+ (forward-line)
+ (while (< (point) (point-max))
+ (push
+ (cons (point)
+ (selected-window))
+ candidates)
+ (forward-line))))
+ (setq avy-action #'identity)
+ (avy--process
+ (nreverse candidates)
+ (avy--style-fn avy-style)))))
+ (ivy-set-index (- (line-number-at-pos candidate) 2))
+ (ivy--exhibit)
+ (ivy-done)))
+
+(defun ivy-sort-file-function-default (x y)
+ "Compare two files X and Y.
+Prioritize directories."
+ (if (get-text-property 0 'dirp x)
+ (if (get-text-property 0 'dirp y)
+ (string< x y)
+ t)
+ (if (get-text-property 0 'dirp y)
+ nil
+ (string< x y))))
+
+(defcustom ivy-sort-functions-alist
+ '((read-file-name-internal . ivy-sort-file-function-default)
+ (internal-complete-buffer . nil)
+ (counsel-git-grep-function . nil)
+ (Man-goto-section . nil)
+ (org-refile . nil)
+ (t . string-lessp))
+ "An alist of sorting functions for each collection function.
+Interactive functions that call completion fit in here as well.
+
+Nil means no sorting, which is useful to turn off the sorting for
+functions that have candidates in the natural buffer order, like
+`org-refile' or `Man-goto-section'.
+
+The entry associated with t is used for all fall-through cases.
+
+See also `ivy-sort-max-size'."
+ :type
+ '(alist
+ :key-type (choice
+ (const :tag "All other functions" t)
+ (symbol :tag "Function"))
+ :value-type (choice
+ (const :tag "plain sort" string-lessp)
+ (const :tag "file sort" ivy-sort-file-function-default)
+ (const :tag "no sort" nil)))
+ :group 'ivy)
+
+(defvar ivy-index-functions-alist
+ '((swiper . ivy-recompute-index-swiper)
+ (swiper-multi . ivy-recompute-index-swiper)
+ (counsel-git-grep . ivy-recompute-index-swiper)
+ (counsel-grep . ivy-recompute-index-swiper-async)
+ (t . ivy-recompute-index-zero))
+ "An alist of index recomputing functions for each collection function.
+When the input changes, the appropriate function returns an
+integer - the index of the matched candidate that should be
+selected.")
+
+(defvar ivy-re-builders-alist
+ '((t . ivy--regex-plus))
+ "An alist of regex building functions for each collection function.
+Each function should take a string and return a valid regex or a
+regex sequence (see below).
+
+The entry associated with t is used for all fall-through cases.
+Possible choices: `ivy--regex', `regexp-quote', `ivy--regex-plus'.
+
+If a function returns a list, it should format like this:
+'((\"matching-regexp\" . t) (\"non-matching-regexp\") ...).
+
+The matches will be filtered in a sequence, you can mix the
+regexps that should match and that should not match as you
+like.")
+
+(defvar ivy-initial-inputs-alist
+ '((org-refile . "^")
+ (org-agenda-refile . "^")
+ (org-capture-refile . "^")
+ (counsel-M-x . "^")
+ (counsel-describe-function . "^")
+ (counsel-describe-variable . "^")
+ (man . "^")
+ (woman . "^"))
+ "Command to initial input table.")
+
+(defcustom ivy-sort-max-size 30000
+ "Sorting won't be done for collections larger than this."
+ :type 'integer)
+
+(defun ivy--sorted-files (dir)
+ "Return the list of files in DIR.
+Directories come first."
+ (let* ((default-directory dir)
+ (seq (all-completions "" 'read-file-name-internal))
+ sort-fn)
+ (if (equal dir "/")
+ seq
+ (setq seq (delete "./" (delete "../" seq)))
+ (when (eq (setq sort-fn (cdr (assoc 'read-file-name-internal
+ ivy-sort-functions-alist)))
+ #'ivy-sort-file-function-default)
+ (setq seq (mapcar (lambda (x)
+ (propertize x 'dirp (string-match-p "/\\'" x)))
+ seq)))
+ (when sort-fn
+ (setq seq (cl-sort seq sort-fn)))
+ (dolist (dir ivy-extra-directories)
+ (push dir seq))
+ seq)))
;;** Entry Point
-(defun ivy-read (prompt collection
- &optional initial-input keymap preselect update-fn)
+(cl-defun ivy-read (prompt collection
+ &key predicate require-match initial-input
+ history preselect keymap update-fn sort
+ action unwind re-builder matcher dynamic-collection
caller)
"Read a string in the minibuffer, with completion.
-PROMPT is a string to prompt with; normally it ends in a colon
-and a space. When PROMPT contains %d, it will be updated with
-the current number of matching candidates.
+PROMPT is a format string, normally ending in a colon and a
+space; %d anywhere in the string is replaced by the current
+number of matching candidates. For the literal % character,
+escape it with %%. See also `ivy-count-format'.
+
+COLLECTION is either a list of strings, a function, an alist, or
+a hash table.
-COLLECTION is a list of strings.
+If INITIAL-INPUT is not nil, then insert that input in the
+minibuffer initially.
-If INITIAL-INPUT is non-nil, insert it in the minibuffer initially.
+KEYMAP is composed with `ivy-minibuffer-map'.
+
+If PRESELECT is not nil, then select the corresponding candidate
+out of the ones that match the INITIAL-INPUT.
UPDATE-FN is called each time the current candidate(s) is changed.
-If PRESELECT is non-nil select the corresponding candidate out of
-the ones that match INITIAL-INPUT.
-
-KEYMAP is composed together with `ivy-minibuffer-map'."
- (cl-case (length collection)
- (0 nil)
- (1 (car collection))
- (t
- (setq ivy--index (or
- (and preselect
- (ivy--preselect-index
- collection initial-input preselect))
- 0))
- (setq ivy--old-re nil)
- (setq ivy--old-cands nil)
- (setq ivy-text "")
- (setq ivy--all-candidates collection)
- (setq ivy--update-fn update-fn)
- (setq ivy-exit nil)
- (setq ivy--default (or (thing-at-point 'symbol) ""))
- (setq ivy--prompt
- (cond ((string-match "%.*d" prompt)
- prompt)
- ((string-match "%.*d" ivy-count-format)
- (concat ivy-count-format prompt))
- (t
- nil)))
- (setq ivy--action nil)
- (prog1
- (unwind-protect
- (minibuffer-with-setup-hook
- #'ivy--minibuffer-setup
- (let ((res (read-from-minibuffer
- prompt
- initial-input
- (make-composed-keymap keymap ivy-minibuffer-map)
- nil
- 'ivy-history)))
- (when (eq ivy-exit 'done)
- (pop ivy-history)
- (setq ivy-history
- (cons ivy-text (delete ivy-text ivy-history)))
- res)))
- (remove-hook 'post-command-hook #'ivy--exhibit))
- (when ivy--action
- (funcall ivy--action))))))
-
-(defvar ivy--action nil
- "Store a function to call at the end of `ivy--read'.")
-
-(defun ivy--preselect-index (candidates initial-input preselect)
- "Return the index in CANDIDATES filtered by INITIAL-INPUT for PRESELECT."
- (when initial-input
- (setq candidates
- (cl-remove-if-not
- (lambda (x)
- (string-match initial-input x))
- candidates)))
- (cl-position-if
- (lambda (x)
- (string-match preselect x))
- candidates))
+When SORT is t, use `ivy-sort-functions-alist' for sorting.
-(defvar ivy-text ""
- "Stores the user's string as it is typed in.")
+ACTION is a lambda function to call after selecting a result. It
+takes a single string argument.
-(defvar ivy-exit nil
- "Store 'done if the completion was successfully selected.
-Otherwise, store nil.")
+UNWIND is a lambda function to call before exiting.
+
+RE-BUILDER is a lambda function to call to transform text into a
+regex pattern.
+
+MATCHER is to override matching.
+
+DYNAMIC-COLLECTION is a boolean to specify if the list of
+candidates is updated after each input by calling COLLECTION.
+
+CALLER is a symbol to uniquely identify the caller to `ivy-read'.
+It is used, along with COLLECTION, to determine which
+customizations apply to the current completion session."
+ (let ((extra-actions (plist-get ivy--actions-list this-command)))
+ (when extra-actions
+ (setq action
+ (if (functionp action)
+ `(1
+ ("o" ,action "default")
+ ,@extra-actions)
+ (delete-dups (append action extra-actions))))))
+ (let ((recursive-ivy-last (and (active-minibuffer-window) ivy-last)))
+ (setq ivy-last
+ (make-ivy-state
+ :prompt prompt
+ :collection collection
+ :predicate predicate
+ :require-match require-match
+ :initial-input initial-input
+ :history history
+ :preselect preselect
+ :keymap keymap
+ :update-fn update-fn
+ :sort sort
+ :action action
+ :window (selected-window)
+ :buffer (current-buffer)
+ :unwind unwind
+ :re-builder re-builder
+ :matcher matcher
+ :dynamic-collection dynamic-collection
+ :caller caller))
+ (ivy--reset-state ivy-last)
+ (prog1
+ (unwind-protect
+ (minibuffer-with-setup-hook
+ #'ivy--minibuffer-setup
+ (let* ((hist (or history 'ivy-history))
+ (minibuffer-completion-table collection)
+ (minibuffer-completion-predicate predicate)
+ (resize-mini-windows (cond
+ ((display-graphic-p) nil)
+ ((null resize-mini-windows)
'grow-only)
+ (t resize-mini-windows)))
+ (res (read-from-minibuffer
+ prompt
+ (ivy-state-initial-input ivy-last)
+ (make-composed-keymap keymap ivy-minibuffer-map)
+ nil
+ hist)))
+ (when (eq ivy-exit 'done)
+ (let ((item (if ivy--directory
+ ivy--current
+ ivy-text)))
+ (unless (equal item "")
+ (set hist (cons (propertize item 'ivy-index ivy--index)
+ (delete item
+ (cdr (symbol-value hist)))))))
+ res)))
+ (remove-hook 'post-command-hook #'ivy--exhibit)
+ (when (setq unwind (ivy-state-unwind ivy-last))
+ (funcall unwind)))
+ (ivy-call)
+ (when recursive-ivy-last
+ (ivy--reset-state (setq ivy-last recursive-ivy-last))))))
+
+(defun ivy--reset-state (state)
+ "Reset the ivy to STATE.
+This is useful for recursive `ivy-read'."
+ (let ((prompt (or (ivy-state-prompt state) ""))
+ (collection (ivy-state-collection state))
+ (predicate (ivy-state-predicate state))
+ (history (ivy-state-history state))
+ (preselect (ivy-state-preselect state))
+ (sort (ivy-state-sort state))
+ (re-builder (ivy-state-re-builder state))
+ (dynamic-collection (ivy-state-dynamic-collection state))
+ (initial-input (ivy-state-initial-input state))
+ (require-match (ivy-state-require-match state))
+ (caller (ivy-state-caller state)))
+ (unless initial-input
+ (setq initial-input (cdr (assoc this-command
+ ivy-initial-inputs-alist))))
+ (setq ivy--directory nil)
+ (setq ivy-case-fold-search 'auto)
+ (setq ivy--regex-function
+ (or re-builder
+ (and (functionp collection)
+ (cdr (assoc collection ivy-re-builders-alist)))
+ (and caller
+ (cdr (assoc caller ivy-re-builders-alist)))
+ (cdr (assoc t ivy-re-builders-alist))
+ 'ivy--regex))
+ (setq ivy--subexps 0)
+ (setq ivy--regexp-quote 'regexp-quote)
+ (setq ivy--old-text "")
+ (setq ivy--full-length nil)
+ (setq ivy-text "")
+ (setq ivy-calling nil)
+ (let (coll sort-fn)
+ (cond ((eq collection 'Info-read-node-name-1)
+ (if (equal Info-current-file "dir")
+ (setq coll
+ (mapcar (lambda (x) (format "(%s)" x))
+ (cl-delete-duplicates
+ (all-completions "(" collection predicate)
+ :test #'equal)))
+ (setq coll (all-completions "" collection predicate))))
+ ((eq collection 'read-file-name-internal)
+ (setq ivy--directory default-directory)
+ (require 'dired)
+ (when preselect
+ (let ((preselect-directory (file-name-directory preselect)))
+ (unless (or (null preselect-directory)
+ (string= preselect-directory
+ default-directory))
+ (setq ivy--directory preselect-directory))
+ (setf
+ (ivy-state-preselect state)
+ (setq preselect (file-name-nondirectory preselect)))))
+ (setq coll (ivy--sorted-files ivy--directory))
+ (when initial-input
+ (unless (or require-match
+ (equal initial-input default-directory)
+ (equal initial-input ""))
+ (setq coll (cons initial-input coll)))
+ (setq initial-input nil)))
+ ((eq collection 'internal-complete-buffer)
+ (setq coll (ivy--buffer-list "" ivy-use-virtual-buffers)))
+ ((or (functionp collection)
+ (byte-code-function-p collection)
+ (vectorp collection)
+ (and (consp collection) (listp (car collection)))
+ (hash-table-p collection))
+ (setq coll (all-completions "" collection predicate)))
+ (t
+ (setq coll collection)))
+ (when sort
+ (if (and (functionp collection)
+ (setq sort-fn (assoc collection ivy-sort-functions-alist)))
+ (when (and (setq sort-fn (cdr sort-fn))
+ (not (eq collection 'read-file-name-internal)))
+ (setq coll (cl-sort coll sort-fn)))
+ (unless (eq history 'org-refile-history)
+ (if (and (setq sort-fn (cdr (assoc t ivy-sort-functions-alist)))
+ (<= (length coll) ivy-sort-max-size))
+ (setq coll (cl-sort (copy-sequence coll) sort-fn))))))
+ (when preselect
+ (unless (or (and require-match
+ (not (eq collection 'internal-complete-buffer)))
+ dynamic-collection
+ (let ((re (regexp-quote preselect)))
+ (cl-find-if (lambda (x) (string-match re x))
+ coll)))
+ (setq coll (cons preselect coll))))
+ (setq ivy--old-re nil)
+ (setq ivy--old-cands nil)
+ (when (integerp preselect)
+ (setq ivy--old-re "")
+ (setq ivy--index preselect))
+ (when initial-input
+ ;; Needed for anchor to work
+ (setq ivy--old-cands coll)
+ (setq ivy--old-cands (ivy--filter initial-input coll)))
+ (setq ivy--all-candidates coll)
+ (unless (integerp preselect)
+ (setq ivy--index (or
+ (and dynamic-collection
+ ivy--index)
+ (and preselect
+ (ivy--preselect-index
+ preselect
+ (if initial-input
+ ivy--old-cands
+ coll)))
+ 0))))
+ (setq ivy-exit nil)
+ (setq ivy--default (or
+ (thing-at-point 'url)
+ (thing-at-point 'symbol)
+ ""))
+ (setq ivy--prompt
+ (cond ((string-match "%.*d" prompt)
+ prompt)
+ ((null ivy-count-format)
+ (error
+ "`ivy-count-format' can't be nil. Set it to an empty string
instead"))
+ ((string-match "%d.*%d" ivy-count-format)
+ (let ((w (length (number-to-string
+ (length ivy--all-candidates))))
+ (s (copy-sequence ivy-count-format)))
+ (string-match "%d" s)
+ (match-end 0)
+ (string-match "%d" s (match-end 0))
+ (setq s (replace-match (format "%%-%dd" w) nil nil s))
+ (string-match "%d" s)
+ (concat (replace-match (format "%%%dd" w) nil nil s)
+ prompt)))
+ ((string-match "%.*d" ivy-count-format)
+ (concat ivy-count-format prompt))
+ (ivy--directory
+ prompt)
+ (t
+ nil)))
+ (setf (ivy-state-initial-input ivy-last) initial-input)))
+
+;;;###autoload
+(defun ivy-completing-read (prompt collection
+ &optional predicate require-match initial-input
+ history def inherit-input-method)
+ "Read a string in the minibuffer, with completion.
+
+This interface conforms to `completing-read' and can be used for
+`completing-read-function'.
+
+PROMPT is a string to prompt with; normally it ends in a colon and a space.
+COLLECTION can be a list of strings, an alist, an obarray or a hash table.
+PREDICATE limits completion to a subset of COLLECTION.
+REQUIRE-MATCH is specified with a boolean value. See `completing-read'.
+INITIAL-INPUT is a string that can be inserted into the minibuffer initially.
+HISTORY is a list of previously selected inputs.
+DEF is the default value.
+INHERIT-INPUT-METHOD is currently ignored."
+ (if (memq this-command '(tmm-menubar tmm-shortcut))
+ (completing-read-default prompt collection
+ predicate require-match
+ initial-input history
+ def inherit-input-method)
+ ;; See the doc of `completing-read'.
+ (when (consp history)
+ (when (numberp (cdr history))
+ (setq initial-input (nth (1- (cdr history))
+ (symbol-value (car history)))))
+ (setq history (car history)))
+ (ivy-read (replace-regexp-in-string "%" "%%" prompt)
+ collection
+ :predicate predicate
+ :require-match require-match
+ :initial-input (if (consp initial-input)
+ (car initial-input)
+ (if (and (stringp initial-input)
+ (string-match "\\+" initial-input))
+ (replace-regexp-in-string
+ "\\+" "\\\\+" initial-input)
+ initial-input))
+ :preselect (if (listp def) (car def) def)
+ :history history
+ :keymap nil
+ :sort
+ (let ((sort (assoc this-command ivy-sort-functions-alist)))
+ (if sort
+ (cdr sort)
+ t)))))
+
+;;;###autoload
+(define-minor-mode ivy-mode
+ "Toggle Ivy mode on or off.
+Turn Ivy mode on if ARG is positive, off otherwise.
+Turning on Ivy mode sets `completing-read-function' to
+`ivy-completing-read'.
+
+Global bindings:
+\\{ivy-mode-map}
+
+Minibuffer bindings:
+\\{ivy-minibuffer-map}"
+ :group 'ivy
+ :global t
+ :keymap ivy-mode-map
+ :lighter " ivy"
+ (if ivy-mode
+ (setq completing-read-function 'ivy-completing-read)
+ (setq completing-read-function 'completing-read-default)))
+
+(defun ivy--preselect-index (preselect candidates)
+ "Return the index of PRESELECT in CANDIDATES."
+ (cond ((integerp preselect)
+ preselect)
+ ((cl-position preselect candidates :test #'equal))
+ ((stringp preselect)
+ (let ((re (regexp-quote preselect)))
+ (cl-position-if
+ (lambda (x)
+ (string-match re x))
+ candidates)))))
;;* Implementation
;;** Regex
-(defvar ivy--subexps 0
- "Number of groups in the current `ivy--regex'.")
-
(defvar ivy--regex-hash
- (make-hash-table :test 'equal)
+ (make-hash-table :test #'equal)
"Store pre-computed regex.")
-(defun ivy--regex (str)
- "Re-build regex from STR in case it has a space."
- (let ((hashed (gethash str ivy--regex-hash)))
+(defun ivy--split (str)
+ "Split STR into a list by single spaces.
+The remaining spaces stick to their left.
+This allows to \"quote\" N spaces by inputting N+1 spaces."
+ (let ((len (length str))
+ start0
+ (start1 0)
+ res s
+ match-len)
+ (while (and (string-match " +" str start1)
+ (< start1 len))
+ (setq match-len (- (match-end 0) (match-beginning 0)))
+ (if (= match-len 1)
+ (progn
+ (when start0
+ (setq start1 start0)
+ (setq start0 nil))
+ (push (substring str start1 (match-beginning 0)) res)
+ (setq start1 (match-end 0)))
+ (setq str (replace-match
+ (make-string (1- match-len) ?\ )
+ nil nil str))
+ (setq start0 (or start0 start1))
+ (setq start1 (1- (match-end 0)))))
+ (if start0
+ (push (substring str start0) res)
+ (setq s (substring str start1))
+ (unless (= (length s) 0)
+ (push s res)))
+ (nreverse res)))
+
+(defun ivy--regex (str &optional greedy)
+ "Re-build regex pattern from STR in case it has a space.
+When GREEDY is non-nil, join words in a greedy way."
+ (let ((hashed (unless greedy
+ (gethash str ivy--regex-hash))))
(if hashed
(prog1 (cdr hashed)
(setq ivy--subexps (car hashed)))
+ (when (string-match "\\([^\\]\\|^\\)\\\\$" str)
+ (setq str (substring str 0 -1)))
(cdr (puthash str
- (let ((subs (split-string str " +" t)))
+ (let ((subs (ivy--split str)))
(if (= (length subs) 1)
(cons
(setq ivy--subexps 0)
@@ -273,11 +1425,75 @@ Otherwise, store nil.")
(cons
(setq ivy--subexps (length subs))
(mapconcat
- (lambda (x) (format "\\(%s\\)" x))
+ (lambda (x)
+ (if (string-match "\\`\\\\(.*\\\\)\\'" x)
+ x
+ (format "\\(%s\\)" x)))
subs
- ".*"))))
+ (if greedy
+ ".*"
+ ".*?")))))
ivy--regex-hash)))))
+(defun ivy--regex-ignore-order (str)
+ "Re-build regex from STR by splitting at spaces.
+Ignore the order of each group.
+
+ATTENTION: This is just a proof of concept and may not work as
+expected. Besides ignoring the order of the tokens where 'foo'
+and 'bar', 'bar' and 'foo' are matched, it also matches multiple
+occurrences of 'foo' and 'bar'. To ignore the sort order and avoid
+multiple matches, use `ivy-restrict-to-matches' instead.
+"
+ (let* ((subs (split-string str " +" t))
+ (len (length subs)))
+ (cl-case len
+ (1
+ (setq ivy--subexps 0)
+ (car subs))
+ (t
+ (setq ivy--subexps len)
+ (let ((all (mapconcat #'identity subs "\\|")))
+ (mapconcat
+ (lambda (x)
+ (if (string-match "\\`\\\\(.*\\\\)\\'" x)
+ x
+ (format "\\(%s\\)" x)))
+ (make-list len all)
+ ".*?"))))))
+
+(defun ivy--regex-plus (str)
+ "Build a regex sequence from STR.
+Spaces are wild card characters, everything before \"!\" should
+match. Everything after \"!\" should not match."
+ (let ((parts (split-string str "!" t)))
+ (cl-case (length parts)
+ (0
+ "")
+ (1
+ (ivy--regex (car parts)))
+ (2
+ (let ((res
+ (mapcar #'list
+ (split-string (cadr parts) " " t))))
+ (cons (cons (ivy--regex (car parts)) t)
+ res)))
+ (t (error "Unexpected: use only one !")))))
+
+(defun ivy--regex-fuzzy (str)
+ "Build a regex sequence from STR.
+Insert .* between each char."
+ (if (string-match "\\`\\(\\^?\\)\\(.*?\\)\\(\\$?\\)\\'" str)
+ (prog1
+ (concat (match-string 1 str)
+ (mapconcat
+ (lambda (x)
+ (format "\\(%c\\)" x))
+ (string-to-list (match-string 2 str)) ".*")
+ (match-string 3 str))
+ (setq ivy--subexps (length (match-string 2 str))))
+ str))
+
;;** Rest
(defun ivy--minibuffer-setup ()
"Setup ivy completion in the minibuffer."
@@ -285,31 +1501,13 @@ Otherwise, store nil.")
(set (make-local-variable 'minibuffer-default-add-function)
(lambda ()
(list ivy--default)))
- (use-local-map (make-composed-keymap ivy-minibuffer-map
- (current-local-map)))
+ (when (display-graphic-p)
+ (setq truncate-lines t))
(setq-local max-mini-window-height ivy-height)
(add-hook 'post-command-hook #'ivy--exhibit nil t)
;; show completions with empty input
(ivy--exhibit))
-(defvar ivy--all-candidates nil
- "Store the candidates passed to `ivy-read'.")
-
-(defvar ivy--index 0
- "Store the index of the current candidate.")
-
-(defvar ivy--length 0
- "Store the amount of viable candidates.")
-
-(defvar ivy--current ""
- "Current candidate.")
-
-(defvar ivy--default nil
- "Default initial input.")
-
-(defvar ivy--update-fn nil
- "Current function to call when current candidate(s) update.")
-
(defun ivy--input ()
"Return the current minibuffer input."
;; assume one-line minibuffer input
@@ -323,103 +1521,925 @@ Otherwise, store nil.")
(goto-char (minibuffer-prompt-end))
(delete-region (line-end-position) (point-max))))
-(defvar ivy--prompt nil
- "Store the format-style prompt.
-When non-nil, it should contain one %d.")
-
(defun ivy--insert-prompt ()
"Update the prompt according to `ivy--prompt'."
(when ivy--prompt
- (let ((inhibit-read-only t)
- (n-str (format ivy--prompt ivy--length)))
- (save-excursion
- (goto-char (point-min))
- (delete-region (point-min) (minibuffer-prompt-end))
- (set-text-properties
- 0 (length n-str)
- '(front-sticky t rear-nonsticky t field t read-only t face
minibuffer-prompt)
- n-str)
- (insert n-str))
- ;; get out of the prompt area
- (constrain-to-field nil (point-max)))))
+ (unless (memq this-command '(ivy-done ivy-alt-done ivy-partial-or-done
+ counsel-find-symbol))
+ (setq ivy--prompt-extra ""))
+ (let (head tail)
+ (if (string-match "\\(.*\\): \\'" ivy--prompt)
+ (progn
+ (setq head (match-string 1 ivy--prompt))
+ (setq tail ": "))
+ (setq head (substring ivy--prompt 0 -1))
+ (setq tail " "))
+ (let ((inhibit-read-only t)
+ (std-props '(front-sticky t rear-nonsticky t field t read-only t))
+ (n-str
+ (concat
+ (if (and (bound-and-true-p minibuffer-depth-indicate-mode)
+ (> (minibuffer-depth) 1))
+ (format "[%d] " (minibuffer-depth))
+ "")
+ (concat
+ (if (string-match "%d.*%d" ivy-count-format)
+ (format head
+ (1+ ivy--index)
+ (or (and (ivy-state-dynamic-collection ivy-last)
+ ivy--full-length)
+ ivy--length))
+ (format head
+ (or (and (ivy-state-dynamic-collection ivy-last)
+ ivy--full-length)
+ ivy--length)))
+ ivy--prompt-extra
+ tail)))
+ (d-str (if ivy--directory
+ (abbreviate-file-name ivy--directory)
+ "")))
+ (save-excursion
+ (goto-char (point-min))
+ (delete-region (point-min) (minibuffer-prompt-end))
+ (if (> (+ (mod (+ (length n-str) (length d-str)) (window-width))
+ (length ivy-text))
+ (window-width))
+ (setq n-str (concat n-str "\n" d-str))
+ (setq n-str (concat n-str d-str)))
+ (let ((regex (format "\\([^\n]\\{%d\\}\\)[^\n]" (window-width))))
+ (while (string-match regex n-str)
+ (setq n-str (replace-match (concat (match-string 1 n-str) "\n")
nil t n-str 1))))
+ (set-text-properties 0 (length n-str)
+ `(face minibuffer-prompt ,@std-props)
+ n-str)
+ (ivy--set-match-props n-str "confirm"
+ `(face ivy-confirm-face ,@std-props))
+ (ivy--set-match-props n-str "match required"
+ `(face ivy-match-required-face ,@std-props))
+ (insert n-str))
+ ;; get out of the prompt area
+ (constrain-to-field nil (point-max))))))
+
+(defun ivy--set-match-props (str match props)
+ "Set STR text properties that match MATCH to PROPS."
+ (when (string-match match str)
+ (set-text-properties
+ (match-beginning 0)
+ (match-end 0)
+ props
+ str)))
+
+(defvar inhibit-message)
+
+(defun ivy--sort-maybe (collection)
+ "Sort COLLECTION if needed."
+ (let ((sort (ivy-state-sort ivy-last))
+ entry)
+ (if (null sort)
+ collection
+ (let ((sort-fn (cond ((functionp sort)
+ sort)
+ ((setq entry (assoc (ivy-state-collection ivy-last)
+ ivy-sort-functions-alist))
+ (cdr entry))
+ (t
+ (cdr (assoc t ivy-sort-functions-alist))))))
+ (if (functionp sort-fn)
+ (cl-sort (copy-sequence collection) sort-fn)
+ collection)))))
(defun ivy--exhibit ()
"Insert Ivy completions display.
Should be run via minibuffer `post-command-hook'."
- (setq ivy-text (ivy--input))
- (ivy--cleanup)
- (let ((text (ivy-completions
- ivy-text
- ivy--all-candidates))
- (buffer-undo-list t)
+ (when (memq 'ivy--exhibit post-command-hook)
+ (let ((inhibit-field-text-motion nil))
+ (constrain-to-field nil (point-max)))
+ (setq ivy-text (ivy--input))
+ (if (ivy-state-dynamic-collection ivy-last)
+ ;; while-no-input would cause annoying
+ ;; "Waiting for process to die...done" message interruptions
+ (let ((inhibit-message t))
+ (unless (equal ivy--old-text ivy-text)
+ (while-no-input
+ (setq ivy--all-candidates
+ (ivy--sort-maybe
+ (funcall (ivy-state-collection ivy-last) ivy-text)))
+ (setq ivy--old-text ivy-text)))
+ (when ivy--all-candidates
+ (ivy--insert-minibuffer
+ (ivy--format ivy--all-candidates))))
+ (cond (ivy--directory
+ (if (string-match "/\\'" ivy-text)
+ (if (member ivy-text ivy--all-candidates)
+ (ivy--cd (expand-file-name ivy-text ivy--directory))
+ (when (string-match "//\\'" ivy-text)
+ (if (and default-directory
+ (string-match "\\`[[:alpha:]]:/"
default-directory))
+ (ivy--cd (match-string 0 default-directory))
+ (ivy--cd "/")))
+ (when (string-match "[[:alpha:]]:/$" ivy-text)
+ (let ((drive-root (match-string 0 ivy-text)))
+ (when (file-exists-p drive-root)
+ (ivy--cd drive-root)))))
+ (if (string-match "\\`~\\'" ivy-text)
+ (ivy--cd (expand-file-name "~/")))))
+ ((eq (ivy-state-collection ivy-last) 'internal-complete-buffer)
+ (when (or (and (string-match "\\` " ivy-text)
+ (not (string-match "\\` " ivy--old-text)))
+ (and (string-match "\\` " ivy--old-text)
+ (not (string-match "\\` " ivy-text))))
+ (setq ivy--all-candidates
+ (if (and (> (length ivy-text) 0)
+ (eq (aref ivy-text 0)
+ ?\ ))
+ (ivy--buffer-list " ")
+ (ivy--buffer-list "" ivy-use-virtual-buffers)))
+ (setq ivy--old-re nil))))
+ (ivy--insert-minibuffer
+ (with-current-buffer (ivy-state-buffer ivy-last)
+ (ivy--format
+ (ivy--filter ivy-text ivy--all-candidates))))
+ (setq ivy--old-text ivy-text))))
+
+(defun ivy--insert-minibuffer (text)
+ "Insert TEXT into minibuffer with appropriate cleanup."
+ (let ((resize-mini-windows nil)
+ (update-fn (ivy-state-update-fn ivy-last))
deactivate-mark)
- (when ivy--update-fn
- (funcall ivy--update-fn))
+ (ivy--cleanup)
+ (when update-fn
+ (funcall update-fn))
(ivy--insert-prompt)
;; Do nothing if while-no-input was aborted.
(when (stringp text)
- (save-excursion
- (forward-line 1)
- (insert text)))))
+ (let ((buffer-undo-list t))
+ (save-excursion
+ (forward-line 1)
+ (insert text))))
+ (when (display-graphic-p)
+ (ivy--resize-minibuffer-to-fit))))
-(defvar ivy--old-re nil
- "Store the old regexp.")
+(defun ivy--resize-minibuffer-to-fit ()
+ "Resize the minibuffer window size to fit the text in the minibuffer."
+ (with-selected-window (minibuffer-window)
+ (if (fboundp 'window-text-pixel-size)
+ (let ((text-height (cdr (window-text-pixel-size)))
+ (body-height (window-body-height nil t)))
+ (when (> text-height body-height)
+ (window-resize nil (- text-height body-height) nil t t)))
+ (let ((text-height (count-screen-lines))
+ (body-height (window-body-height)))
+ (when (> text-height body-height)
+ (window-resize nil (- text-height body-height) nil t))))))
-(defvar ivy--old-cands nil
- "Store the candidates matched by `ivy--old-re'.")
+(declare-function colir-blend-face-background "ext:colir")
(defun ivy--add-face (str face)
"Propertize STR with FACE.
`font-lock-append-text-property' is used, since it's better than
`propertize' or `add-face-text-property' in this case."
- (font-lock-append-text-property 0 (length str) 'face face str)
+ (require 'colir)
+ (condition-case nil
+ (progn
+ (colir-blend-face-background 0 (length str) face str)
+ (let ((foreground (face-foreground face)))
+ (when foreground
+ (add-face-text-property
+ 0 (length str)
+ `(:foreground ,foreground)
+ nil
+ str))))
+ (error
+ (ignore-errors
+ (font-lock-append-text-property 0 (length str) 'face face str))))
str)
-(defun ivy-completions (name candidates)
- "Return as text the current completions.
-NAME is a string of words separated by spaces that is used to
-build a regex.
-CANDIDATES is a list of strings."
- (let* ((re (ivy--regex name))
- (cands (if (and (equal re ivy--old-re)
- ivy--old-cands)
- ivy--old-cands
- (setq ivy--old-re re)
- (ignore-errors
- (cl-remove-if-not
- (lambda (x) (string-match re x))
- candidates))))
- (tail (nthcdr ivy--index ivy--old-cands))
- (ww (window-width))
- idx)
- (setq ivy--length (length cands))
- (when (and tail ivy--old-cands)
- (while (and tail
- (null (setq idx (cl-position (pop tail) cands
- :test #'equal)))))
- (setq ivy--index (or idx 0)))
- (setq ivy--old-cands cands)
- (when (>= ivy--index ivy--length)
- (setq ivy--index (max (1- ivy--length) 0)))
- (if (null cands)
- ""
- (let* ((half-height (/ ivy-height 2))
- (start (max 0 (- ivy--index half-height)))
- (end (min (+ start (1- ivy-height)) ivy--length))
- (cands (cl-subseq cands start end))
- (index (min ivy--index half-height (1- (length cands)))))
- (setq ivy--current (copy-sequence (nth index cands)))
- (setf (nth index cands)
- (ivy--add-face ivy--current 'ivy-current-match))
- (let ((res (concat "\n" (mapconcat
- (lambda (s)
- (if (> (length s) ww)
- (concat (substring s 0 (- ww 3)) "...")
- s))
- cands "\n"))))
- (put-text-property 0 (length res) 'read-only nil res)
+(declare-function flx-make-string-cache "ext:flx")
+(declare-function flx-score "ext:flx")
+
+(defvar ivy--flx-cache nil)
+
+(eval-after-load 'flx
+ '(setq ivy--flx-cache (flx-make-string-cache)))
+
+(defun ivy-toggle-case-fold ()
+ "Toggle the case folding between nil and auto.
+In any completion session, the case folding starts in auto:
+
+- when the input is all lower case, `case-fold-search' is t
+- otherwise nil.
+
+You can toggle this to make `case-fold-search' nil regardless of input."
+ (interactive)
+ (setq ivy-case-fold-search
+ (if ivy-case-fold-search
+ nil
+ 'auto))
+ ;; reset cache so that the candidate list updates
+ (setq ivy--old-re nil))
+
+(defun ivy--filter (name candidates)
+ "Return all items that match NAME in CANDIDATES.
+CANDIDATES are assumed to be static."
+ (let ((re (funcall ivy--regex-function name)))
+ (if (and (equal re ivy--old-re)
+ ivy--old-cands)
+ ;; quick caching for "C-n", "C-p" etc.
+ ivy--old-cands
+ (let* ((re-str (if (listp re) (caar re) re))
+ (matcher (ivy-state-matcher ivy-last))
+ (case-fold-search
+ (and ivy-case-fold-search
+ (string= name (downcase name))))
+ (cands (cond
+ (matcher
+ (funcall matcher re candidates))
+ ((and ivy--old-re
+ (stringp re)
+ (stringp ivy--old-re)
+ (not (string-match "\\\\" ivy--old-re))
+ (not (equal ivy--old-re ""))
+ (memq (cl-search
+ (if (string-match "\\\\)\\'" ivy--old-re)
+ (substring ivy--old-re 0 -2)
+ ivy--old-re)
+ re)
+ '(0 2)))
+ (ignore-errors
+ (cl-remove-if-not
+ (lambda (x) (string-match re x))
+ ivy--old-cands)))
+ (t
+ (let ((re-list (if (stringp re) (list (cons re t)) re))
+ (res candidates))
+ (dolist (re re-list)
+ (setq res
+ (ignore-errors
+ (funcall
+ (if (cdr re)
+ #'cl-remove-if-not
+ #'cl-remove-if)
+ (let ((re-str (car re)))
+ (lambda (x) (string-match re-str x)))
+ res))))
+ res)))))
+ (ivy--recompute-index name re-str cands)
+ (setq ivy--old-re (if cands re-str ""))
+ (setq ivy--old-cands (ivy--sort name cands))))))
+
+(defcustom ivy-sort-matches-functions-alist '((t . nil))
+ "An alist of functions used to sort the matching candidates.
+
+This is different from `ivy-sort-functions-alist', which is used
+to sort the whole collection only once. The functions taken from
+here are instead used on each input change, but they are used
+only on already matching candidates, not on all of them.
+
+The alist KEY is a collection function or t to match previously
+not matched collection functions.
+
+The alist VAL is a sorting function with the signature of
+`ivy--prefix-sort'.")
+
+(defun ivy--sort-files-by-date (_name candidates)
+ "Re-soft CANDIDATES according to file modification date."
+ (let ((default-directory ivy--directory))
+ (cl-sort (copy-sequence candidates)
+ (lambda (f1 f2)
+ (time-less-p
+ (nth 5 (file-attributes f2))
+ (nth 5 (file-attributes f1)))))))
+
+(defun ivy--sort (name candidates)
+ "Re-sort CANDIDATES by NAME.
+All CANDIDATES are assumed to match NAME."
+ (let ((key (or (ivy-state-caller ivy-last)
+ (when (functionp (ivy-state-collection ivy-last))
+ (ivy-state-collection ivy-last))))
+ fun)
+ (cond ((and (require 'flx nil 'noerror)
+ (eq ivy--regex-function 'ivy--regex-fuzzy))
+ (ivy--flx-sort name candidates))
+ ((setq fun (cdr (or (assoc key ivy-sort-matches-functions-alist)
+ (assoc t ivy-sort-matches-functions-alist))))
+ (funcall fun name candidates))
+ (t
+ candidates))))
+
+(defun ivy--prefix-sort (name candidates)
+ "Re-sort CANDIDATES.
+Prefix matches to NAME are put ahead of the list."
+ (if (or (string-match "^\\^" name) (string= name ""))
+ candidates
+ (let ((re-prefix (concat "^" (funcall ivy--regex-function name)))
+ res-prefix
+ res-noprefix)
+ (dolist (s candidates)
+ (if (string-match re-prefix s)
+ (push s res-prefix)
+ (push s res-noprefix)))
+ (nconc
+ (nreverse res-prefix)
+ (nreverse res-noprefix)))))
+
+(defun ivy--recompute-index (name re-str cands)
+ (let* ((caller (ivy-state-caller ivy-last))
+ (func (or (and caller (cdr (assoc caller ivy-index-functions-alist)))
+ (cdr (assoc t ivy-index-functions-alist))
+ #'ivy-recompute-index-zero)))
+ (unless (eq this-command 'ivy-resume)
+ (setq ivy--index
+ (or
+ (cl-position (if (and (> (length re-str) 0)
+ (eq ?^ (aref re-str 0)))
+ (substring re-str 1)
+ re-str) cands
+ :test #'equal)
+ (and ivy--directory
+ (cl-position
+ (concat re-str "/") cands
+ :test #'equal))
+ (and (not (string= name ""))
+ (not (and (require 'flx nil 'noerror)
+ (eq ivy--regex-function 'ivy--regex-fuzzy)
+ (< (length cands) 200)))
+
+ (cl-position (nth ivy--index ivy--old-cands)
+ cands))
+ (funcall func re-str cands))))
+ (when (and (or (string= name "")
+ (string= name "^"))
+ (not (equal ivy--old-re "")))
+ (setq ivy--index
+ (or (ivy--preselect-index
+ (ivy-state-preselect ivy-last)
+ cands)
+ ivy--index)))))
+
+(defun ivy-recompute-index-swiper (_re-str cands)
+ (let ((tail (nthcdr ivy--index ivy--old-cands))
+ idx)
+ (if (and tail ivy--old-cands (not (equal "^" ivy--old-re)))
+ (progn
+ (while (and tail (null idx))
+ ;; Compare with eq to handle equal duplicates in cands
+ (setq idx (cl-position (pop tail) cands)))
+ (or idx 0))
+ (if ivy--old-cands
+ ivy--index
+ ;; already in ivy-state-buffer
+ (let ((n (line-number-at-pos))
+ (res 0)
+ (i 0))
+ (dolist (c cands)
+ (when (eq n (read (get-text-property 0 'display c)))
+ (setq res i))
+ (cl-incf i))
res)))))
+(defun ivy-recompute-index-swiper-async (_re-str cands)
+ (let ((tail (nthcdr ivy--index ivy--old-cands))
+ idx)
+ (if (and tail ivy--old-cands (not (equal "^" ivy--old-re)))
+ (progn
+ (while (and tail (null idx))
+ ;; Compare with `equal', since the collection is re-created
+ ;; each time with `split-string'
+ (setq idx (cl-position (pop tail) cands :test #'equal)))
+ (or idx 0))
+ ivy--index)))
+
+(defun ivy-recompute-index-zero (_re-str _cands)
+ 0)
+
+(defun ivy--flx-sort (name cands)
+ "Sort according to closeness to string NAME the string list CANDS."
+ (condition-case nil
+ (if (and cands
+ (< (length cands) 200))
+ (let* ((flx-name (if (string-match "^\\^" name)
+ (substring name 1)
+ name))
+ (cands-with-score
+ (delq nil
+ (mapcar
+ (lambda (x)
+ (let ((score (car (flx-score x flx-name
ivy--flx-cache))))
+ (and score
+ (cons score x))))
+ cands))))
+ (if cands-with-score
+ (mapcar #'cdr
+ (sort cands-with-score
+ (lambda (x y)
+ (> (car x) (car y)))))
+ cands))
+ cands)
+ (error
+ cands)))
+
+(defcustom ivy-format-function 'ivy-format-function-default
+ "Function to transform the list of candidates into a string.
+This string is inserted into the minibuffer."
+ :type '(choice
+ (const :tag "Default" ivy-format-function-default)
+ (const :tag "Arrow prefix" ivy-format-function-arrow)
+ (const :tag "Full line" ivy-format-function-line)))
+
+(defun ivy--truncate-string (str width)
+ "Truncate STR to WIDTH."
+ (if (> (string-width str) width)
+ (concat (substring str 0 (min (- width 3)
+ (- (length str) 3))) "...")
+ str))
+
+(defun ivy--format-function-generic (selected-fn other-fn cand-pairs separator)
+ "Transform CAND-PAIRS into a string for minibuffer.
+SELECTED-FN and OTHER-FN each take two string arguments.
+SEPARATOR is used to join the candidates."
+ (let ((i -1))
+ (mapconcat
+ (lambda (pair)
+ (let ((str (car pair))
+ (extra (cdr pair))
+ (curr (eq (cl-incf i) ivy--index)))
+ (if curr
+ (funcall selected-fn str extra)
+ (funcall other-fn str extra))))
+ cand-pairs
+ separator)))
+
+(defun ivy-format-function-default (cand-pairs)
+ "Transform CAND-PAIRS into a string for minibuffer."
+ (ivy--format-function-generic
+ (lambda (str extra)
+ (concat (ivy--add-face str 'ivy-current-match) extra))
+ #'concat
+ cand-pairs
+ "\n"))
+
+(defun ivy-format-function-arrow (cand-pairs)
+ "Transform CAND-PAIRS into a string for minibuffer."
+ (ivy--format-function-generic
+ (lambda (str extra)
+ (concat "> " (ivy--add-face str 'ivy-current-match) extra))
+ (lambda (str extra)
+ (concat " " str extra))
+ cand-pairs
+ "\n"))
+
+(defun ivy-format-function-line (cand-pairs)
+ "Transform CAND-PAIRS into a string for minibuffer."
+ (ivy--format-function-generic
+ (lambda (str extra)
+ (ivy--add-face (concat str extra "\n") 'ivy-current-match))
+ (lambda (str extra)
+ (concat str extra "\n"))
+ cand-pairs
+ ""))
+
+(defcustom ivy-minibuffer-faces
+ '(ivy-minibuffer-match-face-1
+ ivy-minibuffer-match-face-2
+ ivy-minibuffer-match-face-3
+ ivy-minibuffer-match-face-4)
+ "List of `ivy' faces for minibuffer group matches.")
+
+(defun ivy--format-minibuffer-line (str)
+ (let ((start 0)
+ (str (copy-sequence str)))
+ (when (eq ivy-display-style 'fancy)
+ (unless ivy--old-re
+ (setq ivy--old-re (funcall ivy--regex-function ivy-text)))
+ (while (and (string-match ivy--old-re str start)
+ (> (- (match-end 0) (match-beginning 0)) 0))
+ (setq start (match-end 0))
+ (let ((i 0))
+ (while (<= i ivy--subexps)
+ (let ((face
+ (cond ((zerop ivy--subexps)
+ (cadr ivy-minibuffer-faces))
+ ((zerop i)
+ (car ivy-minibuffer-faces))
+ (t
+ (nth (1+ (mod (+ i 2) (1- (length
ivy-minibuffer-faces))))
+ ivy-minibuffer-faces)))))
+ (if (fboundp 'add-face-text-property)
+ (add-face-text-property
+ (match-beginning i)
+ (match-end i)
+ face
+ nil
+ str)
+ (font-lock-append-text-property
+ (match-beginning i)
+ (match-end i)
+ 'face
+ face
+ str)))
+ (cl-incf i)))))
+ str))
+
+(defun ivy--format (cands)
+ "Return a string for CANDS suitable for display in the minibuffer.
+CANDS is a list of strings."
+ (setq ivy--length (length cands))
+ (when (>= ivy--index ivy--length)
+ (setq ivy--index (max (1- ivy--length) 0)))
+ (if (null cands)
+ (setq ivy--current "")
+ (let* ((half-height (/ ivy-height 2))
+ (start (max 0 (- ivy--index half-height)))
+ (end (min (+ start (1- ivy-height)) ivy--length))
+ (start (max 0 (min start (- end (1- ivy-height)))))
+ (cands (cl-subseq cands start end))
+ (index (- ivy--index start)))
+ (cond (ivy--directory
+ (setq cands (mapcar (lambda (x)
+ (if (string-match-p "/\\'" x)
+ (propertize x 'face 'ivy-subdir)
+ x))
+ cands)))
+ ((eq (ivy-state-collection ivy-last) 'internal-complete-buffer)
+ (setq cands (mapcar (lambda (x)
+ (let ((b (get-buffer x)))
+ (if (and b
+ (buffer-file-name b)
+ (buffer-modified-p b))
+ (propertize x 'face
'ivy-modified-buffer)
+ x)))
+ cands))))
+ (setq ivy--current (copy-sequence (nth index cands)))
+ (let* ((ivy--index index)
+ (cand-pairs (mapcar
+ (lambda (cand)
+ (cons (ivy--format-minibuffer-line cand) nil))
cands))
+ (res (concat "\n" (funcall ivy-format-function cand-pairs))))
+ (put-text-property 0 (length res) 'read-only nil res)
+ res))))
+
+(defvar ivy--virtual-buffers nil
+ "Store the virtual buffers alist.")
+
+(defvar recentf-list)
+
+(defcustom ivy-virtual-abbreviate 'name
+ "The mode of abbreviation for virtual buffer names."
+ :type '(choice
+ (const :tag "Only name" name)
+ (const :tag "Full path" full)
+ ;; eventually, uniquify
+ ))
+
+(defun ivy--virtual-buffers ()
+ "Adapted from `ido-add-virtual-buffers-to-list'."
+ (unless recentf-mode
+ (recentf-mode 1))
+ (let ((bookmarks (and (boundp 'bookmark-alist)
+ bookmark-alist))
+ virtual-buffers name)
+ (dolist (head (append
+ recentf-list
+ (delete " - no file -"
+ (delq nil (mapcar (lambda (bookmark)
+ (cdr (assoc 'filename
bookmark)))
+ bookmarks)))))
+ (setq name
+ (if (eq ivy-virtual-abbreviate 'name)
+ (file-name-nondirectory head)
+ (expand-file-name head)))
+ (when (equal name "")
+ (setq name (file-name-nondirectory (directory-file-name head))))
+ (when (equal name "")
+ (setq name head))
+ (and (not (equal name ""))
+ (null (get-file-buffer head))
+ (not (assoc name virtual-buffers))
+ (push (cons name head) virtual-buffers)))
+ (when virtual-buffers
+ (dolist (comp virtual-buffers)
+ (put-text-property 0 (length (car comp))
+ 'face 'ivy-virtual
+ (car comp)))
+ (setq ivy--virtual-buffers (nreverse virtual-buffers))
+ (mapcar #'car ivy--virtual-buffers))))
+
+(defun ivy--buffer-list (str &optional virtual)
+ "Return the buffers that match STR.
+When VIRTUAL is non-nil, add virtual buffers."
+ (delete-dups
+ (append
+ (mapcar
+ (lambda (x)
+ (if (with-current-buffer x
+ (file-remote-p
+ (abbreviate-file-name default-directory)))
+ (propertize x 'face 'ivy-remote)
+ x))
+ (all-completions str 'internal-complete-buffer))
+ (and virtual
+ (ivy--virtual-buffers)))))
+
+(defun ivy--switch-buffer-action (buffer)
+ "Switch to BUFFER.
+BUFFER may be a string or nil."
+ (with-ivy-window
+ (if (zerop (length buffer))
+ (switch-to-buffer
+ ivy-text nil 'force-same-window)
+ (let ((virtual (assoc buffer ivy--virtual-buffers)))
+ (if (and virtual
+ (not (get-buffer buffer)))
+ (find-file (cdr virtual))
+ (switch-to-buffer
+ buffer nil 'force-same-window))))))
+
+(defun ivy--switch-buffer-other-window-action (buffer)
+ "Switch to BUFFER in other window.
+BUFFER may be a string or nil."
+ (if (zerop (length buffer))
+ (switch-to-buffer-other-window ivy-text)
+ (let ((virtual (assoc buffer ivy--virtual-buffers)))
+ (if (and virtual
+ (not (get-buffer buffer)))
+ (find-file-other-window (cdr virtual))
+ (switch-to-buffer-other-window buffer)))))
+
+(defun ivy--rename-buffer-action (buffer)
+ "Rename BUFFER."
+ (let ((new-name (read-string "Rename buffer (to new name): ")))
+ (with-current-buffer buffer
+ (rename-buffer new-name))))
+
+(defvar ivy-switch-buffer-map (make-sparse-keymap))
+
+(ivy-set-actions
+ 'ivy-switch-buffer
+ '(("k"
+ (lambda (x)
+ (kill-buffer x)
+ (ivy--reset-state ivy-last))
+ "kill")
+ ("j"
+ ivy--switch-buffer-other-window-action
+ "other")
+ ("r"
+ ivy--rename-buffer-action
+ "rename")))
+
+;;;###autoload
+(defun ivy-switch-buffer ()
+ "Switch to another buffer."
+ (interactive)
+ (if (not ivy-mode)
+ (call-interactively 'switch-to-buffer)
+ (let ((this-command 'ivy-switch-buffer))
+ (ivy-read "Switch to buffer: " 'internal-complete-buffer
+ :preselect (buffer-name (other-buffer (current-buffer)))
+ :action #'ivy--switch-buffer-action
+ :keymap ivy-switch-buffer-map))))
+
+;;;###autoload
+(defun ivy-recentf ()
+ "Find a file on `recentf-list'."
+ (interactive)
+ (ivy-read "Recentf: " recentf-list
+ :action
+ (lambda (f)
+ (with-ivy-window
+ (find-file f)))))
+
+(defun ivy-yank-word ()
+ "Pull next word from buffer into search string."
+ (interactive)
+ (let (amend)
+ (with-ivy-window
+ (let ((pt (point))
+ (le (line-end-position)))
+ (forward-word 1)
+ (if (> (point) le)
+ (goto-char pt)
+ (setq amend (buffer-substring-no-properties pt (point))))))
+ (when amend
+ (insert (replace-regexp-in-string " +" " " amend)))))
+
+(defun ivy-kill-ring-save ()
+ "Store the current candidates into the kill ring.
+If the region is active, forward to `kill-ring-save' instead."
+ (interactive)
+ (if (region-active-p)
+ (call-interactively 'kill-ring-save)
+ (kill-new
+ (mapconcat
+ #'identity
+ ivy--old-cands
+ "\n"))))
+
+(defun ivy-insert-current ()
+ "Make the current candidate into current input.
+Don't finish completion."
+ (interactive)
+ (delete-minibuffer-contents)
+ (if (and ivy--directory
+ (string-match "/$" ivy--current))
+ (insert (substring ivy--current 0 -1))
+ (insert ivy--current)))
+
+(defun ivy-toggle-fuzzy ()
+ "Toggle the re builder between `ivy--regex-fuzzy' and `ivy--regex-plus'."
+ (interactive)
+ (setq ivy--old-re nil)
+ (if (eq ivy--regex-function 'ivy--regex-fuzzy)
+ (setq ivy--regex-function 'ivy--regex-plus)
+ (setq ivy--regex-function 'ivy--regex-fuzzy)))
+
+(defun ivy-reverse-i-search ()
+ "Enter a recursive `ivy-read' session using the current history.
+The selected history element will be inserted into the minibuffer."
+ (interactive)
+ (let ((enable-recursive-minibuffers t)
+ (history (symbol-value (ivy-state-history ivy-last)))
+ (old-last ivy-last))
+ (ivy-read "Reverse-i-search: "
+ history
+ :action (lambda (x)
+ (ivy--reset-state
+ (setq ivy-last old-last))
+ (delete-minibuffer-contents)
+ (insert (substring-no-properties x))
+ (ivy--cd-maybe)))))
+
+(defun ivy-restrict-to-matches ()
+ "Restrict candidates to current matches and erase input."
+ (interactive)
+ (delete-minibuffer-contents)
+ (setq ivy--all-candidates
+ (ivy--filter ivy-text ivy--all-candidates)))
+
+;;* Occur
+(defvar-local ivy-occur-last nil
+ "Buffer-local value of `ivy-last'.
+Can't re-use `ivy-last' because using e.g. `swiper' in the same
+buffer would modify `ivy-last'.")
+
+(defvar ivy-occur-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [mouse-1] 'ivy-occur-click)
+ (define-key map (kbd "RET") 'ivy-occur-press)
+ (define-key map (kbd "j") 'next-line)
+ (define-key map (kbd "k") 'previous-line)
+ (define-key map (kbd "h") 'backward-char)
+ (define-key map (kbd "l") 'forward-char)
+ (define-key map (kbd "g") 'ivy-occur-press)
+ (define-key map (kbd "a") 'ivy-occur-read-action)
+ (define-key map (kbd "o") 'ivy-occur-dispatch)
+ (define-key map (kbd "q") 'quit-window)
+ map)
+ "Keymap for Ivy Occur mode.")
+
+(define-derived-mode ivy-occur-mode fundamental-mode "Ivy-Occur"
+ "Major mode for output from \\[ivy-occur].
+
+\\{ivy-occur-mode-map}")
+
+(defvar ivy-occur-grep-mode-map
+ (let ((map (copy-keymap ivy-occur-mode-map)))
+ (define-key map (kbd "C-x C-q") 'ivy-wgrep-change-to-wgrep-mode)
+ map)
+ "Keymap for Ivy Occur Grep mode.")
+
+(define-derived-mode ivy-occur-grep-mode grep-mode "Ivy-Occur"
+ "Major mode for output from \\[ivy-occur].
+
+\\{ivy-occur-grep-mode-map}")
+
+(defvar counsel-git-grep-cmd)
+
+(defun ivy-occur ()
+ "Stop completion and put the current matches into a new buffer.
+
+The new buffer remembers current action(s).
+
+While in the *ivy-occur* buffer, selecting a candidate with RET or
+a mouse click will call the appropriate action for that candidate.
+
+There is no limit on the number of *ivy-occur* buffers."
+ (interactive)
+ (let ((buffer
+ (generate-new-buffer
+ (format "*ivy-occur%s \"%s\"*"
+ (let (caller)
+ (if (setq caller (ivy-state-caller ivy-last))
+ (concat " " (prin1-to-string caller))
+ ""))
+ ivy-text)))
+ (do-grep (eq (ivy-state-caller ivy-last) 'counsel-git-grep)))
+ (with-current-buffer buffer
+ (if do-grep
+ (progn
+ (setq ivy--old-cands
+ (split-string
+ (shell-command-to-string
+ (format counsel-git-grep-cmd ivy--old-re))
+ "\n"
+ t))
+ (ivy-occur-grep-mode))
+ (ivy-occur-mode))
+ (setf (ivy-state-text ivy-last) ivy-text)
+ (setq ivy-occur-last ivy-last)
+ (setq-local ivy--directory ivy--directory)
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (when do-grep
+ ;; Need precise number of header lines for `wgrep' to work.
+ (insert (format "-*- mode:grep; default-directory: %S -*-\n\n\n"
+ default-directory)))
+ (insert (format "%d candidates:\n" (length ivy--old-cands)))
+ (dolist (cand ivy--old-cands)
+ (let ((str (if do-grep
+ (concat "./" cand)
+ (concat " " cand))))
+ (add-text-properties
+ 0 (length str)
+ `(mouse-face
+ highlight
+ help-echo "mouse-1: call ivy-action")
+ str)
+ (insert str "\n")))))
+ (ivy-exit-with-action
+ `(lambda (_) (pop-to-buffer ,buffer)))))
+
+(declare-function wgrep-change-to-wgrep-mode "ext:wgrep")
+
+(defun ivy-wgrep-change-to-wgrep-mode ()
+ "Forward to `wgrep-change-to-wgrep-mode'."
+ (interactive)
+ (if (require 'wgrep nil 'noerror)
+ (wgrep-change-to-wgrep-mode)
+ (error "Package wgrep isn't installed")))
+
+(defun ivy-occur-read-action ()
+ "Select one of the available actions as the current one."
+ (interactive)
+ (let ((ivy-last ivy-occur-last))
+ (ivy-read-action)))
+
+(defun ivy-occur-dispatch ()
+ "Call one of the available actions on the current item."
+ (interactive)
+ (let* ((state-action (ivy-state-action ivy-occur-last))
+ (actions (if (symbolp state-action)
+ state-action
+ (copy-sequence state-action))))
+ (unwind-protect
+ (progn
+ (ivy-occur-read-action)
+ (ivy-occur-press))
+ (setf (ivy-state-action ivy-occur-last) actions))))
+
+(defun ivy-occur-click (event)
+ "Execute action for the current candidate.
+EVENT gives the mouse position."
+ (interactive "e")
+ (let ((window (posn-window (event-end event)))
+ (pos (posn-point (event-end event))))
+ (with-current-buffer (window-buffer window)
+ (goto-char pos)
+ (ivy-occur-press))))
+
+(defun ivy-occur-press ()
+ "Execute action for the current candidate."
+ (interactive)
+ (require 'pulse)
+ (when (save-excursion
+ (beginning-of-line)
+ (looking-at "\\(?:./\\| \\)\\(.*\\)$"))
+ (let* ((ivy-last ivy-occur-last)
+ (ivy-text (ivy-state-text ivy-last))
+ (str (buffer-substring
+ (match-beginning 1)
+ (match-end 1)))
+ (coll (ivy-state-collection ivy-last))
+ (action (ivy--get-action ivy-last))
+ (ivy-exit 'done))
+ (with-ivy-window
+ (funcall action
+ (if (and (consp coll)
+ (consp (car coll)))
+ (cdr (assoc str coll))
+ str))
+ (if (memq (ivy-state-caller ivy-last)
+ '(swiper counsel-git-grep))
+ (with-current-buffer (window-buffer (selected-window))
+ (swiper--cleanup)
+ (swiper--add-overlays
+ (ivy--regex ivy-text)
+ (line-beginning-position)
+ (line-end-position)
+ (selected-window))
+ (run-at-time 0.5 nil 'swiper--cleanup))
+ (pulse-momentary-highlight-one-line (point)))))))
+
(provide 'ivy)
;;; ivy.el ends here
diff --git a/packages/swiper/swiper.el b/packages/swiper/swiper.el
index b3b1940..d9bf724 100644
--- a/packages/swiper/swiper.el
+++ b/packages/swiper/swiper.el
@@ -4,7 +4,7 @@
;; Author: Oleh Krehel <address@hidden>
;; URL: https://github.com/abo-abo/swiper
-;; Version: 0.2.0
+;; Version: 0.7.0
;; Package-Requires: ((emacs "24.1"))
;; Keywords: matching
@@ -29,10 +29,13 @@
;; candidates. The search regex can be split into groups with a
;; space. Each group is highlighted with a different face.
;;
-;; The overview back end is `ivy'.
-;;
;; It can double as a quick `regex-builder', although only single
;; lines will be matched.
+;;
+;; It also provides `ivy-mode': a global minor mode that uses the
+;; matching back end of `swiper' for all matching on your system,
+;; including file matching. You can use it in place of `ido-mode'
+;; (can't have both on at once).
;;; Code:
(require 'ivy)
@@ -44,19 +47,31 @@
(defface swiper-match-face-1
'((t (:inherit isearch-lazy-highlight-face)))
- "Face for `swiper' matches.")
+ "The background face for `swiper' matches.")
(defface swiper-match-face-2
'((t (:inherit isearch)))
- "Face for `swiper' matches.")
+ "Face for `swiper' matches modulo 1.")
(defface swiper-match-face-3
'((t (:inherit match)))
- "Face for `swiper' matches.")
+ "Face for `swiper' matches modulo 2.")
(defface swiper-match-face-4
- '((t (:inherit isearch)))
- "Face for `swiper' matches.")
+ '((t (:inherit isearch-fail)))
+ "Face for `swiper' matches modulo 3.")
+
+(define-obsolete-face-alias 'swiper-minibuffer-match-face-1
+ 'ivy-minibuffer-match-face-1 "0.6.0")
+
+(define-obsolete-face-alias 'swiper-minibuffer-match-face-2
+ 'ivy-minibuffer-match-face-2 "0.6.0")
+
+(define-obsolete-face-alias 'swiper-minibuffer-match-face-3
+ 'ivy-minibuffer-match-face-3 "0.6.0")
+
+(define-obsolete-face-alias 'swiper-minibuffer-match-face-4
+ 'ivy-minibuffer-match-face-4 "0.6.0")
(defface swiper-line-face
'((t (:inherit highlight)))
@@ -75,6 +90,10 @@
(defvar swiper-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "M-q") 'swiper-query-replace)
+ (define-key map (kbd "C-l") 'swiper-recenter-top-bottom)
+ (define-key map (kbd "C-'") 'swiper-avy)
+ (define-key map (kbd "C-7") 'swiper-mc)
+ (define-key map (kbd "C-c C-f") 'swiper-toggle-face-matching)
map)
"Keymap for swiper.")
@@ -83,53 +102,205 @@
(interactive)
(if (null (window-minibuffer-p))
(user-error "Should only be called in the minibuffer through
`swiper-map'")
- (let* ((from (ivy--regex ivy-text))
+ (let* ((enable-recursive-minibuffers t)
+ (from (ivy--regex ivy-text))
(to (query-replace-read-to from "Query replace" t)))
- (delete-minibuffer-contents)
- (setq ivy--action
- (lambda ()
- (perform-replace from to
- t t t)))
(swiper--cleanup)
- (exit-minibuffer))))
+ (ivy-exit-with-action
+ (lambda (_)
+ (with-ivy-window
+ (move-beginning-of-line 1)
+ (perform-replace from to
+ t t nil)))))))
+
+(defvar avy-background)
+(defvar avy-all-windows)
+(defvar avy-style)
+(defvar avy-keys)
+(declare-function avy--regex-candidates "ext:avy")
+(declare-function avy--process "ext:avy")
+(declare-function avy--overlay-post "ext:avy")
+(declare-function avy-action-goto "ext:avy")
+(declare-function avy--done "ext:avy")
+(declare-function avy--make-backgrounds "ext:avy")
+(declare-function avy-window-list "ext:avy")
+(declare-function avy-read "ext:avy")
+(declare-function avy-read-de-bruijn "ext:avy")
+(declare-function avy-tree "ext:avy")
+(declare-function avy-push-mark "ext:avy")
+(declare-function avy--remove-leading-chars "ext:avy")
-(defvar swiper--window nil
- "Store the current window.")
+;;;###autoload
+(defun swiper-avy ()
+ "Jump to one of the current swiper candidates."
+ (interactive)
+ (unless (string= ivy-text "")
+ (let* ((avy-all-windows nil)
+ (candidates (append
+ (with-ivy-window
+ (avy--regex-candidates
+ (ivy--regex ivy-text)))
+ (save-excursion
+ (save-restriction
+ (narrow-to-region (window-start) (window-end))
+ (goto-char (point-min))
+ (forward-line)
+ (let ((cands))
+ (while (< (point) (point-max))
+ (push (cons (1+ (point))
+ (selected-window))
+ cands)
+ (forward-line))
+ cands)))))
+ (candidate (unwind-protect
+ (prog2
+ (avy--make-backgrounds
+ (append (avy-window-list)
+ (list (ivy-state-window ivy-last))))
+ (if (eq avy-style 'de-bruijn)
+ (avy-read-de-bruijn
+ candidates avy-keys)
+ (avy-read (avy-tree candidates avy-keys)
+ #'avy--overlay-post
+ #'avy--remove-leading-chars))
+ (avy-push-mark))
+ (avy--done))))
+ (if (window-minibuffer-p (cdr candidate))
+ (progn
+ (ivy-set-index (- (line-number-at-pos (car candidate)) 2))
+ (ivy--exhibit)
+ (ivy-done)
+ (ivy-call))
+ (ivy-quit-and-run
+ (avy-action-goto (caar candidate)))))))
+
+(declare-function mc/create-fake-cursor-at-point "ext:multiple-cursors-core")
+(declare-function multiple-cursors-mode "ext:multiple-cursors-core")
+
+;;;###autoload
+(defun swiper-mc ()
+ (interactive)
+ (unless (require 'multiple-cursors nil t)
+ (error "multiple-cursors isn't installed"))
+ (let ((cands (nreverse ivy--old-cands)))
+ (unless (string= ivy-text "")
+ (ivy-exit-with-action
+ (lambda (_)
+ (let (cand)
+ (while (setq cand (pop cands))
+ (swiper--action cand)
+ (when cands
+ (mc/create-fake-cursor-at-point))))
+ (multiple-cursors-mode 1))))))
+
+(defun swiper-recenter-top-bottom (&optional arg)
+ "Call (`recenter-top-bottom' ARG)."
+ (interactive "P")
+ (with-ivy-window
+ (recenter-top-bottom arg)))
(defun swiper-font-lock-ensure ()
"Ensure the entired buffer is highlighted."
(unless (or (derived-mode-p 'magit-mode)
+ (bound-and-true-p magit-blame-mode)
(memq major-mode '(package-menu-mode
gnus-summary-mode
gnus-article-mode
gnus-group-mode
- emms-playlist-mode erc-mode)))
- (if (fboundp 'font-lock-ensure)
- (font-lock-ensure)
- (font-lock-fontify-buffer))))
+ emms-playlist-mode
+ emms-stream-mode
+ erc-mode
+ org-agenda-mode
+ dired-mode
+ jabber-chat-mode
+ elfeed-search-mode
+ elfeed-show-mode
+ fundamental-mode
+ Man-mode
+ woman-mode
+ mu4e-view-mode
+ mu4e-headers-mode
+ help-mode
+ debbugs-gnu-mode
+ occur-mode
+ occur-edit-mode
+ bongo-mode
+ eww-mode
+ twittering-mode
+ vc-dir-mode
+ w3m-mode)))
+ (unless (> (buffer-size) 100000)
+ (if (fboundp 'font-lock-ensure)
+ (font-lock-ensure)
+ (with-no-warnings (font-lock-fontify-buffer))))))
(defvar swiper--format-spec ""
"Store the current candidates format spec.")
-(defun swiper--candidates ()
- "Return a list of this buffer lines."
+(defvar swiper--width nil
+ "Store the amount of digits needed for the longest line nubmer.")
+
+(defvar swiper-use-visual-line nil
+ "When non-nil, use `line-move' instead of `forward-line'.")
+
+(declare-function outline-show-all "outline")
+
+(defun swiper--candidates (&optional numbers-width)
+ "Return a list of this buffer lines.
+
+NUMBERS-WIDTH, when specified, is used for line numbers width
+spec, instead of calculating it as the log of the buffer line
+count."
+ (if (and visual-line-mode
+ ;; super-slow otherwise
+ (< (buffer-size) 20000))
+ (progn
+ (when (eq major-mode 'org-mode)
+ (require 'outline)
+ (if (fboundp 'outline-show-all)
+ (outline-show-all)
+ (with-no-warnings
+ (show-all))))
+ (setq swiper-use-visual-line t))
+ (setq swiper-use-visual-line nil))
(let ((n-lines (count-lines (point-min) (point-max))))
(unless (zerop n-lines)
+ (setq swiper--width (or numbers-width
+ (1+ (floor (log n-lines 10)))))
(setq swiper--format-spec
- (format "%%-%dd %%s" (1+ (floor (log n-lines 10)))))
+ (format "%%-%dd " swiper--width))
(let ((line-number 0)
+ (advancer (if swiper-use-visual-line
+ (lambda (arg) (line-move arg t))
+ #'forward-line))
candidates)
(save-excursion
(goto-char (point-min))
(swiper-font-lock-ensure)
(while (< (point) (point-max))
- (push (format swiper--format-spec
- (cl-incf line-number)
- (buffer-substring
- (line-beginning-position)
- (line-end-position)))
- candidates)
- (zerop (forward-line 1)))
+ (let ((str (concat
+ " "
+ (replace-regexp-in-string
+ "\t" " "
+ (if swiper-use-visual-line
+ (buffer-substring
+ (save-excursion
+ (beginning-of-visual-line)
+ (point))
+ (save-excursion
+ (end-of-visual-line)
+ (point)))
+ (buffer-substring
+ (point)
+ (line-end-position)))))))
+ (when (eq major-mode 'twittering-mode)
+ (remove-text-properties 0 (length str) '(field) str))
+ (put-text-property 0 1 'display
+ (format swiper--format-spec
+ (cl-incf line-number))
+ str)
+ (push str candidates))
+ (funcall advancer 1))
(nreverse candidates))))))
(defvar swiper--opoint 1
@@ -142,43 +313,100 @@ When non-nil, INITIAL-INPUT is the initial search
pattern."
(interactive)
(swiper--ivy initial-input))
+(declare-function evil-jumper--set-jump "ext:evil-jumper")
+
(defun swiper--init ()
"Perform initialization common to both completion methods."
- (deactivate-mark)
(setq swiper--opoint (point))
- (setq swiper--len 0)
- (setq swiper--anchor (line-number-at-pos))
- (setq swiper--window (selected-window)))
+ (when (bound-and-true-p evil-jumper-mode)
+ (evil-jumper--set-jump)))
+
+(defun swiper--re-builder (str)
+ "Transform STR into a swiper regex.
+This is the regex used in the minibuffer, since the candidates
+there have line numbers. In the buffer, `ivy--regex' should be used."
+ (cond
+ ((equal str "")
+ "")
+ ((equal str "^")
+ (setq ivy--subexps 0)
+ ".")
+ ((string-match "^\\^" str)
+ (setq ivy--old-re "")
+ (let ((re (ivy--regex-plus (substring str 1))))
+ (if (zerop ivy--subexps)
+ (prog1 (format "^ ?\\(%s\\)" re)
+ (setq ivy--subexps 1))
+ (format "^ %s" re))))
+ (t
+ (ivy--regex-plus str))))
+
+(defvar swiper-history nil
+ "History for `swiper'.")
+
+(defvar swiper-invocation-face nil
+ "The face at the point of invocation of `swiper'.")
(defun swiper--ivy (&optional initial-input)
"`isearch' with an overview using `ivy'.
When non-nil, INITIAL-INPUT is the initial search pattern."
(interactive)
- (ido-mode -1)
(swiper--init)
+ (setq swiper-invocation-face
+ (plist-get (text-properties-at (point)) 'face))
(let ((candidates (swiper--candidates))
- (preselect (format
- swiper--format-spec
- (line-number-at-pos)
- (regexp-quote
- (buffer-substring-no-properties
- (line-beginning-position)
- (line-end-position)))))
+ (preselect
+ (if swiper-use-visual-line
+ (count-screen-lines
+ (point-min)
+ (save-excursion (beginning-of-visual-line) (point)))
+ (1- (line-number-at-pos))))
+ (minibuffer-allow-text-properties t)
res)
(unwind-protect
- (setq res (ivy-read
- (replace-regexp-in-string
- "%s" "pattern: " swiper--format-spec)
- candidates
- initial-input
- swiper-map
- preselect
- #'swiper--update-input-ivy))
- (ido-mode 1)
- (swiper--cleanup)
- (if (null ivy-exit)
- (goto-char swiper--opoint)
- (swiper--action res ivy-text)))))
+ (setq res
+ (ivy-read
+ "Swiper: "
+ candidates
+ :initial-input initial-input
+ :keymap swiper-map
+ :preselect preselect
+ :require-match t
+ :update-fn #'swiper--update-input-ivy
+ :unwind #'swiper--cleanup
+ :action #'swiper--action
+ :re-builder #'swiper--re-builder
+ :history 'swiper-history
+ :caller 'swiper))
+ (unless res
+ (goto-char swiper--opoint)))))
+
+(defun swiper-toggle-face-matching ()
+ "Toggle matching only the candidates with `swiper-invocation-face'."
+ (interactive)
+ (setf (ivy-state-matcher ivy-last)
+ (if (ivy-state-matcher ivy-last)
+ nil
+ #'swiper--face-matcher))
+ (setq ivy--old-re nil))
+
+(defun swiper--face-matcher (regexp candidates)
+ "Return REGEXP-matching CANDIDATES.
+Matched candidates should have `swiper-invocation-face'."
+ (cl-remove-if-not
+ (lambda (x)
+ (and
+ (string-match regexp x)
+ (let ((s (match-string 0 x))
+ (i 0))
+ (while (and (< i (length s))
+ (text-property-any
+ i (1+ i)
+ 'face swiper-invocation-face
+ s))
+ (cl-incf i))
+ (eq i (length s)))))
+ candidates))
(defun swiper--ensure-visible ()
"Remove overlays hiding point."
@@ -189,6 +417,9 @@ When non-nil, INITIAL-INPUT is the initial search pattern."
(setq expose (overlay-get ov 'isearch-open-invisible)))
(funcall expose ov)))))
+(defvar swiper--overlays nil
+ "Store overlays.")
+
(defun swiper--cleanup ()
"Clean up the overlays."
(while swiper--overlays
@@ -197,84 +428,215 @@ When non-nil, INITIAL-INPUT is the initial search
pattern."
(goto-char (point-min))
(isearch-clean-overlays)))
-(defvar swiper--overlays nil
- "Store overlays.")
-
-(defvar swiper--anchor nil
- "A line number to which the search should be anchored.")
-
-(defvar swiper--len 0
- "The last length of input for which an anchoring was made.")
-
(defun swiper--update-input-ivy ()
"Called when `ivy' input is updated."
- (swiper--cleanup)
- (let* ((re (ivy--regex ivy-text))
- (str ivy--current)
- (num (if (string-match "^[0-9]+" str)
- (string-to-number (match-string 0 str))
- 0)))
- (with-selected-window swiper--window
- (goto-char (point-min))
- (when (cl-plusp num)
- (goto-char (point-min))
- (forward-line (1- num))
- (isearch-range-invisible (line-beginning-position)
- (line-end-position))
- (unless (and (> (point) (window-start))
- (< (point) (window-end swiper--window t)))
- (recenter)))
- (let ((ov (make-overlay
- (line-beginning-position)
- (1+ (line-end-position)))))
- (overlay-put ov 'face 'swiper-line-face)
- (overlay-put ov 'window swiper--window)
- (push ov swiper--overlays))
- (swiper--add-overlays
- re
- (window-start swiper--window)
- (window-end swiper--window t)))))
-
-(defun swiper--add-overlays (re beg end)
- "Add overlays for RE regexp in current buffer between BEG and END."
- (when (>= (length re) swiper-min-highlight)
- (save-excursion
- (goto-char beg)
- ;; RE can become an invalid regexp
- (while (and (ignore-errors (re-search-forward re end t))
- (> (- (match-end 0) (match-beginning 0)) 0))
- (let ((i 0))
- (while (<= i ivy--subexps)
- (when (match-beginning i)
- (let ((overlay (make-overlay (match-beginning i)
- (match-end i)))
- (face
- (cond ((zerop ivy--subexps)
- (cl-caddr swiper-faces))
- ((zerop i)
- (car swiper-faces))
- (t
- (nth (1+ (mod (1- i) (1- (length swiper-faces))))
- swiper-faces)))))
- (push overlay swiper--overlays)
- (overlay-put overlay 'face face)
- (overlay-put overlay 'window swiper--window)
- (overlay-put overlay 'priority i)))
- (cl-incf i)))))))
-
-(defun swiper--action (x input)
- "Goto line X and search for INPUT."
+ (with-ivy-window
+ (swiper--cleanup)
+ (when (> (length ivy--current) 0)
+ (let* ((re (funcall ivy--regex-function ivy-text))
+ (re (if (stringp re) re (caar re)))
+ (str (get-text-property 0 'display ivy--current))
+ (num (if (string-match "^[0-9]+" str)
+ (string-to-number (match-string 0 str))
+ 0)))
+ (unless (eq this-command 'ivy-yank-word)
+ (goto-char (point-min))
+ (when (cl-plusp num)
+ (goto-char (point-min))
+ (if swiper-use-visual-line
+ (line-move (1- num))
+ (forward-line (1- num)))
+ (if (and (equal ivy-text "")
+ (>= swiper--opoint (line-beginning-position))
+ (<= swiper--opoint (line-end-position)))
+ (goto-char swiper--opoint)
+ (re-search-forward re (line-end-position) t))
+ (isearch-range-invisible (line-beginning-position)
+ (line-end-position))
+ (unless (and (>= (point) (window-start))
+ (<= (point) (window-end (ivy-state-window ivy-last)
t)))
+ (recenter))))
+ (swiper--add-overlays re)))))
+
+(defun swiper--add-overlays (re &optional beg end wnd)
+ "Add overlays for RE regexp in visible part of the current buffer.
+BEG and END, when specified, are the point bounds.
+WND, when specified is the window."
+ (setq wnd (or wnd (ivy-state-window ivy-last)))
+ (let ((ov (if visual-line-mode
+ (make-overlay
+ (save-excursion
+ (beginning-of-visual-line)
+ (point))
+ (save-excursion
+ (end-of-visual-line)
+ (point)))
+ (make-overlay
+ (line-beginning-position)
+ (1+ (line-end-position))))))
+ (overlay-put ov 'face 'swiper-line-face)
+ (overlay-put ov 'window wnd)
+ (push ov swiper--overlays)
+ (let* ((wh (window-height))
+ (beg (or beg (save-excursion
+ (forward-line (- wh))
+ (point))))
+ (end (or end (save-excursion
+ (forward-line wh)
+ (point)))))
+ (when (>= (length re) swiper-min-highlight)
+ (save-excursion
+ (goto-char beg)
+ ;; RE can become an invalid regexp
+ (while (and (ignore-errors (re-search-forward re end t))
+ (> (- (match-end 0) (match-beginning 0)) 0))
+ (let ((i 0))
+ (while (<= i ivy--subexps)
+ (when (match-beginning i)
+ (let ((overlay (make-overlay (match-beginning i)
+ (match-end i)))
+ (face
+ (cond ((zerop ivy--subexps)
+ (cadr swiper-faces))
+ ((zerop i)
+ (car swiper-faces))
+ (t
+ (nth (1+ (mod (+ i 2) (1- (length
swiper-faces))))
+ swiper-faces)))))
+ (push overlay swiper--overlays)
+ (overlay-put overlay 'face face)
+ (overlay-put overlay 'window wnd)
+ (overlay-put overlay 'priority i)))
+ (cl-incf i)))))))))
+
+(defun swiper--action (x)
+ "Goto line X."
(if (null x)
(user-error "No candidates")
- (goto-char (point-min))
- (forward-line (1- (read x)))
- (re-search-forward
- (ivy--regex input) (line-end-position) t)
- (swiper--ensure-visible)
- (when (/= (point) swiper--opoint)
- (unless (and transient-mark-mode mark-active)
- (push-mark swiper--opoint t)
- (message "Mark saved where search started")))))
+ (with-ivy-window
+ (unless (equal (current-buffer)
+ (ivy-state-buffer ivy-last))
+ (switch-to-buffer (ivy-state-buffer ivy-last)))
+ (goto-char (point-min))
+ (funcall (if swiper-use-visual-line
+ #'line-move
+ #'forward-line)
+ (1- (read (get-text-property 0 'display x))))
+ (re-search-forward
+ (ivy--regex ivy-text) (line-end-position) t)
+ (swiper--ensure-visible)
+ (when (/= (point) swiper--opoint)
+ (unless (and transient-mark-mode mark-active)
+ (when (eq ivy-exit 'done)
+ (push-mark swiper--opoint t)
+ (message "Mark saved where search started")))))))
+
+;; (define-key isearch-mode-map (kbd "C-o") 'swiper-from-isearch)
+(defun swiper-from-isearch ()
+ "Invoke `swiper' from isearch."
+ (interactive)
+ (let ((query (if isearch-regexp
+ isearch-string
+ (regexp-quote isearch-string))))
+ (isearch-exit)
+ (swiper query)))
+
+(defvar swiper-multi-buffers nil
+ "Store the current list of buffers.")
+
+(defvar swiper-multi-candidates nil
+ "Store the list of candidates for `swiper-multi'.")
+
+(defun swiper-multi-prompt ()
+ (format "Buffers (%s): "
+ (mapconcat #'identity swiper-multi-buffers ", ")))
+
+(defun swiper-multi ()
+ "Select one or more buffers.
+Run `swiper' for those buffers."
+ (interactive)
+ (setq swiper-multi-buffers nil)
+ (ivy-read (swiper-multi-prompt)
+ 'internal-complete-buffer
+ :action 'swiper-multi-action-1)
+ (ivy-read "Swiper: " swiper-multi-candidates
+ :action 'swiper-multi-action-2
+ :unwind #'swiper--cleanup
+ :caller 'swiper-multi))
+
+(defun swiper-all ()
+ "Run `swiper' for all opened buffers."
+ (interactive)
+ (ivy-read "Swiper: " (swiper--multi-candidates
+ (cl-remove-if-not
+ #'buffer-file-name
+ (buffer-list)))
+ :action 'swiper-multi-action-2
+ :unwind #'swiper--cleanup
+ :caller 'swiper-multi))
+
+(defun swiper--multi-candidates (buffers)
+ (let* ((ww (window-width))
+ (res nil)
+ (column-2 (apply #'max
+ (mapcar
+ (lambda (b)
+ (length (buffer-name b)))
+ buffers)))
+ (column-1 (- ww 4 column-2 1)))
+ (dolist (buf buffers)
+ (with-current-buffer buf
+ (setq res
+ (append
+ (mapcar
+ (lambda (s)
+ (setq s (concat (ivy--truncate-string s column-1) " "))
+ (let ((len (length s)))
+ (put-text-property
+ (1- len) len 'display
+ (concat
+ (make-string
+ (- ww (string-width s) (length (buffer-name)) 3)
+ ?\ )
+ (buffer-name))
+ s)
+ s))
+ (swiper--candidates 4))
+ res))
+ nil))
+ res))
+
+(defun swiper-multi-action-1 (x)
+ (if (member x swiper-multi-buffers)
+ (progn
+ (setq swiper-multi-buffers (delete x swiper-multi-buffers)))
+ (unless (equal x "")
+ (setq swiper-multi-buffers (append swiper-multi-buffers (list x)))))
+ (let ((prompt (swiper-multi-prompt)))
+ (setf (ivy-state-prompt ivy-last) prompt)
+ (setq ivy--prompt (concat "%-4d " prompt)))
+ (cond ((memq this-command '(ivy-done
+ ivy-alt-done
+ ivy-immediate-done))
+ (setq swiper-multi-candidates
+ (swiper--multi-candidates
+ (mapcar #'get-buffer swiper-multi-buffers))))
+ ((eq this-command 'ivy-call)
+ (delete-minibuffer-contents))))
+
+(defun swiper-multi-action-2 (x)
+ (let ((buf-space (get-text-property (1- (length x)) 'display x)))
+ (with-ivy-window
+ (when (string-match "\\` *\\([^ ]+\\)\\'" buf-space)
+ (switch-to-buffer (match-string 1 buf-space))
+ (goto-char (point-min))
+ (forward-line (1- (read (get-text-property 0 'display x))))
+ (re-search-forward
+ (ivy--regex ivy-text)
+ (line-end-position) t)
+ (unless (eq ivy-exit 'done)
+ (swiper--cleanup)
+ (swiper--add-overlays (ivy--regex ivy-text)))))))
(provide 'swiper)
diff --git a/packages/test-simple/test-simple.el
b/packages/test-simple/test-simple.el
index a72e179..bd576e1 100644
--- a/packages/test-simple/test-simple.el
+++ b/packages/test-simple/test-simple.el
@@ -6,6 +6,7 @@
;; Author: Rocky Bernstein <address@hidden>
;; URL: http://github.com/rocky/emacs-test-simple
;; Keywords: unit-test
+;; Package-Requires: ((cl-lib "0"))
;; Version: 1.1
;; This program is free software: you can redistribute it and/or
@@ -26,7 +27,7 @@
;; test-simple.el is:
;;
-;; * Simple. No need for
+;; * Simple. No need for
;; - context macros,
;; - enclosing specifications,
;; - required test tags.
@@ -37,7 +38,7 @@
;;
;; * Accomodates 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.
+;; 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>
;;
@@ -81,21 +82,14 @@
;;; To do:
+;; FIXME: Namespace is all messed up!
;; Main issues: more expect predicates
(require 'time-date)
;;; Code:
-(eval-when-compile
- (byte-compile-disable-warning 'cl-functions)
- ;; Somehow disabling cl-functions causes the erroneous message:
- ;; Warning: the function `reduce' might not be defined at runtime.
- ;; FIXME: isolate, fix and/or report back to Emacs developers a bug
- ;; (byte-compile-disable-warning 'unresolved)
- (require 'cl)
- )
-(require 'cl)
+(eval-when-compile (require 'cl-lib))
(defvar test-simple-debug-on-error nil
"If non-nil raise an error on the first failure.")
@@ -103,7 +97,7 @@
(defvar test-simple-verbosity 0
"The greater the number the more verbose output.")
-(defstruct test-info
+(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
@@ -114,7 +108,7 @@
"Variable to store testing information for a buffer.")
(defun note (description &optional test-info)
- "Adds a name to a group of tests."
+ "Add a name to a group of tests."
(if (getenv "USE_TAP")
(test-simple-msg (format "# %s" description) 't)
(if (> test-simple-verbosity 0)
@@ -135,15 +129,13 @@
;;;###autoload
(defun test-simple-clear (&optional test-info test-start-msg)
- "Initializes and resets everything to run tests. You should run
-this before running any assertions. Running more than once clears
-out information from the previous run."
+ "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
- (unless test-simple-info
- (make-variable-buffer-local (defvar test-simple-info (make-test-info))))
(setq test-info test-simple-info))
(setf (test-info-description test-info) "none set")
@@ -174,9 +166,9 @@ out information from the previous run."
(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."
+ "Expectation is that ACTUAL should be equal to EXPECTED."
(unless test-info (setq test-info test-simple-info))
- (incf (test-info-assert-count test-info))
+ (cl-incf (test-info-assert-count test-info))
(if (not (funcall op actual expected))
(let* ((fail-message
(if fail-message
@@ -188,26 +180,26 @@ out information from the previous run."
(if (boundp 'test-info)
(test-info-description test-info)
"unset")))
- (add-failure (format "assert-%s" op) test-info-mess
- (concat fail-message expect-message)))
- (ok-msg fail-message)))
+ (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."
+ "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."
+ "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."
+ "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."
+ "Expectation is that ACTUAL should match EXPECTED-REGEXP."
(unless test-info (setq test-info test-simple-info))
- (incf (test-info-assert-count test-info))
+ (cl-incf (test-info-assert-count test-info))
(if (not (string-match expected-regexp actual))
(let* ((fail-message
(if fail-message
@@ -220,20 +212,21 @@ out information from the previous run."
(if (boundp 'test-info)
(test-info-description test-info)
"unset")))
- (add-failure "assert-equal" test-info-mess
- (concat expect-message fail-message)))
+ (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."
+ "Expectation is that ACTUAL is not nil."
(assert-nil (not actual) fail-message test-info "assert-t"))
-(defun assert-nil (actual &optional fail-message test-info assert-type)
- "expectation is that ACTUAL is nil. FAIL-MESSAGE is an optional
-additional message to be displayed. Since several assertions
-funnel down to this one, ASSERT-TYPE is an optional type."
+(defun assert-nil (actual &optional fail-message test-info _assert-type)
+ "Expectation is that ACTUAL is nil.
+FAIL-MESSAGE is an optional additional message to be displayed.
+Since several assertions funnel down to this one, ASSERT-TYPE is an
+optional type."
(unless test-info (setq test-info test-simple-info))
- (incf (test-info-assert-count test-info))
+ (cl-incf (test-info-assert-count test-info))
(if actual
(let* ((fail-message
(if fail-message
@@ -243,18 +236,19 @@ funnel down to this one, ASSERT-TYPE is an optional type."
(if (boundp 'test-simple-info)
(test-info-description test-simple-info)
"unset")))
- (add-failure "assert-nil" test-info-mess fail-message test-info))
- (ok-msg fail-message)))
+ (test-simple--add-failure "assert-nil" test-info-mess
+ fail-message test-info))
+ (test-simple--ok-msg fail-message)))
-(defun add-failure(type test-info-msg fail-msg &optional test-info)
+(defun test-simple--add-failure (type test-info-msg fail-msg
+ &optional test-info)
(unless test-info (setq test-info test-simple-info))
- (incf (test-info-failure-count test-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))
- (old-read-only inhibit-read-only)
)
(save-excursion
- (not-ok-msg fail-msg)
+ (test-simple--not-ok-msg fail-msg)
(test-simple-msg failure-msg 't)
(unless noninteractive
(if test-simple-debug-on-error
@@ -263,7 +257,7 @@ funnel down to this one, ASSERT-TYPE is an optional type."
)))))
(defun end-tests (&optional test-info)
- "Give a tally of the tests run"
+ "Give a tally of the tests run."
(interactive)
(unless test-info (setq test-info test-simple-info))
(test-simple-describe-failures test-info)
@@ -281,15 +275,12 @@ funnel down to this one, ASSERT-TYPE is an optional type."
(defun test-simple-msg(msg &optional newline)
(switch-to-buffer "*test-simple*")
- (let ((old-read-only inhibit-read-only))
- (setq inhibit-read-only 't)
+ (let ((inhibit-read-only t))
(insert msg)
- (if newline (insert "\n"))
- (setq inhibit-read-only old-read-only)
- (switch-to-buffer nil)
- ))
+ (if newline (insert "\n")))
+ (switch-to-buffer nil))
-(defun ok-msg(fail-message &optional test-info)
+(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 "")
@@ -301,7 +292,7 @@ funnel down to this one, ASSERT-TYPE is an optional type."
(test-simple-msg msg))
't)
-(defun not-ok-msg(fail-message &optional test-info)
+(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))
diff --git a/packages/tiny/Makefile b/packages/tiny/Makefile
index 6332238..708ea1a 100644
--- a/packages/tiny/Makefile
+++ b/packages/tiny/Makefile
@@ -1,18 +1,13 @@
-EMACS ?= emacs
-CASK_EXEC ?= cask exec
-
+emacs ?= emacs
all: test
-test: clean-elc
- ${MAKE} unit
-
-unit:
- ${CASK_EXEC} ${EMACS} -Q -batch -l tiny-test.el -l tiny.el --eval "(ert
t)"
+test: clean
+ cask exec emacs -Q -batch -l tiny-test.el -l tiny.el -f
ert-run-tests-batch-and-exit
compile:
- ${CASK_EXEC} ${EMACS} -Q -batch -f batch-byte-compile tiny.el
+ $(emacs) -Q -batch -f batch-byte-compile tiny.el
-clean-elc:
+clean:
rm -f f.elc
.PHONY: all test
diff --git a/packages/tiny/tiny-test.el b/packages/tiny/tiny-test.el
index dc9c3b9..3d9ec54 100644
--- a/packages/tiny/tiny-test.el
+++ b/packages/tiny/tiny-test.el
@@ -74,6 +74,8 @@ with point at the end of TXT."
(ert-deftest tiny-mapconcat ()
(should (equal (with-text-value "m10" (lambda()(eval (read
(tiny-mapconcat)))))
"0 1 2 3 4 5 6 7 8 9 10"))
+ (should (equal (with-text-value "mm10" (lambda()(eval (read
(tiny-mapconcat)))))
+ "012345678910"))
(should (equal (with-text-value "m5 10" (lambda()(eval (read
(tiny-mapconcat)))))
"5 6 7 8 9 10"))
(should (equal (with-text-value "m5 10*xx" (lambda()(eval (read
(tiny-mapconcat)))))
diff --git a/packages/tiny/tiny.el b/packages/tiny/tiny.el
index 78d44bb..90c89d5 100644
--- a/packages/tiny/tiny.el
+++ b/packages/tiny/tiny.el
@@ -4,7 +4,7 @@
;; Author: Oleh Krehel <address@hidden>
;; URL: https://github.com/abo-abo/tiny
-;; Version: 0.1
+;; Version: 0.1.1
;; Keywords: convenience
;; This file is part of GNU Emacs.
@@ -122,6 +122,11 @@ At the moment, only `tiny-mapconcat' is supported.
"Setup shortcuts."
(global-set-key (kbd "C-;") 'tiny-expand))
+(defalias 'tiny--preceding-sexp
+ (if (fboundp 'elisp--preceding-sexp)
+ 'elisp--preceding-sexp
+ 'preceding-sexp))
+
;;;###autoload
(defun tiny-replace-this-sexp ()
"Eval and replace the current sexp.
@@ -137,9 +142,9 @@ On error go up list and try again."
(catch 'success
(while t
(ignore-errors
- (unless (looking-back ")")
+ (unless (looking-back ")" (line-beginning-position))
(error "Bad location"))
- (let ((sexp (preceding-sexp)))
+ (let ((sexp (tiny--preceding-sexp)))
(if (eq (car sexp) 'lambda)
(error "Lambda evaluates to itself")
(let ((value (eval sexp)))
@@ -169,8 +174,14 @@ Must throw an error when can't go up further."
Defaults are used in place of null values."
(let ((parsed (tiny-mapconcat-parse)))
(when parsed
- (let* ((n1 (or (nth 0 parsed) "0"))
- (s1 (or (nth 1 parsed) " "))
+ (let* ((n0 (or (nth 0 parsed) "0"))
+ (n1 (nth 1 parsed))
+ (s1 (cond ((null n1)
+ " ")
+ ((equal n1 "m")
+ "")
+ (t
+ n1)))
(n2 (nth 2 parsed))
(expr (or (nth 3 parsed) "x"))
(lexpr (read expr))
@@ -193,12 +204,12 @@ Defaults are used in place of null values."
(cdr tes)
" ")
")))(number-sequence %s %s) \"%s\")")))
- (unless (>= (read n1) (read n2))
+ (unless (>= (read n0) (read n2))
(format
format-expression
expr
(replace-regexp-in-string "\\\\n" "\n" fmt)
- n1
+ n0
n2
s1))))))
@@ -266,7 +277,8 @@ Return nil if nothing was matched, otherwise
(when (catch 'done
(cond
;; either start with a number
- ((looking-back "\\bm\\(-?[0-9]+\\)\\([^\n]*?\\)")
+ ((looking-back "\\bm\\(-?[0-9]+\\)\\([^\n]*?\\)"
+ (line-beginning-position))
(setq n1 (match-string-no-properties 1)
str (match-string-no-properties 2)
tiny-beg (match-beginning 0)
@@ -276,7 +288,8 @@ Return nil if nothing was matched, otherwise
n1 nil)
(throw 'done t)))
;; else capture the whole thing
- ((looking-back "\\bm\\([^%|\n]*[0-9][^\n]*\\)")
+ ((looking-back "\\bm\\([^%|\n]*[0-9][^\n]*\\)"
+ (line-beginning-position))
(setq str (match-string-no-properties 1)
tiny-beg (match-beginning 0)
tiny-end (match-end 0))
@@ -361,7 +374,7 @@ Return nil if nothing was matched, otherwise
(cond
;; general functionp
((not (eq t (help-function-arglist sym)))
- (setq expect-fun)
+ (setq expect-fun nil)
(setq allow-spc t)
;; (when (zerop n-paren) (push "(" out))
(unless (equal (car out) "(")
diff --git a/packages/tramp-theme/README b/packages/tramp-theme/README
new file mode 100644
index 0000000..093c1f0
--- /dev/null
+++ b/packages/tramp-theme/README
@@ -0,0 +1,11 @@
+This is a custom theme for remote buffers.
+
+It is not an own custom theme by itself. Rather, it is a custom
+theme to run on top of other custom themes. It shall be loaded
+always as the last custom theme, because it inherits existing
+settings.
+
+This custom theme extends `mode-line-buffer-identification' by the
+name of the remote host. It also allows to change faces according
+to the value of `default-directory' of a buffer. See
+`tramp-theme-face-remapping-alist' for customization options.
diff --git a/packages/tramp-theme/tramp-theme.el
b/packages/tramp-theme/tramp-theme.el
new file mode 100644
index 0000000..6da29a2
--- /dev/null
+++ b/packages/tramp-theme/tramp-theme.el
@@ -0,0 +1,172 @@
+;;; tramp-theme.el --- Custom theme for remote buffers
+
+;; Copyright (C) 2016 Free Software Foundation, Inc.
+
+;; Author: Michael Albinus <address@hidden>
+;; Keywords: convenience, faces
+;; Package: tramp-theme
+;; Version: 0.1.1
+;; Package-Requires: ((emacs "24.1"))
+
+;; This file is not part of GNU Emacs.
+
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This is not an own custom theme by itself. Rather, it is a custom
+;; theme to run on top of other custom themes. It shall be loaded
+;; always as the last custom theme, because it inherits existing
+;; settings.
+
+;; This custom theme extends `mode-line-buffer-identification' by the
+;; name of the remote host. It also allows to change faces according
+;; to the value of `default-directory' of a buffer. See
+;; `tramp-theme-face-remapping-alist' for customization options.
+
+;;; Code:
+
+;; This is needed for the customized variables.
+(require 'dired)
+(require 'em-dirs)
+
+(deftheme tramp
+ "A custom theme to decorate buffers when they are remote.
+It can be combined with other custom themes.")
+
+(defcustom tramp-theme-face-remapping-alist
+ `((nil "^root$"
+ (mode-line-buffer-id
+ (:inherit mode-line-buffer-id
+ :inverse-video
+ ;; If the face uses already :inverse-video, we deactivate it.
+ ;; Happens on displays of type 'tty, for example.
+ ,(null
+ (face-inverse-video-p
+ 'mode-line-buffer-id nil '(mode-line default)))))))
+ "Face remapping for decoration of a remote buffer.
+This is an alist of items (HOST USER REMAPPING-LIST). HOST and
+USER are regular expressions, or nil. REMAPPING-LIST must be an
+alist of face remappings as used by `face-remapping-alist'. If
+USER matches the remote user part of `default-directory', and
+HOST matches the remote host part of `default-directory',
+REMAPPING-LIST is applied to the current buffer.
+
+For instance, the following settings change the background color
+to \"Red\" for frames connected to the remote host \"foo\", it
+changes the background color to \"Green\" for frames connected to
+the remote host \"bar\", and it inverses the fringe face for
+frames using the remote user \"root\":
+
+ '((nil \"^root$\" (fringe (:inherit fringe :inverse-video t)))
+ (\"^foo$\" nil (default (:background \"Red\")))
+ (\"^bar$\" nil (default (:background \"Green\"))))
+
+Per default, `mode-line-buffer-identification' is displayed
+inverse for buffers which are editable with \"root\" permissions."
+ :group 'tramp
+ :type `(repeat (list (choice :tag "Host regexp" regexp (const nil))
+ (choice :tag "User regexp" regexp (const nil))
+ (list :tag "Face Remapping"
+ face (plist :value-type sexp)))))
+
+(defun tramp-theme-original-value (variable)
+ "Return the original value of VARIABLE before loading `tramp-theme'."
+ (let ((theme-value (get variable 'theme-value)))
+ (or (cdr (car (delete (assoc 'tramp theme-value) theme-value)))
+ (get variable 'tramp-theme-original-value))))
+
+(defun tramp-theme-mode-line-buffer-identification ()
+ "Return a list suitable for `mode-line-buffer-identification'.
+It indicates the remote host being used, if any."
+ (append
+ (when (custom-theme-enabled-p 'tramp)
+ (let ((host (file-remote-p default-directory 'host))
+ (user (file-remote-p default-directory 'user))
+ remapping-alist)
+ ;; Apply `tramp-theme-face-remapping-alist'.
+ (dolist (elt tramp-theme-face-remapping-alist)
+ (when (and (string-match (or (nth 0 elt) "") (or host ""))
+ (string-match (or (nth 1 elt) "") (or user "")))
+ (setq remapping-alist (cons (nth 2 elt) remapping-alist))))
+ (setq-local face-remapping-alist (nreverse remapping-alist))
+
+ ;; The extended string.
+ (when host
+ ;; Do not use FQDN.
+ (when (string-match "^[^0-9][^.]*\\(\\..*\\)" host)
+ (setq host (substring host 0 (match-beginning 1))))
+ (list
+ (propertize
+ (concat (propertize host 'help-echo (purecopy "Host name")) ": ")
+ 'face 'mode-line-buffer-id 'mouse-face 'mode-line-highlight)))))
+
+ ;; That's the original definition.
+ (tramp-theme-original-value 'mode-line-buffer-identification)))
+
+(defun tramp-theme-hook-function ()
+ "Modify `mode-line-buffer-indication'.
+Used in different hooks, in order to accelerate the redisplay."
+ (setq
+ mode-line-buffer-identification
+ (tramp-theme-mode-line-buffer-identification)))
+
+(unless (custom-theme-enabled-p 'tramp)
+ ;; Save the original value.
+ (unless (get 'mode-line-buffer-identification 'tramp-theme-original-value)
+ (put 'mode-line-buffer-identification
+ 'tramp-theme-original-value
+ mode-line-buffer-identification))
+
+ (custom-theme-set-variables
+ 'tramp
+ ;; Extend `mode-line-buffer-identification' by host name.
+ '(mode-line-buffer-identification
+ '(:eval (tramp-theme-mode-line-buffer-identification)))
+ ;; `dired-mode' overwrites `mode-line-buffer-identification'. We
+ ;; want to use our own extension.
+ '(dired-mode-hook
+ (cons
+ 'tramp-theme-hook-function
+ (delete 'tramp-theme-hook-function dired-mode-hook)))
+ ;; Redisplay doesn't happen immediately. So we trigger it via
+ ;; `find-file-hook' and `eshell-directory-change-hook'.
+ '(find-file-hook
+ (cons
+ 'tramp-theme-hook-function
+ (delete 'tramp-theme-hook-function find-file-hook)))
+ '(eshell-directory-change-hook
+ (cons
+ 'tramp-theme-hook-function
+ (delete 'tramp-theme-hook-function eshell-directory-change-hook)))))
+
+;;;###autoload
+(when load-file-name
+ (add-to-list
+ 'custom-theme-load-path
+ (file-name-as-directory (file-name-directory load-file-name))))
+
+(provide-theme 'tramp)
+
+;;; TODO:
+
+;; * Use a :type for `tramp-theme-face-remapping-alist' which allows
+;; to edit the faces. Maybe use (widget-get custom-face-edit :args)
+;; for this.
+
+;; Local Variables:
+;; no-byte-compile: t
+;; End:
+
+;;; tramp-theme.el ends here
diff --git a/packages/transcribe/transcribe.el
b/packages/transcribe/transcribe.el
new file mode 100644
index 0000000..684e505
--- /dev/null
+++ b/packages/transcribe/transcribe.el
@@ -0,0 +1,268 @@
+;;; transcribe.el --- Package for audio transcriptions
+
+;; Copyright 2014-2015 Free Software Foundation, Inc.
+
+;; Author: David Gonzalez Gandara <address@hidden>
+;; Version: 1.0.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:
+
+;; REQUIRES:
+;; -----------------------------
+;; This module works without any requires, but in order to use the audio
+;; functions, you need to install the emacs package "emms", by Joe Drew,
+;; and the external program "mpg321", by Jorgen Schafer and Ulrik Jensen,
+;; both under GPL licenses.
+;;
+;; USAGE:
+;; -------------------------
+;; Transcribe is a tool to make audio transcriptions. It allows the
+;; transcriber to control the audio easily while typing, as well as
+;; automate the insertion of xml tags, in case the transcription protocol
+;; include them.
+;; The analyse function will search for a specific structure
+;; of episodes that can be automatically added with the macro NewEpisode.
+;; The function expects the speech acts to be transcribed inside a turn xml
+;; tag with the identifier of the speaker with optional move attribute.
+;; Each speech act is spected inside a <l1> or <l2> tag, depending
+;; on the language used by the person. The attributes expected are the
+;; number of clauses that form the utterance, the number of errors the
+;; transcriber observes, and the function of the speech act. The parser will
+;; work even if some attributes are missing.
+;;
+;;
+;; AUDIO COMMANDS
+;; ------------------------------
+;; C-x C-p ------> Play audio file. You will be prompted for the name
+;; of the file. The recommended format is mp2.
+;; <f5> ---------> Pause or play audio.
+;; C-x <right> --> seek audio 10 seconds forward.
+;; C-x <left> --->seek audio 10 seconds backward.
+;; <f8> ---------> seek interactively: positive seconds go forward and
+;; negative seconds go backward
+;;
+;; XML TAGGING COMMANDS
+;; --------------------------------------------------
+;; C-x C-n ------> Create new episode structure. This is useful in case
your
+;; xml file structure requires it.
+;; <f2> ---------> Interactively insert a function attribute in a speech
act
+;; (l1 or l2) tag.
+;; <f3> ---------> Interactively insert a move attribute in a turn
(person) tag
+;; <f4> ---------> Interactively insert an attribute (any kind)
+;; <f9> ---------> Insert turn (person) tag. Inserts a move attribute.
+;; <f10> --------> Insert a custom tag. Edit the function to adapt to your
needs.
+;; <f11> --------> Insert speech act tag in L1, with clauses, errors and
function
+;; attributes.
+;; <f12> --------> Insert speech act tag in L2, with clauses, errors and
function
+;; attributes.
+;;
+;; AUTOMATIC PARSING
+;; -----------------------------------------------------
+;; C-x C-a ------> Analyses the text for measurments of performance.
+
+;;; Code:
+
+(if t (require 'emms-setup))
+;(require 'emms-player-mpd)
+;(setq emms-player-mpd-server-name "localhost")
+;(setq emms-player-mpd-server-port "6600")
+
+(emms-standard)
+(emms-default-players)
+(if t (require 'emms-player-mpg321-remote))
+(defvar emms-player-list)
+(push 'emms-player-mpg321-remote emms-player-list)
+
+(if t (require 'emms-mode-line))
+(emms-mode-line 1)
+(if t (require 'emms-playing-time))
+(emms-playing-time 1)
+
+(defvar transcribe-function-list '("initiating" "responding" "control"
"expresive" "interpersonal"))
+(defvar transcribe-move-list '("initiation" "response" "follow-up"))
+(defvar transcribe-attribute-list '("clauses" "errors" "function" "move"))
+;(append transcribe-attribute-list transcribe-function-list
transcribe-move-list)
+
+(defun transcribe-analyze-episode (episode person)
+ "This calls the external python package analyze_episodes2.py. The new
+ function transcribe-analyze implements its role now."
+ (interactive "sepisode: \nsperson:")
+ (shell-command (concat (expand-file-name "analyze_episodes2.py")
+ " -e " episode " -p " person " -i " buffer-file-name )))
+
+(defun transcribe-analyze (episodenumber personid)
+ "Extract from a given episode and person the number of asunits per
+ second produced, and the number of clauses per asunits, for L2 and L1."
+ (interactive "sepisodenumber: \nspersonid:")
+ (let* ((interventionsl2 '())
+ (interventionsl1 '())
+ (xml (xml-parse-region (point-min) (point-max)))
+ (results (car xml))
+ (episodes (xml-get-children results 'episode))
+ (asunitsl2 0.0000)
+ (asunitsl1 0.0000)
+ (shifts nil)
+ (clausesl1 0.0000)
+ (errorsl1 0.0000)
+ (clausesl2 0.0000)
+ (errorsl2 0.0000)
+ (duration nil)
+ (number nil))
+
+ (dolist (episode episodes)
+ (let*((numbernode (xml-get-children episode 'number)))
+
+ (setq number (nth 2 (car numbernode)))
+ (when (equal episodenumber number)
+ (let* ((durationnode (xml-get-children episode 'duration))
+ (transcription (xml-get-children episode 'transcription)))
+
+ (setq duration (nth 2 (car durationnode)))
+ (dolist (turn transcription)
+ (let* ((interventionnode (xml-get-children turn
+ (intern personid))))
+
+ (dolist (intervention interventionnode)
+ (let* ((l2node (xml-get-children intervention 'l2))
+ (l1node (xml-get-children intervention 'l1)))
+
+ (dolist (l2turn l2node)
+ (let* ((l2 (nth 2 l2turn))
+ (clausesl2node (nth 1 l2turn))
+ (clausesl2nodeinc (cdr (car clausesl2node))))
+
+ (when (not (equal clausesl2node nil))
+ (setq clausesl2 (+ clausesl2 (string-to-number
+ clausesl2nodeinc))))
+ (when (not (equal l2 nil))
+ (add-to-list 'interventionsl2 l2)
+ (setq asunitsl2 (1+ asunitsl2)))))
+ (dolist (l1turn l1node)
+ (let*((l1 (nth 2 l1turn))
+ (clausesl1node (nth 1 l1turn))
+ (clausesl1nodeinc (cdr (car clausesl1node))))
+
+ (when (not (equal clausesl1node nil))
+ (setq clausesl1 (+ clausesl1 (string-to-number
+ clausesl1nodeinc))))
+ (when (not (equal l1 nil))
+ (add-to-list 'interventionsl1 l1)
+ (setq asunitsl1 (1+ asunitsl1)))))))))))))
+ (reverse interventionsl2)
+ (reverse interventionsl1)
+ ;(print interventions) ;uncomment to display all the interventions on screen
+ (let((asunitspersecondl2 (/ asunitsl2 (string-to-number duration)))
+ (clausesperasunitl2 (/ clausesl2 asunitsl2))
+ (asunitspersecondl1 (/ asunitsl1 (string-to-number duration)))
+ (clausesperasunitl1 (/ clausesl1 asunitsl1)))
+
+ (princ (format "episode: %s, duration: %s, person: %s\n" episodenumber
duration personid))
+ (princ (format "L2(Asunits/second): %s, L2(clauses/Asunit): %s,
L1(Asunits/second): %s"
+ asunitspersecondl2 clausesperasunitl2 asunitspersecondl1)))))
+
+(defun transcribe-xml-tag-person (xmltag)
+ "This function allows the automatic insetion of a speaker xml tag and places
the cursor."
+ (interactive "stag:")
+ (insert (format "<%s move=\"\"></%s>" xmltag xmltag))
+ (backward-char 3)
+ (backward-char (string-width xmltag)))
+
+(defun transcribe-xml-tag (xmltag)
+ "This function allows the automatic insetion of a custom xml tag and places
the cursor."
+ (interactive "stag:")
+ (insert (format "<%s></%s>" xmltag xmltag))
+ (backward-char 3)
+ (backward-char (string-width xmltag)))
+
+(defun transcribe-region-xml-tag (xmltag)
+ "This function encapsulates the marked region in the given tag."
+ (interactive "stag:")
+ (let ((beginning (region-beginning))
+ (end (region-end)))
+ (goto-char beginning)
+ (insert (format "<%s>" xmltag))
+ (goto-char end)
+ (insert (format "</%s>" xmltag))))
+
+(defun transcribe-add-attribute (att val)
+ "Adds a xml attribute at cursor with the name and value specified
(autocompletion possible)"
+ (interactive (list(completing-read "attibute name:"
transcribe-attribute-list)(read-string "value:")))
+ (insert (format "%s=\"%s\"" att val)))
+
+(defun transcribe-add-attribute-function (val)
+ "Adds the xml attribute 'function' at cursor with the name specified
(autocompletion possible)"
+ (interactive (list(completing-read "function name:"
transcribe-function-list)))
+ (insert (format "function=\"%s\"" val)))
+
+(defun transcribe-add-attribute-move (val)
+ "Adds the xml attribute 'move' at cursor with the name specified
(autocompletion possible"
+ (interactive (list(completing-read "move name:" transcribe-move-list)))
+ (insert (format "move=\"%s\"" val)))
+
+(defun transcribe-xml-tag-l1 ()
+ "Inserts a l1 tag and places the cursor"
+ (interactive)
+ (insert "<l1 clauses=\"1\" errors=\"0\" function=\"\"></l1>")
+ (backward-char 5))
+
+(defun transcribe-xml-tag-l2 ()
+ "Inserts a l2 tag and places the cursor"
+ (interactive)
+ (insert "<l2 clauses=\"1\" errors=\"0\" function=\"\"></l2>")
+ (backward-char 5))
+
+(defun transcribe-xml-tag-break (xmltag)
+ "This function breaks an unit into two. That is, insert a closing and an
opening equal tags"
+ (interactive "stag:")
+ (insert (format "</%s><%s clauses=\"1\" errors=\"0\" function=\"\">" xmltag
xmltag)))
+
+(defun transcribe-display-audio-info ()
+ (interactive)
+ (emms-player-mpg321-remote-proc)
+ (shell-command "/usr/bin/mpg321 -R - &"))
+
+
+(fset 'NewEpisode
+
"<episode>\n<number>DATE-NUMBER</number>\n<duration></duration>\n<comment></comment>\n<subject>Subject
(level)</subject>\n<task>\n\t<role>low or high</role>\n<context>low or
high</context>\n<demand>low or
high</demand>\r</task>\n<auxiliar>Yes/no</auxiliar>\n<transcription>\n</transcription>\n</episode>");Inserts
a new episode structure
+
+;;;###autoload
+(define-minor-mode transcribe-mode
+ "Toggle transcribe-mode"
+ nil
+ " Trans"
+ '(([?\C-x ?\C-p] . emms-play-file)
+ ([?\C-x ?\C-a] . transcribe-analyze)
+ ([?\C-x ?\C-n] . NewEpisode)
+ ([?\C-x down] . emms-stop)
+ ([?\C-x right] . emms-seek-forward)
+ ([?\C-x left] . emms-seek-backward)
+
+ ([f2] . transcribe-add-attribute-function)
+ ([f3] . transcribe-add-attribute-move)
+ ([f4] . transcribe-add-attribute)
+
+ ([f5] . emms-pause)
+ ([f8] . emms-seek)
+
+ ([f9] . transcribe-xml-tag)
+ ([f10] . transcribe-xml-tag-person)
+ ([f11] . transcribe-xml-tag-l1)
+ ([f12] . transcribe-xml-tag-l2))
+)
+
+(provide 'transcribe)
+
+;;; transcribe.el ends here
diff --git a/packages/url-http-ntlm/url-http-ntlm.el
b/packages/url-http-ntlm/url-http-ntlm.el
new file mode 100644
index 0000000..92cbb4b
--- /dev/null
+++ b/packages/url-http-ntlm/url-http-ntlm.el
@@ -0,0 +1,316 @@
+;;; url-http-ntlm.el --- NTLM authentication for the url library
+
+;; Copyright (C) 2008, 2016 Free Software Foundation, Inc.
+
+;; Author: Tom Schutzer-Weissmann <address@hidden>
+;; Maintainer: Thomas Fitzsimmons <address@hidden>
+;; Version: 2.0.2
+;; Keywords: comm, data, processes, hypermedia
+;; Homepage: https://code.google.com/p/url-http-ntlm/
+;; Package-Requires: ((cl-lib "0.5") (ntlm "2.0.0"))
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; 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 provides a NTLM handler for the URL package.
+;;
+;; Installation:
+;;
+;; M-x package-install RET url-http-ntlm RET
+;;
+;; Acknowledgements:
+;;
+;; Taro Kawagishi <address@hidden> wrote ntlm.el and md4.el,
+;; which are parts of FLIM (Faithful Library about Internet Message).
+;;
+;; http://stuff.mit.edu/afs/sipb/contrib/emacs/packages/flim-1.14.7/ntlm.el
+;; http://stuff.mit.edu/afs/sipb/contrib/emacs/packages/flim-1.14.7/md4.el
+
+;;; Code:
+(require 'url-auth)
+(require 'url-http)
+(require 'url-util)
+(require 'mail-parse)
+(require 'cl-lib)
+(require 'ntlm)
+
+;; Remove authorization after redirect.
+(when (and (boundp 'emacs-major-version)
+ (< emacs-major-version 25))
+ (defvar url-http-ntlm--parsing-headers nil)
+ (defadvice url-http-parse-headers (around clear-authorization activate)
+ (let ((url-http-ntlm--parsing-headers t))
+ ad-do-it))
+ (defadvice url-http-handle-authentication (around clear-authorization
+ activate)
+ (let ((url-http-ntlm--parsing-headers nil))
+ ad-do-it))
+ (defadvice url-retrieve-internal (before clear-authorization activate)
+ (when (and url-http-ntlm--parsing-headers
+ (eq url-request-extra-headers url-http-extra-headers))
+ ;; This retrieval is presumably in response to a redirect.
+ ;; Do not automatically include an authorization header in the
+ ;; redirect. If needed it will be regenerated by the relevant
+ ;; auth scheme when the new request happens.
+ (setq url-http-extra-headers
+ (cl-remove "Authorization"
+ url-http-extra-headers :key #'car :test #'equal))
+ (setq url-request-extra-headers url-http-extra-headers))))
+
+
+;;; Private variables.
+(defvar url-http-ntlm--auth-storage nil
+ "Authentication storage.
+An alist that maps a server name to a pair of \(<username> <ntlm
+hashes>\).
+
+The hashes are built using `ntlm-get-password-hashes'.")
+
+(defvar url-http-ntlm--last-args nil
+ "The last `url-http-ntlm--get-stage' arguments and result.
+This is used to detect multiple calls.")
+(make-variable-buffer-local 'url-http-ntlm--last-args)
+
+(defvar url-http-ntlm--loop-timer-counter nil
+ "A hash table used to detect NTLM negotiation errors.
+Keys are urls, entries are (START-TIME . COUNTER).")
+
+(defvar url-http-ntlm--default-users nil
+ "An alist that stores one default username per server.")
+
+
+;;; Private functions.
+(defun url-http-ntlm--detect-loop (url)
+ "Detect potential infinite loop when NTLM fails on URL."
+ (when (not url-http-ntlm--loop-timer-counter)
+ (setq url-http-ntlm--loop-timer-counter (make-hash-table :test 'equal)))
+ (let* ((url-string (url-recreate-url url))
+ (last-entry (gethash url-string url-http-ntlm--loop-timer-counter))
+ (start-time (car last-entry))
+ (counter (cdr last-entry)))
+ (if last-entry
+ (progn
+ (if (< (- (float-time) start-time) 10.0)
+ (if (< counter 20)
+ ;; Still within time window, so increment count.
+ (puthash url-string (cons start-time (1+ counter))
+ url-http-ntlm--loop-timer-counter)
+ ;; Error detected, so remove entry and clear.
+ (url-http-ntlm--authorization url-string :clear)
+ (remhash url-string url-http-ntlm--loop-timer-counter)
+ (error
+ (format (concat "Access rate to %s is too high,"
+ " indicating an NTLM failure;"
+ " to debug, re-run with url-debug set to 1")
+ url-string)))
+ ;; Timeout expired, so reset counter.
+ (puthash url-string (cons (float-time) 0)
+ url-http-ntlm--loop-timer-counter)))
+ ;; New access, so initialize counter to 0.
+ (puthash url-string (cons (float-time) 0)
+ url-http-ntlm--loop-timer-counter))))
+
+(defun url-http-ntlm--ensure-user (url)
+ "Return URL with its user slot set.
+If URL's user slot is nil, set it to the last user that made a
+request to the host in URL's server slot."
+ (let ((new-url url))
+ (if (url-user new-url)
+ new-url
+ (setf (url-user new-url)
+ (cdr (assoc (url-host new-url) url-http-ntlm--default-users)))
+ new-url)))
+
+(defun url-http-ntlm--ensure-keepalive ()
+ "Report an error if `url-http-attempt-keepalives' is not set."
+ (cl-assert url-http-attempt-keepalives
+ nil
+ (concat "NTLM authentication won't work unless"
+ " `url-http-attempt-keepalives' is set!")))
+
+(defun url-http-ntlm--clean-headers ()
+ "Remove Authorization element from `url-http-extra-headers' alist."
+ (cl-declare (special url-http-extra-headers))
+ (setq url-http-extra-headers
+ (url-http-ntlm--rmssoc "Authorization" url-http-extra-headers)))
+
+(defun url-http-ntlm--get-stage (args)
+ "Determine what stage of the NTLM handshake we are at.
+PROMPT and ARGS come from `url-ntlm-auth''s caller,
+`url-get-authentication'. Their meaning depends on the current
+implementation - this function is well and truly coupled.
+
+url-get-authentication' calls `url-ntlm-auth' once when checking
+what authentication schemes are supported (PROMPT and ARGS are
+nil), and then twice for every stage of the handshake: the first
+time PROMPT is nil, the second, t; ARGS contains the server
+response's \"WWW-Authenticate\" header, munged by
+`url-parse-args'."
+ (cl-declare (special url-http-extra-headers))
+ (let* ((response-rxp "^NTLM TlRMTVNTUAADAAA")
+ (challenge-rxp "^TLRMTVNTUAACAAA")
+ (auth-header (assoc "Authorization" url-http-extra-headers))
+ (case-fold-search t)
+ stage)
+ (url-debug 'url-http-ntlm "Buffer: %s" (current-buffer))
+ (url-debug 'url-http-ntlm "Arguments: %s" args)
+ (url-debug 'url-http-ntlm "Previous arguments: %s"
url-http-ntlm--last-args)
+ (if (eq args (car url-http-ntlm--last-args))
+ ;; multiple calls, return the same argument we returned last time
+ (progn
+ (url-debug 'url-http-ntlm "Returning previous result: %s"
+ (cdr url-http-ntlm--last-args))
+ (cdr url-http-ntlm--last-args))
+ (let ((stage
+ (cond ((and auth-header (string-match response-rxp
+ (cdr auth-header)))
+ :error)
+ ((and (= (length args) 2)
+ (cl-destructuring-bind (challenge ntlm) args
+ (and (string-equal "ntlm" (car ntlm))
+ (string-match challenge-rxp
+ (car challenge)))))
+ :response)
+ (t
+ :request))))
+ (url-http-ntlm--clean-headers)
+ (setq url-http-ntlm--last-args (cons args stage))
+ stage))))
+
+(defun url-http-ntlm--authorization (url &optional clear realm)
+ "Get or clear NTLM authentication details for URL.
+If CLEAR is non-nil, clear any saved credentials for server.
+Otherwise, return the credentials, prompting the user if
+necessary. REALM appears in the prompt.
+
+If URL contains a username and a password, they are used and
+stored credentials are not affected."
+ (let* ((href (if (stringp url)
+ (url-generic-parse-url url)
+ url))
+ (type (url-type href))
+ (user (url-user href))
+ (server (url-host href))
+ (port (url-portspec href))
+ (pass (url-password href))
+ (stored (assoc (list type user server port)
+ url-http-ntlm--auth-storage))
+ (both (and user pass)))
+ (if clear
+ ;; clear
+ (unless both
+ (setq url-http-ntlm--default-users
+ (url-http-ntlm--rmssoc server url-http-ntlm--default-users))
+ (setq url-http-ntlm--auth-storage
+ (url-http-ntlm--rmssoc '(type user* server port)
+ url-http-ntlm--auth-storage))
+ nil)
+ ;; get
+ (if (or both
+ (and stored user (not (equal user (cl-second (car stored)))))
+ (not stored))
+ (let* ((user* (or user
+ (url-do-auth-source-search server type :user)
+ (read-string (url-auth-user-prompt url realm)
+ (or user (user-real-login-name)))))
+ (pass* (if both
+ pass
+ (or (url-do-auth-source-search server type :secret)
+ (read-passwd (format "Password [for %s]: "
+ (url-recreate-url url))))))
+ (key (list type user* server port))
+ (entry `(,key . (,(ntlm-get-password-hashes pass*)))))
+ (unless both
+ (setq url-http-ntlm--default-users
+ (cons
+ `(,server . ,user*)
+ (url-http-ntlm--rmssoc server
+ url-http-ntlm--default-users)))
+ (setq url-http-ntlm--auth-storage
+ (cons entry
+ (url-http-ntlm--rmssoc
+ key
+ url-http-ntlm--auth-storage))))
+ entry)
+ stored))))
+
+(defun url-http-ntlm--get-challenge ()
+ "Return the NTLM Type-2 message in the WWW-Authenticate header.
+Return nil if the NTLM Type-2 message is not present."
+ (save-restriction
+ (mail-narrow-to-head)
+ (let ((www-authenticate (mail-fetch-field "www-authenticate")))
+ (when (string-match "NTLM\\s-+\\(\\S-+\\)"
+ www-authenticate)
+ (base64-decode-string (match-string 1 www-authenticate))))))
+
+(defun url-http-ntlm--rmssoc (key alist)
+ "Remove all elements whose `car' match KEY from ALIST."
+ (cl-remove key alist :key 'car :test 'equal))
+
+(defun url-http-ntlm--string (data)
+ "Return DATA encoded as an NTLM string."
+ (concat "NTLM " (base64-encode-string data :nobreak)))
+
+
+;;; Public function called by `url-get-authentication'.
+;;;###autoload
+(defun url-ntlm-auth (url &optional prompt overwrite realm args)
+ "Return an NTLM HTTP authorization header.
+Get the contents of the Authorization header for a HTTP response
+using NTLM authentication, to access URL. Because NTLM is a
+two-step process, this function expects to be called twice, first
+to generate the NTLM type 1 message (request), then to respond to
+the server's type 2 message (challenge) with a suitable response.
+
+PROMPT, OVERWRITE, and REALM are ignored.
+
+ARGS is expected to contain the WWW-Authentication header from
+the server's last response. These are used by
+`url-http-get-stage' to determine what stage we are at."
+ (url-http-ntlm--ensure-keepalive)
+ (let* ((user-url (url-http-ntlm--ensure-user url))
+ (stage (url-http-ntlm--get-stage args)))
+ (url-debug 'url-http-ntlm "Stage: %s" stage)
+ (cl-case stage
+ ;; NTLM Type 1 message: the request
+ (:request
+ (url-http-ntlm--detect-loop user-url)
+ (cl-destructuring-bind (&optional key hash)
+ (url-http-ntlm--authorization user-url nil realm)
+ (when (cl-third key)
+ (url-http-ntlm--string
+ (ntlm-build-auth-request (cl-second key) (cl-third key))))))
+ ;; NTLM Type 3 message: the response
+ (:response
+ (url-http-ntlm--detect-loop user-url)
+ (let ((challenge (url-http-ntlm--get-challenge)))
+ (cl-destructuring-bind (key hash)
+ (url-http-ntlm--authorization user-url nil realm)
+ (url-http-ntlm--string
+ (ntlm-build-auth-response challenge
+ (cl-second key)
+ hash)))))
+ (:error
+ (url-http-ntlm--authorization user-url :clear)))))
+
+
+;;; Register `url-ntlm-auth' HTTP authentication method.
+;;;###autoload
+(url-register-auth-scheme "ntlm" nil 8)
+
+(provide 'url-http-ntlm)
+
+;;; url-http-ntlm.el ends here
diff --git a/packages/wcheck-mode/README.md b/packages/wcheck-mode/README.md
index 87b1784..c7b11d8 100644
--- a/packages/wcheck-mode/README.md
+++ b/packages/wcheck-mode/README.md
@@ -18,7 +18,7 @@ checking text. For example, Wcheck mode can be used with
spell-checker
programs such as Ispell, Enchant and Hunspell, but actually any tool
that can receive text from standard input stream and send text to
standard output can be used. Wcheck mode sends parts of buffer's content
-to an external program or an Emacs Lisp function and, based on their
+to an external program or an Emacs Lisp function and, relying on their
output, decides if some parts of text should be marked in the buffer.
[Emacs]: http://www.gnu.org/software/emacs/
@@ -91,10 +91,10 @@ checker.
Install
-------
-You can install Wcheck mode through [Marmalade][] or [Melpa][] package
-archive. Alternatively you can put `wcheck-mode.el` file to some
-directory in your Emacs's `load-path` and add the following lines to
-Emacs's initialization file (`~/.emacs` or `~/.emacs.d/init.el`):
+You can install Wcheck mode through [Melpa][] package archive.
+Alternatively you can put `wcheck-mode.el` file to some directory in
+your Emacs's `load-path` and add the following lines to Emacs's
+initialization file (`~/.emacs` or `~/.emacs.d/init.el`):
(autoload 'wcheck-mode "wcheck-mode"
"Toggle wcheck-mode." t)
@@ -107,8 +107,7 @@ Emacs's initialization file (`~/.emacs` or
`~/.emacs.d/init.el`):
(autoload 'wcheck-jump-backward "wcheck-mode"
"Move point backward to previous marked text area." t)
-[Marmalade]: http://marmalade-repo.org/
-[Melpa]: http://melpa.milkbox.net/
+[Melpa]: https://melpa.org/
Configuration and basic usage
@@ -337,7 +336,7 @@ branches and possibly merged to _master_ when they are
ready.
Copyright and license
---------------------
-Copyright (C) 2009-2014 Teemu Likonen <<address@hidden>>
+Copyright (C) 2009-2016 Free Software Foundation, Inc.
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
diff --git a/packages/wcheck-mode/wcheck-mode.el
b/packages/wcheck-mode/wcheck-mode.el
index ed46e78..ae7e917 100644
--- a/packages/wcheck-mode/wcheck-mode.el
+++ b/packages/wcheck-mode/wcheck-mode.el
@@ -1,13 +1,13 @@
;;; wcheck-mode.el --- General interface for text checkers
-;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2016 Free Software Foundation, Inc.
;; Author: Teemu Likonen <address@hidden>
;; Maintainer: Teemu Likonen <address@hidden>
;; Created: 2009-07-04
;; URL: https://github.com/tlikonen/wcheck-mode
;; Keywords: text spell check languages ispell
-;; Version: 2014.6.21
+;; Version: 2016.1.30
;; 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
@@ -58,7 +58,7 @@
;; actually any tool that can receive text from standard input stream
;; and send text to standard output can be used. Wcheck mode sends parts
;; of buffer's content to an external program or an Emacs Lisp function
-;; and, based on their output, decides if some parts of text should be
+;; and, relying on their output, decides if some parts of text should be
;; marked in the buffer.
;;; Code:
@@ -892,7 +892,7 @@ otherwise turn it off. If ARG is not given toggle the mode.
Wcheck is a minor mode for automatically checking and marking
strings in Emacs buffer. Wcheck sends (parts of) buffer's content
-to a text-checker back-end and, based on its output, decides if
+to a text-checker back-end and, relying on its output, decides if
some parts of text should be marked.
Wcheck can be used with external spell-checker programs such as
@@ -1388,7 +1388,10 @@ areas, including invisible ones. Otherwise skip
invisible text."
(when font-lock-mode
(save-excursion
- (jit-lock-fontify-now (min beg end) (max beg end))))
+ (funcall (if (fboundp 'font-lock-ensure)
+ #'font-lock-ensure
+ #'font-lock-fontify-region)
+ (min beg end) (max beg end))))
(wcheck--with-language-data
(language (wcheck--buffer-data-get :buffer buffer :language))
@@ -1415,7 +1418,7 @@ areas, including invisible ones. Otherwise skip invisible
text."
(match-beginning 1) 'invisible buffer
end)))
- ((and (eval face-p)
+ ((and (funcall face-p)
(or (equal regexp-discard "")
(not (string-match
regexp-discard
@@ -1475,7 +1478,7 @@ text."
(goto-char (next-single-char-property-change
(match-beginning 1) 'invisible buffer
end)))
- ((eval face-p)
+ ((funcall face-p)
;; Make an overlay.
(wcheck--make-overlay
buffer ol-face ol-mouse-face ol-help-echo ol-keymap
@@ -1933,16 +1936,18 @@ expression will return a boolean."
(mode (nth 1 face-settings))
(faces (nthcdr 2 face-settings)))
(cond ((not font-lock-mode)
- t)
+ (lambda () t))
((eq mode 'read)
- `(wcheck--face-found-p
- ',faces (wcheck--collect-faces
- (match-beginning 1) (match-end 1))))
+ `(lambda ()
+ (wcheck--face-found-p
+ ',faces (wcheck--collect-faces
+ (match-beginning 1) (match-end 1)))))
((eq mode 'skip)
- `(not (wcheck--face-found-p
- ',faces (wcheck--collect-faces
- (match-beginning 1) (match-end 1)))))
- (t t))))
+ `(lambda ()
+ (not (wcheck--face-found-p
+ ',faces (wcheck--collect-faces
+ (match-beginning 1) (match-end 1))))))
+ (t (lambda () t)))))
;;; Miscellaneous low-level functions
@@ -2057,8 +2062,7 @@ The returned value is a floating point number."
(high (nth 0 idle))
(low (nth 1 idle))
(micros (nth 2 idle)))
- (+ (* high
- (expt 2 16))
+ (+ (* high 65536)
low
(/ micros 1000000.0))))
@@ -2179,12 +2183,13 @@ But only if it doesn't exist already."
If optional TARGET-KEY is not given return all data associated
with the matching KEY VALUE."
(catch 'answer
- (dolist (item wcheck--buffer-data)
- (when (equal value (aref item (wcheck--buffer-data-key-index key)))
- (throw 'answer (if target-key
- (aref item (wcheck--buffer-data-key-index
- target-key))
- item))))))
+ (let ((index (wcheck--buffer-data-key-index key)))
+ (dolist (item wcheck--buffer-data)
+ (when (equal value (aref item index))
+ (throw 'answer (if target-key
+ (aref item (wcheck--buffer-data-key-index
+ target-key))
+ item)))))))
(defun wcheck--buffer-data-get-all (&optional key)
diff --git a/packages/wconf/.gitignore b/packages/wconf/.gitignore
new file mode 100644
index 0000000..c531d98
--- /dev/null
+++ b/packages/wconf/.gitignore
@@ -0,0 +1 @@
+*.elc
diff --git a/packages/wconf/README.org b/packages/wconf/README.org
new file mode 100644
index 0000000..a13d508
--- /dev/null
+++ b/packages/wconf/README.org
@@ -0,0 +1,108 @@
+* wconf
+** About
+=wconf= is a minimal window configuration manager for
[[http://www.gnu.org/software/emacs/][GNU Emacs]]. Its
+goal is to have several window configurations easily available, to
+switch between them, and to save them to disk and later restore them.
+
+For example, I might have a default "workspace" for miscellaneous stuff,
+and then I might have workspaces "UI", "MT", "DB" for a classic 3-tier
+application.
+
+Can double as a "boss" key; not that you would ever use something like
+that yourself.
+** Using the Package
+Make sure the files are in your =load-path=, and either =(require
+'wconf)= or make sure its autoloads are known to Emacs --- if you have
+installed from a package archive, that should take care of both.
+
+Here is an example from my configuration to show you the intended use of
+=wconf=.
+#+begin_src emacs-lisp
+(add-hook 'desktop-after-read-hook ;so we have all buffers again
+ (lambda ()
+ (wconf-load)
+ (wconf-switch-to-config 0)
+ (add-hook 'kill-emacs-hook
+ (lambda ()
+ (wconf-store-all)
+ (wconf-save))))
+ 'append)
+
+(global-set-key (kbd "C-c w s") #'wconf-store)
+(global-set-key (kbd "C-c w S") #'wconf-store-all)
+(global-set-key (kbd "C-c w r") #'wconf-restore)
+(global-set-key (kbd "C-c w R") #'wconf-restore-all)
+(global-set-key (kbd "C-c w w") #'wconf-switch-to-config)
+(global-set-key (kbd "C-<prior>") #'wconf-use-previous)
+(global-set-key (kbd "C-<next>") #'wconf-use-next)
+#+end_src
+After =desktop= has restored all file buffers from my last session,
+=wconf-load= will get its stored configs from =wconf-file= (defaults to
+=<YOUREMACSDIR>/wconf-window-configs.el=), and I want it to immediately
+switch to the first configuration. Then we hook into killing emacs to
+store and save all our configurations in that same file. The global key
+bindings expose those commands that I consider useful in day-to-day
+work.
+** Concepts
+The main idea is +stolen from+ inspired by =workgroups=. We keep a list
+of configuration pairs. Each such pair consists of an /active/
+configuration (what you see when you switch to this slot of the list),
+and a /stored/ one (what you have in the back, and maybe save to disk at
+some point). In =workgroups= parlance, these are the working and base
+configs.
+
+At each point in time there is (at most) one configuration current. You
+can explictly store and restore the current active configuration to/from
+the stored one, or do likewise for all configurations. For example, you
+might decide that you have a carefully hand-crafted set of
+configurations that you always want to start from, but that you do not
+wish to change this setup, except when doing so explicitly. That's
+easy: just remove the =(wconf-store-all)= call from the above hook
+function.
+
+A nice feature of =wconf= is that it does not alter any hooks or
+settings outside its own small world, and I intend to keep it that way.
+This implies that the currently active configuration is only updated
+explicitly, via one the functions/commands in the package.
+** Rationale, and Other Packages
+I used https://github.com/tlh/workgroups.el for several years. It is a
+great package, which offers a lot of additional features besides the
+core business of managing window configs. It also has some
+shortcomings, is somewhat complex (at 79k), and I occasionally
+experienced minor glitches. Most importantly, it has been unmaintained
+for roughly 4 years now.
+
+https://github.com/pashinin/workgroups2 promises to pick up where
+workgroups left, and is actively maintained. The main difference, as I
+understand it, is the desire to restore "special" buffers as well (help,
+info, org-mode agendas, notmuch mail, you name it). Finally trying it,
+it did not provide a lot of benefit for my personal needs, but added
+still more complexity. The functionality that I want should not require
+179k of elisp.
+
+Nowadays (at least since the GNU Emacs 24.4 release), there are proper
+lisp-reader (de)serializations for both frame and window configurations,
+and =window.el= and =frameset.el= provide functions to deal with them
+(relatively) comfortably. Desktop already (re)stores a single
+configuration. That's when I decided that it's time to roll my own:
+build something light on top of what's already there, in order to
+provide persistent switchable configurations.
+** Notes, TODO
+I only use a single fullscreen frame all the time. An earlier version
+of this package stored configurations as whole framesets, without any
+effort to deal with the multiple-frames case. It has now changed to
+deal with window configurations in a single frame only. This is much
+better defined, simpler, and no longer suffers from annoying flickering
+effects.
+
+Calling the package commands from different frames inside a single
+session may or may not result in the behavior you want. In the latter
+case, feel free to open an issue and describe what happens and what you
+expected/wanted to happen. I explicitly do /not/ guarantee that the
+code will change to suit your wishes --- but if minor changes could
+render it more generally useful, I am all ears.
+
+I am thinking about some rescaling options to deal with restoring on
+frames of different sizes (possible due to a different screen size).
+Filtering options for what is generally (re)stored (and how) might be a
+pleasant side effect. Don't hold your breath.
diff --git a/packages/wconf/wconf.el b/packages/wconf/wconf.el
new file mode 100644
index 0000000..57add63
--- /dev/null
+++ b/packages/wconf/wconf.el
@@ -0,0 +1,343 @@
+;;; wconf.el --- Minimal window layout manager -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
+
+;; Author: Ingo Lohmar <address@hidden>
+;; URL: https://github.com/ilohmar/wconf
+;; Version: 0.2.0
+;; Keywords: windows, frames, layout
+;; Package-Requires: ((emacs "24.4"))
+
+;; 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 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; See the file README.org
+
+;;; Code:
+
+(defgroup wconf nil
+ "Easily use several window configurations."
+ :group 'convenience)
+
+(defcustom wconf-change-config-function #'wconf-change-config-default
+ "Function called with current config whenever it is set."
+ :group 'wconf)
+
+(defcustom wconf-file (expand-file-name "wconf-window-configs.el"
+ user-emacs-directory)
+ "File used to save and load window configurations."
+ :group 'wconf)
+
+(defcustom wconf-fallback-buffer-name "*scratch*"
+ "Name of the buffer to substitute for buffers which are not available."
+ :group 'wconf)
+
+(defcustom wconf-no-configs-string "-----"
+ "String to use if there are no configurations at all."
+ :group 'wconf)
+
+(defcustom wconf-no-config-name "---"
+ "String to use for the empty window configuration."
+ :group 'wconf)
+
+;; internal variables and helper functions
+
+(defvar wconf--configs nil
+ "List of configurations; each item a list (active stored name).")
+
+(defvar wconf--index nil
+ "Index of currently shown configuration. After clean and load
+this can be nil although wconf--configs is not empty.")
+
+(defvar wconf-string nil
+ "String representing information on the current configuration.")
+
+(require 'cl-lib)
+
+(defsubst wconf--ensure-configs (&optional current)
+ (unless wconf--configs
+ (error "wconf: No window configurations"))
+ (when (and current (not wconf--index))
+ (error "wconf: No window configuration is currently used")))
+
+(defsubst wconf--ensure-index (&optional index)
+ (unless (<= 0 index (1- (length wconf--configs)))
+ (error "wconf: No window configuration index %s" index)))
+
+(defun wconf--current-config ()
+ (window-state-get (frame-root-window (selected-frame))
+ 'writable))
+
+(defun wconf- (index)
+ (nth index wconf--configs))
+
+(defun wconf--to-string (index)
+ (if index
+ (format "%s:%s"
+ (number-to-string index)
+ (cl-caddr (wconf- index)))
+ (concat "-:" wconf-no-config-name)))
+
+(defun wconf--update-info ()
+ (when (functionp wconf-change-config-function)
+ (funcall wconf-change-config-function
+ ;; both will be nil if no list
+ wconf--index
+ (and wconf--index
+ (car (wconf- wconf--index))))))
+
+(defun wconf--update-active-config ()
+ (when wconf--index
+ (setf (car (wconf- wconf--index)) (wconf--current-config))))
+
+(defun wconf--use-config (index)
+ (setq wconf--index index)
+ (window-state-put (car (wconf- wconf--index))
+ (frame-root-window (selected-frame))
+ 'safe)
+ (wconf--update-info))
+
+(defun wconf--reset ()
+ "Remove all configurations."
+ (setq wconf--configs nil)
+ (setq wconf--index nil)
+ (wconf--update-info))
+
+(defun wconf--copy (wc)
+ "Return a deep copy of WC, using `copy-tree'."
+ (copy-tree wc t))
+
+;; global stuff
+
+(defun wconf-change-config-default (index config)
+ "Update `wconf-string' to represent configuration CONFIG at
+position INDEX."
+ (setq wconf-string (if wconf--configs
+ (wconf--to-string index)
+ wconf-no-configs-string))
+ (force-mode-line-update))
+
+(defun wconf-save (&optional filename)
+ "Save stored configurations in FILENAME, defaults to
+`wconf-file'."
+ (interactive "F")
+ (let ((filename (or filename wconf-file)))
+ (with-temp-file filename
+ (prin1 (mapcar #'cdr wconf--configs) ;-> (wc name)
+ (current-buffer)))
+ (message "wconf: Save stored configurations in %s" filename)))
+
+(defun wconf--sanitize-buffer (b)
+ (unless (get-buffer (cadr b))
+ (setf (cadr b) wconf-fallback-buffer-name
+ (cdr (assoc 'start b)) 1
+ (cdr (assoc 'point b)) 1
+ (cdr (assoc 'dedicated b)) nil)))
+
+(defun wconf--sanitize-window-tree (node)
+ (let ((buf (assoc 'buffer node)))
+ (if buf ;in a leaf already
+ (wconf--sanitize-buffer buf)
+ (mapc (lambda (x)
+ (when (and (consp x)
+ (memq (car x) '(leaf vc hc)))
+ (wconf--sanitize-window-tree (cdr x))))
+ node))))
+
+;;;###autoload
+(defun wconf-load (&optional filename)
+ "Load stored configurations from FILENAME, defaults to
+`wconf-file'."
+ (interactive "f")
+ (let ((filename (or filename wconf-file)))
+ (unless (file-readable-p filename)
+ (error "wconf: Cannot read file %s" filename))
+ (wconf--reset)
+ (with-temp-buffer
+ (insert-file-contents filename)
+ (goto-char (point-min))
+ (setq wconf--configs
+ (mapcar
+ (lambda (f) ;(wc name)
+ (wconf--sanitize-window-tree (car f))
+ (cons (wconf--copy (car f)) f))
+ (read (current-buffer)))))
+ (message "wconf: Load stored configurations from %s" filename))
+ (wconf--update-info))
+
+;; these functions affect the whole list of configs
+
+;;;###autoload
+(defun wconf-create (&optional new)
+ "Clone the current configuration or create a new \"empty\" one.
+The new configuration is appended to the list and becomes active.
+
+With optional prefix argument NEW, or if there are no
+configurations yet, create a new configuration from the current
+window config."
+ (interactive "P")
+ (wconf--update-active-config)
+ (setq wconf--configs
+ (append wconf--configs
+ (list
+ (if (or new (not wconf--configs))
+ (progn
+ (message "wconf: Created new configuration %s"
+ (length wconf--configs))
+ (list (wconf--current-config)
+ (wconf--current-config)
+ "new"))
+ (wconf--ensure-configs 'current)
+ (let ((wc (wconf- wconf--index)))
+ (message "wconf: Cloned configuration %s"
+ (wconf--to-string wconf--index))
+ (list (wconf--copy (car wc))
+ (wconf--copy (cadr wc))
+ (cl-caddr wc)))))))
+ (wconf--use-config (1- (length wconf--configs))))
+
+(defun wconf-kill ()
+ "Kill current configuration."
+ (interactive)
+ (wconf--ensure-configs 'current)
+ (let ((old-string (wconf--to-string wconf--index)))
+ (setq wconf--configs
+ (append (butlast wconf--configs
+ (- (length wconf--configs) wconf--index))
+ (last wconf--configs
+ (- (length wconf--configs) wconf--index 1))))
+ (if wconf--configs
+ (wconf--use-config (if (< (1- (length wconf--configs)) wconf--index)
+ (1- wconf--index)
+ wconf--index))
+ (wconf--reset)
+ (wconf--update-info))
+ (message "wconf: Killed configuration %s" old-string)))
+
+(defun wconf-swap (i j)
+ "Swap configurations at positions I and J."
+ (interactive
+ (progn
+ (wconf--ensure-configs 'current) ;interactive? then want current config
+ (list
+ wconf--index
+ (read-number "Swap current config with index: "))))
+ (wconf--ensure-configs)
+ (wconf--ensure-index i)
+ (wconf--ensure-index j)
+ (wconf--update-active-config)
+ (let ((wc (wconf- i)))
+ (setf (nth i wconf--configs) (wconf- j))
+ (setf (nth j wconf--configs) wc))
+ (when (memq wconf--index (list i j))
+ (wconf--use-config wconf--index))
+ (message "wconf: Swapped configurations %s and %s"
+ (number-to-string i) (number-to-string j)))
+
+;; manipulate single config
+
+(defun wconf-rename (name)
+ "Rename current configuration to NAME."
+ (interactive
+ (progn
+ (wconf--ensure-configs 'current)
+ (list
+ (read-string "New window configuration name: "
+ (cl-caddr (wconf- wconf--index))))))
+ (wconf--ensure-configs 'current)
+ (setf (cl-caddr (wconf- wconf--index)) name)
+ (message "wconf: Renamed configuration to \"%s\"" name)
+ (wconf--update-info))
+
+;; interaction b/w stored and active configs
+
+;; these commands only make sense when there are wconf--configs, and
+;; after wconf--index has become non-nil
+
+(defsubst wconf--store (wc)
+ (setf (cadr wc) (wconf--copy (car wc))))
+
+(defsubst wconf--restore (wc)
+ (setf (car wc) (wconf--copy (cadr wc))))
+
+(defun wconf-store ()
+ "Store currently active configuration."
+ (interactive)
+ (wconf--ensure-configs 'current)
+ (wconf--update-active-config)
+ (wconf--store (wconf- wconf--index))
+ (message "wconf: Stored configuration %s" (wconf--to-string wconf--index)))
+
+(defun wconf-store-all ()
+ "Store all active configurations."
+ (interactive)
+ (wconf--ensure-configs 'current)
+ (wconf--update-active-config)
+ (mapc #'wconf--store wconf--configs)
+ (message "wconf: Stored all configurations"))
+
+(defun wconf-restore ()
+ "Restore stored configuration."
+ (interactive)
+ (wconf--ensure-configs 'current)
+ (wconf--restore (wconf- wconf--index))
+ (wconf--use-config wconf--index)
+ (message "wconf: Restored configuration %s" (wconf--to-string wconf--index)))
+
+(defun wconf-restore-all ()
+ "Restore all stored configurations."
+ (interactive)
+ (wconf--ensure-configs 'current)
+ (mapc #'wconf--restore wconf--configs)
+ (wconf--use-config wconf--index)
+ (message "wconf: Restored all configurations"))
+
+;; change config
+
+(defun wconf-switch-to-config (index &optional force)
+ "Change to current config INDEX."
+ (interactive "P")
+ (wconf--ensure-configs)
+ (let ((index (or index
+ (read-number "Switch to config number: "))))
+ (wconf--ensure-index index)
+ ;; remember active config (w/o name etc)
+ (wconf--update-active-config)
+ ;; maybe use new configuration
+ (if (and (eq wconf--index index)
+ (not force))
+ (message "wconf: Nothing to do")
+ (wconf--use-config index)
+ (message "wconf: Switched to configuration %s"
+ (wconf--to-string index)))))
+
+(defun wconf-use-previous ()
+ "Switch to previous window configuration."
+ (interactive)
+ (wconf--ensure-configs)
+ (wconf-switch-to-config (mod (1- (or wconf--index 1))
+ (length wconf--configs))))
+
+(defun wconf-use-next ()
+ "Switch to next window configuration."
+ (interactive)
+ (wconf--ensure-configs)
+ (wconf-switch-to-config (mod (1+ (or wconf--index -1))
+ (length wconf--configs))))
+
+(provide 'wconf)
+;;; wconf.el ends here
diff --git a/packages/websocket/websocket.el b/packages/websocket/websocket.el
index 969e70b..1b0b294 100644
--- a/packages/websocket/websocket.el
+++ b/packages/websocket/websocket.el
@@ -1,11 +1,10 @@
;;; websocket.el --- Emacs WebSocket client and server
-;; Copyright (c) 2013 Free Software Foundation, Inc.
+;; Copyright (c) 2013, 2016 Free Software Foundation, Inc.
-;; Author: Andrew Hyatt <ahyatt at gmail dot com>
-;; Maintainer: Andrew Hyatt <ahyatt at gmail dot com>
+;; Author: Andrew Hyatt <address@hidden>
;; Keywords: Communication, Websocket, Server
-;; Version: 1.3
+;; Version: 1.5
;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
@@ -45,6 +44,7 @@
(require 'bindat)
(require 'url-parse)
+(require 'url-cookie)
(eval-when-compile (require 'cl))
;;; Code:
@@ -99,7 +99,7 @@ same for the protocols.
accept-string
(inflight-input nil))
-(defvar websocket-version "1.3"
+(defvar websocket-version "1.5"
"Version numbers of this version of websocket.el.")
(defvar websocket-debug nil
@@ -235,7 +235,11 @@ approximately 537M long."
(if (= nbytes 8)
(progn
(let ((hi-32bits (lsh val -32))
- (low-32bits (logand #xffffffff val)))
+ ;; Test for systems that don't have > 32 bits, and
+ ;; for those systems just return the value.
+ (low-32bits (if (= 0 (expt 2 32))
+ val
+ (logand #xffffffff val))))
(when (or (> hi-32bits 0) (> (lsh low-32bits -29) 0))
(signal 'websocket-frame-too-large val))
(bindat-pack `((:val vec 2 u32))
@@ -296,35 +300,40 @@ We mask the frame or not, depending on SHOULD-MASK."
(let* ((opcode (websocket-frame-opcode frame))
(payload (websocket-frame-payload frame))
(fin (websocket-frame-completep frame))
- (payloadp (memq opcode '(continuation text binary)))
+ (payloadp (and payload
+ (memq opcode '(continuation ping pong text binary))))
(mask-key (when should-mask (websocket-genbytes 4))))
(apply 'unibyte-string
- (append (list
- (logior (cond ((eq opcode 'continuation) 0)
- ((eq opcode 'text) 1)
- ((eq opcode 'binary) 2)
- ((eq opcode 'close) 8)
- ((eq opcode 'ping) 9)
- ((eq opcode 'pong) 10))
- (if fin 128 0)))
- (when payloadp
- (list
- (logior
- (if should-mask 128 0)
- (cond ((< (length payload) 126) (length payload))
- ((< (length payload) 65536) 126)
- (t 127)))))
- (when (and payloadp (>= (length payload) 126))
- (append (websocket-to-bytes (length payload)
- (cond ((< (length payload) 126) 1)
- ((< (length payload) 65536) 2)
- (t 8))) nil))
- (when (and payloadp should-mask)
- (append mask-key nil))
- (when payloadp
- (append (if should-mask (websocket-mask mask-key payload)
- payload)
- nil))))))
+ (let ((val (append (list
+ (logior (cond ((eq opcode 'continuation) 0)
+ ((eq opcode 'text) 1)
+ ((eq opcode 'binary) 2)
+ ((eq opcode 'close) 8)
+ ((eq opcode 'ping) 9)
+ ((eq opcode 'pong) 10))
+ (if fin 128 0)))
+ (when payloadp
+ (list
+ (logior
+ (if should-mask 128 0)
+ (cond ((< (length payload) 126) (length
payload))
+ ((< (length payload) 65536) 126)
+ (t 127)))))
+ (when (and payloadp (>= (length payload) 126))
+ (append (websocket-to-bytes
+ (length payload)
+ (cond ((< (length payload) 126) 1)
+ ((< (length payload) 65536) 2)
+ (t 8))) nil))
+ (when (and payloadp should-mask)
+ (append mask-key nil))
+ (when payloadp
+ (append (if should-mask (websocket-mask mask-key
payload)
+ payload)
+ nil)))))
+ ;; We have to make sure the non-payload data is a full 32-bit
frame
+ (if (= 1 (length val))
+ (append val '(0)) val)))))
(defun websocket-read-frame (s)
"Read from string S a `websocket-frame' struct with the contents.
@@ -334,7 +343,7 @@ the frame finishes. If the frame is not completed, return
NIL."
(websocket-ensure-length s 1)
(let* ((opcode (websocket-get-opcode s))
(fin (logand 128 (websocket-get-bytes s 1)))
- (payloadp (memq opcode '(continuation text binary)))
+ (payloadp (memq opcode '(continuation text binary ping pong)))
(payload-len (when payloadp
(websocket-get-payload-len (substring s 1))))
(maskp (and
@@ -475,7 +484,10 @@ has connection termination."
lex-ws lex-frame)))
((eq opcode 'ping)
(lambda () (websocket-send lex-ws
- (make-websocket-frame :opcode 'pong
:completep t))))
+ (make-websocket-frame
+ :opcode 'pong
+ :payload (websocket-frame-payload
lex-frame)
+ :completep t))))
((eq opcode 'close)
(lambda () (delete-process (websocket-conn lex-ws))))
(t (lambda ()))))))
@@ -506,10 +518,16 @@ has connection termination."
(defun websocket-check (frame)
"Check FRAME for correctness, returning true if correct."
- (and (equal (not (memq (websocket-frame-opcode frame)
- '(continuation text binary)))
- (and (not (websocket-frame-payload frame))
- (websocket-frame-completep frame)))))
+ (or
+ ;; Text, binary, and continuation frames need payloads
+ (and (memq (websocket-frame-opcode frame) '(text binary continuation))
+ (websocket-frame-payload frame))
+ ;; Pings and pongs may optionally have them
+ (memq (websocket-frame-opcode frame) '(ping pong))
+ ;; And close shouldn't have any payload, and should always be complete.
+ (and (eq (websocket-frame-opcode frame) 'close)
+ (not (websocket-frame-payload frame))
+ (websocket-frame-completep frame))))
(defun websocket-send (websocket frame)
"To the WEBSOCKET server, send the FRAME.
@@ -593,6 +611,11 @@ The parameter strings are of the form \"key=value\" or
\"value\".
EXTENSIONS can be NIL if none are in use. An example value would
be '(\"deflate-stream\" . (\"mux\" \"max-channels=4\")).
+Cookies that are set via `url-cookie-store' will be used during
+communication with the server, and cookies received from the
+server will be stored in the same cookie storage that the
+`url-cookie' package uses.
+
Optionally you can specify
ON-OPEN, ON-MESSAGE and ON-CLOSE callbacks as well.
@@ -703,6 +726,14 @@ describing the problem with the frame.
(websocket-debug websocket "Websocket opened")
websocket))
+(defun websocket-process-headers (url headers)
+ "On opening URL, process the HEADERS sent from the server."
+ (when (string-match "Set-Cookie: \(.*\)\r\n" headers)
+ ;; The url-current-object is assumed to be set by
+ ;; url-cookie-handle-set-cookie.
+ (let ((url-current-object (url-generic-parse-url url)))
+ (url-cookie-handle-set-cookie (match-string 1 headers)))))
+
(defun websocket-outer-filter (websocket output)
"Filter the WEBSOCKET server's OUTPUT.
This will parse headers and process frames repeatedly until there
@@ -721,7 +752,8 @@ connection is invalid, the connection will be closed."
(condition-case err
(progn
(websocket-verify-response-code text)
- (websocket-verify-headers websocket text))
+ (websocket-verify-headers websocket text)
+ (websocket-process-headers (websocket-url websocket) text))
(error
(websocket-close websocket)
(signal (car err) (cdr err))))
@@ -852,30 +884,40 @@ connection, which should be kept in order to pass to
(defun websocket-create-headers (url key protocol extensions)
"Create connections headers for the given URL, KEY, PROTOCOL and EXTENSIONS.
These are defined as in `websocket-open'."
- (format (concat "Host: %s\r\n"
- "Upgrade: websocket\r\n"
- "Connection: Upgrade\r\n"
- "Sec-WebSocket-Key: %s\r\n"
- "Sec-WebSocket-Version: 13\r\n"
- (when protocol
- (concat
- (mapconcat (lambda (protocol)
- (format "Sec-WebSocket-Protocol: %s"
protocol))
- protocol "\r\n")
- "\r\n"))
- (when extensions
- (format "Sec-WebSocket-Extensions: %s\r\n"
- (mapconcat
- (lambda (ext)
- (concat (car ext)
- (when (cdr ext) "; ")
- (when (cdr ext)
- (mapconcat 'identity (cdr ext) ";
"))))
- extensions ", ")))
- "\r\n")
- (url-host (url-generic-parse-url url))
- key
- protocol))
+ (let* ((parsed-url (url-generic-parse-url url))
+ (host-port (if (url-port-if-non-default parsed-url)
+ (format "%s:%s" (url-host parsed-url) (url-port
parsed-url))
+ (url-host parsed-url)))
+ (cookie-header (url-cookie-generate-header-lines
+ host-port (car (url-path-and-query parsed-url))
+ (equal (url-type parsed-url) "wss"))))
+ (format (concat "Host: %s\r\n"
+ "Upgrade: websocket\r\n"
+ "Connection: Upgrade\r\n"
+ "Sec-WebSocket-Key: %s\r\n"
+ "Sec-WebSocket-Version: 13\r\n"
+ (when protocol
+ (concat
+ (mapconcat
+ (lambda (protocol)
+ (format "Sec-WebSocket-Protocol: %s" protocol))
+ protocol "\r\n")
+ "\r\n"))
+ (when extensions
+ (format "Sec-WebSocket-Extensions: %s\r\n"
+ (mapconcat
+ (lambda (ext)
+ (concat
+ (car ext)
+ (when (cdr ext) "; ")
+ (when (cdr ext)
+ (mapconcat 'identity (cdr ext) "; "))))
+ extensions ", ")))
+ (when cookie-header cookie-header)
+ "\r\n")
+ host-port
+ key
+ protocol)))
(defun websocket-get-server-response (websocket client-protocols
client-extensions)
"Get the websocket response from client WEBSOCKET."
diff --git a/packages/wisi/NEWS b/packages/wisi/NEWS
old mode 100755
new mode 100644
index 3385ac6..9e8ad77
--- a/packages/wisi/NEWS
+++ b/packages/wisi/NEWS
@@ -7,6 +7,25 @@ Please send wisi bug reports to address@hidden, with
'wisi' in the subject. If possible, use M-x report-emacs-bug.
+* wisi 1.1.2
+20 Jan 2016
+
+** wisi-compile no longer requires semantic.
+
+** wisi-parse slightly faster
+
+** minor bug fixes
+
+** wisi-extend-action now takes two args (first last)
+
+** wisi-face-action-1 optional arg no-override is replaced by
override-no-error.
+
+* wisi 1.1.1
+10 Apr 2015
+
+** rename wisi-font-lock-size-threshold to wisi-size-threshold, use
+ for more things in ada-mode
+
* wisi 1.1.0
18 Nov 2014
@@ -19,6 +38,8 @@ Please send wisi bug reports to address@hidden, with
** change wisi-*-action to take a vector of arguments; faster for
external parser, catches more errors.
+** add wisi-font-lock-size-threshold
+
* wisi 1.0.6
28 Sep 2014
diff --git a/packages/wisi/README b/packages/wisi/README
old mode 100755
new mode 100644
index 72380ae..098b476
--- a/packages/wisi/README
+++ b/packages/wisi/README
@@ -1,4 +1,4 @@
-Emacs wisi package 1.1.0
+Emacs wisi package 1.1.2
The wisi package provides utilities for using generalized LALR parsers
to do indentation and navigation. See ada-mode for an example of its
diff --git a/packages/wisi/wisi-compat-24.2.el
b/packages/wisi/wisi-compat-24.2.el
old mode 100755
new mode 100644
index e4300d7..03bae80
--- a/packages/wisi/wisi-compat-24.2.el
+++ b/packages/wisi/wisi-compat-24.2.el
@@ -1,6 +1,6 @@
-;;; wisi-compat-24.2.el --- Implement current Emacs features not present in
Emacs 24.2
+;;; wisi-compat-24.2.el --- Implement current Emacs features not present in
Emacs 24.2 -*- lexical-binding:t -*-
-;; Copyright (C) 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -31,5 +31,4 @@ buffer-local wherever it is set."
)
(provide 'wisi-compat-24.2)
-
-;; end of file
+;;; wisi-compat-24.2.el ends here
diff --git a/packages/wisi/wisi-compile.el b/packages/wisi/wisi-compile.el
old mode 100755
new mode 100644
index a17b7f6..b70a1ae
--- a/packages/wisi/wisi-compile.el
+++ b/packages/wisi/wisi-compile.el
@@ -1,6 +1,6 @@
-;;; Grammar compiler for the wisent LALR parser, integrating Wisi OpenToken
output.
+;; wisi-compile.el --- Grammar compiler for the wisi parser, integrating Wisi
OpenToken output. -*- lexical-binding:t -*-
;;
-;; Copyright (C) 2012, 2013 Free Software Foundation, Inc.
+;; Copyright (C) 2012, 2013, 2015, 2016 Free Software Foundation, Inc.
;;
;; Author: Stephen Leake <address@hidden>
;;
@@ -19,20 +19,24 @@
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;
-;;; History: first experimental version Jan 2013
+
+;;; Commentary:
+;;
+
+;;;; History: first experimental version Jan 2013
;;
-;;; Context
+;;;; Context
;;
;; Semantic (info "(semantic)Top") provides an LALR(1) parser
-;; wisent-parse. The grammar used is defined by the functions
+;; wisent-parse. The grammar used is defined by the functions
;; semantic-grammar-create-package, which reads a bison-like source
;; file and produces corresponding elisp source, and
;; wisent-compile-grammar, which generates a parser table.
;;
;; However, the algorithm used in wisent-compile-grammar cannot cope
;; with the grammar for the Ada language, because it is not
-;; LALR(1). So we provide a generalized LALR parser, which spawns
-;; parallel LALR parsers at each conflict. Instead of also rewriting
+;; LALR(1). So we provide a generalized LALR parser, which spawns
+;; parallel LALR parsers at each conflict. Instead of also rewriting
;; the entire semantic grammar compiler, we use the OpenToken LALR
;; parser generator, which is easier to modify (it is written in Ada,
;; not Lisp).
@@ -41,42 +45,40 @@
;; produces corresponding elisp source code, similar to that
;; produced by semantic-grammar-create-package.
;;
-;; wisi-compile-grammar (provided here) generate the automaton
-;; structure required by wisi-parse, using functions from
-;; wisent/comp.el
+;; wisi-compile-grammar (provided here) generates the automaton
+;; structure required by wisi-parse
;;
;;;;
-(eval-when-compile
- ;; can't just 'require'; `wisent-with-context' doesn't work.
- ;; also can't load .elc; must load .el or .el.gz
- (let ((file (locate-library "semantic/wisent/comp.el")))
- (if file
- (load file)
- (error "source library semantic/wisent/comp.el not installed; install
emacs lisp sources"))))
-
-(eval-and-compile
- (require 'semantic/wisent/comp))
-
-(defun wisi-compose-action (value symbol-array nonterms)
- (let ((symbol (intern-soft (format "%s:%d" (car value) (cdr value))
symbol-array))
- (prod (car (nth (cdr value) (cdr (assoc (car value) nonterms))))))
- (if symbol
- (list (car value) symbol (length prod))
- (error "%s not in symbol-array" symbol))))
-
-(defun wisi-replace-actions (action symbol-array nonterms)
+(defun wisi-compose-action (value symbol-obarray nonterms)
+ (let* ((nonterm (car value))
+ (index (cdr value))
+ (symbol (intern-soft (format "%s:%d" nonterm index) symbol-obarray))
+ (rhs (car (nth index (cdr (assoc nonterm nonterms))))))
+ (list nonterm symbol (length rhs))
+ ))
+
+(defun wisi-replace-actions (action symbol-obarray nonterms)
"Replace semantic action symbol names in ACTION with list as defined in
`wisi-compile-grammar'.
-ACTION is the alist for one state from the grammar; NONTERMS is from the
grammar.
-Return the new alist."
- ;; result is (nonterm index action-symbol token-count)
+ACTION is the alist for one state from the grammar, with the form:
+ ((default . error) ITEM ... )
+ITEM is one of:
+reduction (TOKEN . (NONTERM . INDEX)) where NONTERM . INDEX gives the action
symbol name.
+shift (TOKEN . STATE)
+shift/reduce conflict (STATE (NONTERM . INDEX))
+reduce/shift conflict ((NONTERM . INDEX) (NONTERM . INDEX))
+
+SYMBOL-OBARRAY contains the action symbols.
+NONTERMS is from the grammar.
+Return the new action alist."
+ ;; result is list of (nonterm index action-symbol token-count)
(let (result item)
(while action
(setq item (pop action))
(cond
((or
(memq (cdr item) '(error accept))
- (numberp (cdr item)))
+ (numberp (cdr item))) ;; shift
(push item result))
((listp (cdr item))
@@ -85,27 +87,20 @@ Return the new alist."
((symbolp (car value))
;; reduction
(push (cons (car item)
- (wisi-compose-action value symbol-array nonterms))
+ (wisi-compose-action value symbol-obarray nonterms))
result))
((integerp (car value))
;; shift/reduce conflict
(push (cons (car item)
(list (car value)
- (wisi-compose-action (cadr value) symbol-array
nonterms)))
- result))
-
- ((integerp (cadr value))
- ;; reduce/shift conflict
- (push (cons (car item)
- (list (wisi-compose-action (car value) symbol-array
nonterms)
- (cadr value)))
+ (wisi-compose-action (cadr value) symbol-obarray
nonterms)))
result))
(t ;; reduce/reduce conflict
(push (cons (car item)
- (list (wisi-compose-action (car value) symbol-array
nonterms)
- (wisi-compose-action (cadr value) symbol-array
nonterms)))
+ (list (wisi-compose-action (car value) symbol-obarray
nonterms)
+ (wisi-compose-action (cadr value) symbol-obarray
nonterms)))
result))
)))
@@ -115,33 +110,25 @@ Return the new alist."
(reverse result)))
-(defun wisi-semantic-action (r rcode tags rlhs)
- "Define an Elisp function for semantic action at rule R.
-On entry RCODE[R] contains a vector [BODY N (NTERM I)] where BODY
-is the body of the semantic action, N is the number of tokens in
-the production, NTERM is the nonterminal the semantic action
-belongs to, and I is the index of the production and associated
-semantic action in the NTERM rule. Returns the semantic action
-symbol, which is interned in RCODE[0].
-
-The semantic action function accepts one argument, the list of
-tokens to be reduced. It returns nil; it is called for the user
-side-effects only."
+(defun wisi-semantic-action (form nonterm iactn symbol-obarray)
+ "Define an Elisp semantic action function for a production, interned in
SYMBOL-OBARRAY.
+FORM is the body of the semantic action.
+NONTERM is the nonterminal left hand side.
+IACTN is the index of the production in the NTERM rule.
+
+The semantic action function accepts two arguments;
+- $nterm : the nonterminal
+- wisi-tokens : the list of tokens to be reduced.
+
+It returns nil; it is called for the semantic side-effects only."
;; based on comp.el wisent-semantic-action
- (let* ((actn (aref rcode r))
- (n (aref actn 1)) ; number of tokens in production
- (name (apply 'format "%s:%d" (aref actn 2)))
- (form (aref actn 0))
- (action-symbol (intern name (aref rcode 0))))
+ (let* ((name (format "%s:%d" nonterm iactn))
+ (action-symbol (intern name symbol-obarray)))
(fset action-symbol
- `(lambda (wisi-tokens)
- (let* (($nterm ',(aref tags (aref rlhs r)))
- ($1 nil));; wisent-parse-nonterminals defines a default
body of $1 for empty actions
- ,form
- nil)))
-
- (list (car (aref actn 2)) action-symbol n)))
+ `(lambda ($nterm wisi-tokens)
+ ,form
+ nil))))
(defun wisi-compile-grammar (grammar)
"Compile the LALR(1) GRAMMAR; return the automaton for wisi-parse.
@@ -150,7 +137,9 @@ GRAMMAR is a list TERMINALS NONTERMS ACTIONS GOTOS, where:
TERMINALS is a list of terminal token symbols.
NONTERMS is a list of productions; each production is a
-list (nonterm (tokens action) ...) where `action' is any lisp form.
+list (nonterm (tokens semantic-action) ...) where `semantic-action' is
+any lisp form. The set of (tokens semantic-action) are the right hand
+sides; nonterm is the left hand side.
ACTIONS is an array indexed by parser state, of alists indexed by
terminal tokens. The value of each item in the alists is one of:
@@ -164,7 +153,6 @@ integer - shift; gives new state
'(nonterm . index) - reduce by nonterm production index.
'(integer (nonterm . index)) - a shift/reduce conflict
-'((nonterm . index) integer) - a reduce/shift conflict
'((nonterm . index) (nonterm . index)) - a reduce/reduce conflict
The first item in the alist must have the key 'default (not a
@@ -175,52 +163,76 @@ GOTOS is an array indexed by parser state, of alists
giving the
new state after a reduce for each nonterminal legal in that
state.
-The automaton is an array with 3 elements:
+The automaton is an array [parser-actions gotos symbol-obarray]:
-parser-actions is a copy of the input ACTIONS, with reduction
+- parser-actions is a copy of the input ACTIONS, with semantic
actions replaced by a list (nonterm action-symbol token-count),
-where `nonterm' is a symbol from NONTERMS, and is the
-non-terminal to reduce to, token-count is the number of tokens in
-the reduction, action-symbol is nil if there is no user action,
-or a symbol from semantic-actions (below).
+where:
-gotos is a copy of GOTOS.
+-- nonterm is a symbol from NONTERMS, and is the non-terminal to
+reduce to
-semantic-actions is an obarray containing functions that
-implement the user action for each nonterminal; the function
-names have the format nonterm:index."
- (wisent-with-context compile-grammar
- (wisent-parse-grammar;; set global vars used by wisent-semantic-action
- (cons
- (nth 0 grammar);; TOKENS
- (cons nil ;; ASSOCS
- (nth 1 grammar));; NONTERMS
- ))
-
- (aset rcode 0 (make-vector 13 0));; obarray for semantic actions
-
- ;; create semantic action functions, interned in rcode[0]
- (let* ((i 1))
- (while (<= i nrules)
- (wisi-semantic-action i rcode tags rlhs)
- (setq i (1+ i)))
- )
+-- token-count is the number of tokens in the reduction,
+
+-- action-symbol is nil if there is no semantic action, or a
+symbol interned in symbol-obarray
- ;; replace semantic actions in ACTIONS with symbols from symbol-array
+- gotos is a copy of GOTOS.
+
+- symbol-obarray is an obarray containing functions that
+implement the semantic action for each nonterminal; the function
+names have the format nonterm:index."
+ ;; We store named symbols for semantic actions, not just lambda
+ ;; functions, so we have a name for debug trace.
+ ;;
+ ;; FIXME: TERMINALS is not used. Eliminating it requires decoupling
+ ;; from OpenToken; we'll do that in the move to FastToken.
+ ;;
+ ;; FIXME: eliminate use of semantic-lex-* in *-wy.el. Similarly
+ ;; requires decoupling from OpenToken
+ ;;
+ ;; FIXME: can eliminate obarray? We don't need the obarray to
+ ;; avoid garbage collection of the symbols; they are all referenced in the
compiled grammar.
+ ;; But each semantic action function has to be defined (and byte-compiled?)
somewhere?
+ ;; currently actions are _not_ byte-compiled; wisi-compile-grammar is
run at load time
+ ;; need 'eval-when-compile' to byte-compile them?
+ ;; can't byte-compile obarray?
+
+ (let ((defs (nth 1 grammar))
+ (symbol-obarray (make-vector 13 0));; for parse actions
+ def nonterm rhs-list rule
+ semantic-action index)
+
+ (while defs
+ (setq def (car defs)
+ defs (cdr defs)
+ nonterm (car def)
+ rhs-list (cdr def)
+ index 0)
+ (while rhs-list
+ (setq rule (car rhs-list)
+ rhs-list (cdr rhs-list)
+ semantic-action (cadr rule))
+
+ (when semantic-action
+ (wisi-semantic-action semantic-action nonterm index symbol-obarray))
+
+ (setq index (1+ index))
+ ))
+
+ ;; replace semantic actions in ACTIONS with symbols from symbol-obarray
(let ((nactions (length (nth 2 grammar)))
(actions (nth 2 grammar))
- (symbol-array (aref rcode 0))
(i 0))
(while (< i nactions)
(aset actions i
- (wisi-replace-actions (aref actions i) symbol-array (nth 1
grammar)))
+ (wisi-replace-actions (aref actions i) symbol-obarray (nth 1
grammar)))
(setq i (1+ i)))
(vector
actions
(nth 3 grammar)
- symbol-array)
+ symbol-obarray)
)))
(provide 'wisi-compile)
-
-;;;; end of file
+;;; wisi-compile.el ends here
diff --git a/packages/wisi/wisi-parse.el b/packages/wisi/wisi-parse.el
old mode 100755
new mode 100644
index 852ecdc..b9da937
--- a/packages/wisi/wisi-parse.el
+++ b/packages/wisi/wisi-parse.el
@@ -1,6 +1,6 @@
-;;; wisi-parse.el --- Wisi parser
+;;; wisi-parse.el --- Wisi parser -*- lexical-binding:t -*-
-;; Copyright (C) 2013, 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2015 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -111,6 +111,9 @@ point at which that max was spawned.")
list (symbol text start . end), where `symbol' is the terminal
symbol, `text' is the token string, `start . end' is the range
in the buffer."
+
+ ;; FIXME: (aref automaton 3) is the obarray storing the semantic actions;
+ ;; not used here (see related FIXME in wisi-compile)
(let* ((actions (aref automaton 0))
(gotos (aref automaton 1))
(parser-states ;; vector of parallel parser states
@@ -148,8 +151,8 @@ point at which that max was spawned.")
(let ((state (aref (wisi-parser-state-stack
parser-state)
(wisi-parser-state-sp
parser-state))))
(wisi-error-msg (concat "too many parallel parsers
required in grammar state %d;"
- " simplify grammar, or
increase `wisi-parse-max-parallel'"
- state)))))
+ " simplify grammar, or
increase `wisi-parse-max-parallel'")
+ state))))
(let ((j (wisi-free-parser parser-states)))
(cond
@@ -381,7 +384,7 @@ nil, 'shift, or 'accept."
result)
)
-(defun wisi-parse-exec-action (func tokens)
+(defun wisi-parse-exec-action (func nonterm tokens)
"Execute action if all tokens past wisi-cache-max."
;; We don't execute actions if all tokens are before wisi-cache-max,
;; because later actions can update existing caches, and if the
@@ -392,7 +395,7 @@ nil, 'shift, or 'accept."
(if (< 0 (length tokens))
(if (>= (wisi-parse-max-pos tokens) wisi-cache-max)
- (funcall func tokens)
+ (funcall func nonterm tokens)
(when (> wisi-debug 1)
(message "... action skipped; before wisi-cache-max %d"
wisi-cache-max)))
@@ -407,7 +410,7 @@ nil, 'shift, or 'accept."
(when (> wisi-debug 1) (message "%s" (car pending)))
(let ((func-args (pop pending)))
- (wisi-parse-exec-action (car func-args) (cadr func-args)))
+ (wisi-parse-exec-action (nth 0 func-args) (nth 1 func-args) (cl-caddr
func-args)))
))
(defun wisi-parse-1 (token parser-state pendingp actions gotos)
@@ -508,7 +511,7 @@ the first and last tokens of the nonterminal."
"Reduce PARSER-STATE.stack, and execute or pend ACTION."
(let* ((stack (wisi-parser-state-stack parser-state)); reference
(sp (wisi-parser-state-sp parser-state)); copy
- (token-count (or (nth 2 action) 0))
+ (token-count (nth 2 action))
(nonterm (nth 0 action))
(nonterm-region (when (> token-count 0)
(wisi-nonterm-bounds stack (- sp (* 2 (1-
token-count)) 1) (1- sp))))
@@ -519,25 +522,29 @@ the first and last tokens of the nonterminal."
(when (not new-state)
(error "no goto for %s %d" nonterm post-reduce-state))
- (dotimes (i token-count)
- (aset tokens (- token-count i 1) (aref stack (- sp (* 2 i) 1))))
+ (when (nth 1 action)
+ ;; don't need wisi-tokens for a null user action
+ (dotimes (i token-count)
+ (aset tokens (- token-count i 1) (aref stack (- sp (* 2 i) 1)))))
(setq sp (+ 2 (- sp (* 2 token-count))))
(aset stack (1- sp) (cons nonterm nonterm-region))
(aset stack sp new-state)
(setf (wisi-parser-state-sp parser-state) sp)
- (if pendingp
- (if (wisi-parser-state-pending parser-state)
+ (when (nth 1 action)
+ ;; nothing to do for a null user action
+ (if pendingp
+ (if (wisi-parser-state-pending parser-state)
+ (setf (wisi-parser-state-pending parser-state)
+ (append (wisi-parser-state-pending parser-state)
+ (list (list (nth 1 action) nonterm tokens))))
(setf (wisi-parser-state-pending parser-state)
- (append (wisi-parser-state-pending parser-state)
- (list (list (nth 1 action) tokens))))
- (setf (wisi-parser-state-pending parser-state)
- (list (list (nth 1 action) tokens))))
-
- ;; Not pending.
- (wisi-parse-exec-action (nth 1 action) tokens)
- )
+ (list (list (nth 1 action) nonterm tokens))))
+
+ ;; Not pending.
+ (wisi-parse-exec-action (nth 1 action) nonterm tokens)
+ ))
))
(provide 'wisi-parse)
diff --git a/packages/wisi/wisi.el b/packages/wisi/wisi.el
old mode 100755
new mode 100644
index 6f06f54..0b29b3e
--- a/packages/wisi/wisi.el
+++ b/packages/wisi/wisi.el
@@ -1,13 +1,13 @@
-;;; wisi.el --- Utilities for implementing an indentation/navigation engine
using a generalized LALR parser
+;;; wisi.el --- Utilities for implementing an indentation/navigation engine
using a generalized LALR parser -*- lexical-binding:t -*-
;;
-;; Copyright (C) 2012 - 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2012 - 2016 Free Software Foundation, Inc.
;;
;; Author: Stephen Leake <address@hidden>
;; Maintainer: Stephen Leake <address@hidden>
;; Keywords: parser
;; indentation
;; navigation
-;; Version: 1.1.0
+;; Version: 1.1.2
;; package-requires: ((cl-lib "0.4") (emacs "24.2"))
;; URL: http://stephe-leake.org/emacs/ada-mode/emacs-ada-mode.html
;;
@@ -158,6 +158,7 @@
;; an appropriate end-point for syntax-propertize, other than
;; point-max. So we call (syntax-propertize point-max) in wisi-setup,
;; and also call syntax-propertize in wisi-after-change.
+;; FIXME: no longer needed in Emacs 25? (email from Stefan Monnier)
;;
;;;; code style
;;
@@ -179,12 +180,12 @@
(require 'wisi-compat-24.2)
;;)
-(defcustom wisi-font-lock-size-threshold 100000
- "Max size (in characters) for using wisi parser results for syntax
highlighting."
+(defcustom wisi-size-threshold 100000
+ "Max size (in characters) for using wisi parser results for syntax
highlighting and file navigation."
:type 'integer
:group 'wisi
:safe 'integerp)
-(make-variable-buffer-local 'wisi-font-lock-size-threshold)
+(make-variable-buffer-local 'wisi-size-threshold)
;;;; lexer
@@ -204,25 +205,24 @@
(defun wisi-number-p (token-text)
"Return t if TOKEN-TEXT plus text after point matches the
-syntax for a real literal; otherwise nil. point is after
+syntax for a real literal; otherwise nil. Point is after
TOKEN-TEXT; move point to just past token."
- ;; typical literals:
+ ;; Typical literals:
;; 1234
;; 1234.5678
- ;; 1234.5678e+99
+ ;; _not_ including non-decimal base, or underscores (see ada-wisi-number-p)
;;
- (let ((end (point)))
- ;; starts with a simple integer
- (when (string-match "^[0-9]+" token-text)
- (when (looking-at "\\.[0-9]+")
- ;; real number
- (goto-char (setq end (match-end 0)))
- (when (looking-at "[Ee][+-][0-9]+")
- ;; exponent
- (goto-char (setq end (match-end 0)))))
-
- t
- )))
+ ;; Starts with a simple integer
+ (when (string-match "^[0-9]+$" token-text)
+ (when (looking-at "\\.[0-9]+")
+ ;; real number
+ (goto-char (match-end 0))
+ (when (looking-at "[Ee][+-][0-9]+")
+ ;; exponent
+ (goto-char (match-end 0))))
+
+ t
+ ))
(defun wisi-forward-token ()
"Move point forward across one token, skipping leading whitespace and
comments.
@@ -290,10 +290,10 @@ If at end of buffer, returns `wisent-eoi-term'."
(scan-error
;; Something screwed up; we should not get here if
;; syntax-propertize works properly.
- (error "wisi-forward-token: forward-sexp failed %s" err)
+ (signal 'wisi-parse-error (format "wisi-forward-token: forward-sexp
failed %s" err))
))))
- (t ;; assuming word syntax
+ (t ;; assuming word or symbol syntax; includes numbers
(skip-syntax-forward "w_'")
(setq token-text (buffer-substring-no-properties start (point)))
(setq token-id
@@ -315,6 +315,7 @@ If at end of buffer, returns `wisent-eoi-term'."
(defun wisi-backward-token ()
"Move point backward across one token, skipping whitespace and comments.
+Does _not_ handle numbers with wisi-number-p; just sees lower-level syntax.
Return (nil start . end) - same structure as
wisi-forward-token, but does not look up symbol."
(forward-comment (- (point)))
@@ -326,6 +327,24 @@ wisi-forward-token, but does not look up symbol."
(cond
((bobp) nil)
+ ((eq syntax 1)
+ ;; punctuation. Find the longest matching string in
wisi-punctuation-table
+ (backward-char 1)
+ (let ((next-point (point))
+ temp-text done)
+ (while (not done)
+ (setq temp-text (buffer-substring-no-properties (point) end))
+ (when (car (rassoc temp-text wisi-punctuation-table))
+ (setq next-point (point)))
+ (if (or
+ (bobp)
+ (= (- end (point)) wisi-punctuation-table-max-length))
+ (setq done t)
+ (backward-char 1))
+ )
+ (goto-char next-point))
+ )
+
((memq syntax '(4 5)) ;; open, close parenthesis
(backward-char 1))
@@ -334,7 +353,7 @@ wisi-forward-token, but does not look up symbol."
(let ((forward-sexp-function nil))
(forward-sexp -1)))
- (t
+ (t ;; assuming word or symbol syntax
(if (zerop (skip-syntax-backward "."))
(skip-syntax-backward "w_'")))
)
@@ -424,6 +443,12 @@ Used in before/after change functions.")
(wisi-delete-cache after)
)
+;; To see the effects of wisi-before-change, wisi-after-change, you need:
+;; (global-font-lock-mode 0)
+;; (setq jit-lock-functions nil)
+;;
+;; otherwise jit-lock runs and overrides them
+
(defun wisi-before-change (begin end)
"For `before-change-functions'."
;; begin . end is range of text being deleted
@@ -507,9 +532,9 @@ Used in before/after change functions.")
(t
(setq wisi-change-need-invalidate
(progn
+ (goto-char begin)
;; note that because of the checks above, this never
;; triggers a parse, so it's fast
- (goto-char begin)
(wisi-goto-statement-start)
(point))))
)))
@@ -544,6 +569,8 @@ Used in before/after change functions.")
(setq begin-state (syntax-ppss begin))
(setq end-state (syntax-ppss end))
;; syntax-ppss has moved point to "end".
+
+ ;; extend fontification over new text,
(skip-syntax-forward "w_")
(setq word-end (point))
(goto-char begin)
@@ -574,7 +601,7 @@ Used in before/after change functions.")
;; no easy way to tell if there is intervening non-string
(setq need-invalidate nil))
- ((or
+ ((and
(nth 4 begin-state)
(nth 4 end-state)); in comment
;; no easy way to detect intervening code
@@ -626,7 +653,8 @@ If accessing cache at a marker for a token as set by
`wisi-cache-tokens', POS mu
(defun wisi-goto-error ()
"Move point to position in last error message (if any)."
- (when (string-match ":\\([0-9]+\\):\\([0-9]+\\):" wisi-parse-error-msg)
+ (when (and wisi-parse-error-msg
+ (string-match ":\\([0-9]+\\):\\([0-9]+\\):" wisi-parse-error-msg))
(let ((line (string-to-number (match-string 1 wisi-parse-error-msg)))
(col (string-to-number (match-string 2 wisi-parse-error-msg))))
(push-mark)
@@ -655,12 +683,15 @@ If accessing cache at a marker for a token as set by
`wisi-cache-tokens', POS mu
(defun wisi-validate-cache (pos)
"Ensure cached data is valid at least up to POS in current buffer."
(let ((msg (when (> wisi-debug 0) (format "wisi: parsing %s:%d ..."
(buffer-name) (line-number-at-pos pos)))))
+ ;; If wisi-cache-max = pos, then there is no cache at pos; need parse
(when (and wisi-parse-try
- (< wisi-cache-max pos))
+ (<= wisi-cache-max pos))
(when (> wisi-debug 0)
(message msg))
+ ;; Don't keep retrying failed parse until text changes again.
(setq wisi-parse-try nil)
+
(setq wisi-parse-error-msg nil)
(setq wisi-end-caches nil)
@@ -700,9 +731,9 @@ If accessing cache at a marker for a token as set by
`wisi-cache-tokens', POS mu
(message "%s done" msg)))
)))
-(defun wisi-fontify-region (begin end)
+(defun wisi-fontify-region (_begin end)
"For `jit-lock-functions'."
- (when (< (point-max) wisi-font-lock-size-threshold)
+ (when (< (point-max) wisi-size-threshold)
(wisi-validate-cache end)))
(defun wisi-get-containing-cache (cache)
@@ -743,8 +774,10 @@ delete from `wisi-end-caches'."
)))
(defvar wisi-tokens nil)
-;; keep byte-compiler happy; `wisi-tokens' is bound in action created
-;; by wisi-semantic-action
+(defvar $nterm nil)
+;; keep byte-compiler happy; `wisi-tokens' and `$nterm' are bound in
+;; action created by wisi-semantic-action, and in module parser.
+;; FIXME: $nterm should have wisi- prefix
(defun wisi-statement-action (pairs)
"Cache information in text properties of tokens.
@@ -823,7 +856,7 @@ grammar action as:
(1+ (car region))
'wisi-cache
(wisi-cache-create
- :nonterm $nterm;; $nterm defined in
wisi-semantic-action
+ :nonterm $nterm
:token token
:last (- (cdr region) (car region))
:class (or override-start class)
@@ -837,8 +870,7 @@ grammar action as:
(when first-item
(setq first-item nil)
(when (or override-start
- ;; FIXME: why block-middle here?
- (memq class '(block-middle block-start
statement-start)))
+ (memq class '(block-start statement-start)))
(setq override-start nil)
(setq first-keyword-mark mark)))
@@ -990,57 +1022,50 @@ vector [number class token_id class token_id ...]:
))
)))
-(defun wisi-extend-action (number)
- "Extend text of cache at token NUMBER to cover all of token NUMBER.
-Also override token with new token."
- (let* ((token-region (aref wisi-tokens (1- number)));; wisi-tokens is
let-bound in wisi-parse-reduce
- (token (car token-region))
- (region (cdr token-region))
+(defun wisi-extend-action (first last)
+ "Extend text of cache at token FIRST to cover all tokens thru LAST."
+ (let* ((first-region (cdr (aref wisi-tokens (1- first))));; wisi-tokens is
let-bound in wisi-parse-reduce
+ (last-region (cdr (aref wisi-tokens (1- last))))
cache)
- (when region
- (setq cache (wisi-get-cache (car region)))
- (setf (wisi-cache-last cache) (- (cdr region) (car region)))
- (setf (wisi-cache-token cache) token)
+ (when first-region
+ (setq cache (wisi-get-cache (car first-region)))
+ (setf (wisi-cache-last cache) (- (cdr last-region) (car first-region)))
)
))
-(defun wisi-face-action-1 (face region &optional no-override)
- "Apply FACE to REGION. If NO-OVERRIDE is non-nil, don't override existing
face."
+(defun wisi-face-action-1 (face region &optional override-no-error)
+ "Apply FACE to REGION.
+If OVERRIDE-NO-ERROR is non-nil, don't report an error for overriding an
existing face."
(when region
;; We allow overriding a face property, because we don't want to
;; delete them in wisi-invalidate (see comments there). On the
;; other hand, it can be an error, so keep this debug
- ;; code. However, note that font-lock-face properties must be
- ;; removed first, or the buffer must be fresh (never parsed).
+ ;; code. However, to validly report errors, note that
+ ;; font-lock-face properties must be removed first, or the buffer
+ ;; must be fresh (never parsed), and wisi-debug must be > 1.
;;
- ;; Grammar sets no-override when a higher-level production might
- ;; override a face in a lower-level production; that's not an
- ;; error.
- (let (cur-face
- (do-set t))
- (when (or no-override
- (> wisi-debug 1))
- (setq cur-face (get-text-property (car region) 'font-lock-face))
- (if cur-face
- (if no-override
- (setq do-set nil)
- (message "%s:%d overriding face %s with %s on '%s'"
+ ;; Grammar sets override-no-error when a higher-level production might
+ ;; override a face in a lower-level production.
+ (when (> wisi-debug 1)
+ (let ((cur-face (get-text-property (car region) 'font-lock-face)))
+ (when cur-face
+ (unless override-no-error
+ (message "%s:%d overriding face %s with %s on '%s'"
(buffer-file-name)
(line-number-at-pos (car region))
face
cur-face
(buffer-substring-no-properties (car region) (cdr
region))))
- ))
- (when do-set
- (with-silent-modifications
- (add-text-properties
- (car region) (cdr region)
- (list
- 'font-lock-face face
- 'fontified t))))
- )))
+ )))
+ (with-silent-modifications
+ (add-text-properties
+ (car region) (cdr region)
+ (list
+ 'font-lock-face face
+ 'fontified t)))
+ ))
(defun wisi-face-action (pairs &optional no-override)
"Cache face information in text properties of tokens.
@@ -1342,14 +1367,28 @@ Return start cache."
(defun wisi-comment-indent ()
"For `comment-indent-function'. Indent single line comment to
the comment on the previous line."
- ;; This should only be called by comment-indent-new-line or
- ;; fill-comment-paragraph, so there will be a preceding comment line
- ;; that we can trust.
- (save-excursion
- (forward-comment -1)
- (if (looking-at comment-start)
- (current-column)
- (error "wisi-comment-indent called after non-comment"))))
+ (or
+ (save-excursion
+ (forward-comment -1)
+ (when (looking-at comment-start)
+ ;; There is a preceding comment line.
+ (current-column)))
+
+ ;; Probably called from `comment-indent'; either to insert a new
+ ;; comment, or to indent the first line of an existing one. In
+ ;; either case, the comment may be after code on the same line.
+ (save-excursion
+ (let ((start-col (current-column)))
+ (back-to-indentation)
+ (if (looking-at comment-start)
+ ;; An existing comment alone on a line. Return nil, so
+ ;; `comment-indent' will call `indent-according-to-mode'
+ nil
+
+ ;; A comment after code on the same line; point was at the
+ ;; comment start, so assume it is already correct.
+ start-col)))
+ ))
(defun wisi-indent-current (offset)
"Return indentation OFFSET relative to indentation of current line."
@@ -1456,6 +1495,13 @@ correct. Must leave point at indentation of current
line.")
(wisi-invalidate-cache)
(wisi-validate-cache (point-max)))
+(defun wisi-lex-buffer ()
+ (interactive)
+ (syntax-propertize (point-max))
+ (goto-char (point-min))
+ (while (not (eq wisent-eoi-term (car (wisi-forward-token)))))
+ )
+
(defun wisi-show-cache ()
"Show cache at point."
(interactive)
diff --git a/packages/yasnippet/CONTRIBUTING.md
b/packages/yasnippet/CONTRIBUTING.md
index 83310bc..7e2ce47 100644
--- a/packages/yasnippet/CONTRIBUTING.md
+++ b/packages/yasnippet/CONTRIBUTING.md
@@ -23,5 +23,7 @@ there is no separate Changelog file.
* foo.el (a-function): Terse summary of per-function changes.
+For trivial changes, a message consisting of just the changelog entry
+(the `* foo.el ...` part) is fine.
[bugnote]:
https://github.com/capitaomorte/yasnippet#important-note-regarding-bug-reporting
diff --git a/packages/yasnippet/README.mdown b/packages/yasnippet/README.mdown
index 75ca37a..6646557 100644
--- a/packages/yasnippet/README.mdown
+++ b/packages/yasnippet/README.mdown
@@ -8,12 +8,10 @@ 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] or download a
-[higher resolution version][high-res-demo].
+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
-[high-res-demo]: http://yasnippet.googlecode.com/files/yas_demo.avi
# Installation
@@ -36,33 +34,22 @@ Add your own snippets to `~/.emacs.d/snippets` by placing
files there or invokin
## 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.milkbox.net/#installing.
+[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. Be sure to install the
-"master" branch since the 3.x series still use the old googlecode code, base.
-Consider using this "local" recipe.
-
- (push '(:name yasnippet
- :website "https://github.com/capitaomorte/yasnippet.git";
- :description "YASnippet is a template system for Emacs."
- :type github
- :pkgname "capitaomorte/yasnippet"
- :features "yasnippet"
- :compile "yasnippet.el")
- el-get-sources)
+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, replace `(yas-global-mode 1)` with
-`(yas-reload-all)` to load the snippet tables. Then add a call to
-`(yas-minor-mode)` to the major-modes where you to enable YASnippet.
+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.
- (add-hook 'prog-mode-hook
- '(lambda ()
- (yas-minor-mode)))
+ (yas-reload-all)
+ (add-hook 'prog-mode-hook #'yas-minor-mode)
# Where are the snippets?
@@ -76,8 +63,8 @@ download "git submodules" and find two subdirs under the main
tree.
1. `snippets/`
- Points to [yasnippet-snippets][yasnippet-snippets] the snippet
- collection of [AndreaCrotti](https://github.com/AndreaCrotti).
+ Points to [yasnippet-snippets] the snippet collection of
+ [AndreaCrotti](https://github.com/AndreaCrotti).
The default configuraiton already points to this dir, so to use
them, just make sure the submodule really was downloaded
@@ -85,8 +72,8 @@ download "git submodules" and find two subdirs under the main
tree.
2. `yasmate/`
- Points to a github repo of the [yasmate][yasmate] tool, which is
- dedicated to converting textmate bundles into yasnippet snippets.
+ Points to a github repo of the [yasmate] 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`
@@ -95,6 +82,11 @@ download "git submodules" and find two subdirs under the
main tree.
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
@@ -136,14 +128,14 @@ $ git clone https://github.com/capitaomorte/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
+$ 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 can't expand foo-mode snippets!
+When I open a foo-mode file I don't see foo-mode under the "YASnippet" menu!
OR
-I can't get yasnippet to load because frankinbogen!
+When loading yasnippet I see "Error: failed to frobnicate"!
```
Using `emacs -Q` or temporarily moving your `.emacs` init file to the side
@@ -175,4 +167,5 @@ Finally, thank you very much for using YASnippet!
[forum]: http://groups.google.com/group/smart-snippet
[melpa]: http://melpa.milkbox.net/
[yasmate]: http://github.com/capitaomorte/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/doc/doc/.nosearch
b/packages/yasnippet/doc/.nosearch
similarity index 100%
rename from packages/yasnippet/doc/doc/.nosearch
rename to packages/yasnippet/doc/.nosearch
diff --git a/packages/yasnippet/doc/doc/faq.org b/packages/yasnippet/doc/faq.org
similarity index 100%
rename from packages/yasnippet/doc/doc/faq.org
rename to packages/yasnippet/doc/faq.org
diff --git a/packages/yasnippet/doc/doc/index.org
b/packages/yasnippet/doc/index.org
similarity index 100%
rename from packages/yasnippet/doc/doc/index.org
rename to packages/yasnippet/doc/index.org
diff --git a/packages/yasnippet/doc/doc/nav-menu.html.inc
b/packages/yasnippet/doc/nav-menu.html.inc
similarity index 100%
rename from packages/yasnippet/doc/doc/nav-menu.html.inc
rename to packages/yasnippet/doc/nav-menu.html.inc
diff --git a/packages/yasnippet/doc/doc/org-setup.inc
b/packages/yasnippet/doc/org-setup.inc
similarity index 100%
rename from packages/yasnippet/doc/doc/org-setup.inc
rename to packages/yasnippet/doc/org-setup.inc
diff --git a/packages/yasnippet/doc/doc/snippet-development.org
b/packages/yasnippet/doc/snippet-development.org
similarity index 100%
rename from packages/yasnippet/doc/doc/snippet-development.org
rename to packages/yasnippet/doc/snippet-development.org
diff --git a/packages/yasnippet/doc/doc/snippet-expansion.org
b/packages/yasnippet/doc/snippet-expansion.org
similarity index 92%
rename from packages/yasnippet/doc/doc/snippet-expansion.org
rename to packages/yasnippet/doc/snippet-expansion.org
index 876b81c..fdc02cc 100644
--- a/packages/yasnippet/doc/doc/snippet-expansion.org
+++ b/packages/yasnippet/doc/snippet-expansion.org
@@ -102,21 +102,23 @@ prefer.
** Expanding from emacs-lisp code
-Sometimes you might want to expand a snippet directly from you own
-elisp code. You should call
-[[sym:yas-expand-snippet][=yas-expand-snippet=]] instead of
-[[sym:yas-expand][=yas-expand=]] in this case.
+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. In fact, expanding from the
-YASnippet menu has the same effect of evaluating the follow code:
+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=]] for more
-information.
+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
diff --git a/packages/yasnippet/doc/doc/snippet-menu.org
b/packages/yasnippet/doc/snippet-menu.org
similarity index 96%
rename from packages/yasnippet/doc/doc/snippet-menu.org
rename to packages/yasnippet/doc/snippet-menu.org
index 46b9b0c..272ea16 100644
--- a/packages/yasnippet/doc/doc/snippet-menu.org
+++ b/packages/yasnippet/doc/snippet-menu.org
@@ -55,13 +55,12 @@ These customizations can also be found in the menu itself,
under the
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]] .
+[[./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]] .
+[[sym:yas-prompt-functions][=yas-prompt-functions=]]. See
[[./snippet-expansion.org][Expanding snippets]].
* Misc
diff --git a/packages/yasnippet/doc/doc/snippet-organization.org
b/packages/yasnippet/doc/snippet-organization.org
similarity index 83%
rename from packages/yasnippet/doc/doc/snippet-organization.org
rename to packages/yasnippet/doc/snippet-organization.org
index ee55a8e..0f5de52 100644
--- a/packages/yasnippet/doc/doc/snippet-organization.org
+++ b/packages/yasnippet/doc/snippet-organization.org
@@ -48,7 +48,7 @@
'("~/Downloads/interesting-snippets")))
#+end_src
- Collections appearing earlier in the list shadow snippets with same names
+ 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.
@@ -112,10 +112,20 @@
** TODO
-* TODO The =.yas-compiled-snippet.el= file
+* The =.yas-compiled-snippet.el= file
-** TODO
+ 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
-* TODO The =.yas-skip= file
+ A =.yas-skip= file in a mode's snippet subdirectory tells YASnippet
+ not to load snippets from there.
** TODO
diff --git a/packages/yasnippet/doc/doc/snippet-reference.org
b/packages/yasnippet/doc/snippet-reference.org
similarity index 100%
rename from packages/yasnippet/doc/doc/snippet-reference.org
rename to packages/yasnippet/doc/snippet-reference.org
diff --git a/packages/yasnippet/doc/doc/stylesheets/manual.css
b/packages/yasnippet/doc/stylesheets/manual.css
similarity index 100%
rename from packages/yasnippet/doc/doc/stylesheets/manual.css
rename to packages/yasnippet/doc/stylesheets/manual.css
diff --git a/packages/yasnippet/doc/yas-doc-helper.el
b/packages/yasnippet/doc/yas-doc-helper.el
index 5bf0d7a..f4cd49b 100755
--- a/packages/yasnippet/doc/yas-doc-helper.el
+++ b/packages/yasnippet/doc/yas-doc-helper.el
@@ -135,7 +135,7 @@
(princ yas--version (current-buffer)))))
(proj-plist
`(,@(when (fboundp 'org-html-publish-to-html)
- '(:publishing-function 'org-html-publish-to-html))
+ '(:publishing-function org-html-publish-to-html))
:base-directory ,dir :publishing-directory ,dir
:html-preamble
,(with-temp-buffer
diff --git a/packages/yasnippet/yasnippet-debug.el
b/packages/yasnippet/yasnippet-debug.el
index 593d081..b12bcd4 100644
--- a/packages/yasnippet/yasnippet-debug.el
+++ b/packages/yasnippet/yasnippet-debug.el
@@ -46,7 +46,7 @@
(yas--snippet-id snippet)
(overlay-start (yas--snippet-control-overlay snippet))
(overlay-end (yas--snippet-control-overlay snippet))))
- (princ (format "\tactive field: %d from %s to %s covering \"%s\"\n"
+ (princ (format "\tactive field: %s from %s to %s covering \"%s\"\n"
(yas--field-number (yas--snippet-active-field snippet))
(marker-position (yas--field-start
(yas--snippet-active-field snippet)))
(marker-position (yas--field-end
(yas--snippet-active-field snippet)))
@@ -56,7 +56,7 @@
(yas--exit-marker (yas--snippet-exit snippet))
(yas--exit-next (yas--snippet-exit snippet)))))
(dolist (field (yas--snippet-fields snippet))
- (princ (format "\tfield: %d from %s to %s covering \"%s\" next: %s%s\n"
+ (princ (format "\tfield: %s from %s to %s covering \"%s\" next: %s%s\n"
(yas--field-number field)
(marker-position (yas--field-start field))
(marker-position (yas--field-end field))
@@ -77,14 +77,15 @@
(point-max)))
(unless (eq buffer-undo-list t)
(princ (format "Undpolist has %s elements. First 10 elements follow:\n"
(length buffer-undo-list)))
- (let ((first-ten (subseq buffer-undo-list 0 19)))
+ (let ((first-ten (subseq buffer-undo-list 0 (min 19
+ (length
buffer-undo-list)))))
(dolist (undo-elem first-ten)
(princ (format "%2s: %s\n" (position undo-elem first-ten)
(truncate-string-to-width (format "%s" undo-elem) 70))))))))
(defun yas--debug-format-fom-concise (fom)
(when fom
(cond ((yas--field-p fom)
- (format "field %d from %d to %d"
+ (format "field %s from %d to %d"
(yas--field-number fom)
(marker-position (yas--field-start fom))
(marker-position (yas--field-end fom))))
diff --git a/packages/yasnippet/yasnippet-tests.el
b/packages/yasnippet/yasnippet-tests.el
index 2d7a0bc..648e4f3 100644
--- a/packages/yasnippet/yasnippet-tests.el
+++ b/packages/yasnippet/yasnippet-tests.el
@@ -54,7 +54,7 @@
(yas-expand-snippet "${1:brother} from another $1")
(should (string= (yas--buffer-contents)
"brother from another brother"))
- (ert-simulate-command `(yas-mock-insert "bla"))
+ (yas-mock-insert "bla")
(should (string= (yas--buffer-contents)
"bla from another bla"))))
@@ -64,7 +64,7 @@
(yas-expand-snippet "${1:brother} from another ${1:$(upcase yas-text)}")
(should (string= (yas--buffer-contents)
"brother from another BROTHER"))
- (ert-simulate-command `(yas-mock-insert "bla"))
+ (yas-mock-insert "bla")
(should (string= (yas--buffer-contents)
"bla from another BLA"))))
@@ -74,7 +74,7 @@
(let ((snippet "${1:$$(upcase yas-text)}${1:$(concat \"bar\" yas-text)}"))
(yas-expand-snippet snippet)
(should (string= (yas--buffer-contents) "bar"))
- (ert-simulate-command `(yas-mock-insert "foo"))
+ (yas-mock-insert "foo")
(should (string= (yas--buffer-contents) "FOObarFOO")))))
(ert-deftest nested-placeholders-kill-superfield ()
@@ -83,7 +83,7 @@
(yas-expand-snippet "brother from ${2:another ${3:mother}}!")
(should (string= (yas--buffer-contents)
"brother from another mother!"))
- (ert-simulate-command `(yas-mock-insert "bla"))
+ (yas-mock-insert "bla")
(should (string= (yas--buffer-contents)
"brother from bla!"))))
@@ -92,7 +92,7 @@
(yas-minor-mode 1)
(yas-expand-snippet "brother from ${2:another ${3:mother}}!")
(ert-simulate-command '(yas-next-field-or-maybe-expand))
- (ert-simulate-command `(yas-mock-insert "bla"))
+ (yas-mock-insert "bla")
(should (string= (yas--buffer-contents)
"brother from another bla!"))))
@@ -102,7 +102,7 @@
(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...'
%>"))
- (ert-simulate-command `(yas-mock-insert "Send"))
+ (yas-mock-insert "Send")
(should (string= (yas--buffer-contents)
"<%= f.submit \"Send\", :disable_with => 'Sending...'
%>"))))
@@ -110,7 +110,7 @@
(with-temp-buffer
(yas-minor-mode 1)
(yas-expand-snippet "${1:FOOOOOOO}${2:$1}${3:$2}${4:$3}")
- (ert-simulate-command `(yas-mock-insert "abc"))
+ (yas-mock-insert "abc")
(should (string= (yas--buffer-contents) "abcabcabcabc"))))
(ert-deftest delete-numberless-inner-snippet-issue-562 ()
@@ -124,12 +124,21 @@
(should (looking-at "ble"))
(should (null (yas--snippets-at-point)))))
+(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))
-;; (ert-simulate-command `(yas-mock-insert "bla"))
+;; (yas-mock-insert "bla")
;; (ert-simulate-command '(undo))
;; (should (string= (yas--buffer-contents)
;; "brother from another mother!"))))
@@ -214,7 +223,7 @@
(snippet "if ${1:condition}\n`yas-selected-text`\nelse\n$3\nend"))
(yas-expand-snippet snippet)
(yas-next-field)
- (ert-simulate-command `(yas-mock-insert "bbb"))
+ (yas-mock-insert "bbb")
(should (string= (yas--buffer-contents) "if
condition\naaa\nelse\nbbb\nend")))))
(defmacro yas--with-font-locked-temp-buffer (&rest body)
@@ -315,9 +324,9 @@
\"fail\")}"))
(yas-expand-snippet snippet)
(should (string= (yas--buffer-contents) "fail"))
- (ert-simulate-command `(yas-mock-insert "foobaaar"))
+ (yas-mock-insert "foobaaar")
(should (string= (yas--buffer-contents) "foobaaarfail"))
- (ert-simulate-command `(yas-mock-insert "baz"))
+ (yas-mock-insert "baz")
(should (string= (yas--buffer-contents) "foobaaarbazok")))))
@@ -341,7 +350,7 @@ TODO: correct this bug!"
;; 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
@@ -446,6 +455,14 @@ TODO: correct this bug!"
("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-lookup-snippet "printf" 'c-mode) "printf($1);"))
+ (should (equal (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 basic-jit-loading ()
"Test basic loading and expansion of snippets"
@@ -454,7 +471,7 @@ TODO: correct this bug!"
(yas--basic-jit-loading-1)))
(ert-deftest basic-jit-loading-with-compiled-snippets ()
- "Test basic loading and expansion of snippets"
+ "Test basic loading and expansion of compiled snippets"
(yas-with-some-interesting-snippet-dirs
(yas-reload-all)
(yas-recompile-all)
@@ -464,6 +481,20 @@ TODO: correct this bug!"
(yas-reload-all)
(yas--basic-jit-loading-1))))
+(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.
+ (yas--with-temporary-redefinitions ((find-file-noselect
+ (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
@@ -482,15 +513,44 @@ TODO: correct this bug!"
yet-another-c-mode
and-also-this-one
and-that-one
- ;; prog-mode doesn't exit in emacs 24.3
+ ;; prog-mode doesn't exist in emacs 24.3
,@(if (fboundp 'prog-mode)
'(prog-mode))
emacs-lisp-mode
lisp-interaction-mode))
(observed (yas--modes-to-activate)))
- (should (null (cl-set-exclusive-or expected observed)))
- (should (= (length expected)
- (length observed))))))))
+ (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 24.3
+ ,@(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)
@@ -700,7 +760,7 @@ TODO: be meaner"
(should (not (eq (key-binding (yas--read-keybinding "TAB"))
'yas-expand)))
(should (eq (key-binding (yas--read-keybinding "SPC"))
'yas-expand))))
;; FIXME: actually should restore to whatever saved values where there.
- ;;
+ ;;
(define-key yas-minor-mode-map [tab] 'yas-expand)
(define-key yas-minor-mode-map (kbd "TAB") 'yas-expand)
(define-key yas-minor-mode-map (kbd "SPC") nil)))
@@ -765,10 +825,9 @@ add the snippets associated with the given mode."
(yas--buffer-contents))))))
(defun yas-mock-insert (string)
- (interactive)
- (do ((i 0 (1+ i)))
- ((= i (length string)))
- (insert (aref string i))))
+ (dotimes (i (length string))
+ (let ((last-command-event (aref string i)))
+ (ert-simulate-command '(self-insert-command 1)))))
(defun yas-make-file-or-dirs (ass)
(let ((file-or-dir-name (car ass))
@@ -819,6 +878,17 @@ add the snippets associated with the given 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))))))
+
;;; btw 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
diff --git a/packages/yasnippet/yasnippet.el b/packages/yasnippet/yasnippet.el
index 95c96e4..dcec0e2 100644
--- a/packages/yasnippet/yasnippet.el
+++ b/packages/yasnippet/yasnippet.el
@@ -1,8 +1,8 @@
;;; yasnippet.el --- Yet another snippet extension for Emacs.
;; Copyright (C) 2008-2013, 2015 Free Software Foundation, Inc.
-;; Authors: pluskid <address@hidden>, João Távora <address@hidden>
-;; Maintainer: João Távora <address@hidden>
+;; Authors: pluskid <address@hidden>, João Távora <address@hidden>, Noam
Postavsky <address@hidden>
+;; Maintainer: Noam Postavsky <address@hidden>
;; Version: 0.8.1
;; Package-version: 0.8.0
;; X-URL: http://github.com/capitaomorte/yasnippet
@@ -41,7 +41,7 @@
;; 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 shadow other dir's snippets. Also, the first
+;; the list override other dir's snippets. Also, the first
;; directory is taken as the default for storing the user's
;; new snippets.
;;
@@ -156,8 +156,11 @@
(when load-file-name
(concat (file-name-directory load-file-name) "snippets")))
+(defconst yas--default-user-snippets-dir
+ (concat user-emacs-directory "snippets"))
+
(defcustom yas-snippet-dirs (remove nil
- (list "~/.emacs.d/snippets"
+ (list yas--default-user-snippets-dir
'yas-installed-snippets-dir))
"List of top-level snippet directories.
@@ -165,7 +168,7 @@ 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 shadow later elements'
+Elements appearing earlier in the list override later elements'
snippets.
The first directory is taken as the default for storing snippet's
@@ -213,7 +216,7 @@ If nil, don't use any snippet."
(defcustom yas-prompt-functions '(yas-x-prompt
yas-dropdown-prompt
yas-completing-prompt
- yas-ido-prompt
+ yas-maybe-ido-prompt
yas-no-prompt)
"Functions to prompt for keys, templates, etc interactively.
@@ -459,10 +462,10 @@ Attention: These hooks are not run when exiting
nested/stacked snippet expansion
"Hooks to run just before expanding a snippet.")
(defvar yas-buffer-local-condition
- '(if (and (or (fourth (syntax-ppss))
- (fifth (syntax-ppss)))
- this-command
- (eq this-command 'yas-expand-from-trigger-key))
+ '(if (and (let ((ppss (syntax-ppss)))
+ (or (nth 3 ppss) (nth 4 ppss)))
+ (memq this-command '(yas-expand yas-expand-from-trigger-key
+ yas-expand-from-keymap)))
'(require-snippet-condition . force-in-comment)
t)
"Snippet expanding condition.
@@ -725,23 +728,24 @@ defined direct keybindings to the command
yas--direct-keymaps))
yas--tables))
-(defun yas--modes-to-activate ()
+(defun yas--modes-to-activate (&optional mode)
"Compute list of mode symbols that are active for `yas-expand'
and friends."
- (let (dfs)
- (setq dfs (lambda (mode &optional explored)
- (push mode explored)
- (cons mode
- (loop for neighbour
- in (cl-list* (get mode 'derived-mode-parent)
- (ignore-errors (symbol-function mode))
- (gethash mode yas--parents))
- when (and neighbour
- (not (memq neighbour explored))
- (symbolp neighbour))
- append (funcall dfs neighbour explored)))))
- (remove-duplicates (append yas--extra-modes
- (funcall dfs major-mode)))))
+ (let* ((explored (if mode (list mode) ; Building up list in reverse.
+ (cons major-mode (reverse yas--extra-modes))))
+ (dfs
+ (lambda (mode)
+ (cl-loop for neighbour
+ in (cl-list* (get mode 'derived-mode-parent)
+ (ignore-errors (symbol-function mode))
+ (gethash mode yas--parents))
+ when (and neighbour
+ (not (memq neighbour explored))
+ (symbolp neighbour))
+ do (push neighbour explored)
+ (funcall dfs neighbour)))))
+ (mapcar dfs explored)
+ (nreverse explored)))
(defvar yas-minor-mode-hook nil
"Hook run when `yas-minor-mode' is turned on.")
@@ -912,14 +916,39 @@ Honour `yas-dont-activate', which see."
;;; Internal structs for template management
-(defstruct (yas--template (:constructor yas--make-template))
+(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
- file
+ load-file
+ save-file
keybinding
uuid
menu-binding-pair
@@ -1079,7 +1108,8 @@ keybinding)."
(defun yas--update-template (table template)
"Add or update TEMPLATE in TABLE.
-Also takes care of adding and updating to the associated menu."
+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))
@@ -1088,7 +1118,8 @@ Also takes care of adding and updating to the associated
menu."
(yas--add-template table template)
;; Take care of the menu
;;
- (yas--update-template-menu table template))
+ (yas--update-template-menu table template)
+ template)
(defun yas--update-template-menu (table template)
"Update every menu-related for TEMPLATE."
@@ -1243,7 +1274,8 @@ Returns (TEMPLATES START END). This function respects
'again)
(setq methods (cdr methods))))
(t
- (yas--warning "Warning invalid element %s in
`yas-key-syntaxes'" method)))
+ (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)
@@ -1333,15 +1365,17 @@ return an expression that when evaluated will issue an
error."
yas--direct-keymaps))
table))
-(defun yas--get-snippet-tables ()
- "Get snippet tables for current buffer.
+(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))))
+ (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.
@@ -1356,16 +1390,6 @@ them all in `yas--menu-table'"
:visible (yas--show-menu-p ',mode)))
menu-keymap))
-
-(defmacro yas--called-interactively-p (&optional kind)
- "A backward-compatible version of `called-interactively-p'.
-
-Optional KIND is as documented at `called-interactively-p'
-in GNU Emacs 24.1 or higher."
- (if (string< emacs-version "24.1")
- '(called-interactively-p)
- `(called-interactively-p ,kind)))
-
;;; Template-related and snippet loading functions
@@ -1380,7 +1404,7 @@ otherwise we attempt to calculate it from FILE.
Return a snippet-definition, i.e. a list
- (KEY TEMPLATE NAME CONDITION GROUP VARS FILE KEYBINDING UUID)
+ (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:
@@ -1417,7 +1441,7 @@ Here's a list of currently recognized directives:
(point-max)))
(setq bound (point))
(goto-char (point-min))
- (while (re-search-forward "^# *\\([^ ]+?\\) *: *\\(.*\\)$"
bound t)
+ (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))
@@ -1544,6 +1568,9 @@ Optional PROMPT sets the prompt to use."
(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)
@@ -1558,11 +1585,13 @@ Optional PROMPT sets the prompt to use."
(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)
- (when (and (fboundp 'ido-completing-read)
- (or (>= emacs-major-version 24)
- ido-mode))
- (yas-completing-prompt prompt choices display-fn #'ido-completing-read)))
+ (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)
@@ -1596,42 +1625,10 @@ Optional PROMPT sets the prompt to use."
(defun yas--define-snippets-1 (snippet snippet-table)
"Helper for `yas-define-snippets'."
- ;; X) Calculate some more defaults on the values returned by
- ;; `yas--parse-template'.
- ;;
- (let* ((file (seventh snippet))
- (key (car snippet))
- (name (or (third snippet)
- (and file
- (file-name-directory file))))
- (condition (fourth snippet))
- (group (fifth snippet))
- (keybinding (yas--read-keybinding (eighth snippet)))
- (uuid (or (ninth snippet)
- name))
- (template (or (gethash uuid (yas--table-uuidhash snippet-table))
- (yas--make-template :uuid uuid
- :table snippet-table))))
- ;; X) populate the template object
- ;;
- (setf (yas--template-key template) key)
- (setf (yas--template-content template) (second snippet))
- (setf (yas--template-name template) (or name key))
- (setf (yas--template-group template) group)
- (setf (yas--template-condition template) condition)
- (setf (yas--template-expand-env template) (sixth snippet))
- (setf (yas--template-file template) (seventh snippet))
- (setf (yas--template-keybinding template) keybinding)
-
- ;; X) Update this template in the appropriate table. This step
- ;; also will take care of adding the key indicators in the
- ;; templates menu entry, if any
- ;;
- (yas--update-template snippet-table template)
- ;; X) Return the template
- ;;
- ;;
- template))
+ ;; 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.
@@ -1639,7 +1636,7 @@ Optional PROMPT sets the prompt to use."
SNIPPETS is a list of snippet definitions, each taking the
following form
- (KEY TEMPLATE NAME CONDITION GROUP EXPAND-ENV FILE KEYBINDING UUID)
+ (KEY TEMPLATE NAME CONDITION GROUP EXPAND-ENV LOAD-FILE KEYBINDING UUID
SAVE-FILE)
Within these, only KEY and TEMPLATE are actually mandatory.
@@ -1661,33 +1658,19 @@ 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
- (progn
+ (let ((print-length nil))
(insert ";;; Snippet definitions:\n;;;\n")
- (let ((literal-snippets (list))
- (print-length nil))
- (dolist (snippet snippets)
- (let ((key (nth 0 snippet))
- (template-content (nth 1 snippet))
- (name (nth 2 snippet))
- (condition (nth 3 snippet))
- (group (nth 4 snippet))
- (expand-env (nth 5 snippet))
- (file nil) ;; omit on purpose
- (binding (nth 7 snippet))
- (uuid (nth 8 snippet)))
- (push `(,key
- ,template-content
- ,name
- ,condition
- ,group
- ,expand-env
- ,file
- ,binding
- ,uuid)
- literal-snippets)))
- (insert (pp-to-string
- `(yas-define-snippets ',mode ',literal-snippets)))
- (insert "\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))
@@ -1699,13 +1682,22 @@ the current buffers contents."
;;; 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 2 "%s has no load file, use 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)
+ (load file 'noerror (<= yas-verbosity 2))
(let ((elfile (concat file ".el")))
(when (file-exists-p elfile)
- (insert ";;; .yas-setup.el support file if any:\n;;;\n")
+ (insert ";;; contents of the .yas-setup.el support file:\n;;;\n")
(insert-file-contents elfile)
(goto-char (point-max))))))
@@ -1753,8 +1745,8 @@ With prefix argument USE-JIT do jit-loading of snippets."
(funcall fun)))
;; Look for buffers that are already in `mode-sym', and so
;; need the new snippets immediately...
- ;;
- (when use-jit
+ ;;
+ (when use-jit
(cl-loop for buffer in (buffer-list)
do (with-current-buffer buffer
(when (eq major-mode mode-sym)
@@ -1762,7 +1754,7 @@ With prefix argument USE-JIT do jit-loading of snippets."
(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
@@ -1781,9 +1773,9 @@ With prefix argument USE-JIT do jit-loading of snippets."
(current-time-string)))))
;; Normal case.
(unless (file-exists-p (concat directory "/" ".yas-skip"))
- (if (and (progn (yas--message 2 "Loading compiled snippets from %s"
directory) t)
- (load (expand-file-name ".yas-compiled-snippets" directory)
'noerror (<= yas-verbosity 3)))
- (yas--message 2 "Loading snippet files from %s" directory)
+ (unless (and (load (expand-file-name ".yas-compiled-snippets" directory)
'noerror (<= yas-verbosity 3))
+ (progn (yas--message 2 "Loaded compiled snippets from %s"
directory) t))
+ (yas--message 2 "Loading snippet files from %s" directory)
(yas--load-directory-2 directory mode-sym)))))
(defun yas--load-directory-2 (directory mode-sym)
@@ -1813,16 +1805,18 @@ With prefix argument USE-JIT do jit-loading of
snippets."
"Reload the directories listed in `yas-snippet-dirs' or
prompt the user to select one."
(let (errors)
- (if yas-snippet-dirs
- (dolist (directory (reverse (yas-snippet-dirs)))
- (cond ((file-directory-p directory)
- (yas-load-directory directory (not nojit))
- (if nojit
- (yas--message 3 "Loaded %s" directory)
- (yas--message 3 "Prepared just-in-time loading for %s"
directory)))
- (t
- (push (yas--message 0 "Check your `yas-snippet-dirs': %s is
not a directory" directory) errors))))
- (call-interactively 'yas-load-directory))
+ (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 3 "Loaded %s" directory)
+ (yas--message 3 "Prepared just-in-time loading for %s"
directory)))
+ (t
+ (push (yas--message 0 "Check your `yas-snippet-dirs': %s is not
a directory" directory) errors)))))
errors))
(defun yas-reload-all (&optional no-jit interactive)
@@ -1948,7 +1942,7 @@ This works by stubbing a few functions, then calling
(interactive)
(message (concat "yasnippet (version "
yas--version
- ") -- pluskid <address@hidden>/joaotavora
<address@hidden>")))
+ ") -- pluskid/joaotavora/npostavs")))
;;; Apropos snippet menu:
@@ -2228,12 +2222,12 @@ Common gateway for `yas-expand-from-trigger-key' and
;; 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)
(assert (or (null beyond-yasnippet) (commandp beyond-yasnippet)))
- (setq this-original-command beyond-yasnippet)
+ (setq this-command beyond-yasnippet)
(when beyond-yasnippet
(call-interactively beyond-yasnippet))))
((and (listp yas-fallback-behavior)
@@ -2305,6 +2299,28 @@ Honours `yas-choose-tables-first',
`yas-choose-keys-first' and
(remove-duplicates (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 content for the snippet 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'."
+ (let ((snippet (yas--lookup-snippet-1 name mode)))
+ (cond
+ (snippet (yas--template-content snippet))
+ (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'.
@@ -2339,7 +2355,6 @@ visited file in `snippet-mode'."
(interactive)
(let* ((yas-buffer-local-condition 'always)
(templates (yas--all-templates (yas--get-snippet-tables)))
- (yas-prompt-functions '(yas-ido-prompt yas-completing-prompt))
(template (and templates
(or (yas--prompt-for-template templates
"Choose a snippet
template to edit: ")
@@ -2351,7 +2366,7 @@ visited file in `snippet-mode'."
(defun yas--visit-snippet-file-1 (template)
"Helper for `yas-visit-snippet-file'."
- (let ((file (yas--template-file template)))
+ (let ((file (yas--template-get-file template)))
(cond ((and file (file-readable-p file))
(find-file-other-window file)
(snippet-mode)
@@ -2397,7 +2412,7 @@ where snippets of table might exist."
(let ((main-dir (replace-regexp-in-string
"/+$" ""
(or (first (or (yas-snippet-dirs)
- (setq yas-snippet-dirs
'("~/.emacs.d/snippets")))))))
+ (setq yas-snippet-dirs (list
yas--default-user-snippets-dir)))))))
(tables (or (and table
(list table))
(yas--get-snippet-tables))))
@@ -2525,7 +2540,7 @@ When called interactively, prompt for the table name."
;; template which is already loaded and neatly positioned,...
;;
(yas--editing-template
- (yas--define-snippets-1 (yas--parse-template (yas--template-file
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'
@@ -2555,29 +2570,27 @@ 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))
(yas-load-snippet-buffer table t)
- (when (and (or
- ;; Only offer to save this if it looks like a library or new
- ;; snippet (loaded from elisp, from a dir in `yas-snippet-dirs'
- ;; which is not the first, or from an unwritable file)
- ;;
- (not (yas--template-file yas--editing-template))
- (not (file-writable-p (yas--template-file
yas--editing-template)))
- (and (listp yas-snippet-dirs)
- (second yas-snippet-dirs)
- (not (string-match (expand-file-name (first
yas-snippet-dirs))
- (yas--template-file
yas--editing-template)))))
- (y-or-n-p (yas--format "Looks like a library or new snippet. Save
to new file? ")))
- (let* ((option (first (yas--guess-snippet-directories (yas--template-table
yas--editing-template))))
- (chosen (and option
- (yas--make-directory-maybe option))))
- (when chosen
- (let ((default-file-name (or (and (yas--template-file
yas--editing-template)
- (file-name-nondirectory
(yas--template-file yas--editing-template)))
- (yas--template-name
yas--editing-template))))
- (write-file (concat chosen "/"
- (read-from-minibuffer (format "File name to
create in %s? " chosen)
- default-file-name)))
- (setf (yas--template-file yas--editing-template)
buffer-file-name)))))
+ (let ((file (yas--template-get-file yas--editing-template)))
+ (when (and (or
+ ;; Only offer to save this if it looks like a library or new
+ ;; snippet (loaded from elisp, from a dir in `yas-snippet-dirs'
+ ;; which is not the first, or from an unwritable file)
+ ;;
+ (not file)
+ (not (file-writable-p file))
+ (and (cdr-safe yas-snippet-dirs)
+ (not (string-prefix-p (expand-file-name (car
yas-snippet-dirs)) file))))
+ (y-or-n-p (yas--format "Looks like a library or new snippet.
Save to new file? ")))
+ (let* ((option (first (yas--guess-snippet-directories
(yas--template-table yas--editing-template))))
+ (chosen (and option
+ (yas--make-directory-maybe option))))
+ (when chosen
+ (let ((default-file-name (or (and file (file-name-nondirectory file))
+ (yas--template-name
yas--editing-template))))
+ (write-file (concat chosen "/"
+ (read-from-minibuffer (format "File name to
create in %s? " chosen)
+ default-file-name)))
+ (setf (yas--template-load-file yas--editing-template)
buffer-file-name))))))
(when buffer-file-name
(save-buffer)
(quit-window kill)))
@@ -3024,11 +3037,11 @@ through the field's start point"
The most recently-inserted snippets are returned first."
(sort
- (remove nil (remove-duplicates (mapcar #'(lambda (ov)
- (overlay-get ov 'yas--snippet))
- (if all-snippets
- (overlays-in (point-min)
(point-max))
- (nconc (overlays-at (point))
(overlays-at (1- (point))))))))
+ (delq nil (delete-dups
+ (mapcar (lambda (ov) (overlay-get ov 'yas--snippet))
+ (if all-snippets (overlays-in (point-min) (point-max))
+ (nconc (overlays-at (point))
+ (overlays-at (1- (point))))))))
#'(lambda (s1 s2)
(<= (yas--snippet-id s2) (yas--snippet-id s1)))))
@@ -3141,12 +3154,6 @@ Also create some protection overlays"
(defvar yas--inhibit-overlay-hooks nil
"Bind this temporarily to non-nil to prevent running
`yas--on-*-modification'.")
-(defmacro yas--inhibit-overlay-hooks (&rest body)
- "Run BODY with `yas--inhibit-overlay-hooks' set to t."
- (declare (indent 0))
- `(let ((yas--inhibit-overlay-hooks t))
- ,@body))
-
(defvar yas-snippet-beg nil "Beginning position of the last snippet
committed.")
(defvar yas-snippet-end nil "End position of the last snippet committed.")
@@ -3166,7 +3173,7 @@ This renders the snippet as ordinary text."
(setq yas-snippet-end (overlay-end control-overlay))
(delete-overlay control-overlay))
- (yas--inhibit-overlay-hooks
+ (let ((yas--inhibit-overlay-hooks t))
(when yas--active-field-overlay
(delete-overlay yas--active-field-overlay))
(when yas--field-protection-overlays
@@ -3381,10 +3388,10 @@ Move the overlay, or create it if it does not exit."
(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 it point it
-at field start. This hook doesn't do anything if an undo is in
-progress."
+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.
(yas--undo-in-progress))
(let* ((field (overlay-get overlay 'yas--field))
(snippet (overlay-get yas--active-field-overlay 'yas--snippet)))
@@ -3394,11 +3401,9 @@ progress."
(yas--field-update-display field))
(yas--update-mirrors snippet))
(field
- (when (and (not after?)
+ (when (and (eq this-command 'self-insert-command)
(not (yas--field-modified-p field))
- (eq (point) (if (markerp (yas--field-start field))
- (marker-position (yas--field-start
field))
- (yas--field-start field))))
+ (= (point) (yas--field-start field)))
(yas--skip-and-clear field))
(setf (yas--field-modified-p field) t))))))
@@ -3411,7 +3416,7 @@ progress."
;; 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.
@@ -3425,7 +3430,7 @@ Move the overlays, or create them if they do not exit."
;;
(when (< (buffer-size) end)
(save-excursion
- (yas--inhibit-overlay-hooks
+ (let ((yas--inhibit-overlay-hooks t))
(goto-char (point-max))
(newline))))
;; go on to normal overlay creation/moving
@@ -3541,7 +3546,7 @@ considered when expanding the snippet."
;; them mostly to make the undo information
;;
(setq yas--start-column (current-column))
- (yas--inhibit-overlay-hooks
+ (let ((yas--inhibit-overlay-hooks t))
(setq snippet
(if expand-env
(eval `(let* ,expand-env
@@ -3999,11 +4004,10 @@ with their evaluated value into
`yas--backquote-markers-and-strings'."
(set-marker marker nil)))))
(defun yas--scan-sexps (from count)
- (condition-case _
+ (ignore-errors
+ (save-match-data ; `scan-sexps' may modify match data.
(with-syntax-table (standard-syntax-table)
- (scan-sexps from count))
- (error
- nil)))
+ (scan-sexps from count)))))
(defun yas--make-marker (pos)
"Create a marker at POS with nil `marker-insertion-type'."
@@ -4035,9 +4039,8 @@ When multiple expressions are found, only the last one
counts."
;; after the ":", this will be
;; caught as a mirror with
;; transform later.
- (not (save-match-data
- (eq (string-match "$[ \t\n]*("
-
(match-string-no-properties 2)) 0)))
+ (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
@@ -4225,7 +4228,7 @@ When multiple expressions are found, only the last one
counts."
(not (string= reflection (buffer-substring-no-properties
(yas--mirror-start mirror)
(yas--mirror-end mirror)))))
(goto-char (yas--mirror-start mirror))
- (yas--inhibit-overlay-hooks
+ (let ((yas--inhibit-overlay-hooks t))
(insert reflection))
(if (> (yas--mirror-end mirror) (point))
(delete-region (point) (yas--mirror-end mirror))
@@ -4244,7 +4247,7 @@ When multiple expressions are found, only the last one
counts."
(yas--field-end field)))))
(setf (yas--field-modified-p field) t)
(goto-char (yas--field-start field))
- (yas--inhibit-overlay-hooks
+ (let ((yas--inhibit-overlay-hooks t))
(insert transformed)
(if (> (yas--field-end field) (point))
(delete-region (point) (yas--field-end field))
@@ -4292,7 +4295,7 @@ When multiple expressions are found, only the last one
counts."
(or (and fallback
(format "call command `%s'."
(pp-to-string fallback)))
- "do nothing (`yas-expand' doesn't shadow\nanything).")))
+ "do nothing (`yas-expand' doesn't
override\nanything).")))
((eq yas-fallback-behavior 'return-nil)
"do nothing.")
(t "defer to `yas-fallback-behavior' (which see)."))))
@@ -4434,6 +4437,7 @@ and return the directory. Return nil if not found."
(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
diff --git a/packages/ztree/README.md b/packages/ztree/README.md
new file mode 100644
index 0000000..dc1907a
--- /dev/null
+++ b/packages/ztree/README.md
@@ -0,0 +1,108 @@
+# 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 address@hidden(mailto:address@hidden). 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:address@hidden) if everything is in place.
+
diff --git a/packages/ztree/ztree-diff-model.el
b/packages/ztree/ztree-diff-model.el
new file mode 100644
index 0000000..b4ad75f
--- /dev/null
+++ b/packages/ztree/ztree-diff-model.el
@@ -0,0 +1,394 @@
+;;; ztree-diff-model.el --- diff model for directory trees -*-
lexical-binding: t; -*-
+
+;; Copyright (C) 2013-2016 Free Software Foundation, Inc.
+;;
+;; Author: Alexey Veretennikov <address@hidden>
+;;
+;; 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-untrampify-filename (file)
+ "Return FILE as the local file name."
+ ;; FIXME: We shouldn't use internal Tramp functions.
+ (require 'tramp)
+ (declare-function tramp-tramp-file-p "tramp" (name))
+ (declare-function tramp-file-name-localname "tramp" (vec))
+ (declare-function tramp-dissect-file-name "tramp" (name &optional nodefault))
+ (if (not (tramp-tramp-file-p file))
+ file
+ (tramp-file-name-localname (tramp-dissect-file-name file))))
+
+(defun ztree-diff-modef-quotify-string (x)
+ "Surround string X with quotes."
+ (concat "\"" x "\""))
+
+(defun ztree-diff-model-files-equal (file1 file2)
+ "Compare files FILE1 and FILE2 using external diff.
+Returns t if equal."
+ ;; FIXME: This "untrampification" only works if both file1 and file2 are on
+ ;; the same host.
+ ;; FIXME: We assume that default-directory is also on the same host as
+ ;; file(1|2).
+ (let* ((file1-untrampified (ztree-diff-untrampify-filename
(ztree-diff-modef-quotify-string file1)))
+ (file2-untrampified (ztree-diff-untrampify-filename
(ztree-diff-modef-quotify-string file2)))
+ (diff-command (concat diff-command " -q" " " file1-untrampified " "
file2-untrampified))
+ (diff-output (shell-command-to-string diff-command)))
+ (if (<= (length diff-output) 2) 'same 'diff)))
+
+(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 (progess-fun)
+ (setf ztree-diff-model-progress-fun progess-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
new file mode 100644
index 0000000..ed3d5f9
--- /dev/null
+++ b/packages/ztree/ztree-diff.el
@@ -0,0 +1,559 @@
+;;; ztree-diff.el --- Text mode diff for directory trees -*- lexical-binding:
t; -*-
+
+;; Copyright (C) 2013-2016 Free Software Foundation, Inc.
+;;
+;; Author: Alexey Veretennikov <address@hidden>
+;;
+;; 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 mesage 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))
+ (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
new file mode 100644
index 0000000..d3d3b25
--- /dev/null
+++ b/packages/ztree/ztree-dir.el
@@ -0,0 +1,171 @@
+;;; ztree-dir.el --- Text mode directory tree -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2013-2016 Free Software Foundation, Inc.
+;;
+;; Author: Alexey Veretennikov <address@hidden>
+;;
+;; 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)
+(eval-when-compile (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
+ "If set to true moves the focus to opened window when the
+user press RETURN on 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)))
+
+
+
+
+;;
+;; 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))
+
+
+
+
+;;;###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
+ (lambda (x) (directory-files x 'full))
+ 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
new file mode 100644
index 0000000..ec49457
--- /dev/null
+++ b/packages/ztree/ztree-util.el
@@ -0,0 +1,70 @@
+;;; ztree-util.el --- Auxiliary utilities for the ztree package -*-
lexical-binding: t; -*-
+
+;; Copyright (C) 2013-2016 Free Software Foundation, Inc.
+;;
+;; Author: Alexey Veretennikov <address@hidden>
+;;
+;; 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";
+ (ztree-printable-string (file-name-nondirectory (directory-file-name file))))
+
+(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)))
+
+(provide 'ztree-util)
+
+;;; ztree-util.el ends here
diff --git a/packages/ztree/ztree-view.el b/packages/ztree/ztree-view.el
new file mode 100644
index 0000000..3244ccc
--- /dev/null
+++ b/packages/ztree/ztree-view.el
@@ -0,0 +1,667 @@
+;;; ztree-view.el --- Text mode tree view (buffer) -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2013-2016 Free Software Foundation, Inc.
+;;
+;; Author: Alexey Veretennikov <address@hidden>
+;;
+;; 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 subsequest BS keys (to identify double BS).
+Used in order to not to use cl package and `lexical-let'")
+
+(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 scroll-to-line (line)
+ "Recommended way to set the cursor to specified LINE."
+ (goto-char (point-min))
+ (forward-line (1- 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)
+ (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
+ (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))
+ (scroll-to-line (if line line ztree-start-line))))
+
+
+(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/ada-mode/ada-mode-compat-24.2.el b/packages/ztree/ztree.el
similarity index 57%
copy from packages/ada-mode/ada-mode-compat-24.2.el
copy to packages/ztree/ztree.el
index aa152db..300ed85 100644
--- a/packages/ada-mode/ada-mode-compat-24.2.el
+++ b/packages/ztree/ztree.el
@@ -1,31 +1,37 @@
-;;; ada-mode-compat-24.2.el --- Implement current Emacs features not present
in Emacs 24.2
-
-;; Copyright (C) 2014 Free Software Foundation, Inc.
-
+;;; ztree.el --- Text mode directory tree -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2013-2016 Free Software Foundation, Inc.
+;;
+;; Author: Alexey Veretennikov <address@hidden>
+;; Created: 2013-11-11
+;; Version: 1.0.3
+;; 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:
-;; using cl-lib 0.4 from Gnu ELPA
-
-(defun file-name-base (&optional filename)
- "Return the base name of the FILENAME: no directory, no extension.
-FILENAME defaults to `buffer-file-name'."
- (file-name-sans-extension
- (file-name-nondirectory (or filename (buffer-file-name)))))
-
-
-(provide 'ada-mode-compat-24.2)
+(require 'ztree-dir)
+(require 'ztree-diff)
-;; end of file
+(provide 'ztree)
+;;; ztree.el ends here