[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/names b269f61 44/44: Merge remote-tracking branch 'upst
|
From: |
Stefan Monnier |
|
Subject: |
[elpa] externals/names b269f61 44/44: Merge remote-tracking branch 'upstream/names/main' into externals/names |
|
Date: |
Sat, 27 Mar 2021 14:40:16 -0400 (EDT) |
branch: externals/names
commit b269f6117575e82bcec48b8d3da0443c1e453c77
Merge: 4e7c577 d8baba5
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>
Merge remote-tracking branch 'upstream/names/main' into externals/names
---
.gitignore | 16 +
.travis.yml | 155 +
Makefile | 80 +
Readme.org | 10 +-
names.el | 3 +-
tests/.nosearch | 0
tests/aggressive-indent-tests.el | 31 +
tests/aggressive-indent.el | 170 +
tests/auctex-11.87.7/auctex-autoloads.el | 382 ++
tests/auctex-11.87.7/auctex-pkg.el | 2 +
tests/auctex-11.87.7/auctex.el | 34 +
tests/auctex-11.87.7/bib-cite.el | 2622 +++++++++++
tests/auctex-11.87.7/circ.tex | 479 ++
tests/auctex-11.87.7/context-en.el | 216 +
tests/auctex-11.87.7/context-nl.el | 197 +
tests/auctex-11.87.7/context.el | 1662 +++++++
tests/auctex-11.87.7/font-latex.el | 1986 +++++++++
tests/auctex-11.87.7/latex.el | 5601 +++++++++++++++++++++++
tests/auctex-11.87.7/latex/.cvsignore | 16 +
tests/auctex-11.87.7/latex/README | 64 +
tests/auctex-11.87.7/latex/bootstrap.ins | 4 +
tests/auctex-11.87.7/latex/prauctex.cfg | 48 +
tests/auctex-11.87.7/latex/prauctex.def | 61 +
tests/auctex-11.87.7/latex/prcounters.def | 38 +
tests/auctex-11.87.7/latex/preview.dtx | 1872 ++++++++
tests/auctex-11.87.7/latex/preview.sty | 391 ++
tests/auctex-11.87.7/latex/prfootnotes.def | 28 +
tests/auctex-11.87.7/latex/prlyx.def | 32 +
tests/auctex-11.87.7/latex/prshowbox.def | 32 +
tests/auctex-11.87.7/latex/prshowlabels.def | 67 +
tests/auctex-11.87.7/latex/prtightpage.def | 146 +
tests/auctex-11.87.7/latex/prtracingall.def | 30 +
tests/auctex-11.87.7/multi-prompt.el | 226 +
tests/auctex-11.87.7/plain-tex.el | 314 ++
tests/auctex-11.87.7/preview.el | 3616 +++++++++++++++
tests/auctex-11.87.7/prv-emacs.el | 600 +++
tests/auctex-11.87.7/prv-xemacs.el | 743 ++++
tests/auctex-11.87.7/style/.nosearch | 1 +
tests/auctex-11.87.7/style/CJK.el | 93 +
tests/auctex-11.87.7/style/CJKutf8.el | 38 +
tests/auctex-11.87.7/style/MinionPro.el | 71 +
tests/auctex-11.87.7/style/alltt.el | 55 +
tests/auctex-11.87.7/style/alphanum.el | 99 +
tests/auctex-11.87.7/style/amsart.el | 10 +
tests/auctex-11.87.7/style/amsbook.el | 10 +
tests/auctex-11.87.7/style/amsbsy.el | 18 +
tests/auctex-11.87.7/style/amsmath.el | 181 +
tests/auctex-11.87.7/style/amsopn.el | 19 +
tests/auctex-11.87.7/style/amstex.el | 60 +
tests/auctex-11.87.7/style/amstext.el | 16 +
tests/auctex-11.87.7/style/amsthm.el | 53 +
tests/auctex-11.87.7/style/article.el | 12 +
tests/auctex-11.87.7/style/austrian.el | 39 +
tests/auctex-11.87.7/style/babel.el | 108 +
tests/auctex-11.87.7/style/beamer.el | 336 ++
tests/auctex-11.87.7/style/biblatex.el | 47 +
tests/auctex-11.87.7/style/book.el | 12 +
tests/auctex-11.87.7/style/booktabs.el | 74 +
tests/auctex-11.87.7/style/bulgarian.el | 54 +
tests/auctex-11.87.7/style/captcont.el | 46 +
tests/auctex-11.87.7/style/comment.el | 69 +
tests/auctex-11.87.7/style/csquotes.el | 245 +
tests/auctex-11.87.7/style/czech.el | 8 +
tests/auctex-11.87.7/style/danish.el | 17 +
tests/auctex-11.87.7/style/dinbrief.el | 165 +
tests/auctex-11.87.7/style/dk-bib.el | 62 +
tests/auctex-11.87.7/style/dk.el | 11 +
tests/auctex-11.87.7/style/doc.el | 158 +
tests/auctex-11.87.7/style/dutch.el | 11 +
tests/auctex-11.87.7/style/emp.el | 84 +
tests/auctex-11.87.7/style/epsf.el | 37 +
tests/auctex-11.87.7/style/fancyref.el | 122 +
tests/auctex-11.87.7/style/flashcards.el | 60 +
tests/auctex-11.87.7/style/foils.el | 46 +
tests/auctex-11.87.7/style/francais.el | 41 +
tests/auctex-11.87.7/style/french.el | 48 +
tests/auctex-11.87.7/style/frenchb.el | 78 +
tests/auctex-11.87.7/style/german.el | 49 +
tests/auctex-11.87.7/style/graphics.el | 10 +
tests/auctex-11.87.7/style/graphicx.el | 302 ++
tests/auctex-11.87.7/style/harvard.el | 128 +
tests/auctex-11.87.7/style/hyperref.el | 124 +
tests/auctex-11.87.7/style/icelandic.el | 53 +
tests/auctex-11.87.7/style/index.el | 83 +
tests/auctex-11.87.7/style/inputenc.el | 86 +
tests/auctex-11.87.7/style/italian.el | 59 +
tests/auctex-11.87.7/style/j-article.el | 12 +
tests/auctex-11.87.7/style/j-book.el | 12 +
tests/auctex-11.87.7/style/j-report.el | 12 +
tests/auctex-11.87.7/style/jarticle.el | 12 +
tests/auctex-11.87.7/style/jbook.el | 12 +
tests/auctex-11.87.7/style/jreport.el | 13 +
tests/auctex-11.87.7/style/jsarticle.el | 12 +
tests/auctex-11.87.7/style/jsbook.el | 12 +
tests/auctex-11.87.7/style/jura.el | 39 +
tests/auctex-11.87.7/style/jurabib.el | 634 +++
tests/auctex-11.87.7/style/latexinfo.el | 181 +
tests/auctex-11.87.7/style/letter.el | 144 +
tests/auctex-11.87.7/style/lettrine.el | 74 +
tests/auctex-11.87.7/style/listings.el | 243 +
tests/auctex-11.87.7/style/ltx-base.el | 86 +
tests/auctex-11.87.7/style/ltxdoc.el | 40 +
tests/auctex-11.87.7/style/makeidx.el | 48 +
tests/auctex-11.87.7/style/mdwlist.el | 63 +
tests/auctex-11.87.7/style/multicol.el | 62 +
tests/auctex-11.87.7/style/multido.el | 52 +
tests/auctex-11.87.7/style/multind.el | 61 +
tests/auctex-11.87.7/style/natbib.el | 131 +
tests/auctex-11.87.7/style/naustrian.el | 39 +
tests/auctex-11.87.7/style/ngerman.el | 49 +
tests/auctex-11.87.7/style/nicefrac.el | 45 +
tests/auctex-11.87.7/style/nomencl.el | 70 +
tests/auctex-11.87.7/style/paralist.el | 104 +
tests/auctex-11.87.7/style/pdfsync.el | 91 +
tests/auctex-11.87.7/style/plfonts.el | 31 +
tests/auctex-11.87.7/style/plhb.el | 31 +
tests/auctex-11.87.7/style/polish.el | 52 +
tests/auctex-11.87.7/style/polski.el | 55 +
tests/auctex-11.87.7/style/prosper.el | 192 +
tests/auctex-11.87.7/style/psfig.el | 81 +
tests/auctex-11.87.7/style/pst-grad.el | 65 +
tests/auctex-11.87.7/style/pst-node.el | 191 +
tests/auctex-11.87.7/style/pst-plot.el | 137 +
tests/auctex-11.87.7/style/pst-slpe.el | 67 +
tests/auctex-11.87.7/style/pstricks.el | 866 ++++
tests/auctex-11.87.7/style/report.el | 12 +
tests/auctex-11.87.7/style/ruby.el | 49 +
tests/auctex-11.87.7/style/scrartcl.el | 26 +
tests/auctex-11.87.7/style/scrbase.el | 222 +
tests/auctex-11.87.7/style/scrbook.el | 62 +
tests/auctex-11.87.7/style/scrlttr2.el | 239 +
tests/auctex-11.87.7/style/scrpage2.el | 129 +
tests/auctex-11.87.7/style/scrreprt.el | 63 +
tests/auctex-11.87.7/style/setspace.el | 61 +
tests/auctex-11.87.7/style/shortvrb.el | 56 +
tests/auctex-11.87.7/style/slides.el | 41 +
tests/auctex-11.87.7/style/slovak.el | 11 +
tests/auctex-11.87.7/style/subfigure.el | 73 +
tests/auctex-11.87.7/style/swedish.el | 14 +
tests/auctex-11.87.7/style/tabularx.el | 52 +
tests/auctex-11.87.7/style/units.el | 49 +
tests/auctex-11.87.7/style/url.el | 95 +
tests/auctex-11.87.7/style/varioref.el | 63 +
tests/auctex-11.87.7/style/verbatim.el | 43 +
tests/auctex-11.87.7/style/virtex.el | 82 +
tests/auctex-11.87.7/style/xspace.el | 51 +
tests/auctex-11.87.7/tex-bar.el | 513 +++
tests/auctex-11.87.7/tex-buf.el | 2207 +++++++++
tests/auctex-11.87.7/tex-fold.el | 983 +++++
tests/auctex-11.87.7/tex-font.el | 173 +
tests/auctex-11.87.7/tex-info.el | 787 ++++
tests/auctex-11.87.7/tex-jp.el | 847 ++++
tests/auctex-11.87.7/tex-mik.el | 71 +
tests/auctex-11.87.7/tex-site.el | 172 +
tests/auctex-11.87.7/tex-style.el | 374 ++
tests/auctex-11.87.7/tex-wizard.el | 111 +
tests/auctex-11.87.7/tex.el | 5650 ++++++++++++++++++++++++
tests/auctex-11.87.7/texmathp.el | 414 ++
tests/auctex-11.87.7/toolbar-x.el | 2154 +++++++++
tests/cl-lib.el | 410 ++
tests/dash-functional.el | 155 +
tests/dash-tests.el | 653 +++
tests/dash.el | 1747 ++++++++
tests/elnode-tests.el | 1883 ++++++++
tests/elnode/creole.el | 1883 ++++++++
tests/elnode/db.el | 317 ++
tests/elnode/default-webserver-image.png | Bin 0 -> 8133 bytes
tests/elnode/default-webserver-test.html | 20 +
tests/elnode/default-wiki-index.creole | 113 +
tests/elnode/default-wiki-logo.gif | Bin 0 -> 29065 bytes
tests/elnode/elnode-bm.el | 110 +
tests/elnode/elnode-compat.el | 35 +
tests/elnode/elnode-js.el | 147 +
tests/elnode/elnode-lists.el | 163 +
tests/elnode/elnode-log-mode.el | 22 +
tests/elnode/elnode-proxy.el | 273 ++
tests/elnode/elnode-rle.el | 387 ++
tests/elnode/elnode-testsupport.el | 239 +
tests/elnode/elnode-tools.el | 103 +
tests/elnode/elnode-wiki.el | 232 +
tests/elnode/elnode.el | 3772 ++++++++++++++++
tests/elnode/elnode_tutorial.creole | 426 ++
tests/elnode/elnode_tutorial.org | 127 +
tests/elnode/fakir.el | 609 +++
tests/elnode/kv.el | 463 ++
tests/elnode/recipes/elnode | 30 +
tests/elnode/web.el | 717 +++
tests/elpa/aggressive-indent-autoloads-24.1.el | 64 +
tests/elpa/aggressive-indent-autoloads-24.2.el | 64 +
tests/elpa/aggressive-indent-autoloads-24.3.el | 64 +
tests/elpa/aggressive-indent-autoloads-25.0.el | 57 +
tests/elpa/aggressive-indent-autoloads.el | 57 +
tests/ert.el | 2544 +++++++++++
tests/google-this-tests.el | 79 +
tests/google-this.el | 472 ++
tests/latex-extra-tests.el | 71 +
tests/latex-extra.el | 929 ++++
tests/macro-test-aux.el | 51 +
tests/names-tests.el | 292 ++
tests/noflet.el | 157 +
tests/run-tests.sh | 14 +
tests/s-tests.el | 375 ++
tests/s.el | 571 +++
tests/test.tex | 40 +
tests/tests.el | 20 +
205 files changed, 66603 insertions(+), 6 deletions(-)
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..19c3ec9
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,16 @@
+*~
+*.elc
+\#*#
+/tests/junk.el
+/la.el
+/dt.el
+/ex.el
+/ex2.el
+/tests/flycheck/
+/tests/out.tex
+/tests/elpa/aggressive-indent-0.1/
+/tests/elpa/names-*/
+
+# ELPA-generated files
+/names-autoloads.el
+/names-pkg.el
diff --git a/.travis.yml b/.travis.yml
new file mode 100644
index 0000000..c3b8248
--- /dev/null
+++ b/.travis.yml
@@ -0,0 +1,155 @@
+###
+### Notes
+###
+### The travis web interface may choke silently and fail to
+### update when there are issues with the .travis.yml file.
+###
+### The "travis-lint" command-line tool does not catch all
+### errors which may lead to silent failure.
+###
+### Shell-style comments in this file must have "#" as the
+### *first* character of the line.
+###
+
+###
+### language
+###
+
+language: emacs-lisp
+
+###
+### defining the build matrix
+###
+### ===> <===
+### ===> each variation in env/matrix will be built and tested <===
+### ===> <===
+###
+### variables under env/global are available to the build process
+### but don't cause the creation of a separate variation
+###
+
+env:
+ - EMACS=emacs-24.1-bin METHOD=evm
+ - EMACS=emacs-24.2-bin METHOD=evm
+ - EMACS=emacs-24.3-bin METHOD=evm
+ - EMACS=emacs24 METHOD=manual
+ - EMACS=emacs-snapshot METHOD=manual
+
+###
+### allowing build failures
+###
+
+matrix:
+ fast_finish: true
+ allow_failures:
+ - env: EMACS=emacs-23.4-bin METHOD=evm
+
+###
+### limit build attempts to defined branches
+###
+### notes
+###
+### This controls which branches are built.
+###
+### You can also control which branches affect the web badge, by
+### appending "?branch=master,staging,production" to the end of the
+### image URL (replacing "master,staging,production" with a
+### comma-separated list of branches to be reflected in the badge).
+###
+#
+# branches:
+# only:
+# - master
+#
+
+###
+### runtime initialization
+###
+### notes
+###
+### emacs22 is extracted manually from Ubuntu Maverick.
+###
+### emacs23 is the stock default, but is updated anyway to
+### a GUI-capable version, which will have certain additional
+### functions compiled in.
+###
+### emacs24 (current stable release) is obtained from the
+### cassou PPA: http://launchpad.net/~cassou/+archive/emacs
+###
+### emacs-snapshot (trunk) is obtained from the Ubuntu Emacs Lisp PPA:
+### https://launchpad.net/~ubuntu-elisp/+archive/ppa
+### For the emacs-snapshot build, bleeding-edge versions
+### of all test dependencies are also used.
+###
+
+before_install:
+ - git submodule --quiet update --init --recursive
+
+install:
+ - if [ "$EMACS" = 'emacs23' ]; then
+ sudo apt-get -qq update &&
+ sudo apt-get -qq -f install &&
+ sudo apt-get -qq install emacs23-gtk emacs23-el;
+ fi
+ - if [ "$METHOD" = 'evm' ]; then
+ sudo mkdir /usr/local/evm &&
+ sudo chown travis:travis /usr/local/evm &&
+ sudo add-apt-repository -y ppa:cassou/emacs &&
+ sudo apt-get update -qq &&
+ sudo apt-get build-dep -qq emacs23 &&
+ sudo apt-get build-dep -qq emacs24 &&
+ curl -fsSkL https://raw.github.com/rejeep/evm/master/go | bash &&
+ export PATH="~/.evm/bin:$PATH" &&
+ chmod +x ~/.evm/bin/evm &&
+ ~/.evm/bin/evm install $EMACS &&
+ ~/.evm/bin/evm use $EMACS &&
+ FULL_EMACS_PATH="/usr/local/evm/$EMACS/bin/emacs" &&
+ export EMACS="$FULL_EMACS_PATH" &&
+ EMACS="$FULL_EMACS_PATH";
+ fi
+ - if [ "$EMACS" = 'emacs24' ]; then
+ sudo add-apt-repository -y ppa:cassou/emacs &&
+ sudo apt-get -qq update &&
+ sudo apt-get -qq -f install &&
+ sudo apt-get -qq install emacs24 emacs24-el;
+ fi
+ - if [ "$EMACS" = 'emacs-snapshot' ]; then
+ sudo add-apt-repository -y ppa:ubuntu-elisp/ppa &&
+ sudo apt-get -qq update &&
+ sudo apt-get -qq -f install &&
+ sudo apt-get -qq install emacs-snapshot &&
+ sudo apt-get -qq install emacs-snapshot-el;
+ fi
+
+before_script:
+# - if [ "$EMACS" = 'emacs-snapshot' ]; then
+# make downloads-latest;
+# else
+# make downloads;
+# fi
+
+###
+### the actual build/test command
+###
+### Use "make test-batch" to test without byte-compiling.
+### The default command avoids byte-compiling on Emacs 22.
+###
+
+script:
+ echo "Method is $METHOD " && $EMACS --version && cd tests && chmod +x
run-tests.sh && EMACS="$EMACS" ./run-tests.sh
+
+###
+### settings
+###
+
+notifications:
+ email: false
+
+#
+# Emacs
+#
+# Local Variables:
+# indent-tabs-mode: nil
+# coding: utf-8
+# End:
+#
diff --git a/Makefile b/Makefile
new file mode 100644
index 0000000..012ea8e
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,80 @@
+EMACS=emacs
+
+EMACS_CLEAN=-Q
+EMACS_BATCH=$(EMACS_CLEAN) --batch -L "auctex-11.87.7/" -L
"tests/auctex-11.87.7/" -l "auctex-autoloads.el" -L "elnode/" -L
"tests/elnode/"
+TESTS=
+
+CURL=curl --silent
+WORK_DIR=$(shell pwd)
+PACKAGE_NAME=$(shell basename $(WORK_DIR))
+AUTOLOADS_FILE=$(PACKAGE_NAME)-autoloads.el
+TRAVIS_FILE=.travis.yml
+TEST_DIR=tests
+TEST_DEP_1=ert
+TEST_DEP_2=cl-lib
+TEST_DEP_1_STABLE_URL=http://git.savannah.gnu.org/cgit/emacs.git/plain/lisp/emacs-lisp/ert.el?h=emacs-24.3
+TEST_DEP_2_STABLE_URL=http://elpa.gnu.org/packages/cl-lib-0.5.el
+TEST_DEP_1_LATEST_URL=http://git.savannah.gnu.org/cgit/emacs.git/plain/lisp/emacs-lisp/ert.el?h=master
+TEST_DEP_2_LATEST_URL=http://elpa.gnu.org/packages/cl-lib-0.5.el
+
+.PHONY : build downloads downloads-latest autoloads test-autoloads test-travis
\
+ test test-interactive clean edit test-dep-1 test-dep-2 test-dep-3
\
+ test-dep-4 test-dep-5 test-dep-6 test-dep-7 test-dep-8 test-dep-9
+
+build :
+ echo "hi " $(shell pwd) && \
+ $(EMACS) $(EMACS_BATCH) -L . -L .. -L tests/ --eval \
+ "(progn \
+ (unless (fboundp 'function-put) (defalias 'function-put #'(lambda
(f prop value) (put f prop value)))) \
+ (defun define-error (name message &optional parent) (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)))) \
+ (setq byte-compile-error-on-warn t) \
+ (batch-byte-compile))" *.el
+
+test-dep-1 :
+ @cd $(TEST_DIR) && \
+ $(EMACS) $(EMACS_BATCH) -L . -L .. -l $(TEST_DEP_1) || \
+ (echo "Can't load test dependency $(TEST_DEP_1).el, run 'make
downloads' to fetch it" ; exit 1)
+
+test-dep-2 :
+ @cd $(TEST_DIR) && \
+ $(EMACS) $(EMACS_BATCH) -L . -L .. -l $(TEST_DEP_2) || \
+ (echo "Can't load test dependency $(TEST_DEP_2).el, run 'make
downloads' to fetch it" ; exit 1)
+
+downloads :
+ $(CURL) '$(TEST_DEP_1_STABLE_URL)' > $(TEST_DIR)/$(TEST_DEP_1).el && \
+ $(CURL) '$(TEST_DEP_2_STABLE_URL)' > $(TEST_DIR)/$(TEST_DEP_2).el
+
+downloads-latest :
+ $(CURL) '$(TEST_DEP_1_LATEST_URL)' > $(TEST_DIR)/$(TEST_DEP_1).el && \
+ $(CURL) '$(TEST_DEP_2_LATEST_URL)' > $(TEST_DIR)/$(TEST_DEP_2).el
+
+autoloads :
+ $(EMACS) $(EMACS_BATCH) --eval \
+ "(progn \
+ (setq generated-autoload-file \"$(WORK_DIR)/$(AUTOLOADS_FILE)\") \
+ (update-directory-autoloads \"$(WORK_DIR)\"))"
+
+test-autoloads : autoloads
+ @$(EMACS) $(EMACS_BATCH) -L . -l "./$(AUTOLOADS_FILE)" || \
+ ( echo "failed to load autoloads: $(AUTOLOADS_FILE)" && false )
+
+test-travis :
+ @if test -z "$$TRAVIS" && test -e $(TRAVIS_FILE); then travis-lint
$(TRAVIS_FILE); fi
+
+test : build test-dep-1 test-dep-2
+ @cd $(TEST_DIR) && \
+ echo "hi " $(pwd) && \
+ (for test_lib in *-test.el; do \
+ $(EMACS) $(EMACS_BATCH) -L . -L .. -l cl -l cl-lib -l $$test_lib
--eval \
+ "(progn \
+ (unless (fboundp 'function-put) (defalias 'function-put #'(lambda
(f prop value) (put f prop value)))) \
+ (defun define-error (name message &optional parent) (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)))) \
+ (fset 'ert--print-backtrace 'ignore) \
+ (ert-run-tests-batch-and-exit '(and \"$(TESTS)\" (not (tag
:interactive)))))" || exit 1; \
+ done)
+
+clean :
+ @rm -f $(AUTOLOADS_FILE) *.elc *~ */*.elc */*~
$(TEST_DIR)/$(TEST_DEP_1).el \
+ $(TEST_DIR)/$(TEST_DEP_2).el $(TEST_DIR)/$(TEST_DEP_3).el
$(TEST_DIR)/$(TEST_DEP_4).el \
+ $(TEST_DIR)/$(TEST_DEP_5).el $(TEST_DIR)/$(TEST_DEP_6).el
$(TEST_DIR)/$(TEST_DEP_7).el \
+ $(TEST_DIR)/$(TEST_DEP_8).el $(TEST_DIR)/$(TEST_DEP_9).el
diff --git a/Readme.org b/Readme.org
index b1e3405..96c97c7 100644
--- a/Readme.org
+++ b/Readme.org
@@ -1,11 +1,11 @@
#+OPTIONS: toc:nil num:nil
-* Names
[[https://travis-ci.org/Bruce-Connor/names?branch=master][https://secure.travis-ci.org/Bruce-Connor/names.png?branch=master]]
+* Names
[[https://travis-ci.org/Malabarba/names?branch%3Dmaster][https://secure.travis-ci.org/Malabarba/names.png?branch=master]]
*Names* is designed as a practical, complete, robust, and debuggable
tool which writes your namespaces for you.
-It is part of Emacs and is available trough
[[https://elpa.gnu.org/packages/names.html][GNU Elpa]], so every
+It is part of Emacs and is available through
[[https://elpa.gnu.org/packages/names.html][GNU Elpa]], so every
Emacs user running at least 24.1 has access to it.
[[file:package-example.png]]\\
@@ -57,14 +57,14 @@ To access them add the following line to your init file.
First and foremost, the =edebug-eval-defun= command (bound to =C-u
C-M-x=) is an essential tool for any package developer. *Names*
wouldn't be a very useful utility if it prevented you from using this
-asset.
+asset.
Therefore, it provides the =names-eval-defun= command, which is
identical to =edebug-eval-defun= except it also works inside
namespaces. It will automatically be added to your
=emacs-lisp-mode-map=.
-*** Font-locking
+*** Font-locking
Font-lock for =define-namespace= and =:autoload=.
*** Expansion and comparison functions
@@ -114,7 +114,7 @@ it goes]].
- *Reduction in code size:* Approx. 2000 characters.
**** s.el
- *Number of ert tests passed:* All.
-- *Reduction in code size:* Approx. 1000 characters (8%).
+- *Reduction in code size:* Approx. 1000 characters (8%).
1000 characters is a lot when you consider /s.el/ has the second
shortest namespace possible, =s-=.
**** dash.el
diff --git a/names.el b/names.el
index 4bf5577..6545b32 100644
--- a/names.el
+++ b/names.el
@@ -83,7 +83,8 @@ it will set PROP."
(if (fboundp 'macrop) #'macrop
(lambda (object)
"Non-nil if and only if OBJECT is a macro."
- (let ((def (ignore-errors (indirect-function object))))
+ (let ((def (or (with-no-warnings (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)))))))))
diff --git a/tests/.nosearch b/tests/.nosearch
new file mode 100644
index 0000000..e69de29
diff --git a/tests/aggressive-indent-tests.el b/tests/aggressive-indent-tests.el
new file mode 100644
index 0000000..5c369b8
--- /dev/null
+++ b/tests/aggressive-indent-tests.el
@@ -0,0 +1,31 @@
+(byte-compile-file "aggressive-indent.el")
+(require 'package)
+(setq package-user-dir (expand-file-name "./elpa"))
+(package-initialize)
+(when (version< emacs-version "24.3")
+ (package-install-file (expand-file-name "cl-lib.el")))
+
+(package-install-file (expand-file-name "../names.el"))
+(setq byte-compile-error-on-warn t)
+(package-install-file (expand-file-name "aggressive-indent.el"))
+
+(defun file-as-list (file)
+ (let (out it)
+ (with-temp-buffer
+ (insert-file-contents-literally file)
+ (goto-char (point-min))
+ (while (setq it (ignore-errors (read (current-buffer))))
+ (push it out))
+ out)))
+
+(defvar truncated-emacs-version
+ (replace-regexp-in-string "\\(....\\).*" "\\1" emacs-version)
+ "")
+
+(ert-deftest compare-autoloads ()
+ (let ((should-have (file-as-list (format
"elpa/aggressive-indent-autoloads-%s.el" truncated-emacs-version)))
+ (do-have (file-as-list
"elpa/aggressive-indent-0.1/aggressive-indent-autoloads.el")))
+ (should (equal do-have should-have))))
+
+
+
diff --git a/tests/aggressive-indent.el b/tests/aggressive-indent.el
new file mode 100644
index 0000000..14eadb0
--- /dev/null
+++ b/tests/aggressive-indent.el
@@ -0,0 +1,170 @@
+;;; aggressive-indent.el --- Minor mode to keep your code always indented.
More aggressive than electric-indent-mode.
+
+;; Copyright (C) 2014 Artur Malabarba <bruce.connor.am@gmail.com>
+
+;; Author: Artur Malabarba <bruce.connor.am@gmail.com>
+;; URL: http://github.com/Bruce-Connor/aggressive-indent-mode
+;; Version: 0.1
+;; Package-Requires: ((emacs "24.1") (names "0") (cl-lib "0.5"))
+;; Keywords: indent lisp maint tools
+;; Prefix: aggressive-indent
+;; Separator: -
+
+;;; Commentary:
+;;
+;; `electric-indent-mode' is enough to keep your code nicely aligned when
+;; all you do is type. However, once you start shifting blocks around,
+;; 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
+;; than `electric-indent-mode'.
+;;
+;; ### Instructions ###
+;;
+;; This package is available fom Melpa, you may install it by calling
+;;
+;; M-x package-install RET aggressive-indent
+;;
+;; Then activate it with
+;;
+;; (add-hook 'emacs-lisp-mode-hook #'aggressive-indent-mode)
+;; (add-hook 'css-mode-hook #'aggressive-indent-mode)
+;;
+;; You can use this hook on any mode you want, `aggressive-indent' is not
+;; exclusive to emacs-lisp code. In fact, if you want to turn it on for
+;; every programming mode, you can do something like:
+;;
+;; (global-aggressive-indent-mode 1)
+;; (add-to-list 'aggressive-indent-excluded-modes 'html-mode)
+;;
+;; ### Manual Installation ###
+;;
+;; If you don't want to install from Melpa, you can download it manually,
+;; place it in your `load-path' and require it with
+;;
+;; (require 'aggressive-indent)
+
+;;; Instructions:
+;;
+;; INSTALLATION
+;;
+;; This package is available fom Melpa, you may install it by calling
+;; M-x package-install RET aggressive-indent.
+;;
+;; Then activate it with
+;; (add-hook 'emacs-lisp-mode-hook #'aggressive-indent-mode)
+;;
+;; You can also use an equivalent hook for another mode,
+;; `aggressive-indent' is not exclusive to emacs-lisp code.
+;;
+;; Alternatively, you can download it manually, place it in your
+;; `load-path' and require it with
+;;
+;; (require 'aggressive-indent)
+
+;;; License:
+;;
+;; This file is NOT part of GNU Emacs.
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License
+;; as published by the Free Software Foundation; either version 2
+;; of the License, or (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+
+;;; Change Log:
+;; 0.1 - 2014/10/15 - Release.
+;;; Code:
+
+(require 'cl-lib)
+(require 'names)
+
+(defvar global-aggressive-indent-mode)
+
+;;;###autoload
+(define-namespace aggressive-indent- :group indent
+
+(defconst version "0.1" "Version of the aggressive-indent.el package.")
+(defun 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!"
+ aggressive-indent-version emacs-version)
+ (browse-url
"https://github.com/Bruce-Connor/aggressive-indent-mode/issues/new";))
+
+
+;;; Start of actual Code:
+(defcustom excluded-modes '(text-mode tabulated-list-mode special-mode)
+ "Modes in which `aggressive-indent-mode' should not be activated.
+This variable is only used if `global-aggressive-indent-mode' is
+active. If the minor mode is turned on with the local command,
+`aggressive-indent-mode', this variable is ignored."
+ :type '(repeat symbol)
+ :package-version '(aggressive-indent . "0.1"))
+
+(defcustom protected-commands '(undo undo-tree-undo undo-tree-redo)
+ "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
+commands will NOT be followed by a re-indent."
+ :type '(repeat symbol)
+ :package-version '(aggressive-indent . "0.1"))
+
+(defun -softly-indent-defun ()
+ "Indent current defun unobstrusively.
+Like `aggressive-indent-indent-defun', except do nothing if
+mark is active (to avoid deactivaing it), or if buffer is not
+modified (to avoid creating accidental modifications).
+Also, never throw errors nor messages.
+
+Meant for use in hooks. Interactively, use the other one."
+ (unless (or (region-active-p)
+ buffer-read-only
+ (null (buffer-modified-p))
+ (memq last-command protected-commands))
+ (ignore-errors
+ (cl-letf (((symbol-function 'message) #'ignore))
+ (indent-defun)))))
+
+:autoload
+(defun indent-defun ()
+ "Indent current defun.
+Throw an error if parentheses are unbalanced."
+ (interactive)
+ (indent-region
+ (save-excursion (beginning-of-defun 1) (point))
+ (save-excursion (end-of-defun 1) (point))))
+
+
+;;; Minor modes
+:autoload
+(define-minor-mode mode nil nil " =>"
+ '(("\C-c\C-q" . aggressive-indent-indent-defun))
+ (if mode
+ (if (and global-aggressive-indent-mode
+ (cl-member-if #'derived-mode-p excluded-modes))
+ (mode -1)
+ (setq-local electric-indent-mode nil)
+ (add-hook 'post-command-hook #'-softly-indent-defun nil 'local))
+ (remove-hook 'post-command-hook #'-softly-indent-defun 'local)))
+
+:autoload
+(define-globalized-minor-mode global-aggressive-indent-mode
+ mode mode)
+
+:autoload
+(defalias 'aggressive-indent-global-mode
+ #'global-aggressive-indent-mode)
+)
+
+(provide 'aggressive-indent)
+;;; aggressive-indent.el ends here.
diff --git a/tests/auctex-11.87.7/auctex-autoloads.el
b/tests/auctex-11.87.7/auctex-autoloads.el
new file mode 100644
index 0000000..f4cc294
--- /dev/null
+++ b/tests/auctex-11.87.7/auctex-autoloads.el
@@ -0,0 +1,382 @@
+;;; auctex-autoloads.el --- automatically extracted autoloads
+;;
+;;; Code:
+(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
+
+;;;### (autoloads nil "bib-cite" "bib-cite.el" (21462 61835 84979
+;;;;;; 913000))
+;;; Generated autoloads from bib-cite.el
+
+(autoload 'bib-cite-minor-mode "bib-cite" "\
+Toggle bib-cite mode.
+When bib-cite mode is enabled, citations, labels and refs are highlighted
+when the mouse is over them. Clicking on these highlights with [mouse-2]
+runs bib-find, and [mouse-3] runs bib-display.
+
+\(fn ARG)" t nil)
+
+(autoload 'turn-on-bib-cite "bib-cite" "\
+Unconditionally turn on Bib Cite mode.
+
+\(fn)" nil nil)
+
+;;;***
+
+;;;### (autoloads nil "context" "context.el" (21462 61874 334764
+;;;;;; 532000))
+;;; Generated autoloads from context.el
+
+(defalias 'ConTeXt-mode 'context-mode)
+
+(autoload 'context-mode "context" "\
+Major mode in AUCTeX for editing ConTeXt files.
+
+Special commands:
+\\{ConTeXt-mode-map}
+
+Entering `context-mode' calls the value of `text-mode-hook',
+then the value of `TeX-mode-hook', and then the value
+of context-mode-hook.
+
+\(fn)" t nil)
+
+;;;***
+
+;;;### (autoloads nil "context-en" "context-en.el" (21462 61839 148290
+;;;;;; 949000))
+;;; Generated autoloads from context-en.el
+
+(autoload 'context-en-mode "context-en" "\
+Major mode for editing files for ConTeXt using its english interface.
+
+Special commands:
+\\{ConTeXt-mode-map}
+
+Entering `context-mode' calls the value of `text-mode-hook',
+then the value of TeX-mode-hook, and then the value
+of context-mode-hook.
+
+\(fn)" t nil)
+
+;;;***
+
+;;;### (autoloads nil "context-nl" "context-nl.el" (21462 61874 581429
+;;;;;; 845000))
+;;; Generated autoloads from context-nl.el
+
+(autoload 'context-nl-mode "context-nl" "\
+Major mode for editing files for ConTeXt using its dutch interface.
+
+Special commands:
+\\{ConTeXt-mode-map}
+
+Entering `context-mode' calls the value of `text-mode-hook',
+then the value of TeX-mode-hook, and then the value
+of context-mode-hook.
+
+\(fn)" t nil)
+
+;;;***
+
+;;;### (autoloads nil "font-latex" "font-latex.el" (21462 61835 541644
+;;;;;; 74000))
+;;; Generated autoloads from font-latex.el
+
+(autoload 'font-latex-setup "font-latex" "\
+Setup this buffer for LaTeX font-lock. Usually called from a hook.
+
+\(fn)" nil nil)
+
+;;;***
+
+;;;### (autoloads nil "latex" "latex.el" (21462 61871 201448 392000))
+;;; Generated autoloads from latex.el
+
+(autoload 'BibTeX-auto-store "latex" "\
+This function should be called from `bibtex-mode-hook'.
+It will setup BibTeX to store keys in an auto file.
+
+\(fn)" nil nil)
+
+(add-to-list 'auto-mode-alist '("\\.drv\\'" . latex-mode))
+
+(autoload 'TeX-latex-mode "latex" "\
+Major mode in AUCTeX for editing LaTeX files.
+See info under AUCTeX for full documentation.
+
+Special commands:
+\\{LaTeX-mode-map}
+
+Entering LaTeX mode calls the value of `text-mode-hook',
+then the value of `TeX-mode-hook', and then the value
+of `LaTeX-mode-hook'.
+
+\(fn)" t nil)
+
+(add-to-list 'auto-mode-alist '("\\.dtx\\'" . doctex-mode))
+
+(autoload 'docTeX-mode "latex" "\
+Major mode in AUCTeX for editing .dtx files derived from `LaTeX-mode'.
+Runs `LaTeX-mode', sets a few variables and
+runs the hooks in `docTeX-mode-hook'.
+
+\(fn)" t nil)
+
+(defalias 'TeX-doctex-mode 'docTeX-mode)
+
+;;;***
+
+;;;### (autoloads nil "multi-prompt" "multi-prompt.el" (21462 61870
+;;;;;; 611451 630000))
+;;; Generated autoloads from multi-prompt.el
+
+(autoload 'multi-prompt "multi-prompt" "\
+Completing prompt for a list of strings.
+The first argument SEPARATOR should be the string (of length 1) to
+separate the elements in the list. The second argument UNIQUE should
+be non-nil, if each element must be unique. The remaining elements
+are the arguments to `completing-read'. See that.
+
+\(fn SEPARATOR UNIQUE PROMPT TABLE &optional MP-PREDICATE REQUIRE-MATCH
INITIAL HISTORY)" nil nil)
+
+(autoload 'multi-prompt-key-value "multi-prompt" "\
+Read multiple strings, with completion and key=value support.
+PROMPT is a string to prompt with, usually ending with a colon
+and a space. TABLE is an alist. The car of each element should
+be a string representing a key and the optional cdr should be a
+list with strings to be used as values for the key.
+
+See the documentation for `completing-read' for details on the
+other arguments: PREDICATE, REQUIRE-MATCH, INITIAL-INPUT, HIST,
+DEF, and INHERIT-INPUT-METHOD.
+
+The return value is the string as entered in the minibuffer.
+
+\(fn PROMPT TABLE &optional PREDICATE REQUIRE-MATCH INITIAL-INPUT HIST DEF
INHERIT-INPUT-METHOD)" nil nil)
+
+;;;***
+
+;;;### (autoloads nil "plain-tex" "plain-tex.el" (21462 61871 88115
+;;;;;; 681000))
+;;; Generated autoloads from plain-tex.el
+
+(autoload 'TeX-plain-tex-mode "plain-tex" "\
+Major mode in AUCTeX for editing plain TeX files.
+See info under AUCTeX for documentation.
+
+Special commands:
+\\{plain-TeX-mode-map}
+
+Entering `plain-tex-mode' calls the value of `text-mode-hook',
+then the value of `TeX-mode-hook', and then the value
+of plain-TeX-mode-hook.
+
+\(fn)" t nil)
+
+(autoload 'ams-tex-mode "plain-tex" "\
+Major mode in AUCTeX for editing AmS-TeX files.
+See info under AUCTeX for documentation.
+
+Special commands:
+\\{AmSTeX-mode-map}
+
+Entering AmS-tex-mode calls the value of `text-mode-hook',
+then the value of `TeX-mode-hook', and then the value
+of `AmS-TeX-mode-hook'.
+
+\(fn)" t nil)
+
+;;;***
+
+;;;### (autoloads nil "preview" "preview.el" (21462 61870 254786
+;;;;;; 920000))
+;;; Generated autoloads from preview.el
+
+(autoload 'preview-install-styles "preview" "\
+Installs the TeX style files into a permanent location.
+This must be in the TeX search path. If FORCE-OVERWRITE is greater
+than 1, files will get overwritten without query, if it is less
+than 1 or nil, the operation will fail. The default of 1 for interactive
+use will query.
+
+Similarly FORCE-SAVE can be used for saving
+`preview-TeX-style-dir' to record the fact that the uninstalled
+files are no longer needed in the search path.
+
+\(fn DIR &optional FORCE-OVERWRITE FORCE-SAVE)" t nil)
+
+(autoload 'LaTeX-preview-setup "preview" "\
+Hook function for embedding the preview package into AUCTeX.
+This is called by `LaTeX-mode-hook' and changes AUCTeX variables
+to add the preview functionality.
+
+\(fn)" nil nil)
+ (add-hook 'LaTeX-mode-hook #'LaTeX-preview-setup)
+
+(autoload 'preview-report-bug "preview" "\
+Report a bug in the preview-latex package.
+
+\(fn)" t nil)
+
+;;;***
+
+;;;### (autoloads nil "tex" "tex.el" (21462 61874 468097 133000))
+;;; Generated autoloads from tex.el
+
+(autoload 'TeX-tex-mode "tex" "\
+Major mode in AUCTeX for editing TeX or LaTeX files.
+Tries to guess whether this file is for plain TeX or LaTeX.
+
+The algorithm is as follows:
+
+ 1) if the file is empty or `TeX-force-default-mode' is not set to nil,
+ `TeX-default-mode' is chosen
+ 2) If \\documentstyle or \\begin{, \\section{, \\part{ or \\chapter{ is
+ found, `latex-mode' is selected.
+ 3) Otherwise, use `plain-tex-mode'
+
+\(fn)" t nil)
+
+(autoload 'TeX-auto-generate "tex" "\
+Generate style file for TEX and store it in AUTO.
+If TEX is a directory, generate style files for all files in the directory.
+
+\(fn TEX AUTO)" t nil)
+
+(autoload 'TeX-auto-generate-global "tex" "\
+Create global auto directory for global TeX macro definitions.
+
+\(fn)" t nil)
+
+(autoload 'TeX-submit-bug-report "tex" "\
+Submit a bug report on AUCTeX via mail.
+
+Don't hesitate to report any problems or inaccurate documentation.
+
+If you don't have setup sending mail from (X)Emacs, please copy the
+output buffer into your mail program, as it gives us important
+information about your AUCTeX version and AUCTeX configuration.
+
+\(fn)" t nil)
+
+;;;***
+
+;;;### (autoloads nil "tex-bar" "tex-bar.el" (21462 61870 811450
+;;;;;; 532000))
+;;; Generated autoloads from tex-bar.el
+
+(autoload 'TeX-install-toolbar "tex-bar" "\
+Install toolbar buttons for TeX mode.
+
+\(fn)" t nil)
+
+(autoload 'LaTeX-install-toolbar "tex-bar" "\
+Install toolbar buttons for LaTeX mode.
+
+\(fn)" t nil)
+
+;;;***
+
+;;;### (autoloads nil "tex-fold" "tex-fold.el" (21462 61839 681621
+;;;;;; 356000))
+;;; Generated autoloads from tex-fold.el
+ (autoload 'TeX-fold-mode "tex-fold" "Minor mode for hiding and revealing
macros and environments." t)
+
+(defalias 'tex-fold-mode 'TeX-fold-mode)
+
+;;;***
+
+;;;### (autoloads nil "tex-font" "tex-font.el" (21462 61838 928292
+;;;;;; 156000))
+;;; Generated autoloads from tex-font.el
+
+(autoload 'tex-font-setup "tex-font" "\
+Setup font lock support for TeX.
+
+\(fn)" nil nil)
+
+;;;***
+
+;;;### (autoloads nil "tex-info" "tex-info.el" (21462 61838 208296
+;;;;;; 107000))
+;;; Generated autoloads from tex-info.el
+
+(defalias 'Texinfo-mode 'texinfo-mode)
+
+(autoload 'TeX-texinfo-mode "tex-info" "\
+Major mode in AUCTeX for editing Texinfo files.
+
+Special commands:
+\\{Texinfo-mode-map}
+
+Entering Texinfo mode calls the value of `text-mode-hook' and then the
+value of `Texinfo-mode-hook'.
+
+\(fn)" t nil)
+
+;;;***
+
+;;;### (autoloads nil "tex-jp" "tex-jp.el" (21462 61860 451507 382000))
+;;; Generated autoloads from tex-jp.el
+
+(autoload 'japanese-plain-tex-mode "tex-jp" "\
+Major mode in AUCTeX for editing Japanese plain TeX files.
+Set `japanese-TeX-mode' to t, and enter `TeX-plain-tex-mode'.
+
+\(fn)" t nil)
+
+(autoload 'japanese-latex-mode "tex-jp" "\
+Major mode in AUCTeX for editing Japanese LaTeX files.
+Set `japanese-TeX-mode' to t, and enter `TeX-latex-mode'.
+
+\(fn)" t nil)
+
+;;;***
+
+;;;### (autoloads nil "tex-site" "tex-site.el" (21462 61834 901647
+;;;;;; 586000))
+;;; Generated autoloads from tex-site.el
+ (require 'tex-site)
+
+;;;***
+
+;;;### (autoloads nil "texmathp" "texmathp.el" (21462 61870 428119
+;;;;;; 303000))
+;;; Generated autoloads from texmathp.el
+
+(autoload 'texmathp "texmathp" "\
+Determine if point is inside (La)TeX math mode.
+Returns t or nil. Additional info is placed into `texmathp-why'.
+The functions assumes that you have (almost) syntactically correct (La)TeX in
+the buffer.
+See the variable `texmathp-tex-commands' about which commands are checked.
+
+\(fn)" t nil)
+
+(autoload 'texmathp-match-switch "texmathp" "\
+Search backward for any of the math switches.
+Limit searched to BOUND.
+
+\(fn BOUND)" nil nil)
+
+;;;***
+
+;;;### (autoloads nil "toolbar-x" "toolbar-x.el" (21462 61860 848171
+;;;;;; 872000))
+;;; Generated autoloads from toolbar-x.el
+ (autoload 'toolbarx-install-toolbar "toolbar-x")
+
+;;;***
+
+;;;### (autoloads nil nil ("auctex-pkg.el" "auctex.el" "prv-emacs.el"
+;;;;;; "prv-xemacs.el" "tex-buf.el" "tex-mik.el" "tex-style.el"
+;;;;;; "tex-wizard.el") (21462 61874 703005 504000))
+
+;;;***
+
+;; Local Variables:
+;; version-control: never
+;; no-byte-compile: t
+;; no-update-autoloads: t
+;; End:
+;;; auctex-autoloads.el ends here
diff --git a/tests/auctex-11.87.7/auctex-pkg.el
b/tests/auctex-11.87.7/auctex-pkg.el
new file mode 100644
index 0000000..048247d
--- /dev/null
+++ b/tests/auctex-11.87.7/auctex-pkg.el
@@ -0,0 +1,2 @@
+;;; -*- no-byte-compile: t -*-
+(define-package "auctex" "11.87.7" "Integrated environment for *TeX*" 'nil
:url "http://www.gnu.org/software/auctex/";)
diff --git a/tests/auctex-11.87.7/auctex.el b/tests/auctex-11.87.7/auctex.el
new file mode 100644
index 0000000..42c4ca7
--- /dev/null
+++ b/tests/auctex-11.87.7/auctex.el
@@ -0,0 +1,34 @@
+;;; auctex.el --- Integrated environment for *TeX*
+
+;; Copyright (C) 2014 Free Software Foundation, Inc.
+
+;; Version: 11.87.7
+;; URL: http://www.gnu.org/software/auctex/
+
+;; 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 can be used for starting up AUCTeX. The following somewhat
+;; strange trick causes tex-site.el to be loaded in a way that can be
+;; safely undone using (unload-feature 'tex-site).
+
+;;; Code:
+
+(autoload 'TeX-load-hack
+ (expand-file-name "tex-site.el"
+ (file-name-directory load-file-name)))
+(TeX-load-hack)
diff --git a/tests/auctex-11.87.7/bib-cite.el b/tests/auctex-11.87.7/bib-cite.el
new file mode 100644
index 0000000..0f94332
--- /dev/null
+++ b/tests/auctex-11.87.7/bib-cite.el
@@ -0,0 +1,2622 @@
+;;; bib-cite.el --- test
+;; bib-cite.el - Display \cite, \ref or \label / Extract refs from BiBTeX file.
+
+;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2001, 2003, 2004, 2005
+;; Free Software Foundation
+
+;; Author: Peter S. Galbraith <psg@debian.org>
+;; Created: 06 July 1994
+;; Version: 3.28 (Feb 23 2005)
+;; Keywords: bibtex, cite, auctex, emacs, xemacs
+
+;;; This file is not part of GNU Emacs.
+
+;; This package 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 package 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 St, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;; LCD Archive Entry:
+;; bib-cite|Peter Galbraith|GalbraithP@dfo-mpo.gc.ca|
+;; Display \cite, \ref or \label / Extract refs from BiBTeX file.|
+;; 21-May-1997|3.01|~/misc/bib-cite.el.gz|
+
+;; ----------------------------------------------------------------------------
+;;; Commentary:
+;; This minor-mode is used in various TeX modes to display or edit references
+;; associated with \cite commands, or matching \ref and \label commands.
+
+;; New versions of this package (if they exist) may be found at:
+;; http://people.debian.org/~psg/elisp/bib-cite.el
+;; and in AUCTeX's CVS archive at
+;; http://savannah.gnu.org/cgi-bin/viewcvs/auctex/auctex/
+
+;; Operating Systems:
+;; Works in unix, DOS and OS/2. Developped under Linux.
+
+;; AUCTeX users:
+;; AUCTeX is a super-charged LaTeX mode for emacs. Get it at:
+;;
+;; ftp://ftp.gnu.org/pub/gnu/auctex/
+;;
+;; WWW users may want to check out the AUCTeX page at
+;; http://www.gnu.org/software/auctex/
+;;
+;; bib-cite.el is included in the AUCTeX distribution. Therefore, if
+;; you use AUCTeX and didn't obtained bib-cite.el separately, make sure
+;; that you are actually using the more recent version.
+
+;; RefTeX users:
+;; RefTeX is a package with similar functions to bib-cite.
+;; http://www.astro.uva.nl/~dominik/Tools/reftex/
+;; RefTeX is bundled and preinstalled with Emacs since version 20.2.
+;; It was also bundled with XEmacs 19.16--20.x.
+;;
+;; I suggest that you use RefTeX to help you type-in text as it's functions
+;; are better suited to this task than bib-cite, and use bib-cite's features
+;; when you proof-read the text.
+;; If you wish bib-cite to use RefTeX's reftex-view-crossref command to
+;; display and find \label's and \cite bibliography entries, set the variable
+;; bib-cite-use-reftex-view-crossref to t.
+
+;; MS-DOS users:
+;; Multifile documents are supported by bib-cite by using etags (TAGS files)
+;; which contains a bug for MSDOS (at least for emacs 19.27 it does).
+;; Get the file
+;; http://people.debian.org/~psg/elisp/bib-cite.etags-bug-report
+;; to see what patches to make to etags.c to fix it.
+
+;; Description:
+;; ~~~~~~~~~~~
+;; This package is used in various TeX modes to display or edit references
+;; associated with \cite commands, or matching \eqref, \ref and \label
+;; commands (so I actually overstep BiBTeX bounds here...).
+;;
+;; These are the functions:
+;;
+;; bib-display bib-display-mouse
+;; - Display citation, \ref or \label under point
+;; bib-find bib-find-mouse
+;; - Edit citation, \ref or \label under point
+;; bib-find-next - Find next occurrence of a \ref or \eqref
+;; bib-make-bibliography - Make BiBTeX file containing only cite keys used.
+;; bib-apropos - Search BiBTeX source files for keywords.
+;; bib-etags - Refreshes (or builds) the TAGS files for
+;; multi-file documents.
+;; bib-create-auto-file - Used in bibtex-mode to create cite key
+;; completion .el file for AUCTeX.
+;; bib-highlight-mouse - Highlight \cite, \ref and \label commands in
+;; green when the mouse is over them.
+
+;; About Cite Commands and related functions:
+;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+;; Various flavors of \cite commands are allowed (as long as they contain
+;; the word `cite') and they may optionally have bracketed [] options.
+;; Bibtex Cross-references are displayed, and @string abbreviations are
+;; substituted or included.
+;;
+;; The \cite text is found (by emacs) in the bibtex source files listed in the
+;; \bibliography command. The BiBTeX files can be located in a search path
+;; defined by an environment variable (typically BIBINPUTS, but you can change
+;; this).
+;;
+;; All citations used in a buffer can also be listed in a new bibtex buffer by
+;; using bib-make-bibliography. This is useful to make a bibtex file for a
+;; document from a large bibtex database. In this case, cross-references are
+;; included, as well as the @string commands used. The @string abbreviations
+;; are not substituted.
+;;
+;; The bibtex files can also be searched for entries matching a regular
+;; expression using bib-apropos.
+
+;; Usage instructions:
+;; ~~~~~~~~~~~~~~~~~~
+;; bib-display Bound to Mouse-3 when specially highlighted.
+;; In Hyperbole, bound to the Assist key.
+;; Bound to `\C-c b d'
+;;
+;; bib-display will show the bibtex entry or the corresponding label or
+;; ref commands from anywhere within a document.
+;; With cursor on the \cite command itslef
+;; -> display all citations of the cite command from the BiBTeX source.
+;; With cursor on a particular cite key within the brackets
+;; -> display that citation's text from the BiBTeX source file(s).
+;;
+;; Example:
+;;
+;; \cite{Wadhams81,Bourke.et.al87,SchneiderBudeus94}
+;; ^Cursor -> Display-all-citations ^Cursor -> Display-this-citation
+;;
+;; With cursor on a \label command
+;; -> Display first matching \ref command in the document
+;; With cursor on a \ref command
+;; -> Display environment associated with the matching \label command.
+;;
+;; Finding a ref or label within a multi-file document requires a TAGS file,
+;; which is automatically generated for you. This enables you to then use
+;; any tags related emacs features.
+;;
+;; bib-find Bound to Mouse-2 when specially highlighted.
+;; In Hyperbole, bound to the Action key.
+;; Bound to `\C-c b f'
+;;
+;; bib-find will select the buffer and move point to the BiBTeX source file
+;; at the proper citation for a cite command, or move point to anywhere
+;; within a document for a label or ref command. The ref chosen is the
+;; first occurrance within a document (using a TAGS file). If point is
+;; moved within the same buffer, mark is set before the move and a message
+;; stating so is given. If point is moved to another file, this is done in
+;; a new window using tag functions.
+;;
+;; The next occurrence of a \ref or \eqref command may be found by invoking
+;; bib-find-next, usually bound to `C-c b n'.
+;;
+;; For multi-file documents, you must be using AUCTeX (so that bib-cite can
+;; find the master file) and all \input and \include commands must be first
+;; on a line (not preceeded by any non-white text).
+;;
+;; bib-make-bibliography: Bound to `\C-c b m'
+;;
+;; Extract citations used in the current document from the \bibliography{}
+;; file(s). Put them into a new suitably-named buffer. In a AUCTeX
+;; multi-file document, the .aux files are used to find the cite keys (for
+;; speed). You will be warned if these are out of date.
+;;
+;; This buffer is not saved to a file. It is your job to save it to whatever
+;; name you wish. Note that AUCTeX has a unique name space for LaTeX and
+;; BiBTeX files, so you should *not* name the bib file associated with
+;; example.tex as example.bib! Rather, name it something like
+;; example-bib.bib.
+;;
+;; bib-apropos: Bound to `\C-c b a'
+;;
+;; Searches the \bibliography{} file(s) for entries containing a keyword and
+;; display them in the *help* buffer. You can trim down your search by using
+;; bib-apropos in the *Help* buffer after the first invocation. the current
+;; buffer is also searched for keyword matches if it is in bibtex-mode.
+;;
+;; It doesn't display cross-references nor does it substitute or display
+;; @string commands used. It could easily be added, but it's faster this
+;; way. Drop me a line if this would be a useful addition.
+;;
+;; If you find yourself entering a cite command and have forgotten which key
+;; you want, but have entered a few initial characters as in `\cite{Gal',
+;; then invoke bib-apropos. It will take that string (in this case `Gal') as
+;; an initial response to the apropos prompt. You are free to edit it, or
+;; simply press carriage return.
+;;
+;; bib-etags: Bound to `\C-c b e'
+;;
+;; Creates a TAGS file for AUCTeX's multi-file document (or refreshes it).
+;; This is used by bib-find when editing multi-file documents. The TAGS file
+;; is created automatically, but it isn't refreshed automatically. So if
+;; bib-find can't find something, try running bib-etags again.
+;;
+;; bib-create-auto-file:
+;;
+;; Use this when editing a BiBTeX buffer to generate the AUCTeX .el file
+;; which tell emacs about all its cite keys. I've added this command to
+;; bibtex-mode pull-down menu.
+;;
+;; bib-highlight-mouse: Bound to `\C-c b h'
+;;
+;; Highlights \cite, \ref and \label commands in green when the mouse is over
+;; them. By default, a call to this function is added to LaTeX-mode-hook
+;; (via bib-cite-initialize) if you set bib-highlight-mouse-t to true. But
+;; you may want to run this command to refresh the highlighting for newly
+;; edited text.
+
+;; Installation instructions:
+;; ~~~~~~~~~~~~~~~~~~~~~~~~~
+;; bib-cite is a minor-mode, so you could invoke it in a LaTeX-mode hook.
+;; e.g. If you are using AUCTeX (http://www.gnu.org/software/auctex/), you
+;; could use:
+;;
+;; (autoload 'turn-on-bib-cite "bib-cite")
+;; (add-hook 'LaTeX-mode-hook 'turn-on-bib-cite)
+;;
+;; If you are using Emacs' regular LaTeX-mode, use instead:
+;;
+;; (autoload 'turn-on-bib-cite "bib-cite")
+;; (add-hook 'latex-mode-hook 'turn-on-bib-cite)
+;;
+;; bib-cite can be used with AUCTeX, or stand-alone. If used with AUCTeX on a
+;; multi-file document (and AUCTeX's parsing is used), then all \bibliography
+;; commands in the document will be found and used.
+;; ---
+;; The following variable can be unset (like shown) to tell bib-cite to
+;; not give advice messages about which commands to use to find the next
+;; occurrence of a search:
+;;
+;; (setq bib-novice nil)
+;; ---
+;; If you wish bib-cite to use RefTeX's reftex-view-crossref command to
+;; display and find \label's and \cite bibliography entries, set the variable
+;; bib-cite-use-reftex-view-crossref to t:
+;;
+;; (setq bib-cite-use-reftex-view-crossref t)
+;; ---
+;; The following variable determines whether we will attempt to highlight
+;; citation, ref and label commands in green when they are under the
+;; mouse. When highlighted, the mouse keys work to call bib-display
+;; (bound to [mouse-3]) and bib-find (bound to [mouse-2]). If you use a
+;; mode other than LaTeX-mode, you'll want to call bib-highlight-mouse with
+;; a hook (See how we do this at the end of this file with the add-hook
+;; command).
+;;
+;; (setq bib-highlight-mouse-t nil)
+;; ---
+;; The variable bib-switch-to-buffer-function sets the function used to
+;; select buffers (if they differ from the original) in bib-cite commands
+;; bib-make-bibliography, bib-display, bib-find
+;; You may use `switch-to-buffer' `switch-to-buffer-other-window' or
+;; `switch-to-buffer-other-frame'.
+;; ---
+;; If you use DOS or OS/2, you may have to set the following variable:
+;;
+;; (setq bib-dos-or-os2-variable t)
+;;
+;; if bib-cite.el fails to determine that you are using DOS or OS/2.
+;; Try `C-h v bib-dos-or-os2-variable' to see if it needs to be set manually.
+;; ---
+;; bib-cite needs to call the etags program with its output file option
+;; and also with the append option (usually -a).
+;; I figured that DOS and OS/2 would use "etags /o=" instead of the unix
+;; variant "etags -o ", but users have reported differently. So while the
+;; unix notation is used here, you can reset it if you need to like so:
+;;
+;; (setq bib-etags-command "etags /r='/.*\\\(eq\|page\|[fvF]\)ref.*/'
/o=")
+;; (setq bib-etags-append-command
+;; "etags /r='/.*\\\(eq\|page\|[fvF]\)ref.*/' /a
/o=")
+;; ---
+;; For multi-file documents, a TAGS file is generated by etags.
+;; By default, its name is TAGS. You can change this like so:
+;;
+;; (setq bib-etags-filename "TAGSLaTeX")
+;; ---
+;; If your environment variable to find BiBTeX files is not BIBINPUTS, then
+;; reset it with the following variable (here, assuming it's TEXBIB instead):
+;;
+;; (setq bib-bibtex-env-variable "TEXBIB")
+;;
+;; Note that any directory ending in a double slash will cause bib-cite to
+;; search recursively through subdirectories for your .bib files. This can
+;; be slow, so use this judiciously.
+;; e.g. setenv BIBINPUTS .:/home/psg/LaTeX/bibinputs//
+;; -> all directories below /home/psg/LaTeX/bibinputs/ will be
+;; searched.
+;;
+;; If your bibtex setup works but Emacs can't see the environment variable
+;; correctly (Check `C-h v process-environment'), then customize the
+;; variable `bib-cite-inputs' (e.g. `M-x customize-variable bib-cite-imputs')
+;;
+;; ---
+;; If you do not wish bib-display to substitute @string abbreviations,
+;; then set the following variable like so:
+;;
+;; (setq bib-substitute-string-in-display nil)
+;; ---
+;; Warnings are given when @string abbreviations are not defined in your bib
+;; files. The exception is for months, usually defined in style files. If you
+;; use other definitions in styles file (e.g. journals), then you may add them
+;; to the `bib-substitute-string-in-display' list variable.
+
+;; If you find circumstances in which this package fails, please let me know.
+
+;; Things for me to do in later versions:
+;; - treat @Strings correctly, not just in isolation.
+;; - use `kpsewhich -expand-path='$BIBINPUTS'` instead of BIBINPUTS.
+;; - jmv@di.uminho.pt (Jose Manuel Valenca) wants:
+;; - prompt for \cite as well as \label and \ref
+;; (and use AUCTeX's completion list)
+;; - implement string concatenation, with #[ \t\n]*STRING_NAME
+;; - Create new command to substitute @string text in any bibtex buffer.
+;; ----------------------------------------------------------------------------
+;;; Change log:
+;; V3.28 Feb 23 2005 - Ralf Angeli
+;; - Some doc fixes in the commentary section.
+;; V3.27 Feb 09 2005 - PSG
+;; - Patch from Peter Heslin. TeX-master can now have symbol values.
+;; V3.26 Aug 06 2004 - Reiner Steib
+;; - Changed URL of AUCTeX. Use "AUCTeX", not "auc-tex" (skipped Change log).
+;; V3.25 Feb 15 2004 - PSG
+;; - Check existence of font-lock-unset-defaults; no longer defined in CVS
+;; Emacs. Thanks to Adrian Lanz for reporting the problem.
+;; V3.24 Oct 28 2003 - PSG
+;; - bib-cite-file-directory-p: new function to replace ff-paths code.
+;; V3.23 Oct 09 2003 - PSG
+;; - some checkdoc cleanup; not yet complete.
+;; V3.22 Sep 17 2003 - PSG
+;; - bib-cite-aux-inputs: new defcustom.
+;; - minor cleanup for `match-string'.
+;; V3.21 Sep 08 2003 - PSG
+;; - Ripping out off-topic imenu code.
+;; V3.20 Aug 14 2003 - PSG
+;; - psg-checkfor-file-list: Allow for relative directoties as entries in
+;; BIBINPUTS.
+;; - bib-cite-inputs: new defcustom equivalent to BIBINPUTS.
+;; - bib-label-help-echo-format: fixed defcustom.
+;; - psg-list-env: code cleanup.
+;; - trailing whitespace cleanup.
+;; V3.19 Apr 06 2003 - PSG
+;; Remove code that ran when defcustom not present.
+;; Remove hilit19 obsolete code.
+;; V3.18 Mar 27 2003 - Bruce Ravel <ravel@phys.washington.edu>
+;; Play well with the varioref and fancyref latex styles (vref, fref, Fref).
+;; V3.17 May 01 2001 - (RCS V1.38)
+;; - XEmacs has imenu after all.
+;; V3.16 Dec 20 99 - (RCS V1.37)
+;; - Added customize support.
+;; V3.15 Dec 20 99 - (RCS V1.36)
+;; - Removed stupid debugging code that I had left in.
+;; V3.14 Dec 20 99 -
+;; - New variable bib-ref-regexp for \ref regexp to match \label constructs
+;; and added \pageref. (RCS V1.34)
+;; - Edited bib-etags-command snd bib-etags-append-command to match.
+;; V3.13 Dec 20 99 - (RCS V1.32)
+;; - License changed to GPL.
+;; - Kai Engelhardt <ke@socs.uts.edu.au> bib-master-file takes .ltx extension
+;; - imenu--create-LaTeX-index-for-document and bib-document-TeX-files
+;; edited to accept .ltx extension.
+;; - Michael Steiner <steiner@cs.uni-sb.de> added journals to @string
+;; abbrevs and contributed `member-cis' to complaces @strings in a
+;; case-insensitive manner.
+;; V3.12 Dec 10 98 - Bruce Ravel <bruce.ravel@nist.gov> (RCS V1.30)
+;; Fixed bib-label-help.
+;; V3.11 Oct 06 98 - PSG (RCS V1.29)
+;; Quote \ character fot replace-match;
+;; Applies to: @String{JGR = "J. Geophys.\ Res."}
+;; V3.10 Sep 21 98 - Matt Hodges <mph1002@cam.ac.uk> (RCS V1.28)
+;; Removed instance of expand-file-name due to new behaviour in Emacs-20.3.
+;; V3.09 Sep 09 98 - PSG (RCS V1.27)
+;; Added support for \eqref; Added bib-find-next.
+;; V3.08 Aug 20 98 - PSG (RCS V1.26)
+;; Fixed imenu bug (prev-pos (point-max))
+;; V3.07 Nov 20 97 - Christoph Wedler <wedler@fmi.uni-passau.de> (RCS V1.24)
+;; bib-ext-list variable made permanent-local, otherwise VC registration
+;; would use two extents for each reference etc. This was not a visible bug.
+;; V3.06 Nov 12 97 - PSG (RCS V1.23)
+;; Support use of reftex's reftex-view-crossref command.
+;; V3.05 Nov 12 97 - Vladimir Alexiev <vladimir@cs.ualberta.ca> (RCS V1.22)
+;; regexp-quote the bibliography keys so a key like galbraith+kelley97 works
+;; V3.04 Aug 25 97 - Christoph Wedler <wedler@fmi.uni-passau.de> (RCS V1.20)
+;; (bib-highlight-mouse): Would bug out on detached extents,
+;; e.g. when killing a whole citation.
+;; V3.03 Jul 16 97 - Christoph Wedler <wedler@fmi.uni-passau.de> (RCS V1.18)
+;; turn-on-bib-cite back to non-interactive.
+;; V3.02 Jul 11 97 - Christoph Wedler <wedler@fmi.uni-passau.de> (RCS V1.17)
+;; * auctex/bib-cite.el (turn-on-bib-cite): Make interactive.
+;; Argument to `bib-cite-minor-mode' is 1.
+;; (bib-label-help-echo-format): New variable.
+;; (bib-label-help-echo): New function.
+;; (bib-label-help): Addition argument format.
+;; (bib-highlight-mouse): Set extent property `help-echo' for XEmacs.
+;; V3.01 May 22 97 - Diego Calvanese <calvanes@dis.uniroma1.it> (RCS V1.16)
+;; bib-make-bibliography handles commas separated citations in aux files.
+;; V3.00 May 16 97 - Peter Galbraith (RCS V1.15)
+;; bib-cite is now a minor mode.
+;; V2.32 Apr 30 97 - Anders Stenman <stenman@isy.liu.se> (RCS V1.14)
+;; - Support for balloon-help.
+;; V2.31 Mar 20 97 - Christoph Wedler <wedler@fmi.uni-passau.de> (RCS V1.12)
+;; - Better fontification of help buffer as bibtex or latex for XEmacs.
+;; V2.30 Feb 10 97 - Peter Galbraith (RCS V1.11)
+;; - Better fontification of help buffer as bibtex or latex.
+;; V2.29 Jan 29 97 - Peter Galbraith (RCS V1.10)
+;; - imenu looks for `\label{stuff}' instead of `\label'
+;; V2.28 Jan 22 97 - Peter Galbraith (RCS V1.9)
+;; - Bug in bib-create-auto-file.
+;; V2.27 Dec 31 96 - Peter Galbraith (RCS V1.8)
+;; - allow spaces between cite keys.
+;; - Vladimir Alexiev <vladimir@cs.ualberta.ca>
+;; Allow () delimiters as well as {}.
+;; Better check on bibtex-menu
+;; Erase *bibtex-bibliography* buffer.
+;; V2.26 Sep 24 96 - Peter Galbraith (RCS V1.7)
+;; imenu bug fix.
+;; V2.25 Sep 23 96 - Anders Stenman <stenman@isy.liu.se> (RCS V1.6)
+;; XEmacs bib-cite-fontify-help-as-latex bug fix.
+;; V2.24 Aug 19 96 - Peter Galbraith (RCS V1.3)
+;; XEmacs bug fix, minor defvars - Vladimir Alexiev <vladimir@cs.ualberta.ca>
+;; V2.23 Aug 13 96 - Peter Galbraith (RCS V1.2)
+;; XEmacs - Add bib-cite entries to bibtex-mode popup menu.
+;; V2.22 July 22 96 - Peter Galbraith (RCS V1.1)
+;; local-map has `m' for bib-make-bibliography instead of `b'
+;; set-buffer-menubar in XEmacs so that menu disappears after use.
+;; V2.21 July 12 96 - Peter Galbraith
+;; Define `\C-c b' keymap for both plain tex and auctex, in XEmacs and emacs.
+;; Separate menu-bar menu in gnu emacs.
+;; font-lock support for bib-display'ed citations (bibtex fontification)
+;; and for matching \ref{} and \labels (latex fontification).
+;; buffer-substring-no-properties in bib-apropos
+;; (bug in completing-read with mouse faces)
+;; imenu-sort-function made local and nil.
+;; imenu--LaTeX-name-and-position fixed for section name containing "\"
+;; Various other things... (whitespace within label strings, etc...)
+;; V2.20 June 25 96 - Peter Galbraith
+;; imenu fixed for emacs-19.31.
+;; V2.19 May 13 96
+;; PSG:
+;; - @string substitution fixed; bib-edit-citation fixed when buffer exists;
+;; Christoph Wedler <wedler@fmi.uni-passau.de>:
+;; - Added bib-switch-to-buffer-function
+;; - (setq tags-always-exact nil) for xemacs
+;; - removed eval-after-load foe xemacs
+;; V2.18 May 06 96 - PSG
+;; New eval-after-load from Fred Devernay <Frederic.Devernay@sophia.inria.fr>
+;; V2.17 May 03 96 - PSG
+;; Fixed bug introduced in V2.16, reported by Dennis Dams <wsindd@win.tue.nl>
+;; V2.16 May 02 96 - Vladimir Alexiev <vladimir@cs.ualberta.ca>
+;; - somewhat compatible with Hyperbole by binding bib-find and bib-display to
+;; the Action and Assist keys inside the bib-highlight-mouse-keymap.
+;; - makes more liberal provisions for users with a tty.
+;; V2.15 Apr 09 96 -
+;; - fix "Buffer read-only" error caused by mouse-face text properties
+;; patch by Piet van Oostrum <piet@cs.ruu.nl>
+;; - Use tmm non-X menu, patch by Vladimir Alexiev <vladimir@cs.ualberta.ca>
+;; - input{file.txt} would not work.
+;; bug report: David Kastrup <dak@pool.informatik.rwth-aachen.de>
+;; V2.14 Feb 26 96 - PSG - define eval-after-load for xemacs
+;; Frederic Devernay's <Frederic.Devernay@sophia.inria.fr> suggestion.
+;; V2.13 Feb 08 96 - Peter Galbraith - Fixed recursive use of bib-apropos.
+;; V2.12 Jan 19 96 - Peter Galbraith
+;; emacs-19.30's [down-mouse-1] is defined (rather than [mouse-1]), so
+;; bib-highlight-mouse-keymap now has [down-mouse-1] defined to override it.
+;; V2.11 Nov 21 95 - Peter Galbraith
+;; - Fixed bib-create-auto-file when bib file loaded before LaTeX file.
+;; - Michal Mnuk's better imenu labels menu <Michal.Mnuk@risc.uni-linz.ac.at>
+;; - [mouse-1] and [mouse-2] key defs for highlighted regions.
+;; - Improve X menus.
+;; - Skip over style files in bib-document-TeX-files.
+;; - Add menus and mouse highlighting for xemacs
+;; Anders Stenman <stenman@isy.liu.se> Dima Barsky <D.Barsky@ee.surrey.ac.uk>
+;; - Check bib-use-imenu before calling LaTeX-hook-setq-imenu.
+;; From: Kurt Hornik <hornik@ci.tuwien.ac.at>
+;; - Remove mouse face properties before inserting new ones.
+;; From: Peter Whaite <peta@Whippet.McRCIM.McGill.EDU>
+;; V2.10 Aug 17 95 - Peter Galbraith - fatal bugs in bib-make-bibliography.
+;; V2.09 Jul 19 95 - Peter Galbraith
+;; - Had introduced bug in search-directory-tree. synced with ff-paths.el.
+;; V2.08 Jul 13 95 - Peter Galbraith
+;; Fred Douglis <douglis@research.att.com> says etags should be required
+;; V2.07 Jul 04 95 - Peter Galbraith
+;; - Minor changes with filename manipulations (careful with DOS...)
+;; - Problem if auc-tex not already loaded -> LaTeX-mode-map
+;; V2.06 Jul 03 95 - Peter Galbraith - Added recursion through BIBINPUTS path.
+;; V2.05 Jun 22 95 - Peter Galbraith Bug: Hanno Wirth <wirth@jake.igd.fhg.de>
+;; bib-get-citations would truncate @String{KEY ="J. {\"u} Res."}
+;; V2.04 Jun 19 95 - Peter Galbraith -
+;; - use bibtex-mode syntax table in bib buffer, else bib-apropos truncates
+;; an article if it contains an unbalanced closing parenthesis.
+;; - bib-highlight-mouse would mark a buffer modified
+;; V2.03 May 16 95 - Peter Galbraith -
+;; auc-tec menu compatible with old "AUC TeX" pull-down name
+;; V2.02 May 10 95 - Peter Galbraith -
+;; bug report by Bodo Huckestein <bh@thp.Uni-Koeln.DE> (getenv env) under DOS
+;; V2.01 Mar 27 95 - Peter Galbraith - No imenu on xemacs; check BIBINPUT also
+;; V2.00 Mar 27 95 - Peter Galbraith
+;; - bib-find and bib-display replace bib-edit-citation and
+;; bib-display-citation
+;; - bib-apropos now take initial guess from start of cite argument at point.
+;; - Multi-file support for bib-make-bibliography using .aux files.
+;; - \label and \ref functionality for bib-find and bib-display:
+;; - \label may appear within an \begin\end or to label a (sub-)section.
+;; - Cursor on \label, goto first \ref, set next i-search to pattern.
+;; - Cursor on \ref, goto \label or display it's environment or section.
+;; - Works on hidden code!
+;; V1.08 Jan 16 95 - Peter Galbraith
+;; bib-apropos can be used within *Help* buffer to trim a search.
+;; V1.07 Dec 13 94 - Peter Galbraith
+;; - Fixed: multi-line @string commands in non-inserted display.
+;; - Fixed: quoted \ character in @string commands.
+;; - BiBTeX comments should not affect bib-cite
+;; - Fixed bib-apropos (from Christoph Wedler <wedler@fmi.uni-passau.de>)
+;; Faster now, and avoids infinite loops.
+;; - Added bib-edit-citation to edit a bibtex files about current citation.
+;; - Allow space and newlines between citations: \cite{ entry1, entry2}
+;; - Added bib-substitute-string-in-display, bib-string-ignored-warning
+;; and bib-string-regexp.
+;; - bib-display-citation (from Markus Stricker <stricki@vision.ee.ethz.ch>)
+;; Could not find entry with trailing spaces
+;; V1.06 Nov 20 94 - Peter Galbraith
+;; - Fixed bib-apropos for:
+;; hilighting without invoking bibtex mode.
+;; display message when no matches found.
+;; would search only last bib file listed (forgot to `goto-char 1')
+;; - Fixed bib-make-bibliography that would only see first citation in a
+;; multi-key \cite command (found by Michail Rozman <roz@physik.uni-ulm.de>
+;; - bib-make-bibliography didn't see \cite[A-Z]* commands.
+;; Found by Richard Stanton <stanton@haas.berkeley.edu>
+;; **************************************************
+;; - * Completely rewritten code to support crossrefs *
+;; **************************************************
+;; - autodetection of OS/2 and DOS for bib-dos-or-os2-variable
+;; - Created bib-display-citation-mouse
+;; - bib-apropos works in bibtex-mode on the current buffer
+;; - bibtex entry may have comma on next line (!)
+;; @ARTICLE{Kiryati-91
+;; , YEAR = {1991 }
+;; ...
+;; V1.05 Nov 02 94 - Peter Galbraith
+;; - bug fix by rossmann@TI.Uni-Trier.DE (Jan Rossmann)
+;; for (boundp 'TeX-check-path) instead of fboundp. Thanks!
+;; - Translate environment variable set by bib-bibtex-env-variable.
+;; (suggested by Richard Stanton <stanton@haas.berkeley.edu>)
+;; - add bib-dos-or-os2-variable to set environment variable path separator
+;; - Add key-defs for any tex-mode and auc-tex menu-bar entries.
+;; [in auc-tec TeX-mode-map is common to both TeX and LaTeX at startup
+;; (but TeX-mode-map is only copied to LaTeX-mode-map at initilisation)
+;; in plain emacs, use tex-mode-map for both TeX and LaTeX.]
+;; - Add key def for bibtex-mode to create auc-tex's parsing file.
+;; - Fix bugs found by <thompson@loon.econ.wisc.edu>
+;; - fix bib-get-citation for options
+;; - fix bib-get-citation for commas preceeded citation command
+;; - better regexp for citations and their keys.
+;; - Added @string support for any entry (not just journal entries).
+;; (I had to disallow numbers in @string keys because of years.
+;; Is that ok?)
+;; - added bib-apropos
+;; V1.04 Oct 24 94 - Peter Galbraith
+;; - Don't require dired-aux, rather define the function we need from it.
+;; - Regexp-quote the re-search for keys.
+;; - Name the bib-make-bibliography buffer diffently than LaTeX buffer
+;; because auc-tex's parsing gets confused if same name base is used.
+;; V1.03 Oct 24 94 - Peter Galbraith - require dired-aux for dired-split
+;; V1.02 Oct 19 94 - Peter Galbraith
+;; - If using auc-tex with parsing activated, use auc-tex's functions
+;; to find all \bibliography files in a multi-file document.
+;; - Find bib files in pwd, BIBINPUTS environment variable path and
+;; TeX-check-path elisp variable path.
+;; - Have the parser ignore \bibliography that is on a commented `%' line.
+;; (patched by Karl Eichwalder <karl@pertron.central.de>)
+;; - Allow for spaces between entry type and key in bib files:
+;; (e.g @Article{ key} )
+;; (suggested by Nathan E. Doss <doss@ERC.MsState.Edu>)
+;; - Allows options in \cite command (e.g. agu++ package \cite[e.g.][]{key})
+;; - Includes @String{} abbreviations for `journal' entries
+;; V1.01 July 07 94 - Peter Galbraith - \bibliography command may have list of
+;; BibTeX files. All must be readable.
+;; V1.00 July 06 94 - Peter Galbraith - Created
+;; ----------------------------------------------------------------------------
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(defgroup bib-cite nil
+ "bib-cite, LaTeX minor-mode to display \\cite, \\ref and \\label commands."
+ :group 'tex)
+
+(defcustom bib-cite-use-reftex-view-crossref nil
+ "*Non-nil means, RefTeX will be used to find cross references.
+When this variable is non-nil, both `bib-find' and `bib-display' will
+call a function in RefTeX to find or display the cross reference of a
+\\ref or \\cite macro at point."
+ :group 'bib-cite
+ :type 'boolean)
+
+(defcustom bib-novice t
+ "*Give advice to novice users about what commands to use next."
+ :group 'bib-cite
+ :type 'boolean)
+
+(defcustom bib-switch-to-buffer-function 'switch-to-buffer
+ "*Function used to select buffers if they differ from the original.
+You may use `switch-to-buffer' `switch-to-buffer-other-window' or
+`switch-to-buffer-other-frame'."
+ :group 'bib-cite
+ :type '(choice (function-item switch-to-buffer)
+ (function-item switch-to-buffer-other-window)
+ (function-item switch-to-buffer-other-frame)))
+
+(defcustom bib-highlight-mouse-t t
+ "*Call bib-highlight-mouse from `LaTeX-mode-hook' to add green highlight."
+ :group 'bib-cite
+ :type 'boolean)
+
+(defcustom bib-label-help-echo-format "button2 finds %s, button3 displays %s"
+ "*Format string for info if the mouse is over LaTeX commands.
+If nil, do not display info."
+ :group 'bib-cite
+ :type '(radio (const :tag "Don't display info" nil)
+ string))
+
+(defcustom bib-bibtex-env-variable "BIBINPUTS"
+ "*Environment variable setting the path where BiBTeX input files are found.
+BiBTeX 0.99b manual says this should be TEXBIB.
+Another version says it should BSTINPUTS. I don't know anymore!
+
+The colon character (:) is the default path separator in unix, but you may
+use semi-colon (;) for DOS or OS/2 if you set bib-dos-or-os2-variable to t."
+ :group 'bib-cite
+ :type 'string)
+
+(defcustom bib-cite-inputs nil
+ "*List of directories to search for .bib files.
+This is in addition to those listed in the environment variable specified by
+`bib-bibtex-env-variable'."
+ :group 'bib-cite
+ :type '(repeat (file :format "%v")))
+
+(defcustom bib-cite-aux-inputs nil
+ "*List of directories to search for .aux files.
+MiKTeX has the LaTeX option -aux-directory to store .aux files in an alternate
+directory. You may set this variable to let bib-cite find these .aux files."
+ :group 'bib-cite
+ :type '(repeat (file :format "%v")))
+
+(defcustom bib-dos-or-os2-variable (or (equal 'emx system-type)
+ (equal 'ms-dos system-type))
+ ;; Under OS/2 system-type equals emx
+ ;; Under DOS system-type equals ms-dos
+ "*Whether you use DOS or OS/2 for bib-make-bibliography/bib-display.
+
+It tells bib-make-bibliography and bib-display to translate
+the BIBINPUTS environment variable using the \";\" character as
+a path separator and to translate DOS' backslash to slash.
+
+e.g. Use a path like \"c:\\emtex\\bibinput;c:\\latex\\bibinput\"
+
+\(You can change the environment variable which is searched by setting the
elisp variable bib-bibtex-env-variable)"
+ :group 'bib-cite
+ :type 'boolean)
+
+(defcustom bib-etags-command "etags -r '/.*\\\\\\(eq\\|page\\|[fvF]\\)ref.*/'
-o "
+ "*Variable for the etags command and its output option.
+In unix, this is usually \"etags -r '/.*\\\(eq\|page\|[fvF]\)ref.*/' -o \"
+\(we use the -r option to tell etags to list AMS-LaTeX's \\eqref command.)
+In DOS and OS/2, this *may* be different, e.g. using slashes like \"etags /o=\"
+If so, set it this variable."
+ :group 'bib-cite
+ :type 'string)
+
+(defcustom bib-etags-append-command "etags -r
'/.*\\\\\\(eq\\|page\\|[fvF]\\)ref.*/' -a -o "
+ "*Variable for the etags command and its append and output option.
+In unix, this is usually \"etags -r '/.*\\\(eq\|page\|[fvF]\)ref.*/' -a -o \"
+In DOS and OS/2, this *may* be \"etags /a /o=\" If so, set it this variable."
+ :group 'bib-cite
+ :type 'string)
+
+(defcustom bib-etags-filename "TAGS"
+ "*Variable for the filename generated by etags, by defaults this TAGS.
+but you may want to change this to something like TAGSLaTeX such that it can
+coexist with some other tags file in your master file directory."
+ :group 'bib-cite
+ :type 'string)
+
+(defcustom bib-ref-regexp "\\\\\\(eq\\|page\\|[fvF]\\)?ref"
+ "*Regular expression for \\ref LaTeX commands that have a matching \\label.
+without the curly bracket.
+
+If you change this variable and you use multi-file documents, make sure you
+also edit the variables bib-etags-command and bib-etags-append-command."
+ :group 'bib-cite
+ :type 'regexp)
+
+(defcustom bib-substitute-string-in-display t
+ "*Determines if bib-display will substitute @string definitions.
+If t, then the @string text is substituted.
+If nil, the text is not substituted but the @string entry is included."
+ :group 'bib-cite
+ :type 'boolean)
+
+(defcustom bib-string-ignored-warning
+ '("jan" "feb" "mar" "apr" "may" "jun" "jul" "aug" "sep" "sept" "oct" "nov"
+ "dec" "acmcs" "acta" "cacm" "ibmjrd" "ibmjs" "ieeese" "ieeetcad"
+ "ieeetc" "ipl" "jacm" "jcss" "scp" "sicomp" "tcs" "tocs" "tods" "tog"
+ "toms" "toois" "toplas" )
+ "*@string abbreviations for which a warning is not given if not defined.
+These are usually month abbreviations (or journals) defined in a style file."
+ :group 'bib-cite
+ :type '(repeat (string :tag "Entry")))
+
+;;<<<<<<User-Modifiable variables end here.
+
+(defvar bib-ref-regexpc (concat bib-ref-regexp "{")
+ "*Regular expression for \\ref LaTeX commands that have a matching \\label.
+A opening curly bracket is appended to the regexp.")
+
+(defvar bib-cite-is-XEmacs
+ (not (null (save-match-data (string-match "XEmacs\\|Lucid" emacs-version)))))
+
+(defvar bib-cite-minor-mode nil)
+
+(defvar bib-highlight-mouse-keymap (make-sparse-keymap)
+ "Keymap for mouse bindings in highlighted texts in bicite.")
+
+(defvar bib-ext-list nil
+ "Xemacs buffer-local list of bib-cite extents.")
+(make-variable-buffer-local 'bib-ext-list)
+(put 'bib-ext-list 'permanent-local t)
+
+(defvar bib-cite-minor-mode-menu nil)
+
+;;;###autoload
+(defun bib-cite-minor-mode (arg)
+ "Toggle bib-cite mode.
+When bib-cite mode is enabled, citations, labels and refs are highlighted
+when the mouse is over them. Clicking on these highlights with [mouse-2]
+runs bib-find, and [mouse-3] runs bib-display."
+ (interactive "P")
+ (set (make-local-variable 'bib-cite-minor-mode)
+ (if arg
+ (> (prefix-numeric-value arg) 0)
+ (not bib-cite-minor-mode)))
+ (cond
+ (bib-cite-minor-mode ;Setup the minor-mode
+ ;; Christoph Wedler's <wedler@fmi.uni-passau.de> suggestion for xemacs
+ ;; Added for version 2.19
+ (if (boundp 'tags-always-exact)
+ (progn
+ (make-local-variable 'tags-always-exact)
+ (setq tags-always-exact nil)))
+ ;; mouse overlay
+ (if bib-highlight-mouse-t
+ (progn
+ (bib-cite-setup-highlight-mouse-keymap)
+ (bib-highlight-mouse)
+ (make-local-hook 'after-change-functions)
+ (add-hook 'after-change-functions
+ 'bib-cite-setup-mouse-function nil t)))
+ (if bib-cite-is-XEmacs
+ (progn
+ (or (local-variable-p 'current-menubar (current-buffer))
+ (set-buffer-menubar current-menubar))
+ (add-submenu nil bib-cite-minor-mode-menu))))
+ (t
+ ;;;Undo the minor-mode
+ ;; mouse overlay
+ (cond
+ (bib-cite-is-XEmacs
+ (while bib-ext-list
+ (delete-extent (car bib-ext-list))
+ (setq bib-ext-list (cdr bib-ext-list))))
+ (t
+ (remove-hook 'after-change-functions 'bib-cite-setup-mouse-function t)
+ (let ((before-change-functions) (after-change-functions))
+ ;; FIXME This detroys all mouse-faces and local-maps!
+ ;; FIXME Hope no other package is using them in this buffer!
+ (remove-text-properties (point-min) (point-max)
+ '(mouse-face t local-map t)))))
+ (if bib-cite-is-XEmacs
+ (delete-menu-item '("BCite"))))))
+
+;;This must be eval'ed when the LaTeX mode is in use.
+;; bib-highlight-mouse-keymap is a local variable so each buffer can have it's
+;; own.
+(defun bib-cite-setup-highlight-mouse-keymap ()
+ "Set up the bib-cite text in the current buffer to be clickable."
+ (make-local-variable 'bib-highlight-mouse-keymap)
+ (setq bib-highlight-mouse-keymap
+ ;;; First, copy the local keymap so we don't have `disappearing' menus
+ ;;; when the mouse is moved over a \ref, \label or \cite command.
+
+ ;;; FIXME: Check out (mouse-major-mode-menu) to see how it grabs the local
+ ;;; menus to display. Maybe on `highlighted' commands we could only
+ ;;; display the bib-cite stuff (or a subset of it).
+ (let ((m (copy-keymap (current-local-map))))
+ (cond
+ (bib-cite-is-XEmacs
+ (set-keymap-name m 'bib-highlight-mouse-keymap)
+ (cond
+ ;;action-key stuff from Vladimir Alexiev <vladimir@cs.ualberta.ca>
+ ((commandp 'action-key)
+ ;; for hyperbole. The Right Way is to define implicit buttons
+ ;; (defib) bib-cite and label-ref instead of overriding
+ ;; action-key and assist key, so that eg smart key help can
+ ;; be obtained, but I'm lazy.
+ (substitute-key-definition 'action-key 'bib-find m global-map)
+ (substitute-key-definition 'assist-key 'bib-display m global-map)
+ (substitute-key-definition 'action-key-depress
+ 'bib-find-mouse m global-map)
+ (substitute-key-definition 'assist-key-depress
+ 'bib-display-mouse m global-map)
+ (substitute-key-definition 'action-mouse-key nil m global-map)
+ (substitute-key-definition 'assist-mouse-key nil m global-map))
+ (t ; xemacs, not hyperbole
+ (define-key m "\e\r" 'bib-find-mouse) ; bug Fixed in V2.17
+ (define-key m "\e\n" 'bib-display-mouse) ;bug Fixed in V2.17
+ ;;(define-key m [(shift button1)] 'bib-display-mouse)
+ (define-key m [button3] 'bib-display-mouse)
+ (define-key m [button2] 'bib-find-mouse))))
+ (t ; emacs 19
+ (cond
+ ((commandp 'action-key)
+ (substitute-key-definition 'action-key 'bib-find m global-map)
+ (substitute-key-definition 'assist-key 'bib-display m global-map)
+ (substitute-key-definition 'action-mouse-key-emacs19
+ 'bib-find-mouse m global-map)
+ (substitute-key-definition 'assist-mouse-key-emacs19
+ 'bib-display-mouse m global-map)
+ (substitute-key-definition 'action-key-depress-emacs19
+ nil m global-map)
+ (substitute-key-definition 'assist-key-depress-emacs19
+ nil m global-map))
+ (t ; emacs 19, not hyperbole
+ (define-key m [down-mouse-3] 'bib-display-mouse)
+ (define-key m [mouse-2] 'bib-find-mouse)))))
+ m)))
+
+;;;###autoload
+(defun turn-on-bib-cite ()
+ "Unconditionally turn on Bib Cite mode."
+ (bib-cite-minor-mode 1))
+
+(defun bib-cite-setup-mouse-function (beg end old-len)
+ (save-excursion
+ (save-match-data
+ (save-restriction
+ (narrow-to-region
+ (progn (goto-char beg) (beginning-of-line) (point))
+ (progn (goto-char end) (forward-line 1) (point)))
+ (bib-highlight-mouse)))))
+
+(defvar bib-cite-minor-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\C-cba" 'bib-apropos)
+ (define-key map "\C-cbb" 'bib-make-bibliography)
+ (define-key map "\C-cbd" 'bib-display)
+ (define-key map "\C-cbe" 'bib-etags)
+ (define-key map "\C-cbf" 'bib-find)
+ (define-key map "\C-cbn" 'bib-find-next)
+ (define-key map "\C-cbh" 'bib-highlight-mouse)
+ map)
+ "Bib-cite minor-mode keymap.")
+
+(easy-menu-define
+ bib-cite-minor-mode-menu bib-cite-minor-mode-map "Menu keymap for bib-cite."
+ '("BCite"
+ ["Make BibTeX bibliography buffer" bib-make-bibliography t]
+ ["Display citation or matching \\ref or \\label" bib-display t]
+ ["Find BibTeX citation or matching \\ref or \\label" bib-find t]
+ ["Search apropos BibTeX files" bib-apropos t]
+ ["Build TAGS file for multi-file document" bib-etags (bib-master-file)]
+ ["Refresh \\cite, \\ref and \\label mouse highlight"
+ bib-highlight-mouse t]))
+
+;; Install ourselves:
+(or (assq 'bib-cite-minor-mode minor-mode-alist)
+ (setq minor-mode-alist
+ (cons '(bib-cite-minor-mode " BCite") minor-mode-alist)))
+(or (assq 'bib-cite-minor-mode minor-mode-map-alist)
+ (setq minor-mode-map-alist
+ (cons (cons 'bib-cite-minor-mode bib-cite-minor-mode-map)
+ minor-mode-map-alist)))
+
+
+;;; Add a menu entry to bibtex.el (Perhaps I should not do this).
+(cond
+ ((and (string-match "XEmacs\\|Lucid" emacs-version)
+ (or window-system
+ (fboundp 'smart-menu))) ;text menus by Bob Weiner
+ ;;
+ ;; xemacs under X with AUCTeX
+ ;;
+
+ ;; Add to bibtex.el's popup menu
+ (defvar bib-cite-xemacs-bibtex-mode-menu
+ '("---"
+ "Bib-Cite"
+ "---"
+ ["Search apropos BibTeX files" bib-apropos t]
+ ["Create AUCTeX auto parsing file" bib-create-auto-file t])
+ "Submenu of bibtex-mode menu, used by bib-cite.")
+
+ (if (boundp 'bibtex-menu)
+ ;; Add menu now
+ (setq bibtex-menu
+ (append
+ bibtex-menu
+ bib-cite-xemacs-bibtex-mode-menu))
+ ;; Setup to add menu later
+ (defun bib-cite-bibtex-mode-hook ()
+ (if (boundp 'bibtex-menu)
+ (progn
+ (setq bibtex-menu
+ (append
+ bibtex-menu
+ bib-cite-xemacs-bibtex-mode-menu))
+ (remove-hook 'bibtex-mode-hook 'bib-cite-bibtex-mode-hook))))
+ (add-hook 'bibtex-mode-hook 'bib-cite-bibtex-mode-hook))
+ )
+
+ ((and (not (string-match "XEmacs\\|Lucid" emacs-version))
+ (string-equal "19" (substring emacs-version 0 2))
+ (or window-system
+ (fboundp 'tmm-menubar))) ; 19.30 - Will autoload if necessary
+ ;;
+ ;; emacs-19 under X-windows (or non-X with tmm)
+ ;;
+
+ ;; This *almost* makes me want to switch over to XEmacs...
+
+ ;; to AUCTeX auto file for a bibtex buffer
+ (eval-after-load
+ "bibtex"
+ '(progn
+ (cond
+ ((lookup-key bibtex-mode-map [menu-bar move/edit])
+ (define-key-after
+ (lookup-key bibtex-mode-map [menu-bar move/edit])
+ [bib-nil] '("---" . nil) '"--")
+ (define-key-after
+ (lookup-key bibtex-mode-map [menu-bar move/edit])
+ [bib-apropos] '("Search Apropos" . bib-apropos) 'bib-nil)
+ (define-key-after
+ (lookup-key bibtex-mode-map [menu-bar move/edit])
+ [auc-tex-parse]
+ '("Create AUCTeX auto parsing file" . bib-create-auto-file)
+ 'bib-apropos))
+ ((lookup-key bibtex-mode-map [menu-bar bibtex-edit])
+ (define-key-after
+ (lookup-key bibtex-mode-map [menu-bar bibtex-edit])
+ [bib-nil] '("---" . nil) '"--")
+ (define-key-after
+ (lookup-key bibtex-mode-map [menu-bar bibtex-edit])
+ [bib-apropos] '("Search Apropos" . bib-apropos) 'bib-nil)
+ (define-key-after
+ (lookup-key bibtex-mode-map [menu-bar bibtex-edit])
+ [auc-tex-parse]
+ '("Create AUCTeX auto parsing file" . bib-create-auto-file)
+ 'bib-apropos)))))))
+
+;; Following from bibtex.el
+(defvar
+ bib-cite-bibtex-font-lock-keywords
+ '(("^\\( \\|\t\\)*\\(@[A-Za-z]+\\)[
\t]*[({]\\([][A-Za-z0-9.:;?!`'()/*@_+=|<>-]+\\)?"
+ (2 font-lock-function-name-face)
+ (3 font-lock-reference-face nil t))
+ ;; reference type and reference label
+ ("^[ \t]*\\(OPT[^\"#%'(),={} \t\n0-9][^\"#%'(),={} \t\n]*\\)[ \t]*="
+ 1 font-lock-comment-face)
+ ;; optional field names (treated as comments)
+ ("^[ \t]*\\([^\"#%'(),={} \t\n0-9][^\"#%'(),={} \t\n]*\\)[ \t]*="
+ 1 font-lock-variable-name-face)
+ ;; field names
+ "Default expressions to fontify in BibTeX mode."))
+
+(defvar bib-cite-bibtex-mode-syntax-table
+ (let ((st (make-syntax-table)))
+ ;; [alarson:19920214.1004CST] make double quote a string quote
+ (modify-syntax-entry ?\" "\"" st)
+ (modify-syntax-entry ?$ "$$ " st)
+ (modify-syntax-entry ?% "< " st)
+ (modify-syntax-entry ?' "w " st)
+ (modify-syntax-entry ?@ "w " st)
+ (modify-syntax-entry ?\\ "\\" st)
+ (modify-syntax-entry ?\f "> " st)
+ (modify-syntax-entry ?\n "> " st)
+ (modify-syntax-entry ?~ " " st)
+ st))
+;; Code from bibtex.el ends
+
+;; @string starts with a letter and does not contain any of ""#%'(),={}
+;; Here we do not check that the field contains only one string field and
+;; nothing else.
+(defvar bib-string-regexp
+ "^[, \t]*[a-zA-Z]+[ \t]*=[ \t]*\\([a-zA-Z][^#%'(),={}\" \t\n]*\\)"
+ "Regular expression for field containing a @string.")
+
+(defun bib-display ()
+ "Display BibTeX citation or matching \\ref or \\label command under point.
+
+If text under cursor is a \\cite command, then display its BibTeX info from
+\\bibliography input file.
+ Example with cursor located over cite command or arguments:
+ \cite{Wadhams81,Bourke.et.al87,SchneiderBudeus94}
+ ^Display-all-citations ^Display-this-citation
+
+If text under cursor is a \\ref command, then display environment associated
+with its matching \\label command.
+
+If text under cursor is a \\label command, then display the text around
+the first matching \\ref command.
+
+The user is prompted for a \\label or \\ref is nothing suitable is found under
+the cursor. The first prompt is for a label. If you answer with an empty
+string, a second prompt for a ref will be given.
+
+A TAGS file is created and used for multi-file documents under auctex."
+ (interactive)
+ (let ((cite)(ref)(label))
+ (save-excursion
+ (if (not (looking-at "\\\\"))
+ (search-backward "\\" nil t))
+ (if (looking-at bib-ref-regexpc)
+ (setq ref t)
+ (if (looking-at "\\\\label{")
+ (setq label t)
+ (setq cite t))))
+ (cond
+ ;; reftex doesn't handle label->ref
+ ((and bib-cite-use-reftex-view-crossref
+ (or ref cite))
+ ;;;FIXME: reftex doesn't want point on \ref or \cite part, but on keyword
+ (require 'reftex)
+ (reftex-view-crossref nil))
+ (cite
+ (bib-display-citation))
+ (t
+ (bib-display-label)))))
+
+(defun bib-find ()
+ "Edit BibTeX citation or find matching \\ref or \\label command under point.
+
+For multi-entry cite commands, the cursor should be on the actual cite key
+desired (otherwise a random entry will be selected).
+e.g.: \cite{Wadhams81,Bourke.et.al87,SchneiderBudeus94}
+ ^Display-this-citation
+
+If text under cursor is a \\ref command, then point is moved to its matching
+\\label command.
+
+If text under cursor is a \\label command, then point is moved to the first
+matching \\ref command.
+
+The user is prompted for a \\label or \\ref is nothing suitable is found under
+the cursor. The first prompt is for a label. If you answer with an empty
+string, a second prompt for a ref will be given.
+
+A TAGS file is created and used for multi-file documents under auctex."
+ (interactive)
+ (let ((cite)(ref)(label))
+ (save-excursion
+ (if (not (looking-at "\\\\"))
+ (search-backward "\\" nil t))
+ (if (looking-at bib-ref-regexpc)
+ (setq ref t)
+ (if (looking-at "\\\\label{")
+ (setq label t)
+ (setq cite t))))
+ (cond
+ ;; reftex doesn't handle label->ref
+ ((and bib-cite-use-reftex-view-crossref
+ (or ref cite))
+ (require 'reftex)
+ (reftex-view-crossref t))
+ (cite
+ (bib-edit-citation))
+ (t
+ (bib-find-label)))))
+
+(defvar bib-cite-search-ring nil
+ "Bib-cite intenal variable to hold last \\ref or \\eqref find.")
+
+(defun bib-find-next (&optional prev-p)
+ "Find next occurrence of a \ref or \eqref.
+This is made necessary because we now use a regexp to find tags in multi-file
+documents, and the Emacs command `find-tag' doesn't allow to interactively
+find the next occurrence of a regexp."
+ (interactive "P")
+ (if (bib-master-file) ;Multi-file document
+ (if prev-p
+ (find-tag t '- t)
+ (find-tag t t t))
+ (if bib-cite-search-ring
+ ;;FIXME: Should first make sure I move off initial \ref{}.
+ (let ((regexp (concat bib-ref-regexpc bib-cite-search-ring "}")))
+ (if prev-p
+ (if (not (re-search-backward regexp nil t))
+ (message "No previous occurrence of reference %s"
+ bib-cite-search-ring))
+ (if (not (re-search-forward regexp nil t))
+ (message "No next occurrence of reference %s"
+ bib-cite-search-ring))))
+ (message "Sorry, no previous reference to find. Use bib-find?"))))
+
+(defun bib-display-mouse (EVENT)
+ "Display BibTeX citation or matching \\ref or \\label under mouse EVENT.
+See bib-display."
+ (interactive "e")
+ (mouse-set-point EVENT)
+ (bib-display))
+
+(defun bib-find-mouse (EVENT)
+ "Edit BibTeX citation or find matching \\ref or \\label under mouse EVENT.
+See bib-find."
+ (interactive "e")
+ (mouse-set-point EVENT)
+ (bib-find))
+
+(defun bib-apropos ()
+ "Display BibTeX entries containing a keyword from bibliography file.
+The files specified in the \\bibliography command are searched unless
+the current buffer is in `bibtex-mode' or is the Help buffer. In those
+cases, *it* is searched. This allows you to trim down a search further
+by using bib-apropos sequentially."
+ ;;(interactive "sBibTeX apropos: ")
+ (interactive)
+ (let* ((keylist (and (boundp 'TeX-auto-update) ;Avoid error in FRAMEPOP
+ (fboundp 'LaTeX-bibitem-list) ;Use this if using auctex
+ (LaTeX-bibitem-list)))
+ (keyword (bib-apropos-keyword-at-point))
+ (keyword (completing-read "BiBTeX apropos: " keylist nil nil keyword))
+ (the-text)(key-point)(start-point)
+ (new-buffer-f (and (not (string-match "^bib" mode-name))
+ (not (string-equal "*Help*" (buffer-name)))))
+ (bib-buffer (or (and new-buffer-f (bib-get-bibliography nil))
+ (current-buffer))))
+ (save-excursion
+ (set-buffer bib-buffer)
+ (goto-char (point-min))
+ (while (and (re-search-forward "^[ \t]*@" nil t)
+ (re-search-forward keyword nil t))
+ (setq key-point (point)) ;To make sure this is within entry
+ (re-search-backward "^[ \t]*@" nil t)
+ (setq start-point (point))
+ (forward-list 1)
+ (if (< (point) key-point) ;And this is that test...
+ (goto-char key-point) ;Not within entry, skip it.
+ (setq the-text
+ (cons (concat (buffer-substring start-point (point)) "\n")
+ the-text))))
+ (if (not the-text)
+ (message "Sorry, no matches found.")
+ (with-output-to-temp-buffer "*Help*"
+ (mapcar 'princ (nreverse the-text)))
+ (bib-cite-fontify-help-as-bibtex)
+ (if bib-novice
+ (message
+ (substitute-command-keys
+ (concat "Use \\[bib-apropos] again in the *help* buffer"
+ " to trim the search")))))
+ (if new-buffer-f
+ (kill-buffer bib-buffer)))))
+
+(defvar bib-document-citekeys-obarray-warnings nil
+ "Bib-cite internal variable.")
+
+(defun bib-make-bibliography ()
+ "Extract citations used in the current document from \bibliography{} file(s).
+Put them into a buffer named after the current buffer, with extension .bib.
+
+In an AUCTeX multi-file document, parsing must be on and the citation keys
+are extracted from the .aux files.
+
+In a plain LaTeX buffer (not multi-file), the cite keys are extracted from
+the text itself. Therefore the text need not have been previously processed
+by LaTeX.
+
+This function is useful when you want to share a LaTeX file, and therefore want
+to create a bibtex file containing only the references used in the document."
+ (interactive)
+ (let* ((the-keys-obarray (or (bib-document-citekeys-obarray)
+ (bib-buffer-citekeys-obarray)))
+ ;1st in case of error
+ (new-buffer
+ (create-file-buffer
+ (concat (substring (buffer-name) 0
+ (or (string-match "\\." (buffer-name))
+ (length (buffer-name))))
+ "-bib.bib")))
+ (bib-buffer (bib-get-bibliography nil))
+ (the-warnings (bib-get-citations the-keys-obarray
+ bib-buffer
+ new-buffer
+ nil)))
+ (kill-buffer bib-buffer)
+;;; (switch-to-buffer new-buffer)
+ (funcall bib-switch-to-buffer-function new-buffer)
+ (bibtex-mode)
+ (if (or bib-document-citekeys-obarray-warnings
+ the-warnings)
+ (progn
+ (cond
+ ((and bib-document-citekeys-obarray-warnings the-warnings)
+ (with-output-to-temp-buffer "*Help*"
+ (princ bib-document-citekeys-obarray-warnings the-warnings)))
+ (bib-document-citekeys-obarray-warnings
+ (with-output-to-temp-buffer "*Help*"
+ (princ bib-document-citekeys-obarray-warnings)))
+ (the-warnings
+ (with-output-to-temp-buffer "*Help*" (princ the-warnings))))
+ (setq bib-document-citekeys-obarray-warnings nil) ;Reset
+ (bib-cite-fontify-red)))
+ (if bib-novice
+ (message
+ (substitute-command-keys
+ "Use \\[save-buffer] to save this buffer to a file.")))))
+
+(defun bib-cite-fontify-red (&optional limit)
+ "Fontify *Help* buffer in red-bold up to optional LIMIT."
+ (if (and window-system ;Not exactly correct for XEmacs
+ (not (facep 'red-bold)))
+ (progn
+ (copy-face 'bold 'red-bold)
+ (set-face-foreground 'red-bold "red")))
+ (save-excursion
+ (set-buffer "*Help*")
+ (let ((before-change-functions) (after-change-functions))
+ (put-text-property (point-min)(or limit (point-max))
+ 'face 'red-bold))))
+
+(defun bib-cite-fontify-help-xemacs (defaults)
+ (if (fboundp 'font-lock-set-defaults-1) ; >= XEmcas 19.14
+ (progn
+ (set-buffer "*Help*")
+ (setq font-lock-defaults-computed nil
+ font-lock-keywords nil)
+ (font-lock-set-defaults-1
+ (and defaults (font-lock-find-font-lock-defaults defaults)))
+ (font-lock-fontify-buffer)
+ (setq font-lock-defaults-computed nil
+ font-lock-keywords nil)
+ (font-lock-set-defaults-1))))
+
+(defun bib-cite-fontify-help-as-bibtex ()
+ (save-excursion
+ (cond
+ ((not (featurep 'font-lock))
+ nil) ;No font-lock! Stop here.
+ ;; font-lock under Emacs and XEmacs
+ ((string-match "XEmacs\\|Lucid" emacs-version)
+ ;; XEmacs
+ (bib-cite-fontify-help-xemacs 'bibtex-mode))
+ (t
+ ;; Emacs
+ (set-buffer "*Help*")
+ (let ((font-lock-defaults
+ '(bib-cite-bibtex-font-lock-keywords
+ nil t ((?$ . "\"")(?\" . ".")))))
+ (if font-lock-mode
+ (font-lock-mode)
+ (if (fboundp 'font-lock-unset-defaults) (font-lock-unset-defaults))
+ (font-lock-unfontify-buffer))
+ (font-lock-fontify-buffer))))))
+
+(defun bib-cite-fontify-help-as-latex ()
+ (save-excursion
+ (cond
+ ((not (featurep 'font-lock))
+ nil) ;No font-lock! Stop here.
+ ;; font-lock under Emacs and XEmacs
+ ((string-match "XEmacs\\|Lucid" emacs-version)
+ ;; XEmacs, not necessary to do s.th. special for font-latex, we do *not*
+ ;; want the buffer-local faces!
+ (bib-cite-fontify-help-xemacs 'latex-mode))
+ (t
+ ;; Emacs
+ (set-buffer "*Help*")
+ ;; Actually, don't want to `permanently' affect *Help* buffer...
+ ;;(if (featurep 'font-latex)
+ ;; (font-latex-setup)
+ ;; Rather I should deal with this in the `let' form:
+ ;; (make-local-variable 'font-lock-string-face)
+ ;; (setq font-lock-string-face font-latex-math-face
+ ;; font-latex-string-face (default-value 'font-lock-string-face))
+ (let ((font-lock-defaults
+ (if (featurep 'font-latex)
+ '((font-latex-keywords font-latex-keywords-1
+ font-latex-keywords-2)
+ nil nil ((?\( . ".") (?\) . ".") (?$ . "\"")) nil
+ (font-lock-comment-start-regexp . "%")
+ (font-lock-mark-block-function . mark-paragraph))
+ '(tex-font-lock-keywords nil nil ((?$ . "\""))))))
+ (if font-lock-mode
+ (font-lock-mode)
+ (if (fboundp 'font-lock-unset-defaults) (font-lock-unset-defaults))
+ (font-lock-unfontify-buffer))
+ (font-lock-fontify-buffer))))))
+
+(defvar bib-document-TeX-files-warnings nil
+ "Bib-cite internal variable.")
+
+(defun bib-etags (&optional masterdir)
+ "Invoke etags on all tex files of the document in directory MASTERDIR.
+Store the TAGS file in the master-directory.
+Expect errors if you use this outside of auctex or within a plain
+single-file document. Also makes sure that the TAGS buffer is updated.
+See variables bib-etags-command and bib-etags-filename"
+ (interactive)
+ (require 'etags)
+ (let* ((the-file-list (bib-document-TeX-files))
+ (the-file (car the-file-list))
+ (dir (or masterdir (bib-master-directory)))
+ (the-tags-file (expand-file-name bib-etags-filename dir))
+ (the-tags-buffer (get-file-buffer the-tags-file)))
+ ;; Create TAGS file with first TeX file (master file)
+ (shell-command (concat bib-etags-command the-tags-file " " the-file))
+ (setq the-file-list (cdr the-file-list))
+ ;; Append to TAGS file for all other TeX files.
+ (while the-file-list
+ (setq the-file (car the-file-list))
+ (shell-command
+ (concat bib-etags-append-command the-tags-file " " the-file))
+ (setq the-file-list (cdr the-file-list)))
+ (if the-tags-buffer ;buffer existed; we must refresh it.
+ (save-excursion
+ (set-buffer the-tags-buffer)
+ (revert-buffer t t)))
+
+ ;; Check value of tags-file-name against the-tags-file
+ (or (equal the-tags-file tags-file-name) ;make sure it's current
+ (visit-tags-table the-tags-file))
+
+ ;(set (make-local-variable 'tags-file-name) the-tags-file))
+ ;; above should not be needed
+
+ ;; Weird Bug:
+ ;; (visit-tags-table-buffer) seems to get called twice when called by
+ ;; find-tag on an undefined tag. The second time, it's in the TAGS
+ ;; buffer and returns an error because TAGS buffer does have
+ ;; tags-file-name set.
+ ;; To get around this. I'm setting this variable in the TAGS buffer.
+ ;; Skip this in XEmacs (Changed by Anders Stenman)
+ (if (and (not (string-match "XEmacs\\|Lucid" emacs-version))
+ (get-file-buffer the-tags-file))
+ (save-excursion
+ (set-buffer (get-file-buffer the-tags-file))
+ (set (make-local-variable 'tags-file-name) the-tags-file))))
+
+
+ (if bib-document-TeX-files-warnings ;free variable loose in emacs!
+ (progn
+ (with-output-to-temp-buffer "*Help*"
+ (princ bib-document-TeX-files-warnings))
+ (setq bib-document-TeX-files-warnings nil) ;Reset
+ (bib-cite-fontify-red))))
+
+(defun bib-Is-hidden ()
+ "Return true is current point is hidden."
+ (if (not selective-display)
+ nil ;Not hidden if not using this...
+ (save-excursion
+ (if (not (re-search-backward "[\n\^M]" nil t))
+ nil ;Play safe
+ (if (string-equal (match-string 0) "\n")
+ nil
+ t)))))
+
+(defun bib-highlight-mouse ()
+ "Make that nice green highlight when the mouse is over LaTeX commands."
+ (interactive)
+;;;Comment this out. User should be able to use bib-highlight-mouse
+;;;to try it out regardless of bib-highlight-mouse-t.
+;;;Check bib-highlight-mouse-t only in automated cases.
+;;;
+;;; (if (and bib-highlight-mouse-t
+;;; ;;window-system) ;Do nothing unless under X
+;;; )
+;;; *all of code was here*
+;;; )
+ (save-excursion
+ (let ((s)(e)(extent)(local-extent-list bib-ext-list)
+ (inhibit-read-only t)
+ (modified (buffer-modified-p))) ;put-text-property changing this?
+ ;; * peta Wed Nov 8 16:27:29 1995 -- better remove the mouse face
+ ;; properties first.
+ (setq bib-ext-list nil) ;Reconstructed below...
+ (if (string-match "XEmacs\\|Lucid" emacs-version)
+ (while local-extent-list
+ (setq extent (car local-extent-list))
+ (if (or (extent-detached-p extent)
+ (and (<= (point-min)(extent-start-position extent))
+ (>= (point-max)(extent-end-position extent))))
+ (delete-extent extent)
+ (setq bib-ext-list (cons extent bib-ext-list)))
+ (setq local-extent-list (cdr local-extent-list)))
+ ;; Remove properties for regular emacs
+ ;; FIXME This detroys all mouse-faces and local-maps!
+ ;; FIXME Hope no other package is using them in this buffer!
+ (let ((before-change-functions) (after-change-functions))
+ (remove-text-properties (point-min) (point-max)
+ '(mouse-face t local-map t))))
+ (goto-char (point-min))
+ (while
+ (re-search-forward
+ (concat
+ "\\\\\\(" (substring bib-ref-regexp 2)
+ "\\|label\\|[A-Za-z]*cite[A-Za-z]*\\(\\[[^]]*\\]\\)*\\){[^}]*}")
+ nil t)
+ (setq s (match-beginning 0))
+ (setq e (match-end 0))
+ (cond
+ ((string-match "XEmacs\\|Lucid" emacs-version)
+ (setq extent (make-extent s e))
+ (setq bib-ext-list (cons extent bib-ext-list))
+ (set-extent-property extent 'highlight t)
+ (set-extent-property extent 'start-open t)
+ (set-extent-property extent 'balloon-help 'bib-label-help)
+ (set-extent-property extent 'help-echo 'bib-label-help-echo)
+ (set-extent-property extent 'keymap bib-highlight-mouse-keymap))
+ (t
+ (let ((before-change-functions) (after-change-functions)
+ ;;(this-overlay (make-overlay s e))
+ )
+;;; Even using overlays doens't help here. If bib-highlight-mouse-keymap
+;;; does not include the AucTeX menus, then these disappear when we click
+;;; onto a \cite command. Perhaps using bib-cite as a minor mode will fix
+;;; this? For now, bib-cite must be loaded after these menus are built.
+;;; It must therefore be loaded in a mode-hook.
+ (put-text-property s e 'local-map bib-highlight-mouse-keymap)
+ (put-text-property s e 'mouse-face 'highlight)
+ ;;(overlay-put this-overlay 'local-map bib-highlight-mouse-keymap)
+ ;;(overlay-put this-overlay 'mouse-face 'highlight)
+ ))))
+ (set-buffer-modified-p modified))))
+
+(defun bib-toggle-highlight ()
+ "Toggle the enabling of bib-cite entries as clickable things."
+;; FIXME: do something about after-change stuff?
+ (interactive)
+ (if (setq bib-highlight-mouse-t (not bib-highlight-mouse-t))
+ (bib-highlight-mouse)
+ (let ((modified (buffer-modified-p))
+ (inhibit-read-only t))
+ (cond
+ ((string-match "XEmacs\\|Lucid" emacs-version)
+ (while bib-ext-list
+ (delete-extent (car bib-ext-list))
+ (setq bib-ext-list (cdr bib-ext-list))))
+ (t
+ (let ((before-change-functions) (after-change-functions))
+ (remove-text-properties (point-min) (point-max)
+ '(mouse-face local-map)))))
+ (set-buffer-modified-p modified))))
+
+(defun bib-label-help-echo (object)
+ (if bib-label-help-echo-format
+ (bib-label-help object bib-label-help-echo-format)))
+
+;;; Balloon-help callback. Anders Stenman <stenman@isy.liu.se>
+;;; Patched by Bruce Ravel <bruce.ravel@nist.gov>
+(defun bib-label-help (object &optional format)
+ (or format (setq format "Use mouse button 2 to find the %s.
+Use mouse button 3 to display the %s."))
+ (save-match-data
+ (let* ((string (extent-string object))
+ (type (cond ((string-match "^\\\\[A-Za-z]*cite[A-Za-z]*" string)
"citation")
+ ((string-match
+ (concat "^" bib-ref-regexp) string) "\\label{}")
+ ((string-match "^\\\\label" string) "\\ref{}")
+ (t "this (unknown) reference"))))
+ (format format type type))))
+
+;;----------------------------------------------------------------------------
+;; Routines to display or edit a citation's bibliography
+
+(defun bib-display-citation ()
+ "Do the displaying of cite info. Return t if found cite key, nil otherwise.
+Example with cursor located over cite command or arguments:
+\cite{Wadhams81,Bourke.et.al87,SchneiderBudeus94}
+ ^Display-all-citations ^Display-this-citation"
+ (save-excursion
+ (let* ((the-keys-obarray (bib-get-citekeys-obarray)) ;1st in case of error
+ (work-buffer (get-buffer-create "*bibtex-work*"))
+ (bib-buffer (bib-get-bibliography nil))
+ (the-warnings (bib-get-citations
+ the-keys-obarray
+ bib-buffer
+ work-buffer
+ bib-substitute-string-in-display))
+ (the-warn-point))
+ (if the-warnings
+ (progn
+ (set-buffer work-buffer)
+ (goto-char 1)
+ (insert the-warnings)
+ (setq the-warn-point (point))))
+ (with-output-to-temp-buffer
+ "*Help*"
+ (set-buffer work-buffer)
+ (princ (buffer-substring 1 (point-max))))
+ (bib-cite-fontify-help-as-bibtex)
+ (if the-warn-point
+ (bib-cite-fontify-red the-warn-point))
+ (kill-buffer bib-buffer)
+ (kill-buffer work-buffer))))
+
+(defun bib-edit-citation ()
+ "Do the edit of cite info. Return t if found cite key, nil otherwise.
+Find and and put edit point in bib file associated with a BibTeX citation
+under cursor from \bibliography input file.
+In a multi-entry cite command, the cursor should be on the actual cite key
+desired (otherwise a random entry will be selected).
+e.g.: \cite{Wadhams81,Bourke.et.al87,SchneiderBudeus94}
+ ^Display-this-citation"
+ (let ((the-keys-obarray (bib-get-citekeys-obarray)) ;1st in case of error
+ (bib-buffer (bib-get-bibliography t))
+ (the-key)(the-file))
+ (save-excursion
+ (mapatoms ;Do this for each cite-key found...
+ (lambda (cite-key)
+ (setq the-key (symbol-name cite-key)))
+ the-keys-obarray)
+ (set-buffer bib-buffer)
+ (goto-char (point-min))
+ (if (not (re-search-forward
+ (concat "@[^{(]+[{(][\t ]*" (regexp-quote the-key) "[ ,\n]")
+ nil t))
+ (progn
+ (kill-buffer bib-buffer)
+ (error "Sorry, could not find bib entry for %s" the-key))
+ (re-search-backward "%%%Filename: \\([^\n]*\\)" nil t)
+ (setq the-file (match-string 1))
+ (kill-buffer bib-buffer)))
+;;; (find-file the-file)
+ (funcall bib-switch-to-buffer-function (find-file-noselect the-file))
+ (goto-char (point-min)) ;V2.19 fix
+ (re-search-forward (concat "@[^{(]+[{(][\t ]*"
+ (regexp-quote the-key)
+ "[ ,\n]") nil t)))
+
+;;--------------------------------------------------------------------------
+;; Function for bib-apropos
+
+(defun bib-apropos-keyword-at-point ()
+ "Return the keyword under point for initial input to bib-apropos prompt."
+ (save-excursion
+ (let ((here (point)))
+ (cond
+ ((and (re-search-backward "[\n{, ]" nil t)
+ (string-equal "{" (buffer-substring (match-beginning 0)
+ (match-end 0))))
+ (if (fboundp 'buffer-substring-no-properties)
+ (buffer-substring-no-properties (1+ (point)) here)
+ (buffer-substring (1+ (point)) here)))))))
+
+;;--------------------------------------------------------------------------
+;; Functions for Displaying or moving to matching \ref or \label command
+
+(defun bib-display-label ()
+"Display environment or first ref associated with a label.
+The label or ref name is extracted from the text under the cursor, or the
+user is prompted is nothing suitable is found. The first prompt is for a
+label. If you answer with an empty string, a second prompt for a ref will
+be given."
+ (let ((the-regexp (bib-guess-or-prompt-for-label)))
+ (if (not the-regexp)
+ (message "No name given")
+ (bib-display-or-find-label the-regexp t))))
+
+(defun bib-find-label ()
+ "Move to a label, or the first occurance of a ref.
+The label or ref name is extracted from the text under the cursor.
+If nothing suitable is found, the user is prompted. The first prompt is for a
+label. If you answer with an empty string, a second prompt for a ref will be
+given.
+
+If within a single file document:
+ You can move back with C-xC-x as the mark is set before moving.
+ You can search for next occurrances of a ref command with C-sC-s.
+
+If within a multi-file document (in auctex only)
+ You can move back with C-xC-x if within the same buffer. If not, just
+ select your previous buffer.
+ You can search for next occurrances of a ref command with tag commands:
+ C-u M-. Find next alternate definition of last tag specified.
+ C-u - M-. Go back to previous tag found."
+ (let ((the-regexp (bib-guess-or-prompt-for-label)))
+ (if (not the-regexp)
+ (message "No name given")
+ (bib-display-or-find-label the-regexp nil))))
+
+;;--------------------------------------------------------------------------
+;; Functions for Displaying or moving to matching \ref or \label command
+
+(defun bib-display-or-find-label (the-regexp displayf)
+;; work horse for bib-find-label and bib-display-label
+ (let* ((masterfile (bib-master-file))
+ (masterdir (and masterfile
+ (file-name-directory masterfile)))
+ (new-point)(new-buffer))
+ (save-excursion
+ ;; Now we are either in a simple file, or with a multi-file document
+ (cond
+ (masterfile ;Multi-file document
+ (cond
+ (displayf ;Display only
+ (set-buffer (bib-etags-find-noselect the-regexp masterdir))
+ (re-search-forward the-regexp nil t)
+ ;; ...because tags puts point on beginning of line
+ (if (string-match "^\\\\\\\\label" the-regexp)
+ (bib-display-this-environment) ;display the label's environment
+ (bib-display-this-ref))) ; display the ref's context
+ (t ;Move to it
+ (setq new-buffer (bib-etags-find-noselect the-regexp masterdir))
+ (if bib-novice
+ (message
+ (substitute-command-keys
+ (concat "Use \\[bib-find-next] to find the next occurrence "
+ "and C-u \\[bib-find-next] to find previous."))))
+ (if (equal new-buffer (current-buffer))
+ (setq new-point (point)))))) ;Moving with the same buffer
+ (t ;Single-file document
+ (goto-char (point-min))
+ (cond
+ ((re-search-forward the-regexp nil t)
+ (if displayf
+ (if (string-match "^\\\\label" the-regexp)
+ (bib-display-this-environment) ;Display the environment
+ (bib-display-this-ref)) ; display the ref's context
+ (setq new-point (match-beginning 0)) ;or move there
+ (if (string-match "{\\(.*\\)}" the-regexp)
+ (setq bib-cite-search-ring (match-string 1 the-regexp)))
+ (if bib-novice
+ (message
+ (substitute-command-keys
+ (concat "Use \\[bib-find-next] to find the next occurrence "
+ "and C-u \\[bib-find-next] to find previous."))))))
+ (t
+ (message "Sorry, cannot find it (%s)" the-regexp))))))
+ (if new-point
+ (progn
+ (push-mark (point) t nil) ;We've moving there... push mark
+ (goto-char new-point))
+ (if new-buffer ;We've changing buffer
+ ;;(switch-to-buffer new-buffer)
+ (funcall bib-switch-to-buffer-function new-buffer)))
+ (if (bib-Is-hidden)
+ (save-excursion
+ (beginning-of-line)
+ (show-entry)))))
+
+(defvar bib-label-prompt-map nil)
+(if bib-label-prompt-map
+ ()
+ (setq bib-label-prompt-map (copy-keymap minibuffer-local-completion-map))
+ (define-key bib-label-prompt-map " " 'self-insert-command))
+
+(defun bib-guess-or-prompt-for-label ()
+ "Guess from context, or prompt the user for a label command."
+ (save-excursion
+ (if (not (looking-at "\\\\")) ;If not on beginning of a command
+ (re-search-backward "[\\]"
+ (save-excursion (beginning-of-line)(point))
+ t))
+ (cond
+ ((looking-at bib-ref-regexpc) ;On \ref, looking for matching \label
+ (let ((b (progn (search-forward "{" nil t)(forward-char -1)(point)))
+ (e (progn (forward-sexp 1)(point))))
+ (concat "\\\\label" (regexp-quote (buffer-substring b e)))))
+ ((looking-at "\\\\label{") ;On \label, looking for matching \ref
+ (let ((b (progn (search-forward "{" nil t)(forward-char -1)(point)))
+ (e (progn (forward-sexp 1)(point))))
+ (concat bib-ref-regexp (regexp-quote (buffer-substring b e)))))
+ (t ;Prompt the user
+ (let* ((minibuffer-local-completion-map bib-label-prompt-map)
+ (the-alist (create-alist-from-list
+ (cdr (reverse LaTeX-label-list))))
+ ;;; LaTeX-label-list example:
+ ;;; '(("label3" "label4")("label1" "label2") nil)
+ ;; so let's get rid of that nil part in embedded list.
+ (the-name
+ (if (string-equal "18" (substring emacs-version 0 2))
+ (completing-read "Label: " the-alist nil nil nil)
+ (completing-read "Label: " the-alist nil nil nil
+ 'LaTeX-find-label-hist-alist))))
+ (if (not (equal the-name ""))
+ (concat "\\\\label{" (regexp-quote the-name) "}")
+ ;; else try to get a \ref
+ (if (string-equal "18" (substring emacs-version 0 2))
+ (setq the-name (completing-read "Ref: " the-alist nil nil nil))
+ (setq the-name (completing-read "Ref: " the-alist nil nil nil
+ 'LaTeX-find-label-hist-alist)))
+ (if (not (equal the-name ""))
+ (concat bib-ref-regexpc (regexp-quote the-name) "}")
+ nil)))))))
+
+(defun bib-display-this-ref ()
+ "Display a few lines around current point."
+ (cond
+ ((bib-Is-hidden)
+ (with-output-to-temp-buffer "*BiBTemp*"
+ (princ
+ (buffer-substring
+ (save-excursion
+ (let ((i 3))
+ (while (and (> i 0)
+ (re-search-backward "[\n\^M]" nil t)
+ (setq i (1- i)))))
+ (point))
+ (save-excursion
+ (let ((i 3))
+ (while (and (> i 0)
+ (re-search-forward "[\n\^M]" nil t)
+ (setq i (1- i)))))
+ (point)))))
+ (set-buffer "*BiBTemp*")
+ (while (search-forward "\^M" nil t)
+ (replace-match "\n" nil t))
+ (goto-char 1)
+ (if (looking-at "\n") ;Remove first empty line...
+ (delete-char 1))
+ (with-output-to-temp-buffer "*Help*"
+ (princ (buffer-substring 1 (point-max))))
+ (bib-cite-fontify-help-as-latex)
+ (kill-buffer "*BiBTemp*"))
+ (t
+ (with-output-to-temp-buffer ; display the ref's context
+ "*Help*"
+ (princ
+ (buffer-substring (save-excursion (forward-line -2)(point))
+ (save-excursion (forward-line 3)(point)))))
+ (bib-cite-fontify-help-as-latex))))
+
+(defun bib-display-this-environment ()
+ "Display the environment associated with a label, or its section name.
+Assumes point is already on the label.
+Does not save excursion."
+;; Bugs: The method used here to detect the environment is *not* foolproof.
+;; It will get confused, for example, between two figure environments,
+;; picking out both instead of the section label above them. But since
+;; users typically puts their labels next to the section declaration,
+;; I'm satisfied with this... for now.
+;; I could have used the following AUCTeX functions:
+;; LaTeX-current-environment
+;; Function: Return the name (a string) of the enclosing LaTeX environment.
+;; LaTeX-current-section
+;; Function: Return the level of the section that contain point.
+;; but then this code would only work as part of AUCTeX...
+ (let ((the-point (point))
+ (end-point (point))
+ (the-environment)(foundf))
+ (while (and (not foundf)
+ (goto-char end-point) ;Past end of last search
+ (re-search-forward "\\(^\\|\^M\\)[ \t]*\\\\end{\\([^}]*\\)}"
+ nil t))
+ (setq end-point (point))
+ (setq the-environment (match-string 2))
+ (and (not (string-match "document" the-environment))
+ (re-search-backward (concat "\\(^\\|\^M\\)[ \t]*\\\\begin{"
+ (regexp-quote the-environment) "}"))
+ (<= (point) the-point)
+ (setq foundf t)))
+ (if foundf ;A good environment
+ (progn
+ (cond ((bib-Is-hidden) ;Better way is: replace-within-string
+ (with-output-to-temp-buffer "*BiBTemp*"
+ (princ (buffer-substring (point) end-point)))
+ (set-buffer "*BiBTemp*")
+ (while (search-forward "\^M" nil t)
+ (replace-match "\n" nil t))
+ (goto-char 1)
+ (if (looking-at "\n") ;Remove first empty line...
+ (delete-char 1))
+ (with-output-to-temp-buffer "*Help*"
+ (princ (buffer-substring 1 (point-max))))
+ (kill-buffer "*BiBTemp*"))
+ (t
+ (with-output-to-temp-buffer "*Help*"
+ (princ (buffer-substring (point) end-point)))))
+ (bib-cite-fontify-help-as-latex))
+ ;; Just find the section declaration
+ (goto-char the-point)
+ (if (re-search-backward
+;;; "\\(^\\|\^M\\)[ \t]*\\\\\\(sub\\)*section{\\([^}]*\\)}" nil t)
+;;; Michael Steiner <steiner@cs.uni-sb.de> patch
+ "\\(^\\|\^M\\)[ \t]*\\\\\\(\\(sub\\)*section\\|chapter\\|part\\)\\*?\
+{\\([^}]*\\)}"
+ nil t)
+ (message (match-string 0))
+ (error
+ "Sorry, could not find an environment or section declaration")))))
+
+(defvar LaTeX-find-label-hist-alist nil "History list for LaTeX-find-label.")
+(defvar LaTeX-label-list nil "Used by AUCTeX to store label names.")
+
+
+(defun create-alist-from-list (the-list)
+ "Return a single list from a THE-LIST that may contain either items or lists.
+e.g. turns
+'((\"label3\" \"label4\")(\"label1\" \"label2\") \"label\")
+into
+'((\"label3\") (\"label4\") (\"label1\") (\"label2\") (\"label\"))"
+ (mapcar 'list (bib-cite-mh-list-to-string the-list)))
+
+;;;
+;;; Following two functions from mh-utils.el (part of GNU emacs)
+;;; I have changed the names in case these functions change what they do.
+;;;
+
+(defun bib-cite-mh-list-to-string (l)
+ "Flattens the list L and make every element of the new list into a string."
+ (nreverse (bib-cite-mh-list-to-string-1 l)))
+
+(defun bib-cite-mh-list-to-string-1 (l)
+ (let ((new-list nil))
+ (while l
+ (cond ((null (car l)))
+ ((symbolp (car l))
+ (setq new-list (cons (symbol-name (car l)) new-list)))
+ ((numberp (car l))
+ (setq new-list (cons (int-to-string (car l)) new-list)))
+ ((equal (car l) ""))
+ ((stringp (car l)) (setq new-list (cons (car l) new-list)))
+ ((listp (car l))
+ (setq new-list (nconc (bib-cite-mh-list-to-string-1 (car l))
+ new-list)))
+ (t (error "Bad element in mh-list-to-string: %s" (car l))))
+ (setq l (cdr l)))
+ new-list))
+
+;; -------------------------------------------------------------------------
+;; Routines to extract cite keys from text
+
+;; ... is truly remarkable, as shown in \citeN{Thomson77,Test56}. Every
+;; \cite[{\it e.g.}]{Thomson77,Test56}
+
+(defun bib-get-citations (keys-obarray bib-buffer new-buffer substitute)
+ "Put citations of KEYS-OBARRAY from BIB-BUFFER into NEW-BUFFER.
+Substitute strings if SUBSTITUTE is t
+Return the-warnings as text."
+ (let ((the-warnings) ;The only variable to remember...
+ (case-fold-search t)) ;All other results go into new-buffer
+ ;; bibtex is not case-sensitive for keys.
+ (save-excursion
+ (let ((the-text))
+ (set-buffer bib-buffer)
+ (mapatoms ;Do this for each cite-key found...
+ (lambda (cite-key)
+ (goto-char (point-min))
+ (if (re-search-forward
+ (concat "@[^{(]+[{(][\t ]*"
+ (regexp-quote (symbol-name cite-key))
+ "\\([, ]\\\|$\\)")
+ ;; ^^ ^ comma, space or end-of-line
+ nil t)
+ (setq the-text (concat the-text
+ (buffer-substring
+ (progn (beginning-of-line)(point))
+ (progn (forward-sexp 2)(point)))
+ "\n\n"))
+ (setq the-warnings (concat the-warnings
+ "Cannot find entry for: "
+ (symbol-name cite-key) "\n"))))
+ keys-obarray)
+ (if (not the-text)
+ (error "Sorry, could not find any of the references"))
+ ;; Insert the citations in the new buffer
+ (set-buffer new-buffer)
+ (insert the-text)
+ (goto-char 1))
+
+ ;; We are at beginning of new-buffer.
+ ;; Now handle crossrefs
+ (let ((crossref-obarray (make-vector 201 0)))
+ (while (re-search-forward
+ "[, \t]*crossref[ \t]*=[ \t]*\\(\"\\|\{\\)" nil t)
+ ;;handle {text} or "text" cases
+ (if (string-equal "{" (match-string 1))
+ (re-search-forward "[^\}]+" nil t)
+ (re-search-forward "[^\"]+" nil t))
+ (intern (match-string 0) crossref-obarray))
+ ;; Now find the corresponding keys,
+ ;; but add them only if not already in `keys-obarray'
+ (set-buffer bib-buffer)
+ (goto-char 1)
+ (let ((the-text))
+ (mapatoms ;Do this for each crossref key found...
+ (lambda (crossref-key)
+ (if (not (intern-soft (symbol-name crossref-key) keys-obarray))
+ (progn
+ ;; Not in keys-obarray, so not yet displayed.
+ (goto-char (point-min))
+ (if (re-search-forward
+ (concat "@[^{(]+[{(][\t ]*"
+ (regexp-quote (symbol-name crossref-key))
+ "\\(,\\|$\\)")
+ nil t)
+ (setq the-text
+ (concat the-text
+ (buffer-substring
+ (progn (beginning-of-line)(point))
+ (progn (forward-sexp 2)(point)))
+ "\n\n"))
+ (setq the-warnings
+ (concat the-warnings
+ "Cannot find crossref entry for: "
+ (symbol-name crossref-key) "\n"))))))
+ crossref-obarray)
+ ;; Insert the citations in the new buffer
+ (set-buffer new-buffer)
+ (goto-char (point-max))
+ (if the-text
+ (insert the-text)))
+ (goto-char 1))
+
+ ;; Now we have all citations in new-buffer, collect all used @String keys
+ ;; Ex: journal = JPO,
+ (let ((strings-obarray (make-vector 201 0)))
+ (while (re-search-forward bib-string-regexp nil t)
+ (intern (match-string 1) strings-obarray))
+ ;; Now find the corresponding @String commands
+ ;; Collect either the @string commands, or the string to substitute
+ (set-buffer bib-buffer)
+ (goto-char 1)
+ (let ((string-alist)
+ (the-text))
+ (mapatoms ;Do this for each string-key found...
+ (lambda (string-key)
+ (goto-char (point-min))
+ ;; search for @string{ key = {text}} or @string{ key = "text"}
+ (if (re-search-forward
+ (concat "^[ \t]*@string[{(]"
+ (regexp-quote (symbol-name string-key))
+ "[\t ]*=[\t ]*\\(\"\\|\{\\)")
+ nil t)
+ (let ((the-string-start (1- (match-end 1))) ;catch bracket
+ ;;handle {text} or "text" cases
+ (the-string-end
+ (cond
+ ((string-equal "\"" (match-string 1))
+ (re-search-forward "[^\\]\"" nil t)
+ (point))
+ (t
+ (forward-char -1)
+ (forward-list 1)
+ (point)))))
+ (if substitute ;Collect substitutions
+ (setq string-alist
+ (append
+ string-alist
+ (list
+ (cons (symbol-name string-key)
+ ;(regexp-quote
+ (buffer-substring the-string-start
+ the-string-end)))));)
+ ;;Collect the strings command themseves
+ (setq the-text
+ (concat the-text
+ (buffer-substring
+ (progn (forward-char 1)(point))
+ (re-search-backward "^[ \t]*@string[{(]"
+ nil t))
+ "\n"))))
+ ;; @string entry not found
+ (if (not (member-cis (symbol-name string-key)
+ bib-string-ignored-warning))
+ (setq the-warnings
+ (concat the-warnings
+ "Cannot find @String entry for: "
+ (symbol-name string-key) "\n")))))
+ strings-obarray)
+ ;; Now we have `the-text' of @string commands,
+ ;; or the `string-alist' to substitute.
+ (set-buffer new-buffer)
+ (if substitute
+ (while string-alist
+ (goto-char 1)
+ (let* ((the-key (car (car string-alist)))
+ (the-string (cdr (car string-alist)))
+ (slashed-string ; "J. of Geo.\" -> "J. of Geo.\\\\"
+ (dired-replace-in-string
+ "\\\\" "\\\\" the-string)))
+
+ (while (re-search-forward
+ (concat "\\(^[, \t]*[a-zA-Z]+[ \t]*=[ \t]*\\)"
+ (regexp-quote the-key)
+ "\\([, \t\n]\\)")
+ nil t)
+ (replace-match (concat "\\1" slashed-string "\\2") t nil)))
+ (setq string-alist (cdr string-alist)))
+ ;; substitute is nil; Simply insert text of @string commands
+ (goto-char 1)
+ (if the-text
+ (insert the-text "\n")))
+ (goto-char 1))))
+
+ ;; We are done!
+ ;; Return the warnings...
+ the-warnings))
+
+;;; Following contributed by Michael Steiner <steiner@cs.uni-sb.de> The
+;; @string abbreviation are not case-sensitive, so we replaced the `member'
+;; test above with `member-cis' defined here:
+(defun member-cis (ELT LIST)
+ "Return non-nil if ELT is an element of LIST.
+All elements should be strings.
+Comparison is case-insensitive."
+ ;; If list is exhausted,
+ (if (null LIST)
+ nil ;; if null then we haven't found the element ...
+ ;; else split list and ...
+ (let((listelt (car LIST))(listrest (cdr LIST)))
+ ;; see if car is equal to ELT
+ (if (string-equal (downcase ELT) (downcase listelt))
+ t ;; if so return true
+ ;; else recurse for rest of list
+ (member-cis ELT listrest)))))
+
+(defun bib-get-citekeys-obarray ()
+ "Return obarray of citation key (within curly brackets) under cursor."
+ (save-excursion
+ ;; First find *only* a key *within a cite command
+ (let ((the-point (point))
+ (keys-obarray (make-vector 201 0)))
+ ;; First try to match a cite command
+ (if (and (skip-chars-backward "a-zA-Z") ;Stops on \ or {
+ (looking-at "[a-zA-Z]*cite[a-zA-Z]*"))
+ (progn
+ ;;skip over any optional arguments to \cite[][]{key} command
+ (skip-chars-forward "a-zA-Z")
+ (while (looking-at "\\[")
+ (forward-list 1))
+ (re-search-forward "{[ \n]*\\([^,} \n]+\\)" nil t)
+ (intern (match-string 1) keys-obarray)
+ (while (and (skip-chars-forward " \n") ;no effect on while
+ (looking-at ","))
+ (forward-char 1)
+ ;;The following re-search skips over leading spaces
+ (re-search-forward "\\([^,} \n]+\\)" nil t)
+ (intern (match-string 1) keys-obarray)))
+ ;; Assume we are on the keyword
+ (goto-char the-point)
+ (let ((the-start (re-search-backward "[\n{, ]" nil t))
+ (the-end (progn (goto-char the-point)
+ (re-search-forward "[\n}, ]" nil t))))
+ (if (and the-start the-end)
+ (intern (buffer-substring (1+ the-start) (1- the-end))
+ keys-obarray)
+ ;; Neither...
+ (error "Sorry, can't find a reference here"))))
+ keys-obarray)))
+
+(defun bib-buffer-citekeys-obarray ()
+ "Extract citations keys used in the current buffer."
+ (let ((keys-obarray (make-vector 201 0)))
+ (save-excursion
+ (goto-char (point-min))
+ ;; Following must allow for \cite[e.g.][]{key} !!!
+ ;; regexp for \cite{key1,key2} was "\\\\[a-Z]*cite[a-Z]*{\\([^,}]+\\)"
+ (while (re-search-forward "\\\\[a-zA-Z]*cite[a-zA-Z]*\\(\\[\\|{\\)"
+ nil t)
+ (backward-char 1)
+ (while (looking-at "\\[") ; ...so skip all bracketted options
+ (forward-sexp 1))
+ ;; then lookup first key
+ (if (looking-at "{[ \n]*\\([^,} \n]+\\)")
+ (progn
+ (intern (match-string 1) keys-obarray)
+ (goto-char (match-end 1))
+ (while (and (skip-chars-forward " \n")
+ (looking-at ","))
+ (forward-char 1)
+ (re-search-forward "\\([^,} \n]+\\)" nil t)
+ (intern (match-string 1) keys-obarray)))))
+ (if keys-obarray
+ keys-obarray
+ (error "Sorry, could not find any citation keys in this buffer")))))
+
+;;---------------------------------------------------------------------------
+;; Multi-file document programming requirements:
+;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+;; bib-make-bibliography
+;; bib-document-citekeys-obarray needs the master .aux file to extract
+;; citation keys.
+;; Included .aux files (corresponding to \include'd LaTeX files) are
+;; then specified relative to the master-file-directory.
+;;
+;; bib-get-bibliography (used by interactive commands to extract bib sources)
+;;
+;; bibtex source filenames are returned from (LaTeX-bibliography-list)
+;; unformatted. Since only a single \bibliogragrphy command is allowed
+;; by BiBTeX in a document, it is safe to assume that their path is
+;; relative to the master file's directory (since the path is relative
+;; to where the BiBTeX program is actually ran).
+;;
+
+;; (See TeX-check-files, used in TeX-save-document. All documents related
+;; files are returned by (TeX-style-list) and stored in TeX-active-styles.
+;; Original idea was to search TeX-check-path for files listed in
+;; TeX-active-styles (with possible relative or full paths) that end in .tex.)
+
+(defun bib-master-directory ()
+ "Return the directory associated with the master file.
+If no master file, then return current default."
+ (let ((masterfile (bib-master-file)))
+ (if masterfile
+ (file-name-directory (expand-file-name (TeX-master-file)))
+ default-directory)))
+
+(defun bib-master-file ()
+ "Return master file full path, or nil if not a multi-file document."
+;; I wish there were a better way to tell about non multi-file documents...
+ (let ((master
+ (cond
+ ((not (boundp 'TeX-master))
+ ;; This buffer doesn't know what a master file is, so return now.
+ nil)
+ ((and TeX-master ;Set, but not to t
+ (not (symbolp TeX-master))) ; then we have an actual name
+ (expand-file-name TeX-master))
+ ((and (eq TeX-master 't) ;Test if master file itself
+ (progn ;But also require at least one \include
+ (save-excursion
+ (goto-char 1) ;Too bad I have to do this search...
+ ;; Require that user uses \input{file}
+ ;; rather than \input file
+ (re-search-forward "^[ \t]*\\\\\\(include\\|input\\){"
+ nil t))))
+ (buffer-file-name))
+ (t
+ nil))))
+ (cond
+ ((not master)
+ nil)
+ ((string-match ".\\(tex\\|ltx\\)$" master)
+ master)
+ ((file-readable-p (concat master ".ltx"))
+ (concat master ".ltx"))
+ (t
+ (concat master ".tex")))))
+
+;; I don't use this one because files are not returned in order...
+;; (defun bib-document-TeX-files ()
+;; ;; Return all tex input files associated with a known multi-file document.
+;; (let ((master-directory (bib-master-directory))
+;; (the-list (cons (file-name-nondirectory (TeX-master-file))
+;; (TeX-style-list)))
+;; ;; TeX-style-list returns "../master" for the main file if TeX-master
+;; ;; was set like that. "../master" would not be found relative
+;; ;; to the master-directory! So let's add it to the list w/o directory.
+;; (the-result)
+;; (the-file))
+;; (while the-list
+;; (setq the-file (expand-file-name (car the-list) master-directory))
+;; (setq the-list (cdr the-list))
+;; (and (not (string-match ".tex$" the-file))
+;; (setq the-file (concat the-file ".tex")))
+;; (and (file-readable-p the-file)
+;; (not (member the-file the-result)) ;listed already?
+;; (setq the-result (cons the-file the-result))))
+;; the-result))
+
+(defun bib-document-TeX-files ()
+ "Return all tex input files associated with a *known* multi-file document.
+For a multi-file document in auctex only.
+No checking is done that this is a real multi-file document.
+Sets global variable bib-document-TeX-files-warnings."
+ (setq bib-document-TeX-files-warnings nil)
+ (let* ((masterfile (bib-master-file))
+ (dir (and masterfile (file-name-directory masterfile)))
+ (tex-buffer (get-buffer-create "*tex-document*"))
+ (the-list (list masterfile))
+ (the-file))
+ (if (not masterfile)
+ (progn
+ (kill-buffer tex-buffer)
+ (error
+ "Sorry, but this is not a multi-file document (Try C-u C-c C-n if
using auctex)")))
+ (save-excursion
+ (set-buffer tex-buffer)
+ ;; set its directory so relative includes work without expanding
+ (setq default-directory dir)
+ (insert-file-contents masterfile)
+ (goto-char (point-min))
+ (while (re-search-forward "^[ \t]*\\\\\\(input\\|include\\){\\(.*\\)}"
+ nil t)
+ (let ((the-file (match-string 2)))
+ (if (string-match ".sty$" the-file) ;Skip over style files!
+ nil
+ (if (and (not (file-readable-p (expand-file-name the-file dir)))
+ (not (string-match ".ltx$" the-file))
+ (file-readable-p
+ (expand-file-name (concat the-file ".ltx") dir)))
+ (setq the-file (concat the-file ".ltx")))
+ (if (and (not (file-readable-p (expand-file-name the-file dir)))
+ (not (string-match ".tex$" the-file)))
+ (setq the-file (concat the-file ".tex")))
+ (setq the-file (expand-file-name the-file dir))
+ (if (not (file-readable-p the-file))
+ (setq bib-document-TeX-files-warnings
+ (concat
+ bib-document-TeX-files-warnings
+ (format "Warning: File not found: %s" the-file)))
+ (setq the-list (cons (expand-file-name the-file dir) the-list))
+ (end-of-line)(insert "\n")
+ (insert-file-contents the-file))))))
+ (kill-buffer tex-buffer)
+ (nreverse the-list)))
+
+(defun bib-document-citekeys-obarray ()
+ "Return cite keys obarray for multi-file document.
+Return nil if not a multi-file document.
+This is a AUCTeX supported feature only.
+Also, see bib-buffer-citekeys-obarray.
+Sets global variable bib-document-citekeys-obarray-warnings."
+ (setq bib-document-citekeys-obarray-warnings nil)
+ (let ((master-tex (bib-master-file))
+ (master-aux))
+ (if (not master-tex)
+ nil ;Not a multifile document. No need...
+ (setq master-aux (bib-return-aux-file-from-tex master-tex "aux"))
+ (or (file-readable-p master-aux)
+ (error "Sorry, cannot read file %s" master-aux))
+ (and (file-newer-than-file-p master-tex master-aux)
+ (setq bib-document-citekeys-obarray-warnings
+ (format "Warning: %s is out of date relative to %s.\n"
+ master-aux master-tex)))
+ (let ((work-buffer (get-buffer-create "*bib-cite-work*"))
+ (keys-obarray (make-vector 201 0)))
+ (save-excursion
+ (set-buffer work-buffer)
+ (insert-file-contents master-aux)
+ ;; Because we will be looking for \input statements, we need to set
+ ;; the default directory to that of the master file.
+ (setq default-directory (file-name-directory master-tex))
+ ;; bib-make-bibliography will need this also to find .bib files
+ ;; look for \@input{chap1/part1.aux}
+ (while (re-search-forward "^\\\\@input{\\(.*\\)}$" nil t)
+ (let* ((auxfile (match-string 1))
+ (texfile (bib-return-aux-file-from-tex auxfile "tex")))
+ (if (not (file-readable-p auxfile))
+ (setq bib-document-citekeys-obarray-warnings
+ (concat
+ bib-document-citekeys-obarray-warnings
+ (format "Warning: %s is not found or readable.\n"
+ auxfile)))
+ (if (file-newer-than-file-p texfile auxfile)
+ (setq bib-document-citekeys-obarray-warnings
+ (concat
+ bib-document-citekeys-obarray-warnings
+ (format
+ "Warning: %s is out of date relative to %s.\n"
+ auxfile texfile))))
+ (end-of-line)(insert "\n")
+ (insert-file-contents auxfile))))
+ (goto-char 1)
+
+;;; Patched by calvanes@dis.uniroma1.it (Diego Calvanese)
+;;; ;; look for \citation{gertsenshtein59}
+;;; (while (re-search-forward "^\\\\citation{\\(.*\\)}$" nil t)
+;;; (intern (buffer-substring (match-beginning 1)(match-end 1))
+;;; keys-obarray))
+ ;; look for \citation{gertsenshtein59,vardi88,...,ullmann90}
+ ;; comma-separation generated by certain LaTeX styles.
+ (while (re-search-forward "^\\\\citation{\\(.*\\)}$" nil t)
+ (let ((string (match-string 1))
+ (start 0))
+ (while (string-match "\\([^,\n]+\\)" string start)
+ (intern (substring string (match-beginning 1) (match-end 1))
+ keys-obarray)
+ (setq start (match-end 0))))))
+ (kill-buffer work-buffer)
+ keys-obarray))))
+
+(defun bib-return-aux-file-from-tex (texname ext)
+ "Given name.name.XXX in TEXNAME return name.name.EXT."
+;; FIXME: Check if in ./, else search
+ (let* ((filename (if (string-match "\\(.*\\)\\.[^\\.]+" texname)
+ (concat (match-string 1 texname) "." ext)
+ (concat texname "." ext)))
+ (sansdir (file-name-nondirectory filename)))
+ (if (file-exists-p filename)
+ filename
+ ;; Search bib-cite-aux-inputs path
+ (let ((filename (psg-checkfor-file-list sansdir bib-cite-aux-inputs)))
+ (if (and filename (file-exists-p filename))
+ filename
+ (error "Could not find file %s" sansdir))))))
+
+(defun bib-etags-find-noselect (tag &optional masterdir)
+ "Returns a buffer with point on TAG.
+Buffer is not selected.
+Makes sure TAGS file exists, etc."
+ (require 'etags)
+ (let* ((master (or masterdir (bib-master-directory)))
+ (the-buffer (current-buffer))
+ (new-buffer)
+ (the-tags-file-name (expand-file-name bib-etags-filename master)))
+ (or (file-exists-p the-tags-file-name) ;make sure TAGS exists
+ (bib-etags master))
+ (or (equal the-tags-file-name tags-file-name) ;make sure it's current
+ (visit-tags-table the-tags-file-name))
+ ;; find-tag-noselect should set the TAGS file for the new buffer
+ ;; that's what C-h f visit-tags-table says...
+ (cond
+ ((string-match "XEmacs\\|Lucid" emacs-version)
+ (find-tag tag)
+ (setq new-buffer (current-buffer))
+ (set-buffer the-buffer))
+ (t
+ (setq new-buffer (find-tag-noselect tag nil t))
+ ; -> Seems to set buffer to TAGS
+ (set-buffer the-buffer)))
+ new-buffer))
+
+;; --------------------------------------------------------------------------
+;; The following routines make a temporary bibliography buffer
+;; holding all bibtex files found.
+
+(defun bib-get-bibliography (include-filenames-f)
+ "Returns a new bibliography buffer holding all bibtex files in the document.
+
+If using AUCTeX, and either TeX-parse-self is set or C-c C-n is used to
+parse the document, then the entire multifile document will be searched
+for \bibliography commands.
+
+If this fails, the current buffer is searched for the first \bibliography
+command.
+
+If include-filenames-f is true, include as a special header the filename
+of each bib file.
+
+Puts the buffer in text-mode such that forward-sexp works with german \"
+accents embeded in bibtex entries."
+ (let ((bib-list (or (and (fboundp 'LaTeX-bibliography-list)
+ (boundp 'TeX-auto-update)
+ (LaTeX-bibliography-list))
+;; LaTeX-bibliography-list (if bound) returns an unformatted list of
+;; bib files used in the document, but only if parsing is turned on
+;; or C-c C-n was used.
+ (bib-bibliography-list)))
+ (bib-buffer (get-buffer-create "*bibtex-bibliography*"))
+ ;; Path is relative to the master directory
+ (default-directory (bib-master-directory))
+ (the-name)(the-warnings)(the-file))
+ (save-excursion
+ ;; such that forward-sexp works with embeeded \" in german,
+ ;; and unbalanced ()
+ (set-buffer bib-buffer)
+ (erase-buffer)
+ (set-syntax-table text-mode-syntax-table)
+;; (if (boundp 'bibtex-mode-syntax-table)
+;; (set-syntax-table bibtex-mode-syntax-table)
+;; (text-mode))
+ )
+ ;;We have a list of bib files
+ ;;Search for them, include them, list those not readable
+ (while bib-list
+ (setq the-name (car (car bib-list))) ;Extract the string only
+ (setq bib-list (cdr bib-list))
+ (setq the-name
+ (substring the-name
+ (string-match "[^ ]+" the-name) ;remove leading spaces
+ (string-match "[ ]+$" the-name))) ;remove trailing space
+ (if (not (string-match "\\.bib$" the-name))
+ (setq the-name (concat the-name ".bib")))
+ (setq the-file
+ (or (and (file-readable-p the-name) the-name)
+ (psg-checkfor-file-list
+ the-name (psg-list-env bib-bibtex-env-variable))
+ ;; Check for BIBINPUT env variable as well (by popular demand!)
+ (psg-checkfor-file-list the-name (psg-list-env "BIBINPUT"))
+ (and bib-cite-inputs
+ (psg-checkfor-file-list the-name bib-cite-inputs))
+ (and (boundp 'TeX-check-path)
+ (psg-checkfor-file-list the-name TeX-check-path))))
+ (if the-file
+ (progn
+ (save-excursion
+ (set-buffer bib-buffer)
+ (goto-char (point-max))
+ (if include-filenames-f
+ (insert "%%%Filename: " the-file "\n"))
+ (insert-file-contents the-file nil)
+ (goto-char 1)))
+ (setq the-warnings
+ (concat the-warnings "Could not read file: " the-name "\n"))))
+ (if the-warnings
+ (progn
+ (with-output-to-temp-buffer "*Help*"
+ (princ the-warnings))
+ (kill-buffer bib-buffer)
+ (error
+ "Sorry, can't find all bibtex files in \\bibliography command"))
+ bib-buffer)))
+
+(defun bib-bibliography-list ()
+ "Return list of bib files listed in first \\bibliography command in buffer.
+Similar output to AUCTeX's LaTeX-bibliography-list
+The first element may contain trailing whitespace (if there was any in input)
+although BiBTeX doesn't allow it!"
+ (save-excursion
+ (goto-char 1)
+ (if (not (re-search-forward "^[ \t]*\\\\bibliography{[ \t]*\\([^},]+\\)"
+ nil t))
+ (error "Sorry, can't find \\bibliography command anywhere")
+ (let ((the-list (list (match-string 1)))
+ (doNext t))
+ (while doNext
+ (if (looking-at ",")
+ (setq the-list
+ (append the-list
+ (list (buffer-substring
+ (progn (skip-chars-forward ", ")(point))
+ (progn (re-search-forward "[,}]" nil t)
+ (backward-char 1)
+ (skip-chars-backward ", ")
+ (point))))))
+ (setq doNext nil)))
+ (mapcar 'list the-list)))))
+
+;; BibTeX-mode key def to create AUCTeX's parsing file.
+(defun bib-create-auto-file ()
+ "Force the creation of the AUCTeX auto file for a bibtex buffer."
+ (interactive)
+ (if (not (require 'latex))
+ (error "Sorry, This is only useful if you have AUCTeX"))
+ (let ((TeX-auto-save t)
+ (TeX-auto-update t)
+ (TeX-auto-regexp-list BibTeX-auto-regexp-list))
+ ;; TeX-auto-write
+ ;; -> calls TeX-auto-store
+ ;; -> calls TeX-auto-parse
+ ;; clears LaTeX-auto-bibtem (temporary holding space for bibitems)
+ ;; searches buffer using regexp in TeX-auto-regexp-list
+ ;; -> if LaTeX-auto-bibtem (the temporary holding space for bibitems)
+ ;; holds stuffs like
+ ;; ("Zimmermann:1991" "Anger_et_al:1993")
+ ;; as determined by
+ ;; (member nil (mapcar 'TeX-auto-entry-clear-p TeX-auto-parser))
+ ;; then it creates the auto file.
+
+ ;; TeX-auto-write may call TeX-master-file which may fail if
+ ;; TeX-header-end is unset (by LaTeX-common-initialization in latex-mode)
+ (if (not TeX-header-end)
+ (setq TeX-header-end LaTeX-header-end))
+
+ (TeX-auto-write)))
+
+;; --------------------------------------------------------------------------
+;; The following routines are also defined in other packages...
+
+(defun psg-checkfor-file-list (filename list)
+ "Check for presence of FILENAME in directory LIST. Return 1st found path."
+ ;;USAGE: (psg-checkfor-file-list "gri" (psg-list-env "PATH"))
+ ;;USAGE: (psg-checkfor-file-list "gri-mode.el" load-path)
+ ;;USAGE: (psg-checkfor-file-list "gri.cmd" (psg-translate-ff-list "gri.tmp"))
+ (let ((the-list list)
+ (filespec))
+ (while the-list
+ (if (not (car the-list)) ; it is nil
+ (setq filespec (expand-file-name filename))
+ (setq filespec
+ (concat
+ (expand-file-name (file-name-as-directory (car the-list)))
+ filename)))
+ (if (file-exists-p filespec)
+ (setq the-list nil)
+ (setq filespec nil)
+ (setq the-list (cdr the-list))))
+ (if filespec
+ filespec
+ ;; If I have not found a file yet, then check if some directories
+ ;; ended in // and recurse through them.
+ (let ((the-list list))
+ (while the-list
+ (if (not (string-match "//$" (car the-list))) nil
+ (setq filespec (car
+ (search-directory-tree
+ (substring (car the-list) 0 (match-beginning 0))
+ (concat "^" filename "$")
+ t
+ t)))
+ (if filespec ;Success!
+ (setq the-list nil)))
+ (setq the-list (cdr the-list)))
+ filespec))))
+
+
+(defun search-directory-tree (directories extension-regexp recurse first-file)
+ "Return a list of all reachable files in DIRECTORIES ending with EXTENSION.
+DIRECTORIES is a list or a single-directory string
+EXTENSION-REGEXP is actually (any) regexp, usually \\\\.bib$
+If RECURSE is t, then we will recurse into the directory tree,
+ nil, we will only search the list given.
+If FIRST-FILE is t, stop after first file is found."
+ (or (listp directories)
+ (setq directories (list directories)))
+
+ (let (match)
+ (while directories
+ (let* ((directory (file-name-as-directory (car directories)))
+ (content (and directory
+ (file-readable-p directory)
+ (file-directory-p directory)
+ (directory-files directory))))
+ (setq directories (cdr directories))
+ (while content
+ (let ((file (expand-file-name (car content) directory)))
+ (cond ((string-match "[.]+$" (car content))) ;This or parent dir
+ ((not (file-readable-p file)))
+ ((and recurse
+ (file-directory-p file))
+ (setq directories
+ (cons (file-name-as-directory file) directories)))
+ ((string-match extension-regexp
+ (file-name-nondirectory file))
+ (and first-file
+ (setq content nil
+ directories nil))
+ (setq match (cons file match)))))
+ (setq content (cdr content)))))
+
+ match))
+
+;;; (defun psg-checkfor-file-list (filename list)
+;;; (let ((the-list list)
+;;; (filespec))
+;;; (while the-list
+;;; (if (not (car the-list)) ; it is nil
+;;; (setq filespec (concat "~/" filename))
+;;; (setq filespec
+;;; (concat (file-name-as-directory (car the-list)) filename)))
+;;; (if (file-exists-p filespec)
+;;; (setq the-list nil)
+;;; (setq filespec nil)
+;;; (setq the-list (cdr the-list))))
+;;; filespec))
+
+(or (fboundp 'dired-replace-in-string)
+ ;; This code is part of GNU emacs
+ (defun dired-replace-in-string (regexp newtext string)
+ ;; Replace REGEXP with NEWTEXT everywhere in STRING and return result.
+ ;; NEWTEXT is taken literally---no \\DIGIT escapes will be recognized.
+ (let ((result "") (start 0) mb me)
+ (while (string-match regexp string start)
+ (setq mb (match-beginning 0)
+ me (match-end 0)
+ result (concat result (substring string start mb) newtext)
+ start me))
+ (concat result (substring string start)))))
+
+
+;; Could use fset here to equal TeX-split-string to dired-split if only
+;; dired-split is defined. That would eliminate a check in psg-list-env.
+(and (not (fboundp 'TeX-split-string))
+ (not (fboundp 'dired-split))
+ ;; This code is part of AUCTeX
+ (defun TeX-split-string (char string)
+ "Returns a list of strings. given REGEXP the STRING is split into
+sections which in string was seperated by REGEXP.
+
+Examples:
+
+ (TeX-split-string \"\:\" \"abc:def:ghi\")
+ -> (\"abc\" \"def\" \"ghi\")
+
+ (TeX-split-string \" *\" \"dvips -Plw -p3 -c4 testfile.dvi\")
+
+ -> (\"dvips\" \"-Plw\" \"-p3\" \"-c4\" \"testfile.dvi\")
+
+If CHAR is nil, or \"\", an error will occur."
+
+ (let ((regexp char)
+ (start 0)
+ (result '()))
+ (while (string-match regexp string start)
+ (let ((match (string-match regexp string start)))
+ (setq result (cons (substring string start match) result))
+ (setq start (match-end 0))))
+ (setq result (cons (substring string start nil) result))
+ (nreverse result))))
+
+(defun bib-cite-file-directory-p (file)
+ "Like default `file-directory-p' but allow FILE to end in // for ms-windows."
+ (save-match-data
+ (if (string-match "\\(.*\\)//$" file)
+ (file-directory-p (match-string 1 file))
+ (file-directory-p file))))
+
+(defun psg-list-env (env)
+ "Return a list of directory elements in ENV variable (w/o leading $)
+argument may consist of environment variable plus a trailing directory, e.g.
+HOME or HOME/bin (trailing directory not supported in dos or OS/2).
+
+bib-dos-or-os2-variable affects:
+ path separator used (: or ;)
+ whether backslashes are converted to slashes"
+ (if (not (getenv env))
+ nil ;Because dired-replace-in-string fails
+ (let* ((value (if bib-dos-or-os2-variable
+ (dired-replace-in-string "\\\\" "/" (getenv env))
+ (getenv env)))
+ (sep-char (or (and bib-dos-or-os2-variable ";") ":"))
+ (entries (and value
+ (or (and (fboundp 'TeX-split-string)
+ (TeX-split-string sep-char value))
+ (dired-split sep-char value)))))
+ (loop for x in entries if (bib-cite-file-directory-p x) collect x))))
+
+(provide 'bib-cite)
+;;; bib-cite.el ends here
diff --git a/tests/auctex-11.87.7/circ.tex b/tests/auctex-11.87.7/circ.tex
new file mode 100644
index 0000000..48a177e
--- /dev/null
+++ b/tests/auctex-11.87.7/circ.tex
@@ -0,0 +1,479 @@
+\documentclass[a4paper,twocolumn]{article}
+\usepackage[german]{babel}
+\usepackage[T1]{fontenc}
+\usepackage[latin1]{inputenc}
+\usepackage[showlabels,sections,floats,textmath,displaymath]{preview}
+\newbox\chaos
+\newdimen\tdim
+\def\fframe{%
+\tdim=\columnwidth
+\advance\tdim by -2\fboxsep
+\advance\tdim by -2\fboxrule
+\setbox\chaos=\hbox\bgroup\begin{minipage}{\tdim}}
+\def\endfframe{\end{minipage}\egroup\fbox{\box\chaos}}
+\unitlength 1mm
+\newcount\fives
+\fives 14
+\newcount\ones
+\ones\fives
+\multiply \ones by 5
+\newsavebox{\raster}
+\savebox{\raster}(\ones,\ones)
+{\thicklines
+ \put(0,0){\line(0,1){\ones}}
+ \put(0,0){\line(1,0){\ones}}
+ \multiput(0,0)(5,0){\fives}
+ {\begin{picture}(0,0)
+ \put(5,0){\line(0,1){\ones}}
+ \thinlines\multiput(1,0)(1,0){4}{\line(0,1){\ones}}
+ \end{picture}}
+ \multiput(0,0)(0,5){\fives}
+ {\begin{picture}(0,0)
+ \put(0,5){\line(1,0){\ones}}
+ \thinlines\multiput(0,1)(0,1){4}{\line(1,0){\ones}}
+ \end{picture}}
+}
+\begin{document}
+\title{Einfache Kurven auf Rastergrafiken}
+\author{David Kastrup}
+\maketitle
+
+\begin{abstract}
+Es sollen hier einfache Methoden vorgestellt werden, um auf einer
+Rastereinheit verschiedene Kurven darzustellen. Vorgestellt werden
+Zeichenalgorithmen f�r Linien, Kreise und Hyperbeln. Die hier
+hergeleiteten Gleichungen sind auch unter dem Namen {\tt DDA}s bekannt.
+\end{abstract}
+
+\section{Einf�hrung}
+Bei den hier vorgestellten Algorithmen werden zun�chst nur
+Kurvenst�cke betrachtet, die die folgenden Eigenschaften besitzen:
+\begin{enumerate}
+\item Sie lassen sich als Funktion $y = f(x)$ darstellen.
+\item $y$ ist im betrachteten Bereich monoton, das hei�t, entweder
+ durchgehend steigend oder durchgehend fallend.
+\item Wenn $x$ sich um $1$ �ndert, so �ndert sich $y$ betragsm��ig
+ h�chstens um $1$
+ ($\left|\frac{\partial y}{\partial x}\right| \leq 1$).
+\end{enumerate}
+
+\section{Die gerade Linie}
+Wir betrachten hier zun�chst nur die gerade Linie im ersten Oktanten,
+die durch den Punkt $0 \choose 0$ geht. Alle anderen Linien lassen
+sich durch Vertauschen von $x$ und~$y$ sowie Vorzeichenwechsel
+erzeugen. Im ersten Oktanten gilt $x \geq y \geq 0$. Zum Zeichnen
+einer Linie gen�gt es also, $x$ durchlaufen zu lassen und f�r $y$ die
+dazugeh�rigen Werte zu berechnen und zu runden.
+
+Die Gleichung einer Geraden durch $\Delta x \choose \Delta y$ lautet:
+\begin{equation}
+\label{lgi}
+y = \frac{\Delta y}{\Delta x}x
+\end{equation}
+%
+Nun stellen wir $y$ als Summe eines ganzzahligen Wertes $e$ und eines
+gebrochenen Wertes $f$ dar, f�r den gilt: $-0.5 \leq f < 0.5$. Somit
+stellt dann $e$ den gew�nschten, auf die n�chste ganze Zahl gerundeten
+$y$-Wert dar. Jetzt formen wir (\ref{lgi}) um:
+\begin{eqnarray}
+e + f &=& x \frac{\Delta y}{\Delta x}\nonumber\\
+e \Delta x + f \Delta x &=& x \Delta y\nonumber\\
+f \Delta x - \left\lceil\frac{\Delta x}2\right\rceil &=&
+x \Delta y - e \Delta x - \left\lceil\frac{\Delta x}2\right\rceil \label{lgii}
+\end{eqnarray}
+%
+Den linken Ausdruck in (\ref{lgii}) bezeichnen wir jetzt mit $d$. F�r
+positive gerade Werte von $\Delta x$ ist offensichtlich $d < 0$ eine
+zu~$f < 0.5$ equivalente Bedingung.
+
+F�r ungerade Werte von~$\Delta x$ ist $f < 0.5$ equivalent zu
+$d + 0.5 < 0$.
+Da $d$ stets eine ganze Zahl ist, ist dies wieder zu $d < 0$
+equivalent.
+
+% INTENTIONAL ERRORS! INTENTIONAL ERRORS! INTENTIONAL ERRORS!
+%
+% The following line should flag a PostScript error when previewing,
+% but processing of other previews should continue.
+%
+Wird nun $\ifPreview\special{ps: junk}\fi f \geq 0.5$, wie sich durch
+den Vergleich $d \stackrel{?}{<} 0$ feststellen l��t, so mu� man
+korrigieren, indem man $f$ um~1 erniedrigt und $e$ um~$1$ erh�ht.
+%
+% The following line will make Ghostscript abort unexpectedly when
+% previewing, but processing of other previews should continue.
+%
+$\ifPreview\special{ps: quit}\fi d$ mu� dann auch entsprechend
+angepa�t werden.
+
+Mit den angegebenen Formeln ergibt sich jetzt bei Ber�cksichtigung der
+Einfl�sse von $x$ und $e$ auf $d$ der in Tabelle~\ref{linalg}
+angegebene Algorithmus. Eine optimierte C-function, die die
+Oktantenaufteilung ber�cksichtigt, ist in Tabelle~\ref{linc} zu
+finden. Einige hiermit gezeichnete Linien sind in
+Abbildung~\ref{linpict} zu sehen.
+\begin{table}
+ \caption{Linienzugalgorithmus} \label{linalg}
+ \begin{fframe}
+ \begin{enumerate}
+ \item Setze $x \gets 0$, $y \gets 0$, $d \gets
+ -\left\lceil\frac{\Delta x}2\right\rceil$
+ \item Wiederhole bis $x = \Delta x$
+ \begin{enumerate}
+ \item Zeichne Punkt an $x \choose y$
+ \item Setze $x \gets x + 1$, $d \gets d + \Delta y$
+ \item Falls $d \geq 0$
+ \begin{enumerate}
+ \item Setze $d \gets d - \Delta x$
+ \item Setze $y \gets y + 1$
+ \end{enumerate}
+ \end{enumerate}
+ \end{enumerate}
+ \end{fframe}
+\end{table}
+\begin{table}
+\caption{Linienziehen in C} \label{linc}
+\begin{fframe}
+\small
+\begin{verbatim}
+extern int x,y;
+/* (x,y) ist Koordinate des nicht
+ * gezeichneten Startpunktes, zeigt
+ * nachher auf gezeichneten Endpunkt
+ */
+#define doline(dx,dy,advx,advy) { \
+ d = -(((i = dx) + 1) >> 1); \
+ while (i--) { \
+ advx; \
+ if ((d += dy) >= 0) { \
+ d -= dx; advy; \
+ } \
+ dot(x,y); \
+ } \
+ return; \
+} /* Grundalgorithmus 1. Oktant */
+/* dx ist Distanz in unabh. Richtung, *
+ * dy in abh. Richtung, advx geht *
+ * in unabh. Richtung, advy in abh. */
+
+#define docond(cond,advx,advy) { \
+ if (cond) doline(dx,dy,advx,advy) \
+ doline(dy,dx,advy,advx) \
+} /* Grundalgorithmus 1./2. Oktant */
+/* cond ist true falls |dx| > |dy| */
+
+void
+linedraw(int dx, int dy)
+/* Von (x,y) nach (x+dx, y+dx). */
+{
+ int i;
+
+ if (dx >= 0) {
+ if (dy >= 0)
+ docond(dx > dy, ++x, ++y)
+ docond(dx > (dy = -dy), ++x, --y)
+ }
+ if (dy >= 0)
+ docond((dx = -dx) > dy,--x,++y)
+ docond((dx = -dx) > (dy = -dy),
+ --x, --y )
+}
+\end{verbatim}
+\end{fframe}
+\end{table}
+\begin{figure}
+ \begin{picture}(\ones,\ones) \put(0,0){\usebox{\raster}}
+ \newcount\x
+ \newcount\y
+ \newcount\d
+ \newcount\dx
+ \newcount\dy
+ \x 0
+ \y 0
+ \dx \ones
+ \dy \ones
+ \loop %{
+ \d -\dx
+ \divide \d by 2 %}
+ \ifnum \dy > 0 %{
+ {\loop %{
+ \put(\x,\y){\circle*{1}}%}
+ \ifnum \x < \ones %{
+ \advance \x by 1
+ \advance \d by \dy %}
+ \ifnum \d > -1 %{
+ \advance \y by 1
+ \advance \d by -\dx %}
+ \fi %}}
+ \repeat}
+ \advance \x by 5
+ \advance \dx by -5
+ \advance \dy by -15 %}
+ \repeat
+ \end{picture}
+\caption{Einige Linien}\label{linpict}
+\end{figure}
+
+\section{Der Kreis}
+Wir betrachten hier nur den Achtelkreis im zweiten Oktanten
+($y \geq x \geq 0$). Hier gelten die oben angegebenen Beziehungen.
+Alle anderen Achtelkreise lassen sich durch elementare Spiegelungen
+erzeugen.
+
+Die Gleichung eines Kreises ist hier
+\begin{equation}
+y = �\sqrt{r^2 - x^2}
+\end{equation}
+
+Der Wert $y$ l��t sich darstellen als Summe einer ganzen Zahl $e$ und
+einem Wert $f$ mit $-0.5 \leq f < 0.5$. Der Wertebereich von $f$ ist
+so gew�hlt worden, damit $e$ einen auf ganze Zahlen gerundeten Wert
+f�r $y$ darstellt.
+
+Nun gilt:
+\begin{eqnarray}
+e + f&=&\sqrt{r^2 - x^2}\nonumber\\
+\label{ggg}e^2 + 2ef + f^2&=&r^2 - x^2
+\end{eqnarray}
+%
+Die Gleichung (\ref{ggg}) hat f�r $x+1$ folgende Form:
+\begin{eqnarray}
+\label{hhh}e'^2 + 2e'f' + f'^2&=&r^2 - x^2 - 2x -1
+\end{eqnarray}
+%
+Zieht man die Gleichung (\ref{ggg}) von (\ref{hhh}) ab, so ergibt sich
+nach Umsortieren:
+\begin{eqnarray*}
+ e' = e:\\
+ 2e'f' + f'^2&=&2ef+f^2-2x-1\\
+ e' = e-1:\\
+ 2e'f' + f'^2&=&2ef+f^2+2e-2x-2
+\end{eqnarray*}
+%
+Jetzt wird $2ef + f^2$ mit $m$ getauft. Also:
+\begin{eqnarray*}
+ e' = e:\\
+ m'&=&m -2x-1\\
+ e' = e-1:\\
+ m'&=&m +2e-1 -2x-1
+\end{eqnarray*}
+Wie gro� ist jetzt $m$? F�r $x=0$ ist es sicher $0$. Solange $e$
+konstant bleibt, schrumpft $f$ stetig. F�llt $f$ unter $-0.5$, so
+f�llt $m$ (unter Vernachl�ssigung von $f^2$) unter $-e$. Dies wird
+jetzt als Kriterium f�r einen Unterlauf von $f$ verwendet. Tritt
+dieser auf, so mu� $f$ um $1$ erh�ht und $e$ um $1$ erniedrigt werden.
+
+Um die Abfragebedingung zu vereinfachen, setzt man jetzt $q$ = $m+e$.
+Der resultierende Algorithmus ist in Tabelle \ref{alg}, ein
+optimiertes C-Programm ist in Tabelle \ref{prog} zu finden.
+\begin{table}
+ \caption{Kreiszeichenalgorithmus}\label{alg}
+ \begin{fframe}
+ \begin{enumerate}
+ \item Setze $x\gets 0$, $y\gets r$, $q\gets r$
+ \item Wiederhole bis $x>y$:
+ \begin{enumerate}
+ \item Setze einen Punkt an $x \choose y$.
+ \item Setze $q\gets q-2x-1$
+ \item Falls $q<0$
+ \begin{enumerate}
+ \item Setze $q\gets q + 2y-2$
+ \item Setze $y\gets y-1$
+ \end{enumerate}
+ \item Setze $x\gets x+1$
+ \end{enumerate}
+ \end{enumerate}
+ \end{fframe}
+\end{table}
+\begin{table}
+ \caption{Kreiszeichenprogramm}\label{prog}
+ \begin{fframe}
+ \small
+\begin{verbatim}
+void
+fourfold(int x0, int y0, int x, int y)
+/* Zeichne in Oktant 1,3,5,7 */
+/* Wird benutzt, um Anfangs- und End- *
+ * Punkte nicht zweimal zu zeichnen */
+{
+ dot(x0+x,y0+y);
+ dot(x0-y,y0+x);
+ dot(x0-x,y0-y);
+ dot(x0+y,y0-x);
+}
+
+void
+eightfold(int x0, int y0, int x, int y)
+/* Zeichne in allen Quadranten */
+{
+ fourfold(x0,y0,x,y); /* 1357 */
+ fourfold(x0,y0,x,-y); /* 8642 */
+}
+
+void
+circle(int x0, int y0, int r)
+{
+ fourfold(x0,y0,0,r);
+ /* Die ersten vier Punkte */
+ for (x=0, y=q=r;; ) {
+ if ((q -= 2* x++ + 1) < 0)
+ q += 2* --y;
+ if (x >= y)
+ break;
+ eightfold(x0,y0,x,y);
+ }
+ if (x==y)
+ fourfold(x0,y0,x,y);
+ /* Eventuell die letzten vier */
+}
+\end{verbatim}
+ \end{fframe}
+\end{table}
+\begin{figure}
+ \begin{picture}(\ones,\ones)
+ \put(0,0){\usebox{\raster}}
+ \newcount\x
+ \newcount\y
+ \newcount\q
+ \loop
+ {\x 0
+ \y \ones
+ \q \ones
+ \loop
+ \put(\x,\y){\circle*{1}}
+ \put(\y,\x){\circle*{1}}
+ \advance \q by -\x
+ \advance \x by 1
+ \advance \q by -\x
+ \ifnum \x < \y
+ \ifnum \q < 0
+ \advance \y by -1
+ \advance \q by \y
+ \advance \q by \y
+ \fi
+ \repeat}
+ \advance \ones by -10
+ \ifnum \ones > 0
+ \repeat
+ \end{picture}
+ \caption{Viertelkreise}\label{zeich}
+\end{figure}
+
+\section{Einfache Hyperbeln}
+Als letztes Beispiel betrachten wir hier Hyperbeln, die der Formel
+$y = r^2\!/x$ gen�gen, und zwar im Bereich~$x \geq r$.
+
+Mit dem Ansatz $y = e + f$ ergibt sich:
+\begin{eqnarray}
+ e+f &=& r^2\!/x\nonumber\\
+ ex + fx &=& r^2\nonumber\\
+ fx &=& r^2 - ex\label{phyp}
+\end{eqnarray}
+\pagebreak[2]
+F�r $x' = x+1$ hat nun (\ref{phyp}) die Form
+\begin{eqnarray*}
+ e' = e:\\
+ f'x' &=& r^2 - ex - e\\
+ e' = e - 1:\\
+ f'x' &=& r^2 - ex - e + x + 1
+\end{eqnarray*}
+Setzt man jetzt $d = (2f + 1)x$, so ist $f < -0.5$ mit~$d < 0$
+equivalent. Erreicht man diesen Fall unter Verwendung der Annahme
+$e' = e$,
+dann mu� in bekannter Weise $f$ um~$1$ erh�ht und $e$ um~$1$
+vermindert werden.
+
+\pagebreak
+F�r $d'$ ergeben sich dann die folgenden Werte:
+\begin{eqnarray*}
+ e' = e:\\
+ d' &=& d - 2e + 1\\
+ e' = e - 1:\\
+ d' &=& d - 2e + 2x + 2 + 1
+\end{eqnarray*}
+Daraus ergibt sich der in Tabelle~\ref{halg} angegebene
+Hyperbelalgorithmus f�r den ersten Oktanten.
+\begin{table}
+ \caption{Hyperbelalgorithmus}\label{halg}
+ \begin{fframe}
+ \begin{enumerate}
+ \item Setze $d \gets r$, $x \gets r$, $y \gets r$
+ \item Wiederhole bis zufrieden
+ \begin{enumerate}
+ \item Setze Punkt an $x \choose y$
+ \item Setze $x \gets x + 1$
+ \item Setze $d \gets d - 2y + 1$
+ \item Falls $d < 0$
+ \begin{enumerate}
+ \item Setze $d \gets d + 2x$
+ \item Setze $y \gets y - 1$
+ \end{enumerate}
+ \end{enumerate}
+ \end{enumerate}
+ \end{fframe}
+\end{table}
+\begin{table}
+ \caption{Hyperbeln in C}
+ \begin{fframe}
+ \small
+\begin{verbatim}
+void
+four(int x0, int y0, int x, int y)
+/* Hyperbeln sind nur in 4 Oktanten */
+{
+ dot(x0+x,y0+y);
+ dot(x0+y,y0+x);
+ dot(x0-x,y0-y);
+ dot(x0-y,y0-x);
+}
+
+void
+hyperb(int x0, int y0, int r, int dx)
+{
+ int d, x, y;
+
+ for (x = y = d = r; dx--;) {
+ four(x0,y0,x,y);
+ ++x;
+ if ((d -= 2*y + 1) < 0) {
+ d += 2*x;
+ --y;
+ }
+ }
+}
+\end{verbatim}
+ \end{fframe}
+\end{table}
+\begin{figure}
+ \begin{picture}(\ones,\ones)
+ \put(0,0){\usebox{\raster}}
+ \newcount\x
+ \newcount\y
+ \newcount\q
+ \newcount\r
+ \r\ones
+ \loop
+ \advance \r by -10
+ \ifnum \r > 0
+ {\x \r
+ \y \r
+ \q \r
+ \loop
+ \put(\x,\y){\circle*{1}}
+ \put(\y,\x){\circle*{1}}
+ \ifnum \x < \ones
+ \advance \x by 1
+ \advance \q by -\y
+ \advance \q by -\y
+ \advance \q by 1
+ \ifnum \q < 0
+ \advance \q by \x
+ \advance \q by \x
+ \advance \y by -1
+ \fi
+ \repeat}
+ \repeat
+ \end{picture}
+ \caption{Hyperbeln}\label{hzeich}
+\end{figure}
+\end{document}
diff --git a/tests/auctex-11.87.7/context-en.el
b/tests/auctex-11.87.7/context-en.el
new file mode 100644
index 0000000..aba1d8c
--- /dev/null
+++ b/tests/auctex-11.87.7/context-en.el
@@ -0,0 +1,216 @@
+;;; context-en.el --- Support for the ConTeXt english interface.
+
+;; Copyright (C) 2003, 2004 Free Software Foundation, Inc.
+
+;; Maintainer: Berend de Boer <berend@pobox.com>
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; This file is loaded by context.el when required.
+
+;;; Code:
+
+;; Build upon ConTeXt
+(require 'context)
+
+;;; ConText macro names
+
+;;; Code:
+(defvar ConTeXt-environment-list-en
+ '("alignment" "appendices"
+ "background" "backmatter" "bodymatter" "bodypart" "buffer"
+ "code" "color" "columns" "combination"
+ "encoding" "extroductions"
+ "fact" "formula" "framedcode" "framedtext" "frontmatter"
+ "helptext" "hiding"
+ "itemize"
+ "legend" "line" "linecorrection" "linenumbering" "lines"
+ "localenvironment" "localfootnotes"
+ "makeup" "mapping" "marginblock" "marginedge" "marginrule" "mode"
+ "narrower" "notmode"
+ "opposite"
+ "packed" "pagecomment" "pagefigure" "positioning" "postponing"
+ "quotation"
+ "raster" "register"
+ "standardmakeup"
+ "table" "tabulate" "TEXpage" "text" "textbackground" "typing"
+ "unpacked"
+ ;; project structure
+ "component" "environment" "product" "project"
+ ;; flowcharts, if you have loaded this module
+ "FLOWcell" "FLOWchart"
+ ;; typesetting computer languages
+ "EIFFEL" "JAVA" "JAVASCRIPT" "MP" "PASCAL" "PERL" "SQL" "TEX" "XML"
+ ;; some metapost environments
+ "MPpositiongraphic" "useMPgraphic" "MPcode" "reusableMPgraphic"
+ "uniqueMPgraphic")
+ "List of the ConTeXt en interface start/stop pairs.")
+
+(defvar ConTeXt-define-list-en
+ '("accent"
+ "background" "blank" "block" "blocks" "bodyfont" "bodyfontenvironment"
+ "buffer"
+ "casemap" "character" "color" "colorgroup" "combinedlist" "command"
+ "description" "enumeration"
+ "float" "font" "fontsynonym" "framedtext" "head"
+ "indenting" "label"
+ "logo" "overlay"
+ "palet" "program" "startstop" "type" "typing")
+ "List of the names of ConTeXt en interface macro's that define things.")
+
+(defvar ConTeXt-setup-list-en
+ '("align" "arranging" "background" "backgrounds" "blackrules"
+ "blank" "block" "bodyfont" "bodyfontenvironment" "bottom"
+ "bottomtexts" "buffer" "capitals" "caption" "captions" "color"
+ "colors" "columns" "combinations" "combinedlist" "descriptions"
+ "enumerations" "externalfigures" "fillinlines" "fillinrules" "float"
+ "floats" "footer" "footertexts" "footnodedefinition" "footnotes"
+ "framed" "framedtexts" "head" "header" "headertexts" "headnumber"
+ "heads" "headtext" "hyphenmark" "indentations" "indenting" "inmargin"
+ "interlinespace" "itemize" "items" "labeltext" "language" "layout"
+ "linenumbering" "lines" "list" "makeup" "marginblocks"
+ "marginrules" "marking" "narrower" "oppositeplacing"
+ "pagecomment" "pagenumber" "pagenumbering" "palet" "papersize" "paragraphs"
+ "quote" "referencing" "register"
+ "screens" "section" "sectionblock" "sorting" "spacing"
+ "subpagenumber" "synonyms" "text" "textrules" "texttexts" "thinrules"
+ "tolerance" "top" "toptexts" "type" "typing" "underbar" "whitespace")
+ "List of the names of ConTeXt en interface macro's that setup things.")
+
+;; referencing in ConTeXt
+(defvar ConTeXt-referencing-list-en
+ '("in" "at" "about" "pagereference" "textreference" "reference")
+ "List of ConTeXt en macro's that are used for referencing."
+)
+
+;; lists some place macro's as well, should perhaps be under separate menu
+(defvar ConTeXt-other-macro-list-en
+ '("abbreviation" "adaptlayout" "at" "combinepages" "copypages"
+ "externalfigure" "framed" "from" "input" "insertpages" "filterpages"
+ "getbuffer" "goto"
+ "hideblocks" "keepblocks"
+ "leftaligned" "midaligned"
+ "obeyspaces"
+ "page"
+ "placecontent" "placeexternalfigure" "placefigure" "placelogos"
"placetable"
+ "processblocks" "protect"
+ "raggedcenter" "rightaligned" "rotate"
+ "scale" "selectblocks" "showexternalfigures" "slicepages"
+ "useexternalfigure" "unprotect" "url" "useblocks" "usemodule" "useURL"
+ "version")
+ "List of ConTeXt en interface macro's that are not an environment nor a
setup.")
+
+(defun ConTeXt-define-command-en (what)
+ "The ConTeXt en interface way of creating a define command."
+ (concat "define" what))
+
+(defun ConTeXt-setup-command-en (what)
+ "The ConTeXt en interface way of creating a setup command."
+ (concat "setup" what))
+
+(defvar ConTeXt-project-structure-list-en
+ '("project" "environment" "product" "component")
+ "List of the names of ConTeXt project structure elements for its en
interface. List should be in logical order.")
+
+(defvar ConTeXt-section-block-list-en
+ '("frontmatter" "bodymatter" "appendices" "backmatter")
+ "List of the names of ConTeXt section blocks for its en interface. List
should be in logical order.")
+
+
+;; TODO:
+;; ConTeXt has alternative sections like title and subject. Currently
+;; the level is used to find the section name, so the alternative
+;; names are never found. Have to start using the section name instead
+;; of the number.
+(defvar ConTeXt-section-list-en
+ '(("part" 0)
+ ("chapter" 1)
+ ("section" 2)
+ ("subsection" 3)
+ ("subsubsection" 4))
+ ;; ("title" 1)
+ ;; ("subject" 2)
+ ;; ("subsubject" 3)
+ ;; ("subsubsubject" 4)
+ "List of the names of ConTeXt sections for its en interface.")
+
+(defvar ConTeXt-text-en "text"
+ "The ConTeXt en interface body text group.")
+
+(defvar ConTeXt-item-list-en
+ '("item" "its" "mar" "ran" "sub" "sym")
+ "The ConTeXt macro's that are variants of item.")
+
+(defcustom ConTeXt-default-environment-en "itemize"
+ "*The default environment when creating new ones with `ConTeXt-environment'."
+ :group 'ConTeXt-en-environment
+ :type 'string)
+
+(defvar ConTeXt-extra-paragraph-commands-en
+ '("crlf" "par" "place[A-Za-z]+")
+ "List of ConTeXt macros that should have their own line.
+That is, besides the section(-block) commands.")
+
+;; Emacs en menu names and labels should go here
+;; to be done
+
+
+;;; Mode
+
+(defun ConTeXt-en-mode-initialization ()
+ "ConTeXt english interface specific initialization."
+ (mapc 'ConTeXt-add-environments (reverse ConTeXt-environment-list-en))
+
+ (TeX-add-symbols
+ '("but" ConTeXt-arg-define-ref (TeX-arg-literal " "))
+ '("item" ConTeXt-arg-define-ref (TeX-arg-literal " "))
+ '("items" [ConTeXt-arg-setup] (TeX-arg-string "Comma separated list"))
+ '("its" ConTeXt-arg-define-ref (TeX-arg-literal " "))
+ '("nop" (TeX-arg-literal " "))
+ '("ran" TeX-arg-string (TeX-arg-literal " "))
+ '("sub" ConTeXt-arg-define-ref (TeX-arg-literal " "))
+ '("sym" (TeX-arg-string "Symbol") (TeX-arg-literal " "))))
+
+;;;###autoload
+(defun context-en-mode ()
+ "Major mode for editing files for ConTeXt using its english interface.
+
+Special commands:
+\\{ConTeXt-mode-map}
+
+Entering `context-mode' calls the value of `text-mode-hook',
+then the value of TeX-mode-hook, and then the value
+of context-mode-hook."
+ (interactive)
+ ;; set the ConTeXt interface
+ (setq ConTeXt-current-interface "en")
+
+ ;; initialization
+ (ConTeXt-mode-common-initialization)
+ (ConTeXt-en-mode-initialization)
+
+ ;; set mode line
+ (setq TeX-base-mode-name "ConTeXt-en")
+ (TeX-set-mode-name))
+
+(provide 'context-en)
+
+;;; context-en.el ends here
diff --git a/tests/auctex-11.87.7/context-nl.el
b/tests/auctex-11.87.7/context-nl.el
new file mode 100644
index 0000000..9ddebe9
--- /dev/null
+++ b/tests/auctex-11.87.7/context-nl.el
@@ -0,0 +1,197 @@
+;;; context-nl.el --- Support for the ConTeXt dutch interface.
+
+;; Copyright (C) 2003, 2004 Free Software Foundation, Inc.
+
+;; Maintainer: Berend de Boer <berend@pobox.com>
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; This file is loaded by context.el when required.
+
+;;; Code:
+
+;; Build upon ConTeXt
+(require 'context)
+
+;;; ConText macro names
+
+(defvar ConTeXt-environment-list-nl
+ '("achtergrond" "alinea" "bloktekst" "buffer" "citaat" "combinatie"
+ "commentaar" "deelomgeving" "document" "doordefinitie"
+ "doornummering" "figuur" "formule" "gegeven" "interactiemenu"
+ "kadertekst" "kantlijn" "kleur" "kolommen" "legenda" "lokaal"
+ "lokalevoetnoten" "margeblok" "naamopmaak" "naast"
+ "opelkaar" "opmaak" "opsomming" "overlay" "overzicht"
+ "paginafiguur" "positioneren" "profiel"
+ "regel" "regelcorrectie" "regelnummeren" "regels"
+ "smaller" "symboolset" "synchronisatie"
+ "tabel" "tabellen" "tabulatie" "tekstlijn" "typen"
+ "uitlijnen" "uitstellen" "vanelkaar" "verbergen" "versie"
+ ;; project structure
+ "omgeving" "onderdeel" "produkt" "project"
+ ;; flowcharts, if you have loaded this module
+ "FLOWcell" "FLOWchart"
+ ;; typesetting computer languages
+ "EIFFEL" "JAVA" "JAVASCRIPT" "MP" "PASCAL" "PERL" "SQL" "TEX" "XML"
+ ;; some metapost environments
+ "MPpositiongraphic" "useMPgraphic" "MPcode" "reusableMPgraphic"
+ "uniqueMPgraphic")
+ "List of the ConTeXt nl interface start/stop pairs.")
+
+(defvar ConTeXt-define-list-nl
+ '("achtergrond" "startstop" "typen")
+ "List of ConTeXt nl interface macro's that define things.")
+
+(defvar ConTeXt-setup-list-nl
+ '("achtergronden" "achtergrond" "alineas" "arrangeren" "blanko"
+ "blok" "blokjes" "blokkopje" "blokkopjes" "boven" "boventeksten"
+ "brieven" "buffer" "buttons" "citeren" "clip" "combinaties"
+ "commentaar" "doordefinieren" "doornummeren" "doorspringen"
+ "dunnelijnen" "externefiguren" "formules" "formulieren"
+ "hoofd" "hoofdteksten" "inmarge" "inspringen" "interactiebalk"
+ "interactie" "interactiemenu" "interactiescherm" "interlinie"
+ "invullijnen" "invulregels" "items" "kaderteksten" "kantlijn"
+ "kapitalen" "kleuren" "kleur" "kolommen" "kop" "kopnummer"
+ "koppelteken" "koppen" "koptekst" "korps" "korpsomgeving"
+ "labeltekst" "layout" "legenda" "lijndikte" "lijn" "lijst"
+ "margeblokken" "markering" "naastplaatsen" "nummeren" "omlijnd"
+ "onder" "onderstrepen" "onderteksten" "opmaak" "opsomming"
+ "paginanummer" "paginanummering" "paginaovergangen" "palet"
+ "papierformaat" "papier" "paragraafnummeren" "plaatsblok"
+ "plaatsblokken" "plaatsblokkensplitsen" "positioneren" "profielen"
+ "programmas" "publicaties" "rasters" "referentielijst" "refereren"
+ "regelnummeren" "regels" "register" "roteren" "samengesteldelijst"
+ "sectieblok" "sectie" "sheets" "smaller" "sorteren" "spatiering"
+ "stickers" "strut" "strut" "subpaginanummer" "symboolset"
+ "synchronisatiebalk" "synchronisatie" "synoniemen" "systeem"
+ "taal" "tabellen" "tab" "tabulatie" "tekst" "tekstlijnen"
+ "tekstpositie" "tekstteksten" "tekstvariabele" "tolerantie" "type"
+ "typen" "uitlijnen" "uitvoer" "url" "velden" "veld" "versies"
+ "voet" "voetnootdefinitie" "voetnoten" "voetteksten" "witruimte")
+ "List of the names of ConTeXt nl interface macro's that setup things.")
+
+;; referencing in ConTeXt
+(defvar ConTeXt-referencing-list-nl
+ '("in" "op" "over" "paginareferentie" "tekstreferentie" "referentie")
+ "List of ConTeXt en macro's that are used for referencing."
+)
+
+(defvar ConTeXt-other-macro-list-nl
+ '("regellinks" "regelmidden" "regelrechts" "toonexternefiguren")
+ "List of ConTeXt nl interface macro's that are not an environment nor a
setup.")
+
+(defun ConTeXt-define-command-nl (what)
+ "The ConTeXt nl interface way of creating a define command."
+ (concat "definieer" what))
+
+(defun ConTeXt-setup-command-nl (what)
+ "The ConTeXt nl interface way of creating a setup command."
+ (concat "stel" what "in"))
+
+(defvar ConTeXt-project-structure-list-nl
+ '("project" "omgeving" "produkt" "onderdeel")
+ "List of the names of ConTeXt project structure elements for its nl
interface. List should be in logical order.")
+
+(defvar ConTeXt-section-block-list-nl
+ '("inleidingen" "hoofdteksten" "bijlagen" "uitleidingen")
+ "List of the names of ConTeXt section blocks for its nl interface. List
should be in logical order.")
+
+
+;; TODO:
+;; ConTeXt has alternative sections like title and subject. Currently
+;; the level is used to find the section name, so the alternative
+;; names are never found. Have to start using the section name instead
+;; of the number.
+(defvar ConTeXt-section-list-nl
+ '(("deel" 0)
+ ("hoofdstuk" 1)
+ ("paragraaf" 2)
+ ("subparagraaf" 3)
+ ("subsubparagraaf" 4))
+ ;; ("title" 1)
+ ;; ("subject" 2)
+ ;; ("subsubject" 3)
+ ;; ("subsubsubject" 4)
+ "List of the names of ConTeXt sections for its nl interface.")
+
+(defvar ConTeXt-text-nl "tekst"
+ "The ConTeXt nl interface body text group.")
+
+(defvar ConTeXt-item-list-nl
+ '("som" "its" "mar" "ran" "sub" "sym")
+ "The ConTeXt macro's that are variants of item.")
+
+(defcustom ConTeXt-default-environment-nl "opsomming"
+ "*The default environment when creating new ones with `ConTeXt-environment'."
+ :group 'ConTeXt-nl-environment
+ :type 'string)
+
+(defvar ConTeXt-extra-paragraph-commands-nl
+ '("crlf" "par" "plaats[A-Za-z]+")
+ "List of ConTeXt macros that should have their own line.
+That is, besides the section(-block) commands.")
+
+;; Emacs en menu names and labels should go here
+;; to be done
+
+
+;;; Mode
+
+(defun ConTeXt-nl-mode-initialization ()
+ "ConTeXt dutch interface specific initialization."
+ (mapc 'ConTeXt-add-environments (reverse ConTeXt-environment-list-nl))
+
+ (TeX-add-symbols
+ '("but" ConTeXt-arg-define-ref (TeX-arg-literal " "))
+ '("som" ConTeXt-arg-define-ref (TeX-arg-literal " "))
+ '("items" [ConTeXt-arg-setup] (TeX-arg-string "Comma separated list"))
+ '("its" ConTeXt-arg-define-ref (TeX-arg-literal " "))
+ '("nop" (TeX-arg-literal " "))
+ '("ran" TeX-arg-string (TeX-arg-literal " "))
+ '("sub" ConTeXt-arg-define-ref (TeX-arg-literal " "))
+ '("sym" (TeX-arg-string "Symbol") (TeX-arg-literal " "))))
+
+;;;###autoload
+(defun context-nl-mode ()
+ "Major mode for editing files for ConTeXt using its dutch interface.
+
+Special commands:
+\\{ConTeXt-mode-map}
+
+Entering `context-mode' calls the value of `text-mode-hook',
+then the value of TeX-mode-hook, and then the value
+of context-mode-hook."
+ (interactive)
+
+ ;; set the ConTeXt interface
+ (setq ConTeXt-current-interface "nl")
+
+ ;; initialization
+ (ConTeXt-mode-common-initialization)
+ (ConTeXt-nl-mode-initialization)
+
+ ;; set mode line
+ (setq TeX-base-mode-name "ConTeXt-nl")
+ (TeX-set-mode-name))
+
+(provide 'context-nl)
+
+;;; context-nl.el ends here
diff --git a/tests/auctex-11.87.7/context.el b/tests/auctex-11.87.7/context.el
new file mode 100644
index 0000000..3a2622b
--- /dev/null
+++ b/tests/auctex-11.87.7/context.el
@@ -0,0 +1,1662 @@
+;;; context.el --- Support for ConTeXt documents.
+
+;; Copyright (C) 2003-2006, 2008, 2010, 2012
+;; Free Software Foundation, Inc.
+
+;; Maintainer: Berend de Boer <berend@pobox.com>
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; This is in progress ConTeXt support for AUCTeX. Please report
+;; anomalies or things you believe should be added.
+
+;; AUCTeX is closely interwoven with LaTeX. We have to split up
+;; things without breaking 'em.
+
+;; some parts are stolen from latex.el and adapted to ConTeXt.
+
+;; TODO
+;; 1. indentation still bad.
+;; 2. paragraph refilling doesn't work 100%, and is very slow.
+;; 4. Remove dependency on LaTeX by moving LaTeX commands to TeX.
+;; 5. Most ConTeXt macro's don't currently have lisp code to query for
+;; arguments. As ConTeXt arguments are quite complex, the LaTeX way
+;; of querying for arguments just doesn't cut it.
+;; 6. Check auto-parsing: does it detect % interface=nl for example?
+;; 7. Complete adding ConTeXt macro's. Perhaps parse cont-en.xml and
+;; generate the interfaces?
+;; 8. Add to menu: make TeX hash (mktexlsr), context format and metapost
format.
+
+;; TODO Documentation
+;; 1. multifile done differently with ConTeXt
+
+;;; Code:
+
+(require 'tex-buf)
+(require 'tex)
+(require 'latex) ; for functions like `TeX-look-at' and `LaTeX-split-long-menu'
+(require 'plain-tex) ; for `plain-TeX-common-initialization'
+
+(defgroup ConTeXt-macro nil
+ "Special support for ConTeXt macros in AUCTeX."
+ :prefix "TeX-"
+ :group 'ConTeXt
+ :group 'TeX-macro)
+
+
+;;; variables
+
+;; globals used in certain macro's.
+(defvar done-mark nil
+ "Position of point afterwards, default nil (meaning end).")
+
+(defvar reference nil
+ "Set by `ConTeXt-section-ref', used by `ConTeXt-section-section'.")
+
+(defvar title nil
+ "Set by `ConTeXt-section-title', used by `ConTeXt-section-section'.")
+
+
+;; others
+
+(defvar ConTeXt-known-interfaces '("cz" "de" "en" "it" "nl" "ro" "uk"))
+
+(defcustom ConTeXt-default-interface "en"
+ "Default interface to be used when running ConTeXt."
+ :group 'ConTeXt
+ :type 'string)
+
+(defvar ConTeXt-current-interface "en"
+ "Interface to be used for inserting macros and ConTeXt run.")
+(make-variable-buffer-local 'ConTeXt-current-interface)
+
+(defvar ConTeXt-menu-changed nil)
+;; Need to update ConTeXt menu.
+(make-variable-buffer-local 'ConTeXt-menu-changed)
+
+(defvar ConTeXt-largest-level nil
+ "Largest sectioning level within current document.")
+(make-variable-buffer-local 'ConTeXt-largest-level)
+
+(defun ConTeXt-largest-level ()
+ (TeX-update-style)
+ ConTeXt-largest-level)
+
+
+;;; Syntax
+
+(defvar ConTeXt-optop "["
+ "The ConTeXt optional argument opening character.")
+
+(defvar ConTeXt-optcl "]"
+ "The ConTeXt optional argument closing character.")
+
+
+;; Define a ConTeXt macro
+
+(defvar ConTeXt-define-list ()
+ "Calls ConTeXt-XX-define-list where XX is the current interface.")
+
+(defun ConTeXt-define-command (what)
+ "The ConTeXt macro to define WHAT."
+ (funcall
+ (intern (concat "ConTeXt-define-command-" ConTeXt-current-interface)) what))
+
+(defun ConTeXt-insert-define (define)
+ "Insert the ConTeXt define macro DEFINE."
+ (insert TeX-esc (ConTeXt-define-command define))
+ (newline)
+ (indent-according-to-mode)
+ (ConTeXt-arg-setup nil))
+
+
+;; Setup a ConTeXt macro
+
+(defvar ConTeXt-setup-list ()
+ "Calls ConTeXt-XX-setup-list where XX is the current interface.")
+
+(defun ConTeXt-setup-command (what)
+ "The ConTeXt macro to setup WHAT."
+ (funcall
+ (intern (concat "ConTeXt-setup-command-" ConTeXt-current-interface)) what))
+
+(defun ConTeXt-insert-setup (setup)
+ "Insert the ConTeXt setup macro SETUP."
+ (insert TeX-esc (ConTeXt-setup-command setup))
+ (newline)
+ (indent-according-to-mode)
+ (ConTeXt-arg-setup nil))
+
+
+;; Referencing ConTeXt macro's
+
+(defvar ConTeXt-referencing-list ()
+ "Calls ConTeXt-XX-other-macro-list where XX is the current interface.")
+
+(defun ConTeXt-referencing-command (what)
+ "The ConTeXt macro to call WHAT is itself, no interface specific calls."
+ what)
+
+(defun ConTeXt-insert-referencing (what)
+ "Insert the ConTeXt referencing SETUP."
+ (insert TeX-esc (ConTeXt-referencing-command what))
+ (newline)
+ (indent-according-to-mode)
+ (ConTeXt-arg-setup nil))
+
+
+;; Other ConTeXt macro's
+
+(defvar ConTeXt-other-macro-list ()
+ "Calls ConTeXt-XX-other-macro-list where XX is the current interface.")
+
+(defun ConTeXt-other-macro-command (what)
+ "The ConTeXt macro to call WHAT is itself, no interface specific calls."
+ what)
+
+(defun ConTeXt-insert-other-macro (other-macro)
+ "Insert the ConTeXt other macro's macro SETUP."
+ (insert TeX-esc (ConTeXt-other-macro-command other-macro))
+ (newline)
+ (indent-according-to-mode)
+ (ConTeXt-arg-setup nil))
+
+
+;;; Project structure
+
+(defvar ConTeXt-project-structure-list ()
+ "Calls ConTeXt-XX-project-structure where XX is the current interface.")
+
+(defun ConTeXt-project-structure (N)
+ "Insert a ConTeXt project structure where N is in index into
`ConTeXt-project-structure-list'."
+ (funcall (intern(concat
+ "ConTeXt-project-"
+ (nth N ConTeXt-project-structure-list)
+ "-insert"))))
+
+(defun ConTeXt-project-project-insert ()
+ "Insert a basic template for a new ConTeXt project."
+ (save-excursion
+ (insert "% The following names are examples only\n")
+ (insert TeX-esc (ConTeXt-environment-start-name) (nth 0
ConTeXt-project-structure-list) " myproject")
+ (newline 2)
+ (insert TeX-esc (nth 1 ConTeXt-project-structure-list) " myenvironment")
+ (newline 2)
+ (insert TeX-esc (nth 2 ConTeXt-project-structure-list) " myproduct1")
+ (newline 2)
+ (insert TeX-esc (nth 2 ConTeXt-project-structure-list) " myproduct2")
+ (newline 2)
+ (insert TeX-esc (ConTeXt-environment-stop-name) (nth 0
ConTeXt-project-structure-list))))
+
+(defun ConTeXt-project-environment-insert ()
+ "Insert a basic template for the environment of a ConTeXt project."
+ (save-excursion
+ (insert "% The name 'myenvironment' is an example only.\n"
+ "% It must match the name in your project file.\n")
+ (insert TeX-esc (ConTeXt-environment-start-name)
+ (nth 1 ConTeXt-project-structure-list) " myenvironment\n\n")
+ (insert "% Put environment charateristics that must be defined at the "
+ "highest level here\n\n")
+ (insert TeX-esc (ConTeXt-environment-stop-name)
+ (nth 1 ConTeXt-project-structure-list))))
+
+(defun ConTeXt-project-product-insert ()
+ "Insert a basic template for a product of a ConTeXt project."
+ (save-excursion
+ (insert "% The following names are examples only\n")
+ (insert TeX-esc (ConTeXt-environment-start-name)
+ (nth 2 ConTeXt-project-structure-list) " myproduct1")
+ (newline 2)
+ (insert TeX-esc (nth 0 ConTeXt-project-structure-list) " myproject")
+ (newline 2)
+ (insert "% Components are optional. "
+ "You can also just start your document here.\n")
+ (insert TeX-esc (nth 3 ConTeXt-project-structure-list) " mycomponent1")
+ (newline 2)
+ (insert TeX-esc (nth 3 ConTeXt-project-structure-list) " mycomponent2")
+ (newline 2)
+ (insert TeX-esc (ConTeXt-environment-stop-name)
+ (nth 2 ConTeXt-project-structure-list))))
+
+(defun ConTeXt-project-component-insert ()
+ "Insert a basic template for a component of a ConTeXt project."
+ (save-excursion
+ (insert "% The following names are examples only\n")
+ (insert TeX-esc (ConTeXt-environment-start-name)
+ (nth 3 ConTeXt-project-structure-list) " mycomponent1")
+ (newline 2)
+ (insert TeX-esc (nth 0 ConTeXt-project-structure-list) " myproject\n")
+ (insert TeX-esc (nth 2 ConTeXt-project-structure-list) " myproduct1")
+ (newline 2)
+ (insert "% ... text here ...")
+ (newline 2)
+ (insert TeX-esc (ConTeXt-environment-stop-name)
+ (nth 3 ConTeXt-project-structure-list))))
+
+
+;;; Section blocks
+
+(defvar ConTeXt-section-block-list ()
+ "Calls ConTeXt-XX-section-list where XX is the current interface.")
+
+(defun ConTeXt-section-block (section-block)
+ "Insert the ConTeXt section block SECTION-BLOCK."
+ (ConTeXt-environment-menu section-block))
+
+
+;;; Sections
+
+(defun ConTeXt-section (arg)
+ "Insert a template for a ConTeXt section.
+Determinate the type of section to be inserted, by the argument ARG.
+
+If ARG is nil or missing, use the current level.
+If ARG is a list (selected by \\[universal-argument]), go downward one level.
+If ARG is negative, go up that many levels.
+If ARG is positive or zero, use absolute level:
+
+ 0 : part
+ 1 : chapter
+ 2 : section
+ 3 : subsection
+ 4 : subsubsection
+ 5 : subsubsubsection
+
+Or:
+
+ 0 : title
+ 1 : subject
+ 2 : subsubject
+ 3 : subsubsubject
+
+The following variables can be set to customize:
+
+`ConTeXt-section-hook' Hooks to run when inserting a section.
+`ConTeXt-section-ref' Prefix to all section references."
+
+ (interactive "*P")
+ (let* ((val (prefix-numeric-value arg))
+ (level (cond ((null arg)
+ (ConTeXt-current-section))
+ ((listp arg)
+ (ConTeXt-down-section))
+ ((< val 0)
+ (ConTeXt-up-section (- val)))
+ (t val)))
+ (name (ConTeXt-section-name level))
+ (toc nil)
+ (title "")
+ (done-mark (make-marker)))
+ (newline)
+ (run-hooks 'ConTeXt-section-hook)
+ (newline)
+ (if (marker-position done-mark)
+ (goto-char (marker-position done-mark)))
+ (set-marker done-mark nil)))
+
+;; LaTeX has a max function here, which makes no sense.
+;; I think you want to insert a section that is max ConTeXt-largest-level
+(defun ConTeXt-current-section ()
+ "Return the level of the section that contain point.
+See also `ConTeXt-section' for description of levels."
+ (save-excursion
+ (min (ConTeXt-largest-level)
+ (if (re-search-backward outline-regexp nil t)
+ (+ 1 (- (ConTeXt-outline-level) (ConTeXt-outline-offset)))
+ (ConTeXt-largest-level)))))
+
+(defun ConTeXt-down-section ()
+ "Return the value of a section one level under the current.
+Tries to find what kind of section that have been used earlier in the
+text, if this fail, it will just return one less than the current
+section."
+ (save-excursion
+ (let ((current (ConTeXt-current-section))
+ (next nil)
+ (regexp outline-regexp))
+ (if (not (re-search-backward regexp nil t))
+ (1+ current)
+ (while (not next)
+ (cond
+ ((eq (ConTeXt-current-section) current)
+ (if (re-search-forward regexp nil t)
+ (if (<= (setq next (ConTeXt-current-section)) current) ;Wow!
+ (setq next (1+ current)))
+ (setq next (1+ current))))
+ ((not (re-search-backward regexp nil t))
+ (setq next (1+ current)))))
+ next))))
+
+(defun ConTeXt-up-section (arg)
+ "Return the value of the section ARG levels above this one."
+ (save-excursion
+ (if (zerop arg)
+ (ConTeXt-current-section)
+ (let ((current (ConTeXt-current-section)))
+ (while (and (>= (ConTeXt-current-section) current)
+ (re-search-backward outline-regexp
+ nil t)))
+ (ConTeXt-up-section (1- arg))))))
+
+(defvar ConTeXt-section-list ()
+ "ConTeXt-XX-section-list where XX is the current interface.")
+
+(defun ConTeXt-section-name (level)
+ "Return the name of the section corresponding to LEVEL."
+ (let ((entry (TeX-member level ConTeXt-section-list
+ (function (lambda (a b) (equal a (nth 1 b)))))))
+ (if entry
+ (nth 0 entry)
+ nil)))
+
+(defun ConTeXt-section-level (name)
+ "Return the level of the section NAME."
+ (let ((entry (TeX-member name ConTeXt-section-list
+ (function (lambda (a b) (equal a (nth 0 b)))))))
+
+ (if entry
+ (nth 1 entry)
+ nil)))
+
+
+;;; Section Hooks.
+
+(defcustom ConTeXt-section-hook
+ '(ConTeXt-section-heading
+ ConTeXt-section-title
+ ConTeXt-section-ref
+ ConTeXt-section-section)
+ "List of hooks to run when a new section is inserted.
+
+The following variables are set before the hooks are run
+
+level - numeric section level, see the documentation of `ConTeXt-section'.
+name - name of the sectioning command, derived from `level'.
+title - The title of the section, default to an empty string.
+`done-mark' - Position of point afterwards, default nil (meaning end).
+
+The following standard hook exist -
+
+ConTeXt-section-heading: Query the user about the name of the
+sectioning command. Modifies `level' and `name'.
+
+ConTeXt-section-title: Query the user about the title of the
+section. Modifies `title'.
+
+ConTeXt-section-section: Insert ConTeXt section command according to
+`name', `title', and `reference'. If `title' is an empty string,
+`done-mark' will be placed at the point they should be inserted.
+
+ConTeXt-section-ref: Insert a reference for this section command.
+
+To get a full featured `ConTeXt-section' command, insert
+
+ (setq ConTeXt-section-hook
+ '(ConTeXt-section-heading
+ ConTeXt-section-title
+ ConTeXt-section-section
+ ConTeXt-section-ref))
+
+in your .emacs file."
+ :group 'ConTeXt-macro
+ :type 'hook
+ :options
+ '(ConTeXt-section-heading
+ ConTeXt-section-title
+ ConTeXt-section-ref
+ ConTeXt-section-section))
+
+(defun ConTeXt-section-heading ()
+ "Hook to prompt for ConTeXt section name.
+Insert this hook into `ConTeXt-section-hook' to allow the user to change
+the name of the sectioning command inserted with `\\[ConTeXt-section]'."
+ (let ((string (completing-read
+ (concat "Select level: (default " name ") ")
+ ConTeXt-section-list
+ nil nil nil)))
+ ;; Update name
+ (if (not (zerop (length string)))
+ (setq name string))))
+
+(defun ConTeXt-section-title ()
+ "Hook to prompt for ConTeXt section title.
+Insert this hook into `ConTeXt-section-hook' to allow the user to change
+the title of the section inserted with `\\[ConTeXt-section]."
+ (setq title (read-string "What title: ")))
+
+(defun ConTeXt-section-section ()
+ "Hook to insert ConTeXt section command into the file.
+Insert this hook into `ConTeXt-section-hook' after those hooks which sets
+the `name', `title', and `reference' variables, but before those hooks which
+assumes the section already is inserted."
+ (insert TeX-esc name)
+ (cond ((null reference))
+ ((zerop (length reference))
+ (insert ConTeXt-optop)
+ (set-marker done-mark (point))
+ (insert ConTeXt-optcl))
+ (t
+ (insert ConTeXt-optop reference ConTeXt-optcl)))
+ (insert TeX-grop)
+ (if (zerop (length title))
+ (set-marker done-mark (point)))
+ (insert title TeX-grcl)
+ (newline)
+ ;; If RefTeX is available, tell it that we've just made a new section
+ (and (fboundp 'reftex-notice-new-section)
+ (funcall (symbol-function 'reftex-notice-new-section))))
+
+(defun ConTeXt-section-ref ()
+ "Hook to insert a reference after the sectioning command.
+Insert this hook into `ConTeXt-section-hook' to prompt for a label to be
+inserted after the sectioning command."
+
+ (setq reference (completing-read
+ (TeX-argument-prompt t nil
+ "Comma separated list of references")
+ (LaTeX-label-list) nil nil))
+ ;; No reference or empty string entered?
+ (if (string-equal "" reference)
+ (setq reference nil)))
+
+
+;; Various
+(defun TeX-ConTeXt-sentinel (process name)
+ "Cleanup TeX output buffer after running ConTeXt."
+ (cond ((TeX-TeX-sentinel-check process name))
+ ((save-excursion
+ ;; in a full ConTeXt run there will multiple texutil
+ ;; outputs. Just looking for "another run needed" would
+ ;; find the first occurence
+ (goto-char (point-max))
+ (re-search-backward "TeXUtil " nil t)
+ (re-search-forward "another run needed" nil t))
+ (message (concat "You should run ConTeXt again "
+ "to get references right, "
+ (TeX-current-pages)))
+ (setq TeX-command-next TeX-command-default))
+ ((re-search-forward "removed files :" nil t)
+ (message "sucessfully cleaned up"))
+ ((re-search-forward "^ ?TeX\\(Exec\\|Util\\)" nil t) ;; strange regexp
--pg
+ (message (concat name ": successfully formatted "
+ (TeX-current-pages)))
+ (setq TeX-command-next TeX-command-Show))
+ (t
+ (message (concat name ": problems after "
+ (TeX-current-pages)))
+ (setq TeX-command-next TeX-command-default))))
+
+
+;;; Environments
+
+(defgroup ConTeXt-environment nil
+ "Environments in AUCTeX."
+ :group 'ConTeXt-macro)
+
+;; TODO: interface awareness
+(defcustom ConTeXt-default-environment "itemize"
+ "*The default environment when creating new ones with `ConTeXt-environment'."
+ :group 'ConTeXt-environment
+ :type 'string)
+(make-variable-buffer-local 'ConTeXt-default-environment)
+
+(TeX-auto-add-type "environment" "ConTeXt")
+
+(fset 'ConTeXt-add-environments-auto
+ (symbol-function 'ConTeXt-add-environments))
+(defun ConTeXt-add-environments (&rest environments)
+ "Add ENVIRONMENTS to the list of known environments."
+ (apply 'ConTeXt-add-environments-auto environments)
+ (setq ConTeXt-menu-changed t))
+
+;; (defvar ConTeXt-environment-list ()
+;; "ConTeXt-environment-list-XX where XX is the current interface.")
+
+(defvar ConTeXt-environment-history nil)
+
+(defun ConTeXt-environment-start-name ()
+ "Return the \\start translated to the language in current interface."
+ ;; it is "inizia", others are "start"
+ (cond ((equal ConTeXt-current-interface "it")
+ "inizia")
+ ((member ConTeXt-current-interface ConTeXt-known-interfaces)
+ "start")
+ (t
+ ;; this should not happen
+ (error "Unknown interface: %s" ConTeXt-current-interface))))
+
+(defun ConTeXt-environment-stop-name ()
+ "Return the \\stop translated to the language in current interface."
+ ;; it is "termina", others are "stop"
+ (cond ((equal ConTeXt-current-interface "it")
+ "termina")
+ ((member ConTeXt-current-interface ConTeXt-known-interfaces)
+ "stop")
+ (t
+ ;; this should not happen
+ (error "Unknown interface: %s" ConTeXt-current-interface))))
+
+
+(defun ConTeXt-environment (arg)
+ "Make ConTeXt environment (\\start...-\\stop... pair).
+With optional ARG, modify current environment."
+ (interactive "*P")
+ (let ((environment (
+ completing-read (concat "Environment type: (default "
+ (if (TeX-near-bobp)
+ "text"
+ ConTeXt-default-environment)
+ ") ")
+ ConTeXt-environment-list
+ nil nil nil
+ 'ConTeXt-environment-history)
+ ))
+ ;; Get default
+ (cond ((and (zerop (length environment))
+ (TeX-near-bobp))
+ (setq environment "text"))
+ ((zerop (length environment))
+ (setq environment ConTeXt-default-environment))
+ (t
+ (setq ConTeXt-default-environment environment)))
+
+ (let ((entry (assoc environment ConTeXt-environment-list)))
+ (when (null entry)
+ (ConTeXt-add-environments (list environment)))
+ (if arg
+ (ConTeXt-modify-environment environment)
+ (ConTeXt-environment-menu environment)))))
+
+(defun ConTeXt-modify-environment (environment)
+ "Modify current environment."
+ (save-excursion
+ (ConTeXt-find-matching-stop)
+ (re-search-backward (concat (regexp-quote TeX-esc)
+ (ConTeXt-environment-stop-name)
+ " *\\([a-zA-Z]*\\)")
+ (save-excursion (beginning-of-line 1) (point)))
+ (replace-match
+ (concat TeX-esc (ConTeXt-environment-stop-name) environment) t t)
+ (beginning-of-line 1)
+ (ConTeXt-find-matching-start)
+ (re-search-forward (concat (regexp-quote TeX-esc)
+ (ConTeXt-environment-start-name)
+ " *\\([a-zA-Z]*\\)")
+ (save-excursion (end-of-line 1) (point)))
+ (replace-match
+ (concat TeX-esc (ConTeXt-environment-start-name) environment) t t)))
+
+
+(defun ConTeXt-environment-menu (environment)
+ "Insert ENVIRONMENT around point or region."
+ (let ((entry (assoc environment ConTeXt-environment-list)))
+ (cond ((not (and entry (nth 1 entry)))
+ (ConTeXt-insert-environment environment))
+ ((numberp (nth 1 entry))
+ (let ((count (nth 1 entry))
+ (args ""))
+ (while (> count 0)
+ (setq args (concat args TeX-grop TeX-grcl))
+ (setq count (- count 1)))
+ (ConTeXt-insert-environment environment args)))
+ ((stringp (nth 1 entry))
+ (let ((prompts (cdr entry))
+ (args ""))
+ (while prompts
+ (setq args (concat args
+ TeX-grop
+ (read-from-minibuffer
+ (concat (car prompts) ": "))
+ TeX-grcl))
+ (setq prompts (cdr prompts)))
+ (ConTeXt-insert-environment environment args)))
+ (t
+ (apply (nth 1 entry) environment (nthcdr 2 entry))))))
+
+(defun ConTeXt-close-environment ()
+ "Insert \\stop... to match the current environment."
+ (interactive "*")
+ (beginning-of-line)
+ (let ((empty-line (looking-at "[ \t]*$")))
+ (end-of-line)
+ (if (not empty-line)
+ (newline)))
+ (insert TeX-esc (ConTeXt-environment-stop-name)
+ (ConTeXt-current-environment))
+ ;; indent broken, so don't do it.
+ ;;(indent-according-to-mode)
+ (end-of-line)
+ (newline))
+
+(defun ConTeXt-insert-environment (environment &optional extra)
+ "Insert ENVIRONMENT, with optional argument EXTRA."
+ (if (and (TeX-active-mark)
+ (not (eq (mark) (point))))
+ (save-excursion
+ (if (< (mark) (point))
+ (exchange-point-and-mark))
+ (insert TeX-esc (ConTeXt-environment-start-name) environment)
+ (newline)
+ (forward-line -1)
+ (indent-according-to-mode)
+ (if extra (insert extra))
+ (goto-char (mark))
+ (or (TeX-looking-at-backward "^[ \t]*")
+ (newline))
+ (insert TeX-esc (ConTeXt-environment-stop-name) environment)
+ (newline)
+ (forward-line -1)
+ (indent-according-to-mode)
+ ;;(goto-char (point))
+ )
+ (or (TeX-looking-at-backward "^[ \t]*")
+ (newline))
+ (insert TeX-esc (ConTeXt-environment-start-name) environment)
+ (indent-according-to-mode)
+ (if extra (insert extra))
+ (end-of-line)
+ (newline-and-indent)
+ (newline)
+ (insert TeX-esc (ConTeXt-environment-stop-name) environment)
+ (or (looking-at "[ \t]*$")
+ (save-excursion (newline-and-indent)))
+ (indent-according-to-mode)
+ (end-of-line 0)))
+
+
+;; with the following we can call a function on an environment. Say
+;; you have metapost stuff within your TeX file, go to the environment
+;; and run ConTeXt-work-on-environment (suggested Key: C-c !). AUCTeX
+;; sees that you are inside e.g. \startMPpage....\stopMPpage and
+;; looks in ConTeXt-environment-helper for a function to be called.
+
+;; % so pressing C-c ! inside the following ...
+;;\startuseMPgraphic{Logo}{Scale}
+;; % Top rectangle
+;; filldraw (0,0)--(2cm,0)--(2cm,1cm)--(0,1cm)--cycle withcolor blue ;
+;; % Bottom black rectangle
+;; drawfill (0,0)--(2cm,0)--(2cm,-1cm)--(0,-1cm)--cycle withcolor black;
+;; % White Text
+;; draw btex \bf AB etex withcolor white ;
+;; % resize to size
+;; currentpicture := currentpicture scaled \MPvar{Scale} ;
+;; \stopuseMPgraphic
+
+;; % ...should give you a "new buffer" (currently narrowed to region
+;; % and switched to metapost-mode and recursive-edit)
+
+;; % Top rectangle
+;; filldraw (0,0)--(2cm,0)--(2cm,1cm)--(0,1cm)--cycle withcolor blue ;
+;; % Bottom black rectangle
+;; drawfill (0,0)--(2cm,0)--(2cm,-1cm)--(0,-1cm)--cycle withcolor black;
+;; % White Text
+;; draw btex \bf AB etex withcolor white ;
+;; % resize to size
+;; currentpicture := currentpicture scaled \MPvar{Scale} ;
+
+
+(defvar ConTeXt-environment-helper
+ '(("useMPgraphic" . ConTeXt-mp-region)
+ ("MPpage" . ConTeXt-mp-region))
+ "Alist that holds functions to call for working on regions.
+An entry looks like: (\"environment\" . function)")
+
+(defun ConTeXt-mp-region ()
+ "Edit region in `metapost-mode'."
+ (ConTeXt-mark-environment t)
+ (narrow-to-region (mark) (point))
+ (metapost-mode)
+ (message "Type `M-x exit-recursive-edit' to get back")
+ (recursive-edit)
+ (context-mode)
+ (widen))
+
+;; find smarter name. Suggestions welcome
+(defun ConTeXt-work-on-environment ()
+ "Takes current environment and does something on it (todo: documentation)."
+ (interactive)
+ (let ((fun (cdr (assoc (ConTeXt-current-environment)
+ ConTeXt-environment-helper))))
+ (when (functionp fun)
+ (funcall fun))))
+
+(defun ConTeXt-current-environment ()
+ "Return the name of the current environment."
+ ;; don't make this interactive.
+ (let ((beg))
+ (save-excursion
+ (ConTeXt-last-unended-start)
+ (setq beg (+ (point) (length (ConTeXt-environment-start-name)) 1))
+ (goto-char (match-end 0))
+ (skip-chars-forward "a-zA-Z")
+ (buffer-substring beg (point)))))
+
+(defun ConTeXt-last-unended-start ()
+ "Leave point at the beginning of the last `\\start...' that is unstopped
looking from the current cursor."
+ (while (and (re-search-backward "\\\\start[a-zA-Z]*\\|\\\\stop[a-zA-Z]*")
+ (looking-at "\\\\stop[a-zA-Z]*"))
+ (ConTeXt-last-unended-start)))
+
+(defun ConTeXt-mark-environment (&optional inner)
+ "Set mark to end of current environment (\\start...-\\stop...) and
+point to the matching begin.
+If optional INNER is not nil, include \\start... and \\stop, otherwise only
+the contents."
+ (interactive)
+ (let ((cur (point)))
+ (ConTeXt-find-matching-stop inner)
+ (set-mark (point))
+ (goto-char cur)
+ (ConTeXt-find-matching-start inner)
+ (TeX-activate-region)))
+
+(defun ConTeXt-find-matching-stop (&optional inner)
+ "Find end of current \\start...\\stop-Pair.
+If INNER is non-nil, go to the point just past before
+\\stop... macro. Otherwise goto the point just past \\stop..."
+ (interactive)
+ (let ((regexp (concat (regexp-quote TeX-esc)
+ "\\("
+ (ConTeXt-environment-start-name)
+ "\\|"
+ (ConTeXt-environment-stop-name)
+ "\\)"
+ ))
+ (level 1)
+ (pos))
+ ;;jump over the \start... when at the beginning of it.
+ (when (looking-at (concat (regexp-quote TeX-esc)
+ (ConTeXt-environment-start-name)))
+ (re-search-forward regexp nil t))
+ (while (and (> level 0)
+ (re-search-forward regexp nil t)
+ (goto-char (1- (match-beginning 1)))
+ (cond ((looking-at (concat (regexp-quote TeX-esc)
+ (ConTeXt-environment-start-name)))
+ (re-search-forward regexp nil t)
+ (setq level (1+ level)))
+ ((looking-at (concat (regexp-quote TeX-esc)
+ (ConTeXt-environment-stop-name)))
+ (re-search-forward regexp nil t)
+ (setq level (1- level))))))
+ ;; now we have to look if we want to start behind the \start... macro
+ (if inner
+ (beginning-of-line)
+ (skip-chars-forward "a-zA-Z"))))
+
+(defun ConTeXt-find-matching-start (&optional inner)
+ "Find beginning of current \\start...\\stop-Pair.
+If INNER is non-nil, go to the point just past the \\start... macro."
+ (interactive)
+ (let ((regexp (concat (regexp-quote TeX-esc)
+ "\\("
+ (ConTeXt-environment-start-name)
+ "\\|"
+ (ConTeXt-environment-stop-name)
+ "\\)"
+ ))
+ (level 1)
+ (pos))
+ (while (and (> level 0)
+ (re-search-backward regexp nil t)
+ (cond ((looking-at (concat (regexp-quote TeX-esc)
+ (ConTeXt-environment-stop-name)))
+ (setq level (1+ level)))
+ ((looking-at (concat (regexp-quote TeX-esc)
+ (ConTeXt-environment-start-name)))
+ (setq level (1- level))))))
+ ;; now we have to look if we want to start behind the \start... macro
+ (when inner
+ ;; \startfoo can have 0 or more {} and [] pairs. I assume that
+ ;; skipping all those parens will be smart enough. It fails when
+ ;; the first part in the \start-\stop-environment is { or [, like
+ ;; in \startquotation {\em important} \stopquotation. There is
+ ;; yet another pitfall: \startsetups SomeSetup foo bar
+ ;; \stopsetups will use SomeSetup as the argument and the
+ ;; environment
+ (skip-chars-forward "\\\\a-zA-Z")
+ (save-excursion
+ (while (progn
+ (skip-chars-forward "\t\n ")
+ (forward-comment 1)
+ (skip-chars-forward "\t\n ")
+ (looking-at "\\s\("))
+ (forward-list 1)
+ (setq pos (point))))
+ (when pos
+ (goto-char pos))
+ (unless (bolp)
+ (forward-line)))))
+
+;;; items
+
+(defun ConTeXt-insert-item ()
+ "Insert a new item."
+ (interactive "*")
+ (or (TeX-looking-at-backward "^[ \t]*")
+ (newline))
+ (TeX-insert-macro "item")
+ (indent-according-to-mode))
+
+
+;;; Macro Argument Hooks
+
+(defun ConTeXt-optional-argument-insert (arg &optional prefix)
+ "Insert ARG surrounded by square brackets."
+ (insert ConTeXt-optop)
+ (insert arg)
+ (insert ConTeXt-optcl))
+
+(defun ConTeXt-required-argument-insert (arg &optional prefix)
+ "Insert ARG surrounded by curly braces."
+ (insert TeX-grop)
+ (insert arg)
+ (insert TeX-grcl))
+
+(defun ConTeXt-argument-insert (arg optional &optional prefix)
+ "Insert ARG surrounded by curly braces.
+
+If OPTIONAL, only insert it if not empty, and then use square brackets."
+ (if optional
+ (if
+ (not (string-equal arg ""))
+ (ConTeXt-optional-argument-insert arg prefix))
+ (ConTeXt-required-argument-insert arg prefix)))
+
+(defun ConTeXt-arg-ref (optional &optional prompt definition)
+ "Prompt for a reference completing with known references."
+ (let ((ref (completing-read (TeX-argument-prompt optional prompt "ref")
+ (LaTeX-label-list))))
+ (if (and definition (not (string-equal "" ref)))
+ (LaTeX-add-labels ref))
+ (ConTeXt-argument-insert ref optional)))
+
+(defun ConTeXt-arg-define-ref (&optional prompt)
+ "Prompt for an optional reference completing with known references."
+ (ConTeXt-arg-ref t prompt t))
+
+(defun ConTeXt-arg-setup (optional &optional prompt)
+ "Prompt for setup arguments."
+ (let ((setup (read-from-minibuffer
+ (TeX-argument-prompt optional prompt "Setup"))))
+ (ConTeXt-argument-insert setup t)))
+
+
+;; paragraph (re)-formatting
+
+(defvar ConTeXt-item-list ()
+ "List of macro's considered items.")
+
+(defun ConTeXt-paragraph-commands-regexp ()
+ "Return a regexp matching macros that should have their own line."
+ (concat
+ (regexp-quote TeX-esc) "\\("
+ "[][]\\|" ; display math delimitors (is this applicable to ConTeXt??)
+ (ConTeXt-environment-start-name) "\\|"
+ (ConTeXt-environment-stop-name) "\\|"
+ (mapconcat 'car ConTeXt-section-list "\\b\\|") "\\b\\|"
+ (mapconcat 'identity ConTeXt-extra-paragraph-commands "\\b\\|")
+ "\\b\\|"
+ (mapconcat 'identity ConTeXt-item-list "\\b\\|") "\\b\\)"))
+
+
+;; Outline support
+
+(defun ConTeXt-environment-full-start-name (environment)
+ "Return the ConTeXt macro name that starts ENVIRONMENT.
+It is interface aware"
+ (concat (ConTeXt-environment-start-name) environment))
+
+(defun ConTeXt-outline-regexp (&optional anywhere)
+ "Return regexp for ConTeXt section blocks and sections.
+
+If optional argument ANYWHERE is not nil, do not require that the
+header is at the start of a line."
+ (concat
+ (if anywhere "" "^")
+ "[ \t]*"
+ (regexp-quote TeX-esc)
+ "\\("
+ (mapconcat 'ConTeXt-environment-full-start-name ConTeXt-section-block-list
"\\|") "\\|"
+ (mapconcat 'car ConTeXt-section-list "\\|")
+ "\\)\\b"
+ (if TeX-outline-extra
+ "\\|"
+ "")
+ (mapconcat 'car TeX-outline-extra "\\|")
+ "\\|" (ConTeXt-header-end) "\\b"
+ "\\|" (ConTeXt-trailer-start) "\\b"))
+
+(defvar ConTeXt-text "Name of ConTeXt macro that begins the text body.")
+
+(defun ConTeXt-header-end ()
+ "Default end of header marker for ConTeXt documents."
+ (concat
+ (regexp-quote TeX-esc)
+ (ConTeXt-environment-start-name)
+ ConTeXt-text))
+
+(defun ConTeXt-trailer-start ()
+ "Default start of trailer marker for ConTeXt documents."
+ (concat
+ (regexp-quote TeX-esc)
+ (ConTeXt-environment-stop-name)
+ ConTeXt-text))
+
+(defun ConTeXt-outline-offset ()
+ "Offset to add to `ConTeXt-section-list' levels to get outline level."
+ (- 4 (ConTeXt-largest-level)))
+
+(defun ConTeXt-start-environment-regexp (list)
+ "Regular expression that matches a start of all environments mentioned in
LIST."
+ (concat
+ "start\\("
+ (mapconcat 'identity list "\\|")
+ "\\)\\b"))
+
+;; The top headings are \starttext, \startfrontmatter, \startbodymatter etc.
+;; \part, \chapter etc. are children of that.
+(defun ConTeXt-outline-level ()
+ "Find the level of current outline heading in an ConTeXt document."
+ (cond ((looking-at (concat (ConTeXt-header-end) "\\b")) 1)
+ ((looking-at (concat (ConTeXt-trailer-start) "\\b")) 1)
+ ((TeX-look-at TeX-outline-extra)
+ (max 1 (+ (TeX-look-at TeX-outline-extra)
+ (ConTeXt-outline-offset))))
+ (t
+ (save-excursion
+ (skip-chars-forward " \t")
+ (forward-char 1)
+ (cond ((looking-at (ConTeXt-start-environment-regexp
+ ConTeXt-section-block-list)) 1)
+ ((TeX-look-at ConTeXt-section-list)
+ (max 1 (+ (TeX-look-at ConTeXt-section-list)
+ (ConTeXt-outline-offset))))
+ (t
+ (error "Unrecognized header")))))))
+
+
+;;; Fonts
+
+(defcustom ConTeXt-font-list '((?\C-b "{\\bf " "}")
+ (?\C-c "{\\sc " "}")
+ (?\C-e "{\\em " "}")
+ (?\C-i "{\\it " "}")
+ (?\C-r "{\\rm " "}")
+ (?\C-s "{\\sl " "}")
+ (?\C-t "{\\tt " "}")
+ (?\C-d "" "" t))
+ "List of fonts used by `TeX-font'.
+
+Each entry is a list.
+The first element is the key to activate the font.
+The second element is the string to insert before point, and the third
+element is the string to insert after point.
+If the fourth and fifth element are strings, they specify the prefix and
+suffix to be used in math mode.
+An optional fourth (or sixth) element means always replace if t."
+ :group 'TeX-macro
+ :type '(repeat
+ (group
+ :value (?\C-a "" "")
+ (character :tag "Key")
+ (string :tag "Prefix")
+ (string :tag "Suffix")
+ (option (group
+ :inline t
+ (string :tag "Math Prefix")
+ (string :tag "Math Suffix")))
+ (option (sexp :format "Replace\n" :value t)))))
+
+
+;; Imenu support
+
+(defun ConTeXt-outline-name ()
+ "Guess a name for the current header line."
+ (save-excursion
+ (if (re-search-forward "{\\([^\}]*\\)}" (point-at-eol) t)
+ (match-string 1)
+ (buffer-substring-no-properties (point) (point-at-eol)))))
+
+;; This imenu also includes commented out chapters. Perhaps a feature
+;; for LaTeX, not sure we want or need that for ConTeXt.
+
+(defun ConTeXt-imenu-create-index-function ()
+ "Imenu support function for ConTeXt."
+ (TeX-update-style)
+ (let (entries level (regexp (ConTeXt-outline-regexp)))
+ (goto-char (point-max))
+ (while (re-search-backward regexp nil t)
+ (let* ((name (ConTeXt-outline-name))
+ (level (make-string (1- (ConTeXt-outline-level)) ?\ ))
+ (label (concat level level name))
+ (mark (make-marker)))
+ (set-marker mark (point))
+ (set-text-properties 0 (length label) nil label)
+ (setq entries (cons (cons label mark) entries))))
+ entries))
+
+
+;; Indentation, copied from Berend's context mode.
+;; TODO: doesn't work great.
+
+(defvar ConTeXt-indent-allhanging t)
+(defvar ConTeXt-indent-arg 2)
+(defvar ConTeXt-indent-basic 2)
+(defvar ConTeXt-indent-item ConTeXt-indent-basic)
+(defvar ConTeXt-indent-item-re "\\\\\\(item\\|sym\\)\\>")
+
+(defvar ConTeXt-indent-syntax-table (make-syntax-table TeX-mode-syntax-table)
+ "Syntax table used while computing indentation.")
+
+(progn
+ (modify-syntax-entry ?$ "." ConTeXt-indent-syntax-table)
+ (modify-syntax-entry ?\( "." ConTeXt-indent-syntax-table)
+ (modify-syntax-entry ?\) "." ConTeXt-indent-syntax-table))
+
+(defun ConTeXt-indent-line (&optional arg)
+ (with-syntax-table ConTeXt-indent-syntax-table
+ ;; TODO: Rather than ignore $, we should try to be more clever about it.
+ (let ((indent
+ (save-excursion
+ (beginning-of-line)
+ (ConTeXt-find-indent))))
+ (if (< indent 0) (setq indent 0))
+ (if (<= (current-column) (current-indentation))
+ (indent-line-to indent)
+ (save-excursion (indent-line-to indent))))))
+
+(defun ConTeXt-find-indent (&optional virtual)
+ "Find the proper indentation of text after point.
+VIRTUAL if non-nil indicates that we're only trying to find the
+indentation in order to determine the indentation of something
+else. There might be text before point."
+ (save-excursion
+ (skip-chars-forward " \t")
+ (or
+ ;; Trust the current indentation, if such info is applicable.
+ (and virtual (>= (current-indentation) (current-column))
+ (current-indentation))
+ ;; Put leading close-paren where the matching open brace would be.
+ (condition-case nil
+ (and (eq (char-syntax (char-after)) ?\))
+ (save-excursion
+ (skip-syntax-forward " )")
+ (backward-sexp 1)
+ (ConTeXt-find-indent 'virtual)))
+ (error nil))
+ ;; Default (maybe an argument)
+ (let ((pos (point))
+ (char (char-after))
+ (indent 0)
+ up-list-pos)
+ ;; Look for macros to be outdented
+ (cond ((looking-at (concat (regexp-quote TeX-esc)
+ (ConTeXt-environment-stop-name)))
+ (setq indent (- indent ConTeXt-indent-basic)))
+ ((looking-at ConTeXt-indent-item-re)
+ (setq indent (- indent ConTeXt-indent-item))))
+ ;; Find the previous point which determines our current indentation.
+ (condition-case err
+ (progn
+ (backward-sexp 1)
+ (while (> (current-column) (current-indentation))
+ (backward-sexp 1)))
+ (scan-error
+ (setq up-list-pos (nth 2 err))))
+ (cond
+ ((= (point-min) pos) 0) ; We're really just indenting the first line.
+ ((integerp up-list-pos)
+ ;; Have to indent relative to the open-paren.
+ (goto-char up-list-pos)
+ (if (and (not ConTeXt-indent-allhanging)
+ (> pos (progn (down-list 1)
+ (forward-comment (point-max))
+ (point))))
+ ;; Align with the first element after the open-paren.
+ (current-column)
+ ;; We're the first element after a hanging brace.
+ (goto-char up-list-pos)
+ (+ indent ConTeXt-indent-basic (ConTeXt-find-indent 'virtual))))
+ ;; We're now at the "beginning" of a line.
+ ((not (and (not virtual) (eq (char-after) ?\\)))
+ ;; Nothing particular here: just keep the same indentation.
+ (+ indent (current-column)))
+ ;; We're now looking at an item.
+ ((looking-at ConTeXt-indent-item-re)
+ ;; Indenting relative to an item, have to re-add the outdenting.
+ (+ indent (current-column) ConTeXt-indent-item))
+ ;; We're looking at an environment starter.
+ ((and (looking-at (concat (regexp-quote TeX-esc)
+ (ConTeXt-environment-start-name)))
+ (not (looking-at (concat (regexp-quote TeX-esc)
+ (ConTeXt-environment-start-name)
+ ConTeXt-text)))) ; other environments?
+ (+ indent (current-column) ConTeXt-indent-basic))
+ (t
+ (let ((col (current-column)))
+ (if (not (and char (eq (char-syntax char) ?\()))
+ ;; If the first char was not an open-paren, there's
+ ;; a risk that this is really not an argument to the
+ ;; macro at all.
+ (+ indent col)
+ (forward-sexp 1)
+ (if (< (line-end-position)
+ (save-excursion (forward-comment (point-max))
+ (point)))
+ ;; we're indenting the first argument.
+ (min (current-column) (+ ConTeXt-indent-arg col))
+ (skip-syntax-forward " ")
+ (current-column))))))))))
+
+
+;; XML inside ConTeXt support
+
+(defun ConTeXt-last-unended-start-xml ()
+ "Leave point at the beginning of the last `tag' that is unstopped."
+ (while (and (re-search-backward "<[_A-Za-z][-:._A-Za-z0-9]*\\([
\t\r\n]\\|[_A-Za-z][-:._A-Za-z0-9]*\=\"[^\"]*\"\\)*>\\|</[_A-Za-z][-:_A-Za-z0-9]*>")
+ (looking-at "</[_A-Za-z][-:._A-Za-z0-9]*>"))
+ (ConTeXt-last-unended-start-xml)))
+
+(defun ConTeXt-close-xml-tag ()
+ "Create an </...> to match the last unclosed <...>. Not fool-proof."
+ (interactive "*")
+ (let ((new-line-needed (bolp)) text indentation)
+ (save-excursion
+ (condition-case nil
+ (ConTeXt-last-unended-start-xml)
+ (error (error "Couldn't find unended XML tag")))
+ (setq indentation (current-column))
+ (re-search-forward "<\\([_A-Za-z][-:._A-Za-z0-9]*\\)")
+ (setq text (buffer-substring (match-beginning 1) (match-end 1))))
+ (indent-to indentation)
+ (insert "</" text ">")
+ (if new-line-needed (insert ?\n))))
+
+
+;; Key bindings
+
+(defvar ConTeXt-mode-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map TeX-mode-map)
+
+ (define-key map "\e\C-a" 'ConTeXt-find-matching-start)
+ (define-key map "\e\C-e" 'ConTeXt-find-matching-stop)
+ ;; likely to change in the future
+ (define-key map "\C-c!" 'ConTeXt-work-on-environment)
+ (define-key map "\C-c\C-e" 'ConTeXt-environment)
+ (define-key map "\C-c\n" 'ConTeXt-insert-item)
+ (or (key-binding "\e\r")
+ (define-key map "\e\r" 'ConTeXt-insert-item)) ;*** Alias
+ (define-key map "\C-c]" 'ConTeXt-close-environment)
+ (define-key map "\C-c\C-s" 'ConTeXt-section)
+ ;; XML in ConTeXt support
+ (define-key map "\C-c/" 'ConTeXt-close-xml-tag)
+ map)
+ "Keymap used in `ConTeXt-mode'.")
+
+
+;;; Menu building
+
+;; functions to create menu entries
+
+;; ConTeXt \start... \stop... pairs
+;; (Choose a different name than the one in LaTeX mode. Otherwise the
+;; contents of the "Insert Environment" and "Change Environment" menus
+;; will not be updated correctly upon loading and switching between
+;; LaTeX and ConTeXt files. AFAICS this is due to a bug in
+;; easymenu.el not returning the correct keymap when
+;; `easy-menu-change' (and therefore `easy-menu-get-map') is called.
+;; It just sees an entry with a matching name and returns this first
+;; match.)
+(defvar ConTeXt-environment-menu-name "Insert Environment (C-c C-e)")
+
+(defun ConTeXt-environment-menu-entry (entry)
+ "Create an entry for the environment menu."
+ (vector (car entry) (list 'ConTeXt-environment-menu (car entry)) t))
+
+(defvar ConTeXt-environment-modify-menu-name "Change Environment (C-u C-c
C-e)")
+
+(defun ConTeXt-environment-modify-menu-entry (entry)
+ "Create an entry for the change environment menu."
+ (vector (car entry) (list 'ConTeXt-modify-environment (car entry)) t))
+
+;; ConTeXt define macros
+(defvar ConTeXt-define-menu-name "Define")
+
+(defun ConTeXt-define-menu-entry (entry)
+ "Create an entry for the define menu."
+ (vector entry (list 'ConTeXt-define-menu entry)))
+
+(defun ConTeXt-define-menu (define)
+ "Insert DEFINE from menu."
+ (ConTeXt-insert-define define))
+
+;; ConTeXt setup macros
+(defvar ConTeXt-setup-menu-name "Setup")
+
+(defun ConTeXt-setup-menu-entry (entry)
+ "Create an entry for the setup menu."
+ (vector entry (list 'ConTeXt-setup-menu entry)))
+
+(defun ConTeXt-setup-menu (setup)
+ "Insert SETUP from menu."
+ (ConTeXt-insert-setup setup))
+
+;; ConTeXt referencing macros
+(defvar ConTeXt-referencing-menu-name "Referencing")
+
+(defun ConTeXt-referencing-menu-entry (entry)
+ "Create an entry for the referencing menu."
+ (vector entry (list 'ConTeXt-referencing-menu entry)))
+
+(defun ConTeXt-referencing-menu (referencing)
+ "Insert REFERENCING from menu."
+ (ConTeXt-insert-referencing referencing))
+
+;; ConTeXt other macros
+(defvar ConTeXt-other-macro-menu-name "Other macro")
+
+(defun ConTeXt-other-macro-menu-entry (entry)
+ "Create an entry for the other macro menu."
+ (vector entry (list 'ConTeXt-other-macro-menu entry)))
+
+(defun ConTeXt-other-macro-menu (other-macro)
+ "Insert OTHER MACRO from menu."
+ (ConTeXt-insert-other-macro other-macro))
+
+
+;; meta-structure project structure menu entries
+
+(defvar ConTeXt-project-structure-menu-name "Project Structure")
+
+(defun ConTeXt-project-structure-menu (project-structure)
+ "Insert project structure from menu."
+ (ConTeXt-project-structure
+ (let ((l ConTeXt-project-structure-list))
+ (- (length l) (length (member project-structure l))))))
+
+(defun ConTeXt-project-structure-menu-entry (entry)
+ "Create an ENTRY for the project structure menu."
+ (vector entry (list 'ConTeXt-project-structure-menu entry)))
+
+
+;; meta-structure section blocks menu entries
+
+(defvar ConTeXt-section-block-menu-name "Section Block")
+
+(defun ConTeXt-section-block-menu (section-block)
+ "Insert section block from menu."
+ (ConTeXt-section-block section-block))
+
+(defun ConTeXt-section-block-menu-entry (entry)
+ "Create an ENTRY for the section block menu."
+ (vector entry (list 'ConTeXt-section-block-menu entry)))
+
+
+;; section menu entries
+
+(defvar ConTeXt-section-menu-name "Section (C-c C-s)")
+
+(defun ConTeXt-section-enable-symbol (level)
+ "Symbol used to enable section LEVEL in the menu bar."
+ (intern (concat "ConTeXt-section-" (int-to-string level) "-enable")))
+
+(defun ConTeXt-section-enable (entry)
+ "Enable or disable section ENTRY from `ConTeXt-section-list'."
+ (let ((level (nth 1 entry)))
+ (set (ConTeXt-section-enable-symbol level)
+ (>= level ConTeXt-largest-level))))
+
+(defun ConTeXt-section-menu (level)
+ "Insert section from menu."
+ (let ((ConTeXt-section-hook (delq 'ConTeXt-section-heading
+ (copy-sequence ConTeXt-section-hook))))
+ (ConTeXt-section level)))
+
+(defun ConTeXt-section-menu-entry (entry)
+ "Create an ENTRY for the section menu."
+ (let ((enable (ConTeXt-section-enable-symbol (nth 1 entry))))
+ (set enable t)
+ (vector (car entry) (list 'ConTeXt-section-menu (nth 1 entry)) enable)))
+
+
+;; etexshow support
+
+(defun ConTeXt-etexshow ()
+ "Call etexshow, if available, to show the definition of a ConText macro."
+ (interactive)
+ (if (fboundp 'etexshow)
+ (let ()
+ (require 'etexshow)
+ (funcall (symbol-function 'etexshow-cmd)))
+ (error "etexshow is not installed. Get it from http://levana.de/emacs/";)))
+
+;; menu itself
+
+(easy-menu-define ConTeXt-mode-command-menu
+ ConTeXt-mode-map
+ "Command menu used in ConTeXt mode."
+ (TeX-mode-specific-command-menu 'context-mode))
+
+;; it seems the menu is evaluated at compile/load-time
+;; we don't have ConTeXt-current-interface at that time
+;; so make sure to do updates based on that variable in
+;; ConTeXt-menu-update
+(easy-menu-define ConTeXt-mode-menu
+ ConTeXt-mode-map
+ "Menu used in ConTeXt mode."
+ (TeX-menu-with-help
+ `("ConTeXt"
+ (,ConTeXt-project-structure-menu-name)
+ (,ConTeXt-section-block-menu-name)
+ (,ConTeXt-section-menu-name)
+ ["Add Table of Contents to Emacs Menu" (imenu-add-to-menubar "TOC") t]
+ "-"
+ ["Macro ..." TeX-insert-macro
+ :help "Insert a macro and possibly arguments"]
+ ["Complete" TeX-complete-symbol
+ :help "Complete the current macro or environment name"]
+ ["Show ConTeXt Macro Definition" ConTeXt-etexshow]
+ "-"
+ (,ConTeXt-environment-menu-name)
+ (,ConTeXt-environment-modify-menu-name)
+ ["Item" ConTeXt-insert-item
+ :help "Insert a new \\item into current environment"]
+ (,ConTeXt-define-menu-name)
+ (,ConTeXt-setup-menu-name)
+ (,ConTeXt-other-macro-menu-name)
+ "-"
+ ("Insert Font"
+ ["Emphasize" (TeX-font nil ?\C-e) :keys "C-c C-f C-e"]
+ ["Bold" (TeX-font nil ?\C-b) :keys "C-c C-f C-b"]
+ ["Typewriter" (TeX-font nil ?\C-t) :keys "C-c C-f C-t"]
+ ["Small Caps" (TeX-font nil ?\C-c) :keys "C-c C-f C-c"]
+ ["Sans Serif" (TeX-font nil ?\C-f) :keys "C-c C-f C-f"]
+ ["Italic" (TeX-font nil ?\C-i) :keys "C-c C-f C-i"]
+ ["Slanted" (TeX-font nil ?\C-s) :keys "C-c C-f C-s"]
+ ["Roman" (TeX-font nil ?\C-r) :keys "C-c C-f C-r"]
+ ["Calligraphic" (TeX-font nil ?\C-a) :keys "C-c C-f C-a"])
+ ("Replace Font"
+ ["Emphasize" (TeX-font t ?\C-e) :keys "C-u C-c C-f C-e"]
+ ["Bold" (TeX-font t ?\C-b) :keys "C-u C-c C-f C-b"]
+ ["Typewriter" (TeX-font t ?\C-t) :keys "C-u C-c C-f C-t"]
+ ["Small Caps" (TeX-font t ?\C-c) :keys "C-u C-c C-f C-c"]
+ ["Sans Serif" (TeX-font t ?\C-f) :keys "C-u C-c C-f C-f"]
+ ["Italic" (TeX-font t ?\C-i) :keys "C-u C-c C-f C-i"]
+ ["Slanted" (TeX-font t ?\C-s) :keys "C-u C-c C-f C-s"]
+ ["Roman" (TeX-font t ?\C-r) :keys "C-u C-c C-f C-r"]
+ ["Calligraphic" (TeX-font t ?\C-a) :keys "C-u C-c C-f C-a"])
+ ["Delete Font" (TeX-font t ?\C-d) :keys "C-c C-f C-d"]
+ "-"
+ ["Comment or Uncomment Region"
+ TeX-comment-or-uncomment-region
+ :help "Make the selected region outcommented or active again"]
+ ["Comment or Uncomment Paragraph"
+ TeX-comment-or-uncomment-paragraph
+ :help "Make the current paragraph outcommented or active again"]
+ ,TeX-fold-menu
+ "-" . ,TeX-common-menu-entries)))
+
+(defun ConTeXt-menu-update (&optional menu)
+ "Update entries on AUCTeX menu."
+ (or (not (memq major-mode '(context-mode)))
+ (null ConTeXt-menu-changed)
+ (not (fboundp 'easy-menu-change))
+ (progn
+ (TeX-update-style)
+ (setq ConTeXt-menu-changed nil)
+ (message "Updating section menu...")
+ (mapc 'ConTeXt-section-enable ConTeXt-section-list)
+ (message "Updating environment menu...")
+ (easy-menu-change '("ConTeXt") ConTeXt-environment-menu-name
+ (LaTeX-split-long-menu
+ (mapcar 'ConTeXt-environment-menu-entry
+ (ConTeXt-environment-list))))
+ (message "Updating modify environment menu...")
+ (easy-menu-change '("ConTeXt") ConTeXt-environment-modify-menu-name
+ (LaTeX-split-long-menu
+ (mapcar 'ConTeXt-environment-modify-menu-entry
+ (ConTeXt-environment-list))))
+ (message "Updating define menu...")
+ (easy-menu-change '("ConTeXt") ConTeXt-define-menu-name
+ (LaTeX-split-long-menu
+ (mapcar 'ConTeXt-define-menu-entry
+ ConTeXt-define-list)))
+ (message "Updating setup menu...")
+ (easy-menu-change '("ConTeXt") ConTeXt-setup-menu-name
+ (LaTeX-split-long-menu
+ (mapcar 'ConTeXt-setup-menu-entry
+ ConTeXt-setup-list)))
+ (message "Updating referencing menu...")
+ (easy-menu-change '("ConTeXt") ConTeXt-referencing-menu-name
+ (LaTeX-split-long-menu
+ (mapcar 'ConTeXt-referencing-menu-entry
+ ConTeXt-referencing-list)))
+ (message "Updating other macro's menu...")
+ (easy-menu-change '("ConTeXt") ConTeXt-other-macro-menu-name
+ (LaTeX-split-long-menu
+ (mapcar 'ConTeXt-other-macro-menu-entry
+ ConTeXt-other-macro-list)))
+ (message "Updating project structure menu...")
+ (easy-menu-change '("ConTeXt") ConTeXt-project-structure-menu-name
+ (LaTeX-split-long-menu
+ (mapcar 'ConTeXt-project-structure-menu-entry
+ ConTeXt-project-structure-list)))
+ (message "Updating section block menu...")
+ (easy-menu-change '("ConTeXt") ConTeXt-section-block-menu-name
+ (LaTeX-split-long-menu
+ (mapcar 'ConTeXt-section-block-menu-entry
+ ConTeXt-section-block-list)))
+ (message "Updating section menu...")
+ (easy-menu-change '("ConTeXt") ConTeXt-section-menu-name
+ (LaTeX-split-long-menu
+ (mapcar 'ConTeXt-section-menu-entry
+ ConTeXt-section-list)))
+ (message "Updating...done")
+ (and menu (easy-menu-return-item ConTeXt-mode-menu menu))
+ )))
+
+;;; Option expander
+
+(defvar ConTeXt-texexec-option-nonstop "--nonstop "
+ "Command line option for texexec to use nonstopmode.")
+
+(defun ConTeXt-expand-options ()
+ "Expand options for texexec command."
+ (concat
+ (let ((engine (eval (nth 4 (assq TeX-engine (TeX-engine-alist))))))
+ (when engine
+ (format "--engine=%s " engine)))
+ (unless (eq ConTeXt-current-interface "en")
+ (format "--interface=%s " ConTeXt-current-interface))
+ (when TeX-source-correlate-mode
+ (format "--passon=\"%s\" "
+ (if (eq TeX-source-correlate-method-active 'synctex)
+ TeX-synctex-tex-flags
+ TeX-source-specials-tex-flags)))
+ (unless TeX-interactive-mode
+ ConTeXt-texexec-option-nonstop)))
+
+;;; Mode
+
+;; ConTeXt variables that are interface aware
+;; They are mapped to interface specific variables
+
+(defvar ConTeXt-language-variable-list
+ '(ConTeXt-define-list
+ ConTeXt-setup-list
+ ConTeXt-referencing-list
+ ConTeXt-other-macro-list
+ ConTeXt-project-structure-list
+ ConTeXt-section-block-list
+ ConTeXt-section-list
+ ConTeXt-text
+ ConTeXt-item-list
+ ConTeXt-extra-paragraph-commands))
+
+(defcustom ConTeXt-clean-intermediate-suffixes
+ ;; See *suffixes in texutil.pl.
+ '("\\.tui" "\\.tup" "\\.ted" "\\.tes" "\\.top" "\\.log" "\\.tmp" "\\.run"
+ "\\.bck" "\\.rlg" "\\.mpt" "\\.mpx" "\\.mpd" "\\.mpo" "\\.tuo" "\\.tub"
+ "\\.top" "-mpgraph\\.mp" "-mpgraph\\.mpd" "-mpgraph\\.mpo" "-mpgraph\\.mpy"
+ "-mprun\\.mp" "-mprun\\.mpd" "-mprun\\.mpo" "-mprun\\.mpy")
+ "List of regexps matching suffixes of files to be deleted.
+The regexps will be anchored at the end of the file name to be matched,
+i.e. you do _not_ have to cater for this yourself by adding \\\\' or $."
+ :type '(repeat regexp)
+ :group 'TeX-command)
+
+(defcustom ConTeXt-clean-output-suffixes
+ '("\\.dvi" "\\.pdf" "\\.ps")
+ "List of regexps matching suffixes of files to be deleted.
+The regexps will be anchored at the end of the file name to be matched,
+i.e. you do _not_ have to cater for this yourself by adding \\\\' or $."
+ :type '(repeat regexp)
+ :group 'TeX-command)
+
+(TeX-abbrev-mode-setup context-mode)
+
+(defun ConTeXt-mode-common-initialization ()
+ "Initialization code that is common for all ConTeXt interfaces."
+ ;; `plain-TeX-common-initialization' kills all local variables, but
+ ;; we need to keep ConTeXt-current-interface, so save and restore
+ ;; it.
+ (let (save-ConTeXt-current-interface)
+ (setq save-ConTeXt-current-interface ConTeXt-current-interface)
+ (plain-TeX-common-initialization)
+ (setq ConTeXt-current-interface save-ConTeXt-current-interface))
+ (setq major-mode 'context-mode)
+
+ (setq local-abbrev-table context-mode-abbrev-table)
+
+ ;; Make language specific variables buffer local
+ (dolist (symbol ConTeXt-language-variable-list)
+ (make-variable-buffer-local symbol))
+
+ (require (intern (concat "context-" ConTeXt-current-interface)))
+ (dolist (symbol ConTeXt-language-variable-list)
+ (set symbol (symbol-value (intern (concat (symbol-name symbol) "-"
+ ConTeXt-current-interface)))))
+
+ ;; Create certain regular expressions based on language
+ (setq ConTeXt-indent-item-re (concat "\\\\\\(" (mapconcat 'identity
ConTeXt-item-list "\\|") "\\)\\>"))
+
+ ;; What's the deepest level at we can collapse a document?
+ ;; set only if user has not set it. Need to be set before menu is created.
+ ;; level 2 is "section"
+ (or ConTeXt-largest-level
+ (setq ConTeXt-largest-level 2))
+
+ ;; keybindings
+ (use-local-map ConTeXt-mode-map)
+
+ ;; Indenting
+ (set (make-local-variable 'indent-line-function) 'ConTeXt-indent-line)
+ (set (make-local-variable 'fill-indent-according-to-mode) t)
+
+ ;; Paragraph formatting
+ (set (make-local-variable 'LaTeX-syntactic-comments) nil)
+ (set (make-local-variable 'LaTeX-paragraph-commands-regexp)
+ (ConTeXt-paragraph-commands-regexp))
+ (set (make-local-variable 'paragraph-ignore-fill-prefix) t)
+ (set (make-local-variable 'fill-paragraph-function) 'LaTeX-fill-paragraph)
+ (set (make-local-variable 'adaptive-fill-mode) nil)
+ (setq paragraph-start
+ (concat
+ "[ \t]*\\("
+ (ConTeXt-paragraph-commands-regexp) "\\|"
+ "\\$\\$\\|" ; Plain TeX display math
+ "$\\)"))
+ (setq paragraph-separate
+ (concat
+ "[ \t]*\\("
+ "\\$\\$" ; Plain TeX display math
+ "\\|$\\)"))
+
+ ;; Keybindings and menu
+ (use-local-map ConTeXt-mode-map)
+ (easy-menu-add ConTeXt-mode-menu ConTeXt-mode-map)
+ (easy-menu-add ConTeXt-mode-command-menu ConTeXt-mode-map)
+ (setq ConTeXt-menu-changed t)
+
+ (if (= emacs-major-version 20)
+ (make-local-hook 'activate-menubar-hook))
+ (add-hook 'activate-menubar-hook 'ConTeXt-menu-update nil t)
+
+ ;; Outline support
+ (require 'outline)
+ (set (make-local-variable 'outline-level) 'ConTeXt-outline-level)
+ (set (make-local-variable 'outline-regexp) (ConTeXt-outline-regexp t))
+ ;;(make-local-variable 'outline-heading-end-regexp)
+ (setq TeX-header-end (ConTeXt-header-end)
+ TeX-trailer-start (ConTeXt-trailer-start))
+
+ ;; font switch support
+ (set (make-local-variable 'TeX-font-list) ConTeXt-font-list)
+
+ ;; imenu support
+ (set (make-local-variable 'imenu-create-index-function)
+ 'ConTeXt-imenu-create-index-function)
+
+ ;; run hooks
+ (setq TeX-command-default "ConTeXt")
+ (setq TeX-sentinel-default-function 'TeX-ConTeXt-sentinel)
+ (TeX-run-mode-hooks 'text-mode-hook 'TeX-mode-hook 'ConTeXt-mode-hook))
+
+(defun context-guess-current-interface ()
+ "Guess what ConTeXt interface the current buffer is using."
+ (interactive)
+ (save-excursion
+ (goto-char (point-min))
+ (setq ConTeXt-current-interface
+ (cond ((re-search-forward "%.*?interface=en" (+ 512 (point)) t)
+ "en")
+ ((re-search-forward "%.*?interface=nl" (+ 512 (point)) t)
+ "nl")
+ ((re-search-forward "\\\\starttext" (+ 1024 (point)) t)
+ "en")
+ ((re-search-forward "\\\\starttekst" (+ 1024 (point)) t)
+ "nl")
+ (t
+ ConTeXt-default-interface)))))
+
+;;;###autoload
+(defalias 'ConTeXt-mode 'context-mode)
+
+;;;###autoload
+(defun context-mode ()
+ "Major mode in AUCTeX for editing ConTeXt files.
+
+Special commands:
+\\{ConTeXt-mode-map}
+
+Entering `context-mode' calls the value of `text-mode-hook',
+then the value of `TeX-mode-hook', and then the value
+of context-mode-hook."
+ (interactive)
+ (context-guess-current-interface)
+ (require (intern (concat "context-" ConTeXt-current-interface)))
+ (funcall (intern (concat "context-" ConTeXt-current-interface "-mode"))))
+
+(provide 'context)
+
+;;; context.el ends here
diff --git a/tests/auctex-11.87.7/font-latex.el
b/tests/auctex-11.87.7/font-latex.el
new file mode 100644
index 0000000..96a4823
--- /dev/null
+++ b/tests/auctex-11.87.7/font-latex.el
@@ -0,0 +1,1986 @@
+;;; font-latex.el --- LaTeX fontification for Font Lock mode.
+
+;; Copyright (C) 1996-2014 Free Software Foundation, Inc.
+
+;; Authors: Peter S. Galbraith <psg@debian.org>
+;; Simon Marshall <Simon.Marshall@esrin.esa.it>
+;; Maintainer: auctex-devel@gnu.org
+;; Created: 06 July 1996
+;; Keywords: tex, wp, faces
+
+;;; This file is not part of GNU Emacs.
+
+;; This package 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 package 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 St, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Commentary:
+;;
+;; This package enhances font-lock fontification patterns for LaTeX.
+;; font-lock mode is a minor mode that causes your comments to be
+;; displayed in one face, strings in another, reserved words in
+;; another, and so on.
+;;
+;; ** Infinite loops !? **
+;; If you get an infinite loop, send a bug report!
+;; Then set the following in your ~/.emacs file to keep on working:
+;; (setq font-latex-do-multi-line nil)
+
+;;; Code:
+
+(require 'font-lock)
+(require 'tex)
+
+(eval-when-compile
+ (require 'cl))
+
+(defgroup font-latex nil
+ "Font-latex text highlighting package."
+ :prefix "font-latex-"
+ :group 'faces
+ :group 'tex
+ :group 'AUCTeX)
+
+(defgroup font-latex-keywords nil
+ "Keywords for highlighting text in font-latex."
+ :prefix "font-latex-"
+ :group 'font-latex)
+
+(defgroup font-latex-highlighting-faces nil
+ "Faces for highlighting text in font-latex."
+ :prefix "font-latex-"
+ :group 'font-latex)
+
+(defvar font-latex-multiline-boundary 5000
+ "Size of region to search for the start or end of a multiline construct.")
+
+(defvar font-latex-quote-regexp-beg nil
+ "Regexp used to find quotes.")
+(make-variable-buffer-local 'font-latex-quote-regexp-beg)
+
+(defvar font-latex-quote-list '(("``" "''") ("<<" ">>" french) ("�" "�"
french))
+ "List of quote specifiers for quotation fontification.
+
+Each element of the list is either a list consisting of two
+strings to be used as opening and closing quotation marks
+independently of the value of `font-latex-quotes' or a list with
+three elements where the first and second element are strings for
+opening and closing quotation marks and the third element being
+either the symbol 'german or 'french describing the order of
+quotes.
+
+If `font-latex-quotes' specifies a different state, order of the
+added quotes will be reversed for fontification. For example if
+'(\"\\\"<\" \"\\\">\" french) is given but `font-latex-quotes'
+specifies 'german, quotes will be used like \">foo\"< for
+fontification.")
+
+(defvar font-latex-quotes-control nil
+ "Internal variable for keeping track if `font-latex-quotes' changed.")
+(make-variable-buffer-local 'font-latex-quotes-control)
+
+(defvar font-latex-quotes-internal nil
+ "Internal variable for tracking outcome of automatic detection.
+If automatic detection is not enabled, it is assigned the value
+of `font-latex-quotes'.")
+(make-variable-buffer-local 'font-latex-quotes-internal)
+
+(defvar font-latex-quotes-fallback 'french
+ "Fallback value for `font-latex-quotes' if automatic detection fails.")
+
+(defvar font-latex-quote-style-list-french
+ '("french" "frenchb" "frenchle" "frenchpro" "francais" "canadien"
+ "acadian" "italian")
+ "List of styles for which French-style quote matching should be activated.")
+
+(defvar font-latex-quote-style-list-german
+ '("austrian" "german" "germanb" "naustrian" "ngerman")
+ "List of styles for which German-style quote matching should be activated.")
+
+(defcustom font-latex-quotes 'auto
+ "Whether to fontify << French quotes >> or >>German quotes<<.
+Also selects \"<quote\"> versus \">quote\"<.
+
+If value `auto' is chosen, an attempt is being made in deriving
+the type of quotation mark matching from document settings like
+the language option supplied to the babel package.
+
+If nil, quoted content will not be fontified."
+ :type '(choice (const auto) (const french) (const german) (const nil))
+ :group 'font-latex)
+(put 'font-latex-quotes 'safe-local-variable
+ '(lambda (x) (memq x '(auto french german nil))))
+
+(defun font-latex-add-quotes (quotes)
+ "Add QUOTES to `font-latex-quote-list'.
+QUOTES has to be a list adhering to the format of an element of
+`font-latex-quote-list'."
+ (setq font-latex-quotes-control nil)
+ (make-local-variable 'font-latex-quote-list)
+ (add-to-list 'font-latex-quote-list quotes))
+
+(defun font-latex-quotes-set-internal ()
+ "Set `font-latex-quotes-internal' according to `font-latex-quotes'.
+If `font-latex-quotes' is set to `auto', try to derive the
+correct value from document properties."
+ (setq font-latex-quotes-internal
+ (if (eq font-latex-quotes 'auto)
+ (or (when (TeX-elt-of-list-member
+ font-latex-quote-style-list-french TeX-active-styles)
+ 'french)
+ (when (TeX-elt-of-list-member
+ font-latex-quote-style-list-german TeX-active-styles)
+ 'german)
+ font-latex-quotes-fallback)
+ font-latex-quotes)))
+;; Update the value of `font-latex-quotes-internal' when the list of
+;; styles changes.
+(add-hook 'TeX-update-style-hook 'font-latex-quotes-set-internal)
+
+;; The definitions of the title faces were originally taken from
+;; info.el (Copyright (C) 1985, 86, 92, 93, 94, 95, 96, 97, 98, 99,
+;; 2000, 2001 Free Software Foundation, Inc.) and adapted to the needs
+;; of font-latex.el.
+
+(defconst font-latex-sectioning-max 5
+ "Highest number for font-latex-sectioning-N-face")
+(defface font-latex-sectioning-5-face
+ (if (featurep 'xemacs)
+ '((((type tty pc) (class color) (background light))
+ (:foreground "blue4" :bold t))
+ (((type tty pc) (class color) (background dark))
+ (:foreground "yellow" :bold t))
+ (((class color) (background light))
+ (:bold t :foreground "blue4" :family "helvetica"))
+ (((class color) (background dark))
+ (:bold t :foreground "yellow" :family "helvetica"))
+ (t (:bold t :family "helvetica")))
+ '((((type tty pc) (class color) (background light))
+ (:foreground "blue4" :weight bold))
+ (((type tty pc) (class color) (background dark))
+ (:foreground "yellow" :weight bold))
+ (((class color) (background light))
+ (:weight bold :inherit variable-pitch :foreground "blue4"))
+ (((class color) (background dark))
+ (:weight bold :inherit variable-pitch :foreground "yellow"))
+ (t (:weight bold :inherit variable-pitch))))
+ "Face for sectioning commands at level 5."
+ :group 'font-latex-highlighting-faces)
+
+(defun font-latex-update-sectioning-faces (&optional max height-scale)
+ "Update sectioning commands faces."
+ (unless height-scale
+ (setq height-scale (if (numberp font-latex-fontify-sectioning)
+ font-latex-fontify-sectioning
+ 1.1)))
+ (unless max
+ (setq max font-latex-sectioning-max))
+ (dotimes (num max)
+ (let* (;; reverse for XEmacs:
+ (num (- max (1+ num)))
+ (face-name (intern (format "font-latex-sectioning-%s-face" num))))
+ (unless (get face-name 'saved-face) ; Do not touch customized faces.
+ (if (featurep 'xemacs)
+ (let ((size
+ ;; Multiply with .9 because `face-height' returns a value
+ ;; slightly larger than the actual font size.
+ ;; `make-face-size' takes numeric points according to Aidan
+ ;; Kehoe in <16989.15536.613916.678965@parhasard.net> (not
+ ;; documented).
+ (round (* 0.9
+ (face-height 'default)
+ (expt height-scale (- max 1 num))))))
+ ;; (message "%s - %s" face-name size)
+ (make-face-size face-name size))
+ (set-face-attribute face-name nil :height height-scale))))))
+
+(defcustom font-latex-fontify-sectioning 1.1
+ "Whether to fontify sectioning macros with varying height or a color face.
+
+If it is a number, use varying height faces. The number is used
+for scaling starting from `font-latex-sectioning-5-face'. Typically
+values from 1.05 to 1.3 give best results, depending on your font
+setup. If it is the symbol `color', use `font-lock-type-face'.
+
+Caveats: Customizing the scaling factor applies to all sectioning
+faces unless those face have been saved by customize. Setting
+this variable directly does not take effect unless you call
+`font-latex-update-sectioning-faces' or restart Emacs.
+
+Switching from `color' to a number or vice versa does not take
+effect unless you call \\[font-lock-fontify-buffer] or restart
+Emacs."
+ ;; Possibly add some words about XEmacs here. :-(
+ :type '(choice (number :tag "Scale factor")
+ (const color))
+ :initialize 'custom-initialize-default
+ :set (lambda (symbol value)
+ (set-default symbol value)
+ (unless (eq value 'color)
+ (font-latex-update-sectioning-faces font-latex-sectioning-max
value)))
+ :group 'font-latex)
+
+(defun font-latex-make-sectioning-faces (max &optional height-scale)
+ "Build the faces used to fontify sectioning commands."
+ (unless max (setq max font-latex-sectioning-max))
+ (unless height-scale
+ (setq height-scale (if (numberp font-latex-fontify-sectioning)
+ font-latex-fontify-sectioning
+ 1.1)))
+ (dotimes (num max)
+ (let* (;; reverse for XEmacs:
+ (num (- max (1+ num)))
+ (face-name (intern (format "font-latex-sectioning-%s-face" num)))
+ (f-inherit (intern (format "font-latex-sectioning-%s-face" (1+
num))))
+ (size (when (featurep 'xemacs)
+ (round (* 0.9 (face-height 'default)
+ (expt height-scale (- max 1 num)))))))
+ (eval
+ `(defface ,face-name
+ (if (featurep 'xemacs)
+ '((t (:size ,(format "%spt" size))))
+ '((t (:height ,height-scale :inherit ,f-inherit))))
+ (format "Face for sectioning commands at level %s.
+
+Probably you don't want to customize this face directly. Better
+change the base face `font-latex-sectioning-5-face' or customize the
+variable `font-latex-fontify-sectioning'." ',num)
+ :group 'font-latex-highlighting-faces))
+ (when (and (featurep 'xemacs)
+ ;; Do not touch customized faces.
+ (not (get face-name 'saved-face)))
+ (set-face-parent face-name f-inherit)
+ ;; Explicitely set the size again to code around the bug that
+ ;; `set-face-parent' overwrites the original face size.
+ (make-face-size face-name size)))))
+
+(font-latex-make-sectioning-faces font-latex-sectioning-max)
+
+
+;;; Keywords
+
+(defvar font-latex-keywords-1 nil
+ "Subdued level highlighting for LaTeX modes.")
+
+(defvar font-latex-keywords-2 nil
+ "High level highlighting for LaTeX modes.")
+
+(defvar font-latex-built-in-keyword-classes
+ '(("warning"
+ ("nopagebreak" "pagebreak" "newpage" "clearpage" "cleardoublepage"
+ "enlargethispage" "nolinebreak" "linebreak" "newline" "-" "\\" "\\*"
+ "appendix" "displaybreak" "allowdisplaybreaks" "include")
+ 'font-latex-warning-face 1 noarg)
+ ("variable"
+ (("setlength" "|{\\{") ("settowidth" "|{\\{") ("settoheight" "{{")
+ ("settodepth" "{{") ("setcounter" "{|{\\")
+ ("addtolength" "|{\\{") ("addtocounter" "{|{\\")
+ ("stepcounter" "{") ("refstepcounter" "{")
+ ("arabic" "{") ("roman" "{") ("Roman" "{") ("alph" "{") ("Alph" "{")
+ ("fnsymbol" "{"))
+ 'font-lock-variable-name-face 2 command)
+ ("biblatexnoarg"
+ ("newrefsegment" "mancite" "pno" "ppno" "nopp" "psq" "psqq")
+ 'font-lock-variable-name-face 2 noarg)
+ ("biblatex"
+ (("newrefsection" "[") ("ExecuteBibliographyOptions" "[{")
+ ("printbibliography" "[") ("printshorthands" "[") ("printbibheading" "[")
+ ("addbibresource" "[{") ("addglobalbib" "[{") ("addsectionbib" "[{")
+ ("bibbysection" "[") ("bibbysegment" "[") ("bibbycategory" "[")
+ ("DeclareBibliographyCategory" "{") ("addtocategory" "{{")
("defbibenvironment" "{{{{")
+ ("defbibheading" "{[{") ("defbibnote" "{{") ("defbibfilter" "{{")
("defbibcheck" "{{")
+ ("defbibentryset" "{{") ("Cite" "[[{") ("parencite" "*[[{") ("Parencite"
"[[{")
+ ("footcite" "[[{") ("footcitetext" "[[{") ("textcite" "[[{") ("Textcite"
"[[{")
+ ("smartcite" "[[{") ("Smartcite" "[[{") ("supercite" "{") ("autocite"
"*[[{")
+ ("Autocite" "*[[{") ("citeauthor" "[[{") ("Citeauthor" "[[{")
("citetitle" "*[[{")
+ ("citeyear" "*[[{") ("citedate" "*[[{") ("citeurl" "[[{") ("parentext"
"{")
+ ("brackettext" "{") ("fullcite" "[[{") ("fullfootcite" "[[{") ("volcite"
"[{[[")
+ ("Volcite" "[{[[") ("pvolcite" "[{[[") ("Pvolcite" "[{[[") ("fvolcite"
"[{[[")
+ ("ftvolcite" "[{[[") ("svolcite" "[{[[") ("Svolcite" "[{[[") ("tvolcite"
"[{[[")
+ ("Tvolcite" "[{[[") ("avolcite" "[{[[") ("Avolcite" "[{[[") ("notecite"
"[[{")
+ ("Notecite" "[[{") ("pnotecite" "[[{") ("Pnotecite" "[[{") ("fnotecite"
"[[{")
+ ("citename" "[[{[{") ("citelist" "[[{[{") ("citefield" "[[{[{")
("citereset" "*")
+ ("RN" "{") ("Rn" "{") ("DefineBibliographyStrings" "{{")
("DefineBibliographyExtras" "{{")
+ ("UndefineBibliographyExtras" "{{") ("DefineHyphenationExceptions" "{{")
+ ("NewBibliographyString" "{") ("autocites" "(([[{") ("Autocites" "(([[{")
+ ("cites" "(([[{") ("Cites" "(([[{") ("parencites" "(([[{") ("Parencites"
"(([[{")
+ ("footcites" "(([[{") ("footcitetexts" "(([[{") ("smartcites" "(([[{")
+ ("Smartcites" "(([[{") ("textcites" "(([[{") ("Textcites" "(([[{")
("supercites" "(([[{"))
+ 'font-lock-constant-face 2 command)
+ ("reference"
+ (("nocite" "*{") ("cite" "*[[{") ("label" "{") ("pageref" "{")
+ ("vref" "{") ("eqref" "{") ("ref" "{") ("include" "{")
+ ("input" "{") ("bibliography" "{") ("index" "{") ("glossary" "{")
+ ("footnote" "[{") ("footnotemark" "[") ("footnotetext" "[{"))
+ 'font-lock-constant-face 2 command)
+ ("function"
+ (("begin" "{") ("end" "{") ("pagenumbering" "{")
+ ("thispagestyle" "{") ("pagestyle" "{") ("nofiles" "")
+ ("includeonly" "{") ("bibliographystyle" "{") ("documentstyle" "[{")
+ ("documentclass" "[{[") ("newenvironment" "*{[[{{")
+ ("newcommand" "*|{\\[[{") ("newlength" "|{\\")
+ ("newtheorem" "{[{[")
+ ("providecommand" "*|{\\[[{")
+ ("newcounter" "{[") ("renewenvironment" "*{[[{{")
+ ("renewcommand" "*|{\\[[{") ("renewtheorem" "{[{[")
+ ("usepackage" "[{[") ("fbox" "{") ("mbox" "{") ("rule" "[{{")
+ ("vspace" "*{") ("hspace" "*{") ("thinspace" "") ("negthinspace" "")
+ ;; XXX: Should macros without arguments rather be listed in a
+ ;; separate category with 'noarg instead of 'command handling?
+ ("enspace" "") ("enskip" "") ("quad" "") ("qquad" "") ("nonumber" "")
+ ("centering" "") ("TeX" "") ("LaTeX" ""))
+ 'font-lock-function-name-face 2 command)
+ ("sectioning-0"
+ (("part" "*[{"))
+ (if (eq font-latex-fontify-sectioning 'color)
+ 'font-lock-type-face
+ 'font-latex-sectioning-0-face)
+ 2 command)
+ ("sectioning-1"
+ (("chapter" "*[{"))
+ (if (eq font-latex-fontify-sectioning 'color)
+ 'font-lock-type-face
+ 'font-latex-sectioning-1-face)
+ 2 command)
+ ("sectioning-2"
+ (("section" "*[{"))
+ (if (eq font-latex-fontify-sectioning 'color)
+ 'font-lock-type-face
+ 'font-latex-sectioning-2-face)
+ 2 command)
+ ("sectioning-3"
+ (("subsection" "*[{"))
+ (if (eq font-latex-fontify-sectioning 'color)
+ 'font-lock-type-face
+ 'font-latex-sectioning-3-face)
+ 2 command)
+ ("sectioning-4"
+ (("subsubsection" "*[{"))
+ (if (eq font-latex-fontify-sectioning 'color)
+ 'font-lock-type-face
+ 'font-latex-sectioning-4-face)
+ 2 command)
+ ("sectioning-5"
+ (("paragraph" "*[{") ("subparagraph" "*[{")
+ ("subsubparagraph" "*[{"))
+ (if (eq font-latex-fontify-sectioning 'color)
+ 'font-lock-type-face
+ 'font-latex-sectioning-5-face)
+ 2 command)
+ ("slide-title" () 'font-latex-slide-title-face 2 command)
+ ("textual"
+ (("item" "[") ("title" "{") ("author" "{") ("date" "{")
+ ("thanks" "{") ("address" "{") ("caption" "[{")
+ ("textsuperscript" "{"))
+ 'font-lock-type-face 2 command)
+ ("bold-command"
+ (("textbf" "{") ("textsc" "{") ("textup" "{") ("boldsymbol" "{")
+ ("pmb" "{"))
+ 'font-latex-bold-face 1 command)
+ ("italic-command"
+ (("emph" "{") ("textit" "{") ("textsl" "{"))
+ 'font-latex-italic-face 1 command)
+ ("math-command"
+ (("ensuremath" "|{\\"))
+ 'font-latex-math-face 1 command)
+ ("type-command"
+ (("texttt" "{") ("textsf" "{") ("textrm" "{") ("textmd" "{"))
+ 'font-lock-type-face 1 command)
+ ("bold-declaration"
+ ("bf" "bfseries" "sc" "scshape" "upshape")
+ 'font-latex-bold-face 1 declaration)
+ ("italic-declaration"
+ ("em" "it" "itshape" "sl" "slshape")
+ 'font-latex-italic-face 1 declaration)
+ ("type-declaration"
+ ("tt" "ttfamily" "sf" "sffamily" "rm" "rmfamily" "mdseries"
+ "tiny" "scriptsize" "footnotesize" "small" "normalsize"
+ "large" "Large" "LARGE" "huge" "Huge")
+ 'font-lock-type-face 1 declaration))
+ "Built-in keywords and specifications for font locking.
+
+The first element of each item is the name of the keyword class.
+
+The second element is a list of keywords (macros without an
+escape character) to highlight or, if the fifth element is the
+symbol 'command, a list of lists where the first element of each
+item is a keyword and the second a string specifying the macro
+syntax. It can contain \"*\" if the macro has a starred variant,
+\"[\" for an optional argument, \"{\" for a mandatory argument,
+and \"\\\" for a macro. A \"|\" means the following two tokens
+should be regarded as alternatives.
+
+The third element is the symbol of a face to be used or a Lisp
+form returning a face symbol.
+
+The fourth element is the fontification level.
+
+The fifth element is the type of construct to be matched. It can
+be one of 'noarg which will match simple macros without
+arguments (like \"\\foo\"), 'declaration which will match macros
+inside a TeX group (like \"{\\bfseries foo}\"), or 'command which
+will match macros of the form \"\\foo[bar]{baz}\".")
+
+(defcustom font-latex-deactivated-keyword-classes nil
+ "List of strings for built-in keyword classes to be deactivated.
+
+Valid entries are \"warning\", \"variable\", \"reference\",
+\"function\" , \"sectioning-0\", \"sectioning-1\", \"sectioning-2\",
+\"sectioning-3\", \"sectioning-4\", \"sectioning-5\", \"textual\",
+\"bold-command\", \"italic-command\", \"math-command\", \"type-command\",
+\"bold-declaration\", \"italic-declaration\", \"type-declaration\".
+
+You have to restart Emacs for a change of this variable to take effect."
+ :group 'font-latex-keywords
+ :type `(set ,@(mapcar
+ (lambda (spec)
+ `(const :tag ,(concat
+ ;; Name of the keyword class
+ (let ((name (split-string (car spec) "-")))
+ (setcar name (capitalize (car name)))
+ (mapconcat 'identity name " "))
+ " keywords in `"
+ ;; Name of the face
+ (symbol-name (eval (nth 2 spec))) "'.\n"
+ ;; List of keywords
+ (with-temp-buffer
+ (insert " Keywords: "
+ (mapconcat (lambda (x)
+ (if (listp x)
+ (car x)
+ x))
+ (nth 1 spec) ", "))
+ (fill-paragraph nil)
+ (buffer-substring-no-properties
+ (point-min) (point-max))))
+ ,(car spec)))
+ font-latex-built-in-keyword-classes)))
+
+(defun font-latex-make-match-defun (prefix name face type)
+ "Return a function definition for keyword matching.
+The variable holding the keywords to match are determined by the
+strings PREFIX and NAME. The type of matcher is determined by
+the symbol TYPE.
+
+This is a helper function for `font-latex-make-built-in-keywords'
+and `font-latex-make-user-keywords' and not intended for general
+use."
+ ;; Note: The functions are byte-compiled at the end of font-latex.el.
+ ;; FIXME: Is the cond-clause possible inside of the defun?
+
+ ;; In an earlier version of font-latex the type could be a list like
+ ;; (command 1). This indicated a macro with one argument. Provide
+ ;; a match function in this case but don't actually support it.
+ (cond ((or (eq type 'command) (listp type))
+ (eval `(defun ,(intern (concat prefix name)) (limit)
+ ,(concat "Fontify `" prefix name "' up to LIMIT.
+
+Generated by `font-latex-make-match-defun'.")
+ (when ,(intern (concat prefix name))
+ (font-latex-match-command-with-arguments
+ ,(intern (concat prefix name))
+ (append
+ (when (boundp ',(intern (concat prefix name
+ "-keywords-local")))
+ ,(intern (concat prefix name "-keywords-local")))
+ ,(intern (concat prefix name "-keywords")))
+ ;; `face' can be a face symbol, a form returning
+ ;; a face symbol, or a list of face attributes.
+ (if (and (listp ,face) (functionp (car ,face)))
+ (eval ,face)
+ ,face)
+ limit)))))
+ ((eq type 'declaration)
+ (eval `(defun ,(intern (concat prefix name)) (limit)
+ ,(concat "Fontify `" prefix name "' up to LIMIT.
+
+Generated by `font-latex-make-match-defun'.")
+ (when ,(intern (concat prefix name))
+ (font-latex-match-command-in-braces
+ ,(intern (concat prefix name)) limit)))))
+ ((eq type 'noarg)
+ (eval `(defun ,(intern (concat prefix name)) (limit)
+ ,(concat "Fontify `" prefix name "' up to LIMIT.
+
+Generated by `font-latex-make-match-defun'.")
+ (when ,(intern (concat prefix name))
+ (re-search-forward
+ ,(intern (concat prefix name)) limit t)))))))
+
+(defun font-latex-keyword-matcher (prefix name face type)
+ "Return a matcher and highlighter as required by `font-lock-keywords'.
+PREFIX and NAME are strings which are concatenated to form the
+respective match function. FACE is a face name or a list of text
+properties that will be applied to the respective part of the
+match returned by the match function. TYPE is the type of
+construct to be highlighted. Currently the symbols 'command,
+'sectioning, 'declaration and 'noarg are valid.
+
+This is a helper function for `font-latex-make-built-in-keywords'
+and `font-latex-make-user-keywords' and not intended for general
+use."
+ ;; In an earlier version of font-latex the type could be a list like
+ ;; (command 1). This indicated a macro with one argument. Provide
+ ;; a matcher in this case but don't actually support it.
+ (cond ((or (eq type 'command) (listp type))
+ `(,(intern (concat prefix name))
+ (0 (font-latex-matched-face 0) append t)
+ (1 (font-latex-matched-face 1) append t)
+ (2 (font-latex-matched-face 2) append t)
+ (3 (font-latex-matched-face 3) append t)
+ (4 (font-latex-matched-face 4) append t)
+ (5 (font-latex-matched-face 5) append t)
+ (6 (font-latex-matched-face 6) append t)
+ (7 (font-latex-matched-face 7) append t)))
+ ((eq type 'noarg)
+ `(,(intern (concat prefix name))
+ ;; Quote a list of face properties but do not to quote a face symbol.
+ (0 ,(if (and (listp face) (not (fboundp (car face))))
+ `',face
+ face))))
+ ((eq type 'declaration)
+ `(,(intern (concat prefix name))
+ (0 'font-latex-warning-face t t)
+ (1 'font-lock-keyword-face append t)
+ (2 ,face append t)))))
+
+(defun font-latex-make-built-in-keywords ()
+ "Build defuns, defvars and defcustoms for built-in keyword fontification."
+ (dolist (item font-latex-built-in-keyword-classes)
+ (let ((prefix "font-latex-match-")
+ (name (nth 0 item))
+ (keywords (nth 1 item))
+ (face (nth 2 item))
+ (level (nth 3 item))
+ (type (nth 4 item)))
+
+ ;; defvar font-latex-match-*-keywords-local
+ (eval `(defvar ,(intern (concat prefix name "-keywords-local"))
+ ',keywords
+ ,(concat "Buffer-local keywords to add to `"
+ prefix name "-keywords'.
+
+This must be a list where each element is a list consisting of a
+keyword string \(not a regular expression\) omitting the leading
+backslash and a format specifier as. The options for the format
+specifier are described in the doc string of
+`font-latex-user-keyword-classes'.
+
+This is an internal variable which should not be set directly.
+Use `font-latex-add-keywords' instead.
+
+Generated by `font-latex-make-built-in-keywords'.")))
+ (make-variable-buffer-local
+ (intern (concat prefix name "-keywords-local")))
+
+ ;; defun font-latex-match-*-make
+ ;; Note: The functions are byte-compiled at the end of font-latex.el.
+ (eval `(defun ,(intern (concat prefix name "-make")) ()
+ ,(concat "Make or remake the variable `" prefix name "'.
+
+Generated by `font-latex-make-built-in-keywords'.")
+ (let ((keywords
+ (append
+ (unless (member ,name
+ font-latex-deactivated-keyword-classes)
+ ,(intern (concat prefix name "-keywords-local")))
+ ,(intern (concat prefix name "-keywords"))))
+ multi-char-macros single-char-macros)
+ (dolist (elt keywords)
+ (let ((keyword (if (listp elt) (car elt) elt)))
+ (if (string-match "^[A-Za-z]" keyword)
+ (push keyword multi-char-macros)
+ (push keyword single-char-macros))))
+ (when (or multi-char-macros single-char-macros)
+ (setq ,(intern (concat prefix name))
+ (concat
+ "\\\\\\("
+ (when multi-char-macros
+ (concat
+ "\\(?:" (regexp-opt multi-char-macros) "\\)\\>"))
+ (when single-char-macros
+ (concat
+ (when multi-char-macros "\\|")
+ "\\(?:" (regexp-opt single-char-macros) "\\)"))
+ "\\)"))))))
+
+ ;; defcustom font-latex-match-*-keywords
+ (eval `(defcustom ,(intern (concat prefix name "-keywords")) nil
+ ,(concat "List of keywords "
+ (when (eq type 'command) "and formats ")
+ "for " name " face.\n"
+ (if (eq type 'command)
+ "\
+Each element has to be a list consisting of the name of a macro
+omitting the leading backslash and a format specifier as
+described in the doc string of `font-latex-user-keyword-classes'."
+ "\
+Each element has to be the name of a macro as a string, omitting
+the leading backslash.")
+ "\n\n\
+Setting this variable directly does not take effect; restart
+Emacs.
+
+Generated by `font-latex-make-built-in-keywords'.")
+ :type '(repeat (string :tag "Keyword"))
+ :type '(repeat ,(if (eq type 'command)
+ '(list (string :tag "Keyword")
+ (string :tag "Format"))
+ '(string :tag "Keyword")))
+ :set (lambda (symbol value)
+ (set-default symbol value)
+ (funcall ',(intern (concat prefix name "-make"))))
+ :group 'font-latex-keywords))
+
+ ;; defvar font-latex-match-*
+ (eval `(defvar ,(intern (concat prefix name))
+ ,(intern (concat prefix name "-keywords"))))
+ (make-variable-buffer-local (intern (concat prefix name)))
+
+ ;; defun font-latex-match-*
+ (font-latex-make-match-defun prefix name face type)
+
+ ;; Add matchers and highlighters to `font-latex-keywords-{1,2}'.
+ (let ((keywords-entry (font-latex-keyword-matcher
+ prefix name face type)))
+ (add-to-list (intern (concat "font-latex-keywords-"
+ (number-to-string level)))
+ keywords-entry t)
+ (when (= level 1)
+ (add-to-list (intern (concat "font-latex-keywords-2"))
+ keywords-entry t))))))
+(font-latex-make-built-in-keywords)
+
+(defcustom font-latex-user-keyword-classes nil
+ "List of user-defined keyword classes for font locking.
+
+Every keyword class consists of four parts, a name, a list of
+keywords, a face and a specifier for the type of macro to be
+highlighted.
+
+When adding new entries, you have to use unique values for the
+class names, i.e. they must not clash with names of the built-in
+keyword classes or other names given by you. Additionally the
+names must not contain spaces.
+
+The list of keywords defines which commands and declarations
+should be covered by the keyword class. A keyword can either be
+a simple command name omitting the leading backslash or a list
+consisting of the command name and a string specifying the syntax
+of the command. The latter is useful if you want to match LaTeX
+macros with arguments (see below). You can specify the occurence
+and order of optional (\"[\") and mandatory (\"{\") arguments for
+each keyword. For example for \"documentclass\" you'd use \"[{\"
+because the macro has one optional followed by one mandatory
+argument. Optionally starred macros can be indicated with \"*\".
+In case an argument is an unbraced macro, use \"\\\". You can
+also specify two alternative arguments by prefixing them with
+\"|\". As an example, the specifier for \\newcommand is
+\"*|{\\=\\[[{\".
+
+The face argument can either be an existing face or a font
+specification. (The latter option is not available in XEmacs.)
+
+There are three alternatives for the class type:
+
+A value of `command' indicates commands with arguments
+\(\"\\foo[bar]{baz}\"). The mandatory arguments in curly braces
+will get the face you specified.
+
+A value of `declaration' indicates declarations inside of TeX
+groups (\"{\\foo bar}\"). The content inside the braces,
+excluding the command, will get the face you specified. In case
+the braces are missing, the face will be applied to the command
+itself.
+
+A value of `noarg' indicates commands without arguments
+\(\"\\foo\"). The command itself will get the face you
+specified.
+
+Setting this variable directly does not take effect;
+use \\[customize] or restart Emacs."
+ :group 'font-latex-keywords
+ :type `(repeat (list (string :tag "Name")
+ (choice (repeat :tag "Keywords" (string :tag "Keyword"))
+ (repeat
+ :tag "Keywords with specs"
+ (group (string :tag "Keyword")
+ (string :tag "Format specifier"))))
+ ,(if (featurep 'xemacs)
+ '(face :tag "Face name")
+ '(choice (custom-face-edit :tag "Face attributes")
+ (face :tag "Face name")))
+ (choice :tag "Type"
+ ;; Maps to
+ ;;`font-latex-match-command-with-arguments'
+ (const :tag "Command with arguments"
+ command)
+ ;; Maps to
+ ;;`font-latex-match-command-in-braces'
+ (const :tag "Declaration inside TeX group"
+ declaration)
+ ;; Maps to `re-search-forward'
+ (const :tag "Command without arguments"
+ noarg))))
+ :set (lambda (symbol value)
+ (dolist (item value)
+ (when (string-match " " (car item))
+ (error "No spaces allowed in name")))
+ (let (names names-uniq)
+ (dolist (item (append font-latex-built-in-keyword-classes value))
+ (setq names (append names (list (car item)))))
+ (setq names (TeX-sort-strings names))
+ (setq names-uniq (TeX-delete-duplicate-strings names))
+ (dotimes (i (safe-length names-uniq))
+ (unless (string= (nth i names) (nth i names-uniq))
+ (error "Name %S already exists" (nth i names)))))
+ (set-default symbol value)
+ (let ((prefix "font-latex-match-"))
+ (dolist (elt value)
+ (unless (boundp (intern (concat prefix (car elt))))
+ ;; defvar font-latex-match-*
+ (eval `(defvar ,(intern (concat prefix (car elt))) nil)))
+ (let ((keywords (nth 1 elt))
+ single-char-macro-flag)
+ (setq keywords (if (listp (car keywords))
+ (mapcar 'car keywords)
+ keywords))
+ (catch 'single-char
+ (dolist (keyword keywords)
+ (unless (string-match "^[A-Za-z]" keyword)
+ (setq single-char-macro-flag t)
+ (throw 'single-char nil))))
+ (set (intern (concat prefix (car elt)))
+ (when (> (safe-length keywords) 0)
+ (concat "\\\\" (let ((max-specpdl-size 1000))
+ (regexp-opt keywords t))
+ (unless single-char-macro-flag "\\>")))))))))
+
+(defun font-latex-make-user-keywords ()
+ "Build defuns and defvars for user keyword fontification."
+ (let ((keyword-specs font-latex-user-keyword-classes))
+ (dolist (item keyword-specs)
+ (let ((prefix "font-latex-match-")
+ (name (nth 0 item))
+ (keywords (nth 1 item))
+ (face (nth 2 item))
+ (type (nth 3 item)))
+
+ ;; defvar font-latex-match-*-keywords
+ (eval `(defvar ,(intern (concat prefix name "-keywords")) ',keywords
+ ,(concat "Font-latex keywords for " name " face.
+
+Generated by `font-latex-make-user-keywords'.")))
+
+ ;; defun font-latex-match-*
+ (eval `(font-latex-make-match-defun prefix name '',face type))
+
+ ;; Add the matcher to `font-latex-keywords-2'.
+ (add-to-list 'font-latex-keywords-2
+ (font-latex-keyword-matcher prefix name face type) t))))
+
+ ;; Add the "fixed" matchers and highlighters.
+ (dolist (item
+ '(("\\(^\\|[^\\]\\)\\(&+\\)" 2 'font-latex-warning-face)
+ ("\\$\\$\\([^$]+\\)\\$\\$" 1 'font-latex-math-face)
+ (font-latex-match-quotation
+ (0 'font-latex-string-face append)
+ (1 'font-latex-warning-face))
+ ;; Hack to remove the verbatim face from the \ in
+ ;; \end{verbatim} and similar. The same hack is used in
+ ;; tex-mode.el.
+ ("^[ \t]*\\(\\\\\\)end"
+ (1 (get-text-property (match-end 1) 'face) t))))
+ (add-to-list 'font-latex-keywords-1 item)
+ (add-to-list 'font-latex-keywords-2 item))
+ (dolist (item
+ '((font-latex-match-math-env
+ (0 'font-latex-warning-face t t)
+ (1 'font-latex-math-face append t))
+ (font-latex-match-math-envII
+ (0 'font-latex-math-face append t))
+ (font-latex-match-simple-command
+ (0 'font-latex-sedate-face append))
+ (font-latex-match-script
+ (1 (font-latex-script (match-beginning 0)) append))))
+ (add-to-list 'font-latex-keywords-2 item t)))
+(font-latex-make-user-keywords)
+
+(defun font-latex-add-keywords (keywords class)
+ "Add KEYWORDS to CLASS.
+KEYWORDS is a list of keywords or keywords with syntax specs.
+CLASS corresponds to a keyword class and can be one of the
+symbols 'warning, 'variable, 'reference, 'biblatex, 'function,
+'sectioning-0, 'sectioning-1, 'sectioning-2, 'sectioning-3,
+'sectioning-4, 'sectioning-5, 'slide-title, 'textual,
+'bold-command, 'italic-command, 'math-command, 'type-command,
+'bold-declaration, 'italic-declaration or 'type-declaration.
+
+The keywords will be added to the buffer-local list of keywords
+of the respective keyword class and necessary updates of the font
+locking machinery will be triggered."
+ (let* ((class (symbol-name class))
+ (list (intern (format "font-latex-match-%s-keywords-local" class))))
+ (dolist (elt keywords)
+ (add-to-list list elt))
+ (funcall (intern (format "font-latex-match-%s-make" class)))
+ (setq font-lock-set-defaults nil)
+ (font-lock-set-defaults)))
+
+(defvar font-latex-keywords font-latex-keywords-1
+ "Default expressions to highlight in TeX mode.")
+
+
+;;; Subscript and superscript
+
+(defcustom font-latex-fontify-script (not (featurep 'xemacs))
+ "If non-nil, fontify subscript and superscript strings.
+This feature does not work in XEmacs."
+ :type 'boolean
+ :group 'font-latex)
+(put 'font-latex-fontify-script 'safe-local-variable 'TeX-booleanp)
+
+(defcustom font-latex-script-display '((raise -0.3) . (raise 0.3))
+ "Display specification for subscript and superscript content.
+The car is used for subscript, the cdr is used for superscripts."
+ :group 'font-latex
+ :type '(cons (choice (sexp :tag "Subscript form")
+ (const :tag "No lowering" nil))
+ (choice (sexp :tag "Superscript form")
+ (const :tag "No raising" nil))))
+
+
+;;; Syntactic keywords
+
+(defvar font-latex-syntactic-keywords nil
+ "Syntactic keywords used by `font-latex'.")
+(make-variable-buffer-local 'font-latex-syntactic-keywords)
+
+(defvar font-latex-syntactic-keywords-extra nil
+ "List of syntactic keywords to add to `font-latex-syntactic-keywords'.
+The form should be the same as in `font-lock-syntactic-keywords'.")
+(make-variable-buffer-local 'font-latex-syntactic-keywords-extra)
+
+;; Set and updated in `font-latex-set-syntactic-keywords'.
+(defvar font-latex-doctex-syntactic-keywords nil)
+
+(defun font-latex-set-syntactic-keywords ()
+ "Set the variable `font-latex-syntactic-keywords'.
+This function can be used to refresh the variable in case other
+variables influencing its value, like `LaTeX-verbatim-environments',
+have changed."
+ ;; Checks for non-emptiness of lists added in order to cater for
+ ;; installations where `(regexp-opt-group nil)' would enter a loop.
+ (let ((verb-envs (and (fboundp 'LaTeX-verbatim-environments)
+ (LaTeX-verbatim-environments)))
+ (verb-macros-with-delims
+ (and (fboundp 'LaTeX-verbatim-macros-with-delims)
+ (LaTeX-verbatim-macros-with-delims)))
+ (verb-macros-with-braces
+ (and (fboundp 'LaTeX-verbatim-macros-with-braces)
+ (LaTeX-verbatim-macros-with-braces))))
+ (setq verb-envs (and verb-envs (regexp-opt verb-envs))
+ verb-macros-with-delims (and verb-macros-with-delims
+ (regexp-opt verb-macros-with-delims))
+ verb-macros-with-braces (and verb-macros-with-braces
+ (regexp-opt verb-macros-with-braces))
+ font-latex-syntactic-keywords nil)
+ (unless (= (length verb-envs) 0)
+ (add-to-list 'font-latex-syntactic-keywords
+ `(,(concat "^[ \t]*\\\\begin *{\\(?:" verb-envs
+ "\\)}.*\\(\n\\)")
+ (1 "|" t)))
+ (add-to-list 'font-latex-syntactic-keywords
+ ;; Using the newline character for the syntax
+ ;; property often resulted in fontification
+ ;; problems when text was inserted at the end of
+ ;; the verbatim environment. That's why we now use
+ ;; the starting backslash of \end. There is a hack
+ ;; in `font-latex-make-user-keywords' to remove the
+ ;; spurious fontification of the backslash.
+ `(,(concat "^[ \t]*\\(\\\\\\)end *{\\(?:" verb-envs "\\)}")
+ (1 "|" t))))
+ (unless (= (length verb-macros-with-delims) 0)
+ (add-to-list 'font-latex-syntactic-keywords
+ `(,(concat "\\\\\\(?:" verb-macros-with-delims "\\)"
+ ;; An opening curly brace as delimiter
+ ;; is valid, but allowing it might screw
+ ;; up fontification of stuff like
+ ;; "\url{...} foo \textbf{<--!...}".
+ "\\([^a-z@*\n\f{]\\).*?"
+ ;; Give an escape char at the end of the
+ ;; verbatim construct punctuation syntax.
+ ;; Prevents wrong fontification of stuff
+ ;; like "\verb|foo\|".
+ "\\(" (regexp-quote TeX-esc) "*\\)\\(\\1\\)")
+ (1 "\"") (2 ".") (3 "\""))))
+ (unless (= (length verb-macros-with-braces) 0)
+ (add-to-list 'font-latex-syntactic-keywords
+ `(,(concat "\\\\\\(?:" verb-macros-with-braces "\\)"
+ "\\({\\).*?[^\\]\\(?:\\\\\\\\\\)*\\(}\\)")
+ (1 "|") (2 "|")))))
+ (when font-latex-syntactic-keywords-extra
+ (nconc font-latex-syntactic-keywords font-latex-syntactic-keywords-extra))
+ ;; Cater for docTeX mode.
+ (setq font-latex-doctex-syntactic-keywords
+ (append font-latex-syntactic-keywords
+ ;; For docTeX comment-in-doc.
+ `(("\\(\\^\\)\\^A" (1 (font-latex-doctex-^^A)))))))
+
+
+;;; Syntactic fontification
+
+;; Copy and adaptation of `tex-font-lock-syntactic-face-function' in
+;; `tex-mode.el' of CVS Emacs (March 2004)
+(defun font-latex-syntactic-face-function (state)
+ (let ((char (nth 3 state)))
+ (cond
+ ((not char) 'font-lock-comment-face)
+ ((eq char ?$) 'font-latex-math-face)
+ (t
+ (when (char-valid-p char)
+ ;; This is a \verb?...? construct. Let's find the end and mark it.
+ (save-excursion
+ (skip-chars-forward (string ?^ char)) ;; Use `end' ?
+ (when (eq (char-syntax (preceding-char)) ?/)
+ (put-text-property (1- (point)) (point) 'syntax-table '(1)))
+ (unless (eobp)
+ (put-text-property (point) (1+ (point)) 'syntax-table '(7)))))
+ 'font-latex-verbatim-face))))
+
+
+;;; Faces
+
+(defface font-latex-bold-face
+ (let ((font (cond ((assq :inherit custom-face-attributes) '(:inherit bold))
+ ((assq :weight custom-face-attributes) '(:weight bold))
+ (t '(:bold t)))))
+ `((((class grayscale) (background light))
+ (:foreground "DimGray" ,@font))
+ (((class grayscale) (background dark))
+ (:foreground "LightGray" ,@font))
+ (((class color) (background light))
+ (:foreground "DarkOliveGreen" ,@font))
+ (((class color) (background dark))
+ (:foreground "OliveDrab" ,@font))
+ (t (,@font))))
+ "Face used to highlight text to be typeset in bold."
+ :group 'font-latex-highlighting-faces)
+
+(defface font-latex-italic-face
+ (let ((font (cond ((assq :inherit custom-face-attributes) '(:inherit italic))
+ ((assq :slant custom-face-attributes) '(:slant italic))
+ (t '(:italic t)))))
+ `((((class grayscale) (background light))
+ (:foreground "DimGray" ,@font))
+ (((class grayscale) (background dark))
+ (:foreground "LightGray" ,@font))
+ (((class color) (background light))
+ (:foreground "DarkOliveGreen" ,@font))
+ (((class color) (background dark))
+ (:foreground "OliveDrab" ,@font))
+ (t (,@font))))
+ "Face used to highlight text to be typeset in italic."
+ :group 'font-latex-highlighting-faces)
+
+(defface font-latex-math-face
+ (let ((font (cond ((assq :inherit custom-face-attributes)
+ '(:inherit underline))
+ (t '(:underline t)))))
+ `((((class grayscale) (background light))
+ (:foreground "DimGray" ,@font))
+ (((class grayscale) (background dark))
+ (:foreground "LightGray" ,@font))
+ (((class color) (background light))
+ (:foreground "SaddleBrown"))
+ (((class color) (background dark))
+ (:foreground "burlywood"))
+ (t (,@font))))
+ "Face used to highlight math."
+ :group 'font-latex-highlighting-faces)
+
+(defface font-latex-sedate-face
+ '((((class grayscale) (background light)) (:foreground "DimGray"))
+ (((class grayscale) (background dark)) (:foreground "LightGray"))
+ (((class color) (background light)) (:foreground "DimGray"))
+ (((class color) (background dark)) (:foreground "LightGray"))
+ ;;;(t (:underline t))
+ )
+ "Face used to highlight sedate stuff."
+ :group 'font-latex-highlighting-faces)
+
+(defface font-latex-string-face
+ (let ((font (cond ((assq :inherit custom-face-attributes) '(:inherit italic))
+ ((assq :slant custom-face-attributes) '(:slant italic))
+ (t '(:italic t)))))
+ `((((type tty) (class color))
+ (:foreground "green"))
+ (((class grayscale) (background light))
+ (:foreground "DimGray" ,@font))
+ (((class grayscale) (background dark))
+ (:foreground "LightGray" ,@font))
+ (((class color) (background light))
+ (:foreground "RosyBrown"))
+ (((class color) (background dark))
+ (:foreground "LightSalmon"))
+ (t (,@font))))
+ "Face used to highlight strings."
+ :group 'font-latex-highlighting-faces)
+
+(defface font-latex-warning-face
+ (let ((font (cond ((assq :inherit custom-face-attributes) '(:inherit bold))
+ ((assq :weight custom-face-attributes) '(:weight bold))
+ (t '(:bold t)))))
+ `((((class grayscale)(background light))
+ (:foreground "DimGray" ,@font))
+ (((class grayscale)(background dark))
+ (:foreground "LightGray" ,@font))
+ (((class color)(background light))
+ (:foreground "red" ,@font))
+ (((class color)(background dark))
+ (:foreground "red" ,@font))
+ (t (,@font))))
+ "Face for important keywords."
+ :group 'font-latex-highlighting-faces)
+
+(defface font-latex-verbatim-face
+ (let ((font (if (and (assq :inherit custom-face-attributes)
+ (if (featurep 'xemacs)
+ (find-face 'fixed-pitch)
+ (facep 'fixed-pitch)))
+ '(:inherit fixed-pitch)
+ '(:family "courier"))))
+ `((((class grayscale) (background light))
+ (:foreground "DimGray" ,@font))
+ (((class grayscale) (background dark))
+ (:foreground "LightGray" ,@font))
+ (((class color) (background light))
+ (:foreground "SaddleBrown" ,@font))
+ (((class color) (background dark))
+ (:foreground "burlywood" ,@font))
+ (t (,@font))))
+ "Face used to highlight TeX verbatim environments."
+ :group 'font-latex-highlighting-faces)
+
+(defface font-latex-superscript-face
+ '((t (:height 0.8)))
+ "Face used for superscripts."
+ :group 'font-latex-highlighting-faces)
+
+(defface font-latex-subscript-face
+ '((t (:height 0.8)))
+ "Face used for subscripts."
+ :group 'font-latex-highlighting-faces)
+
+(defface font-latex-slide-title-face
+ (let* ((scale 1.2)
+ (size (when (featurep 'xemacs)
+ (round (* 0.9 (face-height 'default) scale)))))
+ (if (featurep 'xemacs)
+ `((t (:bold t :family "helvetica" :size ,size)))
+ `((t (:inherit (variable-pitch font-lock-type-face)
+ :weight bold :height ,scale)))))
+ "Face for slide titles."
+ :group 'font-latex-highlighting-faces)
+(when (featurep 'xemacs)
+ (set-face-parent 'font-latex-slide-title-face 'font-lock-type-face
+ nil nil 'append))
+
+
+;;; Setup
+
+(defvar font-lock-comment-start-regexp nil
+ "Regexp to match the start of a comment.")
+
+(defvar font-latex-extend-region-functions nil
+ "List of functions extending the region for multiline constructs.
+
+Each function should accept two arguments, the begin and end of
+the region to be fontified, and return the new region start. If
+no extension is necessary, the original region start should be
+returned.
+
+All specified functions will be called and the region extended
+backwards to the minimum over their return values.")
+
+(defvar font-latex-syntax-alist
+ ;; Use word syntax for @ because we use \> for matching macros and
+ ;; we don't want \foo@bar to be found if we search for \foo.
+ '((?\( . ".") (?\) . ".") (?$ . "\"") (?@ . "w"))
+ "List of specifiers for the syntax alist of `font-lock-defaults'.")
+
+(defun font-latex-add-to-syntax-alist (list)
+ "Activate syntactic font locking for the entries in LIST.
+The entries are added to `font-latex-syntax-alist' and eventually
+end up in `font-lock-defaults'. Each entry in LIST should be a
+cons pair as expected by `font-lock-defaults'. The function also
+triggers Font Lock to recognize the change."
+ (make-local-variable 'font-latex-syntax-alist)
+ (set (make-local-variable 'font-latex-syntax-alist)
+ (append font-latex-syntax-alist list))
+ ;; Tell font-lock about the update.
+ (setq font-lock-set-defaults nil)
+ (font-latex-setup))
+
+;;;###autoload
+(defun font-latex-setup ()
+ "Setup this buffer for LaTeX font-lock. Usually called from a hook."
+ (font-latex-set-syntactic-keywords)
+ ;; Trickery to make $$ fontification be in `font-latex-math-face' while
+ ;; strings get whatever `font-lock-string-face' has been set to.
+ (when (fboundp 'built-in-face-specifiers)
+ ;; Cool patch from Christoph Wedler...
+ (let (instance)
+ (mapc (lambda (property)
+ (setq instance
+ (face-property-instance 'font-latex-math-face property
+ nil 0 t))
+ (if (numberp instance)
+ (setq instance
+ (face-property-instance 'default property nil 0)))
+ (or (numberp instance)
+ (set-face-property 'font-lock-string-face property
+ instance (current-buffer))))
+ (built-in-face-specifiers))))
+
+ ;; Activate multi-line fontification facilities if available.
+ (when (boundp 'font-lock-multiline)
+ (set (make-local-variable 'font-lock-multiline) t))
+
+ ;; Functions for extending the region.
+ (dolist (elt '(font-latex-extend-region-backwards-command-with-args
+ font-latex-extend-region-backwards-command-in-braces
+ font-latex-extend-region-backwards-quotation
+ font-latex-extend-region-backwards-math-env
+ font-latex-extend-region-backwards-math-envII))
+ (add-to-list 'font-latex-extend-region-functions elt))
+
+ ;; Tell Font Lock about the support.
+ (make-local-variable 'font-lock-defaults)
+ ;; The test for `major-mode' currently only works with docTeX mode
+ ;; because `TeX-install-font-lock' is called explicitely in
+ ;; `doctex-mode'. In case other modes have to be distinguished as
+ ;; well, remove the call to `TeX-install-font-lock' from
+ ;; `VirTeX-common-initialization' and place it in the different
+ ;; `xxx-mode' calls instead, but _after_ `major-mode' is set.
+ (let ((defaults
+ `((font-latex-keywords font-latex-keywords-1 font-latex-keywords-2)
+ nil nil ,font-latex-syntax-alist nil))
+ (variables
+ '((font-lock-comment-start-regexp . "%")
+ (font-lock-mark-block-function . mark-paragraph)
+ (font-lock-fontify-region-function
+ . font-latex-fontify-region)
+ (font-lock-unfontify-region-function
+ . font-latex-unfontify-region))))
+ ;; Add the mode-dependent stuff to the basic variables defined above.
+ (if (eq major-mode 'doctex-mode)
+ (progn
+ (setcar defaults (append (car defaults)
+ '(font-latex-doctex-keywords)))
+ (setq variables
+ (append variables
+ '((font-lock-syntactic-face-function
+ . font-latex-doctex-syntactic-face-function)
+ (font-lock-syntactic-keywords
+ . font-latex-doctex-syntactic-keywords)))))
+ (setq variables
+ (append variables
+ '((font-lock-syntactic-face-function
+ . font-latex-syntactic-face-function)
+ (font-lock-syntactic-keywords
+ . font-latex-syntactic-keywords)))))
+ ;; Cater for the idiosyncrasies of Emacs and XEmacs.
+ (if (featurep 'xemacs)
+ (progn
+ ;; XEmacs does not set these variables via `font-lock-defaults'
+ ;; but requires them to be set explicitely.
+ (mapc (lambda (alist)
+ (set (car alist) (cdr alist))) variables)
+ ;; Has to be set to t as otherwise syntax properties will not be
+ ;; be picked up during fontification.
+ (set (make-local-variable 'lookup-syntax-properties) t))
+ (setq defaults (append defaults variables)))
+ ;; Set the defaults.
+ (setq font-lock-defaults defaults)))
+
+(defun font-latex-jit-lock-force-redisplay (buf start end)
+ "Compatibility for Emacsen not offering `jit-lock-force-redisplay'."
+ ;; The following block is an expansion of `jit-lock-force-redisplay'
+ ;; and involved macros taken from CVS Emacs on 2007-04-28.
+ (with-current-buffer buf
+ (let ((modified (buffer-modified-p)))
+ (unwind-protect
+ (let ((buffer-undo-list t)
+ (inhibit-read-only t)
+ (inhibit-point-motion-hooks t)
+ (inhibit-modification-hooks t)
+ deactivate-mark
+ buffer-file-name
+ buffer-file-truename)
+ (put-text-property start end 'fontified t))
+ (unless modified
+ (restore-buffer-modified-p nil))))))
+
+(defun font-latex-fontify-region (beg end &optional loudly)
+ "Fontify region from BEG to END.
+If optional argument is non-nil, print status messages."
+ (let ((extend-list (delq nil (mapcar (lambda (fun) (funcall fun beg end))
+ font-latex-extend-region-functions))))
+ (when extend-list
+ (let ((orig-beg beg))
+ (setq beg (apply 'min extend-list))
+ (when (featurep 'jit-lock)
+ ;; Stolen from `jit-lock-fontify-now' (2007-04-27) and
+ ;; adapted. Without this stanza only the line in which a
+ ;; change happened will refontified. The rest will only be
+ ;; refontified upon redisplay.
+ (run-with-timer 0 nil 'font-latex-jit-lock-force-redisplay
+ (current-buffer) beg orig-beg))))
+ (font-lock-default-fontify-region beg end loudly)))
+
+;; Copy and adaption of `tex-font-lock-unfontify-region' from
+;; tex-mode.el in GNU Emacs on 2004-08-04.
+;; (XEmacs passes a third argument to the function.)
+(defun font-latex-unfontify-region (beg end &rest ignored)
+ "Unfontify region from BEG to END."
+ (font-lock-default-unfontify-region beg end)
+ ;; XEmacs does not provide `font-lock-extra-managed-props', so
+ ;; remove the `font-latex-multiline' property manually. (The
+ ;; property is only added if `font-lock-multiline' is bound.)
+ (unless (boundp 'font-lock-multiline)
+ (remove-text-properties beg end '(font-latex-multiline)))
+ (while (< beg end)
+ (let ((next (next-single-property-change beg 'display nil end))
+ (prop (get-text-property beg 'display)))
+ (if (and (eq (car-safe prop) 'raise)
+ (member (car-safe (cdr prop))
+ (list (nth 1 (car font-latex-script-display))
+ (nth 1 (cdr font-latex-script-display))))
+ (null (cddr prop)))
+ (put-text-property beg next 'display nil))
+ (setq beg next))))
+
+(defadvice font-lock-after-change-function (before font-latex-after-change
+ activate)
+ "Extend region for fontification of multiline constructs.
+This is only necessary if the editor does not provide multiline
+fontification facilities like `font-lock-multiline' itself."
+ (unless (boundp 'font-lock-multiline)
+ (let ((ad-beg (ad-get-arg 0))
+ (ad-end (ad-get-arg 1)))
+ (save-excursion
+ (goto-char ad-beg)
+ (beginning-of-line)
+ (when (get-text-property (point) 'font-latex-multiline)
+ (setq ad-beg (previous-single-property-change (point)
+ 'font-latex-multiline))
+ (when (numberp ad-beg)
+ (ad-set-arg 0 ad-beg)))
+ (goto-char ad-end)
+ (end-of-line)
+ (when (get-text-property (point) 'font-latex-multiline)
+ (setq ad-end (next-single-property-change (point)
+ 'font-latex-multiline))
+ (when (numberp ad-end)
+ (ad-set-arg 1 ad-end)))))))
+
+
+;;; Utility functions
+
+(defun font-latex-find-matching-close (openchar closechar)
+ "Skip over matching pairs of OPENCHAR and CLOSECHAR.
+OPENCHAR is the opening character and CLOSECHAR is the closing
+character. Character pairs are usually { } or [ ]. Comments are
+ignored during the search."
+ (let ((parse-sexp-ignore-comments
+ (not (eq major-mode 'doctex-mode))) ; scan-sexps ignores comments
+ (init-point (point))
+ (mycount 1)
+ (esc-char (or (and (boundp 'TeX-esc) TeX-esc) "\\"))
+ ;; XXX: Do not look up syntax-table properties since they may
+ ;; be misleading, e.g. in the case of "{foo}^^A" where the
+ ;; closing brace gets a comment end syntax.
+ (parse-sexp-lookup-properties nil))
+ (or
+ (condition-case nil
+ (progn
+ (goto-char (with-syntax-table
+ (TeX-search-syntax-table openchar closechar)
+ (scan-sexps (point) 1)))
+ ;; No error code. See if closechar is unquoted
+ (save-excursion
+ (backward-char 1)
+ (zerop (mod (skip-chars-backward (regexp-quote esc-char)) 2))))
+ (error nil))
+ (save-match-data
+ (goto-char (1+ init-point))
+ (while (and (> mycount 0)
+ (re-search-forward
+ (string ?\[
+ ;; closechar might be ]
+ ;; and therefor must be first in regexp
+ closechar openchar
+ ?\])
+ nil t))
+ (cond
+ ((font-latex-commented-outp)
+ (forward-line 1))
+ ((save-excursion
+ (backward-char 1)
+ (zerop (mod (skip-chars-backward (regexp-quote esc-char))
+ 2)))
+ (setq mycount (+ mycount
+ (if (= (preceding-char) openchar) 1 -1)))))))
+ (if (= mycount 0)
+ t
+ (goto-char init-point)
+ nil))))
+
+(defun font-latex-commented-outp ()
+ "Return t if comment character is found between bol and point."
+ (save-excursion
+ (let ((limit (point))
+ (esc-char (if (and (boundp 'TeX-esc) TeX-esc) TeX-esc "\\")))
+ (forward-line 0)
+ (if (and (eq (char-after) ?\%)
+ (not (font-latex-faces-present-p 'font-latex-verbatim-face)))
+ (not (eq major-mode 'doctex-mode))
+ (catch 'found
+ (while (progn (skip-chars-forward "^%" limit)
+ (< (point) limit))
+ (when (and (save-excursion
+ (zerop (mod (skip-chars-backward
+ (regexp-quote esc-char)) 2)))
+ (not (font-latex-faces-present-p
+ 'font-latex-verbatim-face)))
+ (throw 'found t))
+ (forward-char)))))))
+
+(defun font-latex-faces-present-p (faces &optional pos)
+ "Return t if FACES are present at position POS.
+FACES may be a single face or a list of faces.
+If POS is omitted, the current position of point is used."
+ (let* ((faces (if (listp faces) faces (list faces)))
+ (pos (or pos (point)))
+ (prop (get-text-property pos 'face))
+ (prop-list (if (listp prop) prop (list prop))))
+ (catch 'member
+ (dolist (item prop-list)
+ (when (memq item faces)
+ (throw 'member t))))))
+
+(defun font-latex-forward-comment ()
+ "Like `forward-comment' but with special provisions for docTeX mode.
+In docTeX mode \"%\" at the start of a line will be treated as whitespace."
+ (if (eq major-mode 'doctex-mode)
+ ;; XXX: We should probably cater for ^^A as well.
+ (progn
+ (while (progn (if (bolp) (skip-chars-forward "%"))
+ (> (skip-chars-forward " \t\n") 0)))
+ (when (eq (char-after) ?%)
+ (beginning-of-line 2)
+ t))
+ (forward-comment 1)))
+
+(defun font-latex-put-multiline-property-maybe (beg end)
+ "Add a multiline property if no equivalent is provided by the editor.
+The text property is used to find the start or end of a multiline
+construct when unfontifying a region. Emacs adds such a text
+property automatically if `font-lock-multiline' is set to t and
+extends the region to be unfontified automatically as well.
+XEmacs does not do this at the time of this writing."
+ (unless (boundp 'font-lock-multiline)
+ (put-text-property beg end 'font-latex-multiline t)))
+
+
+;;; Match functions
+
+(defvar font-latex-matched-faces nil
+ "List of faces corresponding to matches in match data.")
+
+(defun font-latex-matched-face (pos)
+ "Return face at position POS in `font-latex-matched-faces'."
+ (nth pos font-latex-matched-faces))
+
+(defvar font-latex-command-with-args-default-spec nil ; "*[{"
+ "Default specifier for keywords without syntax description.
+Set this to nil if verification of command syntax is unwanted.")
+
+(defvar font-latex-command-with-args-opt-arg-delims
+ '((?[ . ?]) (?< . ?>) (?\( . ?\)))
+ "List character pairs used as delimiters for optional arguments.")
+
+(defvar font-latex-syntax-error-modes '(latex-mode)
+ "List of modes where syntax errors in macros should be indicated.")
+
+(defun font-latex-match-command-with-arguments (regexp keywords face limit)
+ "Search for regexp command KEYWORDS[opt]{arg} before LIMIT.
+Returns nil if none of KEYWORDS is found."
+ (setq font-latex-matched-faces nil)
+ (catch 'match
+ (while (re-search-forward regexp limit t)
+ (unless (font-latex-faces-present-p '(font-lock-comment-face
+ font-latex-verbatim-face)
+ (match-beginning 0))
+ (let* ((beg (match-beginning 0))
+ end ; Used for multiline text property.
+ (match-data (list beg))
+ match-beg syntax-error alternative spec
+ error-indicator-pos
+ (spec-list (string-to-list
+ (or (cadr (assoc (match-string 1) keywords))
+ font-latex-command-with-args-default-spec)))
+ (parse-sexp-ignore-comments t)) ; scan-sexps ignores comments
+ (goto-char (match-end 0))
+ ;; Check for starred macro if first spec is an asterisk.
+ (when (eq (car spec-list) ?*)
+ (setq spec-list (cdr spec-list))
+ (skip-chars-forward "*" (1+ (point))))
+ ;; Add current point to match data and use keyword face for
+ ;; region from start to point.
+ (nconc match-data (list (point)))
+ (add-to-list 'font-latex-matched-faces 'font-lock-keyword-face)
+ (setq end (point))
+ (catch 'break
+ ;; Walk the list of specs.
+ (while spec-list
+ (setq spec (pop spec-list)
+ error-indicator-pos beg)
+ (while (and (not (eobp)) (font-latex-forward-comment)))
+ ;; Alternative
+ (when (eq spec ?|)
+ (setq alternative t)
+ (setq spec (pop spec-list)))
+ (cond
+ ;; Macros: \foo
+ ((eq spec ?\\)
+ (if (eq (char-after) spec)
+ (progn
+ (nconc match-data
+ (list (point)
+ (progn
+ (forward-char)
+ (if (zerop (skip-chars-forward "A-Za-z@"))
+ (forward-char) ; Single-char macro.
+ (skip-chars-forward "*"))
+ (point))))
+ (nconc font-latex-matched-faces (list face))
+ (setq end (max end (point)))
+ (when alternative (pop spec-list)))
+ (setq syntax-error t)
+ (throw 'break nil)))
+ ;; Mandatory arguments: {...}
+ ((eq spec ?{)
+ (if (and (eq (char-after) spec)
+ (setq match-beg (point))
+ (font-latex-find-matching-close ?{ ?}))
+ (progn
+ (nconc match-data (list (1+ match-beg) (1- (point))))
+ (nconc font-latex-matched-faces (list face))
+ (setq end (max end (1- (point))))
+ (when alternative (pop spec-list)))
+ (unless alternative
+ (setq syntax-error t)
+ (when (and match-beg (= match-beg (point)))
+ (setq error-indicator-pos match-beg))
+ (throw 'break nil))))
+ ;; Optional arguments: [...] and others
+ ((eq (char-after) spec)
+ (setq match-beg (point))
+ (if (font-latex-find-matching-close
+ spec (cdr (assq
+ spec
+ font-latex-command-with-args-opt-arg-delims)))
+ (progn
+ (nconc match-data (list (1+ match-beg) (1- (point))))
+ (nconc font-latex-matched-faces
+ (list 'font-lock-variable-name-face))
+ (setq end (max end (1- (point)))))
+ (setq syntax-error t
+ error-indicator-pos match-beg)
+ (throw 'break nil))))
+ (setq alternative nil)))
+ (when (and syntax-error (memq major-mode
+ font-latex-syntax-error-modes))
+ ;; Add the warning face at the front of the list because
+ ;; the matcher uses 'append and the face would otherwise
+ ;; be overridden by the keyword face.
+ (setq match-data (append (list error-indicator-pos
+ (1+ error-indicator-pos))
+ match-data))
+ (push 'font-latex-warning-face font-latex-matched-faces))
+ (font-latex-put-multiline-property-maybe beg end)
+ (store-match-data match-data)
+ (throw 'match t))))))
+
+(defun font-latex-extend-region-backwards-command-with-args (beg end)
+ "Return position to extend region backwards for commands with args.
+Return nil if region does not have to be extended for a multiline
+macro to fit in. The region between the positions BEG and END
+marks boundaries for searching for macro ends."
+ (save-excursion
+ (goto-char end)
+ (catch 'extend
+ (while (TeX-search-backward-unescaped "}" beg t)
+ (let ((macro-start (TeX-find-macro-start
+ (max (point-min)
+ (- beg font-latex-multiline-boundary)))))
+ (when (and macro-start
+ (< macro-start beg))
+ (throw 'extend macro-start))))
+ nil)))
+
+(defun font-latex-match-command-in-braces (keywords limit)
+ "Search for command like {\\bfseries fubar} before LIMIT.
+Sets `match-data' so that:
+ subexpression 0 is a warning indicator,
+ subexpression 1 is the keyword, and
+ subexpression 2 is the rest in the TeX group.
+Returns nil if no command is found."
+ (catch 'match
+ (while (re-search-forward keywords limit t)
+ (unless (font-latex-faces-present-p '(font-lock-comment-face
+ font-latex-verbatim-face)
+ (match-beginning 0))
+ (let ((kbeg (match-beginning 0)) (kend (match-end 1))
+ (beg (match-end 0))
+ cbeg cend
+ (parse-sexp-ignore-comments t)) ; scan-sexps ignores comments
+ (goto-char kbeg)
+ (if (not (eq (preceding-char) ?\{))
+ ;; Fontify only the keyword (no argument found).
+ (progn
+ (setq cbeg kbeg cend kend)
+ (goto-char (match-end 0))
+ (store-match-data (list (point) (point)
+ (point) (point)
+ cbeg cend))
+ (throw 'match t))
+ ;; There's an opening bracket
+ (save-restriction
+ ;; Restrict to LIMIT.
+ (narrow-to-region (point-min) limit)
+ (forward-char -1) ; Move on the opening bracket
+ (if (font-latex-find-matching-close ?\{ ?\})
+ (progn
+ (font-latex-put-multiline-property-maybe beg (1- (point)))
+ (store-match-data (list kbeg kbeg
+ kbeg kend
+ beg (1- (point)))))
+ (goto-char kend)
+ (store-match-data (list (1- kbeg) kbeg
+ kbeg kend
+ kend kend)))
+ (throw 'match t))))))))
+
+(defun font-latex-extend-region-backwards-command-in-braces (beg end)
+ "Return position to extend region backwards for commands in braces.
+Return nil if region does not have to be extended for a multiline
+group to fit in. The region between the positions BEG and END
+marks boundaries for searching for group ends."
+ (save-excursion
+ (goto-char end)
+ (catch 'extend
+ (while (TeX-search-backward-unescaped "}" beg t)
+ (let ((group-start (TeX-find-opening-brace
+ nil (max (point-min)
+ (- beg font-latex-multiline-boundary)))))
+ (when group-start
+ ;; XXX: Actually we'd have to check if any of the
+ ;; declaration-type macros can be found right after the
+ ;; brace. If we don't do this (like now) large regions
+ ;; may be refontified for no good reason. For checking
+ ;; the built-in `font-latex-match-*' variables for
+ ;; declaration-type macros as well as the respective
+ ;; user-defined variables could be concatenated.
+ (goto-char group-start)
+ (when (< group-start beg)
+ (throw 'extend group-start)))))
+ nil)))
+
+(defun font-latex-match-simple-command (limit)
+ "Search for command like \\foo before LIMIT."
+ (TeX-re-search-forward-unescaped "\\\\[@A-Za-z]+" limit t))
+
+(defun font-latex-match-math-env (limit)
+ "Match math pattern up to LIMIT.
+Used for patterns like:
+\\( F = ma \\)
+\\[ F = ma \\] but not \\\\ [len]"
+ (catch 'match
+ (while (re-search-forward "\\(\\\\(\\)\\|\\(\\\\\\[\\)" limit t)
+ (unless (save-excursion
+ (goto-char (match-beginning 0))
+ ;; \\[ does not start a math environment
+ (/= (mod (skip-chars-backward "\\\\") 2) 0))
+ (let ((beg (match-beginning 0))
+ (open-tag (if (match-beginning 1) "\\(" "\\["))
+ (close-tag (if (match-beginning 1) "\\)" "\\]")))
+ ;; Search for both opening and closing tags in order to be
+ ;; able to avoid erroneously matching stuff like "\(foo \(bar\)".
+ (if (and (re-search-forward (concat "[^\\]\\(?:\\\\\\\\\\)*\\("
+ (regexp-quote open-tag) "\\|"
+ (regexp-quote close-tag) "\\)")
+ limit 'move)
+ (string= (match-string 1) close-tag))
+ ;; Found closing tag.
+ (progn
+ (font-latex-put-multiline-property-maybe beg (point))
+ (store-match-data (list beg beg beg (point))))
+ ;; Did not find closing tag.
+ (goto-char (+ beg 2))
+ (store-match-data (list beg (point) (point) (point))))
+ (throw 'match t))))))
+
+(defun font-latex-extend-region-backwards-math-env (beg end)
+ "Return position to extend region backwards for math environments.
+Return nil if region does not have to be extended for a multiline
+environment to fit in. The region between the positions BEG and
+END marks boundaries for searching for environment ends."
+ (save-excursion
+ (goto-char end)
+ (catch 'extend
+ (while (re-search-backward "\\(\\\\)\\)\\|\\(\\\\]\\)" beg t)
+ (when (and (zerop (mod (skip-chars-backward "\\\\") 2))
+ (re-search-backward
+ (concat "[^\\]\\(?:\\\\\\\\\\)*\\("
+ (regexp-quote (if (match-beginning 1) "\\(" "\\["))
+ "\\)")
+ (- beg font-latex-multiline-boundary) t)
+ (goto-char (match-beginning 1))
+ (< (point) beg))
+ (throw 'extend (point))))
+ nil)))
+
+(defcustom font-latex-math-environments
+ '("display" "displaymath" "equation" "eqnarray" "gather" "multline"
+ "align" "alignat" "xalignat" "xxalignat" "flalign")
+ "List of math environment names for font locking."
+ :type '(repeat string)
+ :group 'font-latex)
+
+(defun font-latex-match-math-envII (limit)
+ "Match math patterns up to LIMIT.
+Used for patterns like:
+\\begin{equation}
+ fontified stuff
+\\end{equation}
+The \\begin{equation} and \\end{equation} are not fontified here."
+ (when (re-search-forward (concat "\\\\begin[ \t]*{"
+ (regexp-opt font-latex-math-environments t)
+ "\\*?}")
+ limit t)
+ (let ((beg (match-end 0)) end)
+ (if (re-search-forward (concat "\\\\end[ \t]*{"
+ (regexp-quote
+ (buffer-substring-no-properties
+ (match-beginning 1)
+ (match-end 0))))
+ ;; XXX: Should this rather be done by
+ ;; extending the region to be fontified?
+ (+ limit font-latex-multiline-boundary) 'move)
+ (setq end (match-beginning 0))
+ (goto-char beg)
+ (setq end beg))
+ (font-latex-put-multiline-property-maybe beg end)
+ (store-match-data (list beg end))
+ t)))
+
+(defun font-latex-extend-region-backwards-math-envII (beg end)
+ "Return position to extend region backwards for math environments.
+Return nil if region does not have to be extended for a multiline
+environment to fit in. The region between the positions BEG and
+END marks boundaries for searching for environment ends."
+ (save-excursion
+ (goto-char end)
+ (catch 'extend
+ (while (re-search-backward
+ (concat "\\\\end[ \t]*{"
+ (regexp-opt font-latex-math-environments t)
+ "\\*?}") beg t)
+ (when (and (re-search-backward (concat "\\\\begin[ \t]*{"
+ (buffer-substring-no-properties
+ (match-beginning 1)
+ (match-end 0)))
+ (- beg font-latex-multiline-boundary) t)
+ (< (point) beg))
+ (throw 'extend (point))))
+ nil)))
+
+(defun font-latex-update-quote-list ()
+ "Update quote list and regexp if value of `font-latex-quotes' changed."
+ (unless (eq font-latex-quotes-control font-latex-quotes)
+ (setq font-latex-quotes-control font-latex-quotes)
+ (font-latex-quotes-set-internal)
+ ;; Set order of each entry in `font-latex-quote-list' according to
+ ;; setting of `font-latex-quotes-internal'.
+ (let ((tail font-latex-quote-list)
+ elt)
+ (while tail
+ (setq elt (car tail))
+ (when (and (> (safe-length elt) 2)
+ (not (eq (nth 2 elt) font-latex-quotes-internal)))
+ (setcar tail (list (nth 1 elt) (nth 0 elt)
+ font-latex-quotes-internal)))
+ (setq tail (cdr tail))))
+ (setq font-latex-quote-regexp-beg
+ (regexp-opt (mapcar 'car font-latex-quote-list) t))))
+
+(defun font-latex-match-quotation (limit)
+ "Match quote patterns up to LIMIT.
+Used for patterns like:
+``this is a normal quote'' and these are multilingual quoted strings:
+\"< french \"> and \"`german\"' quotes.
+The quotes << french >> and 8-bit french are used if `font-latex-quotes' is
+set to french, and >>german<< (and 8-bit) are used if set to german."
+ (when font-latex-quotes
+ (font-latex-update-quote-list)
+ ;; Search for matches.
+ (catch 'match
+ (while (TeX-re-search-forward-unescaped
+ font-latex-quote-regexp-beg limit t)
+ (unless (font-latex-faces-present-p '(font-lock-comment-face
+ font-latex-verbatim-face
+ font-latex-math-face)
+ (match-beginning 0))
+ (let* ((beg (match-beginning 0))
+ (after-beg (match-end 0))
+ (opening-quote (match-string 0))
+ (closing-quote
+ (nth 1 (assoc (if (fboundp 'string-make-multibyte)
+ (string-make-multibyte (match-string 0))
+ (match-string 0))
+ font-latex-quote-list)))
+ (nest-count 0)
+ (point-of-surrender (+ beg font-latex-multiline-boundary)))
+ ;; Find closing quote taking nested quotes into account.
+ (while (progn
+ (re-search-forward
+ (concat opening-quote "\\|" closing-quote)
+ point-of-surrender 'move)
+ (when (and (< (point) point-of-surrender) (not (eobp)))
+ (if (string= (match-string 0) opening-quote)
+ (setq nest-count (1+ nest-count))
+ (when (/= nest-count 0)
+ (setq nest-count (1- nest-count)))))))
+ ;; If no closing quote was found, set the second match which
+ ;; will be marked with warning color, if one was found, set
+ ;; the first match which will be marked with string color.
+ (if (or (= (point) point-of-surrender) (eobp))
+ (progn
+ (goto-char after-beg)
+ (store-match-data (list after-beg after-beg beg after-beg)))
+ (font-latex-put-multiline-property-maybe beg (point))
+ (store-match-data (list beg (point) (point) (point))))
+ (throw 'match t)))))))
+
+(defun font-latex-extend-region-backwards-quotation (beg end)
+ "Return position to extend region backwards for quotations.
+Return nil if region does not have to be extended for a multiline
+quotation to fit in. The region between the positions BEG and
+END marks boundaries for searching for quotation ends."
+ (if font-latex-quotes
+ (progn
+ (font-latex-update-quote-list)
+ (let ((regexp-end (regexp-opt (mapcar 'cadr font-latex-quote-list) t)))
+ (save-excursion
+ (goto-char end)
+ (catch 'extend
+ (while (re-search-backward regexp-end beg t)
+ (let ((closing-quote (match-string 0))
+ (nest-count 0)
+ (point-of-surrender (- beg font-latex-multiline-boundary))
+ opening-quote)
+ (catch 'found
+ (dolist (elt font-latex-quote-list)
+ (when (string= (cadr elt) closing-quote)
+ (setq opening-quote (car elt))
+ (throw 'found nil))))
+ ;; Find opening quote taking nested quotes into account.
+ (while (progn
+ (re-search-backward (concat opening-quote "\\|"
+ closing-quote)
+ point-of-surrender 'move)
+ (when (and (> (point) point-of-surrender)
+ (not (bobp)))
+ (if (string= (match-string 0) closing-quote)
+ (setq nest-count (1+ nest-count))
+ (when (/= nest-count 0)
+ (setq nest-count (1- nest-count)))))))
+ (when (< (point) beg)
+ (throw 'extend (point)))))
+ nil))))
+ nil))
+
+(defun font-latex-match-script (limit)
+ "Match subscript and superscript patterns up to LIMIT."
+ (when (and font-latex-fontify-script
+ (re-search-forward "[_^] *\\([^\n\\{}]\\|\
+\\\\\\([a-zA-Z@]+\\|[^ \t\n]\\)\\|\\({\\)\\)" limit t))
+ (if (font-latex-faces-present-p '(font-latex-subscript-face
+ font-latex-superscript-face))
+ ;; Apply subscript and superscript highlighting only once in
+ ;; order to prevent the font size becoming too small. We set
+ ;; an empty match to do that.
+ (let ((point (point)))
+ (store-match-data (list point point point point)))
+ (when (match-end 3)
+ (let ((beg (match-beginning 3))
+ (end (TeX-find-closing-brace
+ ;; Don't match groups spanning more than one line
+ ;; in order to avoid visually wrong indentation in
+ ;; subsequent lines.
+ nil (line-end-position))))
+ (store-match-data (if end
+ (list (match-beginning 0) end beg end)
+ (list beg beg beg beg))))))
+ t))
+
+;; Copy and adaption of `tex-font-lock-suscript' from tex-mode.el in
+;; GNU Emacs on 2004-07-07.
+(defun font-latex-script (pos)
+ "Return face and display spec for subscript and superscript content."
+ (when (and (font-latex-faces-present-p 'font-latex-math-face pos)
+ (not (font-latex-faces-present-p '(font-lock-constant-face
+ font-lock-builtin-face
+ font-lock-comment-face
+ font-latex-verbatim-face) pos))
+ ;; Check for backslash quoting
+ (not (let ((odd nil)
+ (pos pos))
+ (while (eq (char-before pos) ?\\)
+ (setq pos (1- pos) odd (not odd)))
+ odd)))
+ ;; Adding other text properties than `face' is supported by
+ ;; `font-lock-apply-highlight' in CVS Emacsen since 2001-10-28.
+ ;; With the introduction of this feature the variable
+ ;; `font-lock-extra-managed-props' was introduced and serves here
+ ;; for feature checking. XEmacs (CVS and 21.4.15) currently
+ ;; (2004-08-18) does not support this feature.
+ (let ((extra-props-flag (boundp 'font-lock-extra-managed-props)))
+ (if (eq (char-after pos) ?_)
+ (if extra-props-flag
+ `(face font-latex-subscript-face display
+ ,(car font-latex-script-display))
+ 'font-latex-subscript-face)
+ (if extra-props-flag
+ `(face font-latex-superscript-face display
+ ,(cdr font-latex-script-display))
+ 'font-latex-superscript-face)))))
+
+
+;;; docTeX
+
+(defvar font-latex-doctex-preprocessor-face
+ 'font-latex-doctex-preprocessor-face
+ "Face used to highlight preprocessor directives in docTeX mode.")
+
+(defface font-latex-doctex-preprocessor-face
+ '((t (:inherit (font-latex-doctex-documentation-face
+ font-lock-builtin-face ; Emacs 21 does not provide
+ ; the preprocessor face.
+ font-lock-preprocessor-face))))
+ "Face used to highlight preprocessor directives in docTeX mode."
+ :group 'font-latex-highlighting-faces)
+
+(defvar font-latex-doctex-documentation-face
+ 'font-latex-doctex-documentation-face
+ "Face used to highlight the documentation in docTeX mode.")
+
+(defface font-latex-doctex-documentation-face
+ '((((class mono)) (:inverse-video t))
+ (((class grayscale) (background dark)) (:background "#333"))
+ (((class color) (background dark)) (:background "#333"))
+ (t (:background "#eeeeee")))
+ "Face used to highlight the documentation parts in docTeX mode."
+ :group 'font-latex-highlighting-faces)
+
+(defvar font-latex-doctex-keywords
+ (append font-latex-keywords-2
+ '(("^%<[^>]*>" (0 font-latex-doctex-preprocessor-face t)))))
+
+;; Copy and adaptation of `doctex-font-lock-^^A' in `tex-mode.el' of
+;; CVS Emacs (March 2004)
+(defun font-latex-doctex-^^A ()
+ (if (eq (char-after (line-beginning-position)) ?\%)
+ (progn
+ (put-text-property
+ (1- (match-beginning 1)) (match-beginning 1) 'syntax-table
+ (if (= (1+ (line-beginning-position)) (match-beginning 1))
+ ;; The `%' is a single-char comment, which Emacs
+ ;; syntax-table can't deal with. We could turn it
+ ;; into a non-comment, or use `\n%' or `%^' as the comment.
+ ;; Instead, we include it in the ^^A comment.
+ ;; COMPATIBILITY for Emacs 20 and XEmacs
+ (eval-when-compile (if (fboundp 'string-to-syntax)
+ (string-to-syntax "< b")
+ '(2097163)))
+ ;; COMPATIBILITY for Emacs 20 and XEmacs
+ (eval-when-compile (if (fboundp 'string-to-syntax)
+ (string-to-syntax ">")
+ '(12)))))
+ (let ((end (line-end-position)))
+ (if (< end (point-max))
+ (put-text-property end (1+ end) 'syntax-table
+ ;; COMPATIBILITY for Emacs 20 and XEmacs
+ (eval-when-compile
+ (if (fboundp 'string-to-syntax)
+ (string-to-syntax "> b")
+ '(2097164))))))
+ ;; COMPATIBILITY for Emacs 20 and XEmacs
+ (eval-when-compile (if (fboundp 'string-to-syntax)
+ (string-to-syntax "< b")
+ '(2097163))))))
+
+;; Copy and adaptation of `doctex-font-lock-syntactic-face-function'
+;; in `tex-mode.el' of CVS Emacs (March 2004)
+(defun font-latex-doctex-syntactic-face-function (state)
+ ;; Mark docTeX documentation, which is parsed as a style A comment
+ ;; starting in column 0.
+ (if (or (nth 3 state) (nth 7 state)
+ (not (memq (char-before (nth 8 state))
+ '(?\n nil))))
+ ;; Anything else is just as for LaTeX.
+ (font-latex-syntactic-face-function state)
+ font-latex-doctex-documentation-face))
+
+
+;;; Installation in non-AUCTeX LaTeX mode
+
+(add-hook 'latex-mode-hook 'font-latex-setup)
+;; If font-latex is loaded using a latex-mode-hook, then the add-hook above
+;; won't be called this time around. Check for this now:
+(if (eq major-mode 'latex-mode)
+ (font-latex-setup))
+
+
+;;; Byte-compilation of generated functions
+
+(when (byte-code-function-p
+ (symbol-function 'font-latex-make-built-in-keywords))
+ (dolist (elt font-latex-built-in-keyword-classes)
+ (let ((name (nth 0 elt)))
+ (byte-compile (intern (concat "font-latex-match-" name)))
+ (byte-compile (intern (concat "font-latex-match-" name "-make"))))))
+
+
+;; Provide ourselves:
+(provide 'font-latex)
+
+;; Local Variables:
+;; coding: iso-8859-1
+;; End:
+
+;;; font-latex.el ends here
diff --git a/tests/auctex-11.87.7/latex.el b/tests/auctex-11.87.7/latex.el
new file mode 100644
index 0000000..8bf283a
--- /dev/null
+++ b/tests/auctex-11.87.7/latex.el
@@ -0,0 +1,5601 @@
+;;; latex.el --- Support for LaTeX documents.
+
+;; Copyright (C) 1991, 1993-1997, 1999, 2000, 2003-2012
+;; Free Software Foundation, Inc.
+
+;; Maintainer: auctex-devel@gnu.org
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; This file provides AUCTeX support for LaTeX.
+
+;;; Code:
+
+(require 'tex)
+(require 'tex-style)
+
+;;; Syntax
+
+(defvar LaTeX-optop "["
+ "The LaTeX optional argument opening character.")
+
+(defvar LaTeX-optcl "]"
+ "The LaTeX optional argument closeing character.")
+
+;;; Style
+
+(defcustom LaTeX-default-style "article"
+ "*Default when creating new documents."
+ :group 'LaTeX-environment
+ :type 'string)
+
+(defcustom LaTeX-default-options nil
+ "Default options to documentstyle.
+A list of strings."
+ :group 'LaTeX-environment
+ :type '(repeat (string :format "%v")))
+
+(make-variable-buffer-local 'LaTeX-default-options)
+
+(defcustom LaTeX-insert-into-comments t
+ "*Whether insertion commands stay in comments.
+This allows using the insertion commands even when
+the lines are outcommented, like in dtx files."
+ :group 'LaTeX-environment
+ :type 'boolean)
+
+(defun LaTeX-newline ()
+ "Start a new line potentially staying within comments.
+This depends on `LaTeX-insert-into-comments'."
+ (if LaTeX-insert-into-comments
+ (cond ((and (save-excursion (skip-chars-backward " \t") (bolp))
+ (save-excursion
+ (skip-chars-forward " \t")
+ (looking-at (concat TeX-comment-start-regexp "+"))))
+ (beginning-of-line)
+ (insert (buffer-substring-no-properties
+ (line-beginning-position) (match-end 0)))
+ (newline))
+ ((and (not (bolp))
+ (save-excursion
+ (skip-chars-forward " \t") (not (TeX-escaped-p)))
+ (looking-at
+ (concat "[ \t]*" TeX-comment-start-regexp "+[ \t]*")))
+ (delete-region (match-beginning 0) (match-end 0))
+ (indent-new-comment-line))
+ (t
+ (indent-new-comment-line)))
+ (newline)))
+
+
+;;; Syntax Table
+
+(defvar LaTeX-mode-syntax-table (copy-syntax-table TeX-mode-syntax-table)
+ "Syntax table used in LaTeX mode.")
+
+(progn ; set [] to match for LaTeX.
+ (modify-syntax-entry (string-to-char LaTeX-optop)
+ (concat "(" LaTeX-optcl)
+ LaTeX-mode-syntax-table)
+ (modify-syntax-entry (string-to-char LaTeX-optcl)
+ (concat ")" LaTeX-optop)
+ LaTeX-mode-syntax-table))
+
+;;; Sections
+
+(defun LaTeX-section (arg)
+ "Insert a template for a LaTeX section.
+Determine the type of section to be inserted, by the argument ARG.
+
+If ARG is nil or missing, use the current level.
+If ARG is a list (selected by \\[universal-argument]), go downward one level.
+If ARG is negative, go up that many levels.
+If ARG is positive or zero, use absolute level:
+
+ 0 : part
+ 1 : chapter
+ 2 : section
+ 3 : subsection
+ 4 : subsubsection
+ 5 : paragraph
+ 6 : subparagraph
+
+The following variables can be set to customize:
+
+`LaTeX-section-hook' Hooks to run when inserting a section.
+`LaTeX-section-label' Prefix to all section labels."
+
+ (interactive "*P")
+ (let* ((val (prefix-numeric-value arg))
+ (level (cond ((null arg)
+ (LaTeX-current-section))
+ ((listp arg)
+ (LaTeX-down-section))
+ ((< val 0)
+ (LaTeX-up-section (- val)))
+ (t val)))
+ (name (LaTeX-section-name level))
+ (toc nil)
+ (title (if (TeX-active-mark)
+ (buffer-substring (region-beginning)
+ (region-end))
+ ""))
+ (done-mark (make-marker)))
+ (run-hooks 'LaTeX-section-hook)
+ (LaTeX-newline)
+ (if (marker-position done-mark)
+ (goto-char (marker-position done-mark)))
+ (set-marker done-mark nil)))
+
+(defun LaTeX-current-section ()
+ "Return the level of the section that contain point.
+See also `LaTeX-section' for description of levels."
+ (save-excursion
+ (max (LaTeX-largest-level)
+ (if (re-search-backward (LaTeX-outline-regexp) nil t)
+ (- (LaTeX-outline-level) (LaTeX-outline-offset))
+ (LaTeX-largest-level)))))
+
+(defun LaTeX-down-section ()
+ "Return the value of a section one level under the current.
+Tries to find what kind of section that have been used earlier in the
+text, if this fail, it will just return one less than the current
+section."
+ (save-excursion
+ (let ((current (LaTeX-current-section))
+ (next nil)
+ (regexp (LaTeX-outline-regexp)))
+ (if (not (re-search-backward regexp nil t))
+ (1+ current)
+ (while (not next)
+ (cond
+ ((eq (LaTeX-current-section) current)
+ (if (re-search-forward regexp nil t)
+ (if (<= (setq next (LaTeX-current-section)) current) ;Wow!
+ (setq next (1+ current)))
+ (setq next (1+ current))))
+ ((not (re-search-backward regexp nil t))
+ (setq next (1+ current)))))
+ next))))
+
+(defun LaTeX-up-section (arg)
+ "Return the value of the section ARG levels above this one."
+ (save-excursion
+ (if (zerop arg)
+ (LaTeX-current-section)
+ (let ((current (LaTeX-current-section)))
+ (while (and (>= (LaTeX-current-section) current)
+ (re-search-backward (LaTeX-outline-regexp)
+ nil t)))
+ (LaTeX-up-section (1- arg))))))
+
+(defvar LaTeX-section-list '(("part" 0)
+ ("chapter" 1)
+ ("section" 2)
+ ("subsection" 3)
+ ("subsubsection" 4)
+ ("paragraph" 5)
+ ("subparagraph" 6))
+ "List which elements is the names of the sections used by LaTeX.")
+
+(defun LaTeX-section-list-add-locally (sections &optional clean)
+ "Add SECTIONS to `LaTeX-section-list'.
+SECTIONS can be a single list containing the section macro name
+as a string and the the level as an integer or a list of such
+lists.
+
+If optional argument CLEAN is non-nil, remove any existing
+entries from `LaTeX-section-list' before adding the new ones.
+
+The function will make `LaTeX-section-list' buffer-local and
+invalidate the section submenu in order to let the menu filter
+regenerate it. It is mainly a convenience function which can be
+used in style files."
+ (when (stringp (car sections))
+ (setq sections (list sections)))
+ (make-local-variable 'LaTeX-section-list)
+ (when clean (setq LaTeX-section-list nil))
+ (dolist (elt sections) (add-to-list 'LaTeX-section-list elt t))
+ (setq LaTeX-section-list
+ (sort (copy-sequence LaTeX-section-list)
+ (lambda (a b) (< (nth 1 a) (nth 1 b)))))
+ (setq LaTeX-section-menu nil))
+
+(defun LaTeX-section-name (level)
+ "Return the name of the section corresponding to LEVEL."
+ (let ((entry (TeX-member level LaTeX-section-list
+ (lambda (a b) (equal a (nth 1 b))))))
+ (if entry
+ (nth 0 entry)
+ nil)))
+
+(defun LaTeX-section-level (name)
+ "Return the level of the section NAME."
+ (let ((entry (TeX-member name LaTeX-section-list
+ (lambda (a b) (equal a (nth 0 b))))))
+
+ (if entry
+ (nth 1 entry)
+ nil)))
+
+(defcustom TeX-outline-extra nil
+ "List of extra TeX outline levels.
+
+Each element is a list with two entries. The first entry is the
+regular expression matching a header, and the second is the level of
+the header. See `LaTeX-section-list' for existing header levels."
+ :group 'LaTeX
+ :type '(repeat (group (regexp :tag "Match")
+ (integer :tag "Level"))))
+
+(defun LaTeX-outline-regexp (&optional anywhere)
+ "Return regexp for LaTeX sections.
+
+If optional argument ANYWHERE is not nil, do not require that the
+header is at the start of a line."
+ (concat (if anywhere "" "^")
+ "[ \t]*"
+ (regexp-quote TeX-esc)
+ "\\(appendix\\|documentstyle\\|documentclass\\|"
+ (mapconcat 'car LaTeX-section-list "\\|")
+ "\\)\\b"
+ (if TeX-outline-extra
+ "\\|"
+ "")
+ (mapconcat 'car TeX-outline-extra "\\|")
+ "\\|" TeX-header-end
+ "\\|" TeX-trailer-start))
+
+(defvar LaTeX-largest-level nil
+ "Largest sectioning level with current document class.")
+
+(make-variable-buffer-local 'LaTeX-largest-level)
+
+(defun LaTeX-largest-level ()
+ "Return largest sectioning level with current document class.
+Run style hooks before it has not been done."
+ (TeX-update-style)
+ LaTeX-largest-level)
+
+(defun LaTeX-largest-level-set (section)
+ "Set `LaTeX-largest-level' to the level of SECTION.
+SECTION has to be a string contained in `LaTeX-section-list'.
+Additionally the function will invalidate the section submenu in
+order to let the menu filter regenerate it."
+ (setq LaTeX-largest-level (LaTeX-section-level section))
+ (setq LaTeX-section-menu nil))
+
+(defun LaTeX-outline-offset ()
+ "Offset to add to `LaTeX-section-list' levels to get outline level."
+ (- 2 (LaTeX-largest-level)))
+
+(defun TeX-look-at (list)
+ "Check if we are looking at the first element of a member of LIST.
+If so, return the second element, otherwise return nil."
+ (while (and list
+ (not (looking-at (nth 0 (car list)))))
+ (setq list (cdr list)))
+ (if list
+ (nth 1 (car list))
+ nil))
+
+(defun LaTeX-outline-level ()
+ "Find the level of current outline heading in an LaTeX document."
+ (cond ((looking-at LaTeX-header-end) 1)
+ ((looking-at LaTeX-trailer-start) 1)
+ ((TeX-look-at TeX-outline-extra)
+ (max 1 (+ (TeX-look-at TeX-outline-extra)
+ (LaTeX-outline-offset))))
+ (t
+ (save-excursion
+ (skip-chars-forward " \t")
+ (forward-char 1)
+ (cond ((looking-at "appendix") 1)
+ ((looking-at "documentstyle") 1)
+ ((looking-at "documentclass") 1)
+ ((TeX-look-at LaTeX-section-list)
+ (max 1 (+ (TeX-look-at LaTeX-section-list)
+ (LaTeX-outline-offset))))
+ (t
+ (error "Unrecognized header")))))))
+
+(defun LaTeX-outline-name ()
+ "Guess a name for the current header line."
+ (save-excursion
+ (if (re-search-forward "{\\([^\}]*\\)}" (+ (point) fill-column 10) t)
+ (match-string 1)
+ (buffer-substring (point) (min (point-max) (+ 20 (point)))))))
+
+(add-hook 'TeX-remove-style-hook
+ (lambda () (setq LaTeX-largest-level nil)))
+
+(defcustom LaTeX-section-hook
+ '(LaTeX-section-heading
+ LaTeX-section-title
+;; LaTeX-section-toc ; Most people won't want this
+ LaTeX-section-section
+ LaTeX-section-label)
+ "List of hooks to run when a new section is inserted.
+
+The following variables are set before the hooks are run
+
+level - numeric section level, see the documentation of `LaTeX-section'.
+name - name of the sectioning command, derived from `level'.
+title - The title of the section, default to an empty string.
+toc - Entry for the table of contents list, default nil.
+done-mark - Position of point afterwards, default nil (meaning end).
+
+The following standard hook exist -
+
+LaTeX-section-heading: Query the user about the name of the
+sectioning command. Modifies `level' and `name'.
+
+LaTeX-section-title: Query the user about the title of the
+section. Modifies `title'.
+
+LaTeX-section-toc: Query the user for the toc entry. Modifies
+`toc'.
+
+LaTeX-section-section: Insert LaTeX section command according to
+`name', `title', and `toc'. If `toc' is nil, no toc entry is
+inserted. If `toc' or `title' are empty strings, `done-mark' will be
+placed at the point they should be inserted.
+
+LaTeX-section-label: Insert a label after the section command.
+Controled by the variable `LaTeX-section-label'.
+
+To get a full featured `LaTeX-section' command, insert
+
+ (setq LaTeX-section-hook
+ '(LaTeX-section-heading
+ LaTeX-section-title
+ LaTeX-section-toc
+ LaTeX-section-section
+ LaTeX-section-label))
+
+in your .emacs file."
+ :group 'LaTeX-macro
+ :type 'hook
+ :options '(LaTeX-section-heading
+ LaTeX-section-title
+ LaTeX-section-toc
+ LaTeX-section-section
+ LaTeX-section-label))
+
+
+(defcustom LaTeX-section-label
+ '(("part" . "part:")
+ ("chapter" . "chap:")
+ ("section" . "sec:")
+ ("subsection" . "sec:")
+ ("subsubsection" . "sec:"))
+ "Default prefix when asking for a label.
+
+Some LaTeX packages \(such as `fancyref'\) look at the prefix to generate some
+text around cross-references automatically. When using those packages, you
+should not change this variable.
+
+If it is a string, it it used unchanged for all kinds of sections.
+If it is nil, no label is inserted.
+If it is a list, the list is searched for a member whose car is equal
+to the name of the sectioning command being inserted. The cdr is then
+used as the prefix. If the name is not found, or if the cdr is nil,
+no label is inserted."
+ :group 'LaTeX-label
+ :type '(choice (const :tag "none" nil)
+ (string :format "%v" :tag "Common")
+ (repeat :menu-tag "Level specific"
+ :format "\n%v%i"
+ (cons :format "%v"
+ (string :tag "Type")
+ (choice :tag "Prefix"
+ (const :tag "none" nil)
+ (string :format "%v"))))))
+
+;;; Section Hooks.
+
+(defun LaTeX-section-heading ()
+ "Hook to prompt for LaTeX section name.
+Insert this hook into `LaTeX-section-hook' to allow the user to change
+the name of the sectioning command inserted with `\\[LaTeX-section]'."
+ (let ((string (completing-read
+ (concat "Level: (default " name ") ")
+ LaTeX-section-list
+ nil nil nil)))
+ ; Update name
+ (if (not (zerop (length string)))
+ (setq name string))
+ ; Update level
+ (setq level (LaTeX-section-level name))))
+
+(defun LaTeX-section-title ()
+ "Hook to prompt for LaTeX section title.
+Insert this hook into `LaTeX-section-hook' to allow the user to change
+the title of the section inserted with `\\[LaTeX-section]."
+ (setq title (read-string "Title: " title))
+ (let ((region (and (TeX-active-mark)
+ (cons (region-beginning) (region-end)))))
+ (when region (delete-region (car region) (cdr region)))))
+
+(defun LaTeX-section-toc ()
+ "Hook to prompt for the LaTeX section entry in the table of content .
+Insert this hook into `LaTeX-section-hook' to allow the user to insert
+a different entry for the section in the table of content."
+ (setq toc (read-string "Toc Entry: "))
+ (if (zerop (length toc))
+ (setq toc nil)))
+
+(defun LaTeX-section-section ()
+ "Hook to insert LaTeX section command into the file.
+Insert this hook into `LaTeX-section-hook' after those hooks that set
+the `name', `title', and `toc' variables, but before those hooks that
+assume that the section is already inserted."
+ ;; insert a new line if the current line and the previous line are
+ ;; not empty (except for whitespace), with one exception: do not
+ ;; insert a new line if the previous (or current, sigh) line starts
+ ;; an environment (i.e., starts with `[optional whitespace]\begin')
+ (unless (save-excursion
+ (re-search-backward
+ (concat "^\\s-*\n\\s-*\\=\\|^\\s-*" (regexp-quote TeX-esc)
+ "begin")
+ (line-beginning-position 0) t))
+ (LaTeX-newline))
+ (insert TeX-esc name)
+ (cond ((null toc))
+ ((zerop (length toc))
+ (insert LaTeX-optop)
+ (set-marker done-mark (point))
+ (insert LaTeX-optcl))
+ (t
+ (insert LaTeX-optop toc LaTeX-optcl)))
+ (insert TeX-grop)
+ (if (zerop (length title))
+ (set-marker done-mark (point)))
+ (insert title TeX-grcl)
+ (LaTeX-newline)
+ ;; If RefTeX is available, tell it that we've just made a new section
+ (and (fboundp 'reftex-notice-new-section)
+ (reftex-notice-new-section)))
+
+(defun LaTeX-section-label ()
+ "Hook to insert a label after the sectioning command.
+Insert this hook into `LaTeX-section-hook' to prompt for a label to be
+inserted after the sectioning command.
+
+The behaviour of this hook is controlled by variable `LaTeX-section-label'."
+ (and (LaTeX-label name)
+ (LaTeX-newline)))
+
+;;; Environments
+
+(defgroup LaTeX-environment nil
+ "Environments in AUCTeX."
+ :group 'LaTeX-macro)
+
+(defcustom LaTeX-default-environment "itemize"
+ "*The default environment when creating new ones with `LaTeX-environment'."
+ :group 'LaTeX-environment
+ :type 'string)
+ (make-variable-buffer-local 'LaTeX-default-environment)
+
+(defvar LaTeX-environment-history nil)
+
+;; Variable used to cache the current environment, e.g. for repeated
+;; tasks in an environment, like indenting each line in a paragraph to
+;; be filled. It must not have a non-nil value in general. That
+;; means it is usually let-bound for such operations.
+(defvar LaTeX-current-environment nil)
+
+(defun LaTeX-environment (arg)
+ "Make LaTeX environment (\\begin{...}-\\end{...} pair).
+With optional ARG, modify current environment.
+
+It may be customized with the following variables:
+
+`LaTeX-default-environment' Your favorite environment.
+`LaTeX-default-style' Your favorite document class.
+`LaTeX-default-options' Your favorite document class options.
+`LaTeX-float' Where you want figures and tables to float.
+`LaTeX-table-label' Your prefix to labels in tables.
+`LaTeX-figure-label' Your prefix to labels in figures.
+`LaTeX-default-format' Format for array and tabular.
+`LaTeX-default-width' Width for minipage and tabular*.
+`LaTeX-default-position' Position for array and tabular."
+
+ (interactive "*P")
+ (let ((environment (completing-read (concat "Environment type: (default "
+ (if (TeX-near-bobp)
+ "document"
+ LaTeX-default-environment)
+ ") ")
+ (LaTeX-environment-list)
+ nil nil nil
+ 'LaTeX-environment-history)))
+ ;; Get default
+ (cond ((and (zerop (length environment))
+ (TeX-near-bobp))
+ (setq environment "document"))
+ ((zerop (length environment))
+ (setq environment LaTeX-default-environment))
+ (t
+ (setq LaTeX-default-environment environment)))
+
+ (let ((entry (assoc environment (LaTeX-environment-list))))
+ (if (null entry)
+ (LaTeX-add-environments (list environment)))
+
+ (if arg
+ (LaTeX-modify-environment environment)
+ (LaTeX-environment-menu environment)))))
+
+(defun LaTeX-environment-menu (environment)
+ "Insert ENVIRONMENT around point or region."
+ (let ((entry (assoc environment (LaTeX-environment-list))))
+ (cond ((not (and entry (nth 1 entry)))
+ (LaTeX-insert-environment environment))
+ ((numberp (nth 1 entry))
+ (let ((count (nth 1 entry))
+ (args ""))
+ (while (> count 0)
+ (setq args (concat args TeX-grop TeX-grcl))
+ (setq count (- count 1)))
+ (LaTeX-insert-environment environment args)))
+ ((or (stringp (nth 1 entry)) (vectorp (nth 1 entry)))
+ (let ((prompts (cdr entry))
+ (args ""))
+ (dolist (elt prompts)
+ (let* ((optional (vectorp elt))
+ (elt (if optional (elt elt 0) elt))
+ (arg (read-string (concat (when optional "(Optional) ")
+ elt ": "))))
+ (setq args (concat args
+ (cond ((and optional (> (length arg) 0))
+ (concat LaTeX-optop arg LaTeX-optcl))
+ ((not optional)
+ (concat TeX-grop arg TeX-grcl)))))))
+ (LaTeX-insert-environment environment args)))
+ (t
+ (apply (nth 1 entry) environment (nthcdr 2 entry))))))
+
+(defun LaTeX-close-environment (&optional reopen)
+ "Create an \\end{...} to match the current environment.
+With prefix-argument, reopen environment afterwards."
+ (interactive "*P")
+ (if (> (point)
+ (save-excursion
+ (beginning-of-line)
+ (when LaTeX-insert-into-comments
+ (if (looking-at comment-start-skip)
+ (goto-char (match-end 0))))
+ (skip-chars-forward " \t")
+ (point)))
+ (LaTeX-newline))
+ (let ((environment (LaTeX-current-environment 1)) marker)
+ (insert "\\end{" environment "}")
+ (indent-according-to-mode)
+ (if (or (not (looking-at "[ \t]*$"))
+ (and (TeX-in-commented-line)
+ (save-excursion (beginning-of-line 2)
+ (not (TeX-in-commented-line)))))
+ (LaTeX-newline)
+ (let ((next-line-add-newlines t))
+ (next-line 1)
+ (beginning-of-line)))
+ (indent-according-to-mode)
+ (when reopen
+ (save-excursion
+ (setq marker (point-marker))
+ (set-marker-insertion-type marker t)
+ (LaTeX-environment-menu environment)
+ (delete-region (point)
+ (if (save-excursion (goto-char marker)
+ (bolp))
+ (1- marker)
+ marker))
+ (move-marker marker nil)))))
+
+(defvar LaTeX-after-insert-env-hooks nil
+ "List of functions to be run at the end of `LaTeX-insert-environment'.
+Each function is called with three arguments: the name of the
+environment just inserted, the buffer position just before
+\\begin and the position just before \\end.")
+
+(defun LaTeX-insert-environment (environment &optional extra)
+ "Insert LaTeX ENVIRONMENT with optional argument EXTRA."
+ (let ((active-mark (and (TeX-active-mark) (not (eq (mark) (point)))))
+ prefix content-start env-start env-end)
+ (when (and active-mark (< (mark) (point))) (exchange-point-and-mark))
+ ;; Compute the prefix.
+ (when (and LaTeX-insert-into-comments (TeX-in-commented-line))
+ (save-excursion
+ (beginning-of-line)
+ (looking-at
+ (concat "^\\([ \t]*" TeX-comment-start-regexp "+\\)+[ \t]*"))
+ (setq prefix (match-string 0))))
+ ;; What to do with the line containing point.
+ (cond ((save-excursion (beginning-of-line)
+ (looking-at (concat prefix "[ \t]*$")))
+ (delete-region (match-beginning 0) (match-end 0)))
+ ((TeX-looking-at-backward (concat "^" prefix "[ \t]*")
+ (line-beginning-position))
+ (beginning-of-line)
+ (newline)
+ (beginning-of-line 0))
+ ((bolp)
+ (delete-horizontal-space)
+ (newline)
+ (beginning-of-line 0))
+ (t
+ (delete-horizontal-space)
+ (newline 2)
+ (when prefix (insert prefix))
+ (beginning-of-line 0)))
+ ;; What to do with the line containing mark.
+ (when active-mark
+ (save-excursion
+ (goto-char (mark))
+ (cond ((save-excursion (beginning-of-line)
+ (or (looking-at (concat prefix "[ \t]*$"))
+ (looking-at "[ \t]*$")))
+ (delete-region (match-beginning 0) (match-end 0)))
+ ((TeX-looking-at-backward (concat "^" prefix "[ \t]*")
+ (line-beginning-position))
+ (beginning-of-line)
+ (newline)
+ (beginning-of-line 0))
+ (t
+ (delete-horizontal-space)
+ (insert-before-markers "\n")
+ (newline)
+ (when prefix (insert prefix))))))
+ ;; Now insert the environment.
+ (when prefix (insert prefix))
+ (setq env-start (point))
+ (insert TeX-esc "begin" TeX-grop environment TeX-grcl)
+ (indent-according-to-mode)
+ (when extra (insert extra))
+ (setq content-start (line-beginning-position 2))
+ (unless active-mark
+ (newline)
+ (when prefix (insert prefix))
+ (newline))
+ (when active-mark (goto-char (mark)))
+ (when prefix (insert prefix))
+ (setq env-end (point))
+ (insert TeX-esc "end" TeX-grop environment TeX-grcl)
+ (end-of-line 0)
+ (if active-mark
+ (progn
+ (or (assoc environment LaTeX-indent-environment-list)
+ (LaTeX-fill-region content-start (line-beginning-position 2)))
+ (set-mark content-start))
+ (indent-according-to-mode))
+ (save-excursion (beginning-of-line 2) (indent-according-to-mode))
+ (TeX-math-input-method-off)
+ (run-hook-with-args 'LaTeX-after-insert-env-hooks
+ environment env-start env-end)))
+
+(defun LaTeX-modify-environment (environment)
+ "Modify current ENVIRONMENT."
+ (save-excursion
+ (LaTeX-find-matching-end)
+ (re-search-backward (concat (regexp-quote TeX-esc)
+ "end"
+ (regexp-quote TeX-grop)
+ " *\\([a-zA-Z*]*\\)"
+ (regexp-quote TeX-grcl))
+ (save-excursion (beginning-of-line 1) (point)))
+ (replace-match (concat TeX-esc "end" TeX-grop environment TeX-grcl) t t)
+ (beginning-of-line 1)
+ (LaTeX-find-matching-begin)
+ (re-search-forward (concat (regexp-quote TeX-esc)
+ "begin"
+ (regexp-quote TeX-grop)
+ " *\\([a-zA-Z*]*\\)"
+ (regexp-quote TeX-grcl))
+ (save-excursion (end-of-line 1) (point)))
+ (replace-match (concat TeX-esc "begin" TeX-grop environment TeX-grcl) t
t)))
+
+(defun LaTeX-current-environment (&optional arg)
+ "Return the name (a string) of the enclosing LaTeX environment.
+With optional ARG>=1, find that outer level.
+
+If function is called inside a comment and
+`LaTeX-syntactic-comments' is enabled, try to find the
+environment in commented regions with the same comment prefix.
+
+The functions `LaTeX-find-matching-begin' and `LaTeX-find-matching-end'
+work analogously."
+ (setq arg (if arg (if (< arg 1) 1 arg) 1))
+ (let* ((in-comment (TeX-in-commented-line))
+ (comment-prefix (and in-comment (TeX-comment-prefix))))
+ (save-excursion
+ (while (and (/= arg 0)
+ (re-search-backward
+ "\\\\\\(begin\\|end\\) *{ *\\([A-Za-z*]+\\) *}" nil t))
+ (when (or (and LaTeX-syntactic-comments
+ (eq in-comment (TeX-in-commented-line))
+ (or (not in-comment)
+ ;; Consider only matching prefixes in the
+ ;; commented case.
+ (string= comment-prefix (TeX-comment-prefix))))
+ (and (not LaTeX-syntactic-comments)
+ (not (TeX-in-commented-line))))
+ (setq arg (if (string= (match-string 1) "end") (1+ arg) (1- arg)))))
+ (if (/= arg 0)
+ "document"
+ (match-string-no-properties 2)))))
+
+(defun docTeX-in-macrocode-p ()
+ "Determine if point is inside a macrocode environment."
+ (save-excursion
+ (re-search-backward
+ (concat "^% " (regexp-quote TeX-esc)
+ "\\(begin\\|end\\)[ \t]*{macrocode\\*?}") nil 'move)
+ (not (or (bobp)
+ (= (char-after (match-beginning 1)) ?e)))))
+
+
+;;; Environment Hooks
+
+(defvar LaTeX-document-style-hook nil
+ "List of hooks to run when inserting a document environment.
+
+To insert a hook here, you must insert it in the appropiate style file.")
+
+(defun LaTeX-env-document (&optional ignore)
+ "Create new LaTeX document.
+The compatibility argument IGNORE is ignored."
+ (TeX-insert-macro "documentclass")
+ (LaTeX-newline)
+ (LaTeX-newline)
+ (LaTeX-newline)
+ (end-of-line 0)
+ (LaTeX-insert-environment "document")
+ (run-hooks 'LaTeX-document-style-hook)
+ (setq LaTeX-document-style-hook nil))
+
+(defcustom LaTeX-float ""
+ "Default float position for figures and tables.
+If nil, act like the empty string is given, but do not prompt.
+\(The standard LaTeX classes use [tbp] as float position if the
+optional argument is omitted.)"
+ :group 'LaTeX-environment
+ :type '(choice (const :tag "Do not prompt" nil)
+ (const :tag "Empty" "")
+ (string :format "%v")))
+(make-variable-buffer-local 'LaTeX-float)
+
+(defcustom LaTeX-top-caption-list nil
+ "*List of float environments with top caption."
+ :group 'LaTeX-environment
+ :type '(repeat (string :format "%v")))
+
+(defgroup LaTeX-label nil
+ "Adding labels for LaTeX commands in AUCTeX."
+ :group 'LaTeX)
+
+(defcustom LaTeX-label-function nil
+ "*A function inserting a label at point.
+Sole argument of the function is the environment. The function has to return
+the label inserted, or nil if no label was inserted."
+ :group 'LaTeX-label
+ :type 'function)
+
+(defcustom LaTeX-figure-label "fig:"
+ "*Default prefix to figure labels."
+ :group 'LaTeX-label
+ :group 'LaTeX-environment
+ :type 'string)
+
+(defcustom LaTeX-table-label "tab:"
+ "*Default prefix to table labels."
+ :group 'LaTeX-label
+ :group 'LaTeX-environment
+ :type 'string)
+
+(defcustom LaTeX-default-format ""
+ "Default format for array and tabular environments."
+ :group 'LaTeX-environment
+ :type 'string)
+(make-variable-buffer-local 'LaTeX-default-format)
+
+(defcustom LaTeX-default-width "1.0\\linewidth"
+ "Default width for minipage and tabular* environments."
+ :group 'LaTeX-environment
+ :type 'string)
+(make-variable-buffer-local 'LaTeX-default-width)
+
+(defcustom LaTeX-default-position ""
+ "Default position for array and tabular environments.
+If nil, act like the empty string is given, but do not prompt."
+ :group 'LaTeX-environment
+ :type '(choice (const :tag "Do not prompt" nil)
+ (const :tag "Empty" "")
+ string))
+(make-variable-buffer-local 'LaTeX-default-position)
+
+(defcustom LaTeX-equation-label "eq:"
+ "*Default prefix to equation labels."
+ :group 'LaTeX-label
+ :type 'string)
+
+(defcustom LaTeX-eqnarray-label LaTeX-equation-label
+ "*Default prefix to eqnarray labels."
+ :group 'LaTeX-label
+ :type 'string)
+
+(defun LaTeX-env-item (environment)
+ "Insert ENVIRONMENT and the first item."
+ (LaTeX-insert-environment environment)
+ (if (TeX-active-mark)
+ (progn
+ (LaTeX-find-matching-begin)
+ (end-of-line 1))
+ (end-of-line 0))
+ (delete-char 1)
+ (when (looking-at (concat "^[ \t]+$\\|"
+ "^[ \t]*" TeX-comment-start-regexp "+[ \t]*$"))
+ (delete-region (point) (line-end-position)))
+ (delete-horizontal-space)
+ ;; Deactivate the mark here in order to prevent `TeX-parse-macro'
+ ;; from swapping point and mark and the \item ending up right after
+ ;; \begin{...}.
+ (TeX-deactivate-mark)
+ (LaTeX-insert-item)
+ ;; The inserted \item may have outdented the first line to the
+ ;; right. Fill it, if appropriate.
+ (when (and (not (looking-at "$"))
+ (not (assoc environment LaTeX-indent-environment-list))
+ (> (- (line-end-position) (line-beginning-position))
+ (current-fill-column)))
+ (LaTeX-fill-paragraph nil)))
+
+(defcustom LaTeX-label-alist
+ '(("figure" . LaTeX-figure-label)
+ ("table" . LaTeX-table-label)
+ ("figure*" . LaTeX-figure-label)
+ ("table*" . LaTeX-table-label)
+ ("equation" . LaTeX-equation-label)
+ ("eqnarray" . LaTeX-eqnarray-label))
+ "Lookup prefixes for labels.
+An alist where the CAR is the environment name, and the CDR
+either the prefix or a symbol referring to one."
+ :group 'LaTeX-label
+ :type '(repeat (cons (string :tag "Environment")
+ (choice (string :tag "Label prefix")
+ (symbol :tag "Label prefix symbol")))))
+
+(make-variable-buffer-local 'LaTeX-label-alist)
+
+(defun LaTeX-label (environment)
+ "Insert a label for ENVIRONMENT at point.
+If `LaTeX-label-function' is a valid function, LaTeX label will transfer the
+job to this function."
+ (let (label)
+ (if (and (boundp 'LaTeX-label-function)
+ LaTeX-label-function
+ (fboundp LaTeX-label-function))
+
+ (setq label (funcall LaTeX-label-function environment))
+ (let ((prefix
+ (or (cdr (assoc environment LaTeX-label-alist))
+ (if (assoc environment LaTeX-section-list)
+ (if (stringp LaTeX-section-label)
+ LaTeX-section-label
+ (and (listp LaTeX-section-label)
+ (cdr (assoc environment LaTeX-section-label))))
+ ""))))
+ (when prefix
+ (when (symbolp prefix)
+ (setq prefix (symbol-value prefix)))
+ ;; Use completing-read as we do with `C-c C-m \label RET'
+ (setq label (completing-read
+ (TeX-argument-prompt t nil "What label")
+ (LaTeX-label-list) nil nil prefix))
+ ;; No label or empty string entered?
+ (if (or (string= prefix label)
+ (string= "" label))
+ (setq label nil)
+ (insert TeX-esc "label" TeX-grop label TeX-grcl))))
+ (if label
+ (progn
+ (LaTeX-add-labels label)
+ label)
+ nil))))
+
+(defun LaTeX-env-figure (environment)
+ "Create ENVIRONMENT with \\caption and \\label commands."
+ (let ((float (and LaTeX-float ; LaTeX-float can be nil, i.e.
+ ; do not prompt
+ (read-string "(Optional) Float position: " LaTeX-float)))
+ (caption (read-string "Caption: "))
+ (center (y-or-n-p "Center? "))
+ (active-mark (and (TeX-active-mark)
+ (not (eq (mark) (point)))))
+ start-marker end-marker)
+ (when active-mark
+ (if (< (mark) (point))
+ (exchange-point-and-mark))
+ (setq start-marker (point-marker))
+ (set-marker-insertion-type start-marker t)
+ (setq end-marker (copy-marker (mark))))
+ (setq LaTeX-float float)
+ (LaTeX-insert-environment environment
+ (unless (zerop (length float))
+ (concat LaTeX-optop float
+ LaTeX-optcl)))
+ (when active-mark (goto-char start-marker))
+ (when center
+ (insert TeX-esc "centering")
+ (indent-according-to-mode)
+ (LaTeX-newline))
+ (if (member environment LaTeX-top-caption-list)
+ ;; top caption -- do nothing if user skips caption
+ (unless (zerop (length caption))
+ (insert TeX-esc "caption" TeX-grop caption TeX-grcl)
+ (LaTeX-newline)
+ (indent-according-to-mode)
+ ;; ask for a label and insert a new line only if a label is
+ ;; actually inserted
+ (when (LaTeX-label environment)
+ (LaTeX-newline)
+ (indent-according-to-mode)))
+ ;; bottom caption (default) -- do nothing if user skips caption
+ (unless (zerop (length caption))
+ (when active-mark (goto-char end-marker))
+ (LaTeX-newline)
+ (indent-according-to-mode)
+ (insert TeX-esc "caption" TeX-grop caption TeX-grcl)
+ (LaTeX-newline)
+ (indent-according-to-mode)
+ ;; ask for a label -- if user skips label, remove the last new
+ ;; line again
+ (if (LaTeX-label environment)
+ (progn
+ (unless (looking-at "[ \t]*$")
+ (LaTeX-newline)
+ (end-of-line 0)))
+ (delete-blank-lines)
+ (end-of-line 0))
+ ;; if there is a caption or a label, move point upwards again
+ ;; so that it is placed above the caption or the label (or
+ ;; both) -- search the current line (even long captions are
+ ;; inserted on a single line, even if auto-fill is turned on,
+ ;; so it is enough to search the current line) for \label or
+ ;; \caption and go one line upwards if any of them is found
+ (while (re-search-backward
+ (concat "^\\s-*" (regexp-quote TeX-esc)
+ "\\(label\\|caption\\)")
+ (line-beginning-position) t)
+ (end-of-line 0)
+ (indent-according-to-mode))))
+ (when (and (member environment '("table" "table*"))
+ ;; Suppose an existing tabular environment should just
+ ;; be wrapped into a table if there is an active region.
+ (not active-mark))
+ (LaTeX-env-array "tabular"))))
+
+(defun LaTeX-env-array (environment)
+ "Insert ENVIRONMENT with position and column specifications.
+Just like array and tabular."
+ (let ((pos (and LaTeX-default-position ; LaTeX-default-position can
+ ; be nil, i.e. do not prompt
+ (read-string "(Optional) Position: " LaTeX-default-position)))
+ (fmt (read-string "Format: " LaTeX-default-format)))
+ (setq LaTeX-default-position pos)
+ (setq LaTeX-default-format fmt)
+ (LaTeX-insert-environment environment
+ (concat
+ (unless (zerop (length pos))
+ (concat LaTeX-optop pos LaTeX-optcl))
+ (concat TeX-grop fmt TeX-grcl)))))
+
+(defun LaTeX-env-label (environment)
+ "Insert ENVIRONMENT and prompt for label."
+ (LaTeX-insert-environment environment)
+ (when (LaTeX-label environment)
+ (LaTeX-newline)
+ (indent-according-to-mode)))
+
+(defun LaTeX-env-list (environment)
+ "Insert ENVIRONMENT and the first item."
+ (let ((label (read-string "Default Label: ")))
+ (LaTeX-insert-environment environment
+ (format "{%s}{}" label))
+ (end-of-line 0)
+ (delete-char 1)
+ (delete-horizontal-space))
+ (LaTeX-insert-item))
+
+(defun LaTeX-env-minipage (environment)
+ "Create new LaTeX minipage or minipage-like ENVIRONMENT."
+ (let ((pos (and LaTeX-default-position ; LaTeX-default-position can
+ ; be nil, i.e. do not prompt
+ (read-string "(Optional) Position: " LaTeX-default-position)))
+ (width (read-string "Width: " LaTeX-default-width)))
+ (setq LaTeX-default-position pos)
+ (setq LaTeX-default-width width)
+ (LaTeX-insert-environment environment
+ (concat
+ (unless (zerop (length pos))
+ (concat LaTeX-optop pos LaTeX-optcl))
+ (concat TeX-grop width TeX-grcl)))))
+
+(defun LaTeX-env-tabular* (environment)
+ "Insert ENVIRONMENT with width, position and column specifications."
+ (let ((width (read-string "Width: " LaTeX-default-width))
+ (pos (and LaTeX-default-position ; LaTeX-default-position can
+ ; be nil, i.e. do not prompt
+ (read-string "(Optional) Position: " LaTeX-default-position)))
+ (fmt (read-string "Format: " LaTeX-default-format)))
+ (setq LaTeX-default-width width)
+ (setq LaTeX-default-position pos)
+ (setq LaTeX-default-format fmt)
+ (LaTeX-insert-environment environment
+ (concat
+ (concat TeX-grop width TeX-grcl) ;; not optional!
+ (unless (zerop (length pos))
+ (concat LaTeX-optop pos LaTeX-optcl))
+ (concat TeX-grop fmt TeX-grcl)))))
+
+(defun LaTeX-env-picture (environment)
+ "Insert ENVIRONMENT with width, height specifications."
+ (let ((width (read-string "Width: "))
+ (height (read-string "Height: "))
+ (x-offset (read-string "X Offset: "))
+ (y-offset (read-string "Y Offset: ")))
+ (if (zerop (length x-offset))
+ (setq x-offset "0"))
+ (if (zerop (length y-offset))
+ (setq y-offset "0"))
+ (LaTeX-insert-environment environment
+ (concat
+ (format "(%s,%s)" width height)
+ (if (not (and (string= x-offset "0")
+ (string= y-offset "0")))
+ (format "(%s,%s)" x-offset y-offset))))))
+
+(defun LaTeX-env-bib (environment)
+ "Insert ENVIRONMENT with label for bibitem."
+ (LaTeX-insert-environment environment
+ (concat TeX-grop
+ (read-string "Label for BibItem: " "99")
+ TeX-grcl))
+ (end-of-line 0)
+ (delete-char 1)
+ (delete-horizontal-space)
+ (LaTeX-insert-item))
+
+(defun LaTeX-env-contents (environment)
+ "Insert ENVIRONMENT with filename for contents."
+ (save-excursion
+ (when (re-search-backward "^\\\\documentclass.*{" nil t)
+ (error "Put %s environment before \\documentclass" environment)))
+ (LaTeX-insert-environment environment
+ (concat TeX-grop
+ (read-string "File: ")
+ TeX-grcl))
+ (delete-horizontal-space))
+
+(defun LaTeX-env-args (environment &rest args)
+ "Insert ENVIRONMENT and arguments defined by ARGS."
+ (LaTeX-insert-environment environment)
+ (save-excursion
+ (LaTeX-find-matching-begin)
+ (end-of-line)
+ (TeX-parse-arguments args)))
+
+;;; Item hooks
+
+(defvar LaTeX-item-list nil
+ "A list of environments where items have a special syntax.
+The cdr is the name of the function, used to insert this kind of items.")
+
+(defun LaTeX-insert-item ()
+ "Insert a new item in an environment.
+You may use `LaTeX-item-list' to change the routines used to insert the item."
+ (interactive "*")
+ (let ((environment (LaTeX-current-environment)))
+ (when (and (TeX-active-mark)
+ (> (point) (mark)))
+ (exchange-point-and-mark))
+ (unless (bolp) (LaTeX-newline))
+ (if (assoc environment LaTeX-item-list)
+ (funcall (cdr (assoc environment LaTeX-item-list)))
+ (TeX-insert-macro "item"))
+ (indent-according-to-mode)))
+
+(defun LaTeX-item-argument ()
+ "Insert a new item with an optional argument."
+ (let ((TeX-arg-item-label-p t))
+ (TeX-insert-macro "item")))
+
+(defun LaTeX-item-bib ()
+ "Insert a new bibitem."
+ (TeX-insert-macro "bibitem"))
+
+;;; Parser
+
+(defvar LaTeX-auto-minimal-regexp-list
+ '(("\\\\document\\(style\\|class\\)\
+\\(\\[\\(\\([^#\\%]\\|%[^\n\r]*[\n\r]\\)*\\)\\]\\)?\
+{\\([^#\\.\n\r]+?\\)}"
+ (3 5 1) LaTeX-auto-style)
+ ("\\\\use\\(package\\)\\(\\[\\([^\]\\]*\\)\\]\\)?\
+{\\(\\([^#}\\.%]\\|%[^\n\r]*[\n\r]\\)+?\\)}"
+ (3 4 1) LaTeX-auto-style))
+ "Minimal list of regular expressions matching LaTeX macro definitions.")
+
+(defvar LaTeX-auto-label-regexp-list
+ '(("\\\\label{\\([^\n\r%\\{}]+\\)}" 1 LaTeX-auto-label))
+ "List of regular expression matching LaTeX labels only.")
+
+(defvar LaTeX-auto-index-regexp-list
+
'(("\\\\\\(index\\|glossary\\){\\([^}{]*\\({[^}{]*\\({[^}{]*\\({[^}{]*}[^}{]*\\)*}[^}{]*\\)*}[^}{]*\\)*\\)}"
+ 2 LaTeX-auto-index-entry))
+ "List of regular expression matching LaTeX index/glossary entries only.
+Regexp allows for up to 3 levels of parenthesis inside the index argument.
+This is necessary since index entries may contain commands and stuff.")
+
+(defvar LaTeX-auto-class-regexp-list
+ '(;; \RequirePackage[<options>]{<package>}[<date>]
+ ("\\\\Require\\(Package\\)\\(\\[\\([^#\\.%]*?\\)\\]\\)?\
+{\\([^#\\.\n\r]+?\\)}"
+ (3 4 1) LaTeX-auto-style)
+ ;; \RequirePackageWithOptions{<package>}[<date>],
+ ("\\\\Require\\(Package\\)WithOptions\\(\\){\\([^#\\.\n\r]+?\\)}"
+ (2 3 1) LaTeX-auto-style)
+ ;; \LoadClass[<options>]{<package>}[<date>]
+ ("\\\\Load\\(Class\\)\\(\\[\\([^#\\.%]*?\\)\\]\\)?{\\([^#\\.\n\r]+?\\)}"
+ (3 4 1) LaTeX-auto-style)
+ ;; \LoadClassWithOptions{<package>}[<date>]
+ ("\\\\Load\\(Class\\)WithOptions\\(\\){\\([^#\\.\n\r]+?\\)}"
+ (2 3 1) LaTeX-auto-style)
+ ;; \DeclareRobustCommand{<cmd>}[<num>][<default>]{<definition>},
+ ;; \DeclareRobustCommand*{<cmd>}[<num>][<default>]{<definition>}
+ ("\\\\DeclareRobustCommand\\*?{?\\\\\\([A-Za-z]+\\)}?\
+\\[\\([0-9]+\\)\\]\\[\\([^\n\r]*?\\)\\]"
+ (1 2 3) LaTeX-auto-optional)
+ ("\\\\DeclareRobustCommand\\*?{?\\\\\\([A-Za-z]+\\)}?\\[\\([0-9]+\\)\\]"
+ (1 2) LaTeX-auto-arguments)
+ ("\\\\DeclareRobustCommand\\*?{?\\\\\\([A-Za-z]+\\)}?"
+ 1 TeX-auto-symbol)
+ ;; Patterns for commands described in "LaTeX2e font selection" (fntguide)
+ ("\\\\DeclareMath\\(?:Symbol\\|Delimiter\\|Accent\\|Radical\\)\
+{?\\\\\\([A-Za-z]+\\)}?"
+ 1 TeX-auto-symbol)
+ ("\\\\\\(Declare\\|Provide\\)Text\
+\\(?:Command\\|Symbol\\|Accent\\|Composite\\){?\\\\\\([A-Za-z]+\\)}?"
+ 1 TeX-auto-symbol)
+ ("\\\\Declare\\(?:Text\\|Old\\)FontCommand{?\\\\\\([A-Za-z]+\\)}?"
+ 1 TeX-auto-symbol))
+ "List of regular expressions matching macros in LaTeX classes and packages.")
+
+(defvar LaTeX-auto-regexp-list
+ (append
+ (let ((token TeX-token-char))
+ `((,(concat "\\\\\\(?:new\\|provide\\)command\\*?{?\\\\\\(" token
"+\\)}?\\[\\([0-9]+\\)\\]\\[\\([^\n\r]*\\)\\]")
+ (1 2 3) LaTeX-auto-optional)
+ (,(concat "\\\\\\(?:new\\|provide\\)command\\*?{?\\\\\\(" token
"+\\)}?\\[\\([0-9]+\\)\\]")
+ (1 2) LaTeX-auto-arguments)
+ (,(concat "\\\\\\(?:new\\|provide\\)command\\*?{?\\\\\\(" token
"+\\)}?")
+ 1 TeX-auto-symbol)
+ (,(concat "\\\\newenvironment\\*?{?\\(" token
"+\\)}?\\[\\([0-9]+\\)\\]\\[")
+ 1 LaTeX-auto-environment)
+ (,(concat "\\\\newenvironment\\*?{?\\(" token
"+\\)}?\\[\\([0-9]+\\)\\]")
+ (1 2) LaTeX-auto-env-args)
+ (,(concat "\\\\newenvironment\\*?{?\\(" token "+\\)}?")
+ 1 LaTeX-auto-environment)
+ (,(concat "\\\\newtheorem{\\(" token "+\\)}") 1 LaTeX-auto-environment)
+ ("\\\\input{\\(\\.*[^#}%\\\\\\.\n\r]+\\)\\(\\.[^#}%\\\\\\.\n\r]+\\)?}"
+ 1 TeX-auto-file)
+ ("\\\\include{\\(\\.*[^#}%\\\\\\.\n\r]+\\)\\(\\.[^#}%\\\\\\.\n\r]+\\)?}"
+ 1 TeX-auto-file)
+ (, (concat "\\\\bibitem{\\(" token "[^, \n\r\t%\"#'()={}]*\\)}")
+ 1 LaTeX-auto-bibitem)
+ (, (concat "\\\\bibitem\\[[^][\n\r]+\\]{\\(" token "[^,
\n\r\t%\"#'()={}]*\\)}")
+ 1 LaTeX-auto-bibitem)
+ ("\\\\bibliography{\\([^#}\\\\\n\r]+\\)}" 1 LaTeX-auto-bibliography)
+ ("\\\\addbibresource\\(?:\\[[^]]+\\]\\)?{\\([^#}\\\\\n\r\.]+\\)\\..+}"
+ 1 LaTeX-auto-bibliography)
+
("\\\\add\\(?:global\\|section\\)bib\\(?:\\[[^]]+\\]\\)?{\\([^#}\\\\\n\r\.]+\\)\\(?:\\..+\\)?}"
1 LaTeX-auto-bibliography)
+ ("\\\\newrefsection\\[\\([^]]+\\)\\]" 1 LaTeX-split-bibs)
+ ("\\\\begin{refsection}\\[\\([^]]+\\)\\]" 1 LaTeX-split-bibs)))
+ LaTeX-auto-class-regexp-list
+ LaTeX-auto-label-regexp-list
+ LaTeX-auto-index-regexp-list
+ LaTeX-auto-minimal-regexp-list)
+ "List of regular expression matching common LaTeX macro definitions.")
+
+(defun LaTeX-split-bibs (match)
+ "Extract bibliography resources from MATCH.
+Split the string at commas and remove Biber file extensions."
+ (let ((bibs (TeX-split-string " *, *" (TeX-match-buffer match))))
+ (dolist (bib bibs)
+ (LaTeX-add-bibliographies (replace-regexp-in-string
+ (concat "\\(?:\\."
+ (mapconcat 'regexp-quote
+ TeX-Biber-file-extensions
+ "\\|\\.")
+ "\\)")
+ "" bib)))))
+
+(defun LaTeX-auto-prepare ()
+ "Prepare for LaTeX parsing."
+ (setq LaTeX-auto-arguments nil
+ LaTeX-auto-optional nil
+ LaTeX-auto-env-args nil
+ LaTeX-auto-style nil
+ LaTeX-auto-end-symbol nil))
+
+(add-hook 'TeX-auto-prepare-hook 'LaTeX-auto-prepare)
+
+(defun LaTeX-listify-package-options (options)
+ "Return a list from a comma-separated string of package OPTIONS.
+The input string may include LaTeX comments and newlines."
+ ;; We jump through all those hoops and don't just use `split-string'
+ ;; or the like in order to be able to deal with key=value package
+ ;; options which can look like this: "pdftitle={A Perfect Day},
+ ;; colorlinks=false"
+ (let (opts match start)
+ (with-temp-buffer
+ (set-syntax-table LaTeX-mode-syntax-table)
+ (insert options)
+ (newline) ; So that the last entry can be found.
+ (goto-char (point-min))
+ (setq start (point))
+ (while (re-search-forward "[{ ,%\n\r]" nil t)
+ (setq match (match-string 0))
+ (cond
+ ;; Step over groups. (Let's hope nobody uses escaped braces.)
+ ((string= match "{")
+ (up-list))
+ ;; Get rid of whitespace.
+ ((string= match " ")
+ (delete-region (1- (point))
+ (save-excursion
+ (skip-chars-forward " ")
+ (point))))
+ ;; Add entry to output.
+ ((or (string= match ",") (= (point) (point-max)))
+ (add-to-list 'opts (buffer-substring-no-properties
+ start (1- (point))) t)
+ (setq start (point)))
+ ;; Get rid of comments.
+ ((string= match "%")
+ (delete-region (1- (point))
+ (line-beginning-position 2)))
+ ;; Get rid of newlines.
+ ((or (string= match "\n") (string= match "\r"))
+ (delete-backward-char 1)))))
+ opts))
+
+(defun LaTeX-auto-cleanup ()
+ "Cleanup after LaTeX parsing."
+
+ ;; Cleanup BibTeX/Biber files
+ (setq LaTeX-auto-bibliography
+ (apply 'append (mapcar (lambda (arg)
+ (TeX-split-string "," arg))
+ LaTeX-auto-bibliography)))
+
+ ;; Cleanup document classes and packages
+ (unless (null LaTeX-auto-style)
+ (while LaTeX-auto-style
+ (let* ((entry (car LaTeX-auto-style))
+ (options (nth 0 entry))
+ (style (nth 1 entry))
+ (class (nth 2 entry)))
+
+ ;; Next document style.
+ (setq LaTeX-auto-style (cdr LaTeX-auto-style))
+
+ ;; Get the options.
+ (setq options (LaTeX-listify-package-options options))
+
+ ;; Add them, to the style list.
+ (dolist (elt options)
+ (add-to-list 'TeX-auto-file elt))
+
+ ;; Treat documentclass/documentstyle specially.
+ (if (or (string-equal "package" class)
+ (string-equal "Package" class))
+ (dolist (elt (TeX-split-string
+ "\\([ \t\r\n]\\|%[^\n\r]*[\n\r]\\|,\\)+" style))
+ (add-to-list 'TeX-auto-file elt))
+ ;; And a special "art10" style file combining style and size.
+ (add-to-list 'TeX-auto-file style)
+ (add-to-list 'TeX-auto-file
+ (concat
+ (cond ((string-equal "article" style)
+ "art")
+ ((string-equal "book" style)
+ "bk")
+ ((string-equal "report" style)
+ "rep")
+ ((string-equal "jarticle" style)
+ "jart")
+ ((string-equal "jbook" style)
+ "jbk")
+ ((string-equal "jreport" style)
+ "jrep")
+ ((string-equal "j-article" style)
+ "j-art")
+ ((string-equal "j-book" style)
+ "j-bk")
+ ((string-equal "j-report" style )
+ "j-rep")
+ (t style))
+ (cond ((member "11pt" options)
+ "11")
+ ((member "12pt" options)
+ "12")
+ (t
+ "10")))))
+
+ ;; The third argument if "class" indicates LaTeX2e features.
+ (cond ((equal class "class")
+ (add-to-list 'TeX-auto-file "latex2e"))
+ ((equal class "style")
+ (add-to-list 'TeX-auto-file "latex2"))))))
+
+ ;; Cleanup optional arguments
+ (mapc (lambda (entry)
+ (add-to-list 'TeX-auto-symbol
+ (list (nth 0 entry)
+ (string-to-number (nth 1 entry)))))
+ LaTeX-auto-arguments)
+
+ ;; Cleanup default optional arguments
+ (mapc (lambda (entry)
+ (add-to-list 'TeX-auto-symbol
+ (list (nth 0 entry)
+ (vector "argument")
+ (1- (string-to-number (nth 1 entry))))))
+ LaTeX-auto-optional)
+
+ ;; Cleanup environments arguments
+ (mapc (lambda (entry)
+ (add-to-list 'LaTeX-auto-environment
+ (list (nth 0 entry)
+ (string-to-number (nth 1 entry)))))
+ LaTeX-auto-env-args)
+
+ ;; Cleanup use of def to add environments
+ ;; NOTE: This uses an O(N^2) algorithm, while an O(N log N)
+ ;; algorithm is possible.
+ (mapc (lambda (symbol)
+ (if (not (TeX-member symbol TeX-auto-symbol 'equal))
+ ;; No matching symbol, insert in list
+ (add-to-list 'TeX-auto-symbol (concat "end" symbol))
+ ;; Matching symbol found, remove from list
+ (if (equal (car TeX-auto-symbol) symbol)
+ ;; Is it the first symbol?
+ (setq TeX-auto-symbol (cdr TeX-auto-symbol))
+ ;; Nope! Travel the list
+ (let ((list TeX-auto-symbol))
+ (while (consp (cdr list))
+ ;; Until we find it.
+ (if (equal (car (cdr list)) symbol)
+ ;; Then remove it.
+ (setcdr list (cdr (cdr list))))
+ (setq list (cdr list)))))
+ ;; and add the symbol as an environment.
+ (add-to-list 'LaTeX-auto-environment symbol)))
+ LaTeX-auto-end-symbol))
+
+(add-hook 'TeX-auto-cleanup-hook 'LaTeX-auto-cleanup)
+
+(TeX-auto-add-type "label" "LaTeX")
+(TeX-auto-add-type "bibitem" "LaTeX")
+(TeX-auto-add-type "environment" "LaTeX")
+(TeX-auto-add-type "bibliography" "LaTeX" "bibliographies")
+(TeX-auto-add-type "index-entry" "LaTeX" "index-entries")
+
+(fset 'LaTeX-add-bibliographies-auto
+ (symbol-function 'LaTeX-add-bibliographies))
+(defun LaTeX-add-bibliographies (&rest bibliographies)
+ "Add BIBLIOGRAPHIES to the list of known bibliographies and style files."
+ (apply 'LaTeX-add-bibliographies-auto bibliographies)
+ (apply 'TeX-run-style-hooks bibliographies))
+
+(fset 'LaTeX-add-environments-auto
+ (symbol-function 'LaTeX-add-environments))
+(defun LaTeX-add-environments (&rest environments)
+ "Add ENVIRONMENTS to the list of known environments.
+Additionally invalidate the environment submenus to let them be
+regenerated by the respective menu filter."
+ (apply 'LaTeX-add-environments-auto environments)
+ (setq LaTeX-environment-menu nil)
+ (setq LaTeX-environment-modify-menu nil))
+
+;;; Biber support
+
+(defvar LaTeX-using-Biber nil
+ "Used to track whether Biber is in use.")
+(make-variable-buffer-local 'LaTeX-using-Biber)
+
+;;; BibTeX
+
+;;;###autoload
+(defun BibTeX-auto-store ()
+ "This function should be called from `bibtex-mode-hook'.
+It will setup BibTeX to store keys in an auto file."
+ ;; We want this to be early in the list, so we do not
+ ;; add it before we enter BibTeX mode the first time.
+ (if (boundp 'local-write-file-hooks)
+ (add-hook 'local-write-file-hooks 'TeX-safe-auto-write)
+ (add-hook 'write-file-hooks 'TeX-safe-auto-write))
+ (make-local-variable 'TeX-auto-update)
+ (setq TeX-auto-update 'BibTeX)
+ (make-local-variable 'TeX-auto-untabify)
+ (setq TeX-auto-untabify nil)
+ (make-local-variable 'TeX-auto-parse-length)
+ (setq TeX-auto-parse-length 999999)
+ (make-local-variable 'TeX-auto-regexp-list)
+ (setq TeX-auto-regexp-list BibTeX-auto-regexp-list)
+ (make-local-variable 'TeX-master)
+ (setq TeX-master t))
+
+(defvar BibTeX-auto-regexp-list
+ `(("@[Ss][Tt][Rr][Ii][Nn][Gg]" 1 ignore)
+ (,(concat "@[a-zA-Z]+[{(][ \t]*\\(" TeX-token-char "[^,
\n\r\t%\"#'()={}]*\\)")
+ 1 LaTeX-auto-bibitem))
+ "List of regexp-list expressions matching BibTeX items.")
+
+;;; Macro Argument Hooks
+
+(defun TeX-arg-conditional (optional expr then else)
+ "Implement if EXPR THEN ELSE.
+
+If OPTIONAL is non-nil, insert the resulting value as an optional
+argument, otherwise as a mandatory one.
+
+If EXPR evaluate to true, parse THEN as an argument list, else parse
+ELSE as an argument list."
+ (TeX-parse-arguments (if (eval expr) then else)))
+
+(defun TeX-arg-eval (optional &rest args)
+ "Evaluate ARGS and insert value in buffer.
+If OPTIONAL is non-nil, insert the resulting value as an optional
+argument, otherwise as a mandatory one."
+ (TeX-argument-insert (eval args) optional))
+
+(defun TeX-arg-label (optional &optional prompt definition)
+ "Prompt for a label completing with known labels.
+If OPTIONAL is non-nil, insert the resulting value as an optional
+argument, otherwise as a mandatory one. Use PROMPT as the prompt
+string. If DEFINITION is non-nil, add the chosen label to the
+list of defined labels."
+ (let ((label (completing-read (TeX-argument-prompt optional prompt "Key")
+ (LaTeX-label-list))))
+ (if (and definition (not (string-equal "" label)))
+ (LaTeX-add-labels label))
+ (TeX-argument-insert label optional optional)))
+
+(defalias 'TeX-arg-ref 'TeX-arg-label)
+
+(defun TeX-arg-index-tag (optional &optional prompt &rest args)
+ "Prompt for an index tag.
+This is the name of an index, not the entry.
+
+If OPTIONAL is non-nil, insert the resulting value as an optional
+argument, otherwise as a mandatory one. Use PROMPT as the prompt
+string. ARGS is unused."
+ (let (tag)
+ (setq prompt (concat (if optional "(Optional) " "")
+ (if prompt prompt "Index tag")
+ ": (default none) "))
+ (setq tag (read-string prompt))
+ (TeX-argument-insert tag optional)))
+
+(defun TeX-arg-index (optional &optional prompt &rest args)
+ "Prompt for an index entry completing with known entries.
+If OPTIONAL is non-nil, insert the resulting value as an optional
+argument, otherwise as a mandatory one. Use PROMPT as the prompt
+string. ARGS is unused."
+ (let ((entry (completing-read (TeX-argument-prompt optional prompt "Key")
+ (LaTeX-index-entry-list))))
+ (if (and (not (string-equal "" entry))
+ (not (member (list entry) (LaTeX-index-entry-list))))
+ (LaTeX-add-index-entries entry))
+ (TeX-argument-insert entry optional optional)))
+
+(defalias 'TeX-arg-define-index 'TeX-arg-index)
+
+(defun TeX-arg-macro (optional &optional prompt definition)
+ "Prompt for a TeX macro with completion.
+If OPTIONAL is non-nil, insert the resulting value as an optional
+argument, otherwise as a mandatory one. Use PROMPT as the prompt
+string. If DEFINITION is non-nil, add the chosen macro to the
+list of defined macros."
+ (let ((macro (completing-read (TeX-argument-prompt optional prompt
+ (concat "Macro: "
+ TeX-esc)
+ t)
+ (TeX-symbol-list))))
+ (if (and definition (not (string-equal "" macro)))
+ (TeX-add-symbols macro))
+ (TeX-argument-insert macro optional TeX-esc)))
+
+(defun TeX-arg-environment (optional &optional prompt definition)
+ "Prompt for a LaTeX environment with completion.
+If OPTIONAL is non-nil, insert the resulting value as an optional
+argument, otherwise as a mandatory one. Use PROMPT as the prompt
+string. If DEFINITION is non-nil, add the chosen environment to
+the list of defined environments."
+ (let ((environment (completing-read (TeX-argument-prompt optional prompt
+ "Environment")
+ (TeX-symbol-list))))
+ (if (and definition (not (string-equal "" environment)))
+ (LaTeX-add-environments environment))
+
+ (TeX-argument-insert environment optional)))
+
+;; Why is DEFINITION unused?
+(defun TeX-arg-cite (optional &optional prompt definition)
+ "Prompt for a BibTeX citation with completion.
+If OPTIONAL is non-nil, insert the resulting value as an optional
+argument, otherwise as a mandatory one. Use PROMPT as the prompt
+string. DEFINITION is unused."
+ (setq prompt (concat (if optional "(Optional) " "")
+ (if prompt prompt "Add key")
+ ": (default none) "))
+ (let ((items (multi-prompt "," t prompt (LaTeX-bibitem-list))))
+ (apply 'LaTeX-add-bibitems items)
+ (TeX-argument-insert (mapconcat 'identity items ",") optional optional)))
+
+;; Why is DEFINITION unused?
+(defun TeX-arg-counter (optional &optional prompt definition)
+ "Prompt for a LaTeX counter.
+If OPTIONAL is non-nil, insert the resulting value as an optional
+argument, otherwise as a mandatory one. Use PROMPT as the prompt
+string. DEFINITION is unused."
+ ;; Completion not implemented yet.
+ (TeX-argument-insert
+ (read-string (TeX-argument-prompt optional prompt "Counter"))
+ optional))
+
+;; Why is DEFINITION unused?
+(defun TeX-arg-savebox (optional &optional prompt definition)
+ "Prompt for a LaTeX savebox.
+If OPTIONAL is non-nil, insert the resulting value as an optional
+argument, otherwise as a mandatory one. Use PROMPT as the prompt
+string. DEFINITION is unused."
+ ;; Completion not implemented yet.
+ (TeX-argument-insert
+ (read-string (TeX-argument-prompt optional prompt
+ (concat "Savebox: " TeX-esc)
+ t))
+ optional TeX-esc))
+
+(defun TeX-arg-file (optional &optional prompt)
+ "Prompt for a filename in the current directory.
+If OPTIONAL is non-nil, insert the resulting value as an optional
+argument, otherwise as a mandatory one. Use PROMPT as the prompt
+string."
+ (TeX-argument-insert (read-file-name (TeX-argument-prompt optional
+ prompt "File")
+ "" "" nil)
+ optional))
+
+(defun TeX-arg-define-label (optional &optional prompt)
+ "Prompt for a label completing with known labels.
+If OPTIONAL is non-nil, insert the resulting value as an optional
+argument, otherwise as a mandatory one. Use PROMPT as the prompt
+string."
+ (TeX-arg-label optional prompt t))
+
+(defun TeX-arg-define-macro (optional &optional prompt)
+ "Prompt for a TeX macro with completion.
+If OPTIONAL is non-nil, insert the resulting value as an optional
+argument, otherwise as a mandatory one. Use PROMPT as the prompt
+string."
+ (TeX-arg-macro optional prompt t))
+
+(defun TeX-arg-define-environment (optional &optional prompt)
+ "Prompt for a LaTeX environment with completion.
+If OPTIONAL is non-nil, insert the resulting value as an optional
+argument, otherwise as a mandatory one. Use PROMPT as the prompt
+string."
+ (TeX-arg-environment optional prompt t))
+
+(defun TeX-arg-define-cite (optional &optional prompt)
+ "Prompt for a BibTeX citation.
+If OPTIONAL is non-nil, insert the resulting value as an optional
+argument, otherwise as a mandatory one. Use PROMPT as the prompt
+string."
+ (TeX-arg-cite optional prompt t))
+
+(defun TeX-arg-define-counter (optional &optional prompt)
+ "Prompt for a LaTeX counter.
+If OPTIONAL is non-nil, insert the resulting value as an optional
+argument, otherwise as a mandatory one. Use PROMPT as the prompt
+string."
+ (TeX-arg-counter optional prompt t))
+
+(defun TeX-arg-define-savebox (optional &optional prompt)
+ "Prompt for a LaTeX savebox.
+If OPTIONAL is non-nil, insert the resulting value as an optional
+argument, otherwise as a mandatory one. Use PROMPT as the prompt
+string."
+ (TeX-arg-savebox optional prompt t))
+
+(defcustom LaTeX-style-list '(("amsart")
+ ("amsbook")
+ ("article")
+ ("beamer")
+ ("book")
+ ("dinbrief")
+ ("foils")
+ ("letter")
+ ("memoir")
+ ("minimal")
+ ("prosper")
+ ("report")
+ ("scrartcl")
+ ("scrbook")
+ ("scrlttr2")
+ ("scrreprt")
+ ("slides"))
+ "List of document classes offered when inserting a document environment."
+ :group 'LaTeX-environment
+ :type '(repeat (group (string :format "%v"))))
+
+(defun TeX-arg-document (optional &optional ignore)
+ "Insert arguments to documentclass.
+OPTIONAL and IGNORE are ignored."
+ (let ((style (completing-read
+ (concat "Document class: (default " LaTeX-default-style ") ")
+ LaTeX-style-list))
+ (options (read-string "Options: "
+ (if (stringp LaTeX-default-options)
+ LaTeX-default-options
+ (mapconcat 'identity
+ LaTeX-default-options
+ ",")))))
+ (if (zerop (length style))
+ (setq style LaTeX-default-style))
+ (if (not (zerop (length options)))
+ (insert LaTeX-optop options LaTeX-optcl))
+ (insert TeX-grop style TeX-grcl))
+
+ ;; remove old information
+ (TeX-remove-style)
+
+ ;; defined in individual style hooks
+ (TeX-update-style))
+
+(defun LaTeX-arg-usepackage (optional)
+ "Insert arguments to usepackage.
+OPTIONAL is ignored."
+ (let ((TeX-file-extensions '("sty"))
+ (TeX-input-file-search t))
+ (TeX-arg-input-file nil "Package")
+ (save-excursion
+ (search-backward-regexp "{\\(.*\\)}")
+ (let* ((package (match-string 1))
+ (var (intern (format "LaTeX-%s-package-options" package)))
+ (crm-separator ",")
+ (TeX-arg-opening-brace LaTeX-optop)
+ (TeX-arg-closing-brace LaTeX-optcl)
+ options)
+ (if (or (and (boundp var)
+ (listp (symbol-value var)))
+ (fboundp var))
+ (if (functionp var)
+ (setq options (funcall var))
+ (when (symbol-value var)
+ (setq options
+ (mapconcat 'identity
+ (TeX-completing-read-multiple
+ "Options: " (mapcar 'list (symbol-value var)))
+ ","))))
+ (setq options (read-string "Options: ")))
+ (when options
+ ;; XXX: The following statement will add the options
+ ;; supplied to the LaTeX package to the style list. This is
+ ;; consistent with the way the parser works (see
+ ;; `LaTeX-auto-cleanup'). But in a revamped style system
+ ;; such options should be associated with their LaTeX
+ ;; package to avoid confusion. For example a `german' entry
+ ;; in the style list can come from documentclass options and
+ ;; does not necessarily mean that the babel-related
+ ;; extensions should be activated.
+ (mapc 'TeX-run-style-hooks (LaTeX-listify-package-options options))
+ (TeX-argument-insert options t))))))
+
+(defcustom LaTeX-search-files-type-alist
+ '((texinputs "${TEXINPUTS.latex}" ("tex/generic/" "tex/latex/")
+ TeX-file-extensions)
+ (docs "${TEXDOCS}" ("doc/") TeX-doc-extensions)
+ (graphics "${TEXINPUTS}" ("tex/") LaTeX-includegraphics-extensions)
+ (bibinputs "${BIBINPUTS}" ("bibtex/bib/") BibTeX-file-extensions)
+ (bstinputs "${BSTINPUTS}" ("bibtex/bst/") BibTeX-style-extensions)
+ (biberinputs "${BIBINPUTS}" ("bibtex/bib/") TeX-Biber-file-extensions))
+ "Alist of filetypes with locations and file extensions.
+Each element of the alist consists of a symbol expressing the
+filetype, a variable which can be expanded on kpathsea-based
+systems into the directories where files of the given type
+reside, a list of absolute directories, relative directories
+below the root of a TDS-compliant TeX tree or a list of variables
+with either type of directories as an alternative for
+non-kpathsea-based systems and a list of extensions to be matched
+upon a file search. Note that the directories have to end with a
+directory separator.
+
+Reset the mode for a change of this variable to take effect."
+ :group 'TeX-file
+ :type '(alist :key-type symbol
+ :value-type
+ (group (string :tag "Kpathsea variable")
+ (choice :tag "Directories"
+ (repeat :tag "TDS subdirectories" string)
+ (repeat :tag "Absolute directories" directory)
+ (repeat :tag "Variables" variable))
+ (choice :tag "Extensions"
+ variable (repeat string)))))
+
+(defcustom TeX-arg-input-file-search t
+ "If `TeX-arg-input-file' should search for files.
+If the value is t, files in TeX's search path are searched for
+and provided for completion. The file name is then inserted
+without directory and extension. If the value is nil, the file
+name can be specified manually and is inserted with a path
+relative to the directory of the current buffer's file and with
+extension. If the value is `ask', you are asked for the method
+to use every time `TeX-arg-input-file' is called."
+ :group 'LaTeX-macro
+ :type '(choice (const t) (const nil) (const ask)))
+
+(defvar TeX-global-input-files nil
+ "List of the non-local TeX input files.
+Initialized once at the first time you prompt for an input file.
+May be reset with `\\[universal-argument] \\[TeX-normal-mode]'.")
+
+(defun TeX-arg-input-file (optional &optional prompt local)
+ "Prompt for a tex or sty file.
+If OPTIONAL is non-nil, insert the resulting value as an optional
+argument, otherwise as a mandatory one. PROMPT is the prompt,
+LOCAL is a flag. If the flag is set, only complete with local
+files."
+ (let ((search (if (eq TeX-arg-input-file-search 'ask)
+ (not (y-or-n-p "Find file yourself? "))
+ TeX-arg-input-file-search))
+ file style)
+ (if search
+ (progn
+ (unless (or TeX-global-input-files local)
+ (message "Searching for files...")
+ (setq TeX-global-input-files
+ (mapcar 'list (TeX-search-files-by-type
+ 'texinputs 'global t t))))
+ (setq file (completing-read
+ (TeX-argument-prompt optional prompt "File")
+ (TeX-delete-dups-by-car
+ (append (mapcar 'list (TeX-search-files-by-type
+ 'texinputs 'local t t))
+ (unless local
+ TeX-global-input-files))))
+ style file))
+ (setq file (read-file-name
+ (TeX-argument-prompt optional prompt "File") nil ""))
+ (unless (string-equal file "")
+ (setq file (file-relative-name file)))
+ (setq style (file-name-sans-extension (file-name-nondirectory file))))
+ (unless (string-equal "" style)
+ (TeX-run-style-hooks style))
+ (TeX-argument-insert file optional)))
+
+(defvar BibTeX-global-style-files nil
+ "Association list of BibTeX style files.
+
+Initialized once at the first time you prompt for an input file.
+May be reset with `\\[universal-argument] \\[TeX-normal-mode]'.")
+
+(defun TeX-arg-bibstyle (optional &optional prompt)
+ "Prompt for a BibTeX style file.
+If OPTIONAL is non-nil, insert the resulting value as an optional
+argument, otherwise as a mandatory one. Use PROMPT as the prompt
+string."
+ (message "Searching for BibTeX styles...")
+ (or BibTeX-global-style-files
+ (setq BibTeX-global-style-files
+ (mapcar 'list (TeX-search-files-by-type 'bstinputs 'global t t))))
+ (TeX-argument-insert
+ (completing-read (TeX-argument-prompt optional prompt "BibTeX style")
+ (append (mapcar 'list (TeX-search-files-by-type
+ 'bstinputs 'local t t))
+ BibTeX-global-style-files))
+ optional))
+
+(defvar BibTeX-global-files nil
+ "Association list of BibTeX files.
+
+Initialized once at the first time you prompt for a BibTeX file.
+May be reset with `\\[universal-argument] \\[TeX-normal-mode]'.")
+
+(defvar TeX-Biber-global-files nil
+ "Association list of Biber files.
+
+Initialized once at the first time you prompt for an Biber file.
+May be reset with `\\[universal-argument] \\[TeX-normal-mode]'.")
+
+(defun TeX-arg-bibliography (optional &optional prompt)
+ "Prompt for a BibTeX or Biber database file.
+If OPTIONAL is non-nil, insert the resulting value as an optional
+argument, otherwise as a mandatory one. Use PROMPT as the prompt
+string."
+ (let (name files inputs styles)
+ (if LaTeX-using-Biber
+ (progn
+ (setq name "Biber"
+ files 'TeX-Biber-global-files
+ inputs 'biberinputs))
+ (setq name "BibTeX"
+ files 'BibTeX-global-files
+ inputs 'bibinputs))
+ (message "Searching for %s files..." name)
+ (or (symbol-value files)
+ (set files (mapcar 'list (TeX-search-files-by-type
+ 'biberinputs 'global t t))))
+ (setq styles (multi-prompt
+ "," t
+ (TeX-argument-prompt optional prompt (concat name " files"))
+ (append (mapcar 'list (TeX-search-files-by-type
+ inputs 'local t t))
+ (symbol-value files))))
+ (apply 'LaTeX-add-bibliographies styles)
+ (TeX-argument-insert (mapconcat 'identity styles ",") optional)))
+
+(defun TeX-arg-corner (optional &optional prompt)
+ "Prompt for a LaTeX side or corner position with completion.
+If OPTIONAL is non-nil, insert the resulting value as an optional
+argument, otherwise as a mandatory one. Use PROMPT as the prompt
+string."
+ (TeX-argument-insert
+ (completing-read (TeX-argument-prompt optional prompt "Position")
+ '(("") ("l") ("r") ("t") ("b") ("tl") ("tr") ("bl") ("br"))
+ nil t)
+ optional))
+
+(defun TeX-arg-lr (optional &optional prompt)
+ "Prompt for a LaTeX side with completion.
+If OPTIONAL is non-nil, insert the resulting value as an optional
+argument, otherwise as a mandatory one. Use PROMPT as the prompt
+string."
+ (TeX-argument-insert
+ (completing-read (TeX-argument-prompt optional prompt "Position")
+ '(("") ("l") ("r"))
+ nil t)
+ optional))
+
+(defun TeX-arg-tb (optional &optional prompt)
+ "Prompt for a LaTeX side with completion.
+If OPTIONAL is non-nil, insert the resulting value as an optional
+argument, otherwise as a mandatory one. Use PROMPT as the prompt
+string."
+ (TeX-argument-insert
+ (completing-read (TeX-argument-prompt optional prompt "Position")
+ '(("") ("t") ("b"))
+ nil t)
+ optional))
+
+(defun TeX-arg-pagestyle (optional &optional prompt)
+ "Prompt for a LaTeX pagestyle with completion.
+If OPTIONAL is non-nil, insert the resulting value as an optional
+argument, otherwise as a mandatory one. Use PROMPT as the prompt
+string."
+ (TeX-argument-insert
+ (completing-read (TeX-argument-prompt optional prompt "Pagestyle")
+ '(("plain") ("empty") ("headings") ("myheadings")))
+ optional))
+
+(defcustom LaTeX-default-verb-delimiter ?|
+ "Default delimiter for `\\verb' macros."
+ :group 'LaTeX-macro
+ :type 'character)
+
+(defun TeX-arg-verb (optional &optional ignore)
+ "Prompt for delimiter and text.
+If OPTIONAL is non-nil, insert the resulting value as an optional
+argument, otherwise as a mandatory one. IGNORE is ignored."
+ (let ((del (read-quoted-char
+ (concat "Delimiter: (default "
+ (char-to-string LaTeX-default-verb-delimiter) ") "))))
+ (when (<= del ?\ ) (setq del LaTeX-default-verb-delimiter))
+ (if (TeX-active-mark)
+ (progn
+ (insert del)
+ (goto-char (mark))
+ (insert del))
+ (insert del (read-from-minibuffer "Text: ") del))
+ (setq LaTeX-default-verb-delimiter del)))
+
+(defun TeX-arg-pair (optional first second)
+ "Insert a pair of number, prompted by FIRST and SECOND.
+
+The numbers are surounded by parenthesizes and separated with a
+comma.
+
+If OPTIONAL is non-nil, insert the resulting value as an optional
+argument, otherwise as a mandatory one."
+ (insert "(" (read-string (concat first ": ")) ","
+ (read-string (concat second ": ")) ")"))
+
+(defun TeX-arg-size (optional)
+ "Insert width and height as a pair.
+If OPTIONAL is non-nil, insert the resulting value as an optional
+argument, otherwise as a mandatory one."
+ (TeX-arg-pair optional "Width" "Height"))
+
+(defun TeX-arg-coordinate (optional)
+ "Insert x and y coordinate as a pair.
+If OPTIONAL is non-nil, insert the resulting value as an optional
+argument, otherwise as a mandatory one."
+ (TeX-arg-pair optional "X position" "Y position"))
+
+(defconst TeX-braces-default-association
+ '(("[" . "]")
+ ("\\{" . "\\}")
+ ("(" . ")")
+ ("|" . "|")
+ ("\\|" . "\\|")
+ ("/" . "/")
+ ("\\backslash" . "\\backslash")
+ ("\\lfloor" . "\\rfloor")
+ ("\\lceil" . "\\rceil")
+ ("\\langle" . "\\rangle")))
+
+(defcustom TeX-braces-user-association nil
+ "A list of your personal association of brace symbols.
+These are used for \\left and \\right.
+
+The car of each entry is the brace used with \\left,
+the cdr is the brace used with \\right."
+ :group 'LaTeX-macro
+ :group 'LaTeX-math
+ :type '(repeat (cons :format "%v"
+ (string :tag "Left")
+ (string :tag "Right"))))
+
+(defvar TeX-braces-association
+ (append TeX-braces-user-association
+ TeX-braces-default-association)
+ "A list of association of brace symbols for \\left and \\right.
+The car of each entry is the brace used with \\left,
+the cdr is the brace used with \\right.")
+
+(defvar TeX-left-right-braces
+ '(("[") ("]") ("\\{") ("\\}") ("(") (")") ("|") ("\\|")
+ ("/") ("\\backslash") ("\\lfloor") ("\\rfloor")
+ ("\\lceil") ("\\rceil") ("\\langle") ("\\rangle")
+ ("\\uparrow") ("\\Uparrow") ("\\downarrow") ("\\Downarrow")
+ ("\\updownarrow") ("\\Updownarrow") ("."))
+ "List of symbols which can follow the \\left or \\right command.")
+
+(defun TeX-arg-insert-braces (optional &optional prompt)
+ "Prompt for a brace for \\left and insert the corresponding \\right.
+If OPTIONAL is non-nil, insert the resulting value as an optional
+argument, otherwise as a mandatory one. Use PROMPT as the prompt
+string."
+ (save-excursion
+ (backward-word 1)
+ (backward-char)
+ (LaTeX-newline)
+ (indent-according-to-mode)
+ (beginning-of-line 0)
+ (if (looking-at "^[ \t]*$")
+ (progn (delete-horizontal-space)
+ (delete-char 1))))
+ (let ((left-brace (completing-read
+ (TeX-argument-prompt optional prompt "Which brace")
+ TeX-left-right-braces)))
+ (insert left-brace)
+ (LaTeX-newline)
+ (indent-according-to-mode)
+ (save-excursion
+ (let ((right-brace (cdr (assoc left-brace
+ TeX-braces-association))))
+ (LaTeX-newline)
+ (insert TeX-esc "right")
+ (if (and TeX-arg-right-insert-p
+ right-brace)
+ (insert right-brace)
+ (insert (completing-read
+ (TeX-argument-prompt optional prompt "Which brace")
+ TeX-left-right-braces)))
+ (indent-according-to-mode)))))
+
+(defun TeX-arg-key-val (optional key-val-alist)
+ "Prompt for keys and values in KEY-VAL-ALIST.
+Insert the given value as a TeX macro argument. If OPTIONAL is
+non-nil, insert it as an optional argument. KEY-VAL-ALIST is an
+alist. The car of each element should be a string representing a
+key and the optional cdr should be a list with strings to be used
+as values for the key."
+ (let ((options (multi-prompt-key-value
+ (TeX-argument-prompt optional "Options (k=v)" nil)
+ (if (symbolp key-val-alist)
+ (eval key-val-alist)
+ key-val-alist))))
+ (TeX-argument-insert options optional)))
+
+
+;;; Verbatim constructs
+
+(defcustom LaTeX-verbatim-macros-with-delims
+ '("verb" "verb*")
+ "Macros for inline verbatim with arguments in delimiters, like \\foo|...|.
+
+Programs should not use this variable directly but the function
+`LaTeX-verbatim-macros-with-delims' which returns a value
+including buffer-local keyword additions via
+`LaTeX-verbatim-macros-with-delims-local' as well."
+ :group 'LaTeX-macro
+ :type '(repeat (string)))
+
+(defvar LaTeX-verbatim-macros-with-delims-local nil
+ "Buffer-local variable for inline verbatim with args in delimiters.
+
+Style files should add constructs to this variable and not to
+`LaTeX-verbatim-macros-with-delims'.
+
+Programs should not use this variable directly but the function
+`LaTeX-verbatim-macros-with-delims' which returns a value
+including values of the variable
+`LaTeX-verbatim-macros-with-delims' as well.")
+(make-variable-buffer-local 'LaTeX-verbatim-macros-with-delims-local)
+
+(defcustom LaTeX-verbatim-macros-with-braces nil
+ "Macros for inline verbatim with arguments in braces, like \\foo{...}.
+
+Programs should not use this variable directly but the function
+`LaTeX-verbatim-macros-with-braces' which returns a value
+including buffer-local keyword additions via
+`LaTeX-verbatim-macros-with-braces-local' as well."
+ :group 'LaTeX-macro
+ :type '(repeat (string)))
+
+(defvar LaTeX-verbatim-macros-with-braces-local nil
+ "Buffer-local variable for inline verbatim with args in braces.
+
+Style files should add constructs to this variable and not to
+`LaTeX-verbatim-macros-with-braces'.
+
+Programs should not use this variable directly but the function
+`LaTeX-verbatim-macros-with-braces' which returns a value
+including values of the variable
+`LaTeX-verbatim-macros-with-braces' as well.")
+(make-variable-buffer-local 'LaTeX-verbatim-macros-with-braces-local)
+
+(defcustom LaTeX-verbatim-environments
+ '("verbatim" "verbatim*")
+ "Verbatim environments.
+
+Programs should not use this variable directly but the function
+`LaTeX-verbatim-environments' which returns a value including
+buffer-local keyword additions via
+`LaTeX-verbatim-environments-local' as well."
+ :group 'LaTeX-environment
+ :type '(repeat (string)))
+
+(defvar LaTeX-verbatim-environments-local nil
+ "Buffer-local variable for inline verbatim environments.
+
+Style files should add constructs to this variable and not to
+`LaTeX-verbatim-environments'.
+
+Programs should not use this variable directly but the function
+`LaTeX-verbatim-environments' which returns a value including
+values of the variable `LaTeX-verbatim-environments' as well.")
+(make-variable-buffer-local 'LaTeX-verbatim-environments-local)
+
+(defun LaTeX-verbatim-macros-with-delims ()
+ "Return list of verbatim macros with delimiters."
+ (append LaTeX-verbatim-macros-with-delims
+ LaTeX-verbatim-macros-with-delims-local))
+
+(defun LaTeX-verbatim-macros-with-braces ()
+ "Return list of verbatim macros with braces."
+ (append LaTeX-verbatim-macros-with-braces
+ LaTeX-verbatim-macros-with-braces-local))
+
+(defun LaTeX-verbatim-environments ()
+ "Return list of verbatim environments."
+ (append LaTeX-verbatim-environments
+ LaTeX-verbatim-environments-local))
+
+(defun LaTeX-verbatim-macro-boundaries ()
+ "Return boundaries of verbatim macro.
+Boundaries are returned as a cons cell where the car is the macro
+start and the cdr the macro end.
+
+Only macros which enclose their arguments with special
+non-parenthetical delimiters, like \\verb+foo+, are recognized."
+ (save-excursion
+ (let ((orig (point))
+ (verbatim-regexp (regexp-opt (LaTeX-verbatim-macros-with-delims) t)))
+ ;; Search backwards for the macro start, unless we are facing one
+ (unless (looking-at (concat (regexp-quote TeX-esc) verbatim-regexp))
+ (catch 'found
+ (while (progn
+ (skip-chars-backward (concat "^\n" (regexp-quote TeX-esc))
+ (line-beginning-position))
+ (when (looking-at verbatim-regexp) (throw 'found nil))
+ (or (bobp) (forward-char -1))
+ (/= (point) (line-beginning-position))))))
+ ;; Search forward for the macro end, unless we failed to find a start
+ (unless (bolp)
+ (let* ((beg (1- (point)))
+ (macro-end (match-end 0))
+ ;; XXX: Here we assume we are dealing with \verb which
+ ;; expects the delimiter right behind the command.
+ ;; However, \lstinline can also cope with whitespace as
+ ;; well as an optional argument after the command.
+ (delimiter (buffer-substring-no-properties
+ macro-end (1+ macro-end))))
+ ;; Heuristic: If an opening brace is encountered, search for
+ ;; both the opening and the closing brace as an end marker.
+ ;; Like that the function should work for \verb|...| as well
+ ;; as for \url{...}.
+ (when (string= delimiter TeX-grop)
+ (setq delimiter (concat delimiter TeX-grcl)))
+ (goto-char (1+ macro-end))
+ (skip-chars-forward (concat "^" delimiter))
+ (when (<= orig (point))
+ (cons beg (1+ (point)))))))))
+
+(defun LaTeX-current-verbatim-macro ()
+ "Return name of verbatim macro containing point, nil if none is present."
+ (let ((macro-boundaries (LaTeX-verbatim-macro-boundaries)))
+ (when macro-boundaries
+ (save-excursion
+ (goto-char (car macro-boundaries))
+ (forward-char (length TeX-esc))
+ (buffer-substring-no-properties
+ (point) (progn (skip-chars-forward "@A-Za-z") (point)))))))
+
+(defun LaTeX-verbatim-p (&optional pos)
+ "Return non-nil if position POS is in a verbatim-like construct."
+ (when pos (goto-char pos))
+ (save-match-data
+ (or (when (fboundp 'font-latex-faces-present-p)
+ (font-latex-faces-present-p 'font-latex-verbatim-face))
+ (member (LaTeX-current-verbatim-macro)
+ (LaTeX-verbatim-macros-with-delims))
+ (member (TeX-current-macro) (LaTeX-verbatim-macros-with-braces))
+ (member (LaTeX-current-environment) (LaTeX-verbatim-environments)))))
+
+
+;;; Formatting
+
+(defcustom LaTeX-syntactic-comments t
+ "If non-nil comments will be handled according to LaTeX syntax.
+This variable influences, among others, the behavior of
+indentation and filling which will take LaTeX syntax into
+consideration just as is in the non-commented source code."
+ :type 'boolean
+ :group 'LaTeX)
+
+
+;;; Indentation
+
+;; We are distinguishing two different types of comments:
+;;
+;; 1) Comments starting in column one (line comments)
+;;
+;; 2) Comments starting after column one with only whitespace
+;; preceding it.
+;;
+;; (There is actually a third type: Comments preceded not only by
+;; whitespace but by some code as well; so-called code comments. But
+;; they are not relevant for the following explanations.)
+;;
+;; Additionally we are distinguishing two different types of
+;; indentation:
+;;
+;; a) Outer indentation: Indentation before the comment character(s).
+;;
+;; b) Inner indentation: Indentation after the comment character(s)
+;; (taking into account possible comment padding).
+;;
+;; Comments can be filled syntax-aware or not.
+;;
+;; In `doctex-mode' line comments should always be indented
+;; syntax-aware and the comment character has to be anchored at the
+;; first column (unless the appear in a macrocode environment). Other
+;; comments not in the documentation parts always start after the
+;; first column and can be indented syntax-aware or not. If they are
+;; indented syntax-aware both the indentation before and after the
+;; comment character(s) have to be checked and adjusted. Indentation
+;; should not move the comment character(s) to the first column. With
+;; `LaTeX-syntactic-comments' disabled, line comments should still be
+;; indented syntax-aware.
+;;
+;; In `latex-mode' comments starting in different columns don't have
+;; to be handled differently. They don't have to be anchored in
+;; column one. That means that in any case indentation before and
+;; after the comment characters has to be checked and adjusted.
+
+(defgroup LaTeX-indentation nil
+ "Indentation of LaTeX code in AUCTeX"
+ :group 'LaTeX
+ :group 'TeX-indentation)
+
+(defcustom LaTeX-indent-level 2
+ "*Indentation of begin-end blocks in LaTeX."
+ :group 'LaTeX-indentation
+ :type 'integer)
+
+(defcustom LaTeX-item-indent (- LaTeX-indent-level)
+ "*Extra indentation for lines beginning with an item."
+ :group 'LaTeX-indentation
+ :type 'integer)
+
+(defcustom LaTeX-item-regexp "\\(bib\\)?item\\b"
+ "*Regular expression matching macros considered items."
+ :group 'LaTeX-indentation
+ :type 'regexp)
+
+(defcustom LaTeX-indent-environment-list
+ '(("verbatim" current-indentation)
+ ("verbatim*" current-indentation)
+ ;; The following should have there own, smart indentation function.
+ ;; Some other day.
+ ("array")
+ ("displaymath")
+ ("eqnarray")
+ ("eqnarray*")
+ ("equation")
+ ("equation*")
+ ("picture")
+ ("tabbing")
+ ("table")
+ ("table*")
+ ("tabular")
+ ("tabular*"))
+ "Alist of environments with special indentation.
+The second element in each entry is the function to calculate the
+indentation level in columns."
+ :group 'LaTeX-indentation
+ :type '(repeat (list (string :tag "Environment")
+ (option function))))
+
+(defcustom LaTeX-indent-environment-check t
+ "*If non-nil, check for any special environments."
+ :group 'LaTeX-indentation
+ :type 'boolean)
+
+(defcustom LaTeX-document-regexp "document"
+ "Regexp matching environments in which the indentation starts at col 0."
+ :group 'LaTeX-indentation
+ :type 'regexp)
+
+(defcustom LaTeX-verbatim-regexp "verbatim\\*?"
+ "*Regexp matching environments with indentation at col 0 for begin/end."
+ :group 'LaTeX-indentation
+ :type 'regexp)
+
+(defcustom LaTeX-begin-regexp "begin\\b"
+ "*Regexp matching macros considered begins."
+ :group 'LaTeX-indentation
+ :type 'regexp)
+
+(defcustom LaTeX-end-regexp "end\\b"
+ "*Regexp matching macros considered ends."
+ :group 'LaTeX-indentation
+ :type 'regexp)
+
+(defcustom LaTeX-left-right-indent-level LaTeX-indent-level
+ "*The level of indentation produced by a \\left macro."
+ :group 'LaTeX-indentation
+ :type 'integer)
+
+(defcustom LaTeX-indent-comment-start-regexp "%"
+ "*Regexp matching comments ending the indent level count.
+This means, we just count the LaTeX tokens \\left, \\right, \\begin,
+and \\end up to the first occurence of text matching this regexp.
+Thus, the default \"%\" stops counting the tokens at a comment. A
+value of \"%[^>]\" would allow you to alter the indentation with
+comments, e.g. with comment `%> \\begin'.
+Lines which start with `%' are not considered at all, regardless if this
+value."
+ :group 'LaTeX-indentation
+ :type 'regexp)
+
+(defvar docTeX-indent-inner-fixed
+ `((,(concat (regexp-quote TeX-esc)
+ "\\(begin\\|end\\)[ \t]*{macrocode\\*?}") 4 t)
+ (,(concat (regexp-quote TeX-esc)
+ "\\(begin\\|end\\)[ \t]*{\\(macro\\|environment\\)\\*?}") 0 nil))
+ "List of items which should have a fixed inner indentation.
+The items consist of three parts. The first is a regular
+expression which should match the respective string. The second
+is the amount of spaces to be used for indentation. The third
+toggles if comment padding is relevant or not. If t padding is
+part of the amount given, if nil the amount of spaces will be
+inserted after potential padding.")
+
+(defun LaTeX-indent-line ()
+ "Indent the line containing point, as LaTeX source.
+Add `LaTeX-indent-level' indentation in each \\begin{ - \\end{ block.
+Lines starting with an item is given an extra indentation of
+`LaTeX-item-indent'."
+ (interactive)
+ (let* ((case-fold-search nil)
+ ;; Compute a fill prefix. Whitespace after the comment
+ ;; characters will be disregarded and replaced by
+ ;; `comment-padding'.
+ (fill-prefix
+ (and (TeX-in-commented-line)
+ (save-excursion
+ (beginning-of-line)
+ (looking-at
+ (concat "\\([ \t]*" TeX-comment-start-regexp "+\\)+"))
+ (concat (match-string 0) (TeX-comment-padding-string)))))
+ (overlays (when (featurep 'xemacs)
+ ;; Isn't that fun? In Emacs an `(overlays-at
+ ;; (line-beginning-position))' would do the
+ ;; trick. How boring.
+ (extent-list
+ nil (line-beginning-position) (line-beginning-position)
+ 'all-extents-closed-open 'overlay)))
+ ol-specs)
+ ;; XEmacs' `indent-to' function (at least in version 21.4.15) has
+ ;; a bug which leads to the insertion of whitespace in front of an
+ ;; invisible overlay. So during indentation we temporarily remove
+ ;; the 'invisible property.
+ (dolist (ol overlays)
+ (when (extent-property ol 'invisible)
+ (add-to-list 'ol-specs (list ol (extent-property ol 'invisible)))
+ (set-extent-property ol 'invisible nil)))
+ (save-excursion
+ (cond ((and fill-prefix
+ (TeX-in-line-comment)
+ (eq major-mode 'doctex-mode))
+ ;; If point is in a line comment in `doctex-mode' we only
+ ;; consider the inner indentation.
+ (let ((inner-indent (LaTeX-indent-calculate 'inner)))
+ (when (/= (LaTeX-current-indentation 'inner) inner-indent)
+ (LaTeX-indent-inner-do inner-indent))))
+ ((and fill-prefix
+ LaTeX-syntactic-comments)
+ ;; In any other case of a comment we have to consider
+ ;; outer and inner indentation if we do syntax-aware
+ ;; indentation.
+ (let ((inner-indent (LaTeX-indent-calculate 'inner))
+ (outer-indent (LaTeX-indent-calculate 'outer)))
+ (when (/= (LaTeX-current-indentation 'inner) inner-indent)
+ (LaTeX-indent-inner-do inner-indent))
+ (when (/= (LaTeX-current-indentation 'outer) outer-indent)
+ (LaTeX-indent-outer-do outer-indent))))
+ (t
+ ;; The default is to adapt whitespace before any
+ ;; non-whitespace character, i.e. to do outer
+ ;; indentation.
+ (let ((outer-indent (LaTeX-indent-calculate 'outer)))
+ (when (/= (LaTeX-current-indentation 'outer) outer-indent)
+ (LaTeX-indent-outer-do outer-indent))))))
+ ;; Make the overlays invisible again.
+ (dolist (ol-spec ol-specs)
+ (set-extent-property (car ol-spec) 'invisible (cadr ol-spec)))
+ (when (< (current-column) (save-excursion
+ (LaTeX-back-to-indentation) (current-column)))
+ (LaTeX-back-to-indentation))))
+
+(defun LaTeX-indent-inner-do (inner-indent)
+ ;; Small helper function for `LaTeX-indent-line' to perform
+ ;; indentation after a comment character. It requires that
+ ;; `LaTeX-indent-line' already set the appropriate variables and
+ ;; should not be used outside of `LaTeX-indent-line'.
+ (move-to-left-margin)
+ (TeX-re-search-forward-unescaped
+ (concat "\\(" TeX-comment-start-regexp "+[ \t]*\\)+") (line-end-position) t)
+ (delete-region (line-beginning-position) (point))
+ (insert fill-prefix)
+ (indent-to (+ inner-indent (length fill-prefix))))
+
+(defun LaTeX-indent-outer-do (outer-indent)
+ ;; Small helper function for `LaTeX-indent-line' to perform
+ ;; indentation of normal lines or before a comment character in a
+ ;; commented line. It requires that `LaTeX-indent-line' already set
+ ;; the appropriate variables and should not be used outside of
+ ;; `LaTeX-indent-line'.
+ (back-to-indentation)
+ (delete-region (line-beginning-position) (point))
+ (indent-to outer-indent))
+
+(defun LaTeX-indent-calculate (&optional force-type)
+ "Return the indentation of a line of LaTeX source.
+FORCE-TYPE can be used to force the calculation of an inner or
+outer indentation in case of a commented line. The symbols
+'inner and 'outer are recognized."
+ (save-excursion
+ (LaTeX-back-to-indentation force-type)
+ (let ((i 0)
+ (list-length (safe-length docTeX-indent-inner-fixed))
+ entry
+ found)
+ (cond ((save-excursion (beginning-of-line) (bobp)) 0)
+ ((and (eq major-mode 'doctex-mode)
+ fill-prefix
+ (TeX-in-line-comment)
+ (progn
+ (while (and (< i list-length)
+ (not found))
+ (setq entry (nth i docTeX-indent-inner-fixed))
+ (when (looking-at (nth 0 entry))
+ (setq found t))
+ (setq i (1+ i)))
+ found))
+ (if (nth 2 entry)
+ (- (nth 1 entry) (if (integerp comment-padding)
+ comment-padding
+ (length comment-padding)))
+ (nth 1 entry)))
+ ((looking-at (concat (regexp-quote TeX-esc)
+ "\\(begin\\|end\\){\\("
+ LaTeX-verbatim-regexp
+ "\\)}"))
+ ;; \end{verbatim} must be flush left, otherwise an unwanted
+ ;; empty line appears in LaTeX's output.
+ 0)
+ ((and LaTeX-indent-environment-check
+ ;; Special environments.
+ (let ((entry (assoc (or LaTeX-current-environment
+ (LaTeX-current-environment))
+ LaTeX-indent-environment-list)))
+ (and entry
+ (nth 1 entry)
+ (funcall (nth 1 entry))))))
+ ((looking-at (concat (regexp-quote TeX-esc)
+ "\\("
+ LaTeX-end-regexp
+ "\\)"))
+ ;; Backindent at \end.
+ (- (LaTeX-indent-calculate-last force-type) LaTeX-indent-level))
+ ((looking-at (concat (regexp-quote TeX-esc) "right\\b"))
+ ;; Backindent at \right.
+ (- (LaTeX-indent-calculate-last force-type)
+ LaTeX-left-right-indent-level))
+ ((looking-at (concat (regexp-quote TeX-esc)
+ "\\("
+ LaTeX-item-regexp
+ "\\)"))
+ ;; Items.
+ (+ (LaTeX-indent-calculate-last force-type) LaTeX-item-indent))
+ ((looking-at "}")
+ ;; End brace in the start of the line.
+ (- (LaTeX-indent-calculate-last force-type)
+ TeX-brace-indent-level))
+ (t (LaTeX-indent-calculate-last force-type))))))
+
+(defun LaTeX-indent-level-count ()
+ "Count indentation change caused by all \\left, \\right, \\begin, and
+\\end commands in the current line."
+ (save-excursion
+ (save-restriction
+ (let ((count 0))
+ (narrow-to-region (point)
+ (save-excursion
+ (re-search-forward
+ (concat "[^" TeX-esc "]"
+ "\\(" LaTeX-indent-comment-start-regexp
+ "\\)\\|\n\\|\\'"))
+ (backward-char)
+ (point)))
+ (while (search-forward TeX-esc nil t)
+ (cond
+ ((looking-at "left\\b")
+ (setq count (+ count LaTeX-left-right-indent-level)))
+ ((looking-at "right\\b")
+ (setq count (- count LaTeX-left-right-indent-level)))
+ ((looking-at LaTeX-begin-regexp)
+ (setq count (+ count LaTeX-indent-level)))
+ ((looking-at LaTeX-end-regexp)
+ (setq count (- count LaTeX-indent-level)))
+ ((looking-at (regexp-quote TeX-esc))
+ (forward-char 1))))
+ count))))
+
+(defun LaTeX-indent-calculate-last (&optional force-type)
+ "Return the correct indentation of a normal line of text.
+The point is supposed to be at the beginning of the current line.
+FORCE-TYPE can be used to force the calculation of an inner or
+outer indentation in case of a commented line. The symbols
+'inner and 'outer are recognized."
+ (let (line-comment-current-flag
+ line-comment-last-flag
+ comment-current-flag
+ comment-last-flag)
+ (beginning-of-line)
+ (setq line-comment-current-flag (TeX-in-line-comment)
+ comment-current-flag (TeX-in-commented-line))
+ (if comment-current-flag
+ (skip-chars-backward "%\n\t ")
+ (skip-chars-backward "\n\t "))
+ (beginning-of-line)
+ ;; If we are called in a non-comment line, skip over comment
+ ;; lines. The computation of indentation should in this case
+ ;; rather take the last non-comment line into account.
+ ;; Otherwise there might arise problems with e.g. multi-line
+ ;; code comments. This behavior is not enabled in docTeX mode
+ ;; where large amounts of line comments may have to be skipped
+ ;; and indentation should not be influenced by unrelated code in
+ ;; other macrocode environments.
+ (while (and (not (eq major-mode 'doctex-mode))
+ (not comment-current-flag)
+ (TeX-in-commented-line)
+ (not (bobp)))
+ (skip-chars-backward "\n\t ")
+ (beginning-of-line))
+ (setq line-comment-last-flag (TeX-in-line-comment)
+ comment-last-flag (TeX-in-commented-line))
+ (LaTeX-back-to-indentation force-type)
+ ;; Separate line comments and other stuff (normal text/code and
+ ;; code comments). Additionally we don't want to compute inner
+ ;; indentation when a commented and a non-commented line are
+ ;; compared.
+ (cond ((or (and (eq major-mode 'doctex-mode)
+ (or (and line-comment-current-flag
+ (not line-comment-last-flag))
+ (and (not line-comment-current-flag)
+ line-comment-last-flag)))
+ (and force-type
+ (eq force-type 'inner)
+ (or (and comment-current-flag
+ (not comment-last-flag))
+ (and (not comment-current-flag)
+ comment-last-flag))))
+ 0)
+ ((looking-at (concat (regexp-quote TeX-esc)
+ "begin *{\\("
+ LaTeX-document-regexp
+ "\\)}"))
+ ;; I dislike having all of the document indented...
+ (+ (LaTeX-current-indentation force-type)
+ ;; Some people have opening braces at the end of the
+ ;; line, e.g. in case of `\begin{letter}{%'.
+ (TeX-brace-count-line)))
+ ((and (eq major-mode 'doctex-mode)
+ (looking-at (concat (regexp-quote TeX-esc)
+ "end[ \t]*{macrocode\\*?}"))
+ fill-prefix
+ (TeX-in-line-comment))
+ ;; Reset indentation to zero after a macrocode
+ ;; environment.
+ 0)
+ ((looking-at (concat (regexp-quote TeX-esc)
+ "begin *{\\("
+ LaTeX-verbatim-regexp
+ "\\)}"))
+ 0)
+ ((looking-at (concat (regexp-quote TeX-esc)
+ "end *{\\("
+ LaTeX-verbatim-regexp
+ "\\)}"))
+ ;; If I see an \end{verbatim} in the previous line I skip
+ ;; back to the preceding \begin{verbatim}.
+ (save-excursion
+ (if (re-search-backward (concat (regexp-quote TeX-esc)
+ "begin *{\\("
+ LaTeX-verbatim-regexp
+ "\\)}") 0 t)
+ (LaTeX-indent-calculate-last force-type)
+ 0)))
+ (t (+ (LaTeX-current-indentation force-type)
+ (if (not (and force-type
+ (eq force-type 'outer)
+ (TeX-in-commented-line)))
+ (+ (LaTeX-indent-level-count)
+ (TeX-brace-count-line))
+ 0)
+ (cond ((looking-at (concat (regexp-quote TeX-esc)
+ "\\("
+ LaTeX-end-regexp
+ "\\)"))
+ LaTeX-indent-level)
+ ((looking-at
+ (concat (regexp-quote TeX-esc) "right\\b"))
+ LaTeX-left-right-indent-level)
+ ((looking-at (concat (regexp-quote TeX-esc)
+ "\\("
+ LaTeX-item-regexp
+ "\\)"))
+ (- LaTeX-item-indent))
+ ((looking-at "}")
+ TeX-brace-indent-level)
+ (t 0)))))))
+
+(defun LaTeX-current-indentation (&optional force-type)
+ "Return the indentation of a line.
+FORCE-TYPE can be used to force the calculation of an inner or
+outer indentation in case of a commented line. The symbols
+'inner and 'outer are recognized."
+ (if (and fill-prefix
+ (or (and force-type
+ (eq force-type 'inner))
+ (and (not force-type)
+ (or
+ ;; If `LaTeX-syntactic-comments' is not enabled,
+ ;; do conventional indentation
+ LaTeX-syntactic-comments
+ ;; Line comments in `doctex-mode' are always
+ ;; indented syntax-aware so we need their inner
+ ;; indentation.
+ (and (TeX-in-line-comment)
+ (eq major-mode 'doctex-mode))))))
+ ;; INNER indentation
+ (save-excursion
+ (beginning-of-line)
+ (looking-at (concat "\\(?:[ \t]*" TeX-comment-start-regexp "+\\)+"
+ "\\([ \t]*\\)"))
+ (- (length (match-string 1)) (length (TeX-comment-padding-string))))
+ ;; OUTER indentation
+ (current-indentation)))
+
+(defun LaTeX-back-to-indentation (&optional force-type)
+ "Move point to the first non-whitespace character on this line.
+If it is commented and comments are formatted syntax-aware move
+point to the first non-whitespace character after the comment
+character(s). The optional argument FORCE-TYPE can be used to
+force point being moved to the inner or outer indentation in case
+of a commented line. The symbols 'inner and 'outer are
+recognized."
+ (if (or (and force-type
+ (eq force-type 'inner))
+ (and (not force-type)
+ (or (and (TeX-in-line-comment)
+ (eq major-mode 'doctex-mode))
+ (and (TeX-in-commented-line)
+ LaTeX-syntactic-comments))))
+ (progn
+ (beginning-of-line)
+ ;; Should this be anchored at the start of the line?
+ (TeX-re-search-forward-unescaped
+ (concat "\\(?:" TeX-comment-start-regexp "+[ \t]*\\)+")
+ (line-end-position) t))
+ (back-to-indentation)))
+
+
+;;; Filling
+
+(defcustom LaTeX-fill-break-at-separators nil
+ "List of separators before or after which respectively a line
+break will be inserted if they do not fit into one line."
+ :group 'LaTeX
+ :type '(set :tag "Contents"
+ (const :tag "Opening Brace" \{)
+ (const :tag "Closing Brace" \})
+ (const :tag "Opening Bracket" \[)
+ (const :tag "Opening Inline Math Switches" \\\()
+ (const :tag "Closing Inline Math Switches" \\\))
+ (const :tag "Opening Display Math Switch" \\\[)
+ (const :tag "Closing Display Math Switch" \\\])))
+
+(defcustom LaTeX-fill-break-before-code-comments t
+ "If non-nil, a line with some code followed by a comment will
+be broken before the last non-comment word in case the comment
+does not fit into the line."
+ :group 'LaTeX
+ :type 'boolean)
+
+(defvar LaTeX-nospace-between-char-regexp
+ (if (featurep 'xemacs)
+ (if (and (boundp 'word-across-newline) word-across-newline)
+ word-across-newline
+ ;; NOTE: Ensure not to have a value of nil for such a rare case that
+ ;; somebody removes the mule test in `LaTeX-fill-delete-newlines' so that
+ ;; it could match only "\n" and this could lead to problem. XEmacs does
+ ;; not have a category `\c|' and `\ct' means `Chinese Taiwan' in XEmacs.
+ "\\(\\cj\\|\\cc\\|\\ct\\)")
+ "\\c|")
+ "Regexp matching a character where no interword space is necessary.
+Words formed by such characters can be broken across newlines.")
+
+(defvar LaTeX-fill-newline-hook nil
+ "Hook run after `LaTeX-fill-newline' inserted and indented a new line.")
+
+(defun LaTeX-fill-region-as-paragraph (from to &optional justify-flag)
+ "Fill region as one paragraph.
+Break lines to fit `fill-column', but leave all lines ending with
+\\\\ \(plus its optional argument) alone. Lines with code
+comments and lines ending with `\par' are included in filling but
+act as boundaries. Prefix arg means justify too. From program,
+pass args FROM, TO and JUSTIFY-FLAG."
+ (interactive "*r\nP")
+ (let ((end-marker (save-excursion (goto-char to) (point-marker))))
+ (if (or (assoc (LaTeX-current-environment) LaTeX-indent-environment-list)
+ ;; This could be generalized, if there are more cases where
+ ;; a special string at the start of a region to fill should
+ ;; inhibit filling.
+ (progn (save-excursion (goto-char from)
+ (looking-at (concat TeX-comment-start-regexp
+ "+[ \t]*"
+ "Local Variables:")))))
+ ;; Filling disabled, only do indentation.
+ (indent-region from to nil)
+ (save-restriction
+ (goto-char from)
+ (while (< (point) end-marker)
+ (if (re-search-forward
+ (concat "\\("
+ ;; Code comments.
+ "[^\r\n%\\]\\([ \t]\\|\\\\\\\\\\)*"
+ TeX-comment-start-regexp
+ "\\|"
+ ;; Lines ending with `\par'.
+ "\\(\\=\\|[^" TeX-esc "\n]\\)\\("
+ (regexp-quote (concat TeX-esc TeX-esc))
+ "\\)*"
+ (regexp-quote TeX-esc) "par[ \t]*"
+ "\\({[ \t]*}\\)?[ \t]*$"
+ "\\)\\|\\("
+ ;; Lines ending with `\\'.
+ (regexp-quote TeX-esc)
+ (regexp-quote TeX-esc)
+ "\\(\\s-*\\*\\)?"
+ "\\(\\s-*\\[[^]]*\\]\\)?"
+ "\\s-*$\\)")
+ end-marker t)
+ (progn
+ (goto-char (line-end-position))
+ (delete-horizontal-space)
+ ;; I doubt very much if we want justify -
+ ;; this is a line with \\
+ ;; if you think otherwise - uncomment the next line
+ ;; (and justify-flag (justify-current-line))
+ (forward-char)
+ ;; keep our position in a buffer
+ (save-excursion
+ ;; Code comments and lines ending with `\par' are
+ ;; included in filling. Lines ending with `\\' are
+ ;; skipped.
+ (if (match-string 1)
+ (LaTeX-fill-region-as-para-do from (point) justify-flag)
+ (LaTeX-fill-region-as-para-do
+ from (line-beginning-position 0) justify-flag)
+ ;; At least indent the line ending with `\\'.
+ (indent-according-to-mode)))
+ (setq from (point)))
+ ;; ELSE part follows - loop termination relies on a fact
+ ;; that (LaTeX-fill-region-as-para-do) moves point past
+ ;; the filled region
+ (LaTeX-fill-region-as-para-do from end-marker justify-flag)))))))
+
+;; The content of `LaTeX-fill-region-as-para-do' was copied from the
+;; function `fill-region-as-paragraph' in `fill.el' (CVS Emacs,
+;; January 2004) and adapted to the needs of AUCTeX.
+
+(defun LaTeX-fill-region-as-para-do (from to &optional justify
+ nosqueeze squeeze-after)
+ "Fill the region defined by FROM and TO as one paragraph.
+It removes any paragraph breaks in the region and extra newlines at the end,
+indents and fills lines between the margins given by the
+`current-left-margin' and `current-fill-column' functions.
+\(In most cases, the variable `fill-column' controls the width.)
+It leaves point at the beginning of the line following the paragraph.
+
+Normally performs justification according to the `current-justification'
+function, but with a prefix arg, does full justification instead.
+
+From a program, optional third arg JUSTIFY can specify any type of
+justification. Fourth arg NOSQUEEZE non-nil means not to make spaces
+between words canonical before filling. Fifth arg SQUEEZE-AFTER, if non-nil,
+means don't canonicalize spaces before that position.
+
+Return the `fill-prefix' used for filling.
+
+If `sentence-end-double-space' is non-nil, then period followed by one
+space does not end a sentence, so don't break a line there."
+ (interactive (progn
+ (barf-if-buffer-read-only)
+ (list (region-beginning) (region-end)
+ (if current-prefix-arg 'full))))
+ (unless (memq justify '(t nil none full center left right))
+ (setq justify 'full))
+
+ ;; Make sure "to" is the endpoint.
+ (goto-char (min from to))
+ (setq to (max from to))
+ ;; Ignore blank lines at beginning of region.
+ (skip-chars-forward " \t\n")
+
+ (let ((from-plus-indent (point))
+ (oneleft nil))
+
+ (beginning-of-line)
+ (setq from (point))
+
+ ;; Delete all but one soft newline at end of region.
+ ;; And leave TO before that one.
+ (goto-char to)
+ (while (and (> (point) from) (eq ?\n (char-after (1- (point)))))
+ (if (and oneleft
+ (not (and use-hard-newlines
+ (get-text-property (1- (point)) 'hard))))
+ (delete-backward-char 1)
+ (backward-char 1)
+ (setq oneleft t)))
+ (setq to (copy-marker (point) t))
+ (goto-char from-plus-indent))
+
+ (if (not (> to (point)))
+ nil ;; There is no paragraph, only whitespace: exit now.
+
+ (or justify (setq justify (current-justification)))
+
+ ;; Don't let Adaptive Fill mode alter the fill prefix permanently.
+ (let ((fill-prefix fill-prefix))
+ ;; Figure out how this paragraph is indented, if desired.
+ (when (and adaptive-fill-mode
+ (or (null fill-prefix) (string= fill-prefix "")))
+ (setq fill-prefix (fill-context-prefix from to))
+ ;; Ignore a white-space only fill-prefix
+ ;; if we indent-according-to-mode.
+ (when (and fill-prefix fill-indent-according-to-mode
+ (string-match "\\`[ \t]*\\'" fill-prefix))
+ (setq fill-prefix nil)))
+
+ (goto-char from)
+ (beginning-of-line)
+
+ (if (not justify) ; filling disabled: just check indentation
+ (progn
+ (goto-char from)
+ (while (< (point) to)
+ (if (and (not (eolp))
+ (< (LaTeX-current-indentation) (current-left-margin)))
+ (fill-indent-to-left-margin))
+ (forward-line 1)))
+
+ (when use-hard-newlines
+ (remove-text-properties from to '(hard nil)))
+ ;; Make sure first line is indented (at least) to left margin...
+ (indent-according-to-mode)
+ ;; COMPATIBILITY for Emacs <= 21.1
+ (if (fboundp 'fill-delete-prefix)
+ ;; Delete the fill-prefix from every line.
+ (fill-delete-prefix from to fill-prefix)
+ ;; Delete the comment prefix and any whitespace from every
+ ;; line of the region in concern except the first. (The
+ ;; implementation is heuristic to a certain degree.)
+ (save-excursion
+ (goto-char from)
+ (forward-line 1)
+ (when (< (point) to)
+ (while (re-search-forward (concat "^[ \t]+\\|^[ \t]*"
+ TeX-comment-start-regexp
+ "+[ \t]*") to t)
+ (delete-region (match-beginning 0) (match-end 0))))))
+
+ (setq from (point))
+
+ ;; FROM, and point, are now before the text to fill,
+ ;; but after any fill prefix on the first line.
+
+ (LaTeX-fill-delete-newlines from to justify nosqueeze squeeze-after)
+
+ ;; This is the actual FILLING LOOP.
+ (goto-char from)
+ (let* (linebeg
+ (code-comment-start (save-excursion
+ (LaTeX-back-to-indentation)
+ (TeX-search-forward-comment-start
+ (line-end-position))))
+ (end-marker (save-excursion
+ (goto-char (or code-comment-start to))
+ (point-marker)))
+ (LaTeX-current-environment (LaTeX-current-environment)))
+ ;; Fill until point is greater than the end point. If there
+ ;; is a code comment, use the code comment's start as a
+ ;; limit.
+ (while (and (< (point) (marker-position end-marker))
+ (or (not code-comment-start)
+ (and code-comment-start
+ (> (- (marker-position end-marker)
+ (line-beginning-position))
+ fill-column))))
+ (setq linebeg (point))
+ (move-to-column (current-fill-column))
+ (if (when (< (point) (marker-position end-marker))
+ ;; Find the position where we'll break the line.
+ (forward-char 1) ; Use an immediately following
+ ; space, if any.
+ (LaTeX-fill-move-to-break-point linebeg)
+
+ ;; Check again to see if we got to the end of
+ ;; the paragraph.
+ (skip-chars-forward " \t")
+ (< (point) (marker-position end-marker)))
+ ;; Found a place to cut.
+ (progn
+ (LaTeX-fill-newline)
+ (when justify
+ ;; Justify the line just ended, if desired.
+ (save-excursion
+ (forward-line -1)
+ (justify-current-line justify nil t))))
+
+ (goto-char end-marker)
+ ;; Justify this last line, if desired.
+ (if justify (justify-current-line justify t t))))
+
+ ;; Fill a code comment if necessary. (Enable this code if
+ ;; you want the comment part in lines with code comments to
+ ;; be filled. Originally it was disabled because the
+ ;; indentation code indented the lines following the line
+ ;; with the code comment to the column of the comment
+ ;; starters. That means, it would have looked like this:
+ ;; | code code code % comment
+ ;; | % comment
+ ;; | code code code
+ ;; This now (2005-07-29) is not the case anymore. But as
+ ;; filling code comments like this would split a single
+ ;; paragraph into two separate ones, we still leave it
+ ;; disabled. I leave the code here in case it is useful for
+ ;; somebody.
+ ;; (when (and code-comment-start
+ ;; (> (- (line-end-position) (line-beginning-position))
+ ;; fill-column))
+ ;; (LaTeX-fill-code-comment justify))
+
+ ;; The following is an alternative strategy to minimize the
+ ;; occurence of overfull lines with code comments. A line
+ ;; will be broken before the last non-comment word if the
+ ;; code comment does not fit into the line.
+ (when (and LaTeX-fill-break-before-code-comments
+ code-comment-start
+ (> (- (line-end-position) (line-beginning-position))
+ fill-column))
+ (beginning-of-line)
+ (goto-char end-marker)
+ (while (not (looking-at TeX-comment-start-regexp)) (forward-char))
+ (skip-chars-backward " \t")
+ (skip-chars-backward "^ \t\n")
+ (unless (or (bolp)
+ ;; Comment starters and whitespace.
+ (TeX-looking-at-backward
+ (concat "^\\([ \t]*" TeX-comment-start-regexp "+\\)*"
+ "[ \t]*")
+ (line-beginning-position)))
+ (LaTeX-fill-newline)))))
+ ;; Leave point after final newline.
+ (goto-char to)
+ (unless (eobp) (forward-char 1))
+ ;; Return the fill-prefix we used
+ fill-prefix)))
+
+;; Following lines are copied from `fill.el' (CVS Emacs, March 2005).
+;; The `fill-space' property carries the string with which a newline should
be
+;; replaced when unbreaking a line (in fill-delete-newlines). It is added to
+;; newline characters by fill-newline when the default behavior of
+;; fill-delete-newlines is not what we want.
+(unless (featurep 'xemacs)
+ ;; COMPATIBILITY for Emacs < 22.1
+ (add-to-list 'text-property-default-nonsticky '(fill-space . t)))
+
+(defun LaTeX-fill-delete-newlines (from to justify nosqueeze squeeze-after)
+ ;; COMPATIBILITY for Emacs < 22.1 and XEmacs
+ (if (fboundp 'fill-delete-newlines)
+ (fill-delete-newlines from to justify nosqueeze squeeze-after)
+ (if (featurep 'xemacs)
+ (when (featurep 'mule)
+ (goto-char from)
+ (let ((unwished-newline (concat LaTeX-nospace-between-char-regexp "\n"
+ LaTeX-nospace-between-char-regexp)))
+ (while (re-search-forward unwished-newline to t)
+ (skip-chars-backward "^\n")
+ (delete-char -1))))
+ ;; This else-sentence was copied from the function `fill-delete-newlines'
+ ;; in `fill.el' (CVS Emacs, 2005-02-17) and adapted accordingly.
+ (while (search-forward "\n" to t)
+ (if (get-text-property (match-beginning 0) 'fill-space)
+ (replace-match (get-text-property (match-beginning 0) 'fill-space))
+ (let ((prev (char-before (match-beginning 0)))
+ (next (following-char)))
+ (when (or (aref (char-category-set next) ?|)
+ (aref (char-category-set prev) ?|))
+ (delete-char -1))))))
+
+ ;; Make sure sentences ending at end of line get an extra space.
+ (if (or (not (boundp 'sentence-end-double-space))
+ sentence-end-double-space)
+ (progn
+ (goto-char from)
+ (while (re-search-forward "[.?!][]})\"']*$" to t)
+ (insert ? ))))
+ ;; Then change all newlines to spaces.
+ (let ((point-max (progn
+ (goto-char to)
+ (skip-chars-backward "\n")
+ (point))))
+ (subst-char-in-region from point-max ?\n ?\ ))
+ (goto-char from)
+ (skip-chars-forward " \t")
+ ;; Remove extra spaces between words.
+ (unless (and nosqueeze (not (eq justify 'full)))
+ (canonically-space-region (or squeeze-after (point)) to)
+ ;; Remove trailing whitespace.
+ (goto-char (line-end-position))
+ (delete-char (- (skip-chars-backward " \t"))))))
+
+(defun LaTeX-fill-move-to-break-point (linebeg)
+ "Move to the position where the line should be broken."
+ ;; COMPATIBILITY for Emacs < 22.1 and XEmacs
+ (if (fboundp 'fill-move-to-break-point)
+ (fill-move-to-break-point linebeg)
+ (if (featurep 'mule)
+ (if (TeX-looking-at-backward
+ (concat LaTeX-nospace-between-char-regexp ".?") 2)
+ ;; Cancel `forward-char' which is called just before
+ ;; `LaTeX-fill-move-to-break-point' if the char before point matches
+ ;; `LaTeX-nospace-between-char-regexp'.
+ (backward-char 1)
+ (when (re-search-backward
+ (concat " \\|\n\\|" LaTeX-nospace-between-char-regexp)
+ linebeg 'move)
+ (forward-char 1)))
+ (skip-chars-backward "^ \n"))
+ ;; Prevent infinite loops: If we cannot find a place to break
+ ;; while searching backward, search forward again.
+ (when (save-excursion
+ (skip-chars-backward " \t%")
+ (bolp))
+ (skip-chars-forward "^ \n" (point-max)))
+ ;; This code was copied from the function `fill-move-to-break-point'
+ ;; in `fill.el' (CVS Emacs, 2005-02-22) and adapted accordingly.
+ (when (and (< linebeg (point))
+ ;; If we are going to break the line after or
+ ;; before a non-ascii character, we may have to
+ ;; run a special function for the charset of the
+ ;; character to find the correct break point.
+ (boundp 'enable-multibyte-characters)
+ enable-multibyte-characters
+ (fboundp 'charset-after) ; Non-MULE XEmacsen don't have this.
+ (not (and (eq (charset-after (1- (point))) 'ascii)
+ (eq (charset-after (point)) 'ascii))))
+ ;; Make sure we take SOMETHING after the fill prefix if any.
+ (if (fboundp 'fill-find-break-point)
+ (fill-find-break-point linebeg)
+ (when (fboundp 'kinsoku-process) ;XEmacs
+ (kinsoku-process)))))
+ ;; Prevent line break between 2-byte char and 1-byte char.
+ (when (and (featurep 'mule)
+ enable-multibyte-characters
+ (or (and (not (looking-at LaTeX-nospace-between-char-regexp))
+ (TeX-looking-at-backward
+ LaTeX-nospace-between-char-regexp 1))
+ (and (not (TeX-looking-at-backward
+ LaTeX-nospace-between-char-regexp 1))
+ (looking-at LaTeX-nospace-between-char-regexp)))
+ (re-search-backward
+ (concat LaTeX-nospace-between-char-regexp
+ LaTeX-nospace-between-char-regexp
+ LaTeX-nospace-between-char-regexp
+ "\\|"
+ ".\\ca\\s +\\ca") linebeg t))
+ (if (looking-at "..\\c>")
+ (forward-char 1)
+ (forward-char 2)))
+ ;; Cater for Japanese Macro
+ (when (and (boundp 'japanese-TeX-mode) japanese-TeX-mode
+ (aref (char-category-set (char-after)) ?j)
+ (TeX-looking-at-backward (concat (regexp-quote TeX-esc)
TeX-token-char "*")
+ (1- (- (point) linebeg)))
+ (not (TeX-escaped-p (match-beginning 0))))
+ (goto-char (match-beginning 0)))
+ ;; Cater for \verb|...| (and similar) contructs which should not be
+ ;; broken. (FIXME: Make it work with shortvrb.sty (also loaded by
+ ;; doc.sty) where |...| is allowed. Arbitrary delimiters may be
+ ;; chosen with \MakeShortVerb{<char>}.) This could probably be
+ ;; handled with `fill-nobreak-predicate', but this is not available
+ ;; in XEmacs.
+ (let ((final-breakpoint (point))
+ (verb-macros (regexp-opt (append (LaTeX-verbatim-macros-with-delims)
+ (LaTeX-verbatim-macros-with-braces)))))
+ (save-excursion
+ ;; Look for the start of a verbatim macro in the current line.
+ (when (re-search-backward (concat (regexp-quote TeX-esc)
+ "\\(?:" verb-macros "\\)\\([^a-z@*]\\)")
+ (line-beginning-position) t)
+ ;; Determine start and end of verbatim macro.
+ (let ((beg (point))
+ (end (if (not (string-match "[ [{]" (match-string 1)))
+ (cdr (LaTeX-verbatim-macro-boundaries))
+ (TeX-find-macro-end))))
+ ;; Determine if macro end is behind fill column.
+ (when (and end
+ (> (- end (line-beginning-position))
+ (current-fill-column))
+ (> end final-breakpoint))
+ ;; Search backwards for place to break before the macro.
+ (goto-char beg)
+ (skip-chars-backward "^ \n")
+ ;; Determine if point ended up at the beginning of the line.
+ (when (save-excursion (skip-chars-backward " \t%") (bolp))
+ ;; Search forward for a place to break after the macro.
+ (goto-char end)
+ (skip-chars-forward "^ \n" (point-max)))
+ (setq final-breakpoint (point))))))
+ (goto-char final-breakpoint))
+ (when LaTeX-fill-break-at-separators
+ (let ((orig-breakpoint (point))
+ (final-breakpoint (point))
+ start-point
+ math-sep)
+ (save-excursion
+ (beginning-of-line)
+ (LaTeX-back-to-indentation)
+ (setq start-point (point))
+ ;; Find occurences of [, $, {, }, \(, \), \[, \] or $$.
+ (while (and (= final-breakpoint orig-breakpoint)
+ (TeX-re-search-forward-unescaped
+ (concat "[[{}]\\|\\$\\$?\\|"
+ (regexp-quote TeX-esc) "[][()]")
+ orig-breakpoint t))
+ (let ((match-string (match-string 0)))
+ (cond
+ ;; [ (opening bracket) (The closing bracket should
+ ;; already be handled implicitely by the code for the
+ ;; opening brace.)
+ ((save-excursion
+ (and (memq '\[ LaTeX-fill-break-at-separators)
+ (string= match-string "[")
+ (TeX-re-search-forward-unescaped (concat "\\][ \t]*{")
+ (line-end-position) t)
+ (> (- (or (TeX-find-closing-brace)
+ (line-end-position))
+ (line-beginning-position))
+ fill-column)))
+ (save-excursion
+ (skip-chars-backward "^ \n")
+ (when (> (point) start-point)
+ (setq final-breakpoint (point)))))
+ ;; { (opening brace)
+ ((save-excursion
+ (and (memq '\{ LaTeX-fill-break-at-separators)
+ (string= match-string "{")
+ (> (- (save-excursion
+ ;; `TeX-find-closing-brace' is not enough
+ ;; if there is no breakpoint in form of
+ ;; whitespace after the brace.
+ (goto-char (or (TeX-find-closing-brace)
+ (line-end-position)))
+ (skip-chars-forward "^ \t\n")
+ (point))
+ (line-beginning-position))
+ fill-column)))
+ (save-excursion
+ (skip-chars-backward "^ \n")
+ ;; The following is a primitive and error-prone method
+ ;; to cope with point probably being inside square
+ ;; brackets. A better way would be to use functions
+ ;; to determine if point is inside an optional
+ ;; argument and to jump to the start and end brackets.
+ (when (save-excursion
+ (TeX-re-search-forward-unescaped
+ (concat "\\][ \t]*{") orig-breakpoint t))
+ (TeX-search-backward-unescaped "["
+ (line-beginning-position) t)
+ (skip-chars-backward "^ \n"))
+ (when (> (point) start-point)
+ (setq final-breakpoint (point)))))
+ ;; } (closing brace)
+ ((save-excursion
+ (and (memq '\} LaTeX-fill-break-at-separators)
+ (string= match-string "}")
+ (save-excursion
+ (backward-char 2)
+ (not (TeX-find-opening-brace
+ nil (line-beginning-position))))))
+ (save-excursion
+ (skip-chars-forward "^ \n")
+ (when (> (point) start-point)
+ (setq final-breakpoint (point)))))
+ ;; $ or \( or \[ or $$ (opening math)
+ ((save-excursion
+ (and (or (and (memq '\\\( LaTeX-fill-break-at-separators)
+ (or (and (string= match-string "$")
+ (texmathp))
+ (string= match-string "\\(")))
+ (and (memq '\\\[ LaTeX-fill-break-at-separators)
+ (or (string= match-string "\\[")
+ (and (string= match-string "$$")
+ (texmathp)))))
+ (> (- (save-excursion
+ (TeX-search-forward-unescaped
+ (cond ((string= match-string "\\(")
+ (concat TeX-esc ")"))
+ ((string= match-string "$") "$")
+ ((string= match-string "$$") "$$")
+ (t (concat TeX-esc "]")))
+ (point-max) t)
+ (skip-chars-forward "^ \n")
+ (point))
+ (line-beginning-position))
+ fill-column)))
+ (save-excursion
+ (skip-chars-backward "^ \n")
+ (when (> (point) start-point)
+ (setq final-breakpoint (point)))))
+ ;; $ or \) or \] or $$ (closing math)
+ ((save-excursion
+ (and (or (and (memq '\\\) LaTeX-fill-break-at-separators)
+ (or (and (string= match-string "$")
+ (not (texmathp)))
+ (string= match-string "\\)")))
+ (and (memq '\\\] LaTeX-fill-break-at-separators)
+ (or (string= match-string "\\]")
+ (and (string= match-string "$$")
+ (not (texmathp))))))
+ (if (member match-string '("$" "$$"))
+ (save-excursion
+ (skip-chars-backward "$")
+ (not (TeX-search-backward-unescaped
+ match-string (line-beginning-position) t)))
+ (texmathp-match-switch (line-beginning-position)))))
+ (save-excursion
+ (skip-chars-forward "^ \n")
+ (when (> (point) start-point)
+ (setq final-breakpoint (point)))))))))
+ (goto-char final-breakpoint))))
+
+;; The content of `LaTeX-fill-newline' was copied from the function
+;; `fill-newline' in `fill.el' (CVS Emacs, January 2004) and adapted
+;; to the needs of AUCTeX.
+(defun LaTeX-fill-newline ()
+ "Replace whitespace here with one newline and indent the line."
+ (skip-chars-backward " \t")
+ (newline 1)
+ ;; COMPATIBILITY for XEmacs
+ (unless (featurep 'xemacs)
+ ;; Give newline the properties of the space(s) it replaces
+ (set-text-properties (1- (point)) (point)
+ (text-properties-at (point)))
+ (and (looking-at "\\( [ \t]*\\)\\(\\c|\\)?")
+ (or (aref (char-category-set (or (char-before (1- (point))) ?\000)) ?|)
+ (match-end 2))
+ ;; When refilling later on, this newline would normally not
+ ;; be replaced by a space, so we need to mark it specially to
+ ;; re-install the space when we unfill.
+ (put-text-property (1- (point)) (point) 'fill-space (match-string 1)))
+ ;; COMPATIBILITY for Emacs <= 21.3
+ (when (boundp 'fill-nobreak-invisible)
+ ;; If we don't want breaks in invisible text, don't insert
+ ;; an invisible newline.
+ (if fill-nobreak-invisible
+ (remove-text-properties (1- (point)) (point)
+ '(invisible t)))))
+ ;; Insert the fill prefix.
+ (and fill-prefix (not (equal fill-prefix ""))
+ ;; Markers that were after the whitespace are now at point: insert
+ ;; before them so they don't get stuck before the prefix.
+ (insert-before-markers-and-inherit fill-prefix))
+ (indent-according-to-mode)
+ (run-hooks 'LaTeX-fill-newline-hook))
+
+(defun LaTeX-fill-paragraph (&optional justify)
+ "Like `fill-paragraph', but handle LaTeX comments.
+If any of the current line is a comment, fill the comment or the
+paragraph of it that point is in. Code comments, i.e. comments
+with uncommented code preceding them in the same line, will not
+be filled unless the cursor is placed on the line with the
+code comment.
+
+If LaTeX syntax is taken into consideration during filling
+depends on the value of `LaTeX-syntactic-comments'."
+ (interactive "P")
+ (if (save-excursion
+ (beginning-of-line)
+ (looking-at (concat TeX-comment-start-regexp "*[ \t]*$")))
+ ;; Don't do anything if we look at an empty line and let
+ ;; `fill-paragraph' think we successfully filled the paragraph.
+ t
+ (let (;; Non-nil if the current line contains a comment.
+ has-comment
+ ;; Non-nil if the current line contains code and a comment.
+ has-code-and-comment
+ code-comment-start
+ ;; If has-comment, the appropriate fill-prefix for the comment.
+ comment-fill-prefix)
+
+ ;; Figure out what kind of comment we are looking at.
+ (cond
+ ;; A line only with potential whitespace followed by a
+ ;; comment on it?
+ ((save-excursion
+ (beginning-of-line)
+ (looking-at (concat "^[ \t]*" TeX-comment-start-regexp
+ "\\(" TeX-comment-start-regexp "\\|[ \t]\\)*")))
+ (setq has-comment t
+ comment-fill-prefix (TeX-match-buffer 0)))
+ ;; A line with some code, followed by a comment?
+ ((and (setq code-comment-start (save-excursion
+ (beginning-of-line)
+ (TeX-search-forward-comment-start
+ (line-end-position))))
+ (> (point) code-comment-start)
+ (not (TeX-in-commented-line))
+ (save-excursion
+ (goto-char code-comment-start)
+ ;; See if there is at least one non-whitespace character
+ ;; before the comment starts.
+ (re-search-backward "[^ \t\n]" (line-beginning-position) t)))
+ (setq has-comment t
+ has-code-and-comment t)))
+
+ (cond
+ ;; Code comments.
+ (has-code-and-comment
+ (save-excursion
+ (when (>= (- code-comment-start (line-beginning-position))
+ fill-column)
+ ;; If start of code comment is beyond fill column, fill it as a
+ ;; regular paragraph before it is filled as a code comment.
+ (let ((end-marker (save-excursion (end-of-line) (point-marker))))
+ (LaTeX-fill-region-as-paragraph (line-beginning-position)
+ (line-beginning-position 2)
+ justify)
+ (goto-char end-marker)
+ (beginning-of-line)))
+ (LaTeX-fill-code-comment justify)))
+ ;; Syntax-aware filling:
+ ;; * `LaTeX-syntactic-comments' enabled: Everything.
+ ;; * `LaTeX-syntactic-comments' disabled: Uncommented code and
+ ;; line comments in `doctex-mode'.
+ ((or (or LaTeX-syntactic-comments
+ (and (not LaTeX-syntactic-comments)
+ (not has-comment)))
+ (and (eq major-mode 'doctex-mode)
+ (TeX-in-line-comment)))
+ (let ((fill-prefix comment-fill-prefix))
+ (save-excursion
+ (let* ((end (progn (LaTeX-forward-paragraph)
+ (or (bolp) (newline 1))
+ (and (eobp) (not (bolp)) (open-line 1))
+ (point)))
+ (start
+ (progn
+ (LaTeX-backward-paragraph)
+ (while (and (looking-at
+ (concat "$\\|[ \t]+$\\|"
+ "[ \t]*" TeX-comment-start-regexp
+ "+[ \t]*$"))
+ (< (point) end))
+ (forward-line))
+ (point))))
+ (LaTeX-fill-region-as-paragraph start end justify)))))
+ ;; Non-syntax-aware filling.
+ (t
+ (save-excursion
+ (save-restriction
+ (beginning-of-line)
+ (narrow-to-region
+ ;; Find the first line we should include in the region to fill.
+ (save-excursion
+ (while (and (zerop (forward-line -1))
+ (looking-at (concat "^[ \t]*"
+ TeX-comment-start-regexp))))
+ ;; We may have gone too far. Go forward again.
+ (or (looking-at (concat ".*" TeX-comment-start-regexp))
+ (forward-line 1))
+ (point))
+ ;; Find the beginning of the first line past the region to fill.
+ (save-excursion
+ (while (progn (forward-line 1)
+ (looking-at (concat "^[ \t]*"
+ TeX-comment-start-regexp))))
+ (point)))
+ ;; The definitions of `paragraph-start' and
+ ;; `paragraph-separate' will still make
+ ;; `forward-paragraph' and `backward-paragraph' stop at
+ ;; the respective (La)TeX commands. If these should be
+ ;; disregarded, the definitions would have to be changed
+ ;; accordingly. (Lines with only `%' characters on them
+ ;; can be paragraph boundaries.)
+ (let* ((paragraph-start
+ (concat paragraph-start "\\|"
+ "\\(" TeX-comment-start-regexp "\\|[ \t]\\)*$"))
+ (paragraph-separate
+ (concat paragraph-separate "\\|"
+ "\\(" TeX-comment-start-regexp "\\|[ \t]\\)*$"))
+ (fill-prefix comment-fill-prefix)
+ (end (progn (forward-paragraph)
+ (or (bolp) (newline 1))
+ (point)))
+ (beg (progn (backward-paragraph)
+ (point))))
+ (fill-region-as-paragraph
+ beg end
+ justify nil
+ (save-excursion
+ (goto-char beg)
+ (if (looking-at fill-prefix)
+ nil
+ (re-search-forward comment-start-skip nil t)
+ (point)))))))))
+ t)))
+
+(defun LaTeX-fill-code-comment (&optional justify-flag)
+ "Fill a line including code followed by a comment."
+ (let ((beg (line-beginning-position))
+ fill-prefix code-comment-start)
+ (indent-according-to-mode)
+ (when (when (setq code-comment-start (save-excursion
+ (goto-char beg)
+ (TeX-search-forward-comment-start
+ (line-end-position))))
+ (goto-char code-comment-start)
+ (while (not (looking-at TeX-comment-start-regexp)) (forward-char))
+ ;; See if there is at least one non-whitespace character
+ ;; before the comment starts.
+ (save-excursion
+ (re-search-backward "[^ \t\n]" (line-beginning-position) t)))
+ (setq fill-prefix
+ (concat
+ (if indent-tabs-mode
+ (concat (make-string (/ (current-column) tab-width) ?\t)
+ (make-string (% (current-column) tab-width) ?\ ))
+ (make-string (current-column) ?\ ))
+ (progn
+ (looking-at (concat TeX-comment-start-regexp "+[ \t]*"))
+ (TeX-match-buffer 0))))
+ (fill-region-as-paragraph beg (line-beginning-position 2)
+ justify-flag nil
+ (save-excursion
+ (goto-char beg)
+ (if (looking-at fill-prefix)
+ nil
+ (re-search-forward comment-start-skip nil t)
+ (point)))))))
+
+(defun LaTeX-fill-region (from to &optional justify what)
+ "Fill and indent the text in region from FROM to TO as LaTeX text.
+Prefix arg (non-nil third arg JUSTIFY, if called from program)
+means justify as well. Fourth arg WHAT is a word to be displayed when
+formatting."
+ (interactive "*r\nP")
+ (save-excursion
+ (let ((to (set-marker (make-marker) to))
+ (next-par (make-marker)))
+ (goto-char from)
+ (beginning-of-line)
+ (setq from (point))
+ (catch 'end-of-buffer
+ (while (and (< (point) to))
+ (message "Formatting%s ... %d%%"
+ (or what "")
+ (/ (* 100 (- (point) from)) (- to from)))
+ (save-excursion (LaTeX-fill-paragraph justify))
+ (if (marker-position next-par)
+ (goto-char (marker-position next-par))
+ (LaTeX-forward-paragraph))
+ (when (eobp) (throw 'end-of-buffer t))
+ (LaTeX-forward-paragraph)
+ (set-marker next-par (point))
+ (LaTeX-backward-paragraph)
+ (while (and (not (eobp))
+ (looking-at
+ (concat "^\\($\\|[ \t]+$\\|[ \t]*"
+ TeX-comment-start-regexp "+[ \t]*$\\)")))
+ (forward-line 1))))
+ (set-marker to nil)))
+ (message "Finished"))
+
+(defun LaTeX-find-matching-end ()
+ "Move point to the \\end of the current environment.
+
+If function is called inside a comment and
+`LaTeX-syntactic-comments' is enabled, try to find the
+environment in commented regions with the same comment prefix."
+ (interactive)
+ (let* ((regexp (concat (regexp-quote TeX-esc) "\\(begin\\|end\\)\\b"))
+ (level 1)
+ (in-comment (TeX-in-commented-line))
+ (comment-prefix (and in-comment (TeX-comment-prefix))))
+ (save-excursion
+ (skip-chars-backward "a-zA-Z \t{")
+ (unless (bolp)
+ (backward-char 1)
+ (and (looking-at regexp)
+ (char-equal (char-after (1+ (match-beginning 0))) ?e)
+ (setq level 0))))
+ (while (and (> level 0) (re-search-forward regexp nil t))
+ (when (or (and LaTeX-syntactic-comments
+ (eq in-comment (TeX-in-commented-line))
+ ;; If we are in a commented line, check if the
+ ;; prefix matches the one we started out with.
+ (or (not in-comment)
+ (string= comment-prefix (TeX-comment-prefix))))
+ (and (not LaTeX-syntactic-comments)
+ (not (TeX-in-commented-line))))
+ (if (= (char-after (1+ (match-beginning 0))) ?b) ;;begin
+ (setq level (1+ level))
+ (setq level (1- level)))))
+ (if (= level 0)
+ (search-forward "}")
+ (error "Can't locate end of current environment"))))
+
+(defun LaTeX-find-matching-begin ()
+ "Move point to the \\begin of the current environment.
+
+If function is called inside a comment and
+`LaTeX-syntactic-comments' is enabled, try to find the
+environment in commented regions with the same comment prefix."
+ (interactive)
+ (let* ((regexp (concat (regexp-quote TeX-esc) "\\(begin\\|end\\)\\b"))
+ (level 1)
+ (in-comment (TeX-in-commented-line))
+ (comment-prefix (and in-comment (TeX-comment-prefix))))
+ (skip-chars-backward "a-zA-Z \t{")
+ (unless (bolp)
+ (backward-char 1)
+ (and (looking-at regexp)
+ (char-equal (char-after (1+ (match-beginning 0))) ?b)
+ (setq level 0)))
+ (while (and (> level 0) (re-search-backward regexp nil t))
+ (when (or (and LaTeX-syntactic-comments
+ (eq in-comment (TeX-in-commented-line))
+ ;; If we are in a commented line, check if the
+ ;; prefix matches the one we started out with.
+ (or (not in-comment)
+ (string= comment-prefix (TeX-comment-prefix))))
+ (and (not LaTeX-syntactic-comments)
+ (not (TeX-in-commented-line))))
+ (if (= (char-after (1+ (match-beginning 0))) ?e) ;;end
+ (setq level (1+ level))
+ (setq level (1- level)))))
+ (or (= level 0)
+ (error "Can't locate beginning of current environment"))))
+
+(defun LaTeX-mark-environment (&optional count)
+ "Set mark to end of current environment and point to the matching begin.
+If prefix argument COUNT is given, mark the respective number of
+enclosing environments. The command will not work properly if
+there are unbalanced begin-end pairs in comments and verbatim
+environments."
+ (interactive "p")
+ (setq count (if count (abs count) 1))
+ (let ((cur (point)) beg end)
+ ;; Only change point and mark after beginning and end were found.
+ ;; Point should not end up in the middle of nowhere if the search fails.
+ (save-excursion
+ (dotimes (c count) (LaTeX-find-matching-end))
+ (setq end (line-beginning-position 2))
+ (goto-char cur)
+ (dotimes (c count) (LaTeX-find-matching-begin))
+ (setq beg (point)))
+ (set-mark end)
+ (goto-char beg)
+ (TeX-activate-region)))
+
+(defun LaTeX-fill-environment (justify)
+ "Fill and indent current environment as LaTeX text."
+ (interactive "*P")
+ (save-excursion
+ (LaTeX-mark-environment)
+ (re-search-forward "{\\([^}]+\\)}")
+ (LaTeX-fill-region (region-beginning) (region-end) justify
+ (concat " environment " (TeX-match-buffer 1)))))
+
+(defun LaTeX-fill-section (justify)
+ "Fill and indent current logical section as LaTeX text."
+ (interactive "*P")
+ (save-excursion
+ (LaTeX-mark-section)
+ (re-search-forward "{\\([^}]+\\)}")
+ (LaTeX-fill-region (region-beginning) (region-end) justify
+ (concat " section " (TeX-match-buffer 1)))))
+
+(defun LaTeX-mark-section (&optional no-subsections)
+ "Set mark at end of current logical section, and point at top.
+If optional argument NO-SUBSECTIONS is non-nil, mark only the
+region from the current section start to the next sectioning
+command. Thereby subsections are not being marked.
+
+If the function `outline-mark-subtree' is not available,
+`LaTeX-mark-section' always behaves like this regardless of the
+value of NO-SUBSECTIONS."
+ (interactive "P")
+ (if (or no-subsections
+ (not (fboundp 'outline-mark-subtree)))
+ (progn
+ (re-search-forward (concat "\\(" (LaTeX-outline-regexp)
+ "\\|\\'\\)"))
+ (beginning-of-line)
+ (push-mark (point) nil t)
+ (re-search-backward (concat "\\(" (LaTeX-outline-regexp)
+ "\\|\\`\\)")))
+ (outline-mark-subtree)
+ (when (and (boundp 'transient-mark-mode)
+ transient-mark-mode
+ (boundp 'mark-active)
+ (not mark-active))
+ (setq mark-active t)
+ (run-hooks 'activate-mark-hook)))
+ (TeX-activate-region))
+
+(defun LaTeX-fill-buffer (justify)
+ "Fill and indent current buffer as LaTeX text."
+ (interactive "*P")
+ (save-excursion
+ (LaTeX-fill-region
+ (point-min)
+ (point-max)
+ justify
+ (concat " buffer " (buffer-name)))))
+
+
+;;; Navigation
+
+(defvar LaTeX-paragraph-commands-internal
+ '("[" "]" ; display math
+ "appendix" "begin" "caption" "chapter" "end" "include" "includeonly"
+ "label" "maketitle" "noindent" "par" "paragraph" "part" "section"
+ "subsection" "subsubsection" "tableofcontents")
+ "Internal list of LaTeX macros that should have their own line.")
+
+(defun LaTeX-paragraph-commands-regexp-make ()
+ "Return a regular expression matching defined paragraph commands."
+ (concat (regexp-quote TeX-esc) "\\("
+ (regexp-opt (append LaTeX-paragraph-commands
+ LaTeX-paragraph-commands-internal)) "\\)"))
+
+(defcustom LaTeX-paragraph-commands nil
+ "List of LaTeX macros that should have their own line.
+The list should contain macro names without the leading backslash."
+ :group 'LaTeX-macro
+ :type '(repeat (string))
+ :set (lambda (symbol value)
+ (set-default symbol value)
+ (setq LaTeX-paragraph-commands-regexp
+ (LaTeX-paragraph-commands-regexp-make))))
+
+(defvar LaTeX-paragraph-commands-regexp (LaTeX-paragraph-commands-regexp-make)
+ "Regular expression matching LaTeX macros that should have their own
line.")
+
+(defun LaTeX-set-paragraph-start ()
+ "Set `paragraph-start'."
+ (setq paragraph-start
+ (concat
+ "[ \t]*%*[ \t]*\\("
+ LaTeX-paragraph-commands-regexp "\\|"
+ (regexp-quote TeX-esc) "\\(" LaTeX-item-regexp "\\)\\|"
+ "\\$\\$\\|" ; Plain TeX display math (Some people actually
+ ; use this with LaTeX. Yuck.)
+ "$\\)")))
+
+(defun LaTeX-paragraph-commands-add-locally (commands)
+ "Make COMMANDS be recognized as paragraph commands.
+COMMANDS can be a single string or a list of strings which will
+be added to `LaTeX-paragraph-commands-internal'. Additionally
+`LaTeX-paragraph-commands-regexp' will be updated and both
+variables will be made buffer-local. This is mainly a
+convenience function which can be used in style files."
+ (make-local-variable 'LaTeX-paragraph-commands-internal)
+ (make-local-variable 'LaTeX-paragraph-commands-regexp)
+ (unless (listp commands) (setq commands (list commands)))
+ (dolist (elt commands)
+ (add-to-list 'LaTeX-paragraph-commands-internal elt))
+ (setq LaTeX-paragraph-commands-regexp (LaTeX-paragraph-commands-regexp-make))
+ (LaTeX-set-paragraph-start))
+
+(defun LaTeX-forward-paragraph (&optional count)
+ "Move forward to end of paragraph.
+If COUNT is non-nil, do it COUNT times."
+ (or count (setq count 1))
+ (dotimes (i count)
+ (let* ((macro-start (TeX-find-macro-start))
+ (paragraph-command-start
+ (cond
+ ;; Point is inside of a paragraph command.
+ ((and macro-start
+ (save-excursion
+ (goto-char macro-start)
+ (looking-at LaTeX-paragraph-commands-regexp)))
+ (match-beginning 0))
+ ;; Point is before a paragraph command in the same line.
+ ((looking-at
+ (concat "[ \t]*\\(?:" TeX-comment-start-regexp
+ "\\(?:" TeX-comment-start-regexp "\\|[ \t]\\)*\\)?"
+ "\\(" LaTeX-paragraph-commands-regexp "\\)"))
+ (match-beginning 1))))
+ macro-end)
+ ;; If a paragraph command is encountered there are two cases to be
+ ;; distinguished:
+ ;; 1) If the end of the paragraph command coincides (apart from
+ ;; potential whitespace) with the end of the line, is only
+ ;; followed by a comment or is directly followed by a macro,
+ ;; it is assumed that it should be handled separately.
+ ;; 2) If the end of the paragraph command is followed by other
+ ;; code, it is assumed that it should be included with the rest
+ ;; of the paragraph.
+ (if (and paragraph-command-start
+ (save-excursion
+ (goto-char paragraph-command-start)
+ (setq macro-end (goto-char (TeX-find-macro-end)))
+ (looking-at (concat (regexp-quote TeX-esc) "[@A-Za-z]+\\|"
+ "[ \t]*\\($\\|"
+ TeX-comment-start-regexp "\\)"))))
+ (progn
+ (goto-char macro-end)
+ ;; If the paragraph command is followed directly by
+ ;; another macro, regard the latter as part of the
+ ;; paragraph command's paragraph.
+ (when (looking-at (concat (regexp-quote TeX-esc) "[@A-Za-z]+"))
+ (goto-char (TeX-find-macro-end)))
+ (forward-line))
+ (let (limit)
+ (goto-char (min (save-excursion
+ (forward-paragraph)
+ (setq limit (point)))
+ (save-excursion
+ (TeX-forward-comment-skip 1 limit)
+ (point)))))))))
+
+(defun LaTeX-backward-paragraph (&optional count)
+ "Move backward to beginning of paragraph.
+If COUNT is non-nil, do it COUNT times."
+ (or count (setq count 1))
+ (dotimes (i count)
+ (let* ((macro-start (TeX-find-macro-start)))
+ (if (and macro-start
+ ;; Point really has to be inside of the macro, not before it.
+ (not (= macro-start (point)))
+ (save-excursion
+ (goto-char macro-start)
+ (looking-at LaTeX-paragraph-commands-regexp)))
+ ;; Point is inside of a paragraph command.
+ (progn
+ (goto-char macro-start)
+ (beginning-of-line))
+ (let (limit
+ (start (line-beginning-position)))
+ (goto-char
+ (max (save-excursion
+ (backward-paragraph)
+ (setq limit (point)))
+ ;; Search for possible transitions from commented to
+ ;; uncommented regions and vice versa.
+ (save-excursion
+ (TeX-backward-comment-skip 1 limit)
+ (point))
+ ;; Search for paragraph commands.
+ (save-excursion
+ (let ((end-point 0) macro-bol)
+ (when (setq macro-bol
+ (re-search-backward
+ (format "^[ \t]*%s*[ \t]*\\(%s\\)"
+ TeX-comment-start-regexp
+ LaTeX-paragraph-commands-regexp)
+ limit t))
+ (if (and (string= (match-string 1) "\\begin")
+ (progn
+ (goto-char (match-end 1))
+ (skip-chars-forward "{ \t")
+ (member (buffer-substring-no-properties
+ (point) (progn (skip-chars-forward
+ "A-Za-z*") (point)))
+ LaTeX-verbatim-environments)))
+ ;; If inside a verbatim environment, just
+ ;; use the next line. In such environments
+ ;; `TeX-find-macro-end' could otherwise
+ ;; think brackets or braces belong to the
+ ;; \begin macro.
+ (setq end-point (line-beginning-position 2))
+ ;; Jump to the macro end otherwise.
+ (goto-char (match-beginning 1))
+ (goto-char (TeX-find-macro-end))
+ ;; For an explanation of this distinction see
+ ;; `LaTeX-forward-paragraph'.
+ (if (looking-at (concat (regexp-quote TeX-esc)
+ "[@A-Za-z]+\\|[ \t]*\\($\\|"
+ TeX-comment-start-regexp "\\)"))
+ (progn
+ (when (string= (buffer-substring-no-properties
+ (point) (+ (point)
+ (length TeX-esc)))
+ TeX-esc)
+ (goto-char (TeX-find-macro-end)))
+ (forward-line 1)
+ (when (< (point) start)
+ (setq end-point (point))))
+ (setq end-point macro-bol))))
+ end-point)))))))))
+
+(defun LaTeX-search-forward-comment-start (&optional limit)
+ "Search forward for a comment start from current position till LIMIT.
+If LIMIT is omitted, search till the end of the buffer.
+
+This function makes sure that any comment starters found inside
+of verbatim constructs are not considered."
+ (setq limit (or limit (point-max)))
+ (save-excursion
+ (let (start)
+ (catch 'found
+ (while (progn
+ (when (and (TeX-re-search-forward-unescaped
+ TeX-comment-start-regexp limit 'move)
+ (not (LaTeX-verbatim-p)))
+ (setq start (match-beginning 0))
+ (throw 'found t))
+ (< (point) limit))))
+ start)))
+
+
+;;; Math Minor Mode
+
+(defgroup LaTeX-math nil
+ "Mathematics in AUCTeX."
+ :group 'LaTeX-macro)
+
+(defcustom LaTeX-math-list nil
+ "Alist of your personal LaTeX math symbols.
+
+Each entry should be a list with up to four elements, KEY, VALUE,
+MENU and CHARACTER.
+
+KEY is the key (after `LaTeX-math-abbrev-prefix') to be redefined
+in math minor mode. If KEY is nil, the symbol has no associated
+keystroke \(it is available in the menu, though\).
+
+VALUE can be a string with the name of the macro to be inserted,
+or a function to be called. The macro must be given without the
+leading backslash.
+
+The third element MENU is the name of the submenu where the
+command should be added. MENU can be either a string
+\(e.g. \"greek\"\), a list (e.g. \(\"AMS\" \"Delimiters\"\)\) or
+nil. If MENU is nil, no menu item will be created.
+
+The fourth element CHARACTER is a Unicode character position for
+menu display. When nil, no character is shown.
+
+See also `LaTeX-math-menu'."
+ :group 'LaTeX-math
+ :type '(repeat (group (choice :tag "Key"
+ (const :tag "none" nil)
+ (choice (character)
+ (string :tag "Key sequence")))
+ (choice :tag "Value"
+ (string :tag "Macro")
+ (function))
+ (choice :tag "Menu"
+ (string :tag "Top level menu" )
+ (repeat :tag "Submenu"
+ (string :tag "Menu")))
+ (choice :tag "Unicode character"
+ (const :tag "none" nil)
+ (integer :tag "Number")))))
+
+(defconst LaTeX-math-default
+ '((?a "alpha" "Greek Lowercase" 945) ;; #X03B1
+ (?b "beta" "Greek Lowercase" 946) ;; #X03B2
+ (?g "gamma" "Greek Lowercase" 947) ;; #X03B3
+ (?d "delta" "Greek Lowercase" 948) ;; #X03B4
+ (?e "epsilon" "Greek Lowercase" 1013) ;; #X03F5
+ (?z "zeta" "Greek Lowercase" 950) ;; #X03B6
+ (?h "eta" "Greek Lowercase" 951) ;; #X03B7
+ (?j "theta" "Greek Lowercase" 952) ;; #X03B8
+ (nil "iota" "Greek Lowercase" 953) ;; #X03B9
+ (?k "kappa" "Greek Lowercase" 954) ;; #X03BA
+ (?l "lambda" "Greek Lowercase" 955) ;; #X03BB
+ (?m "mu" "Greek Lowercase" 956) ;; #X03BC
+ (?n "nu" "Greek Lowercase" 957) ;; #X03BD
+ (?x "xi" "Greek Lowercase" 958) ;; #X03BE
+ (?p "pi" "Greek Lowercase" 960) ;; #X03C0
+ (?r "rho" "Greek Lowercase" 961) ;; #X03C1
+ (?s "sigma" "Greek Lowercase" 963) ;; #X03C3
+ (?t "tau" "Greek Lowercase" 964) ;; #X03C4
+ (?u "upsilon" "Greek Lowercase" 965) ;; #X03C5
+ (?f "phi" "Greek Lowercase" 981) ;; #X03D5
+ (?q "chi" "Greek Lowercase" 967) ;; #X03C7
+ (?y "psi" "Greek Lowercase" 968) ;; #X03C8
+ (?w "omega" "Greek Lowercase" 969) ;; #X03C9
+ ("v e" "varepsilon" "Greek Lowercase" 949) ;; #X03B5
+ ("v j" "vartheta" "Greek Lowercase" 977) ;; #X03D1
+ ("v p" "varpi" "Greek Lowercase" 982) ;; #X03D6
+ ("v r" "varrho" "Greek Lowercase" 1009) ;; #X03F1
+ ("v s" "varsigma" "Greek Lowercase" 962) ;; #X03C2
+ ("v f" "varphi" "Greek Lowercase" 966) ;; #X03C6
+ (?G "Gamma" "Greek Uppercase" 915) ;; #X0393
+ (?D "Delta" "Greek Uppercase" 916) ;; #X0394
+ (?J "Theta" "Greek Uppercase" 920) ;; #X0398
+ (?L "Lambda" "Greek Uppercase" 923) ;; #X039B
+ (?X "Xi" "Greek Uppercase" 926) ;; #X039E
+ (?P "Pi" "Greek Uppercase" 928) ;; #X03A0
+ (?S "Sigma" "Greek Uppercase" 931) ;; #X03A3
+ (?U "Upsilon" "Greek Uppercase" 978) ;; #X03D2
+ (?F "Phi" "Greek Uppercase" 934) ;; #X03A6
+ (?Y "Psi" "Greek Uppercase" 936) ;; #X03A8
+ (?W "Omega" "Greek Uppercase" 937) ;; #X03A9
+ (?c LaTeX-math-cal "Cal-whatever")
+ (nil "pm" "Binary Op" 177) ;; #X00B1
+ (nil "mp" "Binary Op" 8723) ;; #X2213
+ (?* "times" "Binary Op" 215) ;; #X00D7
+ (nil "div" "Binary Op" 247) ;; #X00F7
+ (nil "ast" "Binary Op" 8727) ;; #X2217
+ (nil "star" "Binary Op" 8902) ;; #X22C6
+ (nil "circ" "Binary Op" 8728) ;; #X2218
+ (nil "bullet" "Binary Op" 8729) ;; #X2219
+ (?. "cdot" "Binary Op" 8901) ;; #X22C5
+ (?- "cap" "Binary Op" 8745) ;; #X2229
+ (?+ "cup" "Binary Op" 8746) ;; #X222A
+ (nil "uplus" "Binary Op" 8846) ;; #X228E
+ (nil "sqcap" "Binary Op" 8851) ;; #X2293
+ (?| "vee" "Binary Op" 8744) ;; #X2228
+ (?& "wedge" "Binary Op" 8743) ;; #X2227
+ (?\\ "setminus" "Binary Op" 8726) ;; #X2216
+ (nil "wr" "Binary Op" 8768) ;; #X2240
+ (nil "diamond" "Binary Op" 8900) ;; #X22C4
+ (nil "bigtriangleup" "Binary Op" 9651) ;; #X25B3
+ (nil "bigtriangledown" "Binary Op" 9661) ;; #X25BD
+ (nil "triangleleft" "Binary Op" 9665) ;; #X25C1
+ (nil "triangleright" "Binary Op" 9655) ;; #X25B7
+ (nil "lhd" "Binary Op")
+ (nil "rhd" "Binary Op")
+ (nil "unlhd" "Binary Op")
+ (nil "unrhd" "Binary Op")
+ (nil "oplus" "Binary Op" 8853) ;; #X2295
+ (nil "ominus" "Binary Op" 8854) ;; #X2296
+ (nil "otimes" "Binary Op" 8855) ;; #X2297
+ (nil "oslash" "Binary Op" 8709) ;; #X2205
+ (nil "odot" "Binary Op" 8857) ;; #X2299
+ (nil "bigcirc" "Binary Op" 9675) ;; #X25CB
+ (nil "dagger" "Binary Op" 8224) ;; #X2020
+ (nil "ddagger" "Binary Op" 8225) ;; #X2021
+ (nil "amalg" "Binary Op" 10815) ;; #X2A3F
+ (?< "leq" "Relational" 8804) ;; #X2264
+ (?> "geq" "Relational" 8805) ;; #X2265
+ (nil "qed" "Relational" 8718) ;; #X220E
+ (nil "equiv" "Relational" 8801) ;; #X2261
+ (nil "models" "Relational" 8871) ;; #X22A7
+ (nil "prec" "Relational" 8826) ;; #X227A
+ (nil "succ" "Relational" 8827) ;; #X227B
+ (nil "sim" "Relational" 8764) ;; #X223C
+ (nil "perp" "Relational" 10178) ;; #X27C2
+ (nil "preceq" "Relational" 10927) ;; #X2AAF
+ (nil "succeq" "Relational" 10928) ;; #X2AB0
+ (nil "simeq" "Relational" 8771) ;; #X2243
+ (nil "mid" "Relational" 8739) ;; #X2223
+ (nil "ll" "Relational" 8810) ;; #X226A
+ (nil "gg" "Relational" 8811) ;; #X226B
+ (nil "asymp" "Relational" 8781) ;; #X224D
+ (nil "parallel" "Relational" 8741) ;; #X2225
+ (?\{ "subset" "Relational" 8834) ;; #X2282
+ (?\} "supset" "Relational" 8835) ;; #X2283
+ (nil "approx" "Relational" 8776) ;; #X2248
+ (nil "bowtie" "Relational" 8904) ;; #X22C8
+ (?\[ "subseteq" "Relational" 8838) ;; #X2286
+ (?\] "supseteq" "Relational" 8839) ;; #X2287
+ (nil "cong" "Relational" 8773) ;; #X2245
+ (nil "Join" "Relational" 10781) ;; #X2A1D
+ (nil "sqsubset" "Relational" 8847) ;; #X228F
+ (nil "sqsupset" "Relational" 8848) ;; #X2290
+ (nil "neq" "Relational" 8800) ;; #X2260
+ (nil "smile" "Relational" 8995) ;; #X2323
+ (nil "sqsubseteq" "Relational" 8849) ;; #X2291
+ (nil "sqsupseteq" "Relational" 8850) ;; #X2292
+ (nil "doteq" "Relational" 8784) ;; #X2250
+ (nil "frown" "Relational" 8994) ;; #X2322
+ (?i "in" "Relational" 8712) ;; #X2208
+ (nil "ni" "Relational" 8715) ;; #X220B
+ (nil "propto" "Relational" 8733) ;; #X221D
+ (nil "vdash" "Relational" 8866) ;; #X22A2
+ (nil "dashv" "Relational" 8867) ;; #X22A3
+ (?\C-b "leftarrow" "Arrows" 8592) ;; #X2190
+ (nil "Leftarrow" "Arrows" 8656) ;; #X21D0
+ (?\C-f "rightarrow" "Arrows" 8594) ;; #X2192
+ (nil "Rightarrow" "Arrows" 8658) ;; #X21D2
+ (nil "leftrightarrow" "Arrows" 8596) ;; #X2194
+ (nil "Leftrightarrow" "Arrows" 8660) ;; #X21D4
+ (nil "mapsto" "Arrows" 8614) ;; #X21A6
+ (nil "hookleftarrow" "Arrows" 8617) ;; #X21A9
+ (nil "leftharpoonup" "Arrows" 8636) ;; #X21BC
+ (nil "leftharpoondown" "Arrows" 8637) ;; #X21BD
+ (nil "longleftarrow" "Arrows" 10229) ;; #X27F5
+ (nil "Longleftarrow" "Arrows" 10232) ;; #X27F8
+ (nil "longrightarrow" "Arrows" 10230) ;; #X27F6
+ (nil "Longrightarrow" "Arrows" 10233) ;; #X27F9
+ (nil "longleftrightarrow" "Arrows" 10231) ;; #X27F7
+ (nil "Longleftrightarrow" "Arrows" 10234) ;; #X27FA
+ (nil "longmapsto" "Arrows" 10236) ;; #X27FC
+ (nil "hookrightarrow" "Arrows" 8618) ;; #X21AA
+ (nil "rightharpoonup" "Arrows" 8640) ;; #X21C0
+ (nil "rightharpoondown" "Arrows" 8641) ;; #X21C1
+ (?\C-p "uparrow" "Arrows" 8593) ;; #X2191
+ (nil "Uparrow" "Arrows" 8657) ;; #X21D1
+ (?\C-n "downarrow" "Arrows" 8595) ;; #X2193
+ (nil "Downarrow" "Arrows" 8659) ;; #X21D3
+ (nil "updownarrow" "Arrows" 8597) ;; #X2195
+ (nil "Updownarrow" "Arrows" 8661) ;; #X21D5
+ (nil "nearrow" "Arrows" 8599) ;; #X2197
+ (nil "searrow" "Arrows" 8600) ;; #X2198
+ (nil "swarrow" "Arrows" 8601) ;; #X2199
+ (nil "nwarrow" "Arrows" 8598) ;; #X2196
+ (nil "ldots" "Punctuation" 8230) ;; #X2026
+ (nil "cdots" "Punctuation" 8943) ;; #X22EF
+ (nil "vdots" "Punctuation" 8942) ;; #X22EE
+ (nil "ddots" "Punctuation" 8945) ;; #X22F1
+ (?: "colon" "Punctuation" 58) ;; #X003A
+ (?N "nabla" "Misc Symbol" 8711) ;; #X2207
+ (nil "aleph" "Misc Symbol" 8501) ;; #X2135
+ (nil "prime" "Misc Symbol" 8242) ;; #X2032
+ (?A "forall" "Misc Symbol" 8704) ;; #X2200
+ (?I "infty" "Misc Symbol" 8734) ;; #X221E
+ (nil "hbar" "Misc Symbol" 8463) ;; #X210F
+ (?0 "emptyset" "Misc Symbol" 8709) ;; #X2205
+ (?E "exists" "Misc Symbol" 8707) ;; #X2203
+ (nil "surd" "Misc Symbol" 8730) ;; #X221A
+ (nil "Box" "Misc Symbol")
+ (nil "triangle" "Misc Symbol" 9651) ;; #X25B3
+ (nil "Diamond" "Misc Symbol")
+ (nil "imath" "Misc Symbol" 305) ;; #X0131
+ (nil "jmath" "Misc Symbol" 120485) ;; #X1D6A5
+ (nil "ell" "Misc Symbol" 8467) ;; #X2113
+ (nil "neg" "Misc Symbol" 172) ;; #X00AC
+ (?/ "not" "Misc Symbol" 824) ;; #X0338
+ (nil "top" "Misc Symbol" 8868) ;; #X22A4
+ (nil "flat" "Misc Symbol" 9837) ;; #X266D
+ (nil "natural" "Misc Symbol" 9838) ;; #X266E
+ (nil "sharp" "Misc Symbol" 9839) ;; #X266F
+ (nil "wp" "Misc Symbol" 8472) ;; #X2118
+ (nil "bot" "Misc Symbol" 8869) ;; #X22A5
+ (nil "clubsuit" "Misc Symbol" 9827) ;; #X2663
+ (nil "diamondsuit" "Misc Symbol" 9826) ;; #X2662
+ (nil "heartsuit" "Misc Symbol" 9825) ;; #X2661
+ (nil "spadesuit" "Misc Symbol" 9824) ;; #X2660
+ (nil "mho" "Misc Symbol" 8487) ;; #X2127
+ (nil "Re" "Misc Symbol" 8476) ;; #X211C
+ (nil "Im" "Misc Symbol" 8465) ;; #X2111
+ (nil "angle" "Misc Symbol" 8736) ;; #X2220
+ (nil "partial" "Misc Symbol" 8706) ;; #X2202
+ (nil "sum" "Var Symbol" 8721) ;; #X2211
+ (nil "prod" "Var Symbol" 8719) ;; #X220F
+ (nil "coprod" "Var Symbol" 8720) ;; #X2210
+ (nil "int" "Var Symbol" 8747) ;; #X222B
+ (nil "oint" "Var Symbol" 8750) ;; #X222E
+ (nil "bigcap" "Var Symbol" 8898) ;; #X22C2
+ (nil "bigcup" "Var Symbol" 8899) ;; #X22C3
+ (nil "bigsqcup" "Var Symbol" 10758) ;; #X2A06
+ (nil "bigvee" "Var Symbol" 8897) ;; #X22C1
+ (nil "bigwedge" "Var Symbol" 8896) ;; #X22C0
+ (nil "bigodot" "Var Symbol" 10752) ;; #X2A00
+ (nil "bigotimes" "Var Symbol" 10754) ;; #X2A02
+ (nil "bigoplus" "Var Symbol" 10753) ;; #X2A01
+ (nil "biguplus" "Var Symbol" 10756) ;; #X2A04
+ (nil "arccos" "Log-like")
+ (nil "arcsin" "Log-like")
+ (nil "arctan" "Log-like")
+ (nil "arg" "Log-like")
+ (?\C-c "cos" "Log-like")
+ (nil "cosh" "Log-like")
+ (nil "cot" "Log-like")
+ (nil "coth" "Log-like")
+ (nil "csc" "Log-like")
+ (nil "deg" "Log-like")
+ (?\C-d "det" "Log-like")
+ (nil "dim" "Log-like")
+ (?\C-e "exp" "Log-like")
+ (nil "gcd" "Log-like")
+ (nil "hom" "Log-like")
+ (?\C-_ "inf" "Log-like")
+ (nil "ker" "Log-like")
+ (nil "lg" "Log-like")
+ (?\C-l "lim" "Log-like")
+ (nil "liminf" "Log-like")
+ (nil "limsup" "Log-like")
+ (nil "ln" "Log-like")
+ (nil "log" "Log-like")
+ (nil "max" "Log-like")
+ (nil "min" "Log-like")
+ (nil "Pr" "Log-like")
+ (nil "sec" "Log-like")
+ (?\C-s "sin" "Log-like")
+ (nil "sinh" "Log-like")
+ (?\C-^ "sup" "Log-like")
+ (?\C-t "tan" "Log-like")
+ (nil "tanh" "Log-like")
+ (nil "{" "Delimiters")
+ (nil "}" "Delimiters")
+ (nil "lfloor" "Delimiters" 8970) ;; #X230A
+ (nil "rfloor" "Delimiters" 8971) ;; #X230B
+ (nil "lceil" "Delimiters" 8968) ;; #X2308
+ (nil "rceil" "Delimiters" 8969) ;; #X2309
+ (?\( "langle" "Delimiters" 10216) ;; #X27E8
+ (?\) "rangle" "Delimiters" 10217) ;; #X27E9
+ (nil "rmoustache" "Delimiters" 9137) ;; #X23B1
+ (nil "lmoustache" "Delimiters" 9136) ;; #X23B0
+ (nil "rgroup" "Delimiters")
+ (nil "lgroup" "Delimiters")
+ (nil "backslash" "Delimiters" 92) ;; #X005C
+ (nil "|" "Delimiters")
+ (nil "arrowvert" "Delimiters")
+ (nil "Arrowvert" "Delimiters")
+ (nil "bracevert" "Delimiters")
+ (nil "widetilde" "Constructs" 771) ;; #X0303
+ (nil "widehat" "Constructs" 770) ;; #X0302
+ (nil "overleftarrow" "Constructs" 8406) ;; #X20D6
+ (nil "overrightarrow" "Constructs")
+ (nil "overline" "Constructs")
+ (nil "underline" "Constructs")
+ (nil "overbrace" "Constructs" 65079) ;; #XFE37
+ (nil "underbrace" "Constructs" 65080) ;; #XFE38
+ (nil "sqrt" "Constructs" 8730) ;; #X221A
+ (nil "frac" "Constructs")
+ (?^ "hat" "Accents" 770) ;; #X0302
+ (nil "acute" "Accents" 769) ;; #X0301
+ (nil "bar" "Accents" 772) ;; #X0304
+ (nil "dot" "Accents" 775) ;; #X0307
+ (nil "breve" "Accents" 774) ;; #X0306
+ (nil "check" "Accents" 780) ;; #X030C
+ (nil "grave" "Accents" 768) ;; #X0300
+ (nil "vec" "Accents" 8407) ;; #X20D7
+ (nil "ddot" "Accents" 776) ;; #X0308
+ (?~ "tilde" "Accents" 771) ;; #X0303
+ (nil "digamma" ("AMS" "Hebrew") 989) ;; #X03DD
+ (nil "varkappa" ("AMS" "Hebrew") 1008) ;; #X03F0
+ (nil "beth" ("AMS" "Hebrew") 8502) ;; #X2136
+ (nil "daleth" ("AMS" "Hebrew") 8504) ;; #X2138
+ (nil "gimel" ("AMS" "Hebrew") 8503) ;; #X2137
+ ("v G" "varGamma" ("AMS" "Greek Uppercase"))
+ ("v D" "varDelta" ("AMS" "Greek Uppercase"))
+ ("v J" "varTheta" ("AMS" "Greek Uppercase"))
+ ("v L" "varLambda" ("AMS" "Greek Uppercase"))
+ ("v X" "varXi" ("AMS" "Greek Uppercase"))
+ ("v P" "varPi" ("AMS" "Greek Uppercase"))
+ ("v S" "varSigma" ("AMS" "Greek Uppercase"))
+ ("v U" "varUpsilon" ("AMS" "Greek Uppercase"))
+ ("v F" "varPhi" ("AMS" "Greek Uppercase"))
+ ("v Y" "varPsi" ("AMS" "Greek Uppercase"))
+ ("v W" "varOmega" ("AMS" "Greek Uppercase"))
+ (nil "dashrightarrow" ("AMS" "Arrows"))
+ (nil "dashleftarrow" ("AMS" "Arrows"))
+ (nil "leftleftarrows" ("AMS" "Arrows") 8647) ;; #X21C7
+ (nil "leftrightarrows" ("AMS" "Arrows") 8646) ;; #X21C6
+ (nil "Lleftarrow" ("AMS" "Arrows") 8666) ;; #X21DA
+ (nil "twoheadleftarrow" ("AMS" "Arrows") 8606) ;; #X219E
+ (nil "leftarrowtail" ("AMS" "Arrows") 8610) ;; #X21A2
+ (nil "looparrowleft" ("AMS" "Arrows") 8619) ;; #X21AB
+ (nil "leftrightharpoons" ("AMS" "Arrows") 8651) ;; #X21CB
+ (nil "curvearrowleft" ("AMS" "Arrows") 8630) ;; #X21B6
+ (nil "circlearrowleft" ("AMS" "Arrows"))
+ (nil "Lsh" ("AMS" "Arrows") 8624) ;; #X21B0
+ (nil "upuparrows" ("AMS" "Arrows") 8648) ;; #X21C8
+ (nil "upharpoonleft" ("AMS" "Arrows") 8639) ;; #X21BF
+ (nil "downharpoonleft" ("AMS" "Arrows") 8643) ;; #X21C3
+ (nil "multimap" ("AMS" "Arrows") 8888) ;; #X22B8
+ (nil "leftrightsquigarrow" ("AMS" "Arrows") 8621) ;; #X21AD
+ (nil "looparrowright" ("AMS" "Arrows") 8620) ;; #X21AC
+ (nil "rightleftharpoons" ("AMS" "Arrows") 8652) ;; #X21CC
+ (nil "curvearrowright" ("AMS" "Arrows") 8631) ;; #X21B7
+ (nil "circlearrowright" ("AMS" "Arrows"))
+ (nil "Rsh" ("AMS" "Arrows") 8625) ;; #X21B1
+ (nil "downdownarrows" ("AMS" "Arrows") 8650) ;; #X21CA
+ (nil "upharpoonright" ("AMS" "Arrows") 8638) ;; #X21BE
+ (nil "downharpoonright" ("AMS" "Arrows") 8642) ;; #X21C2
+ (nil "rightsquigarrow" ("AMS" "Arrows") 8605) ;; #X219D
+ (nil "nleftarrow" ("AMS" "Neg Arrows") 8602) ;; #X219A
+ (nil "nrightarrow" ("AMS" "Neg Arrows") 8603) ;; #X219B
+ (nil "nLeftarrow" ("AMS" "Neg Arrows") 8653) ;; #X21CD
+ (nil "nRightarrow" ("AMS" "Neg Arrows") 8655) ;; #X21CF
+ (nil "nleftrightarrow" ("AMS" "Neg Arrows") 8622) ;; #X21AE
+ (nil "nLeftrightarrow" ("AMS" "Neg Arrows") 8654) ;; #X21CE
+ (nil "leqq" ("AMS" "Relational I") 8806) ;; #X2266
+ (nil "leqslant" ("AMS" "Relational I") 10877) ;; #X2A7D
+ (nil "eqslantless" ("AMS" "Relational I") 10901) ;; #X2A95
+ (nil "lesssim" ("AMS" "Relational I") 8818) ;; #X2272
+ (nil "lessapprox" ("AMS" "Relational I") 10885) ;; #X2A85
+ (nil "approxeq" ("AMS" "Relational I") 8778) ;; #X224A
+ (nil "lessdot" ("AMS" "Relational I") 8918) ;; #X22D6
+ (nil "lll" ("AMS" "Relational I") 8920) ;; #X22D8
+ (nil "lessgtr" ("AMS" "Relational I") 8822) ;; #X2276
+ (nil "lesseqgtr" ("AMS" "Relational I") 8922) ;; #X22DA
+ (nil "lesseqqgtr" ("AMS" "Relational I") 10891) ;; #X2A8B
+ (nil "doteqdot" ("AMS" "Relational I"))
+ (nil "risingdotseq" ("AMS" "Relational I") 8787) ;; #X2253
+ (nil "fallingdotseq" ("AMS" "Relational I") 8786) ;; #X2252
+ (nil "backsim" ("AMS" "Relational I") 8765) ;; #X223D
+ (nil "backsimeq" ("AMS" "Relational I") 8909) ;; #X22CD
+ (nil "subseteqq" ("AMS" "Relational I") 10949) ;; #X2AC5
+ (nil "Subset" ("AMS" "Relational I") 8912) ;; #X22D0
+ (nil "sqsubset" ("AMS" "Relational I") 8847) ;; #X228F
+ (nil "preccurlyeq" ("AMS" "Relational I") 8828) ;; #X227C
+ (nil "curlyeqprec" ("AMS" "Relational I") 8926) ;; #X22DE
+ (nil "precsim" ("AMS" "Relational I") 8830) ;; #X227E
+ (nil "precapprox" ("AMS" "Relational I") 10935) ;; #X2AB7
+ (nil "vartriangleleft" ("AMS" "Relational I") 8882) ;; #X22B2
+ (nil "trianglelefteq" ("AMS" "Relational I") 8884) ;; #X22B4
+ (nil "vDash" ("AMS" "Relational I") 8872) ;; #X22A8
+ (nil "Vvdash" ("AMS" "Relational I") 8874) ;; #X22AA
+ (nil "smallsmile" ("AMS" "Relational I") 8995) ;; #X2323
+ (nil "smallfrown" ("AMS" "Relational I") 8994) ;; #X2322
+ (nil "bumpeq" ("AMS" "Relational I") 8783) ;; #X224F
+ (nil "Bumpeq" ("AMS" "Relational I") 8782) ;; #X224E
+ (nil "geqq" ("AMS" "Relational II") 8807) ;; #X2267
+ (nil "geqslant" ("AMS" "Relational II") 10878) ;; #X2A7E
+ (nil "eqslantgtr" ("AMS" "Relational II") 10902) ;; #X2A96
+ (nil "gtrsim" ("AMS" "Relational II") 8819) ;; #X2273
+ (nil "gtrapprox" ("AMS" "Relational II") 10886) ;; #X2A86
+ (nil "gtrdot" ("AMS" "Relational II") 8919) ;; #X22D7
+ (nil "ggg" ("AMS" "Relational II") 8921) ;; #X22D9
+ (nil "gtrless" ("AMS" "Relational II") 8823) ;; #X2277
+ (nil "gtreqless" ("AMS" "Relational II") 8923) ;; #X22DB
+ (nil "gtreqqless" ("AMS" "Relational II") 10892) ;; #X2A8C
+ (nil "eqcirc" ("AMS" "Relational II") 8790) ;; #X2256
+ (nil "circeq" ("AMS" "Relational II") 8791) ;; #X2257
+ (nil "triangleq" ("AMS" "Relational II") 8796) ;; #X225C
+ (nil "thicksim" ("AMS" "Relational II") 8764) ;; #X223C
+ (nil "thickapprox" ("AMS" "Relational II") 8776) ;; #X2248
+ (nil "supseteqq" ("AMS" "Relational II") 10950) ;; #X2AC6
+ (nil "Supset" ("AMS" "Relational II") 8913) ;; #X22D1
+ (nil "sqsupset" ("AMS" "Relational II") 8848) ;; #X2290
+ (nil "succcurlyeq" ("AMS" "Relational II") 8829) ;; #X227D
+ (nil "curlyeqsucc" ("AMS" "Relational II") 8927) ;; #X22DF
+ (nil "succsim" ("AMS" "Relational II") 8831) ;; #X227F
+ (nil "succapprox" ("AMS" "Relational II") 10936) ;; #X2AB8
+ (nil "vartriangleright" ("AMS" "Relational II") 8883) ;; #X22B3
+ (nil "trianglerighteq" ("AMS" "Relational II") 8885) ;; #X22B5
+ (nil "Vdash" ("AMS" "Relational II") 8873) ;; #X22A9
+ (nil "shortmid" ("AMS" "Relational II") 8739) ;; #X2223
+ (nil "shortparallel" ("AMS" "Relational II") 8741) ;; #X2225
+ (nil "between" ("AMS" "Relational II") 8812) ;; #X226C
+ (nil "pitchfork" ("AMS" "Relational II") 8916) ;; #X22D4
+ (nil "varpropto" ("AMS" "Relational II") 8733) ;; #X221D
+ (nil "blacktriangleleft" ("AMS" "Relational II") 9664) ;; #X25C0
+ (nil "therefore" ("AMS" "Relational II") 8756) ;; #X2234
+ (nil "backepsilon" ("AMS" "Relational II") 1014) ;; #X03F6
+ (nil "blacktriangleright" ("AMS" "Relational II") 9654) ;; #X25B6
+ (nil "because" ("AMS" "Relational II") 8757) ;; #X2235
+ (nil "nless" ("AMS" "Neg Rel I") 8814) ;; #X226E
+ (nil "nleq" ("AMS" "Neg Rel I") 8816) ;; #X2270
+ (nil "nleqslant" ("AMS" "Neg Rel I"))
+ (nil "nleqq" ("AMS" "Neg Rel I"))
+ (nil "lneq" ("AMS" "Neg Rel I") 10887) ;; #X2A87
+ (nil "lneqq" ("AMS" "Neg Rel I") 8808) ;; #X2268
+ (nil "lvertneqq" ("AMS" "Neg Rel I"))
+ (nil "lnsim" ("AMS" "Neg Rel I") 8934) ;; #X22E6
+ (nil "lnapprox" ("AMS" "Neg Rel I") 10889) ;; #X2A89
+ (nil "nprec" ("AMS" "Neg Rel I") 8832) ;; #X2280
+ (nil "npreceq" ("AMS" "Neg Rel I"))
+ (nil "precnsim" ("AMS" "Neg Rel I") 8936) ;; #X22E8
+ (nil "precnapprox" ("AMS" "Neg Rel I") 10937) ;; #X2AB9
+ (nil "nsim" ("AMS" "Neg Rel I") 8769) ;; #X2241
+ (nil "nshortmid" ("AMS" "Neg Rel I") 8740) ;; #X2224
+ (nil "nmid" ("AMS" "Neg Rel I") 8740) ;; #X2224
+ (nil "nvdash" ("AMS" "Neg Rel I") 8876) ;; #X22AC
+ (nil "nvDash" ("AMS" "Neg Rel I") 8877) ;; #X22AD
+ (nil "ntriangleleft" ("AMS" "Neg Rel I") 8938) ;; #X22EA
+ (nil "ntrianglelefteq" ("AMS" "Neg Rel I") 8940) ;; #X22EC
+ (nil "nsubseteq" ("AMS" "Neg Rel I") 8840) ;; #X2288
+ (nil "subsetneq" ("AMS" "Neg Rel I") 8842) ;; #X228A
+ (nil "varsubsetneq" ("AMS" "Neg Rel I"))
+ (nil "subsetneqq" ("AMS" "Neg Rel I") 10955) ;; #X2ACB
+ (nil "varsubsetneqq" ("AMS" "Neg Rel I"))
+ (nil "ngtr" ("AMS" "Neg Rel II") 8815) ;; #X226F
+ (nil "ngeq" ("AMS" "Neg Rel II") 8817) ;; #X2271
+ (nil "ngeqslant" ("AMS" "Neg Rel II"))
+ (nil "ngeqq" ("AMS" "Neg Rel II"))
+ (nil "gneq" ("AMS" "Neg Rel II") 10888) ;; #X2A88
+ (nil "gneqq" ("AMS" "Neg Rel II") 8809) ;; #X2269
+ (nil "gvertneqq" ("AMS" "Neg Rel II"))
+ (nil "gnsim" ("AMS" "Neg Rel II") 8935) ;; #X22E7
+ (nil "gnapprox" ("AMS" "Neg Rel II") 10890) ;; #X2A8A
+ (nil "nsucc" ("AMS" "Neg Rel II") 8833) ;; #X2281
+ (nil "nsucceq" ("AMS" "Neg Rel II"))
+ (nil "succnsim" ("AMS" "Neg Rel II") 8937) ;; #X22E9
+ (nil "succnapprox" ("AMS" "Neg Rel II") 10938) ;; #X2ABA
+ (nil "ncong" ("AMS" "Neg Rel II") 8775) ;; #X2247
+ (nil "nshortparallel" ("AMS" "Neg Rel II") 8742) ;; #X2226
+ (nil "nparallel" ("AMS" "Neg Rel II") 8742) ;; #X2226
+ (nil "nvDash" ("AMS" "Neg Rel II") 8877) ;; #X22AD
+ (nil "nVDash" ("AMS" "Neg Rel II") 8879) ;; #X22AF
+ (nil "ntriangleright" ("AMS" "Neg Rel II") 8939) ;; #X22EB
+ (nil "ntrianglerighteq" ("AMS" "Neg Rel II") 8941) ;; #X22ED
+ (nil "nsupseteq" ("AMS" "Neg Rel II") 8841) ;; #X2289
+ (nil "nsupseteqq" ("AMS" "Neg Rel II"))
+ (nil "supsetneq" ("AMS" "Neg Rel II") 8843) ;; #X228B
+ (nil "varsupsetneq" ("AMS" "Neg Rel II"))
+ (nil "supsetneqq" ("AMS" "Neg Rel II") 10956) ;; #X2ACC
+ (nil "varsupsetneqq" ("AMS" "Neg Rel II"))
+ (nil "dotplus" ("AMS" "Binary Op") 8724) ;; #X2214
+ (nil "smallsetminus" ("AMS" "Binary Op") 8726) ;; #X2216
+ (nil "Cap" ("AMS" "Binary Op") 8914) ;; #X22D2
+ (nil "Cup" ("AMS" "Binary Op") 8915) ;; #X22D3
+ (nil "barwedge" ("AMS" "Binary Op") 8892) ;; #X22BC
+ (nil "veebar" ("AMS" "Binary Op") 8891) ;; #X22BB
+ (nil "doublebarwedge" ("AMS" "Binary Op") 8966) ;; #X2306
+ (nil "boxminus" ("AMS" "Binary Op") 8863) ;; #X229F
+ (nil "boxtimes" ("AMS" "Binary Op") 8864) ;; #X22A0
+ (nil "boxdot" ("AMS" "Binary Op") 8865) ;; #X22A1
+ (nil "boxplus" ("AMS" "Binary Op") 8862) ;; #X229E
+ (nil "divideontimes" ("AMS" "Binary Op") 8903) ;; #X22C7
+ (nil "ltimes" ("AMS" "Binary Op") 8905) ;; #X22C9
+ (nil "rtimes" ("AMS" "Binary Op") 8906) ;; #X22CA
+ (nil "leftthreetimes" ("AMS" "Binary Op") 8907) ;; #X22CB
+ (nil "rightthreetimes" ("AMS" "Binary Op") 8908) ;; #X22CC
+ (nil "curlywedge" ("AMS" "Binary Op") 8911) ;; #X22CF
+ (nil "curlyvee" ("AMS" "Binary Op") 8910) ;; #X22CE
+ (nil "circleddash" ("AMS" "Binary Op") 8861) ;; #X229D
+ (nil "circledast" ("AMS" "Binary Op") 8859) ;; #X229B
+ (nil "circledcirc" ("AMS" "Binary Op") 8858) ;; #X229A
+ (nil "centerdot" ("AMS" "Binary Op"))
+ (nil "intercal" ("AMS" "Binary Op") 8890) ;; #X22BA
+ (nil "hbar" ("AMS" "Misc") 8463) ;; #X210F
+ (nil "hslash" ("AMS" "Misc") 8463) ;; #X210F
+ (nil "vartriangle" ("AMS" "Misc") 9653) ;; #X25B5
+ (nil "triangledown" ("AMS" "Misc") 9663) ;; #X25BF
+ (nil "square" ("AMS" "Misc") 9633) ;; #X25A1
+ (nil "lozenge" ("AMS" "Misc") 9674) ;; #X25CA
+ (nil "circledS" ("AMS" "Misc") 9416) ;; #X24C8
+ (nil "angle" ("AMS" "Misc") 8736) ;; #X2220
+ (nil "measuredangle" ("AMS" "Misc") 8737) ;; #X2221
+ (nil "nexists" ("AMS" "Misc") 8708) ;; #X2204
+ (nil "mho" ("AMS" "Misc") 8487) ;; #X2127
+ (nil "Finv" ("AMS" "Misc") 8498) ;; #X2132
+ (nil "Game" ("AMS" "Misc") 8513) ;; #X2141
+ (nil "Bbbk" ("AMS" "Misc") 120156) ;; #X1D55C
+ (nil "backprime" ("AMS" "Misc") 8245) ;; #X2035
+ (nil "varnothing" ("AMS" "Misc") 8709) ;; #X2205
+ (nil "blacktriangle" ("AMS" "Misc") 9652) ;; #X25B4
+ (nil "blacktriangledown" ("AMS" "Misc") 9662) ;; #X25BE
+ (nil "blacksquare" ("AMS" "Misc") 9632) ;; #X25A0
+ (nil "blacklozenge" ("AMS" "Misc") 10731) ;; #X29EB
+ (nil "bigstar" ("AMS" "Misc") 9733) ;; #X2605
+ (nil "sphericalangle" ("AMS" "Misc") 8738) ;; #X2222
+ (nil "complement" ("AMS" "Misc") 8705) ;; #X2201
+ (nil "eth" ("AMS" "Misc") 240) ;; #X00F0
+ (nil "diagup" ("AMS" "Misc") 9585) ;; #X2571
+ (nil "diagdown" ("AMS" "Misc") 9586) ;; #X2572
+ (nil "dddot" ("AMS" "Accents") 8411) ;; #X20DB
+ (nil "ddddot" ("AMS" "Accents") 8412) ;; #X20DC
+ (nil "bigl" ("AMS" "Delimiters"))
+ (nil "bigr" ("AMS" "Delimiters"))
+ (nil "Bigl" ("AMS" "Delimiters"))
+ (nil "Bigr" ("AMS" "Delimiters"))
+ (nil "biggl" ("AMS" "Delimiters"))
+ (nil "biggr" ("AMS" "Delimiters"))
+ (nil "Biggl" ("AMS" "Delimiters"))
+ (nil "Biggr" ("AMS" "Delimiters"))
+ (nil "lvert" ("AMS" "Delimiters"))
+ (nil "rvert" ("AMS" "Delimiters"))
+ (nil "lVert" ("AMS" "Delimiters"))
+ (nil "rVert" ("AMS" "Delimiters"))
+ (nil "ulcorner" ("AMS" "Delimiters") 8988) ;; #X231C
+ (nil "urcorner" ("AMS" "Delimiters") 8989) ;; #X231D
+ (nil "llcorner" ("AMS" "Delimiters") 8990) ;; #X231E
+ (nil "lrcorner" ("AMS" "Delimiters") 8991) ;; #X231F
+ (nil "nobreakdash" ("AMS" "Special"))
+ (nil "leftroot" ("AMS" "Special"))
+ (nil "uproot" ("AMS" "Special"))
+ (nil "accentedsymbol" ("AMS" "Special"))
+ (nil "xleftarrow" ("AMS" "Special"))
+ (nil "xrightarrow" ("AMS" "Special"))
+ (nil "overset" ("AMS" "Special"))
+ (nil "underset" ("AMS" "Special"))
+ (nil "dfrac" ("AMS" "Special"))
+ (nil "genfrac" ("AMS" "Special"))
+ (nil "tfrac" ("AMS" "Special"))
+ (nil "binom" ("AMS" "Special"))
+ (nil "dbinom" ("AMS" "Special"))
+ (nil "tbinom" ("AMS" "Special"))
+ (nil "smash" ("AMS" "Special"))
+ (nil "eucal" ("AMS" "Special"))
+ (nil "boldsymbol" ("AMS" "Special"))
+ (nil "text" ("AMS" "Special"))
+ (nil "intertext" ("AMS" "Special"))
+ (nil "substack" ("AMS" "Special"))
+ (nil "subarray" ("AMS" "Special"))
+ (nil "sideset" ("AMS" "Special")))
+ "Alist of LaTeX math symbols.
+
+Each entry should be a list with upto four elements, KEY, VALUE,
+MENU and CHARACTER, see `LaTeX-math-list' for details.")
+
+(defcustom LaTeX-math-abbrev-prefix "`"
+ "Prefix key for use in `LaTeX-math-mode'.
+This has to be a string representing a key sequence in a format
+understood by the `kbd' macro. This corresponds to the syntax
+usually used in the Emacs and Elisp manuals.
+
+Setting this variable directly does not take effect;
+use \\[customize]."
+ :group 'LaTeX-math
+ :initialize 'custom-initialize-default
+ :set '(lambda (symbol value)
+ (define-key LaTeX-math-mode-map (LaTeX-math-abbrev-prefix) t)
+ (set-default symbol value)
+ (define-key LaTeX-math-mode-map
+ (LaTeX-math-abbrev-prefix) LaTeX-math-keymap))
+ :type '(string :tag "Key sequence"))
+
+(defun LaTeX-math-abbrev-prefix ()
+ "Make a key definition from the variable `LaTeX-math-abbrev-prefix'."
+ (if (stringp LaTeX-math-abbrev-prefix)
+ (read-kbd-macro LaTeX-math-abbrev-prefix)
+ LaTeX-math-abbrev-prefix))
+
+(defvar LaTeX-math-keymap (make-sparse-keymap)
+ "Keymap used for `LaTeX-math-mode' commands.")
+
+(defvar LaTeX-math-menu
+ '("Math"
+ ("Greek Uppercase") ("Greek Lowercase") ("Binary Op") ("Relational")
+ ("Arrows") ("Punctuation") ("Misc Symbol") ("Var Symbol") ("Log-like")
+ ("Delimiters") ("Constructs") ("Accents") ("AMS"))
+ "Menu containing LaTeX math commands.
+The menu entries will be generated dynamically, but you can specify
+the sequence by initializing this variable.")
+
+(defcustom LaTeX-math-menu-unicode
+ (and (string-match "\\<GTK\\>" (emacs-version)) t)
+ "Whether the LaTeX menu should try using Unicode for effect."
+ :type 'boolean
+ :group 'LaTeX-math)
+
+(let ((math (reverse (append LaTeX-math-list LaTeX-math-default)))
+ (map LaTeX-math-keymap)
+ (unicode (and LaTeX-math-menu-unicode (fboundp 'decode-char))))
+ (while math
+ (let* ((entry (car math))
+ (key (nth 0 entry))
+ (prefix
+ (and unicode
+ (nth 3 entry)))
+ value menu name)
+ (setq math (cdr math))
+ (if (and prefix
+ (setq prefix (decode-char 'ucs (nth 3 entry))))
+ (setq prefix (concat (string prefix) " \\"))
+ (setq prefix "\\"))
+ (if (listp (cdr entry))
+ (setq value (nth 1 entry)
+ menu (nth 2 entry))
+ (setq value (cdr entry)
+ menu nil))
+ (if (stringp value)
+ (progn
+ (setq name (intern (concat "LaTeX-math-" value)))
+ (fset name (list 'lambda (list 'arg) (list 'interactive "*P")
+ (list 'LaTeX-math-insert value 'arg))))
+ (setq name value))
+ (if key
+ (progn
+ (setq key (cond ((numberp key) (char-to-string key))
+ ((stringp key) (read-kbd-macro key))
+ (t (vector key))))
+ (define-key map key name)))
+ (if menu
+ (let ((parent LaTeX-math-menu))
+ (if (listp menu)
+ (progn
+ (while (cdr menu)
+ (let ((sub (assoc (car menu) LaTeX-math-menu)))
+ (if sub
+ (setq parent sub)
+ (setcdr parent (cons (list (car menu)) (cdr parent))))
+ (setq menu (cdr menu))))
+ (setq menu (car menu))))
+ (let ((sub (assoc menu parent)))
+ (if sub
+ (if (stringp value)
+ (setcdr sub (cons (vector (concat prefix value)
+ name t)
+ (cdr sub)))
+ (error "Cannot have multiple special math menu items"))
+ (setcdr parent
+ (cons (if (stringp value)
+ (list menu (vector (concat prefix value)
+ name t))
+ (vector menu name t))
+ (cdr parent)))))))))
+ ;; Make the math prefix char available if it has not been used as a prefix.
+ (unless (lookup-key map (LaTeX-math-abbrev-prefix))
+ (define-key map (LaTeX-math-abbrev-prefix) 'self-insert-command)))
+
+(define-minor-mode LaTeX-math-mode
+ "A minor mode with easy access to TeX math macros.
+
+Easy insertion of LaTeX math symbols. If you give a prefix argument,
+the symbols will be surrounded by dollar signs. The following
+commands are defined:
+
+\\{LaTeX-math-mode-map}"
+ nil nil (list (cons (LaTeX-math-abbrev-prefix) LaTeX-math-keymap))
+ (if LaTeX-math-mode
+ (easy-menu-add LaTeX-math-mode-menu LaTeX-math-mode-map)
+ (easy-menu-remove LaTeX-math-mode-menu))
+ (TeX-set-mode-name))
+(defalias 'latex-math-mode 'LaTeX-math-mode)
+
+(easy-menu-define LaTeX-math-mode-menu
+ LaTeX-math-mode-map
+ "Menu used in math minor mode."
+ LaTeX-math-menu)
+
+(defcustom LaTeX-math-insert-function 'TeX-insert-macro
+ "Function called with argument STRING to insert \\STRING."
+ :group 'LaTeX-math
+ :type 'function)
+
+(defun LaTeX-math-insert (string dollar)
+ "Insert \\STRING{}. If DOLLAR is non-nil, put $'s around it."
+ (if dollar (insert "$"))
+ (funcall LaTeX-math-insert-function string)
+ (if dollar (insert "$")))
+
+(defun LaTeX-math-cal (char dollar)
+ "Insert a {\\cal CHAR}. If DOLLAR is non-nil, put $'s around it."
+ (interactive "*c\nP")
+ (if dollar (insert "$"))
+ (if (member "latex2e" (TeX-style-list))
+ (insert "\\mathcal{" (char-to-string char) "}")
+ (insert "{\\cal " (char-to-string char) "}"))
+ (if dollar (insert "$")))
+
+
+;;; Folding
+
+(defcustom LaTeX-fold-macro-spec-list nil
+ "List of display strings and macros to fold in LaTeX mode."
+ :type '(repeat (group (choice (string :tag "Display String")
+ (integer :tag "Number of argument" :value 1))
+ (repeat :tag "Macros" (string))))
+ :group 'TeX-fold)
+
+(defcustom LaTeX-fold-env-spec-list nil
+ "List of display strings and environments to fold in LaTeX mode."
+ :type '(repeat (group (choice (string :tag "Display String")
+ (integer :tag "Number of argument" :value 1))
+ (repeat :tag "Environments" (string))))
+ :group 'TeX-fold)
+
+(defcustom LaTeX-fold-math-spec-list
+ (delete nil
+ (mapcar (lambda (elt)
+ (let ((tex-token (nth 1 elt))
+ (submenu (nth 2 elt))
+ (unicode (nth 3 elt))
+ uchar noargp)
+ (when (and (fboundp 'decode-char) (integerp unicode))
+ (setq uchar (decode-char 'ucs unicode)))
+ (when (listp submenu) (setq submenu (nth 1 submenu)))
+ (setq noargp
+ (not (string-match
+ (concat "^" (regexp-opt '("Constructs"
+ "Accents")))
+ submenu)))
+ (when (and (stringp tex-token) (integerp uchar) noargp)
+ `(,(char-to-string uchar) (,tex-token)))))
+ `((nil "to" "" 8594)
+ (nil "gets" "" 8592)
+ ,@LaTeX-math-default)))
+ "List of display strings and math macros to fold in LaTeX mode."
+ :type '(repeat (group (choice (string :tag "Display String")
+ (integer :tag "Number of argument" :value 1))
+ (repeat :tag "Math Macros" (string))))
+ :group 'TeX-fold)
+
+
+;;; Keymap
+
+(defvar LaTeX-mode-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map TeX-mode-map)
+
+ ;; Standard
+ (define-key map "\n" 'reindent-then-newline-and-indent)
+
+ ;; From latex.el
+ ;; We now set `fill-paragraph-function' instead.
+ ;; (define-key map "\eq" 'LaTeX-fill-paragraph) ;*** Alias
+ ;; This key is now used by Emacs for face settings.
+ ;; (define-key map "\eg" 'LaTeX-fill-region) ;*** Alias
+ (define-key map "\e\C-e" 'LaTeX-find-matching-end)
+ (define-key map "\e\C-a" 'LaTeX-find-matching-begin)
+
+ (define-key map "\C-c\C-q\C-p" 'LaTeX-fill-paragraph)
+ (define-key map "\C-c\C-q\C-r" 'LaTeX-fill-region)
+ (define-key map "\C-c\C-q\C-s" 'LaTeX-fill-section)
+ (define-key map "\C-c\C-q\C-e" 'LaTeX-fill-environment)
+
+ (define-key map "\C-c." 'LaTeX-mark-environment) ;*** Dubious
+ (define-key map "\C-c*" 'LaTeX-mark-section) ;*** Dubious
+
+ (define-key map "\C-c\C-e" 'LaTeX-environment)
+ (define-key map "\C-c\n" 'LaTeX-insert-item)
+ (or (key-binding "\e\r")
+ (define-key map "\e\r" 'LaTeX-insert-item)) ;*** Alias
+ (define-key map "\C-c]" 'LaTeX-close-environment)
+ (define-key map "\C-c\C-s" 'LaTeX-section)
+
+ (define-key map "\C-c~" 'LaTeX-math-mode) ;*** Dubious
+
+ (define-key map "-" 'LaTeX-babel-insert-hyphen)
+ map)
+ "Keymap used in `LaTeX-mode'.")
+
+(defvar LaTeX-environment-menu-name "Insert Environment (C-c C-e)")
+
+(defun LaTeX-environment-menu-entry (entry)
+ "Create an entry for the environment menu."
+ (vector (car entry) (list 'LaTeX-environment-menu (car entry)) t))
+
+(defvar LaTeX-environment-modify-menu-name "Change Environment (C-u C-c C-e)")
+
+(defun LaTeX-environment-modify-menu-entry (entry)
+ "Create an entry for the change environment menu."
+ (vector (car entry) (list 'LaTeX-modify-environment (car entry)) t))
+
+(defun LaTeX-section-enable-symbol (LEVEL)
+ "Symbol used to enable section LEVEL in the menu bar."
+ (intern (concat "LaTeX-section-" (int-to-string (nth 1 entry)) "-enable")))
+
+(defun LaTeX-section-enable (entry)
+ "Enable or disable section ENTRY from `LaTeX-section-list'."
+ (let* ((level (nth 1 entry))
+ (symbol (LaTeX-section-enable-symbol level)))
+ (set symbol (or (= level 0) (>= level LaTeX-largest-level)))
+ (make-variable-buffer-local symbol)))
+
+(defun LaTeX-section-menu (level)
+ "Insert section from menu."
+ (let ((LaTeX-section-hook (delq 'LaTeX-section-heading
+ (copy-sequence LaTeX-section-hook))))
+ (LaTeX-section level)))
+
+(defun LaTeX-section-menu-entry (entry)
+ "Create an ENTRY for the section menu."
+ (let ((enable (LaTeX-section-enable-symbol (nth 1 entry))))
+ (vector (car entry) (list 'LaTeX-section-menu (nth 1 entry)) enable)))
+
+(defcustom LaTeX-menu-max-items 25
+ "*Maximum number of items in the menu for LaTeX environments.
+If number of entries in a menu is larger than this value, split menu
+into submenus of nearly equal length. If nil, never split menu into
+submenus."
+ :group 'LaTeX-environment
+ :type '(choice (const :tag "no submenus" nil)
+ (integer)))
+
+(defcustom LaTeX-submenu-name-format "%-12.12s ... %.12s"
+ "*Format specification of the submenu name.
+Used by `LaTeX-split-long-menu' if the number of entries in a menu is
+larger than `LaTeX-menu-max-items'.
+This string should contain one %s for the name of the first entry and
+one %s for the name of the last entry in the submenu.
+If the value is a function, it should return the submenu name. The
+function is called with two arguments, the names of the first and
+the last entry in the menu."
+ :group 'LaTeX-environment
+ :type '(choice (string :tag "Format string")
+ (function)))
+
+(defun LaTeX-split-long-menu (menu)
+ "Split MENU according to `LaTeX-menu-max-items'."
+ (let ((len (length menu)))
+ (if (or (null LaTeX-menu-max-items)
+ (null (featurep 'lisp-float-type))
+ (<= len LaTeX-menu-max-items))
+ menu
+ ;; Submenu is max 2 entries longer than menu, never shorter, number of
+ ;; entries in submenus differ by at most one (with longer submenus first)
+ (let* ((outer (floor (sqrt len)))
+ (inner (/ len outer))
+ (rest (% len outer))
+ (result nil))
+ (setq menu (reverse menu))
+ (while menu
+ (let ((in inner)
+ (sub nil)
+ (to (car menu)))
+ (while (> in 0)
+ (setq in (1- in)
+ sub (cons (car menu) sub)
+ menu (cdr menu)))
+ (setq result
+ (cons (cons (if (stringp LaTeX-submenu-name-format)
+ (format LaTeX-submenu-name-format
+ (aref (car sub) 0) (aref to 0))
+ (funcall LaTeX-submenu-name-format
+ (aref (car sub) 0) (aref to 0)))
+ sub)
+ result)
+ rest (1+ rest))
+ (if (= rest outer) (setq inner (1+ inner)))))
+ result))))
+
+(defvar LaTeX-section-menu nil)
+(make-variable-buffer-local 'LaTeX-section-menu)
+(defun LaTeX-section-menu-filter (ignored)
+ "Filter function for the section submenu in the mode menu.
+The argument IGNORED is not used in any way."
+ (TeX-update-style)
+ (or LaTeX-section-menu
+ (progn
+ (setq LaTeX-section-list-changed nil)
+ (mapc 'LaTeX-section-enable LaTeX-section-list)
+ (setq LaTeX-section-menu
+ (mapcar 'LaTeX-section-menu-entry LaTeX-section-list)))))
+
+(defvar LaTeX-environment-menu nil)
+(make-variable-buffer-local 'LaTeX-environment-menu)
+(defvar LaTeX-environment-modify-menu nil)
+(make-variable-buffer-local 'LaTeX-environment-modify-menu)
+(defun LaTeX-environment-menu-filter (menu)
+ "Filter function for the environment submenus in the mode menu.
+The argument MENU is the name of the submenu in concern and
+corresponds to the variables `LaTeX-environment-menu-name' and
+`LaTeX-environment-modify-menu-name'."
+ (TeX-update-style)
+ (cond
+ ((string= menu LaTeX-environment-menu-name)
+ (or LaTeX-environment-menu
+ (setq LaTeX-environment-menu
+ (LaTeX-split-long-menu
+ (mapcar 'LaTeX-environment-menu-entry
+ (LaTeX-environment-list))))))
+ ((string= menu LaTeX-environment-modify-menu-name)
+ (or LaTeX-environment-modify-menu
+ (setq LaTeX-environment-modify-menu
+ (LaTeX-split-long-menu
+ (mapcar 'LaTeX-environment-modify-menu-entry
+ (LaTeX-environment-list))))))))
+
+(easy-menu-define LaTeX-mode-command-menu
+ LaTeX-mode-map
+ "Command menu used in LaTeX mode."
+ (TeX-mode-specific-command-menu 'latex-mode))
+
+(easy-menu-define LaTeX-mode-menu
+ LaTeX-mode-map
+ "Menu used in LaTeX mode."
+ (TeX-menu-with-help
+ `("LaTeX"
+ ("Section (C-c C-s)" :filter LaTeX-section-menu-filter)
+ ["Macro..." TeX-insert-macro
+ :help "Insert a macro and possibly arguments"]
+ ["Complete Macro" TeX-complete-symbol
+ :help "Complete the current macro or environment name"]
+ ,(list LaTeX-environment-menu-name
+ :filter (lambda (ignored) (LaTeX-environment-menu-filter
+ LaTeX-environment-menu-name)))
+ ,(list LaTeX-environment-modify-menu-name
+ :filter (lambda (ignored) (LaTeX-environment-menu-filter
+ LaTeX-environment-modify-menu-name)))
+ ["Close Environment" LaTeX-close-environment
+ :help "Insert the \\end part of the current environment"]
+ ["Item" LaTeX-insert-item
+ :help "Insert a new \\item into current environment"]
+ "-"
+ ("Insert Font"
+ ["Emphasize" (TeX-font nil ?\C-e) :keys "C-c C-f C-e"]
+ ["Bold" (TeX-font nil ?\C-b) :keys "C-c C-f C-b"]
+ ["Typewriter" (TeX-font nil ?\C-t) :keys "C-c C-f C-t"]
+ ["Small Caps" (TeX-font nil ?\C-c) :keys "C-c C-f C-c"]
+ ["Sans Serif" (TeX-font nil ?\C-f) :keys "C-c C-f C-f"]
+ ["Italic" (TeX-font nil ?\C-i) :keys "C-c C-f C-i"]
+ ["Slanted" (TeX-font nil ?\C-s) :keys "C-c C-f C-s"]
+ ["Roman" (TeX-font nil ?\C-r) :keys "C-c C-f C-r"]
+ ["Calligraphic" (TeX-font nil ?\C-a) :keys "C-c C-f C-a"])
+ ("Replace Font"
+ ["Emphasize" (TeX-font t ?\C-e) :keys "C-u C-c C-f C-e"]
+ ["Bold" (TeX-font t ?\C-b) :keys "C-u C-c C-f C-b"]
+ ["Typewriter" (TeX-font t ?\C-t) :keys "C-u C-c C-f C-t"]
+ ["Small Caps" (TeX-font t ?\C-c) :keys "C-u C-c C-f C-c"]
+ ["Sans Serif" (TeX-font t ?\C-f) :keys "C-u C-c C-f C-f"]
+ ["Italic" (TeX-font t ?\C-i) :keys "C-u C-c C-f C-i"]
+ ["Slanted" (TeX-font t ?\C-s) :keys "C-u C-c C-f C-s"]
+ ["Roman" (TeX-font t ?\C-r) :keys "C-u C-c C-f C-r"]
+ ["Calligraphic" (TeX-font t ?\C-a) :keys "C-u C-c C-f C-a"])
+ ["Delete Font" (TeX-font t ?\C-d) :keys "C-c C-f C-d"]
+ "-"
+ ["Comment or Uncomment Region"
+ TeX-comment-or-uncomment-region
+ :help "Make the selected region outcommented or active again"]
+ ["Comment or Uncomment Paragraph"
+ TeX-comment-or-uncomment-paragraph
+ :help "Make the current paragraph outcommented or active again"]
+ ("Formatting and Marking"
+ ["Format Environment" LaTeX-fill-environment
+ :help "Fill and indent the current environment"]
+ ["Format Paragraph" LaTeX-fill-paragraph
+ :help "Fill and ident the current paragraph"]
+ ["Format Region" LaTeX-fill-region
+ :help "Fill and indent the currently selected region"]
+ ["Format Section" LaTeX-fill-section
+ :help "Fill and indent the current section"]
+ "-"
+ ["Mark Environment" LaTeX-mark-environment
+ :help "Mark the current environment"]
+ ["Mark Section" LaTeX-mark-section
+ :help "Mark the current section"]
+ "-"
+ ["Beginning of Environment" LaTeX-find-matching-begin
+ :help "Move point to the beginning of the current environment"]
+ ["End of Environment" LaTeX-find-matching-end
+ :help "Move point to the end of the current environment"])
+ ,TeX-fold-menu
+ ["Math Mode" LaTeX-math-mode
+ :style toggle :selected LaTeX-math-mode
+ :help "Toggle math mode"]
+ "-"
+ [ "Convert 209 to 2e" LaTeX-209-to-2e
+ :visible (member "latex2" (TeX-style-list)) ]
+ . ,TeX-common-menu-entries)))
+
+(defcustom LaTeX-font-list
+ '((?\C-a "" "" "\\mathcal{" "}")
+ (?\C-b "\\textbf{" "}" "\\mathbf{" "}")
+ (?\C-c "\\textsc{" "}")
+ (?\C-e "\\emph{" "}")
+ (?\C-f "\\textsf{" "}" "\\mathsf{" "}")
+ (?\C-i "\\textit{" "}" "\\mathit{" "}")
+ (?\C-m "\\textmd{" "}")
+ (?\C-n "\\textnormal{" "}" "\\mathnormal{" "}")
+ (?\C-r "\\textrm{" "}" "\\mathrm{" "}")
+ (?\C-s "\\textsl{" "}" "\\mathbb{" "}")
+ (?\C-t "\\texttt{" "}" "\\mathtt{" "}")
+ (?\C-u "\\textup{" "}")
+ (?\C-d "" "" t))
+ "Font commands used with LaTeX2e. See `TeX-font-list'."
+ :group 'LaTeX-macro
+ :type '(repeat
+ (group
+ :value (?\C-a "" "")
+ (character :tag "Key")
+ (string :tag "Prefix")
+ (string :tag "Suffix")
+ (option (group
+ :inline t
+ (string :tag "Math Prefix")
+ (string :tag "Math Suffix")))
+ (option (sexp :format "Replace\n" :value t)))))
+
+
+;;; Simple Commands
+
+(defcustom LaTeX-babel-hyphen "\"="
+ "String to be used when typing `-'.
+This usually is a hyphen alternative or hyphenation aid, like
+\"=, \"~ or \"-, provided by babel and the related language style
+files.
+
+Set it to an empty string or nil in order to disable this
+feature. Alter `LaTeX-babel-hyphen-language-alist' in case you
+want to change the behavior for a specific language only."
+ :group 'LaTeX-macro
+ :type 'string)
+
+(defcustom LaTeX-babel-hyphen-after-hyphen t
+ "Control insertion of hyphen strings.
+If non-nil insert normal hyphen on first key press and swap it
+with the language-specific hyphen string specified in the
+variable `LaTeX-babel-hyphen' on second key press. If nil do it
+the other way round."
+ :group 'LaTeX-macro
+ :type 'boolean)
+
+(defcustom LaTeX-babel-hyphen-language-alist nil
+ "Alist controlling hyphen insertion for specific languages.
+It may be used to override the defaults given by `LaTeX-babel-hyphen'
+and `LaTeX-babel-hyphen-after-hyphen' respectively. The first item
+in each element is a string specifying the language as set by the
+language-specific style file. The second item is the string to be
+used instead of `LaTeX-babel-hyphen'. The third element is the
+value overriding `LaTeX-bybel-hyphen-after-hyphen'."
+ :group 'LaTeX-macro
+ :type '(alist :key-type (string :tag "Language")
+ :value-type (group (string :tag "Hyphen string")
+ (boolean :tag "Insert plain hyphen first"
+ :value t))))
+
+(defvar LaTeX-babel-hyphen-language nil
+ "String determining language-specific behavior of hyphen insertion.
+It serves as an indicator that the babel hyphenation string
+should be used and as a means to find a potential customization
+in `LaTeX-babel-hyphen-language-alist' related to the active
+language. It is usually set by language-related style files.")
+(make-variable-buffer-local 'LaTeX-babel-hyphen-language)
+
+(defun LaTeX-babel-insert-hyphen (force)
+ "Insert a hyphen string.
+The string can be either a normal hyphen or the string specified
+in `LaTeX-babel-hyphen'. Wether one or the other is chosen
+depends on the value of `LaTeX-babel-hyphen-after-hyphen' and
+the buffer context.
+If prefix argument FORCE is non-nil, always insert a regular hyphen."
+ (interactive "*P")
+ (if (or force
+ (zerop (length LaTeX-babel-hyphen))
+ (not LaTeX-babel-hyphen-language)
+ ;; FIXME: It would be nice to check for verbatim constructs in the
+ ;; non-font-locking case, but things like `LaTeX-current-environment'
+ ;; are rather expensive in large buffers.
+ (and (fboundp 'font-latex-faces-present-p)
+ (font-latex-faces-present-p '(font-latex-verbatim-face
+ font-latex-math-face
+ font-lock-comment-face)))
+ (texmathp)
+ (TeX-in-comment))
+ (call-interactively 'self-insert-command)
+ (let* ((lang (assoc LaTeX-babel-hyphen-language
+ LaTeX-babel-hyphen-language-alist))
+ (hyphen (if lang (nth 1 lang) LaTeX-babel-hyphen))
+ (h-after-h (if lang (nth 2 lang) LaTeX-babel-hyphen-after-hyphen))
+ (hyphen-length (length hyphen)))
+ (cond
+ ;; "= --> -- / -
+ ((string= (buffer-substring (max (- (point) hyphen-length) (point-min))
+ (point))
+ hyphen)
+ (if h-after-h
+ (progn (delete-backward-char hyphen-length)
+ (insert "--"))
+ (delete-backward-char hyphen-length)
+ (call-interactively 'self-insert-command)))
+ ;; -- --> [+]-
+ ((string= (buffer-substring (max (- (point) 2) (point-min))
+ (point))
+ "--")
+ (call-interactively 'self-insert-command))
+ ;; - --> "= / [+]-
+ ((eq (char-before) ?-)
+ (if h-after-h
+ (progn (delete-backward-char 1)
+ (insert hyphen))
+ (call-interactively 'self-insert-command)))
+ (h-after-h
+ (call-interactively 'self-insert-command))
+ (t (insert hyphen))))))
+;; Cater for Delete Selection mode
+(put 'LaTeX-babel-insert-hyphen 'delete-selection t)
+
+(defcustom LaTeX-enable-toolbar t
+ "Enable LaTeX tool bar."
+ :group 'TeX-tool-bar
+ :type 'boolean)
+
+(defun LaTeX-maybe-install-toolbar ()
+ "Conditionally install tool bar buttons for LaTeX mode.
+Install tool bar if `LaTeX-enable-toolbar' is non-nil."
+ (when LaTeX-enable-toolbar
+ ;; Defined in `tex-bar.el':
+ (LaTeX-install-toolbar)))
+
+;;; Mode
+
+(defgroup LaTeX-macro nil
+ "Special support for LaTeX macros in AUCTeX."
+ :prefix "TeX-"
+ :group 'LaTeX
+ :group 'TeX-macro)
+
+(defcustom TeX-arg-cite-note-p nil
+ "*If non-nil, ask for optional note in citations."
+ :type 'boolean
+ :group 'LaTeX-macro)
+
+(defcustom TeX-arg-footnote-number-p nil
+ "*If non-nil, ask for optional number in footnotes."
+ :type 'boolean
+ :group 'LaTeX-macro)
+
+(defcustom TeX-arg-item-label-p nil
+ "*If non-nil, always ask for optional label in items.
+Otherwise, only ask in description environments."
+ :type 'boolean
+ :group 'LaTeX-macro)
+
+(defcustom TeX-arg-right-insert-p t
+ "*If non-nil, always insert automatically the corresponding \\right.
+This happens when \\left is inserted."
+ :type 'boolean
+ :group 'LaTeX-macro)
+
+(defcustom LaTeX-mode-hook nil
+ "A hook run in LaTeX mode buffers."
+ :type 'hook
+ :group 'LaTeX)
+
+(TeX-abbrev-mode-setup latex-mode)
+
+;;;###autoload
+(add-to-list 'auto-mode-alist '("\\.drv\\'" . latex-mode))
+
+;;;###autoload
+(defun TeX-latex-mode ()
+ "Major mode in AUCTeX for editing LaTeX files.
+See info under AUCTeX for full documentation.
+
+Special commands:
+\\{LaTeX-mode-map}
+
+Entering LaTeX mode calls the value of `text-mode-hook',
+then the value of `TeX-mode-hook', and then the value
+of `LaTeX-mode-hook'."
+ (interactive)
+ (LaTeX-common-initialization)
+ (setq TeX-base-mode-name "LaTeX")
+ (setq major-mode 'latex-mode)
+ (setq TeX-command-default "LaTeX")
+ (setq TeX-sentinel-default-function 'TeX-LaTeX-sentinel)
+ (add-hook 'tool-bar-mode-on-hook 'LaTeX-maybe-install-toolbar nil t)
+ (when (if (featurep 'xemacs)
+ (featurep 'toolbar)
+ (and (boundp 'tool-bar-mode) tool-bar-mode))
+ (LaTeX-maybe-install-toolbar))
+ (TeX-run-mode-hooks 'text-mode-hook 'TeX-mode-hook 'LaTeX-mode-hook)
+ (TeX-set-mode-name)
+ ;; Defeat filladapt
+ (if (and (boundp 'filladapt-mode)
+ filladapt-mode)
+ (turn-off-filladapt-mode)))
+
+(TeX-abbrev-mode-setup doctex-mode)
+
+;;;###autoload
+(add-to-list 'auto-mode-alist '("\\.dtx\\'" . doctex-mode))
+
+;;;###autoload
+(define-derived-mode docTeX-mode TeX-latex-mode "docTeX"
+ "Major mode in AUCTeX for editing .dtx files derived from `LaTeX-mode'.
+Runs `LaTeX-mode', sets a few variables and
+runs the hooks in `docTeX-mode-hook'."
+ :abbrev-table doctex-mode-abbrev-table
+ (setq major-mode 'doctex-mode)
+ (set (make-local-variable 'LaTeX-insert-into-comments) t)
+ (set (make-local-variable 'LaTeX-syntactic-comments) t)
+ (setq TeX-default-extension docTeX-default-extension)
+ ;; Make filling and indentation aware of DocStrip guards.
+ (setq paragraph-start (concat paragraph-start "\\|%<")
+ paragraph-separate (concat paragraph-separate "\\|%<")
+ TeX-comment-start-regexp "\\(?:%\\(?:<[^>]+>\\)?\\)")
+ (setq TeX-base-mode-name "docTeX")
+ (TeX-set-mode-name)
+ (funcall TeX-install-font-lock))
+
+;;This is actually a mess: to fit the scheme properly, our derived
+;;mode definition would have had to be made for TeX-doctex-mode in the
+;;first place, but then we could not have used define-derived-mode, or
+;;all mode-specific variables would have gotten non-AUCTeX names.
+;;This solution has the advantage that documentation strings are
+;;provided in the autoloads, and has the disadvantage that docTeX-mode
+;;is not aliased to doctex-mode (not even when the AUCTeX version is
+;;disabled) as would be normal for our scheme.
+
+;;;###autoload
+(defalias 'TeX-doctex-mode 'docTeX-mode)
+
+(defcustom docTeX-clean-intermediate-suffixes
+ TeX-clean-default-intermediate-suffixes
+ "List of regexps matching suffixes of files to be deleted.
+The regexps will be anchored at the end of the file name to be matched,
+i.e. you do _not_ have to cater for this yourself by adding \\\\' or $."
+ :type '(repeat regexp)
+ :group 'TeX-command)
+
+(defcustom docTeX-clean-output-suffixes TeX-clean-default-output-suffixes
+ "List of regexps matching suffixes of files to be deleted.
+The regexps will be anchored at the end of the file name to be matched,
+i.e. you do _not_ have to cater for this yourself by adding \\\\' or $."
+ :type '(repeat regexp)
+ :group 'TeX-command)
+
+(defvar LaTeX-header-end
+ (concat "^[^%\n]*" (regexp-quote TeX-esc) "begin *"
+ TeX-grop "document" TeX-grcl)
+ "Default end of header marker for LaTeX documents.")
+
+(defvar LaTeX-trailer-start
+ (concat "^[^%\n]*" (regexp-quote TeX-esc) "end *"
+ TeX-grop "document" TeX-grcl)
+ "Default start of trailer marker for LaTeX documents.")
+
+(defcustom LaTeX-clean-intermediate-suffixes
+ TeX-clean-default-intermediate-suffixes
+ "List of regexps matching suffixes of files to be deleted.
+The regexps will be anchored at the end of the file name to be matched,
+i.e. you do _not_ have to cater for this yourself by adding \\\\' or $."
+ :type '(repeat regexp)
+ :group 'TeX-command)
+
+(defcustom LaTeX-clean-output-suffixes TeX-clean-default-output-suffixes
+ "List of regexps matching suffixes of files to be deleted.
+The regexps will be anchored at the end of the file name to be matched,
+i.e. you do _not_ have to cater for this yourself by adding \\\\' or $."
+ :type '(repeat regexp)
+ :group 'TeX-command)
+
+(defun LaTeX-common-initialization ()
+ "Common initialization for LaTeX derived modes."
+ (VirTeX-common-initialization)
+ (set-syntax-table LaTeX-mode-syntax-table)
+ (make-local-variable 'indent-line-function)
+ (setq indent-line-function 'LaTeX-indent-line)
+
+ (setq local-abbrev-table latex-mode-abbrev-table)
+
+ ;; Filling
+ (make-local-variable 'paragraph-ignore-fill-prefix)
+ (setq paragraph-ignore-fill-prefix t)
+ (make-local-variable 'fill-paragraph-function)
+ (setq fill-paragraph-function 'LaTeX-fill-paragraph)
+ (make-local-variable 'adaptive-fill-mode)
+ (setq adaptive-fill-mode nil)
+
+ (or LaTeX-largest-level
+ (setq LaTeX-largest-level (LaTeX-section-level "section")))
+
+ (setq TeX-header-end LaTeX-header-end
+ TeX-trailer-start LaTeX-trailer-start)
+
+ (require 'outline)
+ (make-local-variable 'outline-level)
+ (setq outline-level 'LaTeX-outline-level)
+ (make-local-variable 'outline-regexp)
+ (setq outline-regexp (LaTeX-outline-regexp t))
+ (when (boundp 'outline-heading-alist)
+ (setq outline-heading-alist
+ (mapcar (lambda (x)
+ (cons (concat "\\" (nth 0 x)) (nth 1 x)))
+ LaTeX-section-list)))
+
+ (make-local-variable 'TeX-auto-full-regexp-list)
+ (setq TeX-auto-full-regexp-list
+ (append LaTeX-auto-regexp-list plain-TeX-auto-regexp-list))
+
+ (LaTeX-set-paragraph-start)
+ (setq paragraph-separate
+ (concat
+ "[ \t]*%*[ \t]*\\("
+ "\\$\\$" ; Plain TeX display math
+ "\\|$\\)"))
+
+ (setq TeX-verbatim-p-function 'LaTeX-verbatim-p)
+ (setq TeX-search-forward-comment-start-function
+ 'LaTeX-search-forward-comment-start)
+ (set (make-local-variable 'TeX-search-files-type-alist)
+ LaTeX-search-files-type-alist)
+
+ (make-local-variable 'LaTeX-item-list)
+ (setq LaTeX-item-list '(("description" . LaTeX-item-argument)
+ ("thebibliography" . LaTeX-item-bib)))
+
+ (setq TeX-complete-list
+ (append '(("\\\\cite\\[[^]\n\r\\%]*\\]{\\([^{}\n\r\\%,]*\\)"
+ 1 LaTeX-bibitem-list "}")
+ ("\\\\cite{\\([^{}\n\r\\%,]*\\)" 1 LaTeX-bibitem-list "}")
+ ("\\\\cite{\\([^{}\n\r\\%]*,\\)\\([^{}\n\r\\%,]*\\)"
+ 2 LaTeX-bibitem-list)
+ ("\\\\nocite{\\([^{}\n\r\\%,]*\\)" 1 LaTeX-bibitem-list "}")
+ ("\\\\nocite{\\([^{}\n\r\\%]*,\\)\\([^{}\n\r\\%,]*\\)"
+ 2 LaTeX-bibitem-list)
+ ("\\\\ref{\\([^{}\n\r\\%,]*\\)" 1 LaTeX-label-list "}")
+ ("\\\\eqref{\\([^{}\n\r\\%,]*\\)" 1 LaTeX-label-list "}")
+ ("\\\\pageref{\\([^{}\n\r\\%,]*\\)" 1 LaTeX-label-list "}")
+ ("\\\\\\(index\\|glossary\\){\\([^{}\n\r\\%]*\\)"
+ 2 LaTeX-index-entry-list "}")
+ ("\\\\begin{\\([A-Za-z]*\\)" 1 LaTeX-environment-list "}")
+ ("\\\\end{\\([A-Za-z]*\\)" 1 LaTeX-environment-list "}")
+ ("\\\\renewcommand\\*?{\\\\\\([A-Za-z]*\\)"
+ 1 LaTeX-symbol-list "}")
+ ("\\\\renewenvironment\\*?{\\([A-Za-z]*\\)"
+ 1 LaTeX-environment-list "}"))
+ TeX-complete-list))
+
+ (LaTeX-add-environments
+ '("document" LaTeX-env-document)
+ '("enumerate" LaTeX-env-item)
+ '("itemize" LaTeX-env-item)
+ '("list" LaTeX-env-list)
+ '("trivlist" LaTeX-env-item)
+ '("picture" LaTeX-env-picture)
+ '("tabular" LaTeX-env-array)
+ '("tabular*" LaTeX-env-tabular*)
+ '("array" LaTeX-env-array)
+ '("eqnarray" LaTeX-env-label)
+ '("equation" LaTeX-env-label)
+ '("minipage" LaTeX-env-minipage)
+
+ ;; The following have no special support, but are included in
+ ;; case the auto files are missing.
+
+ "sloppypar" "picture" "tabbing" "verbatim" "verbatim*"
+ "flushright" "flushleft" "displaymath" "math" "quote" "quotation"
+ "abstract" "center" "titlepage" "verse" "eqnarray*"
+
+ ;; The following are not defined in latex.el, but in a number of
+ ;; other style files. I'm to lazy to copy them to all the
+ ;; corresponding .el files right now.
+
+ ;; This means that AUCTeX will complete e.g.
+ ;; ``thebibliography'' in a letter, but I guess we can live with
+ ;; that.
+
+ '("description" LaTeX-env-item)
+ '("figure" LaTeX-env-figure)
+ '("figure*" LaTeX-env-figure)
+ '("table" LaTeX-env-figure)
+ '("table*" LaTeX-env-figure)
+ '("thebibliography" LaTeX-env-bib)
+ '("theindex" LaTeX-env-item))
+
+ (TeX-add-symbols
+ '("addtocounter" TeX-arg-counter "Value")
+ '("alph" TeX-arg-counter)
+ '("arabic" TeX-arg-counter)
+ '("fnsymbol" TeX-arg-counter)
+ '("newcounter" TeX-arg-define-counter
+ [ TeX-arg-counter "Within counter" ])
+ '("roman" TeX-arg-counter)
+ '("setcounter" TeX-arg-counter "Value")
+ '("usecounter" TeX-arg-counter)
+ '("value" TeX-arg-counter)
+ '("stepcounter" TeX-arg-counter)
+ '("refstepcounter" TeX-arg-counter)
+ '("label" TeX-arg-define-label)
+ '("pageref" TeX-arg-ref)
+ '("ref" TeX-arg-ref)
+ '("newcommand" TeX-arg-define-macro [ "Number of arguments" ] t)
+ '("renewcommand" TeX-arg-macro [ "Number of arguments" ] t)
+ '("newenvironment" TeX-arg-define-environment
+ [ "Number of arguments"] t t)
+ '("renewenvironment" TeX-arg-environment
+ [ "Number of arguments"] t t)
+ '("providecommand" TeX-arg-define-macro [ "Number of arguments" ] t)
+ '("providecommand*" TeX-arg-define-macro [ "Number of arguments" ] t)
+ '("newcommand*" TeX-arg-define-macro [ "Number of arguments" ] t)
+ '("renewcommand*" TeX-arg-macro [ "Number of arguments" ] t)
+ '("newenvironment*" TeX-arg-define-environment
+ [ "Number of arguments"] t t)
+ '("renewenvironment*" TeX-arg-environment
+ [ "Number of arguments"] t t)
+ '("newtheorem" TeX-arg-define-environment
+ [ TeX-arg-environment "Numbered like" ]
+ t [ (TeX-arg-eval progn (if (eq (save-excursion
+ (backward-char 2)
+ (preceding-char)) ?\])
+ ()
+ (TeX-arg-counter t "Within counter"))
+ "") ])
+ '("newfont" TeX-arg-define-macro t)
+ '("circle" "Diameter")
+ '("circle*" "Diameter")
+ '("dashbox" "Dash Length" TeX-arg-size
+ [ TeX-arg-corner ] t)
+ '("frame" t)
+ '("framebox" (TeX-arg-conditional
+ (string-equal (LaTeX-current-environment) "picture")
+ (TeX-arg-size [ TeX-arg-corner ] t)
+ ([ "Length" ] [ TeX-arg-lr ] t)))
+ '("line" (TeX-arg-pair "X slope" "Y slope") "Length")
+ '("linethickness" "Dimension")
+ '("makebox" (TeX-arg-conditional
+ (string-equal (LaTeX-current-environment) "picture")
+ (TeX-arg-size [ TeX-arg-corner ] t)
+ ([ "Length" ] [ TeX-arg-lr ] t)))
+ '("multiput"
+ TeX-arg-coordinate
+ (TeX-arg-pair "X delta" "Y delta")
+ "Number of copies"
+ t)
+ '("oval" TeX-arg-size [ TeX-arg-corner "Portion" ])
+ '("put" TeX-arg-coordinate t)
+ '("savebox" TeX-arg-savebox
+ (TeX-arg-conditional
+ (string-equal (LaTeX-current-environment) "picture")
+ (TeX-arg-size [ TeX-arg-corner ] t)
+ ([ "Length" ] [ TeX-arg-lr ] t)))
+ '("shortstack" [ TeX-arg-lr ] t)
+ '("vector" (TeX-arg-pair "X slope" "Y slope") "Length")
+ '("cline" "Span `i-j'")
+ '("multicolumn" "Columns" "Format" t)
+ '("item"
+ (TeX-arg-conditional (or TeX-arg-item-label-p
+ (string-equal (LaTeX-current-environment)
+ "description"))
+ ([ "Item label" ])
+ ())
+ (TeX-arg-literal " "))
+ '("bibitem" [ "Bibitem label" ] TeX-arg-define-cite)
+ '("cite"
+ (TeX-arg-conditional TeX-arg-cite-note-p ([ "Note" ]) ())
+ TeX-arg-cite)
+ '("nocite" TeX-arg-cite)
+ '("bibliographystyle" TeX-arg-bibstyle)
+ '("bibliography" TeX-arg-bibliography)
+ '("addbibresource" TeX-arg-bibliography)
+ '("footnote"
+ (TeX-arg-conditional TeX-arg-footnote-number-p ([ "Number" ]) nil)
+ t)
+ '("footnotetext"
+ (TeX-arg-conditional TeX-arg-footnote-number-p ([ "Number" ]) nil)
+ t)
+ '("footnotemark"
+ (TeX-arg-conditional TeX-arg-footnote-number-p ([ "Number" ]) nil))
+ '("newlength" TeX-arg-define-macro)
+ '("setlength" TeX-arg-macro "Length")
+ '("addtolength" TeX-arg-macro "Length")
+ '("settowidth" TeX-arg-macro t)
+ '("settoheight" TeX-arg-macro t)
+ '("settodepth" TeX-arg-macro t)
+ '("\\" [ "Space" ])
+ '("\\*" [ "Space" ])
+ '("hyphenation" t)
+ '("linebreak" [ "How much [0 - 4]" ])
+ '("nolinebreak" [ "How much [0 - 4]" ])
+ '("nopagebreak" [ "How much [0 - 4]" ])
+ '("pagebreak" [ "How much [0 - 4]" ])
+ '("stackrel" t nil)
+ '("frac" t nil)
+ '("lefteqn" t)
+ '("overbrace" t)
+ '("overline" t)
+ '("overleftarrow" t)
+ '("overrightarrow" t)
+ '("sqrt" [ "Root" ] t)
+ '("underbrace" t)
+ '("underline" t)
+ '("author" t)
+ '("date" t)
+ '("thanks" t)
+ '("title" t)
+ '("pagenumbering" (TeX-arg-eval
+ completing-read "Numbering style: "
+ '(("arabic") ("roman") ("Roman") ("alph") ("Alph"))))
+ '("pagestyle" TeX-arg-pagestyle)
+ '("markboth" t nil)
+ '("markright" t)
+ '("thispagestyle" TeX-arg-pagestyle)
+ '("addvspace" "Length")
+ '("fbox" t)
+ '("hspace*" "Length")
+ '("hspace" "Length")
+ '("mbox" t)
+ '("newsavebox" TeX-arg-define-savebox)
+ '("parbox" [ TeX-arg-tb ] [ "Height" ] [ TeX-arg-tb "Inner position" ]
+ "Width" t)
+ '("raisebox" "Raise" [ "Height above" ] [ "Depth below" ] t)
+ '("rule" [ "Raise" ] "Width" "Thickness")
+ '("sbox" TeX-arg-savebox t)
+ '("usebox" TeX-arg-savebox)
+ '("vspace*" "Length")
+ '("vspace" "Length")
+ '("documentstyle" TeX-arg-document)
+ '("include" (TeX-arg-input-file "File" t))
+ '("includeonly" t)
+ '("input" TeX-arg-input-file)
+ '("addcontentsline"
+ (TeX-arg-eval completing-read "File: " '(("toc") ("lof") ("lot")))
+ (TeX-arg-eval completing-read "Numbering style: " LaTeX-section-list) t)
+ '("addtocontents"
+ (TeX-arg-eval completing-read "File: " '(("toc") ("lof") ("lot"))) t)
+ '("typeout" t)
+ '("typein" [ TeX-arg-define-macro ] t)
+ '("verb" TeX-arg-verb)
+ '("verb*" TeX-arg-verb)
+ '("extracolsep" t)
+ '("index" TeX-arg-index)
+ '("glossary" TeX-arg-index)
+ '("numberline" "Section number" "Heading")
+ '("caption" t)
+ '("marginpar" [ "Left margin text" ] "Text")
+ '("left" TeX-arg-insert-braces)
+
+ ;; These have no special support, but are included in case the
+ ;; auto files are missing.
+
+ "TeX" "LaTeX"
+ "samepage" "newline"
+ "smallskip" "medskip" "bigskip" "fill" "stretch"
+ "thinspace" "negthinspace" "enspace" "enskip" "quad" "qquad"
+ "nonumber" "centering" "raggedright"
+ "raggedleft" "kill" "pushtabs" "poptabs" "protect" "arraystretch"
+ "hline" "vline" "cline" "thinlines" "thicklines" "and" "makeindex"
+ "makeglossary" "reversemarginpar" "normalmarginpar"
+ "raggedbottom" "flushbottom" "sloppy" "fussy" "newpage"
+ "clearpage" "cleardoublepage" "twocolumn" "onecolumn"
+
+ "maketitle" "tableofcontents" "listoffigures" "listoftables"
+ '("tiny" -1) '("scriptsize" -1) '("footnotesize" -1) '("small" -1)
+ '("normalsize" -1) '("large" -1) '("Large" -1) '("LARGE" -1) '("huge" -1)
+ '("Huge" -1)
+ "pounds" "copyright"
+ "hfil" "hfill" "vfil" "vfill" "hrulefill" "dotfill"
+ "indent" "noindent" "today"
+ "appendix"
+ "dots")
+
+ (when (string-equal LaTeX-version "2e")
+ (LaTeX-add-environments
+ '("filecontents" LaTeX-env-contents)
+ '("filecontents*" LaTeX-env-contents))
+
+ (TeX-add-symbols
+ '("enlargethispage" "Length")
+ '("enlargethispage*" "Length")
+ '("tabularnewline" [ "Length" ])
+ '("suppressfloats" [ TeX-arg-tb "Suppress floats position" ])
+ '("ensuremath" "Math commands")
+ '("textsuperscript" "Text")
+ '("textcircled" "Text")
+
+ "LaTeXe"
+ "listfiles" "frontmatter" "mainmatter" "backmatter"
+ "textcompwordmark" "textvisiblespace" "textemdash" "textendash"
+ "textexclamdown" "textquestiondown" "textquotedblleft"
+ "textquotedblright" "textquoteleft" "textquoteright"
+ "textbullet" "textperiodcentered"
+ "textbackslash" "textbar" "textless" "textgreater"
+ "textasciicircum" "textasciitilde"
+ "textregistered" "texttrademark"
+ "rmfamily" "sffamily" "ttfamily" "mdseries" "bfseries"
+ "itshape" "slshape" "upshape" "scshape"))
+
+ (TeX-run-style-hooks "LATEX")
+
+ (make-local-variable 'TeX-font-list)
+ (make-local-variable 'TeX-font-replace-function)
+ (if (string-equal LaTeX-version "2")
+ ()
+ (setq TeX-font-list LaTeX-font-list)
+ (setq TeX-font-replace-function 'TeX-font-replace-macro)
+ (TeX-add-symbols
+ '("newcommand" TeX-arg-define-macro
+ [ "Number of arguments" ] [ "Default value for first argument" ] t)
+ '("renewcommand" TeX-arg-macro
+ [ "Number of arguments" ] [ "Default value for first argument" ] t)
+ '("providecommand" TeX-arg-define-macro
+ [ "Number of arguments" ] [ "Default value for first argument" ] t)
+ '("providecommand*" TeX-arg-define-macro
+ [ "Number of arguments" ] [ "Default value for first argument" ] t)
+ '("newcommand*" TeX-arg-define-macro
+ [ "Number of arguments" ] [ "Default value for first argument" ] t)
+ '("renewcommand*" TeX-arg-macro
+ [ "Number of arguments" ] [ "Default value for first argument" ] t)
+ '("usepackage" LaTeX-arg-usepackage)
+ '("RequirePackage" LaTeX-arg-usepackage)
+ '("ProvidesPackage" "Name" [ "Version" ])
+ '("documentclass" TeX-arg-document)))
+
+ (TeX-add-style-hook "latex2e"
+ ;; Use new fonts for `\documentclass' documents.
+ (lambda ()
+ (setq TeX-font-list LaTeX-font-list)
+ (setq TeX-font-replace-function 'TeX-font-replace-macro)
+ (run-hooks 'LaTeX2e-hook)))
+
+ (TeX-add-style-hook "latex2"
+ ;; Use old fonts for `\documentstyle' documents.
+ (lambda ()
+ (setq TeX-font-list (default-value 'TeX-font-list))
+ (setq TeX-font-replace-function
+ (default-value 'TeX-font-replace-function))
+ (run-hooks 'LaTeX2-hook)))
+
+ ;; There must be something better-suited, but I don't understand the
+ ;; parsing properly. -- dak
+ (TeX-add-style-hook "pdftex" 'TeX-PDF-mode-on)
+ (TeX-add-style-hook "pdftricks" 'TeX-PDF-mode-on)
+ (TeX-add-style-hook "pst-pdf" 'TeX-PDF-mode-on)
+ (TeX-add-style-hook "dvips" 'TeX-PDF-mode-off)
+;; This is now done in style/pstricks.el because it prevents other
+;; pstricks style files from being loaded.
+;; (TeX-add-style-hook "pstricks" 'TeX-PDF-mode-off)
+ (TeX-add-style-hook "psfrag" 'TeX-PDF-mode-off)
+ (TeX-add-style-hook "dvipdf" 'TeX-PDF-mode-off)
+ (TeX-add-style-hook "dvipdfm" 'TeX-PDF-mode-off)
+;; (TeX-add-style-hook "DVIoutput" 'TeX-PDF-mode-off)
+;;
+;; Well, DVIoutput indicates that we want to run PDFTeX and expect to
+;; get DVI output. Ugh.
+ (TeX-add-style-hook "ifpdf" (lambda ()
+ (TeX-PDF-mode-on)
+ (TeX-PDF-mode-off)))
+;; ifpdf indicates that we cater for either. So calling both
+;; functions will make sure that the default will get used unless the
+;; user overrode it.
+
+ (set (make-local-variable 'imenu-create-index-function)
+ 'LaTeX-imenu-create-index-function)
+
+ (use-local-map LaTeX-mode-map)
+
+ ;; Calling `easy-menu-add' may result in the menu filters being
+ ;; executed which call `TeX-update-style'. So this is placed very
+ ;; late in mode initialization to assure that all relevant variables
+ ;; are properly initialized before style files try to alter them.
+ (easy-menu-add LaTeX-mode-menu LaTeX-mode-map)
+ (easy-menu-add LaTeX-mode-command-menu LaTeX-mode-map))
+
+(defun LaTeX-imenu-create-index-function ()
+ "Imenu support function for LaTeX."
+ (TeX-update-style)
+ (let (entries level
+ (regexp (LaTeX-outline-regexp)))
+ (goto-char (point-max))
+ (while (re-search-backward regexp nil t)
+ (let* ((name (LaTeX-outline-name))
+ (level (make-string (1- (LaTeX-outline-level)) ?\ ))
+ (label (concat level level name))
+ (mark (make-marker)))
+ (set-marker mark (point))
+ (set-text-properties 0 (length label) nil label)
+ (setq entries (cons (cons label mark) entries))))
+ entries))
+
+(defvar LaTeX-builtin-opts
+ '("12pt" "11pt" "10pt" "twocolumn" "twoside" "draft")
+ "Built in options for LaTeX standard styles.")
+
+(defun LaTeX-209-to-2e ()
+ "Make a stab at changing 2.09 doc header to 2e style."
+ (interactive)
+ (TeX-home-buffer)
+ (let (optstr optlist 2eoptlist 2epackages docline docstyle)
+ (goto-char (point-min))
+ (if
+ (search-forward-regexp
+ "\\documentstyle\\[\\([^]]*\\)\\]{\\([^}]*\\)}"
+ (point-max) t)
+ (setq optstr (TeX-match-buffer 1)
+ docstyle (TeX-match-buffer 2)
+ optlist (TeX-split-string "," optstr))
+ (if (search-forward-regexp
+ "\\documentstyle{\\([^}]*\\)}"
+ (point-max) t)
+ (setq docstyle (TeX-match-buffer 1))
+ (error "No documentstyle defined")))
+ (beginning-of-line 1)
+ (setq docline (point))
+ (insert "%%%")
+ (while optlist
+ (if (member (car optlist) LaTeX-builtin-opts)
+ (setq 2eoptlist (cons (car optlist) 2eoptlist))
+ (setq 2epackages (cons (car optlist) 2epackages)))
+ (setq optlist (cdr optlist)))
+ ;;(message (format "%S %S" 2eoptlist 2epackages))
+ (goto-char docline)
+ (forward-line 1)
+ (insert "\\documentclass")
+ (if 2eoptlist
+ (insert "["
+ (mapconcat (lambda (x) x)
+ (nreverse 2eoptlist) ",") "]"))
+ (insert "{" docstyle "}\n")
+ (if 2epackages
+ (insert "\\usepackage{"
+ (mapconcat (lambda (x) x)
+ (nreverse 2epackages) "}\n\\usepackage{") "}\n"))
+ (if (equal docstyle "slides")
+ (progn
+ (goto-char (point-min))
+ (while (re-search-forward "\\\\blackandwhite{" nil t)
+ (replace-match "\\\\input{" nil nil)))))
+ (TeX-normal-mode nil))
+
+(provide 'latex)
+
+;;; latex.el ends here
diff --git a/tests/auctex-11.87.7/latex/.cvsignore
b/tests/auctex-11.87.7/latex/.cvsignore
new file mode 100644
index 0000000..775b4c0
--- /dev/null
+++ b/tests/auctex-11.87.7/latex/.cvsignore
@@ -0,0 +1,16 @@
+
+*.aux
+*.cfg
+*.def
+*.drv
+*.dvi
+*.glo
+*.idx
+*.log
+*.prv
+Makefile
+auto
+preview-mk.ins
+preview.ins
+preview.pdf
+preview.sty
diff --git a/tests/auctex-11.87.7/latex/README
b/tests/auctex-11.87.7/latex/README
new file mode 100644
index 0000000..0d0e8a8
--- /dev/null
+++ b/tests/auctex-11.87.7/latex/README
@@ -0,0 +1,64 @@
+The preview.sty style file
+==========================
+
+Purpose
+-------
+
+The main purpose of the preview package is the extraction of selected
+elements from a LaTeX source, like formulas or graphics, into separate
+pages of a DVI file. A flexible and convenient interface allows it to
+specify what commands and constructs should be extracted. This works
+with DVI files postprocessed by either Dvips and Ghostscript or
+dvipng, but it also works when you are using PDFTeX for generating PDF
+files.
+
+Current uses of the package include the preview-latex package for
+WYSIWYG functionality in the AUCTeX editing environment, generation of
+previews in LyX, as part of the operation of the ps4pdf and pst-pdf
+packages, the tbook XML system and some other tools.
+
+Availability
+------------
+
+The preview package is being developed along and distributed with
+AUCTeX. It can therefore be obtained as part of AUCTeX distribution
+files available at <URL:ftp://ftp.gnu.org/pub/gnu/auctex/> or its
+mirror at <CTAN:support/auctex>. CTAN also provides a standalone
+version at <CTAN:macros/latex/contrib/preview>. The project page at
+<URL:http://savannah.gnu.org/projects/auctex/> offers downloads and
+anonymous CVS access for cutting edge versions. For more information
+about the preview package please refer to the home page of AUCTeX at
+<URL:http://www.gnu.org/software/auctex/>.
+
+Installation
+------------
+
+To install the preview style file on its own without the entire AUCTeX
+package, run
+tex preview.ins
+If preview.ins happens to be missing, you can regenerate it by running
+tex docstrip
+on preview.dtx with the option `installer'.
+
+Running TeX on preview.ins will then extract further files:
+preview.drv which you can run through LaTeX in order to get the
+documentation for preview.sty, preview.sty itself, a bunch of option
+files with extension .def and a few configuration files with extension
+.cfg. In case your docstrip configuration has not already taken care
+of that, install the files with extension .sty, .def and .cfg to a
+location where LaTeX will be able to find them, generate the
+documentation and have fun.
+
+The license of the original file is the GPL which you'll find a copy
+of in the complete AUCTeX distribution. The distribution will also
+unpack and install the respective LaTeX files with an
+autoconf-supported mechanism, so you might consider using that.
+
+Bug reporting
+-------------
+
+Please report problems to <URL:mailto:bug-auctex@gnu.org>, including a
+small example file which uses the \listfiles statement, and the
+resulting log file.
+
+David Kastrup
diff --git a/tests/auctex-11.87.7/latex/bootstrap.ins
b/tests/auctex-11.87.7/latex/bootstrap.ins
new file mode 100644
index 0000000..a27ddb2
--- /dev/null
+++ b/tests/auctex-11.87.7/latex/bootstrap.ins
@@ -0,0 +1,4 @@
+\input docstrip
+\askforoverwritefalse
+\generate{\file{preview-mk.ins}{\from{preview.dtx}{installer,make}}}
+\endbatchfile
diff --git a/tests/auctex-11.87.7/latex/prauctex.cfg
b/tests/auctex-11.87.7/latex/prauctex.cfg
new file mode 100644
index 0000000..495ae40
--- /dev/null
+++ b/tests/auctex-11.87.7/latex/prauctex.cfg
@@ -0,0 +1,48 @@
+%%
+%% This is file `prauctex.cfg',
+%% generated with the docstrip utility.
+%%
+%% The original source files were:
+%%
+%% preview.dtx (with options: `auccfg')
+%%
+%% IMPORTANT NOTICE:
+%%
+%% For the copyright see the source file.
+%%
+%% Any modified versions of this file must be renamed
+%% with new filenames distinct from prauctex.cfg.
+%%
+%% For distribution of the original source see the terms
+%% for copying and modification in the file preview.dtx.
+%%
+%% This generated file may be distributed as long as the
+%% original source files, as listed above, are part of the
+%% same distribution. (The sources need not necessarily be
+%% in the same archive or directory.)
+%% The preview style for extracting previews from LaTeX documents.
+%% Developed as part of AUCTeX <URL:http://www.gnu.org/software/auctex>.
+\PreviewMacro*[[][#1{}]\footnote
+\PreviewMacro*[?[{@{[]}}{}][#1]\item
+\PreviewMacro*\emph
+\PreviewMacro*\textrm
+\PreviewMacro*\textit
+\PreviewMacro*\textsc
+\PreviewMacro*\textsf
+\PreviewMacro*\textsl
+\PreviewMacro*\texttt
+\PreviewMacro*\textcolor
+\PreviewMacro*\mbox
+\PreviewMacro*[][#1{}]\author
+\PreviewMacro*[][#1{}]\title
+\PreviewMacro*\and
+\PreviewMacro*\thanks
+\PreviewMacro*[][#1{}]\caption
+\preview@delay{\@ifundefined{pr@\string\@startsection}{%
+ \PreviewMacro*[!!!!!!*][#1{}]\@startsection}{}}
+\preview@delay{\@ifundefined{pr@\string\chapter}{%
+ \PreviewMacro*[*][#1{}]\chapter}{}}
+\PreviewMacro*\index
+\endinput
+%%
+%% End of file `prauctex.cfg'.
diff --git a/tests/auctex-11.87.7/latex/prauctex.def
b/tests/auctex-11.87.7/latex/prauctex.def
new file mode 100644
index 0000000..4f8f7fa
--- /dev/null
+++ b/tests/auctex-11.87.7/latex/prauctex.def
@@ -0,0 +1,61 @@
+%%
+%% This is file `prauctex.def',
+%% generated with the docstrip utility.
+%%
+%% The original source files were:
+%%
+%% preview.dtx (with options: `auctex')
+%%
+%% IMPORTANT NOTICE:
+%%
+%% For the copyright see the source file.
+%%
+%% Any modified versions of this file must be renamed
+%% with new filenames distinct from prauctex.def.
+%%
+%% For distribution of the original source see the terms
+%% for copying and modification in the file preview.dtx.
+%%
+%% This generated file may be distributed as long as the
+%% original source files, as listed above, are part of the
+%% same distribution. (The sources need not necessarily be
+%% in the same archive or directory.)
+%% The preview style for extracting previews from LaTeX documents.
+%% Developed as part of AUCTeX <URL:http://www.gnu.org/software/auctex>.
+\ifPreview\else\expandafter\endinput\fi
+\nofiles
+\preview@delay{\nonstopmode}
+\begingroup
+\lccode`\~=`\-
+\lccode`\{=`\<
+\lccode`\}=`\>
+\lowercase{\endgroup
+ \def\pr@msgi{{~}}}
+\def\pr@msgii{Preview:
+ Snippet \number\pr@snippet\space}
+\begingroup
+\catcode`\-=13
+\catcode`\<=13
+\@firstofone{\endgroup
+\def\pr@msg#1{{%
+ \let<\pr@msgi
+ \def-{\pr@msgii#1}%
+ \errhelp{Not a real error.}%
+ \errmessage<}}}
+\g@addto@macro\pr@ship@start{\pr@msg{started}}
+\g@addto@macro\pr@ship@end{\pr@msg{ended.%
+ (\number\ht\pr@box+\number\dp\pr@box x\number\wd\pr@box)}}
+\hbadness=\maxdimen
+\newcount\hbadness
+\vbadness=\maxdimen
+\let\vbadness=\hbadness
+\hfuzz=\maxdimen
+\newdimen\hfuzz
+\vfuzz=\maxdimen
+\let\vfuzz=\hfuzz
+\showboxdepth=-1
+\showboxbreadth=-1
+\pr@loadcfg{prauctex}
+\endinput
+%%
+%% End of file `prauctex.def'.
diff --git a/tests/auctex-11.87.7/latex/prcounters.def
b/tests/auctex-11.87.7/latex/prcounters.def
new file mode 100644
index 0000000..f7b5726
--- /dev/null
+++ b/tests/auctex-11.87.7/latex/prcounters.def
@@ -0,0 +1,38 @@
+%%
+%% This is file `prcounters.def',
+%% generated with the docstrip utility.
+%%
+%% The original source files were:
+%%
+%% preview.dtx (with options: `counters')
+%%
+%% IMPORTANT NOTICE:
+%%
+%% For the copyright see the source file.
+%%
+%% Any modified versions of this file must be renamed
+%% with new filenames distinct from prcounters.def.
+%%
+%% For distribution of the original source see the terms
+%% for copying and modification in the file preview.dtx.
+%%
+%% This generated file may be distributed as long as the
+%% original source files, as listed above, are part of the
+%% same distribution. (The sources need not necessarily be
+%% in the same archive or directory.)
+%% The preview style for extracting previews from LaTeX documents.
+%% Developed as part of AUCTeX <URL:http://www.gnu.org/software/auctex>.
+\ifPreview\else\expandafter\endinput\fi
+\def\pr@eltprint#1{\expandafter\@gobble\ifnum\value{#1}=0%
+ \csname pr@c@#1\endcsname\else\relax
+ \space{#1}{\arabic{#1}}\fi}
+\def\pr@eltdef#1{\expandafter\xdef
+ \csname pr@c@#1\endcsname{\arabic{#1}}}
+\def\pr@ckpt#1{{\let\@elt\pr@eltprint\edef\next{\cl@@ckpt}%
+ \ifx\next\@empty\else\typeout{Preview: Counters\next#1}%
+ \let\@elt\pr@eltdef\cl@@ckpt\fi}}
+\pr@addto@front\pr@ship@start{\pr@ckpt:}
+\pr@addto@front\pr@ship@end{\pr@ckpt.}
+\endinput
+%%
+%% End of file `prcounters.def'.
diff --git a/tests/auctex-11.87.7/latex/preview.dtx
b/tests/auctex-11.87.7/latex/preview.dtx
new file mode 100644
index 0000000..97b7a52
--- /dev/null
+++ b/tests/auctex-11.87.7/latex/preview.dtx
@@ -0,0 +1,1872 @@
+% \iffalse
+%% The preview style for extracting previews from LaTeX documents.
+%% Developed as part of AUCTeX <URL:http://www.gnu.org/software/auctex>.
+%
+% Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006,
+% 2010 Free Software Foundation
+%
+% 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, write to the
+% Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
+% Boston, MA 02110-1301 USA
+% \fi
+% \CheckSum{1758}
+% \GetFileInfo{preview.sty}
+% \date{\filedate}
+% \author{David Kastrup\thanks{\texttt{dak@gnu.org}}}
+% \title{The \texttt{preview} Package for \LaTeX\\Version \fileversion}
+% \maketitle
+% \section{Introduction}
+% The main purpose of this package is the extraction of certain
+% environments (most notably displayed formulas) from \LaTeX\ sources
+% as graphics. This works with DVI files postprocessed by either
+% Dvips and Ghostscript or dvipng, but it also works when you are
+% using PDF\TeX\ for generating PDF files (usually also postprocessed
+% by Ghostscript).
+%
+% Current uses of the package include the \previewlatex\ package for
+% WYSIWYG functionality in the AUC\TeX\ editing environment,
+% generation of previews in LyX, as part of the operation of the
+% ps4pdf package, the tbook XML system and some other tools.
+%
+% Producing EPS files with Dvips and its derivatives using the
+% \texttt{-E} option is not a good alternative: People make do by
+% fiddling around with |\thispagestyle{empty}| and hoping for the best
+% (namely, that the specified contents will indeed fit on single
+% pages), and then trying to guess the baseline of the resulting code
+% and stuff, but this is at best dissatisfactory. The preview package
+% provides an easy way to ensure that exactly one page per request
+% gets shipped, with a well-defined baseline and no page decorations.
+% While you still can use the preview package with the `classic'
+% \begin{quote}
+% |dvips -E -i|
+% \end{quote}
+% invocation, there are better ways available that don't rely on Dvips
+% not getting confused by PostScript specials.
+%
+% For most applications, you'll want to make use of the |tightpage|
+% option. This will embed the page dimensions into the PostScript or
+% PDF code, obliterating the need to use the |-E -i| options to Dvips.
+% You can then produce all image files with a single run of
+% Ghostscript from a single PDF or PostScript (as opposed to EPS)
+% file.
+%
+% Various options exist that will pass \TeX\ dimensions and other
+% information about the respective shipped out material (including
+% descender size) into the log file, where external applications might
+% make use of it.
+%
+% The possibility for generating a whole set of graphics with a single
+% run of Ghostscript (whether from \LaTeX\ or PDF\LaTeX) increases
+% both speed and robustness of applications. It is also feasible to
+% use dvipng on a DVI file with the options
+% \begin{quote}
+% |-picky -noghostscript|
+% \end{quote}
+% to omit generating any image file that requires Ghostscript, then
+% let a script generate all missing files using Dvips/Ghostscript.
+% This will usually speed up the process significantly.
+%
+% \section{Package options}
+% The package is included with the customary
+% \begin{quote}
+% |\usepackage|\oarg{options}|{preview}|
+% \end{quote}
+% You should usually load this package as the last one, since it
+% redefines several things that other packages may also provide.
+%
+% The following options are available:
+% \begin{description}
+% \item[|active|] is the most essential option. If this option is not
+% specified, the |preview| package will be inactive and the document
+% will be typeset as if the |preview| package were not loaded,
+% except that all declarations and environments defined by the
+% package are still legal but have no effect. This allows defining
+% previewing characteristics in your document, and only activating
+% them by calling \LaTeX\ as
+% \begin{quote}
+% \raggedright
+% |latex '\PassOptionsToPackage{active}{preview}| |\input|\marg{filename}|'|
+% \end{quote}
+% \item[|noconfig|] Usually the file |prdefault.cfg| gets loaded
+% whenever the |preview| package gets activated. |prdefault.cfg| is
+% supposed to contain definitions that can cater for otherwise bad
+% results, for example, if a certain document class would otherwise
+% lead to trouble. It also can be used to override any settings
+% made in this package, since it is loaded at the very end of it.
+% In addition, there may be configuration files specific for certain
+% |preview| options like |auctex| which have more immediate needs.
+% The |noconfig| option suppresses loading of those option files,
+% too.
+% \item[|psfixbb|] Dvips determines the bounding boxes from the
+% material in the DVI file it understands. Lots of PostScript
+% specials are not part of that. Since the \TeX\ boxes do not make
+% it into the DVI file, but merely characters, rules and specials
+% do, Dvips might include far too small areas. The option |psfixbb|
+% will include |/dev/null| as a graphic file in the ultimate upper
+% left and lower right corner of the previewed box. This will make
+% Dvips generate an appropriate bounding box.
+% \item[|dvips|] If this option is specified as a class option or to
+% other packages, several packages pass things like page size
+% information to Dvips, or cause crop marks or draft messages
+% written on pages. This seriously hampers the usability of
+% previews. If this option is specified, the changes will be undone
+% if possible.
+% \item[|pdftex|] If this option is set, PDF\TeX\ is assumed as the
+% output driver. This mainly affects the |tightpage| option.
+% \item[|xetex|] If this option is set, Xe\TeX\ is assumed as the
+% output driver. This mainly affects the |tightpage| option.
+% \item[|displaymath|] will make all displayed math environments
+% subject to preview processing. This will typically be the most
+% desired option.
+% \item[|floats|] will make all float objects subject to preview
+% processing. If you want to be more selective about what floats to
+% pass through to a preview, you should instead use the
+% \cmd{\PreviewSnarfEnvironment} command on the floats you want to
+% have previewed.
+% \item[|textmath|] will make all text math subject to previews.
+% Since math mode is used throughly inside of \LaTeX\ even for other
+% purposes, this works by redefining \cmd\(, \cmd\)
+% and |$| and the |math| environment (apparently some people use
+% that). Only occurences of these text math delimiters in later
+% loaded packages and in the main document will thus be affected.
+% \item[|graphics|] will subject all \cmd{\includegraphics} commands
+% to a preview.
+% \item[|sections|] will subject all section headers to a preview.
+% \item[|delayed|] will delay all activations and redefinitions the
+% |preview| package makes until |\||begin{document}|. The purpose
+% of this is to cater for documents which should be subjected to the
+% |preview| package without having been prepared for it. You can
+% process such documents with
+% \begin{quote}
+% |latex '\RequirePackage[active,delayed,|\meta{options}|]{preview}|
+% |\input|\marg{filename}|'|
+% \end{quote}
+% This relaxes the requirement to be loading the |preview| package
+% as last package.
+% \item[\meta{driver}] loads a special driver file
+% |pr|\meta{driver}|.def|. The remaining options are implemented
+% through the use of driver files.
+% \item[|auctex|] This driver will produce fake error messages at the
+% start and end of every preview environment that enable the Emacs
+% package \previewlatex\ in connection with AUC\TeX\ to pinpoint
+% the exact source location where the previews have originated.
+% Unfortunately, there is no other reliable means of passing the
+% current \TeX\ input position \emph{in} a line to external
+% programs. In order to make the parsing more robust, this option
+% also switches off quite a few diagnostics that could be
+% misinterpreted.
+%
+% You should not specify this option manually, since it will only be
+% needed by automated runs that want to parse the pseudo error
+% messages. Those runs will then use \cmd{\PassOptionsToPackage} in
+% order to effect the desired behaviour. In addition,
+% |prauctex.cfg| will get loaded unless inhibited by the |noconfig|
+% option. This caters for the most frequently encountered
+% problematic commands.
+% \item[|showlabels|] During the editing process, some people like to
+% see the label names in their equations, figures and the like. Now
+% if you are using Emacs for editing, and in particular
+% \previewlatex, I'd strongly recommend that you check out the
+% Ref\TeX\ package which pretty much obliterates the need for this
+% kind of functionality. If you still want it, standard \LaTeX\
+% provides it with the |showkeys| package, and there is also the
+% less encompassing |showlabels| package. Unfortunately, since
+% those go to some pain not to change the page layout and spacing,
+% they also don't change |preview|'s idea of the \TeX\ dimensions of
+% the involved boxes. So if you are using |preview| for determing
+% bounding boxes, those packages are mostly useless. The option
+% |showlabels| offers a substitute for them.
+% \item[|tightpage|] It is not uncommon to want to use the results of
+% |preview| as graphic images for some other application. One
+% possibility is to generate a flurry of EPS files with
+% \begin{quote}
+% |dvips -E -i -Pwww -o| \meta{outputfile}|.000| \meta{inputfile}
+% \end{quote}
+% However, in case those are to be processed further into graphic
+% image files by Ghostscript, this process is inefficient since all
+% of those files need to be processed one by one. In addition, it
+% is necessary to extract the bounding box comments from the EPS
+% files and convert them into page dimension parameters for
+% Ghostscript in order to avoid full-page graphics. This is not
+% even possible if you wanted to use Ghostscript in a~\emph{single}
+% run for generating the files from a single PostScript file, since
+% Dvips will in that case leave no bounding box information
+% anywhere.
+%
+% The solution is to use the |tightpage| option. That way a single
+% command line like
+% \begin{quote}
+% \raggedright
+% \texttt{gs -sDEVICE=png16m -dTextAlphaBits=4 -r300
+% -dGraphicsAlphaBits=4 -dSAFER -q -dNOPAUSE
+% -sOutputFile=\meta{outputfile}\%d.png \meta{inputfile}.ps}
+% \end{quote}
+% will be able to produce tight graphics from a single PostScript
+% file generated with Dvips \emph{without} use of the options
+% |-E -i|, in a single run.
+%
+% The |tightpage| option actually also works when using the |pdftex|
+% option and generating PDF files with PDF\TeX. The resulting PDF
+% file has separate page dimensions for every page and can directly
+% be converted with one run of Ghostscript into image files.
+%
+% If neither |dvips| or |pdftex| have been specified, the
+% corresponding option will get autodetected and invoked.
+%
+% If you need this in a batch environment where you don't want to
+% use |preview|'s automatic extraction facilities, no problem: just
+% don't use any of the extraction options, and wrap everything to be
+% previewed into |preview| environments. This is how LyX does its
+% math previews.
+%
+% If the pages under the |tightpage| option are just too tight, you
+% can adjust by setting the length |\PreviewBorder| to a different
+% value by using \cmd{\setlength}. The default value is
+% |0.50001bp|, which is half of a usual PostScript point, rounded
+% up. If you go below this value, the resulting page size may drop
+% below |1bp|, and Ghostscript does not seem to like that. If you
+% need finer control, you can adjust the bounding box dimensions
+% individually by changing the macro |\PreviewBbAdjust| with the
+% help of |\renewcommand|. Its default value is
+% \begin{quote}
+% \raggedright
+% |\newcommand| |\PreviewBbAdjust|
+% |{-\PreviewBorder| |-\PreviewBorder|
+% |\PreviewBorder| |\PreviewBorder}|
+% \end{quote}
+% This adjusts the left, lower, right and upper borders by the given
+% amount. The macro must contain 4~\TeX\ dimensions after another,
+% and you may not omit the units if you specify them explicitly
+% instead of by register. PostScript points have the unit~|bp|.
+% \item[|lyx|] This option is for the sake of LyX developers. It will
+% output a few diagnostics relevant for the sake of LyX' preview
+% functionality (at the time of writing, mostly implemented for math
+% insets, in versions of LyX starting with 1.3.0).
+% \item[|counters|] This writes out diagnostics at the start and the
+% end of previews. Only the counters changed since the last output
+% get written, and if no counters changed, nothing gets written at
+% all. The list consists of counter name and value, both enclosed
+% in |{}| braces, followed by a space. The last such pair is
+% followed by a colon (|:|) if it is at the start of the preview
+% snippet, and by a period (|.|) if it is at the end. The order of
+% different diagnostics like this being issued depends on the order
+% of the specification of the options when calling the package.
+%
+% Systems like \previewlatex\ use this for keeping counters accurate
+% when single previews are regenerated.
+% \item[|footnotes|] This makes footnotes render as previews, and only
+% as their footnote symbol. A convenient editing feature inside of
+% Emacs.
+% \end{description}
+% The following options are just for debugging purposes of the package
+% and similar to the corresponding \TeX\ commands they allude to:
+% \begin{description}
+% \item[|tracingall|] causes lots of diagnostic output to appear in
+% the log file during the preview collecting phases of \TeX's
+% operation. In contrast to the similarly named \TeX\ command, it
+% will not switch to |\errorstopmode|, nor will it change the
+% setting of |\tracingonline|.
+% \item[|showbox|] This option will show the contents of the boxes
+% shipped out to the DVI files. It also sets |\showboxbreadth| and
+% |\showboxdepth| to their maximum values at the end of loading this
+% package, but you may reset them if you don't like that.
+% \end{description}
+% \section{Provided Commands}
+% \DescribeEnv{preview} The |preview| environment causes its contents
+% to be set as a single preview image. Insertions like figures and
+% footnotes (except those included in minipages) will typically lead
+% to error messages or be lost. In case the |preview| package has not
+% been activated, the contents of this environment will be typeset
+% normally.
+%
+% \DescribeEnv{nopreview} The |nopreview| environment will cause its
+% contents not to undergo any special treatment by the |preview|
+% package. When |preview| is active, the contents will be discarded
+% like all main text that does not trigger the |preview| hooks. When
+% |preview| is not active, the contents will be typeset just like the
+% main text.
+%
+% Note that both of these environments typeset things as usual when
+% preview is not active. If you need something typeset conditionally,
+% use the \cmd{\ifPreview} conditional for it.
+%
+% \DescribeMacro{\PreviewMacro} If you want to make a macro like
+% \cmd{\includegraphics} (actually, this is what is done by the
+% |graphics| option to |preview|) produce a preview image, you put a
+% declaration like
+% \begin{quote}
+% |\PreviewMacro[*[[!]{\includegraphics}|
+% \end{quote}
+% or, more readable,
+% \begin{quote}
+% |\PreviewMacro[{*[][]{}}]{\includegraphics}|
+% \end{quote}
+% into your preamble. The optional argument to \cmd{\PreviewMacro}
+% specifies the arguments \cmd{\includegraphics} accepts, since this
+% is necessary information for properly ending the preview box. Note
+% that if you are using the more readable form, you have to enclose
+% the argument in a |[{| and |}]| pair. The inner braces are
+% necessary to stop any included |[]| pairs from prematurely ending
+% the optional argument, and to make a single |{}|
+% denoting an optional argument not get stripped away by \TeX's
+% argument parsing.
+%
+% The letters simply mean
+% \begin{description}
+% \item[|*|] indicates an optional |*| modifier, as in
+% |\includegraphics*|.
+% \item[|[|]^^A]
+% indicates an optional argument in brackets. This syntax
+% is somewhat baroque, but brief.
+% \item[{|[]|}] also indicates an optional argument in brackets. Be
+% sure to have encluded the entire optional argument specification
+% in an additional pair of braces as described above.
+% \item[|!|] indicates a mandatory argument.
+% \item[|\char`{\char`}|] indicates the same. Again, be sure to have
+% that additional level of braces around the whole argument
+% specification.
+% \item[|?|\meta{delimiter}\marg{true case}\marg{false case}] is a
+% conditional. The next character is checked against being equal to
+% \meta{delimiter}. If it is, the specification \meta{true case} is
+% used for the further parsing, otherwise \meta{false case} will be
+% employed. In neither case is something consumed from the input,
+% so \marg{true case} will still have to deal with the upcoming
+% delimiter.
+% \item[|@|\marg{literal sequence}] will insert the given sequence
+% literally into the executed call of the command.
+% \item[|-|] will just drop the next token. It will probably be most
+% often used in the true branch of a |?| specification.
+% \item[|\#|\marg{argument}\marg{replacement}] is a transformation
+% rule that calls a macro with the given argument and replacement
+% text on the rest of the argument list. The replacement is used in
+% the executed call of the command. This can be used for parsing
+% arbitrary constructs. For example, the |[]| option could manually
+% be implemented with the option string |?[{#{[#1]}{[{#1}]}}{}|.
+% PStricks users might enjoy this sort of flexibility.
+% \item[|:|\marg{argument}\marg{replacement}] is again a
+% transformation rule. As opposed to |#|, however, the result of
+% the transformation is parsed again. You'll rarely need this.
+% \end{description}
+%
+% There is a second optional argument in brackets that can be used to
+% declare any default action to be taken instead. This is mostly for
+% the sake of macros that influence numbering: you would want to keep
+% their effects in that respect. The default action should use |#1|
+% for referring to the original (not the patched) command with the
+% parsed options appended. Not specifying a second optional argument
+% here is equivalent to specifying~|[#1]|.
+%
+% \DescribeMacro{\PreviewMacro*} A similar invocation
+% \cmd{\PreviewMacro*} simply throws the macro and all of its
+% arguments declared in the manner above away. This is mostly useful
+% for having things like \cmd{\footnote} not do their magic on their
+% arguments. More often than not, you don't want to declare any
+% arguments to scan to \cmd{\PreviewMacro*} since you would want the
+% remaining arguments to be treated as usual text and typeset in that
+% manner instead of being thrown away. An exception might be, say,
+% sort keys for \cmd{\cite}.
+%
+% A second optional argument in brackets can be used to declare any
+% default action to be taken instead. This is for the sake of macros
+% that influence numbering: you would want to keep their effects in
+% that respect. The default action might use |#1| for referring to
+% the original (not the patched) command with the parsed options
+% appended. Not specifying a second optional argument here is
+% equivalent to specifying~|[]| since the command usually gets thrown
+% away.
+%
+% As an example for using this argument, you might want to specify
+% \begin{quote}
+% |\PreviewMacro*\footnote[{[]}][#1{}]|
+% \end{quote}
+% This will replace a footnote by an empty footnote, but taking any
+% optional parameter into account, since an optional paramter changes
+% the numbering scheme. That way the real argument for the footnote
+% remains for processing by \previewlatex.
+%
+% \DescribeMacro{\PreviewEnvironment} The macro
+% \cmd{\PreviewEnvironment} works just as \cmd{\PreviewMacro} does,
+% only for environments. \DescribeMacro{\PreviewEnvironment*} And the
+% same goes for \cmd{\PreviewEnvironment*} as compared to
+% \cmd{\PreviewMacro*}.
+%
+% \DescribeMacro{\PreviewSnarfEnvironment} This macro does not typeset
+% the original environment inside of a preview box, but instead
+% typesets just the contents of the original environment inside of the
+% preview box, leaving nothing for the original environment. This has
+% to be used for figures, for example, since they would
+% \begin{enumerate}
+% \item produce insertion material that cannot be extracted to the
+% preview properly,
+% \item complain with an error message about not being in outer par
+% mode.
+% \end{enumerate}
+%
+% \DescribeMacro{\PreviewOpen}
+% \DescribeMacro{\PreviewClose}
+% Those Macros form a matched preview pair. This is for macros that
+% behave similar as \cmd{\begin} and \cmd{\end} of an environment. It
+% is essential for the operation of \cmd{\PreviewOpen} that the macro
+% treated with it will open an additional group even when the preview
+% falls inside of another preview or inside of a |nopreview|
+% environment. Similarly, the macro treated with \cmd{PreviewClose}
+% will close an environment even when inactive.
+%
+% \DescribeMacro{\ifPreview} In case you need to know whether
+% |preview| is active, you can use the conditional \cmd{\ifPreview}
+% together with |\else| and |\fi|.
+%
+% \StopEventually{}
+% \section{The Implementation}
+% Here we go: the start is somewhat obtuse since we figure out version
+% number and date from RCS strings. This should really be done at
+% docstrip time instead. Takers?
+% \begin{macro}{\pr@version}
+% \begin{macrocode}
+%<*style>
+%<*!active>
+\NeedsTeXFormat{LaTeX2e} \def\reserved@a #1#2$#3:
+#4${\xdef#1{\reserved@c #2#4 $}} \def\reserved@c #1 #2${#1}
+\begingroup \catcode`\_=12
+\reserved@a\pr@version $Name: $ \ifx\pr@version\@empty
+\reserved@a\pr@version CVS-$Revision: 1.126 $ \endgroup \else
+ \def\next release_{} \lccode`\_=`.
+ \edef\next{\lowercase{\endgroup
+ \def\noexpand\pr@version{\expandafter\next\pr@version}}} \next \fi
+\reserved@a\next $Date: 2010-02-14 16:19:00 $
+\edef\next{\noexpand\ProvidesPackage{preview}%
+ [\next\space \pr@version\space (AUCTeX/preview-latex)]}
+\next
+% \end{macrocode}
+% \end{macro}
+% Since many parts here will not be needed as long as the package is
+% inactive, we will include them enclosed with |<*active>| and
+% |</active>| guards. That way, we can append all of this stuff at a
+% place where it does not get loaded if not necessary.
+%
+%\begin{macro}{\ifPreview}
+% Setting the \cmd{\ifPreview} command should not be done by the
+% user, so we don't use \cmd{\newif} here. As a consequence, there
+% are no \cmd{\Previewtrue} and \cmd{\Previewfalse} commands.
+% \begin{macrocode}
+\let\ifPreview\iffalse
+%</!active>
+% \end{macrocode}
+%\end{macro}
+%\begin{macro}{\ifpr@outer}
+% We don't allow previews inside of previews. The macro
+% \cmd{\ifpr@outer} can be used for checking whether we are outside
+% of any preview code.
+% \begin{macrocode}
+%<*active>
+\newif\ifpr@outer
+\pr@outertrue
+%</active>
+% \end{macrocode}
+%\end{macro}
+%
+%\begin{macro}{\preview@delay}
+% The usual meaning of \cmd{\preview@delay} is to just echo its
+% argument in normal |preview| operation. If |preview| is inactive,
+% it swallows its argument. If the |delayed| option is active, the
+% contents will be passed to the \cmd{\AtBeginDocument} hook.
+%\begin{macro}{\pr@advise}
+% The core macro for modifying commands is \cmd{\pr@advise}. You
+% pass it the original command name as first argument and what should
+% be executed before the saved original command as second argument.
+%\begin{macro}{\pr@advise@ship}
+% The most often used macro for modifying commands is
+% \cmd{\pr@advise@ship}. It receives three arguments. The first is
+% the macro to modify, the second specifies some actions to be done
+% inside of a box to be created before the original macro gets
+% executed, the third one specifies actions after the original macro
+% got executed.
+%\begin{macro}{\pr@loadcfg}
+% The macro \cmd{\pr@loadcfg} is used for loading in configuration
+% files, unless disabled by the |noconfig| option.
+% \begin{macrocode}
+%<*!active>
+\let\preview@delay=\@gobble
+\let\pr@advise=\@gobbletwo
+\long\def\pr@advise@ship#1#2#3{}
+\def\pr@loadcfg#1{\InputIfFileExists{#1.cfg}{}{}}
+\DeclareOption{noconfig}{\let\pr@loadcfg=\@gobble}
+% \end{macrocode}
+%\begin{macro}{\pr@addto@front}
+% This adds code globally to the front of a macro.
+% \begin{macrocode}
+\long\def\pr@addto@front#1#2{%
+ \toks@{#2}\toks@\expandafter{\the\expandafter\toks@#1}%
+ \xdef#1{\the\toks@}}
+% \end{macrocode}
+% \end{macro}
+% These commands get more interesting when |preview| is active:
+% \begin{macrocode}
+\DeclareOption{active}{%
+ \let\ifPreview\iftrue
+ \def\pr@advise#1{%
+ \expandafter\pr@adviseii\csname pr@\string#1\endcsname#1}%
+ \long\def\pr@advise@ship#1#2#3{\pr@advise#1{\pr@protect@ship{#2}{#3}}}%
+ \let\preview@delay\@firstofone}
+% \end{macrocode}
+% \end{macro}
+% \end{macro}
+% \end{macro}
+% \end{macro}
+%
+% \begin{macro}{\pr@adviseii}
+% Now \cmd{\pr@advise} needs its helper macro. In order to avoid
+% recursive definitions, we advise only macros that are not yet
+% advised. Or, more exactly, we throw away the old advice and only
+% take the new one. We use e\TeX's \cmd{\protected} where available
+% for some extra robustness.
+% \begin{macrocode}
+\long\def\pr@adviseii#1#2#3{\preview@delay{%
+ \ifx#1\relax \let#1#2\fi
+ \toks@{#3#1}%
+ \ifx\@undefined\protected \else \protected\fi
+ \long\edef#2{\the\toks@}}}
+% \end{macrocode}
+%\end{macro}
+%
+% The |delayed| option is easy to implement: this is \emph{not} done
+% with \cmd{\let} since at the course of document processing, \LaTeX\
+% redefines \cmd{\AtBeginDocument} and we want to follow that
+% redefinition.
+% \begin{macrocode}
+\DeclareOption{delayed}{%
+ \ifPreview \def\preview@delay{\AtBeginDocument}\fi
+}
+% \end{macrocode}
+%
+%\begin{macro}{\ifpr@fixbb}
+% Another conditional. \cmd{\ifpr@fixbb} tells us whether we want to
+% surround the typeset materials with invisible rules so that Dvips
+% gets the bounding boxes right for, say, pure PostScript inclusions.
+%
+% If you are installing this on an operating system different from
+% the one |preview| has been developed on, you might want to redefine
+% |\pr@markerbox| in your |prdefault.cfg| file to use a file known to
+% be empty, like |/dev/null| is under Unix. Make this redefinition
+% depend on \cmd{\ifpr@fixbb} since only then |\pr@markerbox| will be
+% defined.
+% \begin{macrocode}
+\newif\ifpr@fixbb
+\pr@fixbbfalse
+\DeclareOption{psfixbb}{\ifPreview%
+ \pr@fixbbtrue
+ \newbox\pr@markerbox
+ \setbox\pr@markerbox\hbox{\special{psfile=/dev/null}}\fi
+}
+% \end{macrocode}
+% \end{macro}
+% \begin{macro}{\pr@graphicstype}
+% The |dvips| option redefines the |bop-hook| to reset the page
+% size.
+% \begin{macrocode}
+\let\pr@graphicstype=\z@
+\DeclareOption{dvips}{%
+ \let\pr@graphicstype\@ne
+ \preview@delay{\AtBeginDvi{%
+ \special{!/preview@version(\pr@version)def}
+ \special{!userdict begin/preview-bop-level 0 def%
+ /bop-hook{/preview-bop-level dup load dup 0 le{/isls false def%
+ /vsize 792 def/hsize 612 def}if 1 add store}bind def%
+ /eop-hook{/preview-bop-level dup load dup 0 gt{1 sub}if
+ store}bind def end}}}}
+% \end{macrocode}
+% The |pdftex| option just sets \cmd{\pr@graphicstype}.
+% \begin{macrocode}
+\DeclareOption{pdftex}{%
+ \let\pr@graphicstype\tw@}
+% \end{macrocode}
+% And so does the |xetex| option.
+% \begin{macrocode}
+\DeclareOption{xetex}{%
+ \let\pr@graphicstype\thr@@}
+%</!active>
+% \end{macrocode}
+% \end{macro}
+% \subsection{The internals}
+%
+% Those are only needed if |preview| is active.
+% \begin{macrocode}
+%<*active>
+% \end{macrocode}
+% \begin{macro}{\pr@snippet}
+% \cmd{\pr@snippet} is the current snippet number. We need a
+% separate counter to \cmd{\c@page} since several other commands
+% might fiddle with the page number.
+% \begin{macrocode}
+\newcount\pr@snippet
+\global\pr@snippet=1
+% \end{macrocode}
+% \end{macro}
+% \begin{macro}{\pr@protect}
+% This macro gets one argument which is unpacked and executed in
+% typesetting situations where we are not yet inside of a preview.
+% \begin{macrocode}
+\def\pr@protect{\ifx\protect\@typeset@protect
+ \ifpr@outer \expandafter\expandafter\expandafter
+ \@secondoftwo\fi\fi\@gobble}
+% \end{macrocode}
+% \end{macro}
+% \begin{macro}{\pr@protect@ship}
+% Now for the above mentioned \cmd{\pr@protect@ship}. This gets
+% three arguments. The first is what to do at the beginning of the
+% preview, the second what to do at the end, the third is the macro
+% where we stored the original definition.
+%
+% In case we are not in a typesetting situation,
+% \cmd{\pr@protect@ship} leaves the stored macro to fend for its
+% own. No better or worse protection than the original. And we
+% only do anything different when \cmd{\ifpr@outer} turns out to be
+% true.
+% \begin{macrocode}
+\def\pr@protect@ship{\pr@protect{\@firstoftwo\pr@startbox}%
+ \@gobbletwo}
+% \end{macrocode}
+% \end{macro}
+% \begin{macro}{\pr@insert}
+% \begin{macro}{\pr@mark}
+% \begin{macro}{\pr@marks}
+% We don't want insertions to end up on our lists. So we disable
+% them right now by replacing them with the following:
+% \begin{macrocode}
+\def\pr@insert{\begingroup\afterassignment\pr@insertii\count@}
+\def\pr@insertii{\endgroup\setbox\pr@box\vbox}
+% \end{macrocode}
+% Similar things hold for marks.
+% \begin{macrocode}
+\def\pr@mark{{\afterassignment}\toks@}
+\def\pr@marks{{\aftergroup\pr@mark\afterassignment}\count@}
+% \end{macrocode}
+% \end{macro}
+% \end{macro}
+% \end{macro}
+% \begin{macro}{\pr@box}
+% \begin{macro}{\pr@startbox}
+% Previews will be stored in \cmd{\box}\cmd{\pr@box}.
+% \cmd{\pr@startbox} gets two arguments: code to execute immediately
+% before the following stuff, code to execute afterwards. You have
+% to cater for \cmd{\pr@endbox} being called at the right time
+% yourself. We will use a \cmd{\vsplit} on the box later in order
+% to remove any leading glues, penalties and similar stuff. For
+% this reason we start off the box with an optimal break point.
+% \begin{macrocode}
+\newbox\pr@box
+\long\def\pr@startbox#1#2{%
+ \ifpr@outer
+ \toks@{#2}%
+ \edef\pr@cleanup{\the\toks@}%
+ \setbox\pr@box\vbox\bgroup
+ \break
+ \pr@outerfalse\@arrayparboxrestore
+ \let\insert\pr@insert
+ \let\mark\pr@mark
+ \let\marks\pr@marks
+ \expandafter\expandafter\expandafter
+ \pr@ship@start
+ \expandafter\@firstofone
+ \else
+ \expandafter \@gobble
+ \fi{#1}}
+% \end{macrocode}
+% \end{macro}
+% \end{macro}
+% \begin{macro}{\pr@endbox}
+% Cleaning up also is straightforward. If we have to watch the
+% bounding \TeX\ box, we want to remove spurious skips. We also
+% want to unwrap a possible single line paragraph, so that the box
+% is not full line length. We use \cmd{\vsplit} to clean up leading
+% glue and stuff, and we make some attempt of removing trailing
+% ones. After that, we wrap up the box including possible material
+% from \cmd{\AtBeginDvi}. If the |psfixbb| option is active, we
+% adorn the upper left and lower right corners with copies of
+% \cmd{\pr@markerbox}. The first few lines cater for \LaTeX\ hiding
+% things like like the code for \cmd{\paragraph} in \cmd{\everypar}.
+% \begin{macrocode}
+\def\pr@endbox{%
+ \let\reserved@a\relax
+ \ifvmode \edef\reserved@a{\the\everypar}%
+ \ifx\reserved@a\@empty\else
+ \dimen@\prevdepth
+ \noindent\par
+ \setbox\z@\lastbox\unskip\unpenalty
+ \prevdepth\dimen@
+ \setbox\z@\hbox\bgroup\penalty-\maxdimen\unhbox\z@
+ \ifnum\lastpenalty=-\maxdimen\egroup
+ \else\egroup\box\z@ \fi\fi\fi
+ \ifhmode \par\unskip\setbox\z@\lastbox
+ \nointerlineskip\hbox{\unhbox\z@\/}%
+ \else \unskip\unpenalty\unskip \fi
+ \egroup
+ \setbox\pr@box\vbox{%
+ \baselineskip\z@skip \lineskip\z@skip \lineskiplimit\z@
+ \@begindvi
+ \nointerlineskip
+ \splittopskip\z@skip\setbox\z@\vsplit\pr@box to\z@
+ \unvbox\z@
+ \nointerlineskip
+ %\color@setgroup
+ \box\pr@box
+ %\color@endgroup
+ }%
+% \end{macrocode}
+% \begin{macro}{\pr@ship@end}
+% \label{sec:prshipend}At this point, \cmd{\pr@ship@end} gets
+% called. You must not under any circumstances change |\box\pr@box|
+% in any way that would add typeset material at the front of it,
+% except for PostScript header specials, since the front of
+% |\box\pr@box| may contain stuff from \cmd{\AtBeginDvi}.
+% \cmd{\pr@ship@end} contains two types of code additions: stuff
+% that adds to |\box\pr@box|, like the |labels| option does, and
+% stuff that measures out things or otherwise takes a look at the
+% finished |\box\pr@box|, like the |auctex| or |showbox| option do.
+% The former should use \cmd{pr@addto@front} for adding to this
+% hook, the latter use \cmd{g@addto@macro} for adding at the end of
+% this hook.
+%
+% Note that we shift the output box up by its height via
+% \cmd{\voffset}. This has three reasons: first we make sure that
+% no package-inflicted non-zero value of \cmd{\voffset} or
+% \cmd{\hoffset} will have any influence on the positioning of our
+% box. Second we shift the box such that its basepoint will exactly
+% be at the (1in,1in)~mark defined by \TeX. That way we can
+% properly take ascenders into account. And the third reason is
+% that \TeX\ treats a \cmd{\hbox} and a \cmd{\vbox} differently with
+% regard to the treating of its depth. Shifting \cmd{\voffset} and
+% \cmd{\hoffset} can be inhibited by setting |\pr@offset@override|.
+% \begin{macrocode}
+ \pr@ship@end
+ {\let\protect\noexpand
+ \ifx\pr@offset@override\@undefined
+ \voffset=-\ht\pr@box
+ \hoffset=\z@
+ \fi
+ \c@page=\pr@snippet
+ \pr@shipout
+ \ifpr@fixbb\hbox{%
+ \dimen@\wd\pr@box
+ \@tempdima\ht\pr@box
+ \@tempdimb\dp\pr@box
+ \box\pr@box
+ \llap{\raise\@tempdima\copy\pr@markerbox\kern\dimen@}%
+ \lower\@tempdimb\copy\pr@markerbox}%
+ \else \box\pr@box \fi}%
+ \global\advance\pr@snippet\@ne
+ \pr@cleanup
+}
+% \end{macrocode}
+% \end{macro}
+% \end{macro}
+% Oh, and we kill off the usual meaning of \cmd{\shipout} in case
+% somebody makes a special output routine. The following test is
+% pretty much the same as in |everyshi.sty|. One of its implications
+% is that if someone does a \cmd{\shipout} of a \emph{void} box,
+% things will go horribly wrong.
+% \begin{macro}{\shipout}
+% \begin{macrocode}
+\let\pr@shipout=\shipout
+\def\shipout{\deadcycles\z@\bgroup\setbox\z@\box\voidb@x
+ \afterassignment\pr@shipoutegroup\setbox\z@}
+\def\pr@shipoutegroup{\ifvoid\z@ \expandafter\aftergroup\fi \egroup}
+% \end{macrocode}
+% \end{macro}
+% \subsection{Parsing commands}
+% \begin{macro}{\pr@parseit}
+% \begin{macro}{\pr@endparse}
+% \begin{macro}{\pr@callafter}
+% The following stuff is for parsing the arguments of commands we
+% want to somehow surround with stuff. Usage is
+% \begin{quote}
+%
\cmd{\pr@callafter}\meta{aftertoken}\meta{parsestring}\cmd{\pr@endparse}\\
+% \qquad\meta{macro}\meta{parameters}
+% \end{quote}
+% \meta{aftertoken} is stored away and gets executed once parsing
+% completes, with its first argument being the parsed material.
+% \meta{parsestring} would be, for example for the
+% \cmd{\includegraphics} macro, |*[[!|, an optional |*| argument
+% followed by two optional arguments enclosed in |[]|, followed by
+% one mandatory argument.
+%
+% For the sake of a somewhat more intuitive syntax, we now support
+% also the syntax |{*[]{}}| in the optional argument. Since \TeX\
+% strips redundant braces, we have to write |[{{}}]| in this syntax
+% for a single mandatory argument. Hard to avoid. We use an
+% unusual character for ending the parsing. The implementation is
+% rather trivial.
+% \begin{macrocode}
+\def\pr@parseit#1{\csname pr@parse#1\endcsname}
+\let\pr@endparse=\@percentchar
+\def\next#1{%
+\def\pr@callafter{%
+ \afterassignment\pr@parseit
+ \let#1= }}
+\expandafter\next\csname pr@parse\pr@endparse\endcsname
+% \end{macrocode}
+% \end{macro}
+% \end{macro}
+% \end{macro}
+% \begin{macro}{\pr@parse*}
+% Straightforward, same mechanism \LaTeX\ itself employs. We take
+% some care not to pass potential |#| tokens unprotected through
+% macros.
+% \begin{macrocode}
+\long\expandafter\def\csname pr@parse*\endcsname#1\pr@endparse#2{%
+ \begingroup\toks@{#1\pr@endparse{#2}}%
+ \edef\next##1{\endgroup##1\the\toks@}%
+ \@ifstar{\next{\pr@parse@*}}{\next\pr@parseit}}
+% \end{macrocode}
+% \end{macro}
+% \begin{macro}{\pr@parse[}
+% \begin{macro}{\pr@brace}
+% Copies optional parameters in brackets if present. The additional
+% level of braces is necessary to ensure that braces the user might
+% have put to hide a~|]| bracket in an optional argument don't get
+% lost. There will be no harm if such braces were not there at the
+% start.
+% \begin{macrocode}
+\long\expandafter\def\csname pr@parse[\endcsname#1\pr@endparse#2{%
+ \begingroup\toks@{#1\pr@endparse{#2}}%
+ \edef\next##1{\endgroup##1\the\toks@}%
+ \@ifnextchar[{\next\pr@bracket}{\next\pr@parseit}}
+\long\def\pr@bracket#1\pr@endparse#2[#3]{%
+ \pr@parseit#1\pr@endparse{#2[{#3}]}}
+% \end{macrocode}
+% \end{macro}
+% \end{macro}
+% \begin{macro}{\pr@parse]}
+% This is basically a do-nothing, so that we may use the syntax
+% |{*[][]!}| in the optional argument instead of the more concise
+% but ugly |*[[!| which confuses the brace matchers of editors.
+% \begin{macrocode}
+\expandafter\let\csname pr@parse]\endcsname=\pr@parseit
+% \end{macrocode}
+% \end{macro}
+% \begin{macro}{\pr@parse}
+% \begin{macro}{\pr@parse!}
+% Mandatory arguments are perhaps easiest to parse.
+% \begin{macrocode}
+\long\def\pr@parse#1\pr@endparse#2#3{%
+ \pr@parseit#1\pr@endparse{#2{#3}}}
+\expandafter\let\csname pr@parse!\endcsname=\pr@parse
+% \end{macrocode}
+% \end{macro}
+% \end{macro}
+% \begin{macro}{\pr@parse?}
+% \begin{macro}{\pr@parsecond}
+% This does an explicit call of |\@ifnextchar| and forks into the
+% given two alternatives as a result.
+% \begin{macrocode}
+\long\expandafter\def\csname pr@parse?\endcsname#1#2\pr@endparse#3{%
+ \begingroup\toks@{#2\pr@endparse{#3}}%
+ \@ifnextchar#1{\pr@parsecond\@firstoftwo}%
+ {\pr@parsecond\@secondoftwo}}
+\def\pr@parsecond#1{\expandafter\endgroup
+ \expandafter\expandafter\expandafter\pr@parseit
+ \expandafter#1\the\toks@}
+% \end{macrocode}
+% \end{macro}
+% \end{macro}
+% \begin{macro}{\pr@parse@}
+% This makes it possible to insert literal material into the
+% argument list.
+% \begin{macrocode}
+ \long\def\pr@parse@#1#2\pr@endparse#3{%
+ \pr@parseit #2\pr@endparse{#3#1}}
+% \end{macrocode}
+% \end{macro}
+% \begin{macro}{\pr@parse-}
+% This will just drop the next token.
+% \begin{macrocode}
+\long\expandafter\def\csname pr@parse-\endcsname
+ #1\pr@endparse#2{\begingroup
+ \toks@{\endgroup\pr@parseit #1\pr@endparse{#2}}%
+ {\aftergroup\the\aftergroup\toks@ \afterassignment}%
+ \let\next= }
+% \end{macrocode}
+% \end{macro}
+% \begin{macro}{\pr@parse:}
+% The following is a transform rule. A macro is being defined with
+% the given argument list and replacement, and the transformed
+% version replaces the original. The result of the transform is
+% still subject to being parsed.
+% \begin{macrocode}
+\long\expandafter\def\csname pr@parse:\endcsname
+ #1#2#3\pr@endparse#4{\begingroup
+ \toks@{\endgroup \pr@parseit#3\pr@endparse{#4}}%
+ \long\def\next#1{#2}%
+ \the\expandafter\toks@\next}
+% \end{macrocode}
+% \end{macro}
+% \edef\next{\noexpand\begin{macro}{\noexpand
+% \pr@parse\string#}}
+% \next
+% Another transform rule, but this passes the transformed material
+% into the token list.
+% \begin{macrocode}
+\long\expandafter\def\csname pr@parse#\endcsname
+ #1#2#3\pr@endparse#4{\begingroup
+ \toks@{#4}%
+ \long\edef\next##1{\toks@{\the\toks@##1}}%
+ \toks@{\endgroup \pr@parseit#3\pr@endparse}%
+ \long\def\reserved@a#1{{#2}}%
+ \the\expandafter\next\reserved@a}
+%</active>
+% \end{macrocode}
+% \end{macro}
+%
+% \subsection{Selection options}
+% The |displaymath| option. The |equation| environments in AMS\LaTeX\
+% already do too much before our hook gets to interfere, so we hook
+% earlier. Some juggling is involved to ensure we get the original
+% |\everydisplay| tokens only once and where appropriate.
+%
+% The incredible hack with |\dt@ptrue| is necessary for working around
+% bug `amslatex/3425'.
+% \begin{macrocode}
+%<*!active>
+\begingroup
+\catcode`\*=11
+\@firstofone{\endgroup
+\DeclareOption{displaymath}{%
+ \preview@delay{\toks@{%
+ \pr@startbox{\noindent$$%
+ \aftergroup\pr@endbox\@gobbletwo}{$$}\@firstofone}%
+ \everydisplay\expandafter{\the\expandafter\toks@
+ \expandafter{\the\everydisplay}}}%
+ \pr@advise@ship\equation{\begingroup\aftergroup\pr@endbox
+ \def\dt@ptrue{\m@ne=\m@ne}\noindent}%
+ {\endgroup}%
+ \pr@advise@ship\equation*{\begingroup\aftergroup\pr@endbox
+ \def\dt@ptrue{\m@ne=\m@ne}\noindent}%
+ {\endgroup}%
+ \PreviewOpen[][\def\dt@ptrue{\m@ne=\m@ne}\noindent#1]\[%
+ \PreviewClose\]%
+ \PreviewEnvironment[][\noindent#1]{eqnarray}%
+ \PreviewEnvironment[][\noindent#1]{eqnarray*}%
+ \PreviewEnvironment{displaymath}%
+}}
+% \end{macrocode}
+%
+% The |textmath| option. Some folderol in order to define the active
+% |$|
+% math mode delimiter. \cmd\pr@textmathcheck is used for checking
+% whether we have a single |$| or double |$$|.
+% In the latter case, we enter display math (this sort of display math
+% is not allowed inside of \LaTeX\ because of inconsistent spacing,
+% but surprisingly many people use it nevertheless). Strictly
+% speaking, this is incorrect, since not every
+% |$$| actually means display math. For example, |\hbox{$$}| will
+% because of restricted horizontal mode rather yield an empty text
+% math formula. Since our implementation moved the sequence inside of
+% a |\vbox|, the interpretation will change. People should just not
+% enter rubbish like that.
+% \begin{macrocode}
+\begingroup
+\def\next#1#2{%
+ \endgroup
+ \DeclareOption{textmath}{%
+ \PreviewEnvironment{math}%
+ \preview@delay{\ifx#1\@undefined \let#1=$%$
+ \fi\catcode`\$=\active
+ \ifx\xyreuncatcodes\@undefined\else
+ \edef\next{\catcode`@=\the\catcode`@\relax}%
+ \makeatother\expandafter\xyreuncatcodes\next\fi}%
+ \pr@advise@ship\(\pr@endaftergroup{}% \)
+ \pr@advise@ship#1{\@firstoftwo{\let#1=#2%
+ \futurelet\reserved@a\pr@textmathcheck}}{}}%
+ \def\pr@textmathcheck{\expandafter\pr@endaftergroup
+ \ifx\reserved@a#1{#2#2}\expandafter\@gobbletwo\fi#2}}
+\lccode`\~=`\$
+\lowercase{\expandafter\next\expandafter~}%
+ \csname pr@\string$%$
+ \endcsname
+%</!active>
+% \end{macrocode}
+% \begin{macro}{\pr@endaftergroup}
+% This justs ends the box after the group opened by |#1| is closed
+% again.
+% \begin{macrocode}
+%<*active>
+\def\pr@endaftergroup#1{#1\aftergroup\pr@endbox}
+%</active>
+% \end{macrocode}
+% \end{macro}
+%
+% The |graphics| option.
+% \begin{macrocode}
+%<*!active>
+\DeclareOption{graphics}{%
+ \PreviewMacro[*[[!]{\includegraphics}%]]
+}
+% \end{macrocode}
+% The |floats| option. The complications here are merely to spare us
+% bug reports about broken document classes that use |\let| on
+% |\endfigure| and similar. Notable culprits that have not been
+% changed in years in spite of reports are |elsart.cls| and
+% |IEEEtran.cls|. Complain when you are concerned.
+% \begin{macrocode}
+\def\pr@floatfix#1#2{\ifx#1#2%
+ \ifx#1\@undefined\else
+ \PackageWarningNoLine{preview}{%
+Your document class has a bad definition^^J
+of \string#1, most likely^^J
+\string\let\string#1=\string#2^^J
+which has now been changed to^^J
+\string\def\string#1{\string#2}^^J
+because otherwise subsequent changes to \string#2^^J
+(like done by several packages changing float behaviour)^^J
+can't take effect on \string#1.^^J
+Please complain to your document class author}%
+ \def#1{#2}\fi\fi}
+\begingroup
+\def\next#1#2{\endgroup
+ \DeclareOption{floats}{%
+ \pr@floatfix\endfigure\end@float
+ \pr@floatfix\endtable\end@float
+ \pr@floatfix#1\end@dblfloat
+ \pr@floatfix#2\end@dblfloat
+ \PreviewSnarfEnvironment[![]{@float}%]
+ \PreviewSnarfEnvironment[![]{@dblfloat}%]
+ }}
+\expandafter\next\csname endfigure*\expandafter\endcsname
+ \csname endtable*\endcsname
+% \end{macrocode}
+% The |sections| option. Two optional parameters might occur in
+% |memoir.cls|.
+% \begin{macrocode}
+\DeclareOption{sections}{%
+ \PreviewMacro[!!!!!!*[[!]{\@startsection}%]]
+ \PreviewMacro[*[[!]{\chapter}%]]
+}
+% \end{macrocode}
+% We now interpret any further options as driver files we load. Note
+% that these driver files are loaded even when |preview| is not
+% active. The reason is that they might define commands (like
+% \cmd{\PreviewCommand}) that should be available even in case of an
+% inactive package. Large parts of the |preview| package will not
+% have been loaded in this case: you have to cater for that.
+% \begin{macrocode}
+\DeclareOption*
+ {\InputIfFileExists{pr\CurrentOption.def}{}{\OptionNotUsed}}
+% \end{macrocode}
+%
+% \subsection{Preview attaching commands}
+% \begin{macro}{\PreviewMacro}
+% As explained above. Detect possible |*| and call appropriate
+% macro.
+% \begin{macrocode}
+\def\PreviewMacro{\@ifstar\pr@starmacro\pr@macro}
+% \end{macrocode}
+% The version without |*| is now rather straightforward.
+% \begin{macro}{\pr@macro}
+% \begin{macro}{\pr@domacro}
+% \begin{macro}{\pr@macroii}
+% \begin{macro}{\pr@endmacro}
+% \begin{macrocode}
+\long\def\pr@domacro#1#2{%
+ \long\def\next##1{#2}%
+ \pr@callafter\next#1]\pr@endparse}
+\newcommand\pr@macro[1][]{%
+ \toks@{\pr@domacro{#1}}%
+ \long\edef\next[##1]##2{%
+ \noexpand\pr@advise@ship{##2}{\the\toks@{##1\noexpand\pr@endbox}}{}}%
+ \@ifnextchar[\next\pr@macroii}
+\def\pr@macroii{\next[##1]}
+\long\def\pr@endmacro#1{#1\pr@endbox}
+% \end{macrocode}
+% \end{macro}
+% \end{macro}
+% \end{macro}
+% \end{macro}
+% \end{macro}
+% \begin{macro}{PreviewMacro*}
+% \begin{macro}{\pr@protect@domacro}
+% \begin{macro}{\pr@starmacro}
+% The version with |*| has to parse the arguments, then throw them
+% away. Some internal macros first, then the interface call.
+% \begin{macrocode}
+\long\def\pr@protect@domacro#1#2{\pr@protect{%
+ \long\def\next##1{#2}%
+ \pr@callafter\next#1]\pr@endparse}}
+\newcommand\pr@starmacro[1][]{\toks@{\pr@protect@domacro{#1}}%
+ \long\edef\next[##1]##2{%
+ \noexpand\pr@advise##2{\the\toks@{##1}}}%
+ \@ifnextchar[\next{\next[]}}
+% \end{macrocode}
+% \end{macro}
+% \end{macro}
+% \end{macro}
+% \begin{macro}{\PreviewOpen}
+% As explained above. Detect possible |*| and call appropriate macro.
+% \begin{macrocode}
+\def\PreviewOpen{\@ifstar\pr@starmacro\pr@open}
+% \end{macrocode}
+% The version without |*| is now rather straightforward.
+% \begin{macro}{\pr@open}
+% \begin{macrocode}
+\newcommand\pr@open[1][]{%
+ \toks@{\pr@domacro{#1}}%
+ \long\edef\next[##1]##2{%
+ \noexpand\pr@advise##2{\begingroup
+ \noexpand\pr@protect@ship
+ {\the\toks@{\begingroup\aftergroup\noexpand\pr@endbox##1}}%
+ {\endgroup}}}%
+ \@ifnextchar[\next\pr@macroii}
+% \end{macrocode}
+% \end{macro}
+% \end{macro}
+% \begin{macro}{\PreviewClose}
+% As explained above. Detect possible |*| and call appropriate
+% macro.
+% \begin{macrocode}
+\def\PreviewClose{\@ifstar\pr@starmacro\pr@close}
+% \end{macrocode}
+% The version without |*| is now rather straightforward.
+% \begin{macro}{\pr@close}
+% \begin{macrocode}
+\newcommand\pr@close[1][]{%
+ \toks@{\pr@domacro{#1}}%
+ \long\edef\next[##1]##2{%
+ \noexpand\pr@advise{##2}{\the\toks@{##1\endgroup}}}%
+ \@ifnextchar[\next\pr@macroii}
+% \end{macrocode}
+% \end{macro}
+% \end{macro}
+% \begin{macro}{\PreviewEnvironment}
+% Actually, this ignores any syntax argument. But don't tell
+% anybody. Except for the |*|~variant, it respects (actually
+% ignores) any argument! Of course, we'll need to deactivate
+% |\end{|\meta{environment}|}| as well.
+% \begin{macrocode}
+\def\PreviewEnvironment{\@ifstar\pr@starenv\pr@env}
+\newcommand\pr@starenv[1][]{\toks@{\pr@starmacro[{#1}]}%
+ \long\edef\next##1##2{%
+ \the\toks@[{##2}]##1}%
+ \begingroup\pr@starenvii}
+\newcommand\pr@starenvii[2][]{\endgroup
+ \expandafter\next\csname#2\endcsname{#1}%
+ \expandafter\pr@starmacro\csname end#2\endcsname}
+\newcommand\pr@env[1][]{%
+ \toks@{\pr@domacro{#1}}%
+ \long\edef\next[##1]##2{%
+ \noexpand\expandafter\noexpand\pr@advise@ship
+ \noexpand\csname##2\noexpand\endcsname{\the\toks@
+ {\begingroup\aftergroup\noexpand\pr@endbox##1}}{\endgroup}}%
+ \@ifnextchar[\next\pr@macroii %]
+ }
+% \end{macrocode}
+% \end{macro}
+% \begin{macro}{\PreviewSnarfEnvironment}
+% This is a nuisance since we have to advise \emph{both} the
+% environment and its end.
+% \begin{macrocode}
+\newcommand{\PreviewSnarfEnvironment}[2][]{%
+ \expandafter\pr@advise
+ \csname #2\endcsname{\pr@snarfafter{#1}}%
+ \expandafter\pr@advise
+ \csname end#2\endcsname{\pr@endsnarf}}
+%</!active>
+% \end{macrocode}
+% \end{macro}
+% \begin{macro}{\pr@snarfafter}
+% \begin{macro}{\pr@startsnarf}
+% \begin{macro}{\pr@endsnarf}
+% Ok, this looks complicated, but we have to start a group in order
+% to be able to hook \cmd{\pr@endbox} into the game only when
+% \cmd{\ifpr@outer} has triggered the start. And we need to get our
+% start messages out before parsing the arguments.
+% \begin{macrocode}
+%<*active>
+\let\pr@endsnarf\relax
+\long\def\pr@snarfafter#1{\ifpr@outer
+ \pr@ship@start
+ \let\pr@ship@start\relax
+ \let\pr@endsnarf\endgroup
+ \else
+ \let\pr@endsnarf\relax
+ \fi
+ \pr@protect{\pr@callafter\pr@startsnarf#1]\pr@endparse}}
+\def\pr@startsnarf#1{#1\begingroup
+ \pr@startbox{\begingroup\aftergroup\pr@endbox}{\endgroup}%
+ \ignorespaces}
+%</active>
+% \end{macrocode}
+% \end{macro}
+% \end{macro}
+% \end{macro}
+% \begin{macro}{\pr@ship@start}
+% \begin{macro}{\pr@ship@end}
+% The hooks \cmd{\pr@ship@start} and \cmd{\pr@ship@end} can be added
+% to by option files by the help of the \cmd{\g@addto@macro} command
+% from \LaTeX, and by the \cmd{\pr@addto@front} command from
+% |preview.sty| itself. They are called just before starting to
+% process some preview, and just after it. Here is the policy for
+% adding to them: \cmd{\pr@ship@start} is called inside of the vbox
+% |\pr@box| before typeset material gets produced. It is, however,
+% preceded by a break command that is intended for usage in
+% \cmd{\vsplit}, so that any following glue might disappear. In
+% case you want to add any material on the list, you have to precede
+% it with \cmd{\unpenalty} and have to follow it with \cmd{\break}.
+% You have make sure that under no circumstances any other legal
+% breakpoints appear before that, and your material should
+% contribute no nonzero dimensions to the page. For the policies of
+% the \cmd{\pr@ship@end} hook, see the description on
+% page~\pageref{sec:prshipend}.
+% \begin{macrocode}
+%<*!active>
+\let\pr@ship@start\@empty
+\let\pr@ship@end\@empty
+% \end{macrocode}
+% \end{macro}
+% \end{macro}
+% \begin{environment}{preview}
+% \begin{environment}{nopreview}
+% First we write the definitions of these environments when
+% |preview| is inactive. We will redefine them if |preview| gets
+% activated.
+% \begin{macrocode}
+\newenvironment{preview}{\ignorespaces}{\ifhmode\unskip\fi}
+\newenvironment{nopreview}{\ignorespaces}{\ifhmode\unskip\fi}
+% \end{macrocode}
+% \end{environment}
+% \end{environment}
+%
+% We now process the options and finish in case we are not active.
+% \begin{macrocode}
+\ProcessOptions\relax
+\ifPreview\else\expandafter\endinput\fi
+%</!active>
+% \end{macrocode}
+% Now for the redefinition of the |preview| and |endpreview|
+% environments:
+% \begin{macrocode}
+%<*active>
+\renewenvironment{preview}{\begingroup
+ \pr@startbox{\begingroup\aftergroup\pr@endbox}%
+ {\endgroup}%
+ \ignorespaces}%
+ {\ifhmode\unskip\fi\endgroup}
+\renewenvironment{nopreview}{\pr@outerfalse\ignorespaces}%
+ {\ifhmode\unskip\fi}
+% \end{macrocode}
+% We use the normal output routine, but hijack it a bit for our
+% purposes to preserve \cmd{\AtBeginDvi} hooks and not get previews
+% while in output: that could become rather ugly.
+%
+% The main work of disabling normal output relies on a \cmd{\shipout}
+% redefinition.
+% \begin{macro}{\pr@output}
+% \begin{macrocode}
+\newtoks\pr@output
+\pr@output\output
+\output{%
+ \pr@outerfalse
+ \let\@begindvi\@empty
+ \the\pr@output}
+\let\output\pr@output
+% \end{macrocode}
+% \end{macro}
+% \begin{macro}{\pr@typeinfos}
+% Then we have some document info that style files might want to
+% output.
+% \begin{macrocode}
+\def\pr@typeinfos{\typeout{Preview: Fontsize \f@size pt}%
+ \ifnum\mag=\@m\else\typeout{Preview: Magnification \number\mag}\fi
+ \ifx\pdfoutput\@undefined
+ \ifx\XeTeXversion\@undefined \else
+ % FIXME: The message should not be emitted if XeTeX does not produce
+ % PDF. There does not seem to be a primitive for that, though.
+ \typeout{Preview: PDFoutput 1}%
+ \fi
+ \else
+ \ifx\pdfoutput\relax \else
+ \ifnum\pdfoutput>\z@
+ \typeout{Preview: PDFoutput 1}%
+ \fi
+ \fi
+ \fi
+}
+\AtBeginDocument{\pr@typeinfos}
+% \end{macrocode}
+% \end{macro}
+% And at the end we load the default configuration file, so that it
+% may override settings from this package:
+% \begin{macrocode}
+\pr@loadcfg{prdefault}
+%</active>
+%</style>
+% \end{macrocode}
+%
+% \section{The option files}
+% \subsection{The \texttt{auctex} option}
+% The AUC\TeX\ option will cause error messages to spew. We want them
+% on the terminal, but we don't want \LaTeX\ to stop its automated
+% run. We delay \cmd{\nonstopmode} in case the user has any
+% pseudo-interactive folderol like reading in of file names in his
+% preamble. Because we are so good-hearted, we will not break this as
+% long as the document has not started, but after that we need the
+% error message mechanism operative.
+%
+% The |\nofiles| command here tries to avoid clobbering input files
+% used for references and similar. It will come too late if you call
+% the package with \cmd{\AtBeginDocument}, so you'll need to issue
+% |\nofiles| yourself in that case. Previously, this was done
+% unconditionally in the main style file, but since we don't know what
+% the package may be used for, this was inappropriate.
+%
+% So here is the contents of the |prauctex.def| file:
+% \begin{macrocode}
+%<auctex>\ifPreview\else\expandafter\endinput\fi
+%<auctex>\nofiles
+%<auctex>\preview@delay{\nonstopmode}
+% \end{macrocode}
+% Ok, here comes creative error message formatting. It turns out a
+% sizable portion of the runtime is spent in I/O. Making the error
+% messages short is an advantage. It is not possible to convince
+% \TeX\ to make shorter error messages than this: \TeX\ always wants
+% to include context. This is about the shortest \ae sthetic one we
+% can muster.
+% \begin{macrocode}
+%<auctex>\begingroup
+%<auctex>\lccode`\~=`\-
+%<auctex>\lccode`\{=`\<
+%<auctex>\lccode`\}=`\>
+%<auctex>\lowercase{\endgroup
+%<auctex> \def\pr@msgi{{~}}}
+%<auctex>\def\pr@msgii{Preview:
+%<auctex> Snippet \number\pr@snippet\space}
+%<auctex>\begingroup
+%<auctex>\catcode`\-=13
+%<auctex>\catcode`\<=13
+%<auctex>\@firstofone{\endgroup
+%<auctex>\def\pr@msg#1{{%
+%<auctex> \let<\pr@msgi
+%<auctex> \def-{\pr@msgii#1}%
+%<auctex> \errhelp{Not a real error.}%
+%<auctex> \errmessage<}}}
+%<auctex>\g@addto@macro\pr@ship@start{\pr@msg{started}}
+%<auctex>\g@addto@macro\pr@ship@end{\pr@msg{ended.%
+%<auctex> (\number\ht\pr@box+\number\dp\pr@box x\number\wd\pr@box)}}
+% \end{macrocode}
+% This looks pretty baffling, but it produces something short and
+% semi-graphical, namely |<-><->|. That is a macro |<| that expands
+% into |<->|, where |<| and |>| are the braces around an
+% \cmd{\errmessage} argument and |-| is a macro expanding to the full
+% text of the error message. Cough cough. You did not really want to
+% know, did you?
+%
+% Since over/underfull boxes are about the messiest things to parse,
+% we disable them by setting the appropriate badness limits and making
+% the variables point to junk. We also disable other stuff. While we
+% set \cmd{\showboxbreadth} and \cmd{\showboxdepth} to indicate as
+% little diagnostic output as possible, we keep them operative, so
+% that the user retains the option of debugging using this stuff. The
+% other variables concerning the generation of warnings and
+% daignostics, however, are more often set by commonly employed
+% packages and macros such as \cmd{\sloppy}. So we kill them off for
+% good.
+% \begin{macrocode}
+%<auctex>\hbadness=\maxdimen
+%<auctex>\newcount\hbadness
+%<auctex>\vbadness=\maxdimen
+%<auctex>\let\vbadness=\hbadness
+%<auctex>\hfuzz=\maxdimen
+%<auctex>\newdimen\hfuzz
+%<auctex>\vfuzz=\maxdimen
+%<auctex>\let\vfuzz=\hfuzz
+%<auctex>\showboxdepth=-1
+%<auctex>\showboxbreadth=-1
+% \end{macrocode}
+% Ok, now we load a possible configuration file.
+% \begin{macrocode}
+%<auctex>\pr@loadcfg{prauctex}
+% \end{macrocode}
+% And here we cater for several frequently used commands in
+% |prauctex.cfg|:
+% \begin{macrocode}
+%<auccfg>\PreviewMacro*[[][#1{}]\footnote
+%<auccfg>\PreviewMacro*[?[{@{[]}}{}][#1]\item
+%<auccfg>\PreviewMacro*\emph
+%<auccfg>\PreviewMacro*\textrm
+%<auccfg>\PreviewMacro*\textit
+%<auccfg>\PreviewMacro*\textsc
+%<auccfg>\PreviewMacro*\textsf
+%<auccfg>\PreviewMacro*\textsl
+%<auccfg>\PreviewMacro*\texttt
+%<auccfg>\PreviewMacro*\textcolor
+%<auccfg>\PreviewMacro*\mbox
+%<auccfg>\PreviewMacro*[][#1{}]\author
+%<auccfg>\PreviewMacro*[][#1{}]\title
+%<auccfg>\PreviewMacro*\and
+%<auccfg>\PreviewMacro*\thanks
+%<auccfg>\PreviewMacro*[][#1{}]\caption
+%<auccfg>\preview@delay{\@ifundefined{pr@\string\@startsection}{%
+%<auccfg> \PreviewMacro*[!!!!!!*][#1{}]\@startsection}{}}
+%<auccfg>\preview@delay{\@ifundefined{pr@\string\chapter}{%
+%<auccfg> \PreviewMacro*[*][#1{}]\chapter}{}}
+%<auccfg>\PreviewMacro*\index
+% \end{macrocode}
+%
+% \subsection{The \texttt{lyx} option}
+% The following is the option providing LyX with info for its preview
+% implementation.
+% \begin{macrocode}
+%<lyx>\ifPreview\else\expandafter\endinput\fi
+%<lyx>\pr@loadcfg{prlyx}
+%<lyx>\g@addto@macro\pr@ship@end{\typeout{Preview:
+%<lyx> Snippet \number\pr@snippet\space
+%<lyx> \number\ht\pr@box\space \number\dp\pr@box \space\number\wd\pr@box}}
+% \end{macrocode}
+%
+% \subsection{The \texttt{counters} option}
+% This outputs a checkpoint. We do this by saving all counter
+% registers in backup macros starting with |\pr@c@| in their name. A
+% checkpoint first writes out all changed counters (previously
+% unchecked counters are not written out unless different from zero),
+% then saves all involved counter values. \LaTeX\ tracks its counters
+% in the global variable \cmd{\cl@ckpt}.
+% \begin{macrocode}
+%<counters>\ifPreview\else\expandafter\endinput\fi
+%<counters>\def\pr@eltprint#1{\expandafter\@gobble\ifnum\value{#1}=0%
+%<counters> \csname pr@c@#1\endcsname\else\relax
+%<counters> \space{#1}{\arabic{#1}}\fi}
+%<counters>\def\pr@eltdef#1{\expandafter\xdef
+%<counters> \csname pr@c@#1\endcsname{\arabic{#1}}}
+%<counters>\def\pr@ckpt#1{{\let\@elt\pr@eltprint\edef\next{\cl@@ckpt}%
+%<counters> \ifx\next\@empty\else\typeout{Preview: Counters\next#1}%
+%<counters> \let\@elt\pr@eltdef\cl@@ckpt\fi}}
+%<counters>\pr@addto@front\pr@ship@start{\pr@ckpt:}
+%<counters>\pr@addto@front\pr@ship@end{\pr@ckpt.}
+% \end{macrocode}
+%
+% \subsection{Debugging options}
+% Those are for debugging the operation of |preview|, and thus are
+% mostly of interest for people that want to use |preview| for their
+% own purposes. Since debugging output is potentially confusing to
+% the error message parsing from AUC\TeX, you should not turn on
+% |\tracingonline| or switch from |\nonstopmode| unless you are
+% certain your package will never be used with \previewlatex.
+%
+% \paragraph{The \texttt{showbox} option} will generate diagnostic
+% output for every produced box. It does not delay the resetting of
+% the |\showboxbreadth| and |\showboxdepth| parameters so that you can
+% still change them after the loading of the package. It does,
+% however, move them to the end of the package loading, so that they
+% will not be affected by the |auctex| option.
+% \begin{macrocode}
+%<showbox>\ifPreview\else\expandafter\endinput\fi
+%<showbox>\AtEndOfPackage{%
+%<showbox> \showboxbreadth\maxdimen
+%<showbox> \showboxdepth\maxdimen}
+%<showbox>\g@addto@macro\pr@ship@end{\showbox\pr@box}
+% \end{macrocode}
+%
+% \paragraph{The \texttt{tracingall} option} is for the really heavy
+% diagnostic stuff. For the reasons mentioned above, we do not want
+% to change the setting of the interaction mode, nor of the
+% |tracingonline| flag. If the user wants them different, he should
+% set them outside of the preview boxes.
+% \begin{macrocode}
+%<tracingall>\ifPreview\else\expandafter\endinput\fi
+%<tracingall>\pr@addto@front\pr@ship@start{\let\tracingonline\count@
+%<tracingall> \let\errorstopmode\@empty\tracingall}
+% \end{macrocode}
+%
+% \subsection{Supporting conversions}
+% It is not uncommon to want to use the results of |preview| as
+% images. One possibility is to generate a flurry of EPS files with
+% \begin{quote}
+% |dvips -E -i -Ppdf -o| \meta{outputfile}|.000| \meta{inputfile}
+% \end{quote}
+% However, in case those are to be processed further into graphic
+% image files by Ghostscript, this process is inefficient. One cannot
+% use Ghostscript in a single run for generating the files, however,
+% since one needs to set the page size (or full size pages will be
+% produced). The |tightpage| option will set the page dimensions at
+% the start of each PostScript page so that the output will be sized
+% appropriately. That way, a single pass of Dvips followed by a
+% single pass of Ghostscript will be sufficient for generating all
+% images.
+%
+% You will have to specify the output driver to be used, either
+% |dvips| or |pdftex|.
+%
+% \begin{macro}{\PreviewBorder}
+% \begin{macro}{\PreviewBbAdjust}
+% We start this off with the user tunable parameters which get
+% defined even in the case of an inactive package, so that
+% redefinitions and assignments to them will always work:
+% \begin{macrocode}
+%<tightpage>\ifx\PreviewBorder\@undefined
+%<tightpage> \newdimen\PreviewBorder
+%<tightpage> \PreviewBorder=0.50001bp
+%<tightpage>\fi
+%<tightpage>\ifx\PreviewBbAdjust\@undefined
+%<tightpage> \def\PreviewBbAdjust{-\PreviewBorder -\PreviewBorder
+%<tightpage> \PreviewBorder \PreviewBorder}
+%<tightpage>\fi
+% \end{macrocode}
+% \end{macro}
+% \end{macro}
+% Here is stuff used for parsing this:
+% \begin{macrocode}
+%<tightpage>\ifPreview\else\expandafter\endinput\fi
+%<tightpage>\def\pr@nextbb{\edef\next{\next\space\number\dimen@}%
+%<tightpage> \expandafter\xdef\csname pr@bb@%
+%<tightpage> \romannumeral\count@\endcsname{\the\dimen@}%
+%<tightpage> \advance\count@\@ne\ifnum\count@<5
+%<tightpage> \afterassignment\pr@nextbb\dimen@=\fi}
+% \end{macrocode}
+% And here is the stuff that we fudge into our hook. Of course, we
+% have to do it in a box, and we start this box off with our special.
+% There is one small consideration here: it might come before any
+% |\AtBeginDvi| stuff containing header specials. It turns out Dvips
+% rearranges this amicably: header code specials get transferred to
+% the appropriate header section, anyhow, so this ensures that we come
+% right after the bop section. We insert the 7~numbers here: the
+% 4~bounding box adjustments, and the 3~\TeX\ box dimensions. In case
+% the box adjustments have changed since the last time, we write them
+% out to the console.
+% \begin{macrocode}
+%<tightpage>\ifnum\pr@graphicstype=\z@
+%<tightpage> \ifcase
+%<tightpage> \ifx\XeTeXversion\@undefined
+%<tightpage> \ifx\pdfoutput\@undefined \@ne\fi
+%<tightpage> \ifx\pdfoutput\relax \@ne\fi
+%<tightpage> \ifnum\pdfoutput>\z@ \tw@\fi \@ne
+%<tightpage> \else \thr@@\fi
+%<tightpage> \or \ExecuteOptions{dvips}\relax
+%<tightpage> \or \ExecuteOptions{pdftex}\relax
+%<tightpage> \or \ExecuteOptions{xetex}\relax\fi\fi
+%<tightpage>\global\let\pr@bbadjust\@empty
+%<tightpage>\pr@addto@front\pr@ship@end{\begingroup
+%<tightpage> \let\next\@gobble
+%<tightpage> \count@\@ne\afterassignment\pr@nextbb
+%<tightpage> \dimen@\PreviewBbAdjust
+%<tightpage> \ifx\pr@bbadjust\next
+%<tightpage> \else \global\let\pr@bbadjust\next
+%<tightpage> \typeout{Preview: Tightpage \pr@bbadjust}%
+%<tightpage> \fi\endgroup}
+%<tightpage>\ifcase\pr@graphicstype
+%<tightpage>\or
+%<tightpage> \g@addto@macro\pr@ship@end{\setbox\pr@box\hbox{%
+%<tightpage> \special{ps::\pr@bbadjust\space
+%<tightpage> \number\ifdim\ht\pr@box>\z@ \ht\pr@box
+%<tightpage> \else \z@
+%<tightpage> \fi \space
+%<tightpage> \number\ifdim\dp\pr@box>\z@ \dp\pr@box
+%<tightpage> \else \z@
+%<tightpage> \fi \space
+%<tightpage> \number\ifdim\wd\pr@box>\z@ \wd\pr@box
+%<tightpage> \else \z@
+%<tightpage> \fi}\box\pr@box}}
+%<tightpage>\or
+%<tightpage> \g@addto@macro\pr@ship@end{{\dimen@\ht\pr@box
+%<tightpage> \ifdim\dimen@<\z@ \dimen@\z@\fi
+%<tightpage> \advance\dimen@\pr@bb@iv
+%<tightpage> \dimen@ii=\dimen@
+%<tightpage> \global\pdfvorigin\dimen@
+%<tightpage> \dimen@\dp\pr@box
+%<tightpage> \ifdim\dimen@<\z@ \dimen@\z@\fi
+%<tightpage> \advance\dimen@-\pr@bb@ii
+%<tightpage> \advance\dimen@\dimen@ii
+%<tightpage> \global\pdfpageheight\dimen@
+%<tightpage> \dimen@\wd\pr@box
+%<tightpage> \ifdim\dimen@<\z@ \dimen@=\z@\fi
+%<tightpage> \advance\dimen@-\pr@bb@i
+%<tightpage> \advance\dimen@\pr@bb@iii
+%<tightpage> \global\pdfpagewidth\dimen@
+%<tightpage> \global\pdfhorigin-\pr@bb@i}}
+%<tightpage>\or
+%<tightpage> \g@addto@macro\pr@ship@end{\dimen@\ht\pr@box
+%<tightpage> \ifdim\dimen@<\z@ \dimen@\z@\fi
+%<tightpage> \advance\dimen@\pr@bb@iv
+%<tightpage> \dimen@ii=\dimen@
+%<tightpage> \voffset=-1in
+%<tightpage> \advance\voffset\dimen@
+%<tightpage> \advance\voffset-\ht\pr@box
+%<tightpage> \dimen@\dp\pr@box
+%<tightpage> \ifdim\dimen@<\z@ \dimen@\z@\fi
+%<tightpage> \advance\dimen@-\pr@bb@ii
+%<tightpage> \advance\dimen@\dimen@ii
+%<tightpage> \global\pdfpageheight\dimen@
+%<tightpage> \global\paperheight\dimen@
+%<tightpage> \dimen@\wd\pr@box
+%<tightpage> \ifdim\dimen@<\z@ \dimen@=\z@\fi
+%<tightpage> \advance\dimen@-\pr@bb@i
+%<tightpage> \advance\dimen@\pr@bb@iii
+%<tightpage> \global\pdfpagewidth\dimen@
+%<tightpage> \hoffset=-1in
+%<tightpage> \advance\hoffset-\pr@bb@i
+%<tightpage> \let\pr@offset@override\@empty}
+%<tightpage>\fi
+% \end{macrocode}
+% Ok, here comes the beef. First we fish the 7~numbers from the file
+% with |token| and convert them from \TeX~|sp| to PostScript points.
+% \begin{macrocode}
+%<tightpage>\ifnum\pr@graphicstype=\@ne
+%<tightpage>\preview@delay{\AtBeginDvi{%
+% \end{macrocode}
+% Backwards-compatibility. Once we are certain that dvipng-1.6 or
+% later is widely used, the three following specials can be exchanged
+% for the simple |\special{!/preview@tightpage true def}|
+% \begin{macrocode}
+%<tightpage> \special{!/preview@tightpage true def (%
+%<tightpage> compatibility PostScript comment for dvipng<=1.5 }
+%<tightpage> \special{!userdict begin/bop-hook{%
+%<tightpage> 7{currentfile token not{stop}if
+%<tightpage> 65781.76 div DVImag mul}repeat
+%<tightpage> 72 add 72 2 copy gt{exch}if 4 2 roll
+%<tightpage> neg 2 copy lt{exch}if dup 0 gt{pop 0 exch}%
+%<tightpage> {exch dup 0 lt{pop 0}if}ifelse 720 add exch 720 add
+%<tightpage> 3 1 roll
+%<tightpage> 4{5 -1 roll add 4 1 roll}repeat
+%<tightpage> <</PageSize[5 -1 roll 6 index sub 5 -1 roll 5 index sub]%
+%<tightpage> /PageOffset[7 -2 roll [1 1 dtransform exch]%
+%<tightpage> {0 ge{neg}if exch}forall]>>setpagedevice%
+%<tightpage> //bop-hook exec}bind def end}
+%<tightpage> \special{!userdict (some extra code to avoid
+%<tightpage> dvipng>=1.6 unknown special:
+%<tightpage> 7{currentfile token not{stop}if 65781.76 div })) pop}
+% \end{macrocode}
+% The ``userdict'' at the start of the last special is also there to
+% avoid an unknown special in dvipng<=1.6. This is the end of the
+% backwards-compatibility code.
+% \begin{macrocode}
+%<tightpage> \special{!userdict begin/bop-hook{%
+%<tightpage> preview-bop-level 0 le{%
+%<tightpage> 7{currentfile token not{stop}if
+%<tightpage> 65781.76 div DVImag mul}repeat
+% \end{macrocode}
+% Next we produce the horizontal part of the bounding box as
+% \[ (1\mathrm{in},1\mathrm{in}) +
+% \bigl(\min(|\wd\pr@box|,0),\max(|\wd\pr@box|,0)\bigr) \]
+% and roll it to the bottom of the stack:
+% \begin{macrocode}
+%<tightpage> 72 add 72 2 copy gt{exch}if 4 2 roll
+% \end{macrocode}
+% Next is the vertical part of the bounding box. Depth counts in
+% negatively, and we again take $\min$ and $\max$ of possible extents
+% in the vertical direction, limited by 0. 720 corresponds to
+% $10\,\mathrm{in}$ and is the famous $1\,\mathrm{in}$ distance away
+% from the edge of letterpaper.
+% \begin{macrocode}
+%<tightpage> neg 2 copy lt{exch}if dup 0 gt{pop 0 exch}%
+%<tightpage> {exch dup 0 lt{pop 0}if}ifelse 720 add exch 720 add
+%<tightpage> 3 1 roll
+% \end{macrocode}
+% Ok, we now have the bounding box on the stack in the proper order
+% llx, lly, urx, ury. We add the adjustments:
+% \begin{macrocode}
+%<tightpage> 4{5 -1 roll add 4 1 roll}repeat
+% \end{macrocode}
+% The page size is calculated as the appropriate differences, the page
+% offset consists of the coordinates of the lower left corner, with
+% those coordinates negated that would be reckoned positive in the
+% device coordinate system.
+% \begin{macrocode}
+%<tightpage> <</PageSize[5 -1 roll 6 index sub 5 -1 roll 5 index sub]%
+%<tightpage> /PageOffset[7 -2 roll [1 1 dtransform exch]%
+%<tightpage> {0 ge{neg}if exch}forall]>>setpagedevice}if%
+% \end{macrocode}
+% So we now bind the old definition of |bop-hook| into our new
+% definition and finish it.
+% \begin{macrocode}
+%<tightpage> //bop-hook exec}bind def end}}}
+%<tightpage>\fi
+% \end{macrocode}
+%
+% \subsection{The \texttt{showlabels} option}
+% During the editing process, some people like to see the label names
+% in their equations, figures and the like. Now if you are using
+% Emacs for editing, and in particular \previewlatex, I'd strongly
+% recommend that you check out the Ref\TeX\ package which pretty much
+% obliterates the need for this kind of functionality. If you still
+% want it, standard \LaTeX\ provides it with the |showkeys| package,
+% and there is also the less encompassing |showlabels| package.
+% Unfortunately, since those go to some pain not to change the page
+% layout and spacing, they also don't change |preview|'s idea of the
+% \TeX\ dimensions of the involved boxes.
+%
+% So those packages are mostly useless. So we present here an
+% alternative hack that will get the labels through.
+% \begin{macro}{\pr@labelbox}
+% This works by collecting them into a separate box which we then
+% tack to the right of the previews.
+% \begin{macrocode}
+%<showlabels>\ifPreview\else\expandafter\endinput\fi
+%<showlabels>\newbox\pr@labelbox
+% \end{macrocode}
+% \end{macro}
+% \begin{macro}{\pr@label}
+% We follow up with our own definition of the \cmd{\label} macro
+% which will be active only in previews. The original definition is
+% stored in |\pr@@label|. |\pr@lastlabel| contains the last typeset
+% label in order to avoid duplication in certain environments, and
+% we keep the stuff in |\pr@labelbox|.
+% \begin{macrocode}
+%<showlabels>\def\pr@label#1{\pr@@label{#1}%
+% \end{macrocode}
+% Ok, now we generate the box, by placing the label below any existing
+% stuff.
+% \begin{macrocode}
+%<showlabels> \ifpr@setbox\z@{#1}%
+%<showlabels> \global\setbox\pr@labelbox\vbox{\unvbox\pr@labelbox
+%<showlabels> \box\z@}\egroup\fi}
+% \end{macrocode}
+% \end{macro}
+% \begin{macro}{\ifpr@setbox}
+% |\ifpr@setbox| receives two arguments, |#1| is the box into which
+% to set a label, |#2| is the label text itself. If a label needs
+% to be set (if it is not a duplicate in the current box, and is
+% nonempty, and we are in the course of typesetting and so on), we
+% are left in a true conditional and an open group with the preset
+% box. If nothing should be set, no group is opened, and we get
+% into skipping to the closing of the conditional. Since
+% |\ifpr@setbox| is a macro, you should not place the call to it
+% into conditional text, since it will not pair up with |\fi| until
+% being expanded.
+%
+% We have some trickery involved here. |\romannumeral\z@| expands
+% to empty, and will also remove everything between the two of them
+% that also expands to empty, like a chain of |\fi|.
+% \begin{macrocode}
+%<showlabels>\def\ifpr@setbox#1#2{%
+%<showlabels> \romannumeral%
+%<showlabels> \ifx\protect\@typeset@protect\ifpr@outer\else
+% \end{macrocode}
+% Ignore empty labels\dots
+% \begin{macrocode}
+%<showlabels> \z@\bgroup
+%<showlabels> \protected@edef\next{#2}\@onelevel@sanitize\next
+%<showlabels> \ifx\next\@empty\egroup\romannumeral\else
+% \end{macrocode}
+% and labels equal to the last one.
+% \begin{macrocode}
+%<showlabels> \ifx\next\pr@lastlabel\egroup\romannumeral\else
+%<showlabels> \global\let\pr@lastlabel\next
+%<showlabels> \setbox#1\pr@boxlabel\pr@lastlabel
+%<showlabels> \expandafter\expandafter\romannumeral\fi\fi\fi\fi
+%<showlabels> \z@\iffalse\iftrue\fi}
+% \end{macrocode}
+% \end{macro}
+% \begin{macro}{\pr@boxlabel}
+% Now the actual typesetting of a label box is done. We use a small
+% typewriter font inside of a framed box (the default frame/box
+% separating distance is a bit large).
+% \begin{macrocode}
+%<showlabels>\def\pr@boxlabel#1{\hbox{\normalfont
+%<showlabels> \footnotesize\ttfamily\fboxsep0.4ex\relax\fbox{#1}}}
+% \end{macrocode}
+% \end{macro}
+% \begin{macro}{\pr@maketag}
+% And here is a version for |amsmath| equations. They look better
+% when the label is right beside the tag, so we place it there, but
+% augment |\box\pr@labelbox| with an appropriate placeholder.
+% \begin{macrocode}
+%<showlabels>\def\pr@maketag#1{\pr@@maketag{#1}%
+%<showlabels> \ifpr@setbox\z@{\df@label}%
+%<showlabels> \global\setbox\pr@labelbox\vbox{%
+%<showlabels> \hrule\@width\wd\z@\@height\z@
+%<showlabels> \unvbox\pr@labelbox}%
+% \end{macrocode}
+% Set the width of the box to empty so that the label placement gets
+% not disturbed, then append it.
+% \begin{macrocode}
+%<showlabels> \wd\z@\z@\box\z@ \egroup\fi}
+% \end{macrocode}
+% \end{macro}
+% \begin{macro}{\pr@lastlabel}
+% Ok, here is how we activate this: we clear out box and label info
+% \begin{macrocode}
+%<showlabels>\g@addto@macro\pr@ship@start{%
+%<showlabels> \global\setbox\pr@labelbox\box\voidb@x
+%<showlabels> \xdef\pr@lastlabel{}%
+% \end{macrocode}
+% The definitions above are global because we might be in any amount
+% of nesting. We then reassign the appropriate labelling macros:
+% \begin{macrocode}
+%<showlabels> \global\let\pr@@label\label \let\label\pr@label
+%<showlabels> \global\let\pr@@maketag\maketag@@@
+%<showlabels> \let\maketag@@@\pr@maketag
+%<showlabels>}
+% \end{macrocode}
+% \end{macro}
+% Now all we have to do is to add the stuff to the box in question.
+% The stuff at the front works around a bug in |ntheorem.sty|.
+% \begin{macrocode}
+%<showlabels>\pr@addto@front\pr@ship@end{%
+%<showlabels> \ifx \label\pr@label \global\let\label\pr@@label \fi
+%<showlabels> \ifx \maketag@@@\pr@maketag
+%<showlabels> \global\let\maketag@@@\pr@@maketag \fi
+%<showlabels> \ifvoid\pr@labelbox
+%<showlabels> \else \setbox\pr@box\hbox{%
+%<showlabels> \box\pr@box\,\box\pr@labelbox}%
+%<showlabels> \fi}
+% \end{macrocode}
+% \subsection{The \texttt{footnotes} option}
+% This is rather simplistic right now. It overrides the default
+% footnote action (which is to disable footnotes altogether for better
+% visibility).
+% \begin{macrocode}
+%<footnotes>\PreviewMacro[[!]\footnote %]
+% \end{macrocode}
+%
+% \section{Various driver files}
+% The installer, in case it is missing. If it is to be used via
+% |make|, we don't specify an installation path, since
+% \begin{quote}
+% |make install|
+% \end{quote}
+% is supposed to cater for the installation itself.
+% \begin{macrocode}
+%<installer> \input docstrip
+%<installer&make> \askforoverwritefalse
+%<installer> \generate{
+%<installer> \file{preview.drv}{\from{preview.dtx}{driver}}
+%<installer&!make> \usedir{tex/latex/preview}
+%<installer> \file{preview.sty}{\from{preview.dtx}{style}
+%<installer> \from{preview.dtx}{style,active}}
+%<installer> \file{prauctex.def}{\from{preview.dtx}{auctex}}
+%<installer> \file{prauctex.cfg}{\from{preview.dtx}{auccfg}}
+%<installer> \file{prshowbox.def}{\from{preview.dtx}{showbox}}
+%<installer> \file{prshowlabels.def}{\from{preview.dtx}{showlabels}}
+%<installer> \file{prtracingall.def}{\from{preview.dtx}{tracingall}}
+%<installer> \file{prtightpage.def}{\from{preview.dtx}{tightpage}}
+%<installer> \file{prlyx.def}{\from{preview.dtx}{lyx}}
+%<installer> \file{prcounters.def}{\from{preview.dtx}{counters}}
+%<installer> \file{prfootnotes.def}{\from{preview.dtx}{footnotes}}
+%<installer> }
+%<installer> \endbatchfile
+% \end{macrocode}
+% And here comes the documentation driver.
+% \begin{macrocode}
+%<driver> \documentclass{ltxdoc}
+%<driver> \usepackage{preview}
+%<driver> \let\ifPreview\relax
+%<driver> \newcommand\previewlatex{\texttt{preview-latex}}
+%<driver> \begin{document}
+%<driver> \DocInput{preview.dtx}
+%<driver> \end{document}
+% \end{macrocode}
+% \Finale{}
+% \iffalse
+% Local Variables:
+% mode: doctex
+% TeX-master: "preview.drv"
+% End:
+% \fi
diff --git a/tests/auctex-11.87.7/latex/preview.sty
b/tests/auctex-11.87.7/latex/preview.sty
new file mode 100644
index 0000000..1e16577
--- /dev/null
+++ b/tests/auctex-11.87.7/latex/preview.sty
@@ -0,0 +1,391 @@
+%%
+%% This is file `preview.sty',
+%% generated with the docstrip utility.
+%%
+%% The original source files were:
+%%
+%% preview.dtx (with options: `style')
+%% preview.dtx (with options: `style,active')
+%%
+%% IMPORTANT NOTICE:
+%%
+%% For the copyright see the source file.
+%%
+%% Any modified versions of this file must be renamed
+%% with new filenames distinct from preview.sty.
+%%
+%% For distribution of the original source see the terms
+%% for copying and modification in the file preview.dtx preview.dtx.
+%%
+%% This generated file may be distributed as long as the
+%% original source files, as listed above, are part of the
+%% same distribution. (The sources need not necessarily be
+%% in the same archive or directory.)
+%% The preview style for extracting previews from LaTeX documents.
+%% Developed as part of AUCTeX <URL:http://www.gnu.org/software/auctex>.
+\NeedsTeXFormat{LaTeX2e} \def\reserved@a #1#2$#3:
+#4${\xdef#1{\reserved@c #2#4 $}} \def\reserved@c #1 #2${#1}
+\begingroup \catcode`\_=12
+\reserved@a\pr@version $Name: $ \ifx\pr@version\@empty
+\reserved@a\pr@version CVS-$Revision: 1.126 $ \endgroup \else
+ \def\next release_{} \lccode`\_=`.
+ \edef\next{\lowercase{\endgroup
+ \def\noexpand\pr@version{\expandafter\next\pr@version}}} \next \fi
+\reserved@a\next $Date: 2010/02/14 16:19:00 $
+\edef\next{\noexpand\ProvidesPackage{preview}%
+ [\next\space \pr@version\space (AUCTeX/preview-latex)]}
+\next
+\let\ifPreview\iffalse
+\let\preview@delay=\@gobble
+\let\pr@advise=\@gobbletwo
+\long\def\pr@advise@ship#1#2#3{}
+\def\pr@loadcfg#1{\InputIfFileExists{#1.cfg}{}{}}
+\DeclareOption{noconfig}{\let\pr@loadcfg=\@gobble}
+\long\def\pr@addto@front#1#2{%
+ \toks@{#2}\toks@\expandafter{\the\expandafter\toks@#1}%
+ \xdef#1{\the\toks@}}
+\DeclareOption{active}{%
+ \let\ifPreview\iftrue
+ \def\pr@advise#1{%
+ \expandafter\pr@adviseii\csname pr@\string#1\endcsname#1}%
+ \long\def\pr@advise@ship#1#2#3{\pr@advise#1{\pr@protect@ship{#2}{#3}}}%
+ \let\preview@delay\@firstofone}
+\long\def\pr@adviseii#1#2#3{\preview@delay{%
+ \ifx#1\relax \let#1#2\fi
+ \toks@{#3#1}%
+ \ifx\@undefined\protected \else \protected\fi
+ \long\edef#2{\the\toks@}}}
+\DeclareOption{delayed}{%
+ \ifPreview \def\preview@delay{\AtBeginDocument}\fi
+}
+\newif\ifpr@fixbb
+\pr@fixbbfalse
+\DeclareOption{psfixbb}{\ifPreview%
+ \pr@fixbbtrue
+ \newbox\pr@markerbox
+ \setbox\pr@markerbox\hbox{\special{psfile=/dev/null}}\fi
+}
+\let\pr@graphicstype=\z@
+\DeclareOption{dvips}{%
+ \let\pr@graphicstype\@ne
+ \preview@delay{\AtBeginDvi{%
+ \special{!/preview@version(\pr@version)def}
+ \special{!userdict begin/preview-bop-level 0 def%
+ /bop-hook{/preview-bop-level dup load dup 0 le{/isls false def%
+ /vsize 792 def/hsize 612 def}if 1 add store}bind def%
+ /eop-hook{/preview-bop-level dup load dup 0 gt{1 sub}if
+ store}bind def end}}}}
+\DeclareOption{pdftex}{%
+ \let\pr@graphicstype\tw@}
+\DeclareOption{xetex}{%
+ \let\pr@graphicstype\thr@@}
+\begingroup
+\catcode`\*=11
+\@firstofone{\endgroup
+\DeclareOption{displaymath}{%
+ \preview@delay{\toks@{%
+ \pr@startbox{\noindent$$%
+ \aftergroup\pr@endbox\@gobbletwo}{$$}\@firstofone}%
+ \everydisplay\expandafter{\the\expandafter\toks@
+ \expandafter{\the\everydisplay}}}%
+ \pr@advise@ship\equation{\begingroup\aftergroup\pr@endbox
+ \def\dt@ptrue{\m@ne=\m@ne}\noindent}%
+ {\endgroup}%
+ \pr@advise@ship\equation*{\begingroup\aftergroup\pr@endbox
+ \def\dt@ptrue{\m@ne=\m@ne}\noindent}%
+ {\endgroup}%
+ \PreviewOpen[][\def\dt@ptrue{\m@ne=\m@ne}\noindent#1]\[%
+ \PreviewClose\]%
+ \PreviewEnvironment[][\noindent#1]{eqnarray}%
+ \PreviewEnvironment[][\noindent#1]{eqnarray*}%
+ \PreviewEnvironment{displaymath}%
+}}
+\begingroup
+\def\next#1#2{%
+ \endgroup
+ \DeclareOption{textmath}{%
+ \PreviewEnvironment{math}%
+ \preview@delay{\ifx#1\@undefined \let#1=$%$
+ \fi\catcode`\$=\active
+ \ifx\xyreuncatcodes\@undefined\else
+ \edef\next{\catcode`@=\the\catcode`@\relax}%
+ \makeatother\expandafter\xyreuncatcodes\next\fi}%
+ \pr@advise@ship\(\pr@endaftergroup{}% \)
+ \pr@advise@ship#1{\@firstoftwo{\let#1=#2%
+ \futurelet\reserved@a\pr@textmathcheck}}{}}%
+ \def\pr@textmathcheck{\expandafter\pr@endaftergroup
+ \ifx\reserved@a#1{#2#2}\expandafter\@gobbletwo\fi#2}}
+\lccode`\~=`\$
+\lowercase{\expandafter\next\expandafter~}%
+ \csname pr@\string$%$
+ \endcsname
+\DeclareOption{graphics}{%
+ \PreviewMacro[*[[!]{\includegraphics}%]]
+}
+\def\pr@floatfix#1#2{\ifx#1#2%
+ \ifx#1\@undefined\else
+ \PackageWarningNoLine{preview}{%
+Your document class has a bad definition^^J
+of \string#1, most likely^^J
+\string\let\string#1=\string#2^^J
+which has now been changed to^^J
+\string\def\string#1{\string#2}^^J
+because otherwise subsequent changes to \string#2^^J
+(like done by several packages changing float behaviour)^^J
+can't take effect on \string#1.^^J
+Please complain to your document class author}%
+ \def#1{#2}\fi\fi}
+\begingroup
+\def\next#1#2{\endgroup
+ \DeclareOption{floats}{%
+ \pr@floatfix\endfigure\end@float
+ \pr@floatfix\endtable\end@float
+ \pr@floatfix#1\end@dblfloat
+ \pr@floatfix#2\end@dblfloat
+ \PreviewSnarfEnvironment[![]{@float}%]
+ \PreviewSnarfEnvironment[![]{@dblfloat}%]
+ }}
+\expandafter\next\csname endfigure*\expandafter\endcsname
+ \csname endtable*\endcsname
+\DeclareOption{sections}{%
+ \PreviewMacro[!!!!!!*[[!]{\@startsection}%]]
+ \PreviewMacro[*[[!]{\chapter}%]]
+}
+\DeclareOption*
+ {\InputIfFileExists{pr\CurrentOption.def}{}{\OptionNotUsed}}
+\def\PreviewMacro{\@ifstar\pr@starmacro\pr@macro}
+\long\def\pr@domacro#1#2{%
+ \long\def\next##1{#2}%
+ \pr@callafter\next#1]\pr@endparse}
+\newcommand\pr@macro[1][]{%
+ \toks@{\pr@domacro{#1}}%
+ \long\edef\next[##1]##2{%
+ \noexpand\pr@advise@ship{##2}{\the\toks@{##1\noexpand\pr@endbox}}{}}%
+ \@ifnextchar[\next\pr@macroii}
+\def\pr@macroii{\next[##1]}
+\long\def\pr@endmacro#1{#1\pr@endbox}
+\long\def\pr@protect@domacro#1#2{\pr@protect{%
+ \long\def\next##1{#2}%
+ \pr@callafter\next#1]\pr@endparse}}
+\newcommand\pr@starmacro[1][]{\toks@{\pr@protect@domacro{#1}}%
+ \long\edef\next[##1]##2{%
+ \noexpand\pr@advise##2{\the\toks@{##1}}}%
+ \@ifnextchar[\next{\next[]}}
+\def\PreviewOpen{\@ifstar\pr@starmacro\pr@open}
+\newcommand\pr@open[1][]{%
+ \toks@{\pr@domacro{#1}}%
+ \long\edef\next[##1]##2{%
+ \noexpand\pr@advise##2{\begingroup
+ \noexpand\pr@protect@ship
+ {\the\toks@{\begingroup\aftergroup\noexpand\pr@endbox##1}}%
+ {\endgroup}}}%
+ \@ifnextchar[\next\pr@macroii}
+\def\PreviewClose{\@ifstar\pr@starmacro\pr@close}
+\newcommand\pr@close[1][]{%
+ \toks@{\pr@domacro{#1}}%
+ \long\edef\next[##1]##2{%
+ \noexpand\pr@advise{##2}{\the\toks@{##1\endgroup}}}%
+ \@ifnextchar[\next\pr@macroii}
+\def\PreviewEnvironment{\@ifstar\pr@starenv\pr@env}
+\newcommand\pr@starenv[1][]{\toks@{\pr@starmacro[{#1}]}%
+ \long\edef\next##1##2{%
+ \the\toks@[{##2}]##1}%
+ \begingroup\pr@starenvii}
+\newcommand\pr@starenvii[2][]{\endgroup
+ \expandafter\next\csname#2\endcsname{#1}%
+ \expandafter\pr@starmacro\csname end#2\endcsname}
+\newcommand\pr@env[1][]{%
+ \toks@{\pr@domacro{#1}}%
+ \long\edef\next[##1]##2{%
+ \noexpand\expandafter\noexpand\pr@advise@ship
+ \noexpand\csname##2\noexpand\endcsname{\the\toks@
+ {\begingroup\aftergroup\noexpand\pr@endbox##1}}{\endgroup}}%
+ \@ifnextchar[\next\pr@macroii %]
+ }
+\newcommand{\PreviewSnarfEnvironment}[2][]{%
+ \expandafter\pr@advise
+ \csname #2\endcsname{\pr@snarfafter{#1}}%
+ \expandafter\pr@advise
+ \csname end#2\endcsname{\pr@endsnarf}}
+\let\pr@ship@start\@empty
+\let\pr@ship@end\@empty
+\newenvironment{preview}{\ignorespaces}{\ifhmode\unskip\fi}
+\newenvironment{nopreview}{\ignorespaces}{\ifhmode\unskip\fi}
+\ProcessOptions\relax
+\ifPreview\else\expandafter\endinput\fi
+%% The preview style for extracting previews from LaTeX documents.
+%% Developed as part of AUCTeX <URL:http://www.gnu.org/software/auctex>.
+\newif\ifpr@outer
+\pr@outertrue
+\newcount\pr@snippet
+\global\pr@snippet=1
+\def\pr@protect{\ifx\protect\@typeset@protect
+ \ifpr@outer \expandafter\expandafter\expandafter
+ \@secondoftwo\fi\fi\@gobble}
+\def\pr@protect@ship{\pr@protect{\@firstoftwo\pr@startbox}%
+ \@gobbletwo}
+\def\pr@insert{\begingroup\afterassignment\pr@insertii\count@}
+\def\pr@insertii{\endgroup\setbox\pr@box\vbox}
+\def\pr@mark{{\afterassignment}\toks@}
+\def\pr@marks{{\aftergroup\pr@mark\afterassignment}\count@}
+\newbox\pr@box
+\long\def\pr@startbox#1#2{%
+ \ifpr@outer
+ \toks@{#2}%
+ \edef\pr@cleanup{\the\toks@}%
+ \setbox\pr@box\vbox\bgroup
+ \break
+ \pr@outerfalse\@arrayparboxrestore
+ \let\insert\pr@insert
+ \let\mark\pr@mark
+ \let\marks\pr@marks
+ \expandafter\expandafter\expandafter
+ \pr@ship@start
+ \expandafter\@firstofone
+ \else
+ \expandafter \@gobble
+ \fi{#1}}
+\def\pr@endbox{%
+ \let\reserved@a\relax
+ \ifvmode \edef\reserved@a{\the\everypar}%
+ \ifx\reserved@a\@empty\else
+ \dimen@\prevdepth
+ \noindent\par
+ \setbox\z@\lastbox\unskip\unpenalty
+ \prevdepth\dimen@
+ \setbox\z@\hbox\bgroup\penalty-\maxdimen\unhbox\z@
+ \ifnum\lastpenalty=-\maxdimen\egroup
+ \else\egroup\box\z@ \fi\fi\fi
+ \ifhmode \par\unskip\setbox\z@\lastbox
+ \nointerlineskip\hbox{\unhbox\z@\/}%
+ \else \unskip\unpenalty\unskip \fi
+ \egroup
+ \setbox\pr@box\vbox{%
+ \baselineskip\z@skip \lineskip\z@skip \lineskiplimit\z@
+ \@begindvi
+ \nointerlineskip
+ \splittopskip\z@skip\setbox\z@\vsplit\pr@box to\z@
+ \unvbox\z@
+ \nointerlineskip
+ %\color@setgroup
+ \box\pr@box
+ %\color@endgroup
+ }%
+ \pr@ship@end
+ {\let\protect\noexpand
+ \ifx\pr@offset@override\@undefined
+ \voffset=-\ht\pr@box
+ \hoffset=\z@
+ \fi
+ \c@page=\pr@snippet
+ \pr@shipout
+ \ifpr@fixbb\hbox{%
+ \dimen@\wd\pr@box
+ \@tempdima\ht\pr@box
+ \@tempdimb\dp\pr@box
+ \box\pr@box
+ \llap{\raise\@tempdima\copy\pr@markerbox\kern\dimen@}%
+ \lower\@tempdimb\copy\pr@markerbox}%
+ \else \box\pr@box \fi}%
+ \global\advance\pr@snippet\@ne
+ \pr@cleanup
+}
+\let\pr@shipout=\shipout
+\def\shipout{\deadcycles\z@\bgroup\setbox\z@\box\voidb@x
+ \afterassignment\pr@shipoutegroup\setbox\z@}
+\def\pr@shipoutegroup{\ifvoid\z@ \expandafter\aftergroup\fi \egroup}
+\def\pr@parseit#1{\csname pr@parse#1\endcsname}
+\let\pr@endparse=\@percentchar
+\def\next#1{%
+\def\pr@callafter{%
+ \afterassignment\pr@parseit
+ \let#1= }}
+\expandafter\next\csname pr@parse\pr@endparse\endcsname
+\long\expandafter\def\csname pr@parse*\endcsname#1\pr@endparse#2{%
+ \begingroup\toks@{#1\pr@endparse{#2}}%
+ \edef\next##1{\endgroup##1\the\toks@}%
+ \@ifstar{\next{\pr@parse@*}}{\next\pr@parseit}}
+\long\expandafter\def\csname pr@parse[\endcsname#1\pr@endparse#2{%
+ \begingroup\toks@{#1\pr@endparse{#2}}%
+ \edef\next##1{\endgroup##1\the\toks@}%
+ \@ifnextchar[{\next\pr@bracket}{\next\pr@parseit}}
+\long\def\pr@bracket#1\pr@endparse#2[#3]{%
+ \pr@parseit#1\pr@endparse{#2[{#3}]}}
+\expandafter\let\csname pr@parse]\endcsname=\pr@parseit
+\long\def\pr@parse#1\pr@endparse#2#3{%
+ \pr@parseit#1\pr@endparse{#2{#3}}}
+\expandafter\let\csname pr@parse!\endcsname=\pr@parse
+\long\expandafter\def\csname pr@parse?\endcsname#1#2\pr@endparse#3{%
+ \begingroup\toks@{#2\pr@endparse{#3}}%
+ \@ifnextchar#1{\pr@parsecond\@firstoftwo}%
+ {\pr@parsecond\@secondoftwo}}
+\def\pr@parsecond#1{\expandafter\endgroup
+ \expandafter\expandafter\expandafter\pr@parseit
+ \expandafter#1\the\toks@}
+ \long\def\pr@parse@#1#2\pr@endparse#3{%
+ \pr@parseit #2\pr@endparse{#3#1}}
+\long\expandafter\def\csname pr@parse-\endcsname
+ #1\pr@endparse#2{\begingroup
+ \toks@{\endgroup\pr@parseit #1\pr@endparse{#2}}%
+ {\aftergroup\the\aftergroup\toks@ \afterassignment}%
+ \let\next= }
+\long\expandafter\def\csname pr@parse:\endcsname
+ #1#2#3\pr@endparse#4{\begingroup
+ \toks@{\endgroup \pr@parseit#3\pr@endparse{#4}}%
+ \long\def\next#1{#2}%
+ \the\expandafter\toks@\next}
+\long\expandafter\def\csname pr@parse#\endcsname
+ #1#2#3\pr@endparse#4{\begingroup
+ \toks@{#4}%
+ \long\edef\next##1{\toks@{\the\toks@##1}}%
+ \toks@{\endgroup \pr@parseit#3\pr@endparse}%
+ \long\def\reserved@a#1{{#2}}%
+ \the\expandafter\next\reserved@a}
+\def\pr@endaftergroup#1{#1\aftergroup\pr@endbox}
+\let\pr@endsnarf\relax
+\long\def\pr@snarfafter#1{\ifpr@outer
+ \pr@ship@start
+ \let\pr@ship@start\relax
+ \let\pr@endsnarf\endgroup
+ \else
+ \let\pr@endsnarf\relax
+ \fi
+ \pr@protect{\pr@callafter\pr@startsnarf#1]\pr@endparse}}
+\def\pr@startsnarf#1{#1\begingroup
+ \pr@startbox{\begingroup\aftergroup\pr@endbox}{\endgroup}%
+ \ignorespaces}
+\renewenvironment{preview}{\begingroup
+ \pr@startbox{\begingroup\aftergroup\pr@endbox}%
+ {\endgroup}%
+ \ignorespaces}%
+ {\ifhmode\unskip\fi\endgroup}
+\renewenvironment{nopreview}{\pr@outerfalse\ignorespaces}%
+ {\ifhmode\unskip\fi}
+\newtoks\pr@output
+\pr@output\output
+\output{%
+ \pr@outerfalse
+ \let\@begindvi\@empty
+ \the\pr@output}
+\let\output\pr@output
+\def\pr@typeinfos{\typeout{Preview: Fontsize \f@size pt}%
+ \ifnum\mag=\@m\else\typeout{Preview: Magnification \number\mag}\fi
+ \ifx\pdfoutput\@undefined
+ \ifx\XeTeXversion\@undefined \else
+ % FIXME: The message should not be emitted if XeTeX does not produce
+ % PDF. There does not seem to be a primitive for that, though.
+ \typeout{Preview: PDFoutput 1}%
+ \fi
+ \else
+ \ifx\pdfoutput\relax \else
+ \ifnum\pdfoutput>\z@
+ \typeout{Preview: PDFoutput 1}%
+ \fi
+ \fi
+ \fi
+}
+\AtBeginDocument{\pr@typeinfos}
+\pr@loadcfg{prdefault}
+\endinput
+%%
+%% End of file `preview.sty'.
diff --git a/tests/auctex-11.87.7/latex/prfootnotes.def
b/tests/auctex-11.87.7/latex/prfootnotes.def
new file mode 100644
index 0000000..2d525a8
--- /dev/null
+++ b/tests/auctex-11.87.7/latex/prfootnotes.def
@@ -0,0 +1,28 @@
+%%
+%% This is file `prfootnotes.def',
+%% generated with the docstrip utility.
+%%
+%% The original source files were:
+%%
+%% preview.dtx (with options: `footnotes')
+%%
+%% IMPORTANT NOTICE:
+%%
+%% For the copyright see the source file.
+%%
+%% Any modified versions of this file must be renamed
+%% with new filenames distinct from prfootnotes.def.
+%%
+%% For distribution of the original source see the terms
+%% for copying and modification in the file preview.dtx.
+%%
+%% This generated file may be distributed as long as the
+%% original source files, as listed above, are part of the
+%% same distribution. (The sources need not necessarily be
+%% in the same archive or directory.)
+%% The preview style for extracting previews from LaTeX documents.
+%% Developed as part of AUCTeX <URL:http://www.gnu.org/software/auctex>.
+\PreviewMacro[[!]\footnote %]
+\endinput
+%%
+%% End of file `prfootnotes.def'.
diff --git a/tests/auctex-11.87.7/latex/prlyx.def
b/tests/auctex-11.87.7/latex/prlyx.def
new file mode 100644
index 0000000..fd1dab7
--- /dev/null
+++ b/tests/auctex-11.87.7/latex/prlyx.def
@@ -0,0 +1,32 @@
+%%
+%% This is file `prlyx.def',
+%% generated with the docstrip utility.
+%%
+%% The original source files were:
+%%
+%% preview.dtx (with options: `lyx')
+%%
+%% IMPORTANT NOTICE:
+%%
+%% For the copyright see the source file.
+%%
+%% Any modified versions of this file must be renamed
+%% with new filenames distinct from prlyx.def.
+%%
+%% For distribution of the original source see the terms
+%% for copying and modification in the file preview.dtx.
+%%
+%% This generated file may be distributed as long as the
+%% original source files, as listed above, are part of the
+%% same distribution. (The sources need not necessarily be
+%% in the same archive or directory.)
+%% The preview style for extracting previews from LaTeX documents.
+%% Developed as part of AUCTeX <URL:http://www.gnu.org/software/auctex>.
+\ifPreview\else\expandafter\endinput\fi
+\pr@loadcfg{prlyx}
+\g@addto@macro\pr@ship@end{\typeout{Preview:
+ Snippet \number\pr@snippet\space
+ \number\ht\pr@box\space \number\dp\pr@box \space\number\wd\pr@box}}
+\endinput
+%%
+%% End of file `prlyx.def'.
diff --git a/tests/auctex-11.87.7/latex/prshowbox.def
b/tests/auctex-11.87.7/latex/prshowbox.def
new file mode 100644
index 0000000..3280b29
--- /dev/null
+++ b/tests/auctex-11.87.7/latex/prshowbox.def
@@ -0,0 +1,32 @@
+%%
+%% This is file `prshowbox.def',
+%% generated with the docstrip utility.
+%%
+%% The original source files were:
+%%
+%% preview.dtx (with options: `showbox')
+%%
+%% IMPORTANT NOTICE:
+%%
+%% For the copyright see the source file.
+%%
+%% Any modified versions of this file must be renamed
+%% with new filenames distinct from prshowbox.def.
+%%
+%% For distribution of the original source see the terms
+%% for copying and modification in the file preview.dtx.
+%%
+%% This generated file may be distributed as long as the
+%% original source files, as listed above, are part of the
+%% same distribution. (The sources need not necessarily be
+%% in the same archive or directory.)
+%% The preview style for extracting previews from LaTeX documents.
+%% Developed as part of AUCTeX <URL:http://www.gnu.org/software/auctex>.
+\ifPreview\else\expandafter\endinput\fi
+\AtEndOfPackage{%
+ \showboxbreadth\maxdimen
+ \showboxdepth\maxdimen}
+\g@addto@macro\pr@ship@end{\showbox\pr@box}
+\endinput
+%%
+%% End of file `prshowbox.def'.
diff --git a/tests/auctex-11.87.7/latex/prshowlabels.def
b/tests/auctex-11.87.7/latex/prshowlabels.def
new file mode 100644
index 0000000..d0d6108
--- /dev/null
+++ b/tests/auctex-11.87.7/latex/prshowlabels.def
@@ -0,0 +1,67 @@
+%%
+%% This is file `prshowlabels.def',
+%% generated with the docstrip utility.
+%%
+%% The original source files were:
+%%
+%% preview.dtx (with options: `showlabels')
+%%
+%% IMPORTANT NOTICE:
+%%
+%% For the copyright see the source file.
+%%
+%% Any modified versions of this file must be renamed
+%% with new filenames distinct from prshowlabels.def.
+%%
+%% For distribution of the original source see the terms
+%% for copying and modification in the file preview.dtx.
+%%
+%% This generated file may be distributed as long as the
+%% original source files, as listed above, are part of the
+%% same distribution. (The sources need not necessarily be
+%% in the same archive or directory.)
+%% The preview style for extracting previews from LaTeX documents.
+%% Developed as part of AUCTeX <URL:http://www.gnu.org/software/auctex>.
+\ifPreview\else\expandafter\endinput\fi
+\newbox\pr@labelbox
+\def\pr@label#1{\pr@@label{#1}%
+ \ifpr@setbox\z@{#1}%
+ \global\setbox\pr@labelbox\vbox{\unvbox\pr@labelbox
+ \box\z@}\egroup\fi}
+\def\ifpr@setbox#1#2{%
+ \romannumeral%
+ \ifx\protect\@typeset@protect\ifpr@outer\else
+ \z@\bgroup
+ \protected@edef\next{#2}\@onelevel@sanitize\next
+ \ifx\next\@empty\egroup\romannumeral\else
+ \ifx\next\pr@lastlabel\egroup\romannumeral\else
+ \global\let\pr@lastlabel\next
+ \setbox#1\pr@boxlabel\pr@lastlabel
+ \expandafter\expandafter\romannumeral\fi\fi\fi\fi
+ \z@\iffalse\iftrue\fi}
+\def\pr@boxlabel#1{\hbox{\normalfont
+ \footnotesize\ttfamily\fboxsep0.4ex\relax\fbox{#1}}}
+\def\pr@maketag#1{\pr@@maketag{#1}%
+ \ifpr@setbox\z@{\df@label}%
+ \global\setbox\pr@labelbox\vbox{%
+ \hrule\@width\wd\z@\@height\z@
+ \unvbox\pr@labelbox}%
+ \wd\z@\z@\box\z@ \egroup\fi}
+\g@addto@macro\pr@ship@start{%
+ \global\setbox\pr@labelbox\box\voidb@x
+ \xdef\pr@lastlabel{}%
+ \global\let\pr@@label\label \let\label\pr@label
+ \global\let\pr@@maketag\maketag@@@
+ \let\maketag@@@\pr@maketag
+}
+\pr@addto@front\pr@ship@end{%
+ \ifx \label\pr@label \global\let\label\pr@@label \fi
+ \ifx \maketag@@@\pr@maketag
+ \global\let\maketag@@@\pr@@maketag \fi
+ \ifvoid\pr@labelbox
+ \else \setbox\pr@box\hbox{%
+ \box\pr@box\,\box\pr@labelbox}%
+ \fi}
+\endinput
+%%
+%% End of file `prshowlabels.def'.
diff --git a/tests/auctex-11.87.7/latex/prtightpage.def
b/tests/auctex-11.87.7/latex/prtightpage.def
new file mode 100644
index 0000000..31516be
--- /dev/null
+++ b/tests/auctex-11.87.7/latex/prtightpage.def
@@ -0,0 +1,146 @@
+%%
+%% This is file `prtightpage.def',
+%% generated with the docstrip utility.
+%%
+%% The original source files were:
+%%
+%% preview.dtx (with options: `tightpage')
+%%
+%% IMPORTANT NOTICE:
+%%
+%% For the copyright see the source file.
+%%
+%% Any modified versions of this file must be renamed
+%% with new filenames distinct from prtightpage.def.
+%%
+%% For distribution of the original source see the terms
+%% for copying and modification in the file preview.dtx.
+%%
+%% This generated file may be distributed as long as the
+%% original source files, as listed above, are part of the
+%% same distribution. (The sources need not necessarily be
+%% in the same archive or directory.)
+%% The preview style for extracting previews from LaTeX documents.
+%% Developed as part of AUCTeX <URL:http://www.gnu.org/software/auctex>.
+\ifx\PreviewBorder\@undefined
+ \newdimen\PreviewBorder
+ \PreviewBorder=0.50001bp
+\fi
+\ifx\PreviewBbAdjust\@undefined
+ \def\PreviewBbAdjust{-\PreviewBorder -\PreviewBorder
+ \PreviewBorder \PreviewBorder}
+\fi
+\ifPreview\else\expandafter\endinput\fi
+\def\pr@nextbb{\edef\next{\next\space\number\dimen@}%
+ \expandafter\xdef\csname pr@bb@%
+ \romannumeral\count@\endcsname{\the\dimen@}%
+ \advance\count@\@ne\ifnum\count@<5
+ \afterassignment\pr@nextbb\dimen@=\fi}
+\ifnum\pr@graphicstype=\z@
+ \ifcase
+ \ifx\XeTeXversion\@undefined
+ \ifx\pdfoutput\@undefined \@ne\fi
+ \ifx\pdfoutput\relax \@ne\fi
+ \ifnum\pdfoutput>\z@ \tw@\fi \@ne
+ \else \thr@@\fi
+ \or \ExecuteOptions{dvips}\relax
+ \or \ExecuteOptions{pdftex}\relax
+ \or \ExecuteOptions{xetex}\relax\fi\fi
+\global\let\pr@bbadjust\@empty
+\pr@addto@front\pr@ship@end{\begingroup
+ \let\next\@gobble
+ \count@\@ne\afterassignment\pr@nextbb
+ \dimen@\PreviewBbAdjust
+ \ifx\pr@bbadjust\next
+ \else \global\let\pr@bbadjust\next
+ \typeout{Preview: Tightpage \pr@bbadjust}%
+ \fi\endgroup}
+\ifcase\pr@graphicstype
+\or
+ \g@addto@macro\pr@ship@end{\setbox\pr@box\hbox{%
+ \special{ps::\pr@bbadjust\space
+ \number\ifdim\ht\pr@box>\z@ \ht\pr@box
+ \else \z@
+ \fi \space
+ \number\ifdim\dp\pr@box>\z@ \dp\pr@box
+ \else \z@
+ \fi \space
+ \number\ifdim\wd\pr@box>\z@ \wd\pr@box
+ \else \z@
+ \fi}\box\pr@box}}
+\or
+ \g@addto@macro\pr@ship@end{{\dimen@\ht\pr@box
+ \ifdim\dimen@<\z@ \dimen@\z@\fi
+ \advance\dimen@\pr@bb@iv
+ \dimen@ii=\dimen@
+ \global\pdfvorigin\dimen@
+ \dimen@\dp\pr@box
+ \ifdim\dimen@<\z@ \dimen@\z@\fi
+ \advance\dimen@-\pr@bb@ii
+ \advance\dimen@\dimen@ii
+ \global\pdfpageheight\dimen@
+ \dimen@\wd\pr@box
+ \ifdim\dimen@<\z@ \dimen@=\z@\fi
+ \advance\dimen@-\pr@bb@i
+ \advance\dimen@\pr@bb@iii
+ \global\pdfpagewidth\dimen@
+ \global\pdfhorigin-\pr@bb@i}}
+\or
+ \g@addto@macro\pr@ship@end{\dimen@\ht\pr@box
+ \ifdim\dimen@<\z@ \dimen@\z@\fi
+ \advance\dimen@\pr@bb@iv
+ \dimen@ii=\dimen@
+ \voffset=-1in
+ \advance\voffset\dimen@
+ \advance\voffset-\ht\pr@box
+ \dimen@\dp\pr@box
+ \ifdim\dimen@<\z@ \dimen@\z@\fi
+ \advance\dimen@-\pr@bb@ii
+ \advance\dimen@\dimen@ii
+ \global\pdfpageheight\dimen@
+ \global\paperheight\dimen@
+ \dimen@\wd\pr@box
+ \ifdim\dimen@<\z@ \dimen@=\z@\fi
+ \advance\dimen@-\pr@bb@i
+ \advance\dimen@\pr@bb@iii
+ \global\pdfpagewidth\dimen@
+ \hoffset=-1in
+ \advance\hoffset-\pr@bb@i
+ \let\pr@offset@override\@empty}
+\fi
+\ifnum\pr@graphicstype=\@ne
+\preview@delay{\AtBeginDvi{%
+ \special{!/preview@tightpage true def (%
+ compatibility PostScript comment for dvipng<=1.5 }
+ \special{!userdict begin/bop-hook{%
+ 7{currentfile token not{stop}if
+ 65781.76 div DVImag mul}repeat
+ 72 add 72 2 copy gt{exch}if 4 2 roll
+ neg 2 copy lt{exch}if dup 0 gt{pop 0 exch}%
+ {exch dup 0 lt{pop 0}if}ifelse 720 add exch 720 add
+ 3 1 roll
+ 4{5 -1 roll add 4 1 roll}repeat
+ <</PageSize[5 -1 roll 6 index sub 5 -1 roll 5 index sub]%
+ /PageOffset[7 -2 roll [1 1 dtransform exch]%
+ {0 ge{neg}if exch}forall]>>setpagedevice%
+ //bop-hook exec}bind def end}
+ \special{!userdict (some extra code to avoid
+ dvipng>=1.6 unknown special:
+ 7{currentfile token not{stop}if 65781.76 div })) pop}
+ \special{!userdict begin/bop-hook{%
+ preview-bop-level 0 le{%
+ 7{currentfile token not{stop}if
+ 65781.76 div DVImag mul}repeat
+ 72 add 72 2 copy gt{exch}if 4 2 roll
+ neg 2 copy lt{exch}if dup 0 gt{pop 0 exch}%
+ {exch dup 0 lt{pop 0}if}ifelse 720 add exch 720 add
+ 3 1 roll
+ 4{5 -1 roll add 4 1 roll}repeat
+ <</PageSize[5 -1 roll 6 index sub 5 -1 roll 5 index sub]%
+ /PageOffset[7 -2 roll [1 1 dtransform exch]%
+ {0 ge{neg}if exch}forall]>>setpagedevice}if%
+ //bop-hook exec}bind def end}}}
+\fi
+\endinput
+%%
+%% End of file `prtightpage.def'.
diff --git a/tests/auctex-11.87.7/latex/prtracingall.def
b/tests/auctex-11.87.7/latex/prtracingall.def
new file mode 100644
index 0000000..7dfc7e3
--- /dev/null
+++ b/tests/auctex-11.87.7/latex/prtracingall.def
@@ -0,0 +1,30 @@
+%%
+%% This is file `prtracingall.def',
+%% generated with the docstrip utility.
+%%
+%% The original source files were:
+%%
+%% preview.dtx (with options: `tracingall')
+%%
+%% IMPORTANT NOTICE:
+%%
+%% For the copyright see the source file.
+%%
+%% Any modified versions of this file must be renamed
+%% with new filenames distinct from prtracingall.def.
+%%
+%% For distribution of the original source see the terms
+%% for copying and modification in the file preview.dtx.
+%%
+%% This generated file may be distributed as long as the
+%% original source files, as listed above, are part of the
+%% same distribution. (The sources need not necessarily be
+%% in the same archive or directory.)
+%% The preview style for extracting previews from LaTeX documents.
+%% Developed as part of AUCTeX <URL:http://www.gnu.org/software/auctex>.
+\ifPreview\else\expandafter\endinput\fi
+\pr@addto@front\pr@ship@start{\let\tracingonline\count@
+ \let\errorstopmode\@empty\tracingall}
+\endinput
+%%
+%% End of file `prtracingall.def'.
diff --git a/tests/auctex-11.87.7/multi-prompt.el
b/tests/auctex-11.87.7/multi-prompt.el
new file mode 100644
index 0000000..159380f
--- /dev/null
+++ b/tests/auctex-11.87.7/multi-prompt.el
@@ -0,0 +1,226 @@
+;;; multi-prompt.el --- Completing read of multiple strings
+
+;; Copyright (C) 1996, 1997, 2000, 2009 Free Software Foundation
+
+;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
+;; Maintainer: auctex-devel@gnu.org
+;; Created: 1996-08-31
+;; Keywords: extensions
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, 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., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; Commentary:
+
+;; This package is written for use in emacs lisp programs, where the
+;; user is prompted for a string of the form:
+;;
+;; FOO,BAR,BAZ
+;;
+;; where FOO, BAR, and BAZ are elements of some table. The function
+;; `multi-prompt' is a replacement `completing-read' that will allow
+;; the user to enter a string like the above, yet get completion on
+;; all FOO, BAR, and BAZ.
+
+;;; Code:
+
+(defvar multi-prompt-found nil
+ "List of entries currently added during a `multi-prompt'.")
+
+;;;###autoload
+(defun multi-prompt (separator
+ unique prompt table
+ &optional mp-predicate require-match initial history)
+ "Completing prompt for a list of strings.
+The first argument SEPARATOR should be the string (of length 1) to
+separate the elements in the list. The second argument UNIQUE should
+be non-nil, if each element must be unique. The remaining elements
+are the arguments to `completing-read'. See that."
+ (let ((old-map (if require-match
+ minibuffer-local-must-match-map
+ minibuffer-local-completion-map))
+ (new-map (make-sparse-keymap)))
+ (if (fboundp 'set-keymap-parent)
+ ;; `set-keymap-parent' was introduced in Emacs 19.32.
+ (set-keymap-parent new-map old-map)
+ (setq new-map (copy-keymap old-map)))
+ (define-key new-map separator (if require-match
+ 'multi-prompt-next-must-match
+ 'multi-prompt-next))
+ (define-key new-map "\C-?" 'multi-prompt-delete)
+ (let* ((minibuffer-local-completion-map new-map)
+ (minibuffer-local-must-match-map new-map)
+ (multi-prompt-found nil)
+ (done nil)
+ (filter (cond (unique
+ (lambda (x)
+ (and (not (member (car x) multi-prompt-found))
+ (or (null mp-predicate)
+ (funcall mp-predicate x)))))
+ (mp-predicate)))
+ (answer (catch 'multi-prompt-exit
+ (while t
+ (let ((extra (catch 'multi-prompt-next
+ (throw 'multi-prompt-exit
+ (completing-read prompt
+ table
+ filter
+ require-match
+ initial
+ history)))))
+ (cond ((eq extra 'back)
+ (when multi-prompt-found
+ (setq prompt (substring
+ prompt 0
+ (- 0 (length separator)
+ (length
+ (car multi-prompt-found))))
+ initial (car multi-prompt-found))
+ (setq multi-prompt-found
+ (cdr multi-prompt-found))))
+ (t
+ (setq prompt (concat prompt extra separator)
+ initial nil)
+ (setq multi-prompt-found
+ (cons extra multi-prompt-found)))))))))
+ (if answer
+ (nreverse (cons answer multi-prompt-found))
+ multi-prompt-found))))
+
+(defun multi-prompt-delete ()
+ (interactive)
+ (if (bobp)
+ (throw 'multi-prompt-next 'back)
+ (call-interactively 'backward-delete-char)))
+
+(defun multi-prompt-next ()
+ (interactive)
+ (throw 'multi-prompt-next
+ (cond
+ ((fboundp 'minibuffer-contents-no-properties)
+ ;; buffer-substring no longer works in emacs-21, it returns
+ ;; the whole prompt line. Use this instead.
+ (minibuffer-contents-no-properties))
+ (t
+ (buffer-substring-no-properties (point-min) (point-max))))))
+
+(defun multi-prompt-next-must-match ()
+ (interactive)
+ (when (call-interactively 'minibuffer-complete)
+ (let ((content (buffer-substring-no-properties (point-min) (point-max))))
+ (when (or (not require-match)
+ (assoc content table))
+ (throw 'multi-prompt-next content)))))
+
+
+;;; Support for key=value completion
+
+;; The following code was ripped out of crm.el
+;; (completing-read-multiple) and extended to support comma-separated
+;; key=value lists. The code is separate from the code above.
+
+;; WARNING: This obviously relies on internals of crm.el and
+;; minibuffer.el and will therefore have to be adapted if these
+;; change.
+
+;; TODO: How to support stuff like "caption={[one]two}" or
+;; "morekeywords={one,three,five}"?
+
+(defvar multi-prompt-key-value-sep "="
+ "Single-character string separating key=value pairs.")
+(defvar multi-prompt-completion-table nil
+ "Completion table used by `multi-prompt-key-value'.")
+
+(defun multi-prompt-key-value-collection-fn (string predicate flag)
+ "Function used by `multi-prompt-key-value' to compute completion values.
+The value of STRING is the string to be completed.
+
+The value of PREDICATE is a function to filter possible matches, or
+nil if none.
+
+The value of FLAG is used to specify the type of completion operation.
+A value of nil specifies `try-completion'. A value of t specifies
+`all-completions'. A value of lambda specifes a test for an exact match.
+
+For more information on STRING, PREDICATE, and FLAG, see the Elisp
+Reference sections on 'Programmed Completion' and 'Basic Completion
+Functions'."
+ (let ((beg 0) (last 0) matched)
+ (while (string-match multi-prompt-key-value-sep string beg)
+ (setq matched t
+ last beg
+ beg (match-end 0)))
+ (completion-table-with-context
+ (substring string 0 beg)
+ (if (not matched)
+ multi-prompt-completion-table
+ (cadr (assoc (substring string last (1- beg))
+ multi-prompt-completion-table)))
+ (substring string beg)
+ predicate
+ flag)))
+
+(defun multi-prompt-expand-completion-table (table)
+ "Return an expanded version of completion table TABLE.
+This is achieved by eval'ing all variables in the value parts of
+the alist elements."
+ (mapcar (lambda (x)
+ (if (and (cadr x) (symbolp (cadr x)) (not (functionp (cadr x))))
+ (cons (car x) (list (eval (cadr x))))
+ x))
+ table))
+
+;; Silence the byte compiler.
+(defvar crm-local-must-match-map)
+(defvar crm-local-completion-map)
+
+;;;###autoload
+(defun multi-prompt-key-value
+ (prompt table &optional predicate require-match initial-input
+ hist def inherit-input-method)
+ "Read multiple strings, with completion and key=value support.
+PROMPT is a string to prompt with, usually ending with a colon
+and a space. TABLE is an alist. The car of each element should
+be a string representing a key and the optional cdr should be a
+list with strings to be used as values for the key.
+
+See the documentation for `completing-read' for details on the
+other arguments: PREDICATE, REQUIRE-MATCH, INITIAL-INPUT, HIST,
+DEF, and INHERIT-INPUT-METHOD.
+
+The return value is the string as entered in the minibuffer."
+ (require 'crm)
+ (let* ((minibuffer-completion-table #'multi-prompt-key-value-collection-fn)
+ (minibuffer-completion-predicate predicate)
+ (minibuffer-completion-confirm
+ (unless (eq require-match t) require-match))
+ (multi-prompt-completion-table
+ ;; Expand the table here because completion would otherwise
+ ;; interpret symbols in the table as functions. However, it
+ ;; would be nicer if this could be done during the actual
+ ;; completion in order to avoid walking through the whole
+ ;; table.
+ (multi-prompt-expand-completion-table table))
+ (map (if require-match
+ crm-local-must-match-map
+ crm-local-completion-map))
+ (input (read-from-minibuffer
+ prompt initial-input map
+ nil hist def inherit-input-method)))
+ (and def (string-equal input "") (setq input def))
+ input))
+
+(provide 'multi-prompt)
+
+;;; multi-prompt.el ends here
diff --git a/tests/auctex-11.87.7/plain-tex.el
b/tests/auctex-11.87.7/plain-tex.el
new file mode 100644
index 0000000..476976b
--- /dev/null
+++ b/tests/auctex-11.87.7/plain-tex.el
@@ -0,0 +1,314 @@
+;;; plain-tex.el --- Support for plain TeX documents.
+
+;; Copyright (C) 2010 Free Software Foundation, Inc.
+
+;; Maintainer: auctex-devel@gnu.org
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; This file provides support for plain TeX in AUCTeX.
+
+;;; Code:
+
+(require 'tex)
+(require 'tex-buf)
+
+;;; Tool bar
+
+(defcustom plain-TeX-enable-toolbar t
+ "Enable TeX tool bar in plain TeX mode."
+ :group 'TeX-tool-bar
+ :type 'boolean)
+
+(defun plain-TeX-maybe-install-toolbar ()
+ "Conditionally install tool bar buttons for plain TeX mode.
+Install tool bar if `plain-TeX-enable-toolbar' is non-nil."
+ (when plain-TeX-enable-toolbar
+ ;; Defined in `tex-bar.el':
+ (TeX-install-toolbar)))
+
+
+;;; Keymap and menu
+
+(defvar plain-TeX-mode-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map TeX-mode-map)
+ map)
+ "Keymap used in plain TeX mode.")
+
+(defvar plain-TeX-menu-entries
+ (TeX-menu-with-help
+ `(["Macro..." TeX-insert-macro
+ :help "Insert a macro and possibly arguments"]
+ ["Complete" TeX-complete-symbol
+ :help "Complete the current macro"]
+ "-"
+ ("Insert Font"
+ ["Emphasize" (TeX-font nil ?\C-e) :keys "C-c C-f C-e"]
+ ["Bold" (TeX-font nil ?\C-b) :keys "C-c C-f C-b"]
+ ["Typewriter" (TeX-font nil ?\C-t) :keys "C-c C-f C-t"]
+ ["Small Caps" (TeX-font nil ?\C-c) :keys "C-c C-f C-c"]
+ ["Sans Serif" (TeX-font nil ?\C-f) :keys "C-c C-f C-f"]
+ ["Italic" (TeX-font nil ?\C-i) :keys "C-c C-f C-i"]
+ ["Slanted" (TeX-font nil ?\C-s) :keys "C-c C-f C-s"]
+ ["Roman" (TeX-font nil ?\C-r) :keys "C-c C-f C-r"]
+ ["Calligraphic" (TeX-font nil ?\C-a) :keys "C-c C-f C-a"])
+ ("Replace Font"
+ ["Emphasize" (TeX-font t ?\C-e) :keys "C-u C-c C-f C-e"]
+ ["Bold" (TeX-font t ?\C-b) :keys "C-u C-c C-f C-b"]
+ ["Typewriter" (TeX-font t ?\C-t) :keys "C-u C-c C-f C-t"]
+ ["Small Caps" (TeX-font t ?\C-c) :keys "C-u C-c C-f C-c"]
+ ["Sans Serif" (TeX-font t ?\C-f) :keys "C-u C-c C-f C-f"]
+ ["Italic" (TeX-font t ?\C-i) :keys "C-u C-c C-f C-i"]
+ ["Slanted" (TeX-font t ?\C-s) :keys "C-u C-c C-f C-s"]
+ ["Roman" (TeX-font t ?\C-r) :keys "C-u C-c C-f C-r"]
+ ["Calligraphic" (TeX-font t ?\C-a) :keys "C-u C-c C-f C-a"])
+ ["Delete Font" (TeX-font t ?\C-d) :keys "C-c C-f C-d"]
+ "-"
+ ["Comment or Uncomment Region" TeX-comment-or-uncomment-region
+ :help "Comment or uncomment the currently selected region"]
+ ["Comment or Uncomment Paragraph" TeX-comment-or-uncomment-paragraph
+ :help "Comment or uncomment the paragraph containing point"]
+ ,TeX-fold-menu
+ "-" . ,TeX-common-menu-entries)))
+
+(easy-menu-define plain-TeX-mode-command-menu
+ plain-TeX-mode-map
+ "Command menu used in TeX mode."
+ (TeX-mode-specific-command-menu 'plain-tex-mode))
+
+(easy-menu-define plain-TeX-mode-menu
+ plain-TeX-mode-map
+ "Menu used in plain TeX mode."
+ (cons "TeX" plain-TeX-menu-entries))
+
+
+;;; The mode
+
+(defcustom plain-TeX-mode-hook nil
+ "A hook run in plain TeX mode buffers."
+ :type 'hook
+ :group 'TeX-misc)
+
+(TeX-abbrev-mode-setup plain-tex-mode)
+
+;;;###autoload
+(defun TeX-plain-tex-mode ()
+ "Major mode in AUCTeX for editing plain TeX files.
+See info under AUCTeX for documentation.
+
+Special commands:
+\\{plain-TeX-mode-map}
+
+Entering `plain-tex-mode' calls the value of `text-mode-hook',
+then the value of `TeX-mode-hook', and then the value
+of plain-TeX-mode-hook."
+ (interactive)
+ (plain-TeX-common-initialization)
+ (setq major-mode 'plain-tex-mode)
+ (use-local-map plain-TeX-mode-map)
+ (easy-menu-add plain-TeX-mode-menu plain-TeX-mode-map)
+ (easy-menu-add plain-TeX-mode-command-menu plain-TeX-mode-map)
+ (setq TeX-base-mode-name "TeX")
+ (setq TeX-command-default "TeX")
+ (setq TeX-sentinel-default-function 'TeX-TeX-sentinel)
+ (add-hook 'tool-bar-mode-on-hook 'plain-TeX-maybe-install-toolbar nil t)
+ (when (if (featurep 'xemacs)
+ (featurep 'toolbar)
+ (and (boundp 'tool-bar-mode) tool-bar-mode))
+ (plain-TeX-maybe-install-toolbar))
+ (TeX-run-mode-hooks 'text-mode-hook 'TeX-mode-hook 'plain-TeX-mode-hook)
+ (TeX-set-mode-name))
+
+(defun plain-TeX-common-initialization ()
+ "Common initialization for plain TeX like modes."
+ (VirTeX-common-initialization)
+ (set-syntax-table TeX-mode-syntax-table)
+ (setq local-abbrev-table latex-mode-abbrev-table)
+ (setq paragraph-start
+ (concat
+ "\\(^[ \t]*$"
+ "\\|" (regexp-quote TeX-esc) "par\\|"
+ "^[ \t]*"
+ (regexp-quote TeX-esc)
+ "\\("
+ "begin\\|end\\|part\\|chapter\\|"
+ "section\\|subsection\\|subsubsection\\|"
+ "paragraph\\|include\\|includeonly\\|"
+ "tableofcontents\\|appendix\\|label\\|caption\\|"
+ "\\[\\|\\]" ; display math delimitors
+ "\\)"
+ "\\|"
+ "^[ \t]*\\$\\$" ; display math delimitor
+ "\\)" ))
+ (setq paragraph-separate
+ (concat
+ "[ \t]*"
+ "\\("
+ (regexp-quote TeX-esc) "par\\|"
+ "%\\|"
+ "$\\|"
+ "\\$\\$\\|"
+ (regexp-quote TeX-esc)
+ "\\("
+ "begin\\|end\\|label\\|caption\\|part\\|chapter\\|"
+ "section\\|subsection\\|subsubsection\\|"
+ "paragraph\\|include\\|includeonly\\|"
+ "tableofcontents\\|appendix\\|" (regexp-quote TeX-esc)
+ "\\)"
+ "\\)"))
+ (setq TeX-header-end (regexp-quote "%**end of header"))
+ (setq TeX-trailer-start (regexp-quote (concat TeX-esc "bye")))
+ (TeX-add-symbols
+ ;; From the TeX Book, Appendix B
+ ;;
+ ;; XXX: This should be refined and extended by somebody who is
+ ;; familiar with plain TeX.
+ "dag"
+ "ddag"
+ "copyright"
+ "TeX"
+ "dots"
+ "break"
+ "nobreak"
+ "allowbreak"
+ "hbox"
+ "slash"
+ "enskip"
+ "quad"
+ "qquad"
+ "enspace"
+ "thinspace"
+ "negthinspace"
+ "smallskip"
+ "medskip"
+ "bigskip"
+ "eject"
+ "supereject"
+ "goodbreak"
+ "filbreak"
+ "smallbreak"
+ "medbreak"
+ "bigbreak"
+ "hrulefill"
+ "dotfill"
+ "rightarrowfill"
+ "leftarrowfill"
+ "upbracefill"
+ "downbracefill"
+ "halign"
+ "valign"
+ "omit"
+ "span"
+ "multispan"
+ "centerline"
+ "rightline"
+ "leftline"
+ "line"
+ "par"
+ "noindent"
+ "frenchspacing"
+ "nonfrenchspacing"
+ "llap"
+ "rlap"
+ "raggedright"
+ "ttraggedright"
+ "raggedbottom"
+ "normalbottom"
+ "obeylines"
+ "obeyspaces"
+ "hsize"
+ "vsize"
+ "hoffset"
+ "voffset"
+ "tolerance"
+ "looseness"
+ "parindent"
+ "baselineskip"
+ "parskip")
+ (TeX-run-style-hooks "TEX"))
+
+
+;;; Miscellaneous
+
+(defcustom plain-TeX-clean-intermediate-suffixes
+ TeX-clean-default-intermediate-suffixes
+ "List of regexps matching suffixes of intermediate files to be deleted.
+The regexps will be anchored at the end of the file name to be matched,
+i.e. you do _not_ have to cater for this yourself by adding \\\\' or $."
+ :type '(repeat regexp)
+ :group 'TeX-command)
+
+(defcustom plain-TeX-clean-output-suffixes TeX-clean-default-output-suffixes
+ "List of regexps matching suffixes of output files to be deleted.
+The regexps will be anchored at the end of the file name to be matched,
+i.e. you do _not_ have to cater for this yourself by adding \\\\' or $."
+ :type '(repeat regexp)
+ :group 'TeX-command)
+
+
+;;; AmSTeX
+
+(defvar AmSTeX-mode-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map TeX-mode-map)
+ map)
+ "Keymap used in `AmSTeX-mode'.")
+
+;; Menu for AmSTeX mode
+(easy-menu-define AmSTeX-mode-command-menu
+ AmSTeX-mode-map
+ "Command menu used in AmsTeX mode."
+ (TeX-mode-specific-command-menu 'ams-tex-mode))
+
+(easy-menu-define AmSTeX-mode-menu
+ AmSTeX-mode-map
+ "Menu used in AMS-TeX mode."
+ (cons "AmS-TeX" plain-TeX-menu-entries))
+
+;;;###autoload
+(defun ams-tex-mode ()
+ "Major mode in AUCTeX for editing AmS-TeX files.
+See info under AUCTeX for documentation.
+
+Special commands:
+\\{AmSTeX-mode-map}
+
+Entering AmS-tex-mode calls the value of `text-mode-hook',
+then the value of `TeX-mode-hook', and then the value
+of `AmS-TeX-mode-hook'."
+ (interactive)
+ (plain-TeX-common-initialization)
+ (setq major-mode 'ams-tex-mode)
+ (use-local-map AmSTeX-mode-map)
+
+ ;; Menu
+ (easy-menu-add AmSTeX-mode-menu AmSTeX-mode-map)
+ (easy-menu-add AmSTeX-mode-command-menu AmSTeX-mode-map)
+
+ (setq TeX-base-mode-name "AmS-TeX")
+ (setq TeX-command-default "AmSTeX")
+ (TeX-run-mode-hooks 'text-mode-hook 'TeX-mode-hook 'AmS-TeX-mode-hook)
+ (TeX-set-mode-name))
+
+(provide 'plain-tex)
+
+;;; plain-tex.el ends here
diff --git a/tests/auctex-11.87.7/preview.el b/tests/auctex-11.87.7/preview.el
new file mode 100644
index 0000000..39f1c49
--- /dev/null
+++ b/tests/auctex-11.87.7/preview.el
@@ -0,0 +1,3616 @@
+;;; preview.el --- embed preview LaTeX images in source buffer
+
+;; Copyright (C) 2001-2006, 2010, 2012 Free Software Foundation, Inc.
+
+;; Author: David Kastrup
+;; Keywords: tex, wp, convenience
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Commentary:
+
+;; $Id: preview.el,v 1.287 2012-12-04 08:01:34 tsdh Exp $
+;;
+;; This style is for the "seamless" embedding of generated images
+;; into LaTeX source code. Please see the README and INSTALL files
+;; for further instruction.
+;;
+;; Please use the usual configure script for installation: more than
+;; just Elisp files are involved: a LaTeX style, icon files, startup
+;; code and so on.
+;;
+;; Quite a few things with regard to preview-latex's operation can be
+;; configured by using
+;; M-x customize-group RET preview RET
+;;
+;; Please report bugs with M-x preview-report-bug RET
+;;
+
+;;; Code:
+
+(require 'tex-site)
+(require 'tex)
+(require 'tex-buf)
+(require 'latex)
+
+(eval-when-compile
+ (condition-case nil
+ (require 'desktop)
+ (file-error (message "Missing desktop package:
+preview-latex buffers will not survive across sessions.")))
+ (condition-case nil
+ (require 'reporter)
+ (file-error (message "Missing reporter library, probably from the mail-lib
package:
+preview-latex's bug reporting commands will probably not work.")))
+ (require 'info)
+ (defvar error))
+
+;; we need the compatibility macros which do _not_ get byte-compiled.
+(eval-when-compile
+ (if (featurep 'xemacs)
+ (load-library "prv-xemacs.el")))
+
+;; if the above load-library kicked in, this will not cause anything
+;; to get loaded.
+(require (if (featurep 'xemacs)
+ 'prv-xemacs 'prv-emacs))
+
+(defgroup preview nil "Embed Preview images into LaTeX buffers."
+ :group 'AUCTeX
+ :prefix "preview-"
+ :link '(custom-manual "(preview-latex)Top")
+ :link '(info-link "(preview-latex)The Emacs interface")
+ :link '(url-link :tag "Homepage" "http://www.gnu.org/software/auctex/";))
+
+(defgroup preview-gs nil "Preview's Ghostscript renderer."
+ :group 'preview
+ :prefix "preview-")
+
+(defgroup preview-appearance nil "Preview image appearance."
+ :group 'preview
+ :prefix "preview-")
+
+(defconst preview-specs-type
+ '(repeat
+ (list :tag "Image spec"
+ ;; Use an extra :value keyword to avoid a bug in
+ ;; `widget-convert' of XEmacs 21.4 and Emacs 21.
+ ;; Analogously for the following `const' statements.
+ (const :format "" :value :type)
+ (choice :tag "Image type"
+ (const xpm)
+ (const xbm)
+ (symbol :tag "Other"))
+ (set :inline t :tag "Minimum font size"
+ (list :inline t :tag ""
+ (const :format "" :value :min)
+ (integer :tag "pixels")))
+ (const :format "" :value :file) (string :tag "Filename")
+ (set :inline t :tag "Ascent ratio"
+ (list :inline t :tag ""
+ (const :format "" :value :ascent)
+ (integer :tag "percent of image"
+ :value 50))))))
+
+(defun preview-specs-setter (symbol value)
+ "Set SYMBOL to VALUE and clear `preview-min-alist' property.
+This is used in icon specs, so that customizing will
+clear cached icons."
+ (put symbol 'preview-min-alist nil)
+ (set-default symbol value))
+
+(defcustom preview-nonready-icon-specs
+ '((:type xpm :min 26 :file "prvwrk24.xpm" :ascent 90)
+ (:type xpm :min 22 :file "prvwrk20.xpm" :ascent 90)
+ (:type xpm :min 17 :file "prvwrk16.xpm" :ascent 90)
+ (:type xpm :min 15 :file "prvwrk14.xpm" :ascent 90)
+ (:type xpm :file "prvwrk12.xpm" :ascent 90)
+ (:type xbm :file "prvwrk24.xbm" :ascent 90))
+ "The icon used for previews to be generated.
+The spec must begin with `:type'. File names are relative to
+`load-path' and `data-directory', a spec `:min' requires a
+minimal pixel height for `preview-reference-face' before the spec
+will be considered. Since evaluating the `:file' spec takes
+considerable time under XEmacs, it should come after the `:min'
+spec to avoid unnecessary evaluation time."
+ :group 'preview-appearance
+ :type preview-specs-type
+ :set #'preview-specs-setter)
+
+(defvar preview-nonready-icon)
+
+(defcustom preview-error-icon-specs
+ '((:type xpm :min 22 :file "prverr24.xpm" :ascent 90)
+ (:type xpm :min 18 :file "prverr20.xpm" :ascent 90)
+ (:type xpm :file "prverr16.xpm" :ascent 90)
+ (:type xbm :file "prverr24.xbm" :ascent 90))
+ "The icon used for PostScript errors.
+The spec must begin with `:type'. File names are relative to
+`load-path' and `data-directory', a spec `:min' requires a
+minimal pixel height for `preview-reference-face' before the spec
+will be considered. Since evaluating the `:file' spec takes
+considerable time under XEmacs, it should come after the `:min'
+spec to avoid unnecessary evaluation time."
+ :group 'preview-appearance
+ :type preview-specs-type
+ :set #'preview-specs-setter
+)
+
+(defvar preview-error-icon)
+
+(defcustom preview-icon-specs
+ '((:type xpm :min 24 :file "prvtex24.xpm" :ascent 75)
+ (:type xpm :min 20 :file "prvtex20.xpm" :ascent 75)
+ (:type xpm :min 16 :file "prvtex16.xpm" :ascent 75)
+ (:type xpm :file "prvtex12.xpm" :ascent 75)
+ (:type xbm :min 24 :file "prvtex24.xbm" :ascent 75)
+ (:type xbm :min 16 :file "prvtex16.xbm" :ascent 75)
+ (:type xbm :file "prvtex12.xbm" :ascent 75))
+ "The icon used for an open preview.
+The spec must begin with `:type'. File names are relative to
+`load-path' and `data-directory', a spec `:min' requires a
+minimal pixel height for `preview-reference-face' before the spec
+will be considered. Since evaluating the `:file' spec takes
+considerable time under XEmacs, it should come after the `:min'
+spec to avoid unnecessary evaluation time."
+ :group 'preview-appearance
+ :type preview-specs-type
+ :set #'preview-specs-setter)
+
+(defvar preview-icon)
+
+(defgroup preview-latex nil "LaTeX options for preview."
+ :group 'preview
+ :prefix "preview-")
+
+(defcustom preview-image-creators
+ '((dvipng
+ (open preview-gs-open preview-dvipng-process-setup)
+ (place preview-gs-place)
+ (close preview-dvipng-close))
+ (png (open preview-gs-open)
+ (place preview-gs-place)
+ (close preview-gs-close))
+ (jpeg (open preview-gs-open)
+ (place preview-gs-place)
+ (close preview-gs-close))
+ (pnm (open preview-gs-open)
+ (place preview-gs-place)
+ (close preview-gs-close))
+ (tiff (open preview-gs-open)
+ (place preview-gs-place)
+ (close preview-gs-close)))
+ "Define functions for generating images.
+These functions get called in the process of generating inline
+images of the specified type. The open function is called
+at the start of a rendering pass, the place function for
+placing every image, the close function at the end of
+the pass. Look at the documentation of the various
+functions used here for the default settings, and at
+the function `preview-call-hook' through which those are
+called. Additional argument lists specified in here
+are passed to the functions before any additional
+arguments given to `preview-call-hook'.
+
+Not all of these image types may be supported by your copy
+of Ghostscript, or by your copy of Emacs."
+ :group 'preview-gs
+ :type '(alist :key-type (symbol :tag "Preview's image type")
+ :value-type
+ (alist :tag "Handler" :key-type (symbol :tag "Operation:")
+ :value-type (list :tag "Handler"
+ (function :tag "Handler function")
+ (repeat :tag "Additional \
+function args" :inline t sexp))
+ :options (open place close))))
+
+(defcustom preview-gs-image-type-alist
+ '((png png "-sDEVICE=png16m")
+ (dvipng png "-sDEVICE=png16m")
+ (jpeg jpeg "-sDEVICE=jpeg")
+ (pnm pbm "-sDEVICE=pnmraw")
+ (tiff tiff "-sDEVICE=tiff12nc"))
+ "*Alist of image types and corresponding Ghostscript options.
+The `dvipng' and `postscript' (don't use) entries really specify
+a fallback device when images can't be processed by the requested
+method, like when PDFTeX was used."
+ :group 'preview-gs
+ :type '(repeat (list :tag nil (symbol :tag "preview image-type")
+ (symbol :tag "Emacs image-type")
+ (repeat :inline t :tag "Ghostscript options" string))))
+
+(defcustom preview-image-type 'png
+ "*Image type to be used in images."
+ :group 'preview-gs
+ :type (append '(choice)
+ (mapcar (lambda (symbol) (list 'const (car symbol)))
+ preview-image-creators)
+ '((symbol :tag "Other"))))
+
+(defun preview-call-hook (symbol &rest rest)
+ "Call a function from `preview-image-creators'.
+This looks up SYMBOL in the `preview-image-creators' entry
+for the image type `preview-image-type' and calls the
+hook function given there with the arguments specified there
+followed by REST. If such a function is specified in there,
+that is."
+ (let ((hook (cdr (assq symbol
+ (cdr (assq preview-image-type
+ preview-image-creators))))))
+ (when hook
+ (apply (car hook) (append (cdr hook) rest)))))
+
+
+(defvar TeX-active-tempdir nil
+ "List of directory name, top directory name and reference count.")
+(make-variable-buffer-local 'TeX-active-tempdir)
+
+(defcustom preview-bb-filesize 1024
+ "Size of file area scanned for bounding box information."
+ :group 'preview-gs :type 'integer)
+
+(defcustom preview-preserve-indentation t
+ "*Whether to keep additional whitespace at the left of a line."
+ :group 'preview-appearance :type 'boolean)
+
+(defun preview-extract-bb (filename)
+ "Extract EPS bounding box vector from FILENAME."
+ (with-temp-buffer
+ (insert-file-contents-literally filename nil 0 preview-bb-filesize
+ t)
+ (goto-char (point-min))
+ (when (search-forward-regexp "%%BoundingBox:\
+ +\\([-+]?[0-9.]+\\)\
+ +\\([-+]?[0-9.]+\\)\
+ +\\([-+]?[0-9.]+\\)\
+ +\\([-+]?[0-9.]+\\)" nil t)
+ (vector
+ (if preview-preserve-indentation
+ (min 72 (string-to-number (match-string 1)))
+ (string-to-number (match-string 1)))
+ (string-to-number (match-string 2))
+ (string-to-number (match-string 3))
+ (string-to-number (match-string 4))
+ ))))
+
+(defcustom preview-prefer-TeX-bb nil
+ "*Prefer TeX bounding box to EPS one if available.
+If `preview-fast-conversion' is set, this option is not
+ consulted since the TeX bounding box has to be used anyway."
+ :group 'preview-gs
+ :type 'boolean)
+
+(defcustom preview-TeX-bb-border 0.5
+ "*Additional space in pt around Bounding Box from TeX."
+ :group 'preview-gs
+ :type 'number)
+
+(defvar preview-coding-system nil
+ "Coding system used for LaTeX process.")
+(make-variable-buffer-local 'preview-coding-system)
+(defvar preview-parsed-font-size nil
+ "Font size as parsed from the log of LaTeX run.")
+(make-variable-buffer-local 'preview-parsed-font-size)
+(defvar preview-parsed-magnification nil
+ "Magnification as parsed from the log of LaTeX run.")
+(make-variable-buffer-local 'preview-parsed-magnification)
+(defvar preview-parsed-pdfoutput nil
+ "PDFoutput as parsed from the log of LaTeX run.")
+(make-variable-buffer-local 'preview-parsed-pdfoutput)
+(defvar preview-parsed-counters nil
+ "Counters as parsed from the log of LaTeX run.")
+(make-variable-buffer-local 'preview-parsed-counters)
+(defvar preview-parsed-tightpage nil
+ "Tightpage as parsed from the log of LaTeX run.")
+(make-variable-buffer-local 'preview-parsed-tightpage)
+
+(defun preview-get-magnification ()
+ "Get magnification from `preview-parsed-magnification'."
+ (if preview-parsed-magnification
+ (/ preview-parsed-magnification 1000.0) 1.0))
+
+(defun preview-TeX-bb (list)
+ "Calculate bounding box from (ht dp wd).
+LIST consists of TeX dimensions in sp (1/65536 TeX point)."
+ (and
+ (consp list)
+ (let* ((dims (vconcat (mapcar
+ #'(lambda (x)
+ (/ x 65781.76)) list)))
+ (box
+ (vector
+ (+ 72 (min 0 (aref dims 2)))
+ (+ 720 (min (aref dims 0) (- (aref dims 1)) 0))
+ (+ 72 (max 0 (aref dims 2)))
+ (+ 720 (max (aref dims 0) (- (aref dims 1)) 0))))
+ (border (if preview-parsed-tightpage
+ (vconcat (mapcar
+ #'(lambda(x)
+ (/ x 65781.76)) preview-parsed-tightpage))
+ (vector (- preview-TeX-bb-border)
+ (- preview-TeX-bb-border)
+ preview-TeX-bb-border
+ preview-TeX-bb-border))))
+ (dotimes (i 4 box)
+ (aset box i (+ (aref box i) (aref border i)))))))
+
+(defcustom preview-gs-command (if (eq system-type 'windows-nt)
+ "GSWIN32C.EXE"
+ "gs")
+ "*How to call gs for conversion from EPS. See also `preview-gs-options'."
+ :group 'preview-gs
+ :type 'string)
+
+(defcustom preview-gs-options '("-q" "-dDELAYSAFER" "-dNOPAUSE"
+ "-DNOPLATFONTS" "-dPrinted"
+ "-dTextAlphaBits=4"
+ "-dGraphicsAlphaBits=4")
+ "*Options with which to call gs for conversion from EPS.
+See also `preview-gs-command'."
+ :group 'preview-gs
+ :type '(repeat string))
+
+(defvar preview-gs-queue nil
+ "List of overlays to convert using gs.
+Buffer-local to the appropriate TeX process buffer.")
+(make-variable-buffer-local 'preview-gs-queue)
+
+(defvar preview-gs-outstanding nil
+ "Overlays currently processed.")
+(make-variable-buffer-local 'preview-gs-outstanding)
+
+(defcustom preview-gs-outstanding-limit 2
+ "*Number of requests allowed to be outstanding.
+This is the number of not-yet-completed requests we
+might at any time have piped into Ghostscript. If
+this number is larger, the probability of Ghostscript
+working continuously is higher when Emacs is rather
+busy. If this number is smaller, redisplay will
+follow changes in the displayed buffer area faster."
+ :group 'preview-gs
+ :type '(restricted-sexp
+ :match-alternatives
+ ((lambda (value) (and
+ (integerp value)
+ (> value 0)
+ (< value 10))))
+ :tag "small number"))
+
+(defvar preview-gs-answer nil
+ "Accumulated answer of Ghostscript process.")
+(make-variable-buffer-local 'preview-gs-answer)
+
+(defvar preview-gs-image-type nil
+ "Image type for gs produced images.")
+(make-variable-buffer-local 'preview-gs-image-type)
+
+(defvar preview-gs-sequence nil
+ "Pair of sequence numbers for gs produced images.")
+(make-variable-buffer-local 'preview-gs-sequence)
+
+(defvar preview-scale nil
+ "Screen scale of images.
+Magnify by this factor to make images blend with other
+screen content. Buffer-local to rendering buffer.")
+(make-variable-buffer-local 'preview-scale)
+
+(defvar preview-colors nil
+ "Color setup list.
+An array with elements 0, 1 and 2 for background,
+foreground and border colors, respectively. Each element
+is a list of 3 real numbers between 0 and 1, or NIL
+of nothing special should be done for the color")
+(make-variable-buffer-local 'preview-colors)
+
+(defvar preview-gs-init-string nil
+ "Ghostscript setup string.")
+(make-variable-buffer-local 'preview-gs-init-string)
+
+(defvar preview-ps-file nil
+ "PostScript file name for fast conversion.")
+(make-variable-buffer-local 'preview-ps-file)
+
+(defvar preview-gs-dsc nil
+ "Parsed DSC information.")
+(make-variable-buffer-local 'preview-gs-dsc)
+
+(defvar preview-resolution nil
+ "Screen resolution where rendering started.
+Cons-cell of x and y resolution, given in
+dots per inch. Buffer-local to rendering buffer.")
+(make-variable-buffer-local 'preview-resolution)
+
+(defun preview-gs-resolution (scale xres yres)
+ "Generate resolution argument for gs.
+Calculated from real-life factor SCALE and XRES and
+YRES, the screen resolution in dpi."
+ (format "-r%gx%g"
+ (/ (* scale xres) (preview-get-magnification))
+ (/ (* scale yres) (preview-get-magnification))))
+
+(defun preview-gs-behead-outstanding (err)
+ "Remove leading element of outstanding queue after error.
+Return element if non-nil. ERR is the error string to
+show as response of Ghostscript."
+ (let ((ov (pop preview-gs-outstanding)))
+ (when ov
+ (preview-gs-flag-error ov err)
+ (overlay-put ov 'queued nil))
+ ov))
+
+(defvar preview-gs-command-line nil)
+(make-variable-buffer-local 'preview-gs-command-line)
+(defvar preview-gs-file nil)
+(make-variable-buffer-local 'preview-gs-file)
+
+(defcustom preview-fast-conversion t
+ "*Set this for single-file PostScript conversion.
+This will have no effect when `preview-image-type' is
+set to `postscript'."
+ :group 'preview-latex
+ :type 'boolean)
+
+(defun preview-string-expand (arg &optional separator)
+ "Expand ARG as a string.
+It can already be a string. Or it can be a list, then it is
+recursively evaluated using SEPARATOR as separator. If a list
+element is in itself a CONS cell, the CAR of the list (after symbol
+dereferencing) can evaluate to either a string, in which case it is
+used as a separator for the rest of the list,
+or a boolean (t or nil) in which case the rest of the list is
+either evaluated and concatenated or ignored, respectively.
+ARG can be a symbol, and so can be the CDR
+of a cell used for string concatenation."
+ (cond
+ ((stringp arg) arg)
+ ((consp arg)
+ (mapconcat
+ #'identity
+ (delq nil
+ (mapcar
+ (lambda(x)
+ (if (consp x)
+ (let ((sep (car x)))
+ (while (and (symbolp sep)
+ (not (memq sep '(t nil))))
+ (setq sep (symbol-value sep)))
+ (if (stringp sep)
+ (preview-string-expand (cdr x) sep)
+ (and sep
+ (preview-string-expand (cdr x)))))
+ (preview-string-expand x)))
+ arg))
+ (or separator "")))
+ ((and (symbolp arg) (not (memq arg '(t nil))))
+ (preview-string-expand (symbol-value arg) separator))
+ (t (error "Bad string expansion"))))
+
+(defconst preview-expandable-string
+ ((lambda (f) (funcall f (funcall f 'sexp)))
+ (lambda (x)
+ `(choice
+ string
+ (repeat :tag "Concatenate"
+ (choice
+ string
+ (cons :tag "Separated list"
+ (choice (string :tag "Separator")
+ (symbol :tag "Indirect separator or flag"))
+ ,x)
+ (symbol :tag "Indirect variable (no separator)")))
+ (symbol :tag "Indirect variable (with separator)"))))
+ "Type to be used for `preview-string-expand'.
+Just a hack until we get to learn how to do this properly.
+Recursive definitions are not popular with Emacs,
+so we define this type just two levels deep. This
+kind of expandible string can either be just a string, or a
+cons cell with a separator string in the CAR, and either
+an explicit list of elements in the CDR, or a symbol to
+be consulted recursively.")
+
+(defcustom preview-dvipng-command
+ "dvipng -picky -noghostscript %d -o \"%m/prev%%03d.png\""
+ "*Command used for converting to separate PNG images.
+
+You might specify options for converting to other image types,
+but then you'll need to adapt `preview-dvipng-image-type'."
+ :group 'preview-latex
+ :type 'string)
+
+(defcustom preview-dvipng-image-type
+ 'png
+ "*Image type that dvipng produces.
+
+You'll need to change `preview-dvipng-command' too,
+if you customize this."
+ :group 'preview-latex
+ :type '(choice (const png)
+ (const gif)
+ (symbol :tag "Other" :value png)))
+
+(defcustom preview-dvips-command
+ "dvips -Pwww -i -E %d -o %m/preview.000"
+ "*Command used for converting to separate EPS images."
+ :group 'preview-latex
+ :type 'string)
+
+(defcustom preview-fast-dvips-command
+ "dvips -Pwww %d -o %m/preview.ps"
+ "*Command used for converting to a single PS file."
+ :group 'preview-latex
+ :type 'string)
+
+(defcustom preview-pdf2dsc-command
+ "pdf2dsc %s.pdf %m/preview.dsc"
+ "*Command used for generating dsc from a PDF file."
+ :group 'preview-latex
+ :type 'string)
+
+(defun preview-gs-queue-empty ()
+ "Kill off everything remaining in `preview-gs-queue'."
+ (mapc #'preview-delete preview-gs-outstanding)
+ (dolist (ov preview-gs-queue)
+ (if (overlay-get ov 'queued)
+ (preview-delete ov)))
+ (setq preview-gs-outstanding nil)
+ (setq preview-gs-queue nil))
+
+(defvar preview-error-condition nil
+ "Last error raised and to be reported.")
+
+(defun preview-log-error (err context &optional process)
+ "Log an error message to run buffer.
+ERR is the caught error syndrome, CONTEXT is where it
+occured, PROCESS is the process for which the run-buffer
+is to be used."
+ (when (or (null process) (buffer-name (process-buffer process)))
+ (with-current-buffer (or (and process
+ (process-buffer process))
+ (current-buffer))
+ (save-excursion
+ (goto-char (or (and process
+ (process-buffer process)
+ (marker-buffer (process-mark process))
+ (process-mark process))
+ (point-max)))
+ (insert-before-markers
+ (format "%s: %s\n"
+ context (error-message-string err)))
+ (display-buffer (current-buffer)))))
+ (setq preview-error-condition err))
+
+(defun preview-reraise-error (&optional process)
+ "Raise an error that has been logged.
+Makes sure that PROCESS is removed from the \"Compilation\"
+tag in the mode line."
+ (when preview-error-condition
+ (unwind-protect
+ (signal (car preview-error-condition) (cdr preview-error-condition))
+ (setq preview-error-condition nil
+ compilation-in-progress (delq process compilation-in-progress)))))
+
+(defun preview-gs-sentinel (process string)
+ "Sentinel function for rendering process.
+Gets the default PROCESS and STRING arguments
+and tries to restart Ghostscript if necessary."
+ (condition-case err
+ (let ((status (process-status process)))
+ (when (memq status '(exit signal))
+ (setq compilation-in-progress (delq process compilation-in-progress)))
+ (when (buffer-name (process-buffer process))
+ (with-current-buffer (process-buffer process)
+ (goto-char (point-max))
+ (insert-before-markers "\n" mode-name " " string)
+ (forward-char -1)
+ (insert " at "
+ (substring (current-time-string) 0 -5))
+ (forward-char 1)
+ (TeX-command-mode-line process)
+ (when (memq status '(exit signal))
+ ;; process died.
+ ;; Throw away culprit, go on.
+ (let* ((err (concat preview-gs-answer "\n"
+ (process-name process) " " string))
+ (ov (preview-gs-behead-outstanding err)))
+ (when (and (null ov) preview-gs-queue)
+ (save-excursion
+ (goto-char (if (marker-buffer (process-mark process))
+ (process-mark process)
+ (point-max)))
+ (insert-before-markers err)))
+ (delete-process process)
+ (if (or (null ov)
+ (eq status 'signal))
+ ;; if process was killed explicitly by signal, or if nothing
+ ;; was processed, we give up on the matter altogether.
+ (progn
+ (when preview-ps-file
+ (condition-case nil
+ (preview-delete-file preview-ps-file)
+ (file-error nil)))
+ (preview-gs-queue-empty))
+
+ ;; restart only if we made progress since last call
+ (let (filenames)
+ (dolist (ov preview-gs-outstanding)
+ (setq filenames (overlay-get ov 'filenames))
+ (condition-case nil
+ (preview-delete-file (nth 1 filenames))
+ (file-error nil))
+ (setcdr filenames nil)))
+ (setq preview-gs-queue (nconc preview-gs-outstanding
+ preview-gs-queue))
+ (setq preview-gs-outstanding nil)
+ (preview-gs-restart)))))))
+ (error (preview-log-error err "Ghostscript" process)))
+ (preview-reraise-error process))
+
+(defun preview-gs-filter (process string)
+ "Filter function for processing Ghostscript output.
+Gets the usual PROCESS and STRING parameters, see
+`set-process-filter' for a description."
+ (with-current-buffer (process-buffer process)
+ (setq preview-gs-answer (concat preview-gs-answer string))
+ (while (string-match "GS\\(<[0-9]+\\)?>" preview-gs-answer)
+ (let* ((pos (match-end 0))
+ (answer (substring preview-gs-answer 0 pos)))
+ (setq preview-gs-answer (substring preview-gs-answer pos))
+ (condition-case err
+ (preview-gs-transact process answer)
+ (error (preview-log-error err "Ghostscript filter" process))))))
+ (preview-reraise-error))
+
+(defun preview-gs-restart ()
+ "Start a new Ghostscript conversion process."
+ (when preview-gs-queue
+ (if preview-gs-sequence
+ (setcar preview-gs-sequence (1+ (car preview-gs-sequence)))
+ (setq preview-gs-sequence (list 1)))
+ (setcdr preview-gs-sequence 1)
+ (let* ((process-connection-type nil)
+ (outfile (format "-dOutputFile=%s"
+ (preview-ps-quote-filename
+ (format "%s/pr%d-%%d.%s"
+ (car TeX-active-tempdir)
+ (car preview-gs-sequence)
+ preview-gs-image-type))))
+ (process
+ (apply #'start-process
+ "Preview-Ghostscript"
+ (current-buffer)
+ preview-gs-command
+ outfile
+ preview-gs-command-line)))
+ (goto-char (point-max))
+ (insert-before-markers "Running `Preview-Ghostscript' with ``"
+ (mapconcat #'shell-quote-argument
+ (append
+ (list preview-gs-command
+ outfile)
+ preview-gs-command-line)
+ " ") "''\n")
+ (setq preview-gs-answer "")
+ (process-kill-without-query process)
+ (set-process-sentinel process #'preview-gs-sentinel)
+ (set-process-filter process #'preview-gs-filter)
+ (process-send-string process preview-gs-init-string)
+ (setq mode-name "Preview-Ghostscript")
+ (push process compilation-in-progress)
+ (TeX-command-mode-line process)
+ (set-buffer-modified-p (buffer-modified-p))
+ process)))
+
+(defun preview-gs-open (&optional setup)
+ "Start a Ghostscript conversion pass.
+SETUP may contain a parser setup function."
+ (let ((image-info (assq preview-image-type preview-gs-image-type-alist)))
+ (setq preview-gs-image-type (nth 1 image-info))
+ (setq preview-gs-sequence nil)
+ (setq preview-gs-command-line (append
+ preview-gs-options
+ (nthcdr 2 image-info))
+ preview-gs-init-string
+ (format "{DELAYSAFER{.setsafe}if}stopped pop\
+/.preview-BP currentpagedevice/BeginPage get dup \
+null eq{pop{pop}bind}if def\
+<</BeginPage{currentpagedevice/PageSize get dup 0 get 1 ne exch 1 get 1 ne or\
+{.preview-BP %s}{pop}ifelse}bind/PageSize[1 1]>>setpagedevice\
+/preview-do{[count 3 roll save]3 1 roll dup length 0 eq\
+{pop}{setpagedevice}{ifelse .runandhide}\
+stopped{handleerror quit}if \
+aload pop restore}bind def "
+ (preview-gs-color-string preview-colors)))
+ (preview-gs-queue-empty)
+ (preview-parse-messages (or setup #'preview-gs-dvips-process-setup))))
+
+(defun preview-gs-color-value (value)
+ "Return string to be used as color value for an RGB component.
+Conversion from Emacs color numbers (0 to 65535) in VALUE
+to Ghostscript floats."
+ (format "%g" (/ value 65535.0)))
+
+(defun preview-pdf-color-string (colors)
+ "Return a string that patches PDF foreground color to work properly."
+ ;; Actually, this is rather brutal. It will only be invoked in
+ ;; cases, however, where previously it was not expected that
+ ;; anything readable turned up, anyway.
+ (let ((fg (aref colors 1)))
+ (if fg
+ (concat
+ "/GS_PDF_ProcSet GS_PDF_ProcSet dup maxlength dict copy dup begin\
+/graphicsbeginpage{//graphicsbeginpage exec "
+ (mapconcat #'preview-gs-color-value fg " ")
+ " 3 copy rg RG}bind store end readonly store "))))
+
+(defun preview-gs-color-string (colors)
+ "Return a string setting up colors"
+ (let ((bg (aref colors 0))
+ (fg (aref colors 1))
+ (mask (aref colors 2))
+ (border (aref colors 3)))
+ (concat
+ (and (or (and mask border) (and bg (not fg)))
+ "gsave ")
+ (and bg
+ (concat
+ (mapconcat #'preview-gs-color-value bg " ")
+ " setrgbcolor clippath fill "))
+ (and mask border
+ (format "%s setrgbcolor false setstrokeadjust %g \
+setlinewidth clippath strokepath \
+matrix setmatrix true \
+{2 index{newpath}if round exch round exch moveto pop false}\
+{round exch round exch lineto}{curveto}{closepath}\
+pathforall pop fill "
+ (mapconcat #'preview-gs-color-value mask " ")
+ (* 2 border)))
+ ;; I hate antialiasing. Warp border to integral coordinates.
+ (and (or (and mask border) (and bg (not fg)))
+ "grestore ")
+ (and fg
+ (concat
+ (mapconcat #'preview-gs-color-value fg " ")
+ " setrgbcolor")))))
+
+(defun preview-dvipng-color-string (colors res)
+ "Return color setup tokens for dvipng.
+Makes a string of options suitable for passing to dvipng.
+Pure borderless black-on-white will return an empty string."
+ (let
+ ((bg (aref colors 0))
+ (fg (aref colors 1))
+ (mask (aref colors 2))
+ (border (aref colors 3)))
+ (concat
+ (and bg
+ (format "--bg 'rgb %s' "
+ (mapconcat #'preview-gs-color-value bg " ")))
+ (and fg
+ (format "--fg 'rgb %s' "
+ (mapconcat #'preview-gs-color-value fg " ")))
+ (and mask border
+ (format "--bd 'rgb %s' "
+ (mapconcat #'preview-gs-color-value mask " ")))
+ (and border
+ (format "--bd %d" (max 1 (round (/ (* res border) 72.0))))))))
+
+(defun preview-gs-dvips-process-setup ()
+ "Set up Dvips process for conversions via gs."
+ (unless (preview-supports-image-type preview-gs-image-type)
+ (error "preview-image-type setting '%s unsupported by this Emacs"
+ preview-gs-image-type))
+ (setq preview-gs-command-line (append
+ preview-gs-command-line
+ (list (preview-gs-resolution
+ (preview-hook-enquiry preview-scale)
+ (car preview-resolution)
+ (cdr preview-resolution)))))
+ (if preview-parsed-pdfoutput
+ (preview-pdf2dsc-process-setup)
+ (let ((process (preview-start-dvips preview-fast-conversion)))
+ (setq TeX-sentinel-function #'preview-gs-dvips-sentinel)
+ (list process (current-buffer) TeX-active-tempdir preview-ps-file
+ preview-gs-image-type))))
+
+(defun preview-dvipng-process-setup ()
+ "Set up dvipng process for conversion."
+ (setq preview-gs-command-line (append
+ preview-gs-command-line
+ (list (preview-gs-resolution
+ (preview-hook-enquiry preview-scale)
+ (car preview-resolution)
+ (cdr preview-resolution)))))
+ (if preview-parsed-pdfoutput
+ (if (preview-supports-image-type preview-gs-image-type)
+ (preview-pdf2dsc-process-setup)
+ (error "preview-image-type setting '%s unsupported by this Emacs"
+ preview-gs-image-type))
+ (unless (preview-supports-image-type preview-dvipng-image-type)
+ (error "preview-dvipng-image-type setting '%s unsupported by this Emacs"
+ preview-dvipng-image-type))
+ (let ((process (preview-start-dvipng)))
+ (setq TeX-sentinel-function #'preview-dvipng-sentinel)
+ (list process (current-buffer) TeX-active-tempdir t
+ preview-dvipng-image-type))))
+
+
+(defun preview-pdf2dsc-process-setup ()
+ (let ((process (preview-start-pdf2dsc)))
+ (setq TeX-sentinel-function #'preview-pdf2dsc-sentinel)
+ (list process (current-buffer) TeX-active-tempdir preview-ps-file
+ preview-gs-image-type)))
+
+(defun preview-dvips-abort ()
+ "Abort a Dvips run."
+ (preview-gs-queue-empty)
+ (condition-case nil
+ (delete-file
+ (let ((gsfile preview-gs-file))
+ (with-current-buffer TeX-command-buffer
+ (funcall (car gsfile) "dvi"))))
+ (file-error nil))
+ (when preview-ps-file
+ (condition-case nil
+ (preview-delete-file preview-ps-file)
+ (file-error nil)))
+ (setq TeX-sentinel-function nil))
+
+(defalias 'preview-dvipng-abort 'preview-dvips-abort)
+; "Abort a DviPNG run.")
+
+(defun preview-gs-dvips-sentinel (process command &optional gsstart)
+ "Sentinel function for indirect rendering DviPS process.
+The usual PROCESS and COMMAND arguments for
+`TeX-sentinel-function' apply. Starts gs if GSSTART is set."
+ (condition-case err
+ (let ((status (process-status process))
+ (gsfile preview-gs-file))
+ (cond ((eq status 'exit)
+ (delete-process process)
+ (setq TeX-sentinel-function nil)
+ (condition-case nil
+ (delete-file
+ (with-current-buffer TeX-command-buffer
+ (funcall (car gsfile) "dvi")))
+ (file-error nil))
+ (if preview-ps-file
+ (preview-prepare-fast-conversion))
+ (when gsstart
+ (if preview-gs-queue
+ (preview-gs-restart)
+ (when preview-ps-file
+ (condition-case nil
+ (preview-delete-file preview-ps-file)
+ (file-error nil))))))
+ ((eq status 'signal)
+ (delete-process process)
+ (preview-dvips-abort))))
+ (error (preview-log-error err "DviPS sentinel" process)))
+ (preview-reraise-error process))
+
+(defun preview-pdf2dsc-sentinel (process command &optional gsstart)
+ "Sentinel function for indirect rendering PDF process.
+The usual PROCESS and COMMAND arguments for
+`TeX-sentinel-function' apply. Starts gs if GSSTART is set."
+ (condition-case err
+ (let ((status (process-status process)))
+ (cond ((eq status 'exit)
+ (delete-process process)
+ (setq TeX-sentinel-function nil)
+ (setq preview-gs-init-string
+ (concat preview-gs-init-string
+ (preview-pdf-color-string preview-colors)))
+ (preview-prepare-fast-conversion)
+ (when gsstart
+ (if preview-gs-queue
+ (preview-gs-restart)
+ (when preview-ps-file
+ (condition-case nil
+ (preview-delete-file preview-ps-file)
+ (file-error nil))))))
+ ((eq status 'signal)
+ (delete-process process)
+ (preview-dvips-abort))))
+ (error (preview-log-error err "PDF2DSC sentinel" process)))
+ (preview-reraise-error process))
+
+(defun preview-gs-close (process closedata)
+ "Clean up after PROCESS and set up queue accumulated in CLOSEDATA."
+ (setq preview-gs-queue (nconc preview-gs-queue closedata))
+ (if process
+ (if preview-gs-queue
+ (if TeX-process-asynchronous
+ (if (and (eq (process-status process) 'exit)
+ (null TeX-sentinel-function))
+ ;; Process has already finished and run sentinel
+ (progn
+ (when preview-ps-file
+ (condition-case nil
+ (preview-delete-file preview-ps-file)
+ (file-error nil)))
+ (preview-gs-restart))
+ (setq TeX-sentinel-function
+ `(lambda (process command)
+ (,(if preview-parsed-pdfoutput
+ 'preview-pdf2dsc-sentinel
+ 'preview-gs-dvips-sentinel)
+ process
+ command
+ t))))
+ (TeX-synchronous-sentinel "Preview-DviPS" (cdr preview-gs-file)
+ process))
+ ;; pathological case: no previews although we sure thought so.
+ (delete-process process)
+ (unless (eq (process-status process) 'signal)
+ (preview-dvips-abort)))))
+
+(defun preview-dvipng-sentinel (process command &optional placeall)
+ "Sentinel function for indirect rendering DviPNG process.
+The usual PROCESS and COMMAND arguments for
+`TeX-sentinel-function' apply. Places all snippets if PLACEALL is set."
+ (condition-case err
+ (let ((status (process-status process)))
+ (cond ((eq status 'exit)
+ (delete-process process)
+ (setq TeX-sentinel-function nil)
+ (when placeall
+ (preview-dvipng-place-all)))
+ ((eq status 'signal)
+ (delete-process process)
+ (preview-dvipng-abort))))
+ (error (preview-log-error err "DviPNG sentinel" process)))
+ (preview-reraise-error process))
+
+(defun preview-dvipng-close (process closedata)
+ "Clean up after PROCESS and set up queue accumulated in CLOSEDATA."
+ (if preview-parsed-pdfoutput
+ (preview-gs-close process closedata)
+ (setq preview-gs-queue (nconc preview-gs-queue closedata))
+ (if process
+ (if preview-gs-queue
+ (if TeX-process-asynchronous
+ (if (and (eq (process-status process) 'exit)
+ (null TeX-sentinel-function))
+ ;; Process has already finished and run sentinel
+ (preview-dvipng-place-all)
+ (setq TeX-sentinel-function (lambda (process command)
+ (preview-dvipng-sentinel
+ process
+ command
+ t))))
+ (TeX-synchronous-sentinel "Preview-DviPNG" (cdr preview-gs-file)
+ process))
+ ;; pathological case: no previews although we sure thought so.
+ (delete-process process)
+ (unless (eq (process-status process) 'signal)
+ (preview-dvipng-abort))))))
+
+(defun preview-dsc-parse (file)
+ "Parse DSC comments of FILE.
+Returns a vector with offset/length pairs corresponding to
+the pages. Page 0 corresponds to the initialization section."
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert-file-contents-literally file)
+ (let ((last-pt (point-min))
+ trailer
+ pagelist
+ lastbegin
+ pt
+ case-fold-search
+ (level 0))
+ (while (search-forward-regexp "\
+%%\\(?:\\(BeginDocument:\\)\\|\
+\\(EndDocument[\n\r]\\)\\|\
+\\(Page:\\)\\|\
+\\(Trailer[\n\r]\\)\\)" nil t)
+ (setq pt (match-beginning 0))
+ (cond ((null (memq (char-before pt) '(?\C-j ?\C-m nil))))
+ (trailer (error "Premature %%%%Trailer in `%s' at offsets %d/%d"
+ file trailer pt))
+ ((match-beginning 1)
+ (if (zerop level)
+ (setq lastbegin pt))
+ (setq level (1+ level)))
+ ((match-beginning 2)
+ (if (zerop level)
+ (error "Unmatched %%%%EndDocument in `%s' at offset %d"
+ file pt)
+ (setq level (1- level))))
+ ((> level 0))
+ ((match-beginning 3)
+ (push (list last-pt (- pt last-pt)) pagelist)
+ (setq last-pt pt))
+ ((match-beginning 4)
+ (setq trailer pt))))
+ (unless (zerop level)
+ (error "Unmatched %%%%BeginDocument in `%s' at offset %d"
+ file lastbegin))
+ (push (list last-pt
+ (- (or trailer (point-max)) last-pt)) pagelist)
+ (vconcat (nreverse pagelist)))))
+
+(defun preview-gs-dsc-cvx (page dsc)
+ "Generate PostScript code accessing PAGE in the DSC object.
+The returned PostScript code will need the file on
+top of the stack, and will replace it with an executable
+object corresponding to the wanted page."
+ (let ((curpage (aref dsc page)))
+ (format "dup %d setfileposition %d()/SubFileDecode filter cvx"
+ (1- (car curpage)) (nth 1 curpage))))
+
+(defun preview-ps-quote-filename (str &optional nonrel)
+ "Make a PostScript string from filename STR.
+The file name is first made relative unless
+NONREL is not NIL."
+ (unless nonrel (setq str (file-relative-name str)))
+ (let ((index 0))
+ (while (setq index (string-match "[\\()]" str index))
+ (setq str (replace-match "\\\\\\&" t nil str)
+ index (+ 2 index)))
+ (concat "(" str ")")))
+
+(defun preview-prepare-fast-conversion ()
+ "This fixes up all parameters for fast conversion."
+ (let* ((file (if (consp (car preview-ps-file))
+ (if (consp (caar preview-ps-file))
+ (car (last (caar preview-ps-file)))
+ (caar preview-ps-file))
+ (car preview-ps-file)))
+ (all-files (if (and (consp (car preview-ps-file))
+ (consp (caar preview-ps-file)))
+ (caar preview-ps-file)
+ (list file))))
+ (setq preview-gs-dsc (preview-dsc-parse file))
+ (setq preview-gs-init-string
+ (concat (format "{<</PermitFileReading[%s]>> setuserparams \
+.locksafe} stopped pop "
+ (mapconcat 'preview-ps-quote-filename all-files ""))
+ preview-gs-init-string
+ (format "[%s(r)file]aload exch %s .runandhide aload pop "
+ (preview-ps-quote-filename file)
+ (preview-gs-dsc-cvx 0 preview-gs-dsc))))))
+
+(defun preview-gs-urgentize (ov buff)
+ "Make a displayed overlay render with higher priority.
+This function is used in fake conditional display properties
+for reordering the conversion order to prioritize on-screen
+images. OV is the overlay in question, and BUFF is the
+Ghostscript process buffer where the buffer-local queue
+is located."
+ ;; It does not matter that ov gets queued twice in that process: the
+ ;; first version to get rendered will clear the 'queued property.
+ ;; It cannot get queued more than twice since we remove the
+ ;; conditional display property responsible for requeuing here.
+ ;; We don't requeue if the overlay has been killed (its buffer made
+ ;; nil). Not necessary, but while we are checking...
+ ;; We must return t.
+ (preview-remove-urgentization ov)
+ (when (and (overlay-get ov 'queued)
+ (overlay-buffer ov))
+ (with-current-buffer buff
+ (push ov preview-gs-queue)))
+ t)
+
+
+(defun preview-gs-place (ov snippet box run-buffer tempdir ps-file imagetype)
+ "Generate an image placeholder rendered over by Ghostscript.
+This enters OV into all proper queues in order to make it render
+this image for real later, and returns the overlay after setting
+a placeholder image. SNIPPET gives the number of the
+snippet in question for the file to be generated.
+BOX is a bounding box if we already know one via TeX.
+RUN-BUFFER is the buffer of the TeX process,
+TEMPDIR is the correct copy of `TeX-active-tempdir',
+PS-FILE is a copy of `preview-ps-file', IMAGETYPE is the image type
+for the file extension."
+ (overlay-put ov 'filenames
+ (unless (eq ps-file t)
+ (list
+ (preview-make-filename
+ (or ps-file
+ (format "preview.%03d" snippet))
+ tempdir))))
+ (overlay-put ov 'queued
+ (vector box nil snippet))
+ (overlay-put ov 'preview-image
+ (list (preview-icon-copy preview-nonready-icon)))
+ (preview-add-urgentization #'preview-gs-urgentize ov run-buffer)
+ (list ov))
+
+(defun preview-mouse-open-error (string)
+ "Display STRING in a new view buffer on click."
+ (let ((buff (get-buffer-create
+ "*Preview-Ghostscript-Error*")))
+ (with-current-buffer buff
+ (kill-all-local-variables)
+ (set (make-local-variable 'view-exit-action) #'kill-buffer)
+ (setq buffer-undo-list t)
+ (erase-buffer)
+ (insert string)
+ (goto-char (point-min)))
+ (view-buffer-other-window buff)))
+
+(defun preview-mouse-open-eps (file &optional position)
+ "Display eps FILE in a view buffer on click.
+Place point at POSITION, else beginning of file."
+ (let ((default-major-mode
+ (or
+ (assoc-default "x.ps" auto-mode-alist #'string-match)
+ default-major-mode))
+ (buff (get-file-buffer file)))
+ (save-excursion
+ (if buff
+ (pop-to-buffer buff)
+ (view-file-other-window file))
+ (goto-char (or position (point-min)))
+ (if (eq major-mode 'ps-mode) ; Bundled with GNU Emacs
+ (message "%s" (substitute-command-keys "\
+Try \\[ps-run-start] \\[ps-run-buffer] and \
+\\<ps-run-mode-map>\\[ps-run-mouse-goto-error] on error offset." )))
+ (if (eq major-mode 'postscript-mode) ; Bundled with XEmacs, limited
+ (message "%s" (substitute-command-keys "\
+Try \\[ps-shell] and \\[ps-execute-buffer]."))))))
+
+(defun preview-gs-flag-error (ov err)
+ "Make an eps error flag in overlay OV for ERR string."
+ (let* ((filenames (overlay-get ov 'filenames))
+ (file (car (nth 0 filenames)))
+ (outfile (format "-dOutputFile=%s"
+ (preview-ps-quote-filename
+ (car (nth 1 filenames)))))
+ (ps-open
+ `(lambda() (interactive "@")
+ (preview-mouse-open-error
+ ,(concat
+ (mapconcat #'shell-quote-argument
+ (append (list
+ preview-gs-command
+ outfile)
+ preview-gs-command-line)
+ " ")
+ "\nGS>"
+ preview-gs-init-string
+ (aref (overlay-get ov 'queued) 1)
+ err))))
+ (str
+ (preview-make-clickable
+ nil
+ preview-error-icon
+ "%s views error message
+%s more options"
+ ps-open
+ `(lambda() (interactive)
+ (popup-menu
+ '("PostScript error"
+ ["View error" ,ps-open]
+ ["View source"
+ (lambda () (interactive "@")
+ ,(if preview-ps-file
+ `(preview-mouse-open-eps
+ ,(if (consp (car file))
+ (nth 1 (car file))
+ (car file))
+ ,(nth 0 (aref preview-gs-dsc
+ (aref (overlay-get ov 'queued) 2))))
+ `(preview-mouse-open-eps ,file)))]))))))
+ (overlay-put ov 'strings (cons str str))
+ (preview-toggle ov)))
+
+(defun preview-gs-transact (process answer)
+ "Work off Ghostscript transaction.
+This routine is the action routine called via the process filter.
+The Ghostscript process buffer of PROCESS will already be selected, and
+and the standard output of Ghostscript up to the next prompt will be
+given as ANSWER."
+ (let ((ov (pop preview-gs-outstanding))
+ (have-error (not
+ (string-match "\\`GS\\(<[0-9]+\\)?>\\'" answer ))))
+ (when (and ov (overlay-buffer ov))
+ (let ((queued (overlay-get ov 'queued)))
+ (when queued
+ (let* ((bbox (aref queued 0))
+ (filenames (overlay-get ov 'filenames))
+ (oldfile (nth 0 filenames))
+ (newfile (nth 1 filenames)))
+ (if have-error
+ (preview-gs-flag-error ov answer)
+ (condition-case nil
+ (preview-delete-file oldfile)
+ (file-error nil))
+ (overlay-put ov 'filenames (cdr filenames))
+ (preview-replace-active-icon
+ ov
+ (preview-create-icon (car newfile)
+ preview-gs-image-type
+ (preview-ascent-from-bb
+ bbox)
+ (aref preview-colors 2))))
+ (overlay-put ov 'queued nil)))))
+ (while (and (< (length preview-gs-outstanding)
+ preview-gs-outstanding-limit)
+ (setq ov (pop preview-gs-queue)))
+ (let ((queued (overlay-get ov 'queued)))
+ (when (and queued
+ (not (memq ov preview-gs-outstanding))
+ (overlay-buffer ov))
+ (let* ((filenames (overlay-get ov 'filenames))
+ (oldfile (car (nth 0
+ (nconc filenames
+ (list
+ (preview-make-filename
+ (format "pr%d-%d.%s"
+ (car preview-gs-sequence)
+ (cdr preview-gs-sequence)
+ preview-gs-image-type)
+ TeX-active-tempdir))))))
+ (bbox (aset queued 0
+ (or (and preview-prefer-TeX-bb
+ (aref queued 0))
+ (and (stringp oldfile)
+ (preview-extract-bb
+ oldfile))
+ (aref queued 0)
+ (error "No bounding box"))))
+ (snippet (aref queued 2))
+ (gs-line
+ (format
+ "%s<<%s>>preview-do\n"
+ (if preview-ps-file
+ (concat "dup "
+ (preview-gs-dsc-cvx
+ snippet
+ preview-gs-dsc))
+ (format "%s(r)file cvx"
+ (preview-ps-quote-filename
+ (if (listp oldfile)
+ (car (last oldfile))
+ oldfile))))
+ (if preview-parsed-tightpage
+ ""
+ (format "/PageSize[%g %g]/PageOffset[%g \
+%g[1 1 dtransform exch]{0 ge{neg}if exch}forall]"
+ (- (aref bbox 2) (aref bbox 0))
+ (- (aref bbox 3) (aref bbox 1))
+ (aref bbox 0) (aref bbox 1))))))
+ (setcdr preview-gs-sequence (1+ (cdr preview-gs-sequence)))
+ (setq preview-gs-outstanding
+ (nconc preview-gs-outstanding
+ (list ov)))
+ (aset queued 1 gs-line)
+ ;; ignore errors because of dying processes: they will get
+ ;; caught by the sentinel, anyway.
+ (condition-case nil
+ (process-send-string
+ process
+ gs-line)
+ (error nil))))))
+ (unless preview-gs-outstanding
+ (condition-case nil
+ (process-send-eof process)
+ (error nil)))))
+
+(defun preview-hook-enquiry (hook)
+ "Gets a value from a configured hook.
+HOOK is a list or single item, for which the first resolving to
+non-nil counts. Entries can be a callable function, or
+a symbol that is consulted, or a value. Lists are evaluated
+recursively."
+ (cond ((functionp hook)
+ (funcall hook))
+ ((consp hook)
+ (let (res)
+ (while (and (not res) hook)
+ (setq res (preview-hook-enquiry (car hook))
+ hook (cdr hook)))
+ res))
+ ((and (symbolp hook) (boundp hook))
+ (symbol-value hook))
+ (t hook)))
+
+(defcustom preview-scale-function #'preview-scale-from-face
+ "*Scale factor for included previews.
+This can be either a function to calculate the scale, or
+a fixed number."
+ :group 'preview-appearance
+ :type '(choice (function-item preview-scale-from-face)
+ (const 1.0)
+ (number :value 1.0)
+ (function :value preview-scale-from-face)))
+
+(defcustom preview-default-document-pt 10
+ "*Assumed document point size for `preview-scale-from-face'.
+If the point size (such as 11pt) of the document cannot be
+determined from the document options itself, assume this size.
+This is for matching screen font size and previews."
+ :group 'preview-appearance
+ :type
+ '(choice (const :tag "10pt" 10)
+ (const :tag "11pt" 11)
+ (const :tag "12pt" 12)
+ (number :tag "Other" :value 11.0))
+)
+
+(defcustom preview-document-pt-list '(preview-parsed-font-size
+ preview-auctex-font-size
+ preview-default-document-pt)
+ "*How `preview-document-pt' figures out the document size."
+ :group 'preview-appearance
+ :type
+ '(repeat (choice
+ ;; This is a bug: type function seems to match variables, too.
+ (restricted-sexp :match-alternatives (functionp)
+ :tag "Function" :value preview-auctex-font-size)
+ (variable :value preview-parsed-font-size)
+ (number :value 11))))
+
+(defun preview-auctex-font-size ()
+ "Calculate the default font size of document.
+If packages, classes or styles were called with an option
+like 10pt, size is taken from the first such option if you
+had let your document be parsed by AucTeX."
+ (catch 'return (dolist (option (TeX-style-list))
+ (if (string-match "\\`\\([0-9]+\\)pt\\'" option)
+ (throw 'return
+ (string-to-number
+ (match-string 1 option)))))))
+
+(defsubst preview-document-pt ()
+ "Calculate the default font size of document."
+ (preview-hook-enquiry preview-document-pt-list))
+
+(defun preview-scale-from-face ()
+ "Calculate preview scale from `preview-reference-face'.
+This calculates the scale of EPS images from a document assumed
+to have a default font size given by function `preview-document-pt'
+so that they match the reference face in height."
+ `(lambda nil
+ (/ ,(/ (preview-inherited-face-attribute 'preview-reference-face :height
+ 'default) 10.0)
+ (preview-document-pt))))
+
+(defvar preview-min-spec)
+
+(defun preview-make-image (symbol)
+ "Make an image from a preview spec list.
+The first spec that is workable (given the current setting of
+`preview-min-spec') from the given symbol is used here. The
+icon is cached in the property list of the symbol."
+ (let ((alist (get 'preview-min-alist symbol)))
+ (cdr (or
+ (assq preview-min-spec alist)
+ (car (put symbol 'preview-min-alist
+ (cons
+ (cons preview-min-spec
+ (preview-filter-specs
+ (symbol-value symbol)))
+ alist)))))))
+
+(defun preview-filter-specs (spec-list)
+ "Find the first of the fitting specs and make an image."
+ (let (image)
+ (while (and spec-list
+ (not (setq image
+ (catch 'preview-filter-specs
+ (preview-filter-specs-1 (car spec-list))))))
+ (setq spec-list (cdr spec-list)))
+ image))
+
+(defun preview-filter-specs-1 (specs)
+ (and specs
+ (if (get 'preview-filter-specs (car specs))
+ (apply (get 'preview-filter-specs (car specs)) specs)
+ `(,(nth 0 specs) ,(nth 1 specs)
+ ,@(preview-filter-specs-1 (nthcdr 2 specs))))))
+
+(put 'preview-filter-specs :min
+ #'(lambda (keyword value &rest args)
+ (if (> value preview-min-spec)
+ (throw 'preview-filter-specs nil)
+ (preview-filter-specs-1 args))))
+
+(defvar preview-datadir (file-name-directory load-file-name)
+ "The directory relative to which package data may be found.
+This should be hardwired into the startup file containing the
+autoloads for preview-latex.")
+
+(put 'preview-filter-specs :file
+ #'(lambda (keyword value &rest args)
+ `(:file ,(expand-file-name value (expand-file-name "images"
+ preview-datadir))
+ ,@(preview-filter-specs-1 args))))
+
+(defun preview-ascent-from-bb (bb)
+ "This calculates the image ascent from its bounding box.
+The bounding box BB needs to be a 4-component vector of
+numbers (can be float if available)."
+ ;; baseline is at 1in from the top of letter paper (11in), so it is
+ ;; at 10in from the bottom precisely, which is 720 in PostScript
+ ;; coordinates. If our bounding box has its bottom not above this
+ ;; line, and its top above, we can calculate a useful ascent value.
+ ;; If not, something is amiss. We just use 100 in that case.
+
+ (let ((bottom (aref bb 1))
+ (top (aref bb 3)))
+ (if (and (<= bottom 720)
+ (> top 720))
+ (round (* 100.0 (/ (- top 720.0) (- top bottom))))
+ 100)))
+
+(defface preview-face '((((background dark))
+ (:background "dark slate gray"))
+ (t
+ (:background "beige")))
+ "Face to use for the preview source."
+ :group 'preview-appearance)
+
+(defface preview-reference-face '((t nil))
+ "Face consulted for colors and scale of active previews.
+Fallback to :inherit and 'default implemented."
+ :group 'preview-appearance)
+
+(defcustom preview-auto-reveal
+ '(eval (preview-arrived-via (key-binding [left]) (key-binding [right])
+ 'backward-char 'forward-char))
+ "*Cause previews to open automatically when entered.
+Possibilities are:
+T autoopens,
+NIL doesn't,
+a symbol will have its value consulted if it exists,
+defaulting to NIL if it doesn't.
+An integer will specify a maximum cursor movement distance.
+Larger movements won't open the preview.
+A CONS-cell means to call a function for determining the value.
+The CAR of the cell is the function to call which receives
+the CDR of the CONS-cell in the rest of the arguments, while
+point and current buffer point to the position in question.
+All of the options show reasonable defaults."
+ :group 'preview-appearance
+ :type '(choice (const :tag "Off" nil)
+ (const :tag "On" t)
+ (symbol :tag "Indirect variable" :value reveal-mode)
+ (integer :tag "Maximum distance" :value 1)
+ (cons :tag "Function call"
+ :value (eval (preview-arrived-via
+ (key-binding [left])
+ (key-binding [right])))
+ function (list :tag "Argument list"
+ (repeat :inline t sexp)))))
+
+(defun preview-auto-reveal-p (mode distance)
+ "Decide whether to auto-reveal.
+Returns non-NIL if region should be auto-opened.
+See `preview-auto-reveal' for definitions of MODE, which gets
+set to `preview-auto-reveal'. DISTANCE specifies the movement
+distance with which point has been reached in case it has been
+a movement starting in the current buffer."
+ (cond ((symbolp mode)
+ (and (boundp mode)
+ (symbol-value mode)))
+ ((integerp mode)
+ (and distance (/= 0 distance) (<= (abs distance) mode)))
+ ((consp mode)
+ (apply (car mode) (cdr mode)))
+ (t mode)))
+
+(defun preview-arrived-via (&rest list)
+ "Indicate auto-opening.
+Returns non-NIL if called by one of the commands in LIST."
+ (memq this-command list))
+
+(defcustom preview-equality-transforms '(identity
+ preview-canonical-spaces)
+"Transformation functions for region changes.
+These functions are tried in turn on the strings from the
+regions of a preview to decide whether a preview is to be considered
+changed. If any transform leads to equal results, the preview is
+considered unchanged."
+ :group 'preview-appearance
+ :type '(repeat function))
+
+(defun preview-relaxed-string= (&rest args)
+"Check for functional equality of arguments.
+The arguments ARGS are checked for equality by using
+`preview-equality-transforms' on them until it is exhausted
+or one transform returns equality."
+ (let ((lst preview-equality-transforms))
+ (while (and lst (not (apply #'string= (mapcar (car lst) args))))
+ (setq lst (cdr lst)))
+ lst))
+
+(defun preview-canonical-spaces (arg)
+ "Convert ARG into canonical form.
+Removes comments and collapses white space, except for multiple newlines."
+ (let (pos)
+ (while (setq pos (string-match "\\s<.*[\n\r][ \t]*" arg pos))
+ (setq arg (replace-match "" t t arg 0)))
+ (while (setq pos (string-match "[ \t]*\\(\\([ \t]\\)\\|[\n\r][ \t]*\\)"
+ arg pos))
+ (setq arg (replace-match (if (match-beginning 2) " " "\n") t t arg 0)
+ pos (1+ pos)))
+ (while (setq pos (string-match "\n+" arg pos))
+ (if (string= "\n" (match-string 0 arg))
+ (setq arg (replace-match " " t t arg 0)
+ pos (1+ pos))
+ (setq pos (match-end 0)))))
+ arg)
+
+(defun preview-regenerate (ovr)
+ "Pass the modified region in OVR again through LaTeX."
+ (let ((begin (overlay-start ovr))
+ (end (overlay-end ovr)))
+ (with-current-buffer (overlay-buffer ovr)
+ (preview-delete ovr)
+ (preview-region begin end))))
+
+(defcustom preview-inner-environments '("Bmatrix" "Vmatrix" "aligned"
+ "array" "bmatrix" "cases"
+ "gathered" "matrix" "pmatrix"
+ "smallmatrix" "split"
+ "subarray" "vmatrix")
+ "Environments not to be previewed on their own."
+ :group 'preview-latex
+ :type '(repeat string))
+
+
+(defun preview-next-border (backwards)
+ "Search for the next interesting border for `preview-at-point'.
+Searches backwards if BACKWARDS is non-nil."
+ (let (history preview-state (pt (point)))
+ (catch 'exit
+ (while
+ (null
+ (memq
+ (setq preview-state
+ (if backwards
+ (if (> (setq pt
+ (previous-single-char-property-change
+ pt 'preview-state)) (point-min))
+ (get-char-property (1- pt) 'preview-state)
+ (throw 'exit (or history (point-min))))
+ (if (< (setq pt
+ (next-single-char-property-change
+ pt 'preview-state)) (point-max))
+ (get-char-property pt 'preview-state)
+ (throw 'exit (or history (point-max))))))
+ '(active inactive)))
+ (setq history (and (not preview-state) pt)))
+ (or history pt))))
+
+(defun preview-at-point ()
+ "Do the appropriate preview thing at point.
+If point is positioned on or inside of an unmodified preview area,
+its visibility is toggled.
+
+If not, the surroundings are run through preview. The
+surroundings don't extend into unmodified previews or past
+contiguous previews invalidated by modifications.
+
+Overriding any other action, if a region is
+active (`transient-mark-mode' or `zmacs-regions'), it is run
+through `preview-region'."
+ (interactive)
+ (if (TeX-active-mark)
+ (preview-region (region-beginning) (region-end))
+ (catch 'exit
+ (dolist (ovr (overlays-in (max (point-min) (1- (point)))
+ (min (point-max) (1+ (point)))))
+ (let ((preview-state (overlay-get ovr 'preview-state)))
+ (when preview-state
+ (unless (eq preview-state 'disabled)
+ (preview-toggle ovr 'toggle (selected-window))
+ (throw 'exit t)))))
+ (preview-region (preview-next-border t)
+ (preview-next-border nil)))))
+
+(defun preview-disabled-string (ov)
+ "Generate a before-string for disabled preview overlay OV."
+ (concat (preview-make-clickable
+ (overlay-get ov 'preview-map)
+ preview-icon
+ "\
+%s regenerates preview
+%s more options"
+ `(lambda() (interactive) (preview-regenerate ,ov)))
+;; icon on separate line only for stuff starting on its own line
+ (with-current-buffer (overlay-buffer ov)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (overlay-start ov))
+ (if (bolp) "\n" ""))))))
+
+(defun preview-disable (ovr)
+ "Change overlay behaviour of OVR after source edits."
+ (overlay-put ovr 'queued nil)
+ (preview-remove-urgentization ovr)
+ (overlay-put ovr 'preview-image nil)
+ (overlay-put ovr 'timestamp nil)
+ (setcdr (overlay-get ovr 'strings) (preview-disabled-string ovr))
+ (preview-toggle ovr)
+ (overlay-put ovr 'preview-state 'disabled)
+ (dolist (filename (overlay-get ovr 'filenames))
+ (condition-case nil
+ (preview-delete-file filename)
+ (file-error nil))
+ (overlay-put ovr 'filenames nil)))
+
+(defun preview-delete (ovr &rest ignored)
+ "Delete preview overlay OVR, taking any associated file along.
+IGNORED arguments are ignored, making this function usable as
+a hook in some cases"
+ (let ((filenames (overlay-get ovr 'filenames)))
+ (overlay-put ovr 'filenames nil)
+ (delete-overlay ovr)
+ (dolist (filename filenames)
+ (condition-case nil
+ (preview-delete-file filename)
+ (file-error nil)))))
+
+(defun preview-clearout (&optional start end timestamp)
+ "Clear out all previews in the current region.
+When called interactively, the current region is used.
+Non-interactively, the region between START and END is
+affected. Those two values default to the borders of
+the entire buffer. If TIMESTAMP is non-nil, previews
+with a `timestamp' property of it are kept."
+ (interactive "r")
+ (dolist (ov (overlays-in (or start (point-min))
+ (or end (point-max))))
+ (and (overlay-get ov 'preview-state)
+ (not (and timestamp
+ (equal timestamp (overlay-get ov 'timestamp))))
+ (preview-delete ov))))
+
+(defun preview-clearout-buffer (&optional buffer)
+ "Clearout BUFFER from previews, current buffer if nil."
+ (interactive)
+ (if buffer
+ (with-current-buffer buffer (preview-clearout))
+ (preview-clearout)))
+
+(defun preview-clearout-section ()
+ "Clearout previews from LaTeX section."
+ (interactive)
+ (save-excursion
+ (LaTeX-mark-section)
+ (preview-clearout (region-beginning) (region-end))))
+
+(defun preview-clearout-at-point ()
+ "Clearout any preview at point."
+ (interactive)
+ (preview-clearout (max (point-min) (1- (point)))
+ (min (point-max) (1+ (point)))))
+
+(defun preview-walk-document (func)
+ "Cycle through all buffers belonging to current document.
+Each buffer having the same master file as the current file
+has FUNC called with its current buffer being set to it."
+ (let* ((buffers (buffer-list))
+ (master (expand-file-name (TeX-master-file t)))
+ (default-buffers (list (current-buffer)
+ (find-buffer-visiting master))))
+ (while buffers
+ (with-current-buffer (pop buffers)
+ (when
+ (or (memq (current-buffer) default-buffers)
+ (and (memq major-mode '(plain-tex-mode latex-mode))
+ (or (stringp TeX-master)
+ (eq TeX-master t))
+ (string= (expand-file-name (TeX-master-file t))
+ master)))
+ (funcall func))))))
+
+(defun preview-clearout-document ()
+ "Clear out all previews in current document.
+The document consists of all buffers that have the same master file
+as the current buffer. This makes the current document lose
+all previews."
+ (interactive)
+ (preview-walk-document #'preview-clearout-buffer))
+
+(defun preview-kill-buffer-cleanup (&optional buf)
+ "This is a cleanup function just for use in hooks.
+Cleans BUF or current buffer. The difference to
+`preview-clearout-buffer' is that previews
+associated with the last buffer modification time are
+kept."
+ (with-current-buffer (or buf (current-buffer))
+ (save-restriction
+ (widen)
+ (preview-clearout (point-min) (point-max) (visited-file-modtime)))))
+
+(add-hook 'kill-buffer-hook #'preview-kill-buffer-cleanup)
+(add-hook 'before-revert-hook #'preview-kill-buffer-cleanup)
+
+(defvar preview-last-counter)
+
+(defun preview-extract-counters (ctr)
+ (setq preview-last-counter
+ (prog1 (copy-sequence ctr)
+ (dolist (elt preview-last-counter)
+ (setq ctr (delete elt ctr)))))
+ (apply #'concat ctr))
+
+(defun desktop-buffer-preview-misc-data (&rest ignored)
+ "Hook function that extracts previews for persistent sessions."
+ (unless (buffer-modified-p)
+ (setq preview-last-counter nil)
+ (save-restriction
+ (widen)
+ (let (save-info (timestamp (visited-file-modtime)))
+ (dolist (ov (sort (overlays-in (point-min) (point-max))
+ (lambda (x y) (< (overlay-start x)
+ (overlay-start y)))))
+ (when (and (memq (overlay-get ov 'preview-state) '(active inactive))
+ (null (overlay-get ov 'queued))
+ (cdr (overlay-get ov 'preview-image)))
+ (push (preview-dissect ov timestamp) save-info)))
+ (and save-info
+ (cons 'preview (cons timestamp (nreverse save-info))))))))
+
+(eval-after-load "desktop"
+ '(add-hook
+ 'desktop-buffer-misc-functions
+ #'desktop-buffer-preview-misc-data))
+
+(defvar preview-temp-dirs nil
+"List of top level temporary directories in use from preview.
+Any directory not in this list will be cleared out by preview
+on first use.")
+
+(defun preview-dissect (ov timestamp)
+ "Extract all persistent data from OV and TIMESTAMP it."
+ (let ((filenames (butlast (nth 0 (overlay-get ov 'filenames)))))
+ (overlay-put ov 'timestamp timestamp)
+ (list (overlay-start ov)
+ (overlay-end ov)
+ (cdr (overlay-get ov 'preview-image))
+ filenames
+ (let ((ctr (overlay-get ov 'preview-counters)))
+ (and ctr
+ (cons (preview-extract-counters (car ctr))
+ (preview-extract-counters (cdr ctr))))))))
+
+(defun preview-buffer-restore-internal (buffer-misc)
+ "Restore previews from BUFFER-MISC if proper.
+Remove them if they have expired."
+ (let ((timestamp (visited-file-modtime)) tempdirlist files)
+ (setq preview-parsed-counters nil)
+ (when (eq 'preview (pop buffer-misc))
+ (preview-get-geometry)
+ (if (equal (pop buffer-misc) timestamp)
+ (dolist (ovdata buffer-misc)
+ (setq tempdirlist
+ (apply #'preview-reinstate-preview tempdirlist
+ timestamp ovdata)))
+ (dolist (ovdata buffer-misc)
+ (setq files (nth 3 ovdata))
+ (condition-case nil
+ (delete-file (nth 0 files))
+ (file-error nil))
+ (unless (member (nth 1 files) tempdirlist)
+ (push (nth 1 files) tempdirlist)))
+ (dolist (dir tempdirlist)
+ (condition-case nil
+ (delete-directory dir)
+ (file-error nil)))))))
+
+
+(defun preview-buffer-restore (buffer-misc)
+ "At end of desktop load, reinstate previews.
+This delay is so that minor modes changing buffer positions
+\(like `x-symbol-mode' does) will not wreak havoc.
+BUFFER-MISC is the appropriate data to be used."
+ (add-hook 'desktop-delay-hook `(lambda ()
+ (with-current-buffer ,(current-buffer)
+ (preview-buffer-restore-internal
+ ',buffer-misc)))))
+
+(defun desktop-buffer-preview (desktop-buffer-file-name
+ desktop-buffer-name
+ desktop-buffer-misc)
+ "Hook function for restoring persistent previews into a buffer."
+ (when (and desktop-buffer-file-name
+ (file-readable-p desktop-buffer-file-name))
+ (let ((buf (find-file-noselect desktop-buffer-file-name)))
+ (if (eq (car desktop-buffer-misc) 'preview)
+ (with-current-buffer buf
+ (preview-buffer-restore desktop-buffer-misc)
+ buf)
+ buf))))
+
+(eval-after-load "desktop"
+ '(if (boundp 'desktop-buffer-mode-handlers)
+ (add-to-list 'desktop-buffer-mode-handlers
+ '(latex-mode . desktop-buffer-preview))
+ (add-hook 'desktop-buffer-handlers '(lambda ()
+ (desktop-buffer-preview
+ desktop-buffer-file-name
+ desktop-buffer-name
+ desktop-buffer-misc)))))
+
+(defcustom preview-auto-cache-preamble 'ask
+ "*Whether to generate a preamble cache format automatically.
+Possible values are nil, t, and `ask'."
+ :group 'preview-latex
+ :type '(choice (const :tag "Cache" t)
+ (const :tag "Don't cache" nil)
+ (const :tag "Ask" ask)))
+
+(defvar preview-dumped-alist nil
+ "Alist of dumped masters.
+The elements are (NAME . ASSOC). NAME is the master file name
+\(without extension), ASSOC is what to do with regard to this
+format. Possible values: NIL means no format is available
+and none should be generated. T means no format is available,
+it should be generated on demand. If the value is a cons cell,
+the CAR of the cons cell is the command with which the format
+has been generated, and the CDR is some Emacs-flavor specific
+value used for maintaining a watch on possible changes of the
+preamble.")
+
+(defun preview-cleanout-tempfiles ()
+ "Clean out all directories and files with non-persistent data.
+This is called as a hook when exiting Emacs."
+ (mapc #'preview-kill-buffer-cleanup (buffer-list))
+ (mapc #'preview-format-kill preview-dumped-alist))
+
+(defun preview-inactive-string (ov)
+ "Generate before-string for an inactive preview overlay OV.
+This is for overlays where the source text has been clicked
+visible. For efficiency reasons it is expected that the buffer
+is already selected and unnarrowed."
+ (concat
+ (preview-make-clickable (overlay-get ov 'preview-map)
+ preview-icon
+ "\
+%s redisplays preview
+%s more options")
+;; icon on separate line only for stuff starting on its own line
+ (with-current-buffer (overlay-buffer ov)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (overlay-start ov))
+ (if (bolp) "\n" ""))))))
+
+(defun preview-dvipng-place-all ()
+ "Place all images dvipng has created, if any.
+Deletes the dvi file when finished."
+ (let (filename queued oldfiles snippet)
+ (dolist (ov (prog1 preview-gs-queue (setq preview-gs-queue nil)))
+ (when (and (setq queued (overlay-get ov 'queued))
+ (setq snippet (aref (overlay-get ov 'queued) 2))
+ (setq filename (preview-make-filename
+ (format "prev%03d.%s"
+ snippet preview-dvipng-image-type)
+ TeX-active-tempdir)))
+ (if (file-exists-p (car filename))
+ (progn
+ (overlay-put ov 'filenames (list filename))
+ (preview-replace-active-icon
+ ov
+ (preview-create-icon (car filename)
+ preview-dvipng-image-type
+ (preview-ascent-from-bb
+ (aref queued 0))
+ (aref preview-colors 2)))
+ (overlay-put ov 'queued nil))
+ (push filename oldfiles)
+ (overlay-put ov 'filenames nil)
+ (push ov preview-gs-queue))))
+ (if (setq preview-gs-queue (nreverse preview-gs-queue))
+ (progn
+ (preview-start-dvips preview-fast-conversion)
+ (setq TeX-sentinel-function (lambda (process command)
+ (preview-gs-dvips-sentinel
+ process
+ command
+ t)))
+ (dolist (ov preview-gs-queue)
+ (setq snippet (aref (overlay-get ov 'queued) 2))
+ (overlay-put ov 'filenames
+ (list
+ (preview-make-filename
+ (or preview-ps-file
+ (format "preview.%03d" snippet))
+ TeX-active-tempdir))))
+ (while (setq filename (pop oldfiles))
+ (condition-case nil
+ (preview-delete-file filename)
+ (file-error nil))))
+ (condition-case nil
+ (let ((gsfile preview-gs-file))
+ (delete-file
+ (with-current-buffer TeX-command-buffer
+ (funcall (car gsfile) "dvi"))))
+ (file-error nil)))))
+
+(defun preview-active-string (ov)
+ "Generate before-string for active image overlay OV."
+ (preview-make-clickable
+ (overlay-get ov 'preview-map)
+ (car (overlay-get ov 'preview-image))
+ "%s opens text
+%s more options"))
+
+(defun preview-make-filename (file tempdir)
+ "Generate a preview filename from FILE and TEMPDIR.
+Filenames consist of a CONS-cell with absolute file name as CAR
+and TEMPDIR as CDR. TEMPDIR is a copy of `TeX-active-tempdir'
+with the directory name, the reference count and its top directory
+name elements. If FILE is already in that form, the file name itself
+gets converted into a CONS-cell with a name and a reference count."
+ (if (consp file)
+ (progn
+ (if (consp (car file))
+ (setcdr (car file) (1+ (cdr (car file))))
+ (setcar file (cons (car file) 1)))
+ file)
+ (setcar (nthcdr 2 tempdir) (1+ (nth 2 tempdir)))
+ (cons (expand-file-name file (nth 0 tempdir))
+ tempdir)))
+
+(defun preview-attach-filename (attached file)
+ "Attaches the absolute file name ATTACHED to FILE."
+ (if (listp (caar file))
+ (setcar (car file) (cons attached (caar file)))
+ (setcar (car file) (list attached (caar file))))
+ file)
+
+(defun preview-delete-file (file)
+ "Delete a preview FILE.
+See `preview-make-filename' for a description of the data
+structure. If the containing directory becomes empty,
+it gets deleted as well."
+ (let ((filename
+ (if (consp (car file))
+ (and (zerop
+ (setcdr (car file) (1- (cdr (car file)))))
+ (car (car file)))
+ (car file))))
+ (if filename
+ (unwind-protect
+ (if (listp filename)
+ (dolist (elt filename) (delete-file elt))
+ (delete-file filename))
+ (let ((tempdir (cdr file)))
+ (when tempdir
+ (if (> (nth 2 tempdir) 1)
+ (setcar (nthcdr 2 tempdir) (1- (nth 2 tempdir)))
+ (setcdr file nil)
+ (delete-directory (nth 0 tempdir)))))))))
+
+(defvar preview-buffer-has-counters nil)
+(make-variable-buffer-local 'preview-buffer-has-counters)
+
+(defun preview-place-preview (snippet start end
+ box counters tempdir place-opts)
+ "Generate and place an overlay preview image.
+This generates the filename for the preview
+snippet SNIPPET in the current buffer, and uses it for the
+region between START and END. BOX is an optional preparsed
+TeX bounding BOX passed on to the `place' hook.
+COUNTERS is the info about saved counter structures.
+TEMPDIR is a copy of `TeX-active-tempdir'.
+PLACE-OPTS are additional arguments passed into
+`preview-parse-messages'. Returns
+a list with additional info from the placement hook.
+Those lists get concatenated together and get passed
+to the close hook."
+ (preview-clearout start end tempdir)
+ (let ((ov (make-overlay start end nil nil nil)))
+ (when (fboundp 'TeX-overlay-prioritize)
+ (overlay-put ov 'priority (TeX-overlay-prioritize start end)))
+ (overlay-put ov 'preview-map
+ (preview-make-clickable
+ nil nil nil
+ `(lambda(event) (interactive "e")
+ (preview-toggle ,ov 'toggle event))
+ `(lambda(event) (interactive "e")
+ (preview-context-menu ,ov event))))
+ (overlay-put ov 'timestamp tempdir)
+ (when (cdr counters)
+ (overlay-put ov 'preview-counters counters)
+ (setq preview-buffer-has-counters t))
+ (prog1 (apply #'preview-call-hook 'place ov snippet box
+ place-opts)
+ (overlay-put ov 'strings
+ (list (preview-active-string ov)))
+ (preview-toggle ov t))))
+
+;; The following is a brutal hack. It relies on `begin' being let to
+;; the start of the interesting area when TeX-region-create is being
+;; called.
+
+(defun preview-counter-find (begin)
+ "Fetch the next preceding or next preview-counters property.
+Factored out because of compatibility macros XEmacs would
+not use in advice."
+ ;; The following two lines are bug workaround for Emacs < 22.1.
+ (if (markerp begin)
+ (setq begin (marker-position begin)))
+ (or (car (get-char-property begin 'preview-counters))
+ (cdr (get-char-property (max (point-min)
+ (1- begin))
+ 'preview-counters))
+ (cdr (get-char-property
+ (max (point-min)
+ (1- (previous-single-char-property-change
+ begin
+ 'preview-counters)))
+ 'preview-counters))
+ (car (get-char-property
+ (next-single-char-property-change begin 'preview-counters)
+ 'preview-counters))))
+
+(defadvice TeX-region-create (around preview-counters)
+ "Write out counter information to region."
+ (let ((TeX-region-extra
+ (concat
+ (and (boundp 'begin)
+ preview-buffer-has-counters
+ (mapconcat
+ #'identity
+ (cons
+ ""
+ (preview-counter-find (symbol-value 'begin)))
+ "\\setcounter"))
+ TeX-region-extra)))
+ ad-do-it))
+
+(defun preview-reinstate-preview (tempdirlist timestamp start end
+ image filename &optional counters)
+ "Reinstate a single preview.
+This gets passed TEMPDIRLIST, a list consisting of the kind
+of entries used in `TeX-active-tempdir', and TIMESTAMP, the
+time stamp under which the file got read in. It returns an augmented
+list. START and END give the buffer location where the preview
+is to be situated, IMAGE the image to place there, and FILENAME
+the file to use: a triple consisting of filename, its temp directory
+and the corresponding topdir. COUNTERS is saved counter information,
+if any."
+ (when
+ (or (null filename) (file-readable-p (car filename)))
+ (when filename
+ (unless (equal (nth 1 filename) (car TeX-active-tempdir))
+ (setq TeX-active-tempdir
+ (or (assoc (nth 1 filename) tempdirlist)
+ (car (push (append (cdr filename) (list 0))
+ tempdirlist))))
+ (setcar (cdr TeX-active-tempdir)
+ (car (or (member (nth 1 TeX-active-tempdir)
+ preview-temp-dirs)
+ (progn
+ (add-hook 'kill-emacs-hook
+ #'preview-cleanout-tempfiles t)
+ (push (nth 1 TeX-active-tempdir)
+ preview-temp-dirs))))))
+ (setcar (nthcdr 2 TeX-active-tempdir)
+ (1+ (nth 2 TeX-active-tempdir)))
+ (setcdr filename TeX-active-tempdir)
+ (setq filename (list filename)))
+ (let ((ov (make-overlay start end nil nil nil)))
+ (when (fboundp 'TeX-overlay-prioritize)
+ (overlay-put ov 'priority (TeX-overlay-prioritize start end)))
+ (overlay-put ov 'preview-map
+ (preview-make-clickable
+ nil nil nil
+ `(lambda(event) (interactive "e")
+ (preview-toggle ,ov 'toggle event))
+ `(lambda(event) (interactive "e")
+ (preview-context-menu ,ov event))))
+ (when counters
+ (overlay-put
+ ov 'preview-counters
+ (cons
+ (mapcar #'cdr
+ (if (string= (car counters) "")
+ preview-parsed-counters
+ (setq preview-parsed-counters
+ (preview-parse-counters (car counters)))))
+ (mapcar #'cdr
+ (if (string= (cdr counters) "")
+ preview-parsed-counters
+ (setq preview-parsed-counters
+ (preview-parse-counters (cdr counters)))))))
+ (setq preview-buffer-has-counters t))
+ (overlay-put ov 'filenames filename)
+ (overlay-put ov 'preview-image (cons (preview-import-image image)
+ image))
+ (overlay-put ov 'strings
+ (list (preview-active-string ov)))
+ (overlay-put ov 'timestamp timestamp)
+ (preview-toggle ov t)))
+ tempdirlist)
+
+(defun preview-back-command (&optional nocomplex)
+ "Move backward a TeX token.
+If NOCOMPLEX is set, only basic tokens and no argument sequences
+will be skipped over backwards."
+ (let ((oldpos (point)) oldpoint)
+ (condition-case nil
+ (or (search-backward-regexp "\\(\\$\\$?\
+\\|\\\\[^a-zA-Z@]\
+\\|\\\\[a-zA-Z@]+\
+\\|\\\\begin[ \t]*{[^}]+}\
+\\)\\=" (line-beginning-position) t)
+ nocomplex
+ (if (eq ?\) (char-syntax (char-before)))
+ (while
+ (progn
+ (setq oldpoint (point))
+ (backward-sexp)
+ (and (not (eq oldpoint (point)))
+ (eq ?\( (char-syntax (char-after))))))
+ (backward-char)))
+ (error (goto-char oldpos)))))
+
+(defcustom preview-required-option-list '("active" "tightpage" "auctex"
+ (preview-preserve-counters
+ "counters"))
+ "Specifies required options passed to the preview package.
+These are passed regardless of whether there is an explicit
+\\usepackage of that package present."
+ :group 'preview-latex
+ :type preview-expandable-string)
+
+(defcustom preview-preserve-counters nil
+ "Try preserving counters for partial runs if set."
+ :group 'preview-latex
+ :type 'boolean)
+
+(defcustom preview-default-option-list '("displaymath" "floats"
+ "graphics" "textmath" "sections"
+ "footnotes")
+ "*Specifies default options to pass to preview package.
+These options are only used when the LaTeX document in question does
+not itself load the preview package, namely when you use preview
+on a document not configured for preview. \"auctex\", \"active\",
+\"dvips\" and \"delayed\" need not be specified here."
+ :group 'preview-latex
+ :type '(list (set :inline t :tag "Options known to work"
+ :format "%t:\n%v%h" :doc
+ "The above options are all the useful ones
+at the time of the release of this package.
+You should not need \"Other options\" unless you
+upgraded to a fancier version of just the LaTeX style.
+Please also note that `psfixbb' fails to have an effect if
+`preview-fast-conversion' or `preview-prefer-TeX-bb'
+are selected."
+ (const "displaymath")
+ (const "floats")
+ (const "graphics")
+ (const "textmath")
+ (const "sections")
+ (const "footnotes")
+ (const "showlabels")
+ (const "psfixbb"))
+ (set :tag "Expert options" :inline t
+ :format "%t:\n%v%h" :doc
+ "Expert options should not be enabled permanently."
+ (const "noconfig")
+ (const "showbox")
+ (const "tracingall"))
+ (repeat :inline t :tag "Other options" (string))))
+
+(defcustom preview-default-preamble
+ '("\\RequirePackage[" ("," . preview-default-option-list)
+ "]{preview}[2004/11/05]")
+ "*Specifies default preamble code to add to a LaTeX document.
+If the document does not itself load the preview package, that is,
+when you use preview on a document not configured for preview, this
+list of LaTeX commands is inserted just before \\begin{document}."
+ :group 'preview-latex
+ :type preview-expandable-string)
+
+(defcustom preview-LaTeX-command '("%`%l \"\\nonstopmode\\nofiles\
+\\PassOptionsToPackage{" ("," . preview-required-option-list) "}{preview}\
+\\AtBeginDocument{\\ifx\\ifPreview\\undefined"
+preview-default-preamble "\\fi}\"%' %t")
+ "*Command used for starting a preview.
+See description of `TeX-command-list' for details."
+ :group 'preview-latex
+ :type preview-expandable-string)
+
+(defun preview-goto-info-page ()
+ "Read documentation for preview-latex in the info system."
+ (interactive)
+ (info "(preview-latex)"))
+
+(eval-after-load 'info '(add-to-list 'Info-file-list-for-emacs
+ '("preview" . "preview-latex")))
+
+(defvar preview-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\C-p" #'preview-at-point)
+ (define-key map "\C-r" #'preview-region)
+ (define-key map "\C-b" #'preview-buffer)
+ (define-key map "\C-d" #'preview-document)
+ (define-key map "\C-f" #'preview-cache-preamble)
+ (define-key map "\C-c\C-f" #'preview-cache-preamble-off)
+ (define-key map "\C-i" #'preview-goto-info-page)
+ ;; (define-key map "\C-q" #'preview-paragraph)
+ (define-key map "\C-e" #'preview-environment)
+ (define-key map "\C-s" #'preview-section)
+ (define-key map "\C-w" #'preview-copy-region-as-mml)
+ (define-key map "\C-c\C-p" #'preview-clearout-at-point)
+ (define-key map "\C-c\C-r" #'preview-clearout)
+ (define-key map "\C-c\C-s" #'preview-clearout-section)
+ (define-key map "\C-c\C-b" #'preview-clearout-buffer)
+ (define-key map "\C-c\C-d" #'preview-clearout-document)
+ map))
+
+(defun preview-copy-text (ov)
+ "Copy the text of OV into the kill buffer."
+ (save-excursion
+ (set-buffer (overlay-buffer ov))
+ (copy-region-as-kill (overlay-start ov) (overlay-end ov))))
+
+(defun preview-copy-mml (ov)
+ "Copy an MML representation of OV into the kill buffer.
+This can be used to send inline images in mail and news when
+using MML mode."
+ (when (catch 'badcolor
+ (let ((str (car (preview-format-mml ov))))
+ (if str
+ (if (eq last-command 'kill-region)
+ (kill-append str nil)
+ (kill-new str))
+ (error "No image file available")))
+ nil)
+ (let (preview-transparent-border)
+ (preview-regenerate ov))))
+
+(defun preview-copy-region-as-mml (start end)
+ (interactive "r")
+ (when (catch 'badcolor
+ (let (str lst dont-ask)
+ (dolist (ov (overlays-in start end))
+ (when (setq str (preview-format-mml ov dont-ask))
+ (setq dont-ask (cdr str))
+ (and
+ (>= (overlay-start ov) start)
+ (<= (overlay-end ov) end)
+ (push (list (- (overlay-start ov) start)
+ (- (overlay-end ov) start)
+ (car str)) lst))))
+ (setq str (buffer-substring start end))
+ (dolist (elt (nreverse (sort lst #'car-less-than-car)))
+ (setq str (concat (substring str 0 (nth 0 elt))
+ (nth 2 elt)
+ (substring str (nth 1 elt)))))
+ (if (eq last-command 'kill-region)
+ (kill-append str nil)
+ (kill-new str)))
+ nil)
+ (let (preview-transparent-border)
+ (preview-region start end))))
+
+(autoload 'mailcap-extension-to-mime "mailcap")
+
+(defun preview-format-mml (ov &optional dont-ask)
+ "Return an MML representation of OV as string.
+This can be used to send inline images in mail and news when
+using MML mode. If there is nothing current available,
+NIL is returned. If the image has a colored border and the
+user wants it removed when asked (unless DONT-ASK is set),
+'badcolor is thrown a t. The MML is returned in the car of the
+result, DONT-ASK in the cdr."
+ (and (memq (overlay-get ov 'preview-state) '(active inactive))
+ (not (overlay-get ov 'queued))
+ (let* ((text (with-current-buffer (overlay-buffer ov)
+ (buffer-substring (overlay-start ov)
+ (overlay-end ov))))
+ (image (cdr (overlay-get ov 'preview-image)))
+ file type)
+ (cond ((consp image)
+ (and (not dont-ask)
+ (nth 3 image)
+ (if (y-or-n-p "Replace colored borders? ")
+ (throw 'badcolor t)
+ (setq dont-ask t)))
+ (setq file (car (car (last (overlay-get ov 'filenames))))
+ type (mailcap-extension-to-mime
+ (file-name-extension file)))
+ (cons
+ (format "<#part %s
+description=\"%s\"
+filename=%s>
+<#/part>"
+ (if type
+ (format "type=\"%s\" disposition=inline" type)
+ "disposition=attachment")
+ (if (string-match "[\n\"]" text)
+ "preview-latex image"
+ text)
+ (if (string-match "[ \n<>]" file)
+ (concat "\"" file "\"")
+ file))
+ dont-ask))
+ ((stringp image)
+ (cons image dont-ask))))))
+
+(defun preview-active-contents (ov)
+ "Check whether we have a valid image associated with OV."
+ (and (memq (overlay-get ov 'preview-state) '(active inactive)) t))
+
+(defun preview-context-menu (ov ev)
+ "Pop up a menu for OV at position EV."
+ (popup-menu
+ `("Preview"
+ ["Toggle" (preview-toggle ,ov 'toggle ',ev)
+ (preview-active-contents ,ov)]
+ ["Regenerate" (preview-regenerate ,ov)]
+ ["Remove" (preview-delete ,ov)]
+ ["Copy text" (preview-copy-text ,ov)]
+ ["Copy MIME" (preview-copy-mml ,ov)
+ (preview-active-contents ,ov)])
+ ev))
+
+(defvar preview-TeX-style-dir)
+
+(defun preview-TeX-style-cooked ()
+ "Return `preview-TeX-style-dir' in cooked form.
+This will be fine for prepending to a `TEXINPUT' style
+environment variable, including an initial `.' at the front."
+ (if (or (zerop (length preview-TeX-style-dir))
+ (member (substring preview-TeX-style-dir -1) '(";" ":")))
+ preview-TeX-style-dir
+ (let ((sep
+ (cond
+ ((stringp TeX-kpathsea-path-delimiter)
+ TeX-kpathsea-path-delimiter)
+ ((string-match
+ "\\`.[:]"
+ (if (file-name-absolute-p preview-TeX-style-dir)
+ preview-TeX-style-dir
+ (expand-file-name preview-TeX-style-dir)))
+ ";")
+ (t ":"))))
+ (concat "." sep preview-TeX-style-dir sep))))
+
+(defun preview-set-texinputs (&optional remove)
+ "Add `preview-TeX-style-dir' into `TEXINPUTS' variables.
+With prefix argument REMOVE, remove it again."
+ (interactive "P")
+ (let ((case-fold-search nil)
+ (preview-TeX-style-dir (preview-TeX-style-cooked))
+ pattern)
+ (if remove
+ (progn
+ (setq pattern (concat "\\`\\(TEXINPUTS[^=]*\\)=\\(.*\\)"
+ (regexp-quote preview-TeX-style-dir)))
+ (dolist (env (copy-sequence process-environment))
+ (if (string-match pattern env)
+ (setenv (match-string 1 env)
+ (and (or (< (match-beginning 2) (match-end 2))
+ (< (match-end 0) (length env)))
+ (concat (match-string 2 env)
+ (substring env (match-end 0))))))))
+ (setq pattern (regexp-quote preview-TeX-style-dir))
+ (dolist (env (cons "TEXINPUTS=" (copy-sequence process-environment)))
+ (if (string-match "\\`\\(TEXINPUTS[^=]*\\)=" env)
+ (unless (string-match pattern env)
+ (setenv (match-string 1 env)
+ (concat preview-TeX-style-dir
+ (substring env (match-end 0))))))))))
+
+(defcustom preview-TeX-style-dir nil
+ "This variable contains the location of uninstalled TeX styles.
+If this is nil, the preview styles are considered to be part of
+the installed TeX system.
+
+Otherwise, it can either just specify an absolute directory, or
+it can be a complete TEXINPUTS specification. If it is the
+latter, it has to be followed by the character with which
+kpathsea separates path components, either `:' on Unix-like
+systems, or `;' on Windows-like systems. And it should be
+preceded with .: or .; accordingly in order to have . first in
+the search path.
+
+The `TEXINPUT' environment type variables will get this prepended
+at load time calling \\[preview-set-texinputs] to reflect this.
+You can permanently install the style files using
+\\[preview-install-styles].
+
+Don't set this variable other than with customize so that its
+changes get properly reflected in the environment."
+ :group 'preview-latex
+ :set (lambda (var value)
+ (and (boundp var)
+ (symbol-value var)
+ (preview-set-texinputs t))
+ (set var value)
+ (and (symbol-value var)
+ (preview-set-texinputs)))
+ :type '(choice (const :tag "Installed" nil)
+ (string :tag "Style directory or TEXINPUTS path")))
+
+;;;###autoload
+(defun preview-install-styles (dir &optional force-overwrite
+ force-save)
+ "Installs the TeX style files into a permanent location.
+This must be in the TeX search path. If FORCE-OVERWRITE is greater
+than 1, files will get overwritten without query, if it is less
+than 1 or nil, the operation will fail. The default of 1 for interactive
+use will query.
+
+Similarly FORCE-SAVE can be used for saving
+`preview-TeX-style-dir' to record the fact that the uninstalled
+files are no longer needed in the search path."
+ (interactive "DPermanent location for preview TeX styles
+pp")
+ (unless preview-TeX-style-dir
+ (error "Styles are already installed"))
+ (dolist (file (or
+ (condition-case nil
+ (directory-files
+ (progn
+ (string-match
+ "\\`\\(\\.[:;]\\)?\\(.*?\\)\\([:;]\\)?\\'"
+ preview-TeX-style-dir)
+ (match-string 2 preview-TeX-style-dir))
+ t "\\.\\(sty\\|def\\|cfg\\)\\'")
+ (error nil))
+ (error "Can't find files to install")))
+ (copy-file file dir (cond ((eq force-overwrite 1) 1)
+ ((numberp force-overwrite)
+ (> force-overwrite 1))
+ (t force-overwrite))))
+ (if (cond ((eq force-save 1)
+ (y-or-n-p "Stop using non-installed styles permanently "))
+ ((numberp force-save)
+ (> force-save 1))
+ (t force-save))
+ (customize-save-variable 'preview-TeX-style-dir nil)
+ (customize-set-variable 'preview-TeX-style-dir nil)))
+
+;;;###autoload
+(defun LaTeX-preview-setup ()
+ "Hook function for embedding the preview package into AUCTeX.
+This is called by `LaTeX-mode-hook' and changes AUCTeX variables
+to add the preview functionality."
+ (remove-hook 'LaTeX-mode-hook #'LaTeX-preview-setup)
+ (add-hook 'LaTeX-mode-hook #'preview-mode-setup)
+ (define-key LaTeX-mode-map "\C-c\C-p" preview-map)
+ (easy-menu-define preview-menu LaTeX-mode-map
+ "This is the menu for preview-latex."
+ '("Preview"
+ "Generate previews"
+ ["(or toggle) at point" preview-at-point]
+ ["for environment" preview-environment]
+ ["for section" preview-section]
+ ["for region" preview-region (preview-mark-active)]
+ ["for buffer" preview-buffer]
+ ["for document" preview-document]
+ "---"
+ "Remove previews"
+ ["at point" preview-clearout-at-point]
+ ["from section" preview-clearout-section]
+ ["from region" preview-clearout (preview-mark-active)]
+ ["from buffer" preview-clearout-buffer]
+ ["from document" preview-clearout-document]
+ "---"
+ "Turn preamble cache"
+ ["on" preview-cache-preamble]
+ ["off" preview-cache-preamble-off]
+ "---"
+ ("Customize"
+ ["Browse options"
+ (customize-group 'preview)]
+ ["Extend this menu"
+ (easy-menu-add-item
+ nil '("Preview")
+ (customize-menu-create 'preview))])
+ ["Read documentation" preview-goto-info-page]
+ ["Report Bug" preview-report-bug]))
+ (if (eq major-mode 'latex-mode)
+ (preview-mode-setup))
+ (if (boundp 'desktop-buffer-misc)
+ (preview-buffer-restore desktop-buffer-misc)))
+
+(defun preview-clean-subdir (dir)
+ "Cleans out a temporary DIR with preview image files."
+ (condition-case err
+ (progn
+ (mapc #'delete-file
+ (directory-files dir t "\\`pr" t))
+ (delete-directory dir))
+ (error (message "Deletion of `%s' failed: %s" dir
+ (error-message-string err)))))
+
+(defun preview-clean-topdir (topdir)
+ "Cleans out TOPDIR from temporary directories.
+This does not erase the directory itself since its permissions
+might be needed for colloborative work on common files."
+ (mapc #'preview-clean-subdir
+ (condition-case nil
+ (directory-files topdir t "\\`tmp" t)
+ (file-error nil))))
+
+(defun preview-create-subdirectory ()
+ "Create a temporary subdir for the current TeX process.
+If necessary, generates a fitting top
+directory or cleans out an existing one (if not yet
+visited in this session), then returns the name of
+the created subdirectory relative to the master directory,
+in shell-quoted form. `TeX-active-tempdir' is
+set to the corresponding TEMPDIR descriptor as described
+in `preview-make-filename'. The directory is registered
+in `preview-temp-dirs' in order not to be cleaned out
+later while in use."
+ (let ((topdir (expand-file-name (TeX-active-master "prv"))))
+ (if (file-directory-p topdir)
+ (unless (member topdir preview-temp-dirs)
+ ;; Cleans out the top preview directory by
+ ;; removing subdirs possibly left from a previous session.
+ (preview-clean-topdir topdir)
+ (push topdir preview-temp-dirs))
+ (make-directory topdir)
+ (add-to-list 'preview-temp-dirs topdir))
+ (add-hook 'kill-emacs-hook #'preview-cleanout-tempfiles t)
+ (setq TeX-active-tempdir
+ (list (make-temp-file (expand-file-name
+ "tmp" (file-name-as-directory topdir)) t)
+ topdir
+ 0))
+ (shell-quote-argument
+ (concat (file-name-as-directory (file-name-nondirectory topdir))
+ (file-name-nondirectory (nth 0 TeX-active-tempdir))))))
+
+;; Hook into TeX immediately if it's loaded, use LaTeX-mode-hook if not.
+(if (featurep 'latex)
+ (LaTeX-preview-setup)
+ (add-hook 'LaTeX-mode-hook #'LaTeX-preview-setup))
+
+;;;###autoload (add-hook 'LaTeX-mode-hook #'LaTeX-preview-setup)
+
+(defun preview-parse-counters (string)
+ "Extract counter information from STRING."
+ (let ((list preview-parsed-counters) (pos 0))
+ (while (eq pos (string-match " *\\({\\([^{}]+\\)}{[-0-9]+}\\)" string pos))
+ (setcdr (or (assoc (match-string 2 string) list)
+ (car (push (list (match-string 2 string)) list)))
+ (match-string 1 string))
+ (setq pos (match-end 1)))
+ list))
+
+(defun preview-parse-tightpage (string)
+ "Build tightpage vector from STRING,"
+ (read (concat "[" string "]")))
+
+(defvar preview-parse-variables
+ '(("Fontsize" preview-parsed-font-size
+ "\\` *\\([0-9.]+\\)pt\\'" 1 string-to-number)
+ ("Magnification" preview-parsed-magnification
+ "\\` *\\([0-9]+\\)\\'" 1 string-to-number)
+ ("PDFoutput" preview-parsed-pdfoutput
+ "" 0 stringp)
+ ("Counters" preview-parsed-counters
+ ".*" 0 preview-parse-counters)
+ ("Tightpage" preview-parsed-tightpage
+ "\\` *\\(-?[0-9]+ *\\)\\{4\\}\\'" 0 preview-parse-tightpage)))
+
+(defun preview-error-quote (string run-coding-system)
+ "Turn STRING with potential ^^ sequences into a regexp.
+To preserve sanity, additional ^ prefixes are matched literally,
+so the character represented by ^^^ preceding extended characters
+will not get matched, usually."
+ (let (output case-fold-search)
+ (when (featurep 'mule)
+ (setq string (encode-coding-string string run-coding-system)))
+ (while (string-match "\\^\\{2,\\}\\(\\([@-_?]\\)\\|[8-9a-f][0-9a-f]\\)"
+ string)
+ (setq output
+ (concat output
+ (regexp-quote (substring string
+ 0
+ (- (match-beginning 1) 2)))
+ (if (match-beginning 2)
+ (concat
+ "\\(?:" (regexp-quote
+ (substring string
+ (- (match-beginning 1) 2)
+ (match-end 0)))
+ "\\|"
+ (char-to-string
+ (logxor (aref string (match-beginning 2)) 64))
+ "\\)")
+ (char-to-string
+ (string-to-number (match-string 1 string) 16))))
+ string (substring string (match-end 0))))
+ (setq output (concat output (regexp-quote string)))
+ (if (featurep 'mule)
+ (decode-coding-string output
+ (or (and (boundp
'TeX-japanese-process-output-coding-system)
+
TeX-japanese-process-output-coding-system)
+ buffer-file-coding-system))
+ output)))
+
+(defun preview-parse-messages (open-closure)
+ "Turn all preview snippets into overlays.
+This parses the pseudo error messages from the preview
+document style for LaTeX. OPEN-CLOSURE is called once
+it is certain that we have a valid output file, and it has
+to return in its CAR the PROCESS parameter for the CLOSE
+call, and in its CDR the final stuff for the placement hook."
+ (with-temp-message "locating previews..."
+ (let (TeX-error-file TeX-error-offset snippet box counters
+ file line
+ (lsnippet 0) lstart (lfile "") lline lbuffer lpoint
+ lcounters
+ string after-string error context-start
+ context offset
+ parsestate (case-fold-search nil)
+ (run-buffer (current-buffer))
+ (run-coding-system preview-coding-system)
+ (run-directory default-directory)
+ tempdir
+ close-data
+ open-data
+ fast-hook
+ slow-hook)
+ ;; clear parsing variables
+ (dolist (var preview-parse-variables)
+ (set (nth 1 var) nil))
+ (goto-char (point-min))
+ (unwind-protect
+ (progn
+ (while
+ (re-search-forward "\
+^\\(!\\|\\(.*?\\):[0-9]+:\\) \\|\
+\(\\(/*\
+\\(?:\\.+[^()\r\n{} /]*\\|[^()\r\n{} ./]+\
+\\(?: [^()\r\n{} ./]+\\)*\\(?:\\.[-0-9a-zA-Z_.]*\\)?\\)\
+\\(?:/+\\(?:\\.+[^()\r\n{} /]*\\|[^()\r\n{} ./]+\
+\\(?: [^()\r\n{} ./]+\\)*\\(?:\\.[-0-9a-zA-Z_.]*\\)?\\)?\\)*\\)\
+)*\\(?: \\|\r?$\\)\\|\
+\\()+\\)\\|\
+ !\\(?:offset(\\([---0-9]+\\))\\|\
+name(\\([^)]+\\))\\)\\|\
+^Preview: \\([a-zA-Z]+\\) \\([^\n\r]*\\)\r?$" nil t)
+;;; Ok, here is a line by line breakdown:
+;;; match-alternative 1:
+;;; error indicator for TeX error, either style.
+;;; match-alternative 2:
+;;; The same, but file-line-error-style, matching on file name.
+;;; match-alternative 3:
+;;; Too ugly to describe in detail. In short, we try to catch file
+;;; names built from path components that don't contain spaces or
+;;; other special characters once the file extension has started.
+;;;
+;;; Position for searching immediately after the file name so as to
+;;; not miss closing parens or something.
+;;; (match-string 3) is the file name.
+;;; match-alternative 4:
+;;; )+\( \|$\)
+;;; a closing paren followed by the end of line or a space: a just
+;;; closed file.
+;;; match-alternative 5 (wrapped into one shy group with
+;;; match-alternative 6, so that the match on first char is slightly
+;;; faster):
+;;; !offset(\([---0-9]+\))
+;;; an AUCTeX offset message. (match-string 5) is the offset itself
+;;; !name(\([^)]+\))
+;;; an AUCTeX file name message. (match-string 6) is the file name
+;;; TODO: Actually, the latter two should probably again match only
+;;; after a space or newline, since that it what \message produces.
+;;;disabled in prauctex.def:
+;;;\(?:Ov\|Und\)erfull \\.*[0-9]*--[0-9]*
+;;;\(?:.\{79\}
+;;;\)*.*$\)\|
+;;; This would have caught overfull box messages that consist of
+;;; several lines of context all with 79 characters in length except
+;;; of the last one. prauctex.def kills all such messages.
+ (setq file (match-string-no-properties 2))
+ (cond
+ ((match-beginning 1)
+ (if (looking-at "\
+\\(?:Preview\\|Package Preview Error\\): Snippet \\([---0-9]+\\)
\\(started\\|ended\\(\
+\\.? *(\\([---0-9]+\\)\\+\\([---0-9]+\\)x\\([---0-9]+\\))\\)?\\)\\.")
+ (progn
+ (when file
+ (unless TeX-error-file
+ (push nil TeX-error-file)
+ (push nil TeX-error-offset))
+ (unless (car TeX-error-offset)
+ (rplaca TeX-error-file file)))
+ (setq snippet (string-to-number (match-string 1))
+ box (unless
+ (string= (match-string 2) "started")
+ (if (match-string 4)
+ (mapcar #'(lambda (x)
+ (* (preview-get-magnification)
+ (string-to-number x)))
+ (list
+ (match-string 4)
+ (match-string 5)
+ (match-string 6)))
+ t))
+ counters (mapcar #'cdr preview-parsed-counters)
+ error (progn
+ (setq lpoint (point))
+ (end-of-line)
+ (buffer-substring lpoint (point)))
+
+ ;; And the context for the help window.
+ context-start (point)
+
+ ;; And the line number to position the cursor.
+;;; variant 1: profiling seems to indicate the regexp-heavy solution
+;;; to be favorable. Removing incomplete characters from the error
+;;; context is an absolute nuisance.
+ line (and (re-search-forward "\
+^l\\.\\([0-9]+\\) \\(\\.\\.\\.\\(?:\\^*\\(?:[89a-f][0-9a-f]\\|[]@-\\_?]\\)\\|\
+\[0-9a-f]?\\)\\)?\\([^\n\r]*?\\)\r?
+\\([^\n\r]*?\\)\\(\\(?:\\^+[89a-f]?\\)?\\.\\.\\.\\)?\r?$" nil t)
+ (string-to-number (match-string 1)))
+ ;; And a string of the context to search for.
+ string (and line (match-string 3))
+ after-string (and line (buffer-substring
+ (+ (match-beginning 4)
+ (- (match-end 3)
+ (match-beginning 0)))
+ (match-end 4)))
+
+ ;; And we have now found to the end of the context.
+ context (buffer-substring context-start (point))
+ ;; We may use these in another buffer.
+ offset (or (car TeX-error-offset) 0)
+ file (car TeX-error-file))
+ (when (and (stringp file)
+ (or (string= file "<none>")
+ (TeX-match-extension file)))
+ ;; if we are the first time round, check for fast hooks:
+ (when (null parsestate)
+ (setq open-data
+ (save-excursion (funcall open-closure))
+ tempdir TeX-active-tempdir)
+ (dolist
+ (lst (if (listp TeX-translate-location-hook)
+ TeX-translate-location-hook
+ (list TeX-translate-location-hook)))
+ (let ((fast
+ (and (symbolp lst)
+ (get lst 'TeX-translate-via-list))))
+ (if fast
+ (setq fast-hook
+ (nconc fast-hook (list fast)))
+ (setq slow-hook
+ (nconc slow-hook (list lst)))))))
+ (condition-case err
+ (save-excursion (run-hooks 'slow-hook))
+ (error (preview-log-error err "Translation hook")))
+ (push (vector file (+ line offset)
+ string after-string
+ snippet box counters) parsestate)))
+ ;; else normal error message
+ (forward-line)
+ (re-search-forward "^l\\.[0-9]" nil t)
+ (forward-line 2)))
+ ((match-beginning 3)
+ ;; New file -- Push on stack
+ (push (match-string-no-properties 3) TeX-error-file)
+ (push nil TeX-error-offset)
+ (goto-char (match-end 3)))
+ ((match-beginning 4)
+ ;; End of file -- Pop from stack
+ (when (> (length TeX-error-file) 1)
+ (pop TeX-error-file)
+ (pop TeX-error-offset))
+ (goto-char (1+ (match-beginning 0))))
+ ((match-beginning 5)
+ ;; Hook to change line numbers
+ (setq TeX-error-offset
+ (list (string-to-number (match-string 5)))))
+ ((match-beginning 6)
+ ;; Hook to change file name
+ (setq TeX-error-file (list (match-string-no-properties 6))))
+ ((match-beginning 7)
+ (let ((var
+ (assoc (match-string-no-properties 7)
+ preview-parse-variables))
+ (offset (- (match-beginning 0) (match-beginning 8)))
+ (str (match-string-no-properties 8)))
+ ;; paste together continuation lines:
+ (while (= (- (length str) offset) 79)
+ (search-forward-regexp "^\\([^\n\r]*\\)\r?$")
+ (setq offset (- (length str))
+ str (concat str (match-string-no-properties 1))))
+ (when (and var
+ (string-match (nth 2 var) str))
+ (set (nth 1 var)
+ (funcall (nth 4 var)
+ (match-string-no-properties
+ (nth 3 var)
+ str))))))))
+ (when (null parsestate)
+ (error "LaTeX found no preview images")))
+ (unwind-protect
+ (save-excursion
+ (setq parsestate (nreverse parsestate))
+ (condition-case err
+ (dolist (fun fast-hook)
+ (setq parsestate
+ (save-excursion (funcall fun parsestate))))
+ (error (preview-log-error err "Fast translation hook")))
+ (setq snippet 0)
+ (dolist (state parsestate)
+ (setq lsnippet snippet
+ file (aref state 0)
+ line (aref state 1)
+ string (aref state 2)
+ after-string (aref state 3)
+ snippet (aref state 4)
+ box (aref state 5)
+ counters (aref state 6))
+ (unless (string= lfile file)
+ (set-buffer (if (string= file "<none>")
+ (with-current-buffer run-buffer
+ TeX-command-buffer)
+ (find-file-noselect
+ (expand-file-name file run-directory))))
+ (setq lfile file))
+ (save-excursion
+ (save-restriction
+ (widen)
+ ;; a fast hook might have positioned us already:
+ (if (number-or-marker-p string)
+ (progn
+ (goto-char string)
+ (setq lpoint
+ (if (number-or-marker-p after-string)
+ after-string
+ (line-beginning-position))))
+ (if (and (eq (current-buffer) lbuffer)
+ (<= lline line))
+ ;; while Emacs does the perfectly correct
+ ;; thing even when when the line differences
+ ;; get zero or negative, I don't trust this
+ ;; to be universally the case across other
+ ;; implementations. Besides, if the line
+ ;; number gets smaller again, we are probably
+ ;; rereading the file, and restarting from
+ ;; the beginning will probably be faster.
+ (progn
+ (goto-char lpoint)
+ (if (/= lline line)
+ (if (eq selective-display t)
+ (re-search-forward "[\n\C-m]" nil
+ 'end
+ (- line lline))
+ (forward-line (- line lline)))))
+ (goto-line line))
+ (setq lpoint (point))
+ (cond
+ ((search-forward (concat string after-string)
+ (line-end-position) t)
+ (backward-char (length after-string)))
+ ;;ok, transform ^^ sequences
+ ((search-forward-regexp
+ (concat "\\("
+ (setq string
+ (preview-error-quote
+ string
+ run-coding-system))
+ "\\)"
+ (setq after-string
+ (preview-error-quote
+ after-string
+ run-coding-system)))
+ (line-end-position) t)
+ (goto-char (match-end 1)))
+ ((search-forward-regexp
+ (concat "\\("
+ (if (string-match
+ "^[^\0-\177]\\{1,6\\}" string)
+ (setq string
+ (substring string (match-end 0)))
+ string)
+ "\\)"
+ (if (string-match
+ "[^\0-\177]\\{1,6\\}$" after-string)
+ (setq after-string
+ (substring after-string
+ 0 (match-beginning 0)))))
+ (line-end-position) t)
+ (goto-char (match-end 1)))
+ (t (search-forward-regexp
+ string
+ (line-end-position) t))))
+ (setq lline line
+ lbuffer (current-buffer))
+ (if box
+ (progn
+ (if (and lstart (= snippet lsnippet))
+ (setq close-data
+ (nconc
+ (preview-place-preview
+ snippet
+ (save-excursion
+ (preview-back-command
+ (= (prog1 (point)
+ (goto-char lstart))
+ lstart))
+ (point))
+ (point)
+ (preview-TeX-bb box)
+ (cons lcounters counters)
+ tempdir
+ (cdr open-data))
+ close-data))
+ (with-current-buffer run-buffer
+ (preview-log-error
+ (list 'error
+ (format
+ "End of Preview snippet %d unexpected"
+ snippet)) "Parser")))
+ (setq lstart nil))
+ ;; else-part of if box
+ (setq lstart (point) lcounters counters)
+ ;; >= because snippets in between might have
+ ;; been ignored because of TeX-default-extension
+ (unless (>= snippet (1+ lsnippet))
+ (with-current-buffer run-buffer
+ (preview-log-error
+ (list 'error
+ (format
+ "Preview snippet %d out of sequence"
+ snippet)) "Parser"))))))))
+ (preview-call-hook 'close (car open-data) close-data))))))
+
+(defun preview-get-geometry ()
+ "Transfer display geometry parameters from current display.
+Returns list of scale, resolution and colors. Calculation
+is done in current buffer."
+ (condition-case err
+ (let* ((geometry
+ (list (preview-hook-enquiry preview-scale-function)
+ (cons (/ (* 25.4 (display-pixel-width))
+ (display-mm-width))
+ (/ (* 25.4 (display-pixel-height))
+ (display-mm-height)))
+ (preview-get-colors)))
+ (preview-min-spec
+ (* (cdr (nth 1 geometry))
+ (/
+ (preview-inherited-face-attribute
+ 'preview-reference-face :height 'default)
+ 720.0))))
+ (setq preview-icon (preview-make-image 'preview-icon-specs)
+ preview-error-icon (preview-make-image
+ 'preview-error-icon-specs)
+ preview-nonready-icon (preview-make-image
+ 'preview-nonready-icon-specs))
+ geometry)
+ (error (error "Display geometry unavailable: %s"
+ (error-message-string err)))))
+
+(defun preview-set-geometry (geometry)
+ "Set geometry variables from GEOMETRY.
+Buffer-local `preview-scale', `preview-resolution',
+and `preview-colors' are set as given."
+ (setq preview-scale (nth 0 geometry)
+ preview-resolution (nth 1 geometry)
+ preview-colors (nth 2 geometry)))
+
+(defun preview-start-dvipng ()
+ "Start a DviPNG process.."
+ (let* ((file preview-gs-file)
+ tempdir
+ (res (/ (* (car preview-resolution)
+ (preview-hook-enquiry preview-scale))
+ (preview-get-magnification)))
+ (resolution (format " -D%d " res))
+ (colors (preview-dvipng-color-string preview-colors res))
+ (command (with-current-buffer TeX-command-buffer
+ (prog1
+ (concat (TeX-command-expand preview-dvipng-command
+ (car file))
+ " " colors resolution)
+ (setq tempdir TeX-active-tempdir))))
+ (name "Preview-DviPNG"))
+ (setq TeX-active-tempdir tempdir)
+ (goto-char (point-max))
+ (insert-before-markers "Running `" name "' with ``" command "''\n")
+ (setq mode-name name)
+ (setq TeX-sentinel-function
+ (lambda (process name) (message "%s: done." name)))
+ (if TeX-process-asynchronous
+ (let ((process (start-process name (current-buffer) TeX-shell
+ TeX-shell-command-option
+ command)))
+ (if TeX-after-start-process-function
+ (funcall TeX-after-start-process-function process))
+ (TeX-command-mode-line process)
+ (set-process-filter process 'TeX-command-filter)
+ (set-process-sentinel process 'TeX-command-sentinel)
+ (set-marker (process-mark process) (point-max))
+ (push process compilation-in-progress)
+ (sit-for 0)
+ process)
+ (setq mode-line-process ": run")
+ (set-buffer-modified-p (buffer-modified-p))
+ (sit-for 0) ; redisplay
+ (call-process TeX-shell nil (current-buffer) nil
+ TeX-shell-command-option
+ command))))
+
+(defun preview-start-dvips (&optional fast)
+ "Start a DviPS process.
+If FAST is set, do a fast conversion."
+ (let* ((file preview-gs-file)
+ tempdir
+ (command (with-current-buffer TeX-command-buffer
+ (prog1
+ (TeX-command-expand (if fast
+ preview-fast-dvips-command
+ preview-dvips-command)
+ (car file))
+ (setq tempdir TeX-active-tempdir))))
+ (name "Preview-DviPS"))
+ (setq TeX-active-tempdir tempdir)
+ (setq preview-ps-file (and fast
+ (preview-make-filename
+ (preview-make-filename
+ "preview.ps" tempdir) tempdir)))
+ (goto-char (point-max))
+ (insert-before-markers "Running `" name "' with ``" command "''\n")
+ (setq mode-name name)
+ (setq TeX-sentinel-function
+ (lambda (process name) (message "%s: done." name)))
+ (if TeX-process-asynchronous
+ (let ((process (start-process name (current-buffer) TeX-shell
+ TeX-shell-command-option
+ command)))
+ (if TeX-after-start-process-function
+ (funcall TeX-after-start-process-function process))
+ (TeX-command-mode-line process)
+ (set-process-filter process 'TeX-command-filter)
+ (set-process-sentinel process 'TeX-command-sentinel)
+ (set-marker (process-mark process) (point-max))
+ (push process compilation-in-progress)
+ (sit-for 0)
+ process)
+ (setq mode-line-process ": run")
+ (set-buffer-modified-p (buffer-modified-p))
+ (sit-for 0) ; redisplay
+ (call-process TeX-shell nil (current-buffer) nil
+ TeX-shell-command-option
+ command))))
+
+(defun preview-start-pdf2dsc ()
+ "Start a PDF2DSC process."
+ (let* ((file preview-gs-file)
+ tempdir
+ pdfsource
+ (command (with-current-buffer TeX-command-buffer
+ (prog1
+ (TeX-command-expand preview-pdf2dsc-command
+ (car file))
+ (setq tempdir TeX-active-tempdir
+ pdfsource (funcall `,(car file) "pdf")))))
+ (name "Preview-PDF2DSC"))
+ (setq TeX-active-tempdir tempdir)
+ (setq preview-ps-file (preview-attach-filename
+ pdfsource
+ (preview-make-filename
+ (preview-make-filename
+ "preview.dsc" tempdir) tempdir)))
+ (goto-char (point-max))
+ (insert-before-markers "Running `" name "' with ``" command "''\n")
+ (setq mode-name name)
+ (setq TeX-sentinel-function
+ (lambda (process name) (message "%s: done." name)))
+ (if TeX-process-asynchronous
+ (let ((process (start-process name (current-buffer) TeX-shell
+ TeX-shell-command-option
+ command)))
+ (if TeX-after-start-process-function
+ (funcall TeX-after-start-process-function process))
+ (TeX-command-mode-line process)
+ (set-process-filter process 'TeX-command-filter)
+ (set-process-sentinel process 'TeX-command-sentinel)
+ (set-marker (process-mark process) (point-max))
+ (push process compilation-in-progress)
+ (sit-for 0)
+ process)
+ (setq mode-line-process ": run")
+ (set-buffer-modified-p (buffer-modified-p))
+ (sit-for 0) ; redisplay
+ (call-process TeX-shell nil (current-buffer) nil
+ TeX-shell-command-option
+ command))))
+
+(defun preview-TeX-inline-sentinel (process name)
+ "Sentinel function for preview.
+See `TeX-sentinel-function' and `set-process-sentinel'
+for definition of PROCESS and NAME."
+ (if process (TeX-format-mode-line process))
+ (let ((status (process-status process)))
+ (if (memq status '(signal exit))
+ (delete-process process))
+ (when (eq status 'exit)
+ (save-excursion
+ (goto-char (point-max))
+ (forward-line -1)
+ (if (search-forward "abnormally with code 1" nil t)
+ (replace-match "as expected with code 1" t t)
+ (if (search-forward "finished" nil t)
+ (insert " with nothing to show"))))
+ (condition-case err
+ (preview-call-hook 'open)
+ (error (preview-log-error err "LaTeX" process)))
+ (preview-reraise-error process))))
+
+(defcustom preview-format-extensions '(".fmt" ".efmt")
+ "Possible extensions for format files.
+Those are just needed for cleanup."
+ :group 'preview-latex
+ :type '(repeat string))
+
+(defun preview-format-kill (format-cons)
+ "Kill a cached format.
+FORMAT-CONS is intended to be an element of `preview-dumped-alist'.
+Tries through `preview-format-extensions'."
+ (dolist (ext preview-format-extensions)
+ (condition-case nil
+ (delete-file (preview-dump-file-name (concat (car format-cons) ext)))
+ (file-error nil))))
+
+(defun preview-dump-file-name (file)
+ "Make a file name suitable for dumping from FILE."
+ (if file
+ (concat (file-name-directory file)
+ "prv_"
+ (progn
+ (setq file (file-name-nondirectory file))
+ (while (string-match " " file)
+ (setq file (replace-match "_" t t file)))
+ file))
+ "prv_texput"))
+
+(defun preview-do-replacements (string replacements)
+ "Perform replacements in string.
+STRING is the input string, REPLACEMENTS is a list of replacements.
+A replacement is a cons-cell, where the car is the match string,
+and the cdr is a list of strings or symbols. Symbols get dereferenced,
+and strings get evaluated as replacement strings."
+ (let (rep case-fold-search)
+ (while replacements
+ (setq rep (pop replacements))
+ (cond ((symbolp rep)
+ (setq string (preview-do-replacements
+ string (symbol-value rep))))
+ ((string-match (car rep) string)
+ (setq string
+ (mapconcat (lambda(x)
+ (if (symbolp x)
+ (symbol-value x)
+ (replace-match x t nil string)))
+ (cdr rep) ""))))))
+ string)
+
+(defconst preview-LaTeX-disable-pdfoutput
+ '(("\\`\\(pdf[^ ]*\\)\
+\\(\\( [-&]\\([^ \"]\\|\"[^\"]*\"\\)*\\|\
+ \"[-&][^\"]*\"\\)*\\)\\(.*\\)\\'"
+ . ("\\1\\2 \"\\\\pdfoutput=0 \" \\5")))
+ "This replacement places `\"\\pdfoutput=0 \"' after the options
+of any command starting with `pdf'.")
+
+(defcustom preview-LaTeX-command-replacements
+ nil
+ "Replacement for `preview-LaTeX-command'.
+This is passed through `preview-do-replacements'."
+ :group 'preview-latex
+ :type '(repeat
+ (choice
+ (symbol :tag "Named replacement" :value
preview-LaTeX-disable-pdfoutput)
+ (cons (string :tag "Matched string")
+ (repeat :tag "Concatenated elements for replacement"
+ (choice (symbol :tag "Variable with literal string")
+ (string :tag "non-literal regexp
replacement")))))))
+
+(defvar preview-format-name)
+
+(defcustom preview-dump-replacements
+ '(preview-LaTeX-command-replacements
+ ("\\`\\([^ ]+\\)\
+\\(\\( +-\\([^ \\\\\"]\\|\\\\\\.\\|\"[^\"]*\"\\)*\\)*\\)\\(.*\\)\\'"
+ . ("\\1 -ini -interaction=nonstopmode \"&\\1\" " preview-format-name
".ini \\5")))
+ "Generate a dump command from the usual preview command."
+ :group 'preview-latex
+ :type '(repeat
+ (choice (symbol :tag "Named replacement")
+ (cons string (repeat (choice symbol string))))))
+
+(defcustom preview-undump-replacements
+ '(("\\`\\([^ ]+\\)\
+ .*? \"\\\\input\" \\(.*\\)\\'"
+ . ("\\1 -interaction=nonstopmode \"&" preview-format-name "\" \\2")))
+ "Use a dumped format for reading preamble."
+ :group 'preview-latex
+ :type '(repeat
+ (choice (symbol :tag "Named replacement")
+ (cons string (repeat (choice symbol string))))))
+
+
+(defun preview-cache-preamble (&optional format-cons)
+ "Dump a pregenerated format file.
+For the rest of the session, this file is used when running
+on the same master file.
+
+Returns the process for dumping, nil if there is still a valid
+format available.
+
+If FORMAT-CONS is non-nil, a previous format may get reused."
+ (interactive)
+ (let* ((dump-file
+ (expand-file-name (preview-dump-file-name (TeX-master-file "ini"))))
+ (master (TeX-master-file))
+ (format-name (expand-file-name master))
+ (preview-format-name (shell-quote-argument
+ (preview-dump-file-name (file-name-nondirectory
+ master))))
+ (master-file (expand-file-name (TeX-master-file t)))
+ (command (preview-do-replacements
+ (TeX-command-expand
+ (preview-string-expand preview-LaTeX-command)
+ 'TeX-master-file)
+ preview-dump-replacements))
+ (preview-auto-cache-preamble nil))
+ (unless (and (consp (cdr format-cons))
+ (string= command (cadr format-cons)))
+ (unless format-cons
+ (setq format-cons (assoc format-name preview-dumped-alist)))
+ (if format-cons
+ (preview-cache-preamble-off format-cons)
+ (setq format-cons (list format-name))
+ (push format-cons preview-dumped-alist))
+ ;; mylatex.ltx expects a file name to follow. Bad. `.tex'
+ ;; in the tools bundle is an empty file.
+ (write-region "\\ifx\\pdfoutput\\undefined\\else\
+\\let\\PREVIEWdump\\dump\\def\\dump{%
+\\edef\\next{{\\catcode`\\ 9 \\pdfoutput=\\the\\pdfoutput\\relax\
+\\the\\everyjob}}\\everyjob\\next\\catcode`\\ 10
\\let\\dump\\PREVIEWdump\\dump}\\fi\\input mylatex.ltx \\relax\n" nil dump-file)
+ (TeX-save-document master)
+ (prog1
+ (preview-generate-preview
+ nil (file-name-nondirectory master)
+ command)
+ (add-hook 'kill-emacs-hook #'preview-cleanout-tempfiles t)
+ (setq TeX-sentinel-function
+ `(lambda (process string)
+ (condition-case err
+ (progn
+ (if (and (eq (process-status process) 'exit)
+ (zerop (process-exit-status process)))
+ (preview-watch-preamble
+ ',master-file
+ ',command
+ ',format-cons)
+ (preview-format-kill ',format-cons))
+ (delete-file ',dump-file))
+ (error (preview-log-error err "Dumping" process)))
+ (preview-reraise-error process)))))))
+
+(defun preview-cache-preamble-off (&optional old-format)
+ "Clear the pregenerated format file.
+The use of the format file is discontinued.
+OLD-FORMAT may already contain a format-cons as
+stored in `preview-dumped-alist'."
+ (interactive)
+ (unless old-format
+ (setq old-format
+ (let ((master-file (expand-file-name (TeX-master-file))))
+ (or (assoc master-file preview-dumped-alist)
+ (car (push (list master-file) preview-dumped-alist))))))
+ (preview-unwatch-preamble old-format)
+ (preview-format-kill old-format)
+ (setcdr old-format nil))
+
+(defun preview-region (begin end)
+ "Run preview on region between BEGIN and END."
+ (interactive "r")
+ (TeX-region-create (TeX-region-file TeX-default-extension)
+ (buffer-substring begin end)
+ (if buffer-file-name
+ (file-name-nondirectory buffer-file-name)
+ "<none>")
+ (save-restriction
+ (widen)
+ (let ((inhibit-point-motion-hooks t)
+ (inhibit-field-text-motion t))
+ (+ (count-lines (point-min) begin)
+ (save-excursion
+ (goto-char begin)
+ (if (bolp) 0 -1))))))
+ (preview-generate-preview t (TeX-region-file nil t)
+ (preview-do-replacements
+ (TeX-command-expand
+ (preview-string-expand preview-LaTeX-command)
+ 'TeX-region-file)
+ preview-LaTeX-command-replacements)))
+
+(defun preview-buffer ()
+ "Run preview on current buffer."
+ (interactive)
+ (preview-region (point-min) (point-max)))
+
+;; We have a big problem: When we are dumping preambles, diagnostics
+;; issued in later runs will not make it to the output when the
+;; predumped format skips the preamble. So we have to place those
+;; after \begin{document}. This we can only do if regions never
+;; include the preamble. We could do this in our own functions, but
+;; that would not extend to the operation of C-c C-r g RET. So we
+;; make this preamble skipping business part of TeX-region-create.
+;; This will fail if the region is to contain just part of the
+;; preamble -- a bad idea anyhow.
+
+(defadvice TeX-region-create (before preview-preamble preactivate activate)
+ "Skip preamble for the sake of predumped formats."
+ (when (string-match TeX-header-end (ad-get-arg 1))
+ (ad-set-arg 1
+ (prog1 (substring (ad-get-arg 1) (match-end 0))
+ (ad-set-arg 3
+ (with-temp-buffer
+ (insert (substring (ad-get-arg 1)
+ 0 (match-end 0)))
+ (+ (ad-get-arg 3)
+ (count-lines (point-min) (point-max))
+ (if (bolp) 0 -1))))))))
+
+(defun preview-document ()
+ "Run preview on master document."
+ (interactive)
+ (TeX-save-document (TeX-master-file))
+ (preview-generate-preview
+ nil (TeX-master-file nil t)
+ (preview-do-replacements
+ (TeX-command-expand
+ (preview-string-expand preview-LaTeX-command)
+ 'TeX-master-file)
+ preview-LaTeX-command-replacements)))
+
+(defun preview-environment (count)
+ "Run preview on LaTeX environment.
+This avoids running environments through preview that are
+indicated in `preview-inner-environments'. If you use a prefix
+argument COUNT, the corresponding level of outward nested
+environments is selected."
+ (interactive "p")
+ (save-excursion
+ (let (currenv)
+ (dotimes (i (1- count))
+ (setq currenv (LaTeX-current-environment))
+ (if (string= currenv "document")
+ (error "No enclosing outer environment found"))
+ (LaTeX-find-matching-begin))
+ (while (member (setq currenv (LaTeX-current-environment))
+ preview-inner-environments)
+ (LaTeX-find-matching-begin))
+ (if (string= currenv "document")
+ (error "No enclosing outer environment found"))
+ (preview-region
+ (save-excursion (LaTeX-find-matching-begin) (point))
+ (save-excursion (LaTeX-find-matching-end) (point))))))
+
+(defun preview-section ()
+ "Run preview on LaTeX section." (interactive)
+ (save-excursion
+ (LaTeX-mark-section)
+ (preview-region (region-beginning) (region-end))))
+
+
+(defun preview-generate-preview (region-p file command)
+ "Generate a preview.
+REGION-P is the region flag, FILE the file (without default
+extension and directory), COMMAND is the command to use.
+
+It returns the started process."
+ (setq TeX-current-process-region-p region-p)
+ (let* ((geometry (preview-get-geometry))
+ (commandbuff (current-buffer))
+ (pr-file (cons
+ (if TeX-current-process-region-p
+ 'TeX-region-file
+ 'TeX-master-file)
+ file))
+ (master (TeX-master-file))
+ (master-file (expand-file-name master))
+ (dumped-cons (assoc master-file
+ preview-dumped-alist))
+ process)
+ (unless dumped-cons
+ (push (setq dumped-cons (cons master-file
+ (if (eq preview-auto-cache-preamble 'ask)
+ (y-or-n-p "Cache preamble? ")
+ preview-auto-cache-preamble)))
+ preview-dumped-alist))
+ (when (cdr dumped-cons)
+ (let* (TeX-current-process-region-p)
+ (setq process (preview-cache-preamble dumped-cons))
+ (if process
+ (setq TeX-sentinel-function
+ `(lambda (process string)
+ (funcall ,TeX-sentinel-function process string)
+ (TeX-inline-preview-internal
+ ,command ,file
+ ',pr-file ,commandbuff
+ ',dumped-cons
+ ',master
+ ',geometry
+ (buffer-string)))))))
+ (or process
+ (TeX-inline-preview-internal command file
+ pr-file commandbuff
+ dumped-cons master
+ geometry))))
+
+(defun TeX-inline-preview-internal (command file pr-file
+ commandbuff dumped-cons master
+ geometry
+ &optional str)
+ "Internal stuff for previewing.
+COMMAND and FILE should be explained in `TeX-command-list'.
+PR-FILE is the target file name in the form for `preview-gs-file'.
+COMMANDBUFF, DUMPED-CONS, MASTER, and GEOMETRY are
+internal parameters, STR may be a log to insert into the current log."
+ (set-buffer commandbuff)
+ (let*
+ ((preview-format-name (shell-quote-argument
+ (preview-dump-file-name
+ (file-name-nondirectory master))))
+ (process
+ (TeX-run-command
+ "Preview-LaTeX"
+ (if (consp (cdr dumped-cons))
+ (preview-do-replacements
+ command preview-undump-replacements)
+ command) file)))
+ (condition-case err
+ (progn
+ (when str
+ (save-excursion
+ (goto-char (point-min))
+ (insert str)
+ (when (= (process-mark process) (point-min))
+ (set-marker (process-mark process) (point)))))
+ (preview-set-geometry geometry)
+ (setq preview-gs-file pr-file)
+ (setq TeX-sentinel-function 'preview-TeX-inline-sentinel)
+ (when (featurep 'mule)
+ (setq preview-coding-system
+ (or (and (boundp 'TeX-japanese-process-output-coding-system)
+ TeX-japanese-process-output-coding-system)
+ (with-current-buffer commandbuff
+ buffer-file-coding-system)))
+ (when preview-coding-system
+ (setq preview-coding-system
+ (preview-buffer-recode-system
+ (coding-system-base preview-coding-system))))
+ (set-process-coding-system
+ process preview-coding-system))
+ (TeX-parse-reset)
+ (setq TeX-parse-function 'TeX-parse-TeX)
+ (if TeX-process-asynchronous
+ process
+ (TeX-synchronous-sentinel "Preview-LaTeX" file process)))
+ (error (preview-log-error err "Preview" process)
+ (delete-process process)
+ (preview-reraise-error process)))))
+
+(defconst preview-version (eval-when-compile
+ (let ((name "$Name: $")
+ (rev "$Revision: 1.287 $"))
+ (or (when (string-match "\\`[$]Name: *release_\\([^ ]+\\) *[$]\\'" name)
+ (setq name (match-string 1 name))
+ (while (string-match "_" name)
+ (setq name (replace-match "." t t name)))
+ name)
+ (if (string-match "\\`[$]Revision: *\\([^ ]+\\) *[$]\\'" rev)
+ (format "CVS-%s" (match-string 1 rev)))
+ "unknown")))
+ "Preview version.
+If not a regular release, CVS revision of `preview.el'.")
+
+(defconst preview-release-date
+ (eval-when-compile
+ (let ((date "$Date: 2012-12-04 08:01:34 $"))
+ (string-match
+ "\\`[$]Date: *\\([0-9]+\\)/\\([0-9]+\\)/\\([0-9]+\\)"
+ date)
+ (format "%s.%s%s" (match-string 1 date) (match-string 2 date)
+ (match-string 3 date))))
+ "Preview release date.
+In the form of yyyy.mmdd")
+
+(defun preview-dump-state (buffer)
+ (condition-case nil
+ (progn
+ (unless (local-variable-p 'TeX-command-buffer)
+ (setq buffer (with-current-buffer buffer (TeX-active-buffer))))
+ (when (bufferp buffer)
+ (insert "\nRun buffer contents:\n\n")
+ (if (< (buffer-size buffer) 5000)
+ (insert-buffer-substring buffer)
+ (insert-buffer-substring buffer 1 2500)
+ (insert "...\n\n[...]\n\n\t...")
+ (insert-buffer-substring buffer
+ (- (buffer-size buffer) 2500)
+ (buffer-size buffer)))
+ (insert "\n")))
+ (error nil)))
+
+;;;###autoload
+(defun preview-report-bug () "Report a bug in the preview-latex package."
+ (interactive)
+ (let ((reporter-prompt-for-summary-p "Bug report subject: "))
+ (reporter-submit-bug-report
+ "bug-auctex@gnu.org"
+ (if (string-match "^CVS-" preview-version)
+ (concat "preview-" (substring preview-version 4))
+ preview-version)
+ '(AUCTeX-version
+ LaTeX-command-style
+ image-types
+ preview-image-type
+ preview-image-creators
+ preview-dvipng-image-type
+ preview-dvipng-command
+ preview-pdf2dsc-command
+ preview-gs-command
+ preview-gs-options
+ preview-gs-image-type-alist
+ preview-fast-conversion
+ preview-prefer-TeX-bb
+ preview-dvips-command
+ preview-fast-dvips-command
+ preview-scale-function
+ preview-LaTeX-command
+ preview-required-option-list
+ preview-preserve-counters
+ preview-default-option-list
+ preview-default-preamble
+ preview-LaTeX-command-replacements
+ preview-dump-replacements
+ preview-undump-replacements
+ preview-auto-cache-preamble
+ preview-TeX-style-dir)
+ `(lambda () (preview-dump-state ,(current-buffer)))
+ (lambda ()
+ (insert (format "\nOutput from running `%s -h':\n"
+ preview-gs-command))
+ (call-process preview-gs-command nil t nil "-h")
+ (insert "\n"))
+ "Remember to cover the basics. Including a minimal LaTeX example
+file exhibiting the problem might help."
+ )))
+
+(eval-when-compile
+ (when (boundp 'preview-compatibility-macros)
+ (dolist (elt preview-compatibility-macros)
+ (if (consp elt)
+ (fset (car elt) (cdr elt))
+ (fmakunbound elt)))))
+
+(makunbound 'preview-compatibility-macros)
+
+(provide 'preview)
+;;; preview.el ends here
diff --git a/tests/auctex-11.87.7/prv-emacs.el
b/tests/auctex-11.87.7/prv-emacs.el
new file mode 100644
index 0000000..9f40736
--- /dev/null
+++ b/tests/auctex-11.87.7/prv-emacs.el
@@ -0,0 +1,600 @@
+;;; prv-emacs.el --- GNU Emacs specific code for preview.el
+
+;; Copyright (C) 2001, 02, 03, 04, 05 Free Software Foundation, Inc.
+
+;; Author: David Kastrup
+;; Keywords: convenience, tex, wp
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'tex-site)
+(require 'tex)
+(require 'latex)
+
+(defvar preview-compatibility-macros nil
+ "List of macros only present when compiling/loading.")
+
+(defcustom preview-transparent-color '(highlight :background)
+ "Color to appear transparent in previews.
+Set this to something unusual when using `preview-transparent-border',
+to the default background in most other cases."
+ :type '(radio (const :tag "None" nil)
+ (const :tag "Autodetect" t)
+ (color :tag "By name" :value "white")
+ (list :tag "Take from face"
+ :value (default :background)
+ (face)
+ (choice :tag "What to take"
+ (const :tag "Background" :value :background)
+ (const :tag "Foreground" :value :foreground))))
+ :group 'preview-appearance)
+
+;;; Note that the following default introduces a border only when
+;;; Emacs blinks politely when point is on an image (the tested
+;;; unrelated function was introduced at about the time image blinking
+;;; became tolerable).
+(defcustom preview-transparent-border (unless (fboundp 'posn-object-x-y) 1.5)
+ "Width of transparent border for previews in pt.
+Setting this to a numeric value will add a border of
+`preview-transparent-color' around images, and will turn
+the heuristic-mask setting of images to default to 't since
+then the borders are correctly detected even in case of
+palette operations. If the transparent color is something
+not present otherwise in the image, the cursor display
+will affect just this border. A width of 0 is interpreted
+by PostScript as meaning a single pixel, other widths are
+interpreted as PostScript points (1/72 of 1in)"
+ :group 'preview-appearance
+ :type '(choice (const :value nil :tag "No border")
+ (number :value 1.5 :tag "Border width in pt")))
+
+(defun preview-get-heuristic-mask ()
+ "Get heuristic-mask to use for previews.
+Consults `preview-transparent-color'."
+ (cond ((stringp preview-transparent-color)
+ (color-values preview-transparent-color))
+ ((or (not (consp preview-transparent-color))
+ (integerp (car preview-transparent-color)))
+ preview-transparent-color)
+ (t (color-values (preview-inherited-face-attribute
+ (nth 0 preview-transparent-color)
+ (nth 1 preview-transparent-color)
+ 'default)))))
+
+(defsubst preview-create-icon-1 (file type ascent border)
+ `(image
+ :file ,file
+ :type ,type
+ :ascent ,ascent
+ ,@(and border
+ '(:mask (heuristic t)))))
+
+(defun preview-create-icon (file type ascent border)
+ "Create an icon from FILE, image TYPE, ASCENT and BORDER."
+ (list
+ (preview-create-icon-1 file type ascent border)
+ file type ascent border))
+
+(put 'preview-filter-specs :type
+ #'(lambda (keyword value &rest args)
+ (if (image-type-available-p value)
+ `(image :type ,value
+ ,@(preview-filter-specs-1 args))
+ (throw 'preview-filter-specs nil))))
+
+;; No defcustom here: does not seem to make sense.
+
+(defvar preview-tb-icon-specs
+ '((:type xpm :file "prvtex24.xpm")
+ (:type xbm :file "prvtex24.xbm")))
+
+(defvar preview-tb-icon nil)
+
+(defun preview-add-urgentization (fun ov &rest rest)
+ "Cause FUN (function call form) to be called when redisplayed.
+FUN must be a form with OV as first argument,
+REST as the remainder, returning T."
+ (let ((dispro (overlay-get ov 'display)))
+ (unless (eq (car dispro) 'when)
+ (overlay-put ov 'display `(when (,fun ,ov ,@rest) . ,dispro)))))
+
+(defun preview-remove-urgentization (ov)
+ "Undo urgentization of OV by `preview-add-urgentization'.
+Returns the old arguments to `preview-add-urgentization'
+if there was any urgentization."
+ (let ((dispro (overlay-get ov 'display)))
+ (when (eq (car-safe dispro) 'when)
+ (prog1
+ (car (cdr dispro))
+ (overlay-put ov 'display (cdr (cdr dispro)))))))
+
+(defsubst preview-icon-copy (icon)
+ "Prepare a later call of `preview-replace-active-icon'."
+
+ ;; This is just a GNU Emacs specific efficiency hack because it
+ ;; is easy to do. When porting, don't do anything complicated
+ ;; here, rather deliver just the unchanged icon and make
+ ;; `preview-replace-active-icon' do the necessary work of replacing
+ ;; the icon where it actually has been stored, probably
+ ;; in the car of the strings property of the overlay. This string
+ ;; might probably serve as a begin-glyph as well, in which case
+ ;; modifying the string in the strings property would change that
+ ;; glyph automatically.
+
+ (cons 'image (cdr icon)))
+
+(defsubst preview-replace-active-icon (ov replacement)
+ "Replace the active Icon in OV by REPLACEMENT, another icon."
+ (let ((img (overlay-get ov 'preview-image)))
+ (setcdr (car img) (cdar replacement))
+ (setcdr img (cdr replacement))))
+
+(defvar preview-button-1 [mouse-2])
+(defvar preview-button-2 [mouse-3])
+
+(defmacro preview-make-clickable (&optional map glyph helpstring click1 click2)
+ "Generate a clickable string or keymap.
+If MAP is non-nil, it specifies a keymap to add to, otherwise
+a new one is created. If GLYPH is given, the result is made
+to display it wrapped in a string. In that case,
+HELPSTRING is a format string with one or two %s specifiers
+for preview's clicks, displayed as a help-echo. CLICK1 and CLICK2
+are functions to call on preview's clicks."
+ `(let ((resmap ,(or map '(make-sparse-keymap))))
+ ,@(if click1
+ `((define-key resmap preview-button-1 ,click1)))
+ ,@(if click2
+ `((define-key resmap preview-button-2 ,click2)))
+ ,(if glyph
+ `(propertize
+ "x"
+ 'display ,glyph
+ 'mouse-face 'highlight
+ 'help-echo
+ ,(if (stringp helpstring)
+ (format helpstring preview-button-1 preview-button-2)
+ `(format ,helpstring preview-button-1 preview-button-2))
+ 'keymap resmap)
+ 'resmap)))
+
+(defvar preview-overlay nil)
+
+(put 'preview-overlay
+ 'modification-hooks
+ '(preview-handle-modification))
+
+(put 'preview-overlay
+ 'insert-in-front-hooks
+ '(preview-handle-insert-in-front))
+
+(put 'preview-overlay
+ 'insert-behind-hooks
+ '(preview-handle-insert-behind))
+
+;; We have to fake our way around atomicity.
+
+;; Here is the beef: for best intuitiveness, we want to have
+;; insertions be carried out as expected before iconized text
+;; passages, but we want to insert *into* the overlay when not
+;; iconized. A preview that has become empty can not get content
+;; again: we remove it. A disabled preview needs no insert-in-front
+;; handler.
+
+(defvar preview-change-list nil
+ "List of tentatively changed overlays.")
+
+(defcustom preview-dump-threshold
+ "^ *\\\\begin *{document}[ %]*$"
+ "*Regexp denoting end of preamble.
+This is the location up to which preamble changes are considered
+to require redumping of a format."
+ :group 'preview-latex
+ :type 'string)
+
+(defun preview-preamble-changed-function
+ (ov after-change beg end &optional length)
+ "Hook function for change hooks on preamble.
+See info node `(elisp) Overlay Properties' for
+definition of OV, AFTER-CHANGE, BEG, END and LENGTH."
+ (let ((format-cons (overlay-get ov 'format-cons)))
+ (preview-unwatch-preamble format-cons)
+ (preview-format-kill format-cons)
+ (setcdr format-cons t)))
+
+(defun preview-watch-preamble (file command format-cons)
+ "Set up a watch on master file FILE.
+FILE can be an associated buffer instead of a filename.
+COMMAND is the command that generated the format.
+FORMAT-CONS contains the format info for the main
+format dump handler."
+ (let ((buffer (if (bufferp file)
+ file
+ (find-buffer-visiting file))) ov)
+ (setcdr
+ format-cons
+ (cons command
+ (when buffer
+ (with-current-buffer buffer
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (unless (re-search-forward preview-dump-threshold nil t)
+ (error "Can't find preamble of `%s'" file))
+ (setq ov (make-overlay (point-min) (point)))
+ (overlay-put ov 'format-cons format-cons)
+ (overlay-put ov 'insert-in-front-hooks
+ '(preview-preamble-changed-function))
+ (overlay-put ov 'modification-hooks
+ '(preview-preamble-changed-function))
+ ov))))))))
+
+(defun preview-unwatch-preamble (format-cons)
+ "Stop watching a format on FORMAT-CONS.
+The watch has been set up by `preview-watch-preamble'."
+ (when (consp (cdr format-cons))
+ (when (cddr format-cons)
+ (delete-overlay (cddr format-cons)))
+ (setcdr (cdr format-cons) nil)))
+
+(defun preview-register-change (ov)
+ "Register not yet changed OV for verification.
+This stores the old contents of the overlay in the
+`preview-prechange' property and puts the overlay into
+`preview-change-list' where `preview-check-changes' will
+find it at some later point of time."
+ (unless (overlay-get ov 'preview-prechange)
+ (if (eq (overlay-get ov 'preview-state) 'disabled)
+ (overlay-put ov 'preview-prechange t)
+ (overlay-put ov 'preview-prechange
+ (save-restriction
+ (widen)
+ (buffer-substring-no-properties
+ (overlay-start ov) (overlay-end ov)))))
+ (push ov preview-change-list)))
+
+(defun preview-check-changes ()
+ "Check whether the contents under the overlay have changed.
+Disable it if that is the case. Ignores text properties."
+ (dolist (ov preview-change-list)
+ (condition-case nil
+ (with-current-buffer (overlay-buffer ov)
+ (let ((text (save-restriction
+ (widen)
+ (buffer-substring-no-properties
+ (overlay-start ov) (overlay-end ov)))))
+ (if (zerop (length text))
+ (preview-delete ov)
+ (unless
+ (or (eq (overlay-get ov 'preview-state) 'disabled)
+ (preview-relaxed-string=
+ text (overlay-get ov 'preview-prechange)))
+ (overlay-put ov 'insert-in-front-hooks nil)
+ (overlay-put ov 'insert-behind-hooks nil)
+ (preview-disable ov)))))
+ (error nil))
+ (overlay-put ov 'preview-prechange nil))
+ (setq preview-change-list nil))
+
+(defun preview-handle-insert-in-front
+ (ov after-change beg end &optional length)
+ "Hook function for `insert-in-front-hooks' property.
+See info node `(elisp) Overlay Properties' for
+definition of OV, AFTER-CHANGE, BEG, END and LENGTH."
+ (if after-change
+ (unless undo-in-progress
+ (if (eq (overlay-get ov 'preview-state) 'active)
+ (move-overlay ov end (overlay-end ov))))
+ (preview-register-change ov)))
+
+(defun preview-handle-insert-behind
+ (ov after-change beg end &optional length)
+ "Hook function for `insert-behind-hooks' property.
+This is needed in case `insert-before-markers' is used at the
+end of the overlay. See info node `(elisp) Overlay Properties'
+for definition of OV, AFTER-CHANGE, BEG, END and LENGTH."
+ (if after-change
+ (unless undo-in-progress
+ (if (eq (overlay-get ov 'preview-state) 'active)
+ (move-overlay ov (overlay-start ov) beg)))
+ (preview-register-change ov)))
+
+(defun preview-handle-modification
+ (ov after-change beg end &optional length)
+ "Hook function for `modification-hooks' property.
+See info node `(elisp) Overlay Properties' for
+definition of OV, AFTER-CHANGE, BEG, END and LENGTH."
+ (unless after-change
+ (preview-register-change ov)))
+
+(defun preview-toggle (ov &optional arg event)
+ "Toggle visibility of preview overlay OV.
+ARG can be one of the following: t displays the overlay,
+nil displays the underlying text, and 'toggle toggles.
+If EVENT is given, it indicates the window where the event
+occured, either by being a mouse event or by directly being
+the window in question. This may be used for cursor restoration
+purposes."
+ (let ((old-urgent (preview-remove-urgentization ov))
+ (preview-state
+ (if (if (eq arg 'toggle)
+ (null (eq (overlay-get ov 'preview-state) 'active))
+ arg)
+ 'active
+ 'inactive))
+ (strings (overlay-get ov 'strings)))
+ (unless (eq (overlay-get ov 'preview-state) 'disabled)
+ (overlay-put ov 'preview-state preview-state)
+ (if (eq preview-state 'active)
+ (progn
+ (overlay-put ov 'category 'preview-overlay)
+ (if (eq (overlay-start ov) (overlay-end ov))
+ (overlay-put ov 'before-string (car strings))
+ (dolist (prop '(display keymap mouse-face help-echo))
+ (overlay-put ov prop
+ (get-text-property 0 prop (car strings))))
+ (overlay-put ov 'before-string nil))
+ (overlay-put ov 'face nil))
+ (dolist (prop '(display keymap mouse-face help-echo))
+ (overlay-put ov prop nil))
+ (overlay-put ov 'face 'preview-face)
+ (unless (cdr strings)
+ (setcdr strings (preview-inactive-string ov)))
+ (overlay-put ov 'before-string (cdr strings)))
+ (if old-urgent
+ (apply 'preview-add-urgentization old-urgent))))
+ (if event
+ (preview-restore-position
+ ov
+ (if (windowp event)
+ event
+ (posn-window (event-start event))))))
+
+(defsubst preview-buffer-recode-system (base)
+ "This is supposed to translate unrepresentable base encodings
+into something that can be used safely for byte streams in the
+run buffer. A noop for Emacs."
+ base)
+
+(defun preview-mode-setup ()
+ "Setup proper buffer hooks and behavior for previews."
+ (set (make-local-variable 'desktop-save-buffer)
+ #'desktop-buffer-preview-misc-data)
+ (add-hook 'pre-command-hook #'preview-mark-point nil t)
+ (add-hook 'post-command-hook #'preview-move-point nil t)
+ (easy-menu-add preview-menu LaTeX-mode-map)
+ (unless preview-tb-icon
+ (setq preview-tb-icon (preview-filter-specs preview-tb-icon-specs)))
+ (when preview-tb-icon
+ (define-key LaTeX-mode-map [tool-bar preview]
+ `(menu-item "Preview at point" preview-at-point
+ :image ,preview-tb-icon
+ :help "Preview on/off at point")))
+ (when buffer-file-name
+ (let* ((filename (expand-file-name buffer-file-name))
+ format-cons)
+ (when (string-match (concat "\\." TeX-default-extension "\\'")
+ filename)
+ (setq filename (substring filename 0 (match-beginning 0))))
+ (setq format-cons (assoc filename preview-dumped-alist))
+ (when (consp (cdr format-cons))
+ (preview-unwatch-preamble format-cons)
+ (preview-watch-preamble (current-buffer)
+ (cadr format-cons)
+ format-cons)))))
+
+(defvar preview-marker (make-marker)
+ "Marker for fake intangibility.")
+
+(defvar preview-temporary-opened nil)
+
+(defvar preview-last-location nil
+ "Restored cursor position marker for reopened previews.")
+(make-variable-buffer-local 'preview-last-location)
+
+(defun preview-mark-point ()
+ "Mark position for fake intangibility."
+ (when (eq (get-char-property (point) 'preview-state) 'active)
+ (unless preview-last-location
+ (setq preview-last-location (make-marker)))
+ (set-marker preview-last-location (point))
+ (set-marker preview-marker (point))
+ (preview-move-point))
+ (set-marker preview-marker (point)))
+
+(defun preview-restore-position (ov window)
+ "Tweak position after opening/closing preview.
+The treated overlay OV has been triggered in WINDOW. This function
+records the original buffer position for reopening, or restores it
+after reopening. Note that by using the mouse, you can open/close
+overlays not in the active window."
+ (when (eq (overlay-buffer ov) (window-buffer window))
+ (with-current-buffer (overlay-buffer ov)
+ (if (eq (overlay-get ov 'preview-state) 'active)
+ (setq preview-last-location
+ (set-marker (or preview-last-location (make-marker))
+ (window-point window)))
+ (when (and
+ (markerp preview-last-location)
+ (eq (overlay-buffer ov) (marker-buffer preview-last-location))
+ (< (overlay-start ov) preview-last-location)
+ (> (overlay-end ov) preview-last-location))
+ (set-window-point window preview-last-location))))))
+
+(defun preview-move-point ()
+ "Move point out of fake-intangible areas."
+ (preview-check-changes)
+ (let* (newlist (pt (point)) (lst (overlays-at pt)) distance)
+ (setq preview-temporary-opened
+ (dolist (ov preview-temporary-opened newlist)
+ (and (overlay-buffer ov)
+ (eq (overlay-get ov 'preview-state) 'inactive)
+ (if (and (eq (overlay-buffer ov) (current-buffer))
+ (or (<= pt (overlay-start ov))
+ (>= pt (overlay-end ov))))
+ (preview-toggle ov t)
+ (push ov newlist)))))
+ (when lst
+ (if (or disable-point-adjustment
+ global-disable-point-adjustment
+ (preview-auto-reveal-p
+ preview-auto-reveal
+ (setq distance
+ (and (eq (marker-buffer preview-marker)
+ (current-buffer))
+ (- pt (marker-position preview-marker))))))
+ (preview-open-overlays lst)
+ (while lst
+ (setq lst
+ (if (and
+ (eq (overlay-get (car lst) 'preview-state) 'active)
+ (> pt (overlay-start (car lst))))
+ (overlays-at
+ (setq pt (if (and distance (< distance 0))
+ (overlay-start (car lst))
+ (overlay-end (car lst)))))
+ (cdr lst))))
+ (goto-char pt)))))
+
+(defun preview-open-overlays (list &optional pos)
+ "Open all previews in LIST, optionally restricted to enclosing POS."
+ (dolist (ovr list)
+ (when (and (eq (overlay-get ovr 'preview-state) 'active)
+ (or (null pos)
+ (and
+ (> pos (overlay-start ovr))
+ (< pos (overlay-end ovr)))))
+ (preview-toggle ovr)
+ (push ovr preview-temporary-opened))))
+
+(defadvice replace-highlight (before preview)
+ "Make `query-replace' open preview text about to be replaced."
+ (preview-open-overlays
+ (overlays-in (ad-get-arg 0) (ad-get-arg 1))))
+
+(defcustom preview-query-replace-reveal t
+ "*Make `query-replace' autoreveal previews."
+ :group 'preview-appearance
+ :type 'boolean
+ :require 'preview
+ :set (lambda (symbol value)
+ (set-default symbol value)
+ (if value
+ (ad-enable-advice 'replace-highlight 'before 'preview)
+ (ad-disable-advice 'replace-highlight 'before 'preview))
+ (ad-activate 'replace-highlight))
+ :initialize #'custom-initialize-reset)
+
+;; Check whether the four-argument form of `face-attribute' exists.
+;; If not, we will get a `wrong-number-of-arguments' error thrown.
+;; Use `defun' instead of `defsubst' here so that the decision may be
+;; reverted at load time if you are compiling with one Emacs and using
+;; another.
+(if (condition-case nil
+ (progn
+ (face-attribute 'default :height nil nil)
+ t)
+ (wrong-number-of-arguments nil))
+
+ (defun preview-inherited-face-attribute (face attribute &optional inherit)
+ "Fetch face attribute while adhering to inheritance.
+This searches FACE for an ATTRIBUTE, using INHERIT
+for resolving unspecified or relative specs. See the fourth
+argument of function `face-attribute' for details."
+ (face-attribute face attribute nil inherit))
+
+ (defun preview-inherited-face-attribute (face attribute &optional inherit)
+ "Fetch face attribute while adhering to inheritance.
+This searches FACE for an ATTRIBUTE. If it is 'unspecified,
+first inheritance is consulted (if INHERIT is non-NIL), then
+INHERIT is searched if it is a face or a list of faces.
+Relative specs are evaluated recursively until they get absolute or
+are not resolvable. Relative specs are float values."
+ (let ((value (face-attribute face attribute)))
+ (when inherit
+ (setq inherit
+ (append
+ (let ((ancestors (face-attribute face :inherit)))
+ (cond ((facep ancestors) (list ancestors))
+ ((consp ancestors) ancestors)))
+ (cond ((facep inherit) (list inherit))
+ ((consp inherit) inherit)))))
+ (cond ((null inherit) value)
+ ((floatp value)
+ (let ((avalue
+ (preview-inherited-face-attribute
+ (car inherit) attribute (or (cdr inherit) t))))
+ (cond ((integerp avalue)
+ (round (* avalue value)))
+ ((floatp avalue)
+ (* value avalue))
+ (t value))))
+ ((eq value 'unspecified)
+ (preview-inherited-face-attribute
+ (car inherit) attribute (or (cdr inherit) t)))
+ (t value)))))
+
+(defun preview-get-colors ()
+ "Return colors from the current display.
+Fetches the current screen colors and makes a vector
+of colors as numbers in the range 0..65535.
+Pure borderless black-on-white will return triple NIL.
+The fourth value is the transparent border thickness."
+ (let
+ ((bg (color-values (preview-inherited-face-attribute
+ 'preview-reference-face :background 'default)))
+ (fg (color-values (preview-inherited-face-attribute
+ 'preview-reference-face :foreground 'default)))
+ (mask (preview-get-heuristic-mask)))
+ (if (equal '(65535 65535 65535) bg)
+ (setq bg nil))
+ (if (equal '(0 0 0) fg)
+ (setq fg nil))
+ (unless (and (numberp preview-transparent-border)
+ (consp mask) (integerp (car mask)))
+ (setq mask nil))
+ (vector bg fg mask preview-transparent-border)))
+
+(defmacro preview-mark-active ()
+ "Return t if the mark is active."
+ 'mark-active)
+
+(defun preview-import-image (image)
+ "Convert the printable IMAGE rendition back to an image."
+ (cond ((stringp image)
+ (propertize image 'face 'preview-face))
+ ((eq (car image) 'image)
+ image)
+ (t
+ (preview-create-icon-1 (nth 0 image)
+ (nth 1 image)
+ (nth 2 image)
+ (if (< (length image) 4)
+ (preview-get-heuristic-mask)
+ (nth 3 image))))))
+
+(defsubst preview-supports-image-type (imagetype)
+ "Check if IMAGETYPE is supported."
+ (image-type-available-p imagetype))
+
+(provide 'prv-emacs)
+;;; prv-emacs.el ends here
diff --git a/tests/auctex-11.87.7/prv-xemacs.el
b/tests/auctex-11.87.7/prv-xemacs.el
new file mode 100644
index 0000000..ce89a1d
--- /dev/null
+++ b/tests/auctex-11.87.7/prv-xemacs.el
@@ -0,0 +1,743 @@
+;;; prv-xemacs.el --- XEmacs support for preview-latex
+
+;; Copyright (C) 2001-2006 Free Software Foundation, Inc.
+
+;; Author: David Kastrup
+;; Keywords: convenience, tex, wp
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'overlay)
+(require 'tex-site)
+(require 'tex)
+(require 'latex)
+
+;; Compatibility macros and functions.
+
+(eval-when-compile
+ (defvar preview-compatibility-macros nil
+ "List of macros only present when compiling/loading uncompiled.")
+
+ (defmacro preview-defmacro (name &rest rest)
+ (when (featurep 'xemacs)
+ (push
+ (if (fboundp name)
+ (cons name (symbol-function name))
+ name)
+ preview-compatibility-macros)
+ `(eval-when-compile (defmacro ,name ,@rest))))
+ (push 'preview-defmacro preview-compatibility-macros))
+
+(preview-defmacro assoc-default (key alist test)
+ `(cdr (assoc* ,key ,alist
+ :test #'(lambda(a b) (funcall ,test b a)))))
+
+(preview-defmacro display-mm-height () '(device-mm-height))
+(preview-defmacro display-mm-width () '(device-mm-width))
+(preview-defmacro display-pixel-height () '(device-pixel-height))
+(preview-defmacro display-pixel-width () '(device-pixel-width))
+(preview-defmacro line-beginning-position () '(point-at-bol))
+(preview-defmacro line-end-position () '(point-at-eol))
+
+;; This is not quite the case, but unless we're playing with duplicable
extents,
+;; the two are equivalent in XEmacs.
+(preview-defmacro match-string-no-properties (&rest args)
+ `(match-string ,@args))
+
+(preview-defmacro face-attribute (face attr)
+ (cond
+ ((eq attr :height)
+ `(round (/ (* ,(/ 720.0 25.4)
+ (face-height ,face)
+ (device-mm-height))
+ (device-pixel-height))))
+ ((eq attr :foreground)
+ `(face-foreground-instance ,face))
+ ((eq attr :background)
+ `(face-background-instance ,face))
+ (t
+ (error 'unimplemented (format "Don't know how to fake %s" attr)))))
+
+(preview-defmacro make-temp-file (prefix dir-flag)
+ (if (not dir-flag)
+ (error 'unimplemented "Can only fake make-temp-file for directories"))
+ `(let (file)
+ (while (condition-case ()
+ (progn
+ (setq file
+ (make-temp-name ,prefix))
+ (make-directory file)
+ nil)
+ (file-already-exists t))
+ nil)
+ file))
+
+(preview-defmacro set-buffer-multibyte (multibyte)
+ "Set the representation type of the current buffer. If MULTIBYTE
+is non-`nil', the buffer becomes multibyte. If MULTIBYTE is
+`nil', the buffer becomes unibyte.
+
+Because XEmacs does not implement multibyte versus unibyte buffers
+per se (they just have encodings which may be unibyte or multibyte),
+this is only implemented for the `nil' case."
+ (if (not multibyte)
+ `(if (fboundp 'set-buffer-file-coding-system)
+ (set-buffer-file-coding-system 'binary))
+ (error 'unimplemented "`set-buffer-multibyte is only implemented for the
binary case.")))
+
+(preview-defmacro next-single-char-property-change (pos prop)
+ "Return the position of next property change for a specific property.
+This is like `next-single-property-change', except that if no
+change is found before the end of the buffer, it returns
+\(point-max) rather than `nil'."
+ `(or (next-single-property-change ,pos ,prop)
+ (point-max)))
+
+(preview-defmacro previous-single-char-property-change (pos prop)
+ "Return the position of previous property change for a specific property.
+This is like `next-single-property-change', except that if no
+change is found before the end of the buffer, it returns
+\(point-min) rather than `nil'."
+ `(or (previous-single-property-change ,pos ,prop)
+ (point-min)))
+
+(preview-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.
+
+The message is displayed with label `progress'; see `display-message'."
+ (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))
+ (display-message 'progress ,temp-message))
+ ,@body)
+ (and ,temp-message
+ (if ,current-message
+ (display-message 'progress ,current-message)
+ (message nil)))))))
+
+(defun preview-mark-active ()
+ "Return t if the mark is active."
+ (and (mark)
+ t))
+
+(defvar preview-transparent-border)
+
+;; Images.
+
+(defsubst preview-supports-image-type (imagetype)
+ "Return whether IMAGETYPE is supported by XEmacs."
+ (memq imagetype (image-instantiator-format-list)))
+
+;; TODO: Generalize this so we can create the fixed icons using it.
+
+;; Argh, dired breaks :file :(
+;; This is a temporary kludge to get around that until a fixed dired
+;; or a fixed XEmacs is released.
+
+(defun preview-create-icon-1 (file type ascent)
+ "Create an icon from FILE, image TYPE and ASCENT."
+ (let ((glyph
+ (make-glyph
+ (vector type
+ :file file
+ :data (with-temp-buffer
+ (insert-file-contents-literally file)
+ (buffer-string))))))
+ (set-glyph-baseline glyph ascent)
+ glyph))
+
+(defun preview-create-icon (file type ascent border)
+ "Create an icon from FILE, image TYPE, ASCENT and BORDER."
+ (list
+ (preview-create-icon-1 file type ascent)
+ file type ascent border))
+
+(defvar preview-ascent-spec)
+
+(put 'preview-filter-specs :type
+ #'(lambda (keyword value &rest args)
+ (if (preview-supports-image-type value)
+ (let* (preview-ascent-spec
+ (glyph (make-glyph `[,value
+ ,@(preview-filter-specs-1 args)])))
+ (when preview-ascent-spec
+ (set-glyph-baseline glyph preview-ascent-spec))
+ glyph)
+ (throw 'preview-filter-specs nil))))
+
+(put 'preview-filter-specs :ascent
+ #'(lambda (keyword value &rest args)
+ (setq preview-ascent-spec value)
+ (preview-filter-specs-1 args)))
+
+;; No defcustom here: does not seem to make sense.
+
+(defvar preview-tb-icon-specs
+ '((:type xpm :file "prvtex-cap-up.xpm" :ascent 75)
+ (:type xbm :file "prvtex24.xbm" :ascent 75)))
+
+(defvar preview-tb-icon nil)
+
+;; Image frobbing.
+
+(defun preview-add-urgentization (fun ov &rest rest)
+ "Cause FUN (function call form) to be called when redisplayed.
+FUN must be a form with OV as first argument,
+REST as the remainder, returning T. An alternative is to give
+what `preview-remove-urgentization' returns, this will reinstate
+the previous state."
+ (set-extent-initial-redisplay-function
+ ov
+ (if (null rest)
+ fun
+ `(lambda (ov) (,fun ,ov ,@rest)))))
+
+(defun preview-remove-urgentization (ov)
+ "Undo urgentization of OV by `preview-add-urgentization'.
+Returns the old arguments to `preview-add-urgentization'
+if there was any urgentization."
+ (prog1 (list (extent-property ov 'initial-redisplay-function) ov)
+ (set-extent-initial-redisplay-function ov nil)))
+
+(defsubst preview-icon-copy (icon)
+ "Prepare for a later call of `preview-replace-active-icon'."
+ icon)
+
+(defsubst preview-replace-active-icon (ov replacement)
+ "Replace the active Icon in OV by REPLACEMENT, another icon."
+ (set-extent-property ov 'preview-image replacement)
+ (add-text-properties 0 1 (list 'end-glyph (car replacement))
+ (car (extent-property ov 'strings)))
+ (if (eq (extent-property ov 'preview-state) 'active)
+ (set-extent-end-glyph ov (car replacement))))
+
+(defvar preview-button-1 'button2)
+(defvar preview-button-2 'button3)
+
+;; The `x' and invisible junk is because XEmacs doesn't bother to insert
+;; the extents of a zero-length string. Bah.
+;; When this is fixed, we'll autodetect this case and use zero-length
+;; strings where possible.
+(defmacro preview-make-clickable (&optional map glyph helpstring click1 click2)
+ "Generate a clickable string or keymap.
+If MAP is non-nil, it specifies a keymap to add to, otherwise
+a new one is created. If GLYPH is given, the result is made
+to display it wrapped in a string. In that case,
+HELPSTRING is a format string with one or two %s specifiers
+for preview's clicks, displayed as a help-echo. CLICK1 and CLICK2
+are functions to call on preview's clicks."
+ `(let (,@(and glyph '((res (copy-sequence "x"))))
+ (resmap ,(or map '(make-sparse-keymap))))
+ ,@(if click1
+ `((define-key resmap preview-button-1 ,click1)))
+ ,@(if click2
+ `((define-key resmap preview-button-2 ,click2)))
+ ,@(if glyph
+ `((add-text-properties
+ 0 1
+ (list 'end-glyph ,glyph
+ 'mouse-face 'highlight
+ 'preview-balloon-help
+ ,(if (stringp helpstring)
+ (format helpstring preview-button-1 preview-button-2)
+ `(format ,helpstring preview-button-1 preview-button-2))
+ 'preview-keymap resmap)
+ res)
+ res)
+ '(resmap))))
+
+(defun preview-click-reroute (ov event)
+ "If OV received a click EVENT on a glyph, reroute to special map."
+ (let ((oldmap (extent-keymap ov)))
+ (unwind-protect
+ (progn
+ (set-extent-keymap ov
+ (and (event-over-glyph-p event)
+ (extent-property ov 'preview-keymap)))
+ (dispatch-event event))
+ (set-extent-keymap ov oldmap))))
+
+(defun preview-reroute-map (ov)
+ "Get rerouting keymap for OV for catching glyph clicks only."
+ (let ((map (make-sparse-keymap))
+ (fun `(lambda (event)
+ (interactive "e")
+ (preview-click-reroute ,ov event))))
+ (define-key map preview-button-1 fun)
+ (define-key map preview-button-2 fun)
+ map))
+
+(defun preview-balloon-reroute (ov)
+ "Give balloon help only if over glyph of OV."
+ (and (eq ov (event-glyph-extent (mouse-position-as-motion-event)))
+ (extent-property ov 'preview-balloon-help)))
+
+;; Most of the changes to this are junking the use of overlays;
+;; a bit of it is different, and there's a little extra paranoia.
+
+;; We also have to move the image from the begin to the end-glyph
+;; whenever the extent is invisible because of a bug in XEmacs-21.4's
+;; redisplay engine.
+(defun preview-toggle (ov &optional arg event)
+ "Toggle visibility of preview overlay OV.
+ARG can be one of the following: t displays the overlay,
+nil displays the underlying text, and 'toggle toggles.
+If EVENT is given, it indicates the window where the event
+occured, either by being a mouse event or by directly being
+the window in question. This may be used for cursor restoration
+purposes."
+ (if (not (bufferp (extent-object ov)))
+ (error 'wrong-type-argument ov))
+ (let ((old-urgent (preview-remove-urgentization ov))
+ (preview-state
+ (if (if (eq arg 'toggle)
+ (not (eq (extent-property ov 'preview-state) 'active))
+ arg)
+ 'active
+ 'inactive))
+ (strings (extent-property ov 'strings)))
+ (unless (eq (extent-property ov 'preview-state) 'disabled)
+ (set-extent-property ov 'preview-state preview-state)
+ (if (eq preview-state 'active)
+ (progn
+ (unless (extent-keymap ov)
+ (set-extent-keymap ov (preview-reroute-map ov))
+ (set-extent-property ov 'balloon-help #'preview-balloon-reroute))
+ (set-extent-begin-glyph ov nil)
+ (set-extent-end-glyph-layout ov 'text)
+ (set-extent-end-glyph ov (get-text-property
+ 0 'end-glyph (car strings)))
+ (set-extent-properties ov '(invisible t
+ isearch-open-invisible ignore
+ isearch-invisible t
+ face nil))
+ (dolist (prop '(preview-keymap
+ mouse-face preview-balloon-help))
+ (set-extent-property ov prop
+ (get-text-property 0 prop (car strings)))))
+ (unless (cdr strings)
+ (setcdr strings (preview-inactive-string ov)))
+ (set-extent-end-glyph ov nil)
+ (set-extent-begin-glyph-layout ov 'text)
+ (set-extent-begin-glyph ov (get-text-property
+ 0 'end-glyph (cdr strings)))
+ (set-extent-properties ov `(face preview-face
+ mouse-face nil
+ invisible nil
+ isearch-invisible nil
+ preview-keymap
+ ,(get-text-property
+ 0 'preview-keymap (cdr strings))
+ preview-balloon-help
+ ,(get-text-property
+ 0 'preview-balloon-help (cdr strings)))))
+ (if old-urgent
+ (apply 'preview-add-urgentization old-urgent))))
+ (if event
+ (preview-restore-position
+ ov
+ (if (windowp event)
+ event
+ (event-window event)))))
+
+; Does FALLBACKS need to be implemented? Likely not.
+(defmacro preview-inherited-face-attribute (face attribute &optional
+ fallbacks)
+ "Fetch face attribute while adhering to inheritance.
+This searches FACE and all its ancestors for an ATTRIBUTE.
+FALLBACKS is unused."
+ `(face-attribute ,face ,attribute))
+
+(defun preview-get-colors ()
+ "Return colors from the current display.
+Fetches the current screen colors and makes a vector
+of colors as numbers in the range 0..65535.
+Pure borderless black-on-white will return quadruple NIL."
+ (let
+ ((bg (color-instance-rgb-components (preview-inherited-face-attribute
+ 'preview-reference-face :background 'default)))
+ (fg (color-instance-rgb-components (preview-inherited-face-attribute
+ 'preview-reference-face :foreground
'default))))
+ (if (equal '(65535 65535 65535) bg)
+ (setq bg nil))
+ (if (equal '(0 0 0) fg)
+ (setq fg nil))
+ (vector bg fg nil nil)))
+
+(defcustom preview-use-balloon-help nil
+ "*Is balloon help enabled in preview-latex?"
+ :group 'preview-appearance
+ :type 'boolean)
+
+(defcustom preview-buffer-recoding-alist
+ (if (and (= emacs-major-version 21)
+ (< emacs-minor-version 5))
+ '((utf-8-unix . raw-text-unix)
+ (utf-8-dos . raw-text-dos)
+ (utf-8-mac . raw-text-mac)
+ (utf-8 . raw-text)))
+ "Translate buffer encodings into process encodings.
+TeX is sometimes bad dealing with 8bit encodings and rather bad
+dealing with multibyte encodings. So the process encoding output
+might need to get temporarily reprocessed into the original byte
+stream before the buffer characters can be identified. XEmacs
+21.4 is rather bad at preserving incomplete multibyte characters
+in that process. This variable makes it possible to use a
+reconstructable coding system in the run buffer instead. Specify
+an alist of base coding system names here, which you can get
+using
+
+ \(coding-system-name (coding-system-base buffer-file-coding-system))
+
+in properly detected buffers."
+ :group 'preview-latex
+ :type '(repeat (cons symbol symbol)))
+
+(defun preview-buffer-recode-system (base)
+ "This is supposed to translate unrepresentable base encodings
+ into something that can be used safely for byte streams in the
+ run buffer. XEmacs mule-ucs is so broken that this may be
+ needed."
+ (or (cdr (assq (coding-system-name base)
+ preview-buffer-recoding-alist))
+ base))
+
+(defun preview-mode-setup ()
+ "Setup proper buffer hooks and behavior for previews."
+ (set (make-local-variable 'desktop-save-buffer)
+ #'desktop-buffer-preview-misc-data)
+ (mapc #'make-local-hook
+ '(pre-command-hook post-command-hook
+ before-change-functions after-change-functions))
+ (add-hook 'pre-command-hook #'preview-mark-point nil t)
+ (add-hook 'post-command-hook #'preview-move-point nil t)
+ (and preview-use-balloon-help
+ (not (and (boundp 'balloon-help-mode)
+ balloon-help-mode))
+ (balloon-help-minor-mode 1))
+ (add-hook 'before-change-functions #'preview-handle-before-change nil t)
+ (add-hook 'after-change-functions #'preview-handle-after-change nil t)
+ (easy-menu-add preview-menu)
+ (unless preview-tb-icon
+ (setq preview-tb-icon (preview-filter-specs
+ preview-tb-icon-specs))
+ (when preview-tb-icon
+ (setq preview-tb-icon
+ (vector
+ (list preview-tb-icon)
+ #'preview-at-point
+ t
+ "Preview on/off at point"))))
+;;; [Courtesy Stephen J. Turnbull, with some modifications
+;;; Message-ID: <87el9fglsj.fsf@tleepslib.sk.tsukuba.ac.jp>
+;;; I could not have figured this out for the world]
+;;; Hm, there really ought to be a way to get the spec that would be
+;;; instantiated in a given domain
+ (when preview-tb-icon
+ (let ((tb (cdadar (or (specifier-spec-list default-toolbar
(current-buffer))
+ (specifier-spec-list default-toolbar 'global)))))
+ (unless (member preview-tb-icon tb)
+ (set-specifier default-toolbar
+ (append tb (list preview-tb-icon))
+ (current-buffer)))))
+ (when buffer-file-name
+ (let* ((filename (expand-file-name buffer-file-name))
+ format-cons)
+ (when (string-match (concat "\\." TeX-default-extension "\\'")
+ filename)
+ (setq filename (substring filename 0 (match-beginning 0))))
+ (setq format-cons (assoc filename preview-dumped-alist))
+ (when (consp (cdr format-cons))
+ (preview-unwatch-preamble format-cons)
+ (preview-watch-preamble (current-buffer)
+ (cadr format-cons)
+ format-cons)))))
+
+(defvar preview-marker (make-marker)
+ "Marker for fake intangibility.")
+
+(defvar preview-temporary-opened nil)
+
+(defvar preview-last-location nil
+ "Restored cursor position marker for reopened previews.")
+(make-variable-buffer-local 'preview-last-location)
+
+(defun preview-mark-point ()
+ "Mark position for fake intangibility."
+ (when (eq (get-char-property (point) 'preview-state) 'active)
+ (unless preview-last-location
+ (setq preview-last-location (make-marker)))
+ (set-marker preview-last-location (point))
+ (set-marker preview-marker (point))
+ (preview-move-point))
+ (set-marker preview-marker (point)))
+
+(defun preview-restore-position (ov window)
+ "Tweak position after opening/closing preview.
+The treated overlay OV has been triggered in WINDOW. This function
+records the original buffer position for reopening, or restores it
+after reopening. Note that by using the mouse, you can open/close
+overlays not in the active window."
+ (when (eq (extent-object ov) (window-buffer window))
+ (with-current-buffer (extent-object ov)
+ (if (eq (extent-property ov 'preview-state) 'active)
+ (setq preview-last-location
+ (set-marker (or preview-last-location (make-marker))
+ (window-point window)))
+ (when (and
+ (markerp preview-last-location)
+ (eq (extent-object ov) (marker-buffer preview-last-location))
+ (< (extent-start-position ov) preview-last-location)
+ (> (extent-end-position ov) preview-last-location))
+ (set-window-point window preview-last-location))))))
+
+(defun preview-move-point ()
+ "Move point out of fake-intangible areas."
+ (preview-check-changes)
+ (let (newlist (pt (point)) distance)
+ (setq preview-temporary-opened
+ (dolist (ov preview-temporary-opened newlist)
+ (and (extent-object ov)
+ (not (extent-detached-p ov))
+ (eq (extent-property ov 'preview-state) 'inactive)
+ (if (and (eq (extent-object ov) (current-buffer))
+ (or (<= pt (extent-start-position ov))
+ (>= pt (extent-end-position ov))))
+ (preview-toggle ov t)
+ (push ov newlist)))))
+ (if (preview-auto-reveal-p
+ preview-auto-reveal
+ (setq distance
+ (and (eq (marker-buffer preview-marker)
+ (current-buffer))
+ (- pt (marker-position preview-marker)))))
+ (map-extents #'preview-open-overlay nil
+ pt pt nil nil 'preview-state 'active)
+ (let (newpt)
+ (while (setq newpt
+ (map-extents #'preview-skip-overlay nil
+ pt pt (and distance (< distance 0)) nil
+ 'preview-state 'active))
+ (setq pt newpt))
+ (goto-char pt)))))
+
+(defun preview-skip-overlay (ovr backward)
+ "Skip point over OVR, BACKWARD is set if backwards.
+Returns new position or NIL."
+ (if backward
+ (and (> (extent-start-position ovr) (point-min))
+ (1- (extent-start-position ovr)))
+ (and (<= (extent-end-position ovr) (point-max))
+ (> (extent-end-position ovr) (extent-start-position ovr))
+ (extent-end-position ovr))))
+
+(defun preview-open-overlay (ovr ignored)
+ "Open the active preview OVR, IGNORED gets ignored.
+NIL is returned: this is for `map-extents'."
+ (preview-toggle ovr)
+ (push ovr preview-temporary-opened)
+ nil)
+
+(defadvice isearch-highlight (before preview protect disable)
+ "Make isearch open preview text that's a search hit.
+Also make `query-replace' open preview text about to be replaced."
+ (map-extents #'preview-open-overlay nil
+ (ad-get-arg 0) (ad-get-arg 1)
+ nil nil 'preview-state 'active))
+
+(defcustom preview-query-replace-reveal t
+ "*Make `isearch' and `query-replace' autoreveal previews."
+ :group 'preview-appearance
+ :type 'boolean
+ :require 'preview
+ :set (lambda (symbol value)
+ (set-default symbol value)
+ (if value
+ (ad-enable-advice 'isearch-highlight 'before 'preview)
+ (ad-disable-advice 'isearch-highlight 'before 'preview))
+ (ad-activate 'isearch-highlight))
+ :initialize #'custom-initialize-reset)
+
+;; Here is the beef: for best intuitiveness, we want to have
+;; insertions be carried out as expected before iconized text
+;; passages, but we want to insert *into* the overlay when not
+;; iconized. A preview that has become empty can not get content
+;; again: we remove it. A disabled preview needs no insert-in-front
+;; handler.
+
+(defvar preview-change-list nil
+ "List of tentatively changed overlays.")
+
+(defcustom preview-dump-threshold
+ "^ *\\\\begin *{document}[ %]*$"
+ "*Regexp denoting end of preamble.
+This is the location up to which preamble changes are considered
+to require redumping of a format."
+ :group 'preview-latex
+ :type 'string)
+
+(defvar preview-preamble-format-cons nil
+ "Where our preamble is supposed to end.")
+(make-variable-buffer-local 'preview-preamble-format-cons)
+
+(defun preview-preamble-check-change (beg end)
+ "Hook function for change hooks on preamble.
+Reacts to changes between BEG and END."
+ (when (and (consp (cdr preview-preamble-format-cons))
+ (cddr preview-preamble-format-cons)
+ (< beg (cddr preview-preamble-format-cons)))
+ (preview-unwatch-preamble preview-preamble-format-cons)
+ (preview-format-kill preview-preamble-format-cons)
+ (setcdr preview-preamble-format-cons t)))
+
+(defun preview-watch-preamble (file command format-cons)
+ "Set up a watch on master file FILE.
+FILE can be an associated buffer instead of a filename.
+COMMAND is the command that generated the format.
+FORMAT-CONS contains the format info for the main
+format dump handler."
+ (let ((buffer (if (bufferp file)
+ file
+ (find-buffer-visiting file))) ov)
+ (setq preview-preamble-format-cons nil)
+ (setcdr
+ format-cons
+ (cons command
+ (when buffer
+ (with-current-buffer buffer
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (unless (re-search-forward preview-dump-threshold nil t)
+ (error "Can't find preamble of `%s'" file))
+ (setq preview-preamble-format-cons format-cons)
+ (point)))))))))
+
+(defun preview-unwatch-preamble (format-cons)
+ "Stop watching a format on FORMAT-CONS.
+The watch has been set up by `preview-watch-preamble'."
+ (when (consp (cdr format-cons))
+ (setcdr (cdr format-cons) nil)))
+
+(defun preview-register-change (ov map-arg)
+ "Register not yet changed OV for verification.
+This stores the old contents of the overlay in the
+`preview-prechange' property and puts the overlay into
+`preview-change-list' where `preview-check-changes' will
+find it at some later point of time. MAP-ARG is ignored;
+it is usually generated by `map-extents'."
+ (unless (extent-property ov 'preview-prechange)
+ (if (eq (extent-property ov 'preview-state) 'disabled)
+ (set-extent-property ov 'preview-prechange t)
+ (set-extent-property ov
+ 'preview-prechange
+ (save-restriction
+ (widen)
+ (buffer-substring-no-properties
+ (extent-start-position ov)
+ (extent-end-position ov)))))
+ (push ov preview-change-list))
+ nil)
+
+(defun preview-check-changes ()
+ "Check whether the contents under the overlay have changed.
+Disable it if that is the case. Ignores text properties."
+ (dolist (ov preview-change-list)
+ (condition-case nil
+ (with-current-buffer (extent-object ov)
+ (let ((text (save-restriction
+ (widen)
+ (buffer-substring-no-properties
+ (extent-start-position ov)
+ (extent-end-position ov)))))
+ (if (or (zerop (length text))
+ (extent-detached-p ov))
+ (preview-delete ov)
+ (unless
+ (or (eq (extent-property ov 'preview-state) 'disabled)
+ (preview-relaxed-string=
+ text (extent-property ov 'preview-prechange)))
+ (preview-disable ov)))))
+ (error nil))
+ (set-extent-property ov 'preview-prechange nil))
+ (setq preview-change-list nil))
+
+(defun preview-handle-before-change (beg end)
+ "Hook function for `before-change-functions'.
+Receives BEG and END, the affected region."
+ (map-extents #'preview-register-change nil beg end
+ nil nil 'preview-state)
+ (preview-preamble-check-change beg end))
+
+(defun preview-handle-after-change (beg end length)
+ "Hook function for `after-change-functions'.
+Receives BEG and END, the affected region, and LENGTH
+of an insertion."
+ (when (and preview-change-list
+ (zerop length)
+ (not (eq this-command 'undo)))
+ (map-extents (lambda (ov maparg)
+ (set-extent-endpoints
+ ov maparg (extent-end-position ov))) nil
+ beg beg end 'start-in-region 'preview-state 'active)
+ (map-extents (lambda (ov maparg)
+ (set-extent-endpoints
+ ov (extent-start-position ov) maparg)) nil
+ end end beg 'end-in-region 'preview-state 'active)))
+
+(defun preview-import-image (image)
+ "Convert the printable IMAGE rendition back to an image."
+ (cond ((stringp image)
+ (setq image (copy-sequence image))
+ (add-text-properties 0 (length image)
+ '(face preview-face)
+ image)
+ image)
+ ((eq (car image) 'image)
+ (let ((plist (cdr image)))
+ (preview-create-icon-1
+ (plist-get plist :file)
+ (plist-get plist :type)
+ (plist-get plist :ascent))))
+ (t
+ (preview-create-icon-1 (nth 0 image)
+ (nth 1 image)
+ (nth 2 image)))))
+
+(provide 'prv-xemacs)
+
+;;; Local variables:
+;;; eval: (put 'preview-defmacro 'lisp-indent-function 'defun)
+;;; end:
+
+;;; prv-xemacs.el ends here
diff --git a/tests/auctex-11.87.7/style/.nosearch
b/tests/auctex-11.87.7/style/.nosearch
new file mode 100644
index 0000000..aa31332
--- /dev/null
+++ b/tests/auctex-11.87.7/style/.nosearch
@@ -0,0 +1 @@
+;; AUCTeX style/ and auto/ directories should not appear in load path.
diff --git a/tests/auctex-11.87.7/style/CJK.el
b/tests/auctex-11.87.7/style/CJK.el
new file mode 100644
index 0000000..fa285bd
--- /dev/null
+++ b/tests/auctex-11.87.7/style/CJK.el
@@ -0,0 +1,93 @@
+;;; CJK.el --- AUCTeX style for the CJK package.
+
+;; Copyright (C) 2009 Free Software Foundation, Inc.
+
+;; Author: Ralf Angeli <angeli@caeruleus.net>
+;; Maintainer: auctex-devel@gnu.org
+;; Created: 2009-01-04
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; This file adds support for the CJK package, version 4.8.0
+;; (22-May-2008).
+
+;;; Code:
+
+(defvar LaTeX-CJK-package-options
+ '("lowercase" "global" "local" "active" "encapsulated")
+ "Package options for the CJK package.")
+
+(defvar LaTeX-CJK-enc-list
+ '("Bg5" "Bg5+" "HK" "GB" "GBt" "GBK" "JIS" "JIS2" "SJIS" "KS" "UTF8" "CNS1"
+ "CNS2" "CNS3" "CNS4" "CNS5" "CNS6" "CNS7" "CEFX" "CEFY")
+ "List of encodings supported by the CJK package.")
+
+(defun LaTeX-env-CJK (env)
+ "Prompt for the arguments of ENV and insert it.
+The function can be used for CJK and CJK* environments."
+ (LaTeX-insert-environment
+ env
+ (concat
+ (let ((font-enc (read-string "(Optional) Font encoding: ")))
+ (unless (zerop (length font-enc)) (format "[%s]" font-enc)))
+ (format "{%s}" (completing-read "Encoding: "
+ (mapcar 'list LaTeX-CJK-enc-list)))
+ (format "{%s}" (read-string "Font family: ")))))
+
+(TeX-add-style-hook
+ "CJK"
+ (lambda ()
+ ;; New symbols
+ (TeX-add-symbols
+ '("CJKencfamily" ["Font encoding"] "Encoding" "Font family")
+ '("CJKchar" ["Encoding"] "First byte" "Second byte")
+ '("CJKcaption" 1)
+ '("CJKfamily" 1)
+ '("CJKfontenc" "Encoding" "Font encoding")
+ '("CJKenc" 1)
+ '("Unicode" "First byte" "Second byte")
+ '("CJKsymbols" 2)
+ '("CJKsymbol" 1)
+ "CJKbold"
+ "CJKnormal"
+ "CJKboldshift"
+ "CJKCJKchar"
+ "CJKhangulchar"
+ "CJKlatinchar"
+ "CJKhwkatakana"
+ "CJKnohwkatakana"
+ "CJKglue"
+ "CJKtolerance"
+ "CJKtilde"
+ "nbs"
+ "standardtilde"
+ "CJKspace"
+ "CJKnospace"
+ "CJKindent"
+ '("CJKaddEncHook" 2)
+ "CJKkern"
+ "CJKverbatim")
+ ;; New environments
+ (LaTeX-add-environments
+ '("CJK" LaTeX-env-CJK)
+ '("CJK*" LaTeX-env-CJK))))
+
+;;; CJK.el ends here
diff --git a/tests/auctex-11.87.7/style/CJKutf8.el
b/tests/auctex-11.87.7/style/CJKutf8.el
new file mode 100644
index 0000000..ea3c2e3
--- /dev/null
+++ b/tests/auctex-11.87.7/style/CJKutf8.el
@@ -0,0 +1,38 @@
+;;; CJKutf8.el --- AUCTeX style for the CJKutf8 package.
+
+;; Copyright (C) 2009 Free Software Foundation, Inc.
+
+;; Author: Ralf Angeli <angeli@caeruleus.net>
+;; Maintainer: auctex-devel@gnu.org
+;; Created: 2009-01-04
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; This file adds support for the CJKutf8 package.
+
+;;; Code:
+
+(TeX-add-style-hook
+ "CJKutf8"
+ (lambda ()
+ (TeX-run-style-hooks "CJK")))
+
+;;; CJKutf8.el ends here
diff --git a/tests/auctex-11.87.7/style/MinionPro.el
b/tests/auctex-11.87.7/style/MinionPro.el
new file mode 100644
index 0000000..7151c36
--- /dev/null
+++ b/tests/auctex-11.87.7/style/MinionPro.el
@@ -0,0 +1,71 @@
+;;; MinionPro.el -- AUCTeX style for MinionPro.sty
+
+;; Copyright (C) 2005 Free Software Foundation, Inc.
+
+;; Author: Mark Trettin <Mark.Trettin@gmx.de>
+;; Maintainer: auctex-devel@gnu.org
+;; Created: 2005-11-26
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; This file adds support for `MinionPro.sty' (v2.0).
+
+;;; Code
+
+(TeX-add-style-hook
+ "MinionPro"
+ (lambda ()
+ (TeX-add-symbols
+ ;; New symbols
+ '("figureversion"
+ (TeX-arg-eval completing-read "Figure style: "
+ '(("text") ("osf")
+ ("lining") ("lf")
+ ("tabular") ("tab")
+ ("proportional") ("prop"))))
+ '("smallfrac" "Numerator" "Denominator")
+ '("slantfrac" "Numerator" "Denominator")
+ ;; IMHO they should be added to the other \text.. and \..shape commands
+ '("textsw" 1)
+ '("textssc" 1)
+ "sscshape"
+ "swshape")
+ ;; Run style hook for amsmath which is loaded via MnSymbol
+ (TeX-run-style-hooks "amsmath")
+ ;; Fontification
+ (when (and (featurep 'font-latex)
+ (eq TeX-install-font-lock 'font-latex-setup))
+ (font-latex-add-keywords '(("smallfrac" "{{")
+ ("slantfrac" "{{")
+ ("textsw" "{")
+ ("textssc" "{"))
+ 'textual)
+ (font-latex-add-keywords '(("figureversion" "{")) 'variable))))
+
+(defvar LaTeX-MinionPro-package-options
+ '("smallfamily" "medfamily" "fullfamily" "noopticals" "opticals"
+ "slides" "textosf" "mathosf" "osf" "textlf" "mathlf" "lf"
+ "mathtabular" "mnsy" "cmsy" "swash" "abx" "amsbb" "fourierbb"
+ "lucidabb" "mixedgreek" "italicgreek" "frenchmath" "minionint"
+ "footnotefigures")
+"Package options for the MinionPro package.")
+
+;;; MinionPro.el ends here
diff --git a/tests/auctex-11.87.7/style/alltt.el
b/tests/auctex-11.87.7/style/alltt.el
new file mode 100644
index 0000000..a266a88
--- /dev/null
+++ b/tests/auctex-11.87.7/style/alltt.el
@@ -0,0 +1,55 @@
+;;; alltt.el --- AUCTeX style for `alltt.sty'
+
+;; Copyright (C) 2004, 2005 Free Software Foundation, Inc.
+
+;; Author: Ralf Angeli <angeli@iwi.uni-sb.de>
+;; Maintainer: auctex-devel@gnu.org
+;; Created: 2004-04-30
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; This file adds support for `alltt.sty'.
+
+;;; Code:
+
+(TeX-add-style-hook
+ "alltt"
+ (lambda ()
+ (LaTeX-add-environments "alltt")
+ (make-local-variable 'LaTeX-indent-environment-list)
+ (add-to-list 'LaTeX-indent-environment-list
+ '("alltt" current-indentation))
+ (make-local-variable 'LaTeX-verbatim-regexp)
+ (setq LaTeX-verbatim-regexp (concat LaTeX-verbatim-regexp "\\|alltt"))
+ (add-to-list 'LaTeX-verbatim-environments-local "alltt")
+ ;; Fontification
+ (when (and (featurep 'font-latex)
+ (eq TeX-install-font-lock 'font-latex-setup))
+ ;; For syntactic fontification, e.g. verbatim constructs.
+ (font-latex-set-syntactic-keywords)
+ ;; Tell font-lock about the update.
+ (setq font-lock-set-defaults nil)
+ (font-lock-set-defaults))))
+
+(defvar LaTeX-alltt-package-options nil
+ "Package options for the alltt package.")
+
+;;; alltt.el ends here
diff --git a/tests/auctex-11.87.7/style/alphanum.el
b/tests/auctex-11.87.7/style/alphanum.el
new file mode 100644
index 0000000..43ce10e
--- /dev/null
+++ b/tests/auctex-11.87.7/style/alphanum.el
@@ -0,0 +1,99 @@
+;;; alphanum.el --- AUCTeX style for `alphanum.sty'
+
+;; Copyright (C) 2004 Free Software Foundation, Inc.
+
+;; Author: Frank K�ster <frank@kuesterei.ch>
+;; Maintainer: auctex-devel@gnu.org
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; This is file alphanum.el, which makes AUCTeX usable with jura.cls
+;; and its style file alphanum.sty.
+;;
+;; Contributed by Frank K�ster <frank@kuesterei.ch>. The code for
+;; reftex has been written by Carsten Dominik, the maintainer of
+;; reftex, but all the errors are mine.
+
+;;; Code:
+
+
+(defun TeX-arg-none (arg)
+ (insert " "))
+
+(defun reftex-get-section-level-alphanum ()
+ (save-excursion ; preserve position
+ (save-match-data ; preserve matching data (important!)
+ ;; Go back to the beginning of the sectioning command
+ (goto-char (match-beginning 0))
+ ;; Define an initial level number, depending on the current macro.
+ (let* ((macro (reftex-match-string 3)) ; "toc" or "sub"
+ (lev (cond ((string= macro "toc") 1) ; min level for "toc"
+ ((string= macro "sub") 2) ; min level for "sub"
+ (t 0)))
+ ;; Make a regular expression which will match sectioning commands
+ ;; and the levelup macro.
+ (re (concat "\\(^[^%]*\\\\levelup\\>\\)"
+ "\\|"
+ "\\(" reftex-section-regexp "\\)")))
+ ;; Now parse backwards for all sectioning and levelup macros,
+ ;; and keep track of the relative level changes.
+ (while (re-search-backward re nil t)
+ (cond
+ ((match-beginning 1)
+ ;; levelup matched, reduce level counter
+ (setq lev (1- lev)))
+ ((string= (reftex-match-string 4) "toc")
+ ;; a toc entry, nothing changes
+ )
+ ((string= (reftex-match-string 4) "sub")
+ ;; a sub entry, increase level counter
+ (setq lev (1+ lev)))))
+ ;; return the level
+ lev))))
+
+(TeX-add-style-hook
+ "alphanum"
+ (lambda ()
+ (LaTeX-largest-level-set "chapter")
+ (TeX-add-symbols '("levelup" TeX-arg-none))
+ (make-local-variable 'LaTeX-section-list)
+ (LaTeX-section-list-add-locally
+ '(("part" 0)
+ ;; the levels don't make sense with alphanum, I randomly chose 0...
+ ("toc" 0)
+ ("sub" 0)) t)
+ (setq LaTeX-section-label
+ '(("part" . "part:")
+ ("toc" . "sec:")
+ ("sub" . "sec:")))
+ ;;
+ ;; ****************** reftex part ******************
+ ;; this won't work in multifile documents, but at least there is
+ ;; something.
+
+ (if (fboundp 'reftex-add-section-levels)
+ (reftex-add-section-levels
+ '(("toc" . reftex-get-section-level-alphanum)
+ ("sub" . reftex-get-section-level-alphanum))))))
+
+;; Local Variables:
+;; coding: iso-8859-1
+;; End:
diff --git a/tests/auctex-11.87.7/style/amsart.el
b/tests/auctex-11.87.7/style/amsart.el
new file mode 100644
index 0000000..51a2902
--- /dev/null
+++ b/tests/auctex-11.87.7/style/amsart.el
@@ -0,0 +1,10 @@
+;;; amsart.el --- Style hook for the AMS-LaTeX article document class.
+
+;;; Code:
+
+(TeX-add-style-hook "amsart"
+ (function
+ (lambda ()
+ (TeX-run-style-hooks "amsmath" "amsthm"))))
+
+;;; amsart.el ends here.
diff --git a/tests/auctex-11.87.7/style/amsbook.el
b/tests/auctex-11.87.7/style/amsbook.el
new file mode 100644
index 0000000..ccbc84e
--- /dev/null
+++ b/tests/auctex-11.87.7/style/amsbook.el
@@ -0,0 +1,10 @@
+;;; amsbook.el --- Style hook for the AMS-LaTeX book document class.
+
+;;; Code:
+
+(TeX-add-style-hook "amsbook"
+ (function
+ (lambda ()
+ (TeX-run-style-hooks "amsmath" "amsthm"))))
+
+;;; amsbook.el ends here.
diff --git a/tests/auctex-11.87.7/style/amsbsy.el
b/tests/auctex-11.87.7/style/amsbsy.el
new file mode 100644
index 0000000..dd2605c
--- /dev/null
+++ b/tests/auctex-11.87.7/style/amsbsy.el
@@ -0,0 +1,18 @@
+;;; amsbsy.el --- Style hook for the AMS-LaTeX amsbsy package.
+;;;
+;;; AUTHOR: Carsten Dominik <dominik@strw.leidenuniv.nl>
+
+;;; Code:
+
+(TeX-add-style-hook "amsbsy"
+ (function
+ (lambda ()
+ (TeX-add-symbols
+ '("boldsymbol" "Symbol")
+ '("pmb" "Symbol")
+ ))))
+
+(defvar LaTeX-amsbsy-package-options nil
+ "Package options for the amsbsy package.")
+
+;;; amsbsy.el ends here.
diff --git a/tests/auctex-11.87.7/style/amsmath.el
b/tests/auctex-11.87.7/style/amsmath.el
new file mode 100644
index 0000000..8f16425
--- /dev/null
+++ b/tests/auctex-11.87.7/style/amsmath.el
@@ -0,0 +1,181 @@
+;;; amsmath.el --- Style hook for the AMS-LaTeX amsmath package.
+
+;; Copyright (C) 2002, 2005 Free Software Foundation, Inc.
+;; FIXME: What about the copyright for <= 2001?
+
+;; Author: Carsten Dominik <dominik@strw.leidenuniv.nl>
+;; Maintainer: auctex-devel@gnu.org
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; This will also load the amstext, amsbsy and amsopn style files.
+
+;;; Code:
+
+(TeX-add-style-hook "amsmath"
+ (function
+ (lambda ()
+
+ (LaTeX-add-environments
+ '("align" LaTeX-env-label)
+ '("gather" LaTeX-env-label)
+ '("flalign" LaTeX-env-label)
+ '("multline" LaTeX-env-label)
+ '("alignat" LaTeX-amsmath-env-alignat)
+ '("alignat*" LaTeX-amsmath-env-alignat)
+ '("xalignat" LaTeX-amsmath-env-alignat)
+ '("xalignat*" LaTeX-amsmath-env-alignat)
+ '("xxalignat" LaTeX-amsmath-env-alignat)
+ '("aligned" LaTeX-amsmath-env-aligned)
+ '("gathered" LaTeX-amsmath-env-aligned)
+ "align*" "gather*" "flalign*" "multline*" "equation*"
+ "split"
+ "cases"
+ "matrix" "smallmatrix" "pmatrix" "bmatrix" "Bmatrix" "vmatrix" "Vmatrix"
+ "subequations"
+ '("subarray" "Alignment"))
+
+ (TeX-add-symbols
+ '("eqref" TeX-arg-ref)
+ '("numberwithin" TeX-arg-counter "Section level")
+ '("raisetag" "Dimension")
+ '("intertext" t)
+ '("hdotsfor" ["Stretch"] "Number of columns to cover")
+ '("xleftarrow" ["Below"] "Above")
+ '("xrightarrow" ["Below"] "Above")
+ '("overset" "Accent symbol" "Symbol")
+ '("underset" "Accent symbol" "Symbol")
+ '("dfrac" 2)
+ '("tfrac" 2)
+ '("binom" 2)
+ '("dbinom" 2)
+ '("tbinom" 2)
+ '("genfrac" "Left delimiter" "Right delimiter" "Thickness"
+ "Mathstyle" 2)
+ '("cfrac" ["position (l or r)"] t)
+ '("smash" ["where (t or b)"] t)
+ '("sideset" "Left" "Right")
+ '("tag" "(Tag)")
+ '("tag*" "Tag")
+ '("displaybreak" ["Weight (0..4)"])
+ '("allowdisplaybreaks" ["Weight (1..4)"])
+ '("substack" t)
+ '("leftroot" "Push root index left by")
+ '("uproot" "Push root index upward by")
+ '("boxed" t)
+ '("mspace" t)
+ '("mod" t)
+ '("pmod" t)
+ '("pod" t)
+ '("overleftrightarrow" t)
+ '("underleftarrow" t)
+ '("underrightarrow" t)
+ '("underleftrightarrow" t)
+ '("dddot" t)
+ '("ddddot" t)
+ "bmod" "notag"
+ "dots" "dotsb" "dotsc" "dotsi" "dotsm" "dotso" "nobreakdash"
+ "lvert" "rvert" "lVert" "rVert"
+ "iint" "iiint" "iiiint" "idotsint"
+ )
+
+ (setq LaTeX-item-list
+ (append '(("split" . LaTeX-item-equation)
+ ("multline" . LaTeX-item-equation)
+ ("multline*" . LaTeX-item-equation)
+ ("gather" . LaTeX-item-equations)
+ ("gather*" . LaTeX-item-equation)
+ ("gathered" . LaTeX-item-equation)
+ ("align" . LaTeX-item-equations)
+ ("align*" . LaTeX-item-equation)
+ ("aligned" . LaTeX-item-equation)
+ ("alignat" . LaTeX-item-equations)
+ ("alignat*" . LaTeX-item-equation)
+ ("xalignat" . LaTeX-item-equations)
+ ("xalignat*" . LaTeX-item-equation)
+ ("xxalignat" . LaTeX-item-equation)
+ ("flalign" . LaTeX-item-equations)
+ ("flalign*" . LaTeX-item-equation)
+ ("matrix" . LaTeX-item-equation)
+ ("pmatrix" . LaTeX-item-equation)
+ ("bmatrix" . LaTeX-item-equation)
+ ("Bmatrix" . LaTeX-item-equation)
+ ("vmatrix" . LaTeX-item-equation)
+ ("Vmatrix" . LaTeX-item-equation)
+ ("cases" . LaTeX-item-equation))
+ LaTeX-item-list))
+
+ ;; When `LaTeX-amsmath-label' is nil, use value of LaTeX-equation-label:
+ (unless LaTeX-amsmath-label
+ (setq LaTeX-amsmath-label LaTeX-equation-label))
+
+ (setq LaTeX-label-alist
+ (append '(("align" . LaTeX-amsmath-label)
+ ("alignat" . LaTeX-amsmath-label)
+ ("xalignat" . LaTeX-amsmath-label)
+ ("multline" . LaTeX-amsmath-label)
+ ("flalign" . LaTeX-amsmath-label)
+ ("gather" . LaTeX-amsmath-label))
+ LaTeX-label-alist))
+
+ ;; amsmath includes amstext, amsbsy, & amsopn.
+ ;; So we run their hooks, too.
+ (TeX-run-style-hooks "amstext" "amsbsy" "amsopn")
+
+ ;; If RefTeX is loaded, make it recognize the amsmath environments.
+ (when (fboundp 'reftex-add-to-label-alist)
+ (reftex-add-to-label-alist '(AMSTeX))))))
+
+(defun LaTeX-amsmath-env-alignat (env)
+ (let ((ncols (read-string "Number of columns: ")))
+ (LaTeX-insert-environment env (concat TeX-grop ncols TeX-grcl))
+ (and (not (string= "xxalignat" env))
+ (not (string= "*" (substring env -1)))
+ (LaTeX-label env)
+ (newline-and-indent))))
+
+(defun LaTeX-amsmath-env-aligned (env)
+ (let ((where (read-string "(optional) Vertical position (t or b): ")))
+ (if (string= where "")
+ (setq where "")
+ (setq where (concat "[" where "]")))
+ (LaTeX-insert-environment env where)))
+
+(defun LaTeX-item-equation ()
+ (end-of-line 0)
+ (just-one-space)
+ (insert "\\\\")
+ (forward-line 1)
+ (indent-according-to-mode))
+
+(defun LaTeX-item-equations ()
+ (LaTeX-item-equation)
+ (let ((environment (LaTeX-current-environment 1)))
+ (and (LaTeX-label environment)
+ (newline-and-indent))))
+
+(defvar LaTeX-amsmath-package-options '("intlimits" "nointlimits"
+ "sumlimits" "nosumlimits"
+ "namelimits" "nonamelimits"
+ "leqno" "reqno" "centertags"
+ "tbtags" "cmex10" "fleqn" "?")
+ "Package options for the amsmath package.")
+
+;;; amsmath.el ends here.
diff --git a/tests/auctex-11.87.7/style/amsopn.el
b/tests/auctex-11.87.7/style/amsopn.el
new file mode 100644
index 0000000..1e875d8
--- /dev/null
+++ b/tests/auctex-11.87.7/style/amsopn.el
@@ -0,0 +1,19 @@
+;;; amsopn.el --- Style hook for the AMS-LaTeX amsopn package.
+;;;
+;;; AUTHOR: Carsten Dominik <dominik@strw.leidenuniv.nl>
+
+;;; Code:
+
+(TeX-add-style-hook "amsopn"
+ (function
+ (lambda ()
+ (TeX-add-symbols
+ '("DeclareMathOperator" "Operator (with \\)" "Text")
+ '("DeclareMathOperator*" "Operator (with \\)" "Text")
+ '("operatorname" t)
+ '("operatorname*" t)))))
+
+(defvar LaTeX-amsopn-package-options '("namelimits" "nonamelimits")
+ "Package options for the amsopn package.")
+
+;;; amsopn.el ends here.
diff --git a/tests/auctex-11.87.7/style/amstex.el
b/tests/auctex-11.87.7/style/amstex.el
new file mode 100644
index 0000000..347d72f
--- /dev/null
+++ b/tests/auctex-11.87.7/style/amstex.el
@@ -0,0 +1,60 @@
+;;; amstex.el --- AMS-LaTeX support.
+
+;; Copyright (C) 2004, 2005 Free Software Foundation, Inc.
+
+;; Maintainer: auctex-devel@gnu.org
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; This file is only needed when using AMS-LaTeX 1.1 and LaTeX 2.09.
+;; In later versions of LaTeX and AMS-LaTeX this file is never used,
+;; because there is no longer a class or package name amstex.
+;;
+;; As far as AUCTeX is concerned, the old amstex style is fairly
+;; similar to the new amsmath package. So we will just run that hook
+;; here.
+;;
+;; amsmath.el should not be loaded, if an AMS-TeX (in contrast to
+;; AMS-LaTeX) file is opened. The commands defined in amsmath.el
+;; mostly have no meaning in this case and errors about unknown
+;; variables or functions may occur due to latex.el possibly not being
+;; loaded.
+
+;;; Code:
+
+(TeX-add-style-hook
+ "amstex"
+ (function
+ (lambda ()
+ (unless (memq major-mode '(plain-tex-mode ams-tex-mode))
+ (TeX-run-style-hooks "amsmath")))))
+
+(defvar LaTeX-amstex-package-options '("noamsfonts" "psamsfonts"
+ "intlimits" "nointlimits"
+ "sumlimits" "nosumlimits"
+ "namelimits" "nonamelimits"
+ "leqno" "reqno" "centertags"
+ "tbtags" "fleqn" "righttag"
+ "ctagsplt" "intlim" "nosumlim"
+ "nonamelm")
+ "Package options for the amstex package.")
+
+;;; amstex.el ends here.
diff --git a/tests/auctex-11.87.7/style/amstext.el
b/tests/auctex-11.87.7/style/amstext.el
new file mode 100644
index 0000000..a9aa855
--- /dev/null
+++ b/tests/auctex-11.87.7/style/amstext.el
@@ -0,0 +1,16 @@
+;;; amstext.el --- Style hook for the AMS-LaTeX amstext package.
+;;;
+;;; AUTHOR: Carsten Dominik <dominik@strw.leidenuniv.nl>
+
+;;; Code:
+
+(TeX-add-style-hook "amstext"
+ (function
+ (lambda ()
+ (TeX-add-symbols
+ '("text" t)))))
+
+(defvar LaTeX-amstext-package-option nil
+ "Package options for the amstext package.")
+
+;;; amstext.el ends here.
diff --git a/tests/auctex-11.87.7/style/amsthm.el
b/tests/auctex-11.87.7/style/amsthm.el
new file mode 100644
index 0000000..9903040
--- /dev/null
+++ b/tests/auctex-11.87.7/style/amsthm.el
@@ -0,0 +1,53 @@
+;;; amsthm.el --- Style hook for the AMS-LaTeX amsthm package.
+
+;; Copyright (C) 1997 Free Software Foundation, Inc.
+
+;; Author: Carsten Dominik <dominik@strw.leidenuniv.nl>
+;; Maintainer: auctex-devel@gnu.org
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Code:
+
+(TeX-add-style-hook "amsthm"
+ (function
+ (lambda ()
+ (LaTeX-add-environments
+ '("proof" (lambda (env &rest ignore)
+ (LaTeX-insert-environment
+ env
+ (let ((heading (read-string "(optional) Heading: ")))
+ (if (string= heading "")
+ ""
+ (format "[%s]" heading))))))
+ )
+ (TeX-add-symbols
+ '("newtheorem" "Environment name" ["Share numbering with"] "Heading"
+ ["Number subordinated in each"])
+ '("newtheorem*" "Environment name" "Heading")
+ '("theoremstyle" LaTeX-amsthm-complete-theoremstyle)
+ ))))
+
+(defun LaTeX-amsthm-complete-theoremstyle (&rest ignore)
+ (insert TeX-grop
+ (completing-read "Style: " '(("plain" . nil)
+ ("definition" . nil)
+ ("remark" . nil)))
+ TeX-grcl))
+
+;;; amsthm.el ends here
diff --git a/tests/auctex-11.87.7/style/article.el
b/tests/auctex-11.87.7/style/article.el
new file mode 100644
index 0000000..2acb566
--- /dev/null
+++ b/tests/auctex-11.87.7/style/article.el
@@ -0,0 +1,12 @@
+;;; article.el - Special code for article style.
+
+;; $Id: article.el,v 1.4 2005-03-17 10:02:06 angeli Exp $
+
+;;; Code:
+
+(TeX-add-style-hook
+ "article"
+ (lambda ()
+ (LaTeX-largest-level-set "section")))
+
+;;; article.el ends here
diff --git a/tests/auctex-11.87.7/style/austrian.el
b/tests/auctex-11.87.7/style/austrian.el
new file mode 100644
index 0000000..13f28a8
--- /dev/null
+++ b/tests/auctex-11.87.7/style/austrian.el
@@ -0,0 +1,39 @@
+;;; austrian.el --- AUCTeX style for the `austrian' babel option.
+
+;; Copyright (C) 2009 Free Software Foundation, Inc.
+
+;; Author: Ralf Angeli <angeli@caeruleus.net>
+;; Maintainer: auctex-devel@gnu.org
+;; Created: 2009-12-28
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; Set up AUCTeX for editing Austrian text in connection with the
+;; `austrian' babel option.
+
+;;; Code:
+
+(TeX-add-style-hook
+ "austrian"
+ (lambda ()
+ (TeX-run-style-hooks "german")))
+
+;;; austrian.el ends here
diff --git a/tests/auctex-11.87.7/style/babel.el
b/tests/auctex-11.87.7/style/babel.el
new file mode 100755
index 0000000..3242d0e
--- /dev/null
+++ b/tests/auctex-11.87.7/style/babel.el
@@ -0,0 +1,108 @@
+;;; babel.el --- AUCTeX style for `babel.sty'
+
+;; Copyright (C) 2005 Free Software Foundation, Inc.
+
+;; Author: Ralf Angeli <angeli@iwi.uni-sb.de>
+;; Maintainer: auctex-devel@gnu.org
+;; Created: 2005-05-29
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; This file adds support for `babel.sty'.
+
+;;; Code:
+
+(defvar LaTeX-babel-language-list
+ '("acadian" "afrikaans" "american" "austrian""bahasa" "basque" "brazil"
+ "brazilian" "breton" "british" "bulgarian" "canadian" "canadien"
+ "catalan" "croatian" "czech" "danish" "dutch" "english" "esperanto"
+ "estonian" "finnish" "francais" "frenchb" "french" "galician"
+ "german" "germanb" "greek" "polutonikogreek" "hebrew" "hungarian"
+ "icelandic" "irish" "italian" "latin" "lowersorbian" "magyar"
+ "naustrian" "ngerman" "norsk" "samin" "nynorsk" "polish" "portuges"
+ "portuguese" "romanian" "russian" "scottish" "serbian" "slovak"
+ "slovene" "spanish" "swedish" "turkish" "ukrainian" "uppersorbian"
+ "welsh" "UKenglish" "USenglish")
+ "List of languages supported by the babel LaTeX package.")
+
+(if (fboundp 'defvaralias)
+ (defvaralias 'LaTeX-babel-package-options 'LaTeX-babel-language-list)
+ (defvar LaTeX-babel-package-options LaTeX-babel-language-list
+ "Package options for the babel package."))
+
+(defun LaTeX-babel-active-languages ()
+ "Return a list of languages used in the document."
+ (let (active-languages)
+ (dolist (elt LaTeX-babel-language-list)
+ (when (member elt TeX-active-styles)
+ (add-to-list 'active-languages (list elt))))
+ active-languages))
+
+(defun TeX-arg-babel-lang (optional &optional prompt)
+ "Prompt for a language with completion and insert it as an argument."
+ (TeX-argument-insert
+ (completing-read "Language: " (LaTeX-babel-active-languages)) nil))
+
+(defun LaTeX-env-babel-lang (env)
+ "Prompt for a language and insert it as an argument of ENV."
+ (LaTeX-insert-environment
+ env (format "{%s}" (completing-read "Language: "
+ (LaTeX-babel-active-languages)))))
+
+(TeX-add-style-hook
+ "babel"
+ (lambda ()
+ ;; New symbols
+ (TeX-add-symbols
+ '("selectlanguage" TeX-arg-babel-lang)
+ '("foreignlanguage" TeX-arg-babel-lang t)
+ "languagename"
+ '("iflanguage" TeX-arg-babel-lang t nil)
+ '("useshorthands" t)
+ '("defineshorthand" t nil)
+ '("aliasshorthand" t nil)
+ '("languageshorthands" TeX-arg-babel-lang)
+ '("shorthandon" t)
+ '("shorthandoff" t)
+ '("languageattribute" TeX-arg-babel-lang t))
+ ;; New environments
+ (LaTeX-add-environments
+ '("otherlanguage" LaTeX-env-babel-lang)
+ '("otherlanguage*" LaTeX-env-babel-lang)
+ '("hyphenrules" LaTeX-env-babel-lang))
+ ;; Fontification
+ (when (and (featurep 'font-latex)
+ (eq TeX-install-font-lock 'font-latex-setup))
+ (font-latex-add-keywords '(("selectlanguage" "{")
+ ("foreignlanguage" "{{")
+ ("iflanguage" "{{{")
+ ("languagename" "")
+ ("useshorthands" "{")
+ ("languageshorthands" "{")
+ ("shorthandon" "{")
+ ("shorthandoff" "{"))
+ 'function)
+ (font-latex-add-keywords '(("defineshorthand" "{{")
+ ("aliasshorthand" "{{")
+ ("languageattribute" "{{"))
+ 'variable))))
+
+;;; babel.el ends here
diff --git a/tests/auctex-11.87.7/style/beamer.el
b/tests/auctex-11.87.7/style/beamer.el
new file mode 100644
index 0000000..cd4fa09
--- /dev/null
+++ b/tests/auctex-11.87.7/style/beamer.el
@@ -0,0 +1,336 @@
+;;; beamer.el --- AUCTeX style for the latex-beamer class
+
+;; Copyright (C) 2003, 2004, 2005,2008 Free Software Foundation
+
+;; Author: Thomas Baumann <thomas.baumann@ch.tum.de>
+;; Created: 2003-12-20
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; This file adds support for the latex-beamer class.
+
+;;; Code:
+
+(defun LaTeX-beamer-after-insert-env (env start end)
+ "Do beamer-specific stuff after the insertion of an environment."
+ ;; Add `fragile' as an optional argument to the frame environment if
+ ;; a verbatim environment is inserted.
+ (when (and (TeX-member env (LaTeX-verbatim-environments) 'string-equal)
+ (save-excursion
+ (goto-char start)
+ (string-equal (LaTeX-current-environment) "frame")))
+ (save-excursion
+ (when (re-search-backward "\\\\begin[ \t]*{frame}" nil t)
+ (let ((end-of-begin (match-end 0)))
+ (goto-char end-of-begin)
+ (while (forward-comment 1))
+ (if (eq (char-after) (string-to-char LaTeX-optop))
+ (progn
+ (forward-char)
+ (insert "fragile")
+ (unless (looking-at (concat "[ \t]*" LaTeX-optcl))
+ (insert ",")))
+ (goto-char end-of-begin)
+ (insert "[fragile]")))))))
+
+(TeX-add-style-hook
+ "beamer"
+ (lambda ()
+ (add-hook 'LaTeX-after-insert-env-hooks 'LaTeX-beamer-after-insert-env nil
t)
+
+ (unless LaTeX-beamer-section-labels-flag
+ (make-local-variable 'LaTeX-section-hook)
+ (setq LaTeX-section-hook
+ '(LaTeX-section-heading
+ LaTeX-section-title
+ LaTeX-section-section)))
+
+ (setq LaTeX-item-list
+ (append '(("itemize" . LaTeX-item-beamer)
+ ("enumerate" . LaTeX-item-beamer))
+ LaTeX-item-list))
+
+ (LaTeX-paragraph-commands-add-locally "frametitle")
+
+ (TeX-add-symbols
+ '("alert" 1)
+ '("alt" TeX-arg-beamer-overlay-spec 2)
+ '("beamerbutton" 1)
+ '("beamergotobutton" 1)
+ '("beamerreturnbutton" 1)
+ '("beamerskipbutton" 1)
+ '("frame" TeX-arg-beamer-frametitle)
+ '("frametitle" 1)
+ '("hyperlink" TeX-arg-beamer-overlay-spec 2)
+ '("hyperlinkslideprev" TeX-arg-beamer-overlay-spec 1)
+ '("hyperlinkslidenext" TeX-arg-beamer-overlay-spec 1)
+ '("hyperlinkframestart" TeX-arg-beamer-overlay-spec 1)
+ '("hyperlinkframeend" TeX-arg-beamer-overlay-spec 1)
+ '("hyperlinkframestartnext" TeX-arg-beamer-overlay-spec 1)
+ '("hyperlinkframeendprev" TeX-arg-beamer-overlay-spec 1)
+ '("hyperlinkpresentationstart" TeX-arg-beamer-overlay-spec 1)
+ '("hyperlinkpresentationend" TeX-arg-beamer-overlay-spec 1)
+ '("hyperlinkappendixstart" TeX-arg-beamer-overlay-spec 1)
+ '("hyperlinkappendixend" TeX-arg-beamer-overlay-spec 1)
+ '("hyperlinkdocumentstart" TeX-arg-beamer-overlay-spec 1)
+ '("hyperlinkdocumentend" TeX-arg-beamer-overlay-spec 1)
+ '("hypertarget" TeX-arg-beamer-overlay-spec 2)
+ '("institute" 1)
+ '("invisible" TeX-arg-beamer-overlay-spec 1)
+ '("label" TeX-arg-beamer-overlay-spec 1)
+ '("logo" 1)
+ '("note" TeX-arg-beamer-note 1)
+ '("only" TeX-arg-beamer-overlay-spec 1)
+ '("onslide" TeX-arg-beamer-overlay-spec)
+ '("partpage")
+ '("pause")
+ '("structure" TeX-arg-beamer-overlay-spec 1)
+ '("temporal" TeX-arg-beamer-overlay-spec 3)
+ '("titlepage")
+ '("titlegraphic" 1)
+ '("uncover" TeX-arg-beamer-overlay-spec 1)
+ '("usetheme" LaTeX-arg-beamer-theme)
+ '("useinnertheme" LaTeX-arg-beamer-inner-theme)
+ '("useoutertheme" LaTeX-arg-beamer-outer-theme)
+ '("usecolortheme" LaTeX-arg-beamer-color-theme)
+ '("usefonttheme" LaTeX-arg-beamer-font-theme)
+ '("usetheme" LaTeX-arg-beamer-theme)
+ '("visible" TeX-arg-beamer-overlay-spec 1))
+
+ (LaTeX-add-environments
+ '("actionenv")
+ '("alertblock" 1)
+ '("beamerboxesrounded" 1)
+ '("block" (lambda (env &rest ignore)
+ (LaTeX-insert-environment
+ env (format "{%s}" (read-string "Title: ")))))
+ '("column" "Width")
+ "columns"
+ "columnsonlytextwidth"
+ '("exampleblock" 1)
+ '("frame" (lambda (env &rest ignore)
+ (let ((title (read-string "(Optional) Title: ")))
+ (LaTeX-insert-environment env)
+ (unless (zerop (length title))
+ (save-excursion
+ (LaTeX-find-matching-begin)
+ (end-of-line)
+ (LaTeX-newline)
+ (insert (format "\\frametitle{%s}" title))
+ ;; This works because \frametitle is a
+ ;; paragraph command.
+ (backward-char)
+ (LaTeX-fill-paragraph))))))
+ '("onlyenv" (lambda (env &rest ignore)
+ (LaTeX-insert-environment
+ env
+ (let ((overlay (read-string "(Optional) Overlay: ")))
+ (unless (zerop (length overlay))
+ (format "<%s>" overlay))))))
+ '("overlayarea" "Area width" "Area height")
+ '("overprint" (lambda (env &rest ignore)
+ (LaTeX-insert-environment
+ env
+ (let ((width (read-string "(Optional) Area width: ")))
+ (unless (zerop (length width))
+ (format "[%s]" width))))))
+ "semiverbatim")
+
+ (make-local-variable 'LaTeX-indent-environment-list)
+ (add-to-list 'LaTeX-indent-environment-list
+ '("semiverbatim" current-indentation))
+ (make-local-variable 'LaTeX-verbatim-regexp)
+ (setq LaTeX-verbatim-regexp (concat LaTeX-verbatim-regexp
"\\|semiverbatim"))
+ (add-to-list 'LaTeX-verbatim-environments-local "semiverbatim")
+
+ ;; Fontification
+ (when (and (featurep 'font-latex)
+ (eq TeX-install-font-lock 'font-latex-setup))
+ (font-latex-add-keywords '(("frametitle" "<[{")) 'slide-title)
+ ;; For syntactic fontification, e.g. verbatim constructs.
+ (font-latex-set-syntactic-keywords)
+ ;; Tell font-lock about the update.
+ (setq font-lock-set-defaults nil)
+ (font-lock-set-defaults))))
+
+(defun TeX-arg-beamer-overlay-spec (optional &optional prompt)
+ "Prompt for overlay specification."
+ (let ((overlay (read-string "(Optional) Overlay: ")))
+ (unless (zerop (length overlay))
+ (insert "<" overlay ">"))
+ (indent-according-to-mode)))
+
+(defun TeX-arg-beamer-frametitle (optional &optional prompt)
+ "Prompt for the frametitle."
+ (let ((title (read-string "Title: ")))
+ (if (not (zerop (length title)))
+ (insert TeX-grop TeX-esc "frametitle" TeX-grop
+ title TeX-grcl TeX-grcl)
+ (insert TeX-grop TeX-grcl))))
+
+(defun LaTeX-item-beamer ()
+ "Insert a new item with an optional overlay argument. You
+can turn off the prompt for the overlay argument by setting
+`LaTeX-beamer-item-overlay-flag' to nil. Calling the function
+with a prefix argument prompts for the overlay specification
+unconditionally."
+ (if (listp current-prefix-arg)
+ (setq current-prefix-arg (car current-prefix-arg))
+ current-prefix-arg)
+ (TeX-insert-macro "item")
+ (delete-horizontal-space)
+ (if (or current-prefix-arg LaTeX-beamer-item-overlay-flag)
+ (TeX-arg-beamer-overlay-spec 0))
+ (insert " ")
+ (indent-according-to-mode))
+
+(defun TeX-arg-beamer-note (optional &optional prompt)
+ "Prompt for overlay specification and optional argument."
+ (let ((overlay (read-string "(Optional) Overlay: "))
+ (options (read-string "(Optional) Options: ")))
+ (unless (zerop (length overlay))
+ (insert "<" overlay ">"))
+ (unless (zerop (length options))
+ (insert "[" options "]"))
+ (indent-according-to-mode)))
+
+(defun LaTeX-beamer-search-themes (&optional regexp extensions length)
+ "Search for beamer themes matching REGEXP with EXTENSIONS.
+The function removes the first LENGTH characters and the
+extension of the file and returns a list of strings. LENGTH may
+also be a string. Then the length of the string is used."
+ (let* ((match (or regexp "^beamertheme[A-Z]"))
+ (exts (or extensions '("tex" "sty")))
+ (chars (cond ((integerp length)
+ length)
+ ((stringp length)
+ (string-width length))
+ ;; Try some DWIM magic...
+ ((and (not length)
+ (string-match "beamer[A-Za-z0-9]*theme" match))
+ (- (match-end 0) (match-beginning 0)))
+ (t (error "Invalid length: `%s'" length)))))
+ ;; (message "match=`%s' chars=`%s'" match chars)
+ (TeX-delete-duplicate-strings
+ (delete nil
+ (mapcar
+ (lambda (file)
+ (let ((case-fold-search nil))
+ (and (numberp (string-match match file))
+ (substring file chars))))
+ (TeX-search-files nil exts t t))))))
+
+(defun LaTeX-arg-beamer-theme (&rest ignore)
+ "Prompt for beamer theme with completion."
+ (TeX-argument-insert
+ (completing-read
+ (TeX-argument-prompt nil nil "Theme")
+ (mapcar 'list
+ (cond ((eq LaTeX-beamer-themes 'local)
+ (set (make-local-variable 'LaTeX-beamer-themes)
+ (LaTeX-beamer-search-themes)))
+ ((functionp LaTeX-beamer-themes)
+ (funcall LaTeX-beamer-themes))
+ ((listp LaTeX-beamer-themes)
+ LaTeX-beamer-themes)
+ (t (error
+ "`LaTeX-beamer-themes' should be a list: `%s'"
+ LaTeX-beamer-themes))))
+ nil nil nil)
+ t))
+
+(defun LaTeX-arg-beamer-inner-theme (&rest ignore)
+ "Prompt for beamer inner theme with completion."
+ (TeX-argument-insert
+ (completing-read
+ (TeX-argument-prompt nil nil "Theme")
+ (mapcar 'list
+ (cond ((eq LaTeX-beamer-inner-themes 'local)
+ (set (make-local-variable 'LaTeX-beamer-inner-themes)
+ (LaTeX-beamer-search-themes "^beamerinnertheme")))
+ ((functionp LaTeX-beamer-inner-themes)
+ (funcall LaTeX-beamer-inner-themes))
+ ((listp LaTeX-beamer-inner-themes)
+ LaTeX-beamer-inner-themes)
+ (t (error
+ "`LaTeX-beamer-inner-themes' should be a list: `%s'"
+ LaTeX-beamer-inner-themes))))
+ nil nil nil)
+ t))
+
+(defun LaTeX-arg-beamer-outer-theme (&rest ignore)
+ "Prompt for beamer outer theme with completion."
+ (TeX-argument-insert
+ (completing-read
+ (TeX-argument-prompt nil nil "Theme")
+ (mapcar 'list
+ (cond ((eq LaTeX-beamer-outer-themes 'local)
+ (set (make-local-variable 'LaTeX-beamer-outer-themes)
+ (LaTeX-beamer-search-themes "^beameroutertheme")))
+ ((functionp LaTeX-beamer-outer-themes)
+ (funcall LaTeX-beamer-outer-themes))
+ ((listp LaTeX-beamer-outer-themes)
+ LaTeX-beamer-outer-themes)
+ (t (error
+ "`LaTeX-beamer-outer-themes' should be a list: `%s'"
+ LaTeX-beamer-outer-themes))))
+ nil nil nil)
+ t))
+
+(defun LaTeX-arg-beamer-color-theme (&rest ignore)
+ "Prompt for beamer color theme with completion."
+ (TeX-argument-insert
+ (completing-read
+ (TeX-argument-prompt nil nil "Theme")
+ (mapcar 'list
+ (cond ((eq LaTeX-beamer-color-themes 'local)
+ (set (make-local-variable 'LaTeX-beamer-color-themes)
+ (LaTeX-beamer-search-themes "^beamercolortheme")))
+ ((functionp LaTeX-beamer-color-themes)
+ (funcall LaTeX-beamer-color-themes))
+ ((listp LaTeX-beamer-color-themes)
+ LaTeX-beamer-color-themes)
+ (t (error
+ "`LaTeX-beamer-color-themes' should be a list: `%s'"
+ LaTeX-beamer-color-themes))))
+ nil nil nil)
+ t))
+
+(defun LaTeX-arg-beamer-font-theme (&rest ignore)
+ "Prompt for beamer font theme with completion."
+ (TeX-argument-insert
+ (completing-read
+ (TeX-argument-prompt nil nil "Theme")
+ (mapcar 'list
+ (cond ((eq LaTeX-beamer-font-themes 'local)
+ (set (make-local-variable 'LaTeX-beamer-font-themes)
+ (LaTeX-beamer-search-themes "^beamerfonttheme")))
+ ((functionp LaTeX-beamer-font-themes)
+ (funcall LaTeX-beamer-font-themes))
+ ((listp LaTeX-beamer-font-themes)
+ LaTeX-beamer-font-themes)
+ (t (error
+ "`LaTeX-beamer-font-themes' should be a list: `%s'"
+ LaTeX-beamer-font-themes))))
+ nil nil nil)
+ t))
+
+;;; beamer.el ends here
diff --git a/tests/auctex-11.87.7/style/biblatex.el
b/tests/auctex-11.87.7/style/biblatex.el
new file mode 100644
index 0000000..3a66cff
--- /dev/null
+++ b/tests/auctex-11.87.7/style/biblatex.el
@@ -0,0 +1,47 @@
+;;; biblatex.el --- AUCTeX style for `biblatex.sty'
+
+;; Copyright (C) 2012 Free Software Foundation, Inc.
+
+;; Author: Ralf Angeli <angeli@caeruleus.net>
+;; Maintainer: auctex-devel@gnu.org
+;; Created: 2012-11-14
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; This file adds support for `biblatex.sty'.
+
+;;; Code:
+
+(TeX-add-style-hook
+ "biblatex"
+ (lambda ()
+ ;; Unfortunately `(member "backend=biber" TeX-active-styles)' does
+ ;; not work as a test because "backend=biber" is added to
+ ;; `TeX-active-styles' after "biblatex". So we check the value of
+ ;; `LaTeX-biblatex-use-biber' and let the user set it if desired.
+ (when LaTeX-biblatex-use-Biber
+ (setq LaTeX-using-Biber t))))
+
+;; TODO: Add package options.
+(defvar LaTeX-biblatex-package-options nil
+ "Package options for the biblatex package.")
+
+;;; biblatex.el ends here
diff --git a/tests/auctex-11.87.7/style/book.el
b/tests/auctex-11.87.7/style/book.el
new file mode 100644
index 0000000..829fa4e
--- /dev/null
+++ b/tests/auctex-11.87.7/style/book.el
@@ -0,0 +1,12 @@
+;;; book.el - Special code for book style.
+
+;; $Id: book.el,v 1.5 2005-03-17 10:02:06 angeli Exp $
+
+;;; Code:
+
+(TeX-add-style-hook
+ "book"
+ (lambda ()
+ (LaTeX-largest-level-set "chapter")))
+
+;;; book.el ends here
diff --git a/tests/auctex-11.87.7/style/booktabs.el
b/tests/auctex-11.87.7/style/booktabs.el
new file mode 100644
index 0000000..e126872
--- /dev/null
+++ b/tests/auctex-11.87.7/style/booktabs.el
@@ -0,0 +1,74 @@
+;;; booktabs.el -- AUCTeX style for booktabs.sty
+
+;; Copyright (C) 2003, 2004 Free Software Foundation, Inc.
+
+;; Author: Ralf Angeli <angeli@iwi.uni-sb.de>
+;; Maintainer: auctex-devel@gnu.org
+;; Created: 2003-10-21
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; This file adds support for `booktabs.sty'.
+
+;;; Code:
+
+(defun LaTeX-booktabs-arg-paren (optional prompt)
+ "Prompt for a value and use parentheses when it is inserted.
+If OPTIONAL is non-nil the parameter is labeled as optional.
+PROMPT is the value of the prompt to be shown."
+ (let ((< "\(")
+ (> "\)"))
+ (TeX-parse-argument optional prompt)))
+
+(TeX-add-style-hook
+ "booktabs"
+ (lambda ()
+
+ ;; New symbols
+ (TeX-add-symbols
+ '("toprule" [ "Thickness" ])
+ '("midrule" [ "Thickness" ])
+ '("bottomrule" [ "Thickness" ])
+ ;; FIXME: The qestion for the trim parameter will only be asked if
+ ;; a value for the thickness parameter was given. Is this a
+ ;; feature of `TeX-parse-arguments'?
+ '("cmidrule" [ "Thickness" ] [ LaTeX-booktabs-arg-paren "Trim" ]
+ "Column(s)")
+ '("addlinespace" [ "Height" ])
+ '("morecmidrules")
+ '("specialrule" "Thickness" "Space above" "Space below"))
+
+ ;; Fontification
+ (when (and (featurep 'font-latex)
+ (eq TeX-install-font-lock 'font-latex-setup))
+ (font-latex-add-keywords '(("toprule" "[")
+ ("midrule" "[")
+ ("bottomrule" "[")
+ ("cmidrule" "[({")
+ ("addlinespace" "[")
+ ("morecmidrules" "")
+ ("specialrule" "{{{"))
+ 'function))))
+
+(defvar LaTeX-booktabs-package-options nil
+ "Package options for the booktabs package.")
+
+;;; booktabs.el ends here
diff --git a/tests/auctex-11.87.7/style/bulgarian.el
b/tests/auctex-11.87.7/style/bulgarian.el
new file mode 100644
index 0000000..77cb2b2
--- /dev/null
+++ b/tests/auctex-11.87.7/style/bulgarian.el
@@ -0,0 +1,54 @@
+;;; bulgarian.el --- AUCTeX style for the `bulgarian' babel option.
+
+;; Copyright (C) 2008 Free Software Foundation, Inc.
+
+;; Author: Ralf Angeli <angeli@caeruleus.net>
+;; Maintainer: auctex-devel@gnu.org
+;; Created: 2008-06-28
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; Set up AUCTeX for editing Bulgarian text in connection with the
+;; `bulgarian' babel option.
+
+;;; Code:
+
+(defvar LaTeX-bulgarian-mode-syntax-table
+ (copy-syntax-table LaTeX-mode-syntax-table)
+ "Syntax table used in LaTeX mode when using `bulgarian.sty'.")
+
+(modify-syntax-entry ?\" "w" LaTeX-bulgarian-mode-syntax-table)
+
+(TeX-add-style-hook
+ "bulgarian"
+ (lambda ()
+ (set-syntax-table LaTeX-bulgarian-mode-syntax-table)
+ (unless (eq (car TeX-quote-language) 'override)
+ (setq TeX-quote-language
+ `("bulgarian" "\"`" "\"'" ,TeX-quote-after-quote)))
+ (setq LaTeX-babel-hyphen-language "bulgarian")
+ ;; Fontification of quotation marks.
+ (when (fboundp 'font-latex-add-quotes)
+ (font-latex-add-quotes '("\"`" "\"'"))
+ (font-latex-add-quotes '("\"<" "\">" french)))
+ (run-hooks 'TeX-language-bg-hook)))
+
+;;; bulgarian.el ends here
diff --git a/tests/auctex-11.87.7/style/captcont.el
b/tests/auctex-11.87.7/style/captcont.el
new file mode 100644
index 0000000..ffa48bf
--- /dev/null
+++ b/tests/auctex-11.87.7/style/captcont.el
@@ -0,0 +1,46 @@
+;; captcont.el --- AUCTeX style file for captcont.sty
+
+;; Copyright (C) 2003, 2005 Free Software Foundation, Inc.
+
+;; Author: Reiner Steib <Reiner.Steib@gmx.de>
+;; Maintainer: auctex-devel@gnu.org
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; AUCTeX style file for captcont.sty
+
+;;; Code:
+
+(TeX-add-style-hook
+ "captcont"
+ (lambda ()
+ (TeX-add-symbols
+ '("captcont" [ "list entry" ] "Caption")
+ '("captcont*" [ "list entry" ] "Caption"))
+ ;; Fontification
+ (when (featurep 'font-latex)
+ (font-latex-add-keywords '(("captcont" "*[{")) 'textual))))
+
+(defvar LaTeX-captcont-package-options '("figbotcap" "figtopcap" "tabbotcap"
+ "tabtopcap")
+ "Package options for the captcont package.")
+
+;;; captcont.el ends here
diff --git a/tests/auctex-11.87.7/style/comment.el
b/tests/auctex-11.87.7/style/comment.el
new file mode 100644
index 0000000..c842d20
--- /dev/null
+++ b/tests/auctex-11.87.7/style/comment.el
@@ -0,0 +1,69 @@
+;;; comment.el --- AUCTeX style for `comment.sty'
+
+;; Copyright (C) 2007 Free Software Foundation, Inc.
+
+;; Author: Ralf Angeli <angeli@caeruleus.net>
+;; Maintainer: auctex-devel@gnu.org
+;; Created: 2007-03-18
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; 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 adds support for `comment.sty'.
+
+;;; Code:
+
+(TeX-add-style-hook
+ "comment"
+ (lambda ()
+ ;; New symbols
+ (TeX-add-symbols
+ '("includecomment" "Name")
+ '("excludecomment" "Name")
+ '("specialcomment" "Name" "Before commands" "After commands")
+ '("processcomment" "Name" "Each-line commands"
+ "Before commands" "After commands"))
+ ;; New environments
+ (mapc 'LaTeX-add-environments LaTeX-comment-env-list)
+ ;; Fontification
+ (when (and (featurep 'font-latex)
+ (eq TeX-install-font-lock 'font-latex-setup))
+ ;; For syntactic fontification.
+ (add-to-list 'font-latex-syntactic-keywords-extra
+ ;; \begin is supposed to start at the beginning of a line.
+ `(,(format "^\\\\begin *{\\(?:%s\\)}.*\\(\n\\)"
+ (regexp-opt LaTeX-comment-env-list))
+ (1 "<" t)))
+ (add-to-list 'font-latex-syntactic-keywords-extra
+ ;; \end is supposed to start at the beginning of a line.
+ `(,(format "^\\(\\\\\\)end *{\\(?:%s\\)}"
+ (regexp-opt LaTeX-comment-env-list))
+ (1 ">" t)))
+ (font-latex-set-syntactic-keywords)
+ (font-latex-add-keywords '(("includecomment" "{")
+ ("excludecomment" "{")
+ ("specialcomment" "{{{")
+ ("processcomment" "{{{{"))
+ 'variable)
+ ;; Tell font-lock about the update.
+ (setq font-lock-set-defaults nil)
+ (font-lock-set-defaults))))
+
+;;; comment.el ends here
diff --git a/tests/auctex-11.87.7/style/csquotes.el
b/tests/auctex-11.87.7/style/csquotes.el
new file mode 100644
index 0000000..50aa1f9
--- /dev/null
+++ b/tests/auctex-11.87.7/style/csquotes.el
@@ -0,0 +1,245 @@
+;;; csquotes.el --- AUCTeX style for `csquotes.sty'
+
+;; Copyright (C) 2004, 2005, 2006 Free Software Foundation, Inc.
+
+;; Author: Ralf Angeli <angeli@caeruleus.net>
+;; Maintainer: auctex-devel@gnu.org
+;; Created: 2004-11-29
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; This file adds support for `csquotes.sty', version 3.7.
+
+
+;;; Code:
+
+;; FIXME: It would be nice to be able to dump this function in favor
+;; of a generalized handling of additional arguments for environments
+;; specified via `LaTeX-add-environments'. `TeX-parse-arguments' and
+;; friends would be the functions to be used for that, but those
+;; functions currently insert text directly into the buffer. There
+;; would either have to be a way of preventing this and letting them
+;; return a string, or the insertion could happen in a temporary buffer
+;; and the buffer content be returned.
+(defun LaTeX-csquotes-insert-environment (env &rest args)
+ "Insert environment ENV considering optional arguments ARGS.
+
+This is basically a variant of `LaTeX-environment-menu'
+specialized for csquotes.el. ARGS can be made up of strings and
+vectors containing single strings. Plain strings will be used as
+prompts for mandatory arguments and strings in vectors as prompts
+for optional arguments of the environment to be inserted.
+
+That means, in contrast to `LaTeX-environment-menu' it supports
+the insertion of optional arguments."
+ (let (env-extra prompt optional user-input)
+ (dolist (elt args)
+ (if (vectorp elt)
+ (setq prompt (aref elt 0)
+ optional t)
+ (setq prompt elt
+ optional nil))
+ (setq user-input (read-string (TeX-argument-prompt optional prompt nil)))
+ (unless (and optional (zerop (length user-input)))
+ (setq env-extra (concat env-extra
+ (if optional LaTeX-optop TeX-grop)
+ user-input
+ (if optional LaTeX-optcl TeX-grcl)))))
+ (LaTeX-insert-environment env env-extra)))
+
+(TeX-add-style-hook
+ "csquotes"
+ (lambda ()
+ (let ((quote-style-variant-list '(("quotes") ("guillemets") ("american")
+ ("british") ("oldstyle") ("imprimerie")
+ ("swiss")))
+ (quote-style-name-list '(("danish") ("dutch") ("english") ("finnish")
+ ("french") ("german") ("italian")
+ ("norwegian") ("swedish"))))
+ ;; New symbols
+ (TeX-add-symbols
+ '("enquote" 1)
+ '("enquote*" 1)
+ '("foreignquote" 2)
+ '("foreignquote*" 2)
+ '("hyphenquote" 2)
+ '("hyphenquote*" 2)
+ '("textquote" ["Citation"] ["Punctuation"] t)
+ '("textquote*" ["Citation"] ["Punctuation"] t)
+ '("foreigntextquote" "Language" ["Citation"] ["Punctuation"] t)
+ '("foreigntextquote*" "Language" ["Citation"] ["Punctuation"] t)
+ '("hyphentextquote" "Language" ["Citation"] ["Punctuation"] t)
+ '("hyphentextquote*" "Language" ["Citation"] ["Punctuation"] t)
+ '("blockquote" ["Citation"] ["Punctuation"] t)
+ '("foreignblockquote" "Language" ["Citation"] ["Punctuation"] t)
+ '("hyphenblockquote" "Language" ["Citation"] ["Punctuation"] t)
+ `("setquotestyle"
+ [ (TeX-arg-eval completing-read "Quote style variant: "
+ ',quote-style-variant-list) ]
+ (TeX-arg-eval completing-read "Quote style name or alias: "
+ ',quote-style-name-list))
+ "setquotestyle*"
+ '("MakeInnerQuote" "Character")
+ '("MakeOuterQuote" "Character")
+ '("MakeAutoQuote" "Opening quotation mark" "Closing quotation mark")
+ '("MakeAutoQuote*" "Opening quotation mark" "Closing quotation mark")
+ '("MakeForeignQuote" "Babel's language name"
+ "Opening quotation mark" "Closing quotation mark")
+ '("MakeForeignQuote*" "Babel's language name"
+ "Opening quotation mark" "Closing quotation mark")
+ '("MakeHyphenQuote" "Babel's language name"
+ "Opening quotation mark" "Closing quotation mark")
+ '("MakeHyphenQuote" "Babel's language name"
+ "Opening quotation mark" "Closing quotation mark")
+ '("MakeBlockQuote" "Opening quotation mark" "Delimiter for citation"
+ "Closing quotation mark")
+ '("MakeForeignBlockQuote" "Language" "Opening quotation mark"
+ "Delimiter for citation" "Closing quotation mark")
+ '("MakeHyphenBlockQuote" "Language" "Opening quotation mark"
+ "Delimiter for citation" "Closing quotation mark")
+ "EnableQuotes"
+ "DisableQuotes"
+ "VerbatimQuotes"
+ "DeleteQuotes"
+ '("textcquote" ["Pre-note"] ["Post-note"] "Key" ["Punctuation"] t)
+ '("textcquote*" ["Pre-note"] ["Post-note"] "Key" ["Punctuation"] t)
+ '("foreigntextcquote" "Language" ["Pre-note"] ["Post-note"] "Key"
+ ["Punctuation"] t)
+ '("foreigntextcquote*" "Language" ["Pre-note"] ["Post-note"] "Key"
+ ["Punctuation"] t)
+ '("hyphentextcquote" "Language" ["Pre-note"] ["Post-note"] "Key"
+ ["Punctuation"] t)
+ '("hyphentextcquote*" "Language" ["Pre-note"] ["Post-note"] "Key"
+ ["Punctuation"] t)
+ '("blockcquote" ["Pre-note"] ["Post-note"] "Key" ["Punctuation"] t)
+ '("foreignblockcquote" "Language" ["Pre-note"] ["Post-note"] "Key"
+ ["Punctuation"] t)
+ '("hyphenblockcquote" "Language" ["Pre-note"] ["Post-note"] "Key"
+ ["Punctuation"] t)
+ `("DeclareQuoteStyle"
+ [ (TeX-arg-eval completing-read "Quote style variant: "
+ ',quote-style-variant-list) ]
+ (TeX-arg-eval completing-read "Quote style name: "
+ ',quote-style-name-list)
+ ["Outer quote initialization"] ["Inner quote initialization"]
+ "Opening outer quotation mark" ["Middle outer quotation mark"]
+ "Closing outer quotation mark" ["Kerning between adjoining marks"]
+ "Opening inner quotation mark" ["Middle inner quotation mark"]
+ "Closing inner quotation mark")
+ `("DeclareQuoteAlias"
+ [ (TeX-arg-eval completing-read "Quote style variant: "
+ ',quote-style-variant-list) ]
+ (TeX-arg-eval completing-read "Quote style name: "
+ ',quote-style-name-list)
+ "Alias name")
+ '("DeclareQuoteOption" 1)
+ '("ExecuteQuoteOptions" 1)
+ '("DeclarePlainStyle" "Opening outer quotation mark"
+ "Closing outer quotation mark" "Opening inner quotation mark"
+ "Closing inner quotation mark")
+ '("SetBlockThreshold" "Number of lines")
+ '("SetBlockEnvironment" "Environment")
+ '("SetCiteCommand" "Command")
+ "mkcitation"
+ "mkccitation"
+ "mkpreblockpunct"
+ "mkmidblockpunct"
+ "mkfinblockpunct"
+ "mkpretextpunct"
+ "mkmidtextpunct"
+ "mkfintextpunct"
+ "mkpredisppunct"
+ "mkmiddisppunct"
+ "mkfindisppunct"
+ '("ifblockquote" 2)
+ '("ifquotepunct" 2)
+ '("ifquoteterm" 2)
+ '("ifquoteperiod" 2)
+ '("ifquotecomma" 2)
+ '("ifquotesemicolon" 2)
+ '("ifquotecolon" 2)
+ '("ifquoteexclam" 2)
+ '("ifquotequestion" 2)
+ '("ifstringblank" 2)
+ '("BlockquoteDisable" 1))
+ ;; New environments
+ (LaTeX-add-environments
+ "quoteblock"
+ "quotetext"
+ '("displayquote" LaTeX-csquotes-insert-environment ["Citation"]
+ ["Punctuation"])
+ '("foreigndisplayquote" LaTeX-csquotes-insert-environment "Language"
+ ["Citation"] ["Punctuation"])
+ '("hyphendisplayquote" LaTeX-csquotes-insert-environment "Language"
+ ["Citation"] ["Punctuation"])
+ '("displaycquote" LaTeX-csquotes-insert-environment
+ ["Pre-note"] ["Post-note"] "Key" ["Punctuation"])
+ '("foreigndisplaycquote" LaTeX-csquotes-insert-environment
+ "Language" ["Pre-note"] ["Post-note"] "Key" ["Punctuation"])
+ '("hyphendisplaycquote" LaTeX-csquotes-insert-environment
+ "Language" ["Pre-note"] ["Post-note"] "Key" ["Punctuation"]))
+ ;; Quotation marks
+ (when (and (> (length LaTeX-csquotes-open-quote) 0)
+ (> (length LaTeX-csquotes-close-quote) 0))
+ (setq TeX-quote-language
+ `(override ,LaTeX-csquotes-open-quote ,LaTeX-csquotes-close-quote
+ ,LaTeX-csquotes-quote-after-quote)))
+ ;; Fontification
+ (when (and (featurep 'font-latex)
+ (eq TeX-install-font-lock 'font-latex-setup))
+ (font-latex-add-keywords '(("DisableQuotes" "")
+ ("RestoreQuotes" ""))
+ 'function)
+ (font-latex-add-keywords '(("enquote" "*{")
+ ("foreignquote" "*{{")
+ ("hyphenquote" "*{{")
+ ("textcquote" "*[[{[{")
+ ("foreigntextcquote" "*{[[{[{")
+ ("hyphentextcquote" "*{[[{[{")
+ ("textquote" "*[[{")
+ ("foreigntextquote" "*{[[{")
+ ("hyphentextquote" "*{[[{")
+ ("blockquote" "[[{")
+ ("foreignblockquote" "{[[{")
+ ("hyphenblockquote" "{[[{")
+ ("blockcquote" "[[{[{")
+ ("foreignblockcquote" "{[[{[{")
+ ("hyphenblockcquote" "{[[{[{"))
+ 'textual)
+ (font-latex-add-keywords '(("setquotestyle" "[{")
+ ("MakeOuterQuote" "{")
+ ("MakeInnerQuote" "{")
+ ("MakeAutoQuote" "*{{")
+ ("MakeForeignQuote" "*{{{")
+ ("MakeHyphenQuote" "*{{{")
+ ("MakeBlockQuote" "{{{")
+ ("MakeForeignBlockQuote" "{{{{")
+ ("MakeHyphenBlockQuote" "{{{{")
+ ("DeclareQuoteStyle" "[{[[{[{[{[{")
+ ("DeclareQuoteAlias" "[{{")
+ ("DeclareQuoteOption" "{")
+ ("DeclarePlainStyle" "{{{{")
+ ("SetBlockThreshold" "{")
+ ("SetBlockEnvironment" "{")
+ ("SetCiteCommand" "{"))
+ 'variable)))))
+
+;;; csquotes.el ends here
diff --git a/tests/auctex-11.87.7/style/czech.el
b/tests/auctex-11.87.7/style/czech.el
new file mode 100644
index 0000000..6168189
--- /dev/null
+++ b/tests/auctex-11.87.7/style/czech.el
@@ -0,0 +1,8 @@
+;;; czech.el --- Setup AUCTeX for editing Czech text.
+
+(TeX-add-style-hook
+ "czech"
+ (lambda ()
+ (unless (eq (car TeX-quote-language) 'override)
+ (setq TeX-quote-language `("czech" "\\uv{" "}" ,TeX-quote-after-quote)))
+ (run-hooks 'TeX-language-cz-hook)))
diff --git a/tests/auctex-11.87.7/style/danish.el
b/tests/auctex-11.87.7/style/danish.el
new file mode 100644
index 0000000..775fee0
--- /dev/null
+++ b/tests/auctex-11.87.7/style/danish.el
@@ -0,0 +1,17 @@
+;;; danish.el --- Setup AUCTeX for editing Danish text.
+
+;;; Code:
+
+(TeX-add-style-hook
+ "danish"
+ (lambda ()
+ (unless (eq (car TeX-quote-language) 'override)
+ (setq TeX-quote-language `("danish" "\"`" "\"'" ,TeX-quote-after-quote)))
+ (setq LaTeX-babel-hyphen-language "danish")
+ ;; Fontification of quotation marks.
+ (when (fboundp 'font-latex-add-quotes)
+ (font-latex-add-quotes '("\"`" "\"'"))
+ (font-latex-add-quotes '("\">" "\"<" german)))
+ (run-hooks 'TeX-language-dk-hook)))
+
+;;; danish.el ends here
diff --git a/tests/auctex-11.87.7/style/dinbrief.el
b/tests/auctex-11.87.7/style/dinbrief.el
new file mode 100644
index 0000000..1182b7b
--- /dev/null
+++ b/tests/auctex-11.87.7/style/dinbrief.el
@@ -0,0 +1,165 @@
+;;; dinbrief.el - Special code for LaTeX-Style dinbrief.
+
+;; Copyright (C) 2013 Free Software Foundation, Inc.
+
+;; Contributed by Werner Fink <tex@itap.physik.uni-stuttgart.de>
+;; Please direct comments to him.
+
+;;; Commentary:
+
+;; LaTeX-Style: dinbrief.sty
+;; Server: rusinfo.rus.uni-stuttgart.de
+;; Directory: /pub/soft/tex/macros/latex/contrib/letters
+
+;;; Code:
+
+(TeX-add-style-hook "dinbrief"
+ (function
+ (lambda ()
+ (LaTeX-add-environments
+ '("letter" LaTeX-recipient-hook))
+ (TeX-add-symbols
+ '("Absender" "Absender: ")
+ '("Postvermerk" "Postvermerk: ")
+ '("Datum" "Datum: ")
+ '("Betreff" "Betreff: ")
+ '("Behandlungsvermerk" "Behandlungsvermerk: ")
+ '("Verteiler" "Verteiler: ")
+ "makelabel" "Retourlabel"
+ '("Anlagen" "Anlagen: ")
+ '("Fenster" "Fenster \(ja/nein\): ")
+ '("Retouradresse" "Retouradresse: ")
+ '("signature" "Unterschrift: ")
+ '("opening" "Anrede: ")
+ '("closing" "Schlu\"s: ")))))
+
+(defun LaTeX-recipient-hook (environment)
+ "Insert ENVIRONMENT and prompt for recipient and address."
+ (let ((sender (read-string "Absender: " (user-full-name)))
+ (recipient (read-string "Empf\"anger: "))
+ (address (read-string "Anschrift: "))
+ (postvermerk (read-string "Postvermerk: "))
+ (date (read-string "Datum: " (LaTeX-today)))
+ (betreff (read-string "Betreff: "))
+ (vermerk (read-string "Behandlungsvermerk: "))
+ (verteil (read-string "Verteiler: "))
+ (anlage (read-string "Anlagen: "))
+ (opening (read-string "Anrede: "))
+ (closing (read-string "Schlu\"s: "))
+ (fenster (read-string "Fenster \(ja/nein\): "))
+ (signature (read-string "Unterschrift: "))
+ )
+
+ (if (not (zerop (length sender)))
+ (progn
+ (insert TeX-esc "Absender" TeX-grop sender TeX-grcl)
+ (newline-and-indent)))
+ (if (not (zerop (length postvermerk)))
+ (progn
+ (insert TeX-esc "Postvermerk" TeX-grop postvermerk TeX-grcl)
+ (newline-and-indent)))
+ (if (not (zerop (length betreff)))
+ (progn
+ (insert TeX-esc "Betreff" TeX-grop betreff TeX-grcl)
+ (newline-and-indent)))
+ (if (not (zerop (length vermerk)))
+ (progn
+ (insert TeX-esc "Behandlungsvermerk" TeX-grop vermerk TeX-grcl)
+ (newline-and-indent)))
+ (if (not (zerop (length verteil)))
+ (progn
+ (insert TeX-esc "Verteiler" TeX-grop verteil TeX-grcl)
+ (newline-and-indent)))
+ (if (not (zerop (length anlage)))
+ (progn
+ (insert TeX-esc "Anlagen" TeX-grop anlage TeX-grcl)
+ (newline-and-indent)))
+ (if (string= fenster "ja")
+ (progn
+ (insert TeX-esc "Fenster")
+ (let ((retouradr (read-string "Retouradresse: " (user-full-name))))
+ (newline-and-indent)
+ (if (not (zerop (length retouradr)))
+ (progn
+ (insert TeX-esc "Retouradresse" TeX-grop retouradr TeX-grcl)
+ (newline-and-indent))))))
+ (if (not (zerop (length signature)))
+ (progn
+ (insert TeX-esc "signature" TeX-grop signature TeX-grcl)
+ (newline-and-indent)))
+ (if (not (zerop (length date)))
+ (progn
+ (insert TeX-esc "Datum" TeX-grop date TeX-grcl)
+ (newline-and-indent)))
+ (newline-and-indent)
+
+ (let ((indentation (current-column)))
+ (LaTeX-insert-environment
+ environment
+ (concat TeX-grop recipient
+ (if (not (zerop (length address)))
+ (concat
+ (if (not (zerop (length recipient)))
+ (concat " " TeX-esc TeX-esc " "))
+ address))
+ TeX-grcl))
+ (save-excursion ; Fix indentation of address
+ (if (search-backward TeX-grcl nil 'move)
+ (let ((addr-end (point-marker)))
+ (if (search-backward TeX-grop nil 'move)
+ (let ((addr-column (current-column)))
+ (while (search-forward
+ (concat TeX-esc TeX-esc)
+ (marker-position addr-end) 'move)
+ (progn
+ (newline)
+ (indent-to addr-column))))))))
+ (insert "\n")
+ (indent-to indentation))
+ (insert TeX-esc "opening"
+ TeX-grop
+ (if (zerop (length opening))
+ (concat TeX-esc " ")
+ opening)
+ TeX-grcl "\n")
+
+ (indent-relative-maybe)
+ (save-excursion
+ (insert "\n" TeX-esc "closing"
+ TeX-grop
+ (if (zerop (length closing))
+ (concat TeX-esc " ")
+ closing)
+ TeX-grcl "\n")
+ (indent-relative-maybe))))
+
+(defun LaTeX-today nil
+ "Return a string representing todays date according to flavor."
+ (interactive)
+ (let ((ctime-string (current-time-string))
+ (month-alist '(("Jan" . "Januar")
+ ("Feb" . "Februar")
+ ("Mar" . "M\\\"arz")
+ ("Apr" . "April")
+ ("May" . "Mai")
+ ("Jun" . "Juni")
+ ("Jul" . "Juli")
+ ("Aug" . "August")
+ ("Sep" . "September")
+ ("Oct" . "Oktober")
+ ("Nov" . "November")
+ ("Dec" . "Dezember"))))
+ (string-match
+ "^\\S-+\\s-+\\(\\S-+\\)\\s-+\\(\\S-+\\)\\s-+\\S-+\\s-+\\(\\S-+\\)"
+ ctime-string)
+ (let ((year (substring ctime-string (match-beginning 3) (match-end 3)))
+ (month (substring ctime-string (match-beginning 1) (match-end 1)))
+ (day (substring ctime-string (match-beginning 2) (match-end 2))))
+ (if (assoc month month-alist)
+ (progn
+ (setq month (cdr (assoc month month-alist)))
+ (if (> 2 (length day))
+ (setq day (concat "0" day)))))
+ (format "Stuttgart, den %s. %s %s" day month year))))
+
+;;; dinbrief.el ends here
diff --git a/tests/auctex-11.87.7/style/dk-bib.el
b/tests/auctex-11.87.7/style/dk-bib.el
new file mode 100644
index 0000000..2ae7530
--- /dev/null
+++ b/tests/auctex-11.87.7/style/dk-bib.el
@@ -0,0 +1,62 @@
+;;; dk-bib.el --- AUCTeX style for `dk-bib.sty'
+
+;; Copyright (C) 2005 Free Software Foundation, Inc.
+
+;; Author: Arne J�rgensen <arne@arnested.dk>
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
+;; MA 02110-1301, USA.
+
+;;; Commentary:
+
+;; Prompt for package option for dk-bib.sty.
+
+;;; Code:
+
+(defun LaTeX-dk-bib-package-options nil
+ "Prompt for package options for the dk-bib package."
+ (let ((options
+ (mapconcat 'identity
+ (TeX-completing-read-multiple
+ "Options: "
+ '(("isbn") ("issn") ("url") ("annote")
+ ("printing") ("apalike") ("fixcitedash=false")
+ ("ordinals2word") ("ordinaldepth=")))
+ ","))
+ (depth -1))
+ (when (string-match "\\(ordinaldepth=\\)\\([^0-9]\\|$\\)" options)
+ (while (or (< depth 0)
+ (> depth 20))
+ (setq depth (if (fboundp 'read-number)
+ (read-number "Ordinal depth: ")
+ (string-to-number (read-string "Ordinal depth: "))))
+ (when (or (< depth 0)
+ (> depth 20))
+ (message "Ordinal depth must be between 0 and 20")
+ (sit-for 1)))
+ (setq options (concat
+ (substring options 0 (match-end 1))
+ (number-to-string depth)
+ (substring options (match-end 1)))))
+ options))
+
+;; Local Variables:
+;; coding: iso-8859-1
+;; End:
+
+;;; dk-bib.el ends here
diff --git a/tests/auctex-11.87.7/style/dk.el b/tests/auctex-11.87.7/style/dk.el
new file mode 100644
index 0000000..1a211ab
--- /dev/null
+++ b/tests/auctex-11.87.7/style/dk.el
@@ -0,0 +1,11 @@
+;;; dk.el - Setup AUC TeX for editing Danish text.
+
+;; $Id: dk.el,v 1.2 1993-12-15 21:42:40 amanda Exp $
+
+;;; Code:
+
+(TeX-add-style-hook "dk"
+ (function (lambda ()
+ (run-hooks 'TeX-language-dk-hook))))
+
+;;; dk.el ends here
diff --git a/tests/auctex-11.87.7/style/doc.el
b/tests/auctex-11.87.7/style/doc.el
new file mode 100644
index 0000000..b342d87
--- /dev/null
+++ b/tests/auctex-11.87.7/style/doc.el
@@ -0,0 +1,158 @@
+;;; doc.el --- AUCTeX style for `doc.sty'
+
+;; Copyright (C) 2004, 2008 Free Software Foundation, Inc.
+
+;; Author: Frank K�ster <frank@kuesterei.ch>
+;; Maintainer: auctex-devel@gnu.org
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; This file adds support for `doc.sty'.
+
+;;; Code:
+
+(defun LaTeX-env-no-comment (environment)
+ "Insert ENVIRONMENT and make sure there is no commented empty line inside."
+ (LaTeX-insert-environment environment)
+ (unless (TeX-active-mark)
+ (when (save-excursion
+ (beginning-of-line)
+ (looking-at (concat "[ \t]+$\\|[ \t]*"
+ TeX-comment-start-regexp "+[ \t]*$")))
+ (delete-region (line-beginning-position) (line-end-position))
+ (indent-according-to-mode))))
+
+(defun LaTeX-doc-after-insert-macrocode (env start end)
+ "Make sure the macrocode environment is properly formatted after insertion."
+ (when (TeX-member env '("macrocode" "macrocode*") 'string-equal)
+ (save-excursion
+ (goto-char end)
+ (skip-chars-backward " \t")
+ (when (bolp)
+ (insert "%")
+ (indent-according-to-mode))
+ (goto-char start)
+ (skip-chars-backward " \t")
+ (when (bolp)
+ (insert "%")
+ (indent-according-to-mode)))))
+
+(TeX-add-style-hook
+ "doc"
+ (lambda ()
+ (add-to-list (make-local-variable 'LaTeX-indent-environment-list)
+ '("macrocode" current-indentation))
+ (add-to-list 'LaTeX-indent-environment-list
+ '("macrocode*" current-indentation))
+ (add-hook 'LaTeX-after-insert-env-hooks 'LaTeX-doc-after-insert-macrocode
+ nil t)
+ (LaTeX-add-environments
+ "theglossary"
+ '("macrocode" LaTeX-env-no-comment)
+ '("macrocode*" LaTeX-env-no-comment)
+ '("macro" "Macro"))
+ (TeX-add-symbols
+ "EnableCrossrefs"
+ "DisableCrossrefs"
+ "DoNotIndex"
+ "DontCheckModules"
+ "CheckModules"
+ "Module"
+ '("DescribeMacro" "Macro")
+ '("DescribeEnv" "Environment")
+ "verbatim"
+ "verb"
+ "parg"
+ "oarg"
+ "marg"
+ "meta"
+ "cmd"
+ "makelabel"
+ "MacroFont"
+ "MacroFont"
+ "AltMacroFont"
+ "AltMacroFont"
+ "PrintMacroName"
+ "PrintDescribeMacro"
+ "PrintDescribeEnv"
+ "PrintEnvName"
+ "MakePrivateLetters"
+ "actualchar"
+ "quotechar"
+ "levelchar"
+ "encapchar"
+ "verbatimchar"
+ "SpecialIndex"
+ "SpecialMainIndex"
+ "SpecialMainEnvIndex"
+ "SpecialUsageIndex"
+ "SpecialEnvIndex"
+ "SortIndex"
+ "LeftBraceIndex"
+ "RightBraceIndex"
+ "PercentIndex"
+ "OldMakeindex"
+ "PercentIndex"
+ "IndexPrologue"
+ "IndexParms"
+ "subitem"
+ "subsubitem"
+ "indexspace"
+ "efill"
+ "pfill"
+ "PrintIndex"
+ '("changes" "version" "date (YYYY/MM/DD)")
+ "generalname"
+ "RecordChanges"
+ "GlossaryPrologue"
+ "GlossaryParms"
+ "PrintChanges"
+ "AlsoImplementation"
+ "StopEventually"
+ "OnlyDescription"
+ "Finale"
+ "IndexInput"
+ "maketitle"
+ "MakeShortVerb"
+ "DeleteShortVerb"
+ "MakeShortverb"
+ "DeleteShortverb"
+ "CheckSum"
+ "CharacterTable"
+ "CharTableChanges"
+ "CodelineNumbered"
+ "CodelineIndex"
+ "PageIndex"
+ "theCodelineNo"
+ "theCodelineNo"
+ "DocstyleParms"
+ "MakePercentIgnore"
+ "MakePercentComment"
+ "DocInput"
+ "DocInclude"
+ "GetFileInfo"
+ "filename"
+ "fileinfo")
+ (TeX-run-style-hooks "shortvrb")))
+
+;; Local Variables:
+;; coding: iso-8859-1
+;; End:
diff --git a/tests/auctex-11.87.7/style/dutch.el
b/tests/auctex-11.87.7/style/dutch.el
new file mode 100644
index 0000000..5c9a830
--- /dev/null
+++ b/tests/auctex-11.87.7/style/dutch.el
@@ -0,0 +1,11 @@
+;;; dutch.el - Setup AUC TeX for editing Dutch text.
+
+;; $Id: dutch.el,v 1.2 1993-12-15 21:42:42 amanda Exp $
+
+;;; Code:
+
+(TeX-add-style-hook "dutch"
+ (function (lambda ()
+ (run-hooks 'TeX-language-nl-hook))))
+
+;;; dutch.el ends here
diff --git a/tests/auctex-11.87.7/style/emp.el
b/tests/auctex-11.87.7/style/emp.el
new file mode 100644
index 0000000..4e5f867
--- /dev/null
+++ b/tests/auctex-11.87.7/style/emp.el
@@ -0,0 +1,84 @@
+;;; emp.el --- AUCTeX support for emp.sty
+
+;; Copyright (C) 2004, 2005 Free Software Foundation, Inc.
+
+;; Author: Yvon Henel aka TeXnicien de surface <Yvon.Henel@wanadoo.fr>
+;; Maintainer: auctex-devel@gnu.org
+;; Keywords: tex
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;; version 1.0 2004-03-04
+
+;;; Code:
+
+
+(TeX-add-style-hook "emp"
+ (function
+ (lambda ()
+ (TeX-add-symbols "empuse" "empTeX" "empaddtoTeX"
+ "emprelude" "empaddtoprelude" "unitlength"
+ )
+ (LaTeX-add-environments
+ '("empfile" LaTeX-env-empfile)
+ '("emp" LaTeX-env-emp-gen)
+ '("empdef" LaTeX-env-emp-gen)
+ '("empgraph" LaTeX-env-emp-gen)
+ '("empcmds")
+ ))))
+
+(defun LaTeX-env-emp-gen (environment-name)
+ "Ask for file, width and length. Insert environment-name environment
+Used for emp, empdef, and empgraph environments."
+ (let ((emp-fig-name (read-string "figure name: " ""))
+ (emp-fig-width (read-string "figure width: " "1" ))
+ (emp-fig-height (read-string "figure height: " "1" ))
+ ;;; emp.sty demands a width and a height for each of the
+ ;;; emp, empdef, and empgraph environments
+ ;;; we give them 1 by default
+ ;;; not necessarily the best thing to do?
+ )
+ (if (not (zerop (length emp-fig-name)))
+ (progn
+ (setq LaTeX-emp-fig-name (concat LaTeX-optop emp-fig-name
LaTeX-optcl))
+ (LaTeX-insert-environment environment-name LaTeX-emp-fig-name))
+ (LaTeX-insert-environment environment-name))
+ (forward-line -1)
+ (end-of-line)
+ (insert "(" emp-fig-width "," emp-fig-height ")")
+ (forward-line 1)
+ (indent-according-to-mode)
+ ))
+
+(defun LaTeX-env-empfile (optional)
+ "Ask for file. Insert empfile environment"
+ (let ((empfile (read-string "empfile: " "")))
+ (if (not (zerop (length empfile)))
+ (progn
+ (setq LaTeX-emp-file-name (concat LaTeX-optop empfile LaTeX-optcl))
+ (setq mpost-emp-file-name (concat empfile ".mp"))
+ (LaTeX-insert-environment "empfile" LaTeX-emp-file-name))
+ (progn
+ (setq mpost-emp-file-name "\\jobname")
+ (LaTeX-insert-environment "empfile")))
+ (if LaTeX-write18-enabled-p
+ (progn
+ (forward-line 1)
+ (end-of-line)
+ (newline-and-indent)
+ (insert "\\immediate\\write18{mpost -tex=latex " mpost-emp-file-name
TeX-grcl)
+ (forward-line -2)))))
+;;; emp.el ends here
diff --git a/tests/auctex-11.87.7/style/epsf.el
b/tests/auctex-11.87.7/style/epsf.el
new file mode 100644
index 0000000..4725648
--- /dev/null
+++ b/tests/auctex-11.87.7/style/epsf.el
@@ -0,0 +1,37 @@
+;;; epsf.el - Support for the epsf style option.
+
+;; Copyright (C) 2013 Free Software Foundation, Inc.
+
+;; Contributed by Marc Gemis <makke@wins.uia.ac.be>
+
+;;; Code:
+
+(TeX-add-style-hook
+ "epsf"
+ (lambda ()
+ (TeX-add-symbols
+ '("epsfsize" TeX-arg-epsfsize)
+ '("epsffile" TeX-arg-file)
+ '("epsfbox" TeX-arg-file)
+ "epsflly" "epsfury" "testit" "epsfgetlitbb"
+ "epsfnormal" "epsfgetbb" "other" "epsfsetgraph"
+ "PsFragSpecialArgs" "epsfaux" "testit" "epsfgrab"
+ "epsfllx" "epsflly" "epsfury" "epsfverbosetrue")))
+
+(defun TeX-arg-epsfsize (optional &optional prompt definition)
+ "Create a line that print epsf figures at a certain percentage"
+ (interactive)
+ (let ((scale (read-string "Scale in percent (default 75): ")))
+ (setq scale (if (zerop (length scale)) "75" scale))
+ (save-excursion
+ ; append #1#{scale#1}
+ (insert "#1#2" TeX-grop "0." scale "#1" TeX-grcl)
+ ; insert \def before \epsfsize
+ (beginning-of-line 1)
+ (newline)
+ (insert TeX-esc "def")
+ (forward-line -1)
+ (insert "% From now on print figures at " scale "% of original size"))
+ (end-of-line)))
+
+;;; epsf.el ends here
diff --git a/tests/auctex-11.87.7/style/fancyref.el
b/tests/auctex-11.87.7/style/fancyref.el
new file mode 100644
index 0000000..53b64fe
--- /dev/null
+++ b/tests/auctex-11.87.7/style/fancyref.el
@@ -0,0 +1,122 @@
+;;; fancyref.el --- AUCTeX style file with support for fancyref.sty
+
+;; Copyright (C) 1999 Free Software Foundation, Inc.
+
+;; Author: Carsten Dominik <dominik@strw.leidenuniv.nl>
+;; Maintainer: auctex-devel@gnu.org
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Code:
+
+(TeX-add-style-hook "fancyref"
+ (lambda ()
+
+ (TeX-add-symbols
+
+ ;; The macros with label arguments
+ '("fref" [ TeX-arg-fancyref-format ] TeX-arg-label)
+ '("Fref" [ TeX-arg-fancyref-format ] TeX-arg-label)
+
+ ;; The macros which define new prefixes and formats
+ '("fancyrefchangeprefix" TeX-arg-macro "Prefix")
+ '("Frefformat" TeX-arg-fancyref-format TeX-arg-macro "Output")
+ '("frefformat" TeX-arg-fancyref-format TeX-arg-macro "Output")
+
+ ;; The delimiter
+ "fancyrefargdelim"
+
+ ;; All those names and abbreviations.
+ ;; Part
+ "fancyrefpartlabelprefix"
+ "Frefpartname" "frefpartname"
+ ;; Chapter
+ "fancyrefchalabelprefix"
+ "Frefchaname" "frefchaname"
+ ;; Section
+ "fancyrefseclabelprefix"
+ "Frefsecname" "frefsecname"
+ ;; Equation
+ "fancyrefeqlabelprefix"
+ "Frefeqname" "frefeqname"
+ ;; Figure
+ "fancyreffiglabelprefix"
+ "Freffigname" "freffigname" "Freffigshortname"
+ ;; Footnote
+ "fancyreffnlabelprefix"
+ "Freffnname" "freffnname"
+ ;; Item
+ "fancyrefitemlabelprefix"
+ "Frefitemname" "frefitemname"
+ ;; Table
+ "fancyreftablabelprefix"
+ "Freftabname" "freftabname" "Freftabshortname"
+ ;; Page
+ "Frefpgname" "frefpgname" "Frefpgshortname"
+ ;; On
+ "Frefonname" "frefonname"
+ ;; See
+ "Frefseename" "frefseename"
+
+ ;; The spacing macros
+ "fancyrefloosespacing" "fancyreftightspacing" "fancyrefdefaultspacing"
+
+ ;; And the hook
+ "fancyrefhook")
+
+ ;; Insatall completion for labels and formats
+ (setq TeX-complete-list
+ (append
+ '(("\\\\[fF]ref\\(\\[[^]]*\\]\\)?{\\([^{}\n\r\\%,]*\\)"
+ 2 LaTeX-label-list "}")
+ ("\\\\[fF]ref\\[\\([^{}\n\r\\%,]*\\)"
+ 1 LaTeX-fancyref-formats "]")
+ ("\\\\[fF]refformat{\\([^{}\n\r\\%,]*\\)"
+ 1 LaTeX-fancyref-formats "}"))
+ TeX-complete-list))
+ ;; Fontification
+ (when (and (featurep 'font-latex)
+ (eq TeX-install-font-lock 'font-latex-setup))
+ (font-latex-add-keywords '(("fref" "[{") ("Fref" "[{")) 'reference))))
+
+;; The following list keeps a list of available format names
+;; Note that this list is only updated when a format is used, not
+;; during buffer parsing. We could install a regexp to look for
+;; formats, but this would not work in multifile documents since the
+;; formats are not written out to the auto files.
+;; For now, we just leave it at that.
+(defvar LaTeX-fancyref-formats '(("plain") ("vario") ("margin") ("main"))
+ "List of formats for fancyref.")
+
+(defun LaTeX-fancyref-formats () LaTeX-fancyref-formats)
+
+(defun TeX-arg-fancyref-format (optional &optional prompt definition)
+ "Prompt for a fancyref format name.
+If the user gives an unknown name, add it to the list."
+ (let ((format (completing-read (TeX-argument-prompt optional prompt "Format")
+ LaTeX-fancyref-formats)))
+ (if (not (string-equal "" format))
+ (add-to-list 'LaTeX-fancyref-formats (list format)))
+ (TeX-argument-insert format optional)))
+
+(defvar LaTeX-fancyref-package-options '("english" "german" "loose"
+ "margin" "paren" "plain" "tight"
+ "vario")
+ "Package options for the fancyref package.")
+
+;;; fancyref.el ends here
diff --git a/tests/auctex-11.87.7/style/flashcards.el
b/tests/auctex-11.87.7/style/flashcards.el
new file mode 100644
index 0000000..27e96d1
--- /dev/null
+++ b/tests/auctex-11.87.7/style/flashcards.el
@@ -0,0 +1,60 @@
+;;; flashcards.el --- AUCTeX style for the flashcards class.
+
+;; Copyright (C) 2007 Free Software Foundation, Inc.
+
+;; Author: Ralf Angeli <angeli@caeruleus.net>
+;; Maintainer: auctex-devel@gnu.org
+;; Created: 2007-04-23
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; This file adds support for the flashcards class.
+
+;;; Code:
+
+(TeX-add-style-hook
+ "flashcards"
+ (lambda ()
+ (TeX-add-symbols
+ '("cardfrontstyle" ["Format"] "Style")
+ '("cardfrontfoot" "Footer text")
+ '("cardbackstyle" ["Format"] "Style")
+ '("cardfrontheadstyle" ["Format"] "Style")
+ '("cardfrontfootstyle" ["Format"] "Style")
+ "cardmargin"
+ "cardpaper"
+ "cardpapermode"
+ "cardrows"
+ "cardcolumns"
+ "cardheight"
+ "cardwidth")
+ (LaTeX-add-environments '("flashcard" ["Header"] "Front side"))
+ ;; Fontification
+ (when (and (fboundp 'font-latex-add-keywords)
+ (eq TeX-install-font-lock 'font-latex-setup))
+ (font-latex-add-keywords '(("cardfrontstyle" "[{")
+ ("cardfrontfoot" "{")
+ ("cardbackstyle" "[{")
+ ("cardfrontheadstyle" "[{")
+ ("cardfrontfootstyle" "[{"))
+ 'variable))))
+
+;;; flashcards.el ends here
diff --git a/tests/auctex-11.87.7/style/foils.el
b/tests/auctex-11.87.7/style/foils.el
new file mode 100644
index 0000000..435bed7
--- /dev/null
+++ b/tests/auctex-11.87.7/style/foils.el
@@ -0,0 +1,46 @@
+;;; foils.el - Special code for FoilTeX.
+
+;; $Id: foils.el,v 1.5 2008-07-28 20:40:18 angeli Exp $
+
+;;; Code:
+
+(require 'timezone)
+
+(TeX-add-style-hook "foils"
+ (function
+ (lambda ()
+ (add-hook 'LaTeX-document-style-hook 'LaTeX-style-foils)
+ (setq LaTeX-default-style "foils")
+ (setq LaTeX-default-options '("landscape"))
+ (TeX-add-symbols
+ '("foilhead" [ "Rubric-body separation" ] "Foil rubric")))))
+
+(defun LaTeX-style-foils nil
+ "Prompt for and insert foiltex options."
+ (let* ((date (timezone-parse-date (current-time-string)))
+ (year (string-to-number (aref date 0)))
+ (month (string-to-number (aref date 1)))
+ (day (string-to-number (aref date 2)))
+ (title (read-string "Title: ")))
+ (save-excursion
+ (goto-char (point-max))
+ (re-search-backward ".begin.document.")
+ (insert TeX-esc "title"
+ TeX-grop title TeX-grcl "\n")
+ (insert TeX-esc "author"
+ TeX-grop (user-full-name) TeX-grcl "\n")
+ (insert TeX-esc "date" TeX-grop
+ (format "%d-%02d-%02d" year month day)
+ TeX-grcl "\n")
+ (insert "" TeX-esc "MyLogo" TeX-grop TeX-grcl "\n")
+ (insert "%" TeX-esc "Restriction" TeX-grop TeX-grcl "\n")
+ (insert "%" TeX-esc "rightfooter" TeX-grop TeX-grcl "\n")
+ (insert "%" TeX-esc "leftheader" TeX-grop TeX-grcl "\n")
+ (insert "%" TeX-esc "rightheader" TeX-grop TeX-grcl "\n\n")
+ (re-search-forward ".begin.document.")
+ (end-of-line)
+ (newline-and-indent)
+ (insert "" TeX-esc "maketitle\n\n"))
+ (forward-line -1)))
+
+;;; foils.el ends here
diff --git a/tests/auctex-11.87.7/style/francais.el
b/tests/auctex-11.87.7/style/francais.el
new file mode 100644
index 0000000..323d545
--- /dev/null
+++ b/tests/auctex-11.87.7/style/francais.el
@@ -0,0 +1,41 @@
+;;; francais.el --- AUCTeX style for the `francais' babel option.
+
+;; Copyright (C) 2005 Free Software Foundation, Inc.
+
+;; Author: Ralf Angeli <angeli@iwi.uni-sb.de>
+;; Maintainer: auctex-devel@gnu.org
+;; Created: 2005-10-28
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; Set up AUCTeX for editing French text. In particular for commands
+;; provided by the `francais' option of the `babel' LaTeX package. As
+;; this is equivalent to the `frenchb' option, this file only loads
+;; `frenchb.el'.
+
+;;; Code:
+
+(TeX-add-style-hook
+ "francais"
+ (lambda ()
+ (TeX-run-style-hooks "frenchb")))
+
+;;; francais.el ends here
diff --git a/tests/auctex-11.87.7/style/french.el
b/tests/auctex-11.87.7/style/french.el
new file mode 100644
index 0000000..31a468a
--- /dev/null
+++ b/tests/auctex-11.87.7/style/french.el
@@ -0,0 +1,48 @@
+;;; french.el --- AUCTeX style for the `french' babel option.
+
+;; Copyright (C) 2010 Free Software Foundation, Inc.
+
+;; Author: Ralf Angeli <angeli@caeruleus.net>
+;; Maintainer: auctex-devel@gnu.org
+;; Created: 2010-03-20
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; Set up AUCTeX for editing French text in connection with the
+;; `french' babel option. The file basically loads the style file for
+;; the `frenchb' babel option.
+;;
+;; Support for the FrenchPro package by Bernard Gaulle is _not_
+;; included. If the presence of FrenchPro is detected, the `frenchb'
+;; support is not loaded.
+
+;;; Code:
+
+(TeX-add-style-hook
+ "french"
+ (lambda ()
+ (when (and (member "babel" TeX-active-styles)
+ (not (member "frenchpro" TeX-active-styles))
+ (not (member "frenchle" TeX-active-styles))
+ (not (member "mlp" TeX-active-styles)))
+ (TeX-run-style-hooks "frenchb"))))
+
+;;; french.el ends here
diff --git a/tests/auctex-11.87.7/style/frenchb.el
b/tests/auctex-11.87.7/style/frenchb.el
new file mode 100644
index 0000000..83f9002
--- /dev/null
+++ b/tests/auctex-11.87.7/style/frenchb.el
@@ -0,0 +1,78 @@
+;;; frenchb.el --- AUCTeX style for the `frenchb' babel option.
+
+;; Copyright (C) 2005 Free Software Foundation, Inc.
+
+;; Author: Ralf Angeli <angeli@iwi.uni-sb.de>
+;; Maintainer: auctex-devel@gnu.org
+;; Created: 2005-10-28
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; Set up AUCTeX for editing French text. In particular for commands
+;; provided by the `frenchb' option of the `babel' LaTeX package. The
+;; `frenchb' option is equivalent to the `francais' option and since
+;; babel version 3.7j with the `french' option. `french', however, is
+;; ambiguous because another package by that name made by Bernard
+;; Gaulle could be loaded. In order to avoid this, either `frenchb'
+;; (or `francais') or `frenchle' (or `frenchPRO') should be used. See
+;; the documentation of `frenchb' at
+;; <URL:http://daniel.flipo.free.fr/frenchb/frenchb-doc.pdf>.
+
+;;; Code:
+
+(TeX-add-style-hook
+ "frenchb"
+ (lambda ()
+ (TeX-add-symbols
+ "og"
+ "fg"
+ "up"
+ "ier"
+ "iere"
+ "iers"
+ "ieres"
+ "ieme"
+ "iemes"
+ '("bsc" t)
+ "primo"
+ "secundo"
+ "tertio"
+ "quarto"
+ "No"
+ "no"
+ "degre"
+ "degres"
+ "DecimalMathComma"
+ "StandardMathComma"
+ '("nombre" "Nombre")
+ "ThinSpaceInFrenchNumbers"
+ "FrenchLayout"
+ "StandardLayout")
+ (unless (eq (car TeX-quote-language) 'override)
+ (setq TeX-quote-language
+ `("french" "\\og "
+ (lambda ()
+ (concat "\\fg"
+ (unless (member "xspace" TeX-active-styles) "{}")))
+ ,TeX-quote-after-quote)))
+ (run-hooks 'TeX-language-fr-hook)))
+
+;;; frenchb.el ends here
diff --git a/tests/auctex-11.87.7/style/german.el
b/tests/auctex-11.87.7/style/german.el
new file mode 100644
index 0000000..d1acbbf
--- /dev/null
+++ b/tests/auctex-11.87.7/style/german.el
@@ -0,0 +1,49 @@
+;;; german.el --- Setup AUCTeX for editing German text.
+
+;;; Commentary:
+;;
+;; Cater for some specialities of `(n)german.sty', e.g. special quote
+;; and hyphen strings or that `"' makes the following letter an
+;; umlaut.
+
+;;; Code:
+
+(defvar LaTeX-german-mode-syntax-table
+ (copy-syntax-table LaTeX-mode-syntax-table)
+ "Syntax table used in LaTeX mode when using `german.sty'.")
+
+(modify-syntax-entry ?\" "w" LaTeX-german-mode-syntax-table)
+
+(TeX-add-style-hook
+ "german"
+ (lambda ()
+ (set-syntax-table LaTeX-german-mode-syntax-table)
+ ;; XXX: Handle former customizations of the now defunct
+ ;; German-specific variables. References to the respective
+ ;; variables are to be deleted in future versions. (now = 2005-04-01)
+ (unless (eq (car TeX-quote-language) 'override)
+ (let ((open-quote (if (and (boundp 'LaTeX-german-open-quote)
+ LaTeX-german-open-quote)
+ LaTeX-german-open-quote
+ "\"`"))
+ (close-quote (if (and (boundp 'LaTeX-german-close-quote)
+ LaTeX-german-close-quote)
+ LaTeX-german-close-quote
+ "\"'"))
+ (q-after-q (if (and (boundp 'LaTeX-german-quote-after-quote)
+ LaTeX-german-quote-after-quote)
+ LaTeX-german-quote-after-quote
+ t)))
+ (setq TeX-quote-language
+ `("german" ,open-quote ,close-quote ,q-after-q))))
+ (setq LaTeX-babel-hyphen-language "german")
+ ;; Fontification of quotation marks.
+ (when (and (eq TeX-install-font-lock 'font-latex-setup)
+ (featurep 'font-latex))
+ (font-latex-add-quotes '("\"`" "\"'"))
+ (font-latex-add-quotes '("\">" "\"<" german))
+ ;; Prevent "| from leading to color bleed.
+ (font-latex-add-to-syntax-alist (list (cons ?\" "\\"))))
+ (run-hooks 'TeX-language-de-hook)))
+
+;;; german.el ends here
diff --git a/tests/auctex-11.87.7/style/graphics.el
b/tests/auctex-11.87.7/style/graphics.el
new file mode 100644
index 0000000..bffabc9
--- /dev/null
+++ b/tests/auctex-11.87.7/style/graphics.el
@@ -0,0 +1,10 @@
+;;; graphics.el --- Handle graphical commands in LaTeX 2e.
+
+;;; Code:
+
+(TeX-add-style-hook "graphics"
+ (function
+ (lambda ()
+ (TeX-run-style-hooks "graphicx"))))
+
+;;; graphics.el ends here.
diff --git a/tests/auctex-11.87.7/style/graphicx.el
b/tests/auctex-11.87.7/style/graphicx.el
new file mode 100644
index 0000000..a35d151
--- /dev/null
+++ b/tests/auctex-11.87.7/style/graphicx.el
@@ -0,0 +1,302 @@
+;;; graphicx.el --- AUCTeX style file for graphicx.sty
+
+;; Copyright (C) 2000, 2004, 2005 by Free Software Foundation, Inc.
+
+;; Author: Ryuichi Arafune <arafune@debian.org>
+;; Created: 1999/3/20
+;; Keywords: tex
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Commentary:
+
+;; This package supports the includegraphcics macro in graphicx style.
+
+;; Acknowledgements
+;; Dr. Thomas Baumann <thomas.baumann@ch.tum.de>
+;; David Kastrup <David.Kastrup@t-online.de>
+;; Masayuki Akata <ataka@milk.freemail.ne.jp>
+
+;;; Code:
+
+(TeX-add-style-hook
+ "graphicx"
+ (lambda ()
+ (TeX-add-symbols
+ '("reflectbox" "Argument")
+ '("resizebox" "Width" "Height" "Argument")
+ '("resizebox*" "Width" "Total height" "Argument")
+ '("rotatebox" [ "Options" ] "Angle" "Argument")
+ '("scalebox" "Horizontal scale" [ "Vertical scale" ] "Argument")
+ '("includegraphics" LaTeX-arg-includegraphics))
+ ;; Fontification
+ (when (and (featurep 'font-latex)
+ (eq TeX-install-font-lock 'font-latex-setup))
+ (font-latex-add-keywords '(("reflectbox" "{")
+ ("resizebox" "*{{{")
+ ("rotatebox" "[{{")
+ ("scalebox" "{[{"))
+ 'textual)
+ (font-latex-add-keywords '(("includegraphics" "*[[{")) 'reference))))
+
+(defun LaTeX-includegraphics-extensions (&optional list)
+ "Return appropriate extensions for input files to \\includegraphics."
+ ;; FIXME: This function may check for latex/pdflatex later.
+ (concat "\\."
+ (mapconcat 'identity
+ (or list LaTeX-includegraphics-extensions)
+ "$\\|\\.")
+ "$"))
+
+(defun LaTeX-includegraphics-read-file-TeX ()
+ "Read image file for \\includegraphics.
+Offers all graphic files found in the TeX search path. See
+`LaTeX-includegraphics-read-file' for more."
+ ;; Drop latex/pdflatex differences for now. Might be (re-)included later.
+ (completing-read
+ "Image file: "
+ (TeX-delete-dups-by-car
+ (mapcar 'list
+ (TeX-search-files nil LaTeX-includegraphics-extensions t t)))
+ nil nil nil))
+
+(defun LaTeX-includegraphics-read-file-relative ()
+ "Read image file for \\includegraphics.
+
+Lists all graphic files in the master directory and its
+subdirectories and inserts the relative file name. This option
+doesn't works with Emacs 21.3 or XEmacs. See
+`LaTeX-includegraphics-read-file' for more."
+ (file-relative-name
+ (read-file-name
+ "Image file: " nil nil nil nil
+ ;; FIXME: Emacs 21.3 and XEmacs 21.4.15 dont have PREDICATE as the sixth
+ ;; argument (Emacs 21.3: five args; XEmacs 21.4.15: sixth is HISTORY).
+ (lambda (fname)
+ (or (file-directory-p fname)
+ (string-match (LaTeX-includegraphics-extensions) fname))))
+ (TeX-master-directory)))
+
+(defun LaTeX-arg-includegraphics (prefix)
+ "Ask for mandantory and optional arguments for the \\includegraphics command.
+
+The extent of the optional arguments is determined by the prefix argument and
+`LaTeX-includegraphics-options-alist'."
+ (let* ((maybe-left-brace "[")
+ (maybe-comma "")
+ show-hint
+ (image-file (funcall LaTeX-includegraphics-read-file))
+ (incl-opts
+ (cond
+ ((numberp
+ (if (listp current-prefix-arg)
+ (setq current-prefix-arg (car current-prefix-arg))
+ current-prefix-arg))
+ (cdr
+ (assq current-prefix-arg LaTeX-includegraphics-options-alist)))
+ ;; If no prefix is given, use `0' and tell the user about the
+ ;; prefix.
+ ((eq current-prefix-arg nil)
+ (setq show-hint t)
+ (cdr (assq 0 LaTeX-includegraphics-options-alist)))
+ (t
+ (cdr (assq 0 LaTeX-includegraphics-options-alist)))))
+ ;; Order the optional aruments like in the tables in epslatex.ps,
+ ;; page 14. But collect y-or-n options at the end, so that the use
+ ;; can skip some options by typing `RET RET ... RET n n n ... n'
+ ;;
+ ;; Options from Table 1 (epslatex.ps, page 14):
+ (totalheight
+ (TeX-arg-maybe
+ 'totalheight incl-opts
+ '(read-string
+ (concat "Total Height (" TeX-default-unit-for-image "): "))))
+ (height
+ (TeX-arg-maybe
+ 'height incl-opts
+ ;; Either totalheight or height make sense:
+ '(when (zerop (length totalheight))
+ (read-string
+ (concat "Figure height (" TeX-default-unit-for-image "): ")))))
+ (width
+ (TeX-arg-maybe
+ 'width incl-opts
+ '(read-string
+ (concat "Figure width (" TeX-default-unit-for-image "): "))))
+ (scale
+ (TeX-arg-maybe
+ 'angle incl-opts
+ ;; If size is already specified, don't ask for scale:
+ '(when (zerop (+ (length totalheight)
+ (length height)
+ (length width)))
+ (read-string "Scale: "))))
+ (angle
+ (TeX-arg-maybe
+ 'angle incl-opts
+ '(read-string "Rotation angle: ")))
+ (origin
+ (TeX-arg-maybe
+ 'origin incl-opts
+ '(read-string
+ (concat
+ "Origin (any combination of `lcr' (horizontal) "
+ "and `tcbB' (vertical)): "))))
+ (page ;; Not in any table; Only for PDF.
+ (TeX-arg-maybe
+ 'page incl-opts
+ '(read-string "Page: ")))
+ (bb
+ (TeX-arg-maybe
+ 'bb incl-opts
+ '(y-or-n-p "Set Bounding Box? ")))
+ ;; Table 2:
+ (viewport
+ (TeX-arg-maybe
+ 'viewport incl-opts
+ '(y-or-n-p "Set viewport? ")))
+ (trim
+ (TeX-arg-maybe
+ 'trim incl-opts
+ '(and (not viewport)
+ (y-or-n-p "Set trim? "))))
+ ;; Table 3:
+ (clip
+ (TeX-arg-maybe
+ 'clip incl-opts
+ ;; If viewport, we also use clip.
+ '(or viewport
+ (y-or-n-p "Clipping figure? "))))
+ (keepaspectratio
+ (TeX-arg-maybe
+ 'keepaspectratio incl-opts
+ ;; If we have width and [total]height...
+ '(or (and (not (zerop (length width)))
+ (or (not (zerop (length totalheight)))
+ (not (zerop (length height)))))
+ (y-or-n-p "Keep Aspectratio? "))))
+ ;; Used for bb, trim, viewport, ...:
+ llx lly urx ury)
+ ;; Now insert stuff...
+ (when (not (zerop (length totalheight)))
+ (insert
+ maybe-left-brace maybe-comma "totalheight="
+ (car (TeX-string-divide-number-unit totalheight))
+ (if (zerop
+ (length
+ (car (cdr (TeX-string-divide-number-unit totalheight)))))
+ TeX-default-unit-for-image
+ (car (cdr (TeX-string-divide-number-unit totalheight)))))
+ (setq maybe-comma ",")
+ (setq maybe-left-brace ""))
+ (when (not (zerop (length height)))
+ (insert maybe-left-brace maybe-comma
+ "height=" (car (TeX-string-divide-number-unit height))
+ (if (zerop
+ (length
+ (car (cdr (TeX-string-divide-number-unit height)))))
+ TeX-default-unit-for-image
+ (car (cdr (TeX-string-divide-number-unit height)))))
+ (setq maybe-comma ",")
+ (setq maybe-left-brace ""))
+ (when (not (zerop (length width)))
+ (insert maybe-left-brace maybe-comma
+ "width=" (car (TeX-string-divide-number-unit width))
+ (if (zerop
+ (length
+ (car (cdr (TeX-string-divide-number-unit width)))))
+ TeX-default-unit-for-image
+ (car (cdr (TeX-string-divide-number-unit width)))))
+ (setq maybe-comma ",")
+ (setq maybe-left-brace ""))
+ (when (not (zerop (length scale)))
+ (insert maybe-left-brace maybe-comma "scale=" scale)
+ (setq maybe-comma ",")
+ (setq maybe-left-brace ""))
+ (when (not (zerop (length angle)))
+ (insert maybe-left-brace maybe-comma "angle=" angle)
+ (setq maybe-comma ",")
+ (setq maybe-left-brace ""))
+ (when (not (zerop (length origin)))
+ (insert maybe-left-brace maybe-comma "origin=" origin)
+ (setq maybe-comma ",")
+ (setq maybe-left-brace ""))
+ (when bb
+ (setq llx (read-string "Bounding Box lower left x: "))
+ (setq lly (read-string "Bounding Box lower left y: "))
+ (setq urx (read-string "Bounding Box upper right x: "))
+ (setq ury (read-string "Bounding Box upper right y: "))
+ (insert maybe-left-brace maybe-comma
+ "bb=" llx " " lly " " urx " " ury)
+ (setq maybe-comma ",")
+ (setq maybe-left-brace ""))
+ ;;
+ (when viewport
+ (setq llx (read-string "Viewport lower left x: "))
+ (setq lly (read-string "Viewport lower left y: "))
+ (setq urx (read-string "Viewport upper right x: "))
+ (setq ury (read-string "Viewport upper right y: "))
+ (insert maybe-left-brace maybe-comma
+ "viewport=" llx " " lly " " urx " " ury)
+ (setq maybe-comma ",")
+ (setq maybe-left-brace ""))
+ (when trim
+ (setq llx (read-string "Trim lower left x: "))
+ (setq lly (read-string "Trim lower left y: "))
+ (setq urx (read-string "Trim Upper right x: "))
+ (setq ury (read-string "Trim Upper right y: "))
+ (insert maybe-left-brace maybe-comma
+ "trim=" llx " " lly " " urx " " ury)
+ (setq maybe-comma ",")
+ (setq maybe-left-brace ""))
+ ;;
+ (when clip
+ (insert maybe-left-brace maybe-comma "clip")
+ (setq maybe-comma ",")
+ (setq maybe-left-brace ""))
+ (when keepaspectratio
+ (insert maybe-left-brace maybe-comma "keepaspectratio")
+ (setq maybe-comma ",")
+ (setq maybe-left-brace ""))
+ ;;
+ (when (not (zerop (length page)))
+ (insert maybe-left-brace maybe-comma "page=" page)
+ (setq maybe-comma ",")
+ (setq maybe-left-brace ""))
+ ;;
+ (if (zerop (length maybe-left-brace))
+ (insert "]"))
+ (TeX-insert-braces 0)
+ (insert
+ (if LaTeX-includegraphics-strip-extension-flag
+ ;; We don't have `replace-regexp-in-string' in all (X)Emacs versions:
+ (with-temp-buffer
+ (insert image-file)
+ (goto-char (point-max))
+ (when (search-backward-regexp (LaTeX-includegraphics-extensions)
+ nil t 1)
+ (replace-match ""))
+ (buffer-string))
+ image-file))
+ (when show-hint
+ (message
+ (concat
+ "Adding `C-u C-u' before the command asks for more optional arguments."
+ "\nSee `LaTeX-includegraphics-options-alist' for details."))
+ (sit-for 3))
+ t))
+
+;;; graphicx.el ends here
diff --git a/tests/auctex-11.87.7/style/harvard.el
b/tests/auctex-11.87.7/style/harvard.el
new file mode 100644
index 0000000..83463ea
--- /dev/null
+++ b/tests/auctex-11.87.7/style/harvard.el
@@ -0,0 +1,128 @@
+;;; harvard.el --- Support for Harvard Citation style package for AUCTeX.
+
+;; Copyright (C) 1994, 1997, 2005, 2012 Free Software Foundation, Inc.
+
+;; Author: Berwin Turlach <statba@nus.edu.sg>
+;; Maintainer: auctex-devel@gnu.org
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Code:
+
+(TeX-add-style-hook "harvard"
+ (function
+ (lambda ()
+
+ (LaTeX-add-environments
+ '("thebibliography" LaTeX-env-harvardbib ignore))
+
+ (TeX-add-symbols
+ "harvardand"
+ '("citeasnoun"
+ (TeX-arg-conditional TeX-arg-cite-note-p ([ "Note" ]) nil)
+ TeX-arg-cite)
+ '("possessivecite"
+ (TeX-arg-conditional TeX-arg-cite-note-p ([ "Note" ]) nil)
+ TeX-arg-cite)
+ '("citeaffixed"
+ (TeX-arg-conditional TeX-arg-cite-note-p ([ "Note" ]) nil)
+ TeX-arg-cite "Affix")
+ '("citeyear"
+ (TeX-arg-conditional TeX-arg-cite-note-p ([ "Note" ]) nil)
+ TeX-arg-cite)
+ '("citename"
+ (TeX-arg-conditional TeX-arg-cite-note-p ([ "Note" ]) nil)
+ TeX-arg-cite)
+ '("citationstyle"
+ (TeX-arg-eval completing-read "Citation style: " '(("agsm") ("dcu"))))
+ '("citationmode"
+ (TeX-arg-eval completing-read "Citation mode: "
+ '(("full") ("abbr") ("default"))))
+ '("harvardparenthesis"
+ (TeX-arg-eval completing-read "Harvardparenthesis: "
+ '(("round") ("curly") ("angle") ("square"))))
+ '("bibliographystyle"
+ (TeX-arg-eval
+ completing-read "Bibliography style: "
+ '(("agsm") ("apsr") ("dcu") ("jmr") ("jphysicsB") ("kluwer")
("nederlands") ("econometrica")))
+ ignore)
+ '("harvarditem" [ "Short citation" ]
+ "Complete citation" "Year" TeX-arg-define-cite))
+
+ (setq TeX-complete-list
+ (append '(("\\\\citeasnoun\\[[^]\n\r\\%]*\\]{\\([^{}\n\r\\%,]*\\)"
+ 1 LaTeX-bibitem-list "}")
+ ("\\\\citeasnoun{\\([^{}\n\r\\%,]*\\)" 1
+ LaTeX-bibitem-list "}")
+
("\\\\possessivecite\\[[^]\n\r\\%]*\\]{\\([^{}\n\r\\%,]*\\)"
+ 1 LaTeX-bibitem-list "}")
+ ("\\\\possessivecite{\\([^{}\n\r\\%,]*\\)" 1
+ LaTeX-bibitem-list "}")
+ ("\\\\citename\\[[^]\n\r\\%]*\\]{\\([^{}\n\r\\%,]*\\)"
+ 1 LaTeX-bibitem-list "}")
+ ("\\\\citename{\\([^{}\n\r\\%,]*\\)" 1
+ LaTeX-bibitem-list "}")
+ ("\\\\citeaffixed\\[[^]\n\r\\%]*\\]{\\([^{}\n\r\\%,]*\\)"
+ 1 LaTeX-bibitem-list "}")
+ ("\\\\citeaffixed{\\([^{}\n\r\\%,]*\\)" 1
+ LaTeX-bibitem-list "}")
+ ("\\\\citeaffixed{\\([^{}\n\r\\%]*,\\)\\([^{}\n\r\\%,]*\\)"
+ 2 LaTeX-bibitem-list)
+ ("\\\\citeyear\\[[^]\n\r\\%]*\\]{\\([^{}\n\r\\%,]*\\)"
+ 1 LaTeX-bibitem-list "}")
+ ("\\\\citeyear{\\([^{}\n\r\\%,]*\\)" 1
+ LaTeX-bibitem-list "}")
+ ("\\\\citeyear{\\([^{}\n\r\\%]*,\\)\\([^{}\n\r\\%,]*\\)"
+ 2 LaTeX-bibitem-list))
+ TeX-complete-list))
+
+ (setq LaTeX-auto-regexp-list
+ (append '(("\\\\harvarditem{\\([a-zA-Z][^%#'()={}]*\\)}{\\([0-9][^,
%\"#'()={}]*\\)}{\\([a-zA-Z][^, %\"#'()={}]*\\)}" 3 LaTeX-auto-bibitem)
+
("\\\\harvarditem\\[[^][\n\r]+\\]{\\([a-zA-Z][^%#'()={}]*\\)}{\\([0-9][^,
%\"#'()={}]*\\)}{\\([a-zA-Z][^, %\"#'()={}]*\\)}" 3 LaTeX-auto-bibitem)
+ )
+ LaTeX-auto-regexp-list))
+
+ (setq LaTeX-item-list
+ (cons '("thebibliography" . LaTeX-item-harvardbib)
+ LaTeX-item-list))
+
+ ;; Tell RefTeX
+ (when (fboundp 'reftex-set-cite-format)
+ (reftex-set-cite-format 'harvard)))))
+
+(defun LaTeX-env-harvardbib (environment &optional ignore)
+ "Insert ENVIRONMENT with label for harvarditem."
+ (LaTeX-insert-environment environment
+ (concat TeX-grop "xx" TeX-grcl))
+ (end-of-line 0)
+ (delete-char 1)
+ (delete-horizontal-space)
+ (LaTeX-insert-item))
+
+;; Analog to LaTeX-item-bib from latex.el
+(defun LaTeX-item-harvardbib ()
+ "Insert a new harvarditem."
+ (TeX-insert-macro "harvarditem"))
+
+(defvar LaTeX-harvard-package-options '("full" "abbr" "default"
+ "agsmcite" "dcucite" "round"
+ "curly" "angle" "square" "none")
+ "Package options for the harvard package.")
+
+;; harvard.el ends here
diff --git a/tests/auctex-11.87.7/style/hyperref.el
b/tests/auctex-11.87.7/style/hyperref.el
new file mode 100644
index 0000000..1f703f7
--- /dev/null
+++ b/tests/auctex-11.87.7/style/hyperref.el
@@ -0,0 +1,124 @@
+;;; hyperref.el --- AUCTeX style for the hyperref class.
+
+;; Copyright (C) 2008 Free Software Foundation, Inc.
+
+;; Author: Ralf Angeli <angeli@caeruleus.net>
+;; Maintainer: auctex-devel@gnu.org
+;; Created: 2008-06-21
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; This file adds support for the hyperref package.
+
+;;; Code:
+
+(defvar LaTeX-hyperref-package-options
+ '("a4paper" "a5paper" "anchorcolor" "b5paper" "backref" "baseurl"
+ "bookmarks" "bookmarksnumbered" "bookmarksopen"
+ "bookmarksopenlevel \maxdimen" "bookmarkstype" "breaklinks"
+ "CJKbookmarks" "citebordercolor" "citecolor" "colorlinks" "debug"
+ "draft" "dvipdf" "dvipdfm" "dvipdfmx" "dvips" "dvipsone"
+ "dviwindo" "encap" "executivepaper" "extension" "filebordercolor"
+ "filecolor" "final" "frenchlinks" "hyperfigures" "hyperfootnotes"
+ "hyperindex" "hypertex" "hypertexnames" "implicit" "latex2html"
+ "legalpaper" "letterpaper" "linkbordercolor" "linkcolor"
+ "linktocpage" "menubordercolor" "menucolor" "nativepdf"
+ "naturalnames" "nesting" "pageanchor" "pagebackref"
+ "pagebordercolor" "pagecolor" "pdfauthor" "pdfborder"
+ "pdfcenterwindow" "pdfcreator" "pdfdirection" "pdfdisplaydoctitle"
+ "pdfduplex" "pdffitwindow" "pdfhighlight" "pdfkeywords" "pdflang"
+ "pdfmark" "pdfmenubar" "pdfnewwindow" "pdfnonfullscreenpagemode"
+ "pdfnumcopies" "pdfpagelayout" "pdfpagemode" "pdfpagelabels"
+ "pdfpagescrop" "pdfpagetransition" "pdfpicktrackbypdfsize"
+ "pdfprintarea" "pdfprintclip" "pdfprintpagerange"
+ "pdfprintscaling" "pdfproducer" "pdfstartpage" "pdfstartview"
+ "pdfsubject" "pdftex" "pdftitle" "pdftoolbar" "pdfview"
+ "pdfviewarea" "pdfviewclip" "pdfwindowui" "plainpages" "ps2pdf"
+ "raiselinks" "runbordercolor" "setpagesize" "tex4ht" "textures"
+ "unicode" "urlbordercolor" "urlcolor" "verbose" "vtex" "xetex")
+ "Package options for the hyperref package.")
+
+(TeX-add-style-hook
+ "hyperref"
+ (lambda ()
+ ;; hyperref.sty loads url.sty
+ (TeX-run-style-hooks "url")
+ (TeX-add-symbols
+ '("href" "URL" "Text")
+ '("nolinkurl" t)
+ '("hyperbaseurl" t)
+ '("hyperimage" "Image URL" "Text")
+ '("hyperdef" "Category" "Name" "Text")
+ '("hyperref" "URL" "Category" "Name" "Text")
+ '("hyperlink" "Name" "Text")
+ '("hypertarget" "Name" "Text")
+ '("phantomsection" 0)
+ '("autoref" TeX-arg-ref)
+ '("ref*" TeX-arg-ref)
+ '("pageref*" TeX-arg-ref)
+ '("pdfstringdef" "Macro name" "TeX string")
+ '("texorpdfstring" "TeX string" "PDF string")
+ '("hypercalcbp" t)
+ '("Acrobatmenu" "Menu option" "Text")
+ '("TextField" ["Parameters"] "Label")
+ '("CheckBox" ["Parameters"] "Label")
+ '("ChoiceMenu" ["Parameters"] "Label" "Choices")
+ '("PushButton" ["Parameters"] "Label")
+ '("Submit" ["Parameters"] "Label")
+ '("Reset" ["Parameters"] "Label")
+ '("LayoutTextField" "Label" "Field")
+ '("LayoutChoiceField" "Label" "Field")
+ '("LayoutCheckField" "Label" "Field")
+ '("MakeRadioField" "Width" "Height")
+ '("MakeCheckField" "Width" "Height")
+ '("MakeTextField" "Width" "Height")
+ '("MakeChoiceField" "Width" "Height")
+ '("MakeButtonField" "Text"))
+
+ (add-to-list 'LaTeX-verbatim-macros-with-braces-local "nolinkurl")
+ (add-to-list 'LaTeX-verbatim-macros-with-braces-local "hyperbaseurl")
+ (add-to-list 'LaTeX-verbatim-macros-with-braces-local "hyperimage")
+ (add-to-list 'LaTeX-verbatim-macros-with-braces-local "hyperref")
+
+ ;; Fontification
+ (when (and (fboundp 'font-latex-add-keywords)
+ (fboundp 'font-latex-set-syntactic-keywords)
+ (eq TeX-install-font-lock 'font-latex-setup))
+ (font-latex-add-keywords '(("href" "{{")
+ ("nolinkurl" "{")
+ ("hyperbaseurl" "{")
+ ("hyperimage" "{{")
+ ("hyperdef" "{{{")
+ ("hyperref" "{{{{")
+ ("hyperlink" "{{")
+ ("hypertarget" "{{")
+ ("autoref" "{")
+ ("ref" "*{")
+ ("pageref" "*{"))
+ 'reference)
+ ;; For syntactic fontification, e.g. verbatim constructs.
+ (font-latex-set-syntactic-keywords))
+
+ ;; RefTeX
+ (when (fboundp 'reftex-ref-style-activate)
+ (reftex-ref-style-activate "Hyperref"))))
+
+;;; hyperref.el ends here
diff --git a/tests/auctex-11.87.7/style/icelandic.el
b/tests/auctex-11.87.7/style/icelandic.el
new file mode 100644
index 0000000..f7750dd
--- /dev/null
+++ b/tests/auctex-11.87.7/style/icelandic.el
@@ -0,0 +1,53 @@
+;;; icelandic.el --- AUCTeX style for the `icelandic' babel option.
+
+;; Copyright (C) 2007 Free Software Foundation, Inc.
+
+;; Author: Ralf Angeli <angeli@caeruleus.net>
+;; Maintainer: auctex-devel@gnu.org
+;; Created: 2007-03-11
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; Set up AUCTeX for editing Icelandic text in connection with the
+;; `icelandic' babel option.
+
+;;; Code:
+
+(defvar LaTeX-icelandic-mode-syntax-table
+ (copy-syntax-table LaTeX-mode-syntax-table)
+ "Syntax table used in LaTeX mode when using `icelandic.sty'.")
+
+(modify-syntax-entry ?\" "w" LaTeX-icelandic-mode-syntax-table)
+
+(TeX-add-style-hook
+ "icelandic"
+ (lambda ()
+ (set-syntax-table LaTeX-icelandic-mode-syntax-table)
+ (unless (eq (car TeX-quote-language) 'override)
+ (setq TeX-quote-language '("icelandic" "\"`" "\"'" t)))
+ (setq LaTeX-babel-hyphen-language "icelandic")
+ ;; Fontification of quotation marks.
+ (when (fboundp 'font-latex-add-quotes)
+ (font-latex-add-quotes '("\"`" "\"'"))
+ (font-latex-add-quotes '("\"<" "\">" french)))
+ (run-hooks 'TeX-language-is-hook)))
+
+;;; icelandic.el ends here
diff --git a/tests/auctex-11.87.7/style/index.el
b/tests/auctex-11.87.7/style/index.el
new file mode 100644
index 0000000..f14630b
--- /dev/null
+++ b/tests/auctex-11.87.7/style/index.el
@@ -0,0 +1,83 @@
+;;; index.el --- AUCTeX support for indices with index.sty.
+
+;; Copyright (C) 1999 Free Software Foundation, Inc.
+
+;; Author: Carsten Dominik <dominik@strw.leidenuniv.nl>
+;; Maintainer: auctex-devel@gnu.org
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Code:
+
+(TeX-add-style-hook "index"
+ (lambda ()
+
+ (TeX-add-symbols
+
+ ;; New indices
+ '("newindex" [ "Counter" ] "Tag"
+ "Extension of raw index" "Extension of processed index" "Index title")
+ '("renewindex" [ "Counter" ] "Tag"
+ "Extension of raw index" "Extension of processed index" "Index title")
+ "makeindex"
+ '("disableindex" "Tag[,tag...]")
+
+ ;; Printing the index
+ '("printindex" [ "Indextag" ] [ "Prologue" ])
+ "indexspace"
+
+ ;; Index entries
+ '("index" [ TeX-arg-index-tag ] TeX-arg-index)
+ '("index*" [ TeX-arg-index-tag ] TeX-arg-index)
+
+ ;; Showidx-like stuff
+ "proofmodetrue" "proofmodefalse" '("indexproofstyle" "Style")
+
+ ;; Shortcuts (THESE ARE DEPRECATED AND SHOULD NOT BE USED
+ "shortindexingon" "shortindexinoff")
+
+ ;; Parsing index macros
+ (setq LaTeX-auto-regexp-list
+ (append
+
+ ;; The first regexp is faster, but less accurate
+ ;;'(("\\\\index\\*?\\[[^{}]*\\]{\\([^}]*\\)"
+ ;; 1 LaTeX-auto-index-entry))
+
+ ;; The second regexp is very good, but slower.
+
'(("\\\\index\\*?\\[[^{}]*\\]{\\([^}{]*\\({[^}{]*\\({[^}{]*\\({[^}{]*}[^}{]*\\)*}[^}{]*\\)*}[^}{]*\\)*\\)}"
+ 1 LaTeX-auto-index-entry))
+
+ LaTeX-auto-regexp-list))
+
+ ;; Completion for the index entries in \index and |see commands
+ (setq TeX-complete-list
+ (append
+ '(("\\\\index\\*?\\(\\[[^][{}]*\\]\\)?{\\([^{}\n\r]*\\)"
+ 2 LaTeX-index-entry-list)
+ ("|see{\\([^}]*\\)" 1 LaTeX-index-entry-list))
+ TeX-complete-list))
+
+ ;; RefTeX support
+ (and (fboundp 'reftex-add-index-macros)
+ (reftex-add-index-macros '(index)))))
+
+(defvar LaTeX-index-package-options nil
+ "Package options for the index package.")
+
+;;; index.el ends here
diff --git a/tests/auctex-11.87.7/style/inputenc.el
b/tests/auctex-11.87.7/style/inputenc.el
new file mode 100644
index 0000000..8b7be5c
--- /dev/null
+++ b/tests/auctex-11.87.7/style/inputenc.el
@@ -0,0 +1,86 @@
+;;; inputenc.el --- AUCTeX style for `inputenc.sty'
+
+;; Copyright (C) 2005 Free Software Foundation, Inc.
+
+;; Author: Arne J�rgensen <arne@arnested.dk>
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; 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 file adds support for `inputenc.sty'.
+
+;;; Code:
+
+(defun LaTeX-inputenc-package-options nil
+ "Prompt for package options for the inputenc package."
+ ;; separate the condition in three to silence the byte compiler
+ (if (boundp 'latex-inputenc-coding-alist)
+ (when (fboundp 'latexenc-coding-system-to-inputenc)
+ (when (fboundp 'latexenc-inputenc-to-coding-system)
+ (let ((default (latexenc-coding-system-to-inputenc
+ (or coding-system-for-write
+ buffer-file-coding-system)))
+ (selected 'undecided))
+ (setq selected (completing-read
+ (if default
+ (format "Input encoding (default %s): " default)
+ "Input encoding: ")
+ (mapcar 'car latex-inputenc-coding-alist)
+ nil
+ nil
+ nil
+ nil
+ default))
+
+ ;; if necessary offer to set the coding system for saving
+ ;; this buffer based on the selected input encoding
+ (when (and (null
+ (coding-system-equal
+ (coding-system-base
+ (or coding-system-for-write
+ buffer-file-coding-system))
+ (coding-system-base
+ (latexenc-inputenc-to-coding-system selected))))
+ (y-or-n-p "Set coding system for saving this buffer? ")
+ (set-buffer-file-coding-system
+ (coding-system-base
+ (latexenc-inputenc-to-coding-system selected)))
+ (message nil)))
+
+ ;; return selected input encoding
+ selected)))
+ (read-string "Input encoding: ")))
+
+(defun LaTeX-arg-inputenc-inputenc (optional)
+ "Prompt for input encoding."
+ (TeX-argument-insert (LaTeX-inputenc-package-options) nil))
+
+(TeX-add-style-hook
+ "inputenc"
+ (lambda ()
+ ;; New symbols
+ (TeX-add-symbols
+ '("inputencoding" LaTeX-arg-inputenc-inputenc))))
+
+;; Local Variables:
+;; coding: iso-8859-1
+;; End:
+
+;;; inputenc.el ends here
diff --git a/tests/auctex-11.87.7/style/italian.el
b/tests/auctex-11.87.7/style/italian.el
new file mode 100644
index 0000000..4578f6f
--- /dev/null
+++ b/tests/auctex-11.87.7/style/italian.el
@@ -0,0 +1,59 @@
+;;; italian.el --- Setup AUCTeX for editing Italian text.
+
+;; Copyright (C) 2004, 2005 Free Software Foundation, Inc.
+
+;; Author: Davide G. M. Salvetti <salve@debian.org>
+;; Maintainer: Davide G. M. Salvetti <salve@debian.org>
+;; Created: 2004-05-12
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+;;
+;; I believe that the Italian correct quoting is achieved with `\"<' and
+;; `\">'. However, I will be glad to see a normative reference. -- DGMS
+
+;;; Code:
+
+(defvar TeX-language-it-hook nil
+ "Hook run for Italian texts.")
+
+(TeX-add-style-hook
+ "italian"
+ (lambda ()
+ ;; XXX: Handle former customizations of the now defunct
+ ;; Italian-specific variables. References to the respective
+ ;; variables are to be deleted in future versions. (now = 2005-04-01)
+ (unless (eq (car TeX-quote-language) 'override)
+ (let ((open-quote (if (and (boundp 'LaTeX-italian-open-quote)
+ LaTeX-italian-open-quote)
+ LaTeX-italian-open-quote
+ "\"<"))
+ (close-quote (if (and (boundp 'LaTeX-italian-close-quote)
+ LaTeX-italian-close-quote)
+ LaTeX-italian-close-quote
+ "\">")))
+ (setq TeX-quote-language
+ `("italian" ,open-quote ,close-quote TeX-quote-after-quote))))
+ ;; Fontification of quotation marks.
+ (when (fboundp 'font-latex-add-quotes)
+ (font-latex-add-quotes '("\"<" "\">" french)))
+ (run-hooks 'TeX-language-it-hook)))
+
+;;; italian.el ends here
diff --git a/tests/auctex-11.87.7/style/j-article.el
b/tests/auctex-11.87.7/style/j-article.el
new file mode 100644
index 0000000..2408e7e
--- /dev/null
+++ b/tests/auctex-11.87.7/style/j-article.el
@@ -0,0 +1,12 @@
+;;; j-article.el - Special code for j-article style.
+
+;; $Id: j-article.el,v 1.4 2005-03-17 10:02:06 angeli Exp $
+
+;;; Code:
+
+(TeX-add-style-hook
+ "j-article"
+ (lambda ()
+ (LaTeX-largest-level-set "section")))
+
+;;; j-article.el ends here
diff --git a/tests/auctex-11.87.7/style/j-book.el
b/tests/auctex-11.87.7/style/j-book.el
new file mode 100644
index 0000000..92d11b2
--- /dev/null
+++ b/tests/auctex-11.87.7/style/j-book.el
@@ -0,0 +1,12 @@
+;;; j-book.el - Special code for j-book style.
+
+;; $Id: j-book.el,v 1.3 2005-03-17 10:02:06 angeli Exp $
+
+;;; Code:
+
+(TeX-add-style-hook
+ "j-book"
+ (lambda ()
+ (LaTeX-largest-level-set "chapter")))
+
+;;; j-book.el ends here
diff --git a/tests/auctex-11.87.7/style/j-report.el
b/tests/auctex-11.87.7/style/j-report.el
new file mode 100644
index 0000000..437616f
--- /dev/null
+++ b/tests/auctex-11.87.7/style/j-report.el
@@ -0,0 +1,12 @@
+;;; j-report.el - Special code for j-report style.
+
+;; $Id: j-report.el,v 1.3 2005-03-17 10:02:06 angeli Exp $
+
+;;; Code:
+
+(TeX-add-style-hook
+ "j-report"
+ (lambda ()
+ (LaTeX-largest-level-set "chapter")))
+
+;;; j-report.el ends here
diff --git a/tests/auctex-11.87.7/style/jarticle.el
b/tests/auctex-11.87.7/style/jarticle.el
new file mode 100644
index 0000000..010725e
--- /dev/null
+++ b/tests/auctex-11.87.7/style/jarticle.el
@@ -0,0 +1,12 @@
+;;; jarticle.el - Special code for jarticle style.
+
+;; $Id: jarticle.el,v 1.4 2005-03-17 10:02:06 angeli Exp $
+
+;;; Code:
+
+(TeX-add-style-hook
+ "jarticle"
+ (lambda ()
+ (LaTeX-largest-level-set "section")))
+
+;;; jarticle.el ends here
diff --git a/tests/auctex-11.87.7/style/jbook.el
b/tests/auctex-11.87.7/style/jbook.el
new file mode 100644
index 0000000..a678ebc
--- /dev/null
+++ b/tests/auctex-11.87.7/style/jbook.el
@@ -0,0 +1,12 @@
+;;; jbook.el - Special code for jbook style.
+
+;; $Id: jbook.el,v 1.3 2005-03-17 10:02:06 angeli Exp $
+
+;;; Code:
+
+(TeX-add-style-hook
+ "jbook"
+ (lambda ()
+ (LaTeX-largest-level-set "chapter")))
+
+;;; jbook.el ends here
diff --git a/tests/auctex-11.87.7/style/jreport.el
b/tests/auctex-11.87.7/style/jreport.el
new file mode 100644
index 0000000..d2f3f33
--- /dev/null
+++ b/tests/auctex-11.87.7/style/jreport.el
@@ -0,0 +1,13 @@
+;;; jreport.el - Special code for jreport style.
+
+;; $Id: jreport.el,v 1.3 2005-03-17 10:02:06 angeli Exp $
+
+;;; Code:
+
+(TeX-add-style-hook
+ "jreport"
+ (lambda ()
+ (LaTeX-largest-level-set "chapter")))
+
+
+;;; jreport.el ends here
diff --git a/tests/auctex-11.87.7/style/jsarticle.el
b/tests/auctex-11.87.7/style/jsarticle.el
new file mode 100644
index 0000000..36fc54a
--- /dev/null
+++ b/tests/auctex-11.87.7/style/jsarticle.el
@@ -0,0 +1,12 @@
+;;; jsarticle.el - Special code for jsarticle style.
+
+;; $Id: jsarticle.el,v 1.2 2005-03-17 10:02:06 angeli Exp $
+
+;;; Code:
+
+(TeX-add-style-hook
+ "jsarticle"
+ (lambda ()
+ (LaTeX-largest-level-set "section")))
+
+;;; jsarticle.el ends here
diff --git a/tests/auctex-11.87.7/style/jsbook.el
b/tests/auctex-11.87.7/style/jsbook.el
new file mode 100644
index 0000000..3dff339
--- /dev/null
+++ b/tests/auctex-11.87.7/style/jsbook.el
@@ -0,0 +1,12 @@
+;;; jsbook.el - Special code for jsbook style.
+
+;; $Id: jsbook.el,v 1.2 2005-03-17 10:02:06 angeli Exp $
+
+;;; Code:
+
+(TeX-add-style-hook
+ "jsbook"
+ (lambda ()
+ (LaTeX-largest-level-set "chapter")))
+
+;;; jsbook.el ends here
diff --git a/tests/auctex-11.87.7/style/jura.el
b/tests/auctex-11.87.7/style/jura.el
new file mode 100644
index 0000000..2f149c4
--- /dev/null
+++ b/tests/auctex-11.87.7/style/jura.el
@@ -0,0 +1,39 @@
+;;; jura.el --- AUCTeX style for `jura.cls'
+
+;; Copyright (C) 2004 Free Software Foundation, Inc.
+
+;; Author: Frank K�ster <frank@kuesterei.ch>
+;; Maintainer: auctex-devel@gnu.org
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; This file adds support for `jura.cls'.
+
+;;; Code:
+
+(TeX-add-style-hook
+ "jura"
+ (lambda ()
+ (TeX-run-style-hooks "alphanum")))
+
+;; Local Variables:
+;; coding: iso-8859-1
+;; End:
diff --git a/tests/auctex-11.87.7/style/jurabib.el
b/tests/auctex-11.87.7/style/jurabib.el
new file mode 100644
index 0000000..c48e383
--- /dev/null
+++ b/tests/auctex-11.87.7/style/jurabib.el
@@ -0,0 +1,634 @@
+;;; jurabib.el --- AUCTeX style for the `jurabib' package
+
+;; Copyright (C) 2004, 2007 Free Software Foundation, Inc.
+
+;; Author: Ralf Angeli <angeli@iwi.uni-sb.de>
+;; Maintainer: auctex-devel@gnu.org
+;; Created: 2004-10-05
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; This file adds support for the `jurabib' package.
+
+;; Currently only the citation-related commands are supported. Feel
+;; free to complete the support and send the result to the AUCTeX
+;; mailing list. But be aware that the code can only be included if
+;; you assign the copyright to the FSF.
+
+;;; Code:
+
+(TeX-add-style-hook
+ "jurabib"
+ (lambda ()
+ ;; Taken from natbib.el and adapted.
+ (let ((citecmds
+ '(("cite" . 2) ("cite*" . 2)
+ ("citetitle" . 2) ("fullcite" . 2)
+ ("citet" . 1) ("citealt" . 1)
+ ("citep" . 2) ("citealp" . 2)
+ ("citeauthor" . 2) ("citeyear" . 2)
+ ("footcite" . 2) ("footcite*" . 2)
+ ("footcitetitle" . 2) ("footfullcite" . 2)
+ ("footcitet" . 1) ("footcitealt" . 1)
+ ("footcitep" . 2) ("footcitealp" . 2)
+ ("footciteauthor" . 2) ("footciteyear" . 2))))
+ ;; Add these symbols
+ (apply
+ 'TeX-add-symbols
+ (mapcar
+ (lambda (cmd)
+ (cond
+ ((= (cdr cmd) 0)
+ ;; No optional arguments
+ (list (car cmd) 'TeX-arg-cite))
+ ((= (cdr cmd) 1)
+ ;; Just one optional argument, the post note
+ (list
+ (car cmd)
+ '(TeX-arg-conditional TeX-arg-cite-note-p (["Post-note"]) nil)
+ 'TeX-arg-cite))
+ ((= (cdr cmd) 2)
+ ;; Pre and post notes
+ (list
+ (car cmd)
+ '(TeX-arg-conditional TeX-arg-cite-note-p (natbib-note-args) nil)
+ 'TeX-arg-cite))))
+ citecmds))
+ ;; Special cases
+ (TeX-add-symbols
+ ;; FIXME: Completing read for field.
+ '("citefield" ; \citefield[]{}{}
+ (TeX-arg-conditional TeX-arg-cite-note-p (["Post-note"]) nil)
+ "Field" TeX-arg-cite)
+ '("footcitefield" ; \footcitefield[]{}{}
+ (TeX-arg-conditional TeX-arg-cite-note-p (["Post-note"]) nil)
+ "Field" TeX-arg-cite))
+
+ ;; Make an entry in TeX-complete-list
+ (add-to-list
+ 'TeX-complete-list
+ (list
+ (concat "\\\\\\("
+ (mapconcat (lambda (x) (regexp-quote (car x)))
+ (append citecmds
+ '(("citefield") ("footcitefield"))) "\\|")
+ "\\)\\(\\[[^]\n\r\\%]*\\]\\)*{\\([^{}\n\r\\%,]*,\\)*"
+ "\\([^{}\n\r\\%,]*\\)")
+ 4 'LaTeX-bibitem-list "}"))
+
+ ;; Add further symbols
+ (TeX-add-symbols
+ '("citefullfirstfortype" 1)
+ '("citenotitlefortype" 1)
+ '("citeswithoutentry" 1)
+ '("citetitlefortype" 1)
+ '("citeworkwithtitle" 1)
+ '("nextcitefull" 1)
+ '("nextcitenotitle" 1)
+ '("nextcitereset" 1)
+ '("nextciteshort" 1)
+ '("jurabibsetup" 1))
+
+ ;; Fontification
+ (when (and (featurep 'font-latex)
+ (eq TeX-install-font-lock 'font-latex-setup))
+ (font-latex-add-keywords '(("cite" "*[[{")
+ ("citetitle" "[[{")
+ ("fullcite" "[[{")
+ ("citet" "[{")
+ ("citealt" "[{")
+ ("citep" "[[{")
+ ("citealp" "[[{")
+ ("citeauthor" "[[{")
+ ("citeyear" "[[{")
+ ("footcite" "[[{")
+ ("footcite*" "[[{")
+ ("footcitetitle" "[[{")
+ ("footfullcite" "[[{")
+ ("footcitet" "[{")
+ ("footcitealt" "[{")
+ ("footcitep" "[[{")
+ ("footcitealp" "[[{")
+ ("footciteauthor" "[[{")
+ ("footciteyear" "[[{")
+ ("citefield" "[{{")
+ ("footcitefield" "[{{"))
+ 'reference)
+ (font-latex-add-keywords '(("citeswithoutentry" "{")
+ ("nextcitefull" "{")
+ ("nextcitenotitle" "{")
+ ("nextcitereset" "{")
+ ("nextciteshort" "{"))
+ 'function)
+ (font-latex-add-keywords '(("citenotitlefortype" "{")
+ ("citetitlefortype" "{")
+ ("jurabibsetup" "{"))
+ 'variable))
+
+ ;; Tell RefTeX (Thanks, Carsten)
+ (when (and (fboundp 'reftex-set-cite-format)
+ ;; Is it `reftex-cite-format' customized?
+ (not (get 'reftex-cite-format 'saved-value)))
+ ;; Check if RefTeX supports jurabib.
+ (if (assoc 'jurabib reftex-cite-format-builtin)
+ ;; Yes, use the provided default.
+ (reftex-set-cite-format 'jurabib)
+ ;; No, set it by hand.
+ (reftex-set-cite-format
+ '((?\C-m . "\\cite{%l}")
+ (?c . "\\cite[?][]{%l}")
+ (?t . "\\citet{%l}")
+ (?p . "\\citep{%l}")
+ (?e . "\\citep[e.g.][?]{%l}")
+ (?s . "\\citep[see][?]{%l}")
+ (?u . "\\fullcite{%l}")
+ (?i . "\\citetitle{%l}")
+ (?a . "\\citeauthor{%l}")
+ (?e . "\\citefield{?}{%l}")
+ (?y . "\\citeyear{%l}")
+ (?f . "\\footcite{%l}")
+ (?F . "\\footcite[?][]{%l}")
+ (?l . "\\footfullcite{%l}"))))))
+
+ ;; FIXME: The following list is the edited output of
+ ;; `TeX-auto-generate' which probably includes internal macros of
+ ;; jurabib. Unfortunately the macros which should be accessible to
+ ;; the user are not fully documented at the time of this writing.
+ ;; But instead of including only the limited part which is
+ ;; documented we rather give the user a bit too much. The list
+ ;; should be reduced when there is proper documentation, though.
+ (TeX-add-symbols
+ '("Wrapquotes" 1)
+ '("apyformat" 1)
+ '("artnumberformat" 1)
+ '("artvolnumformat" 2)
+ '("artvolumeformat" 1)
+ '("artyearformat" 1)
+ '("bibAnnote" 1)
+ '("bibAnnoteFile" 1)
+ '("bibAnnotePath" 1)
+ '("bibEIMfont" 1)
+ '("bibIMfont" 1)
+ '("bibYear" 1)
+ '("bibedformat" 1)
+ '("bibedinformat" 1)
+ '("bibenf" 5)
+ '("biblenf" 5)
+ '("bibnf" 5)
+ '("bibnumberformat" 1)
+ '("bibrenf" 5)
+ '("bibrlenf" 5)
+ '("bibrnf" 5)
+ '("biburlfont" 1)
+ '("edfont" 1)
+ '("formatarticlepages" ["argument"] 2)
+ '("fsted" 1)
+ '("fullnameoxfordcrossref" 1)
+ '("incolledformat" 5)
+ '("jbArchPages" 1)
+ '("jbPages" 1)
+ '("jbannoteformat" 1)
+ '("jbapifont" 1)
+ '("jbarchnameformat" 1)
+ '("jbarchsig" 2)
+ '("jbartPages" 1)
+ '("jbartcrossrefchecked" ["argument"] 1)
+ '("jbauthorindexfont" 1)
+ '("jbbibargs" 5)
+ '("jbbibyearformat" 1)
+ '("jbcitationoyearformat" 1)
+ '("jbcitationyearformat" 1)
+ '("jbcrossrefchecked" ["argument"] 1)
+ '("jbedafti" 1)
+ '("jbedbyincollcrossreflong" 1)
+ '("jbedbyincollcrossrefshort" 1)
+ '("jbedbyincollcrossrefshortnoapy" 1)
+ '("jbedbyincollcrossrefshortwithapy" 1)
+ '("jbedition" 1)
+ '("jbeditorindexfont" 1)
+ '("jbendnote" 1)
+ '("jbflanguage" 1)
+ '("jbincollcrossref" 2)
+ '("jbisbn" 1)
+ '("jbissn" 1)
+ '("jbnote" 2)
+ '("jborganizationindexfont" 1)
+ '("jbpagesformat" 1)
+ '("jbprformat" 1)
+ '("jbrealcitation" 2)
+ '("jbshortarchformat" 1)
+ '("jbshortsubarchformat" 1)
+ '("jbsy" 1)
+ '("jbtiafed" 1)
+ '("lookatfortype" 1)
+ '("nobibliography" 1)
+ '("nocitebuthowcited" 1)
+ '("numberandseries" 2)
+ '("pageadd" 1)
+ '("pernumberformat" 1)
+ '("pervolnumformat" 2)
+ '("pervolumeformat" 1)
+ '("peryearformat" 1)
+ '("revnumberformat" 1)
+ '("revvolnumformat" 2)
+ '("revvolumeformat" 1)
+ '("revyearformat" 1)
+ '("snded" 1)
+ '("textitswitch" 1)
+ '("translator" 3)
+ '("volumeformat" 1)
+ "Bibbfsasep"
+ "Bibbfsesep"
+ "Bibbstasep"
+ "Bibbstesep"
+ "Bibbtasep"
+ "Bibbtesep"
+ "Bibchaptername"
+ "Bibetal"
+ "Edbyname"
+ "IbidemMidName"
+ "IbidemName"
+ "NAT"
+ "OpCit"
+ "Reprint"
+ "SSS"
+ "Transfrom"
+ "Volumename"
+ "addtoalllanguages"
+ "afterfoundersep"
+ "aftervolsep"
+ "ajtsep"
+ "alsothesisname"
+ "aprname"
+ "augname"
+ "bibBTsep"
+ "bibJTsep"
+ "bibPageName"
+ "bibPagesName"
+ "bibaesep"
+ "bibaldelim"
+ "bibaltformatalign"
+ "bibandname"
+ "bibanfont"
+ "bibansep"
+ "bibapifont"
+ "bibapyldelim"
+ "bibapyrdelim"
+ "bibarchpagename"
+ "bibarchpagesname"
+ "bibardelim"
+ "bibartperiodhowcited"
+ "bibatsep"
+ "bibauthormultiple"
+ "bibbdsep"
+ "bibbfsasep"
+ "bibbfsesep"
+ "bibbstasep"
+ "bibbstesep"
+ "bibbtasep"
+ "bibbtesep"
+ "bibbtfont"
+ "bibbtsep"
+ "bibbudcsep"
+ "bibces"
+ "bibchapterlongname"
+ "bibchaptername"
+ "bibcite"
+ "bibcolumnsep"
+ "bibcommenthowcited"
+ "bibcontinuedname"
+ "bibcrossrefcite"
+ "bibcrossrefciteagain"
+ "bibeandname"
+ "bibedformat"
+ "bibefnfont"
+ "bibeimfont"
+ "bibelnfont"
+ "bibenf"
+ "bibfnfmt"
+ "bibfnfont"
+ "bibhowcited"
+ "bibibidfont"
+ "bibidemPfname"
+ "bibidemPmname"
+ "bibidemPnname"
+ "bibidemSfname"
+ "bibidemSmname"
+ "bibidemSnname"
+ "bibidempfname"
+ "bibidempmname"
+ "bibidempnname"
+ "bibidemsfname"
+ "bibidemsmname"
+ "bibidemsnname"
+ "bibimfont"
+ "bibincollcrossrefcite"
+ "bibincollcrossrefciteagain"
+ "bibjtfont"
+ "bibjtsep"
+ "bibleftcolumn"
+ "bibleftcolumnadjust"
+ "bibleftcolumnstretch"
+ "biblenf"
+ "biblnfmt"
+ "biblnfont"
+ "bibnf"
+ "bibnotcited"
+ "bibpagename"
+ "bibpagesname"
+ "bibpagesnamesep"
+ "bibpldelim"
+ "bibprdelim"
+ "bibrevtfont"
+ "bibrightcolumn"
+ "bibrightcolumnadjust"
+ "bibrightcolumnstretch"
+ "bibsall"
+ "bibsdanish"
+ "bibsdutch"
+ "bibsenglish"
+ "bibsfinnish"
+ "bibsfrench"
+ "bibsgerman"
+ "bibsitalian"
+ "bibsnfont"
+ "bibsnorsk"
+ "bibsportuguese"
+ "bibsspanish"
+ "bibtabularitemsep"
+ "bibtfont"
+ "bibtotalpagesname"
+ "biburlprefix"
+ "biburlsuffix"
+ "bibvolumecomment"
+ "bibvtfont"
+ "bothaesep"
+ "bpubaddr"
+ "byname"
+ "citetitleonly"
+ "citeyearpar"
+ "commaename"
+ "commaname"
+ "dateldelim"
+ "daterdelim"
+ "decname"
+ "diffpageibidemmidname"
+ "diffpageibidemname"
+ "edbyname"
+ "edbysep"
+ "editionname"
+ "editorname"
+ "editorsname"
+ "enoteformat"
+ "etalname"
+ "etalnamenodot"
+ "febname"
+ "fifthedname"
+ "firstedname"
+ "footcitetitleonly"
+ "formatpages"
+ "foundername"
+ "fourthedname"
+ "fromdutch"
+ "fromenglish"
+ "fromfinnish"
+ "fromfrench"
+ "fromgerman"
+ "fromitalian"
+ "fromnorsk"
+ "fromportuguese"
+ "fromspanish"
+ "herename"
+ "howcitedprefix"
+ "howcitedsuffix"
+ "ibidem"
+ "ibidemmidname"
+ "ibidemname"
+ "idemPfedbyname"
+ "idemPfname"
+ "idemPmedbyname"
+ "idemPmname"
+ "idemPnedbyname"
+ "idemPnname"
+ "idemSfedbyname"
+ "idemSfname"
+ "idemSmedbyname"
+ "idemSmname"
+ "idemSnedbyname"
+ "idemSnname"
+ "idemmidname"
+ "idemname"
+ "idempfedbyname"
+ "idempfname"
+ "idempmedbyname"
+ "idempmname"
+ "idempnedbyname"
+ "idempnname"
+ "idemsfedbyname"
+ "idemsfname"
+ "idemsmedbyname"
+ "idemsmname"
+ "idemsnedbyname"
+ "idemsnname"
+ "incollinname"
+ "inname"
+ "inseriesname"
+ "janname"
+ "jbCheckedFirst"
+ "jbFirst"
+ "jbFirstAbbrv"
+ "jbJunior"
+ "jbLast"
+ "jbNotRevedNoVonJr"
+ "jbNotRevedNoVonNoJr"
+ "jbNotRevedOnlyLast"
+ "jbNotRevedVonJr"
+ "jbNotRevedVonNoJr"
+ "jbPAGES"
+ "jbPageName"
+ "jbPages"
+ "jbPagesName"
+ "jbRevedFirstNoVonJr"
+ "jbRevedFirstNoVonNoJr"
+ "jbRevedFirstOnlyLast"
+ "jbRevedFirstVonJr"
+ "jbRevedFirstVonNoJr"
+ "jbRevedNotFirstNoVonJr"
+ "jbRevedNotFirstNoVonNoJr"
+ "jbRevedNotFirstOnlyLast"
+ "jbRevedNotFirstVonJr"
+ "jbRevedNotFirstVonNoJr"
+ "jbVon"
+ "jbactualauthorfnfont"
+ "jbactualauthorfont"
+ "jbaddtomakehowcited"
+ "jbaensep"
+ "jbafterstartpagesep"
+ "jbannotatorfont"
+ "jbapifont"
+ "jbarchnamesep"
+ "jbarchpagename"
+ "jbarchpagesname"
+ "jbartPages"
+ "jbatsep"
+ "jbauthorfnfont"
+ "jbauthorfont"
+ "jbauthorfontifannotator"
+ "jbauthorinfo"
+ "jbbeforestartpagesep"
+ "jbbfsasep"
+ "jbbfsesep"
+ "jbbookedaftertitle"
+ "jbbstasep"
+ "jbbstesep"
+ "jbbtasep"
+ "jbbtesep"
+ "jbbtfont"
+ "jbbtitlefont"
+ "jbcitationyearformat"
+ "jbcrossrefchecked"
+ "jbdisablecitationcrossref"
+ "jbdoitem"
+ "jbdonotindexauthors"
+ "jbdonotindexeditors"
+ "jbdonotindexorganizations"
+ "jbdotafterbibentry"
+ "jbdotafterendnote"
+ "jbdy"
+ "jbedbyincollcrossrefcite"
+ "jbedbyincollcrossrefciteagain"
+ "jbedition"
+ "jbedseplikecite"
+ "jbeimfont"
+ "jbfirstcitepageranges"
+ "jbfootnoteformat"
+ "jbfootnotenumalign"
+ "jbfulltitlefont"
+ "jbhowcitedcomparepart"
+ "jbhowcitednormalpart"
+ "jbhowsepannotatorfirst"
+ "jbhowsepannotatorlast"
+ "jbhowsepbeforetitle"
+ "jbhowsepbeforetitleae"
+ "jbhowsepbeforetitleibidemname"
+ "jbignorevarioref"
+ "jbimfont"
+ "jbindexbib"
+ "jbindexonlyfirstauthors"
+ "jbindexonlyfirsteditors"
+ "jbindexonlyfirstorganizations"
+ "jbindextype"
+ "jblookforgender"
+ "jbmakeinbib"
+ "jbmakeinbiblist"
+ "jbmakeindexactual"
+ "jbnotsamearch"
+ "jbonlyforbib"
+ "jbonlyforcitations"
+ "jbonlyforfirstcitefullbegin"
+ "jbonlyforfirstcitefullend"
+ "jborgauthorfont"
+ "jboyearincitation"
+ "jbpagename"
+ "jbpagenamenodot"
+ "jbpages"
+ "jbpagesep"
+ "jbpagesname"
+ "jbpagesnamesep"
+ "jbsamearch"
+ "jbsamesubarch"
+ "jbsamesubarchindent"
+ "jbshorttitlefont"
+ "jbshowbibextralabel"
+ "jbssedbd"
+ "jbsubarchsep"
+ "jbsuperscripteditionafterauthor"
+ "jbtitlefont"
+ "jbts"
+ "jburldef"
+ "jbuseidemhrule"
+ "jbyear"
+ "jbyearaftertitle"
+ "julname"
+ "junname"
+ "jurthesisname"
+ "marname"
+ "mastersthesisname"
+ "mayname"
+ "nofirstnameforcitation"
+ "noibidem"
+ "noidem"
+ "nopage"
+ "novname"
+ "numbername"
+ "octname"
+ "ofseriesname"
+ "opcit"
+ "organizationname"
+ "origPAGES"
+ "origartPages"
+ "origbibces"
+ "origcrossref"
+ "origpages"
+ "osep"
+ "phdthesisname"
+ "reprint"
+ "reprintname"
+ "reviewbyname"
+ "reviewname"
+ "reviewofname"
+ "samepageibidemmidname"
+ "samepageibidemname"
+ "secondedname"
+ "sepname"
+ "sndecmd"
+ "snded"
+ "sndeditorname"
+ "sndeditorsname"
+ "technicalreportname"
+ "testnosig"
+ "textandname"
+ "texteandname"
+ "theHlvla"
+ "theHlvlb"
+ "theHlvlc"
+ "theHlvld"
+ "theHlvle"
+ "theHlvlf"
+ "theHlvlg"
+ "theHlvlh"
+ "theHlvli"
+ "theHlvlj"
+ "theHlvlk"
+ "theHlvll"
+ "thedname"
+ "thirdedname"
+ "trans"
+ "transby"
+ "transfrom"
+ "updatename"
+ "updatesep"
+ "urldatecomment"
+ "volname"
+ "volumename"
+ "volumeofname")))
+
+;;; jurabib.el ends here
diff --git a/tests/auctex-11.87.7/style/latexinfo.el
b/tests/auctex-11.87.7/style/latexinfo.el
new file mode 100644
index 0000000..59daf6c
--- /dev/null
+++ b/tests/auctex-11.87.7/style/latexinfo.el
@@ -0,0 +1,181 @@
+;;; latexinfo.el - Support for LaTeXinfo files.
+
+;; Copyright (C) 1993 Free Software Foundation, Inc.
+
+;; Author: Marc Gemis <makke@wins.uia.ac.be>
+;; Version: $Id: latexinfo.el,v 1.7 2008-02-03 14:53:30 angeli Exp $
+
+;; 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; if not, write to the Free Software
+;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; Code:
+
+;;; LaTeXinfo mode
+
+(defvar TeX-latexinfo-node-regexp
+ '("\\\\node[ \t]+\\([^,\n\r%]+\\)" 1 TeX-auto-label)
+ "Matches LaTeXinfo \\node commands, only current node will be found.
+We ignore next, previous and up fields.")
+
+(defvar LaTeXinfo-mode nil
+ "Non-nil means LaTeXinfo minor mode is active.")
+ (make-variable-buffer-local 'LaTeXinfo-mode)
+
+(defvar LaTeXinfo-mode-map nil
+ "Keymap containing LaTeXinfo commands.")
+
+(if LaTeXinfo-mode-map
+ ()
+ (setq LaTeXinfo-mode-map (make-sparse-keymap))
+ (define-key LaTeXinfo-mode-map "\C-c\C-u\C-b" 'latexinfo-format-buffer)
+ (define-key LaTeXinfo-mode-map "\C-c\C-u\C-r" 'latexinfo-format-region)
+ (define-key LaTeXinfo-mode-map "\C-c\C-u\C-s" 'latexinfo-show-structure)
+ (define-key LaTeXinfo-mode-map "\C-c\C-ud" 'makke:latexinfo-delete-structure)
+ (define-key LaTeXinfo-mode-map "\C-c\C-ug" 'latexinfo-goto-node)
+ (define-key LaTeXinfo-mode-map "\C-c\C-ui" 'makke:latexinfo-structure))
+
+(or (assq 'LaTeXinfo-mode minor-mode-map-alist)
+ (setq minor-mode-map-alist
+ (cons (cons 'LaTeXinfo-mode LaTeXinfo-mode-map)
+ minor-mode-map-alist)))
+
+(defun TeX-arg-latexinfo-index (optional &optional prompt)
+ "Prompt for a LaTeXinfo index type with completion."
+ (TeX-argument-insert
+ (completing-read (TeX-argument-prompt optional prompt "Index")
+ '(("cp") ("vr") ("fn") ("tp") ("pg") ("ky"))
+ nil t)
+ optional))
+
+(defun LaTeX-item-latexinfo-menu ()
+ "Insert a new menu item"
+ (insert "* ::")
+ (backward-char 2))
+
+(defun latexinfo-goto-node () ; temporarily here, later in latexinfo-upd.el ??
+ "Place pointer on the node given by the user, read node with completion
+This fails when the user types in the label of something else"
+ (interactive)
+ (let ((node-name (completing-read "Goto Node: " (LaTeX-label-list))))
+ (goto-char (point-min))
+ (if (re-search-forward
+ (concat
+ TeX-esc "node[ \\t]+" node-name ","
+ "\\|"
+ TeX-esc "label{" LaTeX-section-label node-name
+ "\\|"
+ TeX-esc "label{" node-name
+ )
+ (point-max) t)
+ (beginning-of-line 1)
+ (error "No such node"))))
+
+;;; Hook
+
+(TeX-add-style-hook "latexinfo"
+ (function
+ (lambda ()
+ (require 'latexinfo)
+ (require 'latexinfo-structure)
+
+ (require 'min-map)
+ (setq LaTeXinfo-mode t)
+
+ (TeX-auto-add-regexp TeX-latexinfo-node-regexp)
+
+ (TeX-add-symbols
+ '("node"
+ (TeX-arg-literal " ")
+ (TeX-arg-free TeX-arg-define-label "Node name")
+ (TeX-arg-literal ", ")
+ (TeX-arg-free TeX-arg-label "Next node")
+ (TeX-arg-literal ", ")
+ (TeX-arg-free TeX-arg-label "Previous node")
+ (TeX-arg-literal ", ")
+ (TeX-arg-free TeX-arg-label "Up node"))
+ '("setfilename" TeX-arg-file)
+
+ '("var" t)
+ '("dfn" t)
+ '("emph" t)
+ '("kbd" t)
+ '("code" t)
+ '("samp" t)
+ '("key" t)
+ '("ctrl" t)
+ '("file" t)
+
+ '("comment"
+ (TeX-arg-literal " ")
+ (TeX-arg-free "Comment"))
+ '("c"
+ (TeX-arg-literal " ")
+ (TeX-arg-free "Comment"))
+
+ '("cindex" t)
+ '("cpsubindex" 2)
+ '("cpindexbold" t)
+
+ '("newindex" TeX-arg-latexinfo-index)
+
+ '("br" nil)
+ '("w" "Text")
+ '("dots" nil)
+ '("refill" nil)
+ '("bullet" nil)
+ '("copyright" nil)
+ '("sp" nil)
+
+ '("xref" TeX-arg-label)
+ '("pxref" TeX-arg-label)
+ '("inforef"
+ (TeX-arg-literal "{")
+ (TeX-arg-free "Name of node")
+ (TeX-arg-literal ", ")
+ (TeX-arg-free "Name for note")
+ (TeX-arg-literal ", ")
+ (TeX-arg-free TeX-arg-file "Info file")
+ (TeX-arg-literal "}")))
+
+ (LaTeX-add-environments "menu" "tex" "ignore" "ifinfo" "iftex"
+ "example" "same" "display" "format")
+
+ ; Menu's have a special kind of items
+ (make-local-variable 'LaTeX-item-list)
+ (setq LaTeX-item-list (cons '("menu" . LaTeX-item-latexinfo-menu)
+ LaTeX-item-list))
+
+ (make-local-variable 'TeX-font-list)
+ (setq TeX-font-list
+ (list (list ?\C-b (concat TeX-esc "b{") "}")
+ (list ?\C-c (concat TeX-esc "sc{") "}")
+ (list ?\C-e (concat TeX-esc "emph{") "}")
+ (list ?\C-i (concat TeX-esc "i{") "}")
+ (list ?\C-r (concat TeX-esc "r{") "}")
+ (list ?\C-s (concat TeX-esc "samp{") "}")
+ (list ?\C-t (concat TeX-esc "t{") "}")
+ (list ?s (concat TeX-esc "strong{") "}")
+ (list ?\C-f (concat TeX-esc "file{") "}")
+ (list ?\C-d (concat TeX-esc "dfn{") "}")
+ (list ?\C-v (concat TeX-esc "var{") "}")
+ (list ?k (concat TeX-esc "key{") "}")
+ (list ?\C-k (concat TeX-esc "kbd{") "}")
+ (list ?c (concat TeX-esc "code{") "}")
+ (list ?C (concat TeX-esc "cite{") "}")))
+
+ ;; need the following stuff to let xref and pxref work
+ (make-local-variable 'LaTeX-section-label)
+ (setq LaTeX-section-label ""))))
+
+;;; latexinfo.el ends here
diff --git a/tests/auctex-11.87.7/style/letter.el
b/tests/auctex-11.87.7/style/letter.el
new file mode 100644
index 0000000..fa269a4
--- /dev/null
+++ b/tests/auctex-11.87.7/style/letter.el
@@ -0,0 +1,144 @@
+;;; letter.el - Special code for letter style.
+
+;; Copyright (C) 1993, 2012 Free Software Foundation, Inc.
+
+;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
+;; Maintainer: auctex-devel@gnu.org
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Code:
+
+;; You may want to define this in tex-site.el to contain your
+;; organizations address.
+(defvar LaTeX-letter-sender-address ""
+ "Initial value when prompting for a sender address in the letter style.")
+
+(TeX-add-style-hook "letter"
+ (function
+ (lambda ()
+ (LaTeX-add-environments
+ '("letter" LaTeX-env-recipient))
+ (TeX-add-symbols
+ '("name" "Sender: ")
+ '("address" "Sender address: ")
+ '("signature" "Signature: ")
+ '("opening" "Opening: ")
+ '("closing" "Closing: ")))))
+
+(defun LaTeX-env-recipient (environment)
+ "Insert ENVIRONMENT and prompt for recipient and address."
+ (let ((sender (read-string "Sender: " (user-full-name)))
+ (sender-address (read-string "Sender address: "
+ LaTeX-letter-sender-address))
+ (recipient (read-string "Recipient: "))
+ (address (read-string "Recipient address: "))
+ (signature (read-string "Signature: "))
+ (opening (read-string "Opening: "))
+ (closing (read-string "Closing: "))
+ (date (read-string "Date: " (LaTeX-today))))
+
+ (insert TeX-esc "name" TeX-grop sender TeX-grcl)
+ (newline-and-indent)
+ (if (not (zerop (length sender-address)))
+ (progn
+ (setq LaTeX-letter-sender-address sender-address)
+ (insert TeX-esc "address" TeX-grop sender-address TeX-grcl)
+ (newline-and-indent)))
+ (if (not (zerop (length signature)))
+ (progn
+ (insert TeX-esc "signature" TeX-grop signature TeX-grcl)
+ (newline-and-indent)))
+ (if (not (zerop (length date)))
+ (progn
+ (insert TeX-esc "renewcommand" TeX-grop TeX-esc "today" TeX-grcl
+ TeX-grop date TeX-grcl)
+ (newline-and-indent)))
+ (newline-and-indent)
+
+ (let ((indentation (current-column)))
+ (LaTeX-insert-environment
+ environment
+ (concat TeX-grop recipient
+ (if (not (zerop (length address)))
+ (concat
+ (if (not (zerop (length recipient)))
+ (concat " " TeX-esc TeX-esc " "))
+ address))
+ TeX-grcl))
+ (save-excursion ; Fix indentation of address
+ (if (search-backward TeX-grcl nil 'move)
+ (let ((addr-end (point-marker)))
+ (if (search-backward TeX-grop nil 'move)
+ (let ((addr-column (current-column)))
+ (while (search-forward
+ (concat TeX-esc TeX-esc)
+ (marker-position addr-end) 'move)
+ (progn
+ (newline)
+ (indent-to addr-column))))))))
+ (insert "\n")
+ (indent-to indentation))
+ (insert TeX-esc "opening"
+ TeX-grop
+ (if (zerop (length opening))
+ (concat TeX-esc " ")
+ opening)
+ TeX-grcl "\n")
+
+ (indent-relative-maybe)
+ (save-excursion
+ (insert "\n" TeX-esc "closing"
+ TeX-grop
+ (if (zerop (length closing))
+ (concat TeX-esc " ")
+ closing)
+ TeX-grcl "\n")
+ (indent-relative-maybe))))
+
+(defun LaTeX-today nil
+ "Return a string representing todays date according to flavor."
+ (interactive)
+ (let ((ctime-string (current-time-string))
+ (month-alist '(("Jan". "01")
+ ("Feb" . "02")
+ ("Mar" . "03")
+ ("Apr" . "04")
+ ("May" . "05")
+ ("Jun" . "06")
+ ("Jul" . "07")
+ ("Aug" . "08")
+ ("Sep" . "09")
+ ("Oct" . "10")
+ ("Nov" . "11")
+ ("Dec" . "12"))))
+ (string-match
+ "^\\S-+\\s-+\\(\\S-+\\)\\s-+\\(\\S-+\\)\\s-+\\S-+\\s-+\\(\\S-+\\)"
+ ctime-string)
+ (let ((year (substring ctime-string (match-beginning 3) (match-end 3)))
+ (month (substring ctime-string (match-beginning 1) (match-end 1)))
+ (day (substring ctime-string (match-beginning 2) (match-end 2))))
+ (if (assoc month month-alist)
+ (progn
+ (setq month (cdr (assoc month month-alist)))
+ (if (> 2 (length day))
+ (setq day (concat "0" day)))))
+ (format "%s-%s-%s" year month day))))
+
+;;; letter.el ends here
diff --git a/tests/auctex-11.87.7/style/lettrine.el
b/tests/auctex-11.87.7/style/lettrine.el
new file mode 100644
index 0000000..f595c43
--- /dev/null
+++ b/tests/auctex-11.87.7/style/lettrine.el
@@ -0,0 +1,74 @@
+;;; lettrine.el --- AUCTeX style for `lettrine.sty'
+
+;; Copyright (C) 2011 Free Software Foundation, Inc.
+
+;; Author: Mads Jensen <mje@inducks.org>
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; This file adds support for `lettrine.sty'.
+
+;;; Code:
+
+(defvar LaTeX-lettrine-key-val-options
+ '(("lines")
+ ("lhang")
+ ("loversize")
+ ("lraise")
+ ("findent")
+ ("nindent")
+ ("slope")
+ ("ante")
+ ("image" ("true")))
+ "Key=value options for \\lettrine")
+
+(TeX-add-style-hook
+ "lettrine"
+ (lambda ()
+ (TeX-add-symbols
+ '("lettrine" [ TeX-arg-key-val LaTeX-lettrine-key-val-options ]
+ "Letter" "Text")
+ '("LettrineImageFalse" 0)
+ ;; all of the below can be configured with either \setlength or
+ ;; \renewcommand
+ '("LettrineFont" 0)
+ '("LettrineFontHook" 0)
+ '("LettrineTextFont" 0)
+ '("LettrineWidth" 0)
+ '("DefaultLhang" 0)
+ '("DefaultLoversize" 0)
+ '("DefaultLraise" 0)
+ '("DefaultFindent" 0)
+ '("DefaultNindent" 0)
+ '("DefaultSlope" 0)
+ ;; above settings can also be input a file, and pointed to with
+ ;; \renewcommand
+ '("DefaultOptionsFile" 0))
+
+ ;; Fontification
+ (when (and (fboundp 'font-latex-add-keywords)
+ (eq TeX-install-font-lock 'font-latex-setup))
+ (font-latex-add-keywords '(("lettrine" "[{{")) 'textual))))
+
+(defvar LaTeX-lettrine-package-options nil
+ "Package options for the lettrine package.")
+
+;;; lettrine.el ends here
diff --git a/tests/auctex-11.87.7/style/listings.el
b/tests/auctex-11.87.7/style/listings.el
new file mode 100644
index 0000000..cfb11e9
--- /dev/null
+++ b/tests/auctex-11.87.7/style/listings.el
@@ -0,0 +1,243 @@
+;;; listings.el --- AUCTeX style for `listings.sty'
+
+;; Copyright (C) 2004, 2005, 2009 Free Software Foundation, Inc.
+
+;; Author: Ralf Angeli <angeli@iwi.uni-sb.de>
+;; Maintainer: auctex-devel@gnu.org
+;; Created: 2004-10-17
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; This file adds support for `listings.sty'.
+;;
+;; FIXME: Please make me more sophisticated!
+
+;;; Code:
+
+;; The following are options taken from chapter 4 of the listings
+;; manual (2006/05/08 Version 1.3c). Experimental options described
+;; in chapter 5 are not included.
+(defvar LaTeX-listings-key-val-options
+ '(;; Space and placement
+ ("float" ("t" "b" "p" "h")) ; Support [*] as an optional prefix and that
+ ; tbph are not exclusive.
+ ("floatplacement" ("t" "b" "p" "h"))
+ ("aboveskip")
+ ("belowskip")
+ ("lineskip")
+ ("boxpos" ("b" "c" "t"))
+ ;; The printed range
+ ("print" ("true" "false"))
+ ("firstline")
+ ("lastline")
+ ("linerange")
+ ("showlines" ("true" "false"))
+ ("emptylines")
+ ("gobble")
+ ;; Languages and styles
+ ("style")
+ ("language")
+ ("alsolanguage")
+ ("defaultdialect")
+ ("printpod" ("true" "false"))
+ ("usekeywordsintag" ("true" "false"))
+ ("tagstyle")
+ ("markfirstintag")
+ ("makemacrouse" ("true" "false"))
+ ;; Figure out the appearance
+ ("basicstyle")
+ ("identifierstyle")
+ ("commentstyle")
+ ("stringstyle")
+ ("keywordstyle")
+ ("classoffset")
+ ("texcsstyle")
+ ("directivestyle")
+ ("emph")
+ ("moreemph")
+ ("deleteemph")
+ ("emphstyle")
+ ("delim")
+ ("moredelim")
+ ("deletedelim")
+ ;; Getting all characters right
+ ("extendedchars" ("true" "false"))
+ ("inputencoding") ; Could make use of `latex-inputenc-coding-alist'.
+ ("upquote" ("true" "false"))
+ ("tabsize")
+ ("showtabs" ("true" "false"))
+ ("tab")
+ ("showspaces" ("true" "false"))
+ ("showstringspaces" ("true" "false"))
+ ("formfeed")
+ ;; Line numbers
+ ("numbers" ("none" "left" "right"))
+ ("stepnumber")
+ ("numberfirstline" ("true" "false"))
+ ("numberstyle")
+ ("numbersep")
+ ("numberblanklines" ("true" "false"))
+ ("firstnumber" ("auto" "last")) ; Can also take a number.
+ ("name")
+ ;; Captions
+ ("title")
+ ("caption") ; Insert braces?
+ ("label")
+ ("nolol" ("true" "false"))
+ ("captionpos" ("t" "b")) ; Can be a subset of tb.
+ ("abovecaptionskip")
+ ("belowcaptionskip")
+ ;; Margins and line shape
+ ("linewidth")
+ ("xleftmargin")
+ ("xrightmargin")
+ ("resetmargins" ("true" "false"))
+ ("breaklines" ("true" "false"))
+ ("breakatwhitespace" ("true" "false"))
+ ("prebreak")
+ ("postbreak")
+ ("breakindent")
+ ("breakautoindent" ("true" "false"))
+ ;; Frames
+ ("frame" ("none" "leftline" "topline" "bottomline" "lines" "single"
+ "shadowbox"
+ ;; Alternative to the above values. A subset of trblTRBL can be
+ ;; given.
+ "t" "r" "b" "l" "T" "R" "B" "L"))
+ ("frameround" ("t" "f")) ; The input actually has to be four times {t,f}.
+ ("framesep")
+ ("rulesep")
+ ("framerule")
+ ("framexleftmargin")
+ ("framexrightmargin")
+ ("framextopmargin")
+ ("framebottommargin")
+ ("backgroundcolor")
+ ("rulecolor")
+ ("fillcolor")
+ ("fulesepcolor")
+ ("frameshape")
+ ;; Indexing
+ ("index")
+ ("moreindex")
+ ("deleteindex")
+ ("indexstyle")
+ ;; Column alignment
+ ("columns" ("fixed" "flexible" "fullflexible")) ; Also supports an optional
+ ; argument with {c,l,r}.
+ ("flexiblecolumns" ("true" "false"))
+ ("keepspaces" ("true" "false"))
+ ("basewidth")
+ ("fontadjust" ("true" "false"))
+ ;; Escaping to LaTeX
+ ("texcl" ("true" "false"))
+ ("mathescape" ("true" "false"))
+ ("escapechar")
+ ("escapeinside")
+ ("escapebegin")
+ ("escapeend")
+ ;; Interface to fancyvrb
+ ("fancyvrb" ("true" "false"))
+ ("fvcmdparams")
+ ("morefvcmdparams")
+ ;; Language definitions
+ ("keywordsprefix")
+ ("keywords")
+ ("morekeywords")
+ ("deletekeywords")
+ ("texcs")
+ ("moretexcs")
+ ("deletetexcs")
+ ("directives")
+ ("moredirectives")
+ ("deletedirectives")
+ ("sensitive" ("true" "false"))
+ ("alsoletter")
+ ("alsodigit")
+ ("alsoother")
+ ("otherkeywords")
+ ("tag")
+ ("string")
+ ("morestring")
+ ("deletestring")
+ ("comment")
+ ("morecomment")
+ ("deletecomment")
+ ("keywordcomment")
+ ("morekeywordcomment")
+ ("deletekeywordcomment")
+ ("keywordcommentsemicolon")
+ ("podcomment" ("true" "false")))
+ "Key=value options for listings macros and environments.")
+
+(TeX-add-style-hook
+ "listings"
+ (lambda ()
+ ;; New symbols
+ (TeX-add-symbols
+ '("lstalias" ["Alias dialect"] "Alias" ["Dialect"] "Language")
+ '("lstdefinestyle" "Style name"
+ (TeX-arg-key-val LaTeX-listings-key-val-options))
+ '("lstinline" TeX-arg-verb)
+ '("lstinputlisting" [TeX-arg-key-val LaTeX-listings-key-val-options]
+ TeX-arg-file)
+ "lstlistoflistings"
+ '("lstnewenvironment" "Name" ["Number or arguments"] ["Default argument"]
+ "Starting code" "Ending code")
+ '("lstset" (TeX-arg-key-val LaTeX-listings-key-val-options)))
+ ;; New environments
+ (LaTeX-add-environments
+ '("lstlisting" LaTeX-env-args
+ [TeX-arg-key-val LaTeX-listings-key-val-options]))
+ ;; Filling
+ (make-local-variable 'LaTeX-indent-environment-list)
+ (add-to-list 'LaTeX-indent-environment-list
+ '("lstlisting" current-indentation))
+ (make-local-variable 'LaTeX-verbatim-regexp)
+ (setq LaTeX-verbatim-regexp (concat LaTeX-verbatim-regexp "\\|lstlisting"))
+ (add-to-list 'LaTeX-verbatim-environments-local "lstlisting")
+ (add-to-list 'LaTeX-verbatim-macros-with-delims-local "lstinline")
+ (add-to-list 'LaTeX-verbatim-macros-with-braces-local "lstinline")
+ ;; Fontification
+ (when (and (fboundp 'font-latex-add-keywords)
+ (fboundp 'font-latex-set-syntactic-keywords)
+ (eq TeX-install-font-lock 'font-latex-setup))
+ (font-latex-add-keywords '(("lstnewenvironment" "{[[{{")) 'function)
+ (font-latex-add-keywords '(("lstinputlisting" "[{")) 'reference)
+ (font-latex-add-keywords '(("lstinline" "[{") ; The second argument should
+ ; actually be verbatim.
+ ("lstlistoflistings" ""))
+ 'textual)
+ (font-latex-add-keywords '(("lstalias" "{{")
+ ("lstdefinestyle" "{{")
+ ("lstset" "{"))
+ 'variable)
+ ;; For syntactic fontification, e.g. verbatim constructs.
+ (font-latex-set-syntactic-keywords)
+ ;; Tell font-lock about the update.
+ (setq font-lock-set-defaults nil)
+ (font-lock-set-defaults))))
+
+(defvar LaTeX-listings-package-options '("draft" "final" "savemem"
+ "noaspects")
+ "Package options for the listings package.")
+
+;;; listings.el ends here
diff --git a/tests/auctex-11.87.7/style/ltx-base.el
b/tests/auctex-11.87.7/style/ltx-base.el
new file mode 100644
index 0000000..27034a2
--- /dev/null
+++ b/tests/auctex-11.87.7/style/ltx-base.el
@@ -0,0 +1,86 @@
+;;; ltx-base.el --- AUCTeX style for basic LaTeX commands.
+
+;; Copyright (C) 2004 Free Software Foundation, Inc.
+
+;; Author: Frank K�ster <frank@kuesterei.ch>
+;; Maintainer: auctex-devel@gnu.org
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; This file adds general support for basic LaTeX commands used for
+;; writing LaTeX class files (.cls), style files (.sty) and package
+;; files (.dtx).
+
+;;; Code:
+
+(TeX-add-style-hook
+ "ltx-base"
+ (function
+ (lambda ()
+ (TeX-add-symbols
+ '("DeclareRobustCommand" TeX-arg-define-macro [ "Number of arguments" ] t)
+ '("CheckCommand" TeX-arg-define-macro [ "Number of arguments" ] t)
+ '("@addtoreset" TeX-arg-counter "Within counter" "counter")
+ '("addvspace" "space")
+ '("addpenalty" "penalty")
+ '("ProvidesClass" "name" [ "release information" ])
+ '("ProvidesPackage" "name" [ "release information" ])
+ '("ProvidesFile" "filename" [ "release information" ])
+ '("NeedsTeXFormat" "format" [ "release" ])
+ '("DeclareOption" "option" t)
+ ;; would be great if DeclareOption RET * RET would give
+ ;; \DeclareOption*!
+ "DeclareOption*"
+ '("CurrentOption" 0)
+ '("PassOptionsToPackage" "option list" "package")
+ '("ExecuteOptions" "option list")
+ "ProcessOptions"
+ "ProcessOptions*"
+ '("OptionNotUsed" 0)
+ ;; candidate for opt/mand toggling
+ '("RequirePackage" [ "option list" ] "package" [ "release" ])
+ '("LoadClass" [ "option list" ] "class" [ "release" ])
+ "AtEndOfPackage"
+ "AtEndOfClass"
+ "AtBeginDocument"
+ "AtEndDocument"
+ '("IfFileExists" "filename" 2)
+ '("InputIfFileExists" "filename" 2)
+ '("PackageWarning" "name" t)
+ '("PackageWarningNoLine" "name" t)
+ '("PackageInfo" "name" t)
+ '("PackageError" "name" "short text" t)
+ '("ClassWarning" "name" t)
+ '("ClassWarningNoLine" "name" t)
+ '("ClassInfo" "name" t)
+ '("ClassError" "name" "short text" t)
+ '("MessageBreak" 0)
+ '("@ifpackageloaded" "package" 2)
+ '("@ifpackagelater" "package" "date" 2)
+ '("@ifpackagewith" "package" "options" 2)
+ '("message" "Log Message")
+ '("@ifundefined" "Macro Name" 2)
+ '("@ifnextchar" (TeX-arg-literal " ") (TeX-arg-free "character") 2 )
+ "expandafter"))))
+
+;; Local Variables:
+;; coding: iso-8859-1
+;; End:
diff --git a/tests/auctex-11.87.7/style/ltxdoc.el
b/tests/auctex-11.87.7/style/ltxdoc.el
new file mode 100644
index 0000000..113e0df
--- /dev/null
+++ b/tests/auctex-11.87.7/style/ltxdoc.el
@@ -0,0 +1,40 @@
+;;; ltxdoc.el --- AUCTeX style for `ltxdoc.cls'
+
+;; Copyright (C) 2004 Free Software Foundation, Inc.
+
+;; Author: Frank K�ster <frank@kuesterei.ch>
+;; Maintainer: auctex-devel@gnu.org
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; This file adds support for `ltxdoc.cls'.
+
+;;; Code:
+
+(TeX-add-style-hook
+ "ltxdoc"
+ (lambda ()
+ (TeX-run-style-hooks "doc")
+ (TeX-run-style-hooks "ltx-base")))
+
+;; Local Variables:
+;; coding: iso-8859-1
+;; End:
diff --git a/tests/auctex-11.87.7/style/makeidx.el
b/tests/auctex-11.87.7/style/makeidx.el
new file mode 100644
index 0000000..3425e49
--- /dev/null
+++ b/tests/auctex-11.87.7/style/makeidx.el
@@ -0,0 +1,48 @@
+;;; makeidx.el --- AUCTeX support for makeidx.sty
+
+;; Copyright (C) 1999 Free Software Foundation, Inc.
+
+;; Author: Carsten Dominik <dominik@strw.leidenuniv.nl>
+;; Maintainer: auctex-devel@gnu.org
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Code:
+
+(TeX-add-style-hook "makeidx"
+ (lambda ()
+ (TeX-add-symbols
+ "printindex" "indexspace")
+
+ ;; Parsing the default index macro is defined in latex.el
+ ;; The same is true form completion in the index macro
+
+ ;; Completion for the |see macro
+ (setq TeX-complete-list
+ (append
+ '(("|see{\\([^{}\n\r]*\\)" 1 LaTeX-index-entry-list))
+ TeX-complete-list))
+
+ ;; RefTeX support
+ (and (fboundp 'reftex-add-index-macros)
+ (reftex-add-index-macros '(default)))))
+
+(defvar LaTeX-makeidx-package-options nil
+ "Package options for the makeidx package.")
+
+;;; makeidx.el ends here
diff --git a/tests/auctex-11.87.7/style/mdwlist.el
b/tests/auctex-11.87.7/style/mdwlist.el
new file mode 100644
index 0000000..2e2634d
--- /dev/null
+++ b/tests/auctex-11.87.7/style/mdwlist.el
@@ -0,0 +1,63 @@
+;;; mdwlist.el --- AUCTeX style for `mdwlist.sty'
+
+;; Copyright (C) 2004, 2005 Free Software Foundation, Inc.
+
+;; Maintainer: auctex-devel@gnu.org
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; This file adds support for `mdwlist.sty'.
+
+;;; Code:
+
+(TeX-add-style-hook
+ "mdwlist"
+ (lambda ()
+ (TeX-add-symbols
+ '("makecompactlist" "New environment" "Existing environment")
+ '("suspend" "Environment") ; this could be done nicer by automatically
+ '("resume" "Environment")) ; determining the environment
+ (LaTeX-add-environments
+ '("enumerate*" LaTeX-env-item)
+ '("itemize*" LaTeX-env-item)
+ '("description*" LaTeX-env-item))
+ ;; Indentation and filling
+ (make-local-variable 'LaTeX-begin-regexp)
+ (setq LaTeX-begin-regexp (concat LaTeX-begin-regexp "\\|resume\\b"))
+ (make-local-variable 'LaTeX-end-regexp)
+ (setq LaTeX-end-regexp (concat LaTeX-end-regexp "\\|suspend\\b"))
+ (make-local-variable 'paragraph-start)
+ (setq paragraph-start (concat paragraph-start
+ "\\|[ \t]*" TeX-comment-start-regexp "*[ \t]*"
+ (regexp-quote TeX-esc)
+ "\\(resume\\b\\|suspend\\b\\)"))
+ ;; Fontification
+ (when (and (featurep 'font-latex)
+ (eq TeX-install-font-lock 'font-latex-setup))
+ (font-latex-add-keywords '(("makecompactlist" "{{")
+ ("suspend" "[{")
+ ("resume" "[{["))
+ 'function))))
+
+(defvar LaTeX-mdwlist-package-options nil
+ "Package options for the mdwlist package.")
+
+;;; mdwlist.el ends here
diff --git a/tests/auctex-11.87.7/style/multicol.el
b/tests/auctex-11.87.7/style/multicol.el
new file mode 100644
index 0000000..5d73221
--- /dev/null
+++ b/tests/auctex-11.87.7/style/multicol.el
@@ -0,0 +1,62 @@
+;;; multicol.el --- AUCTeX style for `multicol.sty'
+
+;; Copyright (C) 2011 Free Software Foundation, Inc.
+
+;; Author: Mads Jensen <mje@inducks.org>
+;; Maintainer: auctex-devel@gnu.org
+;; Created: 2011-01-24
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; This file adds support for `multicol.sty'.
+
+;;; Code:
+
+(TeX-add-style-hook
+ "multicol"
+ (lambda ()
+ (LaTeX-add-environments
+ '("multicols" "Number of columns" [ "Text across columns" ]
+ [ "Local value for \\premulticols" ])
+ '("multicols*" "Number of columns" [ "Text across columns" ]
+ [ "Local value for \\premulticols" ]))
+
+ (TeX-add-symbols
+ '("multicoltolerance" 0)
+ '("multicolpretolerance" 0)
+ '("premulticols" 0)
+ '("postmulticols" 0)
+ '("multicolsep" 0)
+ '("multicolbaselineskip" 0)
+ '("multicolovershoot" 0)
+ '("multicolundershoot" 0)
+ '("columnsep" 0)
+ '("columnseprule" 0)
+ '("columnseprulecolor" 0)
+ '("raggedcolumns" 0)
+ '("flushcolumns" 0)
+ "columnbreak")))
+
+(defvar LaTeX-multicol-package-options
+ '("errorshow" "infoshow" "balancingshow" "markshow" "debugshow" "grid")
+ "Package options for the multicol package.")
+
+;;; multicol.el ends here
diff --git a/tests/auctex-11.87.7/style/multido.el
b/tests/auctex-11.87.7/style/multido.el
new file mode 100644
index 0000000..786185e
--- /dev/null
+++ b/tests/auctex-11.87.7/style/multido.el
@@ -0,0 +1,52 @@
+;;; multido.el --- AUCTeX style for `multido.sty'
+
+;; Copyright (C) 2007 Free Software Foundation, Inc.
+
+;; Author: Holger Sparr <holger.sparr@gmx.net>
+;; Created: 21 Jun 2007
+;; Based on: Jean-Philippe Georget's multido.el
+;; Keywords: latex, pstricks, auctex, emacs
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; This file adds support for `multido.sty'.
+
+;;; TODO:
+;;
+;; -- better argument support for multido
+;; -- parsing for fpAdd resp. fpSub
+
+;;; Code:
+
+(TeX-add-style-hook
+ "multido"
+ (function
+ (lambda ()
+ (TeX-add-symbols
+ '("multido" "\var=<start value>+-<inc>" "Repititions" t)
+ '("Multido" "\var=<start value>+-<inc>" "Repititions" t)
+ '("mmultido" "\var=<start value>+-<inc>" "Repititions" t)
+ '("MMultido" "\var=<start value>+-<inc>" "Repititions" t)
+ "multidostop"
+ "multidocount"
+ '("fpAdd" "Summand 1" "Summand 2" "Register")
+ '("fpSub" "Minuend" "Subtrahend" "Register")))))
+
+;;; multido.el ends here
diff --git a/tests/auctex-11.87.7/style/multind.el
b/tests/auctex-11.87.7/style/multind.el
new file mode 100644
index 0000000..45c710b
--- /dev/null
+++ b/tests/auctex-11.87.7/style/multind.el
@@ -0,0 +1,61 @@
+;;; multind.el --- AUCTeX support for multiple indices with multind.sty.
+
+;; Copyright (C) 1999 Free Software Foundation, Inc.
+
+;; Author: Carsten Dominik <dominik@strw.leidenuniv.nl>
+;; Maintainer: auctex-devel@gnu.org
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Code:
+
+(TeX-add-style-hook "multind"
+ (lambda ()
+
+ ;; Commands
+ (TeX-add-symbols
+ '("makeindex" "Indextag")
+ '("index" TeX-arg-index-tag TeX-arg-index)
+ '("printindex" TeX-arg-index-tag "Title")
+ "printindex" "indexspace")
+
+ ;; Parsing index macros
+ (setq LaTeX-auto-regexp-list
+ (append
+ ;; The first regexp is faster, but less accurate
+ ;; '(("\\\\index\\*?{[^{}]*}{\\([^}]*\\)" 1 LaTeX-auto-index-entry))
+ ;; The second regexp is very good, but slower
+
'(("\\\\index\\*?{[^{}]*}{\\([^}{]*\\({[^}{]*\\({[^}{]*\\({[^}{]*}[^}{]*\\)*}[^}{]*\\)*}[^}{]*\\)*\\)}"
+ 1 LaTeX-auto-index-entry))
+ LaTeX-auto-regexp-list))
+
+ ;; Completion for index entries in the |see and \index commands
+ (setq TeX-complete-list
+ (append
+ '(("\\\\index{[^{}]*}{\\([^{}\n\r]*\\)" 1 LaTeX-index-entry-list)
+ ("|see{\\([^}]*\\)" 1 LaTeX-index-entry-list))
+ TeX-complete-list))
+
+ ;; RefTeX support
+ (and (fboundp 'reftex-add-index-macros)
+ (reftex-add-index-macros '(multind)))))
+
+(defvar LaTeX-multind-package-options nil
+ "Package options for the multind package.")
+
+;;; multind.el ends here
diff --git a/tests/auctex-11.87.7/style/natbib.el
b/tests/auctex-11.87.7/style/natbib.el
new file mode 100644
index 0000000..bf9971e
--- /dev/null
+++ b/tests/auctex-11.87.7/style/natbib.el
@@ -0,0 +1,131 @@
+;;; natbib.el --- Style hook for the natbib package
+
+;; Copyright (C) 1997, 1998, 2004, 2007 Free Software Foundation, Inc.
+
+;; Authors: Berwin Turlach <statba@nus.edu.sg>
+;; Carsten Dominik <dominik@strw.leidenuniv.nl>
+;; Maintainer: auctex-devel@gnu.org
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Code:
+
+(TeX-add-style-hook "natbib"
+ (function
+ (lambda ()
+ ;; The number in the cdr of the following list indicates how many
+ ;; optional note arguments we consider useful. Prompting for those
+ ;; arguments will still depend upon `TeX-arg-cite-note-p'.
+ (let ((citecmds
+ '(("cite" . 0)
+ ("citet" . 1) ("citet*" . 1) ("citealt" . 1) ("citealt*" . 1)
+ ("citep" . 2) ("citep*" . 2) ("citealp" . 2) ("citealp*" . 2)
+ ("citeauthor" . 0) ("citeauthor*" . 0) ("citefullauthor" . 0)
+ ("citeyear" . 0) ("citeyearpar" . 0)
+ ("shortcites" . 0))))
+
+ ;; Add these symbols
+ (apply
+ 'TeX-add-symbols
+ (mapcar
+ (lambda (cmd)
+ (cond
+ ((= (cdr cmd) 0)
+ ;; No optional arguments
+ (list (car cmd) 'TeX-arg-cite))
+ ((= (cdr cmd) 1)
+ ;; Just one optional argument, the post note
+ (list
+ (car cmd)
+ '(TeX-arg-conditional TeX-arg-cite-note-p (["Post-note"]) nil)
+ 'TeX-arg-cite))
+ ((= (cdr cmd) 2)
+ ;; Pre and post notes
+ (list
+ (car cmd)
+ '(TeX-arg-conditional TeX-arg-cite-note-p (natbib-note-args) nil)
+ 'TeX-arg-cite))))
+ citecmds))
+
+ ;; Add the other symbols
+ (TeX-add-symbols
+ '("citetext" "Text")
+ '("bibpunct" ["Post note separator"]
+ "Opening bracket"
+ "Closing bracket"
+ "Punctuation between multiple citations"
+ "style [n]umeric [s]uperscript [a]uthor-year"
+ "Punctuation between author and year"
+ "Punctuation between years for common authors")
+ '("citestyle" "Style")
+ '("citeindextrue")
+ '("citeindexfalse")
+ '("citeindextype"))
+
+ ;; Make an entry in TeX-complete-list
+ (add-to-list
+ 'TeX-complete-list
+ (list
+ (concat "\\\\\\("
+ (mapconcat (lambda (x) (regexp-quote (car x)))
+ citecmds "\\|")
+
"\\)\\(\\[[^]\n\r\\%]*\\]\\)*{\\([^{}\n\r\\%,]*,\\)*\\([^{}\n\r\\%,]*\\)")
+ 4 'LaTeX-bibitem-list "}")))
+
+ ;; Fontification
+ (when (and (fboundp 'font-latex-add-keywords)
+ (eq TeX-install-font-lock 'font-latex-setup))
+ (font-latex-add-keywords '(("cite" "*[[{")
+ ("citet" "*[[{")
+ ("citealt" "*[[{")
+ ("citep" "*[[{")
+ ("citealp" "*[[{")
+ ("citeauthor" "*[[{")
+ ("citefullauthor" "[[{")
+ ("citeyear" "[[{")
+ ("citeyearpar" "[[{")
+ ("shortcites" "{"))
+ 'reference))
+
+ ;; Tell RefTeX
+ (if (fboundp 'reftex-set-cite-format)
+ (reftex-set-cite-format 'natbib)))))
+
+(defun natbib-note-args (optional &optional prompt definition)
+ "Prompt for two note arguments a natbib citation command."
+ (if TeX-arg-cite-note-p
+ (let* ((pre (read-string
+ (TeX-argument-prompt optional optional "Pre-note")))
+ (post (read-string
+ (TeX-argument-prompt optional optional "Post-note"))))
+ (if (not (string= pre "")) (insert "[" pre "]"))
+ (if (not (string= post ""))
+ (insert "[" post "]")
+ ;; Make sure that we have an empty post note if pre is not empty
+ (if (string= pre "") (insert "[]"))))))
+
+(defvar LaTeX-natbib-package-options '("numbers" "super" "authoryear"
+ "round" "square" "angle" "curly"
+ "comma" "colon" "nobibstyle"
+ "bibstyle" "openbib" "sectionbib"
+ "sort" "sort&compress"
+ "longnamesfirst" "nonamebreak")
+ "Package options for the natbib package.")
+
+;; natbib.el ends here
diff --git a/tests/auctex-11.87.7/style/naustrian.el
b/tests/auctex-11.87.7/style/naustrian.el
new file mode 100644
index 0000000..0eb1294
--- /dev/null
+++ b/tests/auctex-11.87.7/style/naustrian.el
@@ -0,0 +1,39 @@
+;;; naustrian.el --- AUCTeX style for the `naustrian' babel option.
+
+;; Copyright (C) 2009 Free Software Foundation, Inc.
+
+;; Author: Ralf Angeli <angeli@caeruleus.net>
+;; Maintainer: auctex-devel@gnu.org
+;; Created: 2009-12-28
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; Set up AUCTeX for editing Austrian text in connection with the
+;; `naustrian' babel option.
+
+;;; Code:
+
+(TeX-add-style-hook
+ "naustrian"
+ (lambda ()
+ (TeX-run-style-hooks "ngerman")))
+
+;;; naustrian.el ends here
diff --git a/tests/auctex-11.87.7/style/ngerman.el
b/tests/auctex-11.87.7/style/ngerman.el
new file mode 100644
index 0000000..8acd2f5
--- /dev/null
+++ b/tests/auctex-11.87.7/style/ngerman.el
@@ -0,0 +1,49 @@
+;;; ngerman.el --- Setup AUCTeX for editing German text.
+
+;;; Commentary:
+;;
+;; Cater for some specialities of `(n)german.sty', e.g. special quote
+;; and hyphen strings or that `"' makes the following letter an
+;; umlaut.
+
+;;; Code:
+
+(defvar LaTeX-german-mode-syntax-table
+ (copy-syntax-table LaTeX-mode-syntax-table)
+ "Syntax table used in LaTeX mode when using `german.sty'.")
+
+(modify-syntax-entry ?\" "w" LaTeX-german-mode-syntax-table)
+
+(TeX-add-style-hook
+ "ngerman"
+ (lambda ()
+ (set-syntax-table LaTeX-german-mode-syntax-table)
+ ;; XXX: Handle former customizations of the now defunct
+ ;; German-specific variables. References to the respective
+ ;; variables are to be deleted in future versions. (now = 2005-04-01)
+ (unless (eq (car TeX-quote-language) 'override)
+ (let ((open-quote (if (and (boundp 'LaTeX-german-open-quote)
+ LaTeX-german-open-quote)
+ LaTeX-german-open-quote
+ "\"`"))
+ (close-quote (if (and (boundp 'LaTeX-german-close-quote)
+ LaTeX-german-close-quote)
+ LaTeX-german-close-quote
+ "\"'"))
+ (q-after-q (if (and (boundp 'LaTeX-german-quote-after-quote)
+ LaTeX-german-quote-after-quote)
+ LaTeX-german-quote-after-quote
+ t)))
+ (setq TeX-quote-language
+ `("ngerman" ,open-quote ,close-quote ,q-after-q))))
+ (setq LaTeX-babel-hyphen-language "ngerman")
+ ;; Fontification
+ (when (and (eq TeX-install-font-lock 'font-latex-setup)
+ (featurep 'font-latex))
+ (font-latex-add-quotes '("\"`" "\"'"))
+ (font-latex-add-quotes '("\">" "\"<" german))
+ ;; Prevent "| from leading to color bleed.
+ (font-latex-add-to-syntax-alist (list (cons ?\" "\\"))))
+ (run-hooks 'TeX-language-de-hook)))
+
+;;; ngerman.el ends here
diff --git a/tests/auctex-11.87.7/style/nicefrac.el
b/tests/auctex-11.87.7/style/nicefrac.el
new file mode 100644
index 0000000..77aee51
--- /dev/null
+++ b/tests/auctex-11.87.7/style/nicefrac.el
@@ -0,0 +1,45 @@
+;;; nicefrac.el --- AUCTeX style for the LaTeX package `nicefrac.sty' (v0.9b)
+
+;; Copyright (C) 2004, 2005 Free Software Foundation, Inc.
+
+;; Author: Christian Schlauer <cschl@arcor.de>
+;; Maintainer: auctex-devel@gnu.org
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; This file adds support for `nicefrac.sty'.
+
+;;; Code:
+
+(TeX-add-style-hook
+ "nicefrac"
+ (lambda ()
+ (TeX-add-symbols
+ '("nicefrac" [ "Font changing command" ] "Numerator" "Denominator"))
+ ;; Fontification
+ (when (and (featurep 'font-latex)
+ (eq TeX-install-font-lock 'font-latex-setup))
+ (font-latex-add-keywords '(("nicefrac" "[{{")) 'textual))))
+
+(defvar LaTeX-nicefrac-package-options '("nice" "ugly")
+ "Package options for the nicefrac package.")
+
+;;; nicefrac.el ends here
diff --git a/tests/auctex-11.87.7/style/nomencl.el
b/tests/auctex-11.87.7/style/nomencl.el
new file mode 100644
index 0000000..3b04d7b
--- /dev/null
+++ b/tests/auctex-11.87.7/style/nomencl.el
@@ -0,0 +1,70 @@
+;;; nomencl.el --- AUCTeX style for the nomencl class.
+
+;; Copyright (C) 2007 Free Software Foundation, Inc.
+
+;; Author: Ralf Angeli <angeli@caeruleus.net>
+;; Maintainer: auctex-devel@gnu.org
+;; Created: 2007-10-09
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; This file adds support for the nomencl package.
+
+;;; Code:
+
+(defvar LaTeX-nomencl-package-options
+ '("refeq" "norefeq" "refpage" "norefpage" "prefix" "noprefix" "cfg" "nocfg"
+ "intoc" "notintoq" "compatible" "noncompatible" "croatian" "danish"
+ "english" "french" "german" "italian" "polish" "portuguese" "russian"
+ "spanish" "ukrainian")
+ "Package options for the nomencl package.")
+
+(TeX-add-style-hook
+ "nomencl"
+ (lambda ()
+ (TeX-add-symbols
+ '("makenomenclature" 0)
+ '("printnomenclature" ["Label width"])
+ '("nomenclature" ["Prefix"] "Symbol" "Description")
+ "nomrefeq"
+ "nomrefpage"
+ "nomrefeqpage"
+ "nomnorefeq"
+ "nomnorefpage"
+ "nomnorefeqpage"
+ '("nomlabelwidth" 0)
+ '("nomname" 0)
+ '("nomgroup" 0)
+ '("nompreamble" 0)
+ '("nompostamble" 0)
+ '("nomitemsep" 0)
+ '("nomprefix" 0)
+ '("nomlabel" 0)
+ '("nomentryend" 0)
+ '("eqdeclaration" 0)
+ '("pagedeclaration" 0))
+ ;; Fontification
+ (when (and (featurep 'font-latex)
+ (eq TeX-install-font-lock 'font-latex-setup))
+ (font-latex-add-keywords '(("nomenclature" "[{{"))
+ 'reference))))
+
+;;; nomencl.el ends here
diff --git a/tests/auctex-11.87.7/style/paralist.el
b/tests/auctex-11.87.7/style/paralist.el
new file mode 100644
index 0000000..a004d3c
--- /dev/null
+++ b/tests/auctex-11.87.7/style/paralist.el
@@ -0,0 +1,104 @@
+;;; paralist.el -- AUCTeX style for paralist.sty
+
+;; Copyright (C) 2003, 2004, 2005 Free Software Foundation, Inc.
+
+;; Author: Ralf Angeli <angeli@iwi.uni-sb.de>
+;; Maintainer: auctex-devel@gnu.org
+;; Created: 2003-10-22
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; This file adds support for `paralist.sty'.
+
+;;; Code:
+
+;; Insert an itemize-ish environment and ask for an optional label
+(defun LaTeX-paralist-env-item-opt-label (environment)
+ "Insert ENVIRONMENT, an optional label and the first item."
+ (LaTeX-insert-environment
+ environment
+ (let ((label (read-string "(Optional) Label: ")))
+ (concat (unless (zerop (length label))
+ (format "[%s]" label)))))
+ (LaTeX-find-matching-begin)
+ (end-of-line 1)
+ (delete-char 1)
+ (delete-horizontal-space)
+ (LaTeX-insert-item))
+
+(TeX-add-style-hook
+ "paralist"
+ (lambda ()
+
+ ;; Add compactdesc to the list of environments which have an optional
+ ;; argument for each item.
+ (add-to-list 'LaTeX-item-list '("compactdesc" . LaTeX-item-argument))
+
+ ;; New symbols
+ (TeX-add-symbols
+ '("pointedenum")
+ '("pointlessenum")
+ '("paradescriptionlabel")
+ '("setdefaultitem" "First level" "Second level" "Third level"
+ "Fourth level")
+ '("setdefaultenum" "First level" "Second level" "Third level"
+ "Fourth level")
+ '("setdefaultleftmargin" "First level" "Second level" "Third level"
+ "Fourth level" "Fifth level" "Sixth level"))
+
+ ;; New environments
+ (LaTeX-add-environments
+ '("asparaenum" LaTeX-paralist-env-item-opt-label)
+ '("inparaenum" LaTeX-paralist-env-item-opt-label)
+ '("compactenum" LaTeX-paralist-env-item-opt-label)
+ '("asparaitem" LaTeX-paralist-env-item-opt-label)
+ '("inparaitem" LaTeX-paralist-env-item-opt-label)
+ '("compactitem" LaTeX-paralist-env-item-opt-label)
+ '("compactdesc" LaTeX-env-item)
+ ;; FIXME: Should not be available if package is loaded with option
+ ;; `olditem':
+ '("itemize" LaTeX-paralist-env-item-opt-label)
+ ;; FIXME: Should not be available if package is loaded with option
+ ;; `oldenum':
+ '("enumerate" LaTeX-paralist-env-item-opt-label)
+ ;; FIXME: Only defined if package is loaded with option
+ ;; `defblank':
+ '("asparablank" LaTeX-env-item)
+ '("inparablank" LaTeX-env-item))
+
+ ;; Fontification
+ (when (and (featurep 'font-latex)
+ (eq TeX-install-font-lock 'font-latex-setup))
+ (font-latex-add-keywords '(("setdefaultitem" "{{{{")
+ ("setdefaultenum" "{{{{")
+ ("setdefaultleftmargin" "{{{{{{"))
+ 'variable))))
+
+(defvar LaTeX-paralist-package-options '("newitem" "olditem" "newenum"
+ "oldenum" "alwaysadjust"
+ "neveradjust" "neverdecrease"
+ "increaseonly" "defblank"
+ "pointedenum" "pointlessenum"
+ "cfg" "nocfg" "flushright"
+ "flushleft")
+ "Package options for the paralist package.")
+
+;;; paralist.el ends here
diff --git a/tests/auctex-11.87.7/style/pdfsync.el
b/tests/auctex-11.87.7/style/pdfsync.el
new file mode 100644
index 0000000..a366fd7
--- /dev/null
+++ b/tests/auctex-11.87.7/style/pdfsync.el
@@ -0,0 +1,91 @@
+;;; pdfsync.el --- AUCTeX style for `pdfsync.sty'
+
+;; Copyright (C) 2005, 2008 Free Software Foundation, Inc.
+
+;; Author: Ralf Angeli <angeli@iwi.uni-sb.de>
+;; Maintainer: auctex-devel@gnu.org
+;; Created: 2005-12-28
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; This file adds support for `pdfsync.sty'.
+
+;;; Code:
+
+(defun LaTeX-pdfsync-output-page ()
+ "Return page number in output file corresponding to buffer position."
+ (let* ((line (TeX-line-number-at-pos))
+ (master (TeX-active-master))
+ (file (file-name-sans-extension
+ (file-relative-name (buffer-file-name)
+ (file-name-directory master))))
+ (pdfsync-file (concat master ".pdfsync"))
+ (buf-live-p (get-file-buffer pdfsync-file))
+ (sync-record "0")
+ (sync-line "-1")
+ (sync-page "1")
+ last-match)
+ (when (file-exists-p pdfsync-file)
+ (with-current-buffer (find-file-noselect pdfsync-file)
+ (save-restriction
+ (goto-char (point-min))
+ ;; Narrow region to file in question.
+ (when (not (string= file master))
+ (re-search-forward (concat "^(" file "\\(.tex\\)?$") nil t)
+ (let ((beg (match-beginning 0)))
+ (goto-char beg)
+ (narrow-to-region (line-beginning-position 2)
+ (progn (forward-sexp) (point))))
+ (goto-char (point-min)))
+ ;; Look for the record number.
+ (catch 'break
+ (while (re-search-forward "^(\\|^l \\([0-9]+\\) \\([0-9]+\\)" nil t)
+ (cond ((string= (match-string 0) "(")
+ (goto-char (match-beginning 0))
+ (forward-sexp))
+ ((> (string-to-number (match-string 2)) line)
+ (throw 'break nil))
+ (t
+ (setq sync-record (match-string 1)
+ sync-line (match-string 2)
+ last-match (match-beginning 0))))))
+ ;; Look for the page number.
+ (goto-char (or last-match (point-min)))
+ ;; There might not be any p or s lines for the current file,
+ ;; so make it possible to search further.
+ (widen)
+ (catch 'break
+ (while (re-search-forward "^p \\([0-9]+\\)" nil t)
+ (when (>= (string-to-number (match-string 1))
+ (string-to-number sync-record))
+ (re-search-backward "^s \\([0-9]+\\)" nil t)
+ (setq sync-page (match-string 1))
+ (throw 'break nil)))))
+ ;; Kill the buffer if it was loaded by us.
+ (unless buf-live-p (kill-buffer (current-buffer)))))
+ sync-page))
+
+(TeX-add-style-hook
+ "pdfsync"
+ (lambda ()
+ (setq TeX-source-correlate-output-page-function
'LaTeX-pdfsync-output-page)))
+
+;;; pdfsync.el ends here
diff --git a/tests/auctex-11.87.7/style/plfonts.el
b/tests/auctex-11.87.7/style/plfonts.el
new file mode 100644
index 0000000..809017c
--- /dev/null
+++ b/tests/auctex-11.87.7/style/plfonts.el
@@ -0,0 +1,31 @@
+;;; plfonts.el - Setup AUC TeX for editing Polish text with plfonts.sty
+
+;; $Id: plfonts.el,v 1.1 1994-01-30 21:17:25 amanda Exp $
+
+;;; Commentary:
+;;
+;; `plfonts.sty' use `"' to make next character Polish.
+;; `plfonts.sty' <C> L. Holenderski, IIUW, lhol@mimuw.edu.pl
+
+;;; Code:
+
+(defvar LaTeX-plfonts-mode-syntax-table
+ (copy-syntax-table LaTeX-mode-syntax-table)
+ "Syntax table used in LaTeX mode when using `plfonts.sty'.")
+
+(modify-syntax-entry ?\" "w" LaTeX-plfonts-mode-syntax-table)
+
+(TeX-add-style-hook "plfonts"
+ (function (lambda ()
+ (set-syntax-table LaTeX-plfonts-mode-syntax-table)
+ (make-local-variable 'TeX-open-quote)
+ (make-local-variable 'TeX-close-quote)
+ (make-local-variable 'TeX-quote-after-quote)
+ (make-local-variable 'TeX-command-default)
+ (setq TeX-open-quote "\"<")
+ (setq TeX-close-quote "\">")
+ (setq TeX-quote-after-quote t)
+ (setq TeX-command-default "plLaTeX")
+ (run-hooks 'TeX-language-pl-hook))))
+
+;;; plfonts.el ends here
diff --git a/tests/auctex-11.87.7/style/plhb.el
b/tests/auctex-11.87.7/style/plhb.el
new file mode 100644
index 0000000..7d0749b
--- /dev/null
+++ b/tests/auctex-11.87.7/style/plhb.el
@@ -0,0 +1,31 @@
+;;; plhb.el - Setup AUC TeX for editing Polish text with plhb.sty
+
+;; $Id: plhb.el,v 1.1 1994-01-30 21:17:27 amanda Exp $
+
+;;; Commentary:
+;;
+;; `plhb.sty' use `"' to make next character Polish.
+;; `plhb.sty' <C> J. S. Bie\'n, IIUW, jsbien@mimuw.edu.pl
+
+;;; Code:
+
+(defvar LaTeX-plhb-mode-syntax-table
+ (copy-syntax-table LaTeX-mode-syntax-table)
+ "Syntax table used in LaTeX mode when using `plhb.sty'.")
+
+(modify-syntax-entry ?\" "w" LaTeX-plhb-mode-syntax-table)
+
+(TeX-add-style-hook "plhb"
+ (function (lambda ()
+ (set-syntax-table LaTeX-plhb-mode-syntax-table)
+ (make-local-variable 'TeX-open-quote)
+ (make-local-variable 'TeX-close-quote)
+ (make-local-variable 'TeX-command-default)
+ (make-local-variable 'TeX-quote-after-quote)
+ (setq TeX-open-quote "\"<")
+ (setq TeX-close-quote "\">")
+ (setq TeX-quote-after-quote t)
+ (setq TeX-command-default "plLaTeX")
+ (run-hooks 'TeX-language-pl-hook))))
+
+;;; plhb.el ends here
diff --git a/tests/auctex-11.87.7/style/polish.el
b/tests/auctex-11.87.7/style/polish.el
new file mode 100644
index 0000000..1538f9c
--- /dev/null
+++ b/tests/auctex-11.87.7/style/polish.el
@@ -0,0 +1,52 @@
+;;; polish.el --- AUCTeX style for the `polish' babel option.
+
+;; Copyright (C) 2007 Free Software Foundation, Inc.
+
+;; Author: Ralf Angeli <angeli@caeruleus.net>
+;; Maintainer: auctex-devel@gnu.org
+;; Created: 2007-01-08
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; Set up AUCTeX for editing Polish text in connection with the
+;; `polish' babel option.
+
+;;; Code:
+
+(defvar LaTeX-polish-mode-syntax-table
+ (copy-syntax-table LaTeX-mode-syntax-table)
+ "Syntax table used in LaTeX mode when using `polish.sty'.")
+
+(modify-syntax-entry ?\" "w" LaTeX-polish-mode-syntax-table)
+
+(TeX-add-style-hook
+ "polish"
+ (lambda ()
+ (set-syntax-table LaTeX-polish-mode-syntax-table)
+ (unless (eq (car TeX-quote-language) 'override)
+ (setq TeX-quote-language '("polish" "\"`" "\"'" t)))
+ ;; Fontification of quotation marks.
+ (when (fboundp 'font-latex-add-quotes)
+ (font-latex-add-quotes '("\"`" "\"'"))
+ (font-latex-add-quotes '("\"<" "\">" french)))
+ (run-hooks 'TeX-language-pl-hook)))
+
+;;; polish.el ends here
diff --git a/tests/auctex-11.87.7/style/polski.el
b/tests/auctex-11.87.7/style/polski.el
new file mode 100644
index 0000000..7b6fcfc
--- /dev/null
+++ b/tests/auctex-11.87.7/style/polski.el
@@ -0,0 +1,55 @@
+;;; polski.el --- AUCTeX style for `polski.sty'.
+
+;; Copyright (C) 2007 Free Software Foundation, Inc.
+
+;; Author: Ralf Angeli <angeli@caeruleus.net>
+;; Maintainer: auctex-devel@gnu.org
+;; Created: 2007-01-11
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; Set up AUCTeX for editing Polish text in connection with
+;; `polski.sty'.
+
+;;; Code:
+
+(defvar LaTeX-polski-package-options
+ '("plmath" "nomathsymbols" "MeX" "T1" "QX" "OT1" "OT4" "prefixinginverb"
+ "noprefixinginverb" "roku" "r." "noroku")
+ "Package options for polski.sty.")
+
+(TeX-add-style-hook
+ "polski"
+ (lambda ()
+ (TeX-add-symbols
+ ;; Dashes
+ "dywiz"
+ "pauza"
+ "ppauza")
+ ;; Quotation marks
+ (unless (eq (car TeX-quote-language) 'override)
+ (setq TeX-quote-language '("polski" ",," "''" t)))
+ ;; Fontification of quotation marks.
+ (when (fboundp 'font-latex-add-quotes)
+ (font-latex-add-quotes '(",," "''")))
+ (run-hooks 'TeX-language-pl-hook)))
+
+;;; polski.el ends here
diff --git a/tests/auctex-11.87.7/style/prosper.el
b/tests/auctex-11.87.7/style/prosper.el
new file mode 100644
index 0000000..b0939c7
--- /dev/null
+++ b/tests/auctex-11.87.7/style/prosper.el
@@ -0,0 +1,192 @@
+;;; prosper.el --- Prosper style file for AUCTeX
+
+;; Copyright (C) 2001, 2002 Free Software Foundation, Inc.
+
+;; Authors: Phillip Lord<p.lord@russet.org.uk>
+;; Nevin Kapur <nevin@jhu.edu>
+;; Keywords: tex, wp, prosper
+;; Version: 0.6
+;; URL: http://www.mts.jhu.edu/~kapur/emacs/prosper.el
+
+;; This 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.
+
+;;; Commentary:
+
+;; This is a propser (http://prosper.sourceforge.net/) style file for
+;; AUCTeX.
+
+;;; Installation:
+;;
+;; For this file to work you need to have a working installation of
+;; AucTeX. After that installtion is simple. Put this file into one of
+;; the directories specified in `TeX-style-path', with the name
+;; "style" rather than "auto" as it might get over written in the
+;; latter.
+;;
+;; Then stick the current for into your .emacs
+;; (eval-after-load "latex"
+;; '(add-to-list 'LaTeX-style-list '("prosper")))
+;;
+;;
+;; And that should be it. You check whether it's worked or not by
+;; opening a prosper document, and trying `LaTeX-environment'. "slide"
+;; should be available by tab completion and it should ask you about
+;; overlays.
+;;
+;; The environment "prosper" should be inserted immediately after the
+;; document environment. It will prompt you for options available
+;; under prosper and create a skeleton document.
+
+;;; Bugs:
+;;
+;; Currently the documentclass expansion doesn't work, unless you
+;; enter a documentclass line to let auctex know which style files to
+;; load. Then delete this and do it again. Not good. I know no way
+;; around this.
+
+;;; Code:
+
+;; Constants:
+
+
+;;;; This is partly working now, and it a little neater than it
+;;;; was. The main problem is that the redefinition of "documentclass"
+;;;; does not happen until its all too late, so that stuff never
+;;;; happens correctly. This is easy enough to fix by fiddling with
+;;;; auctex. I shall have to download the latest version, and see if
+;;;; its already been fixed.
+
+
+
+(defconst LaTeX-prosper-version
+ "$Id: prosper.el,v 1.5 2008-05-25 06:50:33 angeli Exp $"
+ "prosper.el version.")
+
+(defconst LaTeX-prosper-transition-styles '("Split"
+ "Blinds"
+ "Box"
+ "Wipe"
+ "Dissolve"
+ "Glitter"
+ "Replace")
+ "List of transition styles provided by prosper.")
+
+(defconst LaTeX-prosper-slide-styles
+ '("alienglow" "autumn" "azure"
+ "contemporain" "darkblue" "default" "frames"
+ "lignesbleues" "nuancegris" "troispoints"
+ "alcatel" "gyom" "pascal" "rico"
+ ))
+
+(defun LaTeX-prosper-insert-title (optional)
+ (newline)
+ (mapc (lambda(f)
+ (TeX-insert-macro f)
+ (newline))
+ '("title" "subtitle" "author" "email" "institution" "slideCaption"
+ "Logo" "DefaultTransition"))
+ (LaTeX-insert-environment "document")
+ (TeX-insert-macro "maketitle"))
+
+
+;; Utility functions
+(defun LaTeX-prosper-arg-pdftransition (environment)
+ (let ((default
+ (if (boundp 'LaTeX-prosper-transition-history)
+ (car LaTeX-prosper-transition-history)
+ "Replace")))
+ (TeX-argument-insert
+ (completing-read
+ (TeX-argument-prompt nil
+ (format "Transition (Default %s) " default)
+ t)
+ (mapcar 'list LaTeX-prosper-transition-styles)
+ nil
+ t
+ nil
+ 'LaTeX-prosper-transition-history
+ default)
+ nil)))
+
+(defun LaTeX-prosper-slide-style-prompt()
+ (completing-read
+ "Slide Style?"
+ (mapcar 'list LaTeX-prosper-slide-styles)
+ nil nil nil nil "default" ))
+
+
+(defun LaTeX-prosper-insert-options(environment)
+ (insert "[" )
+ (insert (LaTeX-prosper-slide-style-prompt) " ")
+ (mapc (lambda(f)
+ (if (y-or-n-p (car f))
+ (insert (car (cdr f)) " ")))
+ '(("Draft?" "draft")
+ ("Color Slides?" "slideColor")
+ ("Disable running total on each slide?" "nototal")
+ ("Is the final version going to be PDF?" "pdf")
+ ("Are you going to use Adobe Distiller" "distiller")))
+ (delete-char -1)
+ (insert "]"))
+
+(defun LaTeX-prosper-insert-slide (environment)
+ (if (y-or-n-p "Surround with overlay ?")
+ (progn (TeX-insert-macro "overlays")
+ (if (search-backward "{" 0 t)
+ (progn
+ (goto-char (+ 1 (point)))
+ (insert "%\n")))))
+ (let ((title (read-string "Title: ")))
+ (LaTeX-insert-environment "slide" (concat TeX-grop title TeX-grcl))))
+
+
+
+;; AUCTeX configuration
+(TeX-add-style-hook "prosper"
+ (function
+ (lambda ()
+ (LaTeX-add-environments
+ '("slide" LaTeX-prosper-insert-slide)
+ '("itemstep" LaTeX-env-item)
+ '("Itemize" LaTeX-env-item))
+ (TeX-add-symbols
+ '("documentclass"
+ LaTeX-prosper-insert-options
+ LaTeX-prosper-insert-title)
+ '("title" "Title of the presentation")
+ '("subtitle" "Subtitle of the presentation")
+ '("author" "Author name")
+ '("email" "Author email")
+ '("institution" "Author institution")
+ '("slideCaption" "Caption for slide")
+ '("Logo" "Logo")
+ '("displayVersion" TeX-arg-free)
+ '("DefaultTransition"
+ LaTeX-prosper-arg-pdftransition)
+ '("NoFrenchBabelItemize" TeX-arg-free)
+ '("part" LaTeX-prosper-arg-part)
+ '("overlays" "Number of overlays" t)
+ '("FontTitle" "Color slides" "Black & White Slides")
+ '("FontText" "Color slides" "Black & White Slides")
+ '("fontTitle" "Text")
+ '("fontText" "Text")
+ '("ColorFoot" "Color")
+ '("PDFtransition" LaTeX-prosper-arg-pdftransition)
+ '("myitem" "Level" "Definition")
+ '("fromSlide" "Number" t)
+ '("fromSlide*" "Number" t)
+ '("onlySlide" "Number" t)
+ '("onlySlide*" "Number" t)
+ '("OnlySlide" "Number")
+ '("UntilSlide" "Number")
+ '("untilSlide*" "Number")
+ '("PDForPS" TeX-arg-conditional)
+ '("onlyInPS" t)
+ '("onlyInPDF" t)
+ '("FromSlide" "Number")))))
+
+
+;;; prosper.el ends here
diff --git a/tests/auctex-11.87.7/style/psfig.el
b/tests/auctex-11.87.7/style/psfig.el
new file mode 100644
index 0000000..16df7cf
--- /dev/null
+++ b/tests/auctex-11.87.7/style/psfig.el
@@ -0,0 +1,81 @@
+;;; psfig.el - Support for the psfig style option.
+
+;; Copyright (C) 2013 Free Software Foundation, Inc.
+
+;; Contributed by Marc Gemis <makke@wins.uia.ac.be>
+;; Please direct comments to him.
+
+;;; Code:
+
+(TeX-add-style-hook "psfig"
+ (function
+ (lambda ()
+ ;; probable some of the following symbols may be removed
+ (TeX-add-symbols "protect" "figurepath" "fbox"
+ "other" "letter" "other" "then" "Sine" "Cosine"
+ "psdraft" "psfull" "psscalefirst" "psrotatefirst"
+ "psnodraftbox" "psdraftbox" "pssilent" "psnoisy"
+ "minmaxtest"
+ '("psfig" TeX-arg-psfig)
+ '("psfigurepath" t)
+ )
+ (LaTeX-add-environments
+ '("psfigure" LaTeX-env-psfigure)
+ )
+ )))
+
+(defun TeX-arg-psfig (optional)
+ "Ask for file, width and length. Insert psfig macro"
+ (let ((psfile (read-file-name "PS-file: " "" "" nil))
+ (figwidth (read-string "Figure width: "))
+ (figheight (read-string "Figure height: "))
+ )
+
+ (insert TeX-grop "figure=" psfile)
+ (if (not (zerop (length figwidth)))
+ (insert ",width=" figwidth))
+ (if (not (zerop (length figheight)))
+ (insert ",height=" figheight))
+ (insert TeX-grcl)
+ )
+ )
+
+
+(defun LaTeX-env-psfigure (environment)
+ "Create with \\label and \\caption and \\psfig commands."
+ (let ((float (read-string "Float to: " LaTeX-float))
+ (caption (read-string "Caption: "))
+ (label (read-string "Label: " LaTeX-figure-label))
+ ; gf: ask if this should be centered
+ (psfile (read-file-name "PS-file: " "" "" nil))
+ (figwidth (read-string "Figure width: "))
+ (figheight (read-string "Figure height: "))
+ )
+
+ (setq LaTeX-float (if (zerop (length float))
+ LaTeX-float
+ float))
+
+ (LaTeX-insert-environment "figure"
+ (concat LaTeX-optop LaTeX-float LaTeX-optcl))
+
+ (insert TeX-esc "centerline" TeX-grop TeX-esc "psfig" TeX-grop
+ "figure=" psfile)
+ (if (not (zerop (length figwidth)))
+ (insert ",width=" figwidth))
+ (if (not (zerop (length figheight)))
+ (insert ",height=" figheight))
+ (insert TeX-grcl TeX-grcl)
+ (if (zerop (length caption))
+ ()
+ (newline-and-indent)
+ (insert TeX-esc "caption" TeX-grop caption TeX-grcl))
+ (if (or (zerop (length label))
+ (equal LaTeX-figure-label label))
+ ()
+ (newline-and-indent)
+ (insert TeX-esc "label" TeX-grop label TeX-grcl))
+
+ (forward-line 2)))
+
+;;; psfig.el ends here
diff --git a/tests/auctex-11.87.7/style/pst-grad.el
b/tests/auctex-11.87.7/style/pst-grad.el
new file mode 100644
index 0000000..b177561
--- /dev/null
+++ b/tests/auctex-11.87.7/style/pst-grad.el
@@ -0,0 +1,65 @@
+;;; pst-grad.el --- AUCTeX style for `pst-grad.sty'
+
+;; Copyright (C) 2007 Free Software Foundation, Inc.
+
+;; Author: Holger Sparr <holger.sparr@gmx.net>
+;; Created: 21 Jun 2007
+;; Keywords: latex, pstricks, auctex, emacs
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; This file adds support for `pst-grad.sty'.
+
+;;; TODO:
+;;
+;; --
+
+;;; Code:
+
+;;; Parameters
+(defvar LaTeX-pstgrad-parameters-name-list
+ '("gradangle" "gradbegin" "gradend" "gradlines" "gradmidpoint"
+ "gradientHSB" "GradientCircle" "GradientPos" "GradientScale")
+ "A list of parameter names in pst-grad.")
+
+;;; Aliases
+(defvaralias 'LaTeX-pst-gradbegin-list 'LaTeX-pst-color-list)
+(defvaralias 'LaTeX-pst-gradend-list 'LaTeX-pst-color-list)
+
+;;; Hook
+(TeX-add-style-hook
+ "pst-grad"
+ (function
+ (lambda ()
+ (TeX-run-style-hooks
+ "pstricks")
+ (unless (member "gradient" LaTeX-pst-fillstyle-list)
+ (setq LaTeX-pst-fillstyle-list (append LaTeX-pst-fillstyle-list
+ '("gradient")))
+ (setq LaTeX-pst-parameters-completion-regexp
+ (concat
+ (substring LaTeX-pst-parameters-completion-regexp 0 -2)
+ "\\|gradbegin\\|gradend\\)")))
+ (make-local-variable 'LaTeX-pst-parameters-name-list)
+ (setq LaTeX-pst-parameters-name-list
+ (append LaTeX-pstgrad-parameters-name-list
+ LaTeX-pst-parameters-name-list)))))
+
+;;; pst-grad.el ends here
diff --git a/tests/auctex-11.87.7/style/pst-node.el
b/tests/auctex-11.87.7/style/pst-node.el
new file mode 100644
index 0000000..d5ff274
--- /dev/null
+++ b/tests/auctex-11.87.7/style/pst-node.el
@@ -0,0 +1,191 @@
+;;; pst-node.el --- AUCTeX style for `pst-node.sty'
+
+;; Copyright (C) 2007 Free Software Foundation, Inc.
+
+;; Author: Holger Sparr <holger.sparr@gmx.net>
+;; Created: 21 Jun 2007
+;; Based on: Jean-Philippe Georget's pst-plot.el
+;; Keywords: latex, pstricks, auctex, emacs
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; This file adds support for `pst-node.sty'.
+
+;;; TODO:
+;;
+;; -- self parsing of possible node names
+;; -- adding more macro support
+
+;;; Code:
+
+(defalias 'LaTeX-pst-node 'LaTeX-pst-point)
+
+(defvar LaTeX-pstnode-parameters-completion-regexp
+ "\\(npos\\|nrot\\)"
+ "Regexp for `string-match'ing a parameter.")
+
+(defvar LaTeX-pstnode-parameters-boolean-regexp "show\\([a-zA-Z]+\\)"
+ "Regexp for `string-match'ing a parameter.")
+
+(defvar LaTeX-pstnode-npos-list '(".25" ".5" ".75" "1" "1.5" "2")
+ "A list of values for npos in nput.")
+
+(defvar LaTeX-pstnode-nrot-list '(":U" ":D" ":R" ":L")
+ "A list of values for nrot in nput.")
+
+(defvar LaTeX-pstnode-psmatrix-list
+ '("mnode" "emnode" "name" "nodealign" "mocl" "rowsep" "colsep"
+ "mnodesize")
+ "A list of values for trimode in pstribox.")
+
+;;; Parameters
+(defvar LaTeX-pstnode-parameters-history nil
+ "History of values for parameters in pst-node.")
+
+(defvar LaTeX-pstnode-parameters-value-history nil
+ "History of parameter values in pst-node.")
+
+(defvar LaTeX-pstnode-parameters-name-list
+ '("angle" "angleA" "angleB" "arcangle" "arcangleA" "arcangleB" "arm"
+ "armA" "armB" "boxsize" "colsep" "framesize" "href" "loopsize"
+ "ncurv" "ncurvA" "ncurvB" "nodesepA" "nodesepB" "npos" "nrot"
+ "offset" "offsetA" "offsetB" "radius" "vref" "Xnodesep" "XnodesepA"
+ "XnodesepB" "Ynodesep" "YnodesepA" "YnodesepB")
+ "A list of parameters' name in pst-node.")
+
+(defvar LaTeX-pstnode-parameters-name-history nil
+ "History of parameter names in pst-node.")
+
+;;; Derived Functions from pstricks.el defuns
+(defun LaTeX-pstnode-parameter-value (param)
+ "See documentation of `LaTeX-package-parameter-value'."
+ (LaTeX-package-parameter-value param "pstnode"))
+
+(defun LaTeX-pstnode-parameters-pref-and-chosen (param &optional noskip)
+ "See documentation of `LaTeX-package-parameters-pref-and-chosen'."
+ (LaTeX-package-parameters-pref-and-chosen param "pstnode" noskip))
+
+(defun LaTeX-pstnode-parameters (optional &optional preparam param)
+ "See documentation of `LaTeX-package-parameters-pref-and-chosen'."
+ (LaTeX-package-parameters optional "pstnode" preparam param))
+
+;;; Macros
+(defun LaTeX-pstnode-macro-nput (optional &optional arg)
+ "Return \\nput arguments after querying."
+ (insert "[rot=" (LaTeX-pst-angle) "]{" (LaTeX-pst-angle) "}{"
+ (LaTeX-pst-node) "}"))
+
+(defun LaTeX-pstnode-macro-cnodeput (optional &optional arg)
+ "Return \\cnodeput arguments after querying."
+ (let ((rotation (if current-prefix-arg (LaTeX-pst-angle) nil))
+ (pnt (if current-prefix-arg (LaTeX-pst-point) nil)))
+ (insert (if rotation (format "{%s}" rotation) "")
+ (if pnt (format "(%s)" pnt) "") "{" (LaTeX-pst-node) "}")))
+
+(defun LaTeX-pstnode-macro-nc (optional &optional arg)
+ "Return \\nc* arguments after querying."
+ (let ((arrows (LaTeX-pst-arrows)))
+ (insert (if arrows (format "{%s}" arrows) "") "{" (LaTeX-pst-node)
+ "}{" (LaTeX-pst-node) "}")))
+
+(defun LaTeX-pstnode-macro-pc (optional &optional arg)
+ "Return \\pc* arguments after querying."
+ (let ((arrows (LaTeX-pst-arrows)))
+ (insert (if arrows (format "{%s}" arrows) "") "(" (LaTeX-pst-point)
+ ")(" (LaTeX-pst-point) ")")))
+
+(defun LaTeX-pstnode-macro-tnabcput (optional &optional arg)
+ "Return \\t?put or \\n?put arguments after querying."
+ (TeX-argument-insert (LaTeX-pstnode-parameters-pref-and-chosen
+ '("nrot" "npos")) optional))
+
+;;; Environments
+(defun LaTeX-pstnode-env-psmatrix (env)
+ "Return psmatrix environment with arguments."
+ (let ((opt (completing-read-multiple "Options: "
+ LaTeX-pstnode-psmatrix-list)))
+ (LaTeX-insert-environment env opt)))
+
+(TeX-add-style-hook
+ "pst-node"
+ (function
+ (lambda ()
+ (LaTeX-add-environments
+ '("psmatrix" LaTeX-pstnode-env-psmatrix))
+ (TeX-add-symbols
+ '("MakeShortNab" 2) '("MakeShortTablr" 4) '("PSTnodesLoaded" 0)
+ '("nput" LaTeX-pstnode-macro-nput TeX-arg-macro)
+ '("cnodeput" [LaTeX-pst-parameters] LaTeX-pstnode-macro-cnodeput t)
+ '("Cnode" [LaTeX-pstnode-parameters] LaTeX-pst-point-in-parens t)
+ '("cnode" [LaTeX-pstnode-parameters] "Radius" t)
+ '("fnode" [LaTeX-pstnode-parameters] LaTeX-pst-point-in-parens t)
+ '("fnode*" [LaTeX-pstnode-parameters] LaTeX-pst-point-in-parens t)
+ '("dotnode" [LaTeX-pstnode-parameters] LaTeX-pst-point-in-parens t)
+ '("pnode" LaTeX-pst-point-in-parens t)
+ '("Rnode" [LaTeX-pstnode-parameters ("href" "vref")]
+ (TeX-arg-eval LaTeX-pst-point) t)
+ '("rnode" [LaTeX-pstnode-parameters ("ref")]
+ (TeX-arg-eval LaTeX-pst-point) t)
+ '("circlenode" [LaTeX-pst-parameters]
+ (TeX-arg-eval LaTeX-pst-point) t)
+ '("dianode" [LaTeX-pst-parameters] "Node Name" t)
+ '("ovalnode" [LaTeX-pst-parameters] "Node Name" t)
+ '("trinode" [LaTeX-pst-parameters] "Node Name" t)
+ '("dotnode" [LaTeX-pst-parameters] LaTeX-pst-point-in-parens
+ "Node Name")
+ '("naput" [LaTeX-pstnode-macro-tnabcput] t)
+ '("nbput" [LaTeX-pstnode-macro-tnabcput] t)
+ '("ncput" [LaTeX-pstnode-macro-tnabcput] t)
+ '("taput" [LaTeX-pstnode-macro-tnabcput] t)
+ '("tbput" [LaTeX-pstnode-macro-tnabcput] t)
+ '("thput" [LaTeX-pstnode-macro-tnabcput] t)
+ '("tlput" [LaTeX-pstnode-macro-tnabcput] t)
+ '("trput" [LaTeX-pstnode-macro-tnabcput] t)
+ '("tvput" [LaTeX-pstnode-macro-tnabcput] t)
+ '("ncline" [LaTeX-pst-parameters] LaTeX-pstnode-macro-nc)
+ '("ncarc" [LaTeX-pst-parameters] LaTeX-pstnode-macro-nc)
+ '("ncdiag" [LaTeX-pst-parameters] LaTeX-pstnode-macro-nc)
+ '("ncdiagg" [LaTeX-pst-parameters] LaTeX-pstnode-macro-nc)
+ '("ncbar" [LaTeX-pst-parameters] LaTeX-pstnode-macro-nc)
+ '("ncangle" [LaTeX-pst-parameters] LaTeX-pstnode-macro-nc)
+ '("ncangles" [LaTeX-pst-parameters] LaTeX-pstnode-macro-nc)
+ '("ncloop" [LaTeX-pst-parameters] LaTeX-pstnode-macro-nc)
+ '("nccurve" [LaTeX-pst-parameters] LaTeX-pstnode-macro-nc)
+ '("nccircle" [LaTeX-pst-parameters] LaTeX-pstnode-macro-nc)
+ '("ncbox" [LaTeX-pst-parameters] LaTeX-pstnode-macro-nc)
+ '("ncarcbox" [LaTeX-pst-parameters] LaTeX-pstnode-macro-nc)
+ '("pcline" [LaTeX-pst-parameters] LaTeX-pstnode-macro-pc)
+ '("pccurve" [LaTeX-pst-parameters] LaTeX-pstnode-macro-pc)
+ '("pcarc" [LaTeX-pst-parameters] LaTeX-pstnode-macro-pc)
+ '("pcbar" [LaTeX-pst-parameters] LaTeX-pstnode-macro-pc)
+ '("pcdiag" [LaTeX-pst-parameters] LaTeX-pstnode-macro-pc)
+ '("pcdiagg" [LaTeX-pst-parameters] LaTeX-pstnode-macro-pc)
+ '("pcangle" [LaTeX-pst-parameters] LaTeX-pstnode-macro-pc)
+ '("pcangles" [LaTeX-pst-parameters] LaTeX-pstnode-macro-pc)
+ '("pcloop" [LaTeX-pst-parameters] LaTeX-pstnode-macro-pc)
+ '("pcbox" [LaTeX-pst-parameters] LaTeX-pstnode-macro-pc)
+ '("pcarcbox" [LaTeX-pst-parameters] LaTeX-pstnode-macro-pc)
+ '("psspan" (TeX-arg-eval LaTeX-pst-input-int))
+ '("psrowhook" t)
+ '("pscolhook" t))
+ (TeX-run-style-hooks
+ "pstricks"))))
+
+;;; pst-node.el ends here
diff --git a/tests/auctex-11.87.7/style/pst-plot.el
b/tests/auctex-11.87.7/style/pst-plot.el
new file mode 100644
index 0000000..beae60a
--- /dev/null
+++ b/tests/auctex-11.87.7/style/pst-plot.el
@@ -0,0 +1,137 @@
+;;; pst-plot.el --- AUCTeX style for `pst-plot.sty'
+
+;; Copyright (C) 2007 Free Software Foundation, Inc.
+
+;; Author: Holger Sparr <holger.sparr@gmx.net>
+;; Created: 21 Jun 2007
+;; Based on: Jean-Philippe Georget's pst-plot.el
+;; Keywords: latex, pstricks, auctex, emacs
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; This file adds support for `pst-plot.sty'.
+
+;;; TODO:
+;;
+;; -- improve symbol support (especially the pstScalePoints macros)
+;; -- check for multido.el necessity
+
+;;; Code:
+
+;; Self Parsing -- see (info "(auctex)Hacking the Parser")
+(defvar LaTeX-auto-pstplot-regexp-list
+ '(("\\\\\\(save\\|read\\)data{?\\(\\\\[a-zA-Z]+\\)}?"
+ 2 LaTeX-auto-pstplot))
+ "List of regular expressions to extract arguments of \\*data
+ macros.")
+
+(defvar LaTeX-auto-pstplot nil
+ "Temporary for parsing \\*data definitions.")
+
+(defun LaTeX-pstplot-cleanup ()
+ "Move symbols from `LaTeX-auto-pstplot to `TeX-auto-symbol'."
+ (mapcar (lambda (symbol)
+ ;; (setq TeX-symbol-list (cons (list symbol 0) TeX-symbol-list))
+ ;; (setq TeX-auto-symbol (cons (list symbol 0) TeX-auto-symbol)))
+ (add-to-list 'LaTeX-pstplot-datasets symbol))
+ LaTeX-auto-pstplot))
+
+(defun LaTeX-pstplot-prepare ()
+ "Clear `LaTeX-auto-pstplot' before use."
+ (setq LaTeX-auto-pstplot nil))
+
+(add-hook 'TeX-auto-prepare-hook 'LaTeX-pstplot-prepare)
+(add-hook 'TeX-auto-cleanup-hook 'LaTeX-pstplot-cleanup)
+
+;;; Parameters
+(defvar LaTeX-pstplot-datasets nil
+ "List of parsed data sets defined with \\savedata or \\readdata.")
+
+(defvar LaTeX-pstplot-parameters-name-list
+ '("axesstyle" "labels" "plotpoints" "plotstyle" "showorigin" "ticks"
+ "ticksize" "tickstyle")
+ "A list of parameters' name in pst-plot.")
+
+(defvar LaTeX-pst-ticks-list '(t "none" "all" "x" "y")
+ "A list of values for ticks in pst-plot.")
+
+(defvaralias 'LaTeX-pst-labels-list 'LaTeX-pst-ticks-list)
+
+(defvar LaTeX-pst-plotstyle-list
+ '(t "dots" "line" "polygon" "curve" "ecurve" "ccurve")
+ "A list of values for tickstyles in pst-plot.")
+
+(defvar LaTeX-pst-tickstyle-list '(t "full" "top" "bottom")
+ "A list of values for tickstyles in pst-plot.")
+
+(defvar LaTeX-pst-axesstyle-list '(t "axes" "frame" "none")
+ "A list of values for axesstyles in pst-plot.")
+
+;;; Macros
+(defun LaTeX-pst-macro-psaxes (optional &optional arg)
+ "Return \\psaxes arguments after querying."
+(let* ((cpref (if current-prefix-arg (car current-prefix-arg) 0))
+ (arrows (LaTeX-pst-arrows))
+ (pnt1 (if (> cpref 4) (LaTeX-pst-point) nil))
+ (pnt2 (if (> cpref 0) (LaTeX-pst-point) nil))
+ (pnt3 (LaTeX-pst-point)))
+ ;; insert \psaxes arguments
+ (insert (if arrows (format "{%s}" arrows) "")
+ (if pnt1 (format "(%s)" pnt1) "")
+ (if pnt2 (format "(%s)" pnt2) "") "(" pnt3 ")")))
+
+;;; Derived defuns
+(defun LaTeX-pstplot-datasets-read ()
+ (TeX-arg-compl-list "Datasets" LaTeX-pstplot-datasets))
+
+;;; Hook
+(TeX-add-style-hook
+ "pst-plot"
+ (function
+ (lambda ()
+ (mapcar 'TeX-auto-add-regexp LaTeX-auto-pstplot-regexp-list)
+ (TeX-add-symbols
+ '("readdata" "Macro Name" TeX-arg-file)
+ '("savedata" "Macro Name" ["Values"])
+ '("dataplot" ["Options"]
+ (TeX-arg-eval LaTeX-pstplot-datasets-read))
+ '("fileplot" ["Options"] TeX-arg-file)
+ '("listplot" ["Options"] "Values")
+ '("pstScalePoints" "X-Mod" "Y-Mod")
+ '("psplot" [LaTeX-pst-parameter] "xmin" "xmax" t)
+ '("parametricplot" [LaTeX-pst-parameter] "xmin" "xmax" t)
+ '("psaxes" [LaTeX-pst-parameters] LaTeX-pst-macro-psaxes)
+ "pshlabel"
+ "psvlabel")
+ (TeX-run-style-hooks
+ "pstricks"
+ "multido")
+ (unless (string-match "plotstyle"
+ LaTeX-pst-parameters-completion-regexp)
+ (setq LaTeX-pst-parameters-completion-regexp
+ (concat
+ (substring LaTeX-pst-parameters-completion-regexp 0 -2)
+ "\\|plotstyle\\|ticks\\|tickstyle\\|axesstyle\\|labels\\)")))
+ (make-local-variable 'LaTeX-pst-parameters-name-list)
+ (setq LaTeX-pst-parameters-name-list
+ (append LaTeX-pstplot-parameters-name-list
+ LaTeX-pst-parameters-name-list)))))
+
+;;; pst-plot.el ends here
diff --git a/tests/auctex-11.87.7/style/pst-slpe.el
b/tests/auctex-11.87.7/style/pst-slpe.el
new file mode 100644
index 0000000..2c82454
--- /dev/null
+++ b/tests/auctex-11.87.7/style/pst-slpe.el
@@ -0,0 +1,67 @@
+;;; pst-slpe.el --- AUCTeX style for `pst-slpe.sty'
+
+;; Copyright (C) 2007 Free Software Foundation, Inc.
+
+;; Author: Holger Sparr <holger.sparr@gmx.net>
+;; Created: 21 Jun 2007
+;; Keywords: latex, pstricks, auctex, emacs
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; This file adds support for `pst-slpe.sty'.
+
+;;; TODO:
+;;
+;; --
+
+;;; Code:
+
+;;; Parameters
+(defvar LaTeX-pstslpe-parameters-name-list
+ '("slopeangle" "slopecenter" "slopecolors" "slopebegin" "slopeend"
+ "sloperadius" "slopesteps")
+ "A list of parameter names in pst-slpe.")
+
+;;; Aliases
+(defvaralias 'LaTeX-pst-slopebegin-list 'LaTeX-pst-color-list)
+(defvaralias 'LaTeX-pst-slopeend-list 'LaTeX-pst-color-list)
+
+;;; Define hook
+(TeX-add-style-hook
+ "pst-slpe"
+ (function
+ (lambda ()
+ (TeX-run-style-hooks
+ "pstricks")
+ (unless (member "slope" LaTeX-pst-fillstyle-list)
+ (setq LaTeX-pst-fillstyle-list
+ (append LaTeX-pst-fillstyle-list
+ '("slope" "slopes" "ccslope" "ccslopes" "radslope"
+ "radslopes")))
+ (setq LaTeX-pst-parameters-completion-regexp
+ (concat
+ (substring LaTeX-pst-parameters-completion-regexp 0 -2)
+ "\\|slopebegin\\|slopeend\\)")))
+ (make-local-variable 'LaTeX-pst-parameters-name-list)
+ (setq LaTeX-pst-parameters-name-list
+ (append LaTeX-pstslpe-parameters-name-list
+ LaTeX-pst-parameters-name-list)))))
+
+;;; pst-slpe.el ends here
diff --git a/tests/auctex-11.87.7/style/pstricks.el
b/tests/auctex-11.87.7/style/pstricks.el
new file mode 100644
index 0000000..6e4df32
--- /dev/null
+++ b/tests/auctex-11.87.7/style/pstricks.el
@@ -0,0 +1,866 @@
+;;; pstricks.el --- AUCTeX style for the `pstricks' package.
+
+;; Copyright (C) 2007, 2009 Free Software Foundation, Inc.
+
+;; Author: Holger Sparr <holger.sparr@gmx.net>
+;; Maintainer: auctex-devel@gnu.org
+;; Created: 2007-06-14
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+;;
+;; AUCTeX style file for PSTricks
+;;
+;; Support for basic PSTricks macros and their arguments. Separate
+;; history variables for point, angle, ... arguments.
+;;
+;; Parameter input completion together with input completion for certain
+;; parameters (e.g. linestyle, linecolor and the like).
+;;
+;; There is a PSTricks-specific support for adding new parameters to
+;; existing parameter lists or changing existing ones in optional
+;; macro arguments. You might want to make those available through
+;; key bindings by using something like
+;; (define-key LaTeX-mode-map (kbd "C-c p a")
+;; 'LaTeX-pst-parameter-add)
+;; (define-key LaTeX-mode-map (kbd "C-c p c")
+;; 'LaTeX-pst-parameter-change-value)
+;; in a personal style file for PSTricks.
+
+;;; History:
+;;
+;; 14/06/2007 rewrite of pstricks.el based on Jean-Philippe Georget's
+;; pstricks.el version found on <URI:
+;; http://www.emacswiki.org/cgi-bin/wiki/pstricks.el>
+
+;;; TODO:
+;;
+;; -- Use alist or hash-table for parameter input
+;; -- Add more regularly used PSTricks macros
+;; -- Prevent errors in AUCTeX modes other than LaTeX mode.
+;; -- Check if the functionality for adding and changing parameters
+;; can be generalized.
+
+;;; Code:
+
+;;; General Functions
+
+(defun TeX-arg-compl-list (list &optional prompt hist)
+ "Input a value after PROMPT with completion from LIST and HISTORY."
+ (let ((first (car list)))
+ (if (and first (listp first))
+ (let ((func (nth 0 first))
+ (prompt (concat (or (nth 1 first) prompt) ": "))
+ (compl (nth 2 first))
+ (hist (or (nth 3 first) hist))
+ (crm-separator (nth 4 first))
+ res)
+ (setq list (cdr list))
+ (cond ((eq func 'completing-read-multiple)
+ (setq res (funcall func prompt list nil compl nil hist))
+ (mapconcat 'identity res crm-separator))
+ ((eq func 'completing-read)
+ (setq res
+ (funcall func prompt list nil compl nil hist)))))
+ (completing-read (concat prompt ": ") list nil nil nil hist))))
+
+;; XXX: Show default value in prompt. Perhaps extend
+;; `TeX-argument-prompt' to do that.
+(defun LaTeX-pst-what (what prompt default &optional arg)
+ "Ask for WHAT with PROMPT with DEFAULT.
+The corresponding lists LaTeX-pst-<what>-\\(list\\|history\\)
+have to exist.
+
+\(Used to define functions named LaTeX-pst-<what>.\))"
+ (let ((list (intern (concat "LaTeX-pst-" what "-list")))
+ (hist (intern (concat "LaTeX-pst-" what "-history"))))
+ (if (not arg)
+ (setq arg (TeX-arg-compl-list (symbol-value list) prompt hist)))
+ (if (string= arg "")
+ default
+ (add-to-list list arg)
+ arg)))
+
+(defun LaTeX-pst-input-int (prompt arg)
+ "Return number as string asked for with PROMPT if no number
+passed with ARG."
+ (unless (numberp arg)
+ (setq arg (read-number (concat prompt ": ") 2)))
+ (number-to-string arg))
+
+(defun LaTeX-pst-enclose-obj (symbol op cl)
+ "Enclose string returned by the `funcall' SYMBOL in OP and CL
+character."
+ (let ((str (funcall symbol)))
+ (if str (insert (char-to-string op) str (char-to-string cl)))))
+
+(defun LaTeX-package-parameter-value (param pname)
+ "Ask for possible value of parameter PARAM given as string
+available through package name PNAME and return \"param=value\"."
+ (add-to-list (intern (concat "LaTeX-" pname "-parameters-name-list"))
+ param)
+ ;; select predefined set
+ (let* ((cregexp
+ (symbol-value
+ (intern (concat "LaTeX-" pname
+ "-parameters-completion-regexp"))))
+ (bregexp
+ (symbol-value (intern (concat "LaTeX-" pname
+ "-parameters-boolean-regexp"))))
+ (parlist (cond
+ ((string-match cregexp param)
+ (intern (concat "LaTeX-" pname "-"
+ (match-string 0 param) "-list")))
+ ((string-match bregexp param)
+ 'LaTeX-pst-boolean-list)))
+ val compl)
+ ;; ask for value
+ (setq val (TeX-arg-compl-list
+ (symbol-value parlist)
+ (concat "(Press TAB for completions) " param)
+ (intern (concat "LaTeX-" pname
+ "-parameters-value-history"))))
+ ;; FIXME: This looks broken. `compl' is never set and unless ""
+ ;; is added to parlist (at least in the Boolean case), the prompt
+ ;; shown by `TeX-arg-compl-list' will be incorrect.
+ (if (and (not compl) parlist) (add-to-list parlist val))
+ (if (string= val "") "" (concat param "=" val))))
+
+(defun LaTeX-package-parameters-pref-and-chosen (param pname noskip)
+ "Set values for elements of PARAM from package PNAME and
+further explicitly typed in parameters and return a comma
+separated list as string."
+ (let ((allpars "")
+ (fask (intern (concat "LaTeX-" pname "-parameter-value")))
+ tpara parval)
+ (when param
+ (while param
+ (setq tpara (pop param))
+ (setq parval (funcall fask tpara))
+ (setq allpars
+ (concat allpars
+ (if (or (string= "" allpars) (string= "" parval))
+ "" ",") parval))))
+ ;; ask for parameter names as long as none is given
+ (when noskip
+ (while
+ (not
+ (string=
+ ""
+ (setq tpara
+ (completing-read
+ "Parameter name (RET to stop): "
+ (symbol-value (intern
+ (concat "LaTeX-" pname
+ "-parameters-name-list")))
+ nil nil nil (intern
+ (concat "LaTeX-" pname
+ "-parameters-name-history"))))))
+ (setq parval (funcall fask tpara))
+ ;; concat param=value with other ones
+ (setq allpars
+ (concat allpars
+ (if (or (string= "" allpars) (string= "" parval))
+ ""
+ ",")
+ parval))))
+ (add-to-list
+ (intern (concat "LaTeX-" pname "-parameters-history")) allpars)
+ allpars))
+
+(defun LaTeX-package-parameters (optional pname preparam param)
+ "Ask for parameters and manage several parameter lists for
+package PNAME"
+ (let ((fask (intern
+ (concat "LaTeX-" pname "-parameters-pref-and-chosen")))
+ (hlist (intern (concat "LaTeX-" pname "-parameters-history")))
+ (nlist
+ (symbol-value
+ (intern (concat "LaTeX-" pname "-parameters-name-list")))))
+ ;;
+ (when (and preparam (listp preparam))
+ (setq preparam (funcall fask preparam)))
+ ;;
+ (setq param
+ (completing-read-multiple
+ (concat
+ "Params (use <Up,Down> for history or RET for choices): ")
+ nlist nil nil nil hlist))
+ ;;
+ (if (and (string= "" (car param)) (= (length param) 1))
+ (setq param (funcall fask nil t))
+ (setq param (car (symbol-value hlist))))
+ (TeX-argument-insert
+ (if (or (string= "" preparam) (eq preparam nil))
+ param
+ (concat preparam (if (string= "" param) "" (concat "," param))))
+ optional)))
+
+;;; Points
+(defvar LaTeX-pst-point-list (list "0,0")
+ "A list of values for point in pstricks.")
+
+(defvar LaTeX-pst-point-history LaTeX-pst-point-list
+ "History of values for point in pstricks.")
+
+(defun LaTeX-pst-point ()
+ "Ask for a point and manage point list."
+ (LaTeX-pst-what "point"
+ (concat "Point (default " (car LaTeX-pst-point-history) ")")
+ (car LaTeX-pst-point-history)))
+
+(defun LaTeX-pst-point-in-parens (optional)
+ "Enclose point in parentheses."
+ (LaTeX-pst-enclose-obj 'LaTeX-pst-point ?( ?)))
+
+;;; Angles
+(defvar LaTeX-pst-angle-list (list "0")
+ "A list of values for angle in pstricks.")
+
+(defvar LaTeX-pst-angle-history nil
+ "History of values for angle in pstricks.")
+
+(defun LaTeX-pst-angle ()
+ "Ask for a angle and manage angle list"
+ (LaTeX-pst-what "angle"
+ (concat "Angle (default " (car LaTeX-pst-angle-list) ")")
+ (car LaTeX-pst-angle-list)))
+
+;;; Extension in one Direction
+(defvar LaTeX-pst-extdir-list (list "1")
+ "A list of values for extdir in pstricks.")
+
+(defvar LaTeX-pst-extdir-history nil
+ "History of values for extdir in pstricks.")
+
+(defun LaTeX-pst-extdir (descr)
+ "Ask for a extdir and manage extdir list"
+ (LaTeX-pst-what "extdir"
+ (concat descr " (default " (car LaTeX-pst-extdir-list) ")")
+ (car LaTeX-pst-extdir-list)))
+
+;;; Relative Points
+(defvar LaTeX-pst-delpoint-list nil
+ "A list of values for delpoint in pstricks.")
+
+(defvar LaTeX-pst-delpoint-history nil
+ "History of values for delpoint in pstricks.")
+
+;;; Arrows
+(defvar LaTeX-pst-arrows-list
+ '("->" "<-" "<->" ">-<" ">-" "-<" "<<->>" "<<-" "->>" "|-|" "|-" "-|"
+ "|*-|*" "[-]" "[-" "-]" "(-)" "(-" "-)" "*-*" "*-" "-*" "0-0" "0-"
+ "-0" "c-c" "c-" "-c" "C-C" "C-" "-C" "cc-cc" "cc-" "-cc" "|<->|" "|<-"
+ "->|" "|<*->|*" "|<*-" "->|*" "-")
+ "A list of values for arrows in pstricks.")
+
+(defvar LaTeX-pst-arrows-history nil
+ "History of values for arrows in pstricks.")
+
+;; XXX: Better ask for arrow start and end separately?
+;; `LaTeX-pst-arrows-list' is not exhaustive.
+(defun LaTeX-pst-arrows ()
+ "Ask for a arrow type and manage arrow type list"
+ (or (LaTeX-pst-what "arrows" "Arrow type" nil) ""))
+
+;;; Dots
+(defvar LaTeX-pst-dotstyle-list
+ '((completing-read "Dot style" nil LaTeX-pst-dotstyle-history)
+ "*" "o" "+" "|" "triangle" "triangle*" "square" "square*" "pentagon"
+ "pentagon*")
+ "A list of values for dotstyle in pstricks.")
+
+(defvar LaTeX-pst-dotstyle-history nil
+ "History of values for dotstyle in pstricks.")
+
+;;; Reference Point
+(defvar LaTeX-pst-refpoint-list
+ '((completing-read "Reference point" t LaTeX-pst-refpoint-history)
+ "l" "r" "t" "tl" "lt" "tr" "rt" "b" "bl" "br" "lb" "rb" "B" "Bl"
+ "Br" "lB" "rB")
+ "A list of values for refpoint in pstricks.")
+
+(defvar LaTeX-pst-refpoint-history nil
+ "History of values for refpoint in pstricks.")
+
+(defun LaTeX-pst-refpoint ()
+ "Ask for a refpoint and manage refpoint list"
+ (LaTeX-pst-what "refpoint" "Reference point" nil))
+
+;;; Color
+
+;; FIXME: Still used?
+(defvar LaTeX-pst-color-history nil
+ "History of values for color in pstricks.")
+
+;;; Others without History in Completion
+
+(defvar LaTeX-pst-style-list
+ '((completing-read "Defined Style" t))
+ "A list of values for user defined styles in pstricks.")
+
+;;; Parameters
+
+(defvar LaTeX-pst-parameters-history nil
+ "History of values for parameters in pstricks.")
+
+(defvar LaTeX-pst-parameters-value-history nil
+ "History of parameter values in pstricks.")
+
+(defvar LaTeX-pst-basic-parameters-name-list
+ '("arcsep" "arcsepA" "arcsepB" "arrowinset" "arrowlength" "arrows"
+ "arrowscale" "arrowsize" "border" "bordercolor" "boxsep"
+ "bracketlength" "cornersize" "curvature" "dash" "dimen" "dotangle"
+ "dotscale" "dotsep" "dotsize" "dotstyle" "doublecolor" "doubleline"
+ "doublesep" "doubleset" "fillcolor" "fillstyle" "framearc"
+ "framesep" "gangle" "gridcolor" "griddots" "gridlabelcolor"
+ "gridlabels" "gridwidth" "hatchangle" "hatchcolor" "hatchsep"
+ "hatchsepinc" "hatchwidth" "hatchwidthinc" "header" "labelsep"
+ "liftpen" "linearc" "linecolor" "linestyle" "linetype" "linewidth"
+ "rbracketlength" "ref" "runit" "shadow" "shadowangle" "shadowcolor"
+ "shadowsize" "showgrid" "showpoints" "style" "subgridcolor"
+ "subgriddiv" "subgriddots" "subgridwidth" "swapaxes" "tbarsize"
+ "trimode" "unit" "xunit" "yunit")
+ "A list of parameter names in pstricks.")
+
+
+(defvar LaTeX-pst-boolean-list '("true" "false")
+ "List of binary values for key=value completion.")
+
+;; XXX: Colors can actually be given as [-]<color>[!<num>].
+(defvar LaTeX-pst-color-list
+ '("black" "darkgray" "gray" "lightgray" "white"
+ "red" "green" "blue" "cyan" "magenta" "yellow")
+ "List of colors predefined in PSTricks.")
+
+(defvar LaTeX-pst-fillstyle-list
+ '("none" "solid" "vlines" "vlines*" "hlines" "hlines*" "crosshatch"
+ "crosshatch*" "boxfill")
+ "List of fill styles defined in PSTricks.")
+
+;; From PSTricks: PostScript macros for Generic TeX, User's Guide,
+;; Timothy Van Zandt, 25 July 2003, Version 97.
+;; FIXME: Provide separate variables tailored to the different macros.
+(defvar LaTeX-pst-basic-parameters-list
+ '(;; Dimensions, coordinates and angles
+ ("unit")
+ ("xunit")
+ ("yunit")
+ ("runit")
+ ;; Basic graphics parameters
+ ("linewidth")
+ ("linecolor" LaTeX-pst-color-list)
+ ("fillstyle" LaTeX-pst-fillstyle-list)
+ ("fillcolor" LaTeX-pst-color-list)
+ ("arrows" LaTeX-pst-arrows-list)
+ ("showpoints" LaTeX-pst-boolean-list)
+ ;; Lines and polygons
+ ("linearc")
+ ("framearc")
+ ("cornersize" ("relative" "absolute"))
+ ("gangle")
+ ;; Arcs, circles and ellipses
+ ("arcsepA")
+ ("arcsepB")
+ ("arcsep")
+ ;; Curves
+ ("curvature")
+ ;; Dots
+ ("dotstyle" ("*" "o" "Bo" "x" "+" "B+" "asterisk" "Basterisk" "oplus"
+ "otimes" "|" "B|" "square" "Bsquare" "square*" "diamond"
+ "Bdiamond" "diamond*" "triangle" "Btriangle" "triangle*"
+ "pentagon" "Bpentagon" "pentagon*"))
+ ("dotsize")
+ ("dotscale")
+ ("dotangle")
+ ;; Grids
+ ("gridwidth")
+ ("gridcolor" LaTeX-pst-color-list)
+ ("griddots")
+ ("gridlabels")
+ ("gridlabelcolor" LaTeX-pst-color-list)
+ ("subgriddiv")
+ ("subgridwidth")
+ ("subgridcolor" LaTeX-pst-color-list)
+ ("subgriddots")
+ ;; Plots
+ ("plotstyle" ("dots" "line" "polygon" "curve" "ecurve" "ccurve"))
+ ("plotpoints")
+ ;; Coordinate systems
+ ("origin")
+ ("swapaxes" LaTeX-pst-boolean-list)
+ ;; Line styles
+ ("linestyle" ("none" "solid" "dashed" "dotted"))
+ ("dash")
+ ("dotsep")
+ ("border")
+ ("bordercolor" LaTeX-pst-color-list)
+ ("doubleline" LaTeX-pst-boolean-list)
+ ("doublesep")
+ ("doublecolor" LaTeX-pst-color-list)
+ ("shadow" LaTeX-pst-boolean-list)
+ ("shadowsize")
+ ("shadowangle")
+ ("shadowcolor" LaTeX-pst-color-list)
+ ("dimen" ("outer" "inner" "middle"))
+ ;; Fill styles
+ ("hatchwidth")
+ ("hatchsep")
+ ("hatchcolor" LaTeX-pst-color-list)
+ ("hatchangle")
+ ("addfillstyle" LaTeX-pst-fillstyle-list)
+ ;; Arrowheads and such
+ ("arrowsize")
+ ("arrowlength")
+ ("arrowwinset")
+ ("tbarsize")
+ ("bracketlength")
+ ("rbracketlength")
+ ("arrowscale")
+ ;; Parameters
+ ("linetype")
+ ;; Graphics objects
+ ("liftpen")
+ ;; Placing and rotating whatever
+ ("labelsep")
+ ;; Axes
+ ("labels" ("all" "x" "y" "none"))
+ ("showorigin" LaTeX-pst-boolean-list)
+ ("ticks" ("all" "x" "y" "none"))
+ ("tickstyle" ("full" "top" "bottom"))
+ ("ticksize")
+ ("axesstyle" ("axes" "frame" "none"))
+ ;; Framed boxes
+ ("framesep")
+ ("boxsep")
+ ("trimode" ("*" "U" "D" "R" "L"))
+ ;; Nodes
+ ("href")
+ ("vref")
+ ("radius")
+ ;; Node connections
+ ("nodesep")
+ ("arcangle")
+ ("angle")
+ ("arm")
+ ("loopsize")
+ ("ncurv")
+ ("boxsize")
+ ("offset")
+ ;; Node connections labels: I
+ ("ref")
+ ("nrot")
+ ("npos")
+ ("shortput" ("none" "nab" "tablr" "tab"))
+ ;; Node connection labels: II
+ ("tpos")
+ ;; Attaching labels to nodes
+ ("rot")
+ ;; Mathematical diagrams and graphs
+ ("mnode" ("R" "r" "C" "f" "p" "circle" "oval" "dia" "tri" "dot" "none"))
+ ("emnode" ("R" "r" "C" "f" "p" "circle" "oval" "dia" "tri" "dot" "none"))
+ ("name")
+ ("nodealign" LaTeX-pst-boolean-list)
+ ("mcol" ("l" "r" "c"))
+ ("rowsep")
+ ("colsep")
+ ("mnodesize")
+ ;; ...
+ )
+ "List of keys and values for PSTricks macro arguments.")
+
+(defvar LaTeX-pst-parameters-name-list
+ LaTeX-pst-basic-parameters-name-list
+ "A list of all parameters with completion.")
+
+(defvar LaTeX-pst-parameters-name-history nil
+ "History of parameter names in pstricks.")
+
+(defvar LaTeX-pst-parameters-completion-regexp
+
"\\(arrows\\|linestyle\\|fillstyle\\|color\\|trimode\\|dotstyle\\|\\<style\\)"
+ "Regexp for `string-match'ing a parameter.")
+
+(defvar LaTeX-pst-parameters-boolean-regexp
+ "\\(doubleline\\|shadow\\>\\|show[a-zA-Z]+\\)"
+ "Regexp for `string-match'ing a parameter.")
+
+(defun LaTeX-pst-parameter-value (param)
+ "See documentation of `LaTeX-package-parameter-value'."
+ (LaTeX-package-parameter-value param "pst"))
+
+(defun LaTeX-pst-parameters-pref-and-chosen (param &optional noskip)
+ "See documentation of `LaTeX-package-parameters-pref-and-chosen'."
+ (LaTeX-package-parameters-pref-and-chosen param "pst" noskip))
+
+;; FIXME: This is likely only a transitional function used until all
+;; macros got their calls to `TeX-arg-key-val' with tailored parameter
+;; lists.
+(defun LaTeX-pst-parameters (optional)
+ "Prompt for general parameters of a PSTricks argument."
+ (TeX-arg-key-val optional LaTeX-pst-basic-parameters-list))
+
+;;; Macros
+(defun LaTeX-pst-macro-psarc (optional &optional arg)
+ "Return \\psarc arguments after querying."
+ (let ((arrows (LaTeX-pst-arrows))
+ (pnt (if current-prefix-arg nil (LaTeX-pst-point))))
+ (insert (if arrows (format "{%s}" arrows) "")
+ (if pnt (format "(%s)" pnt) "")
+ "{" (LaTeX-pst-extdir "Radius") "}{" (LaTeX-pst-angle) "}{"
+ (LaTeX-pst-angle) "}")))
+
+(defun LaTeX-pst-macro-pscircle (optional &optional arg)
+ "Return \\pscircle arguments after querying."
+ (insert "(" (LaTeX-pst-point) "){" (LaTeX-pst-extdir "Radius") "}"))
+
+(defun LaTeX-pst-macro-rput (optional &optional arg)
+ "Return \\rput arguments after querying."
+ (let ((refpoint (LaTeX-pst-refpoint))
+ (rotation (if current-prefix-arg (LaTeX-pst-angle) nil)))
+ (insert (if refpoint (concat "[" refpoint "]") "")
+ (if rotation
+ (concat "{" rotation "}")
+ "") "(" (LaTeX-pst-point) ")")))
+
+(defun LaTeX-pst-macro-uput (optional &optional arg)
+ "Return \\uput arguments after querying."
+ (let ((dist (LaTeX-pst-extdir "Distance"))
+ (refpoint (LaTeX-pst-refpoint)))
+ (insert (if dist (concat "{" dist "}") "")
+ (if refpoint
+ (concat "[" (LaTeX-pst-refpoint) "]")
+ "[]")
+ "{" (LaTeX-pst-angle) "}(" (LaTeX-pst-point) ")")))
+
+(defun LaTeX-pst-macro-multirputps (optional &optional arg)
+ "Return \\multirput or \\multips arguments after querying."
+ (let ((refpoint (LaTeX-pst-refpoint))
+ (rotation (if current-prefix-arg (LaTeX-pst-angle) nil))
+ (pnt (LaTeX-pst-point))
+ (dpnt (LaTeX-pst-what "delpoint" "Increment (default 1,1)" "1,1"))
+ (repi (LaTeX-pst-input-int "Repetitions" nil)))
+ (insert (if refpoint (format "[%s]" refpoint) "")
+ (if rotation (format "{%s}" rotation) "")
+ "(" pnt ")(" dpnt "){" repi "}")))
+
+(defun LaTeX-pst-macro-psline (optional &optional arg)
+ "Return \\psline or \\ps[ce]?curve[*] arguments after querying."
+ (let ((arrows (LaTeX-pst-arrows))
+ (pnt1 (LaTeX-pst-point))
+ (pnt2 (LaTeX-pst-point)))
+ (insert (if arrows (format "{%s}" arrows) "") "(" pnt1 ")" )
+ (while (and (not (string= pnt2 "")) (not (string= pnt1 pnt2)))
+ (insert "(" pnt2 ")")
+ (setq pnt1 pnt2)
+ (setq pnt2 (LaTeX-pst-point)))))
+
+(defun LaTeX-pst-macro-psdots (optional single)
+ "Return \\psdot[s]? arguments after querying."
+ (let* ((pnt1 (LaTeX-pst-point))
+ (pnt2 (if single pnt1 (LaTeX-pst-point))))
+ (insert "(" pnt1 ")")
+ (while (and (not (string= pnt2 "")) (not (string= pnt1 pnt2)))
+ (setq pnt1 pnt2)
+ (insert "(" pnt1 ")")
+ (setq pnt2 (LaTeX-pst-point)))))
+
+(defun LaTeX-pst-macro-parabola (optional &optional arg)
+ "Return \\parabola arguments after querying."
+ (let ((arrows (LaTeX-pst-arrows)))
+ (insert (if arrows (format "{%s}" arrows) "")
+ "(" (LaTeX-pst-point) ")(" (LaTeX-pst-point) ")")))
+
+(defun LaTeX-pst-macro-pnt-twolen (optional prompt1 prompt2)
+ "Return point and 2 paired lengths in separate parens as arguments."
+ ;; insert \psellipse[*]?, \psdiamond or \pstriangle arguments
+ (let ((pnt (if current-prefix-arg nil (LaTeX-pst-point))))
+ (insert (if pnt (format "(%s)" pnt) "")
+ "(" (LaTeX-pst-extdir prompt1) ","
+ (LaTeX-pst-extdir prompt2) ")")))
+
+(defun LaTeX-pst-macro-psbezier (optional &optional arg)
+ "Return \\psbezier arguments after querying."
+ (let ((arrows (LaTeX-pst-arrows))
+ (pnt1 (LaTeX-pst-point))
+ (pnt2 (LaTeX-pst-point))
+ (pnt3 (LaTeX-pst-point)))
+ (insert (if arrows (format "{%s}" arrows) "")
+ "(" pnt1 ")(" pnt2 ")")
+ (while (not (string= pnt2 pnt3))
+ (insert "(" pnt3 ")")
+ (setq pnt2 pnt3)
+ (setq pnt3 (LaTeX-pst-point)))))
+
+(defun LaTeX-pst-macro-pspolygon (optional &optional arg)
+ "Return \\pspolygon arguments after querying."
+ (let ((pnt1 (LaTeX-pst-point))
+ (pnt2 (LaTeX-pst-point))
+ (pnt3 (LaTeX-pst-point)))
+ (insert "(" pnt1 ")(" pnt2 ")")
+ (while (not (string= pnt2 pnt3))
+ (insert "(" pnt3 ")")
+ (setq pnt2 pnt3)
+ (setq pnt3 (LaTeX-pst-point)))))
+
+(defun LaTeX-pst-macro-psframe (optional &optional arg)
+ "Return \\psframe arguments after querying."
+ (let ((pnt1 (if current-prefix-arg nil (LaTeX-pst-point)))
+ (pnt2 (LaTeX-pst-point)))
+ (insert (if pnt1 (format "(%s)" pnt1) "") "(" pnt2 ")")))
+
+(defun LaTeX-pst-macro-psgrid (optional &optional arg)
+ "Return \\psgrid arguments after querying."
+ (let* ((cpref (if current-prefix-arg (car current-prefix-arg) 0))
+ (pnt1 (if (> cpref 4) (LaTeX-pst-point) nil))
+ (pnt2 (if (> cpref 0) (LaTeX-pst-point) nil))
+ (pnt3 (if (> cpref 0) (LaTeX-pst-point) nil)))
+ (insert (if pnt1 (format "(%s)" pnt1) "")
+ (if pnt2 (format "(%s)(%s)" pnt2 pnt3) ""))))
+
+(defun LaTeX-pst-macro-newpsobject (&optional arg)
+ "Return \\newpsobject arguments after querying."
+ (insert "{" (read-string "New PSObject Name: ") "}"
+ ;; FIXME: It would be better to use something more confined
+ ;; than `TeX-symbol-list'.
+ "{" (completing-read "Parent Object: " (TeX-symbol-list))
+ "}"))
+
+;;; Environments
+(defun LaTeX-pst-env-pspicture (env)
+ "Create new pspicure environment."
+ (let ((opt (multi-prompt-key-value
+ (TeX-argument-prompt t "Options" nil)
+ '(("showgrid") ("shift"))))
+ (p0 (LaTeX-pst-what "point" "Lower left (default 0,0)" "0,0"))
+ (p1 (LaTeX-pst-what "point" "Upper right (default 1,1)" "1,1"))
+ corn)
+ (setq corn (concat (unless (string= "" opt) (format "[%s]" opt))
+ (if (string= "0,0" p0) "" (format "(%s)" p0))
+ "(" p1 ")"))
+ (LaTeX-insert-environment env corn)))
+
+;;; Self Parsing -- see (info "(auctex)Hacking the Parser")
+(defvar LaTeX-auto-pstricks-regexp-list
+ '(("\\\\newps\\(object\\){\\([a-zA-Z]+\\)}{\\([a-zA-Z]+\\)}" (1 2 3)
+ LaTeX-auto-pstricks)
+ ("\\\\newps\\(fontdot\\){\\([a-zA-Z]+\\)}" (1 2)
+ LaTeX-auto-pstricks)
+ ("\\\\newps\\(style\\){\\([a-zA-Z]+\\)}" (1 2)
+ LaTeX-auto-pstricks)
+ ("\\\\define\\(color\\){\\([a-zA-Z]+\\)}{\\(rgb\\|cmyk\\)}" (1 2 3)
+ LaTeX-auto-pstricks)
+ ("\\\\new\\(rgb\\|hsb\\|cmyk\\)\\(color\\){\\([a-zA-Z]+\\)}" (2 3 1)
+ LaTeX-auto-pstricks))
+ "List of regular expressions to extract arguments of \\newps* macros.")
+
+(defvar LaTeX-auto-pstricks nil
+ "Temporary for parsing \\newps* definitions.")
+
+(defun LaTeX-pst-cleanup ()
+ "Move symbols from `LaTeX-auto-pstricks' to `TeX-auto-symbol'."
+ (mapcar
+ (lambda (list)
+ (let ((type (car list)))
+ (cond ((string= type "object")
+ (setq TeX-auto-symbol
+ (cons (list (nth 1 list)
+ (caddr (assoc (nth 2 list)
+ (TeX-symbol-list))))
+ TeX-auto-symbol)))
+ ((string= type "fontdot")
+ (add-to-list 'LaTeX-pst-dotstyle-list (nth 1 list) t))
+ ((string= type "style")
+ (add-to-list 'LaTeX-pst-style-list (nth 1 list) t))
+ ((string= type "color")
+ (add-to-list 'LaTeX-pst-color-list (nth 1 list) t)
+ ;; FIXME: Why is an entry with "-" in front added?
+ (add-to-list 'LaTeX-pst-color-list
+ (concat "-" (nth 1 list)) t)))))
+ LaTeX-auto-pstricks))
+
+(defun LaTeX-pst-prepare ()
+ "Clear `LaTeX-auto-pstricks' before use."
+ (setq LaTeX-auto-pstricks nil))
+
+;; FIXME: This does not seem to work unless one does a manual reparse.
+;; Check e.g. with "\definecolor" and "fillcolor=".
+(add-hook 'TeX-auto-prepare-hook 'LaTeX-pst-prepare)
+(add-hook 'TeX-auto-cleanup-hook 'LaTeX-pst-cleanup)
+
+;;; Additional Functionality
+(defun LaTeX-pst-parameters-add (&optional arg)
+ "With ARG as prefix-argument insert new parameter\(s\) behind
+nearest backward LaTeX macro in brackets. Without ARG add
+parameter\(s\) to the already existing ones at the end of the
+comma separated list. Point has to be within the sexp to modify."
+ (interactive "P")
+ (let ((newpara (LaTeX-pst-parameters-pref-and-chosen nil t))
+ (regexp "\\(") beg end check)
+ (if arg
+ (progn
+ (re-search-backward "\\\\\\([a-zA-Z]\\)")
+ (forward-word 1)
+ (insert-pair nil ?[ ?]))
+ (up-list 1)
+ (backward-char 1)
+ (save-excursion
+ (setq end (point))
+ (up-list -1)
+ (while (re-search-forward "\\([a-zA-Z]+\\)=" end 'limit)
+ (setq regexp (concat regexp
+ (match-string-no-properties 1) "\\|")))
+ (setq regexp (concat (substring regexp 0 -1) ")"))
+ (setq check (string-match regexp newpara))))
+ (when newpara
+ (insert (if arg "" ",") newpara)
+ (when check
+ (message
+ "At least one Parameters appears twice. PLEASE CHECK!")))))
+;; FIXME: Only define a key for this once it is a general-purpose
+;; facility, i.e. not just for pstricks but all types of macros.
+;; (define-key LaTeX-mode-map "\C-c\C-x\C-a" 'LaTeX-pst-parameters-add)
+
+(defvar LaTeX-pst-value-regexp
+ "\\([-!.a-zA-Z0-9]*\\s\\?[-!.a-zA-Z0-9]+\\)"
+ "Expression matching a parameter value.")
+
+(defun LaTeX-pst-parameter-remove-value ()
+ "Remove value of current parameter and return parameter name."
+ (re-search-backward
+ (concat "\\(\\s(\\|,\\)[a-zA-Z]+\\([a-zA-Z]\\|=\\|="
+ LaTeX-pst-value-regexp "\\)"))
+ (re-search-forward "\\([a-zA-Z]+\\)=")
+ (let ((para (match-string-no-properties 1)))
+ (re-search-forward LaTeX-pst-value-regexp)
+ (delete-region (match-beginning 1) (match-end 1))
+ para))
+
+(defun LaTeX-pst-parameter-change-value ()
+ "Replace parameter value with a new one."
+ (interactive)
+ (let* ((para (LaTeX-pst-parameter-remove-value))
+ (symb
+ (when (and
+ (string-match
+ LaTeX-pst-parameters-completion-regexp para)
+ (boundp
+ (intern
+ (concat "LaTeX-pst-" (match-string 0 para) "-list"))))
+ (intern (concat "LaTeX-pst-" (match-string 0 para)
+ "-list")))))
+ (insert (TeX-arg-compl-list (symbol-value symb) "New Value"
+ 'LaTeX-pst-parameters-value-history))))
+;; FIXME: Only define a key for this once it is a general-purpose
+;; facility, i.e. not just for pstricks but all types of macros. (See
+;; also `LaTeX-pst-parameters-add'. Note that a parameter change
+;; should better be made available through a `C-u' prefix of the
+;; binding for the function doing the parameter addition.)
+;; (define-key LaTeX-mode-map "\C-c\C-x\C-v" 'LaTeX-pst-parameter-change-value)
+
+(TeX-add-style-hook
+ "pstricks"
+ (lambda ()
+ (unless (member "pst-pdf" TeX-active-styles)
+ (TeX-PDF-mode-off))
+ (mapc 'TeX-auto-add-regexp LaTeX-auto-pstricks-regexp-list)
+ (LaTeX-add-environments
+ '("pspicture" LaTeX-pst-env-pspicture)
+ "overlaybox" "psclip")
+ (TeX-add-symbols
+ '("AltClipMode" 0) '("DontKillGlue" 0) '("KillGlue" 0)
+ '("NormalCoor" 0) '("SpecialCoor" 0) '("PSTricksLoaded" 0)
+ '("PSTricksOff" 0) '("altcolormode" 0) '("pslinecolor" 0)
+ '("pslinestyle" 0) '("pslinetype" 0) '("pslinewidth" 0)
+ '("pslabelsep" 0) '("radian" 0) '("psunit" 0) '("psrunit" 0)
+ '("psxunit" 0) '("psyunit" 0)
+ '("arrows" (TeX-arg-eval LaTeX-pst-arrows))
+ '("clipbox" ["Border"] t)
+ '("closedshadow" [LaTeX-pst-parameters])
+ '("openshadow" [LaTeX-pst-parameters])
+ "closepath" "code" "coor" "curveto" "degrees" "dim" "endpsclip"
+ "file" "fill" "grestore" "gsave" "lineto" "movepath" "moveto"
+ "mrestore" "msave" "newpath" "rcoor" "rcurveto" "rlineto" "rotate"
+ "scale" "stroke" "swapaxes" "translate"
+ '("newcmykcolor" "Name" "Quadruple")
+ '("newrgbcolor" "Name" "Triple") '("newhsbcolor" "Name" "Triple")
+ '("newgray" "Name" "Value")
+ '("newpsobject" LaTeX-pst-macro-newpsobject LaTeX-pst-parameters)
+ '("newpsstyle" "New PSStyle Name" LaTeX-pst-parameters)
+ '("newpsfontdot" "New PSDot Name" ["Factors"]
+ "Fontname" "Character Number (Hex)")
+ '("parabola" [LaTeX-pst-parameters] LaTeX-pst-macro-parabola)
+ '("parabola*" [LaTeX-pst-parameters] LaTeX-pst-macro-parabola)
+ '("psarc" [LaTeX-pst-parameters] LaTeX-pst-macro-psarc)
+ '("psarc*" [LaTeX-pst-parameters] LaTeX-pst-macro-psarc)
+ '("psarcn" [LaTeX-pst-parameters] LaTeX-pst-macro-psarc)
+ '("pswedge" [LaTeX-pst-parameters] LaTeX-pst-macro-psarc)
+ '("psbezier" [LaTeX-pst-parameters] LaTeX-pst-macro-psbezier)
+ '("psbezier*" [LaTeX-pst-parameters] LaTeX-pst-macro-psbezier)
+ '("pscbezier" [LaTeX-pst-parameters] LaTeX-pst-macro-pspolygon)
+ '("pscircle" [LaTeX-pst-parameters] LaTeX-pst-macro-pscircle)
+ '("psccurve" [LaTeX-pst-parameters] LaTeX-pst-macro-psline)
+ '("psccurve*" [LaTeX-pst-parameters] LaTeX-pst-macro-psline)
+ '("pscurve" [LaTeX-pst-parameters] LaTeX-pst-macro-psline)
+ '("pscurve*" [LaTeX-pst-parameters] LaTeX-pst-macro-psline)
+ '("pscustom" [LaTeX-pst-parameters])
+ '("psdiamond" [LaTeX-pst-parameters]
+ (LaTeX-pst-macro-pnt-twolen "Width" "Height"))
+ '("pstriangle" [LaTeX-pst-parameters]
+ (LaTeX-pst-macro-pnt-twolen "Width" "Height"))
+ '("psdot" [LaTeX-pst-parameters] (LaTeX-pst-macro-psdots t))
+ '("psdots" [LaTeX-pst-parameters] (LaTeX-pst-macro-psdots nil))
+ '("psecurve" [LaTeX-pst-parameters] LaTeX-pst-macro-psline)
+ '("psecurve*" [LaTeX-pst-parameters] LaTeX-pst-macro-psline)
+ '("psellipse" [LaTeX-pst-parameters]
+ (LaTeX-pst-macro-pnt-twolen "Radius x" "Radius y"))
+ '("psellipse*" [LaTeX-pst-parameters]
+ (LaTeX-pst-macro-pnt-twolen "Radius x" "Radius y"))
+ '("psframe" [LaTeX-pst-parameters] LaTeX-pst-macro-psframe)
+ '("psframe*" [LaTeX-pst-parameters] LaTeX-pst-macro-psframe)
+ '("psframebox" [LaTeX-pst-parameters] t)
+ '("pscirclebox" [LaTeX-pst-parameters] t)
+ '("psdblframebox" [LaTeX-pst-parameters] t)
+ '("psdiabox" [LaTeX-pst-parameters] t)
+ '("psovalbox" [LaTeX-pst-parameters] t)
+ '("psshadowbox" [LaTeX-pst-parameters] t)
+ '("pstribox" [LaTeX-pst-parameters] t)
+ '("psscalebox" "Scaling Factor(s)" t)
+ '("psscaleboxto" LaTeX-pst-point-in-parens t)
+ '("psgrid" [LaTeX-pst-parameters] LaTeX-pst-macro-psgrid 0)
+ '("psline" [LaTeX-pst-parameters] LaTeX-pst-macro-psline)
+ '("psoverlay" t)
+ '("pspolygon" [LaTeX-pst-parameters] LaTeX-pst-macro-pspolygon)
+ '("pspolygon*" [LaTeX-pst-parameters] LaTeX-pst-macro-pspolygon)
+ '("psset" LaTeX-pst-parameters)
+ '("pssetlength" TeX-arg-macro "Length")
+ '("psaddtolength" TeX-arg-macro "Length")
+ '("degrees" ["Full Circle"])
+ '("qdisk" LaTeX-pst-point-in-parens "Radius")
+ '("qline" LaTeX-pst-point-in-parens LaTeX-pst-point-in-parens)
+ "pslongbox" "psrotatedown" "psrotateleft" "psrotateright"
+ '("rput" LaTeX-pst-macro-rput t)
+ '("rput*" LaTeX-pst-macro-rput t)
+ '("cput" [LaTeX-pst-parameters]
+ (TeX-arg-eval LaTeX-pst-angle) LaTeX-pst-point-in-parens t)
+ '("uput" LaTeX-pst-macro-uput t)
+ '("multirput" (LaTeX-pst-macro-multirputps t) t)
+ '("multips" (LaTeX-pst-macro-multirputps nil) t))))
+
+;;; pstricks.el ends here
diff --git a/tests/auctex-11.87.7/style/report.el
b/tests/auctex-11.87.7/style/report.el
new file mode 100644
index 0000000..6791f42
--- /dev/null
+++ b/tests/auctex-11.87.7/style/report.el
@@ -0,0 +1,12 @@
+;;; report.el - Special code for report style.
+
+;; $Id: report.el,v 1.3 2005-03-17 10:02:06 angeli Exp $
+
+;;; Code:
+
+(TeX-add-style-hook
+ "report"
+ (lambda ()
+ (LaTeX-largest-level-set "chapter")))
+
+;;; report.el ends here
diff --git a/tests/auctex-11.87.7/style/ruby.el
b/tests/auctex-11.87.7/style/ruby.el
new file mode 100644
index 0000000..0a96e57
--- /dev/null
+++ b/tests/auctex-11.87.7/style/ruby.el
@@ -0,0 +1,49 @@
+;;; ruby.el --- AUCTeX style for the ruby package.
+
+;; Copyright (C) 2009 Free Software Foundation, Inc.
+
+;; Author: Ralf Angeli <angeli@caeruleus.net>
+;; Maintainer: auctex-devel@gnu.org
+;; Created: 2009-01-04
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; This file adds support for the ruby package.
+
+;;; Code:
+
+(defvar LaTeX-ruby-package-options
+ '("overlap" "nooverlap" "CJK" "latin")
+ "Package options for the ruby package.")
+
+(TeX-add-style-hook
+ "ruby"
+ (lambda ()
+ (TeX-add-symbols
+ '("rubyoverlap" 0)
+ '("rubynooverlap" 0)
+ '("rubyCJK" 0)
+ '("rubylatin" 0)
+ '("rubysize" 0)
+ '("rubysep" 0)
+ '("ruby" t nil))))
+
+;;; ruby.el ends here
diff --git a/tests/auctex-11.87.7/style/scrartcl.el
b/tests/auctex-11.87.7/style/scrartcl.el
new file mode 100644
index 0000000..fb69221
--- /dev/null
+++ b/tests/auctex-11.87.7/style/scrartcl.el
@@ -0,0 +1,26 @@
+;;; -*- emacs-lisp -*-
+;;; scrartcl.el -- AUCTeX style for scrartcl.cls
+
+;; Copyright (C) 2002, 2005 Free Software Foundation
+;; License: GPL, see the file COPYING in the base directory of AUCTeX
+
+;; Author: Mark Trettin <Mark.Trettin@gmx.de>
+;; Created: 2002-09-26
+;; Version: $Id: scrartcl.el,v 1.4 2005-03-17 10:02:06 angeli Exp $
+;; Keywords: tex
+
+;;; Commentary:
+
+;; This file adds support for `scrartcl.cls'. This file needs
+;; `scrbase.el'.
+
+;; This file is part of AUCTeX.
+
+;;; Code:
+(TeX-add-style-hook "scrartcl"
+ (lambda ()
+ (LaTeX-largest-level-set "section")
+ ;; load basic definitons
+ (TeX-run-style-hooks "scrbase")))
+
+;;; scrartcl.el ends here
diff --git a/tests/auctex-11.87.7/style/scrbase.el
b/tests/auctex-11.87.7/style/scrbase.el
new file mode 100644
index 0000000..5a8b41f
--- /dev/null
+++ b/tests/auctex-11.87.7/style/scrbase.el
@@ -0,0 +1,222 @@
+;;; scrbase.el --- AUCTeX style for the KOMA-Script bundle.
+
+;; Copyright (C) 2002, 2004, 2005, 2007 Free Software Foundation, Inc.
+
+;; Author: Mark Trettin <Mark.Trettin@gmx.de>
+;; Created: 2002-09-26
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; This file adds support for the KOMA-Script bundle. This file
+;; contains the base definitions that work with all KOMA-Script
+;; classes (scrarctl.cls, scrreprt.cls, scrbook.cls and scrlttr2.cls).
+;; You need this file since it's loaded from the class-styles.
+
+;;; Code:
+(TeX-add-style-hook "scrbase"
+ (lambda ()
+ (TeX-add-symbols
+ "appendixmore"
+ "autodot"
+ '("addtokomafont" TeX-arg-KOMA-fontelements t)
+ '("areaset" [ "BCOR" ] "Width" "Height")
+ '("captionabove" [ "Lof entry" ] "Caption")
+ '("captionbelow" [ "Lof entry" ] "Caption")
+ '("cleardoubleemptypage")
+ '("cleardoubleplainpage")
+ '("cleardoublestandardpage")
+ '("dedication" t)
+ '("deffootnote" [ "Mark width" ] "Indent" "Parindent" "Definition")
+ '("deffootnotemark" "Definition")
+ '("extratitle" t)
+ '("ifpdfoutput" t nil)
+ '("ifthispageodd" t nil)
+ '("lowertitleback" t)
+ '("maketitle" [ "Pagenumber" ])
+ '("marginline" t)
+ '("publishers" "Publishers")
+ '("sectionmark" "Running head")
+ '("setbibpreamble" "Preamble")
+ '("setcaphanging")
+ '("setcapindent" "Indent")
+ '("setcapindent*" "X-Indent")
+ '("setcapmargin" [ "Margin left" ] "Margin")
+ '("setcapmargin*" [ "Margin inside" ] "Margin")
+ '("setcapwidth" [ TeX-arg-KOMA-capjust ] "Width")
+ '("setindexpreamble" "Preamble")
+ '("setkomafont" TeX-arg-KOMA-fontelements t)
+ '("subject" "Subject")
+ '("subsectionmark" "Running head")
+ '("textsubscript" "Text")
+ '("thanks" "Footnote")
+ '("thefootnotemark")
+ '("titlehead" t)
+ '("uppertitleback" t)
+ '("usekomafont" TeX-arg-KOMA-fontelements))
+ (LaTeX-add-environments
+ '("labeling" (lambda (env &rest ignore)
+ (LaTeX-insert-environment
+ env
+ (let ((delim (read-string "(Optional) Delimiter: "))
+ (width (read-string "Longest item: ")))
+ (concat
+ (if (not (zerop (length delim)))
+ (format "[%s]" delim))
+ (format "{%s}" width))))
+ (LaTeX-find-matching-begin)
+ (end-of-line 1)
+ (LaTeX-insert-item)))
+ '("addmargin" (lambda (env &rest ignore)
+ (LaTeX-insert-environment
+ env
+ (let ((leftin (read-string "(Optional) Left Indentation:
"))
+ (indent (read-string "Indentation: ")))
+ (concat
+ (if (not (zerop (length leftin)))
+ (format "[%s]" leftin))
+ (format "{%s}" indent))))))
+ '("addmargin*" (lambda (env &rest ignore)
+ (LaTeX-insert-environment
+ env
+ (let ((innin (read-string "(Optional) Inner Indentation:
"))
+ (indent (read-string "Indentation: ")))
+ (concat
+ (if (not (zerop (length innin)))
+ (format "[%s]" innin))
+ (format "{%s}" indent))))))
+ '("captionbeside" (lambda (env &rest ignore)
+ (LaTeX-insert-environment
+ env
+ (let ((lofent (read-string "(Optional) Lof Entry: "))
+ (title (read-string "Caption: "))
+ (place (read-string "(Optional) Placement
(l,r,o,i): "))
+ (width (read-string "(Optional) Width: "))
+ (offset (read-string "(Optional) Offset: ")))
+ (concat
+ (if (not (zerop (length lofent)))
+ (format "[%s]" lofent))
+ (format "{%s}" title)
+ (if (not (zerop (length place)))
+ (format "[%s]" place))
+ (if (not (zerop (length width)))
+ (format "[%s]" width))
+ (and
+ (not (zerop (length place)))
+ (not (zerop (length offset)))
+ (format "[%s]%s" offset
+ (if (y-or-n-p "Starred? ")
+ "*" "")))))))))
+ (LaTeX-section-list-add-locally '(("addpart" 0)
+ ("addsec" 2)
+ ("minisec" 7)))
+ ;; This doesn't work. Maybe it's RefTeX's label insertion?
+ (make-local-variable 'LaTeX-section-label)
+ (setq LaTeX-section-label (append
+ LaTeX-section-label
+ '(("addpart" . nil)
+ ("addsec" . nil)
+ ("minisec" . nil))))
+ ;; Fontification
+ (when (and (featurep 'font-latex)
+ (eq TeX-install-font-lock 'font-latex-setup))
+ ;; Textual keywords
+ (font-latex-add-keywords '(("captionabove" "[{")
+ ("captionbelow" "[{")
+ ("dedication" "{")
+ ("extratitle" "{")
+ ("lowertitleback" "{")
+ ("maketitle" "[")
+ ("marginline" "{")
+ ("publishers" "{")
+ ("subject" "{")
+ ("sectionmark" "{")
+ ("setbibpreamble" "{")
+ ("setindexpreamble" "{")
+ ("subsectionmark" "{")
+ ("textsubscript" "{")
+ ("titlehead" "{")
+ ("uppertitleback" "{"))
+ 'textual)
+ ;; Function keywords
+ (font-latex-add-keywords '(("deffootnote" "[{{{")
+ ("deffootnotemark" "{")
+ ("ifpdfoutput" "{{")
+ ("ifthispageodd" "{{"))
+ 'function)
+ ;; Variable keywords
+ (font-latex-add-keywords '(("addtokomafont" "{{")
+ ("areaset" "[{{")
+ ("setcaphanging" "")
+ ("setcapindent" "{")
+ ("setcapmargin" "*[{")
+ ("setcapwidth" "[{")
+ ("setkomafont" "{{")
+ ("typearea" "[{")
+ ("usekomafont" "{"))
+ 'variable)
+ ;; Warning keywords
+ (font-latex-add-keywords '("cleardoublestandardpage"
+ "cleardoubleplainpage"
+ "cleardoubleemptypage")
+ 'warning)
+ ;; Sectioning keywords
+ (font-latex-add-keywords '(("addpart" "[{")) 'sectioning-1)
+ (font-latex-add-keywords '(("addsec" "[{")) 'sectioning-2)
+ (font-latex-add-keywords '(("minisec" "[{")) 'sectioning-4))))
+
+(defun TeX-arg-KOMA-setpreamble (optional &optional prompt)
+ "Prompt for KOMA-Script's \\set*preamble position with completion."
+ (TeX-argument-insert
+ (completing-read
+ (TeX-argument-prompt optional prompt "Position")
+ '(("") ("l") ("r") ("c") ("o") ("u")
+ ("lo") ("lu") ("ro") ("ru") ("co") ("cu"))
+ nil t)
+ optional))
+
+(defun TeX-arg-KOMA-capjust (optional &optional prompt)
+ "Prompt for KOMA-Script's \\setcapwidth justification with completion."
+ (TeX-argument-insert
+ (completing-read
+ (TeX-argument-prompt optional prompt "Justification")
+ '(("") ("l") ("r") ("c") ("i") ("o"))
+ nil t)
+ optional))
+
+(defun TeX-arg-KOMA-fontelements (optional &optional prompt)
+ "Prompt for KOMA-Script's fontelements with completion."
+ (TeX-argument-insert
+ (completing-read
+ (TeX-argument-prompt optional prompt "Element")
+ '(("")
+ ("caption") ("captionlabel")
+ ("descriptionlabel") ("dictum") ("dictumauthor") ("dictumtext")
+ ("footnote") ("footnotelabel") ("footnotereference")
+ ("pagefoot") ("pagehead") ("pagenumber") ("pagination")
+ ("sectioning") ("part") ("partnumber") ("chapter") ("section")
+ ("subsection") ("subsubsection") ("paragraph") ("subparagraph")
+ ("title") ("disposition") ("minisec"))
+ nil t)
+ optional))
+
+(add-to-list 'LaTeX-item-list '("labeling" . LaTeX-item-argument))
+
+;;; scrbase.el ends here
diff --git a/tests/auctex-11.87.7/style/scrbook.el
b/tests/auctex-11.87.7/style/scrbook.el
new file mode 100644
index 0000000..6cada7d
--- /dev/null
+++ b/tests/auctex-11.87.7/style/scrbook.el
@@ -0,0 +1,62 @@
+;;; scrbook.el --- AUCTeX style for scrbook.cls
+
+;; Copyright (C) 2002, 2005 Free Software Foundation
+
+;; Author: Mark Trettin <Mark.Trettin@gmx.de>
+;; Created: 2002-09-26
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; This file adds support for `scrbook.cls'. This file needs
+;; `scrbase.el'.
+
+;;; Code:
+
+(TeX-add-style-hook "scrbook"
+ (lambda ()
+ (LaTeX-largest-level-set "chapter")
+ ;; load basic definitons
+ (TeX-run-style-hooks "scrbase")
+ (TeX-add-symbols
+ "chapapp"
+ "raggeddictum"
+ '("chapappifchapterprefix" "Additional text")
+ '("setpartpreamble" [ TeX-arg-KOMA-setpreamble ] [ "Width" ] t)
+ '("setchapterpreamble" [ TeX-arg-KOMA-setpreamble ] [ "Width" ] t)
+ '("dictum" [ "Author" ] t))
+ (LaTeX-section-list-add-locally '("addchap" 1))
+ (make-local-variable 'LaTeX-section-label)
+ (setq LaTeX-section-label (append
+ LaTeX-section-label
+ '(("addchap" . nil))))
+ ;; Definitions for font-latex
+ (when (and (featurep 'font-latex)
+ (eq TeX-install-font-lock 'font-latex-setup))
+ ;; Textual keywords
+ (font-latex-add-keywords '(("addchap" "[{")
+ ("setpartpreamble" "[[{")
+ ("setchapterpreamble" "[[{")
+ ("dictum" "[{"))
+ 'textual)
+ ;; Sectioning keywords
+ (font-latex-add-keywords '(("addchap" "[{")) 'sectioning-1))))
+
+;;; scrbook.el ends here
diff --git a/tests/auctex-11.87.7/style/scrlttr2.el
b/tests/auctex-11.87.7/style/scrlttr2.el
new file mode 100644
index 0000000..136b1c5
--- /dev/null
+++ b/tests/auctex-11.87.7/style/scrlttr2.el
@@ -0,0 +1,239 @@
+;;; scrlttr2.el --- AUCTeX style for scrlttr2.cls.
+
+;; Copyright (C) 2002, 2007 Free Software Foundation
+
+;; Author: Mark Trettin <Mark.Trettin@gmx.de>
+;; Created: 2002-10-26
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; This file adds support for `scrlttr2.cls'.
+
+;; Since I just recently switched from `g-brief.cls' to the
+;; KOMA-Script letter class *and* I don't really write many
+;; snailmails, there are probably some superflous macros included and
+;; important ones left out. Comments appreciated.
+
+;; I left out any length and positioning macros since those should be
+;; set in a personal `*.lco'-File. IMHO.
+
+;;; Code
+
+(TeX-add-style-hook "scrlttr2"
+ (lambda ()
+ (TeX-add-symbols
+ '("AtBeginLetter" t)
+ '("KOMAoptions" t)
+ '("LetterOptionNeedsPapersize" "Name of lco file" "Paper size")
+ '("LoadLetterOption" "Name of lco file")
+ '("addrchar" "Initial letter")
+ '("addrentry" "Lastname" "Firstname" "Address" "Telephone" "F1"
+ "F2" "F3" "F4" "Key")
+ '("addtokomafont" TeX-arg-KOMA-scrlttr-fontelements t)
+ '("addtolengthplength" [ "Factor" ] "Name of length"
+ "Name of pseudo length")
+ '("addtoreffields" TeX-arg-KOMA-scrlttr-vars)
+ '("adrchar" "Initial letter")
+ '("adrentry" "Lastname" "Firstname" "Address" "Telephone" "F1"
+ "F2" "Comment" "Key")
+ '("bankname" t)
+ '("captionsUKenglish" nil)
+ '("captionsUSenglish" nil)
+ '("captionsamerican" nil)
+ '("captionsaustrian" nil)
+ '("captionsbritish" nil)
+ '("captionscroatian" nil)
+ '("captionsdutch" nil)
+ '("captionsenglish" nil)
+ '("captionsfrench" nil)
+ '("captionsgerman" nil)
+ '("captionsitalian" nil)
+ '("captionsngerman" nil)
+ '("captionsspanish" nil)
+ '("cc" t)
+ '("ccname" t)
+ '("cleardoubleemptypage")
+ '("cleardoubleplainpage")
+ '("cleardoublestandardpage")
+ '("closing" "Closing Phrase")
+ '("customername" t)
+ '("dateUKenglish" nil)
+ '("dateUSenglish" nil)
+ '("dateamerican" nil)
+ '("dateaustrian" nil)
+ '("datebritish" nil)
+ '("datecroatian" nil)
+ '("datedutch" nil)
+ '("dateenglish" nil)
+ '("datefrench" nil)
+ '("dategerman" nil)
+ '("dateitalian" nil)
+ '("datename" t)
+ '("datengerman" nil)
+ '("datespanish" nil)
+ '("emailname" t)
+ '("encl" t)
+ '("enclname" t)
+ '("faxname" t)
+ '("firstfoot" t)
+ '("firsthead" t)
+ '("headfromname" t)
+ '("headtoname" t)
+ '("ifkomavarempty" TeX-arg-KOMA-scrlttr-vars 2)
+ '("ifkomavarempty*" TeX-arg-KOMA-scrlttr-vars 2)
+ '("invoicename" t)
+ '("myrefname" t)
+ '("newcaptionname" "Language" "Term" "Definition")
+ '("newkomavar" [ "Description" ] "Name")
+ '("newkomavar*" [ "Description" ] "Name")
+ '("nextfoot" t)
+ '("nexthead" t)
+ '("opening" "Opening")
+ '("pagename" t)
+ '("phonename" t)
+ '("providecaptionname" "Language" "Term" "Definition")
+ '("ps")
+ '("raggedsignature" nil)
+ '("renewcaptionname" "Language" "Term" "Definition")
+ '("setkomafont" TeX-arg-KOMA-scrlttr-fontelements t)
+ '("setkomavar" TeX-arg-KOMA-scrlttr-vars [ "Description" ] t)
+ '("setkomavar*" TeX-arg-KOMA-scrlttr-vars "Description")
+ '("setlengthtoplength" [ "Factor" ] "Name of length"
+ "Name of pseudo length")
+ '("subjectname" t)
+ '("usekomafont" TeX-arg-KOMA-scrlttr-fontelements)
+ '("usekomavar" [ "Command" ] TeX-arg-KOMA-scrlttr-vars)
+ '("usekomavar*" [ "Command" ] TeX-arg-KOMA-scrlttr-vars)
+ '("useplength" "Name")
+ '("wwwname" t)
+ '("yourmailname" t)
+ '("yourrefname" t))
+ (LaTeX-add-environments
+ '("letter" (lambda (env &rest ignore)
+ (LaTeX-insert-environment
+ env
+ (let ((options (read-string "Optional options: "))
+ (recip (read-string "Recipient: ")))
+ (concat
+ (if (not (zerop (length options)))
+ (format "[%s]" options))
+ (format "{%s}" recip)))))))
+ ;; Definitions for font-latex
+ (when (and (featurep 'font-latex)
+ (eq TeX-install-font-lock 'font-latex-setup))
+ ;; Textual keywords
+ (font-latex-add-keywords '(("addrentry" "{{{{{{{{{")
+ ("adrentry" "{{{{{{{{")
+ ("bankname" "{")
+ ("cc" "{")
+ ("ccname" "{")
+ ("closing" "{")
+ ("customername" "{")
+ ("datename" "{")
+ ("emailname" "{")
+ ("encl" "{")
+ ("enclname" "{")
+ ("faxname" "{")
+ ("firstfoot" "{")
+ ("firsthead" "{")
+ ("headfromname" "{")
+ ("headtoname" "{")
+ ("invoicename" "{")
+ ("myrefname" "{")
+ ("nextfoot" "{")
+ ("nexthead" "{")
+ ("opening" "{")
+ ("pagename" "{")
+ ("phonename" "{")
+ ("ps" "")
+ ("subjectname" "{")
+ ("wwwname" "{")
+ ("yourmailname" "{")
+ ("yourrefname" "{"))
+ 'textual)
+ ;; Function keywords
+ (font-latex-add-keywords '(("AtBeginLetter" "{")
+ ("LetterOptionNeedsPapersize" "{{")
+ ("LoadLetterOption" "{")
+ ("addrchar" "{")
+ ("adrchar" "{")
+ ("ifkomavarempty" "*{{{"))
+ 'function)
+ ;; Variable keywords
+ (font-latex-add-keywords '(("KOMAoptions" "{")
+ ("addtokomafont" "{{")
+ ("addtolengthplength" "[{{")
+ ("addtoreffields" "{")
+ ("newcaptionname" "{{{")
+ ("newkomavar" "*[{")
+ ("providecaptionname" "{{{")
+ ("renewcaptionname" "{{{")
+ ("setkomafont" "{{")
+ ("setkomavar" "*{[{")
+ ("setlengthtoplength" "[{{")
+ ("usekomafont" "{")
+ ("usekomavar" "*[{")
+ ("useplength" "{"))
+ 'variable)
+ ;; Warning keywords
+ (font-latex-add-keywords '("cleardoublestandardpage"
+ "cleardoubleplainpage"
+ "cleardoubleemptypage")
+ 'warning))))
+
+(defun TeX-arg-KOMA-scrlttr-vars (optional &optional prompt)
+ "Prompt for KOMA-Script's scrlttr2 predefined variables with completion."
+ (TeX-argument-insert
+ (completing-read
+ (TeX-argument-prompt optional prompt "Variable")
+ '(("")
+ ("backaddress") ("backaddressseparator")
+ ("ccseparator") ("customer")
+ ("date")
+ ("emailseparator") ("enclseparator")
+ ("faxseparator") ("frombank") ("fromaddress") ("fromemail")
+ ("fromfax") ("fromlogo") ("fromname") ("fromphone") ("fromurl")
+ ("invoice")
+ ("location")
+ ("myref")
+ ("place") ("placeseparator") ("phoneseparator")
+ ("signature") ("specialmail") ("subject") ("subjectseparator")
+ ("title") ("toname") ("toaddress")
+ ("yourmail") ("yourref"))
+ nil nil)
+ optional))
+
+(defun TeX-arg-KOMA-scrlttr-fontelements (optional &optional prompt)
+ "Prompt for KOMA-Script's scrlttr2 fontelements with completion."
+ (TeX-argument-insert
+ (completing-read
+ (TeX-argument-prompt optional prompt "Element")
+ '(("")
+ ("backaddress")
+ ("descriptionlabel")
+ ("fromaddress") ("fromname")
+ ("pagefoot") ("pagehead") ("pagenumber")
+ ("subject")
+ ("title"))
+ nil t)
+ optional))
+
+;;; scrlttr2.el ends here
diff --git a/tests/auctex-11.87.7/style/scrpage2.el
b/tests/auctex-11.87.7/style/scrpage2.el
new file mode 100644
index 0000000..ed3d500
--- /dev/null
+++ b/tests/auctex-11.87.7/style/scrpage2.el
@@ -0,0 +1,129 @@
+;;; scrpage2.el --- AUCTeX style for scrpage2.sty.
+
+;; Author: Ralf Angeli <angeli@iwi.uni-sb.de>
+;; Created: 2003-11-01
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; This file adds support for `scrpage2.sty'.
+
+;;; Code:
+
+(TeX-add-style-hook
+ "scrpage2"
+ (lambda ()
+
+ ;; New symbols
+ (TeX-add-symbols
+ '("lehead" [ "scrplain-left-even" ] "scrheadings-left-even")
+ '("cehead" [ "scrplain-center-even" ] "scrheadings-center-even")
+ '("rehead" [ "scrplain-right-even" ] "scrheadings-right-even")
+ '("lefoot" [ "scrplain-left-even" ] "scrheadings-left-even")
+ '("cefoot" [ "scrplain-center-even" ] "scrheadings-center-even")
+ '("refoot" [ "scrplain-right-even" ] "scrheadings-right-even")
+ '("lohead" [ "scrplain-left-odd" ] "scrheadings-left-odd")
+ '("cohead" [ "scrplain-center-odd" ] "scrheadings-center-odd")
+ '("rohead" [ "scrplain-right-odd" ] "scrheadings-right-odd")
+ '("lofoot" [ "scrplain-left-odd" ] "scrheadings-left-odd")
+ '("cofoot" [ "scrplain-center-odd" ] "scrheadings-center-odd")
+ '("rofoot" [ "scrplain-right-odd" ] "scrheadings-right-odd")
+ '("ihead" [ "scrplain-inside" ] "scrheadings-inside")
+ '("chead" [ "scrplain-center" ] "scrheadings-center")
+ '("ohead" [ "scrplain-outside" ] "scrheadings-outside")
+ '("ifoot" [ "scrplain-inside" ] "scrheadings-inside")
+ '("cfoot" [ "scrplain-center" ] "scrheadings-center")
+ '("ofoot" [ "scrplain-outside" ] "scrheadings-outside")
+ '("clearscrheadfoot")
+ '("clearscrheadings")
+ '("clearscrplain")
+ '("automark" [ "Right page" ] "Left page")
+ '("headmark")
+ '("manualmark")
+ '("pagemark")
+ '("leftmark")
+ '("rightmark")
+ '("setfootwidth" [ "Offset" ] "Width")
+ '("setheadwidth" [ "Offset" ] "Width")
+ '("setfootbotline" [ "Length" ] "Thickness")
+ '("setfootsepline" [ "Length" ] "Thickness")
+ '("setheadtopline" [ "Length" ] "Thickness")
+ '("setheadsepline" [ "Length" ] "Thickness")
+ '("deftripstyle" "Name" [ "Thickness of outer line" ]
+ [ "Thickness of inner line" ] "Inner box of page head"
+ "Center box of page head" "Outer box of page head"
+ "Inner box of page foot" "Center box of page foot"
+ "Outer box of page foot")
+ '("defpagestyle" "Name" "Head definition" "Foot definition")
+ '("newpagestyle" "Name" "Head definition" "Foot definition")
+ '("renewpagestyle" "Name" "Head definition" "Foot definition")
+ '("providepagestyle" "Name" "Head definition" "Foot definition"))
+
+ ;; Fontification
+ (when (and (featurep 'font-latex)
+ (eq TeX-install-font-lock 'font-latex-setup))
+ (font-latex-add-keywords '(("lehead" "[{")
+ ("cehead" "[{")
+ ("rehead" "[{")
+ ("lefoot" "[{")
+ ("cefoot" "[{")
+ ("refoot" "[{")
+ ("lohead" "[{")
+ ("cohead" "[{")
+ ("rohead" "[{")
+ ("lofoot" "[{")
+ ("cofoot" "[{")
+ ("rofoot" "[{")
+ ("ihead" "[{")
+ ("chead" "[{")
+ ("ohead" "[{")
+ ("ifoot" "[{")
+ ("cfoot" "[{")
+ ("ofoot" "[{")
+ ("automark" "[{")
+ ("setfootwidth" "[{")
+ ("setheadwidth" "[{")
+ ("setfootbotline" "[{")
+ ("setfootsepline" "[{")
+ ("setheadtopline" "[{")
+ ("setheadsepline" "[{"))
+ 'variable)
+ (font-latex-add-keywords '(("deftripstyle" "{[[{{{{{{")
+ ("defpagestyle" "{{{")
+ ("newpagestyle" "{{{")
+ ("renewpagestyle" "{{{")
+ ("providepagestyle" "{{{"))
+ 'function))))
+
+(defvar LaTeX-scrpage2-package-options '("headinclude" "headexclude"
+ "footinclude" "footexclude"
+ "mpinclude" "mpexclude"
+ "headtopline" "headsepline"
+ "footsepline" "footbotline"
+ "plainheadtopline" "plainheadsepline"
+ "plainfootsepline" "plainfootbotline"
+ "ilines" "clines" "olines"
+ "automark" "manualmark"
+ "autooneside" "markuppercase"
+ "markusedcase" "nouppercase"
+ "komastyle" "standardstyle")
+ "Package options for the scrpage2 package.")
+
+;;; scrpage2.el ends here
diff --git a/tests/auctex-11.87.7/style/scrreprt.el
b/tests/auctex-11.87.7/style/scrreprt.el
new file mode 100644
index 0000000..2ffe3ad
--- /dev/null
+++ b/tests/auctex-11.87.7/style/scrreprt.el
@@ -0,0 +1,63 @@
+;;; scrreprt.el --- AUCTeX style for scrreprt.cls.
+
+;; Copyright (C) 2002, 2005 Free Software Foundation
+
+;; Author: Mark Trettin <Mark.Trettin@gmx.de>
+;; Created: 2002-09-26
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; This file adds support for `scrreprt.cls'. This file needs
+;; `scrbase.el'.
+
+;;; Code:
+
+(TeX-add-style-hook
+ "scrreprt"
+ (lambda ()
+ (LaTeX-largest-level-set "chapter")
+ ;; load basic definitons
+ (TeX-run-style-hooks "scrbase")
+ (TeX-add-symbols
+ "chapapp"
+ "raggeddictum"
+ '("chapappifchapterprefix" "Additional text")
+ '("setpartpreamble" [ TeX-arg-KOMA-setpreamble ] [ "Width" ] t)
+ '("setchapterpreamble" [ TeX-arg-KOMA-setpreamble ] [ "Width" ] t)
+ '("dictum" [ "Author" ] t))
+ (LaTeX-section-list-add-locally '("addchap" 1))
+ (make-local-variable 'LaTeX-section-label)
+ (setq LaTeX-section-label (append
+ LaTeX-section-label
+ '(("addchap" . nil))))
+ ;; Definitions for font-latex
+ (when (and (featurep 'font-latex)
+ (eq TeX-install-font-lock 'font-latex-setup))
+ ;; Textual keywords
+ (font-latex-add-keywords '(("addchap" "[{")
+ ("setpartpreamble" "[[{")
+ ("setchapterpreamble" "[[{")
+ ("dictum" "[{"))
+ 'textual)
+ ;; Sectioning keywords
+ (font-latex-add-keywords '(("addchap" "[{")) 'sectioning-1))))
+
+;;; scrreprt.el ends here
diff --git a/tests/auctex-11.87.7/style/setspace.el
b/tests/auctex-11.87.7/style/setspace.el
new file mode 100644
index 0000000..07db8ca
--- /dev/null
+++ b/tests/auctex-11.87.7/style/setspace.el
@@ -0,0 +1,61 @@
+;;; setspace.el --- AUCTeX style for `setspace.sty'
+
+;; Copyright (C) 2011 Free Software Foundation, Inc.
+
+;; Author: Mads Jensen <mje@inducks.org>
+;; Created: 2011-04-16
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; This file adds support for `setspace.sty'.
+
+;;; Code:
+
+(TeX-add-style-hook
+ "setspace"
+ (lambda ()
+ (TeX-add-symbols
+ '("setstretch" "Stretch")
+ '("setdisplayskipstretch" "Stretch")
+ '("SetSinglespace" "Stretch")
+ '("onehalfspacing" 0)
+ '("doublespacing" 0)
+ '("singlespacing" 0))
+
+ (LaTeX-add-environments
+ '("spacing" "Stretch")
+ "singlespace"
+ "singlespace*"
+ "onehalfspace"
+ "doublespace")
+
+ (when (and (featurep 'font-latex)
+ (eq TeX-install-font-lock 'font-latex-setup))
+ (font-latex-add-keywords '(("singlespacing" "")
+ ("doublespacing" "")
+ ("onehalfspacing" ""))
+ 'function))))
+
+(defvar LaTeX-setspace-package-options
+ '("doublespacing" "onehalfspacing" "singlespacing" "nodisplayskipstretch")
+ "Package options for the setspace package.")
+
+;;; setspace.el ends here
diff --git a/tests/auctex-11.87.7/style/shortvrb.el
b/tests/auctex-11.87.7/style/shortvrb.el
new file mode 100644
index 0000000..2ef191a
--- /dev/null
+++ b/tests/auctex-11.87.7/style/shortvrb.el
@@ -0,0 +1,56 @@
+;;; shortvrb.el --- AUCTeX style for `shortvrb.sty'
+
+;; Copyright (C) 2009 Free Software Foundation, Inc.
+
+;; Author: Ralf Angeli <angeli@caeruleus.net>
+;; Maintainer: auctex-devel@gnu.org
+;; Created: 2009-12-23
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; This file adds support for `shortvrb.sty'.
+
+;; XXX: We might want provide users with the possibility to activate
+;; something like this for any file (incl. Plain TeX). That would
+;; bring us one step closer to the goal of displaying texbook.tex
+;; without font locking going haywire.
+
+;; FIXME: The code does not work for preview.dtx because in that file
+;; the style list is empty. In its master file, preview.drv, it
+;; works, however. However, even if the style file is loaded by hand,
+;; it fails to fontify verbatim text in the documentation parts of the
+;; file.
+
+;;; Code:
+
+(TeX-add-style-hook
+ "shortvrb"
+ (lambda ()
+ ;; Fontification
+ (when (and LaTeX-shortvrb-chars
+ (fboundp 'font-latex-set-syntactic-keywords)
+ (eq TeX-install-font-lock 'font-latex-setup))
+ (let (syntax-alist)
+ (dolist (char LaTeX-shortvrb-chars)
+ (add-to-list 'syntax-alist (cons char "|")))
+ (font-latex-add-to-syntax-alist syntax-alist)))))
+
+;;; shortvrb.el ends here
diff --git a/tests/auctex-11.87.7/style/slides.el
b/tests/auctex-11.87.7/style/slides.el
new file mode 100644
index 0000000..9e16024
--- /dev/null
+++ b/tests/auctex-11.87.7/style/slides.el
@@ -0,0 +1,41 @@
+;;; slides.el --- AUCTeX style for the `slides' document class
+
+;; Copyright (C) 2004 Free Software Foundation, Inc.
+
+;; Author: Ralf Angeli <angeli@iwi.uni-sb.de>
+;; Maintainer: auctex-devel@gnu.org
+;; Created: 2004-04-21
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; This file adds support for the `slides' document class. Currently
+;; the support is very limited. You are welcome to improve it.
+
+;;; Code:
+
+(TeX-add-style-hook
+ "slides"
+ (lambda ()
+ (LaTeX-add-environments "slide"
+ "overlay"
+ "note")))
+
+;;; slides.el ends here
diff --git a/tests/auctex-11.87.7/style/slovak.el
b/tests/auctex-11.87.7/style/slovak.el
new file mode 100644
index 0000000..d147573
--- /dev/null
+++ b/tests/auctex-11.87.7/style/slovak.el
@@ -0,0 +1,11 @@
+;;; slovak.el --- Setup AUCTeX for editing Slovak text.
+
+(TeX-add-style-hook
+ "slovak"
+ (lambda ()
+ (unless (eq (car TeX-quote-language) 'override)
+ (setq TeX-quote-language `("slovak" "\\uv{" "}" ,TeX-quote-after-quote)))
+ (when (fboundp 'font-latex-add-quotes)
+ (font-latex-add-quotes '("\"`" "\"'"))
+ (font-latex-add-quotes '("\"<" "\">" french)))
+ (run-hooks 'TeX-language-sk-hook)))
diff --git a/tests/auctex-11.87.7/style/subfigure.el
b/tests/auctex-11.87.7/style/subfigure.el
new file mode 100644
index 0000000..945f540
--- /dev/null
+++ b/tests/auctex-11.87.7/style/subfigure.el
@@ -0,0 +1,73 @@
+;;; subfigure.el --- AUCTeX style file for subfigure.sty
+
+;; Copyright (C) 2003, 2005 Free Software Foundation, Inc.
+
+;; Author: Reiner Steib <Reiner.Steib@gmx.de>
+;; Maintainer: auctex-devel@gnu.org
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; AUCTeX style file for subfigure.sty
+
+;;; Code:
+
+(TeX-add-style-hook
+ "subfigure"
+ (lambda ()
+ (TeX-add-symbols
+ '("subfigure" [ "list entry" ] [ "sub caption" ] "figure")
+ '("subtable" [ "list entry" ] [ "sub caption" ] "figure")
+ '("Subref" TeX-arg-label)
+ '("subref" TeX-arg-label))
+ ;; TODO: add \subfig* lengths
+
+ ;; Install completion for labels:
+ (setq TeX-complete-list
+ (append
+ '(("\\\\subref{\\([^{}\n\r\\%,]*\\)" 1 LaTeX-label-list "}")
+ ("\\\\Subref{\\([^{}\n\r\\%,]*\\)" 1 LaTeX-label-list "}"))
+ TeX-complete-list))
+ ;; Fontification
+ (when (and (featurep 'font-latex)
+ (eq TeX-install-font-lock 'font-latex-setup))
+ (font-latex-add-keywords '(("subfigure" "[[{")
+ ("subtable" "[[{"))
+ 'textual)
+ (font-latex-add-keywords '(("Subref" "{")
+ ("subref" "{"))
+ 'reference))))
+
+(defvar LaTeX-subfigure-package-options '("normal" "hang" "center"
+ "centerlast" "nooneline"
+ "raggedright" "isu" "anne"
+ "scriptsize" "footnotesize"
+ "small" "normalsize" "large"
+ "Large" "rm" "sf" "tt" "md"
+ "bf" "up" "it" "sl" "sc" "RM"
+ "SF" "TT" "MD" "BF" "IT" "SL"
+ "SC" "UP" "figbotcap"
+ "figtopcap" "tabbotcap"
+ "tabtopcap" "FIGBOTCAP"
+ "FIGTOPCAP" "TABBOTCAP"
+ "TABTOPCAP" "loose" "tight")
+ "Package options for the subfigure package.")
+
+;;; subfigure.el ends here
diff --git a/tests/auctex-11.87.7/style/swedish.el
b/tests/auctex-11.87.7/style/swedish.el
new file mode 100644
index 0000000..75f6337
--- /dev/null
+++ b/tests/auctex-11.87.7/style/swedish.el
@@ -0,0 +1,14 @@
+;;; swedish.el --- Setup AUCTeX for editing Swedish text.
+
+;;; Commentary:
+;;
+;; Apparently the Swedes use ''this style'' quotations.
+
+(TeX-add-style-hook
+ "swedish"
+ (lambda ()
+ (unless (eq (car TeX-quote-language) 'override)
+ (setq TeX-quote-language
+ `("swedish" "''" ,TeX-close-quote ,TeX-quote-after-quote)))
+ (setq LaTeX-babel-hyphen-language "swedish")
+ (run-hooks 'TeX-language-sv-hook)))
diff --git a/tests/auctex-11.87.7/style/tabularx.el
b/tests/auctex-11.87.7/style/tabularx.el
new file mode 100644
index 0000000..0fc8234
--- /dev/null
+++ b/tests/auctex-11.87.7/style/tabularx.el
@@ -0,0 +1,52 @@
+;;; tabularx.el --- AUCTeX style for the tabularx package.
+
+;; Copyright (C) 2009 Free Software Foundation, Inc.
+
+;; Author: Ralf Angeli <angeli@caeruleus.net>
+;; Maintainer: auctex-devel@gnu.org
+;; Created: 2009-02-22
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; This file adds support for the tabularx package.
+
+;;; Code:
+
+(defvar LaTeX-tabularx-package-options
+ '("infoshow" "debugshow")
+ "Package options for the tabularx package.")
+
+(TeX-add-style-hook
+ "tabularx"
+ (lambda ()
+ ;; New symbols
+ (TeX-add-symbols
+ "tracingtabularx"
+ '("tabularxcolumn" 0))
+ ;; New environments
+ (LaTeX-add-environments
+ ;; XXX: The tabularx environment takes the same arguments as the
+ ;; tabular* environment. However, the supported tokens in the
+ ;; format can differ, so at some point in time we might want to
+ ;; separate tabular* and tabularx.
+ '("tabularx" LaTeX-env-tabular*))))
+
+;;; tabularx.el ends here
diff --git a/tests/auctex-11.87.7/style/units.el
b/tests/auctex-11.87.7/style/units.el
new file mode 100644
index 0000000..88ba73d
--- /dev/null
+++ b/tests/auctex-11.87.7/style/units.el
@@ -0,0 +1,49 @@
+;;; units.el --- AUCTeX style for the LaTeX package `units.sty' (v0.9b)
+
+;; Copyright (C) 2004, 2005 Free Software Foundation, Inc.
+
+;; Author: Christian Schlauer <cschl@arcor.de>
+;; Maintainer: auctex-devel@gnu.org
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; This file adds support for `units.sty'.
+
+;;; Code:
+
+(TeX-add-style-hook
+ "units"
+ (lambda ()
+ (TeX-add-symbols
+ '("unit" [ "Value" ] "Unit")
+ '("unitfrac" [ "Value" ] "Unit in numerator" "Unit in denominator"))
+ ;; units.sty requires the package nicefrac.sty, thus we enable the
+ ;; macros of nicefrac.sty, too
+ (TeX-run-style-hooks "nicefrac")
+ ;; Fontification
+ (when (and (featurep 'font-latex)
+ (eq TeX-install-font-lock 'font-latex-setup))
+ (font-latex-add-keywords '(("unit" "[{") ("unitfrac" "[{{")) 'textual))))
+
+(defvar LaTeX-units-package-options '("tight" "loose")
+ "Package options for the units package.")
+
+;;; units.el ends here
diff --git a/tests/auctex-11.87.7/style/url.el
b/tests/auctex-11.87.7/style/url.el
new file mode 100644
index 0000000..0084be4
--- /dev/null
+++ b/tests/auctex-11.87.7/style/url.el
@@ -0,0 +1,95 @@
+;;; url.el --- AUCTeX style for `url.sty'
+
+;; Copyright (C) 2004, 2005 Free Software Foundation, Inc.
+
+;; Author: Ralf Angeli <angeli@iwi.uni-sb.de>
+;; Maintainer: auctex-devel@gnu.org
+;; Created: 2004-10-13
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; This file adds support for `url.sty'.
+
+;;; Code:
+
+(TeX-add-style-hook
+ "url"
+ (lambda ()
+ ;; New symbols
+ (TeX-add-symbols
+ "Url"
+ "UrlBigBreakPenalty"
+ "UrlBigBreaks"
+ "UrlBreakPenalty"
+ "UrlBreaks"
+ "UrlFont"
+ "UrlLeft"
+ "UrlNoBreaks"
+ "UrlOrds"
+ "UrlRight"
+ "UrlSpecials"
+ "path"
+ "url"
+ "urldef"
+ '("urlstyle" TeX-arg-urlstyle))
+
+ (add-to-list 'LaTeX-verbatim-macros-with-delims-local "path")
+ (add-to-list 'LaTeX-verbatim-macros-with-delims-local "url")
+ (add-to-list 'LaTeX-verbatim-macros-with-braces-local "path")
+ (add-to-list 'LaTeX-verbatim-macros-with-braces-local "url")
+
+ ;; Fontification
+ (when (and (featurep 'font-latex)
+ (eq TeX-install-font-lock 'font-latex-setup))
+ (font-latex-add-keywords '(("path" "{") ("url" "{")) 'reference)
+ (font-latex-add-keywords '(("Url" "")
+ ("UrlBigBreakPenalty" "")
+ ("UrlBigBreaks" "")
+ ("UrlBreakPenalty" "")
+ ("UrlBreaks" "")
+ ("UrlFont" "")
+ ("UrlLeft" "")
+ ("UrlNoBreaks" "")
+ ("UrlOrds" "")
+ ("UrlRight" "")
+ ("UrlSpecials" "")
+ ("urldef" "")
+ ("urlstyle" "{"))
+ 'variable)
+ ;; For syntactic fontification, e.g. verbatim constructs.
+ (font-latex-set-syntactic-keywords)
+ ;; Tell font-lock about the update.
+ (setq font-lock-set-defaults nil)
+ (font-lock-set-defaults))))
+
+(defun TeX-arg-urlstyle (optional &optional prompt)
+ "Prompt for style used in \\urlstyle with completion."
+ (TeX-argument-insert
+ (completing-read (TeX-argument-prompt optional prompt "Style")
+ (mapcar 'list '("rm" "same" "sf" "tt"))
+ nil t)
+ optional))
+
+(defvar LaTeX-url-package-options '("hyphens" "obeyspaces" "spaces" "LY1"
+ "T1" "allowmove")
+ "Package options for the url package.")
+
+;;; url.el ends here
diff --git a/tests/auctex-11.87.7/style/varioref.el
b/tests/auctex-11.87.7/style/varioref.el
new file mode 100644
index 0000000..77c791b
--- /dev/null
+++ b/tests/auctex-11.87.7/style/varioref.el
@@ -0,0 +1,63 @@
+;;; varioref.el --- AUCTeX style file with support for varioref.sty
+
+;; Copyright (C) 1999 Free Software Foundation, Inc.
+
+;; Author: Carsten Dominik <dominik@strw.leidenuniv.nl>
+;; Maintainer: auctex-devel@gnu.org
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Code:
+
+(TeX-add-style-hook "varioref"
+ (lambda ()
+
+ (TeX-add-symbols
+
+ ;; The macros with label arguments
+ '("vref" TeX-arg-label)
+ '("vpageref" [ "Same page text" ] [ "different page text" ]
TeX-arg-label)
+ '("fullref" TeX-arg-label)
+
+ ;; And the other macros used for customization
+ "reftextbefore" "reftextfacebefore"
+ "reftextafter" "reftextfaceafter"
+ "reftextfaraway" "vreftextvario" "vrefwarning")
+
+ ;; Install completion for labels
+ (setq TeX-complete-list
+ (append
+ '(("\\\\vref{\\([^{}\n\r\\%,]*\\)" 1 LaTeX-label-list "}")
+ ("\\\\vpageref\\(\\[[^]]*\\]\\)*{\\([^{}\n\r\\%,]*\\)"
+ 2 LaTeX-label-list "}"))
+ TeX-complete-list))))
+
+(defvar LaTeX-varioref-package-options '("draft" "final" "afrikaans"
+ "american" "austrian" "naustrian"
+ "brazil" "breton" "catalan" "croatian"
+ "czech" "danish" "dutch" "english"
+ "esperanto" "finnish" "french"
+ "galician" "german" "ngerman" "greek"
+ "italian" "magyar" "norsk" "nynorsk"
+ "polish" "portuges" "romanian"
+ "russian" "slovak" "slovene"
+ "spanish" "swedish" "turkish"
+ "francais" "germanb")
+ "Package options for the varioref package.")
+
+;;; varioref.el ends here
diff --git a/tests/auctex-11.87.7/style/verbatim.el
b/tests/auctex-11.87.7/style/verbatim.el
new file mode 100644
index 0000000..2c95def
--- /dev/null
+++ b/tests/auctex-11.87.7/style/verbatim.el
@@ -0,0 +1,43 @@
+;;; verbatim.el --- Style hook for the verbatim package.
+
+;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;; Author: Masayuki Ataka <masayuki.ataka@gmail.com>
+;; Maintainer: auctex-devel@gnu.org
+;; Created: 2001/05/01
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; M-x TeX-auto-generate verbatim.sty makes garbages.
+
+;;; Code
+
+(TeX-add-style-hook "verbatim"
+ (function
+ (lambda ()
+ (LaTeX-add-environments
+ "comment")
+ (TeX-add-symbols
+ '("verbatiminput" TeX-arg-file)))))
+
+(defvar LaTeX-verbatim-package-options nil
+ "Package options for the verbatim package.")
+
+;;; verbatim.el ends here.
diff --git a/tests/auctex-11.87.7/style/virtex.el
b/tests/auctex-11.87.7/style/virtex.el
new file mode 100644
index 0000000..18f58bc
--- /dev/null
+++ b/tests/auctex-11.87.7/style/virtex.el
@@ -0,0 +1,82 @@
+;;; virtex.el - Common code for all TeX formats.
+
+;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
+
+;;; Code:
+
+(TeX-add-style-hook "virtex"
+ (lambda ()
+ (TeX-add-symbols "/" "above" "abovedisplayshortskip"
+ "abovedisplayskip" "abovewithdelims" "accent"
+ "adjdemerits" "advance" "afterassignment"
+ "aftergroup" "atop" "atopwithdelims" "badness"
+ "baselineskip" "batchmode" "begingroup"
+ "belowdisplayshortskip" "belowdisplayskip"
+ "binoppenalty" "botmark" "box" "boxmaxdepth"
+ "brokenpenalty" "catcode" "char" "chardef"
+ "cleaders" "closein" "closeout" "clubpenalty"
+ "copy" "count" "countdef" "cr" "crcr" "csname"
+ "day" "deadcycles" "def" "defaulthyphenchar"
+ "defaultskewchar" "delcode" "delimiter"
+ "delimiterfactor" "delimitershortfall" "dimen"
+ "dimendef" "discretionary" "displayindent"
+ "displaylimits" "displaystyle"
+ "displaywidowpenalty" "displaywidth" "divide"
+ "doublehyphendemerits" "dp" "dump" "edef" "else"
+ "emergencystretch" "end" "endcsname" "endgroup"
+ "endinput" "endlinechar" "eqno" "errhelp"
+ "errmessage" "errorcontextlines" "errorstopmode"
+ "escapechar" "everycr" "everydisplay"
+ "everyhbox" "everyjob" "everymath" "everypar"
+ "everyvbox" "exhyphenpenalty" "expandafter"
+ "fam" "fi" "finalhyphendemerits" "firstmark"
+ "floatingpenalty" "font" "fontdimen" "fontname"
+ "futurelet" "gdef" "global" "globaldefs"
+ "halign" "hangafter" "hangindent" "hbadness"
+ "hbox" "hfil" "hfill" "hfilneg" "hfuzz"
+ "hoffset" "holdinginserts" "hrule" "hsize"
+ "hskip" "hss" "ht" "hyphenpenation" "hyphenchar"
+ "hyphenpenalty" "if" "ifcase" "ifcat" "ifdim"
+ "ifeof" "iffalse" "ifhbox" "ifinner" "ifhmode"
+ "ifmmode" "ifnum" "ifodd" "iftrue" "ifvbox"
+ "ifvoid" "ifx" "ignorespaces" "immediate"
+ "indent" "input" "inputlineno" "insert"
+ "insertpenalties" "interlinepenalty" "jobname"
+ "kern" "language" "lastbox" "lastkern"
+ "lastpenalty" "lastskip" "lccode" "leaders"
+ "left" "lefthyphenmin" "leftskip" "leqno" "let"
+ "limits" "linepenalty" "lineskip"
+ "lineskiplimit" "long" "looseness" "lower"
+ "lowercase" "mag" "markaccent" "mathbin"
+ "mathchar" "mathchardef" "mathchoise"
+ "mathclose" "mathcode" "mathinner" "mathhop"
+ "mathopen" "mathord" "mathpunct" "mathrel"
+ "mathsurround" "maxdeadcycles" "maxdepth"
+ "meaning" "medmuskip" "message" "mkern" "month"
+ "moveleft" "moveright" "mskip" "multiply"
+ "muskip" "muskipdef" "newlinechar" "noalign"
+ "noboundary" "noexpand" "noindent" "nolimits"
+ "nonscript" "nonstopmode" "nulldelimiterspace"
+ "nullfont" "number" "omit" "openin" "openout"
+ "or" "outer" "output" "outputpenalty"
+ "overfullrule" "parfillskip" "parindent"
+ "parskip" "pausing" "postdisplaypenalty"
+ "predisplaypenalty" "predisplaysize"
+ "pretolerance" "relpenalty" "rightskip"
+ "scriptspace" "showboxbreadth" "showboxdepth"
+ "smallskipamount" "spaceskip" "splitmaxdepth"
+ "splittopskip" "tabskip" "thickmuskip"
+ "thinmuskip" "time" "tolerance" "topskip"
+ "tracingcommands" "tracinglostchars"
+ "tracingmacros" "tracingonline" "tracingoutput"
+ "tracingpages" "tracingparagraphs"
+ "tracingrestores" "tracingstats" "uccode"
+ "uchyph" "underline" "unhbox" "unhcopy" "unkern"
+ "unpenalty" "unskip" "unvbox" "unvcopy"
+ "uppercase" "vadjust" "valign" "vbadness" "vbox"
+ "vcenter" "vfil" "vfill" "vfilneg" "vfuzz"
+ "voffset" "vrule" "vsize" "vskip" "vss" "vtop"
+ "wd" "widowpenalty" "write" "xdef" "xleaders"
+ "xspaceskip" "year")))
+
+;;; virtex.el ends here
diff --git a/tests/auctex-11.87.7/style/xspace.el
b/tests/auctex-11.87.7/style/xspace.el
new file mode 100644
index 0000000..15f9216
--- /dev/null
+++ b/tests/auctex-11.87.7/style/xspace.el
@@ -0,0 +1,51 @@
+;;; xspace.el --- AUCTeX style for `xspace.sty'
+
+;; Copyright (C) 2011 Free Software Foundation, Inc.
+
+;; Author: Mads Jensen <mje@inducks.org>
+;; Created: 2011-02-01
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; This file adds support for `xspace.sty'.
+
+;;; Code:
+
+(TeX-add-style-hook
+ "xspace"
+ (lambda ()
+ (TeX-add-symbols
+ '("xspace" 0)
+ "xspaceaddexception"
+ "xspaceremoveexception")
+
+ ;; Fontification
+ (when (and (featurep 'font-latex)
+ (eq TeX-install-font-lock 'font-latex-setup))
+ (font-latex-add-keywords '(("xspace" "")
+ ("xspaceaddexception" "{")
+ ("xspaceremoveexception" "{"))
+ 'function))))
+
+(defvar LaTeX-xspace-package-options nil
+ "Package options for the xspace package.")
+
+;;; xspace.el ends here
diff --git a/tests/auctex-11.87.7/tex-bar.el b/tests/auctex-11.87.7/tex-bar.el
new file mode 100644
index 0000000..cf7bc1d
--- /dev/null
+++ b/tests/auctex-11.87.7/tex-bar.el
@@ -0,0 +1,513 @@
+;;; tex-bar.el --- toolbar icons on AUCTeX in GNU emacs and XEmacs
+
+;; Copyright (C) 2004, 2005 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, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
+;; MA 02110-1301 USA
+
+;; Author: Miguel V. S. Frasson <frasson@math.leidenuniv.nl>
+;; Keywords: tool-bar, tex, latex
+
+;;; Commentary:
+;;
+
+;; This package also needs `toolbar-x.el', and `latex.el' for the
+;; symbol-toolbar.
+
+;;; Use of this preliminary version:
+
+;; - Add `LaTeX-install-toolbar' to `LaTeX-mode-hook'.
+
+;; Special requirements for the use of experimental symbol-toolbar:
+
+;; - Customize `TeX-bar-LaTeX-buttons', adding the label
+;; `LaTeX-symbols-experimental' at the end.
+
+;; - You should have a folder called "symb-pics" with the pics of the
+;; symbols (xpm format is a good one), and the *parent* of this
+;; folder should be in `load-path'.
+
+;; Did you read carefully this item? I will say again: the folder
+;; "symb-pics" should *not* be in `load-path', but its *parent*.
+
+;; - each image file is named after the command that it represents in
+;; the following rules: the base name is the name of the command
+;; without the escape character "\", like \delta -> "delta.xpm";
+;; however, since in some OS filenames are case insensitive, all
+;; occurences of capital letter should be replaced by the letter
+;; plus a dash: \Rightarrow -> "R-ightarrow.xpm" --- actually, for
+;; the correct name, apply `TeX-bar-img-filename' to "Rightarrow"
+;; (TeX-bar-img-filename "Rightarrow")
+;; --> "R-ightarrow"
+;; The function `TeX-bar-img-filename' also treats special commands
+;; like `\{', `\|', etc.
+
+;; You can get the symbol images on (temporary solution)
+;; http://www.math.leidenuniv.nl/~frasson/symb-pics.tar.gz
+
+;;; Code:
+
+(require 'custom)
+
+(require 'toolbar-x)
+
+;; for error handling
+(require 'tex-buf)
+
+;; For the symbol toolbar
+(require 'latex)
+
+;;; Standard buttons
+
+;; help strings
+(defun TeX-bar-help-from-command-list (item)
+ "Return the help string of ITEM in `TeX-command-list'.
+If there is no help, the empty string is returned."
+ (let ((help (nth 1 (memq :help (assoc item TeX-command-list)))))
+ (if help help "")))
+
+(defgroup TeX-tool-bar nil
+ "Tool bar support in AUCTeX."
+ :group 'AUCTeX)
+
+(defcustom TeX-bar-TeX-buttons
+ '(new-file open-file dired kill-buffer save-buffer cut copy paste undo
+ [separator nil] tex next-error view bibtex)
+ "List of buttons available in `tex-mode'.
+It should be a list in the same format of the BUTTONS parameter
+in function `toolbarx-install-toolbar', often a symbol that
+labels a button or Emacs/XEmacs choice of buttons.
+
+Type `\\[TeX-bar-TeX-buttons]' for a list of available buttons.
+
+Buttons are defined in alists (labels associated to properties
+that define a button). For a list of variables that hold such
+alists, see variable `TeX-bar-TeX-all-button-alists'."
+ :type '(list (set :inline t
+ (const new-file)
+ (const open-file)
+ (const dired)
+ (const kill-buffer)
+ (const save-buffer)
+ (const write-file)
+ (const undo)
+ (const cut)
+ (const copy)
+ (const paste)
+ (const search-forward)
+ (const print-buffer)
+ (const [separator nil])
+ (const tex)
+ (const next-error)
+ (const view)
+ (const file)
+ (const bibtex)
+ (const clean))
+ ;; (const latex-symbols-experimental)
+ (repeat (choice (symbol :tag "Label")
+ (vector :args ((symbol :tag "Label in Emacs ")
+ (symbol :tag "Label in XEmacs"))
+ :tag "Emacs/XEmacs choice")
+ (sexp :tag "General element"))))
+ :group 'TeX-tool-bar)
+
+(defun TeX-bar-TeX-buttons ()
+ "Display in a buffer a list of buttons for `tex-bar.el'."
+ (interactive)
+ (let ((assqs-button-alists)
+ (labels))
+ (dolist (m-alist TeX-bar-TeX-all-button-alists)
+ (setq labels nil)
+ (dolist (as (eval m-alist))
+ (setq labels (cons (car as) labels)))
+ (setq assqs-button-alists (cons (cons m-alist (nreverse labels))
+ assqs-button-alists)))
+ (setq assqs-button-alists (nreverse assqs-button-alists))
+ ;; displaying results
+ (save-excursion
+ (set-buffer (get-buffer-create "*TeX tool bar buttons*"))
+ (erase-buffer)
+ (insert "Available buttons for TeX mode
+================================")
+ (dolist (i assqs-button-alists)
+ (insert (format "\n\n`%s' provides the following buttons:\n " (car i)))
+ (dolist (j (cdr i))
+ (insert (format " %s" j)))
+ (fill-region (point-at-bol) (point-at-eol))))
+ (display-buffer "*TeX tool bar buttons*" t)))
+
+(defgroup TeX-tool-bar-button-definitions nil
+ "Collections of button definitions."
+ :group 'TeX-tool-bar)
+
+(defcustom TeX-bar-TeX-all-button-alists
+ '(TeX-bar-TeX-button-alist
+ toolbarx-default-toolbar-meaning-alist)
+ "List of variables that hold buttons properties.
+Each element should be a symbol bound to list in the format of
+the argument BUTTON-ALIST in function `toolbarx-install-toolbar'."
+ :type '(repeat variable)
+ :group 'TeX-tool-bar-button-definitions)
+
+(defcustom TeX-bar-TeX-button-alist
+ '((tex :image (lambda nil (if TeX-PDF-mode "pdftex" "tex"))
+ :command (progn
+ (TeX-save-document (TeX-master-file))
+ (TeX-command "TeX" 'TeX-master-file -1))
+ :help (lambda (&rest ignored)
+ (TeX-bar-help-from-command-list "TeX")))
+ (pdftex :image "pdftex"
+ :command (progn
+ (TeX-save-document (TeX-master-file))
+ (TeX-command "PDFTeX" 'TeX-master-file -1))
+ :help (lambda (&rest ignored)
+ (TeX-bar-help-from-command-list "PDFTeX")))
+ (next-error :image "error"
+ :command TeX-next-error
+ :enable (plist-get TeX-error-report-switches
+ (intern (TeX-master-file)))
+ :visible (plist-get TeX-error-report-switches
+ (intern (TeX-master-file))))
+ (view :image (lambda nil (if TeX-PDF-mode "viewpdf" "viewdvi"))
+ :command (TeX-command "View" 'TeX-master-file -1)
+ :help (lambda (&rest ignored)
+ (TeX-bar-help-from-command-list "View")))
+ (file :image "dvips"
+ :command (TeX-command "File" 'TeX-master-file -1)
+ :visible (not TeX-PDF-mode)
+ :help (lambda (&rest ignored)
+ (TeX-bar-help-from-command-list "File")))
+ (bibtex :image "bibtex"
+ :command (TeX-command "BibTeX" 'TeX-master-file -1)
+ :help (lambda (&rest ignored)
+ (TeX-bar-help-from-command-list "BibTeX")))
+ (clean :image "delete"
+ :command (TeX-command "Clean" 'TeX-master-file -1)
+ :help (lambda (&rest ignored)
+ (TeX-bar-help-from-command-list "Clean"))))
+ ;; latex-symbols-experimental?
+ "Alist for button definitions in TeX bar.
+Value should le a list where each element is of format (KEY .
+PROPS), where KEY is a symbol that labels the button and PROPS is
+a list of properties of the button. For a description of the
+format of PROPS, please see documentation of function
+`toolbarx-install-toolbar'. This custom variable is in the same
+format of the argument MEANING-ALIST in the mentioned function."
+ :type '(alist :key-type symbol :value-type sexp)
+ :group 'TeX-tool-bar-button-definitions)
+
+;;; Installation of the tool bar
+;;;###autoload
+(defun TeX-install-toolbar ()
+ "Install toolbar buttons for TeX mode."
+ (interactive)
+ (require 'toolbar-x)
+ (add-to-list 'toolbarx-image-path
+ (expand-file-name "images" TeX-data-directory))
+ (add-hook 'TeX-PDF-mode-hook 'toolbarx-refresh nil t)
+ (toolbarx-install-toolbar TeX-bar-TeX-buttons
+ (let ((append-list))
+ (dolist (elt TeX-bar-TeX-all-button-alists)
+ (setq append-list (append append-list
+ (eval elt))))
+ append-list)))
+
+(defcustom TeX-bar-LaTeX-buttons
+ '(new-file open-file dired kill-buffer save-buffer cut copy paste undo
+ [separator nil] latex next-error view bibtex)
+ "List of buttons available in `latex-mode'.
+It should be a list in the same format of the BUTTONS parameter
+in function `toolbarx-install-toolbar', often a symbol that
+labels a button or Emacs/XEmacs choice of buttons.
+
+Type `\\[TeX-bar-LaTeX-buttons]' for a list of available buttons.
+
+Buttons are defined in alists (labels associated to properties
+that define a button). For a list of variables that hold such
+alists, see variable `TeX-bar-LaTeX-all-button-alists'."
+ :type '(list (set :inline t
+ (const new-file)
+ (const open-file)
+ (const dired)
+ (const kill-buffer)
+ (const save-buffer)
+ (const write-file)
+ (const undo)
+ (const cut)
+ (const copy)
+ (const paste)
+ (const search-forward)
+ (const print-buffer)
+ (const [separator nil])
+ (const latex)
+ (const next-error)
+ (const view)
+ (const file)
+ (const bibtex)
+ (const clean)
+ (const latex-symbols-experimental))
+ (repeat (choice (symbol :tag "Label")
+ (vector :args ((symbol :tag "Label in Emacs ")
+ (symbol :tag "Label in XEmacs"))
+ :tag "Emacs/XEmacs choice")
+ (sexp :tag "General element"))))
+ :group 'TeX-tool-bar)
+
+(defun TeX-bar-LaTeX-buttons ()
+ "Display in a buffer a list of buttons for `tex-bar.el'."
+ (interactive)
+ (let ((assqs-button-alists)
+ (labels))
+ (dolist (m-alist TeX-bar-LaTeX-all-button-alists)
+ (setq labels nil)
+ (dolist (as (eval m-alist))
+ (setq labels (cons (car as) labels)))
+ (setq assqs-button-alists (cons (cons m-alist (nreverse labels))
+ assqs-button-alists)))
+ (setq assqs-button-alists (nreverse assqs-button-alists))
+ ;; displaying results
+ (save-excursion
+ (set-buffer (get-buffer-create "*TeX tool bar buttons*"))
+ (erase-buffer)
+ (insert "Available buttons for LaTeX mode
+================================")
+ (dolist (i assqs-button-alists)
+ (insert (format "\n\n`%s' provides the following buttons:\n " (car i)))
+ (dolist (j (cdr i))
+ (insert (format " %s" j)))
+ (fill-region (point-at-bol) (point-at-eol))))
+ (display-buffer "*TeX tool bar buttons*" t)))
+
+(defgroup TeX-tool-bar-button-definitions nil
+ "Collections of button definitions."
+ :group 'TeX-tool-bar)
+
+(defcustom TeX-bar-LaTeX-all-button-alists
+ '(TeX-bar-LaTeX-button-alist
+ toolbarx-default-toolbar-meaning-alist)
+ "List of variables that hold buttons properties.
+Each element should be a symbol bound to list in the format of
+the argument BUTTON-ALIST in function `toolbarx-install-toolbar'."
+ :type '(repeat variable)
+ :group 'TeX-tool-bar-button-definitions)
+
+(defcustom TeX-bar-LaTeX-button-alist
+ '((latex :image (lambda nil (if TeX-PDF-mode "pdftex" "tex"))
+ :command (progn
+ (TeX-save-document (TeX-master-file))
+ (TeX-command "LaTeX" 'TeX-master-file -1))
+ :help (lambda (&rest ignored)
+ (TeX-bar-help-from-command-list "LaTeX")))
+ (pdflatex :image "pdftex"
+ :command (progn
+ (TeX-save-document (TeX-master-file))
+ (TeX-command "PDFLaTeX" 'TeX-master-file -1))
+ :help (lambda (&rest ignored)
+ (TeX-bar-help-from-command-list "PDFLaTeX")))
+ (next-error :image "error"
+ :command TeX-next-error
+ :enable (plist-get TeX-error-report-switches
+ (intern (TeX-master-file)))
+ :visible (plist-get TeX-error-report-switches
+ (intern (TeX-master-file))))
+ (view :image (lambda nil (if TeX-PDF-mode "viewpdf" "viewdvi"))
+ :command (TeX-command "View" 'TeX-master-file -1)
+ :help (lambda (&rest ignored)
+ (TeX-bar-help-from-command-list "View")))
+ (file :image "dvips"
+ :command (TeX-command "File" 'TeX-master-file -1)
+ :visible (not TeX-PDF-mode)
+ :help (lambda (&rest ignored)
+ (TeX-bar-help-from-command-list "File")))
+ (bibtex :image "bibtex"
+ :command (TeX-command "BibTeX" 'TeX-master-file -1)
+ :help (lambda (&rest ignored)
+ (TeX-bar-help-from-command-list "BibTeX")))
+ (clean :image "delete"
+ :command (TeX-command "Clean" 'TeX-master-file -1)
+ :help (lambda (&rest ignored)
+ (TeX-bar-help-from-command-list "Clean")))
+ (latex-symbols-experimental . (:alias :eval-group
+ LaTeX-symbols-toolbar-switch-contents
+ LaTeX-symbols-toolbar-contents)))
+ "Alist for button definitions in TeX bar.
+Value should le a list where each element is of format (KEY .
+PROPS), where KEY is a symbol that labels the button and PROPS is
+a list of properties of the button. For a description of the
+format of PROPS, please see documentation of function
+`toolbarx-install-toolbar'. This custom variable is in the same
+format of the argument MEANING-ALIST in the mentioned function."
+ :type '(alist :key-type symbol :value-type sexp)
+ :group 'TeX-tool-bar-button-definitions)
+
+;;; Installation of the tool bar
+;;;###autoload
+(defun LaTeX-install-toolbar ()
+ "Install toolbar buttons for LaTeX mode."
+ (interactive)
+ (require 'toolbar-x)
+ (add-to-list 'toolbarx-image-path
+ (expand-file-name "images" TeX-data-directory))
+ (add-hook 'TeX-PDF-mode-hook 'toolbarx-refresh nil t)
+ (toolbarx-install-toolbar TeX-bar-LaTeX-buttons
+ (let ((append-list))
+ (dolist (elt TeX-bar-LaTeX-all-button-alists)
+ (setq append-list (append append-list
+ (eval elt))))
+ append-list)))
+
+;;; Experimental Symbol Toolbar
+
+;;; symbol toolbar
+(defun TeX-bar-img-filename (tex-command)
+ "Return the filename (no extension) for the image button of TEX-COMMAND."
+ (let ((str-list (append tex-command nil))
+ (str-result))
+ (dolist (i str-list)
+ (cond
+ ;; capital letter -> letter + "-"
+ ((and (>= i ?A) (<= i ?Z))
+ (setq str-result (cons ?- (cons i str-result))))
+ ;; lowercase letter -> letter
+ ((and (>= i ?a) (<= i ?z))
+ (setq str-result (cons i str-result)))
+ ;; open curly brackets `{' -> "ocb--"
+ ((eq i ?{)
+ (setq str-result (cons ?o str-result))
+ (setq str-result (cons ?c str-result))
+ (setq str-result (cons ?b str-result))
+ (setq str-result (cons ?- str-result))
+ (setq str-result (cons ?- str-result)))
+ ;; close curly brackets `}' -> "ccb--"
+ ((eq i ?})
+ (setq str-result (cons ?c str-result))
+ (setq str-result (cons ?c str-result))
+ (setq str-result (cons ?b str-result))
+ (setq str-result (cons ?- str-result))
+ (setq str-result (cons ?- str-result)))
+ ;; vertical bar `|' -> "v--"
+ ((eq i ?|)
+ (setq str-result (cons ?v str-result))
+ (setq str-result (cons ?- str-result))
+ (setq str-result (cons ?- str-result)))
+ ;; slash `/' -> "s--"
+ ((eq i ?/)
+ (setq str-result (cons ?s str-result))
+ (setq str-result (cons ?- str-result))
+ (setq str-result (cons ?- str-result)))))
+ (concat (nreverse str-result))))
+
+(let* ((menu-strings-buttons-alist
+ ;; make a alist os strings with the symbol classes and store it in
+ ;; `menu-strings-alist'
+ (let* ((menu-strings-alist-temp))
+ (dolist (item-external (cdr LaTeX-math-menu)
+ (nreverse menu-strings-alist-temp))
+ (when (listp item-external)
+ ;; if first element is vector, I am supposing that all are
+ ;; vectors as well
+ (if (vectorp (cadr item-external))
+ (let* ((menu-str (car item-external))
+ (menu-buttons))
+ (dolist (button (cdr item-external))
+ (setq menu-buttons
+ (cons (list (intern (TeX-bar-img-filename
+ (aref button 0)))
+ :image
+ (concat "symb-pics/"
+ (TeX-bar-img-filename
+ (aref button 0)))
+ :help (aref button 0)
+ :command (aref button 1))
+ menu-buttons)))
+ (setq menu-buttons (nreverse menu-buttons))
+ (setq menu-strings-alist-temp
+ (cons (cons menu-str (list menu-buttons))
+ menu-strings-alist-temp)))
+ ;; if another list (therefore, up to second level menu)
+ (let ((parent-str (concat (car item-external) " ")))
+ (dolist (item-internal (cdr item-external))
+ (unless (equal (car item-internal) "Special")
+ (let* ((menu-str (concat parent-str
+ (car item-internal)))
+ (menu-buttons))
+ (dolist (button (cdr item-internal))
+ (setq menu-buttons
+ (cons (list (intern (aref button 0))
+ :image
+ (concat "symb-pics/"
+ (TeX-bar-img-filename
+ (aref button 0)))
+ :help (aref button 0)
+ :command (aref button 1))
+ menu-buttons)))
+ (setq menu-buttons (nreverse menu-buttons))
+ (setq menu-strings-alist-temp
+ (cons (cons menu-str (list menu-buttons))
+ menu-strings-alist-temp)))))))))))
+ (list-strings (let* ((list-str-temp))
+ (dolist (i menu-strings-buttons-alist
+ (nreverse list-str-temp))
+ (setq list-str-temp (cons (car i)
+ list-str-temp))))))
+ (defvar LaTeX-symbols-toolbar-visible-flag nil
+ "Non-nil means that the LaTeX symbols on toolbar are visible.
+Internal variable.")
+ (defconst LaTeX-symbols-toolbar-switch-contents
+ `(;; the on-off switch button
+ (latex-symbols-switch
+ :image (lambda nil (if LaTeX-symbols-toolbar-visible-flag
+ "ltx-symb-turn-off"
+ "ltx-symb-turn-on"))
+ :command (progn
+ (setq LaTeX-symbols-toolbar-visible-flag
+ (not LaTeX-symbols-toolbar-visible-flag))
+ (toolbarx-refresh))
+ ;; help message depends on if symb-toolbar is on or off, and in
+ ;; the name of the current class of symbols
+ :help (lambda (&rest ignore)
+ (concat "Turn "
+ (if LaTeX-symbols-toolbar-visible-flag "off " "on ")
+ "the toolbar of LaTeX symbols (current class: "
+ (nth (1- LaTeX-symbols-active-menuitem)
+ (quote ,list-strings))
+ ")")))
+ ;; the dropdown button, that also switch on the symbols
+ ,(append '(:dropdown-group)
+ list-strings
+ '(:variable
+ LaTeX-symbols-active-menuitem
+ :save offer
+ :dropdown-prepend-command
+ (setq LaTeX-symbols-toolbar-visible-flag t)
+ :dropdown-help "Select a class of symbols to be displayed"))))
+ (defconst LaTeX-symbols-toolbar-contents
+ (let* ((ltx-symb)
+ (count 0))
+ (dolist (i menu-strings-buttons-alist
+ (append (nreverse ltx-symb)
+ '(:insert
+ LaTeX-symbols-toolbar-visible-flag
+ :toolbar (bottom . top))))
+ (setq count (1+ count))
+ (setq ltx-symb
+ (cons (append (cdr i)
+ `(:insert (eq LaTeX-symbols-active-menuitem
+ ,count)))
+ ltx-symb))))))
+
+(provide 'tex-bar)
+
+;;; tex-bar.el ends here
diff --git a/tests/auctex-11.87.7/tex-buf.el b/tests/auctex-11.87.7/tex-buf.el
new file mode 100644
index 0000000..131cea6
--- /dev/null
+++ b/tests/auctex-11.87.7/tex-buf.el
@@ -0,0 +1,2207 @@
+;;; tex-buf.el --- External commands for AUCTeX.
+
+;; Copyright (C) 1991, 1993, 1996, 2001, 2003, 2004, 2005, 2006, 2007,
+;; 2008, 2009 Free Software Foundation, Inc.
+
+;; Maintainer: auctex-devel@gnu.org
+;; Keywords: tex, wp
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; This file provides support for external commands.
+
+;;; Code:
+
+(require 'tex)
+
+;;; Customization:
+
+(defcustom TeX-process-asynchronous (not (eq system-type 'ms-dos))
+ "*Use asynchronous processes."
+ :group 'TeX-command
+ :type 'boolean)
+
+(defcustom TeX-shell
+ (if (memq system-type '(ms-dos emx windows-nt))
+ shell-file-name
+ "/bin/sh")
+ "Name of shell used to parse TeX commands."
+ :group 'TeX-command
+ :type 'file)
+
+(defcustom TeX-shell-command-option
+ (cond ((memq system-type '(ms-dos emx windows-nt) )
+ (cond ((boundp 'shell-command-option)
+ shell-command-option)
+ ((boundp 'shell-command-switch)
+ shell-command-switch)
+ (t
+ "/c")))
+ (t ;Unix & EMX (Emacs 19 port to OS/2)
+ "-c"))
+ "Shell argument indicating that next argument is the command."
+ :group 'TeX-command
+ :type 'string)
+
+;;; Interactive Commands
+;;
+;; The general idea is, that there is one process and process buffer
+;; associated with each master file, and one process and process buffer
+;; for running TeX on a region. Thus, if you have N master files, you
+;; can run N + 1 processes simultaneously.
+;;
+;; Some user commands operates on ``the'' process. The following
+;; algorithm determine what ``the'' process is.
+;;
+;; IF last process started was on a region
+;; THEN ``the'' process is the region process
+;; ELSE ``the'' process is the master file (of the current buffer) process
+
+(defun TeX-save-document (name)
+ "Save all files belonging to the current document.
+Return non-nil if document needs to be re-TeX'ed."
+ (interactive (list (TeX-master-file)))
+ (if (string-equal name "")
+ (setq name (TeX-master-file)))
+
+ (TeX-check-files (concat name "." (TeX-output-extension))
+ (cons name (TeX-style-list))
+ TeX-file-extensions))
+
+(defun TeX-command-master (&optional override-confirm)
+ "Run command on the current document.
+
+If a prefix argument OVERRIDE-CONFIRM is given, confirmation will
+depend on it being positive instead of the entry in `TeX-command-list'."
+ (interactive "P")
+ (TeX-command (TeX-command-query (TeX-master-file)) 'TeX-master-file
+ override-confirm))
+
+(defvar TeX-command-region-begin nil)
+(defvar TeX-command-region-end nil)
+;; Used for marking the last region.
+
+(make-variable-buffer-local 'TeX-command-region-begin)
+(make-variable-buffer-local 'TeX-command-region-end)
+
+(defun TeX-current-offset (&optional pos)
+ "Calculate line offset of POS, or of point if POS is nil."
+ (save-restriction
+ (widen)
+ (save-excursion
+ (let ((inhibit-point-motion-hooks t)
+ (inhibit-field-text-motion t))
+ (if pos (goto-char pos))
+ (+ (count-lines (point-min) (point))
+ (if (bolp) 0 -1))))))
+
+(defun TeX-pin-region (begin end)
+ "Pin the TeX region specified by BEGIN and END.
+If BEGIN is nil, the region is unpinned.
+
+In interactive use, a positive prefix arg will pin the region,
+a non-positive one will unpin it. Without a prefix arg, if
+a region is actively marked, it will get pinned. If not, a
+pinned region will get unpinned and vice versa."
+ (interactive
+ (if
+ (if current-prefix-arg
+ (> (prefix-numeric-value current-prefix-arg) 0)
+ (or (TeX-active-mark)
+ (null TeX-command-region-begin)))
+ (list (region-beginning) (region-end))
+ '(nil nil)))
+ (if begin
+ (progn
+ (unless (markerp TeX-command-region-begin)
+ (setq TeX-command-region-begin (make-marker))
+ (setq TeX-command-region-end (make-marker)))
+ (set-marker TeX-command-region-begin begin)
+ (set-marker TeX-command-region-end end)
+ (message "TeX region pinned."))
+ (when (markerp TeX-command-region-begin)
+ (set-marker TeX-command-region-begin nil)
+ (set-marker TeX-command-region-end nil))
+ (setq TeX-command-region-begin nil)
+ (setq TeX-command-region-end nil)
+ (message "TeX region unpinned.")))
+
+(defun TeX-command-region (&optional override-confirm)
+ "Run TeX on the current region.
+
+Query the user for a command to run on the temporary file specified by
+the variable `TeX-region'. If there is an explicitly active region,
+it is stored for later commands. If not, a previously stored region
+\(can be also be set with `TeX-pin-region') overrides the current region,
+if present.
+
+If a prefix argument OVERRIDE-CONFIRM is given, prompting will
+ignore the prompting flag from `TeX-command-list' and instead
+will prompt iff the prefix is positive.
+
+If the master file for the document has a header, it is written to the
+temporary file before the region itself. The document's header is all
+text before `TeX-header-end'.
+
+If the master file for the document has a trailer, it is written to
+the temporary file before the region itself. The document's trailer is
+all text after `TeX-trailer-start'."
+ (interactive "P")
+ ;; Note that TeX-command-region-begin is not a marker when called
+ ;; from TeX-command-buffer.
+ (and (or (null TeX-command-region-begin)
+ (markerp TeX-command-region-begin))
+ (TeX-active-mark)
+ (TeX-pin-region (region-beginning) (region-end)))
+ (let ((begin (or TeX-command-region-begin (region-beginning)))
+ (end (or TeX-command-region-end (region-end))))
+ (TeX-region-create (TeX-region-file TeX-default-extension)
+ (buffer-substring begin end)
+ (file-name-nondirectory (buffer-file-name))
+ (TeX-current-offset begin)))
+ (TeX-command (TeX-command-query (TeX-region-file nil t)) 'TeX-region-file
+ override-confirm))
+
+(defun TeX-command-buffer (&optional override-confirm)
+ "Run TeX on the current buffer.
+
+Query the user for a command to run on the temporary file specified by
+the variable `TeX-region'. The region file will be recreated from the
+visible part of the buffer.
+
+If a prefix argument OVERRIDE-CONFIRM is given, confirmation will
+depend on it being positive instead of the entry in `TeX-command-list'."
+ (interactive "P")
+ (let ((TeX-command-region-begin (point-min))
+ (TeX-command-region-end (point-max)))
+ (TeX-command-region override-confirm)))
+
+(unless (featurep 'xemacs)
+ ;; This variable is not defined in XEmacs because XEmacs' version of
+ ;; `pop-to-buffer' doesn't support the optional NORECORD argument. In
+ ;; XEmacs, the third arg is ON-FRAME (Emacs: NORECORD).
+ (defcustom TeX-record-buffer nil
+ "Whether to record buffer names of generated TeX buffers.
+When non-nil, these buffers are put at the front of the list of
+recently selected ones."
+ :group 'TeX-command
+ :type 'boolean))
+
+(defun TeX-pop-to-buffer (buffer &optional other-window norecord)
+ "Compatibility wrapper for `pop-to-buffer'.
+
+Select buffer BUFFER in some window, preferably a different one.
+BUFFER may be a buffer, a string (a buffer name), or nil.
+If BUFFER is a string which is not the name of an existing buffer,
+then this function creates a buffer with that name.
+If BUFFER is nil, then it chooses some other buffer.
+If `pop-up-windows' is non-nil, windows can be split to do this.
+If optional second arg OTHER-WINDOW is non-nil, insist on finding another
+window even if BUFFER is already visible in the selected window,
+and ignore `same-window-regexps' and `same-window-buffer-names'.
+This function returns the buffer it switched to.
+This uses the function `display-buffer' as a subroutine; see the documentation
+of `display-buffer' for additional customization information.
+
+Optional third arg NORECORD non-nil means do not put this buffer
+at the front of the list of recently selected ones.
+
+NORECORD is ignored in XEmacs."
+ ;; Make sure not to use third arg in XEmacs. In XEmacs, the third arg is
+ ;; ON-FRAME (Emacs: NORECORD), so we set it to nil.
+ (pop-to-buffer buffer other-window (and norecord
+ (boundp 'TeX-record-buffer)
+ TeX-record-buffer)))
+
+(defun TeX-recenter-output-buffer (line)
+ "Redisplay buffer of TeX job output so that most recent output can be seen.
+The last line of the buffer is displayed on line LINE of the window, or
+at bottom if LINE is nil."
+ (interactive "P")
+ (let ((buffer (TeX-active-buffer)))
+ (if buffer
+ (let ((old-buffer (current-buffer)))
+ (TeX-pop-to-buffer buffer t t)
+ (bury-buffer buffer)
+ (goto-char (point-max))
+ (recenter (if line
+ (prefix-numeric-value line)
+ (/ (window-height) 2)))
+ (TeX-pop-to-buffer old-buffer nil t))
+ (message "No process for this document."))))
+
+(defun TeX-kill-job ()
+ "Kill the currently running TeX job."
+ (interactive)
+ (let ((process (TeX-active-process)))
+ (if process
+ (kill-process process)
+ ;; Should test for TeX background process here.
+ (error "No TeX process to kill"))))
+
+(defun TeX-home-buffer ()
+ "Go to the buffer where you last issued a TeX command.
+If there is no such buffer, or you already are in that buffer, find
+the master file."
+ (interactive)
+ (if (or (null TeX-command-buffer)
+ (null (buffer-name TeX-command-buffer))
+ (eq TeX-command-buffer (current-buffer)))
+ (find-file (TeX-master-file TeX-default-extension))
+ (switch-to-buffer TeX-command-buffer)))
+
+(defun TeX-next-error (reparse)
+ "Find the next error in the TeX output buffer.
+With \\[universal-argument] prefix, start from the beginning of the errors."
+ (interactive "P")
+ (if (null (TeX-active-buffer))
+ (next-error reparse)
+ (funcall (TeX-process-get-variable (with-current-buffer TeX-command-buffer
+ (TeX-active-master))
+ 'TeX-parse-function)
+ reparse)))
+
+(defun TeX-previous-error (arg)
+ "Find the previous error in the TeX output buffer."
+ (interactive "P")
+ (if (null (TeX-active-buffer))
+ (previous-error arg)
+ (error "Jumping to previous error not supported")))
+
+;;; Command Query
+
+(defun TeX-command (name file &optional override-confirm)
+ "Run command NAME on the file returned by calling FILE.
+
+FILE is the symbol of a function returning a file name. The
+function has one optional argument, the extension to use on the
+file.
+
+Use the information in `TeX-command-list' to determine how to run
+the command.
+
+If OVERRIDE-CONFIRM is a prefix argument, confirmation will be
+asked if it is positive, and suppressed if it is not."
+ (cond ((eq file 'TeX-region-file)
+ (setq TeX-current-process-region-p t))
+ ((eq file 'TeX-master-file)
+ (setq TeX-current-process-region-p nil)))
+ (let ((command (TeX-command-expand (nth 1 (assoc name TeX-command-list))
+ file))
+ (hook (nth 2 (assoc name TeX-command-list)))
+ (confirm (if override-confirm
+ (> (prefix-numeric-value override-confirm) 0)
+ (nth 3 (assoc name TeX-command-list)))))
+
+ ;; Verify the expanded command
+ (if confirm
+ (setq command
+ (read-from-minibuffer (concat name " command: ") command
+ nil nil)))
+
+ ;; Now start the process
+ (setq file (funcall file))
+ (TeX-process-set-variable file 'TeX-command-next TeX-command-Show)
+ (funcall hook name command file)))
+
+(defun TeX-command-expand (command file &optional list)
+ "Expand COMMAND for FILE as described in LIST.
+LIST default to `TeX-expand-list'. As a special exception,
+`%%' can be used to produce a single `%' sign in the output
+without further expansion."
+ (let (pat
+ pos
+ entry TeX-command-text TeX-command-pos
+ (file `(lambda (&rest args)
+ (shell-quote-argument
+ (concat (and (stringp TeX-command-pos) TeX-command-pos)
+ (apply ',file args)
+ (and (stringp TeX-command-pos) TeX-command-pos)))))
+ case-fold-search string expansion arguments)
+ (setq list (cons
+ (list "%%" (lambda nil
+ (setq pos (1+ pos))
+ "%"))
+ (or list TeX-expand-list))
+ pat (regexp-opt (mapcar #'car list)))
+ (while (setq pos (string-match pat command pos))
+ (setq string (match-string 0 command)
+ entry (assoc string list)
+ expansion (car (cdr entry)) ;Second element
+ arguments (cdr (cdr entry)) ;Remaining elements
+ string (save-match-data
+ ;; Note regarding the special casing of `file':
+ ;; `file' is prevented from being evaluated as a
+ ;; function because inside of AUCTeX it only has
+ ;; a meaning as a variable. This makes sure that
+ ;; a function definition made by an external
+ ;; package (e.g. icicles) is not picked up.
+ (cond ((and (not (eq expansion 'file))
+ (TeX-function-p expansion))
+ (apply expansion arguments))
+ ((boundp expansion)
+ (apply (eval expansion) arguments))
+ (t
+ (error "Nonexpansion %s" expansion)))))
+ (if (stringp string)
+ (setq command
+ (replace-match string t t command)))))
+ command)
+
+(defun TeX-check-files (derived originals extensions)
+ "Check if DERIVED is newer than any of the ORIGINALS.
+Try each original with each member of EXTENSIONS, in all directories
+in `TeX-check-path'. Returns true if any of the ORIGINALS with any of the
+EXTENSIONS are newer than DERIVED. Will prompt to save the buffer of any
+ORIGINALS which are modified but not saved yet."
+ (let (existingoriginals
+ found
+ (extensions (TeX-delete-duplicate-strings extensions))
+ (buffers (buffer-list)))
+ (dolist (path (mapcar (lambda (dir)
+ (expand-file-name (file-name-as-directory dir)))
+ TeX-check-path))
+ (dolist (orig originals)
+ (dolist (ext extensions)
+ (let ((filepath (concat path orig "." ext)))
+ (if (file-exists-p filepath)
+ (setq existingoriginals (cons filepath existingoriginals)))))))
+ (while buffers
+ (let* ((buffer (car buffers))
+ (name (buffer-file-name buffer)))
+ (setq buffers (cdr buffers))
+ (if (and name (member name existingoriginals))
+ (progn
+ (and (buffer-modified-p buffer)
+ (or (not TeX-save-query)
+ (y-or-n-p (concat "Save file "
+ (buffer-file-name buffer)
+ "? ")))
+ (save-excursion (set-buffer buffer) (save-buffer)))))))
+ (dolist (eo existingoriginals)
+ (if (file-newer-than-file-p eo derived)
+ (setq found t)))
+ found))
+
+(defcustom TeX-save-query t
+ "*If non-nil, ask user for permission to save files before starting TeX."
+ :group 'TeX-command
+ :type 'boolean)
+
+(defvar TeX-command-history nil)
+
+(defun TeX-command-query (name)
+ "Query the user for what TeX command to use."
+ (let* ((default
+ (cond ((if (string-equal name TeX-region)
+ (TeX-check-files (concat name "." (TeX-output-extension))
+ (list name)
+ TeX-file-extensions)
+ (TeX-save-document (TeX-master-file)))
+ TeX-command-default)
+ ((and (memq major-mode '(doctex-mode latex-mode))
+ ;; Want to know if bib file is newer than .bbl
+ ;; We don't care whether the bib files are open in emacs
+ (TeX-check-files (concat name ".bbl")
+ (mapcar 'car
+ (LaTeX-bibliography-list))
+ (append BibTeX-file-extensions
+ TeX-Biber-file-extensions)))
+ ;; We should check for bst files here as well.
+ (if LaTeX-using-Biber TeX-command-Biber TeX-command-BibTeX))
+ ((TeX-process-get-variable name
+ 'TeX-command-next
+ TeX-command-Show))
+ (TeX-command-Show)))
+ (completion-ignore-case t)
+ (answer (or TeX-command-force
+ (completing-read
+ (concat "Command: (default " default ") ")
+ (TeX-mode-specific-command-list major-mode) nil t
+ nil 'TeX-command-history))))
+ ;; If the answer is "latex" it will not be expanded to "LaTeX"
+ (setq answer (car-safe (TeX-assoc answer TeX-command-list)))
+ (if (and answer
+ (not (string-equal answer "")))
+ answer
+ default)))
+
+(defvar TeX-command-next nil
+ "The default command next time `TeX-command' is invoked.")
+
+ (make-variable-buffer-local 'TeX-command-next)
+
+(defun TeX-printer-query (&optional queue)
+ "Query the user for a printer name.
+QUEUE is non-nil when we are checking for the printer queue."
+ (let (command element printer)
+ (if queue
+ (unless (setq element 2 command TeX-queue-command)
+ (error "Need to customize `TeX-queue-command'"))
+ (unless (setq element 1 command TeX-print-command)
+ (error "Need to customize `TeX-print-command'")))
+ (while (progn
+ (setq printer (if TeX-printer-list
+ (let ((completion-ignore-case t))
+ (completing-read
+ (concat "Printer: "
+ (and TeX-printer-default
+ (concat "(default "
+ TeX-printer-default ")
")))
+ TeX-printer-list))
+ ""))
+ (setq printer (or (car-safe (TeX-assoc printer TeX-printer-list))
+ printer))
+ (not (if (or (null printer) (string-equal "" printer))
+ (setq printer TeX-printer-default)
+ (setq TeX-printer-default printer)))))
+
+ (let ((expansion (let ((entry (assoc printer TeX-printer-list)))
+ (or (nth element entry)
+ command))))
+ (if (string-match "%p" printer)
+ (error "Don't use %s in printer names" "%p"))
+ (while (string-match "%p" expansion)
+ (setq expansion (replace-match printer t t expansion 0)))
+ expansion)))
+
+(defun TeX-style-check (styles)
+ "Check STYLES compared to the current style options."
+ (let ((files (TeX-style-list)))
+ (while (and styles
+ (not (TeX-member (car (car styles)) files 'string-match)))
+ (setq styles (cdr styles))))
+ (if styles
+ (nth 1 (car styles))
+ ""))
+
+(defun TeX-output-extension ()
+ "Get the extension of the current TeX output file."
+ (if (listp TeX-output-extension)
+ (car TeX-output-extension)
+ (or (TeX-process-get-variable (TeX-active-master)
+ 'TeX-output-extension
+ TeX-output-extension)
+ TeX-output-extension)))
+
+(defun TeX-view-mouse (event)
+ "Start `TeX-view' at mouse position."
+ (interactive "e")
+ (save-excursion
+ (set-buffer (window-buffer (posn-window (event-start event))))
+ (goto-char (posn-point (event-start event)))
+ (TeX-view)))
+
+(defun TeX-view ()
+ "Start a viewer without confirmation.
+The viewer is started either on region or master file,
+depending on the last command issued."
+ (interactive)
+ (let ((output-file (TeX-active-master (TeX-output-extension))))
+ (if (file-exists-p output-file)
+ (TeX-command "View" 'TeX-active-master 0)
+ (message "Output file %S does not exist." output-file))))
+
+(defun TeX-output-style-check (styles)
+ "Check STYLES compared to the current view output file extension and
+the current style options."
+ (let ((ext (TeX-output-extension))
+ (files (TeX-style-list)))
+ (while (and
+ styles
+ (or
+ (not (string-match (car (car styles)) ext))
+ (let ((style (nth 1 (car styles))))
+ (cond
+ ((listp style)
+ (while
+ (and style
+ (TeX-member (car style) files 'string-match))
+ (setq style (cdr style)))
+ style)
+ ((not (TeX-member style files 'string-match)))))))
+ (setq styles (cdr styles)))
+ (if styles
+ (nth 2 (car styles))
+ "%v")))
+
+;;; Command Hooks
+
+(defvar TeX-after-start-process-function nil
+ "Hooks to run after starting an asynchronous process.
+Used by Japanese TeX to set the coding system.")
+
+(defcustom TeX-show-compilation nil
+ "*If non-nil, show output of TeX compilation in other window."
+ :group 'TeX-command
+ :type 'boolean)
+
+(defun TeX-run-command (name command file)
+ "Create a process for NAME using COMMAND to process FILE.
+Return the new process."
+ (let ((default TeX-command-default)
+ (buffer (TeX-process-buffer-name file))
+ (dir (TeX-master-directory))
+ (command-buff (current-buffer)))
+ (TeX-process-check file) ; Check that no process is running
+ (setq-default TeX-command-buffer command-buff)
+ (get-buffer-create buffer)
+ (set-buffer buffer)
+ (buffer-disable-undo)
+ (erase-buffer)
+ (set (make-local-variable 'line-number-display-limit) 0)
+ (setq TeX-output-extension nil)
+ (set (make-local-variable 'TeX-command-buffer) command-buff)
+ (if dir (cd dir))
+ (insert "Running `" name "' on `" file "' with ``" command "''\n")
+ (setq mode-name name)
+ (if TeX-show-compilation
+ (display-buffer buffer)
+ (message "Type `%s' to display results of compilation."
+ (substitute-command-keys
+ "\\<TeX-mode-map>\\[TeX-recenter-output-buffer]")))
+ (setq TeX-parse-function 'TeX-parse-command)
+ (setq TeX-command-default default)
+ (setq TeX-sentinel-function
+ (lambda (process name)
+ (message (concat name ": done."))))
+ (if TeX-process-asynchronous
+ (let ((process (start-process name buffer TeX-shell
+ TeX-shell-command-option command)))
+ (if TeX-after-start-process-function
+ (funcall TeX-after-start-process-function process))
+ (TeX-command-mode-line process)
+ (set-process-filter process 'TeX-command-filter)
+ (set-process-sentinel process 'TeX-command-sentinel)
+ (set-marker (process-mark process) (point-max))
+ (setq compilation-in-progress (cons process compilation-in-progress))
+ process)
+ (setq mode-line-process ": run")
+ (set-buffer-modified-p (buffer-modified-p))
+ (sit-for 0) ; redisplay
+ (call-process TeX-shell nil buffer nil
+ TeX-shell-command-option command))))
+
+(defun TeX-run-set-command (name command)
+ "Remember TeX command to use to NAME and set corresponding output extension."
+ (setq TeX-command-default name
+ TeX-output-extension (if TeX-PDF-mode "pdf" "dvi"))
+ (let ((case-fold-search t)
+ (lst TeX-command-output-list))
+ (while lst
+ (if (string-match (car (car lst)) command)
+ (setq TeX-output-extension (car (cdr (car lst)))
+ lst nil)
+ (setq lst (cdr lst))))))
+
+(defun TeX-run-format (name command file)
+ "Create a process for NAME using COMMAND to format FILE with TeX."
+ (TeX-run-set-command name command)
+ (let ((buffer (TeX-process-buffer-name file))
+ (process (TeX-run-command name command file)))
+ ;; Hook to TeX debuger.
+ (save-excursion
+ (set-buffer buffer)
+ (TeX-parse-reset)
+ (setq TeX-parse-function 'TeX-parse-TeX)
+ (setq TeX-sentinel-function 'TeX-TeX-sentinel)
+ (if TeX-process-asynchronous
+ (progn
+ ;; Updating the mode line.
+ (setq TeX-current-page "[0]")
+ (TeX-format-mode-line process)
+ (set-process-filter process 'TeX-format-filter)))
+ process)))
+
+(defvar TeX-error-report-switches nil
+ "Reports presence of errors after `TeX-run-TeX'.
+To test whether the current buffer has an compile error from last
+run of `TeX-run-TeX', use
+ (plist-get TeX-error-report-switches (intern (TeX-master-file)))")
+
+(defun TeX-run-TeX (name command file)
+ "Create a process for NAME using COMMAND to format FILE with TeX."
+
+ ;; Save information in TeX-error-report-switches
+ ;; Initialize error to nil (no error) for current master.
+ ;; Presence of error is reported inside `TeX-TeX-sentinel-check'
+ (let ((current-master (TeX-master-file)))
+ ;; the current master file is saved because error routines are
+ ;; parsed in other buffers;
+ (setq TeX-error-report-switches
+ (plist-put TeX-error-report-switches
+ 'TeX-current-master current-master))
+ ;; reset error to nil (no error)
+ (setq TeX-error-report-switches
+ (plist-put TeX-error-report-switches
+ (intern current-master) nil)))
+
+ ;; can we assume that TeX-sentinel-function will not be changed
+ ;; during (TeX-run-format ..)? --pg
+ ;; rather use let* ? --pg
+
+ (if TeX-interactive-mode
+ (TeX-run-interactive name command file)
+ (let ((sentinel-function TeX-sentinel-default-function))
+ (let ((process (TeX-run-format name command file)))
+ (setq TeX-sentinel-function sentinel-function)
+ (if TeX-process-asynchronous
+ process
+ (TeX-synchronous-sentinel name file process))))))
+
+;; backward compatibilty
+
+(defalias 'TeX-run-LaTeX 'TeX-run-TeX)
+
+
+(defun TeX-run-BibTeX (name command file)
+ "Create a process for NAME using COMMAND to format FILE with BibTeX."
+ (let ((process (TeX-run-command name command file)))
+ (setq TeX-sentinel-function 'TeX-BibTeX-sentinel)
+ (if TeX-process-asynchronous
+ process
+ (TeX-synchronous-sentinel name file process))))
+
+(defun TeX-run-Biber (name command file)
+ "Create a process for NAME using COMMAND to format FILE with Biber."
+ (let ((process (TeX-run-command name command file)))
+ (setq TeX-sentinel-function 'TeX-Biber-sentinel)
+ (if TeX-process-asynchronous
+ process
+ (TeX-synchronous-sentinel name file process))))
+
+(defun TeX-run-compile (name command file)
+ "Ignore first and third argument, start compile with second argument."
+ (compile command))
+
+(defun TeX-run-shell (name command file)
+ "Ignore first and third argument, start shell-command with second argument."
+ (let ((default-directory (TeX-master-directory)))
+ (shell-command command)
+ (if (eq system-type 'ms-dos)
+ (redraw-display))))
+
+(defun TeX-run-discard (name command file)
+ "Start COMMAND as process, discarding its output.
+NAME and FILE are ignored."
+ (let ((default-directory (TeX-master-directory)))
+ (call-process TeX-shell
+ nil 0 nil
+ TeX-shell-command-option
+ command)))
+
+(defun TeX-run-discard-foreground (name command file)
+ "Call process with second argument in the foreground, discarding its output.
+With support for MS-DOS, especially when dviout is used with PC-9801 series."
+ (if (and (boundp 'dos-machine-type) (eq dos-machine-type 'pc98)) ;if PC-9801
+ (send-string-to-terminal "\e[2J")) ; clear screen
+ (call-process TeX-shell (if (eq system-type 'ms-dos) "con") nil nil
+ TeX-shell-command-option command)
+ (if (eq system-type 'ms-dos)
+ (redraw-display)))
+(defalias 'TeX-run-dviout 'TeX-run-discard-foreground)
+
+(defun TeX-run-background (name command file)
+ "Start process with second argument, show output when and if it arrives."
+ (let ((dir (TeX-master-directory)))
+ (set-buffer (get-buffer-create "*TeX background*"))
+ (if dir (cd dir))
+ (erase-buffer)
+ (let ((process (start-process (concat name " background")
+ nil TeX-shell
+ TeX-shell-command-option command)))
+ (if TeX-after-start-process-function
+ (funcall TeX-after-start-process-function process))
+ (set-process-filter process 'TeX-background-filter)
+ (process-kill-without-query process))))
+
+(defun TeX-run-silent (name command file)
+ "Start process with second argument."
+ (let ((dir (TeX-master-directory)))
+ (set-buffer (get-buffer-create "*TeX silent*"))
+ (if dir (cd dir))
+ (erase-buffer)
+ (let ((process (start-process (concat name " silent")
+ nil TeX-shell
+ TeX-shell-command-option command)))
+ (if TeX-after-start-process-function
+ (funcall TeX-after-start-process-function process))
+ (process-kill-without-query process))))
+
+(defun TeX-run-interactive (name command file)
+ "Run TeX interactively.
+Run command in a buffer (in comint-shell-mode) so that it accepts user
+interaction. If you return to the file buffer after the TeX run,
+Error parsing on \\[next-error] should work with a bit of luck."
+ (TeX-run-set-command name command)
+ (require 'comint)
+ (let ((default TeX-command-default)
+ (buffer (TeX-process-buffer-name file))
+ (process nil)
+ (dir (TeX-master-directory))
+ (command-buff (current-buffer))
+ (sentinel-function TeX-sentinel-default-function)) ; inherit from major
mode
+ (TeX-process-check file) ; Check that no process is running
+ (setq-default TeX-command-buffer command-buff)
+ (with-output-to-temp-buffer buffer)
+ (set-buffer buffer)
+ (set (make-local-variable 'TeX-command-buffer) command-buff)
+ (setq buffer-read-only nil)
+ (if dir (cd dir))
+ (insert "Running `" name "' on `" file "' with ``" command "''\n")
+ (comint-exec buffer name TeX-shell nil
+ (list TeX-shell-command-option command))
+ (comint-mode)
+ (add-hook 'comint-output-filter-functions 'TeX-interactive-goto-prompt)
+ (setq mode-name name)
+ (setq TeX-command-default default)
+ (setq process (get-buffer-process buffer))
+ (if TeX-after-start-process-function
+ (funcall TeX-after-start-process-function process))
+ (TeX-command-mode-line process)
+ (set-process-sentinel process 'TeX-command-sentinel)
+ (set-marker (process-mark process) (point-max))
+ (setq compilation-in-progress (cons process compilation-in-progress))
+ (TeX-parse-reset)
+ (setq TeX-parse-function 'TeX-parse-TeX)
+ ;; use the sentinel-function that the major mode sets, not the LaTeX one
+ (setq TeX-sentinel-function sentinel-function)))
+
+(defun TeX-run-function (name command file)
+ "Execute Lisp function or function call given as the string COMMAND.
+Parameters NAME and FILE are ignored."
+ (let ((fun (car (read-from-string command))))
+ (if (functionp fun) (funcall fun) (eval fun))))
+
+(defun TeX-run-discard-or-function (name command file)
+ "Start COMMAND as process or execute it as a Lisp function.
+If run as a process, the output is discarded. COMMAND is
+expected to be a string. NAME and FILE are ignored."
+ (if (functionp (car (read-from-string command)))
+ (TeX-run-function name command file)
+ (TeX-run-discard name command file)))
+
+(defun TeX-run-ispell-on-document (command ignored name)
+ "Run ispell on all open files belonging to the current document.
+This function is *obsolete* and only here for compatibility
+reasons. Use `TeX-run-function' instead."
+ (interactive)
+ (TeX-ispell-document ""))
+
+
+;;; Command Sentinels
+
+(defun TeX-synchronous-sentinel (name file result)
+ "Process TeX command output buffer after the process dies."
+ (let ((buffer (TeX-process-buffer (file-name-nondirectory file))))
+ (save-excursion
+ (set-buffer buffer)
+
+ ;; Append post-mortem information to the buffer
+ (goto-char (point-max))
+ (insert "\n" mode-name (if (and result (zerop result))
+ " finished" " exited") " at "
+ (substring (current-time-string) 0 -5))
+ (setq mode-line-process ": exit")
+
+ ;; Do command specific actions.
+ (setq TeX-command-next TeX-command-Show)
+ (goto-char (point-min))
+ (apply TeX-sentinel-function nil name nil)
+
+ ;; Force mode line redisplay soon
+ (set-buffer-modified-p (buffer-modified-p)))))
+
+(defun TeX-command-sentinel (process msg)
+ "Process TeX command output buffer after the process dies."
+ ;; Set `TeX-transient-master' here because `preview-parse-messages'
+ ;; may open files and thereby trigger master file questions which we
+ ;; don't want and need because we already know the master. Use
+ ;; `TeX-master-file' instead of `TeX-active-master' to determine the
+ ;; master because the region file should never be the master.
+ (let* ((TeX-transient-master (TeX-master-file))
+ (buffer (process-buffer process))
+ (name (process-name process)))
+ (cond ((null (buffer-name buffer)) ; buffer killed
+ (set-process-buffer process nil)
+ (set-process-sentinel process nil))
+ ((memq (process-status process) '(signal exit))
+ (save-excursion
+ (set-buffer buffer)
+
+ ;; Append post-mortem information to the buffer
+ (goto-char (point-max))
+ (insert-before-markers "\n" mode-name " " msg)
+ (forward-char -1)
+ (insert " at "
+ (substring (current-time-string) 0 -5))
+ (forward-char 1)
+
+ ;; Do command specific actions.
+ (TeX-command-mode-line process)
+ (setq TeX-command-next TeX-command-Show)
+ (goto-char (point-min))
+ (apply TeX-sentinel-function process name nil)
+
+
+ ;; If buffer and mode line will show that the process
+ ;; is dead, we can delete it now. Otherwise it
+ ;; will stay around until M-x list-processes.
+ (delete-process process)
+
+ ;; Force mode line redisplay soon
+ (set-buffer-modified-p (buffer-modified-p))))))
+ (setq compilation-in-progress (delq process compilation-in-progress)))
+
+
+(defvar TeX-sentinel-function (lambda (process name))
+ "Hook to cleanup TeX command buffer after temination of PROCESS.
+NAME is the name of the process.")
+
+ (make-variable-buffer-local 'TeX-sentinel-function)
+
+
+(defvar TeX-sentinel-default-function (lambda (process name))
+ "Default for `TeX-sentinel-function'. To be set in major mode.
+Hook to cleanup TeX command buffer after temination of PROCESS.
+NAME is the name of the process.")
+
+ (make-variable-buffer-local 'TeX-sentinel-default-function)
+
+(defun TeX-TeX-sentinel (process name)
+ "Cleanup TeX output buffer after running TeX."
+ (if (TeX-TeX-sentinel-check process name)
+ ()
+ (message (concat name ": formatted " (TeX-current-pages)))
+ (setq TeX-command-next TeX-command-Show)))
+
+(defun TeX-current-pages ()
+ "Return string indicating the number of pages formatted."
+ (cond ((null TeX-current-page)
+ "some pages")
+ ((string-match "[^0-9]1[^0-9]" TeX-current-page)
+ (concat TeX-current-page " page"))
+ (t
+ (concat TeX-current-page " pages"))))
+
+(defun TeX-TeX-sentinel-check (process name)
+ "Cleanup TeX output buffer after running TeX.
+Return nil ifs no errors were found."
+ (save-excursion
+ (goto-char (point-max))
+ (if (re-search-backward "^Output written on \\(.*?\\) (\\([0-9]+\\) page"
+ nil t)
+ (let ((output-file (TeX-match-buffer 1)))
+ (setq TeX-current-page (concat "{" (TeX-match-buffer 2) "}"))
+ ;; Shave off quotation marks if present.
+ (when (string-match "\\`\"\\(.*\\)\"\\'" output-file)
+ (setq output-file (match-string 1 output-file)))
+ (setq TeX-output-extension
+ (if (string-match "\\.\\([^.]*\\)$" output-file)
+ (match-string 1 output-file)
+ "dvi")))))
+ (if process (TeX-format-mode-line process))
+ (if (re-search-forward "^\\(!\\|.*:[0-9]+:\\) " nil t)
+ (progn
+ (message "%s errors in `%s'. Use %s to display." name (buffer-name)
+ (substitute-command-keys
+ "\\<TeX-mode-map>\\[TeX-next-error]"))
+ (setq TeX-command-next TeX-command-default)
+ ;; error reported to TeX-error-report-switches
+ (setq TeX-error-report-switches
+ (plist-put TeX-error-report-switches
+ (intern (plist-get TeX-error-report-switches
+ 'TeX-current-master))
+ t))
+ t)
+ (setq TeX-command-next TeX-command-Show)
+ nil))
+
+(defun TeX-LaTeX-sentinel-has-warnings ()
+ "Return non-nil, if the output buffer contains warnings.
+Warnings can be indicated by LaTeX or packages."
+ (save-excursion
+ (goto-char (point-min))
+ (re-search-forward
+ "^\\(LaTeX [A-Za-z]*\\|Package [A-Za-z]+ \\)Warning:" nil t)))
+
+(defun TeX-LaTeX-sentinel-has-bad-boxes ()
+ "Return non-nil, if LaTeX output indicates overfull or underfull boxes."
+ (save-excursion
+ (goto-char (point-min))
+ (re-search-forward "^\\(Ov\\|Und\\)erfull \\\\" nil t)))
+
+;; should go into latex.el? --pg
+(defun TeX-LaTeX-sentinel (process name)
+ "Cleanup TeX output buffer after running LaTeX."
+ (cond ((TeX-TeX-sentinel-check process name))
+ ((and (save-excursion
+ (re-search-forward
+ "^Package biblatex Warning: Please (re)run Biber on the file"
+ nil t))
+ (with-current-buffer TeX-command-buffer
+ (and (LaTeX-bibliography-list)
+ (TeX-check-files (TeX-master-file "bbl")
+ (TeX-style-list)
+ (append TeX-file-extensions
+ BibTeX-file-extensions
+ TeX-Biber-file-extensions)))))
+ (message "%s%s" "You should run Biber to get citations right, "
+ (TeX-current-pages))
+ (setq TeX-command-next (with-current-buffer TeX-command-buffer
+ TeX-command-Biber)))
+ ((and (save-excursion
+ (re-search-forward
+ "^\\(?:LaTeX\\|Package natbib\\) Warning: Citation" nil t))
+ (with-current-buffer TeX-command-buffer
+ (and (LaTeX-bibliography-list)
+ (TeX-check-files (TeX-master-file "bbl")
+ (TeX-style-list)
+ (append TeX-file-extensions
+ BibTeX-file-extensions
+ TeX-Biber-file-extensions)))))
+ (message "%s%s" "You should run BibTeX to get citations right, "
+ (TeX-current-pages))
+ (setq TeX-command-next (with-current-buffer TeX-command-buffer
+ TeX-command-BibTeX)))
+ ((re-search-forward "Package biblatex Warning: Please rerun LaTeX" nil t)
+ (message "%s%s" "You should run LaTeX again, " (TeX-current-pages))
+ (setq TeX-command-next TeX-command-default))
+ ((re-search-forward "^(biblatex)\\W+Page breaks have changed" nil t)
+ (message "%s%s" "You should run LaTeX again - page breaks have
changed, "
+ (TeX-current-pages))
+ (setq TeX-command-next TeX-command-default))
+ ((re-search-forward "^\\(?:LaTeX Warning: Label(s)\\|\
+Package natbib Warning: Citation(s)\\)" nil t)
+ (message "%s%s" "You should run LaTeX again to get references right, "
+ (TeX-current-pages))
+ (setq TeX-command-next TeX-command-default))
+ ((re-search-forward "^LaTeX Warning: Reference" nil t)
+ (message "%s%s%s" name ": there were unresolved references, "
+ (TeX-current-pages))
+ (setq TeX-command-next TeX-command-Show))
+ ((re-search-forward "^\\(?:LaTeX Warning: Citation\\|\
+Package natbib Warning:.*undefined citations\\)" nil t)
+ (message "%s%s%s" name ": there were unresolved citations, "
+ (TeX-current-pages))
+ (setq TeX-command-next TeX-command-Show))
+ ((re-search-forward "Package longtable Warning: Table widths have \
+changed\\. Rerun LaTeX\\." nil t)
+ (message
+ "%s" "You should run LaTeX again to get table formatting right")
+ (setq TeX-command-next TeX-command-default))
+ ((re-search-forward
+ "^\\(\\*\\* \\)?J?I?p?\\(La\\|Sli\\)TeX\\(2e\\)? \
+\\(Version\\|ver\\.\\|<[0-9/]*>\\)" nil t)
+ (let* ((warnings (and TeX-debug-warnings
+ (TeX-LaTeX-sentinel-has-warnings)))
+ (bad-boxes (and TeX-debug-bad-boxes
+ (TeX-LaTeX-sentinel-has-bad-boxes)))
+ (add-info (when (or warnings bad-boxes)
+ (concat " (with "
+ (when warnings "warnings")
+ (when (and warnings bad-boxes) " and ")
+ (when bad-boxes "bad boxes")
+ ")"))))
+ (message "%s" (concat name ": successfully formatted "
+ (TeX-current-pages) add-info)))
+ (setq TeX-command-next TeX-command-Show))
+ (t
+ (message "%s%s%s" name ": problems after " (TeX-current-pages))
+ (setq TeX-command-next TeX-command-default))))
+
+;; should go into latex.el? --pg
+(defun TeX-BibTeX-sentinel (process name)
+ "Cleanup TeX output buffer after running BibTeX."
+ (goto-char (point-max))
+ (cond
+ ;; Check whether BibTeX reports any warnings or errors.
+ ((re-search-backward (concat
+ "^(There \\(?:was\\|were\\) \\([0-9]+\\) "
+ "\\(warnings?\\|error messages?\\))") nil t)
+ ;; Tell the user their number so that she sees whether the
+ ;; situation is getting better or worse.
+ (message (concat "BibTeX finished with %s %s. "
+ "Type `%s' to display output.")
+ (match-string 1) (match-string 2)
+ (substitute-command-keys
+ "\\<TeX-mode-map>\\[TeX-recenter-output-buffer]")))
+ (t
+ (message (concat "BibTeX finished successfully. "
+ "Run LaTeX again to get citations right."))
+ (setq TeX-command-next TeX-command-default))))
+
+(defun TeX-Biber-sentinel (process name)
+ "Cleanup TeX output buffer after running Biber."
+ (goto-char (point-max))
+ (cond
+ ((re-search-backward (concat
+ "^INFO - \\(WARNINGS\\|ERRORS\\): \\([0-9]+\\)") nil
t)
+ (message (concat "Biber finished with %s %s. "
+ "Type `%s' to display output.")
+ (match-string 2) (downcase (match-string 1))
+ (substitute-command-keys
+ "\\<TeX-mode-map>\\[TeX-recenter-output-buffer]"))
+ (setq TeX-command-next TeX-command-default))
+ ((re-search-backward (concat
+ "^FATAL") nil t)
+ (message (concat "Biber had a fatal error and did not finish! "
+ "Type `%s' to display output.")
+ (substitute-command-keys
+ "\\<TeX-mode-map>\\[TeX-recenter-output-buffer]"))
+ (setq TeX-command-next TeX-command-Biber))
+ (t
+ (message (concat "Biber finished successfully. "
+ "Run LaTeX again to get citations right."))
+ (setq TeX-command-next TeX-command-default))))
+
+;;; Process Control
+
+
+;; This variable is chared with `compile.el'.
+(defvar compilation-in-progress nil
+ "List of compilation processes now running.")
+
+(or (assq 'compilation-in-progress minor-mode-alist)
+ (setq minor-mode-alist (cons '(compilation-in-progress " Compiling")
+ minor-mode-alist)))
+
+(defun TeX-process-get-variable (name symbol &optional default)
+ "Return the value in the process buffer for NAME of SYMBOL.
+
+Return DEFAULT if the process buffer does not exist or SYMBOL is not
+defined."
+ (let ((buffer (TeX-process-buffer name)))
+ (if (and buffer
+ (local-variable-p symbol buffer))
+ (save-excursion
+ (set-buffer buffer)
+ (symbol-value symbol))
+ default)))
+
+(defun TeX-process-set-variable (name symbol value)
+ "Set the variable SYMBOL in the process buffer to VALUE.
+Return nil iff no process buffer exist."
+ (let ((buffer (TeX-process-buffer name)))
+ (if buffer
+ (save-excursion
+ (set-buffer buffer)
+ (set symbol value)
+ t)
+ nil)))
+
+(defun TeX-process-check (name)
+ "Check if a process for the TeX document NAME already exist.
+If so, give the user the choice of aborting the process or the current
+command."
+ (let (process)
+ (while (and (setq process (TeX-process name))
+ (eq (process-status process) 'run))
+ (cond
+ ((yes-or-no-p (concat "Process `"
+ (process-name process)
+ "' for document `"
+ name
+ "' running, kill it? "))
+ (delete-process process))
+ ((eq (process-status process) 'run)
+ (error "Cannot have two processes for the same document"))))))
+
+(defun TeX-process-buffer-name (name)
+ "Return name of AUCTeX buffer associated with the document NAME."
+ (concat "*" (abbreviate-file-name (expand-file-name name)) " output*"))
+
+(defun TeX-process-buffer (name)
+ "Return the AUCTeX buffer associated with the document NAME."
+ (get-buffer (TeX-process-buffer-name name)))
+
+(defun TeX-process (name)
+ "Return AUCTeX process associated with the document NAME."
+ (and TeX-process-asynchronous
+ (get-buffer-process (TeX-process-buffer name))))
+
+;;; Process Filters
+
+(defun TeX-command-mode-line (process)
+ "Format the mode line for a buffer containing output from PROCESS."
+ (setq mode-line-process (concat ": "
+ (symbol-name (process-status process))))
+ (set-buffer-modified-p (buffer-modified-p)))
+
+(defun TeX-command-filter (process string)
+ "Filter to process normal output."
+ (with-current-buffer (process-buffer process)
+ (save-excursion
+ (goto-char (process-mark process))
+ (insert-before-markers string)
+ (set-marker (process-mark process) (point)))))
+
+(defvar TeX-current-page nil
+ "The page number currently being formatted, enclosed in brackets.")
+
+ (make-variable-buffer-local 'TeX-current-page)
+
+(defun TeX-format-mode-line (process)
+ "Format the mode line for a buffer containing TeX output from PROCESS."
+ (setq mode-line-process (concat " " TeX-current-page ": "
+ (symbol-name (process-status process))))
+ (set-buffer-modified-p (buffer-modified-p)))
+
+(defun TeX-format-filter (process string)
+ "Filter to process TeX output."
+ (with-current-buffer (process-buffer process)
+ (let (str pos end (pt (marker-position (process-mark process))))
+ (save-excursion
+ (goto-char pt)
+ (insert-before-markers string)
+ (set-marker (process-mark process) (point))
+ ;; Remove line breaks at column 79
+ (while (> (point) pt)
+ (end-of-line 0)
+ (when (and (= (- (point) (line-beginning-position)) 79)
+ ;; Heuristic: Don't delete the linebreak if the
+ ;; next line is empty or starts with an opening
+ ;; parenthesis or if point is located after a period.
+ (not (memq (char-after (1+ (point))) '(?\n ?\()))
+ (not (eq (char-before) ?.)))
+ (delete-char 1)))
+ (goto-char (marker-position (process-mark process)))
+ ;; Determine current page
+ (while (and pt
+ (skip-chars-backward "^]" pt)
+ (> (point) pt))
+ (setq end (point))
+ (backward-char)
+ (skip-chars-backward "-0-9\n." (max (point-min) (- pt 128)))
+ (when (and (eq ?\[ (char-before))
+ (not (eq ?\] (char-after)))
+ (progn
+ (setq str (buffer-substring (1- (point)) end)
+ pos nil)
+ (while (setq pos (string-match "\n" str pos))
+ (setq str (replace-match "" t t str)))
+ (string-match
+ "\\`\\[-?[0-9]+\\(\\.-?[0-9]+\\)\\{0,9\\}\\]\\'"
+ str)))
+ (setq TeX-current-page str
+ pt nil)
+ (TeX-format-mode-line process)))))))
+
+(defvar TeX-parse-function nil
+ "Function to call to parse content of TeX output buffer.")
+ (make-variable-buffer-local 'TeX-parse-function)
+
+(defun TeX-background-filter (process string)
+ "Filter to process background output."
+ (let ((old-window (selected-window))
+ (pop-up-windows t))
+ (TeX-pop-to-buffer "*TeX background*" nil t)
+ (goto-char (point-max))
+ (insert string)
+ (select-window old-window)))
+
+;; Copy and adaption of `comint-postoutput-scroll-to-bottom' from CVS
+;; Emacs of 2005-04-24.
+(defun TeX-interactive-goto-prompt (string)
+ "Move point to prompt of an interactive TeX run."
+ (let* ((selected (selected-window))
+ (current (current-buffer))
+ (process (get-buffer-process current)))
+ (unwind-protect
+ (when process
+ (walk-windows
+ (lambda (window)
+ (when (eq (window-buffer window) current)
+ (select-window window)
+ (when (and (< (point) (process-mark process))
+ (string-match "^\\? $" string))
+ (goto-char (process-mark process)))
+ (select-window selected)))
+ nil t))
+ (set-buffer current))))
+
+
+;;; Active Process
+
+(defvar TeX-current-process-region-p nil
+ "This variable is set to t iff the last TeX command is on a region.")
+
+(defun TeX-active-process ()
+ "Return the active process for the current buffer."
+ (TeX-process (TeX-active-master)))
+
+(defun TeX-active-buffer ()
+ "Return the buffer of the active process for this buffer."
+ (and TeX-command-buffer
+ (TeX-process-buffer (with-current-buffer TeX-command-buffer
+ (TeX-active-master)))))
+
+(defun TeX-active-master (&optional extension nondirectory)
+ "The master file currently being compiled.
+
+If optional argument EXTENSION is non-nil, add that file extension to
+the name. Special value t means use `TeX-default-extension'.
+
+If optional second argument NONDIRECTORY is non-nil, do not include
+the directory."
+ (if TeX-current-process-region-p
+ (TeX-region-file extension nondirectory)
+ (TeX-master-file extension nondirectory)))
+
+(defvar TeX-command-buffer nil
+ "The buffer from where the last TeX command was issued.")
+
+;;; Region File
+
+(defcustom TeX-region-extra ""
+ "*String to insert in the region file between the header and the text."
+ :group 'TeX-command
+ :type 'string)
+
+;; This was "{\\makeatletter\\gdef\\AucTeX@cite#1[#2]#3{[#3#1#2]}\
+;; \\gdef\\cite{\\@ifnextchar[{\\AucTeX@cite{, }}\
+;; {\\AucTeX@cite{}[]}}}\n"
+;; However, that string is inappropriate for plain TeX and ConTeXt.
+;; This needs reconsideration.
+
+
+(defvar TeX-region-hook nil
+ "List of hooks to run before the region file is saved.
+The hooks are run in the region buffer, you may use the variable
+`master-buffer' to access the buffer of the master file and
+`orig-buffer' to access the buffer where \\[TeX-command-region] or
+\\[TeX-command-buffer] is invoked from.")
+
+(defun TeX-quote-filename (file)
+ "Convert file name into a form acceptable to TeX."
+ (let (pos)
+ (while (setq pos (string-match "\\\\" file pos))
+ (setq file (replace-match "/" t t file 0)
+ pos (1+ pos)))
+ (while (setq pos (string-match "[~#]" file pos))
+ (setq file (replace-match "\\\\string\\&" t nil file 0)
+ pos (+ pos 8))))
+ file)
+
+(defun TeX-region-create (file region original offset)
+ "Create a new file named FILE with the string REGION.
+The region is taken from ORIGINAL starting at line OFFSET.
+
+The current buffer and master file is searched, in order to ensure
+that the TeX header and trailer information is also included.
+
+The OFFSET is used to provide the debugger with information about the
+original file."
+ (let* (;; We shift buffer a lot, so we must keep track of the buffer
+ ;; local variables.
+ (header-end TeX-header-end)
+ (trailer-start TeX-trailer-start)
+
+ ;; We seach for header and trailer in the master file.
+ (orig-buffer (current-buffer))
+ (master-name (TeX-master-file TeX-default-extension))
+ (master-buffer (find-file-noselect master-name))
+
+ ;; Attempt to disable font lock.
+ (font-lock-defaults-alist nil)
+ (font-lock-defaults nil)
+ (font-lock-maximum-size 0)
+ (font-lock-mode-hook nil)
+ (font-lock-auto-fontify nil)
+ (font-lock-mode-enable-list nil)
+ ;; And insert them into the FILE buffer.
+ (file-buffer (let ((TeX-transient-master t))
+ (find-file-noselect file)))
+ ;; But remember original content.
+ original-content
+
+ ;; We search for the header from the master file, if it is
+ ;; not present in the region.
+ (header (if (string-match header-end region)
+ ""
+ (save-excursion
+ (save-restriction
+ (set-buffer master-buffer)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ ;; NOTE: We use the local value of
+ ;; TeX-header-end from the master file.
+ (if (not (re-search-forward TeX-header-end nil t))
+ ""
+ (re-search-forward "[\r\n]" nil t)
+ (buffer-substring (point-min) (point)))))))))
+
+ ;; We search for the trailer from the master file, if it is
+ ;; not present in the region.
+ (trailer-offset 0)
+ (trailer (if (string-match trailer-start region)
+ ""
+ (save-excursion
+ (save-restriction
+ (set-buffer master-buffer)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-max))
+ ;; NOTE: We use the local value of
+ ;; TeX-trailer-start from the master file.
+ (if (not (re-search-backward TeX-trailer-start nil
t))
+ ""
+ ;;(beginning-of-line 1)
+ (re-search-backward "[\r\n]" nil t)
+ (setq trailer-offset (TeX-current-offset))
+ (buffer-substring (point) (point-max))))))))))
+ ;; file name should be relative to master
+ (setq original (TeX-quote-filename (file-relative-name
+ original (TeX-master-directory)))
+ master-name (TeX-quote-filename master-name))
+ (save-excursion
+ (set-buffer file-buffer)
+ (setq buffer-undo-list t)
+ (setq original-content (buffer-string))
+ (erase-buffer)
+ (when (boundp 'buffer-file-coding-system)
+ (setq buffer-file-coding-system
+ (with-current-buffer master-buffer buffer-file-coding-system)))
+ (insert "\\message{ !name(" master-name ")}"
+ header
+ TeX-region-extra
+ "\n\\message{ !name(" original ") !offset(")
+ (insert (int-to-string (- offset
+ (1+ (TeX-current-offset))))
+ ") }\n"
+ region
+ "\n\\message{ !name(" master-name ") !offset(")
+ (insert (int-to-string (- trailer-offset
+ (1+ (TeX-current-offset))))
+ ") }\n"
+ trailer)
+ (run-hooks 'TeX-region-hook)
+ (if (string-equal (buffer-string) original-content)
+ (set-buffer-modified-p nil)
+ (save-buffer 0)))))
+
+(defun TeX-region-file (&optional extension nondirectory)
+ "Return TeX-region file name with EXTENSION.
+If optional second argument NONDIRECTORY is non-nil, do not include
+the directory."
+ (concat (if nondirectory "" (TeX-master-directory))
+ (cond ((eq extension t)
+ (concat TeX-region "." TeX-default-extension))
+ (extension
+ (concat TeX-region "." extension))
+ (t
+ TeX-region))))
+
+(defcustom TeX-region "_region_"
+ "*Base name of temporary file for `TeX-command-region' and
`TeX-command-buffer'."
+ :group 'TeX-command
+ :type 'string)
+
+;;; Parsing
+
+;;; - Global Parser Variables
+
+(defvar TeX-error-point nil
+ "How far we have parsed until now.")
+
+ (make-variable-buffer-local 'TeX-error-point)
+
+(defvar TeX-error-file nil
+ "Stack of files in which errors have occured.")
+
+ (make-variable-buffer-local 'TeX-error-file)
+
+(defvar TeX-error-offset nil
+ "Add this to any line numbers from TeX. Stack like `TeX-error-file'.")
+
+ (make-variable-buffer-local 'TeX-error-offset)
+
+(defun TeX-parse-reset ()
+ "Reset all variables used for parsing TeX output."
+ (setq TeX-error-point (point-min))
+ (setq TeX-error-offset nil)
+ (setq TeX-error-file nil))
+
+;;; - Parsers Hooks
+
+(defun TeX-parse-command (reparse)
+ "We can't parse anything but TeX."
+ (error "I cannot parse %s output, sorry"
+ (if (TeX-active-process)
+ (process-name (TeX-active-process))
+ "this")))
+
+(defun TeX-parse-TeX (reparse)
+ "Find the next error produced by running TeX.
+With \\[universal-argument] prefix, start from the beginning of the errors.
+
+If the file occurs in an included file, the file is loaded (if not
+already in an Emacs buffer) and the cursor is placed at the error."
+ (let ((old-buffer (current-buffer))
+ (default-major-mode major-mode))
+ (with-current-buffer (TeX-active-buffer)
+ (if reparse
+ (TeX-parse-reset))
+ (goto-char TeX-error-point)
+ (TeX-parse-error old-buffer))))
+
+;;; - Parsing (La)TeX
+
+(defvar TeX-translate-location-hook nil
+ "List of functions to be called before showing an error or warning.
+
+You might want to examine and modify the free variables `file',
+`offset', `line', `string', `error', and `context' from this hook.")
+
+(defun TeX-parse-error (old)
+ "Goto next error. Pop to OLD buffer if no more errors are found."
+ (let ((regexp
+ (concat
+ ;; TeX error
+ "^\\(!\\|\\(.*?\\):[0-9]+:\\) \\|"
+ ;; New file
+ "(\\(\"[^\"]*?\"\\|/*\
+\\(?:\\.+[^()\r\n{} \\/]*\\|[^()\r\n{} .\\/]+\
+\\(?: [^()\r\n{} .\\/]+\\)*\\(?:\\.[-0-9a-zA-Z_.]*\\)?\\)\
+\\(?:[\\/]+\\(?:\\.+[^()\r\n{} \\/]*\\|[^()\r\n{} .\\/]+\
+\\(?: [^()\r\n{} .\\/]+\\)*\\(?:\\.[-0-9a-zA-Z_.]*\\)?\\)?\\)*\\)\
+)*\\(?: \\|\r?$\\)\\|"
+ ;; End of file
+ "\\()\\))*\\|"
+ ;; Hook to change line numbers
+ " !\\(?:offset(\\([---0-9]+\\))\\|"
+ ;; Hook to change file name
+ "name(\\([^)]+\\))\\)\\|"
+ ;; LaTeX bad box
+ "^\\(\\(?:Overfull\\|Underfull\\|Tight\\|Loose\\)\
+ \\\\.*?[0-9]+--[0-9]+\\)\\|"
+ ;; LaTeX warning
+ "^\\(LaTeX [A-Za-z]*\\|Package [A-Za-z]+ \\)Warning:.*")))
+ (while
+ (cond
+ ((null
+ (re-search-forward regexp nil t))
+ ;; No more errors.
+ (message "No more errors.")
+ (beep)
+ (TeX-pop-to-buffer old)
+ nil)
+ ;; TeX error
+ ((match-beginning 1)
+ (when (match-beginning 2)
+ (unless TeX-error-file
+ (push nil TeX-error-file)
+ (push nil TeX-error-offset))
+ (unless (car TeX-error-offset)
+ (rplaca TeX-error-file (TeX-match-buffer 2))))
+ (if (looking-at "Preview ")
+ t
+ (TeX-error)
+ nil))
+ ;; LaTeX bad box
+ ((match-beginning 7)
+ (if TeX-debug-bad-boxes
+ (progn
+ (TeX-warning (TeX-match-buffer 7))
+ nil)
+ (re-search-forward "\r?\n\
+\\(?:.\\{79\\}\r?\n\
+\\)*.*\r?$")
+ t))
+ ;; LaTeX warning
+ ((match-beginning 8)
+ (if TeX-debug-warnings
+ (progn
+ (TeX-warning (TeX-match-buffer 8))
+ nil)
+ t))
+
+ ;; New file -- Push on stack
+ ((match-beginning 3)
+ (let ((file (TeX-match-buffer 3))
+ (end (match-end 3)))
+ ;; Strip quotation marks and remove newlines if necessary
+ (when (or (eq (string-to-char file) ?\")
+ (string-match "\n" file))
+ (setq file
+ (mapconcat 'identity (split-string file "[\"\n]+") "")))
+ (push file TeX-error-file)
+ (push nil TeX-error-offset)
+ (goto-char end))
+ t)
+
+ ;; End of file -- Pop from stack
+ ((match-beginning 4)
+ (when (> (length TeX-error-file) 0)
+ (pop TeX-error-file)
+ (pop TeX-error-offset))
+ (goto-char (match-end 4))
+ t)
+
+ ;; Hook to change line numbers
+ ((match-beginning 5)
+ (setq TeX-error-offset
+ (list (string-to-number (TeX-match-buffer 5))))
+ t)
+
+ ;; Hook to change file name
+ ((match-beginning 6)
+ (setq TeX-error-file
+ (list (TeX-match-buffer 6)))
+ t)))))
+
+(defun TeX-error ()
+ "Display an error."
+
+ (let* (;; We need the error message to show the user.
+ (error (progn
+ (re-search-forward "\\(.*\\)")
+ (TeX-match-buffer 1)))
+
+ ;; And the context for the help window.
+ (context-start (point))
+ context-available
+
+ ;; And the line number to position the cursor.
+ (line (cond
+ ;; regular style
+ ((re-search-forward "l\\.\\([0-9]+\\)" nil t)
+ (setq context-available t)
+ (string-to-number (TeX-match-buffer 1)))
+ ;; file:line:error style
+ ((save-excursion
+ (re-search-backward ":\\([0-9]+\\): "
+ (line-beginning-position) t))
+ (string-to-number (TeX-match-buffer 1)))
+ ;; nothing found
+ (t 1)))
+
+ ;; And a string of the context to search for.
+ (string (progn
+ (beginning-of-line)
+ (re-search-forward " \\(\\([^ \t]*$\\)\\|\\($\\)\\)")
+ (TeX-match-buffer 1)))
+
+ ;; And we have now found to the end of the context.
+ (context (if context-available
+ (buffer-substring context-start (progn (forward-line 1)
+ (end-of-line)
+ (point)))
+ ;; There is no real context available, so we
+ ;; simply show the line with the error message.
+ (buffer-substring (1- (line-beginning-position))
+ context-start)))
+ ;; We may use these in another buffer.
+ (offset (or (car TeX-error-offset) 0))
+ (file (car TeX-error-file)))
+
+ ;; Remember where we was.
+ (setq TeX-error-point (point))
+
+ ;; Find the error.
+ (if (null file)
+ (error "Error occured after last TeX file closed"))
+ (let ((runbuf (current-buffer))
+ (master (with-current-buffer
+ TeX-command-buffer
+ (expand-file-name (TeX-master-file))))
+ (command-buffer TeX-command-buffer)
+ error-file-buffer)
+ (run-hooks 'TeX-translate-location-hook)
+ (setq error-file-buffer (find-file file))
+ ;; Set the value of `TeX-command-buffer' in the next file with an
+ ;; error to be displayed to the value it has in the current buffer.
+ (with-current-buffer error-file-buffer
+ (set (make-local-variable 'TeX-command-buffer) command-buffer))
+ (goto-line (+ offset line))
+ (if (not (string= string " "))
+ (search-forward string nil t))
+
+ ;; Explain the error.
+ (cond ((eq TeX-display-help 'expert)
+ (TeX-pop-to-buffer runbuf nil t)
+ (goto-char TeX-error-point)
+ (TeX-pop-to-buffer error-file-buffer nil t))
+ (TeX-display-help
+ (TeX-help-error error context runbuf))
+ (t
+ (message (concat "! " error)))))))
+
+(defun TeX-warning (string)
+ "Display a warning for STRING."
+
+ (let* ((error (concat "** " string))
+
+ ;; bad-box is nil if this is a "LaTeX Warning"
+ (bad-box (string-match "\\\\[vh]box.*[0-9]*--[0-9]*" string))
+ ;; line-string: match 1 is beginning line, match 2 is end line
+ (line-string (if bad-box " \\([0-9]*\\)--\\([0-9]*\\)"
+ "on input line \\([0-9]*\\)\\."))
+ ;; word-string: match 1 is the word
+ (word-string (if bad-box "[][\\W() ---]\\(\\w+\\)[][\\W() ---]*$"
+ "`\\(\\w+\\)'"))
+
+ ;; Get error-line (warning)
+ (line (when (re-search-backward line-string nil t)
+ (string-to-number (TeX-match-buffer 1))))
+ (line-end (if bad-box (string-to-number (TeX-match-buffer 2))
+ line))
+
+ ;; Find the context
+ (context-start (progn (if bad-box (end-of-line)
+ (beginning-of-line))
+ (point)))
+
+ (context (progn
+ (forward-line 1)
+ (end-of-line)
+ (while (equal (current-column) 79)
+ (forward-line 1)
+ (end-of-line))
+ (buffer-substring context-start (point))))
+
+ ;; This is where we want to be.
+ (error-point (point))
+
+ ;; Now find the error word.
+ (string (when (re-search-backward word-string context-start t)
+ (TeX-match-buffer 1)))
+
+ ;; We might use these in another file.
+ (offset (or (car TeX-error-offset) 0))
+ (file (car TeX-error-file)))
+
+ ;; This is where we start next time.
+ (goto-char error-point)
+ (setq TeX-error-point (point))
+
+ (unless file
+ (error "Could not determine file for warning"))
+
+ ;; Go back to TeX-buffer
+ (let ((runbuf (current-buffer))
+ (master (with-current-buffer
+ TeX-command-buffer
+ (expand-file-name (TeX-master-file))))
+ (command-buffer TeX-command-buffer)
+ error-file-buffer)
+ (run-hooks 'TeX-translate-location-hook)
+ (setq error-file-buffer (find-file file))
+ ;; Set the value of `TeX-command-buffer' in the next file with an
+ ;; error to be displayed to the value it has in the current buffer.
+ (with-current-buffer error-file-buffer
+ (set (make-local-variable 'TeX-command-buffer) command-buffer))
+ ;; Find line and string
+ (when line
+ (goto-line (+ offset line))
+ (beginning-of-line 0)
+ (let ((start (point)))
+ (goto-line (+ offset line-end))
+ (end-of-line)
+ (when string
+ (search-backward string start t)
+ (search-forward string nil t))))
+ ;; Display help
+ (cond ((eq TeX-display-help 'expert)
+ (TeX-pop-to-buffer runbuf nil t)
+ (goto-char TeX-error-point)
+ (TeX-pop-to-buffer error-file-buffer nil t))
+ (TeX-display-help
+ (TeX-help-error error (if bad-box context (concat "\n" context))
+ runbuf))
+ (t
+ (message (concat "! " error)))))))
+
+;;; - Help
+
+(defun TeX-help-error (error output runbuffer)
+ "Print ERROR in context OUTPUT from RUNBUFFER in another window."
+
+ (let ((old-buffer (current-buffer))
+ (log-file (with-current-buffer runbuffer
+ (with-current-buffer TeX-command-buffer
+ (expand-file-name (TeX-active-master "log")))))
+ (TeX-error-pointer 0))
+
+ ;; Find help text entry.
+ (while (not (string-match (car (nth TeX-error-pointer
+ TeX-error-description-list))
+ error))
+ (setq TeX-error-pointer (+ TeX-error-pointer 1)))
+
+ (TeX-pop-to-buffer (get-buffer-create "*TeX Help*") nil t)
+ (erase-buffer)
+ (insert "ERROR: " error
+ "\n\n--- TeX said ---"
+ output
+ "\n--- HELP ---\n"
+ (let ((help (cdr (nth TeX-error-pointer
+ TeX-error-description-list))))
+ (save-excursion
+ (if (and (string= help "No help available")
+ (let* ((log-buffer (find-buffer-visiting log-file)))
+ (if log-buffer
+ (progn
+ (set-buffer log-buffer)
+ (revert-buffer t t))
+ (setq log-buffer
+ (find-file-noselect log-file))
+ (set-buffer log-buffer))
+ (auto-save-mode nil)
+ (setq buffer-read-only t)
+ (goto-line (point-min))
+ (search-forward error nil t 1))
+ (re-search-forward "^l\\." nil t)
+ (re-search-forward "^ [^\n]+$" nil t))
+ (let ((start (1+ (point))))
+ (forward-char 1)
+ (re-search-forward "^$")
+ (concat "From the .log file...\n\n"
+ (buffer-substring start (point))))
+ help))))
+ (goto-char (point-min))
+ (TeX-pop-to-buffer old-buffer nil t)))
+
+;;; Error Messages
+
+(defcustom TeX-error-description-list
+ '(("\\(?:Package Preview Error\\|Preview\\):.*" .
+"The `auctex' option to `preview' should not be applied manually.
+If you see this error message outside of a preview run, either
+you did something too clever, or AUCTeX something too stupid.")
+
+ ("Bad \\\\line or \\\\vector argument.*" .
+"The first argument of a \\line or \\vector command, which specifies the
+slope, is illegal\.")
+
+ ("Bad math environment delimiter.*" .
+"TeX has found either a math-mode-starting command such as \\[ or \\(
+when it is already in math mode, or else a math-mode-ending command
+such as \\) or \\] while in LR or paragraph mode. The problem is caused
+by either unmatched math mode delimiters or unbalanced braces\.")
+
+ ("Bad use of \\\\\\\\.*" .
+"A \\\\ command appears between paragraphs, where it makes no sense. This
+error message occurs when the \\\\ is used in a centering or flushing
+environment or else in the scope of a centering or flushing
+declaration.")
+
+ ("\\\\begin{[^ ]*} ended by \\\\end{[^ ]*}." .
+"LaTeX has found an \\end command that doesn't match the corresponding
+\\begin command. You probably misspelled the environment name in the
+\\end command, have an extra \\begin, or else forgot an \\end.")
+
+ ("Can be used only in preamble." .
+"LaTeX has encountered, after the \\begin{document}, one of the
+following commands that should appear only in the preamble:
+\\documentclass, \\nofiles, \\includeonly, \\makeindex, or
+\\makeglossary. The error is also caused by an extra \\begin{document}
+command.")
+
+ ("Command name [^ ]* already used.*" .
+"You are using \\newcommand, \\newenvironment, \\newlength, \\newsavebox,
+or \\newtheorem to define a command or environment name that is
+already defined, or \\newcounter to define a counter that already
+exists. (Defining an environment named gnu automatically defines the
+command \\gnu.) You'll have to choose a new name or, in the case of
+\\newcommand or \\newenvironment, switch to the \\renew ... command.")
+
+ ("Counter too large." .
+"1. Some object that is numbered with letters, probably an item in a
+enumerated list, has received a number greater than 26. Either you're
+making a very long list or you've been resetting counter values.
+
+2. Footnotes are being ``numbered'' with letters or footnote symbols
+and LaTeX has run out of letters or symbols. This is probably caused
+by too many \\thanks commands.")
+
+ ("Environment [^ ]* undefined." .
+"LaTeX has encountered a \\begin command for a nonexistent environment.
+You probably misspelled the environment name. ")
+
+ ("Float(s) lost." .
+"You put a figure or table environment or a \\marginpar command inside a
+parbox---either one made with a minipage environment or \\parbox
+command, or one constructed by LaTeX in making a footnote, figure,
+etc. This is an outputting error, and the offending environment or
+command may be quite a way back from the point where LaTeX discovered
+the problem. One or more figures, tables, and/or marginal notes have
+been lost, but not necessarily the one that caused the error.")
+
+ ("Illegal character in array arg." .
+"There is an illegal character in the argument of an array or tabular
+environment, or in the second argument of a \\multicolumn command.")
+
+ ("Missing \\\\begin{document}." .
+"LaTeX produced printed output before encountering a \\begin{document}
+command. Either you forgot the \\begin{document} command or there is
+something wrong in the preamble. The problem may be a stray character
+or an error in a declaration---for example, omitting the braces around
+an argument or forgetting the \\ in a command name.")
+
+ ("Missing p-arg in array arg.*" .
+"There is a p that is not followed by an expression in braces in the
+argument of an array or tabular environment, or in the second argument
+of a \\multicolumn command.")
+
+ ("Missing @-exp in array arg." .
+"There is an @ character not followed by an @-expression in the
+argument of an array or tabular environment, or in the second argument
+of a \\multicolumn command.")
+
+ ("No such counter." .
+"You have specified a nonexistent counter in a \\setcounter or
+\\addtocounter command. This is probably caused by a simple typing
+error. However, if the error occurred while a file with the extension
+aux is being read, then you probably used a \\newcounter command
+outside the preamble.")
+
+ ("Not in outer par mode." .
+"You had a figure or table environment or a \\marginpar command in math
+mode or inside a parbox.")
+
+ ("\\\\pushtabs and \\\\poptabs don't match." .
+"LaTeX found a \\poptabs with no matching \\pushtabs, or has come to the
+\\end{tabbing} command with one or more unmatched \\pushtabs commands.")
+
+ ("Something's wrong--perhaps a missing \\\\item." .
+"The most probable cause is an omitted \\item command in a list-making
+environment. It is also caused by forgetting the argument of a
+thebibliography environment.")
+
+ ("Tab overflow." .
+"A \\= command has exceeded the maximum number of tab stops that LaTeX
+permits.")
+
+ ("There's no line here to end." .
+"A \\newline or \\\\ command appears between paragraphs, where it makes no
+sense. If you're trying to ``leave a blank line'', use a \\vspace
+command.")
+
+ ("This may be a LaTeX bug." .
+"LaTeX has become thoroughly confused. This is probably due to a
+previously detected error, but it is possible that you have found an
+error in LaTeX itself. If this is the first error message produced by
+the input file and you can't find anything wrong, save the file and
+contact the person listed in your Local Guide.")
+
+ ("Too deeply nested." .
+"There are too many list-making environments nested within one another.
+How many levels of nesting are permitted may depend upon what computer
+you are using, but at least four levels are provided, which should be
+enough.")
+
+ ("Too many unprocessed floats." .
+"While this error can result from having too many \\marginpar commands
+on a page, a more likely cause is forcing LaTeX to save more figures
+and tables than it has room for. When typesetting its continuous
+scroll, LaTeX saves figures and tables separately and inserts them as
+it cuts off pages. This error occurs when LaTeX finds too many figure
+and/or table environments before it is time to cut off a page, a
+problem that is solved by moving some of the environments farther
+towards the end of the input file. The error can also be caused by a
+``logjam''---a figure or table that cannot be printed causing others
+to pile up behind it, since LaTeX will not print figures or tables out
+of order. The jam can be started by a figure or table that either is
+too large to fit on a page or won't fit where its optional placement
+argument says it must go. This is likely to happen if the argument
+does not contain a p option.")
+
+ ("Undefined tab position." .
+"A \\>, \\+, \\-, or \\< command is trying to go to a nonexistent tab
+position---one not defined by a \\= command.")
+
+ ("\\\\< in mid line." .
+"A \\< command appears in the middle of a line in a tabbing environment.
+This command should come only at the beginning of a line.")
+
+ ("Double subscript." .
+"There are two subscripts in a row in a mathematical
+formula---something like x_{2}_{3}, which makes no sense.")
+
+ ("Double superscript." .
+"There are two superscripts in a row in a mathematical
+formula---something like x^{2}^{3}, which makes no sense.")
+
+ ("Extra alignment tab has been changed to \\\\cr." .
+"There are too many separate items (column entries) in a single row of
+an array or tabular environment. In other words, there were too many &
+'s before the end of the row. You probably forgot the \\\\ at the end of
+the preceding row.")
+
+ ("Extra \\}, or forgotten \\$." .
+"The braces or math mode delimiters don't match properly. You probably
+forgot a {, \\[, \\(, or $.")
+
+ ("Font [^ ]* not loaded: Not enough room left." .
+"The document uses more fonts than TeX has room for. If different parts
+of the document use different fonts, then you can get around the
+problem by processing it in parts.")
+
+ ("I can't find file `.*'." .
+"TeX can't find a file that it needs. If the name of the missing file
+has the extension tex, then it is looking for an input file that you
+specified---either your main file or another file inserted with an
+\\input or \\include command. If the missing file has the extension sty
+, then you have specified a nonexistent document style or style
+option.")
+
+ ("Illegal parameter number in definition of .*" .
+"This is probably caused by a \\newcommand, \\renewcommand,
+\\newenvironment, or \\renewenvironment command in which a # is used
+incorrectly. A # character, except as part of the command name \\#,
+can be used only to indicate an argument parameter, as in #2, which
+denotes the second argument. This error is also caused by nesting one
+of the above four commands inside another, or by putting a parameter
+like #2 in the last argument of a \\newenvironment or \\renewenvironment
+command.")
+
+ ("Illegal unit of measure ([^ ]* inserted)." .
+"If you just got a
+
+ ! Missing number, treated as zero.
+
+error, then this is part of the same problem. If not, it means that
+LaTeX was expecting a length as an argument and found a number
+instead. The most common cause of this error is writing 0 instead of
+something like 0in for a length of zero, in which case typing return
+should result in correct output. However, the error can also be caused
+by omitting a command argument.")
+
+ ("Misplaced alignment tab character \\&." .
+"The special character &, which should be used only to separate items
+in an array or tabular environment, appeared in ordinary text. You
+probably meant to type \\&.")
+
+ ("Missing control sequence inserted." .
+"This is probably caused by a \\newcommand, \\renewcommand, \\newlength,
+or \\newsavebox command whose first argument is not a command name.")
+
+ ("Missing number, treated as zero." .
+"This is usually caused by a LaTeX command expecting but not finding
+either a number or a length as an argument. You may have omitted an
+argument, or a square bracket in the text may have been mistaken for
+the beginning of an optional argument. This error is also caused by
+putting \\protect in front of either a length command or a command such
+as \\value that produces a number.")
+
+ ("Missing [{}] inserted." .
+"TeX has become confused. The position indicated by the error locator
+is probably beyond the point where the incorrect input is.")
+
+ ("Missing \\$ inserted." .
+"TeX probably found a command that can be used only in math mode when
+it wasn't in math mode. Remember that unless stated otherwise, all
+all the commands of Section 3.3 in LaTeX Book (Lamport) can be used
+only in math mode. TeX is not in math mode when it begins processing
+the argument of a box-making command, even if that command is inside a
+math environment. This error also occurs if TeX encounters a blank
+line when it is in math mode.")
+
+ ("Not a letter." .
+"Something appears in the argument of a \\hyphenation command that
+doesn't belong there.")
+
+ ("Paragraph ended before [^ ]* was complete." .
+"A blank line occurred in a command argument that shouldn't contain
+one. You probably forgot the right brace at the end of an argument.")
+
+ ("\\\\[^ ]*font [^ ]* is undefined .*" .
+"These errors occur when an uncommon font is used in math mode---for
+example, if you use a \\sc command in a formula inside a footnote,
+calling for a footnote-sized small caps font. This problem is solved
+by using a \\load command.")
+
+ ("Font .* not found." .
+"You requested a family/series/shape/size combination that is totally
+unknown. There are two cases in which this error can occur:
+ 1) You used the \\size macro to select a size that is not available.
+ 2) If you did not do that, go to your local `wizard' and
+ complain fiercely that the font selection tables are corrupted!")
+
+ ("TeX capacity exceeded, sorry .*" .
+"TeX has just run out of space and aborted its execution. Before you
+panic, remember that the least likely cause of this error is TeX not
+having the capacity to process your document. It was probably an
+error in your input file that caused TeX to run out of room. The
+following discussion explains how to decide whether you've really
+exceeded TeX's capacity and, if so, what to do. If the problem is an
+error in the input, you may have to use the divide and conquer method
+described previously to locate it. LaTeX seldom runs out of space on a
+short input file, so if running it on the last few pages before the
+error indicator's position still produces the error, then there's
+almost certainly something wrong in the input file.
+
+The end of the error indicator tells what kind of space TeX ran out
+of. The more common ones are listed below, with an explanation of
+their probable causes.
+
+buffer size
+===========
+Can be caused by too long a piece of text as the argument
+of a sectioning, \\caption, \\addcontentsline, or \\addtocontents
+command. This error will probably occur when the \\end{document} is
+being processed, but it could happen when a \\tableofcontents,
+\\listoffigures, or \\listoftables command is executed. To solve this
+problem, use a shorter optional argument. Even if you're producing a
+table of contents or a list of figures or tables, such a long entry
+won't help the reader.
+
+exception dictionary
+====================
+You have used \\hyphenation commands to give TeX
+more hyphenation information than it has room for. Remove some of the
+less frequently used words from the \\hyphenation commands and insert
+\\- commands instead.
+
+hash size
+=========
+Your input file defines too many command names and/or uses
+too many cross-ref- erencing labels.
+
+input stack size
+================
+This is probably caused by an error in a command
+definition. For example, the following command makes a circular
+definition, defining \\gnu in terms of itself:
+
+ \\newcommand{\\gnu}{a \\gnu} % This is wrong!
+
+When TeX encounters this \\gnu command, it will keep chasing its tail
+trying to figure out what \\gnu should produce, and eventually run out
+of ``input stack''.
+
+main memory size
+================
+This is one kind of space that TeX can run out of when processing a
+short file. There are three ways you can run TeX out of main memory
+space: (1) defining a lot of very long, complicated commands, (2)
+making an index or glossary and having too many \\index or \\glossary
+commands on a single page, and (3) creating so complicated a page of
+output that TeX can't hold all the information needed to generate it.
+The solution to the first two problems is obvious: define fewer
+commands or use fewer \\index and \\glossary commands. The third problem
+is nastier. It can be caused by large tabbing, tabular, array, and
+picture environments. TeX's space may also be filled up with figures
+and tables waiting for a place to go. To find out if you've really
+exceeded TeX's capacity in this way, put a \\clearpage command in your
+input file right before the place where TeX ran out of room and try
+running it again. If it doesn't run out of room with the \\clearpage
+command there, then you did exceed TeX's capacity. If it still runs
+out of room, then there's probably an error in your file. If TeX is
+really out of room, you must give it some help. Remember that TeX
+processes a complete paragraph before deciding whether to cut the
+page. Inserting a \\newpage command in the middle of the paragraph,
+where TeX should break the page, may save the day by letting TeX write
+the current page before processing the rest of the paragraph. (A
+\\pagebreak command won't help.) If the problem is caused by
+accumulated figures and tables, you can try to prevent them from
+accumulating---either by moving them further towards the end of the
+document or by trying to get them to come out sooner. If you are
+still writing the document, simply add a \\clearpage command and forget
+about the problem until you're ready to produce the final version.
+Changes to the input file are likely to make the problem go away.
+
+pool size
+=========
+You probably used too many cross-ref-erencing \\labels and/or defined
+too many new command names. More precisely, the labels and command
+names that you define have too many characters, so this problem can be
+solved by using shorter names. However, the error can also be caused
+by omitting the right brace that ends the argument of either a counter
+command such as \\setcounter, or a \\newenvironment or \\newtheorem
+command.
+
+save size
+=========
+This occurs when commands, environments, and the scopes of
+declarations are nested too deeply---for example, by having the
+argument of a \\multiput command contain a picture environment that in
+turn has a \\footnotesize declaration whose scope contains a \\multiput
+command containing a ....")
+
+ ("Text line contains an invalid character." .
+"The input contains some strange character that it shouldn't. A mistake
+when creating the file probably caused your text editor to insert this
+character. Exactly what could have happened depends upon what text
+editor you used. If examining the input file doesn't reveal the
+offending character, consult the Local Guide for suggestions.")
+
+ ("Undefined control sequence." .
+"TeX encountered an unknown command name. You probably misspelled the
+name. If this message occurs when a LaTeX command is being processed,
+the command is probably in the wrong place---for example, the error
+can be produced by an \\item command that's not inside a list-making
+environment. The error can also be caused by a missing \\documentclass
+command.")
+
+ ("Use of [^ ]* doesn't match its definition." .
+"It's probably one of the picture-drawing commands, and you have used
+the wrong syntax for specifying an argument. If it's \\@array that
+doesn't match its definition, then there is something wrong in an
+@-expression in the argument of an array or tabular
+environment---perhaps a fragile command that is not \\protect'ed.")
+
+ ("You can't use `macro parameter character \\#' in [^ ]* mode." .
+"The special character # has appeared in ordinary text. You probably
+meant to type \\#.")
+
+ ("Overfull \\\\hbox .*" .
+"Because it couldn't find a good place for a line break, TeX put more
+on this line than it should.")
+
+ ("Overfull \\\\vbox .*" .
+"Because it couldn't find a good place for a page break, TeX put more
+on the page than it should. ")
+
+ ("Underfull \\\\hbox .*" .
+"Check your output for extra vertical space. If you find some, it was
+probably caused by a problem with a \\\\ or \\newline command---for
+example, two \\\\ commands in succession. This warning can also be
+caused by using the sloppypar environment or \\sloppy declaration, or
+by inserting a \\linebreak command.")
+
+ ("Underfull \\\\vbox .*" .
+"TeX could not find a good place to break the page, so it produced a
+page without enough text on it. ")
+
+;; New list items should be placed here
+;;
+;; ("err-regexp" . "context")
+;;
+;; the err-regexp item should match anything
+
+ (".*" . "No help available")) ; end definition
+"A list of the form (\"err-regexp\" . \"context\") used by function
+`TeX-help-error' to display help-text on an error message or warning.
+err-regexp should be a regular expression matching the error message
+given from TeX/LaTeX, and context should be some lines describing that
+error."
+ :group 'TeX-output
+ :type '(repeat (cons :tag "Entry"
+ (regexp :tag "Match")
+ (string :format "Description:\n%v"))))
+
+(provide 'tex-buf)
+
+;;; tex-buf.el ends here
diff --git a/tests/auctex-11.87.7/tex-fold.el b/tests/auctex-11.87.7/tex-fold.el
new file mode 100644
index 0000000..05bd61a
--- /dev/null
+++ b/tests/auctex-11.87.7/tex-fold.el
@@ -0,0 +1,983 @@
+;;; tex-fold.el --- Fold TeX macros.
+
+;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2011-2012
+;; Free Software Foundation, Inc.
+
+;; Author: Ralf Angeli <angeli@caeruleus.net>
+;; Maintainer: auctex-devel@gnu.org
+;; Created: 2004-07-04
+;; Keywords: tex, wp
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; This file provides support for hiding and unhiding TeX, LaTeX,
+;; ContTeXt, Texinfo and similar macros and environments inside of
+;; AUCTeX.
+;;
+;; Caveats:
+;;
+;; The display string of content which should display part of itself
+;; is made by copying the text from the buffer together with its text
+;; properties. If fontification has not happened when this is done
+;; (e.g. because of lazy or just-in-time font locking) the intended
+;; fontification will not show up. Maybe this could be improved by
+;; using some sort of "lazy folding" or refreshing the window upon
+;; scrolling. As a workaround fontification of the whole buffer
+;; currently is forced before folding it.
+
+;;; Code:
+
+(when (featurep 'xemacs)
+ (require 'overlay))
+(require 'tex)
+(autoload 'LaTeX-forward-paragraph "latex")
+(autoload 'LaTeX-backward-paragraph "latex")
+(autoload 'LaTeX-find-matching-begin "latex")
+(autoload 'LaTeX-find-matching-end "latex")
+(autoload 'ConTeXt-find-matching-start "context")
+(autoload 'ConTeXt-find-matching-stop "context")
+(autoload 'Texinfo-find-env-start "tex-info")
+(autoload 'Texinfo-find-env-end "tex-info")
+
+(defgroup TeX-fold nil
+ "Fold TeX macros."
+ :group 'AUCTeX)
+
+(defcustom TeX-fold-type-list '(env macro math)
+ "List of item types to consider when folding.
+Valid items are the symbols 'env for environments, 'macro for
+macros, 'math for math macros and 'comment for comments."
+ :type '(set (const :tag "Environments" env)
+ (const :tag "Macros" macro)
+ (const :tag "Math Macros" math)
+ (const :tag "Comments" comment))
+ :group 'TeX-fold)
+
+(defcustom TeX-fold-macro-spec-list
+ `(("[f]" ("footnote" "marginpar"))
+ ("[c]" ("cite"))
+ ("[l]" ("label"))
+ ("[r]" ("ref" "pageref" "eqref"))
+ ("[i]" ("index" "glossary"))
+ ("[1]:||*" ("item"))
+ ("..." ("dots"))
+ ("(C)" ("copyright"))
+ ("(R)" ("textregistered"))
+ ("TM" ("texttrademark"))
+ (1 ("part" "chapter" "section" "subsection" "subsubsection"
+ "paragraph" "subparagraph"
+ "part*" "chapter*" "section*" "subsection*" "subsubsection*"
+ "paragraph*" "subparagraph*"
+ "emph" "textit" "textsl" "textmd" "textrm" "textsf" "texttt"
+ "textbf" "textsc" "textup")))
+ "List of replacement specifiers and macros to fold.
+
+The first element of each item can be a string, an integer or a
+function symbol. The second element is a list of macros two fold
+without the leading backslash.
+
+If the first element is a string, it will be used as a display
+replacement for the whole macro. Numbers in braces, brackets,
+parens or angle brackets will be replaced by the respective macro
+argument. For example \"{1}\" will be replaced by the first
+mandatory argument of the macro. One can also define
+alternatives within the specifier which are used if an argument
+is not found. Alternatives are separated by \"||\". They are
+most useful with optional arguments. As an example, the default
+specifier for \\item is \"[1]:||*\" which means that if there is
+an optional argument, its value is shown followed by a colon. If
+there is no optional argument, only an asterisk is used as the
+display string.
+
+If the first element is an integer, the macro will be replaced by
+the respective macro argument.
+
+If the first element is a function symbol, the function will be
+called with all mandatory arguments of the macro and the result
+of the function call will be used as a replacement for the macro.
+
+Setting this variable does not take effect immediately. Use
+Customize or reset the mode."
+ :type '(repeat (group (choice (string :tag "Display String")
+ (integer :tag "Number of argument" :value 1)
+ (function :tag "Function to execute"))
+ (repeat :tag "Macros" (string))))
+ :group 'TeX-fold)
+
+(defvar TeX-fold-macro-spec-list-internal nil
+ "Internal list of display strings and macros to fold.
+Is updated when the TeX Fold mode is being activated and then
+contains all constructs to fold for the given buffer or mode
+respectively, i.e. contents of both `TeX-fold-macro-spec-list'
+and <mode-prefix>-fold-macro-spec-list.")
+(make-variable-buffer-local 'TeX-fold-macro-spec-list-internal)
+
+(defcustom TeX-fold-env-spec-list
+ '(("[comment]" ("comment")))
+ "List of display strings and environments to fold."
+ :type '(repeat (group (choice (string :tag "Display String")
+ (integer :tag "Number of argument" :value 1))
+ (repeat :tag "Environments" (string))))
+ :group 'TeX-fold)
+
+(defvar TeX-fold-env-spec-list-internal nil
+ "Internal list of display strings and environments to fold.
+Is updated when the TeX Fold mode is being activated and then
+contains all constructs to fold for the given buffer or mode
+respectively, i.e. contents of both `TeX-fold-env-spec-list'
+and <mode-prefix>-fold-env-spec-list.")
+(make-variable-buffer-local 'TeX-fold-env-spec-list-internal)
+
+(defcustom TeX-fold-math-spec-list nil
+ "List of display strings and math macros to fold."
+ :type '(repeat (group (choice (string :tag "Display String")
+ (integer :tag "Number of argument" :value 1))
+ (repeat :tag "Math Macros" (string))))
+ :group 'TeX-fold)
+
+(defvar TeX-fold-math-spec-list-internal nil
+ "Internal list of display strings and math macros to fold.
+Is updated when the TeX Fold mode is being activated and then
+contains all constructs to fold for the given buffer or mode
+respectively, i.e. contents of both `TeX-fold-math-spec-list'
+and <mode-prefix>-fold-math-spec-list.")
+(make-variable-buffer-local 'TeX-fold-math-spec-list-internal)
+
+(defcustom TeX-fold-unspec-macro-display-string "[m]"
+ "Display string for unspecified macros.
+This string will be displayed if a single macro is being hidden
+which is not specified in `TeX-fold-macro-spec-list'."
+ :type '(string)
+ :group 'TeX-fold)
+
+(defcustom TeX-fold-unspec-env-display-string "[env]"
+ "Display string for unspecified environments.
+This string will be displayed if a single environment is being
+hidden which is not specified in `TeX-fold-env-spec-list'."
+ :type '(string)
+ :group 'TeX-fold)
+
+(defcustom TeX-fold-unspec-use-name t
+ "If non-nil use the name of an unspecified item as display string.
+Set it to nil if you want to use the values of the variables
+`TeX-fold-unspec-macro-display-string' or
+`TeX-fold-unspec-env-display-string' respectively as a display
+string for any unspecified macro or environment."
+ :type 'boolean
+ :group 'TeX-fold)
+
+(defcustom TeX-fold-preserve-comments nil
+ "If non-nil do not fold in comments."
+ :type 'boolean
+ :group 'TeX-fold)
+
+(defcustom TeX-fold-unfold-around-mark t
+ "Unfold text around the mark, if active."
+ :type 'boolean
+ :group 'TeX-fold)
+
+(defcustom TeX-fold-help-echo-max-length 70
+ "Maximum length of help echo message for folded overlays.
+Set it to zero in order to disable help echos."
+ :type 'integer
+ :group 'TeX-fold)
+
+(defcustom TeX-fold-force-fontify t
+ "Force the buffer to be fully fontified by folding it."
+ :group 'TeX-fold
+ :type 'boolean)
+
+(defcustom TeX-fold-auto nil
+ "If non-nil, fold macros automatically after `TeX-insert-macro'."
+ :group 'TeX-fold
+ :type 'boolean)
+
+(defface TeX-fold-folded-face
+ '((((class color) (background light))
+ (:foreground "SlateBlue"))
+ (((class color) (background dark))
+ (:foreground "SlateBlue1"))
+ (((class grayscale) (background light))
+ (:foreground "DimGray"))
+ (((class grayscale) (background dark))
+ (:foreground "LightGray"))
+ (t (:slant italic)))
+ "Face for the display string of folded content."
+ :group 'TeX-fold)
+
+(defvar TeX-fold-folded-face 'TeX-fold-folded-face
+ "Face for the display string of folded content.")
+
+(defface TeX-fold-unfolded-face
+ '((((class color) (background light))
+ (:background "#f2f0fd"))
+ (((class color) (background dark))
+ (:background "#38405d"))
+ (((class grayscale) (background light))
+ (:background "LightGray"))
+ (((class grayscale) (background dark))
+ (:background "DimGray"))
+ (t (:inverse-video t)))
+ "Face for folded content when it is temporarily opened."
+ :group 'TeX-fold)
+
+(defvar TeX-fold-unfolded-face 'TeX-fold-unfolded-face
+ "Face for folded content when it is temporarily opened.")
+
+(defvar TeX-fold-ellipsis "..."
+ "String used as display string for overlays instead of a zero-length
string.")
+
+(defvar TeX-fold-open-spots nil)
+(make-variable-buffer-local 'TeX-fold-open-spots)
+
+(defcustom TeX-fold-command-prefix "\C-c\C-o"
+ "Prefix key to use for commands in TeX Fold mode.
+The value of this variable is checked as part of loading TeX Fold mode.
+After that, changing the prefix key requires manipulating keymaps."
+ :type 'string
+ :group 'TeX-fold)
+
+(defvar TeX-fold-keymap
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\C-o" 'TeX-fold-dwim)
+ (define-key map "\C-b" 'TeX-fold-buffer)
+ (define-key map "\C-r" 'TeX-fold-region)
+ (define-key map "\C-p" 'TeX-fold-paragraph)
+ (define-key map "\C-m" 'TeX-fold-macro)
+ (define-key map "\C-e" 'TeX-fold-env)
+ (define-key map "\C-c" 'TeX-fold-comment)
+ (define-key map "b" 'TeX-fold-clearout-buffer)
+ (define-key map "r" 'TeX-fold-clearout-region)
+ (define-key map "p" 'TeX-fold-clearout-paragraph)
+ (define-key map "i" 'TeX-fold-clearout-item)
+ map))
+
+
+;;; Folding
+
+(defun TeX-fold-dwim ()
+ "Hide or show items according to the current context.
+If there is folded content, unfold it. If there is a marked
+region, fold all configured content in this region. If there is
+no folded content but a macro or environment, fold it."
+ (interactive)
+ (cond ((TeX-fold-clearout-item))
+ ((TeX-active-mark) (TeX-fold-region (mark) (point)))
+ ((TeX-fold-item 'macro))
+ ((TeX-fold-item 'math))
+ ((TeX-fold-item 'env))
+ ((TeX-fold-comment))))
+
+(defun TeX-fold-buffer ()
+ "Hide all configured macros and environments in the current buffer.
+The relevant macros are specified in the variable `TeX-fold-macro-spec-list'
+and `TeX-fold-math-spec-list', and environments in `TeX-fold-env-spec-list'."
+ (interactive)
+ (TeX-fold-clearout-region (point-min) (point-max))
+ (when (and TeX-fold-force-fontify
+ (boundp 'jit-lock-mode)
+ jit-lock-mode
+ (fboundp 'jit-lock-fontify-now))
+ ;; We force fontification here only because it should rarely be
+ ;; needed for the other folding commands.
+ (jit-lock-fontify-now))
+ (TeX-fold-region (point-min) (point-max)))
+
+(defun TeX-fold-paragraph ()
+ "Hide all configured macros and environments in the current paragraph.
+The relevant macros are specified in the variable `TeX-fold-macro-spec-list'
+and `TeX-fold-math-spec-list', and environments in `TeX-fold-env-spec-list'."
+ (interactive)
+ (save-excursion
+ (let ((end (progn (LaTeX-forward-paragraph) (point)))
+ (start (progn (LaTeX-backward-paragraph) (point))))
+ (TeX-fold-clearout-region start end)
+ (TeX-fold-region start end))))
+
+(defun TeX-fold-region (start end)
+ "Fold all items in region from START to END."
+ (interactive "r")
+ (when (and (memq 'env TeX-fold-type-list)
+ (not (eq major-mode 'plain-tex-mode)))
+ (TeX-fold-region-macro-or-env start end 'env))
+ (when (memq 'macro TeX-fold-type-list)
+ (TeX-fold-region-macro-or-env start end 'macro))
+ (when (memq 'math TeX-fold-type-list)
+ (TeX-fold-region-macro-or-env start end 'math))
+ (when (memq 'comment TeX-fold-type-list)
+ (TeX-fold-region-comment start end)))
+
+(defun TeX-fold-region-macro-or-env (start end type)
+ "Fold all items of type TYPE in region from START to END.
+TYPE can be one of the symbols 'env for environments, 'macro
+for macros and 'math for math macros."
+ (save-excursion
+ (let (fold-list item-list regexp)
+ (dolist (item (cond ((eq type 'env) TeX-fold-env-spec-list-internal)
+ ((eq type 'math) TeX-fold-math-spec-list-internal)
+ (t TeX-fold-macro-spec-list-internal)))
+ (dolist (i (cadr item))
+ (add-to-list 'fold-list (list i (car item)))
+ (add-to-list 'item-list i)))
+ (when item-list
+ (setq regexp (cond ((and (eq type 'env)
+ (eq major-mode 'context-mode))
+ (concat (regexp-quote TeX-esc)
+ "start" (regexp-opt item-list t)))
+ ((and (eq type 'env)
+ (eq major-mode 'texinfo-mode))
+ (concat (regexp-quote TeX-esc)
+ (regexp-opt item-list t)))
+ ((eq type 'env)
+ (concat (regexp-quote TeX-esc)
+ "begin[ \t]*{"
+ (regexp-opt item-list t) "}"))
+ (t
+ (concat (regexp-quote TeX-esc)
+ (regexp-opt item-list t)))))
+ (save-restriction
+ (narrow-to-region start end)
+ ;; Start from the bottom so that it is easier to prioritize
+ ;; nested macros.
+ (goto-char (point-max))
+ (let ((case-fold-search nil)
+ item-name)
+ (while (re-search-backward regexp nil t)
+ (setq item-name (match-string 1))
+ (unless (or (and TeX-fold-preserve-comments
+ (TeX-in-commented-line))
+ ;; Make sure no partially matched macros are
+ ;; folded. For macros consisting of letters
+ ;; this means there should be none of the
+ ;; characters [A-Za-z@*] after the matched
+ ;; string. Single-char non-letter macros like
+ ;; \, don't have this requirement.
+ (and (memq type '(macro math))
+ (save-match-data
+ (string-match "[A-Za-z]" item-name))
+ (save-match-data
+ (string-match "[A-Za-z@*]"
+ (string (char-after
+ (match-end 0)))))))
+ (let* ((item-start (match-beginning 0))
+ (display-string-spec (cadr (assoc item-name
+ fold-list)))
+ (item-end (TeX-fold-item-end item-start type))
+ (ov (TeX-fold-make-overlay item-start item-end type
+ display-string-spec)))
+ (TeX-fold-hide-item ov))))))))))
+
+(defun TeX-fold-region-comment (start end)
+ "Fold all comments in region from START to END."
+ (save-excursion
+ (goto-char start)
+ (let (beg)
+ (while (setq beg (TeX-search-forward-comment-start end))
+ (goto-char beg)
+ ;; Determine the start of the region to be folded just behind
+ ;; the comment starter.
+ (looking-at TeX-comment-start-regexp)
+ (setq beg (match-end 0))
+ ;; Search for the end of the comment.
+ (while (TeX-comment-forward))
+ (end-of-line 0)
+ ;; Hide the whole region.
+ (TeX-fold-hide-item (TeX-fold-make-overlay beg (point) 'comment
+ TeX-fold-ellipsis))))))
+
+(defun TeX-fold-macro ()
+ "Hide the macro on which point currently is located."
+ (interactive)
+ (unless (TeX-fold-item 'macro)
+ (message "No macro found")))
+
+(defun TeX-fold-math ()
+ "Hide the math macro on which point currently is located."
+ (interactive)
+ (unless (TeX-fold-item 'math)
+ (message "No macro found")))
+
+(defun TeX-fold-env ()
+ "Hide the environment on which point currently is located."
+ (interactive)
+ (unless (TeX-fold-item 'env)
+ (message "No environment found")))
+
+(defun TeX-fold-comment ()
+ "Hide the comment on which point currently is located."
+ (interactive)
+ (unless (TeX-fold-comment-do)
+ (message "No comment found")))
+
+(defun TeX-fold-item (type)
+ "Hide the item on which point currently is located.
+TYPE specifies the type of item and can be one of the symbols
+'env for environments, 'macro for macros or 'math for math
+macros.
+Return non-nil if an item was found and folded, nil otherwise."
+ (if (and (eq type 'env)
+ (eq major-mode 'plain-tex-mode))
+ (message
+ "Folding of environments is not supported in current mode")
+ (let ((item-start (cond ((and (eq type 'env)
+ (eq major-mode 'context-mode))
+ (save-excursion
+ (ConTeXt-find-matching-start) (point)))
+ ((and (eq type 'env)
+ (eq major-mode 'texinfo-mode))
+ (save-excursion
+ (Texinfo-find-env-start) (point)))
+ ((eq type 'env)
+ (condition-case nil
+ (save-excursion
+ (LaTeX-find-matching-begin) (point))
+ (error nil)))
+ (t
+ (TeX-find-macro-start)))))
+ (when item-start
+ (let* ((item-name (save-excursion
+ (goto-char item-start)
+ (looking-at
+ (cond ((and (eq type 'env)
+ (eq major-mode 'context-mode))
+ (concat (regexp-quote TeX-esc)
+ "start\\([A-Za-z]+\\)"))
+ ((and (eq type 'env)
+ (eq major-mode 'texinfo-mode))
+ (concat (regexp-quote TeX-esc)
+ "\\([A-Za-z]+\\)"))
+ ((eq type 'env)
+ (concat (regexp-quote TeX-esc)
+ "begin[ \t]*{"
+ "\\([A-Za-z]+\\)}"))
+ (t
+ (concat (regexp-quote TeX-esc)
+ "\\([A-Za-z@*]+\\)"))))
+ (if (fboundp 'match-string-no-properties)
+ (match-string-no-properties 1)
+ (match-string 1))))
+ (fold-list (cond ((eq type 'env) TeX-fold-env-spec-list-internal)
+ ((eq type 'math)
+ TeX-fold-math-spec-list-internal)
+ (t TeX-fold-macro-spec-list-internal)))
+ fold-item
+ (display-string-spec
+ (or (catch 'found
+ (while fold-list
+ (setq fold-item (car fold-list))
+ (setq fold-list (cdr fold-list))
+ (when (member item-name (cadr fold-item))
+ (throw 'found (car fold-item)))))
+ ;; Item is not specified.
+ (if TeX-fold-unspec-use-name
+ (concat "[" item-name "]")
+ (if (eq type 'env)
+ TeX-fold-unspec-env-display-string
+ TeX-fold-unspec-macro-display-string))))
+ (item-end (TeX-fold-item-end item-start type))
+ (ov (TeX-fold-make-overlay item-start item-end type
+ display-string-spec)))
+ (TeX-fold-hide-item ov))))))
+
+(defun TeX-fold-comment-do ()
+ "Hide the comment on which point currently is located.
+This is the function doing the work for `TeX-fold-comment'. It
+is an internal function communicating with return values rather
+than with messages for the user.
+Return non-nil if a comment was found and folded, nil otherwise."
+ (if (and (not (TeX-in-comment)) (not (TeX-in-line-comment)))
+ nil
+ (let (beg)
+ (save-excursion
+ (while (progn
+ (beginning-of-line 0)
+ (and (TeX-in-line-comment)
+ (not (bobp)))))
+ (goto-char (TeX-search-forward-comment-start (line-end-position 2)))
+ (looking-at TeX-comment-start-regexp)
+ (setq beg (match-end 0))
+ (while (TeX-comment-forward))
+ (end-of-line 0)
+ (when (> (point) beg)
+ (TeX-fold-hide-item (TeX-fold-make-overlay beg (point) 'comment
+ TeX-fold-ellipsis)))))))
+
+
+;;; Utilities
+
+(defun TeX-fold-make-overlay (ov-start ov-end type display-string-spec)
+ "Make a TeX-fold overlay extending from OV-START to OV-END.
+TYPE is a symbol which is used to describe the content to hide
+and may be 'macro for macros, 'math for math macro and 'env for
+environments.
+DISPLAY-STRING-SPEC is the original specification of the display
+string in the variables `TeX-fold-macro-spec-list' or
+`TeX-fold-env-spec-list' and may be a string or an integer."
+ ;; Calculate priority before the overlay is instantiated. We don't
+ ;; want `TeX-overlay-prioritize' to pick up a non-prioritized one.
+ (let ((priority (TeX-overlay-prioritize ov-start ov-end))
+ (ov (make-overlay ov-start ov-end (current-buffer) t nil)))
+ (overlay-put ov 'category 'TeX-fold)
+ (overlay-put ov 'priority priority)
+ (overlay-put ov 'evaporate t)
+ (overlay-put ov 'TeX-fold-type type)
+ (overlay-put ov 'TeX-fold-display-string-spec display-string-spec)
+ ov))
+
+(defun TeX-fold-item-end (start type)
+ "Return the end of an item of type TYPE starting at START.
+TYPE can be either 'env for environments, 'macro for macros or
+'math for math macros."
+ (save-excursion
+ (cond ((and (eq type 'env)
+ (eq major-mode 'context-mode))
+ (goto-char start)
+ (ConTeXt-find-matching-stop)
+ (point))
+ ((and (eq type 'env)
+ (eq major-mode 'texinfo-mode))
+ (goto-char (1+ start))
+ (Texinfo-find-env-end)
+ (point))
+ ((eq type 'env)
+ (goto-char (1+ start))
+ (LaTeX-find-matching-end)
+ (point))
+ (t
+ (goto-char start)
+ (TeX-find-macro-end)))))
+
+(defun TeX-fold-overfull-p (ov-start ov-end display-string)
+ "Return t if an overfull line will result after adding an overlay.
+The overlay extends from OV-START to OV-END and will display the
+string DISPLAY-STRING."
+ (and (not (featurep 'xemacs)) ; Linebreaks in glyphs don't
+ ; work in XEmacs anyway.
+ (save-excursion
+ (goto-char ov-end)
+ (search-backward "\n" ov-start t))
+ (not (string-match "\n" display-string))
+ (> (+ (- ov-start
+ (save-excursion
+ (goto-char ov-start)
+ (line-beginning-position)))
+ (length display-string)
+ (- (save-excursion
+ (goto-char ov-end)
+ (line-end-position))
+ ov-end))
+ (current-fill-column))))
+
+(defun TeX-fold-macro-nth-arg (n macro-start &optional macro-end delims)
+ "Return a property list of the argument number N of a macro.
+The start of the macro to examine is given by MACRO-START, its
+end optionally by MACRO-END. With DELIMS the type of delimiters
+can be specified as a cons cell containing the opening char as
+the car and the closing char as the cdr. The chars have to have
+opening and closing syntax as defined in
+`TeX-search-syntax-table'.
+
+The first item in the returned list is the string specified in
+the argument, the second item may be a face if the argument
+string was fontified. In Emacs the string holds text properties
+as well, so the second item is always nil. In XEmacs the string
+does not enclose any faces, so these are given in the second item
+of the resulting list."
+ (save-excursion
+ (let* ((macro-end (or macro-end
+ (save-excursion (goto-char macro-start)
+ (TeX-find-macro-end))))
+ (open-char (if delims (car delims) ?{))
+ (open-string (char-to-string open-char))
+ (close-char (if delims (cdr delims) ?}))
+ (close-string (char-to-string close-char))
+ content-start content-end)
+ (goto-char macro-start)
+ (if (condition-case nil
+ (progn
+ (while (> n 0)
+ (skip-chars-forward (concat "^" open-string) macro-end)
+ (when (= (point) macro-end)
+ (error nil))
+ (setq content-start (progn
+ (skip-chars-forward
+ (concat open-string " \t"))
+ (point)))
+ (goto-char
+ (if delims
+ (with-syntax-table
+ (TeX-search-syntax-table open-char close-char)
+ (scan-lists (point) 1 1))
+ (TeX-find-closing-brace)))
+ (setq content-end (save-excursion
+ (backward-char)
+ (skip-chars-backward " \t")
+ (point)))
+ (setq n (1- n)))
+ t)
+ (error nil))
+ (list (TeX-fold-buffer-substring content-start content-end)
+ (when (and (featurep 'xemacs)
+ (extent-at content-start))
+ ;; A glyph in XEmacs does not seem to be able to hold more
+ ;; than one face, so we just use the first one we get.
+ (car (extent-property (extent-at content-start) 'face))))
+ nil))))
+
+(defun TeX-fold-buffer-substring (start end)
+ "Return the contents of buffer from START to END as a string.
+Like `buffer-substring' but copy overlay display strings as well."
+ ;; Swap values of `start' and `end' if necessary.
+ (when (> start end) (let ((tmp start)) (setq start end end tmp)))
+ (let ((overlays (overlays-in start end))
+ result)
+ ;; Get rid of overlays not under our control or not completely
+ ;; inside the specified region.
+ (dolist (ov overlays)
+ (when (or (not (eq (overlay-get ov 'category) 'TeX-fold))
+ (< (overlay-start ov) start)
+ (> (overlay-end ov) end))
+ (setq overlays (remove ov overlays))))
+ (if (null overlays)
+ (buffer-substring start end)
+ ;; Sort list according to ascending starts.
+ (setq overlays (sort (copy-sequence overlays)
+ (lambda (a b)
+ (< (overlay-start a) (overlay-start b)))))
+ ;; Get the string from the start of the region up to the first overlay.
+ (setq result (buffer-substring start (overlay-start (car overlays))))
+ (let (ov)
+ (while overlays
+ (setq ov (car overlays)
+ overlays (cdr overlays))
+ ;; Add the display string of the overlay.
+ (setq result (concat result (overlay-get ov 'display)))
+ ;; Remove overlays contained in the current one.
+ (dolist (elt overlays)
+ (when (< (overlay-start elt) (overlay-end ov))
+ (setq overlays (remove elt overlays))))
+ ;; Add the string from the end of the current overlay up to
+ ;; the next overlay or the end of the specified region.
+ (setq result (concat result (buffer-substring (overlay-end ov)
+ (if overlays
+ (overlay-start
+ (car overlays))
+ end))))))
+ result)))
+
+(defun TeX-fold-make-help-echo (start end)
+ "Return a string to be used as the help echo of folded overlays.
+The text between START and END will be used for this but cropped
+to the length defined by `TeX-fold-help-echo-max-length'. Line
+breaks will be replaced by spaces."
+ (let* ((spill (+ start TeX-fold-help-echo-max-length))
+ (lines (split-string (buffer-substring start (min end spill)) "\n"))
+ (result (pop lines)))
+ (dolist (line lines)
+ ;; Strip leading whitespace
+ (when (string-match "^[ \t]+" line)
+ (setq line (replace-match "" nil nil line)))
+ ;; Strip trailing whitespace
+ (when (string-match "[ \t]+$" line)
+ (setq line (replace-match "" nil nil line)))
+ (setq result (concat result " " line)))
+ (when (> end spill) (setq result (concat result "...")))
+ result))
+
+(defun TeX-fold-update-at-point ()
+ "Update all TeX-fold overlays at point displaying computed content."
+ (let (overlays)
+ ;; Get all overlays at point under our control.
+ (dolist (ov (overlays-at (point)))
+ (when (and (eq (overlay-get ov 'category) 'TeX-fold)
+ (numberp (overlay-get ov 'TeX-fold-display-string-spec)))
+ (add-to-list 'overlays ov)))
+ (when overlays
+ ;; Sort list according to descending starts.
+ (setq overlays (sort (copy-sequence overlays)
+ (lambda (a b)
+ (> (overlay-start a) (overlay-start b)))))
+ (dolist (ov overlays)
+ (TeX-fold-hide-item ov)))))
+
+
+;;; Removal
+
+(defun TeX-fold-clearout-buffer ()
+ "Permanently show all macros in the buffer."
+ (interactive)
+ (TeX-fold-clearout-region (point-min) (point-max)))
+
+(defun TeX-fold-clearout-paragraph ()
+ "Permanently show all macros in the paragraph point is located in."
+ (interactive)
+ (save-excursion
+ (let ((end (progn (LaTeX-forward-paragraph) (point)))
+ (start (progn (LaTeX-backward-paragraph) (point))))
+ (TeX-fold-clearout-region start end))))
+
+(defun TeX-fold-clearout-region (start end)
+ "Permanently show all macros in region starting at START and ending at END."
+ (interactive "r")
+ (let ((overlays (overlays-in start end)))
+ (TeX-fold-remove-overlays overlays)))
+
+(defun TeX-fold-clearout-item ()
+ "Permanently show the macro on which point currently is located."
+ (interactive)
+ (let ((overlays (overlays-at (point))))
+ (TeX-fold-remove-overlays overlays)))
+
+(defun TeX-fold-remove-overlays (overlays)
+ "Remove all overlays set by TeX-fold in OVERLAYS.
+Return non-nil if a removal happened, nil otherwise."
+ (let (found)
+ (while overlays
+ (when (eq (overlay-get (car overlays) 'category) 'TeX-fold)
+ (delete-overlay (car overlays))
+ (setq found t))
+ (setq overlays (cdr overlays)))
+ found))
+
+
+;;; Toggling
+
+(defun TeX-fold-expand-spec (spec ov-start ov-end)
+ "Expand instances of {<num>}, [<num>], <<num>>, and (<num>).
+Replace them with the respective macro argument."
+ (let ((spec-list (split-string spec "||"))
+ (delims '((?{ . ?}) (?[ . ?]) (?< . ?>) (?\( . ?\))))
+ index success)
+ (catch 'success
+ ;; Iterate over alternatives.
+ (dolist (elt spec-list)
+ (setq spec elt
+ index nil)
+ ;; Find and expand every placeholder.
+ (while (and (string-match "\\([[{<]\\)\\([1-9]\\)\\([]}>]\\)" elt index)
+ ;; Does the closing delim match the opening one?
+ (string-equal
+ (match-string 3 elt)
+ (char-to-string
+ (cdr (assq (string-to-char (match-string 1 elt))
+ delims)))))
+ (setq index (match-end 0))
+ (let ((arg (car (save-match-data
+ ;; Get the argument.
+ (TeX-fold-macro-nth-arg
+ (string-to-number (match-string 2 elt))
+ ov-start ov-end
+ (assoc (string-to-char (match-string 1 elt))
+ delims))))))
+ (when arg (setq success t))
+ ;; Replace the placeholder in the string.
+ (setq elt (replace-match (or arg TeX-fold-ellipsis) nil t elt)
+ index (+ index (- (length elt) (length spec)))
+ spec elt)))
+ (when success (throw 'success nil))))
+ spec))
+
+(defun TeX-fold-hide-item (ov)
+ "Hide a single macro or environment.
+That means, put respective properties onto overlay OV."
+ (let* ((ov-start (overlay-start ov))
+ (ov-end (overlay-end ov))
+ (spec (overlay-get ov 'TeX-fold-display-string-spec))
+ (computed (cond
+ ((stringp spec)
+ (TeX-fold-expand-spec spec ov-start ov-end))
+ ((functionp spec)
+ (let (arg arg-list
+ (n 1))
+ (while (setq arg (TeX-fold-macro-nth-arg
+ n ov-start ov-end))
+ (add-to-list 'arg-list (car arg) t)
+ (setq n (1+ n)))
+ (or (condition-case nil
+ (apply spec arg-list)
+ (error nil))
+ "[Error: No content or function found]")))
+ (t (or (TeX-fold-macro-nth-arg spec ov-start ov-end)
+ "[Error: No content found]"))))
+ (display-string (if (listp computed) (car computed) computed))
+ (face (when (listp computed) (cadr computed))))
+ ;; Cater for zero-length display strings.
+ (when (string= display-string "") (setq display-string TeX-fold-ellipsis))
+ ;; Add a linebreak to the display string and adjust the overlay end
+ ;; in case of an overfull line.
+ (when (TeX-fold-overfull-p ov-start ov-end display-string)
+ (setq display-string (concat display-string "\n"))
+ (move-overlay ov ov-start (save-excursion
+ (goto-char ov-end)
+ (skip-chars-forward " \t")
+ (point))))
+ (overlay-put ov 'mouse-face 'highlight)
+ (overlay-put ov 'display display-string)
+ (if (featurep 'xemacs)
+ (let ((glyph (make-glyph (if (listp display-string)
+ (car display-string)
+ display-string))))
+ (overlay-put ov 'invisible t)
+ (when font-lock-mode
+ (if face
+ (set-glyph-property glyph 'face face)
+ (set-glyph-property glyph 'face TeX-fold-folded-face)))
+ (set-extent-property ov 'end-glyph glyph))
+ (when font-lock-mode
+ (overlay-put ov 'face TeX-fold-folded-face))
+ (unless (zerop TeX-fold-help-echo-max-length)
+ (overlay-put ov 'help-echo (TeX-fold-make-help-echo
+ (overlay-start ov) (overlay-end ov)))))))
+
+(defun TeX-fold-show-item (ov)
+ "Show a single LaTeX macro or environment.
+Remove the respective properties from the overlay OV."
+ (overlay-put ov 'mouse-face nil)
+ (if (featurep 'xemacs)
+ (progn
+ (set-extent-property ov 'end-glyph nil)
+ (overlay-put ov 'invisible nil))
+ (overlay-put ov 'display nil)
+ (overlay-put ov 'help-echo nil)
+ (when font-lock-mode
+ (overlay-put ov 'face TeX-fold-unfolded-face))))
+
+;; Copy and adaption of `reveal-post-command' from reveal.el in GNU
+;; Emacs on 2004-07-04.
+(defun TeX-fold-post-command ()
+ ;; `with-local-quit' is not supported in XEmacs.
+ (condition-case nil
+ (let ((inhibit-quit nil))
+ (condition-case err
+ (let* ((spots (TeX-fold-partition-list
+ (lambda (x)
+ ;; We refresh any spot in the current
+ ;; window as well as any spots associated
+ ;; with a dead window or a window which
+ ;; does not show this buffer any more.
+ (or (eq (car x) (selected-window))
+ (not (window-live-p (car x)))
+ (not (eq (window-buffer (car x))
+ (current-buffer)))))
+ TeX-fold-open-spots))
+ (old-ols (mapcar 'cdr (car spots))))
+ (setq TeX-fold-open-spots (cdr spots))
+ (when (or (and (boundp 'disable-point-adjustment)
+ disable-point-adjustment)
+ (and (boundp 'global-disable-point-adjustment)
+ global-disable-point-adjustment)
+ ;; See preview.el on how to make this configurable.
+ (memq this-command
+ (list (key-binding [left]) (key-binding [right])
+ 'backward-char 'forward-char
+ 'mouse-set-point)))
+ ;; Open new overlays.
+ (dolist (ol (nconc (when (and TeX-fold-unfold-around-mark
+ (boundp 'mark-active)
+ mark-active)
+ (overlays-at (mark)))
+ (overlays-at (point))))
+ (when (eq (overlay-get ol 'category) 'TeX-fold)
+ (push (cons (selected-window) ol) TeX-fold-open-spots)
+ (setq old-ols (delq ol old-ols))
+ (TeX-fold-show-item ol))))
+ ;; Close old overlays.
+ (dolist (ol old-ols)
+ (when (and (eq (current-buffer) (overlay-buffer ol))
+ (not (rassq ol TeX-fold-open-spots))
+ (or (not (featurep 'xemacs))
+ (and (featurep 'xemacs)
+ (not (extent-detached-p ol)))))
+ (if (and (>= (point) (overlay-start ol))
+ (<= (point) (overlay-end ol)))
+ ;; Still near the overlay: keep it open.
+ (push (cons (selected-window) ol) TeX-fold-open-spots)
+ ;; Really close it.
+ (TeX-fold-hide-item ol)))))
+ (error (message "TeX-fold: %s" err))))
+ (quit (setq quit-flag t))))
+
+
+;;; Misc
+
+;; Copy and adaption of `cvs-partition' from pcvs-util.el in GNU Emacs
+;; on 2004-07-05 to make tex-fold.el mainly self-contained.
+(defun TeX-fold-partition-list (p l)
+ "Partition a list L into two lists based on predicate P.
+The function returns a `cons' cell where the `car' contains
+elements of L for which P is true while the `cdr' contains
+the other elements. The ordering among elements is maintained."
+ (let (car cdr)
+ (dolist (x l)
+ (if (funcall p x) (push x car) (push x cdr)))
+ (cons (nreverse car) (nreverse cdr))))
+
+
+;;; The mode
+
+;; This autoload cookie had to be changed because of XEmacs. This is
+;; very dissatisfactory, because we now don't have the full doc string
+;; available to tell people what to expect when using this mode before
+;; loading it.
+
+;;;###autoload (autoload 'TeX-fold-mode "tex-fold" "Minor mode for hiding and
revealing macros and environments." t)
+(define-minor-mode TeX-fold-mode
+ "Minor mode for hiding and revealing macros and environments.
+
+Called interactively, with no prefix argument, toggle the mode.
+With universal prefix ARG (or if ARG is nil) turn mode on.
+With zero or negative ARG turn mode off."
+ nil nil (list (cons TeX-fold-command-prefix TeX-fold-keymap))
+ (if TeX-fold-mode
+ (progn
+ (set (make-local-variable 'search-invisible) t)
+ (add-hook 'post-command-hook 'TeX-fold-post-command nil t)
+ (add-hook 'LaTeX-fill-newline-hook 'TeX-fold-update-at-point nil t)
+ (add-hook 'TeX-after-insert-macro-hook
+ (lambda ()
+ (when (and TeX-fold-mode TeX-fold-auto)
+ (save-excursion
+ (backward-char)
+ (or (TeX-fold-item 'macro)
+ (TeX-fold-item 'math)
+ (TeX-fold-item 'env))))))
+ ;; Update the `TeX-fold-*-spec-list-internal' variables.
+ (dolist (elt '("macro" "env" "math"))
+ (set (intern (format "TeX-fold-%s-spec-list-internal" elt))
+ ;; Append the value of `TeX-fold-*-spec-list' to the
+ ;; mode-specific `<mode-prefix>-fold-*-spec-list' variable.
+ (append (symbol-value (intern (format "TeX-fold-%s-spec-list"
+ elt)))
+ (let ((symbol (intern (format "%s-fold-%s-spec-list"
+ (TeX-mode-prefix) elt))))
+ (when (boundp symbol)
+ (symbol-value symbol)))))))
+ (kill-local-variable 'search-invisible)
+ (remove-hook 'post-command-hook 'TeX-fold-post-command t)
+ (remove-hook 'LaTeX-fill-newline-hook 'TeX-fold-update-at-point t)
+ (TeX-fold-clearout-buffer))
+ (TeX-set-mode-name))
+
+;;;###autoload
+(defalias 'tex-fold-mode 'TeX-fold-mode)
+
+(provide 'tex-fold)
+
+;;; tex-fold.el ends here
diff --git a/tests/auctex-11.87.7/tex-font.el b/tests/auctex-11.87.7/tex-font.el
new file mode 100644
index 0000000..8c0bf61
--- /dev/null
+++ b/tests/auctex-11.87.7/tex-font.el
@@ -0,0 +1,173 @@
+;;; tex-font.el --- Font-Lock support stolen from Emacs 21.
+;;
+;; Copyright (C) 1985, 86, 89, 92, 94, 95, 96, 97, 98, 1999
+;; Free Software Foundation, Inc.
+
+;; Maintainer: auctex-devel@gnu.org
+;; Keywords: tex, faces
+
+;; This file is part of AUC TeX.
+
+;; AUC TeX 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.
+
+;; AUC TeX 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 AUC TeX; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Comments:
+
+;; Please keep this file in sync with GNU Emacs 21.
+
+;;; Code:
+
+(defconst tex-font-lock-keywords-1
+ (eval-when-compile
+ (let* (;; Names of commands whose arg should be fontified as heading, etc.
+ (headings (regexp-opt
+ '("title" "begin" "end" "chapter" "part"
+ "section" "subsection" "subsubsection"
+ "paragraph" "subparagraph" "subsubparagraph"
+ "newcommand" "renewcommand" "newenvironment"
+ "newtheorem")
+ t))
+ (variables (regexp-opt
+ '("newcounter" "newcounter*" "setcounter" "addtocounter"
+ "setlength" "addtolength" "settowidth")
+ t))
+ (includes (regexp-opt
+ '("input" "include" "includeonly" "bibliography"
+ "epsfig" "psfig" "epsf" "nofiles" "usepackage"
+ "documentstyle" "documentclass" "verbatiminput"
+ "includegraphics" "includegraphics*")
+ t))
+ ;; Miscellany.
+ (slash "\\\\")
+ (opt " *\\(\\[[^]]*\\] *\\)*")
+ ;; This would allow highlighting \newcommand\CMD but requires
+ ;; adapting subgroup numbers below.
+ ;; (arg
"\\(?:{\\(\\(?:[^{}\\]+\\|\\\\.\\|{[^}]*}\\)+\\)\\|\\\\[a-z*]+\\)"))
+ (arg "{\\(\\(?:[^{}\\]+\\|\\\\.\\|{[^}]*}\\)+\\)"))
+ (list
+ ;; Heading args.
+ (list (concat slash headings "\\*?" opt arg)
+ ;; If ARG ends up matching too much (if the {} don't match, f.ex)
+ ;; jit-lock will do funny things: when updating the buffer
+ ;; the re-highlighting is only done locally so it will just
+ ;; match the local line, but defer-contextually will
+ ;; match more lines at a time, so ARG will end up matching
+ ;; a lot more, which might suddenly include a comment
+ ;; so you get things highlighted bold when you type them
+ ;; but they get turned back to normal a little while later
+ ;; because "there's already a face there".
+ ;; Using `keep' works around this un-intuitive behavior as well
+ ;; as improves the behavior in the very rare case where you do
+ ;; have a comment in ARG.
+ 3 'font-lock-function-name-face 'keep)
+ (list (concat slash "\\(re\\)?newcommand\\** *\\(\\\\[A-Za-z@]+\\)")
+ 2 'font-lock-function-name-face 'keep)
+ ;; Variable args.
+ (list (concat slash variables " *" arg) 2 'font-lock-variable-name-face)
+ ;; Include args.
+ (list (concat slash includes opt arg) 3 'font-lock-builtin-face)
+ ;; Definitions. I think.
+ '("^[ \t]*\\\\def *\\\\\\(\\(\\w\\|@\\)+\\)"
+ 1 font-lock-function-name-face))))
+ "Subdued expressions to highlight in TeX modes.")
+
+(defconst tex-font-lock-keywords-2
+ (append tex-font-lock-keywords-1
+ (eval-when-compile
+ (let* (;;
+ ;; Names of commands whose arg should be fontified with fonts.
+ (bold (regexp-opt '("textbf" "textsc" "textup"
+ "boldsymbol" "pmb") t))
+ (italic (regexp-opt '("textit" "textsl" "emph") t))
+ (type (regexp-opt '("texttt" "textmd" "textrm" "textsf") t))
+ ;;
+ ;; Names of commands whose arg should be fontified as a citation.
+ (citations (regexp-opt
+ '("label" "ref" "pageref" "vref" "eqref"
+ "cite" "nocite" "index" "glossary" "bibitem"
+ ;; These are text, rather than citations.
+ ;; "caption" "footnote" "footnotemark" "footnotetext"
+ )
+ t))
+ ;;
+ ;; Names of commands that should be fontified.
+ (specials (regexp-opt
+ '("\\" "\\*" ;; "-"
+ "linebreak" "nolinebreak" "pagebreak" "nopagebreak"
+ "newline" "newpage" "clearpage" "cleardoublepage"
+ "displaybreak" "allowdisplaybreaks" "enlargethispage")
+ t))
+ (general "\\([a-zA-Z@]+\\**\\|[^ \t\n]\\)")
+ ;;
+ ;; Miscellany.
+ (slash "\\\\")
+ (opt " *\\(\\[[^]]*\\] *\\)*")
+ (arg "{\\(\\(?:[^{}\\]+\\|\\\\.\\|{[^}]*}\\)+\\)"))
+ (list
+ ;;
+ ;; Citation args.
+ (list (concat slash citations opt arg) 3 'font-lock-constant-face)
+ ;;
+ ;; Text between `` quotes ''.
+ (cons (concat (regexp-opt `("``" "\"<" "\"`" "<<" "�") t)
+ "[^'\">�]+" ;a bit pessimistic
+ (regexp-opt `("''" "\">" "\"'" ">>" "�") t))
+ 'font-lock-string-face)
+ ;;
+ ;; Command names, special and general.
+ (cons (concat slash specials) 'font-lock-warning-face)
+ (concat slash general)
+ ;;
+ ;; Font environments. It seems a bit dubious to use `bold' etc. faces
+ ;; since we might not be able to display those fonts.
+ (list (concat slash bold " *" arg) 2 '(quote bold) 'append)
+ (list (concat slash italic " *" arg) 2 '(quote italic) 'append)
+ ;; (list (concat slash type arg) 2 '(quote bold-italic) 'append)
+ ;;
+ ;; Old-style bf/em/it/sl. Stop at `\\' and un-escaped `&', for tables.
+ (list (concat "\\\\\\(\\(bf\\)\\|em\\|it\\|sl\\)\\>"
+ "\\(\\([^}&\\]\\|\\\\[^\\]\\)+\\)")
+ 3 '(if (match-beginning 2) 'bold 'italic) 'append)))))
+ "Gaudy expressions to highlight in TeX modes.")
+
+(defvar tex-font-lock-keywords tex-font-lock-keywords-1
+ "Default expressions to highlight in TeX modes.")
+
+
+(defface tex-math-face
+ '((t :inherit font-lock-string-face))
+ "Face used to highlight TeX math expressions.")
+(defvar tex-math-face 'tex-math-face)
+
+;; Use string syntax but math face for $...$.
+(defun tex-font-lock-syntactic-face-function (state)
+ (if (nth 3 state) tex-math-face font-lock-comment-face))
+
+;;;###autoload
+(defun tex-font-setup ()
+ "Setup font lock support for TeX."
+ (set (make-local-variable 'font-lock-defaults)
+ '((tex-font-lock-keywords
+ tex-font-lock-keywords-1 tex-font-lock-keywords-2)
+ nil nil ((?$ . "\"")) nil
+ ;; Who ever uses that anyway ???
+ (font-lock-mark-block-function . mark-paragraph)
+ (font-lock-syntactic-face-function
+ . tex-font-lock-syntactic-face-function)))
+ )
+
+(provide 'tex-font)
+
+;;; tex-font.el ends here
\ No newline at end of file
diff --git a/tests/auctex-11.87.7/tex-info.el b/tests/auctex-11.87.7/tex-info.el
new file mode 100644
index 0000000..f973937
--- /dev/null
+++ b/tests/auctex-11.87.7/tex-info.el
@@ -0,0 +1,787 @@
+;;; tex-info.el --- Support for editing Texinfo source.
+
+;; Copyright (C) 1993, 1994, 1997, 2000, 2001, 2004, 2005, 2006, 2011
+;; Free Software Foundation, Inc.
+
+;; Maintainer: auctex-devel@gnu.org
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Code:
+
+(require 'tex)
+
+(require 'texinfo)
+;; Make sure the Texinfo mode of AUCTeX is still used after loading
+;; texinfo.el. (This is only an issue on Emacs 21.)
+(when (and (boundp 'TeX-modes)
+ (memq 'texinfo-mode TeX-modes))
+ (defalias 'texinfo-mode 'TeX-texinfo-mode))
+
+;;; Environments:
+
+(defvar Texinfo-environment-list
+ '(("cartouche") ("command") ("copying") ("defcv") ("deffn") ("defivar")
+ ("defmac") ("defmethod") ("defop") ("defopt") ("defspec")
+ ("deftp") ("deftypefn") ("deftypefun") ("deftypevar") ("deftypevr")
+ ("defun") ("defvar") ("defvr") ("description") ("detailmenu")
+ ("direntry") ("display") ("documentdescription") ("enumerate")
+ ("example") ("flushleft") ("flushright") ("format") ("ftable")
+ ("group") ("ifclear") ("ifdocbook") ("ifhtml") ("ifinfo")
+ ("ifnotdocbook") ("ifnothtml") ("ifnotinfo") ("ifnotplaintext")
+ ("ifnottex") ("ifnotxml") ("ifplaintext") ("ifset") ("iftex")
+ ("ifxml") ("ignore") ("itemize") ("lisp") ("macro") ("menu")
+ ("multitable") ("quotation") ("smalldisplay") ("smallexample")
+ ("smallformat") ("smalllisp") ("table") ("tex") ("titlepage")
+ ("verbatim") ("vtable"))
+ "Alist of Texinfo environments.")
+
+(defconst texinfo-environment-regexp
+ ;; Overwrite version from `texinfo.el'.
+ (concat "^@\\("
+ (mapconcat 'car Texinfo-environment-list "\\|")
+ "\\|end\\)\\>")
+ "Regexp for environment-like Texinfo list commands.
+Subexpression 1 is what goes into the corresponding `@end' statement.")
+
+(defun Texinfo-environment (env &optional arg)
+ "Make Texinfo environment ENV.
+With optional ARG, modify current environment."
+ ;; XXX: This could be enhanced to act like `LaTeX-environment',
+ ;; i.e. suggest a default environment and have its own history.
+ (interactive (list (completing-read "Environment: "
+ Texinfo-environment-list)
+ current-prefix-arg))
+ (if arg
+ (Texinfo-modify-environment env)
+ (Texinfo-insert-environment env)))
+
+(defun Texinfo-insert-environment (env)
+ "Insert Texinfo environment ENV."
+ (if (and (TeX-active-mark)
+ (not (eq (mark) (point))))
+ (progn
+ (when (< (mark) (point))
+ (exchange-point-and-mark))
+ (unless (TeX-looking-at-backward "^[ \t]*")
+ (newline))
+ (insert "@" env)
+ (newline)
+ (goto-char (mark))
+ (unless (TeX-looking-at-backward "^[ \t]*")
+ (newline))
+ (insert "@end " env)
+ (save-excursion (newline))
+ (end-of-line 0))
+ (insert "@" env "\n\n@end " env "\n")
+ (if (null (cdr-safe (assoc "defcv" Texinfo-environment-list)))
+ (forward-line -2))))
+
+(defun Texinfo-modify-environment (env)
+ "Change current environment to environment ENV."
+ (save-excursion
+ (Texinfo-find-env-end)
+ (re-search-backward (concat (regexp-quote TeX-esc) "end \\([a-zA-Z]*\\)")
+ (line-beginning-position))
+ (replace-match env t t nil 1)
+ (beginning-of-line)
+ (Texinfo-find-env-start)
+ (re-search-forward (concat (regexp-quote TeX-esc) "\\([a-zA-Z]*\\)")
+ (line-end-position))
+ (replace-match env t t nil 1)))
+
+(defun Texinfo-find-env-end ()
+ "Move point to the end of the current environment."
+ (interactive)
+ (let* ((envs (mapcar 'car Texinfo-environment-list))
+ (regexp (concat "^[ \t]*" (regexp-quote TeX-esc) "\\(end \\)*"
+ (regexp-opt envs t) "\\b"))
+ (orig-pos (point))
+ (level 1)
+ case-fold-search)
+ (save-restriction
+ (save-excursion
+ (save-excursion
+ (beginning-of-line)
+ ;; Stop if point is inside of an @end <env> command, but not
+ ;; if it is behind it.
+ (when (and (looking-at regexp)
+ (match-string 1)
+ (> (match-end 0) orig-pos))
+ (setq level 0)))
+ (while (and (> level 0) (re-search-forward regexp nil t))
+ (if (match-string 1)
+ (setq level (1- level))
+ (setq level (1+ level)))))
+ (if (= level 0)
+ (goto-char (match-end 0))
+ (error "Can't locate end of current environment")))))
+
+(defun Texinfo-find-env-start ()
+ "Move point to the start of the current environment."
+ (interactive)
+ (let* ((envs (mapcar 'car Texinfo-environment-list))
+ (regexp (concat "^[ \t]*\\(" (regexp-quote TeX-esc) "\\)\\(end \\)*"
+ (regexp-opt envs t) "\\b"))
+ (level 1)
+ (orig-pos (point))
+ case-fold-search)
+ (save-restriction
+ (save-excursion
+ (save-excursion
+ (beginning-of-line)
+ ;; Stop if point is inside of an @<env> command, but not if
+ ;; it is before it.
+ (when (and (looking-at regexp)
+ (not (match-string 2))
+ (< (match-beginning 1) orig-pos))
+ (setq level 0)))
+ (while (and (> level 0) (re-search-backward regexp nil t))
+ (if (match-string 2)
+ (setq level (1+ level))
+ (setq level (1- level)))))
+ (if (= level 0)
+ (goto-char (match-beginning 0))
+ (error "Can't locate start of current environment")))))
+
+(defun Texinfo-mark-environment (&optional count)
+ "Set mark to end of current environment and point to the matching begin.
+If prefix argument COUNT is given, mark the respective number of
+enclosing environments. The command will not work properly if
+there are unbalanced begin-end pairs in comments and verbatim
+environments."
+ ;; TODO:
+ ;; This is identical to the LaTeX counterpart but for the find begin/end
+ ;; functions. So some day the implemenation should be factorized.
+ (interactive "p")
+ (setq count (if count (abs count) 1))
+ (let ((cur (point)) beg end)
+ ;; Only change point and mark after beginning and end were found.
+ ;; Point should not end up in the middle of nowhere if the search fails.
+ (save-excursion
+ (dotimes (c count)
+ (Texinfo-find-env-end))
+ (setq end (line-beginning-position 2))
+ (goto-char cur)
+ (dotimes (c count)
+ (Texinfo-find-env-start)
+ (unless (= (1+ c) count)
+ (beginning-of-line 0)))
+ (setq beg (point)))
+ (set-mark end)
+ (goto-char beg)
+ (TeX-activate-region)))
+
+(defun Texinfo-mark-section (&optional no-subsection)
+ "Mark current section, with inclusion of any containing node.
+
+The current section is detected as starting by any of the
+structuring commands matched by regexp in variable
+`outline-regexp' which in turn is a regexp matching any element
+of variable `texinfo-section-list'.
+
+If optional argument NO-SUBSECTION is set to any integer or is a
+non nil empty argument (i.e. `C-u \\[Texinfo-mark-section]'),
+then mark the current section with exclusion of any subsections.
+
+Otherwise, any included subsections are also marked along with
+current section.
+
+Note that when current section is starting immediatley after a
+node commande, then the node command is also marked as part as
+the section."
+ (interactive "P")
+ (let (beg end is-beg-section is-end-section
+ (section-re (concat "^\\s-*" outline-regexp)))
+ (if (and (consp no-subsection) (eq (car no-subsection) 4))
+ ;; section with exclusion of any subsection
+ (setq beg (save-excursion
+ (unless (looking-at section-re)
+ (end-of-line))
+ (re-search-backward section-re nil t))
+ is-beg-section t
+ end (save-excursion
+ (beginning-of-line)
+ (when
+ (re-search-forward (concat section-re
+ "\\|^\\s-*@bye\\_>" ) nil t)
+ (save-match-data
+ (beginning-of-line)
+ (point))))
+ is-end-section (match-string 1))
+ ;; full section without exclusion of any subsection
+ (let (section-command-level)
+ (setq beg
+ (save-excursion
+ (end-of-line)
+ (re-search-backward section-re nil t)))
+ (when beg
+ (setq is-beg-section t
+ section-command-level
+ (cadr (assoc (match-string 1) texinfo-section-list))
+ end
+ (save-excursion
+ (beginning-of-line)
+ (while
+ (and (re-search-forward
+ (concat section-re "\\|^\\s-*@bye\\_>" ) nil t)
+ (or (null (setq is-end-section (match-string 1)))
+ (> (cadr (assoc is-end-section
+ texinfo-section-list))
+ section-command-level))))
+ (when (match-string 0)
+ (beginning-of-line)
+ (point))))))); (if ...)
+ (when (and beg end)
+ ;; now take also enclosing node of beg and end
+ (dolist
+ (boundary '(beg end))
+ (when (symbol-value (intern (concat "is-" (symbol-name boundary)
+ "-section")))
+ (save-excursion
+ (goto-char (symbol-value boundary))
+ (while
+ (and
+ (null (bobp))
+ (progn
+ (beginning-of-line 0)
+ (looking-at "^\\s-*\\($\\|@\\(c\\|comment\\)\\_>\\)"))))
+ (when (looking-at "^\\s-*@node\\_>")
+ (set boundary (point))))))
+
+ (set-mark end)
+ (goto-char beg)
+ (TeX-activate-region) )))
+
+(defun Texinfo-mark-node ()
+ "Mark the current node. \
+This is the node in which the pointer is. It is starting at
+previous beginning of keyword `@node' and ending at next
+beginning of keyword `@node' or `@bye'."
+ (interactive)
+ (let ((beg (save-excursion
+ (unless (looking-at "^\\s-*@\\(?:node\\)\\_>")
+ (end-of-line))
+ (re-search-backward "^\\s-*@\\(?:node\\)\\_>" nil t )))
+ (end (save-excursion
+ (beginning-of-line)
+ (and (re-search-forward "^\\s-*@\\(?:node\\|bye\\)\\_>" nil t )
+ (progn (beginning-of-line) (point))))))
+
+ (when (and beg end)
+ (set-mark end)
+ (goto-char beg)
+ (TeX-activate-region) )))
+
+(defun Texinfo-insert-node ()
+ "Insert a Texinfo node in the current buffer.
+That means, insert the string `@node' and prompt for current,
+next, previous and upper node. If there is an active region, use
+this for the current node and inhibit the prompt for it. Insert
+a comment on the following line indicating the order of arguments
+for @node."
+ (interactive)
+ (let ((active-mark (and (TeX-active-mark) (not (eq (mark) (point)))))
+ nodes node-name next-node previous-node up-node)
+ ;; Build list of nodes in current buffer.
+ ;; (What about using `imenu--index-alist'?)
+ ;; FIXME: Support multi-file documents.
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward "^@node\\b" nil t)
+ (skip-chars-forward " \t")
+ (add-to-list 'nodes
+ (list (buffer-substring-no-properties
+ (point) (progn (skip-chars-forward "^,")
+ (point)))))))
+ (unless active-mark
+ (setq node-name (read-string "Node name: ")))
+ ;; FIXME: What if key binding for `minibuffer-complete' was changed?
+ ;; `substitute-command-keys' doesn't return the correct value.
+ (setq next-node (completing-read "Next node (TAB completes): " nodes))
+ (setq previous-node
+ (completing-read "Previous node (TAB completes): " nodes))
+ (setq up-node (completing-read "Upper node (TAB completes): " nodes))
+ (when (and active-mark
+ (< (mark) (point)))
+ (exchange-point-and-mark))
+ (insert "@node ")
+ (if active-mark
+ (goto-char (mark))
+ (insert node-name))
+ (insert ", " next-node ", " previous-node ", " up-node
+ "\n@comment node-name, next, previous, up\n")
+ ;; Position point at first empty field.
+ (unless (and (or (> (length node-name) 0) active-mark)
+ (> (length next-node) 0)
+ (> (length previous-node) 0)
+ (> (length up-node) 0))
+ (forward-line -2)
+ (forward-char 6)
+ (catch 'break
+ (if (or (> (length node-name) 0) active-mark)
+ (progn (skip-chars-forward "^,") (forward-char 2))
+ (throw 'break nil))
+ (dolist (node (list next-node previous-node up-node))
+ (if (> (length node) 0)
+ (progn (skip-chars-forward "^,") (forward-char 2))
+ (throw 'break nil)))))))
+
+;; Silence the byte-compiler from warnings for variables and functions declared
+;; in reftex.
+(eval-when-compile
+ (defvar reftex-section-levels-all)
+ (defvar reftex-level-indent)
+ (defvar reftex-label-menu-flags)
+ (defvar reftex-tables-dirty)
+
+ (when (fboundp 'declare-function)
+ (declare-function reftex-match-string "reftex" (n))
+ (declare-function reftex-section-number "reftex-parse" (&optional level
star))
+ (declare-function reftex-nicify-text "reftex" (text))
+ (declare-function reftex-ensure-compiled-variables "reftex" ())))
+
+(defun Texinfo-reftex-section-info (file)
+ ;; Return a section entry for the current match.
+ ;; Carefull: This function expects the match-data to be still in place!
+ (let* ((marker (set-marker (make-marker) (1- (match-beginning 3))))
+ (macro (reftex-match-string 3))
+ (level-exp (cdr (assoc macro reftex-section-levels-all)))
+ (level (if (symbolp level-exp)
+ (save-match-data (funcall level-exp))
+ level-exp))
+ (unnumbered (< level 0))
+ (level (abs level))
+ (section-number (reftex-section-number level unnumbered))
+ (text1 (save-match-data
+ (save-excursion
+ (buffer-substring-no-properties (point) (progn
(end-of-line) (point))))))
+ (literal (buffer-substring-no-properties
+ (1- (match-beginning 3))
+ (min (point-max) (+ (match-end 0) (length text1) 1))))
+ ;; Literal can be too short since text1 too short. No big problem.
+ (text (reftex-nicify-text text1)))
+
+ ;; Add section number and indentation
+ (setq text
+ (concat
+ (make-string (* reftex-level-indent level) ?\ )
+ (if (nth 1 reftex-label-menu-flags) ; section number flag
+ (concat section-number " "))
+ text))
+ (list 'toc "toc" text file marker level section-number
+ literal (marker-position marker))))
+
+(defun Texinfo-reftex-hook ()
+ "Hook function to plug Texinfo into RefTeX."
+ ;; force recompilation of variables
+ (when (string= TeX-base-mode-name "Texinfo")
+ ;; dirty temporary hook to remove when reftex has a Texinfo builtin
+ ;; TODO --- taken on <2014-01-06 mon> --- remove the dirty trick once
reftex
+ ;; has been corrected for long enough a time
+ (unless (assq 'Texinfo reftex-label-alist-builtin)
+ (setq reftex-label-alist-builtin (append reftex-label-alist-builtin
+ '((Texinfo "Texinfo default
environments" nil)))))
+ (dolist (v `((reftex-section-pre-regexp . "@")
+ ; section post-regexp must contain exactly one group
+ (reftex-section-post-regexp . "\\([ \t]+\\)")
+ (reftex-section-info-function . Texinfo-reftex-section-info)
+ (reftex-default-label-alist-entries . (Texinfo))
+ (reftex-section-levels
+ . ,(mapcar
+ (lambda (x)
+ (if (string-match
"\\(\\`unnumbered\\)\\|\\(heading\\'\\)\\|\\(\\`top\\'\\)"
+ (car x))
+ (cons (car x) (- (cadr x)))
+ (cons (car x) (cadr x))))
+ texinfo-section-list))))
+ (set (make-local-variable (car v) ) (cdr v)))
+ (reftex-ensure-compiled-variables)))
+
+;;; Keymap:
+
+(defvar Texinfo-mode-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map TeX-mode-map)
+
+ ;; From texinfo.el
+ ;; bindings for updating nodes and menus
+ (define-key map "\C-c\C-um" 'texinfo-master-menu)
+ (define-key map "\C-c\C-u\C-m" 'texinfo-make-menu)
+ (define-key map "\C-c\C-u\C-n" 'texinfo-update-node)
+ (define-key map "\C-c\C-u\C-e" 'texinfo-every-node-update)
+ (define-key map "\C-c\C-u\C-a" 'texinfo-all-menus-update)
+
+ ;; Simulating LaTeX-mode
+ (define-key map "\C-c\C-e" 'Texinfo-environment)
+ (define-key map "\C-c." 'Texinfo-mark-environment)
+ (define-key map "\C-c*" 'Texinfo-mark-section)
+ (define-key map "\M-\C-h" 'Texinfo-mark-node)
+ (define-key map "\C-c\n" 'texinfo-insert-@item)
+ (or (key-binding "\e\r")
+ (define-key map "\e\r" 'texinfo-insert-@item)) ;*** Alias
+ (define-key map "\C-c\C-s" 'Texinfo-insert-node)
+ (define-key map "\C-c]" 'texinfo-insert-@end)
+ map)
+ "Keymap for Texinfo mode.")
+
+(easy-menu-define Texinfo-command-menu
+ Texinfo-mode-map
+ "Menu used in Texinfo mode for external commands."
+ (TeX-mode-specific-command-menu 'texinfo-mode))
+
+(easy-menu-define Texinfo-mode-menu
+ Texinfo-mode-map
+ "Menu used in Texinfo mode."
+ (TeX-menu-with-help
+ `("Texinfo"
+ ["Node ..." texinfo-insert-@node
+ :help "Insert a node"]
+ ["Macro ..." TeX-insert-macro
+ :help "Insert a macro and possibly arguments"]
+ ["Complete Macro" TeX-complete-symbol
+ :help "Complete the current macro"]
+ ["Environment ..." Texinfo-insert-environment
+ :help "Insert an environment"]
+ ["Item" texinfo-insert-@item
+ :help "Insert an @item"]
+ "-"
+ ("Insert Font"
+ ["Emphasize" (TeX-font nil ?\C-e) :keys "C-c C-f C-e"]
+ ["Bold" (TeX-font nil ?\C-b) :keys "C-c C-f C-b"]
+ ["Typewriter" (TeX-font nil ?\C-t) :keys "C-c C-f C-t"]
+ ["Small Caps" (TeX-font nil ?\C-c) :keys "C-c C-f C-c"]
+ ["Italic" (TeX-font nil ?\C-i) :keys "C-c C-f C-i"]
+ ["Sample" (TeX-font nil ?\C-s) :keys "C-c C-f C-s"]
+ ["Roman" (TeX-font nil ?\C-r) :keys "C-c C-f C-r"])
+ ("Replace Font"
+ ["Emphasize" (TeX-font t ?\C-e) :keys "C-u C-c C-f C-e"]
+ ["Bold" (TeX-font t ?\C-b) :keys "C-u C-c C-f C-b"]
+ ["Typewriter" (TeX-font t ?\C-t) :keys "C-u C-c C-f C-t"]
+ ["Small Caps" (TeX-font t ?\C-c) :keys "C-u C-c C-f C-c"]
+ ["Italic" (TeX-font t ?\C-i) :keys "C-u C-c C-f C-i"]
+ ["Sample" (TeX-font t ?\C-s) :keys "C-u C-c C-f C-s"]
+ ["Roman" (TeX-font t ?\C-r) :keys "C-u C-c C-f C-r"])
+ ["Delete Font" (TeX-font t ?\C-d) :keys "C-c C-f C-d"]
+ "-"
+ ["Create Master Menu" texinfo-master-menu
+ :help "Make a master menu for the whole Texinfo file"]
+ ["Create Menu" texinfo-make-menu
+ :help "Make or update the menu for the current section"]
+ ["Update Node" texinfo-update-node
+ :help "Update the current node"]
+ ["Update Every Node" texinfo-every-node-update
+ :help "Update every node in the current file"]
+ ["Update All Menus" texinfo-all-menus-update
+ :help "Update every menu in the current file"]
+ "-"
+ ("Commenting"
+ ["Comment or Uncomment Region"
+ TeX-comment-or-uncomment-region
+ :help "Comment or uncomment the currently selected region"]
+ ["Comment or Uncomment Paragraph"
+ TeX-comment-or-uncomment-paragraph
+ :help "Comment or uncomment the current paragraph"])
+ ,TeX-fold-menu
+ "-"
+ . ,TeX-common-menu-entries)))
+
+(defvar Texinfo-font-list
+ '((?\C-b "@b{" "}")
+ (?\C-c "@sc{" "}")
+ (?\C-e "@emph{" "}")
+ (?\C-i "@i{" "}")
+ (?\C-r "@r{" "}")
+ (?\C-s "@samp{" "}")
+ (?\C-t "@t{" "}")
+ (?s "@strong{" "}")
+ (?\C-f "@file{" "}")
+ (?d "@dfn{" "}")
+ (?\C-v "@var{" "}")
+ (?k "@key{" "}")
+ (?\C-k "@kbd{" "}")
+ (?c "@code{" "}")
+ (?C "@cite{" "}")
+ (?\C-d "" "" t))
+ "Font commands used in Texinfo mode. See `TeX-font-list'.")
+
+;;; Mode:
+
+;;;###autoload
+(defalias 'Texinfo-mode 'texinfo-mode)
+
+;;;###autoload
+(defun TeX-texinfo-mode ()
+ "Major mode in AUCTeX for editing Texinfo files.
+
+Special commands:
+\\{Texinfo-mode-map}
+
+Entering Texinfo mode calls the value of `text-mode-hook' and then the
+value of `Texinfo-mode-hook'."
+ (interactive)
+ (kill-all-local-variables)
+ (setq TeX-mode-p t)
+ (setq TeX-sentinel-default-function 'TeX-TeX-sentinel)
+ ;; Mostly stolen from texinfo.el
+ (setq TeX-base-mode-name "Texinfo")
+ (setq major-mode 'texinfo-mode)
+ (use-local-map Texinfo-mode-map)
+ (set-syntax-table texinfo-mode-syntax-table)
+ (make-local-variable 'page-delimiter)
+ (setq page-delimiter
+ (concat
+ "^@node [ \t]*[Tt]op\\|^@\\("
+ texinfo-chapter-level-regexp
+ "\\)"))
+ (make-local-variable 'require-final-newline)
+ (setq require-final-newline t)
+ (make-local-variable 'indent-tabs-mode)
+ (setq indent-tabs-mode nil)
+ (make-local-variable 'paragraph-separate)
+ (setq paragraph-separate
+ (concat "\b\\|^@[a-zA-Z]*[ \n]\\|" paragraph-separate))
+ (make-local-variable 'paragraph-start)
+ (setq paragraph-start
+ (concat "\b\\|^@[a-zA-Z]*[ \n]\\|" paragraph-start))
+ (make-local-variable 'fill-column)
+ (setq fill-column 72)
+ (make-local-variable 'comment-start)
+ (setq comment-start "@c ")
+ (make-local-variable 'comment-start-skip)
+ (setq comment-start-skip "@c +\\|@comment +")
+ (set (make-local-variable 'comment-use-syntax) nil)
+ (make-local-variable 'words-include-escapes)
+ (setq words-include-escapes t)
+ (if (not (boundp 'texinfo-imenu-generic-expression))
+ ;; This was introduced in 19.30.
+ ()
+ (make-local-variable 'imenu-generic-expression)
+ (setq imenu-generic-expression texinfo-imenu-generic-expression))
+ (make-local-variable 'font-lock-defaults)
+ (setq font-lock-defaults
+ ;; COMPATIBILITY for Emacs 20
+ (if (boundp 'texinfo-font-lock-syntactic-keywords)
+ '(texinfo-font-lock-keywords
+ nil nil nil backward-paragraph
+ (font-lock-syntactic-keywords
+ . texinfo-font-lock-syntactic-keywords))
+ '(texinfo-font-lock-keywords t)))
+ (if (not (boundp 'texinfo-section-list))
+ ;; This was included in 19.31.
+ ()
+ (make-local-variable 'outline-regexp)
+ (setq outline-regexp
+ (concat "@\\("
+ (mapconcat 'car texinfo-section-list "\\>\\|")
+ "\\>\\)"))
+ (make-local-variable 'outline-level)
+ (setq outline-level 'texinfo-outline-level))
+
+ ;; Mostly AUCTeX stuff
+ (easy-menu-add Texinfo-mode-menu Texinfo-mode-map)
+ (easy-menu-add Texinfo-command-menu Texinfo-mode-map)
+ (make-local-variable 'TeX-command-current)
+ (setq TeX-command-current 'TeX-command-master)
+
+ (setq TeX-default-extension "texi")
+ (make-local-variable 'TeX-esc)
+ (setq TeX-esc "@")
+
+ (make-local-variable 'TeX-auto-regexp-list)
+ (setq TeX-auto-regexp-list 'TeX-auto-empty-regexp-list)
+ (make-local-variable 'TeX-auto-update)
+ (setq TeX-auto-update t)
+
+ (setq TeX-command-default "TeX")
+ (setq TeX-header-end "%*end")
+ (setq TeX-trailer-start (regexp-quote (concat TeX-esc "bye")))
+
+ (make-local-variable 'TeX-complete-list)
+ (setq TeX-complete-list
+ (list (list "@\\([a-zA-Z]*\\)" 1 'TeX-symbol-list-filtered nil)
+ (list "" TeX-complete-word)))
+
+ (make-local-variable 'TeX-font-list)
+ (setq TeX-font-list Texinfo-font-list)
+ (make-local-variable 'TeX-font-replace-function)
+ (setq TeX-font-replace-function 'TeX-font-replace-macro)
+
+ (add-hook 'find-file-hooks (lambda ()
+ (unless (file-exists-p (buffer-file-name))
+ (TeX-master-file nil nil t))) nil t)
+
+ (when (and (boundp 'add-log-current-defun-function)
+ (fboundp 'texinfo-current-defun-name))
+ (setq add-log-current-defun-function
+ #'texinfo-current-defun-name))
+
+ (TeX-add-symbols
+ '("appendix" (TeX-arg-literal " ") (TeX-arg-free "Title"))
+ '("appendixsec" (TeX-arg-literal " ") (TeX-arg-free "Title"))
+ '("appendixsection" (TeX-arg-literal " ") (TeX-arg-free "Title"))
+ '("appendixsubsec" (TeX-arg-literal " ") (TeX-arg-free "Title"))
+ '("appendixsubsubsec" (TeX-arg-literal " ") (TeX-arg-free "Title"))
+ '("asis")
+ '("author" (TeX-arg-literal " ") (TeX-arg-free "Author"))
+ '("b" "Text")
+ '("bullet")
+ '("bye")
+ '("c" (TeX-arg-literal " ") (TeX-arg-free "Comment"))
+ '("center" (TeX-arg-literal " ") (TeX-arg-free "Line of text"))
+ '("chapheading" (TeX-arg-literal " ") (TeX-arg-free "Title"))
+ '("chapter" (TeX-arg-literal " ") (TeX-arg-free "Title"))
+ '("cindex" (TeX-arg-literal " ") (TeX-arg-free "Entry"))
+ '("cite" "Reference")
+ '("clear" (TeX-arg-literal " ") (TeX-arg-free "Flag"))
+ '("code" "Sample code")
+ '("command" "Command")
+ '("comment" (TeX-arg-literal " ") (TeX-arg-free "Comment"))
+ '("contents")
+ '("copyright" nil)
+ '("defcodeindex" (TeX-arg-literal " ") (TeX-arg-free "Index name"))
+ '("defindex" (TeX-arg-literal " ") (TeX-arg-free "Index name"))
+ '("dfn" "Term")
+ '("dmn" "Dimension")
+ '("dots" nil)
+ '("emph" "Text")
+ '("email" "Email address")
+ '("equiv" nil)
+ '("error")
+ '("evenfooting" Texinfo-lrc-argument-hook)
+ '("evenheading" Texinfo-lrc-argument-hook)
+ '("everyfooting" Texinfo-lrc-argument-hook)
+ '("everyheading" Texinfo-lrc-argument-hook)
+ '("exdent" (TeX-arg-literal " ") (TeX-arg-free "Line of text"))
+ '("expansion" nil)
+ '("file" "Filename")
+ '("finalout")
+ '("findex" (TeX-arg-literal " ") (TeX-arg-free "Entry"))
+ '("footnote" "Text of footnote")
+ '("footnotestyle" (TeX-arg-literal " ") (TeX-arg-free "Style"))
+ '("group")
+ '("heading" (TeX-arg-literal " ") (TeX-arg-free "Title"))
+ ;; XXX: Would be nice with completion.
+ '("headings" (TeX-arg-literal " ") (TeX-arg-free "On off single double"))
+ '("i" "Text")
+ '("ignore")
+ '("include" (TeX-arg-literal " ") (TeX-arg-free "Filename"))
+ '("inforef" "Node name" "Info file name")
+ '("item")
+ '("itemx")
+ '("kbd" "Keyboard characters")
+ '("key" "Key name")
+ '("kindex" (TeX-arg-literal " ") (TeX-arg-free "Entry"))
+ '("lowersections" 0)
+ '("majorheading" (TeX-arg-literal " ") (TeX-arg-free "Title"))
+ '("menu")
+ '("minus")
+ '("need" "N")
+ '("node" (TeX-arg-literal " ") (TeX-arg-free "Name")
+ (TeX-arg-literal ", ") (TeX-arg-free "Next")
+ (TeX-arg-literal ", ") (TeX-arg-free "Previous")
+ (TeX-arg-literal ", ") (TeX-arg-free "Up"))
+ '("noindent")
+ '("oddfooting" Texinfo-lrc-argument-hook)
+ '("oddheading" Texinfo-lrc-argument-hook)
+ '("page")
+ '("paragraphindent" (TeX-arg-literal " ") (TeX-arg-free "Indent"))
+ '("pindex" "Entry")
+ '("point" nil)
+ '("print")
+ '("printindex" (TeX-arg-literal " ") (TeX-arg-free "Index name"))
+ '("pxref" "Node name")
+ '("r" "Text")
+ '("raisesections" 0)
+ '("ref" "Node name")
+ '("refill")
+ '("result")
+ '("samp" "Text")
+ '("sc" "Text")
+ '("section" (TeX-arg-literal " ") (TeX-arg-free "Title"))
+ '("set" (TeX-arg-literal " ") (TeX-arg-free "Flag"))
+ ;; XXX: Would be nice with completion.
+ '("setchapternewpage" (TeX-arg-literal " ") (TeX-arg-free "On off odd"))
+ '("setfilename" (TeX-arg-literal " ") (TeX-arg-free "Info file name"))
+ '("settitle" (TeX-arg-literal " ") (TeX-arg-free "Title"))
+ '("shortcontents")
+ '("smallbook")
+ '("sp" "N")
+ '("strong" "Text")
+ '("subheading" (TeX-arg-literal " ") (TeX-arg-free "Title"))
+ '("subsection" (TeX-arg-literal " ") (TeX-arg-free "Title"))
+ '("subsubheading" (TeX-arg-literal " ") (TeX-arg-free "Title"))
+ '("subsubsection" (TeX-arg-literal " ") (TeX-arg-free "Title"))
+ '("subtitle" (TeX-arg-literal " ") (TeX-arg-free "Title"))
+ '("summarycontents")
+ '("syncodeindex" (TeX-arg-literal " ") (TeX-arg-free "From index")
+ (TeX-arg-literal " ") (TeX-arg-free "Into index"))
+ '("synindex" (TeX-arg-literal " ") (TeX-arg-free "From index")
+ (TeX-arg-literal " ") (TeX-arg-free "Into index"))
+ '("t" "Text")
+ '("TeX" nil)
+ '("thischapter")
+ '("thischaptername")
+ '("thisfile")
+ '("thispage")
+ '("tindex" (TeX-arg-literal " ") (TeX-arg-free "Entry"))
+ '("title" (TeX-arg-literal " ") (TeX-arg-free "Title"))
+ '("titlefont" "Text")
+ '("titlepage")
+ '("today" nil)
+ '("top" (TeX-arg-literal " ") (TeX-arg-free "Title"))
+ '("unnumbered" (TeX-arg-literal " ") (TeX-arg-free "Title"))
+ '("unnumberedsec" (TeX-arg-literal " ") (TeX-arg-free "Title"))
+ '("unnumberedsubsec" (TeX-arg-literal " ") (TeX-arg-free "Title"))
+ '("unnumberedsubsubsec" (TeX-arg-literal " ") (TeX-arg-free "Title"))
+ '("value" "Flag")
+ '("var" "Metasyntactic variable")
+ '("vindex" (TeX-arg-literal " ") (TeX-arg-free "Entry"))
+ '("vskip" (TeX-arg-literal " ") (TeX-arg-free "Amount"))
+ '("w" "Text")
+ '("xref" "Node name"))
+
+ ;; RefTeX plugging
+ (add-hook 'reftex-mode-hook 'Texinfo-reftex-hook)
+ (if (and (boundp 'reftex-mode) reftex-mode)
+ (Texinfo-reftex-hook))
+
+ (TeX-run-mode-hooks 'text-mode-hook 'Texinfo-mode-hook)
+ (TeX-set-mode-name))
+
+(defcustom Texinfo-clean-intermediate-suffixes nil
+ "List of regexps matching suffixes of files to be deleted.
+The regexps will be anchored at the end of the file name to be matched,
+i.e. you do _not_ have to cater for this yourself by adding \\\\' or $."
+ :type '(repeat regexp)
+ :group 'TeX-command)
+
+(defcustom Texinfo-clean-output-suffixes
+ ;; See `man texi2html' for the HTML stuff.
+ '("\\.info\\(-[0-9]+\\)?" "\\.dvi" "\\.pdf" "\\.ps" "\\.html"
+ "_toc\\.html" "_fot\\.html" "_abt\\.html" "_[0-9]+\\.html" "_l2h_img.+")
+ "List of regexps matching suffixes of files to be deleted.
+The regexps will be anchored at the end of the file name to be matched,
+i.e. you do _not_ have to cater for this yourself by adding \\\\' or $."
+ :type '(repeat regexp)
+ :group 'TeX-command)
+
+(provide 'tex-info)
+
+;;; tex-info.el ends here
diff --git a/tests/auctex-11.87.7/tex-jp.el b/tests/auctex-11.87.7/tex-jp.el
new file mode 100644
index 0000000..9486c7a
--- /dev/null
+++ b/tests/auctex-11.87.7/tex-jp.el
@@ -0,0 +1,847 @@
+;;; tex-jp.el --- Support for Japanese TeX. -*- coding: iso-2022-jp-unix; -*-
+
+;; Copyright (C) 1999, 2001-2007, 2012 Free Software Foundation, Inc.
+
+;; Author: KOBAYASHI Shinji <koba@flab.fujitsu.co.jp>,
+;; Hidenobu Nabetani <nabe@debian.or.jp>
+;; Maintainer: Masayuki Ataka <masayuki.ataka@gmail.com>
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; This file was written by KOBAYASHI Shinji <koba@flab.fujitsu.co.jp>
+;; based on many patches developed by Japanese NetNews community.
+;; Japanese message translation by MATUI Takao <mat@nuis.ac.jp>.
+
+;;; Code:
+
+(require 'latex)
+
+;;; Customization
+
+(defgroup AUCTeX-jp nil
+ "Japanese support in AUCTeX."
+ :group 'AUCTeX)
+
+(defcustom japanese-TeX-engine-default 'ptex
+ "Default TeX engine for Japanese TeX."
+ :group 'AUCTeX-jp
+ :type '(choice (const :tag "pTeX" ptex)
+ (const :tag "jTeX" jtex)
+ (const :tag "upTeX" uptex)))
+
+(setq TeX-engine-alist-builtin
+ (append TeX-engine-alist-builtin
+ '((ptex "pTeX" "ptex %(kanjiopt)" "platex %(kanjiopt)" "eptex")
+ (jtex "jTeX" "jtex" "jlatex" nil)
+ (uptex "upTeX" "euptex" "uplatex" "euptex"))))
+
+;; $B=gD4$K9T$1$PITMW$K$J$k!#(B
+(defcustom japanese-TeX-command-list
+ ;; Changed to double quotes for Windows afflicted people. I don't
+ ;; use the %(latex) and %(tex) shorthands here because I have not
+ ;; clue whether Omega-related versions exist. --dak
+ '(("jTeX" "%(PDF)jtex %`%S%(PDFout)%(mode)%' %t"
+ TeX-run-TeX nil (plain-tex-mode) :help "Run NTT jTeX")
+ ("jLaTeX" "%(PDF)jlatex %`%S%(PDFout)%(mode)%' %t"
+ TeX-run-TeX nil (latex-mode) :help "Run NTT jLaTeX")
+ ("pTeX" "%(PDF)ptex %(kanjiopt)%`%S%(PDFout)%(mode)%' %t"
+ TeX-run-TeX nil (plain-tex-mode) :help "Run ASCII pTeX")
+ ("pLaTeX" "%(PDF)platex %(kanjiopt)%`%S%(PDFout)%(mode)%' %t"
+ TeX-run-TeX nil (latex-mode) :help "Run ASCII pLaTeX")
+ ("Mendex" "mendex %(mendexkopt)%s" TeX-run-command nil t :help "Create
index file with mendex")
+ ("jBibTeX" "jbibtex %s" TeX-run-BibTeX nil t :help "Run jBibTeX")
+ ("pBibTeX" "pbibtex %(kanjiopt)%s" TeX-run-BibTeX nil t :help "Run
pBibTeX"))
+ "Additional list of commands, especially for Japanese.
+For detail, see `TeX-command-list', to which this list is appended."
+ :group 'AUCTeX-jp
+ :type '(repeat (group :value ("" "" TeX-run-command nil t)
+ (string :tag "Name")
+ (string :tag "Command")
+ (choice :tag "How"
+ :value TeX-run-command
+ (function-item TeX-run-command)
+ (function-item TeX-run-format)
+ (function-item TeX-run-TeX)
+ (function-item TeX-run-interactive)
+ (function-item TeX-run-BibTeX)
+ (function-item TeX-run-compile)
+ (function-item TeX-run-shell)
+ (function-item TeX-run-discard)
+ (function-item TeX-run-background)
+ (function-item TeX-run-silent)
+ (function-item TeX-run-discard-foreground)
+ (function-item TeX-run-function)
+ (function-item TeX-run-discard-or-function)
+ (function :tag "Other"))
+ (boolean :tag "Prompt")
+ (choice :tag "Modes"
+ (const :tag "All" t)
+ (set (const :tag "Plain TeX" plain-tex-mode)
+ (const :tag "LaTeX" latex-mode)
+ (const :tag "DocTeX" doctex-mode)
+ (const :tag "ConTeXt" context-mode)
+ (const :tag "Texinfo" texinfo-mode)
+ (const :tag "AmSTeX" ams-tex-mode)))
+ (repeat :tag "Menu elements" :inline t sexp))))
+
+;; $B=gD4$K9T$1$PITMW$K$J$k!#(B
+(setq TeX-command-list
+ (append japanese-TeX-command-list
+ '(("-" "" ignore nil t)) ;; separator for command menu
+ TeX-command-list))
+
+;; $B;CDj=hCV!#(Btex.el $B$K<h$j9~$s$G$b$i$($k$H$h$$!#(B
+(setcar (cdr (assoc "BibTeX" TeX-command-list)) "%(bibtex) %s")
+(setcar (cdr (assoc "Index" TeX-command-list)) "%(makeindex) %s")
+
+;; $B;CDj=hCV!#(Btex.el $B$K<h$j9~$s$G$b$i$($k$H$h$$!#(B
+(setq TeX-expand-list
+ (append
+ TeX-expand-list
+ '(
+ ;; -kanji $B%*%W%7%g%s$NJ8;zNs$r:n$k!#(B
+ ("%(kanjiopt)" (lambda ()
+ (if (and
+ ;; non-mule $B$J(B emacsen
$B$O$=$b$=$bF|K\8l(B
+ ;; $BJ8=q$r(B typeset
$B$9$k$3$H$O9M$($J$/$F$b(B
+ ;; $B$$$$$@$m$&!"$H$O;W$&$1$I0l1~!D!#(B
+ (featurep 'mule)
+ japanese-TeX-use-kanji-opt-flag)
+ (let ((str (japanese-TeX-get-encoding-string)))
+ (if str (format " -kanji=%s " str) ""))
+ "")))
+ ;; pbibtex, jbibtex, upbibtex, bibtex
$B$NCf$+$iE,@Z$J$b$N$rA*Br$9$k!#(B
+ ("%(bibtex)" (lambda ()
+ (cond
+ ((eq TeX-engine 'ptex)
+ ;; pLaTeX $BMQF|K\8l(B BibTeX $B$,(B pbibtex
$B$K$J$C$?(B
+ ;; $B$N$OHf3SE*:G6a$J$N$G!"$^$@(B jbibtex
$B$N?M$b$=(B
+ ;; $B$l$J$j$K$$$k$@$m$&!#(B
+ (if (executable-find "pbibtex")
+ "pbibtex %(kanjiopt)" "jbibtex"))
+ ((eq TeX-engine 'jtex) "jbibtex")
+ ((eq TeX-engine 'uptex) "upbibtex")
+ (t "bibtex"))))
+ ;; mendex $B$H(B makeindex $B$NE,@Z$JJ}$rA*Br$9$k!#(B
+ ("%(makeindex)" (lambda ()
+ (if (memq TeX-engine '(ptex uptex))
+ "mendex %(mendexkopt)" "makeindex")))
+ ;; mendex $BMQF|K\8l%3!<%I%*%W%7%g%s!#(B
+ ("%(mendexkopt)" (lambda ()
+ (if (and (featurep 'mule)
+ japanese-TeX-use-kanji-opt-flag)
+ (let ((str (japanese-TeX-get-encoding-string)))
+ ;; $B#1J8;zL\$rBgJ8;z$K!#(B
+ (if str (format " -%c " (upcase (aref str 0)))
+ ""))
+ "")))
+ ;; pxdvi $B$H(B %(o?)xdvi $B$NE,@Z$JJ}$rA*Br$9$k!#(B
+ ("%(xdvi)" (lambda ()
+ ;; pxdvi $B$O(B ptex, jtex $B6&MQ$J$N$G!"(B
+ ;; japanese mode $B$+$I$&$+$GH=Dj$9$l$P(B OK$B!#(B
+ (if (and japanese-TeX-mode (executable-find "pxdvi"))
+ "pxdvi" "%(o?)xdvi"))))))
+
+;;; Viewing (new implementation)
+
+(unless (get 'TeX-view-predicate-list 'saved-value)
+ (setq TeX-view-predicate-list
+ '((paper-a4
+ (TeX-match-style
+ "\\`\\(a4j\\|a4paper\\|a4dutch\\|a4wide\\|sem-a4\\)\\'"))
+ (paper-a5
+ (TeX-match-style
+ "\\`\\(a5j\\|a5paper\\|a5comb\\)\\'"))
+ ;; jarticle $B$J$I$@$H(B b4paper, b5paper $B$O(B JIS B
$B7ONs!#(B
+ ;; j-article $B$J$I$NJ}$K$O(B a4j, b5j
$B$H$$$C$?%*%W%7%g%s$O$J$$!#(B
+ (paper-b5 ; ISO B5
+ (and (TeX-match-style "\\`b5paper\\'")
+ (not (memq TeX-engine '(ptex uptex)))))
+ (paper-b5jis ; JIS B5
+ (or (TeX-match-style "\\`b5j\\'")
+ (and (TeX-match-style "\\`b5paper\\'")
+ (memq TeX-engine '(ptex uptex)))))
+ ;; article $B$J$I$K$O(B b4paper $B$H$$$&%*%W%7%g%s$O$J$$!#(B
+ ;; b4paper $B$H$$$&%*%W%7%g%s$,$"$C$?$i(B JIS B4 $B$H8+$J$9!#(B
+ (paper-b4jis
+ (TeX-match-style "\\`\\(b4j\\|b4paper\\)\\'")))))
+;; jsarticle $B$@$HB>$K$b$b$C$HH=7?$N%*%W%7%g%s$,$"$k$,!"(B
+;; $BA4ItLLE]8+$F$k$H%-%j$,$J$$$N$G!"$3$l$/$i$$$G$$$$$@$m$&!#(B
+;; jsarticle.el $B$d(B jsbook.el
$B$GDI2CJ,$N=hM}$r;E9~$a$P$$$$$N$+$bCN$l$J$$!#(B
+
+;; $B;CDj=hCV!#(Btex.el $B$K<h$j9~$s$G$b$i$($k$H$h$$!#(B
+(unless (get 'TeX-view-program-list 'saved-value)
+ (setq TeX-view-program-list
+ (cond
+ ;; http://oku.edu.mie-u.ac.jp/~okumura/texwiki/?AUCTeX
+ ;; $B$r;29M$K$7$F$_$?!#(B
+ ((eq system-type 'windows-nt)
+ '(("Dviout" ("dviout -1 "
+ ((paper-a4 paper-portrait) " -y=A4 ")
+ ((paper-a4 paper-landscape) " -y=A4L ")
+ ((paper-a5 paper-portrait) " -y=A5 ")
+ ((paper-a5 paper-landscape) " -y=A5L ")
+ ((paper-b5 paper-portrait) " -y=E5 ")
+ ((paper-b5 paper-landscape) " -y=E5L ")
+ ((paper-b4jis paper-portrait) " -y=B4 ")
+ ((paper-b4jis paper-landscape) " -y=B4L ")
+ ((paper-b5jis paper-portrait) " -y=B5 ")
+ ((paper-b5jis paper-landscape) " -y=B5L ")
+ (paper-legal " -y=Legal ")
+ (paper-letter " -y=Letter ")
+ (paper-executive " -y=Exective ")
+ "%o" (mode-io-correlate " \"# %n '%b'\"")))
+ ("TeXworks" "TeXworks %o")
+ ("SumatraPDF" "SumatraPDF -reuse-instance %o"
+ (mode-io-correlate " -forward-search \"%b\" %n"))
+ ("MuPDF" "mupdf %o")))
+ ;; $B$3$l$G$$$$$N$+$I$&$+$OIT0B!#(B
+ ((eq system-type 'darwin)
+ '(("Preview" "open -a Preview.app %o")
+ ("TeXShop" "open -a TeXShop.app %o")
+ ("TeXworks" "open -a TeXworks.app %o")
+ ("Skim" "open -a Skim.app %o")
+ ("displayline" "displayline %n %o %b")
+ ("PictPrinter" "open -a PictPrinter.app %d")
+ ("Mxdvi" "open -a Mxdvi.app %d")
+ ("open" "open %o")))
+ (t
+ (setcar (cadr (assoc "xdvi" TeX-view-program-list-builtin))
+ "%(xdvi) -unique")
+ '(("TeXworks" "texworks %o")
+ ("zathura" "zathura %o")
+ ("MuPDF" "mupdf %o"))))))
+
+;; $B$3$l$O(B tex.el $B$K<h$jF~$l$F$b$i$&$N$OFq$7$$$+!)(B
+;; tex-jp.el $B$,FI$_9~$^$l$k$@$1$G!"(Bdvi viewer $B$N%G%U%)%k%H$,(B
dviout $B$K(B
+;; $B$J$C$F$7$^$&$N$ODq93$,Bg$-$$$+$b!#(B
+(unless (get 'TeX-view-program-selection 'saved-value)
+ (setq TeX-view-program-selection
+ (append
+ (cond
+ ((eq system-type 'windows-nt)
+ '((output-dvi "Dviout")
+ (output-pdf "TeXworks")))
+ ((eq system-type 'darwin)
+ '((output-pdf "Preview")))
+ (t
+ nil))
+ TeX-view-program-selection)))
+
+(mapc (lambda (dir) (add-to-list 'TeX-macro-global dir t))
+ (or (TeX-tree-expand
+ '("$SYSTEXMF" "$TEXMFLOCAL" "$TEXMFMAIN" "$TEXMFDIST")
+ "platex" '("/ptex/" "/pbibtex/bst/"))
+ '("/usr/share/texmf/ptex/" "/usr/share/texmf/pbibtex/bst/")))
+
+(mapc (lambda (dir) (add-to-list 'TeX-macro-global dir t))
+ (or (TeX-tree-expand
+ '("$SYSTEXMF" "$TEXMFLOCAL" "$TEXMFMAIN" "$TEXMFDIST")
+ "jlatex" '("/jtex/" "/jbibtex/bst/"))
+ '("/usr/share/texmf/jtex/" "/usr/share/texmf/jbibtex/bst/")))
+
+;; $B=gD4$K9T$1$PITMW$K$J$k!#(B
+(setq LaTeX-command-style
+ (append '(("\\`u[jt]\\(article\\|report\\|book\\)\\'\\|\\`uplatex\\'"
+ "%(PDF)uplatex %(kanjiopt)%S%(PDFout)")
+ ("\\`[jt]s?\\(article\\|report\\|book\\)\\'"
+ "%(PDF)platex %(kanjiopt)%S%(PDFout)")
+ ("\\`j-\\(article\\|report\\|book\\)\\'"
+ "%(PDF)jlatex %(kanjiopt)%S%(PDFout)"))
+ LaTeX-command-style))
+
+(defcustom japanese-TeX-error-messages t
+ "*If non-nil, explain TeX error messages in Japanese."
+ :group 'AUCTeX-jp
+ :type 'boolean)
+
+(when (featurep 'mule)
+
+;; FIX-ME (2007-02-09) The default coding system in recent Unix (like Fedora
and
+;; Ubuntu) is utf-8. But Japanese TeX system does not support utf-8 yet
+;; (platex-utf is under development, may be alpha phase). So,
+;; process-coding-system for Japanese TeX is not defined from
+;; default-coding-system. When platex-utf is out, we should look this setting,
+;; again.
+
+(defcustom TeX-japanese-process-input-coding-system
+ (cond ((memq system-type '(windows-nt ms-dos cygwin)) 'shift_jis-dos)
+ ((memq system-type '(mac darwin)) 'shift_jis-mac)
+ (t 'euc-jp-unix))
+ "TeX-process' coding system with standard input."
+ :group 'AUCTeX-jp
+ :type 'coding-system)
+
+(defcustom TeX-japanese-process-output-coding-system
+ (cond ((memq system-type '(windows-nt ms-dos cygwin)) 'shift_jis-dos)
+ ((memq system-type '(mac darwin)) 'shift_jis-mac)
+ (t 'euc-jp-unix))
+ "TeX-process' coding system with standard output."
+ :group 'AUCTeX-jp
+ :type 'coding-system)
+
+)
+
+;; $B=gD4$K9T$1$PITMW$K$J$k!#(B
+(defcustom japanese-TeX-command-default "pTeX"
+ "*The default command for `TeX-command' in the japanese-TeX mode."
+ :group 'AUCTeX-jp
+ :type 'string)
+ (make-variable-buffer-local 'japanese-TeX-command-default)
+
+;; $B=gD4$K9T$1$PITMW$K$J$k!#(B
+(defcustom japanese-LaTeX-command-default "LaTeX"
+ "*The default command for `TeX-command' in the japanese-LaTeX mode."
+ :group 'AUCTeX-jp
+ :type 'string)
+ (make-variable-buffer-local 'japanese-LaTeX-command-default)
+
+(defcustom japanese-LaTeX-default-style "jarticle"
+ "*Default when creating new Japanese documents."
+ :group 'AUCTeX-jp
+ :type 'string)
+
+(defcustom japanese-LaTeX-style-list
+ '(("j-article")
+ ("j-report")
+ ("j-book")
+ ("jslides")
+ ("jarticle")
+ ("jreport")
+ ("jbook")
+ ("tarticle")
+ ("treport")
+ ("tbook")
+ ("jsarticle")
+ ("jsbook"))
+ "*List of Japanese document styles."
+ :group 'AUCTeX-jp
+ :type '(repeat (group (string :format "%v"))))
+
+(setq LaTeX-style-list
+ (append japanese-LaTeX-style-list LaTeX-style-list))
+
+;;; Coding system
+
+(when (featurep 'mule)
+
+(defun japanese-TeX-set-process-coding-system (process)
+ "Set proper coding system for japanese TeX PROCESS."
+ (if (with-current-buffer TeX-command-buffer japanese-TeX-mode)
+ (set-process-coding-system process
+ TeX-japanese-process-output-coding-system
+ TeX-japanese-process-input-coding-system)))
+(setq TeX-after-start-process-function
+ 'japanese-TeX-set-process-coding-system)
+
+(defcustom japanese-TeX-use-kanji-opt-flag t
+ "Add kanji option to Japanese pTeX family if non-nil."
+ :group 'AUCTeX-jp
+ :type 'boolean)
+
+(defun japanese-TeX-coding-ejsu (coding-system)
+ "Convert japanese CODING-SYSTEM to mnemonic string.
+euc-jp: \"euc\"
+jis: \"jis\"
+shift_jis: \"sjis\"
+utf-8: \"utf8\"
+Return nil otherwise."
+ (let ((base (coding-system-base coding-system)))
+ (cdr (assq base
+ '((japanese-iso-8bit . "euc")
+ (iso-2022-jp . "jis")
+ (japanese-shift-jis . "sjis")
+ (utf-8 . "utf8")
+
+ ;; xemacs $B$@$H0J2<$NL>A0$O0c$&$+$b!D!#(B
+ (euc-jis-2004 . "euc")
+ (iso-2022-jp-2004 . "jis")
+ (japanese-shift-jis-2004 . "sjis")
+
+ (japanese-cp932 . "sjis")
+ (eucjp-ms . "euc"))))))
+
+(defun japanese-TeX-get-encoding-string ()
+ "Return coding option string for Japanese pTeX family.
+For inappropriate encoding, nil instead."
+ (or (japanese-TeX-coding-ejsu buffer-file-coding-system)
+
+ ;; $BJ#?t%U%!%$%k$KJ,3d$7$?J8=q$N>l9g!"(Bemacs
$B$G3+$$$?%U%!%$%k$,F|K\(B
+ ;; $B8l$r#1;z$b4^$^$J$$$3$H$,$"$k!#$3$N$?$a!"$=$N%U%!%$%k$N(B
+ ;; buffer-file-coding-system $B$OF|K\8l%3!<%I$,ITDj$KN1$^$C$F(B
+ ;; $B$7$^$&2DG=@-$,$"$k!#$=$N$h$&$J>l9g!"(Bmaster file $B$N(B
+ ;; buffer-file-coding-system $B$r;H$&!#(B
+ (if (stringp TeX-master) ; $B<+J,$,;R%U%!%$%k$N$H$-(B
+ (let ((buf (get-file-buffer (TeX-master-file t))))
+ (if buf
+ (japanese-TeX-coding-ejsu
+ (with-current-buffer buf buffer-file-coding-system)))))
+
+ ;; $B$=$l$G$b7h$a$i$l$J$$>l9g$O(B buffer-file-coding-system $B$N(B
+ ;; default $BCM$r;H$&!#(B
+ (japanese-TeX-coding-ejsu
+ (default-value 'buffer-file-coding-system))))
+
+)
+
+;;; Japanese TeX modes
+
+(defvar japanese-TeX-mode nil
+ "Non-nil means the current buffer handles Japanese TeX/LaTeX.")
+(make-variable-buffer-local 'japanese-TeX-mode)
+(put 'japanese-TeX-mode 'permanent-local t)
+
+;;;###autoload
+(defun japanese-plain-tex-mode ()
+ "Major mode in AUCTeX for editing Japanese plain TeX files.
+Set `japanese-TeX-mode' to t, and enter `TeX-plain-tex-mode'."
+ (interactive)
+ (setq japanese-TeX-mode t)
+ (TeX-plain-tex-mode))
+
+(defun japanese-plain-tex-mode-initialization ()
+ "Japanese plain-TeX specific initializations."
+ (when japanese-TeX-mode
+; (setq TeX-command-default japanese-TeX-command-default)
+ (TeX-engine-set japanese-TeX-engine-default)))
+
+(add-hook 'plain-TeX-mode-hook 'japanese-plain-tex-mode-initialization)
+
+;;;###autoload
+(defun japanese-latex-mode ()
+ "Major mode in AUCTeX for editing Japanese LaTeX files.
+Set `japanese-TeX-mode' to t, and enter `TeX-latex-mode'."
+ (interactive)
+ (setq japanese-TeX-mode t)
+ (TeX-latex-mode))
+
+(defun japanese-latex-mode-initialization ()
+ "Japanese LaTeX specific initializations."
+ (when japanese-TeX-mode
+; (setq TeX-command-default japanese-LaTeX-command-default)
+ (TeX-engine-set
+ ;; class file $BL>$KMj$k$N$O@5$7$$$N$+!)(B
+ ;; jLaTeX $B$K$b(B jarticle $B$O0l1~$"$k$7!"(BpLaTeX $B$G$b<+J,$G(B
j-article $B$r(B
+ ;; $B%$%s%9%H!<%k$7$F;H$C$F$$$1$J$$K!$O$J$$!#(B
+ (cond
+ ((TeX-match-style
"\\`u[jt]\\(article\\|report\\|book\\)\\'\\|\\`uplatex\\'")
+ 'uptex)
+ ((TeX-match-style "\\`[jt]s?\\(article\\|report\\|book\\)\\'")
+ 'ptex)
+ ((TeX-match-style "\\`j-\\(article\\|report\\|book\\)\\'")
+ 'jtex)
+ (t japanese-TeX-engine-default)))
+ (setq LaTeX-default-style japanese-LaTeX-default-style)
+; (setq TeX-command-BibTeX
+; (if (and (eq TeX-engine 'ptex) (executable-find "pbibtex"))
+; "pBibTeX" "jBibTeX"))
+))
+
+(add-hook 'LaTeX-mode-hook 'japanese-latex-mode-initialization)
+
+
+;;; Support for various self-insert-command
+
+(fset 'japanese-TeX-self-insert-command
+ (cond ((fboundp 'can-n-egg-self-insert-command)
+ 'can-n-egg-self-insert-command)
+ ((fboundp 'egg-self-insert-command)
+ 'egg-self-insert-command)
+ ((fboundp 'canna-self-insert-command)
+ 'canna-self-insert-command)
+ (t
+ 'self-insert-command)))
+
+(defun TeX-insert-punctuation ()
+ "Insert point or comma, cleaning up preceding space."
+ (interactive)
+ (expand-abbrev)
+ (if (TeX-looking-at-backward "\\\\/\\(}+\\)" 50)
+ (replace-match "\\1" t))
+ (call-interactively 'japanese-TeX-self-insert-command))
+
+;;; Error Messages
+
+(if japanese-TeX-error-messages
+(setq TeX-error-description-list
+ '(("Bad \\\\line or \\\\vector argument.*" .
+"$B@~$N79$-$r;XDj$9$k!$(B\\line$B$^$?$O(B\\vector$B$N:G=i$N0z?t$,IT@5$G$9!%(B")
+
+ ("Bad math environment delimiter.*" .
+"$B?t<0%b!<%ICf$G?t<0%b!<%I3+;O%3%^%s%I(B\\[$B$^$?$O(B\\($B!$$^$?$O!$?t<0%b!<%I30$G(B
+$B?t<0%b!<%I=*N;%3%^%s%I(B\\]$B$^$?$O(B\\)$B$r(BTeX$B$,8+$D$1$^$7$?!%$3$NLdBj$O!$?t<0%b!<(B
+$B%I$N%G%j%_%?$,%^%C%A$7$F$$$J$+$C$?$j!$3g8L$N%P%i%s%9$,$H$l$F$$$J$+$C$?$j$9(B
+$B$k$?$a$K@8$8$^$9!%(B")
+
+ ("Bad use of \\\\\\\\.*" .
+"\\\\$B%3%^%s%I$,%Q%i%0%i%UCf$K$"$j$^$7$?!%$3$N;H$$$+$?$OL50UL#$G$9!%(B
+$B$3$N%(%i!<%a%C%;!<%8$O(B\\\\$B$,(Bcentering$B4D6-$d(Bflushing$B4D6-$G;H$o$l$?(B
+$B;~!$$"$k$$$O(Bcentering/flushing$B@k8@$,M-8z$J$H$3$m$G;H$o$l$?;~$K@8$8$^$9!%(B")
+
+ ("\\\\begin{[^ ]*} ended by \\\\end{[^ ]*}." .
+"$BBP1~$9$k(B\\begin$BL?Na$N$J$$(B\\end$BL?Na$r(BLaTeX$B$,8+$D$1$^$7$?!%(B\\end$BL?Na$N4D(B
+$B6-L>$r4V0c$($?$+!$M>J,$J(B\\begin$BL?Na$,$"$k$+!$(B\\end$BL?Na$r$o$9$l$?$+$N$$$:(B
+$B$l$+$G$7$g$&!%(B")
+
+ ("Can be used only in preamble." .
+"$B%W%j%"%s%V%k$G$7$+;H$($J$$(B\\documentclass$B!&(B\\nofiles$B!&(B\\includeonly
+\\makeindex$B!&(B\\makeglossary$B$N$&$A$N$$$:$l$+$,(B\\begin{document}$B$h$j$b(B
+$B8e$G;H$o$l$F$$$k$N$r(BLaTeX$B$,8!=P$7$^$7$?!%$3$N%(%i!<$O(B\\begin{document}
+$B$,M>J,$K$"$C$?;~$K$b@8$8$^$9!%(B")
+
+ ("Command name [^ ]* already used.*" .
+"$B$9$G$KDj5A$5$l$F$$$kL?NaL>$^$?$O4D6-L>$KBP$7$F(B\\newcommand$B!&(B
+\\newenvironment$B!&(B\\newlength$B!&(B\\newsavebox$B!&(B\\newtheorem$B$N$&$A$N$$$:(B
+$B$l$+$r<B9T$7$h$&$H$7$F$$$^$9(B($B$"$k4D6-$rDj5A$9$k$HF1$8L>A0$NL?Na$,<+F0(B
+$BE*$KDj5A$5$l$k$N$G!$4{$KB8:_$9$k4D6-$HF1L>$NL?Na$ODj5A$G$-$^$;$s(B)$B!%?7(B
+$B$7$$L>A0$r9M$($k$+!$(B\\newcommand$B$+(B\\newenvironment$B$N>l9g$J$iBP1~$9$k(B
+\\renew...$BL?Na$r;H$o$J$1$l$P$J$j$^$;$s!%(B")
+
+ ("Counter too large." .
+"1. $BJ8;z$G=g=xIU$1$5$l$?$b$N!$$?$V$sHV9fIU$1$5$l$?%j%9%H4D6-$N%i%Y%k$,!$(B
+26$B$h$j$bBg$-$$HV9f$r<u$1<h$j$^$7$?!%Hs>o$KD9$$%j%9%H$r;H$C$F$$$k$+!$(B
+$B%+%&%s%?$r:F@_Dj$7$F$7$^$C$?$+$N$$$:$l$+$G$7$g$&!%(B
+
+2. $B5SCm$,J8;z$^$?$O5SCm5-9f$G=g=x$E$1$5$l$F$$$^$9$,!$J8;z$^$?$O5-9f$r(B
+$B;H$$@Z$C$F$7$^$$$^$7$?!%$*$=$i$/(B\\thanks$BL?Na$N;H$$$9$.$G$9!%(B")
+
+
+ ("Environment [^ ]* undefined." .
+"$BDj5A$5$l$F$$$J$$4D6-$KBP$9$k(B\\begin$BL?Na$r(BLaTeX$B$,8+$D$1$^$7$?!%$*$=$i$/(B
+$B4D6-L>$r4V0c$($?$N$G$7$g$&!%(B")
+
+ ("Float(s) lost." .
+"parbox$B$N$J$+$K(Bfigure$B4D6-!&(Btable$B4D6-$^$?$O(B\\marginpar$BL?Na$,$"$j$^$7$?(B
+\($B$J$*!$(Bparbox$B$O(Bminipage$B4D6-$+(B\\parbox$BL?Na$K$h$C$F:n$i$l$k$+!$5SCm$d?^(B
+$B$J$I$KBP$7$F(BLaTeX$B$,@8@.$9$k$b$N$G$9(B\)$B!%$3$l$O=PNO;~$N%(%i!<$J$N$G!$860x(B
+$B$H$J$C$F$$$k4D6-$"$k$$$OL?Na$O!$(BLaTeX$B$,LdBj$rH/8+$7$?>l=j$h$j$b$@$$$V(B
+$B$sA0$K$"$k2DG=@-$,$"$j$^$9!%=PNO$5$l$F$$$J$$?^!&I=!&K5Cm$J$I$,$$$/$D$+(B
+$B$"$k$+$b$7$l$^$;$s$,!$$=$l$i$,860x$G$"$k$H$O8B$j$^$;$s!%(B")
+
+ ("Illegal character in array arg." .
+"array$B4D6-$^$?$O(Btabular$B4D6-$N0z?t!$$^$?$O(B\\multicolumn$BL?Na$NBh(B2$B0z?t(B
+$B$NCf$KIT@5$JJ8;z$,$"$j$^$7$?!%(B")
+
+ ("Missing \\\\begin{document}." .
+"\\begin{document}$BL?Na$h$jA0$K(BLaTeX$B$,=PNO$r9T$J$C$F$7$^$$$^$7$?!%(B
+\\begin{document}$BL?Na$rK:$l$?$+!$%W%j%"%s%V%k$K2?$+4V0c$$$,$"$k$N$G$7$g$&!%(B
+$BBG$A4V0c$$$K$h$kJ8;z$d!$@k8@$N8m$j$K$h$k2DG=@-$b$"$j$^$9!%Nc$($P!$0z?t$r(B
+$B0O$`3g8L$rH4$+$7$?$H$+!$L?NaL>$N(B\\$B$rK:$l$?>l9g$J$I$G$9!%(B")
+
+ ("Missing p-arg in array arg.*" .
+"array$B4D6-!&(Btabular$B4D6-$N0z?t!$$"$k$$$O(B\\multicolumn$BL?Na$NBh(B2$B0z?t$NCf$K!$(B
+$B3g8L$K0O$^$l$?I=8=$N$D$$$F$$$J$$(Bp$B$,$"$j$^$7$?!%(B")
+
+ ("Missing @-exp in array arg." .
+"array$B4D6-!&(Btabular$B4D6-$N0z?t!$$"$k$$$O(B\\multicolumn$BL?Na$NBh(B2$B0z?t$NCf$K!$(B
+@$BI=8=$N$D$$$F$$$J$$(B@$B$,$"$j$^$7$?!%(B")
+
+ ("No such counter." .
+"\\setcounter$BL?Na$^$?$O(B\\addtocounter$BL?Na$G!$B8:_$7$J$$%+%&%s%?$,;XDj$5$l(B
+$B$^$7$?!%$*$=$i$/$?$@$N%?%$%W%_%9$G$7$g$&!%$?$@$7!$%(%i!<$,(Baux$B%U%!%$%k$NCf(B
+$B$G@8$8$?>l9g$O!$(B\\newcounter$BL?Na$r%W%j%"%s%V%k$N30$G;H$C$?$N$@$H;W$o$l$^$9!%(B")
+
+ ("Not in outer par mode." .
+"figure$B4D6-!&(Btable$B4D6-$"$k$$$O(B\\marginpar$BL?Na$,?t<0%b!<%I$^$?$O(Bparbox$B$NCf(B
+$B$G;H$o$l$^$7$?!%(B")
+
+ ("\\\\pushtabs and \\\\poptabs don't match." .
+"\\pushtabs$B$HBP1~$7$J$$(B\\poptabs$B$,$_$D$+$C$?$+!$$^$?$O!$BP1~$9$k(B\\poptabs
+$B$r$b$?$J$$(B\\pushtabs$B$,$"$k$N$K(B\\end{tabbing}$B$,8=$l$F$7$^$$$^$7$?!%(B")
+
+ ("Something's wrong--perhaps a missing \\\\item." .
+"$B%j%9%H4D6-$NCf$K(B\\item$BL?Na$,$J$$$N$,:G$b$"$j$=$&$J%1!<%9$G$9!%(B
+thebibliography$B4D6-$G0z?t$rK:$l$?>l9g$K$b@8$8$^$9!%(B")
+
+ ("Tab overflow." .
+"\\=$B$,!$(BLaTeX$B$G5v$5$l$k%?%V%9%H%C%W$N:GBg?t$rD6$($F$$$^$9!%(B")
+
+ ("There's no line here to end." .
+"\\newline$BL?Na$^$?$O(B\\\\$BL?Na$,%Q%i%0%i%U4V$K$"$j$^$9!%$3$N;H$$$+$?$O(B
+$BL50UL#$G$9!%$b$76u9T$r$"$1$?$$$N$G$7$?$i!$(B\\vspace$B$r;H$C$F$/$@$5$$!%(B")
+
+ ("This may be a LaTeX bug." .
+"$B$^$C$?$/$o$1$,$o$+$i$J$/$J$C$F$7$^$$$^$7$?!%$?$V$s$3$l0JA0$K8!=P$5$l$?(B
+$B%(%i!<$N$;$$$@$H;W$o$l$^$9!%$7$+$7!$(BLaTeX$B<+BN$N%P%0$G$"$k2DG=@-$b$"$j$^$9!%(B
+$B$b$7$3$N%(%i!<$,F~NO%U%!%$%k$KBP$9$k:G=i$N%(%i!<$G$"$j!$2?$b4V0c$$$,8+$D(B
+$B$+$i$J$$>l9g$O!$$=$N%U%!%$%k$rJ]B8$7$F!$%m!<%+%k%,%$%I$K=q$+$l$F$$$k@UG$(B
+$B<T$KO"Mm$7$F$/$@$5$$!%(B")
+
+ ("Too deeply nested." .
+"$B%j%9%H4D6-$NF~$l;R$,?<$9$.$^$9!%2?CJ3,$NF~$l;R$,5v$5$l$k$+$O;H$C$F$$$k(B
+$B%3%s%T%e!<%?$K0MB8$7$^$9$,!$>/$J$/$H$b(B4$BCJ3,$^$G$O5v$5$l$F$$$^$9(B($BIaDL$O(B
+$B$=$l$G==J,$G$7$g$&(B)$B!%(B")
+
+ ("Too many unprocessed floats." .
+"$B$3$N%(%i!<$O(B1$B%Z!<%8Cf$N(B\\marginpar$BL?Na$,B?$9$.$k$?$a$K@8$8$k>l9g$b$"(B
+$B$j$^$9$,!$$b$C$H$"$j$=$&$J$N$O!$8B3&$rD6$($F?^$dI=$rJ]B8$7$h$&$H$7$?>l(B
+$B9g$G$9!%D9$$J8=q$rAHHG$7$F$$$/$H$-!$(BLaTeX$B$O?^$dI=$r8D!9$KJ]B8$7!$%Z!<(B
+$B%8$NJ,3d$r9T$J$&;~$K$=$l$i$rA^F~$7$^$9!%$3$N%(%i!<$O!$%Z!<%8$X$NJ,3d$,(B
+$B9T$J$o$l$kA0$K!$$"$^$j$K$bB?$/$N(Bfigure$B4D6-$d(Btable$B4D6-$,8+$D$+$C$?>l9g(B
+$B$K@8$8$^$9!%$3$NLdBj$O4D6-$N$&$A$N$$$/$D$+$rJ8=q$N=*$o$j$NJ}$K0\F0$9$l(B
+$B$P2r7h$G$-$^$9!%$^$?!$$3$N%(%i!<$O(B``logjam''$B$K$h$C$F@8$8$k$3$H$b$"$j$^(B
+$B$9!%(B``logjam''$B$H$O!$(BLaTeX$B$,=P8==g=xDL$j$K$7$+?^I=$r=PNO$G$-$J$$$;$$$G!$(B
+$B?^I=$N=PNO$,(B1$B%v=j$G$b$D$^$k$H$=$N8e$m$N?^I=$,8.JB$_$9$Y$F$D$C$+$($F$7$^(B
+$B$&$3$H$r$$$$$^$9!%$3$N%8%c%`$N860x$O!$Bg$-$9$.$F(B1$B%Z!<%8$J$$$7$O%*%W%7%g(B
+$B%s0z?t$G;XDj$5$l$?0LCV$K<}$^$i$J$$$h$&$J?^$dI=$G$"$k2DG=@-$,$"$j$^$9!%$3(B
+$B$l$O!$0z?t$K(Bp$B%*%W%7%g%s$,;XDj$5$l$F$$$J$$$H5/$-$d$9$/$J$j$^$9!%(B")
+
+ ("Undefined tab position." .
+"\\>$B!&(B\\+$B!&(B\\-$B$^$?$O(B\\<$BL?Na$G!$B8:_$7$J$$%?%V0LCV!$$9$J$o$A(B\\=$BL?Na$GDj(B
+$B5A$5$l$F$$$J$$%?%V0LCV$r;XDj$7$h$&$H$7$F$$$^$9!%(B")
+
+ ("\\\\< in mid line." .
+"\\<$BL?Na$,(Btabbing$B4D6-$N9T$NESCf$K8=$l$^$7$?!%$3$NL?Na$O9T$N@hF,$K$J$1$l$P(B
+$B$J$j$^$;$s!%(B")
+
+ ("Double subscript." .
+"$B?t<0Cf$N(B1$B$D$NNs$K(B2$B$D$N2<IU$-J8;z$,$D$$$F$$$^$9!%Nc$($P(Bx_{2}_{3}$B$N$h$&$K!%(B
+$B$3$N$h$&$JI=8=$OL50UL#$G$9!%(B")
+
+ ("Double superscript." .
+"$B?t<0Cf$N(B1$B$D$NNs$K(B2$B$D$N>eIU$-J8;z$,$D$$$F$$$^$9!%Nc$($P(Bx^{2}^{3}$B$N$h$&$K!%(B
+$B$3$N$h$&$JI=8=$OL50UL#$G$9!%(B")
+
+ ("Extra alignment tab has been changed to \\\\cr." .
+"array$B4D6-$^$?$O(Btabular$B4D6-$N(B1$BNsCf$K$"$k9`L\$,B?$9$.$^$9!%8@$$49$($k$H!$(B
+$BNs$N=*$o$j$^$G$K$"$k(B&$B$N?t$,B?$9$.$^$9!%$*$=$i$/A0$NNs$N:G8e$K(B\\\\$B$r$D$1(B
+$B$k$N$rK:$l$?$N$G$7$g$&!%(B")
+
+ ("Extra \\}, or forgotten \\$." .
+"$B3g8L$^$?$O?t<0%b!<%I$N%G%j%_%?$,@5$7$/BP1~$7$F$$$^$;$s!%$*$=$i$/(B{$B!&(B\\[$B!&(B
+\\($B$"$k$$$O(B$$B$N$&$A$N$$$:$l$+$r=q$-K:$l$?$N$G$7$g$&!%(B")
+
+ ("Font [^ ]* not loaded: Not enough room left." .
+"$B$3$NJ8=q$O8B3&$h$j$bB?$/$N%U%)%s%H$r;H$C$F$$$^$9!%$b$7J8=q$NItJ,$4$H$K(B
+$BJL!9$N%U%)%s%H$,;H$o$l$F$$$k$N$J$i!$J,3d$7$F=hM}$9$l$PLdBj$O2r7h$5$l$^$9!%(B")
+
+ ("I can't find file `.*'." .
+"$BI,MW$J%U%!%$%k$,8+$D$+$j$^$;$s$G$7$?!%$b$78+$D$+$i$J$$%U%!%$%k$N3HD%;R(B
+$B$,(Btex$B$N>l9g!$$"$J$?$,;XDj$7$?%U%!%$%k!$$9$J$o$A%a%$%s%U%!%$%k$^$?$O(B
+\\input$BL?Na!&(B\\include$BL?Na$GA^F~$5$l$k%U%!%$%k$,8+$D$+$i$J$$$N$G$9!%(B
+$B3HD%;R$,(Bsty$B$G$"$l$P!$B8:_$7$J$$J8=q%9%?%$%k$^$?$O%9%?%$%k%*%W%7%g%s$r(B
+$B;XDj$7$h$&$H$7$F$$$^$9!%(B")
+
+ ("Illegal parameter number in definition of .*" .
+"$B$3$l$O$*$=$i$/!$(B\\newcommand$B!&(B\\renewcommand$B!&(B\\newenvironment$B$^$?$O(B
+\\renewenvironment$BL?Na$N$J$+$G(B#$B$,@5$7$/;H$o$l$J$+$C$?$?$a$K@8$8$?%(%i!<(B
+$B$G$9!%(B\\#$BL?Na$H$7$F;H$o$l$k>l9g$r=|$1$P!$(B#$B$H$$$&J8;z$O!$Nc$($P(B2$BHVL\$N(B
+$B0z?t$r;XDj$9$k(B#2$B$N$h$&$K!$0z?t%Q%i%a!<%?$H$7$F$7$+;H$($^$;$s!%$^$?!$(B
+$B$3$N%(%i!<$O!$>e$K$"$2$?(B4$B$D$N%3%^%s%I$,$*8_$$$KF~$l;R$K$J$C$F$$$k>l9g(B
+$B$d!$(B\\newenvironment$BL?Na!&(B\\renewenvironment$BL?Na$G(B#2$B$N$h$&$J%Q%i%a!<%?(B
+$B$,:G8e$N0z?t$NCf$G;H$o$l$F$$$k>l9g$K$b@8$8$^$9!%(B")
+
+ ("Illegal unit of measure ([^ ]* inserted)." .
+"$B$b$7(B
+ ! Missing number, treated as zero.
+$B$H$$$&%(%i!<$,5/$-$?D>8e$G$"$l$P!$$3$N%(%i!<$N860x$b$=$l$HF1$8$G$9!%(B
+$B$=$&$G$J$$>l9g$O!$(BLaTeX$B$,0z?t$H$7$F(Blength$B$r4|BT$7$F$$$k$N$K(Bnumber$B$,(B
+$B8=$l$?$3$H$r0UL#$7$F$$$^$9!%$3$N%(%i!<$N:G$b$"$j$,$A$J860x$OD9$5(B0$B$r(B
+$BI=$o$9(B0in$B$N$h$&$JI=8=$NBe$o$j$K(B0$B$H$+$$$F$7$^$&$3$H$K$"$j$^$9!%$?$@$7!$(B
+$BL?Na$N0z?t$r=q$-K:$l$?>l9g$K$b$3$N%(%i!<$,@8$8$k$3$H$,$"$j$^$9!%(B")
+
+ ("Misplaced alignment tab character \\&." .
+"array$B$^$?$O(Btabular$B4D6-$G$N9`L\6h@Z$j$K$N$_;H$o$l$k$Y$-J8;z(B&$B$,IaDL$NJ8(B
+$B$NCf$K$"$j$^$7$?!%$?$V$s(B\\&$B$HF~NO$7$?$+$C$?$N$G$7$g$&!%(B")
+
+ ("Missing control sequence inserted." .
+"$B$3$N%(%i!<$O!$$*$=$i$/L?NaL>$G$J$$$b$N$r(B\\newcommand$B!&(B\\renewcommand$B!&(B
+\\newlength$B$^$?$O(B\\newsavebox$B$NBh(B1$B0z?t$H$7$F;H$C$?$?$a$K@8$8$?$N$G$7$g$&!%(B")
+
+ ("Missing number, treated as zero." .
+"$B$3$N%(%i!<$O$?$$$F$$!$0z?t$H$7$F(Bnumber$B$^$?$O(Blength$B$rI,MW$H$7$F$$$kL?Na$K(B
+$BBP$7$F0z?t$,M?$($i$l$J$+$C$?$?$a$K@8$8$^$9!%0z?t$r=q$-K:$l$?$N$+!$%F%-%9%H(B
+$B$NCf$NBg3g8L(B([])$B$,%*%W%7%g%s0z?t$N;XDj$H4V0c$($i$l$F$7$^$C$?$+$N$I$A$i$+$G(B
+$B$7$g$&!%$^$?!$?t$r@8@.$9$k(B\\value$B$N$h$&$JL?Na$d(Blength$BL?Na$NA0$K(B\\protect$B$r(B
+$BCV$$$?>l9g$K$b$3$N%(%i!<$O@8$8$^$9!%(B")
+
+ ("Missing [{}] inserted." .
+"TeX$B$O4{$K$o$1$,$o$+$i$J$/$J$C$F$$$^$9!%%(%i!<%a%C%;!<%8$K$h$C$F<($5$l$F(B
+$B$$$k>l=j$O$?$V$sF~NO$K4V0c$$$,$"$C$?$H$3$m$h$j$b8e$m$K$J$C$F$7$^$C$F$$$k(B
+$B$G$7$g$&!%(B")
+
+ ("Missing \\$ inserted." .
+"$B$*$=$i$/!$?t<0%b!<%ICf$G$7$+;H$($J$$L?Na$r(BTeX$B$,?t<0%b!<%I30$G8!=P$7$?(B
+$B$N$@$H;W$o$l$^$9!%FC$K5-=R$5$l$F$$$J$$8B$j!$(BLaTeX
Book(Lamport$BCx(B,$BLu=q(B
+$B$O%"%9%-!<=PHG(B)$B$N(B3.3$B@a$K$"$kE:;z!&J,?t!&?t3X5-9f$J$I$N%3%^%s%I$O$9$Y$F(B
+$B?t<0%b!<%I$G$7$+;H$($J$$$N$@$H$$$&$3$H$KCm0U$7$F$/$@$5$$!%$?$H$(L?Na$,(B
+$B?t<04D6-$NCf$K$"$C$?$H$7$F$b!$(Bbox$B$r@8@.$9$kL?Na$N0z?t$r=hM}$7$O$8$a$?(B
+$B;~E@$G$O!$(BTeX$B$O$^$@?t<0%b!<%I$KF~$C$F$$$J$$$N$G$9!%$^$?!$$3$N%(%i!<$O!$(B
+$B?t<0%b!<%ICf$G(BTeX$B$,6u9T$r8!=P$7$?>l9g$K$b@8$8$^$9!%(B")
+
+ ("Not a letter." .
+"\\hyphenation$BL?Na$N0z?t$NCf$K$J$K$+@5$7$/$J$$$b$N$,$"$j$^$9!%(B")
+
+ ("Paragraph ended before [^ ]* was complete." .
+"$BL?Na$N0z?t$NCf$KIT@5$J6u9T$,F~$C$F$7$^$C$F$$$^$9!%$*$=$i$/0z?t$N=*$o$j(B
+$B$KJD$83g8L$r$D$1$k$N$rK:$l$?$N$G$7$g$&!%(B")
+
+ ("\\\\[^ ]*font [^ ]* is undefined .*" .
+"$B$3$N%(%i!<$O$"$^$j0lHLE*$G$J$$%U%)%s%H$,?t<0%b!<%I$G;H$o$l$?;~$K@8$8(B
+$B$^$9!%Nc$($P!$5SCm$NCf$N?t<0$G(B\\sc$BL?Na$,;H$o$l$k$H!$(Bfootnotesize$B$N(B
+small
caps$B%U%)%s%H$,8F$S$@$5$l$k$3$H$K$J$j$^$9!%$3$NLdBj$O(B\\load$BL?Na$r(B
+$B;H$($P2r7h$G$-$^$9!%(B")
+
+ ("Font .* not found." .
+"$BL$CN$N(Bfamily/series/shape/size$B$NAH$_9g$o$;$N%U%)%s%H$,;XDj$5$l$^$7$?!%(B
+$B$3$N%(%i!<$,5/$-$k%1!<%9$O(B2$B$D9M$($i$l$^$9!%(B
+ 1) \\size$B%^%/%m$G;H$($J$$%5%$%:$rA*Br$7$h$&$H$7$?!%(B
+ 2) $B$=$&$G$J$1$l$P!$4IM}<T$N$H$3$m$K9T$C$F!$%U%)%s%HA*Br%F!<%V%k$,(B
+ $BIe$C$F$$$k$HJ86g$r$D$1$F$d$j$^$7$g$&(B!")
+
+ ("TeX capacity exceeded, sorry .*" .
+"TeX$B$,%a%b%j$r;H$$$-$C$F$7$^$$!$<B9T$rCfCG$7$^$7$?!%$7$+$7!$92$F$J$$$G(B
+$B$/$@$5$$!%$3$N%(%i!<$,@8$8$?860x$O!$$?$V$s!$(BTeX$B$K$"$J$?$NJ8=q$r=hM}$G(B
+$B$-$k$@$1$NG=NO$,$J$$$+$i$G$O$"$j$^$;$s!%(BTeX$B$K%a%b%j$r;H$$$-$i$;$?860x(B
+$B$O!$$*$=$i$/F~NO$7$?%U%!%$%k$NA0$NJ}$G@8$8$?%(%i!<$G$9!%$"$J$?$,K\Ev$K(B
+TeX$B$NMFNL$rD6$($?$3$H$r$7$h$&$H$7$?$N$+$I$&$+!$$=$7$F$=$N>l9g$I$&$9$l(B
+$B$P$$$$$N$+$rH=CG$9$kJ}K!$r0J2<$K@bL@$7$^$9!%$b$7LdBj$,F~NO%U%!%$%kCf$N(B
+$B%(%i!<$K$"$k>l9g$O!$8D!9$N%(%i!<$r2r7h$7$F$$$/J}K!$r$H$k$N$,$h$$$G$7$g(B
+$B$&!%(BLaTeX$B$,C;$$%U%!%$%k$G%a%b%j$r;H$$$-$k$3$H$O$a$C$?$K$"$j$^$;$s$+$i!$(B
+$B%(%i!<$N5/$-$?0LCV$h$jA0$K=hM}$7$?%Z!<%8$,?t%Z!<%8$7$+$J$1$l$P!$$^$:4V(B
+$B0c$$$J$/F~NO%U%!%$%k$KLdBj$,$"$k$O$:$G$9!%(B
+
+$B%(%i!<%a%C%;!<%8$N:G8e$K!$(BTeX$B$,;H$$$-$C$F$7$^$C$?%a%b%j$N<oN`$,<($5$l(B
+$B$F$$$^$9!%$=$l$i$N$&$A0lHLE*$J$b$N$K$D$$$F!$9M$($i$l$k860x$r0J2<$K5s$2(B
+$B$^$9!%(B
+
+buffer size
+===========
+$B>O@a!&(B\\caption$B!&(B\\addcontentsline$B$"$k$$$O(B\\addtocontents$BL?Na$N0z?t$H(B
+$B$7$FM?$($?%F%-%9%H$,D9$9$.$k>l9g$K@8$8$k$3$H$,$"$j$^$9!%$3$N%(%i!<$O(B
+$B$?$$$F$$(B\\end{document}$B$r=hM}$7$F$$$k;~$K@8$8$^$9$,!$(B\\tableofcontents$B!&(B
+\\listoffigures$B$"$k$$$O(B\\listoftables$BL?Na$r<B9T$7$F$$$k>l9g$K$b5/$-$k(B
+$B$3$H$,$"$j$^$9!%$3$NLdBj$r2r7h$9$k$K$O!$$b$C$HC;$$%F%-%9%H$r%*%W%7%g%s(B
+$B0z?t$H$7$FM?$($F$/$@$5$$!%L\<!$d?^I=0lMw$r:n@.$7$F$b!$8+=P$7$,D9$9$.$k(B
+$B$HFI$_$K$/$/$J$k$O$:$G$9!%(B
+
+exception dictionary
+====================
+TeX$B$,;}$C$F$$$kNN0h0J>e$K%O%$%U%M!<%7%g%s>pJs$rM?$($h$&$H$7$F$$$^$9!%(B
+$B$"$^$j;H$o$J$$C18l$N(B\\hyphenation$BL?Na$r<h$j=|$$$F!$Be$o$j$K(B\\-$BL?Na$r;H$C(B
+$B$F$/$@$5$$!%(B
+
+hash size
+=========
+$BL?NaL>$NDj5A$^$?$OAj8_;2>H%i%Y%k$NDj5A$,B?$9$.$^$9!%(B
+
+input stack size
+================
+$B$3$N%(%i!<$O$*$=$i$/L?NaDj5ACf$N8m$j$K$h$k$b$N$G$9!%Nc$($P!$<!$NL?Na$O(B
+$B:F5"E*Dj5A$H$J$C$F$*$j!$<+J,<+?H$r;H$C$F(B\\gnu$B$rDj5A$7$F$$$^$9!%(B
+
+ \\newcommand{\\gnu}{a \\gnu} % $B$3$l$O$@$a(B
+
+$B$3$N(B\\gnu$BL?Na$r8+$D$1$k$H(BTeX$B$O(B\\gnu$B$,2?$r$&$_$@$9$N$+$r7hDj$7$h$&$H$7(B
+$B$F$=$NKvHx$r$$$D$^$G$bDI$$$D$E$1!$$d$,$F(B``input
stack''$B$r;H$$$-$C$F$7(B
+$B$^$$$^$9!%(B
+
+main memory size
+================
+$B$3$l$O!$(BTeX$B$,C;$$%U%!%$%k$r=hM}$7$F$$$k;~$K;H$$$-$k2DG=@-$N$"$k%a%b%j(B
+$B$N$R$H$D$G$9!%(Bmain
memory$B$r;H$$$-$k$N$O<!$N(B3$B$D$N>l9g$N$$$:$l$+$G$9!%(B
+\(1\)$BHs>o$KD9$/J#;($JL?Na$r?tB?$/Dj5A$7$?!%(B(2)index$B$^$?$O(Bglossary$B$r:n$C(B
+$B$F$$$k$H$-!$(B1$B%Z!<%8Cf$K$"$^$j$K$bB?$/$N(B\\index$B$^$?$O(B\\glossary$BL?Na$,$"(B
+$B$k!%(B(3)$B@8@.$N$?$a$N>pJs$r(BTeX$B$,J];}$7$-$l$J$$$h$&$J!$$"$^$j$K$bJ#;($J%Z!<(B
+$B%8$r@8@.$7$h$&$H$7$?!%:G=i$N(B2$B$D$NLdBj$N2r7hJ}K!$OL@$i$+$G$9!%L?NaDj5A(B
+$B$N?t$"$k$$$O(B\\index$B!&(B\\glossary$BL?Na$N?t$r8:$i$9$3$H$G$9!%(B3$BHVL\$NLdBj$O(B
+$B$A$g$C$HLq2p$G$9!%$3$l$O!$Bg$-$J(Btabbing$B!&(Btabular$B!&(Barray$B!&(Bpicture$B4D6-$N(B
+$B$;$$$G@8$8$k$3$H$,$"$j$^$9!%=PNO0LCV$,7hDj$5$l$k$N$rBT$C$F$$$k?^$dI=$G(B
+TeX$B$N%a%b%j$,$$$C$Q$$$K$J$C$F$$$k$N$+$b$7$l$^$;$s!%K\Ev$K(BTeX$B$NMFNL$rD6(B
+$B$($F$7$^$C$?$N$+$I$&$+D4$Y$k$?$a$K$O!$%(%i!<$N5/$3$C$?>l=j$ND>A0$K(B
+\\clearpage$BL?Na$rF~$l$F$b$&0lEY%3%s%Q%$%k$r<B9T$7$F$_$F$/$@$5$$!%$b$7(B
+$B$=$l$G$b%a%b%j$,B-$j$J$/$J$k$h$&$J$i!$$J$s$i$+$N<jCJ$r9V$8$kI,MW$,$"$j(B
+$B$^$9!%(BTeX$B$,%Z!<%8$r@ZCG$9$k$+$I$&$+7hDj$9$k$?$a$K$OCJMnA4BN$r=hM}$7$J(B
+$B$1$l$P$J$i$J$$$H$$$&$3$H$r;W$$$@$7$F$/$@$5$$!%CJMn$NESCf$K(B\\newpage$BL?(B
+$BNa$rF~$l$l$P!$CJMn$N;D$j$r=hM}$9$kA0$K:#$N%Z!<%8$r(BTeX$B$K=PNO$5$;$k$3$H(B
+$B$GM>M5$,$G$-$k$+$b$7$l$^$;$s(B(\\pagebreak$BL?Na$G$O$@$a$G$9(B)$B!%$b$7?^$dI=(B
+$B$,N/$^$C$F$$$k$3$H$,LdBj$J$N$J$i$P!$?^I=$r$b$C$H8e$m$NJ}$K0\F0$9$k$H$+!$(B
+$B$"$k$$$O$b$C$HA0$N;~E@$G=PNO$5$l$k$h$&$K$9$l$P2sHr$G$-$^$9!%$b$7$^$@J8(B
+$B=q$r:n@.$7$F$$$kESCf$J$i!$$H$j$"$($:(B\\clearpage$BL?Na$rF~$l$F$*$$$F!$:G(B
+$B=*HG$r:n$k;~$^$G$3$NLdBj$OC*>e$2$7$F$*$-$^$7$g$&!%F~NO%U%!%$%k$,JQ$o$k(B
+$B$HLdBj$,2r>C$5$l$k>l9g$b$"$k$N$G$9!%(B
+
+pool size
+=========
+$BAj8_;2>H$N(B\\label$B$,B?$9$.$k$+!$L?Na$NDj5A$,B?$9$.$k$+$N$I$A$i$+$G$9!%(B
+$B@53N$K$$$($P!$Dj5A$7$?%i%Y%kL>$*$h$SL?NaL>$K;H$C$?J8;z?t$,B?$9$.$k$H$$(B
+$B$&$3$H$G$9!%$G$9$+$i!$$b$C$HC;$$L>A0$r;H$($P$3$NLdBj$O2r7h$7$^$9!%$?$@(B
+$B$7!$$3$N%(%i!<$O!$(B\\setcounter$B$J$I$N%+%&%s%?L?Na$d(B\\newenvironment$B!&(B
+\\newtheorem$BL?Na$N0z?t$N=*$o$j$r<($91&3g8L$rK:$l$?>l9g$K$b@8$8$^$9!%(B
+
+save size
+=========
+$B$3$N%(%i!<$O!$@k8@$NM-8zHO0O$dL?Na!&4D6-$,$"$^$j$K$b?<$/F~$l;R$K$J$C$F(B
+$B$$$k>l9g$K@8$8$^$9!%$?$H$($P!$(B\\multiput$BL?Na$N0z?t$K(Bpicture$B4D6-$,$"$j!$(B
+$B$=$N$J$+$K(B\\footnotesize$B@k8@$,$"$j!$$=$N@k8@$NM-8zHO0O$K(B\\multiput$BL?Na(B
+$B$,$"$C$F!$$=$N0z?t$K(B... $B$H$$$&$h$&$J>l9g$G$9!%(B")
+
+ ("Text line contains an invalid character." .
+"$BF~NOCf$KIT@5$JJ8;z$,4^$^$l$F$$$^$9!%%U%!%$%k:n@.$N8m$j$K$h$C$F%F%-%9%H(B
+$B%(%G%#%?$,$3$NJ8;z$rA^F~$7$F$7$^$C$?$N$G$7$g$&!%<B:]$K2?$,5/$-$?$N$+$O(B
+$B%(%G%#%?$K$h$j$^$9!%F~NO%U%!%$%k$rD4$Y$F$_$F!$;XE&$5$l$?J8;z$,8+$D$+$i(B
+$B$J$$>l9g$K$O%m!<%+%k%,%$%I$r8+$F$/$@$5$$!%(B")
+
+ ("Undefined control sequence." .
+"TeX$B$,L$Dj5A$NL?NaL>$rH/8+$7$^$7$?!%$*$=$i$/F~NO$N8m$j$G$7$g$&!%$b$7$3(B
+$B$N%(%i!<$,(BLaTeX$BL?Na$N=hM}Cf$K@8$8$?>l9g$O!$$=$NL?Na$O4V0c$C$?0LCV$KCV$+(B
+$B$l$F$$$^$9!%Nc$($P!$%j%9%H4D6-$NCf$G$J$$$N$K(B\\item$BL?Na$,;H$o$l$?>l9g$J$I(B
+$B$G$9!%$^$?!$(B\\documentclass$BL?Na$,$J$$>l9g$K$b$3$N%(%i!<$,@8$8$^$9!%(B")
+
+ ("Use of [^ ]* doesn't match its definition." .
+"$B$*$=$i$/IA2h$N$?$a$NL?Na$@$H;W$o$l$^$9$,!$0z?t$N;H$$$+$?$,4V0c$C$F$$(B
+$B$^$9!%4V0c$C$F$$$k$N$,(B\\@array$BL?Na$N>l9g$O!$(Barray$B4D6-$+(Btabular$B4D6-$G$N(B
+@$BI=8=$N0z?t$K$J$K$+8m$j$,$"$k$N$G$7$g$&!%(Bfragile$B$JL?Na$,(B\\protect$B$5$l$F(B
+$B$$$J$$$N$+$b$7$l$^$;$s!%(B")
+
+ ("You can't use `macro parameter character \\#' in [^ ]* mode." .
+"$BFC<lJ8;z(B#$B$,IaDL$N%F%-%9%H$NCf$K8=$l$^$7$?!%$*$=$i$/(B\\#$B$H=q$-$?$+$C$?(B
+$B$N$G$7$g$&!%(B")
+
+ ("Overfull \\\\hbox .*" .
+"$B9TJ,3d$N$?$a$NE,@Z$J>l=j$,8+$D$+$i$J$+$C$?$N$G!$(B1$B9T$K<}$^$k$Y$-J,NL0J>e(B
+$B$N=PNO$,9T$J$o$l$F$7$^$$$^$7$?!%(B")
+
+ ("Overfull \\\\vbox .*" .
+"$B%Z!<%8J,3d$N$?$a$NE,@Z$J>l=j$,8+$D$+$i$J$+$C$?$N$G!$(B1$B%Z!<%8$K<}$^$k$Y$-(B
+$BJ,NL0J>e$N=PNO$,9T$J$o$l$F$7$^$$$^$7$?!%(B")
+
+ ("Underfull \\\\hbox .*" .
+"$BM>J,$J?bD>%9%Z!<%9$,$J$$$+$I$&$+=PNO$r3N$+$a$F$/$@$5$$!%$b$7$"$l$P!$$=(B
+$B$l$O(B\\\\$BL?Na$^$?$O(B\\newline$BL?Na$K4X78$9$kLdBj$N$?$a$K@8$8$?$b$N$G$9!%Nc(B
+$B$($P(B2$B$D$N(B\\\\$BL?Na$,B3$$$F$$$k>l9g$J$I$G$9!%$3$N7Y9p$O(Bsloppypar$B4D6-$d(B
+\\sloppy$B@k8@$N;HMQ!$$"$k$$$O(B\\linebreak$BL?Na$NA^F~$J$I$K$h$k>l9g$b$"$j$^$9!%(B")
+
+ ("Underfull \\\\vbox .*" .
+"$B%Z!<%8$rJ,3d$9$k$?$a$NE,@Z$J>l=j$,8+$D$1$i$l$:!$==J,$J%F%-%9%H$N$J$$(B
+$B%Z!<%8$,$G$-$F$7$^$$$^$7$?!%(B")
+
+;; New list items should be placed here
+;;
+;; ("err-regexp" . "context")
+;;
+;; the err-regexp item should match anything
+
+ (".*" . "$B$4$a$s$J$5$$!%3:Ev$9$k%X%k%W%a%C%;!<%8$,$"$j$^$;$s!%(B"))))
+
+(provide 'tex-jp)
+
+;;; tex-jp.el ends here
diff --git a/tests/auctex-11.87.7/tex-mik.el b/tests/auctex-11.87.7/tex-mik.el
new file mode 100644
index 0000000..4197df5
--- /dev/null
+++ b/tests/auctex-11.87.7/tex-mik.el
@@ -0,0 +1,71 @@
+;;; tex-mik.el --- MiKTeX support for AUCTeX.
+
+;; Copyright (C) 1999, 2000, 2001, 2004 Free Software Foundation, Inc.
+
+;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
+;; Maintainer: auctex-devel@gnu.org
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+;;
+;; This file contains variables customized for MiKTeX.
+
+;;; Code:
+
+ ;; Remove the Queue entry from the default, and make a non-Unix
+ ;; specific print entry, assuming that we'll print via gsview32.
+(unless (get 'TeX-queue-command 'saved-value)
+ (setq TeX-queue-command nil))
+
+(unless (get 'TeX-printer-list 'saved-value)
+ (setq TeX-printer-list nil))
+
+(unless (get 'TeX-print-command 'saved-value)
+ (setq TeX-print-command
+ "start \"\" %f"))
+
+(unless (get 'TeX-view-style 'saved-value)
+ (setq TeX-view-style '(("^epsf$" "start \"\" %f")
+ ("." "yap -1 %dS %d"))))
+
+(unless (get 'TeX-output-view-style 'saved-value)
+ (setq TeX-output-view-style
+ '(("^dvi$" "^pstricks$\\|^pst-\\|^psfrag$" "dvips %d -o && start \"\"
%f")
+ ("^dvi$" "." "yap -1 %dS %d")
+ ("^pdf$" "." "start \"\" %o")
+ ("^html?$" "." "start \"\" %o"))))
+
+(unless (get 'TeX-source-specials-view-position-flags 'saved-value)
+ (setq TeX-source-specials-view-position-flags "-s %n%b"))
+
+;; Yap does not support a command line option for inverse searching.
+;; The editor command has to be configured inside Yap in
+;; "View/Options/Inverse Search" instead.
+(unless (get 'TeX-source-specials-view-editor-flags 'saved-value)
+ (setq TeX-source-specials-view-editor-flags ""))
+
+;; kpsewhich in MiKTeX (aka findtexmf) does not emit any useful
+;; information if fed with kpathsea-related variables anyway.
+(unless (get 'TeX-kpathsea-path-delimiter 'saved-value)
+ (setq TeX-kpathsea-path-delimiter nil))
+
+(provide 'tex-mik)
+
+;;; tex-mik.el ends here
diff --git a/tests/auctex-11.87.7/tex-site.el b/tests/auctex-11.87.7/tex-site.el
new file mode 100644
index 0000000..a342055
--- /dev/null
+++ b/tests/auctex-11.87.7/tex-site.el
@@ -0,0 +1,172 @@
+;;; tex-site.el - Site specific variables. Don't edit.
+
+;; Copyright (C) 2005, 2013, 2014 Free Software Foundation, Inc.
+;;
+;; completely rewritten.
+
+;; Author: David Kastrup <dak@gnu.org>
+;; Maintainer: auctex-devel@gnu.org
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; This file contains startup code, autoloads and variables adapted to
+;; the local site configuration. It is generated and placed by the
+;; installation procedure and should not be edited by hand, nor moved
+;; to a different place, as some settings may be established relative
+;; to the file.
+
+;; All user customization should be done with
+;; M-x customize-variable RET
+
+;;; Code:
+
+(if (< emacs-major-version 21)
+ (error "AUCTeX requires Emacs 21 or later"))
+
+;; Define here in order for `M-x customize-group <RET> AUCTeX <RET>'
+;; to work if the main AUCTeX files are not loaded yet.
+(defgroup AUCTeX nil
+ "A (La)TeX environment."
+ :tag "AUCTeX"
+ :link '(custom-manual "(auctex)Top")
+ :link '(url-link :tag "Home Page" "http://www.gnu.org/software/auctex/";)
+ :prefix "TeX-"
+ :group 'tex
+ :load "tex" :load "latex" :load "tex-style")
+
+(defvar TeX-lisp-directory
+ (file-name-directory load-file-name)
+ "The directory where most of the AUCTeX lisp files are located.
+For the location of lisp files associated with
+styles, see the variables TeX-style-* (hand-generated lisp) and
+TeX-auto-* (automatically generated lisp).")
+
+(add-to-list 'load-path TeX-lisp-directory)
+
+(defvar TeX-data-directory
+ (file-name-directory load-file-name)
+ "The directory where the AUCTeX non-Lisp data is located.")
+
+(defcustom TeX-auto-global
+ (if (file-writable-p "/usr/local/var/auctex") "/usr/local/var/auctex"
"~/.emacs.d/auctex")
+ "*Directory containing automatically generated information.
+Must end with a directory separator.
+
+For storing automatic extracted information about the TeX macros
+shared by all users of a site."
+ :group 'TeX-file
+ :type 'directory)
+
+(defconst TeX-mode-alist
+ '((tex-mode . tex-mode)
+ (plain-tex-mode . tex-mode)
+ (texinfo-mode . texinfo)
+ (latex-mode . tex-mode)
+ (doctex-mode . tex-mode))
+ "Alist of built-in TeX modes and their load files.")
+
+(defalias 'TeX-load-hack 'ignore)
+
+(add-hook 'tex-site-unload-hook
+ (lambda ()
+ (let ((list after-load-alist))
+ (while list
+ ;; Adapted copy of the definition of `assq-delete-all'
+ ;; from Emacs 21 as substitute for
+ ;; `(assq-delete-all'TeX-modes-set (car list))' which
+ ;; fails on non-list elements in Emacs 21.
+ (let* ((alist (car list))
+ (tail alist)
+ (key 'TeX-modes-set))
+ (while tail
+ (if (and (consp (car tail))
+ (eq (car (car tail)) key))
+ (setq alist (delq (car tail) alist)))
+ (setq tail (cdr tail))))
+ (setq list (cdr list))))
+ (setq load-path (delq TeX-lisp-directory load-path))))
+
+(defun TeX-modes-set (var value &optional update)
+ "Set VAR (which should be `TeX-modes') to VALUE.
+
+This places either the standard or the AUCTeX versions of
+functions into the respective function cell of the mode.
+If UPDATE is set, a previously saved value for
+the non-AUCTeX function gets overwritten with the current
+definition."
+ (custom-set-default var value)
+ (let ((list TeX-mode-alist) elt)
+ (while list
+ (setq elt (car (pop list)))
+ (let ((dst (intern (concat "TeX-" (symbol-name elt)))))
+ (if (fboundp 'advice-add)
+ (if (memq elt value)
+ (advice-add elt :override dst)
+ (advice-remove elt dst))
+ (when (or update (null (get elt 'tex-saved)))
+ (when (fboundp elt)
+ (put elt 'tex-saved (symbol-function elt))))
+ (defalias elt
+ (if (memq elt value)
+ dst
+ (get elt 'tex-saved))))))))
+
+(defcustom TeX-modes
+ (mapcar 'car TeX-mode-alist)
+ "List of modes provided by AUCTeX.
+
+This variable can't be set normally; use customize for that, or
+set it with `TeX-modes-set'."
+ :type (cons 'set
+ (mapcar (lambda(x) (list 'const (car x))) TeX-mode-alist))
+ :set 'TeX-modes-set
+ :group 'AUCTeX
+ :initialize (lambda (var value)
+ (custom-initialize-reset var value)
+ (unless (fboundp 'advice-add)
+ (let ((list TeX-mode-alist))
+ (while list
+ (eval-after-load (cdar list)
+ `(TeX-modes-set ',var ,var t))
+ (setq list (cdr list)))))))
+
+(defconst AUCTeX-version "11.87.2012-12-04"
+ "AUCTeX version.
+If not a regular release, the date of the last change.")
+
+(defconst AUCTeX-date "2012-12-04"
+ "AUCTeX release date using the ISO 8601 format, yyyy-mm-dd.")
+
+;; Store bibitems when saving a BibTeX buffer
+(add-hook 'bibtex-mode-hook 'BibTeX-auto-store)
+
+;;; Code specific to ELPA packaging:
+
+;; From preview-latex.el:
+
+(defvar preview-TeX-style-dir
+ (expand-file-name "latex" (file-name-directory load-file-name)))
+
+;;; Ensure that loading the autoloads file also loads this file.
+;;;###autoload (require 'tex-site)
+
+(provide 'tex-site)
+;;; tex-site.el ends here
diff --git a/tests/auctex-11.87.7/tex-style.el
b/tests/auctex-11.87.7/tex-style.el
new file mode 100644
index 0000000..1c91168
--- /dev/null
+++ b/tests/auctex-11.87.7/tex-style.el
@@ -0,0 +1,374 @@
+;;; tex-style.el --- Customizable variables for AUCTeX style files
+
+;; Copyright (C) 2005 Free Software Foundation, Inc.
+
+;; Author: Reiner Steib <Reiner.Steib@gmx.de>
+;; Keywords: tex, wp, convenience
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Commentary:
+
+;; This file provides customizable variables for AUCTeX style files.
+
+;;; Code:
+
+(defgroup LaTeX-style nil
+ "Support for special LaTeX style files in AUCTeX."
+ :group 'LaTeX-macro)
+
+;; Note: We don't have any defcustom in plain TeX style files yet. Else we
+;; should also create a TeX-style group.
+
+;; style/amsmath.el
+
+(defcustom LaTeX-amsmath-label nil
+ "Default prefix to amsmath equation labels.
+
+Amsmath equations include \"align\", \"alignat\", \"xalignat\",
+\"multline\", \"flalign\" and \"gather\". If it is nil,
+`LaTeX-equation-label' is used."
+ :group 'LaTeX-label
+ :type '(choice (const :tag "Use `LaTeX-equation-label'" nil)
+ (string)))
+
+;; style/beamer.el
+
+(defcustom LaTeX-beamer-section-labels-flag nil
+ "If non-nil section labels are added"
+ :type 'boolean
+ :group 'LaTeX-style)
+
+(defcustom LaTeX-beamer-item-overlay-flag t
+ "If non-nil do prompt for an overlay in itemize-like environments."
+ :type 'boolean
+ :group 'LaTeX-style)
+
+(defcustom LaTeX-beamer-themes 'local
+ "Presentation themes for the LaTeX beamer package.
+It can be a list of themes or a function. If it is the symbol
+`local', search only once per buffer."
+ :group 'LaTeX-style
+ :type
+ '(choice
+ (const :tag "TeX search" LaTeX-beamer-search-themes)
+ (const :tag "Search once per buffer" local)
+ (function :tag "Other function")
+ (list
+ :value
+ ;; Work around (bug in customize?), see
+ ;; <news:v9is48jrj1.fsf@marauder.physik.uni-ulm.de>
+ ("Antibes" "Bergen" "Berkeley" "Berlin" "Boadilla" "Copenhagen"
+ "Darmstadt" "Dresden" "Frankfurt" "Goettingen" "Hannover"
+ "Ilmenau" "JuanLesPins" "Luebeck" "Madrid" "Malmoe" "Marburg"
+ "Montpellier" "PaloAlto" "Pittsburgh" "Rochester" "Singapore"
+ "Szeged" "Warsaw")
+ (set :inline t
+ (const "Antibes")
+ (const "Bergen")
+ (const "Berkeley")
+ (const "Berlin")
+ (const "Boadilla")
+ (const "Copenhagen")
+ (const "Darmstadt")
+ (const "Dresden")
+ (const "Frankfurt")
+ (const "Goettingen")
+ (const "Hannover")
+ (const "Ilmenau")
+ (const "JuanLesPins")
+ (const "Luebeck")
+ (const "Madrid")
+ (const "Malmoe")
+ (const "Marburg")
+ (const "Montpellier")
+ (const "PaloAlto")
+ (const "Pittsburgh")
+ (const "Rochester")
+ (const "Singapore")
+ (const "Szeged")
+ (const "Warsaw"))
+ (repeat :inline t
+ :tag "Other"
+ (string)))))
+
+(defcustom LaTeX-beamer-inner-themes 'local
+ "Presentation inner themes for the LaTeX beamer package.
+It can be a list of themes or a function. If it is the symbol
+`local', search only once per buffer."
+ :group 'LaTeX-style
+ :type '(choice
+ (const :tag "TeX search" LaTeX-beamer-search-inner-themes)
+ (const :tag "Search once per buffer" local)
+ (function :tag "Other function")
+ (list
+ :value ("circles" "default" "inmargin" "rectangles" "rounded")
+ (set :inline t
+ (const "circles")
+ (const "default")
+ (const "inmargin")
+ (const "rectangles")
+ (const "rounded"))
+ (repeat :inline t
+ :tag "Other"
+ (string)))))
+
+(defcustom LaTeX-beamer-outer-themes 'local
+ "Presentation outer themes for the LaTeX beamer package.
+It can be a list of themes or a function. If it is the symbol
+`local', search only once per buffer."
+ :group 'LaTeX-style
+ :type
+ '(choice
+ (const :tag "TeX search" LaTeX-beamer-search-outer-themes)
+ (const :tag "Search once per buffer" local)
+ (function :tag "Other function")
+ (list
+ :value
+ ("default" "infolines" "miniframes" "shadow" "sidebar" "smoothbars"
+ "smoothtree" "split" "tree")
+ (set :inline t
+ (const "default")
+ (const "infolines")
+ (const "miniframes")
+ (const "shadow")
+ (const "sidebar")
+ (const "smoothbars")
+ (const "smoothtree")
+ (const "split")
+ (const "tree"))
+ (repeat :inline t
+ :tag "Other"
+ (string)))))
+
+(defcustom LaTeX-beamer-color-themes 'local
+ "Presentation color themes for the LaTeX beamer package.
+It can be a list of themes or a function. If it is the symbol
+`local', search only once per buffer."
+ :group 'LaTeX-style
+ :type
+ '(choice
+ (const :tag "TeX search" LaTeX-beamer-search-color-themes)
+ (const :tag "Search once per buffer" local)
+ (function :tag "Other function")
+ (list
+ :value
+ ("albatross" "beetle" "crane" "default" "dolphin" "dove" "fly" "lily"
+ "orchid" "rose" "seagull" "seahorse" "sidebartab" "structure" "whale")
+ (set :inline t
+ (const "albatross")
+ (const "beetle")
+ (const "crane")
+ (const "default")
+ (const "dolphin")
+ (const "dove")
+ (const "fly")
+ (const "lily")
+ (const "orchid")
+ (const "rose")
+ (const "seagull")
+ (const "seahorse")
+ (const "sidebartab")
+ (const "structure")
+ (const "whale"))
+ (repeat :inline t
+ :tag "Other"
+ (string)))))
+
+(defcustom LaTeX-beamer-font-themes 'local
+ "Presentation font themes for the LaTeX beamer package.
+It can be a list of themes or a function. If it is the symbol
+`local', search only once per buffer."
+ :group 'LaTeX-style
+ :type
+ '(choice
+ (const :tag "TeX search" LaTeX-beamer-search-font-themes)
+ (const :tag "Search once per buffer" local)
+ (function :tag "Other function")
+ (list
+ :value
+ ("default" "professionalfonts" "serif" "structurebold"
+ "structureitalicserif" "structuresmallcapsserif")
+ (set :inline t
+ (const "default")
+ (const "professionalfonts")
+ (const "serif")
+ (const "structurebold")
+ (const "structureitalicserif")
+ (const "structuresmallcapsserif"))
+ (repeat :inline t
+ :tag "Other"
+ (string)))))
+
+;; style/biblatex.el
+
+(defcustom LaTeX-biblatex-use-Biber t
+ "Whether to use Biber with biblatex."
+ :type 'boolean
+ :group 'LaTeX-style)
+
+;; style/comment.el
+
+(defcustom LaTeX-comment-env-list '("comment")
+ "List of environment names defined with comment.sty.
+Setting this variable does not take effect unless you
+reinitialize affected buffers."
+ :type '(repeat string)
+ :group 'LaTeX-style)
+
+;; style/csquotes.el
+
+(defcustom LaTeX-csquotes-quote-after-quote nil
+ "Initial value of `TeX-quote-after-quote' for `csquotes.el'"
+ :type 'boolean
+ :group 'LaTeX-style)
+
+(defcustom LaTeX-csquotes-open-quote ""
+ "Opening quotation mark to be used with the csquotes package.
+The specified string will be used for `TeX-open-quote' (and override
+any language-specific setting) only if both `LaTeX-csquotes-open-quote'
+and `LaTeX-csquotes-close-quote' are non-empty strings."
+ :type 'string
+ :group 'LaTeX-style)
+
+(defcustom LaTeX-csquotes-close-quote ""
+ "Closing quotation mark to be used with the csquotes package.
+The specified string will be used for `TeX-close-quote' (and override
+any language-specific setting) only if both `LaTeX-csquotes-open-quote'
+and `LaTeX-csquotes-close-quote' are non-empty strings."
+ :type 'string
+ :group 'LaTeX-style)
+
+;; style/emp.el
+
+(defcustom LaTeX-write18-enabled-p t
+ "*If non-nil, insert automatically the \\write18 calling metapost.
+When disabled, you have to use mpost on the mp files automatically
+produced by emp.sty and then re-LaTeX the document."
+ :type 'boolean
+ :group 'LaTeX-style)
+
+;; style/graphicx.el
+
+(defcustom LaTeX-includegraphics-extensions
+ '("eps" "jpe?g" "pdf" "png")
+ "Extensions for images files used by \\includegraphics."
+ :group 'LaTeX-style
+ :type '(list (set :inline t
+ (const "eps")
+ (const "jpe?g")
+ (const "pdf")
+ (const "png"))
+ (repeat :inline t
+ :tag "Other"
+ (string))))
+
+(defcustom LaTeX-includegraphics-options-alist
+ '((0 width)
+ ;; (1 width height clip)
+ ;; (2 width height keepaspectratio clip)
+ (4) ;; --> (4 nil)
+ (5 trim)
+ (16
+ ;; Table 1 in epslatex.ps: ``includegraphics Options''
+ height totalheight width scale angle origin bb
+ ;; Table 2 in epslatex.ps: ``cropping Options''
+ viewport trim
+ ;; Table 3 in epslatex.ps: ``Boolean Options''
+ ;; [not implemented:] noclip draft final
+ clip keepaspectratio
+ ;; Only for PDF:
+ page))
+ "Controls for which optional arguments of \\includegraphics you get prompted.
+
+An alist, consisting of \(NUMBER . LIST\) pairs. Valid elements of LIST are
+`width', `height', `keepaspectratio', `clip', `angle', `totalheight', `trim'
+and `bb' \(Bounding Box\).
+
+The list corresponding to 0 is used if no prefix is given. Note that 4 \(one
+\\[universal-argument]\) and 16 \(two \\[universal-argument]'s\) are easy to
+type and should be used for frequently needed combinations."
+ :group 'LaTeX-style
+ :type '(repeat (cons (integer :tag "Argument")
+ (list (set :inline t
+ (const height)
+ (const totalheight)
+ (const width)
+ (const scale)
+ (const angle)
+ (const origin)
+ (const :tag "Bounding Box" bb)
+ ;;
+ (const viewport)
+ (const trim)
+ ;;
+ (const clip)
+ (const keepaspectratio))))))
+
+(defcustom LaTeX-includegraphics-strip-extension-flag t
+ "Non-nil means to strip known extensions from image file name."
+ :group 'LaTeX-style
+ :type 'boolean)
+
+(defcustom LaTeX-includegraphics-read-file
+ 'LaTeX-includegraphics-read-file-TeX
+ "Function for reading \\includegraphics files.
+
+`LaTeX-includegraphics-read-file-TeX' lists all graphic files
+found in the TeX search path.
+
+`LaTeX-includegraphics-read-file-relative' lists all graphic files
+in the master directory and its subdirectories and inserts the
+relative file name. This option does not work with Emacs 21 or
+XEmacs.
+
+The custom option `simple' works as
+`LaTeX-includegraphics-read-file-relative' but it lists all kind of
+files.
+
+Inserting the subdirectory in the filename (as
+`LaTeX-includegraphics-read-file-relative') is discouraged by
+`epslatex.ps'."
+;; ,----[ epslatex.ps; Section 12; (page 26) ]
+;; | Instead of embedding the subdirectory in the filename, there are two
+;; | other options
+;; | 1. The best method is to modify the TeX search path [...]
+;; | 2. Another method is to specify sub/ in a \graphicspath command
+;; | [...]. However this is much less efficient than modifying the
+;; | TeX search path
+;; `----
+;; See "Inefficiency" and "Unportability" in the same section for more
+;; information.
+ :group 'LaTeX-style
+ :type '(choice (const :tag "TeX" LaTeX-includegraphics-read-file-TeX)
+ (const :tag "relative"
+ LaTeX-includegraphics-read-file-relative)
+ (const :tag "simple" (lambda ()
+ (file-relative-name
+ (read-file-name "Image file: ")
+ (TeX-master-directory))))
+ (function :tag "other")))
+
+;; style/shortvrb.el
+
+(defcustom LaTeX-shortvrb-chars '(?|)
+ "List of characters toggling verbatim mode."
+ :group 'LaTeX-style
+ :type '(repeat character))
+
+(provide 'tex-style)
+
+;;; tex-style.el ends here
diff --git a/tests/auctex-11.87.7/tex-wizard.el
b/tests/auctex-11.87.7/tex-wizard.el
new file mode 100644
index 0000000..f5badae
--- /dev/null
+++ b/tests/auctex-11.87.7/tex-wizard.el
@@ -0,0 +1,111 @@
+;;; tex-wizard.el --- Check the TeX configuration
+
+;; Copyright (C) 2003 Free Software Foundation, Inc.
+
+;; Author: David Kastrup <dak@gnu.org>
+;; Keywords: tex, wp, convenience
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Commentary:
+
+;; This checks through your TeX configuration. Call M-x TeX-wizard RET
+
+;;; Code:
+
+(defun TeX-wizard nil
+ (interactive)
+ (switch-to-buffer "*TeX wizard*")
+ (let ((wizwin (selected-window))
+ (wizbuf (current-buffer)))
+ (set-visited-file-name nil)
+ (erase-buffer)
+ (if (featurep 'tex-site)
+ (insert-before-markers "AUCTeX is enabled. Good.\n")
+ (insert-before-markers "\
+It appears that AUCTeX is not enabled. AUCTeX is the main
+major mode for editing TeX/LaTeX files.\n")
+ (condition-case nil
+ (info-other-window "(AUCTeX)")
+ (error (select-window wizwin)
+ (switch-to-buffer wizbuf)
+ (insert-before-markers "(I am unable to find AUCTeX's info
file.)\n")))
+ (if (prog1 (y-or-n-p "Should I try enabling AUCTeX now?")
+ (select-window wizwin)
+ (switch-to-buffer wizbuf))
+ (condition-case nil
+ (require 'tex-site)
+ (error (insert-before-markers "AUCTeX appears not to be
installed.\n")))
+ (insert-before-markers "AUCTeX installation imprudently skipped.\n"))
+ (when (featurep 'tex-site)
+ (when (prog1 (yes-or-no-p (format "Also enable AUCTeX in `%s'"
user-init-file))
+ (select-window wizwin)
+ (switch-to-buffer wizbuf))
+ (write-region "\
+;;; Enable AUCTeX
+\(require 'tex-site)\n" nil user-init-file t))))
+ (if (memq 'turn-on-reftex
+ (if (featurep 'tex-site)
+ (and (boundp 'LaTeX-mode-hook) LaTeX-mode-hook)
+ (and (boundp 'latex-mode-hook) latex-mode-hook)))
+ (insert-before-markers "RefTeX is enabled. Good.\n")
+ (insert-before-markers "\
+It appears that RefTeX is not enabled. RefTeX is a mode
+that will greatly facilitate the management of labels
+and bibliographics references.\n")
+ (condition-case nil
+ (info-other-window "(RefTeX)")
+ (error (select-window wizwin)
+ (switch-to-buffer wizbuf)
+ (insert-before-markers
+ "(I am unable to find RefTeX's info file.)\n")))
+ (when (prog1 (yes-or-no-p
+ (format "Enable RefTeX in `%s'" user-init-file))
+ (select-window wizwin)
+ (switch-to-buffer wizbuf))
+ (add-hook 'LaTeX-mode-hook 'turn-on-reftex)
+ (add-hook 'latex-mode-hook 'turn-on-reftex)
+ (condition-case nil
+ (write-region "\
+;;; Enable RefTeX
+\(add-hook 'LaTeX-mode-hook 'turn-on-reftex)
+\(add-hook 'latex-mode-hook 'turn-on-reftex)
+" nil user-init-file t)
+ (error (insert-before-markers
+ (format "Unable to write to file `%s'\n" user-init-file))))))
+ (when (and (featurep 'tex-site)
+ (boundp 'LaTeX-mode-hook)
+ (memq 'turn-on-reftex LaTeX-mode-hook))
+ (if (and (boundp 'reftex-plug-into-AUCTeX)
+ reftex-plug-into-AUCTeX)
+ (insert-before-markers
+ "RefTeX appears to be configured for use with AUCTeX.\n")
+ (require 'reftex)
+ (insert-before-markers "\
+It appears that RefTeX is not configured to cooperate with
+AUCTeX. Please configure it using the menus, save for future
+sessions, then press the finish button.")
+ (customize-variable-other-window 'reftex-plug-into-AUCTeX)
+ (set (make-local-variable 'custom-buffer-done-function)
+ (lambda (buff) (kill-buffer buff) (exit-recursive-edit)))
+ (recursive-edit)
+ (select-window wizwin)
+ (switch-to-buffer wizbuf))))
+ (insert-before-markers "That's all!\n"))
+
+
+(provide 'tex-wizard)
+;;; tex-wizard.el ends here
diff --git a/tests/auctex-11.87.7/tex.el b/tests/auctex-11.87.7/tex.el
new file mode 100644
index 0000000..3fde81e
--- /dev/null
+++ b/tests/auctex-11.87.7/tex.el
@@ -0,0 +1,5650 @@
+;;; tex.el --- Support for TeX documents.
+
+;; Copyright (C) 1985-1987, 1991, 1993, 1994, 1996, 1997, 1999-2012
+;; Free Software Foundation, Inc.
+
+;; Maintainer: auctex-devel@gnu.org
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+
+;; This file provides basic functions used by the AUCTeX modes.
+
+;;; Code:
+
+(when (< emacs-major-version 21)
+ (error "AUCTeX requires Emacs 21 or later"))
+
+(require 'custom)
+(require 'tex-site)
+(eval-when-compile
+ (require 'cl))
+
+(defun TeX--call-3/2 (f arg1 arg2 arg3)
+ (condition-case nil
+ (funcall f arg1 arg2 arg3)
+ (wrong-number-of-arguments (funcall f arg1 arg2))))
+
+(defgroup TeX-file nil
+ "Files used by AUCTeX."
+ :group 'AUCTeX)
+
+(defgroup TeX-command nil
+ "Calling external commands from AUCTeX."
+ :group 'AUCTeX)
+
+(defgroup LaTeX nil
+ "LaTeX support in AUCTeX."
+ :tag "LaTeX"
+ :group 'AUCTeX
+ :prefix "LaTeX-")
+
+(defgroup TeX-misc nil
+ "Various AUCTeX settings."
+ :group 'AUCTeX)
+
+;;; Site Customization
+;;
+;; The following variables are likely to need to be changed for your
+;; site. You should do this with customize.
+
+(defcustom TeX-command "tex"
+ "Command to run plain TeX."
+ :group 'TeX-command
+ :type 'string)
+
+(defcustom TeX-Omega-command "omega"
+ "Command to run plain TeX on Omega."
+ :group 'TeX-command
+ :type 'string)
+
+(defcustom LaTeX-command "latex"
+ "Command to run LaTeX."
+ :group 'TeX-command
+ :type 'string)
+
+(defcustom LaTeX-Omega-command "lambda"
+ "Command to run LaTeX on Omega."
+ :group 'TeX-command
+ :type 'string)
+
+(defcustom ConTeXt-engine nil
+ "Engine to use for --engine in the texexec command.
+If nil, none is specified."
+ :group 'TeX-command
+ :type '(choice (const :tag "Unspecified" nil)
+ string))
+
+(defcustom ConTeXt-Omega-engine TeX-Omega-command
+ "Engine to use for --engine in the texexec command in Omega mode.
+If nil, none is specified."
+ :group 'TeX-command
+ :type '(choice (const :tag "Unspecified" nil)
+ string))
+;; At least in TeXLive 2009 ConTeXt does not support an omega option anymore.
+(TeX--call-3/2 #'make-obsolete-variable 'ConTeXt-Omega-engine
+ 'TeX-engine-alist "before 11.86")
+
+(defcustom TeX-mode-hook nil
+ "A hook run in TeX mode buffers."
+ :type 'hook
+ :group 'TeX-misc)
+
+(defcustom AmS-TeX-mode-hook nil
+ "A hook run in AmS-TeX mode buffers."
+ :type 'hook
+ :group 'TeX-misc)
+
+;; This is the major configuration variable. Most sites will only
+;; need to change the second string in each entry, which is the name
+;; of a command to send to the shell. If you use other formatters
+;; like AMSLaTeX or AMSTeX, you can add those to the list. See
+;; TeX-expand-list for a description of the % escapes
+
+(defcustom TeX-command-list
+ `(("TeX" "%(PDF)%(tex) %`%S%(PDFout)%(mode)%' %t"
+ TeX-run-TeX nil
+ (plain-tex-mode ams-tex-mode texinfo-mode) :help "Run plain TeX")
+ ("LaTeX" "%`%l%(mode)%' %t"
+ TeX-run-TeX nil
+ (latex-mode doctex-mode) :help "Run LaTeX")
+ ;; Not part of standard TeX.
+ ("Makeinfo" "makeinfo %t" TeX-run-compile nil
+ (texinfo-mode) :help "Run Makeinfo with Info output")
+ ("Makeinfo HTML" "makeinfo --html %t" TeX-run-compile nil
+ (texinfo-mode) :help "Run Makeinfo with HTML output")
+ ("AmSTeX" "%(PDF)amstex %`%S%(PDFout)%(mode)%' %t"
+ TeX-run-TeX nil (ams-tex-mode) :help "Run AMSTeX")
+ ;; support for ConTeXt --pg
+ ;; first version of ConTeXt to support nonstopmode: 2003.2.10
+ ("ConTeXt" "texexec --once --texutil %(execopts)%t"
+ TeX-run-TeX nil (context-mode) :help "Run ConTeXt once")
+ ("ConTeXt Full" "texexec %(execopts)%t"
+ TeX-run-TeX nil
+ (context-mode) :help "Run ConTeXt until completion")
+ ("BibTeX" "bibtex %s" TeX-run-BibTeX nil t :help "Run BibTeX")
+ ("Biber" "biber %s" TeX-run-Biber nil t :help "Run Biber")
+ ,(if (or window-system (getenv "DISPLAY"))
+ '("View" "%V" TeX-run-discard-or-function t t :help "Run Viewer")
+ '("View" "dvi2tty -q -w 132 %s" TeX-run-command t t
+ :help "Run Text viewer"))
+ ("Print" "%p" TeX-run-command t t :help "Print the file")
+ ("Queue" "%q" TeX-run-background nil t :help "View the printer queue"
+ :visible TeX-queue-command)
+ ("File" "%(o?)dvips %d -o %f " TeX-run-command t t
+ :help "Generate PostScript file")
+ ("Index" "makeindex %s" TeX-run-command nil t :help "Create index file")
+ ("Check" "lacheck %s" TeX-run-compile nil (latex-mode)
+ :help "Check LaTeX file for correctness")
+ ("Spell" "(TeX-ispell-document \"\")" TeX-run-function nil t
+ :help "Spell-check the document")
+ ("Clean" "TeX-clean" TeX-run-function nil t
+ :help "Delete generated intermediate files")
+ ("Clean All" "(TeX-clean t)" TeX-run-function nil t
+ :help "Delete generated intermediate and output files")
+ ("Other" "" TeX-run-command t t :help "Run an arbitrary command"))
+ "List of commands to execute on the current document.
+
+Each element is a list, whose first element is the name of the command
+as it will be presented to the user.
+
+The second element is the string handed to the shell after being
+expanded. The expansion is done using the information found in
+`TeX-expand-list'.
+
+The third element is the function which actually start the process.
+Several such hooks has been defined:
+
+TeX-run-command: Start up the process and show the output in a
+separate buffer. Check that there is not two commands running for the
+same file. Return the process object.
+
+TeX-run-format: As `TeX-run-command', but assume the output is created
+by a TeX macro package. Return the process object.
+
+TeX-run-TeX: For TeX output.
+
+TeX-run-interactive: Run TeX or LaTeX interactively.
+
+TeX-run-BibTeX: For BibTeX output.
+
+TeX-run-Biber: For Biber output.
+
+TeX-run-compile: Use `compile' to run the process.
+
+TeX-run-shell: Use `shell-command' to run the process.
+
+TeX-run-discard: Start the process in the background, discarding its
+output.
+
+TeX-run-background: Start the process in the background, show output
+in other window.
+
+TeX-run-silent: Start the process in the background.
+
+TeX-run-discard-foreground: Start the process in the foreground,
+discarding its output.
+
+TeX-run-function: Execute the Lisp function or function call
+specified by the string in the second element. Consequently,
+this hook does not start a process.
+
+TeX-run-discard-or-function: If the command is a Lisp function,
+execute it as such, otherwise start the command as a process,
+discarding its output.
+
+To create your own hook, define a function taking three arguments: The
+name of the command, the command string, and the name of the file to
+process. It might be useful to use `TeX-run-command' in order to
+create an asynchronous process.
+
+If the fourth element is non-nil, the user will get a chance to
+modify the expanded string.
+
+The fifth element indicates in which mode(s) the command should be
+present in the Command menu. Use t if it should be active in any
+mode. If it should only be present in some modes, specify a list with
+the respective mode names.
+
+Any additional elements get just transferred to the respective menu entries."
+ :group 'TeX-command
+ :type '(repeat (group :value ("" "" TeX-run-command nil t)
+ (string :tag "Name")
+ (string :tag "Command")
+ (choice :tag "How"
+ :value TeX-run-command
+ (function-item TeX-run-command)
+ (function-item TeX-run-format)
+ (function-item TeX-run-TeX)
+ (function-item TeX-run-interactive)
+ (function-item TeX-run-BibTeX)
+ (function-item TeX-run-Biber)
+ (function-item TeX-run-compile)
+ (function-item TeX-run-shell)
+ (function-item TeX-run-discard)
+ (function-item TeX-run-background)
+ (function-item TeX-run-silent)
+ (function-item TeX-run-discard-foreground)
+ (function-item TeX-run-function)
+ (function-item TeX-run-discard-or-function)
+ (function :tag "Other"))
+ (boolean :tag "Prompt")
+ (choice :tag "Modes"
+ (const :tag "All" t)
+ (set (const :tag "Plain TeX" plain-tex-mode)
+ (const :tag "LaTeX" latex-mode)
+ (const :tag "DocTeX" doctex-mode)
+ (const :tag "ConTeXt" context-mode)
+ (const :tag "Texinfo" texinfo-mode)
+ (const :tag "AmSTeX" ams-tex-mode)))
+ (repeat :tag "Menu elements" :inline t sexp))))
+
+(defcustom TeX-command-output-list
+ '(
+; Add the following line if you want to use htlatex (tex4ht)
+; ("\\`htlatex" ("html"))
+ )
+ "List of regexps and file extensions.
+
+Each element is a list, whose first element is a regular expression to
+match against the name of the command that will be used to process the TeX
+file.
+
+The second element is either a string or a list with a string as element.
+If it is a string this is the default file extension that will be expected
+for output files that are produced by commands that match the first
+element. The real file extension will be obtained from the logging output
+if possible, defaulting to the given string.
+If it is a list, the element of the list will be the fixed extension used
+without looking at the logging output.
+
+If this list does not yield an extension, the default is either \"dvi\"
+or \"pdf\", depending on the setting of `TeX-PDF-mode'.
+Extensions must be given without the \".\"."
+
+ :group 'TeX-command
+ :type '(repeat (group (regexp :tag "Command Regexp")
+ (choice (string :tag "Default Extension")
+ (group (string :tag "Fixed Extension"))))))
+
+;; You may want to change the default LaTeX version for your site.
+(defcustom LaTeX-version "2e"
+ "Default LaTeX version. Currently recognized is \"2\" and \"2e\"."
+ :group 'LaTeX
+ :type '(radio (const :format "%v\n%h"
+ :doc "\
+The executable `latex' is LaTeX version 2."
+ "2")
+ (const :format "%v\n%h"
+ :doc "\
+The executable `latex' is LaTeX version 2e."
+ "2e")
+ (string :tag "Other")))
+
+
+;; Use different compilation commands depending on style.
+;; Only works if parsing is enabled.
+
+(defcustom LaTeX-command-style
+ ;; They have all been combined in LaTeX 2e.
+ '(("" "%(PDF)%(latex) %S%(PDFout)"))
+"List of style options and LaTeX commands.
+
+If the first element (a regular expression) matches the name of one of
+the style files, any occurrence of the string `%l' in a command in
+`TeX-command-list' will be replaced with the second element. The first
+match is used, if no match is found the `%l' is replaced with the empty
+string."
+ :group 'TeX-command
+ :type '(repeat (group :value ("" "")
+ regexp (string :tag "Style"))))
+
+;; Printing: If you want to print, TeX-print-command must be non-nil
+;; (if it is nil, you'll get a complaint when using the print menu).
+;; If you want to view the queue, TeX-queue-command needs to be
+;; non-nil (if it is nil, it won't get mentioned in the menu). If
+;; TeX-printer-list is nil, nothing else gets asked: the menu entries
+;; lead directly to the respective commands. If those commands
+;; contain %p, the value of TeX-printer-default gets inserted there,
+;; no questions asked. Now if TeX-printer-list is non-nil, you'll
+;; always get asked which printer you want to use. You can enter a
+;; configured printer from TeX-printer-list, or an unknown one. The
+;; respective menus will show all configured printers. Since you can
+;; enter unknown printers, the printer name _must_ be set with %p in
+;; TeX-print-command.
+
+(defcustom TeX-print-command
+ "{ test -e %s.dvi && %(o?)dvips -P%p %r %s; } || lpr -P%p %o"
+ "Command used to print a file.
+
+First `%p' is expanded to the printer name, then ordinary expansion is
+performed as specified in `TeX-expand-list'. If it is nil,
+then customization is requested."
+ :group 'TeX-command
+ :type '(choice (string :tag "Print command")
+ (const :tag "No print command customized" nil)))
+
+(defcustom TeX-queue-command "lpq -P%p"
+ "Command used to show the status of a printer queue.
+
+First `%p' is expanded to the printer name, then ordinary expansion is
+performed as specified in `TeX-expand-list'. If this is nil,
+the printer has no corresponding command."
+ :group 'TeX-command
+ :type '(choice (string :tag "Queue check command")
+ (const :tag "No such command" nil)))
+
+;; Enter the names of the printers available at your site, or nil if
+;; you only have one printer.
+
+(defcustom TeX-printer-list
+ '(("Default"
+ ;; Print to the (unnamed) default printer. If there is a DVI
+ ;; file print via Dvips. If not, pass the output file (which
+ ;; should then be a Postscript or PDF file) directly to lpr.
+ "{ test -e %s.dvi && %(o?)dvips -f %r %s | lpr; } || lpr %o"
+ ;; Show the queue for the (unnamed) default printer.
+ "lpq"))
+ "List of available printers.
+
+The first element of each entry is the printer name.
+
+The second element is the command used to print to this
+printer. It defaults to the value of `TeX-print-command' when nil.
+
+The third element is the command used to examine the print queue for
+this printer. It defaults to the value of `TeX-queue-command' similarly.
+
+Any occurrence of `%p' in the second or third element is expanded to
+the printer name given in the first element, then ordinary expansion
+is performed as specified in `TeX-expand-list'.
+
+If this list is empty, only `TeX-print-command' and `TeX-queue-command'
+get consulted."
+ :group 'TeX-command
+ :type '(repeat (group (string :tag "Name")
+ (option (group :inline t
+ :extra-offset -4
+ (choice :tag "Print"
+ (const :tag "default")
+ (string :format "%v"))
+ (option (choice :tag "Queue"
+ (const :tag "default")
+ (string
+ :format "%v"))))))))
+
+;; The name of the most used printer.
+
+(defcustom TeX-printer-default (or (getenv "PRINTER")
+ (and TeX-printer-list
+ (car (car TeX-printer-list)))
+ "lp")
+ "Default printer to use with `TeX-command'."
+ :group 'TeX-command
+ :type 'string)
+
+(defcustom TeX-print-style '(("^landscape$" "-t landscape"))
+ "List of style options and print options.
+
+If the first element (a regular expression) matches the name of one of
+the style files, any occurrence of the string `%r' in a command in
+`TeX-command-list' will be replaced with the second element. The first
+match is used, if no match is found the `%r' is replaced with the empty
+string."
+ :group 'TeX-command
+ :type '(repeat (group regexp (string :tag "Command"))))
+
+;; This is the list of expansion for the commands in
+;; TeX-command-list. Not likely to be changed, but you may e.g. want
+;; to handle .ps files.
+
+(defcustom TeX-expand-list
+ '(("%p" TeX-printer-query) ;%p must be the first entry
+ ("%q" (lambda ()
+ (TeX-printer-query t)))
+ ("%V" (lambda ()
+ (TeX-source-correlate-start-server-maybe)
+ (TeX-view-command-raw)))
+ ("%vv" (lambda ()
+ (TeX-source-correlate-start-server-maybe)
+ (TeX-output-style-check TeX-output-view-style)))
+ ("%v" (lambda ()
+ (TeX-source-correlate-start-server-maybe)
+ (TeX-style-check TeX-view-style)))
+ ("%r" (lambda ()
+ (TeX-style-check TeX-print-style)))
+ ("%l" (lambda ()
+ (TeX-style-check LaTeX-command-style)))
+ ("%(PDF)" (lambda ()
+ (if (and (eq TeX-engine 'default)
+ (or TeX-PDF-mode
+ TeX-DVI-via-PDFTeX))
+ "pdf"
+ "")))
+ ("%(PDFout)" (lambda ()
+ (cond ((and (eq TeX-engine 'xetex)
+ (not TeX-PDF-mode))
+ " -no-pdf")
+ ((and (eq TeX-engine 'luatex)
+ (not TeX-PDF-mode))
+ " --output-format=dvi")
+ ((and (eq TeX-engine 'default)
+ (not TeX-PDF-mode)
+ TeX-DVI-via-PDFTeX)
+ " \"\\pdfoutput=0 \"")
+ (t ""))))
+ ("%(mode)" (lambda ()
+ (if TeX-interactive-mode
+ ""
+ " -interaction=nonstopmode")))
+ ("%(o?)" (lambda () (if (eq TeX-engine 'omega) "o" "")))
+ ("%(tex)" (lambda () (eval (nth 2 (assq TeX-engine (TeX-engine-alist))))))
+ ("%(latex)" (lambda () (eval (nth 3 (assq TeX-engine
(TeX-engine-alist))))))
+ ("%(execopts)" ConTeXt-expand-options)
+ ("%S" TeX-source-correlate-expand-options)
+ ("%dS" TeX-source-specials-view-expand-options)
+ ("%cS" TeX-source-specials-view-expand-client)
+ ("%(outpage)" (lambda ()
+ (or (when TeX-source-correlate-output-page-function
+ (funcall TeX-source-correlate-output-page-function))
+ "1")))
+ ;; `file' means to call `TeX-master-file' or `TeX-region-file'
+ ("%s" file nil t)
+ ("%t" file t t)
+ ("%`" (lambda nil
+ (setq TeX-command-pos t TeX-command-text "")))
+ (" \"\\" (lambda nil
+ (if (eq TeX-command-pos t)
+ (setq TeX-command-pos pos
+ pos (+ 3 pos))
+ (setq pos (1+ pos)))))
+ ("\"" (lambda nil (if (numberp TeX-command-pos)
+ (setq TeX-command-text
+ (concat
+ TeX-command-text
+ (substring command
+ TeX-command-pos
+ (1+ pos)))
+ command
+ (concat
+ (substring command
+ 0
+ TeX-command-pos)
+ (substring command
+ (1+ pos)))
+ pos TeX-command-pos
+ TeX-command-pos t)
+ (setq pos (1+ pos)))))
+ ("%'" (lambda nil
+ (prog1
+ (if (stringp TeX-command-text)
+ (progn
+ (setq pos (+ (length TeX-command-text) 9)
+ TeX-command-pos
+ (and (string-match " "
+ (funcall file t t))
+ "\""))
+ (concat TeX-command-text " \"\\input\""))
+ (setq TeX-command-pos nil)
+ "")
+ (setq TeX-command-text nil))))
+ ("%n" TeX-current-line)
+ ("%d" file "dvi" t)
+ ("%f" file "ps" t)
+ ("%o" (lambda nil (funcall file (TeX-output-extension) t)))
+ ;; for source specials the file name generated for the xdvi
+ ;; command needs to be relative to the master file, just in
+ ;; case the file is in a different subdirectory
+ ("%b" TeX-current-file-name-master-relative)
+ ;; the following is for preview-latex.
+ ("%m" preview-create-subdirectory))
+ "List of expansion strings for TeX command names.
+
+Each entry is a list with two or more elements. The first element is
+the string to be expanded. The second element is the name of a
+function returning the expanded string when called with the remaining
+elements as arguments. The special value `file' will be expanded to
+the name of the file being processed, with an optional extension."
+ :group 'TeX-command
+ :type '(repeat (group (string :tag "Key")
+ (sexp :tag "Expander")
+ (repeat :inline t
+ :tag "Arguments"
+ (sexp :format "%v")))))
+
+
+;; The following dependencies are not done with autoload cookies since
+;; they are only useful when tex.el is loaded, anyway. tex-buf.el
+;; should remain unloaded as long as one is only editing files, so
+;; requiring it here would be wrong.
+
+(autoload 'TeX-region-create "tex-buf" nil nil)
+(autoload 'TeX-save-document "tex-buf" nil t)
+(autoload 'TeX-home-buffer "tex-buf" nil t)
+(autoload 'TeX-pin-region "tex-buf" nil t)
+(autoload 'TeX-command-region "tex-buf" nil t)
+(autoload 'TeX-command-buffer "tex-buf" nil t)
+(autoload 'TeX-command-master "tex-buf" nil t)
+(autoload 'TeX-command "tex-buf" nil nil)
+(autoload 'TeX-kill-job "tex-buf" nil t)
+(autoload 'TeX-recenter-output-buffer "tex-buf" nil t)
+(autoload 'TeX-next-error "tex-buf" nil t)
+(autoload 'TeX-region-file "tex-buf" nil nil)
+(autoload 'TeX-current-offset "tex-buf" nil nil)
+(autoload 'TeX-process-set-variable "tex-buf" nil nil)
+(autoload 'TeX-view "tex-buf" nil t)
+
+;;; Portability.
+
+(require 'easymenu)
+
+(eval-and-compile
+ (if (featurep 'xemacs)
+ (defun TeX-maybe-remove-help (menu)
+ "Removes :help entries from menus, since XEmacs does not like them.
+Also does other stuff."
+ (cond ((consp menu)
+ (cond ((eq (car menu) :help)
+ (TeX-maybe-remove-help (cddr menu)))
+ ((eq (car menu) :visible)
+ (cons :included
+ (cons (cadr menu)
+ (TeX-maybe-remove-help (cddr menu)))))
+ (t (cons (TeX-maybe-remove-help (car menu))
+ (TeX-maybe-remove-help (cdr menu))))))
+ ((vectorp menu)
+ (vconcat (TeX-maybe-remove-help (append menu nil))))
+ (t menu)))
+ (defun TeX-maybe-remove-help (menu)
+ "Compatibility function that would remove :help entries if on XEmacs,
+but does nothing in Emacs."
+ menu))
+ (defmacro TeX-menu-with-help (menu)
+ "Compatibility macro that removes :help entries if on XEmacs.
+Also does other stuff."
+ (TeX-maybe-remove-help menu)))
+
+
+;;; Documentation for Info-goto-emacs-command-node and similar
+
+(eval-after-load 'info '(dolist (elt '("TeX" "LaTeX" "ConTeXt" "Texinfo"
+ "docTeX"))
+ (add-to-list 'Info-file-list-for-emacs
+ (cons elt "AUCTeX"))))
+
+(defadvice hack-one-local-variable (after TeX-hack-one-local-variable-after
+ activate)
+ "Call minor mode function if minor mode variable is found."
+ (let ((var (ad-get-arg 0))
+ (val (ad-get-arg 1)))
+ ;; Instead of checking for each mode explicitely `minor-mode-list'
+ ;; could be used. But this may make the byte compiler pop up.
+ (when (memq var '(TeX-PDF-mode
+ TeX-source-correlate-mode TeX-interactive-mode
+ TeX-fold-mode LaTeX-math-mode))
+ (if (symbol-value val) (funcall var 1) (funcall var 0)))))
+
+(defvar TeX-overlay-priority-step 16
+ "Numerical difference of priorities between nested overlays.
+The step should be big enough to allow setting a priority for new
+overlays between two existing ones.")
+
+
+;;; Special support for XEmacs
+
+(when (featurep 'xemacs)
+
+ (defun TeX-read-string
+ (prompt &optional initial-input history default-value)
+ (condition-case nil
+ (read-string prompt initial-input history default-value t)
+ (wrong-number-of-arguments
+ (read-string prompt initial-input history default-value))))
+
+ (defun TeX-mark-active ()
+ ;; In Lucid (mark) returns nil when not active.
+ (if zmacs-regions
+ (mark)
+ (mark t)))
+
+ (defun TeX-active-mark ()
+ (and zmacs-regions (mark)))
+
+ (fset 'TeX-activate-region (symbol-function 'zmacs-activate-region))
+
+ ;; I am aware that this counteracts coding conventions but I am sick
+ ;; of it.
+ (unless (fboundp 'line-beginning-position)
+ (defalias 'line-beginning-position 'point-at-bol))
+ (unless (fboundp 'line-end-position)
+ (defalias 'line-end-position 'point-at-eol))
+
+ (defun TeX-overlay-prioritize (start end)
+ "Calculate a priority for an overlay extending from START to END.
+The calculated priority is lower than the minimum of priorities
+of surrounding overlays and higher than the maximum of enclosed
+overlays."
+ (let (inner-priority outer-priority
+ (prios (cons nil nil)))
+ (map-extents
+ #'(lambda (ov prios)
+ (and
+ (or (eq (extent-property ov 'category) 'TeX-fold)
+ (extent-property ov 'preview-state))
+ (setcar prios
+ (max (or (car prios) 0)
+ (extent-property ov 'priority))))
+ nil)
+ nil start end prios 'start-and-end-in-region 'priority)
+ (map-extents
+ #'(lambda (ov prios)
+ (and
+ (or (eq (extent-property ov 'category) 'TeX-fold)
+ (extent-property ov 'preview-state))
+ (setcdr prios
+ (min (or (cdr prios) most-positive-fixnum)
+ (extent-property ov 'priority))))
+ nil)
+ nil start end prios
+ '(start-and-end-in-region negate-in-region) 'priority)
+ (setq inner-priority (car prios) outer-priority (cdr prios))
+ (cond ((and inner-priority (not outer-priority))
+ (+ inner-priority TeX-overlay-priority-step))
+ ((and (not inner-priority) outer-priority)
+ (/ outer-priority 2))
+ ((and inner-priority outer-priority)
+ (+ (/ (- outer-priority inner-priority) 2) inner-priority))
+ (t TeX-overlay-priority-step)))) )
+
+
+(if (fboundp 'completing-read-multiple)
+ (defalias 'TeX-completing-read-multiple 'completing-read-multiple)
+ (defun TeX-completing-read-multiple
+ (prompt table &optional predicate require-match initial-input
+ hist def inherit-input-method)
+ "Poor mans implementation of Emacs' `completing-read-multiple' for XEmacs.
+The XEmacs package edit-utils-2.32 includes `crm.el'."
+ (multi-prompt "," nil prompt table predicate require-match initial-input
+ hist)))
+
+(if (fboundp 'line-number-at-pos)
+ (defalias 'TeX-line-number-at-pos 'line-number-at-pos)
+ ;; `line-number-at-pos' from `simple.el' in Emacs CVS (2006-06-07)
+ (defun TeX-line-number-at-pos (&optional pos)
+ "Return (narrowed) buffer line number at position POS.
+If POS is nil, use current buffer location."
+ (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)))))))
+
+;;; Special support for GNU Emacs
+
+(unless (featurep 'xemacs)
+
+ (defun TeX-read-string (prompt &optional initial-input history default-value)
+ (read-string prompt initial-input history default-value t))
+
+ (defun TeX-mark-active ()
+ ;; In FSF 19 mark-active indicates if mark is active.
+ mark-active)
+
+ (defun TeX-active-mark ()
+ (and transient-mark-mode mark-active))
+
+ (defun TeX-activate-region ()
+ nil)
+
+ (defun TeX-overlay-prioritize (start end)
+ "Calculate a priority for an overlay extending from START to END.
+The calculated priority is lower than the minimum of priorities
+of surrounding overlays and higher than the maximum of enclosed
+overlays."
+ (let (outer-priority inner-priority ov-priority)
+ (dolist (ov (overlays-in start end))
+ (when (or (eq (overlay-get ov 'category) 'TeX-fold)
+ (overlay-get ov 'preview-state))
+ (setq ov-priority (overlay-get ov 'priority))
+ (if (>= (overlay-start ov) start)
+ (setq inner-priority (max ov-priority (or inner-priority
+ ov-priority)))
+ (setq outer-priority (min ov-priority (or outer-priority
+ ov-priority))))))
+ (cond ((and inner-priority (not outer-priority))
+ (+ inner-priority TeX-overlay-priority-step))
+ ((and (not inner-priority) outer-priority)
+ (/ outer-priority 2))
+ ((and inner-priority outer-priority)
+ (+ (/ (- outer-priority inner-priority) 2) inner-priority))
+ (t TeX-overlay-priority-step)))) )
+
+(defun TeX-delete-dups-by-car (alist &optional keep-list)
+ "Return a list of all elements in ALIST, but each car only once.
+Elements of KEEP-LIST are not removed even if duplicate."
+ ;; Copy of `reftex-uniquify-by-car' (written by David Kastrup).
+ (setq keep-list (sort (copy-sequence keep-list) #'string<))
+ (setq alist (sort (copy-sequence alist)
+ (lambda (a b)
+ (string< (car a) (car b)))))
+ (let ((new alist) elt)
+ (while new
+ (setq elt (caar new))
+ (while (and keep-list (string< (car keep-list) elt))
+ (setq keep-list (cdr keep-list)))
+ (unless (and keep-list (string= elt (car keep-list)))
+ (while (string= elt (car (cadr new)))
+ (setcdr new (cddr new))))
+ (setq new (cdr new))))
+ alist)
+
+(defun TeX-delete-duplicate-strings (list)
+ "Return a list of all strings in LIST, but each only once."
+ (setq list (TeX-sort-strings list))
+ (let ((new list) elt)
+ (while new
+ (setq elt (car new))
+ (while (string= elt (cadr new))
+ (setcdr new (cddr new)))
+ (setq new (cdr new))))
+ list)
+
+(defun TeX-sort-strings (list)
+ "Return sorted list of all strings in LIST."
+ (sort (copy-sequence list) #'string<))
+
+;;; Buffer
+
+(defgroup TeX-output nil
+ "Parsing TeX output."
+ :prefix "TeX-"
+ :group 'AUCTeX)
+
+(defcustom TeX-display-help t
+ "Control type of help display when stepping through errors with
\\[TeX-next-error].
+If t display help buffer. If nil display message about error in
+echo area. If `expert' display output buffer with raw processor output."
+ :group 'TeX-output
+ :type '(choice (const :tag "Help buffer" t)
+ (const :tag "Echo area" nil)
+ (const :tag "Output buffer" expert)))
+
+(defcustom TeX-debug-bad-boxes nil
+ "Non-nil means also find overfull/underfull box warnings with
\\[TeX-next-error]."
+ :group 'TeX-output
+ :type 'boolean)
+
+(defcustom TeX-debug-warnings nil
+ "Non-nil means also find LaTeX or package warnings with \\[TeX-next-error]."
+ :group 'TeX-output
+ :type 'boolean)
+
+(defun TeX-toggle-debug-bad-boxes ()
+ "Toggle if the debugger should display \"bad boxes\" too."
+ (interactive)
+ (setq TeX-debug-bad-boxes (not TeX-debug-bad-boxes))
+ (message (concat "TeX-debug-bad-boxes: "
+ (if TeX-debug-bad-boxes "on" "off"))))
+
+(defun TeX-toggle-debug-warnings ()
+ "Toggle if the debugger should display warnings too."
+ (interactive)
+ (setq TeX-debug-warnings (not TeX-debug-warnings))
+ (message (concat "TeX-debug-warnings: "
+ (if TeX-debug-warnings "on" "off"))))
+
+;;; Mode names.
+
+(defvar TeX-base-mode-name nil
+ "Base name of mode.")
+(make-variable-buffer-local 'TeX-base-mode-name)
+
+(defun TeX-set-mode-name (&optional changed local reset)
+ "Build and set the mode name.
+The base mode name will be concatenated with indicators for
+helper modes where appropriate.
+
+If CHANGED is non-nil, it indicates which global mode
+may have changed so that all corresponding buffers
+without a local value might get their name updated.
+A value of t will thus update all buffer names.
+
+If LOCAL is non-nil and CHANGED is buffer-local, only
+a local change has been performed and only the local
+name is to be updated.
+
+If RESET is non-nil, `TeX-command-next' is reset to
+`TeX-command-default' in updated buffers."
+ (if (and changed
+ (not (and local (local-variable-p changed (current-buffer)))))
+ (dolist (buffer (buffer-list))
+ (and (local-variable-p 'TeX-mode-p buffer)
+ (not (local-variable-p changed buffer))
+ (with-current-buffer buffer (TeX-set-mode-name nil nil reset))))
+ (if TeX-mode-p
+ (let ((trailing-flags
+ (concat
+ (and (boundp 'TeX-fold-mode) TeX-fold-mode "F")
+ (and (boundp 'LaTeX-math-mode) LaTeX-math-mode "M")
+ (and TeX-PDF-mode "P")
+ (and TeX-interactive-mode "I")
+ (and TeX-source-correlate-mode "S"))))
+ (setq mode-name (concat TeX-base-mode-name
+ (when (> (length trailing-flags) 0)
+ (concat "/" trailing-flags))))
+ (when reset
+ (TeX-process-set-variable (TeX-master-file)
+ 'TeX-command-next TeX-command-default)
+ (TeX-process-set-variable (TeX-region-file)
+ 'TeX-command-next TeX-command-default))
+ (set-buffer-modified-p (buffer-modified-p))))))
+
+(defun TeX-mode-prefix (&optional mode)
+ "Return the prefix for the symbol MODE as string.
+If no mode is given the current major mode is used."
+ (cdr (assoc (or mode major-mode) '((plain-tex-mode . "plain-TeX")
+ (latex-mode . "LaTeX")
+ (doctex-mode . "docTeX")
+ (texinfo-mode . "Texinfo")
+ (context-mode . "ConTeXt")))))
+
+;;; Viewing
+
+(defgroup TeX-view nil
+ "Calling viewers from AUCTeX."
+ :group 'TeX-command)
+
+(defcustom TeX-view-style
+ `((,(concat
+ "^" (regexp-opt '("a4paper" "a4dutch" "a4wide" "sem-a4")) "$")
+ "%(o?)xdvi %dS -paper a4 %d")
+ (,(concat "^" (regexp-opt '("a5paper" "a5comb")) "$")
+ "%(o?)xdvi %dS -paper a5 %d")
+ ("^b5paper$" "%(o?)xdvi %dS -paper b5 %d")
+ ("^letterpaper$" "%(o?)xdvi %dS -paper us %d")
+ ("^legalpaper$" "%(o?)xdvi %dS -paper legal %d")
+ ("^executivepaper$" "%(o?)xdvi %dS -paper 7.25x10.5in %d")
+ ("^landscape$" "%(o?)xdvi %dS -paper a4r -s 0 %d")
+ ;; The latest xdvi can show embedded postscript. If you don't
+ ;; have that, uncomment next line.
+ ;; ("^epsf$" "ghostview %f")
+ ("." "%(o?)xdvi %dS %d"))
+ "List of style options and view options.
+
+If the first element (a regular expression) matches the name of
+one of the style files, any occurrence of the string `%v' in a
+command in `TeX-command-list' will be replaced with the second
+element. The first match is used, if no match is found the `%v'
+is replaced with the empty string.
+
+As a default, the \"View\" command in `TeX-command-list' is set
+to `%V'. This means that `TeX-output-view-style' will be
+consulted before `TeX-view-style'. Only if no match is found in
+`TeX-output-view-style' the settings in `TeX-view-style' will be
+considered. If you want to bypass `TeX-output-view-style', which
+is not recommended because it is more powerful than
+`TeX-view-style', use `%v' in the \"View\" command."
+ :group 'TeX-view
+ :type '(repeat (group regexp (string :tag "Command"))))
+
+(defcustom TeX-output-view-style
+ `(("^dvi$" ("^landscape$" "^pstricks$\\|^pst-\\|^psfrag$")
+ "%(o?)dvips -t landscape %d -o && gv %f")
+ ("^dvi$" "^pstricks$\\|^pst-\\|^psfrag$" "%(o?)dvips %d -o && gv %f")
+ ("^dvi$" (,(concat
+ "^" (regexp-opt '("a4paper" "a4dutch" "a4wide" "sem-a4")) "$")
+ "^landscape$")
+ "%(o?)xdvi %dS -paper a4r -s 0 %d")
+ ("^dvi$" ,(concat
+ "^" (regexp-opt '("a4paper" "a4dutch" "a4wide" "sem-a4")) "$")
+ "%(o?)xdvi %dS -paper a4 %d")
+ ("^dvi$" (,(concat "^" (regexp-opt '("a5paper" "a5comb")) "$")
+ "^landscape$")
+ "%(o?)xdvi %dS -paper a5r -s 0 %d")
+ ("^dvi$" ,(concat "^" (regexp-opt '("a5paper" "a5comb")) "$")
+ "%(o?)xdvi %dS -paper a5 %d")
+ ("^dvi$" "^b5paper$" "%(o?)xdvi %dS -paper b5 %d")
+ ("^dvi$" "^letterpaper$" "%(o?)xdvi %dS -paper us %d")
+ ("^dvi$" "^legalpaper$" "%(o?)xdvi %dS -paper legal %d")
+ ("^dvi$" "^executivepaper$" "%(o?)xdvi %dS -paper 7.25x10.5in %d")
+ ("^dvi$" "." "%(o?)xdvi %dS %d")
+ ("^pdf$" "." "xpdf -remote %s -raise %o %(outpage)")
+ ("^html?$" "." "netscape %o"))
+ "List of output file extensions and view options.
+
+If the first element (a regular expression) matches the output
+file extension, and the second element (a regular expression)
+matches the name of one of the style options, any occurrence of
+the string `%V' in a command in `TeX-command-list' will be
+replaced with the third element. The first match is used; if no
+match is found the `%V' is replaced with `%v'. The outcome of `%v'
+is determined by the settings in `TeX-view-style' which therefore
+serves as a fallback for `TeX-output-view-style'. The second
+element may also be a list of regular expressions, in which case
+all the regular expressions must match for the element to apply."
+ :group 'TeX-view
+ :type '(repeat (group
+ (regexp :tag "Extension")
+ (choice regexp (repeat :tag "List" regexp))
+ (string :tag "Command"))))
+
+;;; Viewing (new implementation)
+
+(defvar TeX-view-predicate-list-builtin
+ '((output-dvi
+ (string-match "dvi" (TeX-output-extension)))
+ (output-pdf
+ (string-match "pdf" (TeX-output-extension)))
+ (output-html
+ (string-match "html" (TeX-output-extension)))
+ (style-pstricks
+ (TeX-match-style "^pstricks$\\|^pst-\\|^psfrag$"))
+ (engine-omega
+ (eq TeX-engine 'omega))
+ (engine-xetex
+ (eq TeX-engine 'xetex))
+ (mode-io-correlate
+ TeX-source-correlate-mode)
+ (paper-landscape
+ (TeX-match-style "\\`landscape\\'"))
+ (paper-portrait
+ (not (TeX-match-style "\\`landscape\\'")))
+ (paper-a4
+ (TeX-match-style "\\`a4paper\\|a4dutch\\|a4wide\\|sem-a4\\'"))
+ (paper-a5
+ (TeX-match-style "\\`a5paper\\|a5comb\\'"))
+ (paper-b5
+ (TeX-match-style "\\`b5paper\\'"))
+ (paper-letter
+ (TeX-match-style "\\`letterpaper\\'"))
+ (paper-legal
+ (TeX-match-style "\\`legalpaper\\'"))
+ (paper-executive
+ (TeX-match-style "\\`executivepaper\\'")))
+ "Alist of built-in predicates for viewer selection and invocation.
+See the doc string of `TeX-view-predicate-list' for a short
+description of each predicate.")
+
+(defcustom TeX-view-predicate-list nil
+ "Alist of predicates for viewer selection and invocation.
+The key of each list item is a symbol and the value a Lisp form
+to be evaluated. The form should return nil if the predicate is
+not fulfilled.
+
+Built-in predicates provided in `TeX-view-predicate-list-builtin'
+can be overwritten by defining predicates with the same symbol.
+
+The following built-in predicates are available:
+ `output-dvi': The output is a DVI file.
+ `output-pdf': The output is a PDF file.
+ `output-html': The output is an HTML file.
+ `style-pstricks': The document loads a PSTricks package.
+ `engine-omega': The Omega engine is used for typesetting.
+ `engine-xetex': The XeTeX engine is used for typesetting.
+ `mode-io-correlate': TeX Source Correlate mode is active.
+ `paper-landscape': The document is typeset in landscape orientation.
+ `paper-portrait': The document is not typeset in landscape orientation.
+ `paper-a4': The paper format is A4.
+ `paper-a5': The paper format is A5.
+ `paper-b5': The paper format is B5.
+ `paper-letter': The paper format is letter.
+ `paper-legal': The paper format is legal.
+ `paper-executive': The paper format is executive."
+ :group 'TeX-view
+ :type '(alist :key-type symbol :value-type (group sexp)))
+
+(defun TeX-evince-dbus-p (&rest options)
+ "Return non-nil, if evince is installed and accessible via DBUS.
+Additional OPTIONS may be given to extend the check. If none are
+given, only the minimal requirements needed by backward search
+are checked. If OPTIONS include `:forward', which is currently
+the only option, then additional requirements needed by forward
+search are checked, too."
+ (and (not (featurep 'xemacs)) ; XEmacs 21.4 has no `require' with
+ ; arity 3, and no dbus support anyway.
+ (require 'dbus nil :no-error)
+ (functionp 'dbus-register-signal)
+ (getenv "DBUS_SESSION_BUS_ADDRESS")
+ (executable-find "evince")
+ (or (not (memq :forward options))
+ (let ((spec (dbus-introspect-get-method
+ :session "org.gnome.evince.Daemon"
+ "/org/gnome/evince/Daemon"
+ "org.gnome.evince.Daemon"
+ "FindDocument")))
+ ;; FindDocument must exist, and its signature must be (String,
+ ;; Boolean, String). Evince versions between 2.30 and 2.91.x
+ ;; didn't have the Boolean spawn argument we need to start evince
+ ;; initially.
+ (and spec
+ (equal '("s" "b" "s")
+ (delq nil (mapcar (lambda (elem)
+ (when (and (listp elem)
+ (eq (car elem) 'arg))
+ (cdr (caar (cdr elem)))))
+ spec))))))))
+
+(defun TeX-evince-sync-view ()
+ "Focus the focused page/paragraph in Evince with the position
+of point in emacs by using Evince's DBUS API. Used by default
+for the Evince viewer entry in `TeX-view-program-list-builtin' if
+the requirements are met."
+ (let* ((uri (concat "file://" (expand-file-name
+ (concat file "." (TeX-output-extension)))))
+ (owner (dbus-call-method
+ :session "org.gnome.evince.Daemon"
+ "/org/gnome/evince/Daemon"
+ "org.gnome.evince.Daemon"
+ "FindDocument"
+ uri
+ t)))
+ (if owner
+ (dbus-call-method
+ :session owner
+ "/org/gnome/evince/Window/0"
+ "org.gnome.evince.Window"
+ "SyncView"
+ (buffer-file-name)
+ (list :struct :int32 (line-number-at-pos) :int32 (1+ (current-column)))
+ :uint32 (let ((time (float-time)))
+ ;; FIXME: Evince wants a timestamp as UInt32, but POSIX time
+ ;; is too large for emacs integers on 32 bit systems. Emacs
+ ;; 24.2 will allow providing DBUS ints as floats, and this
+ ;; dbus version will be identifiable by its new variables
+ ;; `dbus-compiled-version' and `dbus-runtime-version'. But
+ ;; it seems providing just 1 as timestamp has no negative
+ ;; consequences, anyway.
+ (if (> most-positive-fixnum time)
+ (round time)
+ 1)))
+ (error "Couldn't find the Evince instance for %s" uri))))
+
+(defvar TeX-view-program-list-builtin
+ (cond
+ ((eq system-type 'windows-nt)
+ '(("Yap" ("yap -1" (mode-io-correlate " -s %n%b") " %o"))
+ ("dvips and start" "dvips %d -o && start \"\" %f")
+ ("start" "start \"\" %o")))
+;; XXX: We need the advice of a Mac OS X user to configure this
+;; correctly and test it.
+;; ((eq system-type 'darwin)
+;; '(("Preview.app" "open -a Preview.app %o")
+;; ("Skim" "open -a Skim.app %o")
+;; ("displayline" "displayline %n %o %b")
+;; ("open" "open %o")))
+ (t
+ `(("xdvi" ("%(o?)xdvi"
+ (mode-io-correlate " -sourceposition \"%n %b\" -editor \"%cS\"")
+ ((paper-a4 paper-portrait) " -paper a4")
+ ((paper-a4 paper-landscape) " -paper a4r")
+ ((paper-a5 paper-portrait) " -paper a5")
+ ((paper-a5 paper-landscape) " -paper a5r")
+ (paper-b5 " -paper b5")
+ (paper-letter " -paper us")
+ (paper-legal " -paper legal")
+ (paper-executive " -paper 7.25x10.5in")
+ " %d"))
+ ("dvips and gv" "%(o?)dvips %d -o && gv %f")
+ ("gv" "gv %o")
+ ("xpdf" ("xpdf -remote %s -raise %o" (mode-io-correlate " %(outpage)")))
+ ("Evince" ,(if (TeX-evince-dbus-p :forward)
+ 'TeX-evince-sync-view
+ `("evince" (mode-io-correlate
+ ;; With evince 3, -p N opens the page *labeled*
N,
+ ;; and -i,--page-index the physical page N.
+ ,(if (string-match "--page-index"
+ (shell-command-to-string
"evince --help"))
+ " -i %(outpage)"
+ " -p %(outpage)")) " %o")))
+ ("Okular" ("okular --unique %o" (mode-io-correlate "#src:%n%b")))
+ ("xdg-open" "xdg-open %o"))))
+ "Alist of built-in viewer specifications.
+This variable should not be changed by the user who can use
+`TeX-view-program-list' to add new viewers or overwrite the
+definition of built-in ones. The latter variable also contains a
+description of the data format.")
+
+(defcustom TeX-view-program-list nil
+ "Alist of viewer specifications.
+This variable can be used to specify how a viewer is to be
+invoked and thereby add new viewers on top of the built-in list
+of viewers defined in `TeX-view-program-list-builtin' or override
+entries in the latter.
+
+The car of each item is a string with a user-readable name. The
+second element can be a command line to be run as a process or a
+Lisp function to be executed. The command line can either be
+specified as a single string or a list of strings and two-part
+lists. The first element of the two-part lists is a symbol or a
+list of symbols referring to one or more of the predicates in
+`TeX-view-predicate-list' or `TeX-view-predicate-list-builtin'.
+The second part of the two-part lists is a command line part.
+The command line for the viewer is constructed by concatenating
+the command line parts. Parts with a predicate are only
+considered if the predicate was evaluated with a positive result.
+Note that the command line can contain placeholders as defined in
+`TeX-expand-list' which are expanded before the viewer is called.
+
+The use of a function as the second element only works if the
+View command in `TeX-command-list' makes use of the hook
+`TeX-run-discard-or-function'.
+
+Note: Predicates defined in the current Emacs session will only
+show up in the customization interface for this variable after
+restarting Emacs."
+ :group 'TeX-view
+ :type
+ `(alist
+ :key-type (string :tag "Name")
+ :value-type
+ (choice
+ (group :tag "Command" (string :tag "Command"))
+ (group :tag "Command parts"
+ (repeat
+ :tag "Command parts"
+ (choice
+ (string :tag "Command part")
+ (list :tag "Predicate and command part"
+ ,(let (list)
+ ;; Build the list of available predicates.
+ (mapc (lambda (spec)
+ (add-to-list 'list `(const ,(car spec))))
+ (append TeX-view-predicate-list
+ TeX-view-predicate-list-builtin))
+ ;; Sort the list alphabetically.
+ (setq list (sort list
+ (lambda (a b)
+ (string<
+ (downcase (symbol-name (cadr a)))
+ (downcase (symbol-name (cadr b)))))))
+ `(choice
+ (choice :tag "Predicate" ,@list)
+ (repeat :tag "List of predicates"
+ (choice :tag "Predicate" ,@list))))
+ (string :tag "Command part")))))
+ (group :tag "Function" function))))
+
+;; XXX: Regarding a possibility to (manually) run an update command,
+;; one could support this through `TeX-view' by letting it temporarily
+;; set a variable which is checked with a predicate in the viewer
+;; selection. If the check is positive, the update command is run
+;; instead of the normal viewer command. Direct support through the
+;; View command would require a predicate which knows when an update
+;; has to be done.
+(defcustom TeX-view-program-selection
+ (cond
+ ((eq system-type 'windows-nt)
+ '(((output-dvi style-pstricks) "dvips and start")
+ (output-dvi "Yap")
+ (output-pdf "start")
+ (output-html "start")))
+;; XXX: We need the advice of a Mac OS X user to configure this
+;; correctly and test it.
+;; ((eq system-type 'darwin)
+;; '((output-dvi "open")
+;; (output-pdf "open")
+;; (output-html "open")))
+ (t
+ '(((output-dvi style-pstricks) "dvips and gv")
+ (output-dvi "xdvi")
+ (output-pdf "Evince")
+ (output-html "xdg-open"))))
+ "Alist of predicates and viewers.
+Each entry consists of a list with two elements. The first
+element is a symbol or list of symbols referring to predicates as
+defined in `TeX-view-predicate-list' or
+`TeX-view-predicate-list-builtin'. The second element is a
+string referring to the name of a viewer as defined in
+`TeX-view-program-list' or `TeX-view-program-list-builtin'.
+\(Note: Viewers added to `TeX-view-program-list' in the current
+Emacs session will not show up in the customization interface of
+`TeX-view-program-selection' until you restart Emacs.)
+
+When a viewer is called for, the entries are evaluated in turn
+and the viewer related to the first entry all predicates of which
+are evaluated positively is chosen."
+ :group 'TeX-view
+ :type `(alist :key-type
+ ;; Offer list of defined predicates.
+ ,(let (list)
+ (mapc (lambda (spec)
+ (add-to-list 'list `(const ,(car spec))))
+ (append TeX-view-predicate-list
+ TeX-view-predicate-list-builtin))
+ (setq list (sort list
+ (lambda (a b)
+ (string<
+ (downcase (symbol-name (cadr a)))
+ (downcase (symbol-name (cadr b)))))))
+ `(choice (choice :tag "Single predicate" ,@list)
+ (repeat :tag "Multiple predicates"
+ (choice ,@list))))
+ :value-type
+ ;; Offer list of defined viewers.
+ (group (choice :tag "Viewer"
+ ,@(let (list)
+ (mapc (lambda (spec)
+ (add-to-list 'list
+ `(const ,(car spec))))
+ (append TeX-view-program-list
+ TeX-view-program-list-builtin))
+ (sort list
+ (lambda (a b)
+ (string< (downcase (cadr a))
+ (downcase (cadr b))))))))))
+
+(defun TeX-match-style (regexp)
+ "Check if a style matching REGEXP is active."
+ (TeX-member regexp (TeX-style-list) 'string-match))
+
+(defun TeX-view-match-predicate (predicate)
+ "Check if PREDICATE is true.
+PREDICATE can be a symbol or a list of symbols defined in
+`TeX-view-predicate-list-builtin' or `TeX-view-predicate-list'.
+In case of a single symbol, return t if the predicate is true,
+nil otherwise. In case of a list of symbols, return t if all
+predicates are true, nil otherwise."
+ (let ((pred-symbols (if (listp predicate) predicate (list predicate)))
+ (pred-defs (append TeX-view-predicate-list
+ TeX-view-predicate-list-builtin))
+ (result t)
+ elt)
+ (while (and (setq elt (pop pred-symbols)) result)
+ (unless (eval (cadr (assq elt pred-defs)))
+ (setq result nil)))
+ result))
+
+(defun TeX-view-command-raw ()
+ "Choose a viewer and return its unexpanded command string."
+ (let ((selection TeX-view-program-selection)
+ entry viewer spec command)
+ ;; Find the appropriate viewer.
+ (while (and (setq entry (pop selection)) (not viewer))
+ (when (TeX-view-match-predicate (car entry))
+ (setq viewer (cadr entry))))
+ (unless viewer
+ (error "No matching viewer found"))
+ ;; Get the command line or function spec.
+ (setq spec (cadr (assoc viewer (append TeX-view-program-list
+ TeX-view-program-list-builtin))))
+ (cond ((functionp spec)
+ ;; Converting the function call to a string is ugly, but
+ ;; the backend currently only supports strings.
+ (prin1-to-string spec))
+ ((stringp spec)
+ spec)
+ (t
+ ;; Build the unexpanded command line. Pieces with predicates are
+ ;; only added if the predicate is evaluated positively.
+ (dolist (elt spec)
+ (cond ((stringp elt)
+ (setq command (concat command elt)))
+ ((listp elt)
+ (when (TeX-view-match-predicate (car elt))
+ (setq command (concat command (cadr elt)))))))
+ command))))
+
+;;; Engine
+
+(defvar TeX-engine-alist-builtin
+ '((default "Default" TeX-command LaTeX-command ConTeXt-engine)
+ (xetex "XeTeX" "xetex" "xelatex" "xetex")
+ ;; Some lualatex versions before 0.71 would use "texput" as file
+ ;; name if --jobname were not supplied
+ (luatex "LuaTeX" "luatex" "lualatex --jobname=%s" "luatex")
+ (omega "Omega" TeX-Omega-command LaTeX-Omega-command ConTeXt-Omega-engine))
+ "Alist of built-in TeX engines and associated commands.
+For a description of the format see `TeX-engine-alist'.")
+
+(defcustom TeX-engine-alist nil
+ "Alist of TeX engines and associated commands.
+Each entry is a list with a maximum of five elements. The first
+element is a symbol used to identify the engine. The second is a
+string describing the engine. The third is the command to be
+used for plain TeX. The fourth is the command to be used for
+LaTeX. The fifth is the command to be used for the --engine
+parameter of ConTeXt's texexec program. Each command can either
+be a variable or a string. An empty string or nil means there is
+no command available.
+
+You can override a built-in engine defined in the variable
+`TeX-engine-alist-builtin' by adding an entry beginning with the
+same symbol as the built-in entry to `TeX-engine-alist'."
+ :group 'TeX-command
+ :type '(repeat (group symbol
+ (string :tag "Name")
+ (choice :tag "Plain TeX command" string variable)
+ (choice :tag "LaTeX command" string variable)
+ (choice :tag "ConTeXt command" string variable))))
+
+(defun TeX-engine-alist ()
+ "Return an alist of TeX engines.
+The function appends the built-in engine specs from
+`TeX-engine-alist-builtin' and the user-defined engines from
+`TeX-engine-alist' and deletes any entries from the built-in part
+where an entry with the same car exists in the user-defined part."
+ (TeX-delete-dups-by-car (append TeX-engine-alist TeX-engine-alist-builtin)))
+
+(defcustom TeX-engine 'default
+ (concat "Type of TeX engine to use.
+It should be one of the following symbols:\n\n"
+ (mapconcat (lambda (x) (format "* `%s'" (car x)))
+ (TeX-engine-alist) "\n"))
+ :group 'TeX-command
+ :type `(choice ,@(mapcar (lambda (x)
+ `(const :tag ,(nth 1 x) ,(car x)))
+ (TeX-engine-alist))))
+(make-variable-buffer-local 'TeX-engine)
+(put 'TeX-engine 'safe-local-variable
+ (lambda (arg) (memq arg (mapcar 'car TeX-engine-alist-builtin))))
+
+(defun TeX-engine-set (type)
+ "Set TeX engine to TYPE.
+For available TYPEs, see variable `TeX-engine'."
+ (interactive (list (completing-read "Engine: "
+ (mapcar (lambda (x)
+ (symbol-name (car x)))
+ (TeX-engine-alist))
+ nil t)))
+ (when (stringp type)
+ (setq type (intern type)))
+ (setq TeX-engine type)
+ ;; Automatically enable or disable TeX PDF mode as a convenience
+ (cond ((eq type 'xetex) (TeX-PDF-mode 1))
+ ((eq type 'omega) (TeX-PDF-mode 0))))
+
+(define-minor-mode TeX-Omega-mode
+ "Minor mode for using the Omega engine."
+ nil nil nil
+ :group 'TeX-command
+ (TeX-engine-set (if TeX-Omega-mode 'omega 'default)))
+(defalias 'tex-omega-mode 'TeX-Omega-mode)
+(TeX--call-3/2 #'make-obsolete 'TeX-Omega-mode 'TeX-engine-set "before 11.86")
+(TeX--call-3/2 #'make-obsolete-variable 'TeX-Omega-mode
+ 'TeX-engine "before 11.86")
+
+;;; Forward and inverse search
+
+(defcustom TeX-source-correlate-method 'auto
+ "Method to use for enabling forward and inverse search.
+This can be `source-specials' if source specials should be used,
+`synctex' if SyncTeX should be used, or`auto' if AUCTeX should
+decide.
+
+Setting this variable does not take effect if TeX Source
+Correlate mode has already been active. Restart Emacs in this
+case."
+ :type '(choice (const auto) (const synctex) (const source-specials))
+ :group 'TeX-view)
+
+(defvar TeX-source-correlate-method-active nil
+ "Method actually used for forward and inverse search.")
+
+(defvar TeX-source-correlate-output-page-function nil
+ "Symbol of function returning an output page relating to buffer position.
+The function should take no arguments and return the page numer
+as a string.")
+(make-variable-buffer-local 'TeX-source-correlate-output-page-function)
+
+(defcustom TeX-source-correlate-start-server 'ask
+ "Control if server should be started for inverse search."
+ :type '(choice (const :tag "Always" t)
+ (const :tag "Never" nil)
+ (const :tag "Ask" ask))
+ :group 'TeX-view)
+(when (fboundp 'defvaralias)
+ (defvaralias 'TeX-source-specials-view-start-server
+ 'TeX-source-correlate-start-server))
+
+(defvar TeX-source-correlate-start-server-asked nil
+ "Keep track if question about server start search was asked.")
+
+(defvar TeX-source-correlate-start-server-flag nil
+ "If non-nil, `TeX-source-correlate-start-server-maybe' will start a server.
+Code related to features requiring a server, e.g. for inverse
+search, can set the variable.")
+
+(defun TeX-source-correlate-gnuserv-p ()
+ "Guess whether to use gnuserv when a server is requested."
+ (cond ((and (boundp 'gnuserv-process)
+ (processp gnuserv-process)))
+ ((and (boundp 'server-process)
+ (processp server-process))
+ nil)
+ ((featurep 'xemacs))))
+
+(defun TeX-source-correlate-server-enabled-p ()
+ "Return non-nil if Emacs server or gnuserv is enabled."
+ (let* ((gnuserv-p (TeX-source-correlate-gnuserv-p))
+ (process (if gnuserv-p 'gnuserv-process 'server-process)))
+ (and (boundp process) (processp (symbol-value process)))))
+
+(defun TeX-source-correlate-start-server-maybe ()
+ "Start Emacs server or gnuserv if a feature using it is enabled.
+This is the case if `TeX-source-correlate-start-server-flag' is non-nil."
+ (when (and TeX-source-correlate-start-server-flag
+ (not (TeX-source-correlate-server-enabled-p)))
+ (let* ((gnuserv-p (TeX-source-correlate-gnuserv-p))
+ (start (if gnuserv-p 'gnuserv-start 'server-start)))
+ (cond
+ ;; Server should be started unconditionally
+ ((eq TeX-source-correlate-start-server t)
+ (funcall start))
+ ;; Ask user if server is to be started
+ ((and (eq TeX-source-correlate-start-server 'ask)
+ (not TeX-source-correlate-start-server-asked)
+ (prog1
+ (y-or-n-p (format "Start %s for inverse search in viewer? "
+ (if gnuserv-p
+ "gnuserv"
+ "Emacs server")))
+ (setq TeX-source-correlate-start-server-asked t)))
+ (funcall start))))))
+
+(defun TeX-source-correlate-determine-method ()
+ "Determine which method is available for forward and inverse search."
+ (let ((help (condition-case nil
+ (with-output-to-string
+ (call-process LaTeX-command
+ nil (list standard-output nil) nil "--help"))
+ (error ""))))
+ (if (string-match "^[ ]*-?-synctex" help)
+ 'synctex
+ 'source-specials)))
+
+(defun TeX-source-correlate-expand-options ()
+ "Return TeX engine command line option for forward search facilities.
+The return value depends on the value of `TeX-source-correlate-mode'.
+If this is nil, an empty string will be returned."
+ (if TeX-source-correlate-mode
+ (if (eq TeX-source-correlate-method-active 'source-specials)
+ (concat TeX-source-specials-tex-flags
+ (if TeX-source-specials-places
+ ;; -src-specials=WHERE: insert source specials
+ ;; in certain places of the DVI file. WHERE is a
+ ;; comma-separated value list: cr display hbox
+ ;; math par parend vbox
+ (concat "=" (mapconcat 'identity
+ TeX-source-specials-places ","))))
+ TeX-synctex-tex-flags)
+ ""))
+
+(defvar TeX-source-correlate-map
+ (let ((map (make-sparse-keymap)))
+ ;; (if (featurep 'xemacs)
+ ;; (define-key map [(control button1)] #'TeX-view-mouse)
+ ;; (define-key map [C-down-mouse-1] #'TeX-view-mouse))
+ map)
+ "Keymap for `TeX-source-correlate-mode'.
+You could use this for unusual mouse bindings.")
+
+(defun TeX-source-correlate-sync-source (file linecol &rest ignored)
+ "Show TeX FILE with point at LINECOL.
+This function is called when emacs receives a SyncSource signal
+emitted from the Evince document viewer. IGNORED absorbs an
+unused id field accompanying the DBUS signal sent by Evince-3.0.0
+or newer."
+ ;; FILE may be given as relative path to the TeX-master root document or as
+ ;; absolute file:// URL. In the former case, the tex file has to be already
+ ;; opened.
+ (let ((buf (let ((f (condition-case nil
+ (progn
+ (require 'url-parse)
+ (aref (url-generic-parse-url file) 6))
+ ;; For Emacs 21 compatibility, which doesn't have the
+ ;; url package.
+ (file-error (replace-regexp-in-string "^file://" ""
file)))))
+ (if (file-name-absolute-p f)
+ (find-file f)
+ (get-buffer (file-name-nondirectory file)))))
+ (line (car linecol))
+ (col (cadr linecol)))
+ (if (null buf)
+ (message "No buffer for %s." file)
+ (switch-to-buffer buf)
+ (push-mark (point) 'nomsg)
+ (goto-char (point-min))
+ (forward-line (1- line))
+ (unless (= col -1)
+ (move-to-column col)))))
+
+(define-minor-mode TeX-source-correlate-mode
+ "Minor mode for forward and inverse search.
+
+If enabled, the viewer can be advised to show the output page
+corresponding to the point in the source and vice versa.
+
+The method to be used can be controlled with the variable
+`TeX-source-correlate-method'. Currently source specials or
+SyncTeX are recognized."
+ :group 'TeX-view
+ ;; Since this is a global minor mode and we don't want to require
+ ;; tex.el when the mode variable is set, the mode function is called
+ ;; explicitely (if necessary) in `VirTeX-common-initialization'. We
+ ;; do it there because otherwise `kill-all-local-variables' would
+ ;; reset `TeX-source-correlate-output-page-function' which is
+ ;; buffer-local.
+ :global t
+ (set-keymap-parent TeX-mode-map (and TeX-source-correlate-mode
+ TeX-source-correlate-map))
+ (TeX-set-mode-name 'TeX-source-correlate-mode t t)
+ (setq TeX-source-correlate-start-server-flag TeX-source-correlate-mode)
+ ;; Register Emacs for the SyncSource DBUS signal emitted by Evince.
+ (when (TeX-evince-dbus-p)
+ (dbus-register-signal
+ :session nil "/org/gnome/evince/Window/0"
+ "org.gnome.evince.Window" "SyncSource"
+ 'TeX-source-correlate-sync-source))
+ (unless TeX-source-correlate-method-active
+ (setq TeX-source-correlate-method-active
+ (if (eq TeX-source-correlate-method 'auto)
+ (TeX-source-correlate-determine-method)
+ TeX-source-correlate-method)))
+ (when (eq TeX-source-correlate-method-active 'synctex)
+ (setq TeX-source-correlate-output-page-function
+ (when TeX-source-correlate-mode
+ 'TeX-synctex-output-page))))
+(defalias 'TeX-source-specials-mode 'TeX-source-correlate-mode)
+(TeX--call-3/2 #'make-obsolete 'TeX-source-specials-mode
+ 'TeX-source-correlate-mode "before 11.86")
+(defalias 'tex-source-correlate-mode 'TeX-source-correlate-mode)
+(put 'TeX-source-correlate-mode 'safe-local-variable 'TeX-booleanp)
+;; We do not want the custom variable to require tex.el. This is only
+;; necessary if AUCTeX was compiled with Emacs 21.
+(put 'TeX-source-correlate-mode 'custom-requests nil)
+(setq minor-mode-map-alist
+ (delq (assq 'TeX-source-correlate-mode minor-mode-map-alist)
+ minor-mode-map-alist))
+
+
+;;; Source Specials
+
+(defcustom TeX-source-specials-tex-flags "-src-specials"
+ "Extra flags to pass to TeX commands to generate source specials."
+ :group 'TeX-view
+ :type 'string)
+
+(defcustom TeX-source-specials-places nil
+ "List of places where to insert source specials into the DVI file.
+If nil, use (La)TeX's defaults."
+ :group 'TeX-view
+ :type '(list (set :inline t
+ ;; :tag "Options known to work"
+ ;; cr display hbox math par parend vbox
+ (const "cr")
+ (const "display")
+ (const "hbox")
+ (const "math")
+ (const "par")
+ (const "parend")
+ (const "vbox"))
+ (repeat :inline t
+ :tag "Other options"
+ (string))))
+
+(defcustom TeX-source-specials-view-position-flags
+ "-sourceposition \"%n %b\""
+ "Flags to pass to the DVI viewer commands for the position in the source."
+ :group 'TeX-view
+ :type 'string)
+
+(defcustom TeX-source-specials-view-editor-flags
+ "-editor \"%cS\""
+ "Flags to pass to DVI viewer commands for inverse search."
+ :group 'TeX-view
+ :type 'string)
+
+(defcustom TeX-source-specials-view-gnuclient-flags
+ "-q +%%l %%f"
+ "Flags to pass to gnuclient for inverse search."
+ :group 'TeX-view
+ :type 'string)
+
+(defcustom TeX-source-specials-view-emacsclient-flags
+ "--no-wait +%%l %%f"
+ "Flags to emacsclient for inverse search."
+ :group 'TeX-view
+ :type 'string)
+
+;; FIXME: Make client binaries configurable.
+(defun TeX-source-specials-view-expand-client ()
+ "Return gnuclient or emacslient executable with options.
+Return the full path to the executable if possible."
+ (let* ((gnuserv-p (TeX-source-correlate-gnuserv-p))
+ (client-base (if gnuserv-p
+ "gnuclient"
+ "emacsclient"))
+ (client-full (and invocation-directory
+ (expand-file-name client-base
+ invocation-directory)))
+ (options (if gnuserv-p
+ TeX-source-specials-view-gnuclient-flags
+ TeX-source-specials-view-emacsclient-flags)))
+ (if (and client-full (file-executable-p client-full))
+ (concat client-full " " options)
+ (concat client-base " " options))))
+
+(defun TeX-source-specials-view-expand-options (&optional viewer)
+ "Return source specials command line option for viewer command.
+The return value depends on the values of
+`TeX-source-correlate-mode' and
+`TeX-source-correlate-method-active'. If those are nil or not
+`source-specials' respectively, an empty string will be
+returned."
+ (if (and TeX-source-correlate-mode
+ (eq TeX-source-correlate-method-active 'source-specials))
+ (concat TeX-source-specials-view-position-flags
+ (when (TeX-source-correlate-server-enabled-p)
+ (concat " " TeX-source-specials-view-editor-flags)))
+ ""))
+
+;;; SyncTeX
+
+(defvar TeX-synctex-tex-flags "--synctex=1"
+ "Extra flags to pass to TeX commands to enable SyncTeX.")
+
+(defun TeX-synctex-output-page-1 (file)
+ "Return the page corresponding to the current position in FILE.
+This method assumes that the document was compiled with SyncTeX
+enabled and the `synctex' binary is available."
+ (let ((synctex-output
+ (with-output-to-string
+ (call-process "synctex" nil (list standard-output nil) nil "view"
+ "-i" (format "%s:%s:%s" (line-number-at-pos)
+ (current-column)
+ file)
+ "-o" (TeX-active-master (TeX-output-extension))))))
+ (when (string-match "Page:\\([0-9]+\\)" synctex-output)
+ (match-string 1 synctex-output))))
+
+(defun TeX-synctex-output-page ()
+ "Return the page corresponding to the position in the current buffer.
+This method assumes that the document was compiled with SyncTeX
+enabled and the `synctex' binary is available."
+ (let* ((file (file-relative-name (buffer-file-name)
+ (file-name-directory
+ (TeX-active-master))))
+ (abs-file (concat (expand-file-name (or (file-name-directory
(TeX-active-master))
+ (file-name-directory
(buffer-file-name))))
+ "./" file)))
+ ;; It's known that depending on synctex version one of
+ ;; /absolute/path/./foo/bar.tex, foo/bar.tex, or ./foo/bar.tex (relative to
+ ;; TeX-master, and the "." in the absolute path is important) are needed.
+ ;; So try all variants before falling back to page 1.
+ (or (TeX-synctex-output-page-1 abs-file)
+ (TeX-synctex-output-page-1 file)
+ (TeX-synctex-output-page-1 (concat "./" file))
+ "1")))
+
+;;; Miscellaneous minor modes
+
+(defvar TeX-mode-p nil
+ "This indicates a TeX mode being active.")
+(make-variable-buffer-local 'TeX-mode-p)
+
+(defun TeX-mode-set (var value)
+ (set-default var value)
+ (TeX-set-mode-name var nil t))
+
+(defcustom TeX-PDF-mode nil nil
+ :group 'TeX-command
+ :set 'TeX-mode-set
+ :type 'boolean)
+(put 'TeX-PDF-mode 'safe-local-variable 'TeX-booleanp)
+
+(define-minor-mode TeX-PDF-mode
+ "Minor mode for using PDFTeX.
+
+If enabled, PDFTeX will be used as an executable by default.
+You can customize an initial value, and you can use the
+function `TeX-global-PDF-mode' for toggling this value."
+ :group 'TeX-command
+ (when (eq TeX-engine 'omega)
+ (setq TeX-PDF-mode nil))
+ (setq TeX-PDF-mode-parsed nil)
+ (TeX-set-mode-name nil nil t)
+ (setq TeX-output-extension
+ (if TeX-PDF-mode "pdf" "dvi")))
+(add-to-list 'minor-mode-alist '(TeX-PDF-mode ""))
+
+(defun TeX-global-PDF-mode (&optional arg)
+ "Toggle default for `TeX-PDF-mode'."
+ (interactive "P")
+ (prog1
+ (setq-default TeX-PDF-mode
+ (if arg (> (prefix-numeric-value arg) 0)
+ (not (default-value 'TeX-PDF-mode))))
+ (TeX-set-mode-name 'TeX-PDF-mode nil t)))
+
+(defalias 'tex-pdf-mode 'TeX-PDF-mode)
+
+(defvar TeX-PDF-mode-parsed nil
+ "Set if `TeX-PDF-mode' has come about by parsing.")
+
+(make-variable-buffer-local 'TeX-PDF-mode-parsed)
+
+(defun TeX-PDF-mode-parsed (arg)
+ "Change `TeX-PDF-mode' to ARG based on parsing.
+If this conflicts with previous parsed settings,
+just use the default. If an explicit setting is
+already established, don't do anything."
+
+;; Basically we have the following situations:
+;; TeX-PDF-mode-parsed (local-variable-p 'TeX-PDF-mode):
+;; nil nil : virgin state
+;; nil t : stably set state (possibly because of conflicting parse info)
+;; t t : non-conflicting parsed info
+
+ (if TeX-PDF-mode-parsed
+ (unless (eq TeX-PDF-mode arg)
+ (TeX-PDF-mode (if (default-value 'TeX-PDF-mode) 1 0)))
+ (unless (local-variable-p 'TeX-PDF-mode (current-buffer))
+ (TeX-PDF-mode (if arg 1 0))
+ (setq TeX-PDF-mode-parsed t))))
+
+(defun TeX-PDF-mode-on ()
+ "Use only from parsing routines."
+ (TeX-PDF-mode-parsed t))
+
+(defun TeX-PDF-mode-off ()
+ "Use only from parsing routines."
+ (TeX-PDF-mode-parsed nil))
+
+(defcustom TeX-DVI-via-PDFTeX nil
+ "Whether to use PDFTeX also for producing DVI files."
+ :group 'TeX-command
+ :type 'boolean)
+
+(define-minor-mode TeX-interactive-mode
+ "Minor mode for interactive runs of TeX."
+ nil nil nil
+ :group 'TeX-command
+ (TeX-set-mode-name 'TeX-interactive-mode t t))
+(defalias 'tex-interactive-mode 'TeX-interactive-mode)
+(add-to-list 'minor-mode-alist '(TeX-interactive-mode ""))
+
+;;; Commands
+
+(defgroup TeX-command-name nil
+ "Names for external commands in AUCTeX."
+ :group 'TeX-command)
+
+(defcustom TeX-command-BibTeX "BibTeX"
+ "*The name of the BibTeX entry in `TeX-command-list'."
+ :group 'TeX-command-name
+ :type 'string)
+ (make-variable-buffer-local 'TeX-command-BibTeX)
+
+(defcustom TeX-command-Biber "Biber"
+ "*The name of the Biber entry in `TeX-command-list'."
+ :group 'TeX-command-name
+ :type 'string)
+ (make-variable-buffer-local 'TeX-command-Biber)
+
+(defcustom TeX-command-Show "View"
+ "*The default command to show (view or print) a TeX file.
+Must be the car of an entry in `TeX-command-list'."
+ :group 'TeX-command-name
+ :type 'string)
+ (make-variable-buffer-local 'TeX-command-Show)
+
+(defcustom TeX-command-Print "Print"
+ "The name of the Print entry in `TeX-command-Print'."
+ :group 'TeX-command-name
+ :type 'string)
+
+(defcustom TeX-command-Queue "Queue"
+ "The name of the Queue entry in `TeX-command-Queue'."
+ :group 'TeX-command-name
+ :type 'string)
+
+(defvar TeX-trailer-start nil
+ "Regular expression delimiting start of trailer in a TeX file.")
+
+ (make-variable-buffer-local 'TeX-trailer-start)
+
+(defvar TeX-header-end nil
+ "Regular expression delimiting end of header in a TeX file.")
+
+ (make-variable-buffer-local 'TeX-header-end)
+
+(defvar TeX-command-default nil
+ "The default command for `TeX-command' in the current major mode.")
+
+ (make-variable-buffer-local 'TeX-command-default)
+
+(put 'TeX-command-default 'safe-local-variable 'stringp)
+
+(defvar TeX-clean-default-intermediate-suffixes
+ '("\\.aux" "\\.bbl" "\\.blg" "\\.brf" "\\.fot"
+ "\\.glo" "\\.gls" "\\.idx" "\\.ilg" "\\.ind"
+ "\\.lof" "\\.log" "\\.lot" "\\.nav" "\\.out"
+ "\\.snm" "\\.toc" "\\.url" "\\.synctex\\.gz"
+ "\\.bcf" "\\.run\\.xml")
+ "List of regexps matching suffixes of files to be cleaned.
+Used as a default in TeX, LaTeX and docTeX mode.")
+
+(defvar TeX-clean-default-output-suffixes
+ '("\\.dvi" "\\.pdf" "\\.ps" "\\.xdv")
+ "List of regexps matching suffixes of files to be cleaned.
+Used as a default in TeX, LaTeX and docTeX mode.")
+
+(defcustom TeX-clean-confirm t
+ "If non-nil, ask before deleting files."
+ :type 'boolean
+ :group 'TeX-command)
+
+(autoload 'dired-mark-pop-up "dired")
+
+(defun TeX-clean (&optional arg)
+ "Delete generated files associated with current master and region files.
+If prefix ARG is non-nil, not only remove intermediate but also
+output files."
+ (interactive "P")
+ (let* ((mode-prefix (TeX-mode-prefix))
+ (suffixes (append (symbol-value
+ (intern (concat mode-prefix
+ "-clean-intermediate-suffixes")))
+ (when arg
+ (symbol-value
+ (intern (concat mode-prefix
+ "-clean-output-suffixes"))))))
+ (master (TeX-active-master))
+ (master-dir (file-name-directory master))
+ (regexp (concat "\\("
+ (regexp-quote (file-name-nondirectory master)) "\\|"
+ (TeX-region-file nil t)
+ "\\)"
+ "\\("
+ (mapconcat 'identity suffixes "\\|")
+ "\\)\\'"
+ "\\|" (TeX-region-file t t)))
+ (files (when regexp
+ (directory-files (or master-dir ".") nil regexp))))
+ (if files
+ (when (or (not TeX-clean-confirm)
+ (condition-case nil
+ (dired-mark-pop-up " *Deletions*" 'delete
+ (if (> (length files) 1)
+ files
+ (cons t files))
+ 'y-or-n-p "Delete files? ")
+ (wrong-type-argument ; e.g. with Emacs 21
+ (y-or-n-p (format "Delete %S? " (car files))))))
+ (dolist (file files)
+ (delete-file (concat master-dir file))))
+ (message "No files to be deleted"))))
+
+
+;;; Master File
+
+(defcustom TeX-master t
+ "*The master file associated with the current buffer.
+If the file being edited is actually included from another file, you
+can tell AUCTeX the name of the master file by setting this variable.
+If there are multiple levels of nesting, specify the top level file.
+
+If this variable is nil, AUCTeX will query you for the name.
+
+If the variable is t, AUCTeX will assume the file is a master file
+itself.
+
+If the variable is 'shared, AUCTeX will query for the name, but not
+change the file.
+
+If the variable is 'dwim, AUCTeX will try to avoid querying by
+attempting to `do what I mean'; and then change the file.
+
+It is suggested that you use the File Variables (see the info node in
+the Emacs manual) to set this variable permanently for each file."
+ :group 'TeX-command
+ :group 'TeX-parse
+ :type '(choice (const :tag "Query" nil)
+ (const :tag "This file" t)
+ (const :tag "Shared" shared)
+ (const :tag "Dwim" dwim)
+ (string :format "%v")))
+(make-variable-buffer-local 'TeX-master)
+(put 'TeX-master 'safe-local-variable
+ '(lambda (x)
+ (or (stringp x)
+ (member x (quote (t nil shared dwim))))))
+
+(defcustom TeX-one-master "\\.\\(texi?\\|dtx\\)$"
+ "*Regular expression matching ordinary TeX files.
+
+You should set this variable to match the name of all files, where
+automatically adding a file variable with the name of the master file
+is a good idea. When AUCTeX adds the name of the master file as a
+file variable, it does not need to ask next time you edit the file.
+
+If you dislike AUCTeX automatically modifying your files, you can set
+this variable to \"<none>\"."
+ :group 'TeX-command
+ :type 'regexp)
+
+(defvar TeX-convert-master t
+ "*If not nil, automatically convert ``Master:'' lines to file variables.
+This will be done when AUCTeX first try to use the master file.")
+
+;; Can be let-bound temporarily in order to inhibit the master file question
+;; by using its value instead in case `TeX-master' is nil or 'shared.
+(defvar TeX-transient-master nil)
+
+(defun TeX-dwim-master ()
+ "Find a likely `TeX-master'."
+ (let ((dir default-directory))
+ (dolist (buf (buffer-list))
+ (when (with-current-buffer buf
+ (and (equal dir default-directory)
+ (stringp TeX-master)))
+ (return (with-current-buffer buf TeX-master))))))
+
+(defun TeX-master-file-ask ()
+ "Ask for master file, set `TeX-master' and add local variables."
+ (interactive)
+ (if (TeX-local-master-p)
+ (error "Master file already set")
+ (let* ((default (TeX-dwim-master))
+ (name (or (and (eq 'dwim TeX-master) default)
+ (condition-case nil
+ (read-file-name (format "Master file: (default %s) "
+ (or default "this file"))
+ nil default)
+ (quit "<quit>")))))
+ (cond ((string= name "<quit>")
+ (setq TeX-master t))
+ ((string= name default)
+ (setq TeX-master default)
+ (TeX-add-local-master))
+ ((or
+ ;; Default `read-file-name' proposes and buffer visits a file.
+ (string= (expand-file-name name) (buffer-file-name))
+ ;; Default of `read-file-name' and buffer does not visit a file.
+ (string= name default-directory)
+ ;; User typed <RET> in an empty minibuffer.
+ (string= name ""))
+ (setq TeX-master t)
+ (TeX-add-local-master))
+ (t
+ (setq TeX-master (TeX-strip-extension (file-relative-name name)
+ (list TeX-default-extension)
+ 'path))
+ (TeX-add-local-master))))))
+
+(defun TeX-master-file (&optional extension nondirectory ask)
+ "Set and return the name of the master file for the current document.
+
+If optional argument EXTENSION is non-nil, add that file extension to
+the name. Special value t means use `TeX-default-extension'.
+
+If optional second argument NONDIRECTORY is non-nil, do not include
+the directory.
+
+If optional third argument ASK is non-nil, ask the user for the
+name of master file if it cannot be determined otherwise.
+
+Currently it will check for the presence of a ``Master:'' line in
+the beginning of the file, but that feature will be phased out."
+ (interactive)
+ (if (eq extension t)
+ (setq extension TeX-default-extension))
+ (let ((my-name (if (buffer-file-name)
+ (TeX-strip-extension nil (list TeX-default-extension) t)
+ "<none>")))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (cond
+ ((and TeX-transient-master
+ (or (not TeX-master) (eq TeX-master 'shared)))
+ (setq TeX-master TeX-transient-master))
+ ;; Special value 't means it is own master (a free file).
+ ((equal TeX-master my-name)
+ (setq TeX-master t))
+
+ ;; For files shared between many documents.
+ ((and (eq 'shared TeX-master) ask)
+ (setq TeX-master
+ (let* ((default (TeX-dwim-master))
+ (name (read-file-name
+ (format "Master file: (default %s) "
+ (or default "this file"))
+ nil default)))
+ (cond ((string= name default)
+ default)
+ ((or
+ ;; Default `read-file-name' proposes and
+ ;; buffer visits a file.
+ (string= (expand-file-name name)
+ (buffer-file-name))
+ ;; Default of `read-file-name' and
+ ;; buffer does not visit a file.
+ (string= name default-directory)
+ ;; User typed <RET> in an empty minibuffer.
+ (string= name ""))
+ t)
+ (t
+ (TeX-strip-extension
+ name (list TeX-default-extension) 'path))))))
+
+ ;; We might already know the name.
+ ((or (eq TeX-master t) (stringp TeX-master)) TeX-master)
+
+ ;; Support the ``Master:'' line (under protest!)
+ ((re-search-forward
+ "^%% *[Mm]aster:?[ \t]*\\([^ \t\n]+\\)" 500 t)
+ (setq TeX-master
+ (TeX-strip-extension (TeX-match-buffer 1)
+ (list TeX-default-extension)))
+ (if TeX-convert-master
+ (progn
+ (beginning-of-line)
+ (kill-line 1)
+ (TeX-add-local-master))))
+
+ ;; Ask the user (but add it as a local variable).
+ (ask (TeX-master-file-ask)))))
+
+ (let ((name (if (stringp TeX-master)
+ TeX-master
+ my-name)))
+
+ (if (TeX-match-extension name)
+ ;; If it already has an extension...
+ (if (equal extension TeX-default-extension)
+ ;; Use instead of the default extension
+ (setq extension nil)
+ ;; Otherwise drop it.
+ (setq name (TeX-strip-extension name))))
+
+ ;; Remove directory if needed.
+ (if nondirectory
+ (setq name (file-name-nondirectory name)))
+
+ (if extension
+ (concat name "." extension)
+ name))))
+
+(defun TeX-master-directory ()
+ "Directory of master file."
+ (file-name-as-directory
+ (abbreviate-file-name
+ (substitute-in-file-name
+ (expand-file-name
+ (let ((dir (file-name-directory (TeX-master-file))))
+ (if dir (directory-file-name dir) "."))
+ (and buffer-file-name
+ (file-name-directory buffer-file-name)))))))
+
+(defun TeX-add-local-master ()
+ "Add local variable for `TeX-master'."
+ (when (and (buffer-file-name)
+ (string-match TeX-one-master
+ (file-name-nondirectory (buffer-file-name)))
+ (not buffer-read-only))
+ (goto-char (point-max))
+ (if (re-search-backward (concat "^\\([^\n]+\\)Local " "Variables:")
+ (- (point-max) 3000) t)
+ (let ((prefix (TeX-match-buffer 1)))
+ (re-search-forward (regexp-quote (concat prefix
+ "End:")))
+ (beginning-of-line 1)
+ (insert prefix "TeX-master: " (prin1-to-string TeX-master) "\n"))
+ (let ((comment-prefix (cond ((eq major-mode 'texinfo-mode) "@c ")
+ ((eq major-mode 'doctex-mode) "% ")
+ (t "%%% ")))
+ (mode (concat (and (boundp 'japanese-TeX-mode) japanese-TeX-mode
+ "japanese-")
+ (substring (symbol-name major-mode) 0 -5))))
+ (newline)
+ (when (eq major-mode 'doctex-mode)
+ (insert comment-prefix TeX-esc "endinput\n"))
+ (insert
+ comment-prefix "Local " "Variables: \n"
+ comment-prefix "mode: " mode "\n"
+ comment-prefix "TeX-master: " (prin1-to-string TeX-master) "\n"
+ comment-prefix "End: \n")))))
+
+(defun TeX-local-master-p ()
+ "Return non-nil if there is a `TeX-master' entry in local variables spec.
+Return nil otherwise."
+ (save-excursion
+ ;; XXX: Checking -*- line necessary as well?
+ (goto-char (point-max))
+ (search-backward "\n\^L" (max (- (point-max) 3000) (point-min)) 'move)
+ (re-search-forward "^%+ *TeX-master:" nil t)))
+
+;;; Style Paths
+
+(defcustom TeX-style-global (expand-file-name "style" TeX-data-directory)
+ "*Directory containing hand generated TeX information.
+
+These correspond to TeX macros shared by all users of a site."
+ :group 'TeX-file
+ :type 'directory)
+
+(defcustom TeX-auto-local "auto"
+ "*Directory containing automatically generated TeX information.
+
+This correspond to TeX macros found in the current directory, and must
+be relative to that."
+ :group 'TeX-file
+ :type 'string)
+
+(defcustom TeX-style-local "style"
+ "*Directory containing hand generated TeX information.
+
+These correspond to TeX macros found in the current directory, and must
+be relative to that."
+ :group 'TeX-file
+ :type 'string)
+
+(defun TeX-split-string (regexp string)
+ "Return a list of strings.
+Given REGEXP the STRING is split into sections which in string was
+seperated by REGEXP.
+
+Examples:
+
+ (TeX-split-string \"\:\" \"abc:def:ghi\")
+ -> (\"abc\" \"def\" \"ghi\")
+
+ (TeX-split-string \" +\" \"dvips -Plw -p3 -c4 testfile.dvi\")
+
+ -> (\"dvips\" \"-Plw\" \"-p3\" \"-c4\" \"testfile.dvi\")
+
+If REGEXP is nil, or \"\", an error will occur."
+
+ (let ((start 0) result match)
+ (while (setq match (string-match regexp string start))
+ (push (substring string start match) result)
+ (setq start (match-end 0)))
+ (push (substring string start) result)
+ (nreverse result)))
+
+(defun TeX-parse-path (env)
+ "Return a list if private TeX directories found in environment variable ENV."
+ (let* ((value (getenv env))
+ (entries (and value
+ (TeX-split-string
+ (if (string-match ";" value) ";" ":")
+ value)))
+ entry
+ answers)
+ (while entries
+ (setq entry (car entries))
+ (setq entries (cdr entries))
+ (setq entry (file-name-as-directory
+ (if (string-match "/?/?\\'" entry)
+ (substring entry 0 (match-beginning 0))
+ entry)))
+ (or (not (file-name-absolute-p entry))
+ (member entry (append '("/" "\\") TeX-macro-global))
+ (setq answers (cons entry answers))))
+ answers))
+
+(defun TeX-tree-expand (vars program &optional subdirs)
+ "Return directories corresponding to the kpathsea variables VARS.
+This is done calling `kpsewhich --expand-path' for each variable.
+PROGRAM is passed as the parameter for --progname. SUBDIRS are
+subdirectories which are appended to the directories of the TeX
+trees. Only existing directories are returned."
+ (let (path-list path exit-status input-dir-list)
+ (condition-case nil
+ (dolist (var vars)
+ (setq path (with-output-to-string
+ (setq exit-status (call-process
+ "kpsewhich" nil
+ (list standard-output nil) nil
+ "--progname" program
+ "--expand-path" var))))
+ (when (zerop exit-status)
+ (add-to-list 'path-list path t)))
+ (error nil))
+ (dolist (elt path-list)
+ (let ((separators (if (string-match "^[A-Za-z]:" elt)
+ "[\n\r;]"
+ "[\n\r:]")))
+ (dolist (item (condition-case nil
+ (split-string elt separators t)
+ ;; COMPATIBILITY for XEmacs <= 21.4.15
+ (error (delete "" (split-string elt separators)))))
+ (if subdirs
+ (dolist (subdir subdirs)
+ (setq path (file-name-as-directory (concat item subdir)))
+ (when (file-exists-p path)
+ (add-to-list 'input-dir-list path t)))
+ (setq path (file-name-as-directory item))
+ (when (file-exists-p path)
+ (add-to-list 'input-dir-list path t))))))
+ input-dir-list))
+
+(defun TeX-macro-global ()
+ "Return directories containing the site's TeX macro and style files."
+ (or (TeX-tree-expand '("$SYSTEXMF" "$TEXMFLOCAL" "$TEXMFMAIN" "$TEXMFDIST")
+ "latex" '("/tex/" "/bibtex/bst/"))
+ '("/usr/share/texmf/tex/" "/usr/share/texmf/bibtex/bst/")))
+
+(defun TeX-macro-private ()
+ "Return directories containing the user's TeX macro and style files."
+ (TeX-tree-expand '("$TEXMFHOME") "latex" '("/tex/" "/bibtex/bst/")))
+
+(defcustom TeX-macro-global (TeX-macro-global)
+ "Directories containing the site's TeX macro and style files."
+ :group 'TeX-file
+ :type '(repeat (directory :format "%v")))
+
+(defcustom TeX-macro-private (or (append (TeX-parse-path "TEXINPUTS")
+ (TeX-parse-path "BIBINPUTS"))
+ (TeX-macro-private))
+ "Directories where you store your personal TeX macros."
+ :group 'TeX-file
+ :type '(repeat (file :format "%v")))
+
+(defcustom TeX-auto-private
+ (list (expand-file-name TeX-auto-local
+ (or (and (boundp 'user-emacs-directory)
+ (concat user-emacs-directory "auctex/"))
+ "~/.emacs.d/auctex/")))
+ "List of directories containing automatically generated AUCTeX style files.
+
+These correspond to the personal TeX macros."
+ :group 'TeX-file
+ :type '(repeat (file :format "%v")))
+
+(if (stringp TeX-auto-private) ;Backward compatibility
+ (setq TeX-auto-private (list TeX-auto-private)))
+
+(defcustom TeX-style-private
+ (list (expand-file-name TeX-style-local
+ (or (and (boundp 'user-emacs-directory)
+ (concat user-emacs-directory "auctex/"))
+ "~/.emacs.d/auctex/")))
+ "List of directories containing hand-generated AUCTeX style files.
+
+These correspond to the personal TeX macros."
+ :group 'TeX-file
+ :type '(repeat (file :format "%v")))
+
+(if (stringp TeX-style-private) ;Backward compatibility
+ (setq TeX-style-private (list TeX-style-private)))
+
+(defcustom TeX-style-path
+ (let ((path))
+ ;; Put directories in an order where the more local files can
+ ;; override the more global ones.
+ (mapcar (lambda (file) (when file (add-to-list 'path file t)))
+ (append (list TeX-auto-global TeX-style-global)
+ TeX-auto-private TeX-style-private
+ (list TeX-auto-local TeX-style-local)))
+ path)
+ "List of directories to search for AUCTeX style files.
+Per default the list is built from the values of the variables
+`TeX-auto-global', `TeX-style-global', `TeX-auto-private',
+`TeX-style-private', `TeX-auto-local', and `TeX-style-local'."
+ :group 'TeX-file
+ :type '(repeat (file :format "%v")))
+
+(defcustom TeX-check-path
+ (append (list ".") TeX-macro-private TeX-macro-global)
+ "Directory path to search for dependencies.
+
+If nil, just check the current file.
+Used when checking if any files have changed."
+ :group 'TeX-file
+ :type '(repeat (file :format "%v")))
+
+;;; Style Files
+
+(defvar TeX-style-hook-list nil
+ "List of TeX style hooks currently loaded.
+
+Each entry is a list where the first element is the name of the style,
+and the remaining elements are hooks to be run when that style is
+active.")
+
+(defcustom TeX-byte-compile nil
+ "*Not nil means try to byte compile auto files before loading."
+ :group 'TeX-parse
+ :type 'boolean)
+
+(defun TeX-load-style (style)
+ "Search for and load each definition for STYLE in `TeX-style-path'."
+ (cond ((assoc style TeX-style-hook-list)) ; We already found it
+ ((string-match "\\`\\(.+[/\\]\\)\\([^/\\]*\\)\\'" style) ;Complex path
+ (let* ((dir (substring style (match-beginning 1) (match-end 1)))
+ (style (substring style (match-beginning 2) (match-end 2)))
+ (master-dir (if (stringp TeX-master)
+ (file-name-directory
+ (file-relative-name TeX-master))
+ "./"))
+ (TeX-style-path (append (list (expand-file-name
+ TeX-auto-local dir)
+ (expand-file-name
+ TeX-auto-local master-dir)
+ (expand-file-name
+ TeX-style-local dir)
+ (expand-file-name
+ TeX-style-local master-dir))
+ TeX-style-path)))
+ (TeX-load-style style)))
+ (t ;Relative path
+ ;; Insert empty list to mark the fact that we have searched.
+ (setq TeX-style-hook-list (cons (list style) TeX-style-hook-list))
+ ;; Now check each element of the path
+ (dolist (name TeX-style-path)
+ (TeX-load-style-file (expand-file-name style name))))))
+
+(defun TeX-load-style-file (file)
+ "Load FILE checking for a Lisp extensions."
+ (let ((el (concat file ".el"))
+ (elc (concat file ".elc")))
+ (cond ((file-newer-than-file-p el elc)
+ (if (file-readable-p el)
+ (if (and TeX-byte-compile
+ (file-writable-p elc)
+ (save-excursion
+ ;; `byte-compile-file' switches buffer in Emacs 20.3.
+ (byte-compile-file el))
+ (file-readable-p elc))
+ (load-file elc)
+ (load-file el))))
+ ((file-readable-p elc)
+ (load-file elc))
+ ((file-readable-p el)
+ (load-file el)))))
+
+(defun TeX-add-style-hook (style hook)
+ "Give STYLE yet another HOOK to run."
+ (let ((entry (assoc style TeX-style-hook-list)))
+ (cond ((null entry)
+ ;; New style, add entry.
+ (setq TeX-style-hook-list (cons (list style hook)
+ TeX-style-hook-list)))
+ ((member hook entry)
+ ;; Old style, hook already there, do nothing.
+ nil)
+ (t
+ ;; Old style, new hook.
+ (setcdr entry (cons hook (cdr entry)))))))
+
+(defun TeX-unload-style (style)
+ "Forget that we once loaded STYLE."
+ (cond ((null (assoc style TeX-style-hook-list)))
+ ((equal (car (car TeX-style-hook-list)) style)
+ (setq TeX-style-hook-list (cdr TeX-style-hook-list)))
+ (t
+ (let ((entry TeX-style-hook-list))
+ (while (not (equal (car (car (cdr entry))) style))
+ (setq entry (cdr entry)))
+ (setcdr entry (cdr (cdr entry)))))))
+
+(defcustom TeX-virgin-style (if (and TeX-auto-global
+ (file-directory-p TeX-auto-global))
+ "virtex"
+ "NoVirtexSymbols")
+ "Style all documents use."
+ :group 'TeX-parse
+ :type 'string)
+
+(defvar TeX-active-styles nil
+ "List of styles currently active in the document.")
+ (make-variable-buffer-local 'TeX-active-styles)
+
+(defun TeX-run-style-hooks (&rest styles)
+ "Run the TeX style hooks STYLES."
+ (mapcar (lambda (style)
+ ;; Avoid recursion.
+ (unless (TeX-member style TeX-active-styles 'string-equal)
+ (setq TeX-active-styles
+ (cons style TeX-active-styles))
+ (TeX-load-style style)
+ (let ((default-directory default-directory))
+ ;; Complex path.
+ (when (string-match "\\`\\(.+[/\\]\\)\\([^/\\]*\\)\\'" style)
+ ;; Set `default-directory' to directory of master
+ ;; file since style files not stored in the fixed
+ ;; style directories are usually located there.
+ (setq default-directory (save-match-data
+ (TeX-master-directory))
+ style (substring style
+ (match-beginning 2) (match-end 2))))
+ (mapcar 'funcall
+ (cdr-safe (assoc style TeX-style-hook-list))))))
+ styles))
+
+(defcustom TeX-parse-self nil
+ "Parse file after loading it if no style hook is found for it."
+ :group 'TeX-parse
+ :type 'boolean)
+
+(defvar TeX-style-hook-applied-p nil
+ "Nil, unless the style specific hooks have been applied.")
+ (make-variable-buffer-local 'TeX-style-hook-applied-p)
+
+(defvar TeX-update-style-hook nil
+ "Hook run as soon as style specific hooks were applied.")
+
+(defun TeX-update-style (&optional force)
+ "Run style specific hooks for the current document.
+
+Only do this if it has not been done before, or if optional argument
+FORCE is not nil."
+ (unless (or (and (boundp 'TeX-auto-update)
+ (eq TeX-auto-update 'BibTeX)) ; Not a real TeX buffer
+ (and (not force)
+ TeX-style-hook-applied-p))
+ (setq TeX-style-hook-applied-p t)
+ (message "Applying style hooks...")
+ (TeX-run-style-hooks (TeX-strip-extension nil nil t))
+ ;; Run parent style hooks if it has a single parent that isn't itself.
+ (if (or (not (memq TeX-master '(nil t)))
+ (and (buffer-file-name)
+ (string-match TeX-one-master
+ (file-name-nondirectory (buffer-file-name)))))
+ (TeX-run-style-hooks (TeX-master-file)))
+ (if (and TeX-parse-self
+ (null (cdr-safe (assoc (TeX-strip-extension nil nil t)
+ TeX-style-hook-list))))
+ (TeX-auto-apply))
+ (run-hooks 'TeX-update-style-hook)
+ (message "Applying style hooks... done")))
+
+(defvar TeX-remove-style-hook nil
+ "List of hooks to call when we remove the style specific information.")
+ (make-variable-buffer-local 'TeX-remove-style-hook)
+
+(defun TeX-remove-style ()
+ "Remove all style specific information."
+ (setq TeX-style-hook-applied-p nil)
+ (run-hooks 'TeX-remove-style-hook)
+ (setq TeX-active-styles (list TeX-virgin-style)))
+
+(defun TeX-style-list ()
+ "Return a list of all styles (subfiles) used by the current document."
+ (TeX-update-style)
+ TeX-active-styles)
+
+;;; Special Characters
+
+(defvar TeX-esc "\\" "The TeX escape character.")
+ (make-variable-buffer-local 'TeX-esc)
+
+(defvar TeX-grop "{" "The TeX group opening character.")
+ (make-variable-buffer-local 'TeX-grop)
+
+(defvar TeX-grcl "}" "The TeX group closing character.")
+ (make-variable-buffer-local 'TeX-grcl)
+
+;;; Symbols
+
+;; Must be before keymaps.
+
+(defgroup TeX-macro nil
+ "Support for TeX macros in AUCTeX."
+ :prefix "TeX-"
+ :group 'AUCTeX)
+
+(defcustom TeX-complete-word 'ispell-complete-word
+ "*Function to call for completing non-macros in `tex-mode'."
+ :group 'TeX-macro)
+
+(defvar TeX-complete-list nil
+ "List of ways to complete the preceding text.
+
+Each entry is a list with the following elements:
+
+0. Regexp matching the preceding text.
+1. A number indicating the subgroup in the regexp containing the text.
+2. A function returning an alist of possible completions.
+3. Text to append after a succesful completion.
+
+Or alternatively:
+
+0. Regexp matching the preceding text.
+1. Function to do the actual completion.")
+
+(defun TeX-complete-symbol ()
+ "Perform completion on TeX/LaTeX symbol preceding point."
+ (interactive "*")
+ (let ((list TeX-complete-list)
+ entry)
+ (while list
+ (setq entry (car list)
+ list (cdr list))
+ (if (TeX-looking-at-backward (car entry) 250)
+ (setq list nil)))
+ (if (numberp (nth 1 entry))
+ (let* ((sub (nth 1 entry))
+ (close (nth 3 entry))
+ (begin (match-beginning sub))
+ (end (match-end sub))
+ (pattern (TeX-match-buffer 0))
+ (symbol (buffer-substring begin end))
+ (list (funcall (nth 2 entry)))
+ (completion (try-completion symbol list))
+ (buf-name "*Completions*"))
+ (cond ((eq completion t)
+ (and close
+ (not (looking-at (regexp-quote close)))
+ (insert close))
+ (let ((window (get-buffer-window buf-name)))
+ (when window (delete-window window))))
+ ((null completion)
+ (error "Can't find completion for \"%s\"" pattern))
+ ((not (string-equal symbol completion))
+ (delete-region begin end)
+ (insert completion)
+ (and close
+ (eq (try-completion completion list) t)
+ (not (looking-at (regexp-quote close)))
+ (insert close))
+ (let ((window (get-buffer-window buf-name)))
+ (when window (delete-window window))))
+ (t
+ (if (fboundp 'completion-in-region)
+ (completion-in-region begin end
+ (all-completions symbol list nil))
+ (message "Making completion list...")
+ (let ((list (all-completions symbol list nil)))
+ (with-output-to-temp-buffer buf-name
+ (display-completion-list list)))
+ (set-window-dedicated-p (get-buffer-window buf-name) 'soft)
+ (message "Making completion list...done")))))
+ (funcall (nth 1 entry)))))
+
+(defcustom TeX-default-macro "ref"
+ "*The default macro when creating new ones with `TeX-insert-macro'."
+ :group 'TeX-macro
+ :type 'string)
+
+(make-variable-buffer-local 'TeX-default-macro)
+
+(defcustom TeX-insert-braces t
+ "*If non-nil, append a empty pair of braces after inserting a macro."
+ :group 'TeX-macro
+ :type 'boolean)
+
+(defcustom TeX-insert-macro-default-style 'show-optional-args
+ "Specifies whether `TeX-insert-macro' will ask for all optional arguments.
+
+If set to the symbol `show-optional-args', `TeX-insert-macro' asks for
+optional arguments of TeX marcos. If set to `mandatory-args-only',
+`TeX-insert-macro' asks only for mandatory argument.
+
+When `TeX-insert-macro' is called with \\[universal-argument], it's the other
+way round.
+
+Note that for some macros, there are special mechanisms, see e.g.
+`LaTeX-includegraphics-options-alist'."
+ :group 'TeX-macro
+ :type '(choice (const mandatory-args-only)
+ (const show-optional-args)))
+
+(defvar TeX-arg-opening-brace nil
+ "String used as an opening brace for argument insertion.
+The variable will be temporarily let-bound with the necessary value.")
+
+(defvar TeX-arg-closing-brace nil
+ "String used as a closing brace for argument insertion.
+The variable will be temporarily let-bound with the necessary value.")
+
+(defvar TeX-after-insert-macro-hook nil
+ "A hook run after `TeX-insert-macro'.")
+
+(defvar TeX-macro-history nil)
+
+(defun TeX-insert-macro (symbol)
+ "Insert TeX macro SYMBOL with completion.
+
+AUCTeX knows of some macros and may query for extra arguments, depending on
+the value of `TeX-insert-macro-default-style' and whether `TeX-insert-macro'
+is called with \\[universal-argument]."
+ ;; When called with a prefix (C-u), only ask for mandatory arguments,
+ ;; i.e. all optional arguments are skipped. See `TeX-parse-arguments' for
+ ;; details. Note that this behavior may be changed in favor of a more
+ ;; flexible solution in the future, therefore we don't document it at the
+ ;; moment.
+ (interactive (list (completing-read (concat "Macro (default "
+ TeX-default-macro
+ "): "
+ TeX-esc)
+ (TeX-symbol-list) nil nil nil
+ 'TeX-macro-history)))
+ (cond ((string-equal symbol "")
+ (setq symbol TeX-default-macro))
+ ((interactive-p)
+ (setq TeX-default-macro symbol)))
+ (TeX-parse-macro symbol (cdr-safe (assoc symbol (TeX-symbol-list))))
+ (run-hooks 'TeX-after-insert-macro-hook))
+
+(defvar TeX-electric-macro-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map minibuffer-local-completion-map)
+ (define-key map " " 'minibuffer-complete-and-exit)
+ map))
+
+(defun TeX-electric-macro ()
+ "Insert TeX macro with completion.
+
+AUCTeX knows of some macros, and may query for extra arguments.
+Space will complete and exit."
+ (interactive)
+ (cond ((eq (preceding-char) ?\\)
+ (call-interactively 'self-insert-command))
+ ((eq (preceding-char) ?.)
+ (let ((TeX-default-macro " ")
+ (minibuffer-local-completion-map TeX-electric-macro-map))
+ (call-interactively 'TeX-insert-macro)))
+ (t
+ (let ((minibuffer-local-completion-map TeX-electric-macro-map))
+ (call-interactively 'TeX-insert-macro)))))
+
+(defun TeX-parse-macro (symbol args)
+ "How to parse TeX macros which takes one or more arguments.
+
+First argument SYMBOL is the name of the macro.
+
+If called with no additional arguments, insert macro with point
+inside braces. Otherwise, each argument of this function should
+match an argument to the TeX macro. What is done depend on the
+type of ARGS:
+
+ string: Use the string as a prompt to prompt for the argument.
+
+ number: Insert that many braces, leave point inside the first.
+
+ nil: Insert empty braces.
+
+ t: Insert empty braces, leave point between the braces.
+
+ other symbols: Call the symbol as a function. You can define
+ your own hook, or use one of the predefined argument hooks. If
+ you add new hooks, you can assume that point is placed directly
+ after the previous argument, or after the macro name if this is
+ the first argument. Please leave point located after the
+ argument you are inserting. If you want point to be located
+ somewhere else after all hooks have been processed, set the value
+ of `exit-mark'. It will point nowhere, until the argument hook
+ set it. By convention, these hooks all start with `TeX-arg-'.
+
+ list: If the car is a string, insert it as a prompt and the next
+ element as initial input. Otherwise, call the car of the list
+ with the remaining elements as arguments.
+
+ vector: Optional argument. If it has more than one element,
+ parse it as a list, otherwise parse the only element as above.
+ Use square brackets instead of curly braces, and is not inserted
+ on empty user input."
+
+ (if (and (TeX-active-mark)
+ (> (point) (mark)))
+ (exchange-point-and-mark))
+ (insert TeX-esc symbol)
+ (let ((exit-mark (make-marker))
+ (position (point)))
+ (TeX-parse-arguments args)
+ (cond ((marker-position exit-mark)
+ (goto-char (marker-position exit-mark))
+ (set-marker exit-mark nil))
+ ((and TeX-insert-braces
+ ;; Do not add braces if the argument is 0 or -1.
+ (not (and (= (safe-length args) 1)
+ (numberp (car args))
+ (<= (car args) 0)))
+ (equal position (point))
+ (string-match "[a-zA-Z]+" symbol)
+ (not (texmathp)))
+ (insert TeX-grop)
+ (if (TeX-active-mark)
+ (progn
+ (exchange-point-and-mark)
+ (insert TeX-grcl))
+ (insert TeX-grcl)
+ (backward-char))))))
+
+(defun TeX-arg-string (optional &optional prompt initial-input)
+ "Prompt for a string.
+
+If OPTIONAL is not nil then the PROMPT will start with ``(Optional) ''.
+INITIAL-INPUT is a string to insert before reading input."
+ (TeX-argument-insert
+ (if (and (not optional) (TeX-active-mark))
+ (let ((TeX-argument (buffer-substring (point) (mark))))
+ (delete-region (point) (mark))
+ TeX-argument)
+ (read-string (TeX-argument-prompt optional prompt "Text") initial-input))
+ optional))
+
+(defun TeX-parse-arguments (args)
+ "Parse TeX macro arguments ARGS.
+
+See `TeX-parse-macro' for details."
+ (let ((last-optional-rejected nil)
+ skip-opt)
+ ;; Maybe get rid of all optional arguments. See `TeX-insert-macro' for
+ ;; more comments. See `TeX-insert-macro-default-style'.
+ (when (or (and (eq TeX-insert-macro-default-style 'show-optional-args)
+ (equal current-prefix-arg '(4)))
+ (and (eq TeX-insert-macro-default-style 'mandatory-args-only)
+ (null (equal current-prefix-arg '(4)))))
+ (while (vectorp (car args))
+ (setq args (cdr args))))
+
+ (while args
+ (if (vectorp (car args))
+ (unless last-optional-rejected
+ (let ((TeX-arg-opening-brace LaTeX-optop)
+ (TeX-arg-closing-brace LaTeX-optcl))
+ (TeX-parse-argument t (if (equal (length (car args)) 1)
+ (aref (car args) 0)
+ (append (car args) nil)))))
+ (let ((TeX-arg-opening-brace TeX-grop)
+ (TeX-arg-closing-brace TeX-grcl))
+ (setq last-optional-rejected nil)
+ (TeX-parse-argument nil (car args))))
+ (setq args (cdr args)))))
+
+(defun TeX-parse-argument (optional arg)
+ "Depending on OPTIONAL, insert TeX macro argument ARG.
+If OPTIONAL is set, only insert if there is anything to insert, and
+then use square brackets instead of curly braces.
+
+See `TeX-parse-macro' for details."
+ (let (insert-flag)
+ (cond ((stringp arg)
+ (TeX-arg-string optional arg)
+ (setq insert-flag t))
+ ((numberp arg)
+ (cond ((< arg 0)
+ (when (TeX-active-mark)
+ ;; Put both the macro and the marked region in a TeX group.
+ (let ((beg (min (point) (mark)))
+ (end (set-marker (make-marker) (max (point) (mark)))))
+ (insert " ")
+ (goto-char beg)
+ (skip-chars-backward "^\\\\")
+ (backward-char)
+ (insert TeX-arg-opening-brace)
+ (goto-char (marker-position end))
+ (insert TeX-arg-closing-brace)
+ (setq insert-flag t))))
+ ((= arg 0)) ; nop for clarity
+ ((> arg 0)
+ (TeX-parse-argument optional t)
+ (while (> arg 1)
+ (TeX-parse-argument optional nil)
+ (setq arg (- arg 1))))))
+ ((null arg)
+ (insert TeX-arg-opening-brace)
+ (when (and (not optional) (TeX-active-mark))
+ (exchange-point-and-mark))
+ (insert TeX-arg-closing-brace)
+ (setq insert-flag t))
+ ((eq arg t)
+ (insert TeX-arg-opening-brace)
+ (if (and (not optional) (TeX-active-mark))
+ (progn
+ (exchange-point-and-mark))
+ (set-marker exit-mark (point)))
+ (insert TeX-arg-closing-brace)
+ (setq insert-flag t))
+ ((symbolp arg)
+ (funcall arg optional))
+ ((listp arg)
+ (let ((head (car arg))
+ (tail (cdr arg)))
+ (cond ((stringp head)
+ (apply 'TeX-arg-string optional arg))
+ ((symbolp head)
+ (apply head optional tail))
+ (t (error "Unknown list argument type %s"
+ (prin1-to-string head))))))
+ (t (error "Unknown argument type %s" (prin1-to-string arg))))
+ (when (and insert-flag (not optional) (TeX-active-mark))
+ (TeX-deactivate-mark))))
+
+(defun TeX-argument-insert (name optional &optional prefix)
+ "Insert NAME surrounded by curly braces.
+
+If OPTIONAL, only insert it if not empty, and then use square brackets.
+If PREFIX is given, insert it before NAME."
+ (if (and optional (string-equal name ""))
+ (setq last-optional-rejected t)
+ (insert TeX-arg-opening-brace)
+ (if prefix
+ (insert prefix))
+ (if (and (string-equal name "")
+ (null (marker-position exit-mark)))
+ (set-marker exit-mark (point))
+ (insert name))
+ (insert TeX-arg-closing-brace)))
+
+(defun TeX-argument-prompt (optional prompt default &optional complete)
+ "Return a argument prompt.
+
+If OPTIONAL is not nil then the prompt will start with ``(Optional) ''.
+
+PROMPT will be used if not nil, otherwise use DEFAULT.
+
+Unless optional argument COMPLETE is non-nil, ``: '' will be appended."
+ (concat (if optional "(Optional) " "")
+ (if prompt prompt default)
+ (if complete "" ": ")))
+
+(defun TeX-string-divide-number-unit (string)
+ "Divide number and unit in STRING.
+Return the number as car and unit as cdr."
+ (if (string-match "[0-9]*\\.?[0-9]+" string)
+ (list (substring string 0 (string-match "[^.0-9]" string))
+ (substring string (if (string-match "[^.0-9]" string)
+ (string-match "[^.0-9]" string)
+ (length string))))
+ (list "" string)))
+
+(defcustom TeX-default-unit-for-image "cm"
+ "Default unit when prompting for an image size."
+ :group 'TeX-macro
+ :type '(choice (const "cm")
+ (const "in")
+ (const "\\linewidth")
+ (string :tag "Other")))
+
+(defun TeX-arg-maybe (symbol list form)
+ "Evaluates FORM, if SYMBOL is an element of LIST."
+ (when (memq symbol list)
+ (eval form)))
+
+(defun TeX-arg-free (optional &rest args)
+ "Parse its arguments but use no braces when they are inserted."
+ (let ((TeX-arg-opening-brace "")
+ (TeX-arg-closing-brace ""))
+ (if (equal (length args) 1)
+ (TeX-parse-argument optional (car args))
+ (TeX-parse-argument optional args))))
+
+(defun TeX-arg-literal (optional &rest args)
+ "Insert its arguments ARGS into the buffer.
+Used for specifying extra syntax for a macro."
+ ;; FIXME: What is the purpose of OPTIONAL here? -- rs
+ (apply 'insert args))
+
+
+;;; Font Locking
+
+(defcustom TeX-install-font-lock 'font-latex-setup
+ "Function to call to install font lock support.
+Choose `ignore' if you don't want AUCTeX to install support for font locking."
+ :group 'TeX-misc
+ :type '(radio (function-item font-latex-setup)
+ (function-item tex-font-setup)
+ (function-item ignore)
+ (function :tag "Other")))
+
+;;; The Mode
+
+(defvar TeX-format-list
+ '(("JLATEX" japanese-latex-mode
+ "\\\\\\(documentstyle\\|documentclass\\)[^%\n]*{\\(j[s-]?\\|t\\)\
+\\(article\\|report\\|book\\|slides\\)")
+ ("JTEX" japanese-plain-tex-mode
+ "-- string likely in Japanese TeX --")
+ ("AMSTEX" ams-tex-mode
+ "\\\\document\\b")
+ ("CONTEXT" context-mode
+ "\\\\\\(start\\(text\\|tekst\\|proje[ck]t\\|proiect\\|\
+produ[ck]t\\|produs\\|environment\\|omgeving\\|umgebung\\|prostredi\\|mediu\\|\
+component\\|onderdeel\\|komponent[ea]\\|componenta\\)\
+\\|inizia\\(testo\\|progetto\\|prodotto\\|ambiente\\|componente\\)\
+\\)\\|%.*?interface=")
+ ("LATEX" latex-mode
+ "\\\\\\(begin\\|\\(?:sub\\)\\{0,2\\}section\\|chapter\\|documentstyle\\|\
+documentclass\\)\\b")
+ ("TEX" plain-tex-mode "."))
+ "*List of format packages to consider when choosing a TeX mode.
+
+A list with an entry for each format package available at the site.
+
+Each entry is a list with three elements.
+
+1. The name of the format package.
+2. The name of the major mode.
+3. A regexp typically matched in the beginning of the file.
+
+When entering `tex-mode', each regexp is tried in turn in order to find
+the major mode to be used.")
+
+(defcustom TeX-default-mode 'latex-mode
+ "*Mode to enter for a new file when it can't be determined otherwise."
+ :group 'TeX-misc
+ :type '(radio (function-item latex-mode)
+ (function-item plain-tex-mode)
+ (function :tag "Other")))
+
+(defcustom TeX-force-default-mode nil
+ "*If set to nil, try to infer the mode of the file from its content."
+ :group 'TeX-misc
+ :type 'boolean)
+
+;;;###autoload
+(defun TeX-tex-mode ()
+ "Major mode in AUCTeX for editing TeX or LaTeX files.
+Tries to guess whether this file is for plain TeX or LaTeX.
+
+The algorithm is as follows:
+
+ 1) if the file is empty or `TeX-force-default-mode' is not set to nil,
+ `TeX-default-mode' is chosen
+ 2) If \\documentstyle or \\begin{, \\section{, \\part{ or \\chapter{ is
+ found, `latex-mode' is selected.
+ 3) Otherwise, use `plain-tex-mode'"
+ (interactive)
+
+ (funcall (if (or (equal (buffer-size) 0)
+ TeX-force-default-mode)
+ TeX-default-mode
+ (save-excursion
+ (goto-char (point-min))
+ (let ((comment-start-skip ;Used by TeX-in-comment
+ (concat
+ "\\(\\(^\\|[^\\\n]\\)\\("
+ (regexp-quote TeX-esc)
+ (regexp-quote TeX-esc)
+ "\\)*\\)\\(%+ *\\)"))
+ (entry TeX-format-list)
+ answer)
+ (while (and entry (not answer))
+ (if (re-search-forward (nth 2 (car entry))
+ 10000 t)
+ (if (not (TeX-in-comment))
+ (setq answer (nth 1 (car entry))))
+ (setq entry (cdr entry))))
+ (if answer
+ answer
+ TeX-default-mode))))))
+
+(defun VirTeX-common-initialization ()
+ "Perform basic initialization."
+ (kill-all-local-variables)
+ (setq TeX-mode-p t)
+ (setq TeX-output-extension (if TeX-PDF-mode "pdf" "dvi"))
+ (setq indent-tabs-mode nil)
+
+ ;; Ispell support
+ (make-local-variable 'ispell-parser)
+ (setq ispell-parser 'tex)
+ (make-local-variable 'ispell-tex-p)
+ (setq ispell-tex-p t)
+
+ ;; Redefine some standard variables
+ (make-local-variable 'paragraph-start)
+ (make-local-variable 'paragraph-separate)
+ (make-local-variable 'comment-start)
+ (setq comment-start "%")
+ (make-local-variable 'comment-start-skip)
+ (setq comment-start-skip
+ (concat
+ "\\(\\(^\\|[^\\\n]\\)\\("
+ (regexp-quote TeX-esc)
+ (regexp-quote TeX-esc)
+ "\\)*\\)\\(%+[ \t]*\\)"))
+ (set (make-local-variable 'comment-end-skip) "[ \t]*\\(\\s>\\|\n\\)")
+ (set (make-local-variable 'comment-use-syntax) t)
+ ;; `comment-padding' is defined here as an integer for compatibility
+ ;; reasons because older Emacsen could not cope with a string.
+ (make-local-variable 'comment-padding)
+ (setq comment-padding 1)
+ ;; Removed as commenting in (La)TeX is done with one `%' not two
+ ;; (make-local-variable 'comment-add)
+ ;; (setq comment-add 1) ;default to `%%' in comment-region
+ (make-local-variable 'comment-indent-function)
+ (setq comment-indent-function 'TeX-comment-indent)
+ (make-local-variable 'comment-multi-line)
+ (setq comment-multi-line nil)
+ (make-local-variable 'compile-command)
+ (unless (boundp 'compile-command)
+ (setq compile-command "make"))
+ (make-local-variable 'words-include-escapes)
+ (setq words-include-escapes nil)
+
+ ;; Make TAB stand out
+ ;; (make-local-variable 'buffer-display-table)
+ ;; (setq buffer-display-table (if standard-display-table
+ ;; (copy-sequence standard-display-table)
+ ;; (make-display-table)))
+ ;; (aset buffer-display-table ?\t (apply 'vector (append "<TAB>" nil)))
+
+ ;; Symbol completion.
+ (make-local-variable 'TeX-complete-list)
+ (setq TeX-complete-list
+ (list (list "\\\\\\([a-zA-Z]*\\)"
+ 1 'TeX-symbol-list (if TeX-insert-braces "{}"))
+ (list "" TeX-complete-word)))
+
+ (funcall TeX-install-font-lock)
+
+ ;; We want this to be early in the list, so we do not add it before
+ ;; we enter TeX mode the first time.
+ (if (boundp 'local-write-file-hooks)
+ (add-hook 'local-write-file-hooks 'TeX-safe-auto-write)
+ (add-hook 'write-file-hooks 'TeX-safe-auto-write))
+ (make-local-variable 'TeX-auto-update)
+ (setq TeX-auto-update t)
+
+ ;; Minor modes
+ (when TeX-source-correlate-mode
+ (TeX-source-correlate-mode 1))
+
+ ;; Let `TeX-master-file' be called after a new file was opened and
+ ;; call `TeX-update-style' on any file opened. (The addition to the
+ ;; hook has to be made here because its local value will be deleted
+ ;; by `kill-all-local-variables' if it is added e.g. in `tex-mode'.)
+ ;;
+ ;; `TeX-update-style' has to be called before
+ ;; `global-font-lock-mode', which may also be specified in
+ ;; `find-file-hooks', gets called. Otherwise style-based
+ ;; fontification will break (in XEmacs). That means, `add-hook'
+ ;; cannot be called with a non-nil value of the APPEND argument.
+ ;;
+ ;; `(TeX-master-file nil nil t)' has to be called *before*
+ ;; `TeX-update-style' as the latter will call `TeX-master-file'
+ ;; without the `ask' bit set.
+ (when (and (featurep 'xemacs) (not (emacs-version>= 21 5)))
+ (make-local-hook 'find-file-hooks))
+ (add-hook 'find-file-hooks
+ (lambda ()
+ ;; Check if we are looking at a new or shared file.
+ (when (or (not (file-exists-p (buffer-file-name)))
+ (eq TeX-master 'shared))
+ (TeX-master-file nil nil t))
+ (TeX-update-style t)) nil t))
+
+
+;;; Hilighting
+
+(if (boundp 'hilit-patterns-alist)
+ (let ((latex-patterns (cdr-safe (assq 'latex-mode hilit-patterns-alist)))
+ (plain-tex-patterns (cdr-safe (assq 'plain-tex-mode
+ hilit-patterns-alist))))
+ (if (and latex-patterns plain-tex-patterns)
+ (setq hilit-patterns-alist
+ (append (list (cons 'ams-tex-mode plain-tex-patterns))
+ hilit-patterns-alist)))))
+
+;;; Parsing
+
+(defgroup TeX-parse nil
+ "Parsing TeX files from AUCTeX."
+ :group 'AUCTeX)
+
+(defvar TeX-auto-parser '((styles TeX-auto-file TeX-run-style-hooks)))
+;; Alist of parsed information.
+;; Each entry is a list with the following elements:
+;;
+;; 0. Name of information type.
+;; 1. Name of temporary variable used when parsing.
+;; 2. Name of function to add information to add to #3.
+;; 3. Name of variable holding buffer local information.
+;; 4. Name of variable indicating that #3 has changed.
+
+
+(defconst TeX-auto-parser-temporary 1)
+(defconst TeX-auto-parser-add 2)
+(defconst TeX-auto-parser-local 3)
+(defconst TeX-auto-parser-change 4)
+
+(defun TeX-auto-add-type (name prefix &optional plural)
+ "Add information about NAME to the parser using PREFIX.
+
+Optional third argument PLURAL is the plural form of TYPE.
+By default just add an `s'.
+
+This function create a set of variables and functions to maintain a
+separate type of information in the parser."
+ (let* ((names (or plural (concat name "s")))
+ (tmp (intern (concat prefix "-auto-" name)))
+ (add (intern (concat prefix "-add-" names)))
+ (local (intern (concat prefix "-" name "-list")))
+ (change (intern (concat prefix "-" name "-changed"))))
+ (setq TeX-auto-parser
+ (cons (list name tmp add local change) TeX-auto-parser))
+ (set local nil)
+ (make-variable-buffer-local local)
+ (set change nil)
+ (make-variable-buffer-local change)
+ (fset add `(lambda (&rest entries)
+ ,(concat "Add information about " (upcase name)
+ " to the current buffer.
+Generated by `TeX-auto-add-type'.")
+ (TeX-auto-add-information ,name entries)))
+ (fset local `(lambda nil
+ ,(concat "List of " names
+ " active in the current buffer.
+Generated by `TeX-auto-add-type'.")
+ (TeX-auto-list-information ,name)))
+ (add-hook 'TeX-remove-style-hook
+ `(lambda nil (setq ,(symbol-name local) nil)))))
+
+(defun TeX-auto-add-information (name entries)
+ "For NAME in `TeX-auto-parser' add ENTRIES."
+ (let* ((entry (assoc name TeX-auto-parser))
+ (change (nth TeX-auto-parser-change entry))
+ (change-value (symbol-value change))
+ (local (nth TeX-auto-parser-local entry))
+ (local-value (symbol-value local)))
+ (if change-value
+ (set local (cons entries local-value))
+ (set change t)
+ (set local (list entries local-value)))))
+
+(defun TeX-auto-list-information (name)
+ "Return information in `TeX-auto-parser' about NAME."
+ (TeX-update-style)
+ (let* ((entry (assoc name TeX-auto-parser))
+ (change (nth TeX-auto-parser-change entry))
+ (change-value (symbol-value change))
+ (local (nth TeX-auto-parser-local entry)))
+ (if (not change-value)
+ ()
+ (set change nil)
+ ;; Sort it
+ (message "Sorting %s..." name)
+ (set local
+ (sort (mapcar 'TeX-listify (apply 'append (symbol-value local)))
+ 'TeX-car-string-lessp))
+ ;; Make it unique
+ (message "Removing duplicates...")
+ (let ((entry (symbol-value local)))
+ (while (and entry (cdr entry))
+ (let ((this (car entry))
+ (next (car (cdr entry))))
+ (if (not (string-equal (car this) (car next)))
+ (setq entry (cdr entry))
+ ;; We have two equal symbols. Use the one with
+ ;; most arguments.
+ (if (> (length next) (length this))
+ (setcdr this (cdr next)))
+ (setcdr entry (cdr (cdr entry)))))))
+ (message "Removing duplicates... done"))
+ (symbol-value local)))
+
+(TeX-auto-add-type "symbol" "TeX")
+
+(defvar TeX-auto-apply-hook nil
+ "Hook run when a buffer is parsed and the information is applied.")
+
+(defun TeX-auto-apply ()
+ "Parse and apply TeX information in the current buffer."
+ (TeX-auto-parse)
+ (run-hooks 'TeX-auto-apply-hook)
+ (mapcar 'TeX-auto-apply-entry TeX-auto-parser))
+
+(defun TeX-auto-apply-entry (entry)
+ "Apply the information in ENTRY in `TeX-auto-parser'."
+ (let ((value (symbol-value (nth TeX-auto-parser-temporary entry)))
+ (add (nth TeX-auto-parser-add entry)))
+ (if value (apply add value))))
+
+(defun TeX-safe-auto-write ()
+ "Call `TeX-auto-write' safely."
+ (condition-case name
+ (and (boundp 'TeX-auto-update)
+ TeX-auto-update
+ (TeX-auto-write))
+ (error nil))
+ ;; Continue with the other write file hooks.
+ nil)
+
+(defcustom TeX-auto-save nil
+ "*Automatically save style information when saving the buffer."
+ :group 'TeX-parse
+ :type 'boolean)
+
+(defcustom TeX-auto-untabify nil
+ "*Automatically untabify when saving the buffer."
+ :group 'TeX-parse
+ :type 'boolean)
+
+(defun TeX-auto-write ()
+ "Save all relevant TeX information from the current buffer."
+ (if TeX-auto-untabify
+ (untabify (point-min) (point-max)))
+ (if (and TeX-auto-save TeX-auto-local)
+ (let* ((file (expand-file-name
+ (concat
+ (file-name-as-directory TeX-auto-local)
+ (TeX-strip-extension nil TeX-all-extensions t)
+ ".el")
+ (TeX-master-directory)))
+ (dir (file-name-directory file)))
+ ;; Create auto directory if possible.
+ (if (not (file-exists-p dir))
+ (condition-case name
+ (make-directory dir)
+ (error nil)))
+ (if (file-writable-p file)
+ (save-excursion
+ (TeX-update-style)
+ (TeX-auto-store file))
+ (message "Can't write style information.")))))
+
+(defcustom TeX-macro-default (car-safe TeX-macro-private)
+ "*Default directory to search for TeX macros."
+ :group 'TeX-file
+ :type 'directory)
+
+(defcustom TeX-auto-default (car-safe TeX-auto-private)
+ "*Default directory to place automatically generated TeX information."
+ :group 'TeX-file
+ :type 'directory)
+
+(defcustom TeX-ignore-file
+ "\\(^\\|[/\\]\\)\\(\\.\\|\\.\\.\\|RCS\\|SCCS\\|CVS\\|babel\\..*\\)$"
+ "Regular expression matching file names to ignore.
+
+These files or directories will not be considered when searching for
+TeX files in a directory."
+ :group 'TeX-parse
+ :type 'regexp)
+
+(defcustom TeX-file-recurse t
+ "Whether to search TeX directories recursively.
+nil means do not recurse, a positive integer means go that far deep in the
+directory hierarchy, t means recurse indefinitely."
+ :group 'TeX-parse
+ :type '(choice (const :tag "On" t)
+ (const :tag "Off" nil)
+ (integer :tag "Depth" :value 1)))
+
+;;;###autoload
+(defun TeX-auto-generate (tex auto)
+ "Generate style file for TEX and store it in AUTO.
+If TEX is a directory, generate style files for all files in the directory."
+ (interactive (list (setq TeX-macro-default
+ (expand-file-name (read-file-name
+ "TeX file or directory: "
+ TeX-macro-default
+ TeX-macro-default 'confirm)))
+ (setq TeX-auto-default
+ (expand-file-name (read-file-name
+ "AUTO lisp directory: "
+ TeX-auto-default
+ TeX-auto-default 'confirm)))))
+ (cond ((not (file-readable-p tex)))
+ ((string-match TeX-ignore-file tex))
+ ((file-directory-p tex)
+ (let ((files (directory-files (expand-file-name tex)))
+ (default-directory (file-name-as-directory
+ (expand-file-name tex)))
+ (TeX-file-recurse (cond ((symbolp TeX-file-recurse)
+ TeX-file-recurse)
+ ((zerop TeX-file-recurse)
+ nil)
+ ((1- TeX-file-recurse)))))
+ (mapcar (lambda (file)
+ (if (or TeX-file-recurse
+ (not (file-directory-p file)))
+ (TeX-auto-generate file auto)))
+ files)))
+ ((not (file-newer-than-file-p
+ tex
+ (concat (file-name-as-directory auto)
+ (TeX-strip-extension tex TeX-all-extensions t)
+ ".el"))))
+ ((TeX-match-extension tex (TeX-delete-duplicate-strings
+ (append TeX-file-extensions
+ BibTeX-file-extensions
+ TeX-Biber-file-extensions)))
+ (save-excursion
+ (set-buffer (let (enable-local-eval)
+ (find-file-noselect tex)))
+ (message "Parsing %s..." tex)
+ (TeX-auto-store (concat (file-name-as-directory auto)
+ (TeX-strip-extension tex
+ TeX-all-extensions
+ t)
+ ".el"))
+ (kill-buffer (current-buffer))
+ (message "Parsing %s... done" tex)))))
+
+;;;###autoload
+(defun TeX-auto-generate-global ()
+ "Create global auto directory for global TeX macro definitions."
+ (interactive)
+ (unless (file-directory-p TeX-auto-global)
+ (make-directory TeX-auto-global))
+ (let ((TeX-file-extensions '("cls" "sty"))
+ (BibTeX-file-extensions nil)
+ (TeX-Biber-file-extensions nil))
+ (mapc (lambda (macro) (TeX-auto-generate macro TeX-auto-global))
+ TeX-macro-global))
+ (byte-recompile-directory TeX-auto-global 0))
+
+(defun TeX-auto-store (file)
+ "Extract information for AUCTeX from current buffer and store it in FILE."
+ (TeX-auto-parse)
+
+ (if (member nil (mapcar 'TeX-auto-entry-clear-p TeX-auto-parser))
+ (let ((style (TeX-strip-extension nil TeX-all-extensions t)))
+ (TeX-unload-style style)
+ (save-excursion
+ (set-buffer (generate-new-buffer file))
+ (erase-buffer)
+ (insert "(TeX-add-style-hook \"" style "\"\n"
+ " (lambda ()")
+ (mapc (lambda (el) (TeX-auto-insert el style))
+ TeX-auto-parser)
+ (insert "))\n\n")
+ (write-region (point-min) (point-max) file nil 'silent)
+ (kill-buffer (current-buffer))))
+ (if (file-exists-p (concat file "c"))
+ (delete-file (concat file "c")))
+ (if (file-exists-p file)
+ (delete-file file))))
+
+(defun TeX-auto-entry-clear-p (entry)
+ "Check if the temporary for `TeX-auto-parser' entry ENTRY is clear."
+ ;; FIXME: This doc-string isn't clear to me. -- rs
+ (null (symbol-value (nth TeX-auto-parser-temporary entry))))
+
+(defun TeX-auto-insert (entry &optional skip)
+ "Insert code to initialize ENTRY from `TeX-auto-parser'.
+
+If SKIP is not-nil, don't insert code for SKIP."
+ (let ((name (symbol-name (nth TeX-auto-parser-add entry)))
+ (list (symbol-value (nth TeX-auto-parser-temporary entry))))
+ (unless (null list)
+ (insert "\n (" name)
+ (dolist (el list)
+ (cond ((and (stringp el) (not (string= el skip)))
+ (insert "\n ")
+ (insert (prin1-to-string el)))
+ ((not (stringp el))
+ (insert "\n ")
+ (insert "'" (prin1-to-string el)))))
+ (insert ")"))))
+
+(defvar TeX-auto-ignore
+ '("csname" "filedate" "fileversion" "docdate" "next" "labelitemi"
+ "labelitemii" "labelitemiii" "labelitemiv" "labelitemv"
+ "labelenumi" "labelenumii" "labelenumiii" "labelenumiv"
+ "labelenumv" "theenumi" "theenumii" "theenumiii" "theenumiv"
+ "theenumv" "document" "par" "do" "expandafter")
+ "List of symbols to ignore when scanning a TeX style file.")
+
+(defcustom TeX-auto-regexp-list 'TeX-auto-full-regexp-list
+ "List of regular expressions used for parsing the current file."
+ :type '(radio (variable-item TeX-auto-empty-regexp-list)
+ (variable-item TeX-auto-full-regexp-list)
+ (variable-item plain-TeX-auto-regexp-list)
+ (variable-item LaTeX-auto-minimal-regexp-list)
+ (variable-item LaTeX-auto-label-regexp-list)
+ (variable-item LaTeX-auto-regexp-list)
+ (symbol :tag "Other")
+ (repeat :tag "Specify"
+ (group (regexp :tag "Match")
+ (sexp :tag "Groups")
+ symbol)))
+ :group 'TeX-parse)
+ (make-variable-buffer-local 'TeX-auto-regexp-list)
+
+(defun TeX-auto-add-regexp (regexp)
+ "Add REGEXP to `TeX-auto-regexp-list' if not already a member."
+ (if (symbolp TeX-auto-regexp-list)
+ (setq TeX-auto-regexp-list (symbol-value TeX-auto-regexp-list)))
+ (or (memq regexp TeX-auto-regexp-list)
+ (setq TeX-auto-regexp-list (cons regexp TeX-auto-regexp-list))))
+
+(defvar TeX-auto-empty-regexp-list
+ '(("<IMPOSSIBLE>\\(\\'\\`\\)" 1 ignore))
+ "List of regular expressions guaranteed to match nothing.")
+
+(defvar TeX-token-char
+ (if (featurep 'mule)
+ "\\(?:[a-zA-Z]\\|\\cj\\)"
+ "[a-zA-Z]")
+ "Regexp matching a character in a TeX macro.
+
+Please use a shy group if you use a grouping construct, because
+the functions/variables which use `TeX-token-char' expect not to
+alter the numbering of any ordinary, non-shy groups.")
+
+(defvar plain-TeX-auto-regexp-list
+ (let ((token TeX-token-char))
+ `((,(concat "\\\\def\\\\\\(" token "+\\)[^a-zA-Z@]")
+ 1 TeX-auto-symbol-check)
+ (,(concat "\\\\let\\\\\\(" token "+\\)[^a-zA-Z@]")
+ 1 TeX-auto-symbol-check)
+ (,(concat "\\\\font\\\\\\(" token "+\\)[^a-zA-Z@]") 1 TeX-auto-symbol)
+ (,(concat "\\\\chardef\\\\\\(" token "+\\)[^a-zA-Z@]") 1 TeX-auto-symbol)
+ (,(concat "\\\\new\\(?:count\\|dimen\\|muskip\\|skip\\)\\\\\\(" token
+ "+\\)[^a-zA-Z@]")
+ 1 TeX-auto-symbol)
+ (,(concat "\\\\newfont{?\\\\\\(" token "+\\)}?") 1 TeX-auto-symbol)
+ (,(concat "\\\\typein\\[\\\\\\(" token "+\\)\\]") 1 TeX-auto-symbol)
+ ("\\\\input +\\(\\.*[^#%\\\\\\.\n\r]+\\)\\(\\.[^#%\\\\\\.\n\r]+\\)?"
+ 1 TeX-auto-file)
+ (,(concat "\\\\mathchardef\\\\\\(" token "+\\)[^a-zA-Z@]")
+ 1 TeX-auto-symbol)))
+ "List of regular expression matching common LaTeX macro definitions.")
+
+(defvar TeX-auto-full-regexp-list plain-TeX-auto-regexp-list
+ "Full list of regular expression matching TeX macro definitions.")
+
+(defvar TeX-auto-prepare-hook nil
+ "List of hooks to be called before parsing a TeX file.")
+
+(defvar TeX-auto-cleanup-hook nil
+ "List of hooks to be called after parsing a TeX file.")
+
+(defcustom TeX-auto-parse-length 999999
+ "Maximal length of TeX file (in characters) that will be parsed."
+ :group 'TeX-parse
+ :type 'integer)
+ (make-variable-buffer-local 'TeX-auto-parse-length)
+
+(defcustom TeX-auto-x-parse-length 0
+ "Maximum length of TeX file that will be parsed additionally.
+Use `TeX-auto-x-regexp-list' for parsing the region between
+`TeX-auto-parse-length' and this value."
+ :group 'TeX-parse
+ :type 'integer)
+ (make-variable-buffer-local 'TeX-auto-x-parse-length)
+
+(defcustom TeX-auto-x-regexp-list 'LaTeX-auto-label-regexp-list
+ "List of regular expressions used for additional parsing.
+See `TeX-auto-x-parse-length'."
+ :type '(radio (variable-item TeX-auto-empty-regexp-list)
+ (variable-item TeX-auto-full-regexp-list)
+ (variable-item plain-TeX-auto-regexp-list)
+ (variable-item LaTeX-auto-minimal-regexp-list)
+ (variable-item LaTeX-auto-label-regexp-list)
+ (variable-item LaTeX-auto-regexp-list)
+ (symbol :tag "Other")
+ (repeat :tag "Specify"
+ (group (regexp :tag "Match")
+ (sexp :tag "Groups")
+ symbol)))
+ :group 'TeX-parse)
+ (make-variable-buffer-local 'TeX-auto-x-regexp-list)
+
+(defun TeX-regexp-group-count (regexp)
+ "Return number of groups in a REGEXP. This is not foolproof:
+you should not use something like `[\\(]' for a character range."
+ (let (start (n 0))
+ (while (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\\\([^?]"
+ regexp start)
+ (setq start (- (match-end 0) 2)
+ n (1+ n)))
+ n))
+
+(defun TeX-auto-parse-region (regexp-list beg end)
+ "Parse TeX information according to REGEXP-LIST between BEG and END."
+ (if (symbolp regexp-list)
+ (setq regexp-list (and (boundp regexp-list) (symbol-value regexp-list))))
+ (if regexp-list
+ ;; Extract the information.
+ (let* (groups
+ (count 1)
+ (regexp (concat "\\("
+ (mapconcat
+ (lambda(x)
+ (push (cons count x) groups)
+ (setq count
+ (+ 1 count
+ (TeX-regexp-group-count (car x))))
+ (car x))
+ regexp-list "\\)\\|\\(")
+ "\\)"))
+ syms
+ lst)
+ (setq count 0)
+ (goto-char (if end (min end (point-max)) (point-max)))
+ (while (re-search-backward regexp beg t)
+ (let* ((entry (cdr (TeX-member nil groups
+ (lambda (a b)
+ (match-beginning (car b))))))
+ (symbol (nth 2 entry))
+ (match (nth 1 entry)))
+ (unless (TeX-in-comment)
+ (looking-at (nth 0 entry))
+ (if (fboundp symbol)
+ (funcall symbol match)
+ (puthash (if (listp match)
+ (mapcar #'TeX-match-buffer match)
+ (TeX-match-buffer match))
+ (setq count (1- count))
+ (cdr (or (assq symbol syms)
+ (car (push
+ (cons symbol
+ (make-hash-table :test 'equal))
+ syms)))))))))
+ (setq count 0)
+ (dolist (symbol syms)
+ (setq lst (symbol-value (car symbol)))
+ (while lst
+ (puthash (pop lst)
+ (setq count (1+ count))
+ (cdr symbol)))
+ (maphash (lambda (key value)
+ (push (cons value key) lst))
+ (cdr symbol))
+ (clrhash (cdr symbol))
+ (set (car symbol) (mapcar #'cdr (sort lst #'car-less-than-car)))))))
+
+
+(defun TeX-auto-parse ()
+ "Parse TeX information in current buffer.
+
+Call the functions in `TeX-auto-prepare-hook' before parsing, and the
+functions in `TeX-auto-cleanup-hook' after parsing."
+
+ (let ((case-fold-search nil))
+
+ (mapc 'TeX-auto-clear-entry TeX-auto-parser)
+ (run-hooks 'TeX-auto-prepare-hook)
+
+ (save-excursion
+ (and (> TeX-auto-x-parse-length TeX-auto-parse-length)
+ (> (point-max) TeX-auto-parse-length)
+ (TeX-auto-parse-region TeX-auto-x-regexp-list
+ TeX-auto-parse-length
+ TeX-auto-x-parse-length))
+ (TeX-auto-parse-region TeX-auto-regexp-list
+ nil TeX-auto-parse-length))
+
+ ;; Cleanup ignored symbols.
+
+ ;; NOTE: This is O(N M) where it could be O(N log N + M log M) if we
+ ;; sorted the lists first.
+ (while (member (car TeX-auto-symbol) TeX-auto-ignore)
+ (setq TeX-auto-symbol (cdr TeX-auto-symbol)))
+ (let ((list TeX-auto-symbol))
+ (while (and list (cdr list))
+ (if (member (car (cdr list)) TeX-auto-ignore)
+ (setcdr list (cdr (cdr list)))
+ (setq list (cdr list)))))
+
+ (run-hooks 'TeX-auto-cleanup-hook)))
+
+(defun TeX-auto-clear-entry (entry)
+ "Set the temporary variable in ENTRY to nil."
+ (set (nth TeX-auto-parser-temporary entry) nil))
+
+(defvar LaTeX-auto-end-symbol nil)
+
+(defun TeX-auto-symbol-check (match)
+ "Add MATCH to TeX-auto-symbols.
+Check for potential LaTeX environments."
+ (let ((symbol (if (listp match)
+ (mapcar 'TeX-match-buffer match)
+ (TeX-match-buffer match))))
+ (if (and (stringp symbol)
+ (string-match "^end\\(.+\\)$" symbol))
+ (add-to-list 'LaTeX-auto-end-symbol
+ (substring symbol (match-beginning 1) (match-end 1)))
+ (if (listp symbol)
+ (dolist (elt symbol)
+ (add-to-list 'TeX-auto-symbol elt))
+ (add-to-list 'TeX-auto-symbol symbol)))))
+
+
+;;; File Extensions
+
+(defgroup TeX-file-extension nil
+ "File extensions recognized by AUCTeX."
+ :group 'TeX-file)
+
+(defcustom TeX-file-extensions '("tex" "sty" "cls" "ltx" "texi" "texinfo"
"dtx")
+ "*File extensions used by manually generated TeX files."
+ :group 'TeX-file-extension
+ :type '(repeat (string :format "%v")))
+
+(defcustom TeX-all-extensions '("[^.\n]+")
+ "All possible file extensions."
+ :group 'TeX-file-extension
+ :type '(repeat (regexp :format "%v")))
+
+(defcustom TeX-default-extension "tex"
+ "*Default extension for TeX files."
+ :group 'TeX-file-extension
+ :type 'string)
+
+ (make-variable-buffer-local 'TeX-default-extension)
+
+(defvar TeX-doc-extensions
+ '("dvi" "pdf" "ps" "txt" "html" "dvi.gz" "pdf.gz" "ps.gz" "txt.gz" "html.gz"
+ "dvi.bz2" "pdf.bz2" "ps.bz2" "txt.bz2" "html.bz2")
+ "File extensions of documentation files.")
+
+(defcustom docTeX-default-extension "dtx"
+ "*Default extension for docTeX files."
+ :group 'TeX-file-extension
+ :type 'string)
+
+(defvar TeX-output-extension nil
+ "Extension of TeX output file.
+This is either a string or a list with
+a string as element. Its value is obtained from `TeX-command-output-list'.
+Access to the value should be through the function `TeX-output-extension'.")
+
+ (make-variable-buffer-local 'TeX-output-extension)
+
+(defcustom TeX-Biber-file-extensions '("bib" "ris" "xml")
+ "Valid file extensions for Biber files."
+ :group 'TeX-file-extension
+ :type '(repeat (string :format "%v")))
+
+(defcustom BibTeX-file-extensions '("bib")
+ "Valid file extensions for BibTeX files."
+ :group 'TeX-file-extension
+ :type '(repeat (string :format "%v")))
+
+(defcustom BibTeX-style-extensions '("bst")
+ "Valid file extensions for BibTeX styles."
+ :group 'TeX-file-extension
+ :type '(repeat (string :format "%v")))
+
+(defun TeX-match-extension (file &optional extensions)
+ "Return non-nil if FILE has one of EXTENSIONS.
+
+If EXTENSIONS is not specified or nil, the value of
+`TeX-file-extensions' is used instead."
+
+ (if (null extensions)
+ (setq extensions TeX-file-extensions))
+
+ (let ((regexp (concat "\\.\\("
+ (mapconcat 'identity extensions "\\|")
+ "\\)$"))
+ (case-fold-search t))
+ (string-match regexp file)))
+
+(defun TeX-strip-extension (&optional string extensions nodir nostrip)
+ "Return STRING without any trailing extension in EXTENSIONS.
+If NODIR is t, also remove directory part of STRING.
+If NODIR is `path', remove directory part of STRING if it is equal to
+the current directory, `TeX-macro-private' or `TeX-macro-global'.
+If NOSTRIP is set, do not remove extension after all.
+STRING defaults to the name of the current buffer.
+EXTENSIONS defaults to `TeX-file-extensions'."
+
+ (if (null string)
+ (setq string (or (buffer-file-name) "<none>")))
+
+ (if (null extensions)
+ (setq extensions TeX-file-extensions))
+
+ (let* ((strip (if (and (not nostrip)
+ (TeX-match-extension string extensions))
+ (substring string 0 (match-beginning 0))
+ string))
+ (dir (expand-file-name (or (file-name-directory strip) "./"))))
+ (if (or (eq nodir t)
+ (string-equal dir (expand-file-name "./"))
+ (member dir TeX-macro-global)
+ (member dir TeX-macro-private))
+ (file-name-nondirectory strip)
+ strip)))
+
+
+;;; File Searching
+
+(defun TeX-tree-roots ()
+ "Return a list of available TeX tree roots."
+ (let (list)
+ (dolist (dir (TeX-tree-expand '("$TEXMFHOME" "$TEXMFMAIN" "$TEXMFLOCAL"
+ "$TEXMFDIST") "latex"))
+ (when (file-readable-p dir)
+ (add-to-list 'list dir t)))
+ list))
+
+(defcustom TeX-tree-roots (TeX-tree-roots)
+ "List of all available TeX tree root directories."
+ :group 'TeX-file
+ :type '(repeat directory))
+
+(defcustom TeX-kpathsea-path-delimiter t
+ "Path delimiter for kpathsea output.
+t means autodetect, nil means kpathsea is disabled."
+ :group 'TeX-file
+ :type '(choice (const ":")
+ (const ";")
+ (const :tag "Autodetect" t)
+ (const :tag "Off" nil)))
+
+;; We keep this function in addition to `TeX-search-files' because it
+;; is faster. Since it does not look further into subdirectories,
+;; this comes at the price of finding a smaller number of files.
+(defun TeX-search-files-kpathsea (var extensions scope nodir strip)
+ "Return a list of files in directories determined by expanding VAR.
+Only files which match EXTENSIONS are returned. SCOPE defines
+the scope for the search and can be `local' or `global' besides
+nil. If NODIR is non-nil, remove directory part. If STRIP is
+non-nil, remove file extension."
+ (and TeX-kpathsea-path-delimiter
+ (catch 'no-kpathsea
+ (let* ((dirs (if (eq scope 'local)
+ "."
+ (with-output-to-string
+ (unless (zerop (call-process
+ "kpsewhich" nil
+ (list standard-output nil) nil
+ (concat "-expand-path=" var)))
+ (if (eq TeX-kpathsea-path-delimiter t)
+ (throw 'no-kpathsea
+ (setq TeX-kpathsea-path-delimiter nil))
+ (error "kpsewhich error"))))))
+ result)
+ (when (eq TeX-kpathsea-path-delimiter t)
+ (setq TeX-kpathsea-path-delimiter
+ (if (string-match ";" dirs) ";" ":")))
+ (unless TeX-kpathsea-path-delimiter
+ (throw 'no-kpathsea nil))
+ (setq dirs (delete "" (split-string
+ dirs (concat "[\n\r"
+ TeX-kpathsea-path-delimiter
+ "]+"))))
+ (if (eq scope 'global)
+ (delete "." dirs))
+ (setq extensions (concat "\\." (regexp-opt extensions t) "\\'")
+ result (apply #'append (mapcar (lambda (x)
+ (when (file-readable-p x)
+ (directory-files
+ x (not nodir) extensions)))
+ dirs)))
+ (if strip
+ (mapcar (lambda(x)
+ (if (string-match extensions x)
+ (substring x 0 (match-beginning 0))
+ x))
+ result)
+ result)))))
+
+(defun TeX-search-files (&optional directories extensions nodir strip)
+ "Return a list of all reachable files in DIRECTORIES ending with EXTENSIONS.
+If optional argument NODIR is set, remove directory part.
+If optional argument STRIP is set, remove file extension.
+If optional argument DIRECTORIES is set, search in those directories.
+Otherwise, search in all TeX macro directories.
+If optional argument EXTENSIONS is not set, use `TeX-file-extensions'"
+ (when (null extensions)
+ (setq extensions TeX-file-extensions))
+ (when (null directories)
+ (setq directories (cons "./" (append TeX-macro-private TeX-macro-global))))
+ (let (match
+ (TeX-file-recurse (cond ((symbolp TeX-file-recurse)
+ TeX-file-recurse)
+ ((zerop TeX-file-recurse)
+ nil)
+ ((1- TeX-file-recurse)))))
+ (while directories
+ (let* ((directory (car directories))
+ (content (and directory
+ (file-readable-p directory)
+ (file-directory-p directory)
+ (directory-files directory))))
+ (setq directories (cdr directories))
+ (while content
+ (let ((file (concat directory (car content))))
+ (setq content (cdr content))
+ (cond ((string-match TeX-ignore-file file))
+ ((not (file-readable-p file)))
+ ((file-directory-p file)
+ (if TeX-file-recurse
+ (setq match
+ (append match
+ (TeX-search-files
+ (list (file-name-as-directory file))
+ extensions nodir strip)))))
+ ((TeX-match-extension file extensions)
+ (setq match (cons (TeX-strip-extension
+ file extensions nodir (not strip))
+ match))))))))
+ match))
+
+;; The variables `TeX-macro-private' and `TeX-macro-global' are not
+;; used for specifying the directories because the number of
+;; directories to be searched should be limited as much as possible
+;; and the TeX-macro-* variables are just too broad for this.
+(defvar TeX-search-files-type-alist
+ '((texinputs "${TEXINPUTS}" ("tex/") TeX-file-extensions)
+ (docs "${TEXDOCS}" ("doc/") TeX-doc-extensions)
+ (graphics "${TEXINPUTS}" ("tex/") LaTeX-includegraphics-extensions)
+ (bibinputs "${BIBINPUTS}" ("bibtex/bib/") BibTeX-file-extensions)
+ (bstinputs "${BSTINPUTS}" ("bibtex/bst/") BibTeX-style-extensions))
+ "Alist of filetypes with locations and file extensions.
+Each element of the alist consists of a symbol expressing the
+filetype, a variable which can be expanded on kpathsea-based
+systems into the directories where files of the given type
+reside, a list of absolute directories, relative directories
+below the root of a TDS-compliant TeX tree or a list of variables
+with either type of directories as an alternative for
+non-kpathsea-based systems and a list of extensions to be matched
+upon a file search. Note that the directories have to end with a
+directory separator.
+
+Each AUCTeX mode should set the variable buffer-locally with a
+more specific value. See `LateX-search-files-type-alist' for an
+example.")
+
+(defun TeX-search-files-by-type (filetype &optional scope nodir strip)
+ "Return a list of files in TeX's search path with type FILETYPE.
+FILETYPE is a symbol used to choose the search paths and
+extensions. See `TeX-search-file-type-alist' for supported
+symbols.
+
+The optional argument SCOPE sets the scope for the search.
+Besides nil the symbols `local' and `global' are accepted.
+`local' means to search in the current directory only, `global'
+in the global directories only and nil in both.
+
+If optional argument NODIR is non-nil, remove directory part.
+
+If optional argument STRIP is non-nil, remove file extension."
+ (let* ((spec (assq filetype TeX-search-files-type-alist))
+ (kpse-var (nth 1 spec))
+ (rawdirs (nth 2 spec))
+ (exts (nth 3 spec))
+ expdirs dirs local-files)
+ (setq exts (if (symbolp exts) (eval exts) exts))
+ (or (TeX-search-files-kpathsea kpse-var exts scope nodir strip)
+ (progn
+ (unless (eq scope 'global)
+ (setq local-files
+ (let ((TeX-file-recurse nil))
+ (TeX-search-files '("./") exts nodir strip))))
+ (if (eq scope 'local)
+ local-files
+ (if (null TeX-tree-roots)
+ (error "No TeX trees available; configure `TeX-tree-roots'")
+ ;; Expand variables.
+ (dolist (rawdir rawdirs)
+ (if (symbolp rawdir)
+ (setq expdirs (append expdirs (eval rawdir)))
+ (add-to-list 'expdirs rawdir t)))
+ (delete-dups expdirs)
+ ;; Assumption: Either all paths are absolute or all are relative.
+ (if (file-name-absolute-p (car expdirs))
+ (setq dirs expdirs)
+ ;; Append relative TDS subdirs to all TeX tree roots.
+ (dolist (root TeX-tree-roots)
+ (dolist (dir expdirs)
+ (add-to-list 'dirs (concat (file-name-as-directory root)
+ dir) t)))))
+ (append local-files (TeX-search-files dirs exts nodir strip)))))))
+
+
+;;; Utilities
+;;
+;; Some of these functions has little to do with TeX, but nonetheless we
+;; should use the "TeX-" prefix to avoid name clashes.
+
+(defun TeX-car-string-lessp (s1 s2)
+ "Compare the cars of S1 and S2 in lexicographic order.
+Return t if first is less than second in lexicographic order."
+ (string-lessp (car s1) (car s2)))
+
+(defun TeX-listify (elt)
+ "Return a newly created list with element ELT.
+If ELT already is a list, return ELT."
+ (if (listp elt) elt (list elt)))
+
+(defun TeX-member (elt list how)
+ "Return the member ELT in LIST. Comparison done with HOW.
+Return nil if ELT is not a member of LIST."
+ (while (and list (not (funcall how elt (car list))))
+ (setq list (cdr list)))
+ (car-safe list))
+
+(defun TeX-elt-of-list-member (elts list)
+ "Return non-nil if an element of ELTS is a member of LIST."
+ (catch 'found
+ (dolist (elt elts)
+ (when (member elt list)
+ (throw 'found t)))))
+
+(defun TeX-assoc (key list)
+ "Return non-nil if KEY is `equal' to the car of an element of LIST.
+Like assoc, except case insensitive."
+ (let ((case-fold-search t))
+ (TeX-member key list
+ (lambda (a b)
+ (string-match (concat "^" (regexp-quote a) "$")
+ (car b))))))
+
+(defun TeX-match-buffer (n)
+ "Return the substring corresponding to the N'th match.
+See `match-data' for details."
+ (if (match-beginning n)
+ (buffer-substring-no-properties (match-beginning n) (match-end n))
+ ""))
+
+(defun TeX-function-p (arg)
+ "Return non-nil if ARG is callable as a function."
+ (or (and (fboundp 'byte-code-function-p)
+ (byte-code-function-p arg))
+ (and (listp arg)
+ (eq (car arg) 'lambda))
+ (and (symbolp arg)
+ (fboundp arg))))
+
+(defun TeX-booleanp (arg)
+ "Return non-nil if ARG is t or nil."
+ (memq arg '(t nil)))
+
+(defun TeX-looking-at-backward (regexp &optional limit)
+ "Return non-nil if the text before point matches REGEXP.
+Optional second argument LIMIT gives a max number of characters
+to look backward for."
+ (let ((pos (point)))
+ (save-excursion
+ (and (re-search-backward regexp
+ (if limit (max (point-min) (- (point) limit)))
+ t)
+ (eq (match-end 0) pos)))))
+
+(defun TeX-current-line ()
+ "The current line number."
+ (format "%d" (1+ (TeX-current-offset))))
+
+(defun TeX-current-file-name-master-relative ()
+ "Return current filename, relative to master directory."
+ (file-relative-name
+ (buffer-file-name)
+ (TeX-master-directory)))
+
+(defun TeX-near-bobp ()
+ "Return t iff there's nothing but whitespace between (bob) and (point)."
+ (save-excursion
+ (skip-chars-backward " \t\n")
+ (bobp)))
+
+(defun TeX-deactivate-mark ()
+ "Deactivate the mark.
+This is a compatibility function which works both in Emacs and
+XEmacs. In XEmacs the region is deactivated instead of the
+mark which is sort of equivalent."
+ (if (featurep 'xemacs)
+ (zmacs-deactivate-region)
+ (deactivate-mark)))
+
+(defalias 'TeX-run-mode-hooks
+ (if (fboundp 'run-mode-hooks) 'run-mode-hooks 'run-hooks))
+
+
+;;; Syntax Table
+
+(defvar TeX-mode-syntax-table (make-syntax-table)
+ "Syntax table used while in TeX mode.")
+
+ (make-variable-buffer-local 'TeX-mode-syntax-table)
+
+(progn ; Define TeX-mode-syntax-table.
+ (modify-syntax-entry (string-to-char TeX-esc)
+ "\\" TeX-mode-syntax-table)
+ (modify-syntax-entry ?\f ">" TeX-mode-syntax-table)
+ (modify-syntax-entry ?\n ">" TeX-mode-syntax-table)
+ (modify-syntax-entry (string-to-char TeX-grop)
+ (concat "(" TeX-grcl)
+ TeX-mode-syntax-table)
+ (modify-syntax-entry (string-to-char TeX-grcl)
+ (concat ")" TeX-grop)
+ TeX-mode-syntax-table)
+ (modify-syntax-entry ?% "<" TeX-mode-syntax-table)
+ (modify-syntax-entry ?\" "." TeX-mode-syntax-table)
+ (modify-syntax-entry ?& "." TeX-mode-syntax-table)
+ (modify-syntax-entry ?_ "." TeX-mode-syntax-table)
+ (modify-syntax-entry ?@ "_" TeX-mode-syntax-table)
+ (modify-syntax-entry ?~ "." TeX-mode-syntax-table)
+ (modify-syntax-entry ?$ "$" TeX-mode-syntax-table)
+ (modify-syntax-entry ?' "w" TeX-mode-syntax-table)
+ (modify-syntax-entry ?� "." TeX-mode-syntax-table)
+ (modify-syntax-entry ?� "." TeX-mode-syntax-table))
+
+;;; Menu Support
+
+(defvar TeX-command-current 'TeX-command-master
+ "Specify whether to run command on master, buffer or region.")
+;; Function used to run external command.
+
+(defun TeX-command-select-master ()
+ "Determine that the next command will be on the master file."
+ (interactive)
+ (message "Next command will be on the master file.")
+ (setq TeX-command-current 'TeX-command-master))
+
+(defun TeX-command-select-buffer ()
+ "Determine that the next command will be on the buffer."
+ (interactive)
+ (message "Next command will be on the buffer")
+ (setq TeX-command-current 'TeX-command-buffer))
+
+(defun TeX-command-select-region ()
+ "Determine that the next command will be on the region."
+ (interactive)
+ (message "Next command will be on the region")
+ (setq TeX-command-current 'TeX-command-region))
+
+(defvar TeX-command-force nil)
+;; If non-nil, TeX-command-query will return the value of this
+;; variable instead of quering the user.
+
+(defun TeX-command-menu (name)
+ "Execute `TeX-command-list' NAME from a menu."
+ (let ((TeX-command-force name))
+ (funcall TeX-command-current)))
+
+(defun TeX-command-menu-print (printer command name)
+ "Print on PRINTER using method COMMAND to run NAME."
+ (let ((TeX-printer-default (unless (string= printer "Other") printer))
+ (TeX-printer-list (and (string= printer "Other") TeX-printer-list))
+ (TeX-print-command command)
+ (TeX-queue-command command))
+ (TeX-command-menu name)))
+
+(defun TeX-command-menu-printer-entry (entry lookup command name)
+ "Return `TeX-printer-list' ENTRY as a menu item."
+ (vector (nth 0 entry)
+ (list 'TeX-command-menu-print
+ (nth 0 entry)
+ (or (nth lookup entry) command)
+ name)))
+
+(defun TeX-command-menu-entry (entry)
+ "Return `TeX-command-list' ENTRY as a menu item."
+ (let ((name (car entry)))
+ (cond ((and (string-equal name TeX-command-Print)
+ TeX-printer-list)
+ (cons TeX-command-Print
+ (mapcar (lambda (entry)
+ (TeX-command-menu-printer-entry
+ entry 1 TeX-print-command name))
+ (append TeX-printer-list '(("Other"))))))
+ ((and (string-equal name TeX-command-Queue)
+ TeX-printer-list)
+ (cons TeX-command-Queue
+ (mapcar (lambda (entry)
+ (TeX-command-menu-printer-entry
+ entry 2 TeX-queue-command name))
+ (append TeX-printer-list '(("Other"))))))
+ (t
+ (vconcat `(,name (TeX-command-menu ,name))
+ (nthcdr 5 entry))))))
+
+(defconst TeX-command-menu-name "Command"
+ "Name to be displayed for the command menu in all modes defined by AUCTeX.")
+
+;;; Keymap
+
+(defcustom TeX-electric-escape nil
+ "If non-nil, ``\\'' will be bound to `TeX-electric-macro'."
+ :group 'TeX-macro
+ :type 'boolean)
+
+(defcustom TeX-electric-sub-and-superscript nil
+ "If non-nil, insert braces after typing `^' and `_' in math mode."
+ :group 'TeX-macro
+ :type 'boolean)
+
+(defcustom TeX-newline-function 'newline
+ "Function to be called upon pressing `RET'."
+ :group 'TeX-indentation
+ :type '(choice (const newline)
+ (const newline-and-indent)
+ (const reindent-then-newline-and-indent)
+ (sexp :tag "Other")))
+
+(defun TeX-insert-backslash (arg)
+ "Either insert typed key ARG times or call `TeX-electric-macro'.
+`TeX-electric-macro' will be called if `TeX-electric-escape' is non-nil."
+ (interactive "*p")
+ (if TeX-electric-escape
+ (TeX-electric-macro)
+ (self-insert-command arg)))
+
+(defun TeX-insert-sub-or-superscript (arg)
+ "Insert typed key ARG times and possibly a pair of braces.
+Brace insertion is only done if point is in a math construct and
+`TeX-electric-sub-and-superscript' has a non-nil value."
+ (interactive "*p")
+ (self-insert-command arg)
+ (when (and TeX-electric-sub-and-superscript (texmathp))
+ (insert (concat TeX-grop TeX-grcl))
+ (backward-char)))
+
+(defun TeX-newline ()
+ "Call the function specified by the variable `TeX-newline-function'."
+ (interactive) (funcall TeX-newline-function))
+
+(defvar TeX-mode-map
+ (let ((map (make-sparse-keymap)))
+ ;; Standard
+ ;; (define-key map "\177" 'backward-delete-char-untabify)
+ (define-key map "\C-c}" 'up-list)
+ (define-key map "\C-c#" 'TeX-normal-mode)
+ (define-key map "\C-c\C-n" 'TeX-normal-mode)
+ (define-key map "\C-c?" 'TeX-doc)
+ (define-key map "\C-c\C-i" 'TeX-goto-info-page)
+ (define-key map "\r" 'TeX-newline)
+
+ ;; From tex.el
+ (define-key map "\"" 'TeX-insert-quote)
+ (define-key map "$" 'TeX-insert-dollar)
+ ;; Removed because LaTeX 2e have a better solution to italic correction.
+ ;; (define-key map "." 'TeX-insert-punctuation)
+ ;; (define-key map "," 'TeX-insert-punctuation)
+ (define-key map "\C-c{" 'TeX-insert-braces)
+ (define-key map "\C-c\C-f" 'TeX-font)
+ (define-key map "\C-c\C-m" 'TeX-insert-macro)
+ (define-key map "\\" 'TeX-insert-backslash)
+ (define-key map "^" 'TeX-insert-sub-or-superscript)
+ (define-key map "_" 'TeX-insert-sub-or-superscript)
+ (define-key map "\e\t" 'TeX-complete-symbol) ;*** Emacs 19 way
+
+ (define-key map "\C-c'" 'TeX-comment-or-uncomment-paragraph) ;*** Old
way
+ (define-key map "\C-c:" 'TeX-comment-or-uncomment-region) ;*** Old way
+ (define-key map "\C-c\"" 'TeX-uncomment) ;*** Old way
+
+ (define-key map "\C-c;" 'TeX-comment-or-uncomment-region)
+ (define-key map "\C-c%" 'TeX-comment-or-uncomment-paragraph)
+
+ (define-key map "\C-c\C-t\C-p" 'TeX-PDF-mode)
+ (define-key map "\C-c\C-t\C-i" 'TeX-interactive-mode)
+ (define-key map "\C-c\C-t\C-s" 'TeX-source-correlate-mode)
+ (define-key map "\C-c\C-t\C-r" 'TeX-pin-region)
+ (define-key map "\C-c\C-w" 'TeX-toggle-debug-bad-boxes); to be
removed
+ (define-key map "\C-c\C-t\C-b" 'TeX-toggle-debug-bad-boxes)
+ (define-key map "\C-c\C-t\C-w" 'TeX-toggle-debug-warnings)
+ (define-key map "\C-c\C-v" 'TeX-view)
+ ;; From tex-buf.el
+ (define-key map "\C-c\C-d" 'TeX-save-document)
+ (define-key map "\C-c\C-r" 'TeX-command-region)
+ (define-key map "\C-c\C-b" 'TeX-command-buffer)
+ (define-key map "\C-c\C-c" 'TeX-command-master)
+ (define-key map "\C-c\C-k" 'TeX-kill-job)
+ (define-key map "\C-c\C-l" 'TeX-recenter-output-buffer)
+ (define-key map "\C-c^" 'TeX-home-buffer)
+ (define-key map "\C-c`" 'TeX-next-error)
+ ;; Remap bindings of `next-error'
+ (if (featurep 'xemacs)
+ (substitute-key-definition 'next-error 'TeX-next-error map global-map)
+ (define-key map [remap next-error] 'TeX-next-error))
+ ;; Remap bindings of `previous-error'
+ (if (featurep 'xemacs)
+ (substitute-key-definition 'previous-error 'TeX-previous-error
+ map global-map)
+ (define-key map [remap previous-error] 'TeX-previous-error))
+ ;; From tex-fold.el
+ (define-key map "\C-c\C-o\C-f" 'TeX-fold-mode)
+
+ ;; Multifile
+ (define-key map "\C-c_" 'TeX-master-file-ask) ;*** temporary
+ map)
+ "Keymap for common TeX and LaTeX commands.")
+
+(defun TeX-mode-specific-command-menu (mode)
+ "Return a Command menu specific to the major MODE."
+ ;; COMPATIBILITY for Emacs < 21
+ (if (and (not (featurep 'xemacs))
+ (= emacs-major-version 20))
+ (cons TeX-command-menu-name
+ (TeX-mode-specific-command-menu-entries mode))
+ (list TeX-command-menu-name
+ :filter `(lambda (&rest ignored)
+ (TeX-mode-specific-command-menu-entries ',mode))
+ "Bug.")))
+
+(defun TeX-mode-specific-command-menu-entries (mode)
+ "Return the entries for a Command menu specific to the major MODE."
+ (append
+ (TeX-menu-with-help
+ `("Command on"
+ [ "Master File" TeX-command-select-master
+ :keys "C-c C-c" :style radio
+ :selected (eq TeX-command-current 'TeX-command-master)
+ :help "Commands in this menu work on the Master File"]
+ [ "Buffer" TeX-command-select-buffer
+ :keys "C-c C-b" :style radio
+ :selected (eq TeX-command-current 'TeX-command-buffer)
+ :help "Commands in this menu work on the current buffer"]
+ [ "Region" TeX-command-select-region
+ :keys "C-c C-r" :style radio
+ :selected (eq TeX-command-current 'TeX-command-region)
+ :help "Commands in this menu work on the region"]
+ [ "Fix the Region" TeX-pin-region
+ :active (or (if prefix-arg
+ (<= (prefix-numeric-value prefix-arg) 0)
+ (and (boundp 'TeX-command-region-begin)
+ (markerp TeX-command-region-begin)))
+ (TeX-mark-active))
+ ;;:visible (eq TeX-command-current 'TeX-command-region)
+ :style toggle
+ :selected (and (boundp 'TeX-command-region-begin)
+ (markerp TeX-command-region-begin))
+ :help "Fix the region for \"Command on Region\""]
+ "-"
+ ["Recenter Output Buffer" TeX-recenter-output-buffer
+ :help "Show the output of current TeX process"]
+ ["Kill Job" TeX-kill-job
+ :help "Kill the current TeX process"]
+ ["Next Error" TeX-next-error
+ :help "Jump to the next error of the last TeX run"]
+ ["Quick View" TeX-view
+ :help "Start a viewer without prompting"]
+ "-"
+ ("TeXing Options"
+ ,@(mapcar (lambda (x)
+ (let ((symbol (car x)) (name (nth 1 x)))
+ `[ ,(format "Use %s engine" name) (TeX-engine-set ',symbol)
+ :style radio :selected (eq TeX-engine ',symbol)
+ :help ,(format "Use %s engine for compiling" name) ]))
+ (TeX-engine-alist))
+ "-"
+ [ "Generate PDF" TeX-PDF-mode
+ :style toggle :selected TeX-PDF-mode
+ :active (not (eq TeX-engine 'omega))
+ :help "Use PDFTeX to generate PDF instead of DVI"]
+ [ "Run Interactively" TeX-interactive-mode
+ :style toggle :selected TeX-interactive-mode :keys "C-c C-t C-i"
+ :help "Stop on errors in a TeX run"]
+ [ "Correlate I/O" TeX-source-correlate-mode
+ :style toggle :selected TeX-source-correlate-mode
+ :help "Enable forward and inverse search in the previewer"]
+ ["Debug Bad Boxes" TeX-toggle-debug-bad-boxes
+ :style toggle :selected TeX-debug-bad-boxes :keys "C-c C-t C-b"
+ :help "Make \"Next Error\" show overfull and underfull boxes"]
+ ["Debug Warnings" TeX-toggle-debug-warnings
+ :style toggle :selected TeX-debug-warnings
+ :help "Make \"Next Error\" show warnings"])))
+ (let ((file 'TeX-command-on-current));; is this actually needed?
+ (TeX-maybe-remove-help
+ (delq nil
+ (mapcar 'TeX-command-menu-entry
+ (TeX-mode-specific-command-list mode)))))))
+
+(defun TeX-mode-specific-command-list (mode)
+ "Return the list of commands available in the given MODE."
+ (let ((full-list TeX-command-list)
+ out-list
+ entry)
+ (while (setq entry (pop full-list))
+ ;; `(nth 4 entry)' may be either an atom in case of which the
+ ;; entry should be present in any mode or a list of major modes.
+ (if (or (atom (nth 4 entry))
+ (memq mode (nth 4 entry)))
+ (push entry out-list)))
+ (nreverse out-list)))
+
+(defvar TeX-fold-menu
+ (TeX-menu-with-help
+ '("Show/Hide"
+ ["Fold Mode" TeX-fold-mode
+ :style toggle
+ :selected (and (boundp 'TeX-fold-mode) TeX-fold-mode)
+ :help "Toggle folding mode"]
+ "-"
+ ["Hide All in Current Buffer" TeX-fold-buffer
+ :active (and (boundp 'TeX-fold-mode) TeX-fold-mode)
+ :help "Hide all configured TeX constructs in the current buffer"]
+ ["Hide All in Current Region" TeX-fold-region
+ :active (and (boundp 'TeX-fold-mode) TeX-fold-mode)
+ :help "Hide all configured TeX constructs in the marked region"]
+ ["Hide All in Current Paragraph" TeX-fold-paragraph
+ :active (and (boundp 'TeX-fold-mode) TeX-fold-mode)
+ :help "Hide all configured TeX constructs in the paragraph containing
point"]
+ ["Hide Current Macro" TeX-fold-macro
+ :active (and (boundp 'TeX-fold-mode) TeX-fold-mode)
+ :help "Hide the macro containing point"]
+ ["Hide Current Environment" TeX-fold-env
+ :visible (not (eq major-mode 'plain-tex-mode))
+ :active (and (boundp 'TeX-fold-mode) TeX-fold-mode)
+ :help "Hide the environment containing point"]
+ ["Hide Current Comment" TeX-fold-comment
+ :active (and (boundp 'TeX-fold-mode) TeX-fold-mode)
+ :help "Hide the comment containing point"]
+ "-"
+ ["Show All in Current Buffer" TeX-fold-clearout-buffer
+ :active (and (boundp 'TeX-fold-mode) TeX-fold-mode)
+ :help "Permanently show all folded content again"]
+ ["Show All in Current Region" TeX-fold-clearout-region
+ :active (and (boundp 'TeX-fold-mode) TeX-fold-mode)
+ :help "Permanently show all folded content in marked region"]
+ ["Show All in Current Paragraph" TeX-fold-clearout-paragraph
+ :active (and (boundp 'TeX-fold-mode) TeX-fold-mode)
+ :help "Permanently show all folded content in paragraph containing
point"]
+ ["Show Current Item" TeX-fold-clearout-item
+ :active (and (boundp 'TeX-fold-mode) TeX-fold-mode)
+ :help "Permanently show the item containing point"]
+ "-"
+ ["Hide or Show Current Item" TeX-fold-dwim
+ :active (and (boundp 'TeX-fold-mode) TeX-fold-mode)
+ :help "Hide or show the item containing point"]))
+ "Menu definition for commands from tex-fold.el.")
+
+(defvar TeX-customization-menu nil)
+
+(defvar TeX-common-menu-entries
+ (TeX-menu-with-help
+ `(("Multifile/Parsing"
+ ["Switch to Master File" TeX-home-buffer
+ :help "Switch to buffer of Master File, or buffer of last TeX command"]
+ ["Save Document" TeX-save-document
+ :help "Save all buffers associated with the current Master File"]
+ ["Set Master File" TeX-master-file-ask
+ :active (not (TeX-local-master-p))
+ :help "Set the main file to run TeX commands on"]
+ ["Reset Buffer" TeX-normal-mode
+ :help "Save and reparse the current buffer for style information"]
+ ["Reset AUCTeX" (TeX-normal-mode t) :keys "C-u C-c C-n"
+ :help "Reset buffer and reload AUCTeX style files"])
+ ["Find Documentation..." TeX-doc
+ :help "Get help on commands, packages, or TeX-related topics in general"]
+ ["Read the AUCTeX Manual" TeX-goto-info-page
+ :help "Everything worth reading"]
+ ("Customize AUCTeX"
+ ["Browse Options"
+ (customize-group 'AUCTeX)
+ :help "Open the customization buffer for AUCTeX"]
+ ["Extend this Menu"
+ (progn
+ (easy-menu-add-item
+ nil
+ ;; Ugly hack because docTeX mode uses the LaTeX menu.
+ (list (if (eq major-mode 'doctex-mode) "LaTeX" TeX-base-mode-name))
+ (or TeX-customization-menu
+ (setq TeX-customization-menu
+ (customize-menu-create 'AUCTeX "Customize AUCTeX")))))
+ :help "Make this menu a full-blown customization menu"])
+ ["Report AUCTeX Bug" TeX-submit-bug-report
+ :help ,(format "Problems with AUCTeX %s? Mail us!"
+ AUCTeX-version)])))
+
+
+;;; Verbatim constructs
+
+(defvar TeX-verbatim-p-function nil
+ "Mode-specific function to be called by `TeX-verbatim-p'.")
+(make-variable-buffer-local 'TeX-verbatim-p-function)
+
+;; XXX: We only have an implementation for LaTeX mode at the moment (Oct 2009).
+(defun TeX-verbatim-p (&optional pos)
+ "Return non-nil if position POS is in a verbatim-like construct.
+A mode-specific implementation is required. If it is not
+available, the function always returns nil."
+ (when TeX-verbatim-p-function
+ (funcall TeX-verbatim-p-function)))
+
+
+;;; Comments
+
+(defvar TeX-comment-start-regexp "%"
+ "Regular expression matching a comment starter.
+Unlike the variable `comment-start-skip' it should not match any
+whitespace after the comment starter or any character before it.")
+(make-variable-buffer-local 'TeX-comment-start-regexp)
+
+(defun TeX-comment-region (beg end &optional arg)
+ "Comment each line in the region from BEG to END.
+Numeric prefix arg ARG means use ARG comment characters.
+If ARG is negative, delete that many comment characters instead."
+ (interactive "*r\nP")
+ ;; `comment-padding' will not be recognized in XEmacs' (21.4)
+ ;; `comment-region', so we temporarily modify `comment-start' to get
+ ;; proper spacing. Unfortunately we have to check for the XEmacs
+ ;; version and cannot test if `comment-padding' is bound as this
+ ;; gets initialized in `VirTeX-common-initialization'.
+ (let ((comment-start (if (and (featurep 'xemacs)
+ (= emacs-major-version 21)
+ (<= emacs-minor-version 4))
+ (concat comment-start (TeX-comment-padding-string))
+ comment-start)))
+ (comment-region beg end arg)))
+
+(eval-and-compile
+ ;; COMPATIBILITY for Emacs <= 21.3
+ (if (fboundp 'comment-or-uncomment-region)
+ (defalias 'TeX-comment-or-uncomment-region 'comment-or-uncomment-region)
+ ;; The following function was copied from `newcomment.el' on
+ ;; 2004-01-30 and adapted accordingly
+ (defun TeX-comment-or-uncomment-region (beg end &optional arg)
+ "Comment or uncomment a the region from BEG to END.
+Call `TeX-comment-region', unless the region only consists of
+comments, in which case call `TeX-uncomment-region'. If a prefix
+arg ARG is given, it is passed on to the respective function."
+ (interactive "*r\nP")
+ (funcall (if (save-excursion ;; check for already commented region
+ (goto-char beg)
+ (TeX-comment-forward (point-max))
+ (<= end (point)))
+ 'TeX-uncomment-region 'TeX-comment-region)
+ beg end arg)))
+
+ ;; COMPATIBILITY for Emacs <= 20. (Introduced in 21.1?)
+ (if (fboundp 'uncomment-region)
+ (defalias 'TeX-uncomment-region 'uncomment-region)
+ (defun TeX-uncomment-region (beg end &optional arg)
+ "Remove comment characters from the beginning of each line
+in the region from BEG to END. Numeric prefix arg ARG means use
+ARG comment characters. If ARG is negative, delete that many
+comment characters instead."
+ (interactive "*r\nP")
+ (or arg
+ ;; Determine the number of comment characters at the
+ ;; beginning of the first commented line.
+ (setq arg
+ (save-excursion
+ (goto-char beg)
+ (re-search-forward
+ (concat "^" TeX-comment-start-regexp "+") end t)
+ (length (match-string 0)))))
+ (comment-region beg end (- arg)))))
+
+(defun TeX-uncomment ()
+ "Delete comment characters from the beginning of each line in a comment."
+ (interactive)
+ (save-excursion
+ ;; Find first comment line
+ (beginning-of-line)
+ (while (and (looking-at (concat "^[ \t]*" TeX-comment-start-regexp))
+ (not (bobp)))
+ (forward-line -1))
+ (let ((beg (point)))
+ (forward-line 1)
+ ;; Find last comment line
+ (while (and (looking-at (concat "^[ \t]*" TeX-comment-start-regexp))
+ (not (eobp)))
+ (forward-line 1))
+ ;; Uncomment region
+ (TeX-uncomment-region beg (point)))))
+
+(defun TeX-comment-or-uncomment-paragraph ()
+ "Comment or uncomment current paragraph."
+ (interactive)
+ (if (TeX-in-commented-line)
+ (TeX-uncomment)
+ (save-excursion
+ (beginning-of-line)
+ ;; Don't do anything if we are in an empty line. If this line
+ ;; is followed by a lot of commented lines, this shall prevent
+ ;; that mark-paragraph skips over these lines and marks a
+ ;; paragraph outside the visible window which might get
+ ;; commented without the user noticing.
+ (unless (looking-at "^[ \t]*$")
+ (mark-paragraph)
+ (TeX-comment-region (point) (mark))))))
+
+(defun TeX-in-comment ()
+ "Return non-nil if point is in a comment."
+ (if (or (bolp)
+ (null comment-start-skip)
+ (eq (preceding-char) ?\r))
+ nil
+ (save-excursion
+ (save-match-data
+ (let ((pos (point)))
+ (beginning-of-line)
+ (and (or (looking-at comment-start-skip)
+ (re-search-forward comment-start-skip pos t))
+ (not (TeX-verbatim-p))))))))
+
+(defun TeX-in-commented-line ()
+ "Return non-nil if point is in a line consisting only of a comment.
+The comment can be preceded by whitespace. This means that
+`TeX-in-commented-line' is more general than `TeX-in-line-comment'
+which will not match commented lines with leading whitespace. But
+`TeX-in-commented-line' will match commented lines without leading
+whitespace as well."
+ (save-excursion
+ (forward-line 0)
+ (skip-chars-forward " \t")
+ (string= (buffer-substring-no-properties
+ (point) (min (point-max) (+ (point) (length comment-start))))
+ comment-start)))
+
+(defun TeX-in-line-comment ()
+ "Return non-nil if point is in a line comment.
+A line comment is a comment starting in column one, i.e. there is
+no whitespace before the comment sign."
+ (save-excursion
+ (forward-line 0)
+ (string= (buffer-substring-no-properties
+ (point) (min (point-max) (+ (point) (length comment-start))))
+ comment-start)))
+
+(defun TeX-comment-prefix ()
+ "Return the comment prefix of the current line.
+If there are no comment starters after potential whitespace at
+the beginning of the line, return nil."
+ (save-excursion
+ (beginning-of-line)
+ (save-match-data
+ (when (looking-at (concat "\\([ \t]*" TeX-comment-start-regexp "+\\)+"))
+ (match-string 0)))))
+
+(defun TeX-forward-comment-skip (&optional count limit)
+ "Move forward to the next comment skip.
+This may be a switch between commented and not commented adjacent
+lines or between lines with different comment prefixes. With
+argument COUNT do it COUNT times. If argument LIMIT is given, do
+not move point further than this value."
+ (unless count (setq count 1))
+ ;; A value of 0 is nonsense.
+ (when (= count 0) (setq count 1))
+ (unless limit (setq limit (point-max)))
+ (dotimes (i (abs count))
+ (if (< count 0)
+ (forward-line -1)
+ (beginning-of-line))
+ (let ((prefix (when (looking-at (concat "\\([ \t]*"
+ TeX-comment-start-regexp "+\\)+"))
+ (buffer-substring (+ (line-beginning-position)
+ (current-indentation))
+ (match-end 0)))))
+ (while (save-excursion
+ (and (if (> count 0)
+ (<= (point) limit)
+ (>= (point) limit))
+ (zerop (if (> count 0)
+ (forward-line 1)
+ (forward-line -1)))
+ (if prefix
+ (if (looking-at (concat "\\([ \t]*"
+ TeX-comment-start-regexp
+ "+\\)+"))
+ ;; If the preceding line is a commented line
+ ;; as well, check if the prefixes are
+ ;; identical.
+ (string= prefix
+ (buffer-substring
+ (+ (line-beginning-position)
+ (current-indentation))
+ (match-end 0)))
+ nil)
+ (not (looking-at (concat "[ \t]*"
+ TeX-comment-start-regexp))))))
+ (if (> count 0)
+ (forward-line 1)
+ (forward-line -1)))
+ (if (> count 0)
+ (forward-line 1)))))
+
+(defun TeX-backward-comment-skip (&optional count limit)
+ "Move backward to the next comment skip.
+This may be a switch between commented and not commented adjacent
+lines or between lines with different comment prefixes. With
+argument COUNT do it COUNT times. If argument LIMIT is given, do
+not move point to a position less than this value."
+ (unless count (setq count 1))
+ (when (= count 0) (setq count 1))
+ (unless limit (setq limit (point-min)))
+ (TeX-forward-comment-skip (- count) limit))
+
+;; Taken from `comment-forward' in Emacs' CVS on 2006-12-26. Used as
+;; a compatibility function for XEmacs 21.4.
+(defun TeX-comment-forward (&optional n)
+ "Skip forward over N comments.
+Just like `forward-comment' but only for positive N
+and can use regexps instead of syntax."
+ (when (fboundp 'comment-normalize-vars)
+ (comment-normalize-vars))
+ (if (fboundp 'comment-forward)
+ (comment-forward n)
+ (setq n (or n 1))
+ (if (< n 0) (error "No comment-backward")
+ (if comment-use-syntax (forward-comment n)
+ (while (> n 0)
+ (setq n
+ (if (or (forward-comment 1)
+ (and (looking-at comment-start-skip)
+ (goto-char (match-end 0))
+ (re-search-forward comment-end-skip nil 'move)))
+ (1- n) -1)))
+ (= n 0)))))
+
+(defun TeX-comment-padding-string ()
+ "Return comment padding as a string.
+The variable `comment-padding' can hold an integer or a string.
+This function will return the appropriate string representation
+regardless of its data type."
+ (if (integerp comment-padding)
+ (make-string comment-padding ? )
+ comment-padding))
+
+
+;;; Indentation
+
+(defgroup TeX-indentation nil
+ "Indentation of TeX buffers in AUCTeX."
+ :group 'AUCTeX)
+
+(defcustom TeX-brace-indent-level 2
+ "*The level of indentation produced by an open brace."
+ :group 'TeX-indentation
+ :type 'integer)
+
+(defun TeX-comment-indent ()
+ "Determine the indentation of a comment."
+ (if (looking-at "%%%")
+ (current-column)
+ (skip-chars-backward " \t")
+ (max (if (bolp) 0 (1+ (current-column)))
+ comment-column)))
+
+(defun TeX-brace-count-line ()
+ "Count number of open/closed braces."
+ (save-excursion
+ (let ((count 0) (limit (line-end-position)) char)
+ (while (progn
+ (skip-chars-forward "^{}\\\\" limit)
+ (when (and (< (point) limit) (not (TeX-in-comment)))
+ (setq char (char-after))
+ (forward-char)
+ (cond ((eq char ?\{)
+ (setq count (+ count TeX-brace-indent-level)))
+ ((eq char ?\})
+ (setq count (- count TeX-brace-indent-level)))
+ ((eq char ?\\)
+ (when (< (point) limit)
+ (forward-char)
+ t))))))
+ count)))
+
+;;; Navigation
+
+(defvar TeX-search-syntax-table
+ (let ((table (make-syntax-table (make-char-table (if (featurep 'xemacs)
+ 'syntax
+ 'syntax-table)))))
+ ;; Preset mode-independent syntax entries. (Mode-dependent
+ ;; entries are set in the function `TeX-search-syntax-table'.)
+ ;; ?\", ?\( and ?\) explicitely get whitespace syntax because
+ ;; Emacs 21.3 and XEmacs don't generate a completely empty syntax
+ ;; table.
+ (dolist (elt '((?\f . ">") (?\n . ">") (?\" . " ") (?\( . " ") (?\) . "
")))
+ (modify-syntax-entry (car elt) (cdr elt) table))
+ table)
+ "Syntax table used for searching purposes.
+It should be accessed through the function `TeX-search-syntax-table'.")
+
+(defun TeX-search-syntax-table (&rest args)
+ "Return a syntax table for searching purposes.
+ARGS may be a list of characters. For each of them the
+respective predefined syntax is set. Currently the parenthetical
+characters ?{, ?}, ?[, ?], ?\(, ?\), ?<, and ?> are supported.
+The syntax of each of these characters not specified will be
+reset to \" \"."
+ (let ((char-syntax-alist '((?\{ . "(}") (?\} . "){")
+ (?\[ . "(]") (?\] . ")[")
+ (?\( . "()") (?\) . ")(")
+ (?\< . "(>") (?\> . ")<"))))
+ ;; Clean entries possibly set before.
+ (modify-syntax-entry ?\\ " " TeX-search-syntax-table)
+ (modify-syntax-entry ?@ " " TeX-search-syntax-table)
+ (modify-syntax-entry ?\% " " TeX-search-syntax-table)
+ ;; Preset mode-dependent syntax entries. (Mode-independent entries
+ ;; are set when the variable `TeX-search-syntax-table' is created.)
+ (modify-syntax-entry (string-to-char TeX-esc) "\\" TeX-search-syntax-table)
+ (unless (eq major-mode 'texinfo-mode)
+ (modify-syntax-entry ?\% "<" TeX-search-syntax-table))
+ ;; Clean up the entries which can be specified as arguments.
+ (dolist (elt char-syntax-alist)
+ (modify-syntax-entry (car elt) " " TeX-search-syntax-table))
+ ;; Now set what we got.
+ (dolist (elt args)
+ (unless (assoc elt char-syntax-alist) (error "Char not supported"))
+ (modify-syntax-entry elt (cdr (assoc elt char-syntax-alist))
+ TeX-search-syntax-table))
+ ;; Return the syntax table.
+ TeX-search-syntax-table))
+
+(defun TeX-find-balanced-brace (&optional count depth limit)
+ "Return the position of a balanced brace in a TeX group.
+The function scans forward COUNT parenthetical groupings.
+Default is 1. If COUNT is negative, it searches backwards. With
+optional DEPTH>=1, find that outer level. If LIMIT is non-nil,
+do not search further than this position in the buffer."
+ (let ((count (if count
+ (if (= count 0) (error "COUNT has to be <> 0") count)
+ 1))
+ (depth (if depth
+ (if (< depth 1) (error "DEPTH has to be > 0") depth)
+ 1)))
+ (save-restriction
+ (when limit
+ (if (> count 0)
+ (narrow-to-region (point-min) limit)
+ (narrow-to-region limit (point-max))))
+ (with-syntax-table (TeX-search-syntax-table ?\{ ?\})
+ (condition-case nil
+ (scan-lists (point) count depth)
+ (error nil))))))
+
+(defun TeX-find-closing-brace (&optional depth limit)
+ "Return the position of the closing brace in a TeX group.
+The function assumes that point is inside the group, i.e. after
+an opening brace. With optional DEPTH>=1, find that outer level.
+If LIMIT is non-nil, do not search further down than this
+position in the buffer."
+ (TeX-find-balanced-brace 1 depth limit))
+
+(defun TeX-find-opening-brace (&optional depth limit)
+ "Return the position of the opening brace in a TeX group.
+The function assumes that point is inside the group, i.e. before
+a closing brace. With optional DEPTH>=1, find that outer level.
+If LIMIT is non-nil, do not search further up than this position
+in the buffer."
+ (TeX-find-balanced-brace -1 depth limit))
+
+(defun TeX-find-macro-boundaries (&optional lower-bound)
+ "Return a list containing the start and end of a macro.
+If LOWER-BOUND is given, do not search backward further than this
+point in buffer. Arguments enclosed in brackets or braces are
+considered part of the macro."
+ (save-restriction
+ (when lower-bound
+ (narrow-to-region lower-bound (point-max)))
+ (let ((orig-point (point))
+ start-point)
+ ;; Point is located directly at the start of a macro. (-!-\foo{bar})
+ (when (and (eq (char-after) (aref TeX-esc 0))
+ (not (TeX-escaped-p)))
+ (setq start-point (point)))
+ ;; Point is located on a macro. (\fo-!-o{bar})
+ (unless start-point
+ (save-excursion
+ (skip-chars-backward "A-Za-z@*")
+ (when (and (eq (char-before) (aref TeX-esc 0))
+ (not (TeX-escaped-p (1- (point)))))
+ (setq start-point (1- (point))))))
+ ;; Point is located in the argument of a macro. (\foo{ba-!-r})
+ (unless start-point
+ (save-excursion
+ (catch 'abort
+ (let ((parse-sexp-ignore-comments t))
+ (when (condition-case nil (progn (up-list) t) (error nil))
+ (while (progn
+ (condition-case nil (backward-sexp)
+ (error (throw 'abort nil)))
+ (forward-comment -1)
+ (and (memq (char-before) '(?\] ?\}))
+ (not (TeX-escaped-p (1- (point)))))))
+ (skip-chars-backward "A-Za-z@*")
+ (when (and (eq (char-before) (aref TeX-esc 0))
+ (not (TeX-escaped-p (1- (point)))))
+ (setq start-point (1- (point)))))))))
+ ;; Search forward for the end of the macro.
+ (when start-point
+ (save-excursion
+ (goto-char (TeX-find-macro-end-helper start-point))
+ (if (< orig-point (point))
+ (cons start-point (point))
+ nil))))))
+
+(defun TeX-find-macro-end-helper (start)
+ "Find the end of a macro given its START.
+START is the position just before the starting token of the macro.
+If the macro is followed by square brackets or curly braces,
+those will be considered part of it."
+ (save-excursion
+ (save-match-data
+ (catch 'found
+ (goto-char (1+ start))
+ (if (zerop (skip-chars-forward "A-Za-z@"))
+ (forward-char)
+ (skip-chars-forward "*"))
+ (while (not (eobp))
+ (cond
+ ;; Skip over pairs of square brackets
+ ((or (looking-at "[ \t]*\n?\\(\\[\\)") ; Be conservative: Consider
+ ; only consecutive lines.
+ (and (looking-at (concat "[ \t]*" TeX-comment-start-regexp))
+ (save-excursion
+ (forward-line 1)
+ (looking-at "[ \t]*\\(\\[\\)"))))
+ (goto-char (match-beginning 1))
+ (condition-case nil
+ (forward-sexp)
+ (scan-error (throw 'found (point)))))
+ ;; Skip over pairs of curly braces
+ ((or (looking-at "[ \t]*\n?{") ; Be conservative: Consider
+ ; only consecutive lines.
+ (and (looking-at (concat "[ \t]*" TeX-comment-start-regexp))
+ (save-excursion
+ (forward-line 1)
+ (looking-at "[ \t]*{"))))
+ (goto-char (match-end 0))
+ (goto-char (or (TeX-find-closing-brace)
+ ;; If we cannot find a regular end, use the
+ ;; next whitespace.
+ (save-excursion (skip-chars-forward "^ \t\n")
+ (point))))
+ (when (eobp) (throw 'found (point))))
+ (t
+ (throw 'found (point)))))))))
+
+(defun TeX-find-macro-start (&optional limit)
+ "Return the start of a macro.
+If LIMIT is given, do not search backward further than this point
+in buffer. Arguments enclosed in brackets or braces are
+considered part of the macro."
+ (car (TeX-find-macro-boundaries limit)))
+
+(defun TeX-find-macro-end ()
+ "Return the end of a macro.
+Arguments enclosed in brackets or braces are considered part of
+the macro."
+ (cdr (TeX-find-macro-boundaries)))
+
+(defun TeX-search-forward-unescaped (string &optional bound noerror)
+ "Search forward from point for unescaped STRING.
+The optional argument BOUND limits the search to the respective
+buffer position.
+If NOERROR is non-nil, return nil if the search failed instead of
+throwing an error.
+A pattern is escaped, if it is preceded by an odd number of escape
+characters."
+ (TeX-search-unescaped string 'forward nil bound noerror))
+
+(defun TeX-search-backward-unescaped (string &optional bound noerror)
+ "Search backward from point for unescaped STRING.
+The optional argument BOUND limits the search to the respective
+buffer position.
+If NOERROR is non-nil, return nil if the search failed instead of
+throwing an error.
+A pattern is escaped, if it is preceded by an odd number of escape
+characters."
+ (TeX-search-unescaped string 'backward nil bound noerror))
+
+(defun TeX-re-search-forward-unescaped (regexp &optional bound noerror)
+ "Search forward from point for unescaped regular expression REGEXP.
+The optional argument BOUND limits the search to the respective
+buffer position.
+If NOERROR is non-nil, return nil if the search failed instead of
+throwing an error.
+A pattern is escaped, if it is preceded by an odd number of escape
+characters."
+ (TeX-search-unescaped regexp 'forward t bound noerror))
+
+(defun TeX-search-unescaped (pattern
+ &optional direction regexp-flag bound noerror)
+ "Search for unescaped PATTERN in a certain DIRECTION.
+DIRECTION can be indicated by the symbols 'forward and 'backward.
+If DIRECTION is omitted, a forward search is carried out.
+If REGEXP-FLAG is non-nil, PATTERN may be a regular expression,
+otherwise a string.
+The optional argument BOUND limits the search to the respective
+buffer position.
+If NOERROR is non-nil, return nil if the search failed instead of
+throwing an error.
+A pattern is escaped, if it is preceded by an odd number of escape
+characters."
+ (let ((search-fun (if (eq direction 'backward)
+ (if regexp-flag 're-search-backward 'search-backward)
+ (if regexp-flag 're-search-forward 'search-forward))))
+ (catch 'found
+ (while (funcall search-fun pattern bound noerror)
+ (when (not (TeX-escaped-p (match-beginning 0)))
+ (throw 'found (point)))))))
+
+(defun TeX-escaped-p (&optional pos)
+ "Return t if the character at position POS is escaped.
+If POS is omitted, examine the character at point.
+A character is escaped if it is preceded by an odd number of
+escape characters, such as \"\\\" in LaTeX."
+ (save-excursion
+ (when pos (goto-char pos))
+ (not (zerop (mod (skip-chars-backward (regexp-quote TeX-esc)) 2)))))
+
+(defun TeX-current-macro ()
+ "Return the name of the macro containing point, nil if there is none."
+ (let ((macro-start (TeX-find-macro-start)))
+ (when macro-start
+ (save-excursion
+ (goto-char macro-start)
+ (forward-char (length TeX-esc))
+ (buffer-substring-no-properties
+ (point) (progn (skip-chars-forward "@A-Za-z") (point)))))))
+
+(defvar TeX-search-forward-comment-start-function nil
+ "Function to find the start of a comment.
+The function should accept an optional argument for specifying
+the limit of the search. It should return the position just
+before the comment if one is found and nil otherwise. Point
+should not be moved.")
+(make-variable-buffer-local 'TeX-search-forward-comment-start-function)
+
+(defun TeX-search-forward-comment-start (&optional limit)
+ "Search forward for a comment start from current position till LIMIT.
+If LIMIT is omitted, search till the end of the buffer.
+
+The search relies on `TeX-comment-start-regexp' being set
+correctly for the current mode.
+
+Set `TeX-search-forward-comment-start-defun' in order to override
+the default implementation."
+ (if TeX-search-forward-comment-start-function
+ (funcall TeX-search-forward-comment-start-function limit)
+ (setq limit (or limit (point-max)))
+ (when (TeX-re-search-forward-unescaped TeX-comment-start-regexp limit t)
+ (match-beginning 0))))
+
+;;; Fonts
+
+(defcustom TeX-font-list '((?\C-b "{\\bf " "}")
+ (?\C-c "{\\sc " "}")
+ (?\C-e "{\\em " "\\/}")
+ (?\C-i "{\\it " "\\/}")
+ (?\C-r "{\\rm " "}")
+ (?\C-s "{\\sl " "\\/}")
+ (?\C-t "{\\tt " "}")
+ (?\C-d "" "" t))
+ "List of fonts used by `TeX-font'.
+
+Each entry is a list.
+The first element is the key to activate the font.
+The second element is the string to insert before point, and the third
+element is the string to insert after point.
+If the fourth and fifth element are strings, they specify the prefix and
+suffix to be used in math mode.
+An optional fourth (or sixth) element means always replace if t."
+ :group 'TeX-macro
+ :type '(repeat
+ (group
+ :value (?\C-a "" "")
+ (character :tag "Key")
+ (string :tag "Prefix")
+ (string :tag "Suffix")
+ (option (group
+ :inline t
+ (string :tag "Math Prefix")
+ (string :tag "Math Suffix")))
+ (option (sexp :format "Replace\n" :value t)))))
+
+(defvar TeX-font-replace-function 'TeX-font-replace
+ "Determines the function which is called when a font should be replaced.")
+
+(defun TeX-describe-font-entry (entry)
+ "A textual description of an ENTRY in `TeX-font-list'."
+ (concat (format "%16s " (key-description (char-to-string (nth 0 entry))))
+ (if (or (eq t (nth 3 entry)) (eq t (nth 5 entry)))
+ "-- delete font"
+ (format "%14s %-3s %14s %-3s"
+ (nth 1 entry) (nth 2 entry)
+ (if (stringp (nth 3 entry)) (nth 3 entry) "")
+ (if (stringp (nth 4 entry)) (nth 4 entry) "")))))
+
+(defun TeX-font (replace what)
+ "Insert template for font change command.
+If REPLACE is not nil, replace current font. WHAT determines the font
+to use, as specified by `TeX-font-list'."
+ (interactive "*P\nc")
+ (TeX-update-style)
+ (let* ((entry (assoc what TeX-font-list))
+ (in-math (texmathp))
+ (before (nth 1 entry))
+ (after (nth 2 entry)))
+ (setq replace (or replace (eq t (nth 3 entry)) (eq t (nth 5 entry))))
+ (if (and in-math (stringp (nth 3 entry)))
+ (setq before (nth 3 entry)
+ after (nth 4 entry)))
+ (cond ((null entry)
+ (let ((help (concat
+ "Font list: "
+ "KEY TEXTFONT MATHFONT\n\n"
+ (mapconcat 'TeX-describe-font-entry
+ TeX-font-list "\n"))))
+ (with-output-to-temp-buffer "*Help*"
+ (set-buffer "*Help*")
+ (insert help))))
+ (replace
+ (funcall TeX-font-replace-function before after))
+ ((TeX-active-mark)
+ (save-excursion
+ (cond ((> (mark) (point))
+ (insert before)
+ (goto-char (mark))
+ (insert after))
+ (t
+ (insert after)
+ (goto-char (mark))
+ (insert before)))))
+ (t
+ (insert before)
+ (save-excursion
+ (insert after))))))
+
+(defun TeX-font-replace (start end)
+ "Replace font specification around point with START and END.
+For modes with font specifications like `{\\font text}'.
+See also `TeX-font-replace-macro' and `TeX-font-replace-function'."
+ (save-excursion
+ (while (not (looking-at "{\\\\[a-zA-Z]+ "))
+ (up-list -1))
+ (forward-sexp)
+ (save-excursion
+ (replace-match start t t))
+ (if (save-excursion
+ (backward-char 3)
+ (if (looking-at (regexp-quote "\\/}"))
+ (progn
+ (delete-char 3)
+ nil)
+ t))
+ (delete-backward-char 1))
+ (insert end)))
+
+(defun TeX-font-replace-macro (start end)
+ "Replace font specification around point with START and END.
+For modes with font specifications like `\\font{text}'.
+See also `TeX-font-replace' and `TeX-font-replace-function'."
+ (let ((font-list TeX-font-list)
+ cmds strings regexp)
+ (while font-list
+ (setq strings (cdr (car font-list))
+ font-list (cdr font-list))
+ (and (stringp (car strings)) (null (string= (car strings) ""))
+ (setq cmds (cons (car strings) cmds)))
+ (setq strings (cdr (cdr strings)))
+ (and (stringp (car strings)) (null (string= (car strings) ""))
+ (setq cmds (cons (car strings) cmds))))
+ (setq regexp (mapconcat 'regexp-quote cmds "\\|"))
+ (save-excursion
+ (catch 'done
+ (while t
+ (if (/= ?\\ (following-char))
+ (skip-chars-backward "a-zA-Z "))
+ (skip-chars-backward (regexp-quote TeX-esc))
+ (if (looking-at regexp)
+ (throw 'done t)
+ (up-list -1))))
+ ;; Use stripped syntax table in order to get stuff like "\emph{(}" right.
+ (with-syntax-table (TeX-search-syntax-table ?\{ ?\})
+ (forward-sexp 2))
+ (save-excursion
+ (replace-match start t t))
+ (delete-backward-char 1)
+ (insert end))))
+
+;;; Dollars
+;;
+;; Rewritten from scratch with use of `texmathp' by
+;; Carsten Dominik <dominik@strw.leidenuniv.nl>
+
+(defvar TeX-symbol-marker nil)
+
+(defvar TeX-symbol-marker-pos 0)
+
+;; The following constants are no longer used, but kept in case some
+;; foreign code uses any of them.
+(defvar TeX-dollar-sign ?$
+ "*Character used to enter and leave math mode in TeX.")
+(defconst TeX-dollar-string (char-to-string TeX-dollar-sign))
+(defconst TeX-dollar-regexp
+ (concat "^" (regexp-quote TeX-dollar-string) "\\|[^" TeX-esc "]"
+ (regexp-quote TeX-dollar-string)))
+
+(defcustom TeX-math-toggle-off-input-method t
+ "*If non-nil, auto toggle off CJK input methods when entering math mode."
+ :group 'TeX-macro
+ :type 'boolean)
+
+(defcustom TeX-math-close-double-dollar nil
+ "If non-nil close double dollar math by typing a single `$'."
+ :group 'TeX-macro
+ :type 'boolean)
+
+(defun TeX-insert-dollar (&optional arg)
+ "Insert dollar sign.
+
+If current math mode was not entered with a dollar, refuse to
+insert one. Show matching dollar sign if this dollar sign ends
+the TeX math mode and `blink-matching-paren' is non-nil. Ensure
+double dollar signs match up correctly by inserting extra dollar
+signs when needed.
+
+With raw \\[universal-argument] prefix, insert exactly one dollar
+sign. With optional ARG, insert that many dollar signs."
+ (interactive "P")
+ (cond
+ ((and arg (listp arg))
+ ;; C-u always inserts one
+ (insert "$"))
+ (arg
+ ;; Numerical arg inserts that many
+ (insert (make-string (prefix-numeric-value arg) ?\$)))
+ ((TeX-escaped-p)
+ ;; This is escaped with `\', so just insert one.
+ (insert "$"))
+ ((texmathp)
+ ;; We are inside math mode
+ (if (and (stringp (car texmathp-why))
+ (string-equal (substring (car texmathp-why) 0 1) "\$"))
+ ;; Math mode was turned on with $ or $$ - so finish it accordingly.
+ (progn
+ (if TeX-math-close-double-dollar
+ (insert (car texmathp-why))
+ (insert "$"))
+ (when (and blink-matching-paren
+ (or (string= (car texmathp-why) "$")
+ (zerop (mod (save-excursion
+ (skip-chars-backward "$")) 2))))
+ (save-excursion
+ (goto-char (cdr texmathp-why))
+ (if (pos-visible-in-window-p)
+ (sit-for 1)
+ (message "Matches %s"
+ (buffer-substring
+ (point) (progn (end-of-line) (point))))))))
+ ;; Math mode was not entered with dollar - we cannot finish it with one.
+ (message "Math mode started with `%s' cannot be closed with dollar"
+ (car texmathp-why))
+ (insert "$")))
+ (t
+ ;; Just somewhere in the text.
+ (insert "$")))
+ (TeX-math-input-method-off))
+
+(defvar TeX-math-input-method-off-regexp
+ "^\\(chinese\\|japanese\\|korean\\|bulgarian\\|russian\\)"
+ "Regexp matching input methods to be deactivated when entering math mode.")
+
+(defun TeX-math-input-method-off ()
+ "Toggle off input method when entering math mode."
+ (and TeX-math-toggle-off-input-method
+ (texmathp)
+ (boundp 'current-input-method) current-input-method
+ (string-match TeX-math-input-method-off-regexp current-input-method)
+ (inactivate-input-method)))
+
+;;; Simple Commands
+
+(defun TeX-normal-mode (arg)
+ "Remove all information about this buffer, and apply the style hooks again.
+Save buffer first including style information.
+With optional argument ARG, also reload the style hooks."
+ ;; FIXME: Shouldn't it be (&optional arg)? -- rs
+ (interactive "*P")
+ (if arg
+ (setq TeX-style-hook-list nil
+ BibTeX-global-style-files nil
+ BibTeX-global-files nil
+ TeX-Biber-global-files nil
+ TeX-global-input-files nil))
+ (let ((TeX-auto-save t))
+ (if (buffer-modified-p)
+ (save-buffer)
+ (TeX-auto-write)))
+ (normal-mode)
+ ;; See also addition to `find-file-hooks' in `VirTeX-common-initialization'.
+ (when (eq TeX-master 'shared) (TeX-master-file nil nil t))
+ (TeX-update-style t))
+
+(defgroup TeX-quote nil
+ "Quoting in AUCTeX."
+ :group 'AUCTeX)
+
+(defcustom TeX-open-quote "``"
+ "String inserted by typing \\[TeX-insert-quote] to open a quotation."
+ :group 'TeX-quote
+ :type 'string)
+
+(defcustom TeX-close-quote "''"
+ "String inserted by typing \\[TeX-insert-quote] to close a quotation."
+ :group 'TeX-quote
+ :type 'string)
+
+(defcustom TeX-quote-after-quote nil
+ "Behaviour of \\[TeX-insert-quote].
+Nil means standard behaviour; when non-nil, opening and closing
+quotes are inserted only after \"."
+ :group 'TeX-quote
+ :type 'boolean)
+
+(defcustom TeX-quote-language-alist nil
+ "Alist for overriding the default language-specific quote insertion.
+First element in each item is the name of the language as set by
+the language style file as a string. Second element is the
+opening quotation mark. Third elemxent is the closing quotation
+mark. Opening and closing quotation marks can be specified
+directly as strings or as functions returning a string. Fourth
+element is a boolean specifying insertion behavior, overriding
+`TeX-quote-after-quote'. See Info node `(auctex)European' for
+valid languages."
+ :group 'TeX-quote
+ :link '(custom-manual "(auctex)European")
+ :type '(repeat (group (choice
+ (const "czech")
+ (const "danish")
+ (const "dutch")
+ (const "german")
+ (const "ngerman")
+ (const "french") ;; not frenchb or francais
+ (const "italian")
+ (const "polish")
+ (const "slovak")
+ (const "swedish")
+ (string :tag "Other Language"))
+ (choice :tag "Opening quotation mark" string function)
+ (choice :tag "Closing quotation mark" string function)
+ (boolean :tag "Insert plain quote first" :value t))))
+
+(defvar TeX-quote-language nil
+ "If non-nil determines behavior of quote insertion.
+It is usually set by language-related style files. Its value has
+the same structure as the elements of `TeX-quote-language-alist'.
+The symbol 'override can be used as its car in order to override
+the settings of style files. Style files should therefore check
+if this symbol is present and not alter `TeX-quote-language' if
+it is.")
+(make-variable-buffer-local 'TeX-quote-language)
+
+(defun TeX-insert-quote (force)
+ "Insert the appropriate quotation marks for TeX.
+Inserts the value of `TeX-open-quote' (normally ``) or `TeX-close-quote'
+\(normally '') depending on the context. If `TeX-quote-after-quote'
+is non-nil, this insertion works only after \".
+With prefix argument FORCE, always inserts \" characters."
+ (interactive "*P")
+ (if (or force
+ ;; Do not insert TeX quotes in verbatim, math or comment constructs.
+ (and (fboundp 'font-latex-faces-present-p)
+ (font-latex-faces-present-p '(font-latex-verbatim-face
+ font-latex-math-face
+ font-lock-comment-face))
+ (font-latex-faces-present-p '(font-latex-verbatim-face
+ font-latex-math-face
+ font-lock-comment-face)
+ (1- (point))))
+ (texmathp)
+ (and (TeX-in-comment) (not (eq major-mode 'doctex-mode))))
+ (self-insert-command (prefix-numeric-value force))
+ (TeX-update-style)
+ (let* ((lang-override (if (eq (car TeX-quote-language) 'override)
+ TeX-quote-language
+ (assoc (car TeX-quote-language)
+ TeX-quote-language-alist)))
+ (lang (or lang-override TeX-quote-language))
+ (open-quote (if lang (nth 1 lang) TeX-open-quote))
+ (close-quote (if lang (nth 2 lang) TeX-close-quote))
+ (q-after-q (if lang (nth 3 lang) TeX-quote-after-quote)))
+ (when (functionp open-quote)
+ (setq open-quote (funcall open-quote)))
+ (when (functionp close-quote)
+ (setq close-quote (funcall close-quote)))
+ (if q-after-q
+ (insert (cond ((bobp)
+ ?\")
+ ((save-excursion
+ (TeX-looking-at-backward
+ (concat (regexp-quote open-quote) "\\|"
+ (regexp-quote close-quote))
+ (max (length open-quote) (length close-quote))))
+ (delete-backward-char (length (match-string 0)))
+ "\"\"")
+ ((< (save-excursion (skip-chars-backward "\"")) -1)
+ ?\")
+ ((not (= (preceding-char) ?\"))
+ ?\")
+ ((save-excursion
+ (forward-char -1)
+ (bobp))
+ (delete-backward-char 1)
+ open-quote)
+ ((save-excursion
+ (forward-char -2) ;;; at -1 there is double quote
+ (looking-at "[ \t\n]\\|\\s("))
+ (delete-backward-char 1)
+ open-quote)
+ (t
+ (delete-backward-char 1)
+ close-quote)))
+ (insert (cond ((bobp)
+ open-quote)
+ ((= (preceding-char) (string-to-char TeX-esc))
+ ?\")
+ ((= (preceding-char) ?\")
+ ?\")
+ ((save-excursion
+ (forward-char (- (length open-quote)))
+ (looking-at (regexp-quote open-quote)))
+ (delete-backward-char (length open-quote))
+ ?\")
+ ((save-excursion
+ (forward-char (- (length close-quote)))
+ (looking-at (regexp-quote close-quote)))
+ (delete-backward-char (length close-quote))
+ ?\")
+ ((save-excursion
+ (forward-char -1)
+ (looking-at "[ \t\n]\\|\\s("))
+ open-quote)
+ (t
+ close-quote)))))))
+
+(defun TeX-insert-punctuation ()
+ "Insert point or comma, cleaning up preceding space."
+ (interactive)
+ (expand-abbrev)
+ (if (TeX-looking-at-backward "\\\\/\\(}+\\)" 50)
+ (replace-match "\\1" t))
+ (call-interactively 'self-insert-command))
+
+(defun TeX-insert-braces (arg)
+ "Make a pair of braces around next ARG sexps and leave point inside.
+No argument is equivalent to zero: just insert braces and leave point
+between.
+
+If there is an active region, ARG will be ignored, braces will be
+inserted around the region, and point will be left after the
+closing brace."
+ (interactive "P")
+ (if (TeX-active-mark)
+ (progn
+ (if (< (point) (mark))
+ (exchange-point-and-mark))
+ (insert TeX-grcl)
+ (save-excursion
+ (goto-char (mark))
+ (insert TeX-grop)))
+ (insert TeX-grop)
+ (save-excursion
+ (if arg (forward-sexp (prefix-numeric-value arg)))
+ (insert TeX-grcl))))
+
+;;;###autoload
+(defun TeX-submit-bug-report ()
+ "Submit a bug report on AUCTeX via mail.
+
+Don't hesitate to report any problems or inaccurate documentation.
+
+If you don't have setup sending mail from (X)Emacs, please copy the
+output buffer into your mail program, as it gives us important
+information about your AUCTeX version and AUCTeX configuration."
+ (interactive)
+ (require 'reporter)
+ (let ((reporter-prompt-for-summary-p "Bug report subject: "))
+ (reporter-submit-bug-report
+ "bug-auctex@gnu.org"
+ AUCTeX-version
+ (list 'AUCTeX-date
+ 'window-system
+ 'LaTeX-version
+ 'TeX-style-path
+ 'TeX-auto-save
+ 'TeX-parse-self
+ 'TeX-master
+ 'TeX-command-list)
+ nil nil
+ "Remember to cover the basics, that is, what you expected to happen and
+what in fact did happen.
+
+Be sure to consult the FAQ section in the manual before submitting
+a bug report. In addition check if the bug is reproducable with an
+up-to-date version of AUCTeX. So please upgrade to the version
+available from http://www.gnu.org/software/auctex/ if your
+installation is older than the one available from the web site.
+
+If the bug is triggered by a specific \(La\)TeX file, you should try
+to produce a minimal sample file showing the problem and include it
+in your report.
+
+Your bug report will be posted to the AUCTeX bug reporting list.
+------------------------------------------------------------------------")))
+
+
+;;; Documentation
+
+(defun TeX-goto-info-page ()
+ "Read documentation for AUCTeX in the info system."
+ (interactive)
+ (info "auctex"))
+
+(autoload 'info-lookup->completions "info-look")
+
+(defvar TeX-doc-backend-alist
+ '((texdoc (plain-tex-mode latex-mode doctex-mode ams-tex-mode context-mode)
+ (lambda ()
+ (when (executable-find "texdoc")
+ (TeX-search-files
+ ;; Explicitely supply doc directory for
+ ;; non-kpathsea-based TeX systems.
+ (unless (stringp TeX-kpathsea-path-delimiter)
+ (or (TeX-tree-expand
+ '("$SYSTEXMF" "$TEXMFLOCAL" "$TEXMFMAIN" "$TEXMFDIST")
+ "latex" '("/doc/"))
+ `(,@TeX-macro-global ,@TeX-macro-private)))
+ '("dvi" "pdf" "ps" "txt" "html") t t)))
+ (lambda (doc)
+ ;; texdoc in MiKTeX requires --view in order to start
+ ;; the viewer instead of an intermediate web page.
+ (call-process "texdoc" nil 0 nil "--view" doc)))
+ (latex-info (latex-mode)
+ (lambda ()
+ (when (condition-case nil
+ (save-window-excursion
+ (let ((buf (generate-new-buffer-name "*info*")))
+ (info "latex" buf)
+ (kill-buffer buf))
+ t)
+ (error nil))
+ (mapcar (lambda (x)
+ (let ((x (car x)))
+ (if (string-match "\\`\\\\" x)
+ (substring x 1) x)))
+ (info-lookup->completions 'symbol 'latex-mode))))
+ (lambda (doc)
+ (info-lookup-symbol (concat "\\" doc) 'latex-mode)))
+ (texinfo-info (texinfo-mode)
+ (lambda ()
+ (when (condition-case nil
+ (save-window-excursion
+ (let ((buf (generate-new-buffer-name "*info*")))
+ (info "texinfo" buf)
+ (kill-buffer buf))
+ t)
+ (error nil))
+ (mapcar (lambda (x)
+ (let ((x (car x)))
+ (if (string-match "\\`@" x)
+ (substring x 1) x)))
+ (info-lookup->completions 'symbol
+ 'texinfo-mode))))
+ (lambda (doc)
+ (info-lookup-symbol (concat "@" doc) 'texinfo-mode))))
+ "Alist of backends used for looking up documentation.
+Each item consists of four elements.
+
+The first is a symbol describing the backend's name.
+
+The second is a list of modes the backend should be activated in.
+
+The third is a function returning a list of documents available
+to the backend. It should return nil if the backend is not
+available, e.g. if a required executable is not present on the
+system in question.
+
+The fourth is a function for displaying the documentation. The
+function should accept a single argument, the chosen package,
+command, or document name.")
+
+(defun TeX-doc (&optional name)
+ "Display documentation for string NAME.
+NAME may be a package, a command, or a document."
+ (interactive)
+ (let (docs)
+ ;; Build the lists of available documentation used for completion.
+ (dolist (elt TeX-doc-backend-alist)
+ (when (memq major-mode (nth 1 elt))
+ (let ((completions (funcall (nth 2 elt))))
+ (unless (null completions)
+ (add-to-list 'docs (cons completions (nth 0 elt)))))))
+ (if (null docs)
+ (progn
+ (if (executable-find "texdoc")
+ ;; Fallback if we did not find anything via the backend list.
+ (let ((doc (read-from-minibuffer "Input for `texdoc': ")))
+ (when doc (call-process "texdoc" nil 0 nil "--view" doc)))
+ ;; Give up.
+ (message "No documentation found")))
+ ;; Ask the user about the package, command, or document.
+ (when (and (interactive-p)
+ (or (not name) (string= name "")))
+ (let ((symbol (thing-at-point 'symbol))
+ contained completions doc)
+ ;; Is the symbol at point contained in the lists of available
+ ;; documentation?
+ (setq contained (catch 'found
+ (dolist (elt docs)
+ (when (member symbol (car elt))
+ (throw 'found t)))))
+ ;; Setup completion list in a format suitable for `completing-read'.
+ (dolist (elt docs)
+ (setq completions (nconc (mapcar 'list (car elt)) completions)))
+ ;; Query user.
+ (setq doc (completing-read
+ (if contained
+ (format "Package, command, or document (default %s): "
+ symbol)
+ "Package, command, or document: ")
+ completions))
+ (setq name (if (string= doc "") symbol doc))))
+ (if (not name)
+ (message "No documentation specified")
+ ;; XXX: Provide way to choose in case a symbol can be found in
+ ;; more than one backend.
+ (let* ((backend (catch 'found
+ (dolist (elt docs)
+ (when (member name (car elt))
+ (throw 'found (cdr elt)))))))
+ (if backend
+ (funcall (nth 3 (assoc backend TeX-doc-backend-alist)) name)
+ (message "Documentation not found")))))))
+
+
+;;; Ispell Support
+
+;; FIXME: Document those functions and variables. -- rs
+
+;; The FSF ispell.el use this.
+(defun ispell-tex-buffer-p ()
+ (and (boundp 'ispell-tex-p) ispell-tex-p))
+
+;; The FSF ispell.el might one day use this.
+(setq ispell-enable-tex-parser t)
+
+(defun TeX-run-ispell (command string file)
+ "Run ispell on current TeX buffer."
+ (cond ((and (string-equal file (TeX-region-file))
+ (fboundp 'ispell-region))
+ (call-interactively 'ispell-region))
+ ((string-equal file (TeX-region-file))
+ (call-interactively 'spell-region))
+ ((fboundp 'ispell-buffer)
+ (ispell-buffer))
+ ((fboundp 'ispell)
+ (ispell))
+ (t
+ (spell-buffer))))
+
+(defun TeX-ispell-document (name)
+ "Run ispell on all open files belonging to the current document."
+ (interactive (list (TeX-master-file)))
+ (if (string-equal name "")
+ (setq name (TeX-master-file)))
+
+ (let ((found nil)
+ (regexp (concat "\\`\\("
+ (mapconcat (lambda (dir)
+ (regexp-quote
+ (expand-file-name
+ (file-name-as-directory dir))))
+ (append (when (file-name-directory name)
+ (list (file-name-directory name)))
+ TeX-check-path)
+ "\\|")
+ "\\).*\\("
+ (mapconcat 'regexp-quote
+ (cons (file-name-nondirectory name)
+ (TeX-style-list)) "\\|")
+ "\\)\\.\\("
+ (mapconcat 'regexp-quote TeX-file-extensions "\\|")
+ "\\)\\'"))
+ (buffers (buffer-list)))
+ (while buffers
+ (let* ((buffer (car buffers))
+ (name (buffer-file-name buffer)))
+ (setq buffers (cdr buffers))
+ (if (and name (string-match regexp name))
+ (progn
+ (save-excursion (switch-to-buffer buffer) (ispell-buffer))
+ (setq found t)))))))
+
+;; Some versions of ispell 3 use this.
+(defvar ispell-tex-major-modes nil)
+(setq ispell-tex-major-modes
+ (append '(plain-tex-mode ams-tex-mode latex-mode doctex-mode)
+ ispell-tex-major-modes))
+
+
+;;; Abbrev mode
+
+(defmacro TeX-abbrev-mode-setup (mode)
+ "Set up the abbrev table and variable for MODE."
+ (let ((symbol (intern (concat (symbol-name mode) "-abbrev-table")))
+ (name (TeX-mode-prefix mode)))
+ `(progn
+ (defvar ,symbol nil
+ ,(format "Abbrev table for %s mode." name))
+ (define-abbrev-table ',symbol nil)
+ (when (fboundp 'abbrev-table-put)
+ (abbrev-table-put ,symbol :parents (list text-mode-abbrev-table))))))
+
+
+;;; Special provisions for other modes and libraries
+
+;; desktop-locals-to-save is broken by design. Don't have
+;; buffer-local values of it.
+(eval-after-load "desktop"
+ '(progn
+ (dolist (elt '(TeX-master))
+ (unless (member elt (default-value 'desktop-locals-to-save))
+ (setq-default desktop-locals-to-save
+ (cons elt (default-value 'desktop-locals-to-save)))))
+ (add-hook 'desktop-after-read-hook '(lambda ()
+ (TeX-set-mode-name t)))))
+
+;; delsel.el, `delete-selection-mode'
+(put 'TeX-newline 'delete-selection t)
+(put 'TeX-insert-dollar 'delete-selection t)
+(put 'TeX-insert-quote 'delete-selection t)
+(put 'TeX-insert-backslash 'delete-selection t)
+
+(provide 'tex)
+
+;; Local Variables:
+;; coding: iso-8859-1
+;; End:
+
+;;; tex.el ends here
diff --git a/tests/auctex-11.87.7/texmathp.el b/tests/auctex-11.87.7/texmathp.el
new file mode 100644
index 0000000..350406b
--- /dev/null
+++ b/tests/auctex-11.87.7/texmathp.el
@@ -0,0 +1,414 @@
+;;; texmathp.el -- Code to check if point is inside LaTeX math environment
+
+;; Copyright (C) 1998, 2004 Free Software Foundation, Inc.
+
+;; Author: Carsten Dominik <dominik@strw.LeidenUniv.nl>
+;; Maintainer: auctex-devel@gnu.org
+;; Keywords: tex
+
+;; This file is part of AUCTeX.
+
+;; AUCTeX 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.
+
+;; AUCTeX 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 AUCTeX; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+;; 02110-1301, USA.
+
+;;; Commentary:
+;;
+;; This code provides a function to determine if point in a buffer is
+;; inside a (La)TeX math environment. This is not trivial since many
+;; different ways are used to switch between the two. Examples:
+;;
+;; \begin{equation} ... \end{equation}
+;; $ ... $
+;; $$ ... $$
+;; \[ ... \]
+;; \ensuremath{...}
+;; \mbox{...}
+;;
+;; To install, put this file on your load-path and compile it.
+;;
+;; To use this in a Lisp program, do
+;;
+;; (require 'texmathp)
+;;
+;; You can then write code like this:
+;;
+;; (if (texmathp) ...)
+;;
+;; The call to `texmathp' leaves some extra information in the
+;; variable `texmathp-why'. It's value is a cons cell (MATCH . POSITION),
+;; specifying which command at what position is responsible for math
+;; mode being on or off.
+;;
+;; To configure which macros and environments influence LaTeX math mode,
+;; customize the variable `texmathp-tex-commands'. By default
+;; it recognizes the LaTeX core as well as AMS-LaTeX (see the variable
+;; `texmathp-tex-commands-default', also as an example).
+;;
+;; To try out the code interactively, use `M-x texmathp RET'.
+;;
+;; Of course, in order to work this function has to assume that the
+;; LaTeX above point is syntactically correct. In particular:
+;;
+;; o The different math delimiters are paired correctly. Thus if
+;; you do things like "\begin{equation} $" or "\[ ... \)"
+;; the result of (texmathp) is undefined. It is in fact possible
+;; in LaTeX to pair \[ with $$ and \( with $, but this will confuse
+;; texmathp (and human readers as well).
+;;
+;; o However, texmathp will correctly work with nested delimiters.
+;; Something like the following will be parsed correctly at any point:
+;;
+;; \begin{equation}
+;; x = y \mbox{abc \ensuremath{\alpha} cba $2^3$}
+;; \end{equation}
+;;
+;; o texmathp is somewhat forgiving if you have an empty line inside
+;; the current math environment, which is not legal in TeX but may
+;; easily happen during editing. Depending upon the variable
+;; `texmathp-search-n-paragraphs' several paragraphs are checked
+;; backwards, by default 2. Paragraph here means something limited
+;; by an empty line.
+;;--------------------------------------------------------------------------
+;;
+;; BUGS:
+;;
+;; If any of the the special macros like \mbox or \ensuremath has optional
+;; arguments, math mode inside these optional arguments is *not* influenced
+;; by the macro.
+;;--------------------------------------------------------------------------
+
+;;; Code:
+
+(defgroup texmathp nil
+ "Testing TeX and LaTeX documents for math mode."
+ :tag "Test For TeX and LaTeX Math Mode"
+ :prefix "texmathp-"
+ :group 'tex)
+
+;; Some internal variables which are computed from `texmathp-tex-commands'
+;; and `texmathp-tex-commands-default'.
+(defvar texmathp-environments nil)
+(defvar texmathp-macros nil)
+(defvar texmathp-onoff-regexp nil)
+(defvar texmathp-toggle-regexp nil)
+(defvar texmathp-tex-commands1 nil)
+(defvar texmathp-memory nil)
+
+(defvar texmathp-tex-commands) ; silence the compiler
+
+(defvar texmathp-tex-commands-default
+ '(;; Plain TeX
+ ("$$" sw-toggle) ("$" sw-toggle)
+ ("\\hbox" arg-off)
+ ("\\vbox" arg-off)
+ ("\\vtop" arg-off)
+ ("\\vcenter" arg-off)
+
+ ;; Standard LaTeX
+ ("equation" env-on) ("equation*" env-on)
+ ("eqnarray" env-on) ("eqnarray*" env-on)
+ ("math" env-on)
+ ("displaymath" env-on)
+ ("minipage" env-off)
+ ("\\fbox" arg-off)
+ ("\\mbox" arg-off)
+ ("\\framebox" arg-off)
+ ("\\label" arg-off)
+ ("\\textrm" arg-off)
+ ("\\(" sw-on) ("\\)" sw-off)
+ ("\\[" sw-on) ("\\]" sw-off)
+ ("\\ensuremath" arg-on)
+
+ ;; AMS-LaTeX
+ ("align" env-on) ("align*" env-on)
+ ("gather" env-on) ("gather*" env-on)
+ ("multline" env-on) ("multline*" env-on)
+ ("flalign" env-on) ("flalign*" env-on)
+ ("alignat" env-on) ("alignat*" env-on)
+ ("xalignat" env-on) ("xalignat*" env-on)
+ ("xxalignat" env-on) ("\\boxed" arg-on)
+ ("\\text" arg-off) ("\\intertext" arg-off)
+
+ ;; mathtools
+ ("\\shortintertext" arg-off))
+ "The default entries for `texmathp-tex-commands', which see.")
+
+(defun texmathp-compile ()
+ "Compile the value of `texmathp-tex-commands' into the internal lists.
+Call this when you have changed the value of that variable without using
+customize (customize calls it when setting the variable)."
+ (interactive)
+ ;; Extract lists and regexp.
+ (setq texmathp-macros nil texmathp-environments nil)
+ (setq texmathp-memory
+ (cons texmathp-tex-commands texmathp-tex-commands-default))
+ (setq texmathp-tex-commands1 (append texmathp-tex-commands
+ texmathp-tex-commands-default))
+ (let ((list (reverse texmathp-tex-commands1))
+ var entry type switches togglers)
+ (while (setq entry (car list))
+ (setq type (nth 1 entry)
+ list (cdr list)
+ var (cond ((memq type '(env-on env-off)) 'texmathp-environments)
+ ((memq type '(arg-on arg-off)) 'texmathp-macros)
+ ((memq type '(sw-on sw-off)) 'switches)
+ ((memq type '(sw-toggle)) 'togglers)))
+ (set var (cons (car entry) (symbol-value var))))
+ (setq texmathp-onoff-regexp
+ (concat "[^\\\\]\\("
+ (mapconcat 'regexp-quote switches "\\|")
+ "\\)")
+ texmathp-toggle-regexp
+ (concat "\\([^\\\\\\$]\\|\\`\\)\\("
+ (mapconcat 'regexp-quote togglers "\\|")
+ "\\)"))))
+
+(defcustom texmathp-tex-commands nil
+ "List of environments and macros influencing (La)TeX math mode.
+This user-defined list is used in addition to LaTeX and AMSLaTeX defaults.
+The structure of each entry is (NAME TYPE)
+
+- The first item in each entry is the name of an environment or macro.
+ If it's a macro, include the backslash.
+
+- The second item is a symbol indicating how the command works:
+ `env-on' Environment: turns math mode for its body on
+ `env-off' Environment: turns math mode for its body off
+ `arg-on' Command: turns math mode for its arguments on
+ `arg-off' Command: turns math mode for its arguments off
+ `sw-on' Switch: turns math-mode of following text on
+ `sw-off' Switch: turns math-mode of following text off
+ `sw-toggle' Switch: toggles math mode of following text"
+ :group 'texmathp
+ :set '(lambda (symbol value) (set-default symbol value) (texmathp-compile))
+ :type
+ '(repeat
+ (list :value ("" env-on)
+ (string :tag "Name")
+ (choice :tag "Type"
+ (const :tag "Environment: turns math mode for its body on" env-on)
+ (const :tag "Environment: turns math mode for its body off" env-off)
+ (const :tag "Command: turns math mode for its argument on" arg-on)
+ (const :tag "Command: turns math-mode for its argument off" arg-off)
+ (const :tag "Switch: turns math-mode of following text on" sw-on)
+ (const :tag "Switch: turns math-mode of following text off" sw-off)
+ (const :tag "Switch: toggles math mode of following text" sw-toggle)))))
+
+(defcustom texmathp-search-n-paragraphs 2
+ "*Number of paragraphs to check before point.
+Normally, you cannot have an empty line in a math environment in (La)TeX.
+The fastest method to test for math mode is then limiting the search
+backward to the nearest empty line.
+However, during editing it happens that such lines exist temporarily.
+Therefore we look a little further. This variable determines how many
+empty lines we go back to fix the search limit."
+ :group 'texmathp
+ :type 'number)
+
+(defcustom texmathp-allow-detached-args nil
+ "*Non-nil means, allow arguments of macros to be detached by whitespace.
+When this is t, `aaa' will be interpreted as an argument of \bb in the
+following construct: \bbb [xxx] {aaa}
+This is legal in TeX. The disadvantage is that any number of braces
expressions
+will be considered arguments of the macro independent of its definition."
+ :group 'texmathp
+ :type 'boolean)
+
+(defvar texmathp-why nil
+ "After a call to `texmathp' this variable shows why math-mode is on or off.
+The value is a cons cell (MATCH . POSITION).
+MATCH is a string like a car of an entry in `texmathp-tex-commands', e.q.
+\"equation\" or \"\\ensuremath\" or \"\\[\" or \"$\".
+POSITION is the buffer position of the match. If there was no match,
+it points to the limit used for searches, usually two paragraphs up.")
+
+;; We need our own syntax table to play with the syntax of () [] and {}
+;; For speed reasons we define it statically instead of copying it each time.
+(defvar texmathp-syntax-table
+ (let ((table (make-syntax-table)))
+ (mapc (lambda (x) (modify-syntax-entry (car x) (cdr x) table))
+ '((?\\ . "\\") (?\f .">") (?\n . ">") (?% . "<")
+ (?\[ . ".") (?\] . ".") (?\{ . "(}") (?\} . "){")
+ (?\( . ".") (?\) . ".") (?\" . ".") (?& . ".") (?_ . ".")
+ (?@ . "_") (?~ . " ") (?$ . "$") (?' . "w")))
+ table)
+ "Syntax table used while texmathp is parsing.")
+
+;;;###autoload
+(defun texmathp ()
+ "Determine if point is inside (La)TeX math mode.
+Returns t or nil. Additional info is placed into `texmathp-why'.
+The functions assumes that you have (almost) syntactically correct (La)TeX in
+the buffer.
+See the variable `texmathp-tex-commands' about which commands are checked."
+ (interactive)
+ (let* ((pos (point)) math-on sw-match
+ (bound (save-excursion
+ (if (re-search-backward "[\n\t][ \t]*[\n\r]"
+ nil 1 texmathp-search-n-paragraphs)
+ (match-beginning 0)
+ (point-min))))
+ (mac-match (texmathp-match-macro bound))
+ (env-match (texmathp-match-environment
+ (if (and mac-match (> (cdr mac-match) bound))
+ (cdr mac-match)
+ bound)))
+ (match (cons nil bound)))
+
+ ;; Select the nearer match
+ (and env-match (setq match env-match))
+ (and mac-match (> (cdr mac-match) (cdr match)) (setq match mac-match))
+ (setq math-on (memq (nth 1 (assoc (car match) texmathp-tex-commands1))
+ '(env-on arg-on)))
+
+ ;; Check for switches
+ (and (not math-on)
+ (setq sw-match (texmathp-match-switch bound))
+ (> (cdr sw-match) (cdr match))
+ (eq (nth 1 (assoc (car sw-match) texmathp-tex-commands1)) 'sw-on)
+ (setq match sw-match math-on t))
+
+ ;; Check for togglers
+ (if (not math-on)
+ (save-excursion
+ (goto-char (cdr match))
+ (while (re-search-forward texmathp-toggle-regexp pos t)
+ (if (setq math-on (not math-on))
+ (setq sw-match (cons (match-string 2) (match-beginning 2)))
+ (setq sw-match nil)))
+ (and math-on sw-match (setq match sw-match))))
+
+ ;; Store info, show as message when interactive, and return
+ (setq texmathp-why match)
+ (and (interactive-p)
+ (message "math-mode is %s: %s begins at buffer position %d"
+ (if math-on "on" "off")
+ (or (car match) "new paragraph")
+ (cdr match)))
+ (and math-on t)))
+
+(defun texmathp-match-environment (bound)
+ "Find out if point is inside any of the math environments.
+Limit searched to BOUND. The return value is like (\"equation\" . (point))."
+ (catch 'exit
+ (save-excursion
+ (and (null texmathp-environments) (throw 'exit nil))
+ ;; Check if the line we are starting with is a commented one.
+ (let ((orig-comment-flag
+ ;; Could be replaced by `TeX-in-commented-line'.
+ (progn
+ (save-excursion
+ (beginning-of-line)
+ (skip-chars-forward " \t")
+ (string= (buffer-substring-no-properties
+ (point) (min (point-max)
+ (+ (point) (length comment-start))))
+ comment-start))))
+ end-list env)
+ (while (re-search-backward "\\\\\\(begin\\|end\\)[ \t]*{\\([^}]+\\)}"
+ bound t)
+ ;; Check if the match found is inside of a comment.
+ (let ((current-comment-flag
+ ;; Could be replaced by `TeX-in-comment'.
+ (when (save-match-data
+ (re-search-backward comment-start-skip
+ (line-beginning-position) t))
+ ;; We need a t for comparison with `orig-comment-flag',
+ ;; not a number.
+ t)))
+ ;; Only consider matching alternatives with respect to
+ ;; "in-commentness", i.e. if we started with a comment
+ ;; only consider matches which are in comments as well and
+ ;; vice versa.
+ (when (eq orig-comment-flag current-comment-flag)
+ (setq env (buffer-substring-no-properties
+ (match-beginning 2) (match-end 2)))
+ (cond ((string= (match-string 1) "end")
+ (setq end-list (cons env end-list)))
+ ((equal env (car end-list))
+ (setq end-list (cdr end-list)))
+ ((member env texmathp-environments)
+ (throw 'exit (cons env (point))))))))
+ nil))))
+
+(defun texmathp-match-macro (bound)
+ "Find out if point is within the arguments of any of the Math macros.
+Limit searches to BOUND. The return value is like (\"\\macro\" . (point))."
+ (catch 'exit
+ (and (null texmathp-macros) (throw 'exit nil))
+ (let (pos cmd (syntax-table (syntax-table)))
+ (unwind-protect
+ (save-restriction
+ (save-excursion
+ (set-syntax-table texmathp-syntax-table)
+ (narrow-to-region (max 1 bound) (point))
+ ;; Move back out of the current parenthesis
+ (while (condition-case nil (progn (up-list -1) t) (error nil))
+ ;; Move back over any touching sexps (in fact also non-touching)
+ (while
+ (and
+ (cond
+ ((memq (preceding-char) '(?\] ?\})))
+ ((and
+ texmathp-allow-detached-args
+ (re-search-backward
+ "[]}][ \t]*[\n\r]?\\([ \t]*%[^\n\r]*[\n\r]\\)*[ \t]*\\="
+ bound t))
+ (goto-char (1+ (match-beginning 0))) t))
+ (if (eq (preceding-char) ?\})
+ ;; Jump back over {}
+ (condition-case nil
+ (progn (backward-sexp) t)
+ (error nil))
+ ;; Jump back over []. Modify syntax temporarily for this.
+ (unwind-protect
+ (progn
+ (modify-syntax-entry ?\{ ".")
+ (modify-syntax-entry ?\} ".")
+ (modify-syntax-entry ?\[ "(]")
+ (modify-syntax-entry ?\] ")[")
+ (condition-case nil
+ (progn (backward-sexp) t)
+ (error nil)))
+ (modify-syntax-entry ?\{ "(}")
+ (modify-syntax-entry ?\} "){")
+ (modify-syntax-entry ?\[ ".")
+ (modify-syntax-entry ?\] ".")
+ nil))))
+ (setq pos (point))
+ (and (memq (following-char) '(?\[ ?\{))
+ (re-search-backward "\\\\[*a-zA-Z]+\\=" nil t)
+ (setq cmd (buffer-substring-no-properties
+ (match-beginning 0) (match-end 0)))
+ (member cmd texmathp-macros)
+ (throw 'exit (cons cmd (point))))
+ (goto-char pos))
+ (throw 'exit nil)))
+ (set-syntax-table syntax-table)))))
+
+;;;###autoload
+(defun texmathp-match-switch (bound)
+ "Search backward for any of the math switches.
+Limit searched to BOUND."
+ ;; The return value is like ("\\(" . (point)).
+ (save-excursion
+ (if (re-search-backward texmathp-onoff-regexp bound t)
+ (cons (buffer-substring-no-properties (match-beginning 1) (match-end 1))
+ (match-beginning 1))
+ nil)))
+
+(provide 'texmathp)
+
+;;; texmathp.el ends here
diff --git a/tests/auctex-11.87.7/toolbar-x.el
b/tests/auctex-11.87.7/toolbar-x.el
new file mode 100644
index 0000000..ef4edc8
--- /dev/null
+++ b/tests/auctex-11.87.7/toolbar-x.el
@@ -0,0 +1,2154 @@
+;;; toolbar-x.el --- fancy toolbar handling in Emacs and XEmacs
+
+;; Copyright (C) 2004, 2005, 2008 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, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
+;; MA 02110-1301 USA
+
+;;; Author: Miguel Vinicius Santini Frasson
+
+;;; Commentary:
+;; This program implements a common interface to display toolbar
+;; buttons in both Emacs and XEmacs. A toolbar should be basicly
+;; defined by a image and a command to run when the button is pressed,
+;; and additional properties could be added. This is the idea of this
+;; program. See the documentation of function
+;; `toolbarx-install-toolbar' for a description of how to specify
+;; toolbars.
+
+;;; Features:
+
+;; * Button properties are given in the toolbar definition (BUTTON
+;; paramenter in `toolbarx-install-toolbar') and/or in an alist with
+;; associates the symbol with properties (MEANING-ALIST paramenter in
+;; `toolbarx-install-toolbar').
+
+;; * Supported properties:
+;; - All editors: `:insert', `:image', `:command', `:help', `:enable',
+;; `:append-command' and `:prepend-command';
+;; - Emacs only: `:visible' and `:button';
+;; - XEmacs only: `:toolbar'.
+;; For the precise value-type for each property, see documentation of
+;; the function `toolbarx-install-toolbar'.
+;; (ps: properties that are particular to an editor are just ignored
+;; the other editor flavour.)
+
+;; * Button properties may depend on the editor flavour, if the value
+;; is a vector; the first element will be used for Emacs and the 2nd
+;; for XEmacs. Example: `:image ["new" toolbar-file-icon]'
+
+;; * Properties can have value specified by function (with no
+;; argument) or variables that evaluate to an object of the correct
+;; type for a particular property. The evaluation is done when the
+;; roolbar is refresh (a call of `toolbarx-refresh'.)
+;; (ps: this is valid only for properties that *not* have \`form\' as
+;; value type.)
+
+;; * On `refresh time' (a call `toolbarx-refresh', necessary when the
+;; toolbar should change), the `:insert' property (if present) is
+;; evaluated to decide if button will be displayed.
+
+;; Properties can be distributed to several buttons, using \`groups\'.
+;; Example: (for (bar baz :toolbar (bottom . top) :insert foo-form)
+;; means that `foo', `bar' and `baz' have `:insert foo-form' and `bar' and
+;; `baz' have the property `:toolbar (bottom . top)'. (ps: this type
+;; of value for the `:toolbar' property (XEmacs only) means that the
+;; buttons will be in the bottom toolbar unless the default toolbar is
+;; in the bottom, and in this case, this buttons go to the top
+;; toolbar).
+
+;; * (Part of) the toolbar definition can be stored in a variable,
+;; evaluated in `installation time'. See `:eval-group' on the
+;; documentation of the function `toolbarx-install-toolbar'.
+
+;; * It is possible to define sets of buttons that appear according to
+;; an option selected in a dropdown menu. See `:dropdown-group' on
+;; the documentation of the function `toolbarx-install-toolbar'.
+
+;;; Rough description of the implementation
+;; There are 3 \`engines\' implemented:
+
+;; == the 1st one (parsing) parses the toolbar definition
+;; independently of editor flavour and store the parsed buttons with
+;; their properties, in the same order that they appear in the
+;; definitions, in a variable `toolbarx-internal-button-switches';
+
+;; == the 2nd one (refresh for Emacs) inserts buttons in the Emacs
+;; toolbar in the same order that they appear in the definitions;
+;; buttons with a `:insert' property value that evaluates to nil are
+;; ignored; if a (real) button does not have at least (valid) image
+;; and command properties, they are silently ignored;
+
+;; == the 3rd engine (refresh for XEmacs) is similar to the 2nd, but
+;; inserts buttons in XEmacs.
+
+;;; History:
+
+;; This program was motivated by the intention of implementation of a
+;; good toolbar for AUCTeX, that would work in both Emacs and XEmacs.
+;; Since toolbars are very different in behaviour and implementation
+;; (for instance, in Emacs one can display as many toolbar buttons as
+;; wanted, because it becomes mult-line, and in XEmacs, there is one
+;; line, but toolbars and all sides of a frame.)
+
+
+;;; Code:
+
+;; Note that this just gives a useful default. Icons are expected to
+;; be in subdirectory "images" or "toolbar" relative to the load-path.
+;; Packages loading toolbarx are advised to explicitly add their own
+;; searchpath with add-to-list here even when they fulfill that
+;; criterion: another package might have loaded toolbar-x previously
+;; when load-path was not yet correctly set. The default setting
+;; really caters only for toolbar-x' stock icons.
+
+(defvar toolbarx-image-path
+ (nconc
+ (delq nil (mapcar #'(lambda(x)
+ (and x
+ (member
+ (file-name-nondirectory
+ (directory-file-name x))
+ '("toolbar" "images"))
+ ;;(file-directory-p x)
+ x))
+ load-path))
+ (list data-directory))
+ "List of directories where toolbarx finds its images.")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; First engine: Parsing buttons
+
+;; it obtains button information, process it and stores result in
+;; `toolbarx-internal-button-switches', which is a list with 1st
+;; element the symbol `:switches', the 2nd element as a list of
+;; processed buttons, and the 3rd element is used for Emacs to store
+;; the keys used in ``constant'' buttons.
+
+;; The 2nd element of `toolbarx-internal-button-switches' is a list
+;; where each element is either:
+;; * a button-list, that is, a list with elements to define a button.
+;; * a list where 1st elem is `:insert' and 2nd is a form, and the
+;; following elements are in the same format of the 2nd element of
+;; `toolbarx-internal-button-switches'.
+
+(defun toolbarx-make-string-from-symbol (symbol)
+ "Return a string from the name of a SYMBOL.
+Upcase initials and replace dashes by spaces."
+ (let* ((str (upcase-initials (symbol-name symbol)))
+ (str2))
+ (dolist (i (append str nil))
+ (if (eq i 45) ; if dash, push space
+ (push 32 str2)
+ (push i str2))) ; else push identical
+ (concat (nreverse str2))))
+
+(defun toolbarx-make-symbol-from-string (string)
+ "Return a (intern) symbol from STRING.
+Downcase string and replace spaces by dashes."
+ (let* ((str1 (append (downcase string) nil))
+ (str2))
+ (dolist (i str1)
+ (if (eq i 32) ; if dash, push space
+ (push 45 str2)
+ (push i str2)))
+ (intern (concat (nreverse str2)))))
+
+(defun toolbarx-good-option-list-p (option-list valid-options)
+ "Non-nil means the OPTION-LIST is of form (OPT FORM ... OPT FORM).
+Each OPT is member of VALID-OPTIONS and OPT are pairwise
+different. OPTION-LIST equal to nil is a good option list."
+ (let ((elt-in-valid t)
+ (temp-opt-list option-list)
+ (list-diff)
+ (n (/ (length option-list) 2)))
+ (dotimes (i n)
+ (when (> i 0)
+ (setq temp-opt-list (cddr temp-opt-list)))
+ (add-to-list 'list-diff
+ (car temp-opt-list))
+ (setq elt-in-valid (and elt-in-valid
+ (memq (car temp-opt-list)
+ valid-options))))
+ (and elt-in-valid ; options are on VALID-OPTOPNS
+ ;; OPTION-LIST has all option different from each other
+ (eq (length list-diff) n)
+ ;; OPTION-LIST has even number of elements
+ (eq (% (length option-list) 2) 0))))
+
+(defun toolbarx-separate-options (group-list valid-options &optional check)
+ "Return a cons cell with non-options and options of GROUP-LIST.
+The options-part is the largest tail of the list GROUP-LIST that
+has an element of VALID-OPTIONS (the comparation is made with
+`memq'.) The non-options-part is the beginning of GROUP-LIST
+less its tail. Return a cons cell which `car' is the
+non-options-part and the `cdr' is the options-part.
+
+If CHECK is non-nil, the tail is the largest that yield non-nil
+when applied to `toolbarx-good-option-list-p'."
+ (let ((maximal)
+ (temp))
+ (dolist (i valid-options)
+ (setq temp (memq i group-list))
+ (when (and (> (length temp) (length maximal))
+ (if check
+ (toolbarx-good-option-list-p temp valid-options)
+ t))
+ (setq maximal (memq i group-list))))
+ (cons (butlast group-list (length maximal)) maximal)))
+
+
+(defun toolbarx-merge-props (inner-props outer-props override add)
+ "Merge property lists INNER-PROPS and OUTER-PROPS.
+INNER-PROPS and OUTER-PROPS are two lists in the format
+ (PROP VAL PROP VAL ... PROP VAL).
+Returns a list with properties and values merged.
+
+OVERRIDE and ADD are supposed to be lists of symbols. The value
+of a property in OVERRIDE is the one on OUTER-PROPS or
+INNER-PROPS, but if the property is in both, the value in
+INNER-PROPS is used. The value of a property in ADD will be a
+list with first element the symbol `:add-value-list' and the rest
+are the properties, inner properties first."
+ (let* ((merged)
+ (inner-prop)
+ (outer-prop))
+ (dolist (prop override)
+ (if (memq prop inner-props)
+ (setq merged (append merged
+ (list prop (cadr (memq prop inner-props)))))
+ (when (memq prop outer-props)
+ (setq merged (append merged
+ (list prop (cadr (memq prop outer-props))))))))
+ (dolist (prop add merged)
+ (setq inner-prop (memq prop inner-props))
+ (when inner-prop
+ (if (and (listp (cadr inner-prop))
+ (eq (car (cadr inner-prop)) :add-value-list))
+ (setq inner-prop (cdr (cadr inner-prop)))
+ (setq inner-prop (list (cadr inner-prop)))))
+ (setq outer-prop (memq prop outer-props))
+ (when outer-prop
+ (if (and (listp (cadr outer-prop))
+ (eq (car (cadr outer-prop)) :add-value-list))
+ (setq outer-prop (cdr (cadr outer-prop)))
+ (setq outer-prop (list (cadr outer-prop)))))
+ (when (append inner-prop outer-prop)
+ (setq merged (append merged
+ (list prop (cons :add-value-list
+ (append inner-prop
+ outer-prop)))))))))
+
+(defun toolbarx-make-command (comm prep app)
+ "Return a command made from COMM, PREP and APP.
+COMM is a command or a form. PREP and APP are forms. If PREP or
+APP are non-nil, they are added to the resulting command at the
+beginning and end, respectively. If both are nil and COMM is a
+command, COMM is returned."
+ (let ((comm-is-command (commandp comm)))
+ (if (and (not prep)
+ (not app)
+ comm-is-command)
+ comm
+ (append '(lambda nil (interactive))
+ (when prep (list prep))
+ (when comm
+ (if comm-is-command
+ `((call-interactively (function ,comm)))
+ (list comm)))
+ (when app (list app))))))
+
+;; in Emacs, menus are made of keymaps (vectors are possible, but editors
+;; handle `menu titles' differently) meanwhile in XEmacs, menus are lists of
+;; vectors
+
+(defun toolbarx-emacs-mount-popup-menu
+ (strings var type &optional title save)
+ "Return an interactive `lambda'-expression that shows a popup menu.
+This function is the action of `toolbarx-mount-popup-menu' if
+inside Emacs. See documentation of that function for more."
+ ;; making the menu keymap by adding each menu-item definition
+ ;; see (info "(elisp)Menu keymaps")
+ (let* ((keymap (make-sparse-keymap title))
+ (count 1)
+ (used-symbols '(nil))
+ (key)
+ (real-type (if (eq type 'toggle) 'toggle 'radio))
+ (real-save (when save (if (eq save 'offer) 'offer 'always))))
+ ;; warn if type is not `radio' ot `toggle'; use `radio' if incorrect.
+ (unless (eq type real-type)
+ (display-warning 'toolbarx
+ (format (concat "TYPE should be symbols `radio' or "
+ "`toggle', but %s found; using `radio'")
+ type)))
+ ;; warn if save is not `nil', `offer' or `always'; use nil when incorrect
+ (unless (eq save real-save)
+ (setq real-save nil)
+ (display-warning 'toolbarx
+ (format (concat "SAVE should be symbols `nil', "
+ "`offer' or `always', but %s found; "
+ "using `nil'")
+ save)))
+ (dolist (i strings)
+ ;; finding a new symbol
+ (let* ((aux-count 0)
+ (i-symb (toolbarx-make-symbol-from-string i)))
+ (setq key i-symb)
+ (while (memq key used-symbols)
+ (setq aux-count (1+ aux-count))
+ (setq key (intern (format "%s-%d" i-symb aux-count))))
+ (setq used-symbols (cons key used-symbols)))
+ (define-key-after keymap (vector key)
+ `(menu-item ,i
+ ,(append
+ `(lambda nil (interactive)
+ ,(if (eq real-type 'radio)
+ `(setq ,var ,count)
+ `(if (memq ,count ,var)
+ (setq ,var (delete ,count ,var))
+ (setq ,var (sort (cons ,count ,var) '<))))
+ (toolbarx-refresh))
+ (when (eq real-save 'always)
+ `((customize-save-variable
+ (quote ,var) ,var)))
+ `(,var))
+ :button ,(if (eq real-type 'radio)
+ `(:radio eq ,var ,count)
+ `(:toggle memq ,count ,var))))
+ (setq count (1+ count)))
+ (when (eq real-save 'offer)
+ (define-key-after keymap [sep] '(menu-item "--shadow-etched-in-dash"))
+ (let* ((aux-count 0)
+ (i-symb 'custom-save))
+ (setq key i-symb)
+ (while (memq key used-symbols)
+ (setq aux-count (1+ aux-count))
+ (setq key (intern (format "%s-%d" i-symb aux-count))))
+ (setq used-symbols (cons key used-symbols)))
+ (define-key-after keymap (vector key)
+ `(menu-item "Save state of this menu"
+ (lambda nil (interactive)
+ (customize-save-variable (quote ,var) ,var)))))
+ ;; returns a `lambda'-expression
+ `(lambda nil (interactive) (popup-menu (quote ,keymap)))))
+
+(defun toolbarx-xemacs-mount-popup-menu
+ (strings var type &optional title save)
+ "Return an interactive `lambda'-expression that shows a popup menu.
+This function is the action of `toolbarx-mount-popup-menu' if
+inside XEmacs. See documentation of that function for more."
+ (let* ((menu (if (and title (stringp title))
+ (list title)
+ (setq title nil)
+ (list "Dropdown menu")))
+ (count 0)
+ (menu-item)
+ (menu-callback)
+ (real-type (if (eq type 'toggle) 'toggle 'radio))
+ (real-save (when save (if (eq save 'offer) 'offer 'always))))
+ ;; warn if type is not `radio' ot `toggle'; use `radio' if incorrect.
+ (unless (eq type real-type)
+ (warn (concat "TYPE should be symbols `radio' or `toggle', "
+ "but %s found; using `radio'") type))
+ ;; warn if save is not `nil', `offer' or `always'; use nil when incorrect
+ (unless (eq save real-save)
+ (setq real-save nil)
+ (display-warning 'toolbarx
+ (format (concat "SAVE should be symbols `nil', "
+ "`offer' or `always', but %s found; "
+ "using `nil'")
+ save)))
+ ;; making the menu list of vectors
+ (dolist (str strings)
+ (setq count (1+ count))
+ (setq menu-callback (list 'progn
+ (if (eq real-type 'radio)
+ `(setq ,var ,count)
+ `(if (memq ,count ,var)
+ (setq ,var (delete ,count ,var))
+ (setq ,var (sort (cons ,count ,var) '<))))
+ '(toolbarx-refresh)))
+ (when (eq real-save 'always)
+ (setq menu-callback (append menu-callback
+ (list (list 'customize-save-variable
+ (list 'quote var) var)))))
+ (setq menu-item (vector str menu-callback
+ :style real-type
+ :selected (if (eq real-type 'radio)
+ `(eq ,var ,count)
+ `(memq ,count ,var))))
+ (setq menu (append menu (list menu-item))))
+ (when (eq real-save 'offer)
+ (setq menu (append menu (list "--:shadowEtchedInDash")))
+ (setq menu (append menu (list
+ (vector
+ "Save state of this menu"
+ `(customize-save-variable (quote ,var)
+ ,var))))))
+ ;; returnung the lambda-expression
+ `(lambda nil (interactive)
+ (let ((popup-menu-titles ,(if title t nil)))
+ (popup-menu (quote ,menu))))))
+
+(defun toolbarx-mount-popup-menu (strings var type &optional title save)
+ "Return a command that show a popup menu.
+The return is a `lambda'-expression with a interactive declaration.
+
+STRINGS is a list of strings which will be the itens of the menu.
+
+VAR is a symbol that is set when an item is clicked. TYPE should
+be one of the symbols `radio' or `toggle': `radio' means that the
+nth item is selected if VAR is `n' and this item sets VAR to `n';
+`toggle' means that VAR should be a list of integers and the nth
+item is selected if `n' belongs to VAR. The item inserts or
+deletes `n' from VAR.
+
+TITLE is a string (the title of the popup menu) or nil for no
+title.
+
+SAVE is one of the symbols nil, `offer' or `always'. If value
+is nil, do not try to save anything. If it is `offer', a menu
+item is added offering the user the possibiity to save state of
+that dropdown menu for future sesseions (using `custom'). If it
+is `always', state is saved every time that a item is clicked."
+ (if (featurep 'xemacs)
+ (toolbarx-xemacs-mount-popup-menu strings var type title save)
+ (toolbarx-emacs-mount-popup-menu strings var type title save)))
+
+(defun toolbarx-option-value (opt)
+ "Return option value according to Emacs flavour.
+If OPT is a vector, return first element if in Emacs or
+second if in XEmacs. Otherwise, return OPT.
+If OPT is vector and length is smaller than the necessary (like
+if in XEmacs and vector has length 1), then nil is returned."
+ (if (vectorp opt)
+ (if (featurep 'xemacs)
+ (when (> (length opt) 1)
+ (aref opt 1))
+ (when (> (length opt) 0)
+ (aref opt 0)))
+ opt))
+
+(defun toolbarx-eval-function-or-symbol (object type-test-func)
+ "Return a cons cell (GOOD-OBJ . VAL).
+GOOD-OBJ non-nil means that VAL is a valid value, according to
+the car of the result of TYPE-TEST-FUNCTION, that should return a
+cons cell in the same format as the return of this function.
+
+If OBJECT applied to TYPE-TEST-FUNC return (GOOD-OBJ . VAL), and
+GOOD-OBJ is non-nil, return that. Else, check if OBJECT is a
+function. If so, evaluate and test again with TYPE-TEST-FUNC. If
+not a function or if GOOD-OBJ is again nil, test if OBJECT is a
+bound symbol, evaluate that and return the result of
+TYPE-TEST-FUNC."
+ (let* ((ret (funcall type-test-func object)))
+ (unless (car ret)
+ (if (functionp object)
+ (progn
+ (setq ret (funcall type-test-func (funcall object)))
+ (unless (car ret)
+ (when (and (symbolp object) (boundp object))
+ (setq ret (funcall type-test-func (symbol-value object))))))
+ ;; ok, obj is not function; try symbol
+ (when (and (symbolp object) (boundp object))
+ (setq ret (funcall type-test-func (symbol-value object))))))
+ ret))
+
+(defun toolbarx-test-image-type (obj)
+ "Return a cons cell (GOOD-OBJ . VAL).
+GOOD-OBJ is non-nil if OBJ yields a valid image object VAL (see
+documentation of function `toolbarx-process-symbol')."
+ (let ((toolbarx-test-image-type-simple
+ (lambda (img)
+ (let* ((val (toolbarx-option-value img))
+ (all-obj-ok t)
+ (good-obj
+ (if (featurep 'xemacs)
+ ;; if XEmacs
+ (or (stringp val) ; a string
+ (glyphp val) ; or a glyph
+ (and (symbolp val) ; or a symbol bound to a
+ (boundp val) ; glyph-list
+ (check-toolbar-button-syntax
+ (vector val
+ (lambda nil (interactive))
+ nil nil) t))
+ (and (listp val) ; or a glyph-or-string list
+ (> (length val) 0)
+ (< (length val) 7)
+ (dolist (i val all-obj-ok)
+ (setq all-obj-ok
+ (and all-obj-ok
+ (or (not i)
+ (stringp i)
+ (glyphp i)))))))
+ ;; if Emacs
+ (or (stringp val) ; string
+ (and (consp val) ; or image descriptor
+ (eq (car val) 'image))
+ (and (symbolp val) ; or a symbol bound to a
+ (boundp val) ; image descriptor
+ ; (defined with `defimage')
+ (consp (eval val))
+ (eq (car (eval val)) 'image))
+ (and (listp val) ; or list with 4 strings or
+ ; image descriptors
+ (= (length val) 4)
+ (dolist (i val all-obj-ok)
+ (setq all-obj-ok
+ (and all-obj-ok
+ (or (stringp i)
+ (and (consp i)
+ (eq (car i)
+ 'image)))))))))))
+ (cons good-obj val)))))
+ (toolbarx-eval-function-or-symbol obj toolbarx-test-image-type-simple)))
+
+(defun toolbarx-test-button-type (obj)
+ "Return a cons cell (GOOD-OBJ . VAL).
+GOOD-OBJ is non-nil if OBJ yields a valid button object VAL (see
+documentation of function `toolbarx-process-symbol')."
+ (let ((toolbarx-test-button-type-simple
+ (lambda (but)
+ (let* ((val (toolbarx-option-value but))
+ (good-obj (if (featurep 'xemacs)
+ ;; if XEmacs
+ t
+ ;; if Emacs
+ (and (consp val)
+ (memq (car val) '(:toggle :radio))))))
+ (cons good-obj val)))))
+ (toolbarx-eval-function-or-symbol obj toolbarx-test-button-type-simple)))
+
+(defun toolbarx-test-any-type (obj)
+ "Return a cons cell (t . VAL).
+If OBJ is vector, return VAL according to editor. Else, return
+OBJ, because it is a form anyway."
+ (cons t (toolbarx-option-value obj)))
+
+(defun toolbarx-test-string-or-nil (obj)
+ "Return a cons cell (GOOD-OBJ . VAL).
+GOOD-OBJ is non-nil if OBJ yields a valid help object VAL (see
+documentation of function `toolbarx-process-symbol')."
+ (let ((toolbarx-test-string-or-nil-simple
+ (lambda (obj)
+ (let* ((val (toolbarx-option-value obj))
+ (good-obj (or (stringp val)
+ (not val))))
+ (cons good-obj val)))))
+ (toolbarx-eval-function-or-symbol obj toolbarx-test-string-or-nil-simple)))
+
+(defun toolbarx-test-toolbar-type (obj)
+ "Return a cons cell (GOOD-OBJ . VAL).
+GOOD-OBJ is non-nil if OBJ yields a valid toolbar property object
+VAL (see documentation of function `toolbarx-process-symbol')."
+ (let ((toolbarx-test-toolbar-type-simple
+ (lambda (obj)
+ (let* ((val (toolbarx-option-value obj))
+ (all-but-def-opts '(top bottom left right))
+ (all-opts '(default top bottom left right))
+ (good-obj
+ (if (featurep 'xemacs)
+ ;; if XEmacs
+ (if (symbolp val)
+ (memq val all-opts)
+ (and (consp val)
+ (memq (car val) all-but-def-opts)
+ (memq (cdr val) all-but-def-opts)))
+ ;; if Emacs
+ t)))
+ (cons good-obj val)))))
+ (toolbarx-eval-function-or-symbol obj toolbarx-test-toolbar-type-simple)))
+
+(defun toolbarx-test-dropdown-type (obj)
+ "Return a cons cell (GOOD-OBJ . VAL).
+GOOD-OBJ is non-nil if OBJ yields a valid `:type' property object
+VAL of a dropdown group (see documentation of function
+`toolbarx-process-dropdown-group'."
+ (let ((toolbarx-test-dropdown-type-simple
+ (lambda (obj)
+ (let* ((val (toolbarx-option-value obj))
+ (good-obj (memq val '(radio toggle))))
+ (cons good-obj val)))))
+ (toolbarx-eval-function-or-symbol obj toolbarx-test-dropdown-type-simple)))
+
+(defun toolbarx-test-symbol (obj)
+ "Return a cons cell (GOOD-OBJ . VAL).
+GOOD-OBJ is non-nil if OBJ yields a valid `:variable' property
+object VAL of a dropdown group (see documentation of function
+`toolbarx-process-dropdown-group'."
+ (let ((toolbarx-test-symbol-simple
+ (lambda (obj)
+ (let* ((val (toolbarx-option-value obj))
+ (good-obj (symbolp val)))
+ (cons good-obj val)))))
+ (toolbarx-eval-function-or-symbol obj toolbarx-test-symbol-simple)))
+
+(defun toolbarx-test-dropdown-default (obj)
+ "Return a cons cell (GOOD-OBJ . VAL).
+GOOD-OBJ is non-nil if OBJ yields a valid `:default' property
+object VAL of a dropdown group (see documentation of function
+`toolbarx-process-dropdown-group'."
+ (let ((toolbarx-test-dropdown-default-simple
+ (lambda (obj)
+ (let* ((val (toolbarx-option-value obj))
+ (good-obj (or (integerp val)
+ (and (listp val)
+ (let ((ok t))
+ (dolist (i val ok)
+ (setq ok (and ok (integerp i)))))))))
+ (cons good-obj val)))))
+ (toolbarx-eval-function-or-symbol obj
+ toolbarx-test-dropdown-default-simple)))
+
+(defun toolbarx-test-dropdown-save (obj)
+ "Return a cons cell (GOOD-OBJ . VAL).
+GOOD-OBJ is non-nil if OBJ yields a valid `:save' property
+object VAL of a dropdown group (see documentation of function
+`toolbarx-process-dropdown-group'."
+ (let ((toolbarx-test-dropdown-save-simple
+ (lambda (obj)
+ (let* ((val (toolbarx-option-value obj))
+ (good-obj (memq val '(nil offer always))))
+ (cons good-obj val)))))
+ (toolbarx-eval-function-or-symbol obj toolbarx-test-dropdown-save-simple)))
+
+(defconst toolbarx-button-props
+ (let* ((props-types-alist
+ '((:image toolbarx-test-image-type)
+ (:command toolbarx-test-any-type)
+ (:enable toolbarx-test-any-type)
+ (:visible toolbarx-test-any-type)
+ (:help toolbarx-test-string-or-nil)
+ (:insert toolbarx-test-any-type . and)
+ (:toolbar toolbarx-test-toolbar-type)
+ (:button toolbarx-test-button-type)
+ (:append-command toolbarx-test-any-type . progn)
+ (:prepend-command toolbarx-test-any-type . progn)))
+ (possible-props (nreverse (let* ((props ()))
+ (dolist (p props-types-alist props)
+ (setq props (cons (car p) props))))))
+ (props-override (nreverse (let* ((props ()))
+ (dolist (p props-types-alist props)
+ (unless (cddr p)
+ (setq props (cons (car p) props)))))))
+ (props-add (nreverse (let* ((props ()))
+ (dolist (p props-types-alist props)
+ (when (cddr p)
+ (setq props (cons (car p) props))))))))
+ (list props-types-alist possible-props props-override props-add))
+ "List yielding all encarnations of properties of a button.
+First element: alist, where each element is of form
+ (PROP . (TYPE-TEST-FUNCTION . ADD-OR-NIL))
+Second is a list with all properties.
+Third, a list with properties that override when merging.
+Fourth, a list of lists, each in the format (PROP ADD).")
+
+(defconst toolbarx-dropdown-props
+ ;; for naming dropdown properties see `Convention' in the doc string
+ (let* ((props-types-alist
+ '((:type toolbarx-test-dropdown-type)
+ (:variable toolbarx-test-symbol)
+ (:default toolbarx-test-dropdown-default)
+ (:save toolbarx-test-dropdown-save)
+ (:title toolbarx-test-string-or-nil)
+ (:dropdown-image toolbarx-test-image-type)
+ (:dropdown-enable toolbarx-test-any-type)
+ (:dropdown-visible toolbarx-test-any-type)
+ (:dropdown-insert toolbarx-test-any-type . and)
+ (:dropdown-help toolbarx-test-string-or-nil)
+ (:dropdown-toolbar toolbarx-test-toolbar-type)
+ (:dropdown-append-command toolbarx-test-any-type . progn)
+ (:dropdown-prepend-command toolbarx-test-any-type . progn)))
+ (possible-props (nreverse (let* ((props ()))
+ (dolist (p props-types-alist props)
+ (setq props (cons (car p) props))))))
+ (props-override (nreverse (let* ((props ()))
+ (dolist (p props-types-alist props)
+ (unless (cddr p)
+ (setq props (cons (car p) props)))))))
+ (props-add (nreverse (let* ((props ()))
+ (dolist (p props-types-alist props)
+ (when (cddr p)
+ (setq props (cons (car p) props))))))))
+ (list props-types-alist possible-props props-override props-add))
+ "List yielding all encarnations of properties of a dropdown group.
+First element: alist, where each element is of form
+ (PROP . (TYPE-TEST-FUNCTION . ADD-OR-NIL))
+Second is a list with all properties.
+Third, a list with properties that override when merging.
+Fourth, a list of lists, each in the format (PROP ADD).
+
+Convention: properties for the dropdown button should be formed
+with the strings \":dropdown-\" with the button property name
+without `:'. This is used on the implementation.")
+
+(defun toolbarx-process-group-without-insert (group-without-props
+ merged-props-without-insert
+ meaning-alist switches)
+ "Return an updated version of SWITCHES.
+GROUP-WITHOUT-PROPS and MERGED-PROPS-WITHOUT-INSERT are
+preprocessed variables in `toolbarx-process-group'."
+ (let ((current-switches switches))
+ (dolist (i group-without-props current-switches)
+ (setq i (toolbarx-option-value i))
+ (if (symbolp i)
+ (setq current-switches
+ (toolbarx-process-symbol i meaning-alist
+ merged-props-without-insert
+ current-switches))
+ (when (listp i)
+ (setq current-switches
+ (toolbarx-process-group i meaning-alist
+ merged-props-without-insert
+ current-switches)))))))
+
+(defun toolbarx-process-group (group meaning-alist props switches)
+ "Return an updated version of SWITCHES.
+Append to already processed buttons (stored in SWITCHES) a
+processed version of GROUP. Groups are useful to distribute
+properties. External properties are given in PROPS, and merged
+with the internal properties that are in the end of GROUP. If
+properties (after merge) contain a `:insert' property, return a
+list where the first and second elements are `:insert' and its
+value, and after that a list in the same format as SWITCHES."
+ (cond
+ ;; if DROPDOWN group
+ ((eq (car group) :dropdown-group)
+ (toolbarx-process-dropdown-group group meaning-alist props switches))
+ ;; if EVAL group
+ ((eq (car group) :eval-group)
+ (let ((current-switches switches))
+ (dolist (elt (cdr group) current-switches)
+ (let ((eval-elt (eval elt)))
+ (setq current-switches
+ (toolbarx-process-group (if (listp eval-elt)
+ eval-elt
+ (list eval-elt))
+ meaning-alist props
+ current-switches))))))
+ ;; if normal group
+ (t
+ (let* ((splited-props
+ (toolbarx-separate-options
+ group (append (nth 1 toolbarx-button-props)
+ (nth 1 toolbarx-dropdown-props))))
+ (intern-props (cdr splited-props))
+ (group-without-props (car splited-props))
+ (merged-props
+ (toolbarx-merge-props intern-props props
+ (append (nth 2 toolbarx-button-props)
+ (nth 2 toolbarx-dropdown-props))
+ (append (nth 3 toolbarx-button-props)
+ (nth 3 toolbarx-dropdown-props)))))
+ ;; check whether merged props have an `:insert'
+ (if (memq :insert merged-props)
+ ;; if yes, prepend switches with a (:insert cond elements)
+ (let* ((memq-ins (memq :insert merged-props))
+ (ins-val (if (and (listp (cadr memq-ins))
+ (eq :add-value-list
+ (car (cadr memq-ins))))
+ ;; if property is add-value property
+ (let* ((p (assq
+ :insert
+ (nth 0 toolbarx-button-props)))
+ (add-list (list (cddr p)))
+ (prop-good-val))
+ (dolist (val (cdr (cadr memq-ins)))
+ (setq prop-good-val (funcall (cadr p) val))
+ (when (car prop-good-val)
+ (setq add-list (cons (cdr prop-good-val)
+ add-list))))
+ ;; return: (nreverse add-list)
+ (setq add-list (nreverse add-list))
+ (if (eq 2 (length add-list))
+ (cadr add-list) ; just 1 value, no
+ add-list)) ; add-function
+ ;; if property is not add-value
+ (cadr memq-ins)))
+ (merged-props-without-insert
+ (append (butlast merged-props (length memq-ins))
+ (cddr memq-ins)))
+ (group-switches
+ (toolbarx-process-group-without-insert
+ group-without-props merged-props-without-insert
+ meaning-alist nil)))
+ ;; return
+ (nreverse (cons (append (list :insert ins-val)
+ group-switches)
+ (nreverse switches))))
+ ;; if not, just append what is processed to switches
+ (toolbarx-process-group-without-insert group-without-props
+ merged-props meaning-alist
+ switches))))))
+
+(defun toolbarx-process-symbol (symbol meaning-alist props switches)
+ "Process a button given by SYMBOL in MEANING-ALIST.
+The processed button is appended in SWITCHES, which is returned.
+Look for a association of SYMBOL in MEANING-ALIST for collecting
+properties. Such association is a list that represents either a
+normal button (a description of the button) or an alias
+group (the symbol is an alias for a group of buttons). PROPS is
+a externel list of properties that are merged and then applied to
+the button. Scope is given by GLOBAL-FLAG."
+ ;; there are 3 situations: symbol is :new-line, there is an alias group
+ ;; or a normal button
+ (let ((button-assq (cdr (assq symbol meaning-alist))))
+ (cond
+ ((eq (car button-assq) :alias)
+ ;; button association is ALIAS GROUP is passed to
+ ;; `toolbarx-process-group' as is but without the car.
+ ;; return: (toolbarx-process-group... returns updates switch
+ (toolbarx-process-group (cdr button-assq) meaning-alist props switches))
+ (t
+ ;; NORMAL BUTTON (association is a list of properties)
+ ;;
+ ;; properties need to be processed, that is, merge internal
+ ;; and external (given by PROPS) properties
+ (let* (;; button properties defined in `toolbarx-button-props'
+ (props-override (nth 2 toolbarx-button-props))
+ (props-add (nth 3 toolbarx-button-props))
+ ;; split considering also dropdown-group properties
+ (button-assq-split
+ (toolbarx-separate-options
+ button-assq
+ (append (nth 1 toolbarx-button-props)
+ (nth 1 toolbarx-dropdown-props))))
+ (button-split-no-props (car button-assq-split))
+ (button-split-props (cdr button-assq-split))
+ ;; if there is no :image or :command in the props,
+ ;; try to get them from no-props part
+ (button-image-no-prop
+ (unless (memq :image button-split-props)
+ (when (> (length button-split-no-props) 0)
+ (list :image (nth 0 button-split-no-props)))))
+ (button-command-no-prop
+ (unless (memq :command button-split-props)
+ (when (> (length button-split-no-props) 1)
+ (list :command (nth 1 button-split-no-props)))))
+ (button-props (append button-split-props
+ button-image-no-prop
+ button-command-no-prop))
+ ;; merge props
+ (merged-props (toolbarx-merge-props button-props props
+ props-override
+ props-add)))
+ ;; return:
+ (nreverse (cons (cons symbol merged-props) (nreverse switches))))))))
+
+(defun toolbarx-process-dropdown-group (dropdown meaning-alist props switches)
+ "Process buttons that appear according to dropdown menu.
+Process a dropdown group DROPDOWN with meaning alist
+MEANING-ALIST, external property list PROP and GLOBAL-FLAG
+specifying scope. For a complete description, see documentation
+of `toolbarx-install-toolbar'. The processed buttons are stored
+in the end of SWITCHES, which is returned."
+ (let* ((dropdown-group (if (eq (car dropdown) :dropdown-group)
+ (cdr dropdown)
+ dropdown))
+ (dropdown-list-splited
+ (toolbarx-separate-options dropdown-group
+ (append
+ (nth 1 toolbarx-button-props)
+ (nth 1 toolbarx-dropdown-props))))
+ (dropdown-list (car dropdown-list-splited))
+ (dropdown-props (cdr dropdown-list-splited))
+ (merged-props
+ (toolbarx-merge-props dropdown-props props
+ (append (nth 2 toolbarx-button-props)
+ (nth 2 toolbarx-dropdown-props))
+ (append (nth 3 toolbarx-button-props)
+ (nth 3 toolbarx-dropdown-props))))
+ (merged-props-button-only
+ (let* ((props-button-only)
+ (prop))
+ (dolist (p (nth 1 toolbarx-button-props) props-button-only)
+ (setq prop (memq p merged-props))
+ (when prop
+ (setq props-button-only
+ (append (list p (cadr prop))
+ props-button-only))))))
+ (merged-props-dropdown-only
+ (let* ((props-dropdown-only)
+ (prop))
+ (dolist (p (nth 1 toolbarx-dropdown-props) props-dropdown-only)
+ (setq prop (memq p merged-props))
+ (when prop
+ (setq props-dropdown-only
+ (append (list p (cadr prop))
+ props-dropdown-only))))))
+ ;; get value for each property and check type ONLY for props that do
+ ;; not concern the dropdown button, like `:type', `:save', etc. The
+ ;; props that concern the button are going to be handled in refresh
+ ;; time.
+ (filtered-dropdown-group-props-only
+ (let* ((filtered-props-temp)
+ (prop-good-val)
+ (prop))
+ (save-match-data
+ (dolist (p (nth 0 toolbarx-dropdown-props) filtered-props-temp)
+ (unless (string-match "^:dropdown-.*$"
+ (symbol-name (car p)))
+ ;; property -> (car p)
+ ;; test type function -> (cadr p)
+ (setq prop (memq (car p) merged-props-dropdown-only))
+ ;; if so, check if value is of correct type
+ (when prop
+ (setq prop-good-val (funcall (cadr p) (cadr prop)))
+ (if (car prop-good-val)
+ (setq filtered-props-temp
+ (append filtered-props-temp
+ (list (car p) (cdr prop-good-val))))
+ (display-warning
+ 'toolbarx
+ (format (concat "Wrong type for value in "
+ "property `%s' in dropdown group")
+ (car p))))))))))
+ ;; properties for the dropdown button from dropdown merged properties
+ (dropdown-button-props
+ (let* ((props))
+ (save-match-data
+ (dolist (pr (nth 1 toolbarx-dropdown-props))
+ (when (and (memq pr merged-props-dropdown-only)
+ (string-match "^:dropdown-\\(.*\\)$"
+ (symbol-name pr)))
+ (let* ((new-pr (intern (concat ":"
+ (substring (symbol-name pr)
+ (match-beginning 1)
+ (match-end 1)))))
+ (val (cadr (memq pr merged-props-dropdown-only))))
+ (setq props (append (list new-pr val) props))))))
+ (unless (memq :image props)
+ (setq props (append (list :image "dropdown") props)))
+ props))
+ (dropdown-button-without-command
+ (cons 'dropdown dropdown-button-props))
+ ;; `:type' defaults to `radio'
+ (type (if (memq :type filtered-dropdown-group-props-only)
+ (cadr (memq :type filtered-dropdown-group-props-only))
+ 'radio))
+ ;; `:default' defaults to 1 or nil depending on `type'
+ ;; if type is toggle and default is not a list, but a
+ ;; integer, set as the list with integer
+ (default
+ (let* ((memq-default (memq :default
+ filtered-dropdown-group-props-only))
+ (def-temp (cadr memq-default))
+ (default-temp (if memq-default
+ def-temp
+ (if (eq type 'radio) 1 (list 1)))))
+ default-temp))
+ ;; `:save' defaults to nil and require `:variable'
+ (save (let* ((save-temp
+ (when (memq :save filtered-dropdown-group-props-only)
+ (cadr (memq :save
+ filtered-dropdown-group-props-only)))))
+ (if (and save-temp
+ (not (memq :variable
+ filtered-dropdown-group-props-only)))
+ (progn
+ (display-warning
+ 'toolbarx
+ (concat "`:save' property with non-nil value should "
+ "be used only with the `:variable' property; "
+ "using value nil for `:save'."))
+ nil)
+ save-temp)))
+ ;; `:title' defaults to nil
+ (title (when (memq :title filtered-dropdown-group-props-only)
+ (cadr (memq :title filtered-dropdown-group-props-only))))
+ ;; the menu variable is buildt from the `:variable' option or
+ ;; make a symbol not used
+ (variable (if (memq :variable filtered-dropdown-group-props-only)
+ (cadr (memq :variable
+ filtered-dropdown-group-props-only))
+ (let* ((count 0)
+ (symb (intern (format
+ "toolbarx-internal-menu-var-%d"
+ count))))
+ (while (boundp symb)
+ (setq count (1+ count))
+ (setq symb
+ (intern (format "toolbarx-internal-menu-var-%d"
+ count))))
+ symb)))
+ ;; auxiliary variables
+ (list-strings)
+ (list-buttons))
+ ;; setting `variable'
+ (if save
+ (custom-declare-variable
+ variable default
+ "Used as variable of dropdown menu defined with `toolbarx'.")
+ (when (not (boundp variable))
+ (set variable default)))
+ ;; now check `variable' content
+ (set variable
+ (let ((val (eval variable)))
+ (if (eq type 'toggle)
+ (if (listp val)
+ val
+ (if (integerp val)
+ (list val)
+ (list 1)))
+ ;; then, type is radio
+ (if (integerp val)
+ val
+ (if (and val
+ (listp val)
+ (integerp (car val)))
+ (car val)
+ 1)))))
+ ;; === buiding `list-strings' and `list-buttons' ===
+ ;; if only symbols, build `list-strings' and `list-buttons' from symbols
+ (if (let ((only-symbols-flag t))
+ (dolist (i dropdown-list only-symbols-flag)
+ (setq only-symbols-flag (and only-symbols-flag (symbolp i)))))
+ (let ((count 0))
+ (dolist (i dropdown-list)
+ ;; list-strings and list-buttons are buildt reversed
+ (setq list-strings (cons (toolbarx-make-string-from-symbol i)
+ list-strings))
+ (setq count (1+ count))
+ (setq list-buttons (cons (list i
+ :insert
+ (if (eq type 'radio)
+ (list 'eq count variable)
+ (list 'memq count variable)))
+ list-buttons))))
+ ;; if not, the it must start with string
+ (unless (stringp (car dropdown-list))
+ (error "%s %s %s"
+ "If not all itens on dropdown are symbols, then a string"
+ "must come before each set of buttons; no string found"
+ "in first position."))
+ (let ((count 0)
+ (elem)
+ (temp-list-buttons))
+ (while dropdown-list
+ (setq elem (car dropdown-list))
+ (setq dropdown-list (cdr dropdown-list))
+ (if (stringp elem)
+ ;; if string, output `temp-list-buttons' and prepair it again
+ (progn
+ ;; list-strings and list-buttons are buildt reversed
+ (setq list-strings (cons elem list-strings))
+ (when temp-list-buttons
+ (setq list-buttons (cons (append (nreverse temp-list-buttons)
+ (list :insert
+ (if (eq type 'radio)
+ (list 'eq count
+ variable)
+ (list 'memq count
+ variable))))
+ list-buttons)))
+ (setq temp-list-buttons nil)
+ (setq count (1+ count)))
+ ;; else, if not string, just insert it to `temp-list-buttons'
+ ;; which is also buildt reversed
+ (setq temp-list-buttons (cons elem temp-list-buttons))))
+ ;; output last temp list, left behind
+ (when temp-list-buttons
+ (setq list-buttons (cons (append (nreverse
+ temp-list-buttons)
+ (list
+ :insert (if (eq type 'radio)
+ (list 'eq count
+ variable)
+ (list 'memq count
+ variable))))
+ list-buttons)))))
+ ;; lists were made reversed (elements inserted at the beginning)
+ (setq list-strings (nreverse list-strings))
+ (setq list-buttons (nreverse list-buttons))
+ ;; now, pass `list-buttons' as a group to `toolbarx-process-group'
+ (let ((current-switches switches))
+ (setq current-switches
+ (toolbarx-process-group list-buttons meaning-alist
+ merged-props ; pass non-processed props
+ current-switches))
+ (setq current-switches
+ ;; outputing dropdown button
+ (toolbarx-process-group (append dropdown-button-without-command
+ (list :command
+ (toolbarx-mount-popup-menu
+ list-strings variable type
+ title save)))
+ meaning-alist merged-props-button-only
+ switches))
+ current-switches)))
+
+
+
+;; Still functions `toolbarx-install-toolbar' and `toolbarx-refresh'to
+;; complete the parsing engine. Since they interface with other
engines,
+;; they must come in the end.
+
+;;; How a image is made, giving a string as (part of) file name.
+
+;; look at function `image-type-available-p' for Emacs !!!!
+
+(defun toolbarx-find-image (image)
+ "Return image descriptor or glyph for IMAGE.
+In Emacs, return an image descriptor for IMAGE. In XEmacs,
+return a glyph.
+
+IMAGE is string. Usually IMAGE neither contains a directory nor
+an extension. If the extension is omitted, `xpm', `xbm' and
+`pbm' are tried. If the directory is omitted,
+`toolbarx-image-path' is searched."
+ ;; `find-image' in Emacs 21 looks in `load-path' and `data-directory'. In
+ ;; Emacs 22, we have `image-load-path' which includes `load-path' and
+ ;; `data-directory'.
+ ;;
+ ;; If there's some API in XEmacs to find the images, we should use it
+ ;; instead of locate-library.
+ ;;
+ ;; Emacs 22 has locate-file, but the other Emacsen don't. The
+ ;; following should hopefully get us to all images ultimately.
+
+ (let ((file))
+ (dolist (i '("" ".xpm" ".xbm" ".pbm"))
+ (unless file
+ (setq file (locate-library (concat image i) t toolbarx-image-path))))
+ (if (featurep 'xemacs)
+ (and file (make-glyph file))
+ (if file
+ (create-image file)
+ (find-image `((:type xpm :file ,(concat image ".xpm"))
+ (:type xbm :file ,(concat image ".xbm"))
+ (:type pbm :file ,(concat image ".pbm"))))))))
+
+;; next variable interfaces between parsing and display engines
+(defvar toolbarx-internal-button-switches nil
+ "Store the list of processed buttons, used by `toolbarx-refresh'.
+This variable can store different values for the different buffers.")
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Second engine: display parsed buttons in Emacs
+
+(defun toolbarx-emacs-add-button (button used-keys keymap)
+ "Insert a button where BUTTON is its description.
+USED-KEYS should be a list of symbols, where the first element is
+`:used-symbols'. This list should store the symbols of the
+buttons already inserted. This list is changed by side effect.
+KEYMAP is the keymap where the menu-item corresponding to the
+tool-bal button is going to be inserted. Insertion is made in
+the end of KEYMAP.
+
+BUTTON should be a list of form (SYMBOL . PROP-LIST). SYMBOL is
+a symbol that \"names\" this button. PROP-LIST is a list in the
+format (PROP VAL ... PROP VAL). The supported properties are
+`:image', `:command', `:append-command', `:prepend-command',
+`:help', `:enable', `:visible', `:button', `:insert' and
+`:toolbar'. For a description of properties, see documentation of
+function `toolbar-install-toolbar'."
+ (let* ((symbol (nth 0 button))
+ (used-keys-list (when used-keys
+ (cdr used-keys)))
+ (filtered-props
+ (let* ((filtered-props-temp)
+ (prop-good-val)
+ (prop))
+ (dolist (p (nth 0 toolbarx-button-props) filtered-props-temp)
+ ;; property -> (car p)
+ ;; test type function -> (cadr p)
+ ;; add-function -> (cddr p)
+ (setq prop (memq (car p) button))
+ ;; if so, check if value is of correct type
+ (when prop
+ ;; if property is of add-type, them the value is a list
+ ;; (:add-value-list VAL VAL). Each VAL should be checked.
+ (if (and (cddr p) (eq :add-value-list (car (cadr prop))))
+ (let* ((add-list (list (cddr p))))
+ (dolist (val (cdr (cadr prop)))
+ (setq prop-good-val (funcall (cadr p) val))
+ (when (car prop-good-val)
+ (setq add-list (cons (cdr prop-good-val) add-list))))
+ (setq add-list (nreverse add-list))
+ (when (eq 2 (length add-list)) ; just 1 value, no
+ ; add-function
+ (setq add-list (cadr add-list)))
+ (setq filtered-props-temp (append
+ (list (car p) add-list)
+ filtered-props-temp)))
+ ;; if override-property
+ (setq prop-good-val (funcall (cadr p) (cadr prop)))
+ (when (car prop-good-val)
+ (setq filtered-props-temp (append
+ (list (car p)
+ (cdr prop-good-val))
+ filtered-props-temp))))))))
+ (insert (or (not (memq :insert filtered-props))
+ ;; (memq :insert filtered-props)
+ (eval (nth 1 (memq :insert filtered-props))))))
+ (when insert
+ (cond
+ (t
+ ;; symbol is not :new-line, therefore a normal button
+ (let* ((image (cadr (memq :image filtered-props)))
+ (image-descriptor
+ (when (memq :image filtered-props)
+ (cond
+ ((stringp image) ; string
+ (toolbarx-find-image image))
+ ((and (consp image) ; or image descriptor
+ (eq (car image) 'image))
+ image)
+ ((and (symbolp image) ; or a symbol bound to a
+ (boundp image) ; image descriptor (defined
+ ; with `defimage')g
+ (consp (eval image))
+ (eq (car (eval image)) 'image))
+ (eval image))
+ (t ; otherwise, must be a list
+ ; with 4 strings or image
+ ; descriptors
+ (apply 'vector (mapcar (lambda (img)
+ (if (stringp img)
+ (toolbarx-find-image img)
+ img))
+ image))))))
+ (command
+ (let* ((com (nth 1 (memq :command filtered-props)))
+ (app (nth 1 (memq :append-command filtered-props)))
+ (prep (nth 1 (memq :prepend-command filtered-props))))
+ (when (or com app prep)
+ (toolbarx-make-command com prep app))))
+ (help (cons (memq :help filtered-props)
+ (cadr (memq :help filtered-props))))
+ (enable (cons (memq :enable filtered-props)
+ (cadr (memq :enable filtered-props))))
+ (visible (cons (memq :visible filtered-props)
+ (cadr (memq :visible filtered-props))))
+ (button (cons (memq :button filtered-props)
+ (cadr (memq :button filtered-props))))
+ (menuitem (append
+ (list 'menu-item
+ (toolbarx-make-string-from-symbol symbol)
+ command
+ :image image-descriptor)
+ (when (car help)
+ (list :help (cdr help)))
+ (when (car enable)
+ (list :enable (cdr enable)))
+ (when (car visible)
+ (list :visible (cdr visible)))
+ (when (car button)
+ (list :button (cdr button)))))
+ (key-not-used
+ (let* ((count 0)
+ (symb symbol))
+ (while (memq symb used-keys-list)
+ (setq count (1+ count))
+ (setq symb (intern (format "%s-%d" symbol count))))
+ symb)))
+ (when (and image-descriptor command)
+ (setq used-keys-list (cons key-not-used used-keys-list))
+ (define-key-after keymap
+ (vector key-not-used) menuitem))))))
+ (when used-keys (setcdr used-keys used-keys-list))))
+
+
+(defun toolbarx-emacs-refresh-process-button-or-insert-list (switches
+ used-keys
+ keymap)
+ "Process SWITCHES, inserting buttons in `tool-bar-map'.
+If a button is actually a `:insert' clause group (if `car' is
+`:insert') and evaluation of `cdr' yields non-nil, process `cddr'
+recursively as SWITCHES. USED-KEYS is a list which `car' is
+`:used-symbols' and which `cdr' is a list of symbols that have already
+been used as keys in the keymap `tool-bar-map'."
+ (dolist (button switches)
+ (if (eq (car button) :insert)
+ (when (eval (cadr button))
+ (toolbarx-emacs-refresh-process-button-or-insert-list (cddr button)
+ used-keys
+ keymap))
+ (toolbarx-emacs-add-button button used-keys keymap))))
+
+
+
+(defun toolbarx-emacs-refresh (&optional global-flag)
+ "Refresh and redraw the toolbar in Emacs.
+If GLOBAL-FLAG is non-nil, the default value of toolbar switches
+is used and the default value of `toolbarx-map' is changed."
+ (let* ((switches (if global-flag
+ (if (default-boundp 'toolbarx-internal-button-switches)
+ (default-value 'toolbarx-internal-button-switches)
+ toolbarx-internal-button-switches)
+ toolbarx-internal-button-switches))
+ (used-keys (list :used-symbols nil))
+ (tool-bar-map-temp (make-sparse-keymap)))
+ (toolbarx-emacs-refresh-process-button-or-insert-list switches used-keys
+ tool-bar-map-temp)
+ (if global-flag
+ (setq-default tool-bar-map tool-bar-map-temp)
+ (setq tool-bar-map tool-bar-map-temp))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Third engine: display parsed buttons in XEmacs
+
+(defun toolbarx-xemacs-image-properties (image)
+ "Return a list of properties of IMAGE.
+IMAGE should be a string or a list of one to six strings or
+glyphs or nil, or a symbol bound to a list of one to six
+glyphs (them must be a valid image list, like one created with
+the function `toolbar-make-button-list'). Return a
+list (GLYPH-LIST HEIGHT WIDTH) where HEIGHT (resp. WIDTH) is the
+maximum of the heights (resp. widths) of all glyphs (or strings
+converted to glyphs) in GLYPH-LIST. If IMAGE is not a list, it
+is treated as a list with IMAGE as only element. Strings are
+converted to glyphs with the function `toolbarx-find-image'. If,
+after possible string-to-glyph convertions, the list of glyphs
+has nil as first element, GLYPH-LIST becomes nil."
+ (let* ((glyph-list
+ (if (symbolp image) ; if symbol, them must be a
+ ; valid image list, like
+ ; created by function
+ ; `toolbar-make-button-list'
+ (eval image)
+ (let ((img-list (if (listp image)
+ image
+ (list image)))
+ (glyph-list-temp))
+ ;; glyph-list-temp
+ (setq glyph-list-temp
+ (dolist (glyph img-list (nreverse glyph-list-temp))
+ (if (stringp glyph)
+ (setq glyph-list-temp
+ (cons (toolbarx-find-image glyph)
+ glyph-list-temp))
+ (setq glyph-list-temp (cons glyph glyph-list-temp)))))
+ (unless (car glyph-list-temp)
+ (setq glyph-list-temp nil))
+ glyph-list-temp)))
+ (usable-buttons
+ ;; computing inheritage
+ (let* ((usable-temp))
+ (if toolbar-captioned-p ; problematic point :-(
+ (progn
+ ;; CAP-UP: cap-up -> up
+ (setq usable-temp (cons (cond
+ ((nth 3 glyph-list))
+ ((nth 0 glyph-list)))
+ usable-temp))
+ ;; CAP-DOWN: cap-down -> cap-up -> down -> up
+ (setq usable-temp (cons (cond
+ ((nth 4 glyph-list))
+ ((nth 3 glyph-list))
+ ((nth 1 glyph-list))
+ ((nth 0 glyph-list)))
+ usable-temp))
+ ;; CAP-DISABLED: cap-disabled -> cap-up -> disabled -> up
+ (setq usable-temp (cons (cond
+ ((nth 5 glyph-list))
+ ((nth 3 glyph-list))
+ ((nth 2 glyph-list))
+ ((nth 0 glyph-list)))
+ usable-temp)))
+ ;; UP: up
+ (setq usable-temp (cons (nth 0 glyph-list) usable-temp))
+ ;; DOWN: down -> up
+ (setq usable-temp (cons (cond
+ ((nth 1 glyph-list))
+ ((nth 0 glyph-list)))
+ usable-temp))
+ ;; DISABLED: disabled -> up
+ (setq usable-temp (cons (cond
+ ((nth 2 glyph-list))
+ ((nth 0 glyph-list)))
+ usable-temp)))
+ usable-temp))
+ (height (apply 'max 0 (mapcar (lambda (glyph)
+ (if glyph
+ (glyph-height glyph)
+ 0))
+ usable-buttons)))
+ (width (apply 'max 0 (mapcar (lambda (glyph)
+ (if glyph
+ (glyph-width glyph)
+ 0))
+ usable-buttons))))
+ (list (if (symbolp image) image glyph-list) height width)))
+
+
+
+(defun toolbarx-xemacs-button-properties (button)
+ "Return a list of properties of BUTTON.
+The result is either nil (if not to be inserted) or a list in the format
+ (TOOLBAR HEIGHT WIDTH BUTTON-DESCRIPTION)
+where
+
+TOOLBAR is one of the symbols `default', `top', `right', `bottom'
+ or `left'.
+
+HEIGHT and WIDTH are the maximal dimentions of all the glyphs
+ involved.
+
+BUTTON-DESCRIPTION is button definition in XEmacs; see the
+ documentation of variable `default-toolbar'."
+ (let* ((filtered-props
+ (let* ((filtered-props-temp)
+ (prop-good-val)
+ (prop))
+ (dolist (p (nth 0 toolbarx-button-props) filtered-props-temp)
+ ;; property -> (car p)
+ ;; test type function -> (cadr p)
+ ;; add-function -> (cddr p)
+ (setq prop (memq (car p) button))
+ ;; if so, check if value is of correct type
+ (when prop
+ ;; if property is of add-type, them the value is a list
+ ;; (:add-value-list VAL VAL). Each VAL should be checked.
+ (if (and (cddr p) (eq :add-value-list (car (cadr prop))))
+ (let* ((add-list (list (cddr p))))
+ (dolist (val (cdr (cadr prop)))
+ (setq prop-good-val (funcall (cadr p) val))
+ (when (car prop-good-val)
+ (setq add-list (cons (cdr prop-good-val) add-list))))
+ (setq add-list (nreverse add-list))
+ (when (eq 2 (length add-list)) ; just 1 value, no
+ ; add-function
+ (setq add-list (cadr add-list)))
+ (setq filtered-props-temp (append
+ (list (car p) add-list)
+ filtered-props-temp)))
+ ;; if override-property
+ (setq prop-good-val (funcall (cadr p) (cadr prop)))
+ (when (car prop-good-val)
+ (setq filtered-props-temp (append
+ (list (car p)
+ (cdr prop-good-val))
+ filtered-props-temp))))))))
+ (insert (or (not (memq :insert filtered-props))
+ ;; (memq :insert filtered-props) holds
+ (eval (nth 1 (memq :insert filtered-props))))))
+ (when insert
+ (let* ((image-props (toolbarx-xemacs-image-properties
+ (cadr (memq :image filtered-props))))
+ (glyph-list (car image-props))
+ (image-height (nth 1 image-props))
+ (image-width (nth 2 image-props))
+ (command
+ (let* ((com (nth 1 (memq :command filtered-props)))
+ (app (nth 1 (memq :append-command filtered-props)))
+ (prep (nth 1 (memq :prepend-command filtered-props))))
+ (when (or com app prep)
+ (toolbarx-make-command com prep app))))
+ ;; enable defaults to `t'
+ (enable (if (memq :enable filtered-props)
+ (cadr (memq :enable filtered-props))
+ t))
+ ;; help defaults to nil
+ (help (when (memq :help filtered-props)
+ (cadr (memq :help filtered-props))))
+ ;; toolbar defaults to `default'
+ (toolbar-prop (cons (memq :toolbar filtered-props)
+ (cadr (memq :toolbar filtered-props))))
+ (toolbar (if (car toolbar-prop)
+ (if (symbolp (cdr toolbar-prop))
+ (cdr toolbar-prop)
+ ;; (cdr toolbar-prop) is cons cell
+ (if (eq (cadr toolbar-prop)
+ (default-toolbar-position))
+ (cddr toolbar-prop)
+ (cadr toolbar-prop)))
+ 'default)))
+ (when glyph-list
+ (list toolbar image-height image-width
+ (vector glyph-list command enable help)))))))
+
+(defun toolbarx-xemacs-refresh-process-button-or-insert-list (switches
+ toolbar-props)
+ "Process SWITCHES, returning an updated version of TOOLBAR-PROPS.
+TOOLBAR-PROPS should be a list with 12 elements, each one representing
+properties (in this order) `locale', `default', `top', `right',
+`bottom', `left', `default-height', `default-width', `top-height',
+`right-width', `bottom-height' and `left-width'. The return is a list
+with the same properties updated.
+
+NB: Buttons (vectors) are inserted in front of the lists
+represented by `default', `top', `right', `bottom' and `left', so
+the lists are built reversed."
+ (let ((locale (nth 0 toolbar-props))
+ (default (nth 1 toolbar-props))
+ (top (nth 2 toolbar-props))
+ (right (nth 3 toolbar-props))
+ (bottom (nth 4 toolbar-props))
+ (left (nth 5 toolbar-props))
+ (default-height (nth 6 toolbar-props))
+ (default-width (nth 7 toolbar-props))
+ (top-height (nth 8 toolbar-props))
+ (right-width (nth 9 toolbar-props))
+ (bottom-height (nth 10 toolbar-props))
+ (left-width (nth 11 toolbar-props))
+ (toolbar-props-temp))
+ (dolist (button switches)
+ (if (eq (car button) :insert)
+ (when (eval (cadr button))
+ ;; if insert group, process `cddr'
+ (progn
+ (setq toolbar-props-temp
+ (toolbarx-xemacs-refresh-process-button-or-insert-list
+ (cddr button)
+ (list locale default top right bottom left
+ default-height default-width top-height
+ right-width bottom-height left-width)))
+ (setq default (nth 1 toolbar-props-temp))
+ (setq top (nth 2 toolbar-props-temp))
+ (setq right (nth 3 toolbar-props-temp))
+ (setq bottom (nth 4 toolbar-props-temp))
+ (setq left (nth 5 toolbar-props-temp))
+ (setq default-height (nth 6 toolbar-props-temp))
+ (setq default-width (nth 7 toolbar-props-temp))
+ (setq top-height (nth 8 toolbar-props-temp))
+ (setq right-width (nth 9 toolbar-props-temp))
+ (setq bottom-height (nth 10 toolbar-props-temp))
+ (setq left-width (nth 11 toolbar-props-temp))))
+ ;; else, if normal button
+ (let* ((button-props (toolbarx-xemacs-button-properties button))
+ (toolbar (nth 0 button-props))
+ (height (nth 1 button-props))
+ (width (nth 2 button-props))
+ (button-description (nth 3 button-props)))
+ (when button-props
+ (cond
+ ;; default
+ ((eq toolbar 'default)
+ (setq default (cons button-description default))
+ (setq default-height (max default-height height))
+ (setq default-width (max default-width width)))
+ ;; top
+ ((eq toolbar 'top)
+ (setq top (cons button-description top))
+ (setq top-height (max top-height height)))
+ ;; right
+ ((eq toolbar 'right)
+ (setq right (cons button-description right))
+ (setq right-width (max right-width width)))
+ ;; bottom
+ ((eq toolbar 'bottom)
+ (setq bottom (cons button-description bottom))
+ (setq bottom-height (max bottom-height height)))
+ ;; left
+ ((eq toolbar 'left)
+ (setq left (cons button-description left))
+ (setq left-width (max left-width width))))))))
+ ;; return a list similar to toolbar-props
+ (list locale default top right bottom left default-height
+ default-width top-height right-width bottom-height left-width)))
+
+
+(defun toolbarx-xemacs-refresh (&optional global-flag)
+ "Refresh the toolbar in XEmacs."
+ (let* ((switches (if global-flag
+ (if (default-boundp 'toolbarx-internal-button-switches)
+ (default-value 'toolbarx-internal-button-switches)
+ toolbarx-internal-button-switches)
+ toolbarx-internal-button-switches))
+ (locale (if global-flag 'global (current-buffer)))
+ (toolbar-init (list locale ; locale
+ nil ; default
+ nil ; top
+ nil ; right
+ nil ; bottom
+ nil ; left
+ 0 ; default-height
+ 0 ; default-width
+ 0 ; top-height
+ 0 ; right-width
+ 0 ; bottom-height
+ 0)) ; left-width
+ (toolbar-props
+ (toolbarx-xemacs-refresh-process-button-or-insert-list switches
+ toolbar-init))
+ ;; NB: Buttons (vectors) are inserted in front of the lists
+ ;; represented by `default', `top', `right', `bottom' and
+ ;; `left', so the lists are built reversed.
+ (default (nreverse (nth 1 toolbar-props)))
+ (top (nreverse (nth 2 toolbar-props)))
+ (right (nreverse (nth 3 toolbar-props)))
+ (bottom (nreverse (nth 4 toolbar-props)))
+ (left (nreverse (nth 5 toolbar-props)))
+ (default-height (nth 6 toolbar-props))
+ (default-width (nth 7 toolbar-props))
+ (top-height (nth 8 toolbar-props))
+ (right-width (nth 9 toolbar-props))
+ (bottom-height (nth 10 toolbar-props))
+ (left-width (nth 11 toolbar-props))
+ (button-raised-border 2)
+ (default-border (specifier-instance default-toolbar-border-width))
+ (top-border (specifier-instance top-toolbar-border-width))
+ (right-border (specifier-instance right-toolbar-border-width))
+ (bottom-border (specifier-instance bottom-toolbar-border-width))
+ (left-border (specifier-instance left-toolbar-border-width)))
+ ;; adding borders
+ (when default
+ (setq default-height (+ (* 2 button-raised-border)
+ (* 2 default-border)
+ default-height))
+ (setq default-width (+ (* 2 button-raised-border)
+ (* 2 default-border)
+ default-width)))
+ (when top
+ (setq top-height (+ (* 2 button-raised-border)
+ (* 2 top-border)
+ top-height)))
+ (when right
+ (setq right-width (+ (* 2 button-raised-border)
+ (* 2 right-border)
+ right-width)))
+ (when bottom
+ (setq bottom-height (+ (* 2 button-raised-border)
+ (* 2 bottom-border)
+ bottom-height)))
+ (when left
+ (setq left-width (+ (* 2 button-raised-border)
+ (* 2 left-border)
+ left-width)))
+ ;; deal with specifiers
+ ;; - remove all specifiers for toolbars witout buttons
+ (if default
+ (progn
+ ;; Only activate the tool bar if it is already visible.
+ (when toolbar-visible-p
+ (set-specifier default-toolbar-visible-p (not (not default)) locale)
+ (if (memq (default-toolbar-position) '(top bottom))
+ (set-specifier default-toolbar-height default-height locale)
+ (set-specifier default-toolbar-width default-width locale)))
+ (set-specifier default-toolbar default locale))
+ (remove-specifier default-toolbar locale)
+ (remove-specifier default-toolbar-visible-p locale)
+ (remove-specifier default-toolbar-height locale)
+ (remove-specifier default-toolbar-width locale))
+ (if top
+ (progn
+ (set-specifier top-toolbar-visible-p (not (not top)) locale)
+ (set-specifier top-toolbar-height top-height locale)
+ (set-specifier top-toolbar top locale))
+ (remove-specifier top-toolbar locale)
+ (remove-specifier top-toolbar-visible-p locale)
+ (remove-specifier top-toolbar-height locale))
+ (if right
+ (progn
+ (set-specifier right-toolbar-visible-p (not (not right))
+ locale)
+ (set-specifier right-toolbar-width right-width locale)
+ (set-specifier right-toolbar right locale))
+ (remove-specifier right-toolbar locale)
+ (remove-specifier right-toolbar-visible-p locale)
+ (remove-specifier right-toolbar-width locale))
+ (if bottom
+ (progn
+ (set-specifier bottom-toolbar-visible-p (not (not bottom)) locale)
+ (set-specifier bottom-toolbar-height bottom-height locale)
+ (set-specifier bottom-toolbar bottom locale))
+ (remove-specifier bottom-toolbar locale)
+ (remove-specifier bottom-toolbar-visible-p locale)
+ (remove-specifier bottom-toolbar-height locale))
+ (if left
+ (progn
+ (set-specifier left-toolbar-visible-p (not (not left)) locale)
+ (set-specifier left-toolbar-width left-width locale)
+ (set-specifier left-toolbar left locale))
+ (remove-specifier left-toolbar locale)
+ (remove-specifier left-toolbar-visible-p locale)
+ (remove-specifier left-toolbar-width locale))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; finishing parsing engine
+
+(defun toolbarx-refresh (&optional global-flag)
+ "Redraw the toolbar, peviously installed with `toolbarx'.
+Force global refresh if GLOBAL-FLAG is non-nil."
+ (interactive "P")
+ (if (featurep 'xemacs)
+ (toolbarx-xemacs-refresh global-flag)
+ (toolbarx-emacs-refresh global-flag)))
+
+;;;###autoload (autoload 'toolbarx-install-toolbar "toolbar-x")
+
+(defun toolbarx-install-toolbar (buttons &optional meaning-alist global-flag)
+ "Install toolbar buttons given in BUTTONS.
+Button properties are optionally given in MEANING-ALIST. If
+GLOBAL-FLAG is non-nil, toolbar is installed globally (on every
+buffer that does not have a toolbar set locally). BUTTONS is a
+list of format
+ (ELEM ... ELEM . PROPS),
+where each ELEM is either
+
+ - a list in the same format od BUTTONS, which is going to be
+ refered as a *group*; groups are used to distribute properties
+ recursively to its elements; there are groups with special
+ format for special purpose: *dropdown groups* and also *eval
+ groups*.
+
+ - a symbol, which could be associated in MEANING-ALIST with a
+ list of button properties (symbol + properties = a *button*)
+ or associated to a special kind of group (an *alias group*).
+
+ - a vector, which elements are on the previous formats (but not
+ another vector); this is useful to specify different
+ ingredients to the toolbar depending if editor is Emacs or
+ XEmacs; the first element will be used in Emacs; the second
+ element is going to be used in XEmacs.
+
+Meaning alist
+=============
+
+MEANING-ALIST is a list where each element is in one of the
+formats (SYMB . BUTTON-PROPS-LIST) or (SYMB . ALIAS-GROUP).
+BUTTON-PROPS-LIST is a list in one of the formats
+ (IMAGE COMMAND PROP VAL PROP VAL ... PROP VAL) or
+ (PROP VAL PROP VAL ... PROP VAL).
+The IMAGE is going to be used as the `:image' property of the
+button (see button properties bellow), and COMMAND shall be used
+as the `:command' property of the button. Each PROP is one of
+the button properties, and VAL is its respective value.
+ALIAS-GROUP is a list which first element is the symbol `:alias'
+and the cdr shall be processed as a group.
+
+However, a symbol is not required to have an association in
+MEANING-ALIST, which is only a way to specify properties to a
+button. One can use groups to specify properties. Nil is a good
+MEANING-ALIST.
+
+Buttons
+=======
+
+A toolbar button in `toolbarx' is the set with a symbol and
+properties used to display the button, like a image and a command
+to call when the button is pressed (which are the minimal
+elements that a button should have.) The supported properties
+for buttons and their `basic types' (see note on how values of
+properties are obtained!) are:
+
+ :image -- in Emacs, either a string or image descriptor (see
+ info for a definition), or a variable bound to a image
+ descriptor (like those defined with `defimage') or a list of 4
+ strings or image descriptors; in XEmacs, either a string or a
+ glyph, or a symbol bount to a glyph, or a list of at least 1
+ and at most 6 strings or glyphs or nil (not the first element
+ though); defines the image file displayed by the button. If
+ it is a string, the image file found with that name (always
+ using the function `toolbarx-find-image' to make the
+ \`internal\' image descriptor) is used as button image. For
+ the other formats, the button image is handled in the same way
+ as it is treated by the editors; see info nodes bellow for a
+ description of the capabilities of each editor
+ Emacs: info file \"elisp\", node \"Tool Bar\" (see `:image'
+ property);
+ PS: a *vector* of four strings is used in the Emacs
+ Lisp documentation as the `more ellaborated' image
+ property format, but here we reserve vectors to
+ provide editor-dependent values; this motivates our
+ choice for a list instead of vector (however,
+ internally the list becomes a vector when displaying
+ the button).
+ XEmacs: info file \"lispref\", node \"Toolbar Descriptor
+ Format\" (see GLYPH-LIST) or the documentation of
+ the variable `default-toolbar'; check the inheritage
+ in case of a ommited glyph or nil instead of glyph.
+
+ :command -- a form; if the form happens to be a command, it will
+ be called with `call-interactively'.
+
+ :append-command -- a form added to the end of the value of
+ `:command'.
+
+ :prepend-command -- a form added at the beginning of the value
+ of `:command'.
+
+ :help -- either a string or nil; defined the help string of the
+ button;
+
+ :enable -- a form, evaluated constantly by both editors to
+ determine if a button is active (enabled) or not.
+
+ :visible -- in Emacs, a form that is evaluated constantly to
+ determine if a button is visible; in XEmacs, this property is
+ ignored.
+
+ :button -- in Emacs, a cons cell (TYPE . SELECTED) where the
+ TYPE should be `:toggle' or `:radio' and the cdr should be a
+ form. SELECTED is evaluated to determine when the button is
+ selected. This property is ignored in XEmacs.
+
+ :insert -- a form that is evaluated every time that the toolbar
+ is refresh (a call of `toolbarx-refresh') to determine if the
+ button is inserted or just ignored (until next refresh).
+
+ :toolbar -- in XEmacs, either one of the symbols `default',
+ `top', `bottom', `left', `right', or a cons cell
+ (POS . POS-AVOID-DEFAULT) where POS and POS-AVOID-DEFAULT
+ should be one of the symbols `top', `bottom', `left', `right';
+ if a symbol, the button will be inserted in one of these
+ toolbars; if a cons cell, button will be inserted in toolbar
+ POS unless the position of the default toolbar is POS (then,
+ the default toolbar would override the position-specific
+ toolbar), and in this case, button will be inserted in toolbar
+ POS-AVOID-DEFAULT; in Emacs, this property is meaningless, and
+ therefore ignored. Hint of use of this property: in a
+ program, use or everything with `default' and the cons format
+ to avoid the default toolbar, or use only the position
+ specific buttons (symbols that are not `default'), because of
+ the `overriding' system in XEmacs, when a position-specific
+ toolbar overrides the default toolbar; for instance, if you
+ put a button in the default toolbar and another in the top
+ toolbar (and the default toolbar is in the top), then *only*
+ the ones in the top toolbar will be visible!
+
+How to specify a button
+=======================
+
+One can specify a button by its symbol or by a group to specify
+properties. For example,
+ BUTTON =
+ ( foo
+ (bar :image [\"bar-Emacs\" \"bar-XEmacs\"]
+ :command bar-function :help \"Bar help string\")
+ :insert foo-bar )
+ MEANING-ALIST = ( (foo :image \"foo\" :command foo-function) )
+specifiy two buttons `foo' and `bar', each one with its necessary
+:image and :command properties, and both use the :insert property
+specified ate the end of BUTTONS (because groups distribute
+properties to all its elements). `foo' and `bar' will be
+inserted only if `foo-bar' evaluation yields non-nil. `bar' used
+a different :image property depending if editor is Emacs or
+XEmacs.
+
+Note on how values of properties are obtained
+=============================================
+
+For each property PROP, its value should be either:
+ i) a vector of 2 elements; then each element should be of the
+ basic type of PROP.
+ ii) an element on the basic type of PROP.
+ iii) a function (that does not need arguments); it is evaluated
+ and the return should be ot type i) or ii) above
+ iv) a symbol bound to a element of type i) or ii).
+
+The type is cheched in the order i), ii) iii) and iv). This
+evaluations are done every time that the oolbar is refresh.
+
+Ps.: in order to specify a vector as value of a property (like
+the :image in Emacs), it is necessary to provide the vector as
+element of another vector.
+
+Special groups
+==============
+
+Eval groups
+-----------
+
+If the first element of a group is the symbol `:eval-group', each
+element is evaluated (with `eval'), put inside a list and
+processed like a group. Eval groups are useful to store
+definition of buttons in a variable.
+
+Dropdown groups
+---------------
+
+The idea is to specify a set of buttons that appear when a
+determined menu item of a dropdown menu is active. The dropdown
+menu appears when a button (by default with a triangle pointing
+down) is clicked. This button is called `dropdown button'. The
+dropdown button appears on the left of the currently visible
+buttons of the dropdown group.
+
+A dropdown group is a list which first element is the symbol
+`:dropdown-group' and in one of the following formats
+ (:dropdown-group SYMBOL-1 ... SYMBOL-n PROP-1 VAL-1 ... PROP-k VAL-k)
+or
+ (:dropdown-group
+ STRING-1 ITEM-11 ... ITEM-1n
+ STRING-2 ITEM-21 ... ITEM-2m
+ . . .
+ STRING-n ITEM-n1 ... ITEM-np
+ PROP-1 VAL-1 ... PROP-j VAL-j)
+where
+ SYMBOL-* is a symbol that defines a button in MEANING-ALIST;
+ STRING-* is a string that will appear in the dropdown menu;
+ ITEM-* is any format that define buttons or groups.
+
+\(a dropdown group of first format is internally converted to the
+second by making strings from the symbols and each symbol is the
+item)
+
+The same rules for obtaining property values, described above,
+apply here. Properties are also distributed by groups. The
+supported properties and their basic type are:
+
+ :type -- one of the symbols `radio' (default) or `toggle'; if
+ type is radio, only one of the itens may be active, and if
+ type is toggle, any item number of itens can be active.
+
+ :variable -- a symbol; it is the variable that govern the
+ dropdown button; every time the value should be an integer
+ starting from 1 (if type is radio) or a list of integers (if
+ type is toggle). The Nth set of buttons is :insert'ed.
+
+ :default -- determines the default value when the menu is
+ installed; it is ignored if a value was saved with custom; it
+ defaults to 1 if type is radio or nil if type is toggle. If
+ value is a integer and type is `toggle', value used is a list
+ with that integer.
+
+ :save -- one of the symbols nil (default), `offer' or
+ `always'; determined if it is possible for the user to save
+ the which menu itens are active, for a next session. If value
+ is `offer', a item (offering to save) is added to the
+ popup menu. If the value is `always', every time that a item
+ is selected, the variable is saved. If value is nil, variable
+ shall not be saved. If value is non-nil then `:variable' is
+ mandatory.
+
+ :title -- a string or nil; if a string, the popup menu will show
+ is as menu title; if nil, no title is shown.
+
+ :dropdown-help -- a string or nil; the help string of the
+ dropdown button.
+
+ :dropdown-image -- in Emacs, either a string or a vector of 4
+ strings; in XEmacs, either a string or a glyph or a list of at
+ least 1 and at most 6 strings or glyphs; defines the image
+ file displayed by the dropdown button; by default, it is the
+ string \"dropdown\".
+
+ :dropdown-append-command,
+ :dropdownprepend-command -- a form; append or prepend forms to
+ the command that shows the dropdown menu, allowing extra code
+ to run before or after the menu appears (remember that every
+ menu item clicked refresh the toolbar.)
+
+ :dropdown-enable -- a form; evaluated constantly by both editors
+ to determine if the dropdown button is active (enabled) or
+ not.
+
+ :dropdown-visible -- a form; in Emacs, it is evaluated
+ constantly to determine if the dropdown button is visible; in
+ XEmacs, this property is ignored.
+
+ :dropdown-toolbar -- in XEmacs, one of the symbols `default',
+ `opposite', `top', `bottom', `left' or `right'; ignored in
+ Emacs; in XEmacs, the toolbar where the dropdown button will
+ appear.
+
+Also, if the symbol `dropdown' is associted in MEANING-ALIST
+with some properties, these properties override (or add) with
+higher precedence.
+
+Special buttons
+===============
+
+If the symbol of a button is `:new-line', it is inserted
+a (faked) return, and the next button will be displayed a next
+line of buttons. The only property supported for this button is
+`:insert'. This feature is available only in Emacs. In XEmacs,
+this button is ignored."
+ (let ((switches (toolbarx-process-group buttons meaning-alist nil nil)))
+ (if global-flag
+ (setq-default toolbarx-internal-button-switches
+ switches)
+ (set (make-local-variable 'toolbarx-internal-button-switches)
+ switches)
+ (unless (featurep 'xemacs)
+ (make-local-variable 'tool-bar-map))))
+ (toolbarx-refresh global-flag))
+
+
+(defconst toolbarx-default-toolbar-meaning-alist
+ `((separator :image "sep" :command t :enable nil :help "")
+
+ (,(if (and (not (featurep 'xemacs)) (>= emacs-major-version 22))
+ 'new-file
+ 'open-file)
+ :image ["new" toolbar-file-icon]
+ :command [find-file toolbar-open]
+ :enable [(not (window-minibuffer-p
+ (frame-selected-window menu-updating-frame)))
+ t]
+ :help ["Specify a new file's name, to edit the file" "Visit new file"])
+
+ ,(when (and (not (featurep 'xemacs)) (>= emacs-major-version 22))
+ '(open-file :image ["open" toolbar-file-icon]
+ :command [menu-find-file-existing toolbar-open]
+ :enable [(not (window-minibuffer-p
+ (frame-selected-window menu-updating-frame)))
+ t]
+ :help ["Read a file into an Emacs buffer" "Open a file"]))
+
+ (dired :image [,(if (>= emacs-major-version 22)
+ "diropen"
+ "open")
+ toolbar-folder-icon]
+ :command [dired toolbar-dired]
+ :help ["Read a directory, operate on its files" "Edit a directory"])
+
+ (save-buffer :image ["save" toolbar-disk-icon]
+ :command [save-buffer toolbar-save]
+ :enable [(and
+ (buffer-modified-p)
+ (buffer-file-name)
+ (not (window-minibuffer-p
+ (frame-selected-window menu-updating-frame))))
+ t]
+ :help ["Save current buffer to its file" "Save buffer"]
+ :visible (or buffer-file-name
+ (not (eq 'special
+ (get major-mode 'mode-class)))))
+
+ ;; Emacs only
+ (write-file :image "saveas"
+ :command write-file
+ :enable (not
+ (window-minibuffer-p
+ (frame-selected-window menu-updating-frame)))
+ :insert [t nil]
+ :help "Write current buffer to another file"
+ :visible (or buffer-file-name
+ (not (eq 'special (get major-mode 'mode-class)))))
+
+ (undo :image ["undo" toolbar-undo-icon]
+ :command [undo toolbar-undo]
+ :enable [(and (not buffer-read-only)
+ (not (eq t buffer-undo-list))
+ (if (eq last-command 'undo)
+ pending-undo-list
+ (consp buffer-undo-list)))
+ t]
+ :help ["Undo last operation" "Undo edit"]
+ :visible (not (eq 'special (get major-mode 'mode-class))))
+
+ (cut :image ["cut" toolbar-cut-icon]
+ :help ["Delete text in region and copy it to the clipboard"
+ "Kill region"]
+ :command [clipboard-kill-region toolbar-cut]
+ :visible (not (eq 'special (get major-mode 'mode-class))))
+
+ (copy :image ["copy" toolbar-copy-icon]
+ :help ["Copy text in region to the clipboard" "Copy region"]
+ :command [clipboard-kill-ring-save toolbar-copy])
+
+ (paste :image ["paste" toolbar-paste-icon]
+ :help ["Paste text from clipboard" "Paste from clipboard"]
+ :command [clipboard-yank toolbar-paste]
+ :visible (not (eq 'special (get major-mode 'mode-class))))
+
+ ;; Emacs only
+ (search-forward :command nonincremental-search-forward
+ :help "Search forward for a string"
+ :image "search"
+ :insert [t nil])
+
+ (search-replace
+ :image ["search-replace" toolbar-replace-icon]
+ :command [query-replace toolbar-replace]
+ :help ["Replace string interactively, ask about each occurrence"
+ "Search & Replace"])
+
+ (print-buffer :image ["print" toolbar-printer-icon]
+ :command [print-buffer toolbar-print]
+ :help ["Print current buffer with page headings"
+ "Print buffer"])
+
+ ;; Emacs only
+ (customize :image "preferences"
+ :command customize
+ :help "Edit preferences (customize)"
+ :insert [t nil])
+
+ ;; Emacs only
+ (help :image "help"
+ :command (lambda () (interactive) (popup-menu menu-bar-help-menu))
+ :help "Pop up the Help menu"
+ :insert [t nil])
+
+ ;; Emacs only
+ (kill-buffer :command kill-this-buffer
+ :enable (kill-this-buffer-enabled-p)
+ :help "Discard current buffer"
+ :image "close"
+ :insert [t nil])
+
+ ;; Emacs only
+ (exit-emacs :image "exit"
+ :command save-buffers-kill-emacs
+ :help "Offer to save unsaved buffers, then exit Emacs"
+ :insert [t nil])
+
+ (spell-buffer :image ["spell" toolbar-spell-icon]
+ :command [ispell-buffer toolbar-ispell]
+ :help ["Check spelling of selected buffer" "Check spelling"])
+
+ (info :image ["info" toolbar-info-icon]
+ :command [info toolbar-info]
+ :help ["Enter Info, the documentation browser" "Info documentation"])
+
+ ;; XEmacs only
+ (mail :image toolbar-mail-icon
+ :command toolbar-mail
+ :help "Read mail"
+ :insert [nil t])
+
+ ;; XEmacs only
+ (compile :image toolbar-compile-icon
+ :command toolbar-compile
+ :help "Start a compilation"
+ :insert [nil t])
+
+ ;; XEmacs only
+ (debug :image toolbar-debug-icon
+ :command toolbar-debug
+ :help "Start a debugger"
+ :insert [nil t])
+
+ ;; XEmacs only
+ (news :image toolbar-news-icon
+ :command toolbar-news
+ :help "Read news"
+ :insert [nil t]))
+ "A meaning alist with definition of the default buttons.
+The following buttons are available:
+
+* Both Emacs and XEmacs: `open-file', `dired', `save-buffer',
+ `undo', `cut', `copy', `paste', `search-replace', `print-buffer',
+ `spell-buffer', `info'.
+
+* Emacs only: `new-file' (Emacs 22+) `write-file', `search-forward',
+ `customize', `help', `kill-buffer', `exit-emacs'.
+
+* XEmacs only: `mail', `compile', `debug', `news'.
+
+To reproduce the default toolbar in both editors with use as BUTTON
+in `toolbarx-install-toolbar':
+
+\(toolbarx-install-toolbar
+ '([(open-file dired kill-buffer save-buffer write-file undo cut
+ copy paste search-forward print-buffer customize help)
+ (open-file dired save-buffer print-buffer cut copy paste undo
+ spell-buffer search-replace mail info compile debug news)])
+ toolbarx-default-toolbar-meaning-alist)
+
+Ps.: there are more buttons available than suggested in the
+expression above.")
+
+(provide 'toolbar-x)
+
+;;; toolbar-x.el ends here
diff --git a/tests/cl-lib.el b/tests/cl-lib.el
new file mode 100644
index 0000000..ce11309
--- /dev/null
+++ b/tests/cl-lib.el
@@ -0,0 +1,410 @@
+;;; cl-lib.el --- Properly prefixed CL functions and macros -*- coding: utf-8
-*-
+
+;; Copyright (C) 2012, 2013, 2014 Free Software Foundation, Inc.
+
+;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
+;; vcomment: Emacs-24.3's version is 1.0 so this has to stay below.
+;; Version: 0.5
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This is a forward compatibility package, which provides (a subset of) the
+;; features of the cl-lib package introduced in Emacs-24.3, for use on
+;; previous emacsen.
+
+;; Make sure this is installed *late* in your `load-path`, i.e. after Emacs's
+;; built-in .../lisp/emacs-lisp directory, so that if/when you upgrade to
+;; Emacs-24.3, the built-in version of the file will take precedence, otherwise
+;; you could get into trouble (although we try to hack our way around the
+;; problem in case it happens).
+
+;; This code is largely copied from Emacs-24.3's cl.el, with the alias bindings
+;; simply reversed.
+
+;;; Code:
+
+;; We need to handle the situation where this package is used with an Emacs
+;; that comes with a real cl-lib (i.e. ≥24.3).
+
+;; First line of defense: try to make sure the built-in cl-lib comes earlier in
+;; load-path so we never get loaded:
+;;;###autoload (let ((d (file-name-directory #$)))
+;;;###autoload (when (member d load-path)
+;;;###autoload (setq load-path (append (remove d load-path) (list d)))))
+
+(when (functionp 'macroexp--compiler-macro)
+ ;; `macroexp--compiler-macro' was introduced as part of the big CL
+ ;; reorganization which moved/reimplemented some of CL into core (mostly the
+ ;; setf and compiler-macro support), so its presence indicates we're running
+ ;; in an Emacs that comes with the new cl-lib.el, where this file should
+ ;; never be loaded!
+ (message "Real cl-lib shadowed by compatibility cl-lib? (%s)" load-file-name)
+ (when load-file-name
+ ;; (message "Let's try to patch things up")
+ (let ((loaddir (file-name-directory load-file-name))
+ load-path-dir)
+ ;; Find the problematic directory from load-path.
+ (dolist (dir load-path)
+ (if (equal loaddir (expand-file-name (file-name-as-directory dir)))
+ (setq load-path-dir dir)))
+ (when load-path-dir
+ ;; (message "Let's move the offending dir to the end")
+ (setq load-path (append (remove load-path-dir load-path)
+ (list load-path-dir)))
+ ;; Here we could manually load cl-lib and then return immediately.
+ ;; But Emacs currently doesn't provide any way for a file to "return
+ ;; immediately", so instead we make sure the rest of the file does not
+ ;; throw away any pre-existing definition.
+ ))))
+
+(require 'cl)
+
+;; Some of Emacs-24.3's cl.el definition are not just aliases, because either
+;; the feature was dropped from cl-lib.el or because the cl-lib version is
+;; not fully compatible.
+;; Let's just not include them here, since it is very important that if code
+;; works with this cl-lib.el it should also work with Emacs-24.3's cl-lib.el,
+;; whereas the reverse is much less important.
+
+(dolist (var '(
+ ;; loop-result-var
+ ;; loop-result
+ ;; loop-initially
+ ;; loop-finally
+ ;; loop-bindings
+ ;; loop-args
+ ;; bind-inits
+ ;; bind-block
+ ;; lambda-list-keywords
+ float-negative-epsilon
+ float-epsilon
+ least-negative-normalized-float
+ least-positive-normalized-float
+ least-negative-float
+ least-positive-float
+ most-negative-float
+ most-positive-float
+ ;; custom-print-functions
+ ))
+ (let ((new (intern (format "cl-%s" var))))
+ (unless (boundp new) (defvaralias new var))))
+
+;; The following cl-lib functions were already defined in the old cl.el,
+;; with a different meaning:
+;; - cl-position and cl-delete-duplicates
+;; the two meanings are clearly different, but we can distinguish which was
+;; meant by looking at the arguments.
+;; - cl-member
+;; the old meaning hasn't been used for a long time and is a subset of the
+;; new, so we can simply override it.
+;; - cl-adjoin
+;; the old meaning is actually the same as the new except for optimizations.
+
+(dolist (fun '(
+ (get* . cl-get)
+ (random* . cl-random)
+ (rem* . cl-rem)
+ (mod* . cl-mod)
+ (round* . cl-round)
+ (truncate* . cl-truncate)
+ (ceiling* . cl-ceiling)
+ (floor* . cl-floor)
+ (rassoc* . cl-rassoc)
+ (assoc* . cl-assoc)
+ ;; (member* . cl-member) ;Handle specially below.
+ (delete* . cl-delete)
+ (remove* . cl-remove)
+ (defsubst* . cl-defsubst)
+ (sort* . cl-sort)
+ (function* . cl-function)
+ (defmacro* . cl-defmacro)
+ (defun* . cl-defun)
+ (mapcar* . cl-mapcar)
+
+ remprop
+ getf
+ tailp
+ list-length
+ nreconc
+ revappend
+ concatenate
+ subseq
+ random-state-p
+ make-random-state
+ signum
+ isqrt
+ lcm
+ gcd
+ notevery
+ notany
+ every
+ some
+ mapcon
+ mapcan
+ mapl
+ maplist
+ map
+ equalp
+ coerce
+ tree-equal
+ nsublis
+ sublis
+ nsubst-if-not
+ nsubst-if
+ nsubst
+ subst-if-not
+ subst-if
+ subsetp
+ nset-exclusive-or
+ set-exclusive-or
+ nset-difference
+ set-difference
+ nintersection
+ intersection
+ nunion
+ union
+ rassoc-if-not
+ rassoc-if
+ assoc-if-not
+ assoc-if
+ member-if-not
+ member-if
+ merge
+ stable-sort
+ search
+ mismatch
+ count-if-not
+ count-if
+ count
+ position-if-not
+ position-if
+ ;; position ;Handle specially via defadvice below.
+ find-if-not
+ find-if
+ find
+ nsubstitute-if-not
+ nsubstitute-if
+ nsubstitute
+ substitute-if-not
+ substitute-if
+ substitute
+ ;; delete-duplicates ;Handle specially via defadvice below.
+ remove-duplicates
+ delete-if-not
+ delete-if
+ remove-if-not
+ remove-if
+ replace
+ fill
+ reduce
+ compiler-macroexpand
+ define-compiler-macro
+ assert
+ check-type
+ typep
+ deftype
+ defstruct
+ callf2
+ callf
+ letf*
+ letf
+ rotatef
+ shiftf
+ remf
+ psetf
+ declare
+ the
+ locally
+ multiple-value-setq
+ multiple-value-bind
+ symbol-macrolet
+ macrolet
+ progv
+ psetq
+ do-all-symbols
+ do-symbols
+ dotimes
+ dolist
+ do*
+ do
+ loop
+ return-from
+ return
+ block
+ etypecase
+ typecase
+ ecase
+ case
+ load-time-value
+ eval-when
+ destructuring-bind
+ gentemp
+ gensym
+ pairlis
+ acons
+ subst
+ ;; adjoin ;It's already defined.
+ copy-list
+ ldiff
+ list*
+ cddddr
+ cdddar
+ cddadr
+ cddaar
+ cdaddr
+ cdadar
+ cdaadr
+ cdaaar
+ cadddr
+ caddar
+ cadadr
+ cadaar
+ caaddr
+ caadar
+ caaadr
+ caaaar
+ cdddr
+ cddar
+ cdadr
+ cdaar
+ caddr
+ cadar
+ caadr
+ caaar
+ tenth
+ ninth
+ eighth
+ seventh
+ sixth
+ fifth
+ fourth
+ third
+ endp
+ rest
+ second
+ first
+ svref
+ copy-seq
+ evenp
+ oddp
+ minusp
+ plusp
+ floatp-safe
+ declaim
+ proclaim
+ nth-value
+ multiple-value-call
+ multiple-value-apply
+ multiple-value-list
+ values-list
+ values
+ pushnew
+ decf
+ incf
+
+ dolist
+ dotimes
+ ))
+ (let ((new (if (consp fun) (prog1 (cdr fun) (setq fun (car fun)))
+ (intern (format "cl-%s" fun)))))
+ (if (fboundp new)
+ (unless (or (eq (symbol-function new) fun)
+ (eq new (and (symbolp fun) (fboundp fun)
+ (symbol-function fun))))
+ (message "%S already defined, not rebinding" new))
+ (defalias new fun))))
+
+(unless (symbolp (symbol-function 'position))
+ (autoload 'cl-position "cl-seq")
+ (defadvice cl-position (around cl-lib (cl-item cl-seq &rest cl-keys)
activate)
+ (let ((argk (ad-get-args 2)))
+ (if (or (null argk) (keywordp (car argk)))
+ ;; This is a call to cl-lib's `cl-position'.
+ (setq ad-return-value
+ (apply #'position (ad-get-arg 0) (ad-get-arg 1) argk))
+ ;; Must be a call to cl's old `cl-position'.
+ ad-do-it))))
+
+(unless (symbolp (symbol-function 'delete-duplicates))
+ (autoload 'cl-delete-duplicates "cl-seq")
+ (defadvice cl-delete-duplicates (around cl-lib (cl-seq &rest cl-keys)
activate)
+ (let ((argk (ad-get-args 1)))
+ (if (or (null argk) (keywordp (car argk)))
+ ;; This is a call to cl-lib's `cl-delete-duplicates'.
+ (setq ad-return-value
+ (apply #'delete-duplicates (ad-get-arg 0) argk))
+ ;; Must be a call to cl's old `cl-delete-duplicates'.
+ ad-do-it))))
+
+(when (or (not (fboundp 'cl-member))
+ (eq (symbol-function 'cl-member) #'memq))
+ (defalias 'cl-member #'member*))
+
+;; `cl-labels' is not 100% compatible with `labels' when using dynamic scoping
+;; (mostly because it does not turn lambdas that refer to those functions into
+;; closures). OTOH it is compatible when using lexical scoping.
+
+(unless (fboundp 'cl-labels)
+ (defmacro cl-labels (&rest args)
+ (unless (and (boundp 'lexical-binding) lexical-binding)
+ ;; We used to signal an error rather than a message, but in many uses of
+ ;; cl-labels, the value of lexical-binding doesn't actually matter.
+ ;; More importantly, the value of `lexical-binding' here is unreliable
+ ;; (it does not necessarily reflect faithfully whether the output of this
+ ;; macro will be interpreted as lexically bound code or not).
+ (message "This `cl-labels' requires `lexical-binding' to be non-nil"))
+ `(labels ,@args)))
+
+;;;; ChangeLog:
+
+;; 2014-02-25 Stefan Monnier <monnier@iro.umontreal.ca>
+;;
+;; Fixes: debbugs:16671
+;;
+;; * cl-lib.el (cl-position, cl-delete-duplicate): Don't advise if >=24.3.
+;; (load-path): Try to make sure we're at the end.
+;;
+;; 2014-01-25 Stefan Monnier <monnier@iro.umontreal.ca>
+;;
+;; * cl-lib.el: Resolve conflicts with old internal definitions
+;; (bug#16353).
+;; (dolist fun): Don't skip definitions silently.
+;; (define-setf-expander): Remove, not in cl-lib.
+;; (cl-position, cl-delete-duplicates): Add advice to distinguish the use
+;; case.
+;; (cl-member): Override old definition.
+;;
+;; 2013-05-22 Stefan Monnier <monnier@iro.umontreal.ca>
+;;
+;; * cl-lib.el (cl-labels): Demote error to message and improve it.
+;;
+;; 2012-11-30 Stefan Monnier <monnier@iro.umontreal.ca>
+;;
+;; * cl-lib.el: Try and patch things up in case we're hiding the real
+;; cl-lib.
+;;
+;; 2012-11-22 Stefan Monnier <monnier@iro.umontreal.ca>
+;;
+;; Add cl-letf and cl-labels.
+;;
+;; 2012-11-16 Stefan Monnier <monnier@iro.umontreal.ca>
+;;
+;; * packages/cl-lib: New package.
+;;
+
+
+(provide 'cl-lib)
+;;; cl-lib.el ends here
diff --git a/tests/dash-functional.el b/tests/dash-functional.el
new file mode 100644
index 0000000..eb2484a
--- /dev/null
+++ b/tests/dash-functional.el
@@ -0,0 +1,155 @@
+;;; dash-functional.el --- Collection of useful combinators for Emacs Lisp
-*- lexical-binding: t -*-
+
+;; Copyright (C) 2013 Matus Goljer, Magnar Sveen
+
+;; Authors: Matus Goljer <matus.goljer@gmail.com>
+;; Magnar Sveen <magnars@gmail.com>
+;; Version: 1.1.0
+;; Package-Requires: ((dash "2.0.0") (emacs "24"))
+;; Keywords: lisp functions combinators
+
+;; 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:
+
+;; Collection of useful combinators for Emacs Lisp
+;;
+;; See documentation on https://github.com/magnars/dash.el#functions
+
+;;; Code:
+
+(require 'dash)
+
+(defun -partial (fn &rest args)
+ "Takes a function FN and fewer than the normal arguments to FN,
+and returns a fn that takes a variable number of additional ARGS.
+When called, the returned function calls FN with ARGS first and
+then additional args."
+ (apply 'apply-partially fn args))
+
+(defun -rpartial (fn &rest args)
+ "Takes a function FN and fewer than the normal arguments to FN,
+and returns a fn that takes a variable number of additional ARGS.
+When called, the returned function calls FN with the additional
+args first and then ARGS."
+ (lambda (&rest args-before) (apply fn (append args-before args))))
+
+(defun -juxt (&rest fns)
+ "Takes a list of functions and returns a fn that is the
+juxtaposition of those fns. The returned fn takes a variable
+number of args, and returns a list containing the result of
+applying each fn to the args (left-to-right)."
+ (lambda (&rest args) (mapcar (lambda (x) (apply x args)) fns)))
+
+(defun -compose (&rest fns)
+ "Takes a list of functions and returns a fn that is the
+composition of those fns. The returned fn takes a variable
+number of arguments, and returns the result of applying
+each fn to the result of applying the previous fn to
+the arguments (right-to-left)."
+ (lambda (&rest args)
+ (car (-reduce-r-from (lambda (fn xs) (list (apply fn xs)))
+ args fns))))
+
+(defun -applify (fn)
+ "Changes an n-arity function FN to a 1-arity function that
+expects a list with n items as arguments"
+ (apply-partially 'apply fn))
+
+(defun -on (operator transformer)
+ "Return a function of two arguments that first applies
+TRANSFORMER to each of them and then applies OPERATOR on the
+results (in the same order).
+
+In types: (b -> b -> c) -> (a -> b) -> a -> a -> c"
+ (lambda (x y) (funcall operator (funcall transformer x) (funcall transformer
y))))
+
+(defun -flip (func)
+ "Swap the order of arguments for binary function FUNC.
+
+In types: (a -> b -> c) -> b -> a -> c"
+ (lambda (x y) (funcall func y x)))
+
+(defun -const (c)
+ "Return a function that returns C ignoring any additional arguments.
+
+In types: a -> b -> a"
+ (lambda (&rest _) c))
+
+(defmacro -cut (&rest params)
+ "Take n-ary function and n arguments and specialize some of them.
+Arguments denoted by <> will be left unspecialized.
+
+See SRFI-26 for detailed description."
+ (let* ((i 0)
+ (args (mapcar (lambda (_) (setq i (1+ i)) (make-symbol (format "D%d"
i)))
+ (-filter (-partial 'eq '<>) params))))
+ `(lambda ,args
+ ,(--map (if (eq it '<>) (pop args) it) params))))
+
+(defun -not (pred)
+ "Take an unary predicates PRED and return an unary predicate
+that returns t if PRED returns nil and nil if PRED returns
+non-nil."
+ (lambda (x) (not (funcall pred x))))
+
+(defun -orfn (&rest preds)
+ "Take list of unary predicates PREDS and return an unary
+predicate with argument x that returns non-nil if at least one of
+the PREDS returns non-nil on x.
+
+In types: [a -> Bool] -> a -> Bool"
+ (lambda (x) (-any? (-cut funcall <> x) preds)))
+
+(defun -andfn (&rest preds)
+ "Take list of unary predicates PREDS and return an unary
+predicate with argument x that returns non-nil if all of the
+PREDS returns non-nil on x.
+
+In types: [a -> Bool] -> a -> Bool"
+ (lambda (x) (-all? (-cut funcall <> x) preds)))
+
+(defun -iteratefn (fn n)
+ "Return a function FN composed N times with itself.
+
+FN is a unary function. If you need to use a function of higher
+arity, use `-applify' first to turn it into an unary function.
+
+With n = 0, this acts as identity function.
+
+In types: (a -> a) -> Int -> a -> a.
+
+This function satisfies the following law:
+
+ (funcall (-iteratefn fn n) init) = (-last-item (-iterate fn init (1+ n)))."
+ (lambda (x) (--dotimes n (setq x (funcall fn x))) x))
+
+(defun -prodfn (&rest fns)
+ "Take a list of n functions and return a function that takes a
+list of length n, applying i-th function to i-th element of the
+input list. Returns a list of length n.
+
+In types (for n=2): ((a -> b), (c -> d)) -> (a, c) -> (b, d)
+
+This function satisfies the following laws:
+
+ (-compose (-prodfn f g ...) (-prodfn f' g' ...)) = (-prodfn (-compose f f')
(-compose g g') ...)
+ (-prodfn f g ...) = (-juxt (-compose f (-partial 'nth 0)) (-compose g
(-partial 'nth 1)) ...)
+ (-compose (-prodfn f g ...) (-juxt f' g' ...)) = (-juxt (-compose f f')
(-compose g g') ...)
+ (-compose (-partial 'nth n) (-prod f1 f2 ...)) = (-compose fn (-partial 'nth
n))"
+ (lambda (x) (-zip-with 'funcall fns x)))
+
+(provide 'dash-functional)
+
+;;; dash-functional.el ends here
diff --git a/tests/dash-tests.el b/tests/dash-tests.el
new file mode 100644
index 0000000..b0a4922
--- /dev/null
+++ b/tests/dash-tests.el
@@ -0,0 +1,653 @@
+;; -*- lexical-binding: t -*-
+
+(byte-compile-file "dash.el")
+(require 'dash)
+
+;; (macroexpand '(--mapcat (apply 'append (--map (list it) it))
+;; ;; (list it)
+;; ;; it
+;; ))
+
+(defun even? (num) (= 0 (% num 2)))
+(defun square (num) (* num num))
+(defun three-letters () '("A" "B" "C"))
+
+(ert-deftest -map ()
+ (should (equal (-map (lambda (num) (* num num)) '(1 2 3 4)) '(1 4 9 16)))
+ (should (equal (-map 'square '(1 2 3 4)) '(1 4 9 16)))
+ (should (equal (--map (* it it) '(1 2 3 4)) '(1 4 9 16)))
+ (should (equal (--map (concat it it) (three-letters)) '("AA" "BB" "CC"))))
+
+(ert-deftest -map-when ()
+ (should (equal (-map-when 'even? 'square '(1 2 3 4)) '(1 4 3 16)))
+ (should (equal (--map-when (> it 2) (* it it) '(1 2 3 4)) '(1 2 9 16)))
+ (should (equal (--map-when (= it 2) 17 '(1 2 3 4)) '(1 17 3 4)))
+ (should (equal (-map-when (lambda (n) (= n 3)) (lambda (n) 0) '(1 2 3 4))
'(1 2 0 4))))
+
+(ert-deftest -map-indexed ()
+ (should (equal (-map-indexed (lambda (index item) (- item index)) '(1 2 3
4)) '(1 1 1 1)))
+ (should (equal (--map-indexed (- it it-index) '(1 2 3 4)) '(1 1 1 1))))
+
+(ert-deftest -annotate ()
+ (should (equal (-annotate '1+ '(1 2 3)) '((2 . 1) (3 . 2) (4 . 3))))
+ (should (equal (-annotate 'length '(("h" "e" "l" "l" "o") ("hello"
"world"))) '((5 . ("h" "e" "l" "l" "o")) (2 . ("hello" "world")))))
+ (should (equal (--annotate (< 1 it) '(0 1 2 3)) '((nil . 0) (nil . 1) (t .
2) (t . 3)))))
+
+(ert-deftest -splice ()
+ (should (equal (-splice 'even? (lambda (x) (list x x)) '(1 2 3 4)) '(1 2 2 3
4 4)))
+ (should (equal (--splice 't (list it it) '(1 2 3 4)) '(1 1 2 2 3 3 4 4)))
+ (should (equal (--splice (equal it :magic) '((list of) (magical) (code))
'((foo) (bar) :magic (baz))) '((foo) (bar) (list of) (magical) (code) (baz)))))
+
+(ert-deftest -splice-list ()
+ (should (equal (-splice-list 'keywordp '(a b c) '(1 :foo 2)) '(1 a b c 2)))
+ (should (equal (-splice-list 'keywordp nil '(1 :foo 2)) '(1 2))))
+
+(ert-deftest -mapcat ()
+ (should (equal (-mapcat 'list '(1 2 3)) '(1 2 3)))
+ (should (equal (-mapcat (lambda (item) (list 0 item)) '(1 2 3)) '(0 1 0 2 0
3)))
+ (should (equal (--mapcat (list 0 it) '(1 2 3)) '(0 1 0 2 0 3))))
+
+(ert-deftest -copy ()
+ (should (equal (-copy '(1 2 3)) '(1 2 3)))
+ (should (equal (let ((a '(1 2 3))) (eq a (-copy a))) nil)))
+
+(ert-deftest -filter ()
+ (should (equal (-filter (lambda (num) (= 0 (% num 2))) '(1 2 3 4)) '(2 4)))
+ (should (equal (-filter 'even? '(1 2 3 4)) '(2 4)))
+ (should (equal (--filter (= 0 (% it 2)) '(1 2 3 4)) '(2 4))))
+
+(ert-deftest -remove ()
+ (should (equal (-remove (lambda (num) (= 0 (% num 2))) '(1 2 3 4)) '(1 3)))
+ (should (equal (-remove 'even? '(1 2 3 4)) '(1 3)))
+ (should (equal (--remove (= 0 (% it 2)) '(1 2 3 4)) '(1 3)))
+ (should (equal (let ((mod 2)) (-remove (lambda (num) (= 0 (% num mod))) '(1
2 3 4))) '(1 3)))
+ (should (equal (let ((mod 2)) (--remove (= 0 (% it mod)) '(1 2 3 4))) '(1
3))))
+
+(ert-deftest -slice ()
+ (should (equal (-slice '(1 2 3 4 5) 1) '(2 3 4 5)))
+ (should (equal (-slice '(1 2 3 4 5) 0 3) '(1 2 3)))
+ (should (equal (-slice '(1 2 3 4 5 6 7 8 9) 1 -1 2) '(2 4 6 8)))
+ (should (equal (-slice '(1 2 3 4 5) 0 10) '(1 2 3 4 5))) ;; "to > length"
should not fill in nils!
+ (should (equal (-slice '(1 2 3 4 5) -3) '(3 4 5)))
+ (should (equal (-slice '(1 2 3 4 5) -3 -1) '(3 4)))
+ (should (equal (-slice '(1 2 3 4 5 6) 0 nil 1) '(1 2 3 4 5 6)))
+ (should (equal (-slice '(1 2 3 4 5 6) 0 nil 2) '(1 3 5)))
+ (should (equal (-slice '(1 2 3 4 5 6) 0 nil 3) '(1 4)))
+ (should (equal (-slice '(1 2 3 4 5 6) 0 nil 10) '(1)))
+ (should (equal (-slice '(1 2 3 4 5 6) 1 4 2) '(2 4)))
+ (should (equal (-slice '(1 2 3 4 5 6) 2 6 3) '(3 6)))
+ (should (equal (-slice '(1 2 3 4 5 6) 2 -1 2) '(3 5)))
+ (should (equal (-slice '(1 2 3 4 5 6) -4 -1 2) '(3 5)))
+ (should (equal (-slice '(1 2 3 4 5 6) 1 2 10) '(2))))
+
+(ert-deftest -take ()
+ (should (equal (-take 3 '(1 2 3 4 5)) '(1 2 3)))
+ (should (equal (-take 17 '(1 2 3 4 5)) '(1 2 3 4 5))))
+
+(ert-deftest -drop ()
+ (should (equal (-drop 3 '(1 2 3 4 5)) '(4 5)))
+ (should (equal (-drop 17 '(1 2 3 4 5)) '())))
+
+(ert-deftest -take-while ()
+ (should (equal (-take-while 'even? '(1 2 3 4)) '()))
+ (should (equal (-take-while 'even? '(2 4 5 6)) '(2 4)))
+ (should (equal (--take-while (< it 4) '(1 2 3 4 3 2 1)) '(1 2 3))))
+
+(ert-deftest -drop-while ()
+ (should (equal (-drop-while 'even? '(1 2 3 4)) '(1 2 3 4)))
+ (should (equal (-drop-while 'even? '(2 4 5 6)) '(5 6)))
+ (should (equal (--drop-while (< it 4) '(1 2 3 4 3 2 1)) '(4 3 2 1))))
+
+(ert-deftest -select-by-indices ()
+ (should (equal (-select-by-indices '(4 10 2 3 6) '("v" "e" "l" "o" "c" "i"
"r" "a" "p" "t" "o" "r")) '("c" "o" "l" "o" "r")))
+ (should (equal (-select-by-indices '(2 1 0) '("a" "b" "c")) '("c" "b" "a")))
+ (should (equal (-select-by-indices '(0 1 2 0 1 3 3 1) '("f" "a" "r" "l"))
'("f" "a" "r" "f" "a" "l" "l" "a"))))
+
+(ert-deftest -keep ()
+ (should (equal (-keep 'cdr '((1 2 3) (4 5) (6))) '((2 3) (5))))
+ (should (equal (-keep (lambda (num) (when (> num 3) (* 10 num))) '(1 2 3 4 5
6)) '(40 50 60)))
+ (should (equal (--keep (when (> it 3) (* 10 it)) '(1 2 3 4 5 6)) '(40 50
60))))
+
+(ert-deftest -concat ()
+ (should (equal (-concat '(1)) '(1)))
+ (should (equal (-concat '(1) '(2)) '(1 2)))
+ (should (equal (-concat '(1) '(2 3) '(4)) '(1 2 3 4)))
+ (should (equal (-concat) nil)))
+
+(ert-deftest -flatten ()
+ (should (equal (-flatten '((1))) '(1)))
+ (should (equal (-flatten '((1 (2 3) (((4 (5))))))) '(1 2 3 4 5)))
+ (should (equal (-flatten '(1 2 (3 . 4))) '(1 2 (3 . 4)))))
+
+;; (ert-deftest -flatten-n ()
+;; (should (equal (-flatten-n 1 '((1 2) ((3 4) ((5 6))))) '(1 2 (3 4) ((5
6)))))
+;; (should (equal (-flatten-n 2 '((1 2) ((3 4) ((5 6))))) '(1 2 3 4 (5 6))))
+;; (should (equal (-flatten-n 3 '((1 2) ((3 4) ((5 6))))) '(1 2 3 4 5 6)))
+;; (should (equal (-flatten-n 0 '(3 4)) '(3 4)))
+;; (should (equal (-flatten-n 0 '((1 2) (3 4))) '((1 2) (3 4))))
+;; (should (equal (-flatten-n 0 '(((1 2) (3 4)))) '(((1 2) (3 4))))))
+
+(ert-deftest -replace ()
+ (should (equal (-replace 1 "1" '(1 2 3 4 3 2 1)) '("1" 2 3 4 3 2 "1")))
+ (should (equal (-replace "foo" "bar" '("a" "nice" "foo" "sentence" "about"
"foo")) '("a" "nice" "bar" "sentence" "about" "bar")))
+ (should (equal (-replace 1 2 nil) nil)))
+
+(ert-deftest -insert-at ()
+ (should (equal (-insert-at 1 'x '(a b c)) '(a x b c)))
+ (should (equal (-insert-at 12 'x '(a b c)) '(a b c x))))
+
+(ert-deftest -replace-at ()
+ (should (equal (-replace-at 0 9 '(0 1 2 3 4 5)) '(9 1 2 3 4 5)))
+ (should (equal (-replace-at 1 9 '(0 1 2 3 4 5)) '(0 9 2 3 4 5)))
+ (should (equal (-replace-at 4 9 '(0 1 2 3 4 5)) '(0 1 2 3 9 5)))
+ (should (equal (-replace-at 5 9 '(0 1 2 3 4 5)) '(0 1 2 3 4 9))))
+
+(ert-deftest -update-at ()
+ (should (equal (-update-at 0 (lambda (x) (+ x 9)) '(0 1 2 3 4 5)) '(9 1 2 3
4 5)))
+ (should (equal (-update-at 1 (lambda (x) (+ x 8)) '(0 1 2 3 4 5)) '(0 9 2 3
4 5)))
+ (should (equal (--update-at 2 (length it) '("foo" "bar" "baz" "quux"))
'("foo" "bar" 3 "quux")))
+ (should (equal (--update-at 2 (concat it "zab") '("foo" "bar" "baz" "quux"))
'("foo" "bar" "bazzab" "quux"))))
+
+(ert-deftest -remove-at ()
+ (should (equal (-remove-at 0 '("0" "1" "2" "3" "4" "5")) '("1" "2" "3" "4"
"5")))
+ (should (equal (-remove-at 1 '("0" "1" "2" "3" "4" "5")) '("0" "2" "3" "4"
"5")))
+ (should (equal (-remove-at 2 '("0" "1" "2" "3" "4" "5")) '("0" "1" "3" "4"
"5")))
+ (should (equal (-remove-at 3 '("0" "1" "2" "3" "4" "5")) '("0" "1" "2" "4"
"5")))
+ (should (equal (-remove-at 4 '("0" "1" "2" "3" "4" "5")) '("0" "1" "2" "3"
"5")))
+ (should (equal (-remove-at 5 '("0" "1" "2" "3" "4" "5")) '("0" "1" "2" "3"
"4")))
+ (should (equal (-remove-at 5 '((a b) (c d) (e f g) h i ((j) k) l (m))) '((a
b) (c d) (e f g) h i l (m))))
+ (should (equal (-remove-at 0 '(((a b) (c d) (e f g) h i ((j) k) l (m))))
nil)))
+
+(ert-deftest -remove-at-indices ()
+ (should (equal (-remove-at-indices '(0) '("0" "1" "2" "3" "4" "5")) '("1"
"2" "3" "4" "5")))
+ (should (equal (-remove-at-indices '(0 2 4) '("0" "1" "2" "3" "4" "5"))
'("1" "3" "5")))
+ (should (equal (-remove-at-indices '(0 5) '("0" "1" "2" "3" "4" "5")) '("1"
"2" "3" "4")))
+ (should (equal (-remove-at-indices '(1 2 3) '("0" "1" "2" "3" "4" "5"))
'("0" "4" "5")))
+ (should (equal (-remove-at-indices '(0 1 2 3 4 5) '("0" "1" "2" "3" "4"
"5")) nil))
+ (should (equal (-remove-at-indices '(2 0 4) '("0" "1" "2" "3" "4" "5"))
'("1" "3" "5")))
+ (should (equal (-remove-at-indices '(5 0) '("0" "1" "2" "3" "4" "5")) '("1"
"2" "3" "4")))
+ (should (equal (-remove-at-indices '(1 3 2) '("0" "1" "2" "3" "4" "5"))
'("0" "4" "5")))
+ (should (equal (-remove-at-indices '(0 3 4 2 5 1) '("0" "1" "2" "3" "4"
"5")) nil))
+ (should (equal (-remove-at-indices '(1) '("0" "1" "2" "3" "4" "5")) '("0"
"2" "3" "4" "5")))
+ (should (equal (-remove-at-indices '(2) '("0" "1" "2" "3" "4" "5")) '("0"
"1" "3" "4" "5")))
+ (should (equal (-remove-at-indices '(3) '("0" "1" "2" "3" "4" "5")) '("0"
"1" "2" "4" "5")))
+ (should (equal (-remove-at-indices '(4) '("0" "1" "2" "3" "4" "5")) '("0"
"1" "2" "3" "5")))
+ (should (equal (-remove-at-indices '(5) '("0" "1" "2" "3" "4" "5")) '("0"
"1" "2" "3" "4")))
+ (should (equal (-remove-at-indices '(1 2 4) '((a b) (c d) (e f g) h i ((j)
k) l (m))) '((a b) h ((j) k) l (m))))
+ (should (equal (-remove-at-indices '(5) '((a b) (c d) (e f g) h i ((j) k) l
(m))) '((a b) (c d) (e f g) h i l (m))))
+ (should (equal (-remove-at-indices '(0) '(((a b) (c d) (e f g) h i ((j) k) l
(m)))) nil))
+ (should (equal (-remove-at-indices '(2 3) '((0) (1) (2) (3) (4) (5) (6)))
'((0) (1) (4) (5) (6)))))
+
+(ert-deftest -reduce-from ()
+ (should (equal (-reduce-from '- 10 '(1 2 3)) 4))
+ (should (equal (-reduce-from (lambda (memo item)
+ (concat "(" memo " - " (int-to-string item)
")")) "10" '(1 2 3)) "(((10 - 1) - 2) - 3)"))
+ (should (equal (--reduce-from (concat acc " " it) "START" '("a" "b" "c"))
"START a b c"))
+ (should (equal (-reduce-from '+ 7 '()) 7))
+ (should (equal (-reduce-from '+ 7 '(1)) 8)))
+
+(ert-deftest -reduce-r-from ()
+ (should (equal (-reduce-r-from '- 10 '(1 2 3)) -8))
+ (should (equal (-reduce-r-from (lambda (item memo)
+ (concat "(" (int-to-string item) " - " memo
")")) "10" '(1 2 3)) "(1 - (2 - (3 - 10)))"))
+ (should (equal (--reduce-r-from (concat it " " acc) "END" '("a" "b" "c")) "a
b c END"))
+ (should (equal (-reduce-r-from '+ 7 '()) 7))
+ (should (equal (-reduce-r-from '+ 7 '(1)) 8)))
+
+(ert-deftest -reduce ()
+ (should (equal (-reduce '- '(1 2 3 4)) -8))
+ (should (equal (-reduce (lambda (memo item) (format "%s-%s" memo item)) '(1
2 3)) "1-2-3"))
+ (should (equal (--reduce (format "%s-%s" acc it) '(1 2 3)) "1-2-3"))
+ (should (equal (-reduce '+ '()) 0))
+ (should (equal (-reduce '+ '(1)) 1))
+ (should (equal (--reduce (format "%s-%s" acc it) '()) "nil-nil")))
+
+(ert-deftest -reduce-r ()
+ (should (equal (-reduce-r '- '(1 2 3 4)) -2))
+ (should (equal (-reduce-r (lambda (item memo) (format "%s-%s" memo item))
'(1 2 3)) "3-2-1"))
+ (should (equal (--reduce-r (format "%s-%s" acc it) '(1 2 3)) "3-2-1"))
+ (should (equal (-reduce-r '+ '()) 0))
+ (should (equal (-reduce-r '+ '(1)) 1))
+ (should (equal (--reduce-r (format "%s-%s" it acc) '()) "nil-nil")))
+
+(ert-deftest -count ()
+ (should (equal (-count 'even? '(1 2 3 4 5)) 2))
+ (should (equal (--count (< it 4) '(1 2 3 4)) 3)))
+
+(ert-deftest -sum ()
+ (should (equal (-sum '()) 0))
+ (should (equal (-sum '(1)) 1))
+ (should (equal (-sum '(1 2 3 4)) 10)))
+
+(ert-deftest -product ()
+ (should (equal (-product '()) 1))
+ (should (equal (-product '(1)) 1))
+ (should (equal (-product '(1 2 3 4)) 24)))
+
+(ert-deftest -min ()
+ (should (equal (-min '(0)) 0))
+ (should (equal (-min '(3 2 1)) 1))
+ (should (equal (-min '(1 2 3)) 1)))
+
+(ert-deftest -min-by ()
+ (should (equal (-min-by '> '(4 3 6 1)) 1))
+ (should (equal (--min-by (> (car it) (car other)) '((1 2 3) (2) (3 2))) '(1
2 3)))
+ (should (equal (--min-by (> (length it) (length other)) '((1 2 3) (2) (3
2))) '(2))))
+
+(ert-deftest -max ()
+ (should (equal (-max '(0)) 0))
+ (should (equal (-max '(3 2 1)) 3))
+ (should (equal (-max '(1 2 3)) 3)))
+
+(ert-deftest -max-by ()
+ (should (equal (-max-by '> '(4 3 6 1)) 6))
+ (should (equal (--max-by (> (car it) (car other)) '((1 2 3) (2) (3 2))) '(3
2)))
+ (should (equal (--max-by (> (length it) (length other)) '((1 2 3) (2) (3
2))) '(1 2 3))))
+
+(ert-deftest -iterate ()
+ (should (equal (-iterate '1+ 1 10) '(1 2 3 4 5 6 7 8 9 10)))
+ (should (equal (-iterate (lambda (x) (+ x x)) 2 5) '(2 4 8 16 32)))
+ (should (equal (--iterate (* it it) 2 5) '(2 4 16 256 65536))))
+
+(ert-deftest -unfold ()
+ (should (equal (-unfold (lambda (x) (unless (= x 0) (cons x (1- x)))) 10)
'(10 9 8 7 6 5 4 3 2 1)))
+ (should (equal (--unfold (when it (cons it (cdr it))) '(1 2 3 4)) '((1 2 3
4) (2 3 4) (3 4) (4))))
+ (should (equal (--unfold (when it (cons it (butlast it))) '(1 2 3 4)) '((1 2
3 4) (1 2 3) (1 2) (1)))))
+
+(ert-deftest -any? ()
+ (should (equal (-any? 'even? '(1 2 3)) t))
+ (should (equal (-any? 'even? '(1 3 5)) nil))
+ (should (equal (--any? (= 0 (% it 2)) '(1 2 3)) t)))
+
+(ert-deftest -all? ()
+ (should (equal (-all? 'even? '(1 2 3)) nil))
+ (should (equal (-all? 'even? '(2 4 6)) t))
+ (should (equal (--all? (= 0 (% it 2)) '(2 4 6)) t)))
+
+(ert-deftest -none? ()
+ (should (equal (-none? 'even? '(1 2 3)) nil))
+ (should (equal (-none? 'even? '(1 3 5)) t))
+ (should (equal (--none? (= 0 (% it 2)) '(1 2 3)) nil)))
+
+(ert-deftest -only-some? ()
+ (should (equal (-only-some? 'even? '(1 2 3)) t))
+ (should (equal (-only-some? 'even? '(1 3 5)) nil))
+ (should (equal (-only-some? 'even? '(2 4 6)) nil))
+ (should (equal (--only-some? (> it 2) '(1 2 3)) t)))
+
+(ert-deftest -contains? ()
+ (should (equal (-contains? '(1 2 3) 1) t))
+ (should (equal (-contains? '(1 2 3) 2) t))
+ (should (equal (-contains? '(1 2 3) 4) nil))
+ (should (equal (-contains? '() 1) nil))
+ (should (equal (-contains? '() '()) nil)))
+
+(ert-deftest -same-items? ()
+ (should (equal (-same-items? '(1 2 3) '(1 2 3)) t))
+ (should (equal (-same-items? '(1 2 3) '(3 2 1)) t))
+ (should (equal (-same-items? '(1 2 3) '(1 2 3 4)) nil))
+ (should (equal (-same-items? '((a . 1) (b . 2)) '((a . 1) (b . 2))) t))
+ (should (equal (-same-items? '(1 2 3) '(2 3 1)) t)))
+
+(ert-deftest -is-prefix? ()
+ (should (equal (-is-prefix? '(1 2 3) '(1 2 3 4 5)) t))
+ (should (equal (-is-prefix? '(1 2 3 4 5) '(1 2 3)) nil))
+ (should (equal (-is-prefix? '(1 3) '(1 2 3 4 5)) nil))
+ (should (equal (-is-prefix? '(1 2 3) '(1 2 4 5)) nil)))
+
+(ert-deftest -is-suffix? ()
+ (should (equal (-is-suffix? '(3 4 5) '(1 2 3 4 5)) t))
+ (should (equal (-is-suffix? '(1 2 3 4 5) '(3 4 5)) nil))
+ (should (equal (-is-suffix? '(3 5) '(1 2 3 4 5)) nil))
+ (should (equal (-is-suffix? '(3 4 5) '(1 2 3 5)) nil)))
+
+(ert-deftest -is-infix? ()
+ (should (equal (-is-infix? '(1 2 3) '(1 2 3 4 5)) t))
+ (should (equal (-is-infix? '(2 3 4) '(1 2 3 4 5)) t))
+ (should (equal (-is-infix? '(3 4 5) '(1 2 3 4 5)) t))
+ (should (equal (-is-infix? '(2 3 4) '(1 2 4 5)) nil))
+ (should (equal (-is-infix? '(2 4) '(1 2 3 4 5)) nil)))
+
+(ert-deftest -split-at ()
+ (should (equal (-split-at 3 '(1 2 3 4 5)) '((1 2 3) (4 5))))
+ (should (equal (-split-at 17 '(1 2 3 4 5)) '((1 2 3 4 5) nil))))
+
+(ert-deftest -split-with ()
+ (should (equal (-split-with 'even? '(1 2 3 4)) '(() (1 2 3 4))))
+ (should (equal (-split-with 'even? '(2 4 5 6)) '((2 4) (5 6))))
+ (should (equal (--split-with (< it 4) '(1 2 3 4 3 2 1)) '((1 2 3) (4 3 2
1)))))
+
+(ert-deftest -split-on ()
+ (should (equal (-split-on '| '(Nil | Leaf a | Node [Tree a])) '((Nil) (Leaf
a) (Node [Tree a]))))
+ (should (equal (-split-on ':endgroup '("a" "b" :endgroup "c" :endgroup "d"
"e")) '(("a" "b") ("c") ("d" "e"))))
+ (should (equal (-split-on ':endgroup '("a" "b" :endgroup :endgroup "d" "e"))
'(("a" "b") ("d" "e"))))
+ (should (equal (-split-on ':endgroup '("a" "b" :endgroup "c" :endgroup))
'(("a" "b") ("c"))))
+ (should (equal (-split-on ':endgroup '("a" "b" :endgroup :endgroup :endgroup
"d" "e")) '(("a" "b") ("d" "e"))))
+ (should (equal (-split-on ':endgroup '(:endgroup "c" :endgroup "d" "e"))
'(("c") ("d" "e"))))
+ (should (equal (-split-on '| '(Nil | | Node [Tree a])) '((Nil) (Node [Tree
a])))))
+
+(ert-deftest -split-when ()
+ (should (equal (-split-when 'even? '(1 2 3 4 5 6)) '((1) (3) (5))))
+ (should (equal (-split-when 'even? '(1 2 3 4 6 8 9)) '((1) (3) (9))))
+ (should (equal (--split-when (memq it '(&optional &rest)) '(a b &optional c
d &rest args)) '((a b) (c d) (args))))
+ (should (equal (-split-when 'even? '(1 2 3 5 6)) '((1) (3 5))))
+ (should (equal (-split-when 'even? '(1 2 3 5)) '((1) (3 5))))
+ (should (equal (-split-when 'even? '(1 3 4 5 6)) '((1 3) (5))))
+ (should (equal (-split-when 'even? '(1 2 3 4 5 6 8 10)) '((1) (3) (5))))
+ (should (equal (-split-when 'even? '(1 2 3 5 7 6)) '((1) (3 5 7)))))
+
+(ert-deftest -separate ()
+ (should (equal (-separate (lambda (num) (= 0 (% num 2))) '(1 2 3 4 5 6 7))
'((2 4 6) (1 3 5 7))))
+ (should (equal (--separate (< it 5) '(3 7 5 9 3 2 1 4 6)) '((3 3 2 1 4) (7 5
9 6))))
+ (should (equal (-separate 'cdr '((1 2) (1) (1 2 3) (4))) '(((1 2) (1 2 3))
((1) (4))))))
+
+(ert-deftest -partition ()
+ (should (equal (-partition 2 '(1 2 3 4 5 6)) '((1 2) (3 4) (5 6))))
+ (should (equal (-partition 2 '(1 2 3 4 5 6 7)) '((1 2) (3 4) (5 6))))
+ (should (equal (-partition 3 '(1 2 3 4 5 6 7)) '((1 2 3) (4 5 6)))))
+
+(ert-deftest -partition-all ()
+ (should (equal (-partition-all 2 '(1 2 3 4 5 6)) '((1 2) (3 4) (5 6))))
+ (should (equal (-partition-all 2 '(1 2 3 4 5 6 7)) '((1 2) (3 4) (5 6) (7))))
+ (should (equal (-partition-all 3 '(1 2 3 4 5 6 7)) '((1 2 3) (4 5 6) (7)))))
+
+(ert-deftest -partition-in-steps ()
+ (should (equal (-partition-in-steps 2 1 '(1 2 3 4)) '((1 2) (2 3) (3 4))))
+ (should (equal (-partition-in-steps 3 2 '(1 2 3 4)) '((1 2 3))))
+ (should (equal (-partition-in-steps 3 2 '(1 2 3 4 5)) '((1 2 3) (3 4 5))))
+ (should (equal (-partition-in-steps 2 1 '(1)) '())))
+
+(ert-deftest -partition-all-in-steps ()
+ (should (equal (-partition-all-in-steps 2 1 '(1 2 3 4)) '((1 2) (2 3) (3 4)
(4))))
+ (should (equal (-partition-all-in-steps 3 2 '(1 2 3 4)) '((1 2 3) (3 4))))
+ (should (equal (-partition-all-in-steps 3 2 '(1 2 3 4 5)) '((1 2 3) (3 4 5)
(5))))
+ (should (equal (-partition-all-in-steps 2 1 '(1)) '((1)))))
+
+(ert-deftest -partition-by ()
+ (should (equal (-partition-by 'even? '()) '()))
+ (should (equal (-partition-by 'even? '(1 1 2 2 2 3 4 6 8)) '((1 1) (2 2 2)
(3) (4 6 8))))
+ (should (equal (--partition-by (< it 3) '(1 2 3 4 3 2 1)) '((1 2) (3 4 3) (2
1)))))
+
+(ert-deftest -partition-by-header ()
+ (should (equal (--partition-by-header (= it 1) '(1 2 3 1 2 1 2 3 4)) '((1 2
3) (1 2) (1 2 3 4))))
+ (should (equal (--partition-by-header (> it 0) '(1 2 0 1 0 1 2 3 0)) '((1 2
0) (1 0) (1 2 3 0))))
+ (should (equal (-partition-by-header 'even? '(2 1 1 1 4 1 3 5 6 6 1)) '((2 1
1 1) (4 1 3 5) (6 6 1)))))
+
+(ert-deftest -group-by ()
+ (should (equal (-group-by 'even? '()) '()))
+ (should (equal (-group-by 'even? '(1 1 2 2 2 3 4 6 8)) '((nil . (1 1 3)) (t
. (2 2 2 4 6 8)))))
+ (should (equal (--group-by (car (split-string it "/")) '("a/b" "c/d" "a/e"))
'(("a" . ("a/b" "a/e")) ("c" . ("c/d"))))))
+
+(ert-deftest -elem-index ()
+ (should (equal (-elem-index 2 '(6 7 8 2 3 4)) 3))
+ (should (equal (-elem-index "bar" '("foo" "bar" "baz")) 1))
+ (should (equal (-elem-index '(1 2) '((3) (5 6) (1 2) nil)) 2)))
+
+(ert-deftest -elem-indices ()
+ (should (equal (-elem-indices 2 '(6 7 8 2 3 4 2 1)) '(3 6)))
+ (should (equal (-elem-indices "bar" '("foo" "bar" "baz")) '(1)))
+ (should (equal (-elem-indices '(1 2) '((3) (1 2) (5 6) (1 2) nil)) '(1 3))))
+
+(ert-deftest -find-index ()
+ (should (equal (-find-index 'even? '(2 4 1 6 3 3 5 8)) 0))
+ (should (equal (--find-index (< 5 it) '(2 4 1 6 3 3 5 8)) 3))
+ (should (equal (-find-index (-partial 'string-lessp "baz") '("bar" "foo"
"baz")) 1)))
+
+(ert-deftest -find-last-index ()
+ (should (equal (-find-last-index 'even? '(2 4 1 6 3 3 5 8)) 7))
+ (should (equal (--find-last-index (< 5 it) '(2 7 1 6 3 8 5 2)) 5))
+ (should (equal (-find-last-index (-partial 'string-lessp "baz") '("q" "foo"
"baz")) 1)))
+
+(ert-deftest -find-indices ()
+ (should (equal (-find-indices 'even? '(2 4 1 6 3 3 5 8)) '(0 1 3 7)))
+ (should (equal (--find-indices (< 5 it) '(2 4 1 6 3 3 5 8)) '(3 7)))
+ (should (equal (-find-indices (-partial 'string-lessp "baz") '("bar" "foo"
"baz")) '(1))))
+
+;; (ert-deftest -grade-up ()
+;; (should (equal (-grade-up '< '(3 1 4 2 1 3 3)) '(1 4 3 0 5 6 2)))
+;; (should (equal (let ((l '(3 1 4 2 1 3 3))) (-select-by-indices (-grade-up
'< l) l)) '(1 1 2 3 3 3 4))))
+
+;; (ert-deftest -grade-down ()
+;; (should (equal (-grade-down '< '(3 1 4 2 1 3 3)) '(2 0 5 6 3 1 4)))
+;; (should (equal (let ((l '(3 1 4 2 1 3 3))) (-select-by-indices
(-grade-down '< l) l)) '(4 3 3 3 2 1 1))))
+
+(ert-deftest -union ()
+ (should (equal (-union '(1 2 3) '(3 4 5)) '(1 2 3 4 5)))
+ (should (equal (-union '(1 2 3 4) '()) '(1 2 3 4)))
+ (should (equal (-union '(1 1 2 2) '(3 2 1)) '(1 1 2 2 3))))
+
+(ert-deftest -difference ()
+ (should (equal (-difference '() '()) '()))
+ (should (equal (-difference '(1 2 3) '(4 5 6)) '(1 2 3)))
+ (should (equal (-difference '(1 2 3 4) '(3 4 5 6)) '(1 2))))
+
+(ert-deftest -intersection ()
+ (should (equal (-intersection '() '()) '()))
+ (should (equal (-intersection '(1 2 3) '(4 5 6)) '()))
+ (should (equal (-intersection '(1 2 3 4) '(3 4 5 6)) '(3 4))))
+
+(ert-deftest -distinct ()
+ (should (equal (-distinct '()) '()))
+ (should (equal (-distinct '(1 2 2 4)) '(1 2 4))))
+
+;; (ert-deftest -rotate ()
+;; (should (equal (-rotate 3 '(1 2 3 4 5 6 7)) '(5 6 7 1 2 3 4)))
+;; (should (equal (-rotate -3 '(1 2 3 4 5 6 7)) '(4 5 6 7 1 2 3))))
+
+(ert-deftest -repeat ()
+ (should (equal (-repeat 3 :a) '(:a :a :a)))
+ (should (equal (-repeat 1 :a) '(:a)))
+ (should (equal (-repeat 0 :a) nil))
+ (should (equal (-repeat -1 :a) nil)))
+
+(ert-deftest -cons* ()
+ (should (equal (-cons* 1 2) '(1 . 2)))
+ (should (equal (-cons* 1 2 3) '(1 2 . 3)))
+ (should (equal (-cons* 1) 1))
+ (should (equal (-cons* 1 2 3 4) '(1 2 3 . 4)))
+ (should (equal (apply '-cons* (number-sequence 1 10)) '(1 2 3 4 5 6 7 8 9 .
10))))
+
+(ert-deftest -snoc ()
+ (should (equal (-snoc '(1 2 3) 4) '(1 2 3 4)))
+ (should (equal (-snoc '(1 2 3) 4 5 6) '(1 2 3 4 5 6)))
+ (should (equal (-snoc '(1 2 3) '(4 5 6)) '(1 2 3 (4 5 6)))))
+
+(ert-deftest -interpose ()
+ (should (equal (-interpose "-" '()) '()))
+ (should (equal (-interpose "-" '("a")) '("a")))
+ (should (equal (-interpose "-" '("a" "b" "c")) '("a" "-" "b" "-" "c"))))
+
+(ert-deftest -interleave ()
+ (should (equal (-interleave '(1 2) '("a" "b")) '(1 "a" 2 "b")))
+ (should (equal (-interleave '(1 2) '("a" "b") '("A" "B")) '(1 "a" "A" 2 "b"
"B")))
+ (should (equal (-interleave '(1 2 3) '("a" "b")) '(1 "a" 2 "b")))
+ (should (equal (-interleave '(1 2 3) '("a" "b" "c" "d")) '(1 "a" 2 "b" 3
"c"))))
+
+(ert-deftest -zip-with ()
+ (should (equal (-zip-with '+ '(1 2 3) '(4 5 6)) '(5 7 9)))
+ (should (equal (-zip-with 'cons '(1 2 3) '(4 5 6)) '((1 . 4) (2 . 5) (3 .
6))))
+ (should (equal (--zip-with (concat it " and " other) '("Batman" "Jekyll")
'("Robin" "Hyde")) '("Batman and Robin" "Jekyll and Hyde"))))
+
+(ert-deftest -zip ()
+ (should (equal (-zip '(1 2 3) '(4 5 6)) '((1 . 4) (2 . 5) (3 . 6))))
+ (should (equal (-zip '(1 2 3) '(4 5 6 7)) '((1 . 4) (2 . 5) (3 . 6))))
+ (should (equal (-zip '(1 2 3 4) '(4 5 6)) '((1 . 4) (2 . 5) (3 . 6))))
+ (should (equal (-zip '(1 2 3) '(4 5 6) '(7 8 9)) '((1 4 7) (2 5 8) (3 6 9))))
+ (should (equal (-zip '(1 2) '(3 4 5) '(6)) '((1 3 6)))))
+
+(ert-deftest -zip-fill ()
+ (should (equal (-zip-fill 0 '(1 2 3 4 5) '(6 7 8 9)) '((1 . 6) (2 . 7) (3 .
8) (4 . 9) (5 . 0)))))
+
+(ert-deftest -cycle ()
+ (should (equal (-take 5 (-cycle '(1 2 3))) '(1 2 3 1 2)))
+ (should (equal (-take 7 (-cycle '(1 "and" 3))) '(1 "and" 3 1 "and" 3 1)))
+ (should (equal (-zip (-cycle '(1 2 3)) '(1 2)) '((1 . 1) (2 . 2))))
+ (should (equal (-zip-with 'cons (-cycle '(1 2 3)) '(1 2)) '((1 . 1) (2 .
2))))
+ (should (equal (-map (-partial '-take 5) (-split-at 5 (-cycle '(1 2 3))))
'((1 2 3 1 2) (3 1 2 3 1)))))
+
+(ert-deftest -pad ()
+ (should (equal (-pad 0 '()) '(())))
+ (should (equal (-pad 0 '(1)) '((1))))
+ (should (equal (-pad 0 '(1 2 3) '(4 5)) '((1 2 3) (4 5 0))))
+ (should (equal (-pad nil '(1 2 3) '(4 5) '(6 7 8 9 10)) '((1 2 3 nil nil) (4
5 nil nil nil) (6 7 8 9 10))))
+ (should (equal (-pad 0 '(1 2) '(3 4)) '((1 2) (3 4)))))
+
+(ert-deftest -table ()
+ (should (equal (-table '* '(1 2 3) '(1 2 3)) '((1 2 3) (2 4 6) (3 6 9))))
+ (should (equal (-table (lambda (a b) (-sum (-zip-with '* a b))) '((1 2) (3
4)) '((1 3) (2 4))) '((7 15) (10 22))))
+ (should (equal (apply '-table 'list (-repeat 3 '(1 2))) '((((1 1 1) (2 1 1))
((1 2 1) (2 2 1))) (((1 1 2) (2 1 2)) ((1 2 2) (2 2 2)))))))
+
+;; (ert-deftest -table-flat ()
+;; (should (equal (-table-flat 'list '(1 2 3) '(a b c)) '((1 a) (2 a) (3 a)
(1 b) (2 b) (3 b) (1 c) (2 c) (3 c))))
+;; (should (equal (-table-flat '* '(1 2 3) '(1 2 3)) '(1 2 3 2 4 6 3 6 9)))
+;; (should (equal (apply '-table-flat 'list (-repeat 3 '(1 2))) '((1 1 1) (2
1 1) (1 2 1) (2 2 1) (1 1 2) (2 1 2) (1 2 2) (2 2 2))))
+
+;; ;; flatten law tests
+;; (should (equal (-flatten-n 1 (-table 'list '(1 2 3) '(a b c))) '((1 a) (2
a) (3 a) (1 b) (2 b) (3 b) (1 c) (2 c) (3 c))))
+;; (should (equal (-flatten-n 1 (-table '* '(1 2 3) '(1 2 3))) '(1 2 3 2 4 6
3 6 9)))
+;; (should (equal (-flatten-n 2 (apply '-table 'list (-repeat 3 '(1 2))))
'((1 1 1) (2 1 1) (1 2 1) (2 2 1) (1 1 2) (2 1 2) (1 2 2) (2 2 2)))))
+
+(ert-deftest -first ()
+ (should (equal (-first 'even? '(1 2 3)) 2))
+ (should (equal (-first 'even? '(1 3 5)) nil))
+ (should (equal (--first (> it 2) '(1 2 3)) 3)))
+
+(ert-deftest -last ()
+ (should (equal (-last 'even? '(1 2 3 4 5 6 3 3 3)) 6))
+ (should (equal (-last 'even? '(1 3 7 5 9)) nil))
+ (should (equal (--last (> (length it) 3) '("a" "looong" "word" "and" "short"
"one")) "short")))
+
+(ert-deftest -first-item ()
+ (should (equal (-first-item '(1 2 3)) 1))
+ (should (equal (-first-item nil) nil)))
+
+(ert-deftest -last-item ()
+ (should (equal (-last-item '(1 2 3)) 3))
+ (should (equal (-last-item nil) nil)))
+
+(ert-deftest -butlast ()
+ (should (equal (-butlast '(1 2 3)) '(1 2)))
+ (should (equal (-butlast '(1 2)) '(1)))
+ (should (equal (-butlast '(1)) nil))
+ (should (equal (-butlast nil) nil)))
+
+(ert-deftest -sort ()
+ (should (equal (-sort '< '(3 1 2)) '(1 2 3)))
+ (should (equal (-sort '> '(3 1 2)) '(3 2 1)))
+ (should (equal (--sort (< it other) '(3 1 2)) '(1 2 3)))
+ (should (equal (let ((l '(3 1 2))) (-sort '> l) l) '(3 1 2))))
+
+(ert-deftest -list ()
+ (should (equal (-list 1) '(1)))
+ (should (equal (-list 1 2 3) '(1 2 3)))
+ (-list (should (equal '(1 2 3) '(1 2 3))))
+ (-list (should (equal '((1) (2)) '((1) (2))))))
+
+(ert-deftest -tree-map ()
+ (should (equal (-tree-map '1+ '(1 (2 3) (4 (5 6) 7))) '(2 (3 4) (5 (6 7)
8))))
+ (should (equal (-tree-map '(lambda (x) (cons x (expt 2 x))) '(1 (2 3) 4))
'((1 . 2) ((2 . 4) (3 . 8)) (4 . 16))))
+ (should (equal (--tree-map (length it) '("<body>" ("<p>" "text" "</p>")
"</body>")) '(6 (3 4 4) 7)))
+ (should (equal (--tree-map 1 '(1 2 (3 4) (5 6))) '(1 1 (1 1) (1 1))))
+ (should (equal (--tree-map (cdr it) '((1 . 2) (3 . 4) (5 . 6))) '(2 4 6))))
+
+(ert-deftest -tree-reduce ()
+ (should (equal (-tree-reduce '+ '(1 (2 3) (4 5))) 15))
+ (should (equal (-tree-reduce 'concat '("strings" (" on" " various") (("
levels")))) "strings on various levels"))
+ (should (equal (--tree-reduce (cond
+ ((stringp it) (concat it " " acc))
+ (t (let ((sn (symbol-name it))) (concat "<"
sn ">" acc "</" sn ">"))))
+ '(body (p "some words") (div "more" (b "bold")
"words"))) "<body><p>some words</p> <div>more <b>bold</b> words</div></body>")))
+
+(ert-deftest -tree-reduce-from ()
+ (should (equal (-tree-reduce-from '+ 1 '(1 (1 1) ((1)))) 8))
+ (should (equal (--tree-reduce-from (-concat acc (list it)) nil '(1 (2 3 (4
5)) (6 7))) '((7 6) ((5 4) 3 2) 1))))
+
+(ert-deftest -tree-mapreduce ()
+ (should (equal (-tree-mapreduce 'list 'append '(1 (2 (3 4) (5 6)) (7 (8
9)))) '(1 2 3 4 5 6 7 8 9)))
+ (should (equal (--tree-mapreduce 1 (+ it acc) '(1 (2 (4 9) (2 1)) (7 (4
3)))) 9))
+ (should (equal (--tree-mapreduce 0 (max acc (1+ it)) '(1 (2 (4 9) (2 1)) (7
(4 3)))) 3))
+ (should (equal (--tree-mapreduce (-value-to-list it)
+ (-concat it acc)
+ '((1 . 2) (3 . 4) (5 (6 7) 8))) '(1 2 3 4 5
6 7 8)))
+ (should (equal (--tree-mapreduce (if (-cons-pair? it) (cdr it) it)
+ (concat it " " acc)
+ '("foo" (bar . "bar") ((baz . "baz"))
"quux" (qwop . "qwop"))) "foo bar baz quux qwop"))
+ (should (equal (--tree-mapreduce (if (-cons-pair? it) (list (cdr it)) nil)
+ (append it acc)
+ '((elips-mode (foo (bar . booze)) (baz .
qux)) (c-mode (foo . bla) (bum . bam)))) '(booze qux bla bam))))
+
+(ert-deftest -tree-mapreduce-from ()
+ (should (equal (-tree-mapreduce-from 'identity '* 1 '(1 (2 (3 4) (5 6)) (7
(8 9)))) 362880))
+ (should (equal (--tree-mapreduce-from (+ it it) (cons it acc) nil '(1 (2 (4
9) (2 1)) (7 (4 3)))) '(2 (4 (8 18) (4 2)) (14 (8 6)))))
+ (should (equal (concat "{" (--tree-mapreduce-from
+ (cond
+ ((-cons-pair? it)
+ (concat (symbol-name (car it)) " -> "
(symbol-name (cdr it))))
+ (t (concat (symbol-name it) " : {")))
+ (concat it (unless (or (equal acc "}")
+ (equal (substring it (1-
(length it))) "{"))
+ ", ") acc)
+ "}"
+ '((elips-mode (foo (bar . booze)) (baz . qux))
(c-mode (foo . bla) (bum . bam))))) "{elips-mode : {foo : {bar -> booze}, baz
-> qux}, c-mode : {foo -> bla, bum -> bam}}")))
+
+(ert-deftest -clone ()
+ (should (equal (let* ((a '(1 2 3)) (b (-clone a))) (nreverse a) b) '(1 2
3))))
+
+(ert-deftest -> ()
+ (should (equal (-> '(2 3 5)) '(2 3 5)))
+ (should (equal (-> '(2 3 5) (append '(8 13))) '(2 3 5 8 13)))
+ (should (equal (-> '(2 3 5) (append '(8 13)) (-slice 1 -1)) '(3 5 8)))
+ (should (equal (-> 5 square) 25))
+ (should (equal (-> 5 (+ 3) square) 64)))
+
+(ert-deftest ->> ()
+ (should (equal (->> '(1 2 3) (-map 'square)) '(1 4 9)))
+ (should (equal (->> '(1 2 3) (-map 'square) (-remove 'even?)) '(1 9)))
+ (should (equal (->> '(1 2 3) (-map 'square) (-reduce '+)) 14))
+ (should (equal (->> 5 (- 8)) 3))
+ (should (equal (->> 5 (- 3) square) 4)))
+
+(ert-deftest --> ()
+ (should (equal (--> "def" (concat "abc" it "ghi")) "abcdefghi"))
+ (should (equal (--> "def" (concat "abc" it "ghi") (upcase it)) "ABCDEFGHI"))
+ (should (equal (--> "def" (concat "abc" it "ghi") upcase) "ABCDEFGHI")))
+
+(ert-deftest -when-let ()
+ (should (equal (-when-let (match-index (string-match "d" "abcd")) (+
match-index 2)) 5))
+ (should (equal (--when-let (member :b '(:a :b :c)) (cons :d it)) '(:d :b
:c)))
+ (should (equal (--when-let (even? 3) (cat it :a)) nil)))
+
+(ert-deftest -when-let* ()
+ (should (equal (-when-let* ((x 5) (y 3) (z (+ y 4))) (+ x y z)) 15))
+ (should (equal (-when-let* ((x 5) (y nil) (z 7)) (+ x y z)) nil)))
+
+(ert-deftest -if-let ()
+ (should (equal (-if-let (match-index (string-match "d" "abc")) (+
match-index 3) 7) 7))
+ (should (equal (--if-let (even? 4) it nil) t)))
+
+(ert-deftest -if-let* ()
+ (should (equal (-if-let* ((x 5) (y 3) (z 7)) (+ x y z) "foo") 15))
+ (should (equal (-if-let* ((x 5) (y nil) (z 7)) (+ x y z) "foo") "foo")))
+
+(ert-deftest -each ()
+ (should (equal (let (s) (-each '(1 2 3) (lambda (item) (setq s (cons item
s))))) nil))
+ (should (equal (let (s) (-each '(1 2 3) (lambda (item) (setq s (cons item
s)))) s) '(3 2 1)))
+ (should (equal (let (s) (--each '(1 2 3) (setq s (cons it s))) s) '(3 2 1)))
+ (should (equal (let (s) (--each (reverse (three-letters)) (setq s (cons it
s))) s) '("A" "B" "C"))))
+
+(ert-deftest -each-while ()
+ (should (equal (let (s) (-each-while '(2 4 5 6) 'even? (lambda (item) (!cons
item s))) s) '(4 2)))
+ (should (equal (let (s) (--each-while '(1 2 3 4) (< it 3) (!cons it s)) s)
'(2 1))))
+
+(ert-deftest -dotimes ()
+ (should (equal (let (s) (-dotimes 3 (lambda (n) (!cons n s))) s) '(2 1 0)))
+ (should (equal (let (s) (--dotimes 5 (!cons it s)) s) '(4 3 2 1 0))))
+
+(ert-deftest !cons ()
+ (should (equal (let (l) (!cons 5 l) l) '(5)))
+ (should (equal (let ((l '(3))) (!cons 5 l) l) '(5 3))))
+
+(ert-deftest !cdr ()
+ (should (equal (let ((l '(3))) (!cdr l) l) '()))
+ (should (equal (let ((l '(3 5))) (!cdr l) l) '(5))))
+
diff --git a/tests/dash.el b/tests/dash.el
new file mode 100644
index 0000000..aeb8c21
--- /dev/null
+++ b/tests/dash.el
@@ -0,0 +1,1747 @@
+;;; IMPORTANT!!!
+
+;; The following file is meant for testing, not usage! It has been
+;; heavily modified, so the original author should not be blaimed (or
+;; even bothered) by any bug that happens to be in this version.
+
+;;; dash.el --- A modern list library for Emacs
+
+;; Copyright (C) 2012 Magnar Sveen
+
+;; Author: Magnar Sveen <magnars@gmail.com>
+;; Version: 2.8.0
+;; Keywords: lists
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; A modern list api for Emacs.
+;;
+;; See documentation on https://github.com/magnars/dash.el#functions
+
+;;; Code:
+
+(require 'names)
+(defgroup dash ()
+ "Customize group for dash.el"
+ :group 'lisp
+ :prefix "dash-")
+
+(defun dash--enable-fontlock (symbol value)
+ (when value
+ (dash-enable-font-lock))
+ (set-default symbol value))
+
+(defcustom dash-enable-fontlock nil
+ "If non-nil, enable fontification of dash functions, macros and
+special values."
+ :type 'boolean
+ :set 'dash--enable-fontlock
+ :group 'dash)
+
+(defmacro !cons (car cdr)
+ "Destructive: Set CDR to the cons of CAR and CDR."
+ `(setq ,cdr (cons ,car ,cdr)))
+
+(defmacro !cdr (list)
+ "Destructive: Set LIST to the cdr of LIST."
+ `(setq ,list (cdr ,list)))
+
+(define-namespace -
+
+(defmacro -each (list &rest body)
+ "Anaphoric form of `-each'."
+ (declare (debug (form body))
+ (indent 1))
+ (let ((l (make-symbol "list")))
+ `(let ((,l ,list)
+ (it-index 0))
+ (while ,l
+ (let ((it (car ,l)))
+ ,@body)
+ (setq it-index (1+ it-index))
+ (!cdr ,l)))))
+
+(defun each (list fn)
+ "Call FN with every item in LIST. Return nil, used for side-effects only."
+ (-each list (funcall fn it)))
+
+(put '-each 'lisp-indent-function 1)
+
+(defmacro -each-while (list pred &rest body)
+ "Anaphoric form of `-each-while'."
+ (declare (debug (form form body))
+ (indent 2))
+ (let ((l (make-symbol "list"))
+ (c (make-symbol "continue")))
+ `(let ((,l ,list)
+ (,c t)
+ (it-index 0))
+ (while (and ,l ,c)
+ (let ((it (car ,l)))
+ (if (not ,pred) (setq ,c nil) ,@body))
+ (setq it-index (1+ it-index))
+ (!cdr ,l)))))
+
+(defun each-while (list pred fn)
+ "Call FN with every item in LIST while (PRED item) is non-nil.
+Return nil, used for side-effects only."
+ (-each-while list (funcall pred it) (funcall fn it)))
+
+(put '-each-while 'lisp-indent-function 2)
+
+(defmacro -dotimes (num &rest body)
+ "Repeatedly executes BODY (presumably for side-effects) with `it` bound to
integers from 0 through NUM-1."
+ (declare (debug (form body))
+ (indent 1))
+ (let ((n (make-symbol "num")))
+ `(let ((,n ,num)
+ (it 0))
+ (while (< it ,n)
+ ,@body
+ (setq it (1+ it))))))
+
+(defun dotimes (num fn)
+ "Repeatedly calls FN (presumably for side-effects) passing in integers from
0 through NUM-1."
+ (-dotimes num (funcall fn it)))
+
+(put '-dotimes 'lisp-indent-function 1)
+
+(defun map (fn list)
+ "Return a new list consisting of the result of applying FN to the items in
LIST."
+ (mapcar fn list))
+
+(defmacro -map (form list)
+ "Anaphoric form of `-map'."
+ (declare (debug (form form)))
+ `(mapcar (lambda (it) ,form) ,list))
+
+(defmacro -reduce-from (form initial-value list)
+ "Anaphoric form of `-reduce-from'."
+ (declare (debug (form form form)))
+ `(let ((acc ,initial-value))
+ (--each ,list (setq acc ,form))
+ acc))
+
+(defun reduce-from (fn initial-value list)
+ "Return the result of applying FN to INITIAL-VALUE and the
+first item in LIST, then applying FN to that result and the 2nd
+item, etc. If LIST contains no items, return INITIAL-VALUE and
+FN is not called.
+
+In the anaphoric form `--reduce-from', the accumulated value is
+exposed as `acc`."
+ (-reduce-from (funcall fn acc it) initial-value list))
+
+(defmacro -reduce (form list)
+ "Anaphoric form of `-reduce'."
+ (declare (debug (form form)))
+ (let ((lv (make-symbol "list-value")))
+ `(let ((,lv ,list))
+ (if ,lv
+ (--reduce-from ,form (car ,lv) (cdr ,lv))
+ (let (acc it) ,form)))))
+
+(defun reduce (fn list)
+ "Return the result of applying FN to the first 2 items in LIST,
+then applying FN to that result and the 3rd item, etc. If LIST
+contains no items, FN must accept no arguments as well, and
+reduce return the result of calling FN with no arguments. If
+LIST has only 1 item, it is returned and FN is not called.
+
+In the anaphoric form `--reduce', the accumulated value is
+exposed as `acc`."
+ (if list
+ (reduce-from fn (car list) (cdr list))
+ (funcall fn)))
+
+(defun reduce-r-from (fn initial-value list)
+ "Replace conses with FN, nil with INITIAL-VALUE and evaluate
+the resulting expression. If LIST is empty, INITIAL-VALUE is
+returned and FN is not called.
+
+Note: this function works the same as `-reduce-from' but the
+operation associates from right instead of from left."
+ (if (not list) initial-value
+ (funcall fn (car list) (reduce-r-from fn initial-value (cdr list)))))
+
+(defmacro -reduce-r-from (form initial-value list)
+ "Anaphoric version of `-reduce-r-from'."
+ (declare (debug (form form form)))
+ `(-reduce-r-from (lambda (&optional it acc) ,form) ,initial-value ,list))
+
+(defun reduce-r (fn list)
+ "Replace conses with FN and evaluate the resulting expression.
+The final nil is ignored. If LIST contains no items, FN must
+accept no arguments as well, and reduce return the result of
+calling FN with no arguments. If LIST has only 1 item, it is
+returned and FN is not called.
+
+The first argument of FN is the new item, the second is the
+accumulated value.
+
+Note: this function works the same as `-reduce' but the operation
+associates from right instead of from left."
+ (cond
+ ((not list) (funcall fn))
+ ((not (cdr list)) (car list))
+ (t (funcall fn (car list) (reduce-r fn (cdr list))))))
+
+(defmacro -reduce-r (form list)
+ "Anaphoric version of `-reduce-r'."
+ (declare (debug (form form)))
+ `(-reduce-r (lambda (&optional it acc) ,form) ,list))
+
+(defmacro -filter (form list)
+ "Anaphoric form of `-filter'."
+ (declare (debug (form form)))
+ (let ((r (make-symbol "result")))
+ `(let (,r)
+ (--each ,list (when ,form (!cons it ,r)))
+ (nreverse ,r))))
+
+(defun filter (pred list)
+ "Return a new list of the items in LIST for which PRED returns a non-nil
value.
+
+Alias: `-select'"
+ (-filter (funcall pred it) list))
+
+(defalias '-select #'filter)
+(defalias '--select #'-filter)
+
+(defmacro -remove (form list)
+ "Anaphoric form of `-remove'."
+ (declare (debug (form form)))
+ `(--filter (not ,form) ,list))
+
+(defun remove (pred list)
+ "Return a new list of the items in LIST for which PRED returns nil.
+
+Alias: `-reject'"
+ (-remove (funcall pred it) list))
+
+(defalias '-reject #'remove)
+(defalias '--reject #'-remove)
+
+(defmacro -keep (form list)
+ "Anaphoric form of `-keep'."
+ (declare (debug (form form)))
+ (let ((r (make-symbol "result"))
+ (m (make-symbol "mapped")))
+ `(let (,r)
+ (--each ,list (let ((,m ,form)) (when ,m (!cons ,m ,r))))
+ (nreverse ,r))))
+
+(defun keep (fn list)
+ "Return a new list of the non-nil results of applying FN to the items in
LIST."
+ (-keep (funcall fn it) list))
+
+(defmacro -map-indexed (form list)
+ "Anaphoric form of `-map-indexed'."
+ (declare (debug (form form)))
+ (let ((r (make-symbol "result")))
+ `(let (,r)
+ (--each ,list
+ (!cons ,form ,r))
+ (nreverse ,r))))
+
+(defun map-indexed (fn list)
+ "Return a new list consisting of the result of (FN index item) for each item
in LIST.
+
+In the anaphoric form `--map-indexed', the index is exposed as `it-index`."
+ (-map-indexed (funcall fn it-index it) list))
+
+(defmacro -map-when (pred rep list)
+ "Anaphoric form of `-map-when'."
+ (declare (debug (form form form)))
+ (let ((r (make-symbol "result")))
+ `(let (,r)
+ (--each ,list (!cons (if ,pred ,rep it) ,r))
+ (nreverse ,r))))
+
+(defun map-when (pred rep list)
+ "Return a new list where the elements in LIST that does not match the PRED
function
+are unchanged, and where the elements in LIST that do match the PRED function
are mapped
+through the REP function.
+
+Alias: `-replace-where'
+
+See also: `-update-at'"
+ (-map-when (funcall pred it) (funcall rep it) list))
+
+(defalias '-replace-where #'map-when)
+(defalias '--replace-where #'-map-when)
+
+(defun replace (old new list)
+ "Replace all OLD items in LIST with NEW.
+
+Elements are compared using `equal'.
+
+See also: `-replace-at'"
+ (-map-when (equal it old) new list))
+
+(defun flatten (l)
+ "Take a nested list L and return its contents as a single, flat list.
+
+See also: `-flatten-n'"
+ (if (and (listp l) (listp (cdr l)))
+ (mapcat '-flatten l)
+ (::list l)))
+
+(defun concat (&rest lists)
+ "Return a new list with the concatenation of the elements in the supplied
LISTS."
+ (apply 'append lists))
+
+(defmacro -mapcat (form list)
+ "Anaphoric form of `-mapcat'."
+ (declare (debug (form form)))
+ `(apply 'append (--map ,form ,list)))
+
+(defun mapcat (fn list)
+ "Return the concatenation of the result of mapping FN over LIST.
+Thus function FN should return a list."
+ (-mapcat (funcall fn it) list))
+
+(defalias '-copy #'copy-sequence
+ "Create a shallow copy of LIST.")
+
+(defun splice (pred fun list)
+ "Splice lists generated by FUN in place of elements matching PRED in LIST.
+
+FUN takes the element matching PRED as input.
+
+This function can be used as replacement for `,@' in case you
+need to splice several lists at marked positions (for example
+with keywords).
+
+See also: `-splice-list', `-insert-at'"
+ (let (r)
+ (-each list
+ (if (funcall pred it)
+ (let ((new (funcall fun it)))
+ (-each new (!cons it r)))
+ (!cons it r)))
+ (nreverse r)))
+
+(defmacro -splice (pred form list)
+ "Anaphoric form of `-splice'."
+ `(-splice (lambda (it) ,pred) (lambda (it) ,form) ,list))
+
+(defun splice-list (pred new-list list)
+ "Splice NEW-LIST in place of elements matching PRED in LIST.
+
+See also: `-splice', `-insert-at'"
+ (splice pred (lambda (_) new-list) list))
+
+(defun -splice-list (pred new-list list)
+ "Anaphoric form of `-splice-list'."
+ `(-splice-list (lambda (it) ,pred) ,new-list ,list))
+
+(defun cons* (&rest args)
+ "Make a new list from the elements of ARGS.
+
+The last 2 members of ARGS are used as the final cons of the
+result so if the final member of ARGS is not a list the result is
+a dotted list."
+ (reduce-r 'cons args))
+
+(defun snoc (list elem &rest elements)
+ "Append ELEM to the end of the list.
+
+This is like `cons', but operates on the end of list.
+
+If ELEMENTS is non nil, append these to the list as well."
+ (concat list (::list elem) elements))
+
+(defmacro -first (form list)
+ "Anaphoric form of `-first'."
+ (declare (debug (form form)))
+ (let ((n (make-symbol "needle")))
+ `(let (,n)
+ (--each-while ,list (not ,n)
+ (when ,form (setq ,n it)))
+ ,n)))
+
+(defun first (pred list)
+ "Return the first x in LIST where (PRED x) is non-nil, else nil.
+
+To get the first item in the list no questions asked, use `car'.
+
+Alias: `-find'"
+ (-first (funcall pred it) list))
+
+(defalias '-find #'first)
+(defalias '--find #'-first)
+
+(defmacro -last (form list)
+ "Anaphoric form of `-last'."
+ (declare (debug (form form)))
+ (let ((n (make-symbol "needle")))
+ `(let (,n)
+ (--each ,list
+ (when ,form (setq ,n it)))
+ ,n)))
+
+(defun last (pred list)
+ "Return the last x in LIST where (PRED x) is non-nil, else nil."
+ (-last (funcall pred it) list))
+
+(defalias '-first-item #'car
+ "Return the first item of LIST, or nil on an empty list.")
+
+(defun last-item (list)
+ "Return the last item of LIST, or nil on an empty list."
+ (car (::last list)))
+
+(defun butlast (list)
+ "Return a list of all items in list except for the last."
+ (let (result)
+ (while (cdr list)
+ (!cons (car list) result)
+ (!cdr list))
+ (nreverse result)))
+
+(defmacro -count (pred list)
+ "Anaphoric form of `-count'."
+ (declare (debug (form form)))
+ (let ((r (make-symbol "result")))
+ `(let ((,r 0))
+ (--each ,list (when ,pred (setq ,r (1+ ,r))))
+ ,r)))
+
+(defun count (pred list)
+ "Counts the number of items in LIST where (PRED item) is non-nil."
+ (-count (funcall pred it) list))
+
+(defun --truthy? (val)
+ (not (null val)))
+
+(defmacro -any? (form list)
+ "Anaphoric form of `-any?'."
+ (declare (debug (form form)))
+ `(---truthy? (--first ,form ,list)))
+
+(defun any? (pred list)
+ "Return t if (PRED x) is non-nil for any x in LIST, else nil.
+
+Alias: `-any-p', `-some?', `-some-p'"
+ (-any? (funcall pred it) list))
+
+(defalias '-some? #'any?)
+(defalias '--some? #'-any?)
+(defalias '-any-p #'any?)
+(defalias '--any-p #'-any?)
+(defalias '-some-p #'any?)
+(defalias '--some-p #'-any?)
+
+(defmacro -all? (form list)
+ "Anaphoric form of `-all?'."
+ (declare (debug (form form)))
+ (let ((a (make-symbol "all")))
+ `(let ((,a t))
+ (--each-while ,list ,a (setq ,a ,form))
+ (---truthy? ,a))))
+
+(defun all? (pred list)
+ "Return t if (PRED x) is non-nil for all x in LIST, else nil.
+
+Alias: `-all-p', `-every?', `-every-p'"
+ (-all? (funcall pred it) list))
+
+(defalias '-every? #'all?)
+(defalias '--every? #'-all?)
+(defalias '-all-p #'all?)
+(defalias '--all-p #'-all?)
+(defalias '-every-p #'all?)
+(defalias '--every-p #'-all?)
+
+(defmacro -none? (form list)
+ "Anaphoric form of `-none?'."
+ (declare (debug (form form)))
+ `(--all? (not ,form) ,list))
+
+(defun none? (pred list)
+ "Return t if (PRED x) is nil for all x in LIST, else nil.
+
+Alias: `-none-p'"
+ (-none? (funcall pred it) list))
+
+(defalias '-none-p #'none?)
+(defalias '--none-p #'-none?)
+
+(defmacro -only-some? (form list)
+ "Anaphoric form of `-only-some?'."
+ (declare (debug (form form)))
+ (let ((y (make-symbol "yes"))
+ (n (make-symbol "no")))
+ `(let (,y ,n)
+ (--each-while ,list (not (and ,y ,n))
+ (if ,form (setq ,y t) (setq ,n t)))
+ (---truthy? (and ,y ,n)))))
+
+(defun only-some? (pred list)
+ "Return `t` if at least one item of LIST matches PRED and at least one item
of LIST does not match PRED.
+Return `nil` both if all items match the predicate or if none of the items
match the predicate.
+
+Alias: `-only-some-p'"
+ (-only-some? (funcall pred it) list))
+
+(defalias '-only-some-p #'only-some?)
+(defalias '--only-some-p #'-only-some?)
+
+(defun slice (list from &optional to step)
+ "Return copy of LIST, starting from index FROM to index TO.
+
+FROM or TO may be negative. These values are then interpreted
+modulo the length of the list.
+
+If STEP is a number, only each STEPth item in the resulting
+section is returned. Defaults to 1."
+ (let ((length (length list))
+ (new-list nil))
+ ;; to defaults to the end of the list
+ (setq to (or to length))
+ (setq step (or step 1))
+ ;; handle negative indices
+ (when (< from 0)
+ (setq from (mod from length)))
+ (when (< to 0)
+ (setq to (mod to length)))
+
+ ;; iterate through the list, keeping the elements we want
+ (-each-while list (< it-index to)
+ (when (and (>= it-index from)
+ (= (mod (- from it-index) step) 0))
+ (push it new-list)))
+ (nreverse new-list)))
+
+(defun take (n list)
+ "Return a new list of the first N items in LIST, or all items if there are
fewer than N."
+ (let (result)
+ (-dotimes n
+ (when list
+ (!cons (car list) result)
+ (!cdr list)))
+ (nreverse result)))
+
+(defalias '-drop #'nthcdr "Return the tail of LIST without the first N items.")
+
+(defmacro -take-while (form list)
+ "Anaphoric form of `-take-while'."
+ (declare (debug (form form)))
+ (let ((r (make-symbol "result")))
+ `(let (,r)
+ (--each-while ,list ,form (!cons it ,r))
+ (nreverse ,r))))
+
+(defun take-while (pred list)
+ "Return a new list of successive items from LIST while (PRED item) returns a
non-nil value."
+ (-take-while (funcall pred it) list))
+
+(defmacro -drop-while (form list)
+ "Anaphoric form of `-drop-while'."
+ (declare (debug (form form)))
+ (let ((l (make-symbol "list")))
+ `(let ((,l ,list))
+ (while (and ,l (let ((it (car ,l))) ,form))
+ (!cdr ,l))
+ ,l)))
+
+(defun drop-while (pred list)
+ "Return the tail of LIST starting from the first item for which (PRED item)
returns nil."
+ (-drop-while (funcall pred it) list))
+
+(defun split-at (n list)
+ "Return a list of ((-take N LIST) (-drop N LIST)), in no more than one pass
through the list."
+ (let (result)
+ (-dotimes n
+ (when list
+ (!cons (car list) result)
+ (!cdr list)))
+ (::list (nreverse result) list)))
+
+(defun rotate (n list)
+ "Rotate LIST N places to the right. With N negative, rotate to the left.
+The time complexity is O(n)."
+ (if (::> n 0)
+ (append (::last list n) (::butlast list n))
+ (append (drop (- n) list) (take (- n) list))))
+
+(defun insert-at (n x list)
+ "Return a list with X inserted into LIST at position N.
+
+See also: `-splice', `-splice-list'"
+ (let ((split-list (split-at n list)))
+ (nconc (car split-list) (cons x (cadr split-list)))))
+
+(defun replace-at (n x list)
+ "Return a list with element at Nth position in LIST replaced with X.
+
+See also: `-replace'"
+ (let ((split-list (split-at n list)))
+ (nconc (car split-list) (cons x (cdr (cadr split-list))))))
+
+(defun update-at (n func list)
+ "Return a list with element at Nth position in LIST replaced with `(func
(nth n list))`.
+
+See also: `-map-when'"
+ (let ((split-list (split-at n list)))
+ (nconc (car split-list) (cons (funcall func (car (cadr split-list))) (cdr
(cadr split-list))))))
+
+(defmacro -update-at (n form list)
+ "Anaphoric version of `-update-at'."
+ (declare (debug (form form form)))
+ `(-update-at ,n (lambda (it) ,form) ,list))
+
+(defun remove-at (n list)
+ "Return a list with element at Nth position in LIST removed.
+
+See also: `-remove-at-indices', `-remove'"
+ (remove-at-indices (::list n) list))
+
+(defun remove-at-indices (indices list)
+ "Return a list whose elements are elements from LIST without
+elements selected as `(nth i list)` for all i
+from INDICES.
+
+See also: `-remove-at', `-remove'"
+ (let* ((indices (sort '< indices))
+ (diffs (cons (car indices) (map '1- (zip-with '- (cdr indices)
indices))))
+ r)
+ (-each diffs
+ (let ((split (split-at it list)))
+ (!cons (car split) r)
+ (setq list (cdr (cadr split)))))
+ (!cons list r)
+ (apply '-concat (nreverse r))))
+
+(defmacro -split-with (pred list)
+ "Anaphoric form of `-split-with'."
+ (declare (debug (form form)))
+ (let ((l (make-symbol "list"))
+ (r (make-symbol "result"))
+ (c (make-symbol "continue")))
+ `(let ((,l ,list)
+ (,r nil)
+ (,c t))
+ (while (and ,l ,c)
+ (let ((it (car ,l)))
+ (if (not ,pred)
+ (setq ,c nil)
+ (!cons it ,r)
+ (!cdr ,l))))
+ (list (nreverse ,r) ,l))))
+
+(defun split-with (pred list)
+ "Return a list of ((-take-while PRED LIST) (-drop-while PRED LIST)), in no
more than one pass through the list."
+ (-split-with (funcall pred it) list))
+
+(defmacro split-on (item list)
+ "Split the LIST each time ITEM is found.
+
+Unlike `-partition-by', the ITEM is discarded from the results.
+Empty lists are also removed from the result.
+
+Comparison is done by `equal'.
+
+See also `-split-when'"
+ (declare (debug (form form)))
+ `(-split-when (lambda (it) (equal it ,item)) ,list))
+
+(defmacro -split-when (form list)
+ "Anaphoric version of `-split-when'."
+ (declare (debug (form form)))
+ `(-split-when (lambda (it) ,form) ,list))
+
+(defun split-when (fn list)
+ "Split the LIST on each element where FN returns non-nil.
+
+Unlike `-partition-by', the \"matched\" element is discarded from
+the results. Empty lists are also removed from the result.
+
+This function can be thought of as a generalization of
+`split-string'."
+ (let (r s)
+ (while list
+ (if (not (funcall fn (car list)))
+ (push (car list) s)
+ (when s (push (nreverse s) r))
+ (setq s nil))
+ (!cdr list))
+ (when s (push (nreverse s) r))
+ (nreverse r)))
+
+(defmacro -separate (form list)
+ "Anaphoric form of `-separate'."
+ (declare (debug (form form)))
+ (let ((y (make-symbol "yes"))
+ (n (make-symbol "no")))
+ `(let (,y ,n)
+ (--each ,list (if ,form (!cons it ,y) (!cons it ,n)))
+ (list (nreverse ,y) (nreverse ,n)))))
+
+(defun separate (pred list)
+ "Return a list of ((-filter PRED LIST) (-remove PRED LIST)), in one pass
through the list."
+ (-separate (funcall pred it) list))
+
+(defun --partition-all-in-steps-reversed (n step list)
+ "Private: Used by -partition-all-in-steps and -partition-in-steps."
+ (when (< step 1)
+ (error "Step must be a positive number, or you're looking at some juicy
infinite loops."))
+ (let ((result nil)
+ (len 0))
+ (while list
+ (!cons (-take n list) result)
+ (setq list (drop step list)))
+ result))
+
+(defun partition-all-in-steps (n step list)
+ "Return a new list with the items in LIST grouped into N-sized sublists at
offsets STEP apart.
+The last groups may contain less than N items."
+ (nreverse (--partition-all-in-steps-reversed n step list)))
+
+(defun partition-in-steps (n step list)
+ "Return a new list with the items in LIST grouped into N-sized sublists at
offsets STEP apart.
+If there are not enough items to make the last group N-sized,
+those items are discarded."
+ (let ((result (--partition-all-in-steps-reversed n step list)))
+ (while (and result (< (length (car result)) n))
+ (!cdr result))
+ (nreverse result)))
+
+(defun partition-all (n list)
+ "Return a new list with the items in LIST grouped into N-sized sublists.
+The last group may contain less than N items."
+ (partition-all-in-steps n n list))
+
+(defun partition (n list)
+ "Return a new list with the items in LIST grouped into N-sized sublists.
+If there are not enough items to make the last group N-sized,
+those items are discarded."
+ (partition-in-steps n n list))
+
+(defmacro -partition-by (form list)
+ "Anaphoric form of `-partition-by'."
+ (declare (debug (form form)))
+ (let ((r (make-symbol "result"))
+ (s (make-symbol "sublist"))
+ (v (make-symbol "value"))
+ (n (make-symbol "new-value"))
+ (l (make-symbol "list")))
+ `(let ((,l ,list))
+ (when ,l
+ (let* ((,r nil)
+ (it (car ,l))
+ (,s (list it))
+ (,v ,form)
+ (,l (cdr ,l)))
+ (while ,l
+ (let* ((it (car ,l))
+ (,n ,form))
+ (unless (equal ,v ,n)
+ (!cons (nreverse ,s) ,r)
+ (setq ,s nil)
+ (setq ,v ,n))
+ (!cons it ,s)
+ (!cdr ,l)))
+ (!cons (nreverse ,s) ,r)
+ (nreverse ,r))))))
+
+(defun partition-by (fn list)
+ "Apply FN to each item in LIST, splitting it each time FN returns a new
value."
+ (-partition-by (funcall fn it) list))
+
+(defmacro -partition-by-header (form list)
+ "Anaphoric form of `-partition-by-header'."
+ (declare (debug (form form)))
+ (let ((r (make-symbol "result"))
+ (s (make-symbol "sublist"))
+ (h (make-symbol "header-value"))
+ (b (make-symbol "seen-body?"))
+ (n (make-symbol "new-value"))
+ (l (make-symbol "list")))
+ `(let ((,l ,list))
+ (when ,l
+ (let* ((,r nil)
+ (it (car ,l))
+ (,s (list it))
+ (,h ,form)
+ (,b nil)
+ (,l (cdr ,l)))
+ (while ,l
+ (let* ((it (car ,l))
+ (,n ,form))
+ (if (equal ,h ,n)
+ (when ,b
+ (!cons (nreverse ,s) ,r)
+ (setq ,s nil)
+ (setq ,b nil))
+ (setq ,b t))
+ (!cons it ,s)
+ (!cdr ,l)))
+ (!cons (nreverse ,s) ,r)
+ (nreverse ,r))))))
+
+(defun partition-by-header (fn list)
+ "Apply FN to the first item in LIST. That is the header
+value. Apply FN to each item in LIST, splitting it each time FN
+returns the header value, but only after seeing at least one
+other value (the body)."
+ (-partition-by-header (funcall fn it) list))
+
+(defmacro -group-by (form list)
+ "Anaphoric form of `-group-by'."
+ (declare (debug (form form)))
+ (let ((l (make-symbol "list"))
+ (v (make-symbol "value"))
+ (k (make-symbol "key"))
+ (r (make-symbol "result")))
+ `(let ((,l ,list)
+ ,r)
+ ;; Convert `list' to an alist and store it in `r'.
+ (while ,l
+ (let* ((,v (car ,l))
+ (it ,v)
+ (,k ,form)
+ (kv (assoc ,k ,r)))
+ (if kv
+ (setcdr kv (cons ,v (cdr kv)))
+ (push (list ,k ,v) ,r))
+ (setq ,l (cdr ,l))))
+ ;; Reverse lists in each group.
+ (let ((rest ,r))
+ (while rest
+ (let ((kv (car rest)))
+ (setcdr kv (nreverse (cdr kv))))
+ (setq rest (cdr rest))))
+ ;; Reverse order of keys.
+ (nreverse ,r))))
+
+(defun group-by (fn list)
+ "Separate LIST into an alist whose keys are FN applied to the
+elements of LIST. Keys are compared by `equal'."
+ (-group-by (funcall fn it) list))
+
+(defun interpose (sep list)
+ "Return a new list of all elements in LIST separated by SEP."
+ (let (result)
+ (when list
+ (!cons (car list) result)
+ (!cdr list))
+ (while list
+ (setq result (cons (car list) (cons sep result)))
+ (!cdr list))
+ (nreverse result)))
+
+(defun interleave (&rest lists)
+ "Return a new list of the first item in each list, then the second etc."
+ (let (result)
+ (while (none? 'null lists)
+ (-each lists (!cons (car it) result))
+ (setq lists (map 'cdr lists)))
+ (nreverse result)))
+
+(defmacro -zip-with (form list1 list2)
+ "Anaphoric form of `-zip-with'.
+
+The elements in list1 is bound as `it`, the elements in list2 as `other`."
+ (declare (debug (form form form)))
+ (let ((r (make-symbol "result"))
+ (l1 (make-symbol "list1"))
+ (l2 (make-symbol "list2")))
+ `(let ((,r nil)
+ (,l1 ,list1)
+ (,l2 ,list2))
+ (while (and ,l1 ,l2)
+ (let ((it (car ,l1))
+ (other (car ,l2)))
+ (!cons ,form ,r)
+ (!cdr ,l1)
+ (!cdr ,l2)))
+ (nreverse ,r))))
+
+(defun zip-with (fn list1 list2)
+ "Zip the two lists LIST1 and LIST2 using a function FN. This
+function is applied pairwise taking as first argument element of
+LIST1 and as second argument element of LIST2 at corresponding
+position.
+
+The anaphoric form `--zip-with' binds the elements from LIST1 as `it`,
+and the elements from LIST2 as `other`."
+ (-zip-with (funcall fn it other) list1 list2))
+
+(defun zip (&rest lists)
+ "Zip LISTS together. Group the head of each list, followed by the
+second elements of each list, and so on. The lengths of the returned
+groupings are equal to the length of the shortest input list.
+
+If two lists are provided as arguments, return the groupings as a list
+of cons cells. Otherwise, return the groupings as a list of lists. "
+ (let (results)
+ (while (none? 'null lists)
+ (setq results (cons (mapcar 'car lists) results))
+ (setq lists (mapcar 'cdr lists)))
+ (setq results (nreverse results))
+ (if (= (length lists) 2)
+ ; to support backward compatability, return
+ ; a cons cell if two lists were provided
+ (-map (cons (car it) (cadr it)) results)
+ results)))
+
+(defun zip-fill (fill-value &rest lists)
+ "Zip LISTS, with FILL-VALUE padded onto the shorter lists. The
+lengths of the returned groupings are equal to the length of the
+longest input list."
+ (apply '-zip (apply '-pad (cons fill-value lists))))
+
+(defun cycle (list)
+ "Return an infinite copy of LIST that will cycle through the
+elements and repeat from the beginning."
+ (let ((newlist (map 'identity list)))
+ (nconc newlist newlist)))
+
+(defun pad (fill-value &rest lists)
+ "Appends FILL-VALUE to the end of each list in LISTS such that they
+will all have the same length."
+ (let* ((annotations (annotate 'length lists))
+ (n (max (map 'car annotations))))
+ (-map (append (cdr it) (repeat (- n (car it)) fill-value)) annotations)))
+
+(defun annotate (fn list)
+ "Return a list of cons cells where each cell is FN applied to each
+element of LIST paired with the unmodified element of LIST."
+ (zip (map fn list) list))
+
+(defmacro -annotate (form list)
+ "Anaphoric version of `-annotate'."
+ (declare (debug (form form)))
+ `(-annotate (lambda (it) ,form) ,list))
+
+(defun dash--table-carry (lists restore-lists &optional re)
+ "Helper for `-table' and `-table-flat'.
+
+If a list overflows, carry to the right and reset the list.
+
+Return how many lists were re-seted."
+ (while (and (not (car lists))
+ (not (equal lists '(nil))))
+ (setcar lists (car restore-lists))
+ (pop (cadr lists))
+ (!cdr lists)
+ (!cdr restore-lists)
+ (when re
+ (push (nreverse (car re)) (cadr re))
+ (setcar re nil)
+ (!cdr re))))
+
+(defun table (fn &rest lists)
+ "Compute outer product of LISTS using function FN.
+
+The function FN should have the same arity as the number of
+supplied lists.
+
+The outer product is computed by applying fn to all possible
+combinations created by taking one element from each list in
+order. The dimension of the result is (length lists).
+
+See also: `-table-flat'"
+ (let ((restore-lists (copy-sequence lists))
+ (last-list (::last lists))
+ (re (-map nil (number-sequence 1 (length lists)))))
+ (while (car last-list)
+ (let ((item (apply fn (map 'car lists))))
+ (push item (car re))
+ (pop (car lists))
+ (dash--table-carry lists restore-lists re)))
+ (nreverse (car (::last re)))))
+
+(defun table-flat (fn &rest lists)
+ "Compute flat outer product of LISTS using function FN.
+
+The function FN should have the same arity as the number of
+supplied lists.
+
+The outer product is computed by applying fn to all possible
+combinations created by taking one element from each list in
+order. The results are flattened, ignoring the tensor structure
+of the result. This is equivalent to calling:
+
+ (-flatten-n (1- (length lists)) (-table fn lists))
+
+but the implementation here is much more efficient.
+
+See also: `-flatten-n', `-table'"
+ (let ((restore-lists (copy-sequence lists))
+ (last-list (::last lists))
+ re)
+ (while (car last-list)
+ (push (apply fn (map 'car lists)) re)
+ (pop (car lists))
+ (dash--table-carry lists restore-lists))
+ (nreverse re)))
+
+(defun partial (fn &rest args)
+ "Take a function FN and fewer than the normal arguments to FN,
+and return a fn that takes a variable number of additional ARGS.
+When called, the returned function calls FN with ARGS first and
+then additional args."
+ (apply 'apply-partially fn args))
+
+(defun elem-index (elem list)
+ "Return the index of the first element in the given LIST which
+is equal to the query element ELEM, or nil if there is no
+such element."
+ (car (elem-indices elem list)))
+
+(defun elem-indices (elem list)
+ "Return the indices of all elements in LIST equal to the query
+element ELEM, in ascending order."
+ (find-indices (partial 'equal elem) list))
+
+(defun find-indices (pred list)
+ "Return the indices of all elements in LIST satisfying the
+predicate PRED, in ascending order."
+ (let ((i 0))
+ (apply 'append (-map-indexed (when (funcall pred it) (::list it-index))
list))))
+
+(defmacro -find-indices (form list)
+ "Anaphoric version of `-find-indices'."
+ (declare (debug (form form)))
+ `(-find-indices (lambda (it) ,form) ,list))
+
+(defun find-index (pred list)
+ "Take a predicate PRED and a LIST and return the index of the
+first element in the list satisfying the predicate, or nil if
+there is no such element."
+ (car (find-indices pred list)))
+
+(defmacro -find-index (form list)
+ "Anaphoric version of `-find-index'."
+ (declare (debug (form form)))
+ `(-find-index (lambda (it) ,form) ,list))
+
+(defun find-last-index (pred list)
+ "Take a predicate PRED and a LIST and return the index of the
+last element in the list satisfying the predicate, or nil if
+there is no such element."
+ (last-item (find-indices pred list)))
+
+(defmacro -find-last-index (form list)
+ "Anaphoric version of `-find-last-index'."
+ `(-find-last-index (lambda (it) ,form) ,list))
+
+(defun select-by-indices (indices list)
+ "Return a list whose elements are elements from LIST selected
+as `(nth i list)` for all i from INDICES."
+ (let (r)
+ (-each indices
+ (!cons (nth it list) r))
+ (nreverse r)))
+
+(defmacro > (x &optional form &rest more)
+ "Thread the expr through the forms. Insert X as the second item
+in the first form, making a list of it if it is not a list
+already. If there are more forms, insert the first form as the
+second item in second form, etc."
+ (cond
+ ((null form) x)
+ ((null more) (if (listp form)
+ `(,(car form) ,x ,@(cdr form))
+ (list form x)))
+ (:else `(-> (-> ,x ,form) ,@more))))
+
+(defmacro >> (x form &rest more)
+ "Thread the expr through the forms. Insert X as the last item
+in the first form, making a list of it if it is not a list
+already. If there are more forms, insert the first form as the
+last item in second form, etc."
+ (if (null more)
+ (if (listp form)
+ `(,(car form) ,@(cdr form) ,x)
+ (::list form x))
+ `(->> (->> ,x ,form) ,@more)))
+
+(defmacro -> (x form &rest more)
+ "Thread the expr through the forms. Insert X at the position
+signified by the token `it' in the first form. If there are more
+forms, insert the first form at the position signified by `it' in
+in second form, etc."
+ (if (null more)
+ (if (listp form)
+ (-map-when (eq it 'it) x form)
+ (::list form x))
+ `(--> (--> ,x ,form) ,@more)))
+
+(put '-> 'lisp-indent-function 1)
+(put '->> 'lisp-indent-function 1)
+(put '--> 'lisp-indent-function 1)
+
+(defun grade-up (comparator list)
+ "Grade elements of LIST using COMPARATOR relation, yielding a
+permutation vector such that applying this permutation to LIST
+sorts it in ascending order."
+ ;; ugly hack to "fix" lack of lexical scope
+ (let ((comp `(lambda (it other) (funcall ',comparator (car it) (car
other)))))
+ (>> (--map-indexed (cons it it-index) list)
+ (-sort comp)
+ (-map 'cdr))))
+
+(defun grade-down (comparator list)
+ "Grade elements of LIST using COMPARATOR relation, yielding a
+permutation vector such that applying this permutation to LIST
+sorts it in descending order."
+ ;; ugly hack to "fix" lack of lexical scope
+ (let ((comp `(lambda (it other) (funcall ',comparator (car other) (car
it)))))
+ (>> (--map-indexed (cons it it-index) list)
+ (-sort comp)
+ (-map 'cdr))))
+
+(defmacro when-let (var-val &rest body)
+ "If VAL evaluates to non-nil, bind it to VAR and execute body.
+VAR-VAL should be a (VAR VAL) pair."
+ (declare (debug ((symbolp form) body))
+ (indent 1))
+ (let ((var (car var-val))
+ (val (cadr var-val)))
+ `(let ((,var ,val))
+ (when ,var
+ ,@body))))
+
+(defmacro when-let* (vars-vals &rest body)
+ "If all VALS evaluate to true, bind them to their corresponding
+VARS and execute body. VARS-VALS should be a list of (VAR VAL)
+pairs (corresponding to bindings of `let*')."
+ (declare (debug ((&rest (symbolp form)) body))
+ (indent 1))
+ (if (= (length vars-vals) 1)
+ `(-when-let ,(car vars-vals)
+ ,@body)
+ `(-when-let ,(car vars-vals)
+ (-when-let* ,(cdr vars-vals)
+ ,@body))))
+
+(defmacro -when-let (val &rest body)
+ "If VAL evaluates to non-nil, bind it to `it' and execute
+body."
+ (declare (debug (form body))
+ (indent 1))
+ `(let ((it ,val))
+ (when it
+ ,@body)))
+
+(defmacro if-let (var-val then &rest else)
+ "If VAL evaluates to non-nil, bind it to VAR and do THEN,
+otherwise do ELSE. VAR-VAL should be a (VAR VAL) pair."
+ (declare (debug ((symbolp form) form body))
+ (indent 2))
+ (let ((var (car var-val))
+ (val (cadr var-val)))
+ `(let ((,var ,val))
+ (if ,var ,then ,@else))))
+
+(defmacro if-let* (vars-vals then &rest else)
+ "If all VALS evaluate to true, bind them to their corresponding
+VARS and do THEN, otherwise do ELSE. VARS-VALS should be a list
+of (VAR VAL) pairs (corresponding to the bindings of `let*')."
+ (declare (debug ((&rest (symbolp form)) form body))
+ (indent 2))
+ (let ((first-pair (car vars-vals))
+ (rest (cdr vars-vals)))
+ (if (= (length vars-vals) 1)
+ `(-if-let ,first-pair ,then ,@else)
+ `(-if-let ,first-pair
+ (-if-let* ,rest ,then ,@else)
+ ,@else))))
+
+(defmacro -if-let (val then &rest else)
+ "If VAL evaluates to non-nil, bind it to `it' and do THEN,
+otherwise do ELSE."
+ (declare (debug (form form body))
+ (indent 2))
+ `(let ((it ,val))
+ (if it ,then ,@else)))
+
+(defun distinct (list)
+ "Return a new list with all duplicates removed.
+The test for equality is done with `equal',
+or with `-compare-fn' if that's non-nil.
+
+Alias: `-uniq'"
+ (let (result)
+ (-each list (unless (contains? result it) (!cons it result)))
+ (nreverse result)))
+
+(defalias '-uniq #'distinct)
+
+(defun union (list list2)
+ "Return a new list containing the elements of LIST1 and elements of LIST2
that are not in LIST1.
+The test for equality is done with `equal',
+or with `-compare-fn' if that's non-nil."
+ (let (result)
+ (-each list (!cons it result))
+ (-each list2 (unless (contains? result it) (!cons it result)))
+ (nreverse result)))
+
+(defun intersection (list list2)
+ "Return a new list containing only the elements that are members of both
LIST and LIST2.
+The test for equality is done with `equal',
+or with `-compare-fn' if that's non-nil."
+ (-filter (contains? list2 it) list))
+
+(defun difference (list list2)
+ "Return a new list with only the members of LIST that are not in LIST2.
+The test for equality is done with `equal',
+or with `-compare-fn' if that's non-nil."
+ (-filter (not (contains? list2 it)) list))
+
+(defvar compare-fn nil
+ "Tests for equality use this function or `equal' if this is nil.
+It should only be set using dynamic scope with a let, like:
+
+ (let ((-compare-fn =)) (-union numbers1 numbers2 numbers3)")
+
+(defun contains? (list element)
+ "Return non-nil if LIST contains ELEMENT.
+
+The test for equality is done with `equal', or with `-compare-fn'
+if that's non-nil.
+
+Alias: `-contains-p'"
+ (not
+ (null
+ (cond
+ ((null compare-fn) (member element list))
+ ((eq compare-fn 'eq) (memq element list))
+ ((eq compare-fn 'eql) (memql element list))
+ (t
+ (let ((lst list))
+ (while (and lst
+ (not (funcall compare-fn element (car lst))))
+ (setq lst (cdr lst)))
+ lst))))))
+
+(defalias '-contains-p #'contains?)
+
+(defun same-items? (list list2)
+ "Return true if LIST and LIST2 has the same items.
+
+The order of the elements in the lists does not matter.
+
+Alias: `-same-items-p'"
+ (let ((length-a (length list))
+ (length-b (length list2)))
+ (and
+ (= length-a length-b)
+ (= length-a (length (intersection list list2))))))
+
+(defalias '-same-items-p #'same-items?)
+
+(defun is-prefix? (prefix list)
+ "Return non-nil if PREFIX is prefix of LIST.
+
+Alias: `-is-prefix-p'"
+ (-each-while list (equal (car prefix) it)
+ (!cdr prefix))
+ (not prefix))
+
+(defun is-suffix? (suffix list)
+ "Return non-nil if SUFFIX is suffix of LIST.
+
+Alias: `-is-suffix-p'"
+ (is-prefix? (nreverse suffix) (nreverse list)))
+
+(defun is-infix? (infix list)
+ "Return non-nil if INFIX is infix of LIST.
+
+This operation runs in O(n^2) time
+
+Alias: `-is-infix-p'"
+ (let (done)
+ (while (and (not done) list)
+ (setq done (is-prefix? infix list))
+ (!cdr list))
+ done))
+
+(defalias '-is-prefix-p #'is-prefix?)
+(defalias '-is-suffix-p #'is-suffix?)
+(defalias '-is-infix-p #'is-infix?)
+
+(defun sort (comparator list)
+ "Sort LIST, stably, comparing elements using COMPARATOR.
+Return the sorted list. LIST is NOT modified by side effects.
+COMPARATOR is called with two elements of LIST, and should return non-nil
+if the first element should sort before the second."
+ (::sort (copy-sequence list) comparator))
+
+(defmacro -sort (form list)
+ "Anaphoric form of `-sort'."
+ (declare (debug (form form)))
+ `(-sort (lambda (it other) ,form) ,list))
+
+(defun list (&rest args)
+ "Return a list with ARGS.
+
+If first item of ARGS is already a list, simply return ARGS. If
+not, return a list with ARGS as elements."
+ (let ((arg (car args)))
+ (if (listp arg) arg args)))
+
+(defun repeat (n x)
+ "Return a list with X repeated N times.
+Return nil if N is less than 1."
+ (let (ret)
+ (-dotimes n (!cons x ret))
+ ret))
+
+(defun sum (list)
+ "Return the sum of LIST."
+ (apply '+ list))
+
+(defun product (list)
+ "Return the product of LIST."
+ (apply '* list))
+
+(defun max (list)
+ "Return the largest value from LIST of numbers or markers."
+ (apply 'max list))
+
+(defun min (list)
+ "Return the smallest value from LIST of numbers or markers."
+ (apply 'min list))
+
+(defun max-by (comparator list)
+ "Take a comparison function COMPARATOR and a LIST and return
+the greatest element of the list by the comparison function.
+
+See also combinator `-on' which can transform the values before
+comparing them."
+ (-reduce (if (funcall comparator it acc) it acc) list))
+
+(defun min-by (comparator list)
+ "Take a comparison function COMPARATOR and a LIST and return
+the least element of the list by the comparison function.
+
+See also combinator `-on' which can transform the values before
+comparing them."
+ (-reduce (if (funcall comparator it acc) acc it) list))
+
+(defmacro -max-by (form list)
+ "Anaphoric version of `-max-by'.
+
+The items for the comparator form are exposed as \"it\" and \"other\"."
+ (declare (debug (form form)))
+ `(-max-by (lambda (it other) ,form) ,list))
+
+(defmacro -min-by (form list)
+ "Anaphoric version of `-min-by'.
+
+The items for the comparator form are exposed as \"it\" and \"other\"."
+ (declare (debug (form form)))
+ `(-min-by (lambda (it other) ,form) ,list))
+
+(defun iterate (fun init n)
+ "Return a list of iterated applications of FUN to INIT.
+
+This means a list of form:
+
+ (init (fun init) (fun (fun init)) ...)
+
+N is the length of the returned list."
+ (if (= n 0) nil
+ (let ((r (::list init)))
+ (-dotimes (1- n)
+ (push (funcall fun (car r)) r))
+ (nreverse r))))
+
+(defmacro -iterate (form init n)
+ "Anaphoric version of `-iterate'."
+ (declare (debug (form form form)))
+ `(-iterate (lambda (it) ,form) ,init ,n))
+
+(defun unfold (fun seed)
+ "Build a list from SEED using FUN.
+
+This is \"dual\" operation to `-reduce-r': while -reduce-r
+consumes a list to produce a single value, `-unfold' takes a
+seed value and builds a (potentially infinite!) list.
+
+FUN should return `nil' to stop the generating process, or a
+cons (A . B), where A will be prepended to the result and B is
+the new seed."
+ (let ((last (funcall fun seed)) r)
+ (while last
+ (push (car last) r)
+ (setq last (funcall fun (cdr last))))
+ (nreverse r)))
+
+(defmacro -unfold (form seed)
+ "Anaphoric version of `unfold'."
+ (declare (debug (form form)))
+ `(-unfold (lambda (it) ,form) ,seed))
+
+(defun cons-pair? (con)
+ "Return non-nil if CON is true cons pair.
+That is (A . B) where B is not a list."
+ (and (listp con)
+ (not (listp (cdr con)))))
+
+(defun cons-to-list (con)
+ "Convert a cons pair to a list with `car' and `cdr' of the pair
respectively."
+ (::list (car con) (cdr con)))
+
+(defun value-to-list (val)
+ "Convert a value to a list.
+
+If the value is a cons pair, make a list with two elements, `car'
+and `cdr' of the pair respectively.
+
+If the value is anything else, wrap it in a list."
+ (cond
+ ((cons-pair? val) (cons-to-list val))
+ (t (::list val))))
+
+(defun tree-mapreduce-from (fn folder init-value tree)
+ "Apply FN to each element of TREE, and make a list of the results.
+If elements of TREE are lists themselves, apply FN recursively to
+elements of these nested lists.
+
+Then reduce the resulting lists using FOLDER and initial value
+INIT-VALUE. See `-reduce-r-from'.
+
+This is the same as calling `-tree-reduce-from' after `-tree-map'
+but is twice as fast as it only traverse the structure once."
+ (cond
+ ((not tree) nil)
+ ((cons-pair? tree) (funcall fn tree))
+ ((listp tree)
+ (reduce-r-from folder init-value (mapcar (lambda (x) (tree-mapreduce-from
fn folder init-value x)) tree)))
+ (t (funcall fn tree))))
+
+(defmacro -tree-mapreduce-from (form folder init-value tree)
+ "Anaphoric form of `-tree-mapreduce-from'."
+ (declare (debug (form form form form)))
+ `(-tree-mapreduce-from (lambda (it) ,form) (lambda (it acc) ,folder)
,init-value ,tree))
+
+(defun tree-mapreduce (fn folder tree)
+ "Apply FN to each element of TREE, and make a list of the results.
+If elements of TREE are lists themselves, apply FN recursively to
+elements of these nested lists.
+
+Then reduce the resulting lists using FOLDER and initial value
+INIT-VALUE. See `-reduce-r-from'.
+
+This is the same as calling `-tree-reduce' after `-tree-map'
+but is twice as fast as it only traverse the structure once."
+ (cond
+ ((not tree) nil)
+ ((cons-pair? tree) (funcall fn tree))
+ ((listp tree)
+ (reduce-r folder (mapcar (lambda (x) (tree-mapreduce fn folder x)) tree)))
+ (t (funcall fn tree))))
+
+(defmacro -tree-mapreduce (form folder tree)
+ "Anaphoric form of `-tree-mapreduce'."
+ (declare (debug (form form form)))
+ `(-tree-mapreduce (lambda (it) ,form) (lambda (it acc) ,folder) ,tree))
+
+(defun tree-map (fn tree)
+ "Apply FN to each element of TREE while preserving the tree structure."
+ (cond
+ ((not tree) nil)
+ ((cons-pair? tree) (funcall fn tree))
+ ((listp tree)
+ (mapcar (lambda (x) (tree-map fn x)) tree))
+ (t (funcall fn tree))))
+
+(defmacro -tree-map (form tree)
+ "Anaphoric form of `-tree-map'."
+ (declare (debug (form form)))
+ `(-tree-map (lambda (it) ,form) ,tree))
+
+(defun tree-reduce-from (fn init-value tree)
+ "Use FN to reduce elements of list TREE.
+If elements of TREE are lists themselves, apply the reduction recursively.
+
+FN is first applied to INIT-VALUE and first element of the list,
+then on this result and second element from the list etc.
+
+The initial value is ignored on cons pairs as they always contain
+two elements."
+ (cond
+ ((not tree) nil)
+ ((cons-pair? tree) tree)
+ ((listp tree)
+ (reduce-r-from fn init-value (mapcar (lambda (x) (tree-reduce-from fn
init-value x)) tree)))
+ (t tree)))
+
+(defmacro -tree-reduce-from (form init-value tree)
+ "Anaphoric form of `-tree-reduce-from'."
+ (declare (debug (form form form)))
+ `(-tree-reduce-from (lambda (it acc) ,form) ,init-value ,tree))
+
+(defun tree-reduce (fn tree)
+ "Use FN to reduce elements of list TREE.
+If elements of TREE are lists themselves, apply the reduction recursively.
+
+FN is first applied to first element of the list and second
+element, then on this result and third element from the list etc.
+
+See `-reduce-r' for how exactly are lists of zero or one element handled."
+ (cond
+ ((not tree) nil)
+ ((cons-pair? tree) tree)
+ ((listp tree)
+ (reduce-r fn (mapcar (lambda (x) (tree-reduce fn x)) tree)))
+ (t tree)))
+
+(defmacro -tree-reduce (form tree)
+ "Anaphoric form of `-tree-reduce'."
+ (declare (debug (form form)))
+ `(-tree-reduce (lambda (it acc) ,form) ,tree))
+
+(defun clone (list)
+ "Create a deep copy of LIST.
+The new list has the same elements and structure but all cons are
+replaced with new ones. This is useful when you need to clone a
+structure such as plist or alist."
+ (tree-map 'identity list))
+)
+
+(defun dash-enable-font-lock ()
+ "Add syntax highlighting to dash functions, macros and magic values."
+ (eval-after-load "lisp-mode"
+ '(progn
+ (let ((new-keywords '(
+ "-each"
+ "--each"
+ "-each-while"
+ "--each-while"
+ "-dotimes"
+ "--dotimes"
+ "-map"
+ "--map"
+ "-reduce-from"
+ "--reduce-from"
+ "-reduce"
+ "--reduce"
+ "-reduce-r-from"
+ "--reduce-r-from"
+ "-reduce-r"
+ "--reduce-r"
+ "-filter"
+ "--filter"
+ "-select"
+ "--select"
+ "-remove"
+ "--remove"
+ "-reject"
+ "--reject"
+ "-keep"
+ "--keep"
+ "-map-indexed"
+ "--map-indexed"
+ "-splice"
+ "--splice"
+ "-splice-list"
+ "--splice-list"
+ "-map-when"
+ "--map-when"
+ "-replace-where"
+ "--replace-where"
+ "-replace"
+ "-flatten"
+ "-flatten-n"
+ "-concat"
+ "-mapcat"
+ "--mapcat"
+ "-copy"
+ "-cons*"
+ "-snoc"
+ "-first"
+ "--first"
+ "-find"
+ "--find"
+ "-last"
+ "--last"
+ "-first-item"
+ "-last-item"
+ "-butlast"
+ "-count"
+ "--count"
+ "-any?"
+ "--any?"
+ "-some?"
+ "--some?"
+ "-any-p"
+ "--any-p"
+ "-some-p"
+ "--some-p"
+ "-all?"
+ "--all?"
+ "-every?"
+ "--every?"
+ "-all-p"
+ "--all-p"
+ "-every-p"
+ "--every-p"
+ "-none?"
+ "--none?"
+ "-none-p"
+ "--none-p"
+ "-only-some?"
+ "--only-some?"
+ "-only-some-p"
+ "--only-some-p"
+ "-slice"
+ "-take"
+ "-drop"
+ "-take-while"
+ "--take-while"
+ "-drop-while"
+ "--drop-while"
+ "-split-at"
+ "-rotate"
+ "-insert-at"
+ "-replace-at"
+ "-update-at"
+ "--update-at"
+ "-remove-at"
+ "-remove-at-indices"
+ "-split-with"
+ "--split-with"
+ "-split-on"
+ "-split-when"
+ "--split-when"
+ "-separate"
+ "--separate"
+ "-partition-all-in-steps"
+ "-partition-in-steps"
+ "-partition-all"
+ "-partition"
+ "-partition-by"
+ "--partition-by"
+ "-partition-by-header"
+ "--partition-by-header"
+ "-group-by"
+ "--group-by"
+ "-interpose"
+ "-interleave"
+ "-zip-with"
+ "--zip-with"
+ "-zip"
+ "-zip-fill"
+ "-cycle"
+ "-pad"
+ "-annotate"
+ "--annotate"
+ "-table"
+ "-table-flat"
+ "-partial"
+ "-elem-index"
+ "-elem-indices"
+ "-find-indices"
+ "--find-indices"
+ "-find-index"
+ "--find-index"
+ "-find-last-index"
+ "--find-last-index"
+ "-select-by-indices"
+ "-grade-up"
+ "-grade-down"
+ "->"
+ "->>"
+ "-->"
+ "-when-let"
+ "-when-let*"
+ "--when-let"
+ "-if-let"
+ "-if-let*"
+ "--if-let"
+ "-distinct"
+ "-uniq"
+ "-union"
+ "-intersection"
+ "-difference"
+ "-contains?"
+ "-contains-p"
+ "-same-items?"
+ "-same-items-p"
+ "-is-prefix-p"
+ "-is-prefix?"
+ "-is-suffix-p"
+ "-is-suffix?"
+ "-is-infix-p"
+ "-is-infix?"
+ "-sort"
+ "--sort"
+ "-list"
+ "-repeat"
+ "-sum"
+ "-product"
+ "-max"
+ "-min"
+ "-max-by"
+ "--max-by"
+ "-min-by"
+ "--min-by"
+ "-iterate"
+ "--iterate"
+ "-unfold"
+ "--unfold"
+ "-cons-pair?"
+ "-cons-to-list"
+ "-value-to-list"
+ "-tree-mapreduce-from"
+ "--tree-mapreduce-from"
+ "-tree-mapreduce"
+ "--tree-mapreduce"
+ "-tree-map"
+ "--tree-map"
+ "-tree-reduce-from"
+ "--tree-reduce-from"
+ "-tree-reduce"
+ "--tree-reduce"
+ "-clone"
+ "-rpartial"
+ "-juxt"
+ "-applify"
+ "-on"
+ "-flip"
+ "-const"
+ "-cut"
+ "-orfn"
+ "-andfn"
+ "-iteratefn"
+ "-prodfn"
+ ))
+ (special-variables '(
+ "it"
+ "it-index"
+ "acc"
+ "other"
+ )))
+ (font-lock-add-keywords 'emacs-lisp-mode `((,(concat "\\_<"
(regexp-opt special-variables 'paren) "\\_>")
+ 1
font-lock-variable-name-face)) 'append)
+ (font-lock-add-keywords 'emacs-lisp-mode `((,(concat "(\\s-*"
(regexp-opt new-keywords 'paren) "\\_>")
+ 1
font-lock-keyword-face)) 'append))
+ (--each (buffer-list)
+ (with-current-buffer it
+ (when (and (eq major-mode 'emacs-lisp-mode)
+ (boundp 'font-lock-mode)
+ font-lock-mode)
+ (font-lock-refresh-defaults)))))))
+
+(provide 'dash)
+;;; dash.el ends here
diff --git a/tests/elnode-tests.el b/tests/elnode-tests.el
new file mode 100644
index 0000000..de96711
--- /dev/null
+++ b/tests/elnode-tests.el
@@ -0,0 +1,1883 @@
+;;; elnode-tests.el --- tests for Elnode -*- lexical-binding: t -*-
+
+;;; Code:
+
+(add-to-list 'load-path (expand-file-name "./elnode/"))
+
+(require 'ert)
+(require 'fakir)
+(require 'elnode)
+(require 'elnode-wiki)
+(require 'elnode-proxy)
+(require 'elnode-testsupport)
+(require 'kv)
+(require 'mail-parse)
+(require 'noflet)
+(require 'rx)
+
+(ert-deftest elnode/case ()
+ "Show that elnode/case works."
+ (should
+ (equal
+ '(10 "blah")
+ (list
+ (let ((v 1))
+ (elnode/case v
+ (1 10)
+ (t 11)))
+ ;; Shows the else case
+ (let ((v 2))
+ (elnode/case v
+ (1 10)
+ (t "blah")))))))
+
+(ert-deftest elnode--posq ()
+ (equal
+ (list
+ (elnode--posq 10 '(1 2 3 4 5 10 20 70))
+ (elnode--posq 2 '(1 2 3 4 5 10 20 70))
+ (elnode--posq 100 '(1 2 3 4 5 10 20 70)))
+ '(5 1 nil)))
+
+(ert-deftest elnode-msg ()
+ (should
+ (equal
+ (list
+ ;; Checks we get a status
+ (let ((elnode--do-error-logging :status))
+ (let (received)
+ (noflet ((elnode-log-buffer-log (text buf &optional filename)
+ (setq received text)))
+ (elnode-msg :status "hello")
+ received)))
+ ;; Checks we don't
+ (let ((elnode--do-error-logging :warning))
+ (let (received)
+ (noflet ((elnode-log-buffer-log (text buf &optional filename)
+ (setq received text)))
+ (elnode-msg :status "hello")
+ received)))
+ ;; And now without a level set
+ (let ((elnode--do-error-logging nil))
+ (let (received)
+ (noflet ((elnode-log-buffer-log (text buf &optional filename)
+ (setq received text)))
+ (elnode-msg :status "hello")
+ received))))
+ '("hello" nil nil))))
+
+(ert-deftest elnode-join ()
+ "Test the path joining."
+ (should
+ (equal "/la/la/file"
+ (elnode-join "/la" "la" "file")))
+ (should
+ (equal "/la/la/file/"
+ (elnode-join "/la" "la" "file/")))
+ (should
+ (equal "/la/la/file/"
+ (elnode-join "/la" "la/file/" ""))))
+
+(ert-deftest elnode-url-encode-path ()
+ "Test the path encoding."
+ (should
+ (equal
+ "/path/the%20path"
+ (elnode-url-encode-path "/path/the path")))
+ (should
+ (equal
+ "/path/the%20path/"
+ (elnode-url-encode-path "/path/the path/")))
+ (should
+ (equal
+ "/path/the%20%27path%27"
+ (elnode-url-encode-path "/path/the 'path'"))))
+
+(defun elnode--log-buffer-read-text (buffer)
+ "Turn the buffer into a list of text.
+
+Strips off the date format from each text line. Primarily this
+is just a test helper."
+ (let* ((log-line-regex "[0-9]\\{14\\}: \\(.*\\)")
+ (lines
+ (split-string
+ (with-current-buffer buffer
+ (buffer-substring (point-min) (point-max)))
+ "\n")))
+ (loop for line in lines
+ if (string-match log-line-regex line)
+ collect (match-string 1 line))))
+
+;; (unless (version< emacs-version "24.4")
+;; (ert-deftest elnode-log-buffer-log ()
+;; "Test the log buffer stuff."
+;; (noflet ((read-log (&optional buffer)
+;; (with-current-buffer (or buffer (current-buffer))
+;; (->> (split-string (buffer-string) "\n")
+;; (-filter (lambda (s) (> (length s) 0)))
+;; (-map
+;; (lambda (str)
+;; (string-match "^[^ ]+ \\(.*\\)" str)
+;; (match-string 1 str)))))))
+;; (let ((tf (make-temp-file "logbufferlog")))
+;; (with-temp-buffer
+;; (elnode-log-buffer-log "test it" (current-buffer) tf)
+;; (should
+;; (equal
+;; (marker-position elnode-log-buffer-position-written)
+;; (point-max)))
+;; (elnode-log-buffer-log "test again" (current-buffer) tf)
+;; (should
+;; (equal '("test it" "test again")
+;; (read-log))))
+;; ;; Test that we can read it back from the file.
+;; (let* ((log-buf (find-file-noselect tf)))
+;; (should
+;; (equal
+;; '("test it" "test again")
+;; (read-log log-buf)))))))
+
+;; (ert-deftest elnode-log-buffer-log-truncates ()
+;; "Test the log buffer gets truncated stuff."
+;; (let ((log-line-regex "[0-9]\\{14\\}: \\(.*\\)")
+;; (tf (make-temp-file "logbufferlog"))
+;; (elnode-log-buffer-max-size 8))
+;; (with-temp-buffer
+;; (elnode-log-buffer-log "test it" (current-buffer) tf)
+;; (elnode-log-buffer-log "test again" (current-buffer) tf)
+;; (elnode-log-buffer-log "test three" (current-buffer) tf)
+;; (elnode-log-buffer-log "test four" (current-buffer) tf)
+;; (elnode-log-buffer-log "test five" (current-buffer) tf)
+;; (elnode-log-buffer-log "test six" (current-buffer) tf)
+;; (elnode-log-buffer-log "test seven" (current-buffer) tf)
+;; (elnode-log-buffer-log "test eight" (current-buffer) tf)
+;; (elnode-log-buffer-log "test nine" (current-buffer) tf)
+;; (elnode-log-buffer-log "test ten" (current-buffer) tf)
+;; (should
+;; (equal
+;; 8
+;; (length
+;; (loop for i in
+;; (split-string
+;; (buffer-substring
+;; (point-min)
+;; (point-max))
+;; "\n")
+;; if (not (equal i ""))
+;; collect i)))))))
+
+;; (ert-deftest elnode-test-access-log ()
+;; "Test the access logging."
+;; (fakir-mock-process :httpcon
+;; ((:buffer
+;; (elnode--http-make-hdr
+;; 'get "/"
+;; '(host . "localhost")
+;; '(user-agent . "test-agent")))
+;; (:elnode-httpresponse-status 200)
+;; (:elnode-bytes-written 2048))
+;; (set-process-plist :httpcon (list (make-hash-table
:test 'eq)))
+;; (elnode/con-put :httpcon
+;; :elnode-http-started (current-time)
+;; :elnode-httpresponse-status 200
+;; :elnode-bytes-written 2048)
+;; (should
+;; (equal
+;; 'done
+;; (catch 'elnode-parse-http (elnode--http-parse
:httpcon))))
+;; (let* ((logname "ert-test")
+;; (buffername (format "*%s-elnode-access*"
logname))
+;; (log-rx (rx
+;; (and line-start
+;; ;; year - month - day
+;; (= 4 (any "0-9")) "-" (= 2
(any "0-9")) "-" (= 2 (any "0-9")) "-"
+;; ;; hours - minutes - seconds
+;; (= 2 (any "0-9")) ":" (= 2
(any "0-9")) ":" (= 2 (any "0-9")) ":"
+;; (1+ " ") "200" ; status
code
+;; (1+ " ") "2048" ; size
+;; (1+ " ") "GET" ; method
+;; (1+ " ") "/" ; path
+;; line-end))))
+;; (noflet ((elnode--log-filename (log-name)
(make-temp-file "elnode-access")))
+;; (unwind-protect
+;; (progn
+;; (elnode-log-access logname :httpcon)
+;; (should
+;; (string-match
+;; log-rx
+;; (with-current-buffer buffername
+;; (s-trim-right
(buffer-string))))))
+;; (kill-buffer buffername)))))))
+
+(ert-deftest elnode-test-logs-dont-log ()
+ "Test the logs don't log when we turn stuff off."
+ (let ((elnode-log-files-directory nil))
+ ;; FIXME this is not a test. duh.
+ (elnode-error "test message!")))
+
+(ert-deftest elnode-test-error-log ()
+ (let ((err-message "whoops!! something went wrong! %s" )
+ (err-include "some included value"))
+ (with-temp-buffer
+ (let ((test-log-buf (current-buffer)))
+ ;; Setup a fake server log buffer
+ (noflet ((elnode--get-error-log-buffer ()
+ test-log-buf))
+ (elnode-error err-message err-include))
+ ;; Assert the message sent to the log buffer is correctly formatted.
+ (should (string-match
+ (format
+ "^.*: %s\n$"
+ (apply 'format `(,err-message ,@(list err-include))))
+ (buffer-substring (point-min) (point-max))))))))
+
+(ert-deftest elnode-test-error-log-list ()
+ (let ((err-message "whoops!! something went wrong! %s %s")
+ (err-include '("included value 1" "included value 2")))
+ (with-temp-buffer
+ (let ((test-log-buf (current-buffer)))
+ ;; Setup a fake server log buffer
+ (noflet ((elnode--get-error-log-buffer ()
+ test-log-buf))
+ (elnode-error
+ err-message
+ "included value 1" "included value 2"))
+ ;; Assert the message sent to the log buffer is correctly formatted.
+ (should (string-match
+ (format
+ "^.*: %s\n$"
+ (apply 'format `(,err-message ,@err-include)))
+ (buffer-substring (point-min) (point-max))))))))
+
+(ert-deftest elnode-deferring ()
+ "Testing the defer setup."
+ (let* ((result :not-done)
+ (handler (lambda (httpcon)
+ (message "here!")
+ (setq result :done)))
+ (elnode--deferred (list)))
+ (fakir-mock-process :httpcon ()
+ (set-process-plist :httpcon (list (make-hash-table
:test 'eq)))
+ ;; The queue starts empty
+ (should (equal 0 (length elnode--deferred)))
+ ;; Then we add to it...
+ (elnode--deferred-add :httpcon handler)
+ (should (equal 1 (length elnode--deferred)))
+ ;; Then we process it...
+ (noflet ((process-status (proc) 'open))
+ (elnode--deferred-processor))
+ ;; ... that should have emptied it out...
+ (should (eq result :done))
+ (should (equal 0 (length elnode--deferred)))
+ ;; Now we add a handler that defers...
+ (elnode--deferred-add :httpcon
+ (lambda (httpcon)
+ (elnode-defer-now handler)))
+ (should (equal 1 (length elnode--deferred)))
+ ;; Now we process...
+ (noflet ((process-status (proc) 'open))
+ (elnode--deferred-processor))
+ ;; ... should still have the deferred handler in it...
+ (should (equal 1 (length elnode--deferred)))
+ ;; ... process again ...
+ (noflet ((process-status (proc) 'open))
+ (elnode--deferred-processor))
+ (should (equal 0 (length elnode--deferred))))))
+
+(ert-deftest elnode--http-parse-status-line-rx ()
+ "Prove different status lines."
+ (assert (string-match-p elnode--http-status-line-rx "GET / HTTP/1.1"))
+ (assert (string-match-p elnode--http-status-line-rx "POST / HTTP/1.1"))
+ (assert (string-match-p elnode--http-status-line-rx "POST /abc HTTP/1.1"))
+ (assert (string-match-p elnode--http-status-line-rx "DELETE /abc HTTP/1.1"))
+ (assert (string-match-p elnode--http-status-line-rx "PUT /abc HTTP/1.1"))
+ (assert (string-match-p elnode--http-status-line-rx "GET /abc/09283
HTTP/1.1"))
+ (assert (string-match-p elnode--http-status-line-rx "GET /abc/09283?abc
HTTP/1.1"))
+ (assert (string-match-p elnode--http-status-line-rx "GET /abc/09283?abc=1234
HTTP/1.1"))
+ (assert (string-match-p elnode--http-status-line-rx "GET /abc?abc=123
HTTP/1.1"))
+ (assert (string-match-p elnode--http-status-line-rx "GET /abc/?abc=123
HTTP/1.1"))
+ (assert (string-match-p elnode--http-status-line-rx "GET /abc/09283?x=1
HTTP/1.1"))
+ (assert (string-match-p elnode--http-status-line-rx "GET /abc/09283?x=1&a=1
HTTP/1.1"))
+ (assert (string-match-p elnode--http-status-line-rx "GET /abc/09283;def
HTTP/1.1"))
+ (assert (string-match-p elnode--http-status-line-rx "GET /abc/09283;def?a=1
HTTP/1.1")))
+
+(ert-deftest elnode--http-parse-header ()
+ "Pass an HTTP header."
+ (let ((content "some content"))
+ (with-temp-buffer
+ (insert
+ (format "POST /blah HTTP/1.1\r
+Content-type: application/form-www-data\r
+Content-length: %s\r
+User-Agent: ert-test\r
+X-test-Header: somevalue\r
+\r
+%s" (length content) content))
+ (destructuring-bind (status header-alist)
+ (save-excursion
+ (goto-char (point-min))
+ (elnode--http-parse-header (current-buffer) (point-min)))
+ (should
+ (equal
+ (kva "content-type" header-alist)
+ "application/form-www-data"))
+ (should (equal "POST /blah HTTP/1.1" status))))))
+
+(ert-deftest elnode--http-parse-header-non-main ()
+ "Pass a non-main HTTP header, eg: multipart."
+ (let ((content "some content"))
+ (with-temp-buffer
+ (insert
+ (format "POST /blah HTTP/1.1\r
+Content-length: %s\r
+User-Agent: ert-test\r
+X-test-Header: somevalue\r
+Content-Type: multipart/form-data;
boundary=----------------------------96a411d2bf2a\r
+\r
+------------------------------96a411d2bf2a\r
+Content-Disposition: form-data; name=\"file\"; filename=\"chat.css\"\r
+Content-Type: application/octet-stream\r
+\r
+%s
+----------------------------96a411d2bf2a--\r" (length content) content))
+ (save-excursion
+ (goto-char (point-min))
+ (elnode--http-parse-header (current-buffer) (point-min))
+ (destructuring-bind (status header-alist)
+ (elnode--http-parse-header (current-buffer) (point) t)
+ (should
+ (equal
+ (kva "content-type" header-alist)
+ "application/octet-stream"))
+ (should
+ (equal
+ status
+ "------------------------------96a411d2bf2a")))))))
+
+(ert-deftest elnode--make-http-hdr ()
+ "Test the construction of headers"
+ (should
+ (equal
+ (elnode--http-make-hdr
+ 'get "/"
+ '(host . "host1")
+ '(user-agent . "test-agent"))
+ "GET / HTTP/1.1\r
+Host: host1\r
+User-Agent: test-agent\r
+\r
+"))
+ (should
+ (equal
+ (elnode--http-make-hdr
+ 'get "/"
+ '(host . "host2")
+ '(user-agent . "test-agent")
+ '(body . "my test data"))
+ "GET / HTTP/1.1\r
+Host: host2\r
+User-Agent: test-agent\r
+\r
+my test data")))
+
+(ert-deftest elnode--http-parse-header-complete ()
+ "Test the HTTP parsing."
+ (fakir-mock-process
+ :httpcon
+ ((:buffer
+ (elnode--http-make-hdr
+ 'get "/"
+ '(host . "localhost")
+ '(user-agent . "test-agent"))))
+ (set-process-plist :httpcon (list (make-hash-table :test 'eq)))
+ ;; Parse the header
+ (should
+ (equal 'done
+ (catch 'elnode-parse-http
+ (elnode--http-parse :httpcon))))
+ ;; Now check the side effects
+ (should
+ (equal
+ (elnode/con-get :httpcon :elnode-http-header)
+ '(("host" . "localhost")
+ ("user-agent" . "test-agent"))))))
+
+(ert-deftest elnode--http-parse-header-incomplete ()
+ "Test the HTTP parsing of an incomplete header.
+
+An HTTP request with an incomplete header is setup and tested,
+then we finish the request (fill out the header) and then test
+again."
+ (fakir-mock-process
+ :httpcon
+ ((:buffer
+ "GET / HTTP/1.1\r\nHost: localh"))
+ (set-process-plist :httpcon (list (make-hash-table :test 'eq)))
+ ;; Now parse
+ (should
+ ;; It fails with incomplete 'header signal
+ (equal 'header
+ (catch 'elnode-parse-http
+ (elnode--http-parse :httpcon))))
+ ;; Now put the rest of the header in the buffer
+ (with-current-buffer (process-buffer :httpcon)
+ (goto-char (point-max))
+ (insert "ost\r\n\r\n"))
+ (should
+ ;; Now it succeeds with the 'done signal
+ (equal 'done
+ (catch 'elnode-parse-http
+ (elnode--http-parse :httpcon))))))
+
+
+(ert-deftest elnode--http-parse-body-incomplete ()
+ "Tests the HTTP parsing of an incomplete body.
+
+An HTTP request with an incomplete body is setup and tested, then
+we finish the request (fill out the content to content-length)
+and then test again."
+ (let ((hdr
+ (elnode--http-make-hdr
+ 'get "/"
+ '(host . "localhost")
+ '(user-agent . "test-agent")
+ `(content-length . ,(format "%d" (length "this is not finished")))
+ '(body . "this is not fin"))))
+ (fakir-mock-process :httpcon
+ ((:buffer hdr))
+ (set-process-plist :httpcon (list (make-hash-table :test 'eq)))
+ ;; Now parse
+ (should
+ (equal 'content
+ (catch 'elnode-parse-http
+ (elnode--http-parse :httpcon))))
+ ;; Now put the rest of the text in the buffer
+ (with-current-buffer (process-buffer :httpcon)
+ (goto-char (point-max))
+ (insert "ished"))
+ ;; And test again
+ (should
+ (equal 'done
+ (catch 'elnode-parse-http
+ (elnode--http-parse :httpcon)))))))
+
+
+(ert-deftest elnode-http-start ()
+ "Test starting a response.
+
+Especially tests the mix of header setting techniques."
+ (fakir-mock-process :httpcon ()
+ (set-process-plist :httpcon (list (make-hash-table :test 'eq)))
+ (elnode-http-header-set :httpcon "Content-Type" "text/html")
+ (elnode-http-header-set :httpcon "Accept" "application/javascript")
+ (elnode-http-start :httpcon 200 '("Content-Type" . "text/plain"))
+ ;; Test that we have the correct text in the fake process buffer
+ (with-current-buffer (fakir-get-output-buffer)
+ (goto-char (point-min))
+ (should
+ (re-search-forward "^Content-Type: text/html\r\n" nil t))
+ (goto-char (point-min))
+ (should
+ (re-search-forward "^Accept: application/javascript\r\n" nil t)))))
+
+(ert-deftest elnode--auth-entry->dispatch-table ()
+ "Test the construction of dispatch tables."
+ (let ((elnode--defined-authentication-schemes
+ (make-hash-table :test 'equal)))
+ (elnode-defauth :test-scheme1)
+ (let ((tbl (elnode--auth-entry->dispatch-table :test-scheme1)))
+ (should
+ (and
+ (equal (caar tbl) "^/login/$")
+ (functionp (cdr (car tbl))))))
+ (elnode-defauth :test-scheme2 :redirect "/testauth/")
+ (let ((tbl (elnode--auth-entry->dispatch-table :test-scheme2)))
+ (should
+ (and
+ (equal (caar tbl) "^/testauth/$")
+ (functionp (cdr (car tbl))))))))
+
+(defun elnode-test-handler (httpcon)
+ "A simple handler for testing `elnode-test-call'.
+
+The text spat out is tested, so is the status."
+ (elnode-http-start
+ httpcon 200
+ '("Content-Type" . "text/html")
+ '("User-Agent" . "elnode-test"))
+ (let ((params (elnode-http-params httpcon)))
+ (elnode-http-return
+ httpcon
+ (format
+ "<html><body><h1>Hello World</h1>%s</body></html>"
+ (if params
+ (format "<div>%S</div>" params)
+ "")))))
+
+;; (ert-deftest elnode--dispatch-proc ()
+;; "Test the dispatch mechanism."
+;; ;; Normal dispatch
+;; (let (result)
+;; (should
+;; (equal
+;; :login
+;; (fakir-mock-process :httpcon ()
+;; (set-process-plist :httpcon (list (make-hash-table :test 'eq)))
+;; (elnode--dispatch-proc
+;; :httpcon "/login/"
+;; '(("^/a/$" (lambda (httpcon) (setq result :ha0)))
+;; ("^/b/$" (lambda (httpcon) (setq result :ha1)))
+;; ("^/login/$" (lambda (httpcon) (setq result :login)))))))))
+;; ;; Providing an extra table to dispatch from auth
+;; (let (result
+;; (elnode--defined-authentication-schemes
+;; (make-hash-table :test 'equal)))
+;; (elnode-defauth :test-scheme1
+;; :sender
+;; (lambda (httpcon target redirect)
+;; (setq result :login)))
+;; (should
+;; (equal
+;; :login
+;; (fakir-mock-process :httpcon
+;; ((:elnode-http-method "GET")
+;; (:elnode-http-params '(("redirect" . "/a/"))))
+;; (set-process-plist :httpcon (list (make-hash-table :test 'eq)))
+;; (elnode/con-put :httpcon
+;; :elnode-http-method "GET"
+;; :elnode-http-params '(("redirect" . "/a/")))
+;; (elnode--dispatch-proc
+;; :httpcon
+;; "/login/"
+;; '(("^/a/$" (lambda (httpcon) (setq result :ha0)))
+;; ("^/b/$" (lambda (httpcon) (setq result :ha1))))
+;; :extra-table (elnode--auth-entry->dispatch-table :test-scheme1)))))
+;; ;; ... as well as stuff in the main table
+;; (should
+;; (equal
+;; :ha1
+;; (fakir-mock-process :httpcon
+;; ((:elnode-http-method "GET")
+;; (:elnode-http-params '(("redirect" . "/b/"))))
+;; (set-process-plist :httpcon (list (make-hash-table :test 'eq)))
+;; (elnode/con-put :httpcon
+;; :elnode-http-method "GET"
+;; :elnode-http-params '(("redirect" . "/b/")))
+;; (elnode--dispatch-proc
+;; :httpcon
+;; "/b/"
+;; '(("^/a/$" (lambda (httpcon) (setq result :ha0)))
+;; ("^/b/$" (lambda (httpcon) (setq result :ha1))))
+;; :extra-table (elnode--auth-entry->dispatch-table
:test-scheme1)))))))
+
+(ert-deftest elnode-test-call-simple ()
+ "Simple test of calling a handler.
+
+This tests the basics of mocked server, it goes through the
+filter so it's very useful for working stuff out."
+ (with-elnode-mock-server
+ (lambda (httpcon)
+ (elnode-http-start httpcon 200 '("Content-Type" . "text/plain"))
+ (elnode-http-return httpcon "that's it"))
+ (let ((response (elnode-test-call "/test/test.something")))
+ (should-elnode-response response
+ :status-code 200
+ :header-name "Content-Type"
+ :header-value "text/plain"
+ :body-match ".*that's it"))))
+
+(ert-deftest elnode--make-test-call ()
+ "Test the HTTP request construction."
+ (should
+ (equal
+ "GET / HTTP/1.1\r\n\r\n"
+ (elnode--make-test-call
+ "/" "GET"
+ '()
+ nil)))
+ (should
+ (equal
+ "GET /?a=1&b=hello HTTP/1.1\r\n\r\n"
+ (elnode--make-test-call
+ "/" "GET"
+ '((a . 1)(b . "hello"))
+ nil)))
+ (should
+ (equal
+ "POST / HTTP/1.1\r
+Content-Type: application/x-www-form-urlencoded\r
+Content-Length: 11\r
+\r
+a=1&b=hello"
+ (elnode--make-test-call
+ "/" "POST"
+ '((a . 1)(b . "hello"))
+ nil)))
+ ;; The content type always comes before any other headers
+ (should
+ (equal
+ "POST / HTTP/1.1\r
+Content-Type: application/x-www-form-urlencoded\r
+Content-Length: 11\r
+User-Agent: elnode-test\r
+\r
+a=1&b=hello"
+ (elnode--make-test-call
+ "/" "POST"
+ '((a . 1)(b . "hello"))
+ '(("User-agent" . "elnode-test"))))))
+
+(ert-deftest elnode-test-call-assert ()
+ "Test that we can assert things about elnode test responses."
+ (with-elnode-mock-server
+ ;; Test dispatcher
+ (lambda (httpcon)
+ (elnode-hostpath-dispatcher
+ httpcon
+ '(("[^/]*//test/.*" . elnode-test-handler)))) t
+ (should-elnode-response
+ (elnode-test-call "/test/test.something")
+ :status-code 200
+ :header-name "Content-Type"
+ :header-value "text/html"
+ :body-match ".*<h1>Hello World</h1>")
+ ;; Success with multiple headers
+ (should-elnode-response
+ (elnode-test-call "/test/test.something"
+ :method "POST"
+ :parameters '(("a" . 1)))
+ :status-code 200
+ :header-list '(("Content-Type" . "text/html")
+ ("User-Agent" . "elnode-test"))
+ :body-match ".*<div>((\"a\" . \"1\"))</div>")
+ ;; Success with multiple header regexes
+ (should-elnode-response
+ (elnode-test-call "/test/test.something"
+ :method "POST"
+ :parameters '(("a" . 1)))
+ :status-code 200
+ :header-list-match '(("Content-Type" . "text/html")
+ ("User-Agent" . "elnode-.*"))
+ :body-match ".*<div>((\"a\" . \"1\"))</div>")
+ ;; With params
+ (should-elnode-response
+ (elnode-test-call "/test/test.something"
+ :method "POST"
+ :parameters '(("a" . 1)))
+ :status-code 200
+ :header-name "Content-Type"
+ :header-value "text/html"
+ :body-match ".*<div>((\"a\" . \"1\"))</div>")))
+
+(ert-deftest elnode-test-call-cookie-store ()
+ "Test the cookie store."
+ ;; Test with empty cookie store
+ (with-elnode-mock-server
+ (lambda (httpcon)
+ (elnode-http-start
+ httpcon 200
+ '("Content-Type" . "text/html")
+ (elnode-http-cookie-make
+ "mycookie" 101
+ :expiry "Mon, Feb 27 2012 22:10:21 GMT"))
+ (elnode-http-return httpcon "<h1>HA!</h1>")) t
+ ;; Let-bind empty cookie store
+ (let ((elnode--cookie-store (make-hash-table :test 'equal)))
+ (elnode-test-call "/anything")
+ (should
+ (equal
+ (kvhash->alist elnode--cookie-store)
+ '(("mycookie" . "101"))))))
+ ;; Test merging cookie store
+ (with-elnode-mock-server
+ (lambda (httpcon)
+ (elnode-http-start
+ httpcon 200
+ '("Content-Type" . "text/html")
+ (elnode-http-cookie-make
+ "mycookie" 101
+ :expiry "Mon, Feb 27 2012 22:10:21 GMT"))
+ (elnode-http-return httpcon "<h1>HA!</h1>")) t
+ (let ((elnode--cookie-store
+ (kvalist->hash '(("a" . "1")("b" . "hello!")))))
+ (elnode-test-call "/anything")
+ (should
+ (equal
+ (kvalist-sort (kvhash->alist elnode--cookie-store) 'string-lessp)
+ '(("a" . "1")
+ ("b" . "hello!")
+ ("mycookie" . "101")))))))
+
+(ert-deftest elnode-http-header ()
+ "Test that we have headers."
+ (fakir-mock-process
+ :httpcon
+ ((:buffer
+ (elnode--http-make-hdr
+ 'get "/"
+ '(host . "localhost")
+ '(user-agent . "test-agent")
+ '(if-modified-since . "Mon, Feb 27 2012 22:10:21 GMT")
+ `(content-length . ,(format "%d" (length "this is finished")))
+ '(body . "this is finished"))))
+ (set-process-plist :httpcon (list (make-hash-table :test 'eq)))
+ ;; Now parse
+ (should
+ (equal 'done
+ (catch 'elnode-parse-http
+ (elnode--http-parse :httpcon))))
+ (should
+ (equal "test-agent"
+ (elnode-http-header :httpcon "user-agent")))
+ (should
+ (equal "test-agent"
+ (elnode-http-header :httpcon 'user-agent)))
+ (should
+ (equal "test-agent"
+ (elnode-http-header :httpcon 'User-Agent)))
+ (should
+ (equal '(20299 65357)
+ (elnode-http-header :httpcon 'if-modified-since :time)))
+ ;; FIXME - add a test for bad time encoding
+ (should
+ (equal "Mon, Feb 27 2012 22:10:21 GMT"
+ (elnode-http-header :httpcon 'if-modified-since)))))
+
+(ert-deftest elnode-test-cookies ()
+ "Test that we can get all the cookies."
+ (fakir-mock-process :httpcon ()
+ (set-process-plist :httpcon (list (make-hash-table :test 'eq)))
+ (elnode/con-put :httpcon
+ :elnode-http-header-syms
+ '((cookie . "csrf=213u2132%20321412nsfnwlv; username=nicferrier")))
+ (should
+ (equal
+ (elnode-http-cookies :httpcon)
+ '(("csrf" . "213u2132 321412nsfnwlv")
+ ("username" . "nicferrier")))))
+ ;; Now with empty header
+ (fakir-mock-process :httpcon ()
+ (set-process-plist :httpcon (list (make-hash-table :test 'eq)))
+ (elnode/con-put :httpcon :elnode-http-header '(("Content-type" .
"text/xml")))
+ (should-not (elnode-http-cookies :httpcon))))
+
+(ert-deftest elnode-test-cookie ()
+ "Test the cookie retrieval"
+ ;; First test no cookie header
+ (fakir-mock-process :httpcon ()
+ (set-process-plist :httpcon (list (make-hash-table :test 'eq)))
+ (elnode/con-put :httpcon
+ :elnode-http-header-syms '((referer . "http://somehost.example/com";)))
+ (should-not (elnode-http-cookie :httpcon "username")))
+ ;; Now do we have a cookie?
+ (fakir-mock-process :httpcon ()
+ (set-process-plist :httpcon (list (make-hash-table :test 'eq)))
+ (elnode/con-put :httpcon
+ :elnode-http-header-syms
+ '((cookie . "csrf=213u21321321412nsfnwlv; username=nicferrier")))
+ (should
+ (equal
+ (elnode-http-cookie :httpcon "username")
+ '("username" . "nicferrier")))
+ (should
+ (equal
+ "nicferrier"
+ (elnode-http-cookie :httpcon "username" t)))))
+
+(ert-deftest elnode-test-cookie-list ()
+ "Test that a cookie list property is set on the connection.
+
+Cookie lists are good fake up values for higher abstraction
+testing code so we specifically test that they work."
+ (fakir-mock-process :httpcon ()
+ (set-process-plist :httpcon (list (make-hash-table :test 'eq)))
+ (elnode/con-put :httpcon :elnode-http-cookie-list '(("name" . "value")))
+ (should
+ (equal
+ '("name" . "value")
+ (elnode-http-cookie :httpcon "name"))))
+ ;; Not sure about what the property should contain here...
+ (fakir-mock-process :httpcon ()
+ (set-process-plist :httpcon (list (make-hash-table :test 'eq)))
+ (elnode/con-put :httpcon
+ :elnode-http-header-syms
+ '((cookie . "name=value; other=hello%20world")))
+ (elnode-http-cookie :httpcon "name")
+ (should
+ (equal
+ '(("name" . "value")
+ ("other" . "hello world"))
+ (elnode/con-get :httpcon :elnode-http-cookie-list)))))
+
+(ert-deftest elnode-http-cookie-make ()
+ "Test the cookie header maker."
+ ;; Expiry using a string date
+ (should
+ (equal
+ '("Set-Cookie" . "mycookie=101; Expires=Mon, Feb 27 2012 22:10:21 GMT;")
+ (elnode-http-cookie-make
+ "mycookie" 101
+ :expiry "Mon, Feb 27 2012 22:10:21 GMT"))))
+
+(ert-deftest elnode--response-header-to-cookie-store ()
+ "Test increasing the cookie store."
+ (should
+ (equal
+ (kvhash->alist
+ (let ((elnode--cookie-store (make-hash-table :test 'equal)))
+ (elnode--response-header-to-cookie-store
+ '(("Cookie" . "a=10; b=20")
+ ("Content-Type" . "text/html")
+ ("Set-Cookie"
+ . "mycookie=101; Expires=Mon, Feb 27 2012 22:10:21 GMT;")))))
+ '(("mycookie" . "101"))))
+ (should
+ (equal
+ (kvalist-sort
+ (kvhash->alist
+ (let ((elnode--cookie-store
+ (kvalist->hash '(("a" . "20")
+ ("b" . "this is it!")))))
+ (elnode--response-header-to-cookie-store
+ '(("Cookie" . "a=10; b=20")
+ ("Content-Type" . "text/html")
+ ("Set-Cookie"
+ . "mycookie=101; Expires=Mon, Feb 27 2012 22:10:21 GMT;")))))
+ 'string-lessp)
+ '(("a" . "20")
+ ("b" . "this is it!")
+ ("mycookie" . "101")))))
+
+(ert-deftest elnode--cookie-store-to-header-value ()
+ (let ((elnode--cookie-store
+ (kvalist->hash
+ '(("a" . "10")
+ ("b" . "hello world!")
+ ("mycookie" . "101")))))
+ (if (version< emacs-version "24.3")
+ (should
+ (equal
+ (elnode--cookie-store-to-header-value)
+ "a=10; b=hello%20world!; mycookie=101"))
+ (should
+ (equal
+ (elnode--cookie-store-to-header-value)
+ "a=10; b=hello%20world%21; mycookie=101"))))
+ (let ((elnode--cookie-store (make-hash-table :test 'equal)))
+ (should-not
+ (elnode--cookie-store-to-header-value))))
+
+(ert-deftest elnode-test-http-get-params ()
+ "Test that the params are ok if they are on the status line.
+
+Sets ':elnode-http-params' to nil to trigger `elnode-http-params'
+parsing. That checks the ':elnode-http-method':
+
+- for GET it returns the parsed ':elnode-http-query'
+
+- for POST it returns the merger of the parsed POST body and
+ ':elnode-http-query'.
+
+*** WARNING:: This test so far only handles GET ***"
+ (fakir-mock-process :httpcon ()
+ (set-process-plist :httpcon (list (make-hash-table :test 'eq)))
+ (elnode/con-put :httpcon
+ :elnode-http-params nil
+ :elnode-http-method "GET"
+ :elnode-http-query "a=10")
+ (should (equal "10" (elnode-http-param :httpcon "a"))))
+ ;; Test some more complex params
+ (fakir-mock-process :httpcon ()
+ (set-process-plist :httpcon (list (make-hash-table :test 'eq)))
+ (elnode/con-put :httpcon
+ :elnode-http-params nil
+ :elnode-http-method "GET"
+ :elnode-http-query "a=10&b=lah+dee+dah&c+a=blah+blah")
+ (should (equal "lah dee dah" (elnode-http-param :httpcon "b")))
+ (should (equal "lah dee dah" (elnode-http-param :httpcon 'b)))
+ (should (equal "blah blah" (elnode-http-param :httpcon "c a"))))
+ ;; Test the filtering
+ (fakir-mock-process :httpcon ()
+ (set-process-plist :httpcon (list (make-hash-table :test 'eq)))
+ (elnode/con-put :httpcon
+ :elnode-http-params nil
+ :elnode-http-method "GET"
+ :elnode-http-query "a=10&b=lah+dee+dah&d=blah+blah")
+ (should (equal "lah dee dah" (elnode-http-param :httpcon "b")))
+ (should (equal "lah dee dah" (elnode-http-param :httpcon 'b)))
+ (should (equal '(("a" . "10")("b" . "lah dee dah"))
+ (elnode-http-params :httpcon "a" "b")))
+ (should (equal '(("a" . "10")("b" . "lah dee dah"))
+ (elnode-http-params :httpcon 'a "b")))))
+
+(ert-deftest elnode-test-http-post-params ()
+ "Test that the params are ok if they are in the body.
+
+Does a full http parse of a dummy buffer."
+ (let ((httpcon :httpcon))
+ (let ((post-body "a=10&b=20&c=this+is+finished"))
+ (fakir-mock-process
+ :httpcon
+ ((:buffer
+ (elnode--http-make-hdr
+ 'post "/"
+ '(host . "localhost")
+ '(user-agent . "test-agent")
+ `(content-length . ,(format "%d" (length post-body)))
+ `(body . ,post-body))))
+ (set-process-plist :httpcon (list (make-hash-table :test 'eq)))
+ ;; Now parse
+ (should
+ (equal 'done
+ (catch 'elnode-parse-http
+ (elnode--http-parse httpcon))))
+ ;; Now test some params
+ (should (equal "10" (elnode-http-param httpcon "a")))
+ (should (equal "20" (elnode-http-param httpcon "b")))
+ (should (equal "this is finished" (elnode-http-param httpcon "c")))))
+ ;; Test get of params that aren't there
+ (fakir-mock-process
+ :httpcon
+ ((:buffer
+ (elnode--http-make-hdr
+ 'post "/"
+ '(host . "localhost")
+ '(user-agent . "test-agent")
+ `(content-length . "0")
+ `(body . ""))))
+ (set-process-plist :httpcon (list (make-hash-table :test 'eq)))
+ ;; Now parse
+ (should
+ (equal 'done
+ (catch 'elnode-parse-http
+ (elnode--http-parse httpcon))))
+ (should-not (elnode-http-param httpcon "a"))
+ (should-not (elnode-http-param httpcon "b"))
+ (should-not (elnode-http-param httpcon "c")))))
+
+(ert-deftest elnode-test-http-post-empty-params ()
+ "Test that the params are ok if they are just empty in the body."
+ (let ((post-body ""))
+ (fakir-mock-process
+ :httpcon
+ ((:buffer
+ (elnode--http-make-hdr
+ 'post "/"
+ '(host . "localhost")
+ '(user-agent . "test-agent")
+ `(content-length . ,(format "%d" (length post-body)))
+ `(body . ,post-body))))
+ (set-process-plist :httpcon (list (make-hash-table :test 'eq)))
+ ;; Now parse
+ (should
+ (equal 'done
+ (catch 'elnode-parse-http
+ (elnode--http-parse :httpcon))))
+ ;; Now test some params
+ (should-not (elnode-http-param :httpcon "a")))))
+
+(defun elnode--test-multipart-example (&optional boundary)
+ "Get an example Multipart body in BUFFER."
+ ;; This is from the W3C example -
+ ;; http://www.w3.org/TR/html401/interact/forms.html#h-17.13.4.2
+ (let ((bound (or boundary "AaB03x")))
+ (format
+ "Content-Type: multipart/form-data; boundary=%s\r
+\r
+--%s\r
+Content-Disposition: form-data; name=\"submit-name\"\r
+\r
+Larry\r
+--%s\r
+Content-Disposition: form-data; name=\"files\"; filename=\"file1.txt\"\r
+Content-Type: text/plain\r
+\r
+... contents of file1.txt ...\r
+--%s--\r
+" bound bound bound bound)))
+
+(ert-deftest elnode-test-multipart-parser ()
+ "Simple test of multipart parsing."
+ (with-temp-buffer
+ (insert "TEST\r\n")
+ (insert (elnode--test-multipart-example))
+ ;; Now read the buffer as a header
+ (goto-char (point-min))
+ ;; And then test
+ (let* ((buffer (current-buffer))
+ (hdr (elnode--http-parse-header (current-buffer) (point)))
+ (hdr-end-pt (with-current-buffer buffer (point)))
+ (parsed-cont-type
+ (mail-header-parse-content-type
+ (kva "content-type" (cadr hdr))))
+ (boundary (kva 'boundary (cdr parsed-cont-type)))
+ (params
+ (elnode--http-mp-decode buffer hdr-end-pt boundary)))
+ (should (equal (kva "submit-name" params) "Larry"))
+ (should (equal (kva "files" params) "... contents of file1.txt ..."))
+ (should (equal (get-text-property
+ 0 :elnode-filename (kva "files" params))
+ "file1.txt")))))
+
+(ert-deftest elnode-test-http-multipart-post ()
+ "Test that a multipart POST params are ok."
+ (let* ((boundary "96a411d2bf2a")
+ (post-body (elnode--test-multipart-example boundary)))
+ (fakir-mock-process
+ :httpcon
+ ((:buffer
+ (elnode--http-make-hdr
+ 'post "/"
+ '(host . "localhost")
+ '(user-agent . "test-agent")
+ `(content-type .
+ ,(format
+ "multipart/form-data; boundary=%s"
+ boundary))
+ `(content-length . ,(format "%d" (length post-body)))
+ `(body . ,post-body))))
+ (set-process-plist :httpcon (list (make-hash-table :test 'eq)))
+ ;; Now parse
+ (should
+ (equal 'done
+ (catch 'elnode-parse-http
+ (elnode--http-parse :httpcon))))
+ ;; Now test some params
+ (should
+ (equal
+ (elnode-http-param :httpcon "submit-name")
+ "Larry"))
+ (should
+ (equal
+ (elnode-http-param :httpcon "files")
+ "... contents of file1.txt ..."))
+ (should
+ (equal
+ (get-text-property
+ 0 :elnode-filename
+ (elnode-http-param :httpcon "files"))
+ "file1.txt")))))
+
+(ert-deftest elnode--http-result-header ()
+ "Test that we can make result headers."
+ (let ((l '((content-type . "text/html"))))
+ (should
+ (equal
+ (elnode--http-result-header l)
+ "Transfer-Encoding: chunked\r
+Content-Type: text/html\r
+")))
+ (let ((l '()))
+ (should
+ (equal
+ (elnode--http-result-header l)
+ "Transfer-Encoding: chunked\r
+"))))
+
+(ert-deftest elnode-http-header-set ()
+ "Test the premature setting of HTTP headers."
+ (fakir-mock-process
+ :httpcon
+ ()
+ (set-process-plist :httpcon (list (make-hash-table :test 'eq)))
+ (should
+ (equal nil
+ (elnode/con-get :httpcon :elnode-headers-to-set)))
+ (elnode-http-header-set :httpcon "Content-Type" "text/html")
+ (elnode-http-header-set
+ :httpcon
+ (elnode-http-cookie-make "mycookie" "value"))
+ (should
+ (equal '(("Content-Type" . "text/html")
+ ("Set-Cookie" . "mycookie=value;"))
+ (elnode/con-get :httpcon :elnode-headers-to-set)))))
+
+
+(ert-deftest elnode--format-response ()
+ "Test response formatting."
+ ;; Test standard 200 response
+ (should
+ (equal
+ "<h1>Ok.</h1>\r\n"
+ (elnode--format-response 200)))
+ ;; Test a response we don't have a mapping for
+ (should
+ (equal
+ "<h1>Error.</h1>\r\n"
+ (elnode--format-response 531)))
+ (let ((elnode-default-response-table '((404 . "We didn't find that!"))))
+ (should
+ (equal
+ "<h1>We didn't find that!</h1>\r\n"
+ (elnode--format-response 404)))))
+
+(ert-deftest elnode-send-json ()
+ "Test sending JSON."
+ (let ((sent-data ""))
+ (should
+ (equal
+ ["a string in a list"]
+ (json-read-from-string
+ (noflet ((elnode-http-return (con data)
+ (setq sent-data data)))
+ (fakir-mock-process :httpcon ()
+ (set-process-plist :httpcon (list (make-hash-table :test 'eq)))
+ (elnode-send-json :httpcon (list "a string in a list")))
+ sent-data))))))
+
+(defconst elnode--buffer-template-example
+ "<!doctype html>
+<head>
+ <meta charset='utf-8'>
+ <meta http-equiv='X-UA-Compatible' content='IE=edge,chrome=1'>
+ <title><!##E title E##!></title>
+ <meta name='viewport' content='width=device-width'>
+ <link rel='stylesheet' href='/talk/stuff/css/style.css'/>
+ <link rel='stylesheet' href='/talk/stuff/css/basic.css'/>
+</head>
+<body>
+ <a href='<!##E username E##!>'><!##E username E##!></a>
+ <div id='header'>
+ <ul>
+ <li><a href='javascript:;'>talk to a friend</a></li>
+ <li><a href='/about/'>about</a></li>
+ <li><a href='/blog/'>blog</a></li>
+ </ul>
+ <!##E name-html E##!>
+ </div>
+</body>
+</html>"
+ "Example template source for `elnode--buffer-template' tests.")
+
+(ert-deftest elnode--buffer-template ()
+ "Test the buffer templating."
+ (let ((result
+ (with-temp-buffer
+ (insert elnode--buffer-template-example)
+ (elnode--buffer-template
+ (current-buffer)
+ '(("title" . "My webpage")
+ ("username" . "nicferrier")
+ ("name-html" . "<div>you are talking to Caroline</div>"))))))
+ (should
+ (string-match ".*<title>My webpage</title>.*" result))
+ (should
+ (string-match ".*<a href='nicferrier'>nicferrier</a>.*" result))
+ (should
+ (string-match ".*<div>you are talking to Caroline</div>.*" result))))
+
+(ert-deftest elnode-http-pathinfo ()
+ "Test the pathinfo calling."
+ (fakir-mock-process
+ :httpcon
+ ((:elnode-http-pathinfo "/test/somepath"))
+ (set-process-plist :httpcon (list (make-hash-table :test 'eq)))
+ (elnode/con-put :httpcon :elnode-http-pathinfo "/test/somepath")
+ (should
+ (equal
+ "/test/somepath"
+ (elnode-http-pathinfo :httpcon)))))
+
+(ert-deftest elnode--mapper-find ()
+ "Test the mapper find function."
+ (fakir-mock-process
+ :httpcon
+ ((:nothing))
+ (set-process-plist :httpcon (list (make-hash-table :test 'eq)))
+ (should
+ (equal
+ (elnode--mapper-find
+ :httpcon
+ "localhost//wiki/somefile.creole"
+ '(("[^/]+//wiki/\\(.*\\)" . elnode-wikiserver)
+ ("[^/]+//.*" . elnode-webserver)))
+ 'elnode-wikiserver))
+ (should (equal (elnode-http-mapping :httpcon t) 2))
+ (should
+ (equal
+ (elnode-http-mapping :httpcon)
+ "localhost//wiki/somefile.creole"))
+ (should
+ (equal
+ (elnode-http-mapping :httpcon 0)
+ "localhost//wiki/somefile.creole"))
+ (should
+ (equal
+ (elnode-http-mapping :httpcon 1)
+ "somefile.creole"))
+ (should
+ (equal
+ (elnode--mapper-find
+ :httpcon
+ "anyhost//wiki/somefile.creole"
+ '(("[^/]+//wiki/\\(.*\\)" . elnode-wikiserver)
+ ("[^/]+//.*" . elnode-webserver)))
+ 'elnode-wikiserver))))
+
+(ert-deftest elnode--strip-leading-slash ()
+ "Test slash stripping.
+
+That sounds more fun than it is."
+ (should
+ (equal "blah"
+ (elnode--strip-leading-slash "/blah")))
+ (should
+ (equal "blah"
+ (elnode--strip-leading-slash "blah")))
+ (should
+ (equal "blah/"
+ (elnode--strip-leading-slash "/blah/")))
+ (should
+ (equal "blah/"
+ (elnode--strip-leading-slash "blah/"))))
+
+(ert-deftest elnode-get-targetfile ()
+ "Test the target file resolution stuff."
+ (fakir-mock-process :httpcon
+ ((:elnode-http-pathinfo "/wiki/index.creole"))
+ (set-process-plist :httpcon (list (make-hash-table :test 'eq)))
+ (elnode/con-put :httpcon :elnode-http-pathinfo "/wiki/index.creole")
+ (should
+ (equal
+ 'elnode-wikiserver
+ (elnode--mapper-find
+ :httpcon
+ "localhost//wiki/index.creole"
+ '(("[^/]+//wiki/\\(.*\\)" . elnode-wikiserver)
+ ("[^/]+//\\(.*\\)" . elnode-webserver)))))
+ (fakir-mock-file (fakir-file
+ :filename "index.creole"
+ :directory "/home/elnode/wiki")
+ (should
+ (equal
+ (elnode-get-targetfile :httpcon "/home/elnode/wiki")
+ "/home/elnode/wiki/index.creole"))))
+ ;; Now alter the mapping to NOT declare the mapped part...
+ (fakir-mock-process :httpcon
+ ((:elnode-http-pathinfo "/blah/thing.txt"))
+ (set-process-plist :httpcon (list (make-hash-table :test 'eq)))
+ (elnode/con-put :httpcon :elnode-http-pathinfo "/blah/thing.txt")
+ ;; ... the mapper-find should still work...
+ (should
+ (equal
+ 'elnode-webserver
+ (elnode--mapper-find :httpcon
+ "localhost//blah/thing.txt"
+ '(("[^/]+//.*" . elnode-webserver)))))
+ ;; ... but now there is no mapping so it only maps because of path-info
+ (fakir-mock-file (fakir-file
+ :filename "thing.txt"
+ :directory "/home/elnode/www/blah")
+ (should
+ (equal
+ (elnode-get-targetfile :httpcon "/home/elnode/www")
+ "/home/elnode/www/blah/thing.txt"))))
+ ;; Test without a mapping
+ (fakir-mock-process :httpcon
+ ((:elnode-http-pathinfo "/index.creole"))
+ (set-process-plist :httpcon (list (make-hash-table :test 'eq)))
+ (elnode/con-put :httpcon :elnode-http-pathinfo "/index.creole")
+ (fakir-mock-file (fakir-file
+ :filename "index.creole"
+ :directory "/home/elnode/wiki")
+ (should
+ (equal
+ (elnode-get-targetfile :httpcon "/home/elnode/wiki")
+ "/home/elnode/wiki/index.creole")))))
+
+;; This stuff is replaced by the new rle stuff
+;; (ert-deftest elnode-worker-elisp ()
+;; "Test the `elnode-worker-elisp' macro.
+;;
+;; Runs some lisp in a child Emacs and tests that it outputs the
+;; right thing."
+;; (let* ((bufname (generate-new-buffer-name "elnode-worker-elisp-test"))
+;; (buf (get-buffer-create bufname)))
+;; (elnode-wait-for-exit
+;; ;; Nice simple bit of elisp to run in the child
+;; (elnode-worker-elisp
+;; buf
+;; ((a 10)
+;; (b 20))
+;; (setq x a)
+;; (princ x)))
+;; (should
+;; (equal
+;; "10"
+;; (let ((output
+;; (with-current-buffer buf
+;; (buffer-substring (point-min) (point-max)))))
+;; (kill-buffer buf)
+;; output)))))
+
+(ert-deftest elnode-method ()
+ "A quick test for `elnode-method'."
+ (let ((httpcon :fake)
+ method)
+ (noflet ((elnode-http-method (http-con) "GET"))
+ (elnode-method httpcon
+ (GET
+ (setq method "GET"))
+ (POST
+ (set method "POST")))
+ (should (equal method "GET")))))
+
+
+(ert-deftest elnode--under-docroot-p ()
+ "Test that the docroot protection works."
+ (let ((fakir--home-root "/home/elnode"))
+ (fakir-mock-file (fakir-file
+ :filename "index.creole"
+ :directory "/home/elnode/wiki")
+
+ (should
+ (elnode--under-docroot-p
+ "/home/elnode/wiki/index.creole"
+ "~/wiki"))
+
+ (should
+ (elnode--under-docroot-p
+ "/home/elnode/wiki/index.creole"
+ "/home/elnode/wiki"))
+
+ (should-not
+ (elnode--under-docroot-p
+ "/home/elnode/wiki/blah/index.creole"
+ "/home/elnode/wiki"))
+ (should-not
+ (elnode--under-docroot-p
+ "/home/elnode/wiki/blah.creole"
+ "/home/elnode/wiki"))
+ (should-not
+ (elnode--under-docroot-p
+ "/home/elnode/wikiroot/blah.creole"
+ "/home/elnode/wiki"))
+ (should-not
+ (elnode--under-docroot-p
+ "/home/elnode/wiki/blah.creole"
+ "/home/elnode/wikiroot")))))
+
+(ert-deftest elnode-cached-p ()
+ "Is a resource cached?"
+ (fakir-mock-file (fakir-file
+ :filename "page.creole"
+ :directory "/home/elnode/wiki"
+ :mtime "Mon, Feb 27 2012 22:10:21 GMT")
+ (fakir-mock-process :httpcon ()
+ (set-process-plist :httpcon (list (make-hash-table :test 'eq)))
+ (elnode/con-put :httpcon
+ :elnode-http-header-syms
+ '((if-modified-since . "Mon, Feb 27 2012 22:10:24 GMT")))
+ (should
+ (elnode-cached-p :httpcon "/home/elnode/wiki/page.creole")))
+ ;; Test the case where there is no header
+ (fakir-mock-process :httpcon ()
+ (set-process-plist :httpcon (list (make-hash-table :test 'eq)))
+ (elnode/con-put :httpcon
+ :elnode-http-header-syms '((user-agent . "Elnode test client")))
+ (should-not
+ (elnode-cached-p :httpcon "/home/elnode/wiki/page.creole")))))
+
+(ert-deftest elnode-docroot-for ()
+ "Test the docroot protection macro."
+ (let ((httpcon :fake))
+ (noflet ((process-status (proc) 'open)
+ (elnode-send-404 (httpcon) (throw :test 404))
+ (send-200 (httpcon) (throw :test 200))
+ (elnode-send-status (httpcon status &optional msg)
+ (throw :test status)))
+ ;; Test straight through
+ (should
+ (equal
+ 200
+ (catch :test
+ (fakir-mock-process :fake ()
+ (set-process-plist :fake (list (make-hash-table :test 'eq)))
+ (elnode/con-put :fake
+ :elnode-http-pathinfo "/wiki/test.creole"
+ :elnode-http-mapping ["/wiki/test.creole" "test.creole"])
+ (fakir-mock-file
+ (fakir-file
+ :filename "test.creole"
+ :directory "/home/elnode/wikiroot")
+ (elnode-docroot-for "/home/elnode/wikiroot"
+ with target-path
+ on httpcon
+ do
+ (send-200 httpcon)))))))
+ ;; Non-existant path
+ (should
+ (equal
+ 404
+ (catch :test
+ (fakir-mock-process :fake ()
+ (set-process-plist :fake (list (make-hash-table :test 'eq)))
+ (elnode/con-put :fake
+ :elnode-http-pathinfo "/wiki/test.creole"
+ :elnode-http-mapping ["/wiki/test.creole" "test.creole"])
+ (fakir-mock-file
+ (fakir-file
+ :filename "test.creole"
+ :directory "/home/elnode/wikiroot")
+ (elnode-docroot-for "/home/elnode/wikifiles"
+ with target-path
+ on httpcon
+ do
+ (send-200 httpcon)))))))
+ ;; Test the cached check
+ (should
+ (equal
+ 304
+ (catch :test
+ (fakir-mock-process :fake ()
+ (set-process-plist :fake (list (make-hash-table :test 'eq)))
+ (elnode/con-put :fake
+ :elnode-http-pathinfo "/wiki/test.creole"
+ :elnode-http-mapping ["/wiki/test.creole" "test.creole"]
+ :elnode-http-header-syms '((if-modified-since
+ . "Mon, Feb 27 2012 22:10:24 GMT")))
+ (fakir-mock-file
+ (fakir-file
+ :filename "test.creole"
+ :directory "/home/elnode/wikiroot"
+ :mtime "Mon, Feb 27 2012 22:10:20 GMT")
+ (elnode-docroot-for "/home/elnode/wikiroot"
+ with target-path
+ on httpcon
+ do
+ (send-200 httpcon))))))))))
+
+;; (ert-deftest elnode-webserver ()
+;; (noflet ((my-dispatch (httpcon)
+;; (elnode-hostpath-dispatcher
+;; httpcon '(("[^/]*/\\(.*\\)" . elnode-webserver)))))
+;; (with-elnode-mock-server 'my-dispatch
+;; ;; Now the actual test
+;; (fakir-mock-file
+;; (fakir-file
+;; :filename "blah.html"
+;; :directory elnode-webserver-docroot-default
+;; :content "<html>Fake HTML file</html>")
+;; (unwind-protect
+;; ;; Ensure the webserver uses Emacs to open files so fakir can
+;; ;; override it.
+;; (let* ((elnode-webserver-visit-file t)
+;; ;; Turn off logging
+;; (elnode--do-error-logging nil)
+;; (elnode--do-access-logging-on-dispatch nil)
+;; ;; Make the served root the default
+;; (elnode-webserver-docroot
elnode-webserver-docroot-default))
+;; (should-elnode-response
+;; (elnode-test-call "/blah.html")
+;; :status-code 200
+;; :body-match "<html>Fake HTML file</html>"))
+;; ;; Now kill the buffer that was opened to serve the file.
+;; (if (get-buffer "blah.html")
+;; (kill-buffer "blah.html")))))))
+
+(ert-deftest elnode-client-with-stdout ()
+ "Test the stdout macro.
+
+Test that we get the right chunked encoding stuff going on."
+ (fakir-mock-process :fake ((:elnode-http-started t))
+ (set-process-plist :fake (list (make-hash-table :test 'eq)))
+ (elnode/con-put :fake :elnode-http-started t)
+ (noflet ((process-status (proc) 'open))
+ (with-stdout-to-elnode :fake (princ "hello!")))
+ (should
+ (equal
+ (let ((str "hello!"))
+ (format "%d\r\n%s\r\n0\r\n\r\n" (length str) str))
+ (with-current-buffer (fakir-get-output-buffer) (buffer-string))))))
+
+(defvar elnode-test-wrapped-handler-counter 0)
+(defvar elnode-test-wrapping-handler-counter 0)
+
+
+;; Elnode auth tests
+
+(defun elnode--auth-init-user-db (user-alist &optional db)
+ "Initialize the auth database.
+
+USER-ALIST is an assoc list of username and passwords.
+
+Optionally allow the database to be specified with DB (the
+default is `elnode-auth-db')."
+ (loop for pair in user-alist
+ do
+ (db-put
+ (car pair)
+ `(("username" . ,(car pair))
+ ("token" . ,(elnode-auth-make-hash (car pair) (cdr pair))))
+ (or db elnode-auth-db))))
+
+(ert-deftest elnode-auth-user-p ()
+ "Check the authentication check.
+
+This tests the authentication database check."
+ (let* ((elnode-auth-db (db-make '(db-hash)))
+ ;; auth test
+ (auth-test
+ (lambda (username)
+ (elnode-auth-default-test username elnode-auth-db))))
+ ;; The only time we really need clear text passwords is when
+ ;; faking records for test
+ (elnode--auth-init-user-db '(("nferrier" . "password")
+ ("someuser" . "secret")))
+ (should
+ (elnode-auth-user-p "someuser" "secret" :auth-test auth-test))))
+
+(ert-deftest elnode-auth-check-p ()
+ "Test basic login.
+
+Tess that we can login a user and then assert that they are
+authenticated."
+ (let* ((elnode-loggedin-db (make-hash-table :test 'equal))
+ (elnode-auth-db (db-make '(db-hash)))
+ ;; Make an auth-test function
+ (auth-test
+ (lambda (username)
+ (elnode-auth-default-test username elnode-auth-db))))
+ (elnode--auth-init-user-db '(("nferrier" . "password") ("someuser"
"secret")))
+ ;; Test a failure
+ (should
+ (equal "an error occured!"
+ (condition-case credentials
+ (elnode-auth-login
+ "nferrier" "secret"
+ :auth-test auth-test)
+ (elnode-auth
+ "an error occured!"))))
+
+ ;; Now test
+ (let ((hash (elnode-auth-login
+ "nferrier" "password" :auth-test auth-test)))
+ (should (elnode-auth-check-p "nferrier" hash)))))
+
+;; (ert-deftest elnode-auth-cookie-value ()
+;; (let* ((elnode-loggedin-db (make-hash-table :test 'equal)))
+;; (fakir-mock-process :httpcon ()
+;; (noflet ((elnode-auth-get-cookie-value (httpcon :cookie-name
cookie-name)
+;; (cons "nic" "blah")))
+;; (with-elnode-auth :httpcon 'marmalade-auth
+;; ;; Nil first...
+;; (should-not (elnode-auth-cookie-check :httpcon :cookie-name
"blah"))
+;; ;;; ... then the username
+;; (should
+;; (equal (elnode-auth-cookie-check :httpcon :cookie-name "blah")
+;; "nic")))))))
+
+(ert-deftest elnode-auth-cookie-check-p ()
+ "Check that a cookie can be used for auth."
+ (let* ((elnode-loggedin-db (make-hash-table :test 'equal))
+ (elnode-auth-db (db-make '(db-hash)))
+ ;; auth-test function
+ (auth-test
+ (lambda (username)
+ (elnode-auth-default-test username elnode-auth-db))))
+ ;; Fake the db data
+ (elnode--auth-init-user-db '(("nferrier" . "password") ("someuser"
"secret")))
+ ;; Now test
+ (let ((hash (elnode-auth-login "nferrier" "password" :auth-test
auth-test)))
+ (fakir-mock-process :httpcon ()
+ (set-process-plist :httpcon (list (make-hash-table :test 'eq)))
+ (elnode/con-put :httpcon
+ :elnode-http-header-syms
+ `((cookie . ,(concat "elnode-auth=nferrier::" hash))))
+ (should (elnode-auth-cookie-check-p :httpcon))))
+ ;; Test what happens without a cookie
+ (let ((hash (elnode-auth-login
+ "nferrier" "password" :auth-test auth-test)))
+ (fakir-mock-process :httpcon ()
+ (set-process-plist :httpcon (list (make-hash-table :test 'eq)))
+ (elnode/con-put :httpcon
+ :elnode-http-header-syms
+ `((referer . "http://somehost.example.com";)))
+ ;; The error should signal the cookie name
+ (should-equal
+ (condition-case token
+ (elnode-auth-cookie-check-p :httpcon)
+ (elnode-auth-token (cdr token)))
+ "elnode-auth")))))
+
+(ert-deftest elnode-auth-login-sender ()
+ "Low levelish test of the login page sender."
+ (fakir-mock-process :httpcon ()
+ (set-process-plist :httpcon (list (make-hash-table :test 'eq)))
+ (elnode/con-put :httpcon :elnode-http-started (current-time))
+ (noflet ((process-status (proc) 'open))
+ (elnode-auth-login-sender :httpcon "/login/" "/myapp/loggedin"))
+ (with-current-buffer (fakir-get-output-buffer)
+ (message "%s" (buffer-string))
+ (goto-char (point-min))
+ (should (re-search-forward
+ "<form method='POST' action='/login/'>" nil 't))
+ (should (re-search-forward
+ "<input type='hidden' name='redirect' value='/myapp/loggedin'/>"
+ nil 't)))))
+
+(defmacro elnode--auth-state (handler &rest body)
+ "A bunch of authentication state wrapped around BODY."
+ (declare (debug (sexp &rest form))
+ (indent 1))
+ `(noflet ((get-result (response)
+ (cadr (split-string (plist-get response :result-string)
"\r\n\r\n"))))
+ (let* ((elnode-auth-db (db-make '(db-hash))))
+ (elnode--auth-init-user-db '(("nferrier" . "password") ("someuser" .
"secret")))
+ (let* ((elnode--defined-authentication-schemes (make-hash-table :test
'equal))
+ (token (elnode-auth-make-hash "nferrier" "password"))
+ (auth-hash (progn
+ (elnode-defauth :if-auth-test :cookie-name
"if-auth")
+ (elnode-auth-login
+ "nferrier" "password"
+ :auth-test (lambda (username) token)))))
+ (with-elnode-mock-server ,handler
+ (progn ,@body))))))
+
+(ert-deftest elnode-if-auth ()
+ "Basic auth test testing."
+ (elnode--auth-state
+ (lambda (httpcon)
+ (elnode-http-start httpcon 200 '(Content-type . "text/plain"))
+ (let
+ ((httpconv httpcon)
+ (scheme-list
+ (gethash :if-auth-test elnode--defined-authentication-schemes)))
+ (if (eq :cookie (plist-get scheme-list :test))
+ (condition-case token
+ (let*
+ ((cookie
+ (plist-get scheme-list :cookie-name))
+ (username
+ (elnode-auth-cookie-check httpconv :cookie-name
cookie)))
+ (elnode/con-put httpconv :auth-username username)
+ (elnode-http-return httpcon "done"))
+ (elnode-auth-token
+ (progn
+ (elnode-http-return httpcon "bad"))))
+ ;; Else ...
+ (error 'elnode-not-a-cookie))))
+ ;; need one call without a cookie
+ (should
+ (assert-elnode-response
+ (let ((headers `(("Cookie" . ,(concat "if-auth=nferrier::" auth-hash)))))
+ (elnode-test-call "/" :headers headers))
+ :body-match ".*\r\n4\r\ndone\r\n0\r\n\r\n"))
+ (should
+ (assert-elnode-response
+ (let ((headers `(("Cookie" . ,(concat "if-auth=someuser::" auth-hash)))))
+ (elnode-test-call "/" :headers headers))
+ :body-match ".*\r\n3\r\nbad\r\n0\r\n\r\n"))
+ (should
+ (assert-elnode-response
+ (let ((headers `(("User-Agent" . "blah"))))
+ (elnode-test-call "/" :headers headers))
+ :body-match ".*\r\n3\r\nbad\r\n0\r\n\r\n"))))
+
+(ert-deftest elnode-with-auth ()
+ "Test protection of code with authentication.
+
+This tests that the auth protection macro does its job, including
+the wrapping of a specified handler with the login sender."
+ (elnode--auth-state
+ (lambda (httpcon)
+ (with-elnode-auth httpcon :if-auth-test
+ (elnode-http-start httpcon 200 '(Content-type . "text/plain"))
+ (elnode-http-return httpcon "done")))
+ (should
+ (assert-elnode-response
+ (let ((headers `(("User-Agent" . "blah"))))
+ (elnode-test-call "/" :headers headers))
+ :header-list '(("Location" . "/login/"))))
+ (should
+ (assert-elnode-response
+ (let ((headers `(("Cookie" . ,(concat "if-auth=nferrier::" auth-hash)))))
+ (elnode-test-call "/" :headers headers))
+ :body-match ".*\r\n4\r\ndone\r\n0\r\n\r\n"))))
+
+(ert-deftest elnode-server-info ()
+ "Test server meta data."
+ (let* ((port (elnode-find-free-service))
+ (server-info
+ (unwind-protect
+ (let (the-end)
+ (elnode-start
+ (lambda (httpcon)
+ (elnode-send-json httpcon (elnode-server-info httpcon)))
+ :port port)
+ (web-http-get
+ (lambda (con header data)
+ (setq the-end (json-read-from-string data)))
+ :port port)
+ (while (not the-end) (sit-for 1))
+ the-end)
+ (elnode-stop port))))
+ (should (equal server-info (format "127.0.0.1:%s" port)))))
+
+;; Wiki tests
+
+;; (ert-deftest elnode-wiki--setup ()
+;; "Test the wiki setup function."
+;; ;; Test that it's not called if we can't find the source file
+;; (let (called)
+;; (noflet ((make-directory (dirname &optional parents)
+;; (setq called t))
+;; ;; We fake buffer-file-name so that the wiki-index-source
+;; ;; will not be found
+;; (buffer-file-name ()
+;; "/tmp/elnode/elnode-wiki.el"))
+;; (elnode-wiki--setup)
+;; (should-not called)))
+;; ;; Test that when called we're going to copy things right
+;; (let (make-dir
+;; copy-file
+;; ;; Ensure the configurable wikiroot is set to the default
+;; (elnode-wikiserver-wikiroot elnode-wikiserver-wikiroot-default))
+;; (noflet ((make-directory (dirname &optional parents)
+;; (setq make-dir (list dirname parents)))
+;; (dired-copy-file (from to ok-flag)
+;; (setq copy-file (list from to ok-flag)))
+;; ;; Mock the source filename environment
+;; (buffer-file-name ()
+;; "/tmp/elnode--wiki-setup-test/elnode-wiki.el")
+;; (file-exists-p (filename)
+;; (equal
+;; filename
+;; "/tmp/elnode--wiki-setup-test/default-wiki-index.creole")))
+;; (elnode-wiki--setup)
+;; (should
+;; (equal
+;; (list
+;; ;; This is the dir we should make
+;; '("/home/nferrier/.emacs.d/elnode/wiki/" t)
+;; ;; This is the copy file spec
+;; '("/tmp/elnode--wiki-setup-test/default-wiki-index.creole"
+;; "/home/nferrier/.emacs.d/elnode/wiki/index.creole"
+;; nil))
+;; ;; So this is the directory that make-directory will create
+;; ;; and the copy-file spec
+;; (list make-dir copy-file))))))
+
+(ert-deftest elnode-wiki-page ()
+ "Full stack Wiki test."
+ (with-elnode-mock-server
+ ;; The dispatcher function
+ (lambda (httpcon)
+ (let ((elnode-wikiserver-wikiroot "/home/elnode/wiki"))
+ (elnode-hostpath-dispatcher
+ httpcon
+ '(("[^/]*//wiki/\\(.*\\)" . elnode-wikiserver))))) t
+ (fakir-mock-file
+ (fakir-file
+ :filename "test.creole"
+ :directory "/home/elnode/wiki"
+ :content "= Hello World =\nthis is a creole wiki file!\n")
+ (let* ((elnode--do-error-logging nil)
+ (elnode--do-access-logging-on-dispatch nil))
+ (should-elnode-response
+ (elnode-test-call "/wiki/test.creole")
+ :status-code 200
+ :body-match ".*<h1>Hello World</h1>.*")))))
+
+
+;;; Some new testing constructs
+
+(ert-deftest elnode-fake-params ()
+ "Testing faking the parameters."
+ (should
+ (equal
+ (elnode-fake-params :httpcon '(("a" . "10"))
+ (elnode-http-param :httpcon "a"))
+ "10"))
+ ;; And with a file property
+ (should
+ (equal
+ (elnode-fake-params
+ :httpcon '(("a" "10" :elnode-filename "file"))
+ (get-text-property
+ 0 :elnode-filename
+ (elnode-http-param :httpcon "a")))
+ "file")))
+
+(ert-deftest elnode-server-info ()
+ "Test the server info stuff."
+ (noflet ((fake-server-ip ()
+ (let (remote)
+ (elnode-start
+ (lambda (httpcon)
+ (setq
+ remote (elnode-server-info httpcon))
+ (elnode-send-400 httpcon))
+ :port 5999)
+ (web-http-get
+ (lambda (httpc hdr data) (elnode-stop 5999))
+ :url "http://localhost:5999";)
+ (sleep-for 1)
+ remote)))
+ (should (equal (fake-server-ip) "127.0.0.1:5999"))))
+
+(ert-deftest elnode-proxy-post ()
+ "Test making a proxy-call back to the server."
+ (noflet ((proxy-post ()
+ (let (remote)
+ (elnode-start
+ (lambda (httpcon)
+ (if (equal
+ (elnode-http-pathinfo httpcon)
+ "/ping/")
+ (elnode-send-status httpcon 201)
+ ;; Else send the internal call
+ (elnode-proxy-post
+ httpcon "/ping/"
+ :callback (lambda (httpc hdr data)
+ (setq remote data)))
+ (elnode-send-status httpcon 200)))
+ :port 5999)
+ (web-http-get
+ (lambda (httpc hdr data) (elnode-stop 5999))
+ :url "http://localhost:5999";)
+ (sleep-for 1)
+ remote)))
+ (should (equal (proxy-post) "<h1>Created</h1>\r\n"))))
+
+(ert-deftest elnode-make-proxy ()
+ "Test the proxy stuff."
+ (let* ((html '("<html><h1>hello!</h1>"
+ "<a id=\"100\"><h2>world!</h2>"
+ "</html>"))
+ (hdr (kvacons :status-code "200"
+ :status "Ok"
+ :content-type "text/html"
+ :content-length (format "%d" (length html))))
+ (hdr-hash (kvalist->hash hdr)))
+ (noflet ((web-http-call (method callback
+ :mode mode
+ :url url
+ :extra-headers headers)
+ ;; Serve element after element of the html list
+ (dolist (data html)
+ (funcall callback :httpcon hdr-hash data))
+ (funcall callback :httpcon hdr-hash :done))
+ (elnode-http-method (httpcon) "GET")
+ (elnode-http-pathinfo (httpcon) "/test/one")
+ (elnode-http-params (httpcon) '(("x" . "1")))
+ (elnode-get-remote-ipaddr (httpcon) "127.0.0.1:8000")
+ (elnode-http-header (httpcon name) nil))
+ (let* ((proxy-handler (elnode-make-proxy "http://some/place";))
+ (result
+ (elnode-sink :httpcon
+ (fakir-mock-proc-properties :httpcon
+ (funcall proxy-handler :httpcon)))))
+ ;; Test that the result is the same as the doc that the web call served
+ (should (equal result (s-join "" html)))
+ ;; FIXME - we should probably also check that the
+ ;; :elnode-child-process property has been added to the
+ ;; :httpcon
+ (should
+ (equal
+ (get-text-property 0 :content-type result)
+ "text/html"))))))
+
+(provide 'elnode-tests)
+
+;;; elnode-tests.el ends here
diff --git a/tests/elnode/creole.el b/tests/elnode/creole.el
new file mode 100644
index 0000000..8fb7fef
--- /dev/null
+++ b/tests/elnode/creole.el
@@ -0,0 +1,1883 @@
+;;; creole.el --- A parser for the Creole Wiki language
+
+;;; Copyright (C) 2011, 2012 by Nic Ferrier
+
+;; Author: Nic Ferrier <nferrier@ferrier.me.uk>
+;; Maintainer: Nic Ferrier <nferrier@ferrier.me.uk>
+;; Created: 27th October 2011
+;; Version: 20140705.414
+;; X-Original-Version: 1.0.5
+;; Package-requires: ((noflet "0.0.3")(kv "0.0.17"))
+;; Keywords: lisp, creole, wiki
+
+;; 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 this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This is a WikiCreole wiki parser. WikiCreole is something like the
+;; Wiki language used by OddMuse, which is the EmacsWiki wiki
+;; language.
+
+;; This parser now includes extra support to help deal with OddMuse
+;; files.
+
+;; This code was originally written to mark the death of John McCarthy
+;; - http://news.ycombinator.com/item?id=3151988
+
+;; WikiCreole is an emerging standard documented at:
+;; http://www.wikicreole.org/wiki/Creole1.0
+
+;;; Code:
+
+(require 'htmlfontify)
+(require 'org-table)
+(require 'calc)
+(require 'rx)
+(require 'noflet)
+(require 'cl)
+(require 'kv)
+
+(defmacro when1 (expr &rest body)
+ "Evaluate BODY when EXPR but return EXPR."
+ (declare (debug (form &rest form))
+ (indent 1))
+ (let ((expr-val (make-symbol "expr-val")))
+ `(let ((,expr-val ,expr))
+ (when ,expr-val
+ ,@body)
+ ,expr-val)))
+
+(defgroup creole nil
+ "A WikiCreole parser and associated tools."
+ :group 'hypertext)
+
+(defvar creole-oddmuse-on nil
+ "Whether creole should include OddMuse compatability.
+
+OddMuse is the Wiki language used by the EmacsWiki. It is very
+nearly WikiCreole but not quite. Hence this flag which turns on
+various small tweaks in behaviour.")
+
+(defvar creole-link-resolver-fn nil
+ "The function which will resolve links.
+
+Resolving a link is necessary for links without context such as:
+
+ [thing]
+
+or a link formed by CamelCaps.
+
+By default there is no link resolver and these links are not
+resolved.")
+
+(defun creole/link-resolve (name)
+ "A simple creole link resolver.
+
+Resolve the link by looking in the current directory for a
+.creole file that matches the name.
+
+A note for Wiki implementors: This is not a good implementation
+for a web app since it exposes the extensions and does not
+prepend a URL. If you use a resolver to prepend the url then you
+may as well resolve the extension in the webapp."
+ (let ((candidates
+ (directory-files
+ default-directory
+ nil (concat name ".creole"))))
+ (if (and (listp candidates)
+ (car-safe candidates))
+ (car candidates)
+ name)))
+
+(defun creole/link-replacer (m)
+ "Replace regexp replacer for `creole-link'."
+ (apply
+ 'format
+ "<a href='%s'>%s</a>"
+ (cond
+ ;; We have both a url and a link
+ ((match-string 4 m)
+ (let ((link (match-string 1 m))
+ (text (match-string 5 m)))
+ (list
+ (if (and (not (string-match-p (rx (or "ftp" "http" "mailto") ":")
link))
+ (functionp creole-link-resolver-fn))
+ (funcall creole-link-resolver-fn link) link) text)))
+ ;; We only have a url
+ ((match-string 1 m)
+ (let ((link (match-string 1 m)))
+ (list
+ (if (and (not (string-match-p (rx (or "ftp" "http" "mailto") ":")
link))
+ (functionp creole-link-resolver-fn))
+ (funcall creole-link-resolver-fn link) link)
+ link))))))
+
+(defun creole-link-parse (text)
+ "Parse TEXT for creole links.
+
+If `creole-oddmuse-on' is t then OddMuse links (that do not start
+with '!') will be parsed as well. OddMuse links are single
+bracket links, like:
+
+ [ThisIsOddMuse]
+
+If `creole-link-resolver-fn' is non-nil and a function then all
+single element links are passed through it. This variable also
+turns on CamelCase linking."
+ (if (and creole-oddmuse-on (string-match-p (rx bol "!") text))
+ (replace-regexp-in-string (rx bol "!") "" text t)
+ ;; Else it's not an escaped link
+ (let* ((resolvable-link
+ (if (functionp creole-link-resolver-fn)
+ (let* ((case-fold-search nil)) ; do CamelCaps links
+ (replace-regexp-in-string
+ (rx
+ (or buffer-start bol bos)
+ (group
+ (? (not (any "[")))
+ (group
+ (>= 2 (and (any upper)
+ (one-or-more (any lower)))))))
+ (lambda (m)
+ (let ((link (match-string 1 m)))
+ (format
+ "<a href='%s'>%s</a>"
+ (funcall creole-link-resolver-fn link)
+ link)))
+ text t))
+ ;; Else just use the text
+ text))
+ (real-creole
+ (replace-regexp-in-string
+ (rx "[["
+ (group
+ (* (group (or "ftp" "http" "mailto") ":"))
+ (+ (not (any "]|"))))
+ (*
+ (group
+ "|" (group (group (+ (not (any "]")))))))
+ "]]")
+ 'creole/link-replacer
+ resolvable-link))
+ (oddmuse
+ (when creole-oddmuse-on
+ (replace-regexp-in-string
+ (rx "["
+ (group
+ (* (group (and (+ (in alpha))) ":"))
+ (+ (not (any "]| "))))
+ (* (group
+ (any "| ")
+ (group (group (+ (not (any ?\])))))))
+ "]")
+ 'creole/link-replacer
+ real-creole)))
+ (bracket-resolved (if oddmuse oddmuse real-creole)))
+ bracket-resolved)))
+
+(defvar creole-image-class nil
+ "A default class to be applied to wiki linked images.")
+
+(defun creole/image->html (m)
+ "Convert image urls to HTML."
+ (let (title)
+ (apply
+ 'format
+ (append
+ '("<img %ssrc=\"%s\" alt=\"%s\" %s%s></img>")
+ (list
+ ;; Whether we have a class to apply or not
+ (if creole-image-class (format "class=\"%s\" " creole-image-class) "")
+ ;; URL of the image
+ (if (functionp creole-link-resolver-fn)
+ (funcall creole-link-resolver-fn (match-string 1 m))
+ ;; Else
+ (match-string 1 m))
+ ;; if we don't have an alternate, use the URL
+ (if (match-string 4 m)
+ (setq title (match-string 5 m))
+ (match-string 1 m))
+ ;; title
+ (if title (format "title=\"%s\" " title) "")
+ ;; Match only the size part for now
+ (if (match-string 2 m)
+ (let ((options (match-string 3 m)))
+ (save-match-data
+ ;; 'size=' is optional and is the only parameter right now
+ (string-match
+ (rx (group (+ digit))
+ (? (group (and ?x (group (+ digit))))))
+ options)
+ (when (match-string 1 options)
+ (concat
+ (format
+ "width=\"%s\" " (match-string 1 options))
+ (when (match-string 2 options)
+ (format "height=\"%s\" " (match-string 3 options)))))))
+ ""))))))
+
+(defun creole-include-handler (match-data scheme path)
+ "Embed handler to handle \"include:file\" embeds.
+
+Add this to `creole-embed-hanndlers' (for example, for scheme
+\"include\") to support creole includes, for example:
+
+ = A document =
+ {{include:somecreolefile}}
+
+allows \"somecreolefile\" to be HTML rendered and embedded in the
+output of the main document.
+
+If `creole-link-resolver' is defined then link resolution is
+performed on PATH before loading.
+
+`creole-html' is used to render the HTML for the included file."
+ (let* ((file-path (if (functionp creole-link-resolver-fn)
+ (funcall creole-link-resolver-fn path)
+ ;; Else just the path
+ path)))
+ (with-temp-buffer
+ (insert-file-contents-literally file-path)
+ (let ((creole-buffer (current-buffer)))
+ (with-temp-buffer
+ (creole-html creole-buffer (current-buffer) :erase-existing t)
+ (buffer-string))))))
+
+(defvar creole-youtube-handler-width 420
+ "The width that will be used for youtube videos.
+
+Note that not all widths are possible.")
+
+(defvar creole-youtube-handler-height 315
+ "The height that will be used for youtube videos.
+
+Note that not all heights are possible.")
+
+(defun creole-youtube-handler (m scheme path)
+ "Handle \"youtube\" scheme, turning it into an HTML embed.
+
+This creole:
+
+ {{youtube:WcUwCsAhWMk|a nice video on emacs-lisp}}
+
+will produce this HTML:
+
+ <span class=\"youtube\">
+ <iframe src=\"//www.youtube.com/embed/WcUwCsAhWMk\"
+ width=\"420\" height=\"315\"
+ frameborder=\"0\" allowfullscreen></iframe>
+ <em>a nice video on emacs-lisp</em>
+ </span>
+
+The link resolver is not consulted to resolve the link."
+ ;; Just the youtube iframe thing
+ (format "<span class=\"youtube\"><iframe src=\"//www.youtube.com/embed/%s\"
+width=\"%s\" height=\"%s\"
+frameborder=\"0\" allowfullscreen></iframe>
+%s
+</span>" path creole-youtube-handler-width creole-youtube-handler-height
+(if (match-string 4 m)
+ (format "<em>%s</em>" (match-string 5 m))
+ "")))
+
+(defvar creole-summary-resolver nil
+ "Optional resolver function for article links from summaries.
+
+If set to a function of one argument, this is used by
+`creole-summary-handler' to resolve the path to the summary
+article into an article path.")
+
+(defun creole-summary-handler (m scheme path)
+ "Embed handler to handle \"summary:file\" embeds.
+
+Using this will let you pull in the first para of an article."
+ ;; This is not a very good summary handler
+ ;;
+ ;; what is SHOULD do is to take the elements up to and including the
+ ;; first para and then throw everything else away.
+ (let* ((file-path (if (functionp creole-link-resolver-fn)
+ (funcall creole-link-resolver-fn path)
+ ;; Else just the path
+ path)))
+ (with-temp-buffer
+ (insert-file-contents-literally file-path)
+ (let* ((creole-buffer (current-buffer))
+ ;; We could cache the creole-structure?
+ (struct
+ (creole-structure (creole-tokenize creole-buffer)))
+ ;; cdar expects a para...need to change that
+ (summary (cdar struct))
+ (decorated (format "%s [[%s|... read more]]"
+ summary
+ path)))
+ (with-temp-buffer
+ (insert
+ (let ((creole-link-resolver-fn
+ (lambda (path)
+ (if (functionp creole-summary-resolver)
+ (funcall creole-summary-resolver path)
+ path))))
+ (creole-block-parse decorated)))
+ (buffer-string))))))
+
+
+(defvar creole-embed-handlers nil
+ "An a-list of scheme . handler-function pairs for handling embeds.
+
+The image syntax can be used to handle generic embedding, turning
+a URL into some generic output code. Each url scheme that can be
+used to do that must be registered here.
+
+For example: youtube:TR7DPvEi7Jg could be returned as the embed
+HTML for that specific youtube video.
+
+Handlers should expect three arguments: the match data (as passed
+to `creole-image-resolve') and then the scheme and the path (the
+non-scheme part of the url).")
+
+(defun creole-image-resolve (m)
+ "Resolve M, a match object, into HTML.
+
+M comes from `creole-image-parse' and has the following groups:
+
+ 1 the url part
+ 2 the query part with the leading \"?\"
+ 3 the query part without the \"?\"
+ 4 the description part with the leading \"|\"
+ 5 the description part without the leading \"|\"
+
+The resolution uses `creole-embed-handlers' to attach handling
+logic to urls via url schemes.
+
+If no handler is found the embed is presumed to be an image and
+passed to `creole/image->html'."
+ (let ((md (match-data)))
+ ;; Match the url part for a scheme
+ (noflet ((matches (regex to-match)
+ (save-match-data
+ (when (string-match regex to-match)
+ (loop for i from 0 to (- (/ (length (match-data)) 2) 1)
+ collect (match-string i to-match))))))
+ (let ((url (match-string 1 m)))
+ (destructuring-bind (&optional url scheme path)
+ (matches
+ (rx (group (+ (any "A-Za-z"))) ":"
+ (group (+ anything)))
+ url)
+ ;; I do this because save-match-data doesn't seem to work.
+ (set-match-data md)
+ ;; Find whether we have a specific handler for scheme and then
+ ;; pass it path
+ (let ((handler-fn (kva scheme creole-embed-handlers)))
+ (if (functionp handler-fn)
+ (save-match-data
+ (funcall handler-fn m scheme path))
+ ;; Else just call the image handler
+ (creole/image->html m))))))))
+
+(defun creole-image-parse (text)
+ "Parse TEXT for creole images.
+
+Images should have this format:
+
+{{image.jpg?size=50x100|description}}
+
+where the size and description is optional, and the second
+dimension in size can be omitted.
+
+The 'size=' is optional, and I keep there because this way you
+could add more parameters to the image if you needed them. By
+now, a size is supposed, and the values are assumed to be either
+a Width, or a WidthxHeight specification.
+
+If defined then `creole-link-resolver-fn' is used for links."
+ (replace-regexp-in-string
+ (rx "{{"
+ (group (+ (not (any "?|}"))))
+ (* (group "?" (group (+ (not (any "?|}"))))))
+ (? (group "|" (group (+ (not (any "}"))))))
+ "}}")
+ 'creole-image-resolve
+ text))
+
+(defun creole-block-parse (text)
+ "Parses TEXT as a creole block.
+
+A creole block is a paragraph or list item that can include
+links, italic, bold, line break or inline preformatted markup.
+
+Returns a copy of TEXT with the WikiCreole replaced with
+appropriate HTML."
+ (let ((transformed
+ (replace-regexp-in-string
+ (rx "**"
+ (group (*? anything))
+ "**")
+ "<strong>\\1</strong>"
+ (replace-regexp-in-string
+ (rx (group (not (any ":")))
+ "//"
+ (group (*? anything) (not (any ":")))
+ "//")
+ "\\1<em>\\2</em>"
+ (replace-regexp-in-string
+ (rx bol
+ "//"
+ (group (*? anything) (not (any ":")))
+ "//")
+ "<em>\\1</em>"
+ (replace-regexp-in-string
+ (rx "{{{"
+ (group (*? anything))
+ "}}}")
+ "<code>\\1</code>"
+ (replace-regexp-in-string
+ (rx ?\\)
+ "<br/>"
+ text)))))))
+ (if creole-oddmuse-on
+ (creole-image-parse
+ (creole-link-parse
+ (replace-regexp-in-string
+ (rx "'''"
+ (group (*? not-newline))
+ "'''")
+ "<em>\\1</em>"
+ (replace-regexp-in-string
+ (rx "##"
+ (group (*? not-newline))
+ "##")
+ "<code>\\1</code>"
+ transformed))))
+ ;; Else
+ (creole-image-parse (creole-link-parse transformed)))))
+
+(defvar creole-recalculate-org-tables t
+ "Indicates that Org tables should be recalculated inplace.
+
+Table calculation is performed calling
+`org-table-recalculate'. The default value is to recalculate the
+tables. However, this leaves the original buffer modified. If you
+don't want the original buffer modified, or you don't have
+formulas in your tables (so recalculation is not necessary), you
+can change this value to nil.")
+
+(defun creole/org-table-row-parser (row-text)
+ "Split an org-table row into a list of cells."
+ (noflet ((last-pos (text) ;; find the last |
+ (string-match "|[ \n]*$" text)))
+ (let* ((pairs (list (cons "//" "//")
+ (cons "{{" "}}")
+ (cons "[[" "]]")))
+ (cellstart 1)
+ (pt cellstart)
+ lst)
+ (catch :escape
+ (while t
+ (if (< pt (last-pos row-text))
+ (let* ((cell (substring row-text pt))
+ (delim-pos (string-match
+ (rx (group
+ (or "//" "{{" "[[" "|")))
+ cell))
+ (delim (match-string 1 cell)))
+ (if (equal delim "|")
+ (progn
+ (push
+ (substring row-text cellstart
+ (+ pt delim-pos))
+ lst)
+ (setq pt (setq cellstart (+ pt delim-pos 1))))
+ ;; else it's got some formatting so skip it whatever it is
+ (let* ((start (+ delim-pos (length delim)))
+ (delim-end (kva delim pairs))
+ (end (string-match
+ (rx-to-string `(and ,delim-end) t)
+ (substring cell start))))
+ ;; and add it to l to find end point
+ ;; and then search again
+ (setq pt (+ pt (+ start end (length delim-end)))))))
+ ;; Else
+ (unless (equal cellstart pt)
+ (push (substring row-text cellstart pt) lst))
+ (throw :escape (reverse lst))))))))
+
+(defun creole/org-table-to-lisp (&optional txt)
+ "Convert the table at point to a Lisp structure.
+
+Replaces `org-table-to-lisp' with something that handles cells
+for creole better since a cell with a link in it would fail
+otherwise because creole uses the | as a link separator."
+ (unless txt
+ (unless (org-at-table-p)
+ (user-error "No table at point")))
+ (let* ((txt (or txt
+ (buffer-substring-no-properties
+ (org-table-begin)
+ (org-table-end))))
+ (lines (org-split-string txt "[ \t]*\n[ \t]*")))
+ (mapcar
+ (lambda (x)
+ (if (string-match org-table-hline-regexp x)
+ 'hline
+ (creole/org-table-row-parser x)))
+ lines)))
+
+(defun creole-tokenize (docbuf)
+ "Parse DOCBUF which is full of creole wiki text.
+
+See http://www.wikicreole.org/wiki/Creole1.0 for more information
+on WikiCreole.
+
+Returns a list of parsed elements."
+ (with-current-buffer docbuf
+ (save-excursion
+ (goto-char (point-min))
+ (let ((res '()))
+ (while (not (eobp))
+ (cond
+ (;; Heading
+ (looking-at
+ (rx bol
+ (group (+ "="))
+ (in blank)))
+ (let ((level (length (match-string 1))))
+ ;; Actually, the end = is optional... not sure if, when
+ ;; there is an end = it has to be the same number as the
+ ;; first one
+ (if (not
+ (re-search-forward
+ (rx bol
+ (group (+ "="))
+ (+ blank)
+ (group (* any))
+ (+ blank)
+ (group (+ "="))
+ eol)
+ nil 't))
+ (error "Creole: badly formatted heading"))
+ (when (equal (length (match-string 3))
+ level)
+ (setq res (append res
+ (list
+ (cons
+ (intern (format "heading%s" level))
+ ;; The string that is the heading
+ ;; - any internal rules we should
+ ;; deal with here
+ (match-string 2)))))
+ (forward-line))))
+ (;; OddMuse portraits
+ (and creole-oddmuse-on (looking-at
+ (rx bol "portrait:" (group (* any)))))
+ (setq res (append res (list (cons 'portrait (match-string 1)))))
+ (forward-line))
+ (;; Table
+ (looking-at "^|")
+ ;; Recalculate tables?
+ (when creole-recalculate-org-tables
+ ;; Requires that we're back in the table
+ (org-table-recalculate t))
+ (let* ((tbl (creole/org-table-to-lisp))
+ (pt (org-table-end)))
+ (setq res (append
+ res
+ (list
+ (cons 'table tbl))))
+ (goto-char pt)
+ ;; Skip forward over any org-tbl comments
+ (unless (re-search-forward "^[^#]" nil t)
+ (goto-char (point-max)))
+ (beginning-of-line)))
+ (;; Unordered list item
+ (looking-at
+ (rx bol
+ (group (+ "*"))
+ (in blank)
+ (group (* any))))
+ (let ((level (length (match-string 1))))
+ (setq res (append res
+ (list
+ (cons
+ (intern (format "ul%s" level))
+ ;; The string that is the heading
+ ;; - any internal rules we should
+ ;; deal with here
+ (match-string 2)))))
+ (forward-line)))
+ (;; Ordered list item
+ (looking-at
+ (rx bol
+ (group (+ "#"))
+ (in blank)
+ (group (* any))))
+ (let ((level (length (match-string 1))))
+ (setq res (append res
+ (list
+ (cons
+ (intern (format "ol%s" level))
+ ;; The string that is the heading
+ ;; - any internal rules we should
+ ;; deal with here
+ (match-string 2)))))
+ (forward-line)))
+ (;; Horizontal rule
+ (looking-at
+ (rx bol
+ (* (in blank))
+ "----"
+ (* (in blank))
+ eol))
+ (setq res (append res
+ (list
+ (cons 'hr ""))))
+ (forward-line))
+ (;; Pre-formatted block
+ (looking-at
+ (rx bol "\n{{{" eol))
+ (if (not
+ (re-search-forward
+ (rx bol
+ "\n{{{\n"
+ (group (*? anything))
+ "\n}}}" (* space)
+ eol)
+ nil t))
+ (error "Creole: bad preformatted block"))
+ (setq res (append res
+ (list
+ (cons 'preformatted (match-string 1)))))
+ (forward-line))
+ ((and creole-oddmuse-on (looking-at "^\n +[^-]"))
+ (let* ((start (point))
+ (end (progn (next-line)
+ (re-search-forward "^$" nil t)))
+ (str (buffer-substring start end)))
+ (setq res (append res (list (cons 'preformatted str))))
+ (goto-char end)))
+ (;; Lisp-plugin
+ (or (looking-at (rx bol "\n" "<<(" eol))
+ (and (looking-at "^<<(")
+ (when1 (save-excursion
+ (previous-line)
+ (looking-at (rx bol "\n" "<<(")))
+ (previous-line))))
+ (if (not
+ (re-search-forward
+ (rx bol
+ "\n"
+ "<<("
+ "\n"
+ (group (*? anything))
+ "\n"
+ ")>>"
+ (* space)
+ eol)
+ nil t))
+ (error "Creole: bad Lisp plugin block"))
+ (let* ((plugin-lisp (match-string 1))
+ (value (eval (car (read-from-string plugin-lisp))))
+ (plugin-fragment (with-temp-buffer
+ (insert value)
+ (creole-tokenize (current-buffer)))))
+ (setq res (append res plugin-fragment)))
+ (forward-line))
+ (;; HTML-plugin
+ (or (looking-at "^\n<<html\n")
+ (and
+ (looking-at "<<html\n")
+ (when1
+ (save-excursion
+ (previous-line)
+ (looking-at "\n<<html\n"))
+ (previous-line))))
+ (if (not
+ (re-search-forward
+ (rx bol
+ "\n"
+ "<<html"
+ "\n"
+ (group-n 1 (*? anything))
+ "\n"
+ "html>>"
+ eol) nil t))
+ (error "Creole: bad HTML plugin block"))
+ (setq res (append res
+ (list
+ (cons 'plugin-html (match-string 1)))))
+ (forward-line))
+ (;; Paragraph line
+ (and (looking-at (rx bol (not (any "=*"))))
+ (not (looking-at (rx bol "<<html")))
+ (not (looking-at (rx bol eol))))
+ (let* ((start (point))
+ (end
+ (save-match-data
+ (let* ((matched-end
+ ;; Find the end - the end is actually BEFORE
this
+ (re-search-forward
+ (rx (or (group bol eol)
+ (group bol (in "=*"))
+ (group eol "\nhtml>>\n")))
+ nil 't))
+ (matched (if matched-end (match-string 0))))
+ (cond
+ ((equal matched "") (- matched-end 1))
+ ((equal matched "*") (- matched-end 2))
+ ((equal matched "=") (- matched-end 2))
+ ((equal matched "\n<<html") (- matched-end 8))
+ (t
+ (point-max)))))))
+ (setq res
+ (append
+ res
+ (list
+ (cons 'para (buffer-substring start end)))))
+ (goto-char end)))
+ ('t
+ (forward-line))))
+ res))))
+
+(defun creole/test-doc (buffer)
+ "Insert a test document of creole text into BUFFER."
+ (with-current-buffer buffer
+ (insert "= Heading! =\n")
+ (insert "\n")
+ (insert "== Heading2! ==\n")
+ (insert "# an ordered list item\n## a 2nd ordered list item\n")
+ (insert "== Heading3 is a multi word heading ==\n")
+ (insert "\n{{{\n== this is preformatted ==\n{{\nIt looks great\n}}\n}}}\n")
+ (insert "* list item\n** 2nd list item\n*** 3rd list item\n")
+ (insert "** another 2nd list item\n*** another 3rd list item\n")
+ (insert " ----\n")
+ (insert "This is a paragraph
+that runs over several lines
+* and a list item stops it
+")
+ (insert "This is a paragraph {{{with code}}} and [[links]]
+and **bold** and //italics//.")))
+
+(defun creole/list-item (list-symbol)
+ "Return the type and the level of the LIST-SYMBOL.
+
+For example:
+
+ (creole/list-item 'ol1)
+ => (ordered . 1)
+
+ (creole/list-item 'ul10)
+ => (unordered . 10)"
+ (save-match-data
+ (let ((s (symbol-name list-symbol)))
+ (when (string-match (rx (group (in "uo") "l")
+ (group (+ digit)))
+ s)
+ (cons
+ (intern (match-string 1 s))
+ (string-to-number (match-string 2 s)))))))
+
+(defun creole-structure (lst)
+ "Make a parsed structure from a list.
+
+This is a parser, of sorts, in that it turns a list of tokens
+into more of a tree structure. In WikiCreole though, the only
+thing that really needs a tree representation is ordered and
+unordered lists, so all this function does is add structure to a
+stream of list tokens. All other tokens are passed through
+directly.
+
+This is not marked private because it does form part of what
+might be called the parsing API of this creole library."
+ (let* ((docptr lst)
+ (state '()) ; used as a stack
+ (result '()))
+ (while docptr
+ (let* ((token (car docptr))
+ (lst-item (creole/list-item (car token))))
+ (case (if lst-item 'listitem (car token))
+ (listitem
+ (let* ((last (if (car state) (cdar state)))
+ (last-level (if (car state) (caar state)))
+ (new (list (car lst-item) (cdr token))))
+ (cond
+ ;; Current level is higher than the last, embed a new list
+ ((and last
+ (> (cdr lst-item) last-level))
+ (setcdr last (append (cdr last) (list new)))
+ ;; Update the stack
+ (push (cons (cdr lst-item) new) state))
+ ;; Current level is same as the last, extend the last list
+ ((and last
+ (= (cdr lst-item) last-level))
+ (setq new (list (cdr token)))
+ (setcdr last (append (cdr last) new))
+ ;; Reset the top of the stack
+ (pop state)
+ (push (cons (cdr lst-item) new) state))
+ ;; Current level is same as the last, extend the last list
+ ((and last
+ (< (cdr lst-item) last-level))
+ (loop for i from 1 to (- last-level (cdr lst-item))
+ do (pop state))
+ (let* ((last (if (car state) (cdar state)))
+ (last-level (if (car state) (caar state))))
+ (setq new (list (cdr token)))
+ (setcdr last (append (cdr last) new))))
+ ;; The default action when we're dealing with lists
+ (t
+ (setq result (append result (list new)))
+ ;; Update the stack
+ (push (cons (cdr lst-item) new) state)))))
+ ;; Not a list item - just push it onto the result, always
+ ;; empty the list state
+ (t
+ (setq state '())
+ (setq result (append result (list token))))))
+ (setq docptr (cdr docptr)))
+ result))
+
+;; Exporting functions
+
+(defun creole/html-list (type lst)
+ "Export the specified LST in HTML.
+
+The exported HTML is written into the current buffer.
+
+This is NOT intended to be used by anything but
+`creole-export-html'."
+ (let ((first t))
+ (insert "<" (symbol-name type) ">\n")
+ (loop for item in lst
+ do
+ (cond
+ ((listp item)
+ (creole/html-list (car item) (cdr item))
+ (setq first nil))
+ (t
+ (when (not first)
+ (insert "</li>\n"))
+ (setq first nil)
+ (insert "<li>")
+ (insert (creole-block-parse item)))))
+ (insert "</li>\n")
+ (insert "</" (symbol-name type) ">\n")))
+
+(defun creole/html-table (table-list)
+ "Convert the org-table structure TABLE-LIST to HTML.
+
+We use `orgtbl-to-generic' to do this."
+ (let ((value
+ (orgtbl-to-generic
+ table-list
+ (list
+ :tstart "<table>"
+ :tend "</table>\n"
+ :hlstart "<thead><tr>\n"
+ :hlend "</tr></thead>"
+ :hllstart "<thead><tr>\n"
+ :hllend "</tr></thead>"
+ :lstart "<tr>\n"
+ :lend "</tr>"
+ :hline nil
+ :hfmt (lambda (field)
+ ;; Where we do block formatting
+ (format
+ "<th>%s</th>\n"
+ (creole-block-parse field)))
+ :fmt (lambda (field)
+ ;; Where we do block formatting
+ (format
+ "<td>%s</td>\n"
+ (creole-block-parse field)))
+ ))))
+ value))
+
+(defun creole-htmlize/mode-func (text)
+ "Work out the mode function for TEXT.
+
+A list is returned. The first element is whether the first line
+of the text should be stripped or not (if forcing marker text is
+used that should be the case). The `cdr' of the cons is the
+Emacs mode function to use to color the text. This either uses
+some heuristics or a specific instruction at the start of the
+text:
+
+ ##! C
+ int main(char** argv, int argc)
+ {
+ return 0;
+ }
+
+Shows how to indicate some C.
+
+The heuristics are very simple right now. They will probably
+change to something heavily based on existing mode choosing
+logic."
+ (save-match-data
+ (cond
+ ((string-match (rx bol "##! "
+ (group (* any))
+ "\n")
+ text)
+ (list
+ t
+ (intern
+ (concat
+ (or (match-string 1 text)
+ (downcase mode-name))
+ "-mode"))))
+ ((string-match-p (rx bol (or (group ";;" (* ";") " " (* any)) "(")) text)
+ ;; It's lisp
+ (list nil (if (string-match-p (rx bol (* any) " -*- " (* any)) text)
+ 'emacs-lisp-mode
+ 'lisp-mode)))
+ ((string-match-p (rx bol "#!/bin/" (+ lower) "sh" eol) text)
+ (list nil 'shell-script-mode))
+ (t (list nil text)))))
+
+(defun creole-htmlize-string (text)
+ "Make TEXT syntax coloured HTML using Emacs font-lock.
+
+The syntax coloring to use is decided by `creole-htmlize/mode-func'.
+
+A string containing the HTML syntax coloured with
+`font-lock-fontify-buffer' and `htmlfontify' is returned.
+
+If called interactively the current region is used as the string
+and the result buffer is left open and switched to.
+
+A property `:css-list' attached to the returned string contains
+the list of CSS declarations generated by `htmlfontify'. The
+list can be turned into CSS by `creole-css-list-to-style-decl'.
+
+Unfortunately, when run in batch mode Emacs doesn't attach colors
+to faces and so we don't get coloured styles. It should be
+possible to use the `cadr' of the style to add colors."
+ (interactive
+ (list
+ (if (mark)
+ (buffer-substring
+ (region-beginning)
+ (region-end))
+ (buffer-substring
+ (point-min)
+ (point-max)))))
+ (destructuring-bind (strip-line mode-func) (creole-htmlize/mode-func text)
+ (save-match-data
+ (if (not (functionp mode-func))
+ (concat "<pre>\n" text "\n</pre>")
+ (with-temp-buffer
+ ;; Get font-lock?
+ (insert text "\n")
+ (when strip-line
+ ;; Kill the mode variable line
+ (goto-char (point-min))
+ (kill-line))
+ ;; Now switch that mode into the new mode
+ (funcall mode-func)
+ (whitespace-mode -1)
+ (font-lock-fontify-buffer)
+ ;; Do some dynamic binding magic to alter htmlfontify
+ ;; behaviour - no header, no footer and the styles list is
+ ;; captured rather than written out.
+ (let (css-list)
+ (noflet ((hfy-sprintf-stylesheet
+ (css file)
+ (setq css-list css)
+ ""))
+ (let ((hfy-display-class '((type x-toolkit)))
+ (hfy-page-footer (lambda (&optional file-name) "" "")))
+ (let (result
+ (htmlbuf
+ (noflet
+ ((message (format-str &rest args) t)) ;
htmlfontify has annoying messages in it.
+ (htmlfontify-buffer))))
+ (with-current-buffer htmlbuf
+ ;; FIXME we should add another property
+ ;; detailing which mode we're dealing with-
+ ;;
+ ;; We MAY want to disambiguate styles, like
+ ;; "keyword" into "pre.emacs-lisp span.keyword"
+ (put-text-property
+ (point-min) (point-max)
+ :css-list css-list)
+ (setq
+ result
+ (buffer-substring
+ (point-min)
+ (point-max))))
+ (if (called-interactively-p 'interactive)
+ (switch-to-buffer htmlbuf)
+ (with-current-buffer htmlbuf
+ (set-buffer-modified-p nil))
+ (kill-buffer htmlbuf))
+ result)))))))))
+
+(defun creole-content-list (structure)
+ "Add a table of contents list to the STRUCTURE.
+
+The list is only added if the STRUCTURE has at least 2 headings."
+ (let* ((heads '(heading1 heading2 heading3 heading4))
+ (headings
+ (loop for el in structure
+ if (memq (car el) heads)
+ collect el))
+ (heading-texts
+ (loop for el in headings
+ collect (list
+ (car el)
+ (format
+ "<a href='#%s'>%s</a>"
+ (creole/heading-text->id (cdr el))
+ (cdr el))))))
+ (if (< (length headings) 2)
+ structure
+ ;; Else add the index before the 2nd index
+ (let* ((toc `(ul ,@(loop for (head . data)
+ in (cdr heading-texts)
+ collect (car data)))))
+ (loop for el in structure
+ if (equal el (elt headings 0))
+ append `((heading2 . "Table of content") ,toc)
+ collect el)))))
+
+(defvar creole-structured '()
+ "A buffer local containing the parsed creole for the buffer.")
+
+(defun creole/structure-pipeline (pipeline structure)
+ "Calls each function in PIPELINE transforming STRUCTURE."
+ (assert (listp pipeline) "creole/structure-pipeline needs a list")
+ (loop
+ with result = structure
+ for stage in pipeline
+ do (setq result (funcall stage result))
+ finally return result))
+
+(defun creole/heading-text->id (heading-text)
+ "Make HEADING-TEXT into an HTML ID."
+ (replace-regexp-in-string " " "-" heading-text))
+
+(defvar creole-do-anchor-headings t
+ "Whether to give each heading it's own anchor.
+
+This behaviour is also controlled by `creole-oddmuse-on'.")
+
+(defun creole/heading->html (heading-cons)
+ "Convert a heading to HTML.
+
+If `creole-oddmuse-on' or `creole-do-anchor-headings' is `t' then
+an anchor is added automatically."
+ (let* ((h-str (symbol-name (car heading-cons)))
+ (level (save-match-data
+ (string-match
+ (rx "heading" (group (+ digit)))
+ h-str)
+ (match-string 1 h-str)))
+ (h-text (if (listp (cdr heading-cons))
+ (cadr heading-cons)
+ (cdr heading-cons))))
+ (format
+ "%s<h%s>%s</h%s>\n"
+ (if (or creole-oddmuse-on
+ creole-do-anchor-headings)
+ (format
+ "<a id='%s'></a>\n"
+ (creole/heading-text->id h-text)) "") ; else
+ level h-text level)))
+
+(defun* creole-html (docbuf
+ &optional html-buffer
+ &key result-mode
+ (erase-existing t)
+ (do-font-lock t)
+ switch-to
+ structure-transform-fn)
+ "Export DOCBUF as HTML to HTML-BUFFER.
+
+If HTML-BUFFER does not exist then a buffer is created based on
+the name of DOCBUF. If DOCBUF doesn't have a name then the
+destination buffer is called:
+
+ *creolehtml.html
+
+If RESULT-MODE is specified then the HTML-BUFFER is placed in
+that mode.
+
+If ERASE-EXISTING is not nil then any existing content in the
+HTML-BUFFER is erased before rendering. By default this is true.
+
+If DO-FONT-LOCK is not nil then any pre-formatted areas tested
+for fontification with `creole-htmlize/mode-func'. It is `t' by
+default.
+
+If SWITCH-TO is not nil then the HTML-BUFFER is switched to when
+the export is done.
+
+When called interactively RESULT-MODE is set to 'html-mode',
+ERASE-EXISTING is set to true and SWITCH-TO is set to true.
+
+STRUCTURE-TRANSFORM-FN may be a function or a list of functions
+to transform the parsed structure of the creole source. A
+transformation function must result in a legal creole
+structure. If a list is used the result of the first function in
+the list is passed to the next until the list is exhausted.
+
+The buffer local variable `creole-structured' is set on the
+HTML-BUFFER with the parsed creole in it. See `creole-structure'
+for the details of that data structure.
+
+Returns the HTML-BUFFER."
+ (interactive
+ (list
+ (read-buffer "Creole buffer: " (current-buffer))
+ nil
+ :result-mode 'html-mode
+ :switch-to 't))
+ (let ((result-buffer ; make up the result buffer
+ (or html-buffer
+ (get-buffer-create
+ (replace-regexp-in-string
+ (rx (group (* "*"))
+ (group (* any))
+ (group (* "*")))
+ "*creolehtml\\2.html"
+ (buffer-name
+ (if (bufferp docbuf)
+ docbuf
+ (get-buffer docbuf))))))))
+ (make-local-variable 'creole-structured)
+ (let ((creole
+ (creole/structure-pipeline
+ (if (functionp structure-transform-fn)
+ (list structure-transform-fn)
+ structure-transform-fn)
+ (creole-structure
+ (creole-tokenize docbuf))))) ; Get the parsed creole doc
+ (with-current-buffer result-buffer
+ (if erase-existing (erase-buffer)) ; Erase if we were asked to
+ (loop for element in creole
+ do
+ (let ((syntax (car element)))
+ (case syntax
+ ;; The list elements can follow on from each other
+ ;; and require special handling
+ ((ul ol)
+ ;; FIXME lists don't do block level replacement yet!
+ (creole/html-list syntax (cdr element)))
+ ;; Headings
+ ((heading1 heading2 heading3 heading4 heading5)
+ (insert (creole/heading->html element)))
+ (portrait ; this is oddmuse/emacswiki stuff
+ (insert (format
+ "<img class='portrait' src='%s'><img>"
+ (cdr element))))
+ ;; Tables
+ (table
+ (insert (creole/html-table (cdr element))))
+ ;; We support htmfontify for PRE blocks
+ (preformatted
+ (let ((styled (and do-font-lock
+ (creole-htmlize-string (cdr element)))))
+ (if (not styled)
+ (insert
+ (format
+ "<pre>\n%s\n</pre>\n"
+ (cdr element)))
+ (insert styled))))
+ ;; Just embed any HTML
+ (plugin-html
+ (insert (cdr element)))
+ (hr
+ (insert "<hr/>\n"))
+ (para
+ (insert (format
+ "<p>%s</p>\n"
+ (creole-block-parse (cdr element))))))))
+ (if result-mode (call-interactively result-mode))
+ (setq creole-structured creole))
+ (if switch-to (switch-to-buffer result-buffer))
+ result-buffer)))
+
+
+(defun creole/file-under-root-p (file-name root)
+ "Is FILE-NAME under the directory ROOT?
+
+Return nil if there is no match or the part of the file-name
+which was not under the docroot."
+ (and root
+ (file-directory-p root)
+ (let* ((true-name
+ (file-truename
+ (expand-file-name file-name)))
+ (root-dir
+ (directory-file-name
+ (expand-file-name root))))
+ (let ((docroot-match-index
+ (compare-strings
+ root-dir 0 (length root-dir)
+ true-name 0 (length true-name))))
+ ;; If the compare-value is less than 0 we matched
+ ;; and we have extra characters in the
+ ;; true-name... we *should* have extra
+ ;; characters because otherwise we'd be referring
+ ;; to the docroot.
+ (when (< docroot-match-index 0)
+ (substring
+ true-name
+ ;; -2 here because of index 0 *and* needing the
+ ;; -leading slash
+ (- (abs docroot-match-index) 1)
+ (length true-name)))))))
+
+(defun creole/get-file (filename)
+ "An exception based FILENAME lookup.
+
+Either loads the FILENAME in a buffer (but does not select it) or
+errors 'file-error.
+
+The FILENAME is expanded and `file-truename'd first."
+ (let ((file-path
+ (ignore-errors
+ (file-truename (expand-file-name filename)))))
+ (if (not (file-exists-p file-path))
+ (signal 'file-error (format "No such file %s" file-path))
+ (find-file-noselect file-path))))
+
+(defun creole/expand-item-value (item &optional docroot)
+ "Expand ITEM to be a value.
+
+If ITEM begins with a file-name identifying character then try
+and resolve the ITEM as a file-name, optionally under the
+DOCROOT.
+
+Return a cons cell with the `car' identifying the type, one of:
+
+ :link to indicate a linkable file-name
+ :string to indicate the raw data
+
+and the `cdr' being the expanded string."
+ (save-match-data
+ (if (string-match
+ (rx bol (or "./" "/" "~") (* any))
+ item)
+ ;; file-name templating has been requested
+ ;; Check if we have a docroot that works
+ (let* ((path-info (creole/file-under-root-p item docroot)))
+ (if path-info
+ ;; The file is linkable so return the template with the
+ ;; docroot-ed true-name
+ (cons :link path-info)
+ ;; No workable docroot so return either the text of the
+ ;; file (if it exists) or just the filename
+ (condition-case err
+ (with-current-buffer (creole/get-file item)
+ (cons :string
+ (buffer-substring
+ (point-min)
+ (point-max))))
+ ;; FIXME - I'd like this to be file-error - why doesn't
+ ;; that work???
+ (error (cons :link item)))))
+ ;; The item was not a file-name so just return it
+ (cons :string item))))
+
+(defun creole/wrap-buffer-text (start end &optional buffer)
+ "Simply wrap the text of BUFFER (or the current buffer).
+
+START is placed at the start of the BUFFER and END is placed at
+the end of the BUFFER."
+ (let ((buf (or buffer (current-buffer))))
+ (with-current-buffer buf
+ (save-excursion
+ (goto-char (point-min))
+ (insert start)
+ (goto-char (point-max))
+ (insert end)))))
+
+(defun creole/insert-template (key
+ position
+ docroot
+ link-template
+ embed-template
+ &optional docroot-alias)
+ "Insert either the LINK-TEMPLATE or the EMBED-TEMPLATE.
+
+KEY specifies a value that is expanded with
+`creole/expand-item-value', possibly with DOCROOT.
+
+Whether we're a :link or a :string will cause either the
+LINK-TEMPLATE or the EMBED-TEMPLATE to be inserted at the marker
+POSITION.
+
+If DOCROOT-ALIAS is specified and the :link template is used then
+the filename is concatenated with that."
+ (save-excursion
+ (when key
+ (goto-char position)
+ (let ((value (creole/expand-item-value key docroot)))
+ (case (car value)
+ (:link
+ (insert
+ (format
+ link-template
+ (if docroot-alias
+ (concat docroot-alias (cdr value))
+ (cdr value)))))
+ (:string
+ (insert
+ (format embed-template (cdr value)))))))))
+
+(defcustom creole-css-color-type "#000000"
+ "A custom color to be used for CSS style rendering."
+ :group 'creole
+ :type '(string))
+
+(defcustom creole-css-color-default "#000000"
+ "A custom color to be used for CSS style rendering."
+ :group 'creole
+ :type '(string))
+
+(defcustom creole-css-color-whitespace-empty "#b22222"
+ "A custom color to be used for CSS style rendering."
+ :group 'creole
+ :type '(string))
+
+(defcustom creole-css-color-regexp-grouping-construct "#000000"
+ "A custom color to be used for CSS style rendering."
+ :group 'creole
+ :type '(string))
+
+(defcustom creole-css-color-builtin "#483d8b"
+ "A custom color to be used for CSS style rendering."
+ :group 'creole
+ :type '(string))
+
+(defcustom creole-css-color-function-name "#0000ff"
+ "A custom color to be used for CSS style rendering."
+ :group 'creole
+ :type '(string))
+
+(defcustom creole-css-color-doc "#8b2252"
+ "A custom color to be used for CSS style rendering."
+ :group 'creole
+ :type '(string))
+
+(defcustom creole-css-color-string "#8b2252"
+ "A custom color to be used for CSS style rendering."
+ :group 'creole
+ :type '(string))
+
+(defcustom creole-css-color-variable-name "#a0522d"
+ "A custom color to be used for CSS style rendering."
+ :group 'creole
+ :type '(string))
+
+(defcustom creole-css-color-constant "#008b8b"
+ "A custom color to be used for CSS style rendering."
+ :group 'creole
+ :type '(string))
+
+(defcustom creole-css-color-keyword "#a020f0"
+ "A custom color to be used for CSS style rendering."
+ :group 'creole
+ :type '(string))
+
+(defcustom creole-css-color-comment "#b22222"
+ "A custom color to be used for CSS style rendering."
+ :group 'creole
+ :type '(string))
+
+(defcustom creole-css-color-whitespace-space "#d3d3d3"
+ "A custom color to be used for CSS style rendering."
+ :group 'creole
+ :type '(string))
+
+(defcustom creole-css-color-comment-delimiter "#b22222"
+ "A custom color to be used for CSS style rendering."
+ :group 'creole
+ :type '(string))
+
+(defcustom creole-css-background-default "#ffffff"
+ "A custom color to be used for CSS style rendering."
+ :group 'creole
+ :type '(string))
+
+(defcustom creole-css-background-whitespace-empty "#ffff00"
+ "A custom color to be used for CSS style rendering."
+ :group 'creole
+ :type '(string))
+
+(defcustom creole-css-background-regexp-grouping-construct "#ffffff"
+ "A custom color to be used for CSS style rendering."
+ :group 'creole
+ :type '(string))
+
+(defcustom creole-css-background-regexp-grouping-backslash "#ffffff"
+ "A custom color to be used for CSS style rendering."
+ :group 'creole
+ :type '(string))
+
+(defcustom creole-css-background-builtin "#ffffff"
+ "A custom color to be used for CSS style rendering."
+ :group 'creole
+ :type '(string))
+
+(defcustom creole-css-background-function-name "#ffffff"
+ "A custom color to be used for CSS style rendering."
+ :group 'creole
+ :type '(string))
+
+(defcustom creole-css-background-doc "#ffffff"
+ "A custom color to be used for CSS style rendering."
+ :group 'creole
+ :type '(string))
+
+(defcustom creole-css-background-string "#ffffff"
+ "A custom color to be used for CSS style rendering."
+ :group 'creole
+ :type '(string))
+
+(defcustom creole-css-background-variable-name "#ffffff"
+ "A custom color to be used for CSS style rendering."
+ :group 'creole
+ :type '(string))
+
+(defcustom creole-css-background-constant "#ffffff"
+ "A custom color to be used for CSS style rendering."
+ :group 'creole
+ :type '(string))
+
+(defcustom creole-css-background-keyword "#ffffff"
+ "A custom color to be used for CSS style rendering."
+ :group 'creole
+ :type '(string))
+
+(defcustom creole-css-background-comment "#ffffff"
+ "A custom color to be used for CSS style rendering."
+ :group 'creole
+ :type '(string))
+
+(defcustom creole-css-background-whitespace-space "#ffffe0"
+ "A custom color to be used for CSS style rendering."
+ :group 'creole
+ :type '(string))
+
+(defcustom creole-css-background-comment-delimiter "#ffffff"
+ "A custom color to be used for CSS style rendering."
+ :group 'creole
+ :type '(string))
+
+(defun creole-css-list-to-style-decl (css-list)
+ "Make the CSS-LIST into an HTML STYLE decl.
+
+A CSS-LIST should look something like this:
+
+ ((default \"default\" . \"{ ... CSS declarations ... }\")
+ (font-lock-string-face \"string\" . \"{ ... CSS declarations ... }\")
+ (font-lock-type-face \"type\" . \"{ ... CSS declarations ... }\")
+ (font-lock-function-name-face \"function-name\" . \"{ ... CSS declarations
... }\")
+ (font-lock-keyword-face \"keyword\" . \"{ ... CSS declarations ... }\")
+ (font-lock-comment-face \"comment\" . \"{ ... CSS declarations ... }\")
+ (whitespace-space \"whitespace-space\" . \"{ ... CSS declarations ... }\")
+ (font-lock-comment-delimiter-face \"comment-delimiter\" . \"{ ... CSS
declarations ... }\"))
+
+Each element of the list contains the descriptive part of a CSS
+class declaration.
+
+This is from `hfy-sprintf-stylesheet' which is part of
+`htmlfontify'."
+ (mapconcat
+ (lambda (style)
+ (format
+ "span.%s %s\nspan.%s a %s\n%s\n"
+ (cadr style) (cddr style)
+ (cadr style) (hfy-link-style (cddr style))
+ ;; Add in our own colors - just add nothing
+ ;; if we don't have customization for it
+ (condition-case err
+ (let ((css-value
+ (symbol-value
+ (intern
+ (concat
+ "creole-css-color-"
+ (cadr style))))))
+ (if css-value
+ (format
+ "span.%s { color: %s; }\n"
+ (cadr style)
+ css-value)))
+ (void-variable ""))))
+ css-list
+ "\n"))
+
+(defun creole-moustache (template variables)
+ "Moustache replace in TEMPLATE with VARIABLES.
+
+Eg:
+
+ (creole-moustache
+ \"<textarea>{{text}}</textarea>\"
+ '((text . \"this is my text\")))
+
+ => \"<textarea>this is my text</textarea>\""
+ (replace-regexp-in-string
+ (rx "{{"
+ (group (+ (in alphanumeric "_-")))
+ "}}")
+ (lambda (m)
+ (let* ((expansion (match-string 1 m))
+ (var (intern expansion))
+ (pair (assoc var variables)))
+ (if pair
+ (cdr pair)
+ (concat "{{" expansion "}}"))))
+ template
+ nil
+ t))
+
+(defun creole-list-text-properties (buffer property predicate)
+ "List all the values for PROPERTY in BUFFER.
+
+PREDICATE is used to merge the properties."
+ (with-current-buffer buffer
+ (save-excursion
+ (goto-char (point-min))
+ (let* ((lst (list))
+ (p (next-single-property-change
+ (point-min)
+ :css-list
+ (current-buffer)
+ (point-max))))
+ (while (not (equal p (point-max)))
+ (let ((prop (get-text-property p property)))
+ (when prop
+ (setq lst
+ (merge
+ 'list
+ lst prop
+ predicate))))
+ (goto-char (+ 1 p))
+ (setq p (next-single-property-change
+ (point)
+ property
+ (current-buffer)
+ (point-max))))
+ lst))))
+
+;;;###autoload
+(defun* creole-wiki (source
+ &key
+ destination
+ structure-transform-fn
+ (htmlfontify t)
+ (htmlfontify-style t)
+ body-header
+ body-footer
+ variables
+ docroot
+ docroot-alias
+ css
+ javascript
+ meta
+ other-link
+ doctype)
+ "Export WikiCreole SOURCE into HTML.
+
+Returns the buffer where the HTML was exported. This could be a
+user supplied buffer (see DESTINATION) or a buffer created based
+on the filename of the source (or just automatically created).
+
+SOURCE can be a buffer or plain text or something we might
+recognize as a file. A file-name is detected by a leading
+'~' (meaning expand from the user root) or '/' (meaning rooted)
+or './' (meaning expand from the root of the source creole file).
+
+If SOURCE is a filename it is loaded with `creole/get-file'.
+
+
+Keyword arguments are supported to change the way the HTML is
+produced.
+
+DESTINATION can be a buffer or a buffer name to write the HTML
+into or it can be 't' to indicate the default output stream. In
+the latter case an automatic buffer is still created and the HTML
+is sent to the default output stream when the export is done.
+
+The DESTINATION buffer is always returned.
+
+STRUCTURE-TRANSFORM-FN is a structure transformation function or
+list of functions, see `creole-html' for details.
+
+HTMLFONTIFY - use 'htmlfontify' to fontify any code blocks; this
+is true by default.
+
+Code blocks are marked up like pre-formatted areas but must begin
+with a line stating the Emacs mode to fontify the text as; for
+example:
+
+ {{{
+ ##! emacs-lisp
+ (let ((x 1)) x)
+ }}}
+
+would cause Emacs Lisp to be fontified.
+
+HTMLFONTIFY-STYLE - add an HTML-STYLE block for 'htmlfontify'
+code blocks. If this is nil an HTML-STYLE block is NOT added.
+
+BODY-HEADER - a string or a file-name with HTML code to be
+inserted in the BODY of the HTML document before the Creole
+markup export. A file-name is detected in the same way as for
+SOURCE.
+
+BODY-FOOTER - a string or a file-name with HTML code to be
+inserted in the BODY of the HTML document after the Creole markup
+export. A file-name is detected in the same way as for SOURCE.
+
+The BODY-HEADER and the BODY-FOOTER are treated as moustache
+templates and expanded before being inserted. See
+'creole-moustache' for a description. Variables passed to
+'creole-moustache' with the template are:
+
+ text - the creole source text of the page
+
+or any variable in VARIABLES, which is an alist of
+symbols -> values.
+
+DOCROOT - base any files to be served. Any file-name reference
+for CSS or JavaScript, if residing under this docroot, will be
+linked to the document rather than embedded.
+
+DOCROOT-ALIAS - is the docroot path to use in any links as an
+alias for the docroot.
+
+CSS - a list of cascading style sheets, each entry can either be
+a file-name (a file-name is detected in the same way as
+for SOURCE) or a string with W3C-CSS statements in it.
+
+If a DOCROOT is specified then any cascading style sheets
+file-name is LINKed into the resulting document, if not then the
+statements are embedded directly.
+
+JAVASCRIPT - a list of JavaScript, as for CSS, each entry can
+be either a string of the JavaScript to be directly embedded or a
+file-name reference (as in SOURCE). As for :CSS if
+a :DOCROOT is specified then the scripts will be loaded as links
+but otherwise will be embedded.
+
+META - a list of strings specifying resulting HTML-META elements.
+For example:
+
+ :meta '(\"name='description'
+ content='Free Web tutorials on HTML, CSS, XML'\")
+
+:OTHER-LINK - a list of string specifying resulting HTML-LINK
+elements, for example:
+
+ :other-link '(\"rel='alternate' href='/my-feed.rss'\")
+
+:DOCTYPE may be nil, in which case nothing is added or it may be
+a string in which case it is inserted directly before the <html>
+element, or it may be one of the symbols 'xhtml or 'html5 in
+which case the right doctype is added.
+
+All, any or none of these keys may be specified.
+"
+ (interactive "fCreole file: ")
+ (let* (file-opened ;; a flag to indicate whether we opened a file or not
+ (source-buffer
+ ;; Detect what sort of source we have
+ (cond
+ ((bufferp source)
+ source)
+ ((string-match (rx bol (or "/" "~") (* any)) source)
+ (creole/get-file source))
+ (t
+ (with-current-buffer (generate-new-buffer "* creole-source *")
+ (insert source)
+ (current-buffer)))))
+ (html-buffer
+ (cond
+ ((bufferp destination)
+ destination)
+ ((stringp destination)
+ (get-buffer-create destination))
+ (t
+ (get-buffer-create "*creole-html*")))))
+
+ ;; Export the creole to the result buffer
+ (creole-html source-buffer html-buffer
+ :do-font-lock htmlfontify
+ :structure-transform-fn structure-transform-fn)
+
+ ;; Now a bunch of other transformations on the result buffer
+ (with-current-buffer html-buffer
+ (let* ((creole-text
+ (with-current-buffer source-buffer
+ (buffer-substring (point-min)(point-max))))
+ ;; We should let users specify more variables in the
+ ;; call to creole-wiki?
+ (vars (append `((text . ,creole-text)) variables)))
+
+ ;; Insert the BODY header and footer
+ (when body-header
+ (let ((hdr (creole/expand-item-value body-header)))
+ (when (eq (car hdr) :string)
+ (goto-char (point-min))
+ (insert
+ (creole-moustache
+ (cdr hdr)
+ vars)))))
+
+ (when body-footer
+ (let ((ftr (creole/expand-item-value body-footer)))
+ (when (eq (car ftr) :string)
+ (goto-char (point-max))
+ (insert
+ (creole-moustache
+ (cdr ftr)
+ vars)))))
+
+ ;; Now wrap everything we have so far with the BODY tag
+ (creole/wrap-buffer-text "<body>\n" "</body>\n")
+
+ ;; Now stuff that should go in a header
+ (when (or css javascript meta other-link
+ (and htmlfontify
+ htmlfontify-style
+ (next-single-property-change
+ (point-min)
+ :css-list
+ (current-buffer)
+ (point-max))))
+ (let (head-marker)
+ (goto-char (point-min))
+ (insert "<head>\n")
+ (let ((creole-doc-title (assoc 'heading1 creole-structured)))
+ (when creole-doc-title
+ (insert (format "<title>%s</title>\n" (cdr
creole-doc-title)))))
+ (setq head-marker (point-marker))
+ (insert "</head>\n")
+ ;; First the CSS
+ (loop for ss in css
+ do (creole/insert-template
+ ss
+ head-marker
+ docroot
+ "<link rel='stylesheet' href='%s' type='text/css'/>\n"
+ "<style>\n%s\n</style>\n"
+ docroot-alias))
+ ;; Now the JS
+ (loop for js in javascript
+ do (creole/insert-template
+ js
+ head-marker
+ docroot
+ "<script src='%s' language='Javascript'></script>\n"
+ "<script>
+//<!--
+%s
+//-->
+</script>
+"
+ docroot-alias))
+ ;; Now meta
+ (creole/insert-template
+ meta
+ head-marker
+ docroot
+ "<meta %s/>\n"
+ "<meta %s/>\n")
+ (creole/insert-template
+ other-link
+ head-marker
+ docroot
+ "<link %s/>\n"
+ "<link %s/>\n")
+
+ ;; Find any styles that are embedded
+ (if (and htmlfontify htmlfontify-style)
+ (let ((css (remove-duplicates
+ (creole-list-text-properties
+ (current-buffer)
+ :css-list
+ (lambda (a b) (string< (cadr a) (cadr b))))
+ :test (lambda (a b) (string= (cadr a) (cadr b))))))
+ (save-excursion
+ (goto-char head-marker)
+ (insert
+ "<style>\n"
+ (creole-css-list-to-style-decl css)
+ "\n</style>\n"))))))
+
+ ;; Wrap the whole thing in the DOCTYPE and the HTML tag
+ (creole/wrap-buffer-text
+ (cond
+ ((eq doctype 'html5) "<!DOCTYPE html>\n<html>")
+ ((eq doctype 'xhtml) "<!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\";>\n")
+ ((stringp doctype) (concat doctype "<html>\n"))
+ ((eq doctype nil) "<html>\n"))
+ "</html>\n")))
+
+ ;; Should we output the whole thing to the default output stream?
+ (when (eq destination t)
+ (with-current-buffer html-buffer
+ (princ (buffer-substring (point-min)(point-max)))))
+
+ (when (called-interactively-p 'any)
+ (switch-to-buffer html-buffer))
+
+ (when file-opened
+ (kill-buffer source-buffer))
+
+ ;; Return the destination buffer
+ html-buffer))
+
+
+;; Useful functions
+
+(defun creole-directory-list (directory-name &optional make-links)
+ "WikiCreole format a table of files in DIRECTORY-NAME.
+
+MAKE-LINKS causes the files to be WikiCreole links."
+ (loop for filename in (directory-files directory-name)
+ if (not (or (equal filename ".")
+ (equal filename "..")))
+ concat
+ (let* ((fq (expand-file-name filename directory-name))
+ (fa (file-attributes fq))
+ (timestr
+ (apply 'format
+ "%04d-%02d-%02d %02d:%02d"
+ (let ((dt (decode-time (elt fa 5))))
+ (list (elt dt 5)
+ (elt dt 4)
+ (elt dt 3)
+ (elt dt 2)
+ (elt dt 1))))))
+ (format
+ "|%s|%s|%s|\n"
+ (if make-links
+ (format "[[%s]]" filename)
+ filename)
+ timestr
+ (elt fa 7)))))
+
+(provide 'creole)
+
+;;; creole.el ends here
diff --git a/tests/elnode/db.el b/tests/elnode/db.el
new file mode 100644
index 0000000..72666ac
--- /dev/null
+++ b/tests/elnode/db.el
@@ -0,0 +1,317 @@
+;;; db.el --- A database for EmacsLisp -*- lexical-binding: t -*-
+
+;; Copyright (C) 2012 Nic Ferrier
+
+;; Author: Nic Ferrier <nferrier@ferrier.me.uk>
+;; Maintainer: Nic Ferrier <nferrier@ferrier.me.uk>
+;; Keywords: data, lisp
+;; Created: 23rd September 2012
+;; Package-Requires: ((kv "0.0.11"))
+;; Version: 20140421.1411
+;; X-Original-Version: 0.0.6
+
+;; 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 simple database interface and implementation.
+;;
+;; It should be possible to specify any kind of key/value database
+;; with this interface.
+;;
+;; The supplied implementation is an Emacs hash-table implementation
+;; backed with serializing objects. It is NOT intended for anything
+;; other than very simple use cases and will not scale very well at
+;; all.
+
+;; However, other implementations (mongodb, redis or PostgreSQL
+;; hstore) would be easy to implement and fit in here.
+
+
+;;; Code:
+
+(eval-when-compile
+ (require 'cl))
+(require 'kv)
+
+(defun db/make-type-store ()
+ "Make the type store."
+ (make-hash-table :test 'eq))
+
+(defvar db/types (db/make-type-store)
+ "Hash of database type ids against funcs?")
+
+(defun* db-make (reference)
+ "Make a DB based on the REFERENCE."
+ (if (and (listp reference)
+ (eq 'db-hash (car reference)))
+ ;; this should be part of what we find when we look it up?
+ (db-hash reference)
+ ;; Otherwise look it up...
+ (let ((db-func (gethash (car reference) db/types)))
+ (if (functionp db-func)
+ (funcall db-func reference)
+ ;; there should be a specific db error
+ (error "no such database implementation")))))
+
+(defun db-get (key db)
+ "Get the value from the DB with the KEY."
+ (funcall (plist-get db :get) key db))
+
+(defun db-put (key value db)
+ "Put a new VALUE into the DB with the specified KEY.
+
+Return the VALUE as it has been put into the DB."
+ (funcall (plist-get db :put) key value db))
+
+(defun db-map (func db &optional query filter)
+ "Call FUNC for every record in DB optionally QUERY filter.
+
+QUERY, if specified, should be a list of query terms as specified
+by `kvquery->func'.
+
+FUNC should take 2 arguments:
+
+ KEY DB-VALUE
+
+where the DB-VALUE is whatever the DB has attached to the
+specified KEY.
+
+This returns an alist of the KEY and the value the function
+returned. If FILTER is `t' then only pairs with a value are
+returned."
+ (let (retlist)
+ (funcall (plist-get db :map)
+ (lambda (key value)
+ (when key
+ (setq
+ retlist
+ (cons
+ (funcall func key value)
+ retlist))))
+ db query)
+ (if filter
+ (loop for p in retlist
+ if (cdr p)
+ collect p)
+ retlist)))
+
+(defun db-query (db query)
+ "Do QUERY on DB and return the result.
+
+The query is as specified by `kvquery->func'.
+
+This is `db-map' with an identity function."
+ (db-map 'kvidentity db query))
+
+
+;;; Generic utility functions
+
+(defun db-copy (src-db dest-db)
+ "Copy the data from SRC-DB into DEST-DB."
+ (db-map (lambda (key value)
+ ;;(unless (db-get key dest-db)
+ (progn
+ (db-put key value dest-db))) src-db))
+
+
+;;; Hash implementation
+
+(defun db-hash (reference)
+ "Make a db-hash database.
+
+REFERENCE comes from the call to `db-make' and should
+include a `:filename' key arg to point to a file:
+
+ '(db-hash :filename \"/var/local/db/auth-db\")
+
+If the filename exists then it is loaded into the database.
+
+:from-filename let's you specify the source location the db will
+be read from. The first version of the hash db tied databases to
+specific filenames so you could not easily load a db from one
+file location into another. This has been fixed but if you need
+to work with a previous version's database you can use
+the :from-filename to specify where the db file was located."
+ (let* ((db-plist (cdr reference))
+ (filename (plist-get db-plist :filename))
+ (from-filename (plist-get db-plist :from-filename))
+ (db (list
+ :db (make-hash-table :test 'equal)
+ :get 'db-hash-get
+ :put 'db-hash-put
+ :map 'db-hash-map
+ :query-equal (or
+ (plist-get db-plist :query-equal)
+ 'kvassoq=)
+ :filename filename
+ :from-filename from-filename)))
+ (when (and filename
+ (file-exists-p (concat filename ".elc")))
+ (db-hash/read db))
+ ;; Return the database
+ db))
+
+(defun db-hash/read (db)
+ "Loads the DB."
+ (let* ((filename (plist-get db :filename))
+ (source-filename ; this is needed for the crappy old way of
+ ; saving with a unique filename based symbol
+ (or
+ (plist-get db :from-filename)
+ filename)))
+ (when filename
+ (plist-put
+ db :db
+ (catch 'return
+ (progn
+ ;; The new saving mechanism causes that throw
+ (load-file (concat filename ".elc"))
+ ;; the old way used unique symbols
+ (symbol-value (intern source-filename))))))))
+
+(defvar db-hash-do-not-save nil
+ "If `t' then do not save the database.
+
+This is very useful for testing.")
+
+(defun db-hash/save (db)
+ "Saves the DB."
+ (unless db-hash-do-not-save
+ (let ((filename (plist-get db :filename)))
+ (when filename
+ ;; Make the parent directory for the db if it doesn't exist
+ (let ((dir (file-name-directory filename)))
+ (unless (file-exists-p dir)
+ (make-directory dir t)))
+ ;; Now store the data
+ (with-temp-file (concat filename ".el")
+ (erase-buffer)
+ (let ((fmt-obj (format
+ "(throw 'return %S)"
+ (plist-get db :db))))
+ (insert fmt-obj)))
+ ;; And compile it and delete the original
+ (byte-compile-file (concat filename ".el"))
+ (delete-file (concat filename ".el"))))))
+
+
+(defun db-hash-get (key db)
+ (let ((v (gethash key (plist-get db :db))))
+ v))
+
+(defun db-hash-map (func db &optional query)
+ "Run FUNC for every value in DB.
+
+The QUERY is ignored. We never filter."
+ (let* ((equal-fn (plist-get db :query-equal))
+ (filterfn (if query
+ (kvquery->func query :equal-func equal-fn)
+ 'identity)))
+ (maphash
+ (lambda (key value)
+ (when (funcall filterfn value)
+ (funcall func key value)))
+ (plist-get db :db))))
+
+(defun db-hash-put (key value db)
+ (let ((v (puthash key value (plist-get db :db))))
+ ;; Instead of saving every time we could simply signal an update
+ ;; and have a timer do the actual save.
+ (db-hash/save db)
+ v))
+
+(defvar db/hash-clear-history nil
+ "History variable for completing read.")
+
+(defun db-hash-clear (db)
+ "Clear the specified DB (a hash-db)."
+ (interactive
+ (list (symbol-value
+ (intern
+ (completing-read
+ "Database: "
+ obarray
+ nil
+ 't
+ nil
+ 'db/hash-clear-history)))))
+ (clrhash (plist-get db :db))
+ (if (file-exists-p (plist-get db :filename))
+ (delete-file (plist-get db :filename))))
+
+
+;; Filter db - let's you filter another db
+
+(defun db-filter-get (key db)
+ (let* ((filter-func (plist-get db :filter))
+ (origin (plist-get db :source))
+ (value (db-get key origin)))
+ (funcall filter-func key value)))
+
+(defun db-filter-put (key value db)
+ (let* ((filter-func (plist-get db :filter))
+ (origin (plist-get db :source))
+ (ret (db-put key value origin)))
+ (funcall filter-func key ret)))
+
+(defun db-filter-map (key db &optional query)
+ (let* ((filter-func (plist-get db :filter))
+ (origin (plist-get db :source)))
+ (mapcar
+ filter-func
+ (db-map key origin query))))
+
+(defun db-filter (reference)
+ "Make a database object that is a filter around another.
+
+The reference should look something like:
+
+ '(db-filter
+ :source (db-hash :filename ....)
+ :filter (lambda (value) ...)
+
+The `:filter' function takes 2 arguments: KEY and VALUE with
+VALUE being the returned value from the `:source' database."
+ (let* ((ref-plist (cdr reference))
+ (db (list
+ :get 'db-filter-get
+ :put 'db-filter-put
+ :map 'db-filter-map
+ :filter (plist-get ref-plist :filter)
+ :source (plist-get ref-plist :source))))
+ db))
+
+(puthash 'db-filter 'db-filter db/types)
+
+(defun db-change-timestamp ()
+ "Place a timestamp in the kill-ring for a db change log."
+ (interactive)
+ (kill-new (format-time-string "\"%Y%M%d%H%M%S%N\""(current-time))))
+
+(defmacro db-change (change-db timestamp &rest change)
+ "Do CHANGE and make a record in the CHANGE-DB with TIMESTAMP."
+ (declare (indent 2))
+ (let ((cdbv (make-symbol "cdbv"))
+ (tsv (make-symbol "tsv")))
+ `(let ((,cdbv ,change-db)
+ (,tsv ,timestamp))
+ (unless (db-get ,tsv ,cdbv)
+ (progn
+ (progn ,@change)
+ (db-put ,tsv (list (cons "timestamp" ,tsv)) ,cdbv))))))
+
+(provide 'db)
+
+;;; db.el ends here
diff --git a/tests/elnode/default-webserver-image.png
b/tests/elnode/default-webserver-image.png
new file mode 100644
index 0000000..403b894
Binary files /dev/null and b/tests/elnode/default-webserver-image.png differ
diff --git a/tests/elnode/default-webserver-test.html
b/tests/elnode/default-webserver-test.html
new file mode 100644
index 0000000..90af241
--- /dev/null
+++ b/tests/elnode/default-webserver-test.html
@@ -0,0 +1,20 @@
+<html>
+<body>
+<h1>This is Elnode's Test HTML file</h1>
+<p>If you are reading this then most likely Elnode is working ok.</p>
+
+<p>This file is normally stored in the user's directory. It can
+normally be found in:</p>
+
+<pre>
+~/.emacs.d/elnode
+</pre>
+
+<p>To learn more about Elnode visit <a href="http://elnode.org";>the
website</a>.</p>
+
+<p>Just to show that Elnode will serve anything, here's a png:</p>
+
+<img src="default-webserver-image.png"/>
+
+</body>
+</html>
diff --git a/tests/elnode/default-wiki-index.creole
b/tests/elnode/default-wiki-index.creole
new file mode 100644
index 0000000..8f4f3a4
--- /dev/null
+++ b/tests/elnode/default-wiki-index.creole
@@ -0,0 +1,113 @@
+= Elnode Wiki =
+
+This is Elnode's Wiki. It is based on the {{{creole}}} wiki language
+and is written completely in EmacsLisp.
+
+{{default-wiki-logo.gif|GNUs sitting on clouds}}
+
+== What does it do? ==
+
+It does syntax coloring:
+
+{{{
+##! emacs-lisp
+(defun elnode-wiki-handler (httpcon wikiroot)
+ "A low level handler for Wiki operations.
+
+Send the Wiki page requested, which must be a file existing under
+the WIKIROOT, back to the HTTPCON.
+
+Update operations are protected by authentication."
+ (elnode-method httpcon
+ (GET
+ (elnode-docroot-for wikiroot
+ with target-path
+ on httpcon
+ do
+ (if (equal target-path (expand-file-name (concat wikiroot "/")))
+ (elnode-wiki-page httpcon (concat wikiroot "/index.creole"))
+ (elnode-wiki-page httpcon target-path))))
+ (POST
+ (elnode-with-auth httpcon 'elnode-wiki-auth
+ (let* ((path (elnode-http-pathinfo httpcon))
+ (text (elnode-wiki--text-param httpcon)))
+ (if (not (elnode-http-param httpcon "preview"))
+ ;; A save request in which case save the new text and then
+ ;; send the wiki text.
+ (elnode-wiki--save-request httpcon wikiroot path text)
+ ;; Might be a preview request in which case send back the WIKI
+ ;; text that's been sent.
+ (with-temp-file "/tmp/preview"
+ (insert text))
+ (elnode-wiki-send httpcon "/tmp/preview" path)))))))
+}}}
+
+It does links, for example to
+[[http://github.com/nicferrier/elwikicreole|Emacs Creole]] which is
+the Wiki render engine used to display pages.
+
+It does all the normal Wiki things like headings and lists.
+
+You can also do some special Emacs things, like org-mode tables:
+
+| Date | Amount | Description |
+|------------+--------+---------------------|
+| 2011-11-15 | 100.15 | Expensive lunch out |
+| 2011-11-18 | 7.30 | Dry cleaning |
+| 2011-11-21 | 22.50 | Takeaway curry |
+|------------+--------+---------------------|
+| | 129.95 | |
+#+TBLFM: @5$2=vsum(@I..@II)
+
+and lisp callouts:
+
+<<(
+ (mapconcat
+ (lambda (s)
+ (format "* %s" s))
+ '("which" "eval" "lisp" "and" "render" "the" "results")
+ "\n")
+)>>
+
+
+== Authentication ==
+
+By default, the Wiki uses an authentication database in the Emacs
+instance running Elnode and the Wiki server.
+
+If you want to add a user to the Wiki so you can edit pages you can do this in
Emacs:
+
+{{{
+M-x elnode-auth-user-add
+}}}
+
+and it will ask you for a username and a password. The user will be
+stored in a persistent database.
+
+
+== Where the Wiki pages are ==
+
+By default the Elnode Wiki stores files in your {{{~/.emacs.d}}}
+directory which is actually defined by the variable
+{{{user-emacs-directory}}} in Emacs.
+
+There is normally a directory {{{elnode}}} in that directory which
+contains directories for the Web server document root and the Wiki.
+
+The location of the Wiki files can be configured though, try:
+
+{{{
+M-x customize-variable [RET] elnode-wikiserver-wikiroot
+}}}
+
+== More customization ==
+
+There are many other things in Elnode's Wiki that can be customized,
+including the header and footer. Use:
+
+{{{
+M-x customize-group [RET] elnode-wikiserver [RET]
+}}}
+
+There is more to do with the Elnode Wiki server because there is so
+much that Emacs can do.
diff --git a/tests/elnode/default-wiki-logo.gif
b/tests/elnode/default-wiki-logo.gif
new file mode 100644
index 0000000..2187935
Binary files /dev/null and b/tests/elnode/default-wiki-logo.gif differ
diff --git a/tests/elnode/elnode-bm.el b/tests/elnode/elnode-bm.el
new file mode 100644
index 0000000..d73e593
--- /dev/null
+++ b/tests/elnode/elnode-bm.el
@@ -0,0 +1,110 @@
+;;; elnode-bm.el -- bookmarking helpers with elnode -*- lexical-binding: t
-*-
+
+(require 'elnode)
+(require 's)
+
+(defgroup elnode-bookmark nil
+ "The Elnode bookmarker application."
+ :group 'elnode)
+
+(defcustom elnode-bookmark-file-name "~/bookmarks.org"
+ "The filename used to log bookmarks.
+
+This file is expanded to find the file that bookmarks will be
+stored in."
+ :group 'elnode-bookmark
+ :type 'filename)
+
+(defun elnode-stud (port forward-port pem-file)
+ "Start stud on PORT, sending to FORWARD-PORT with PEM-FILE."
+ (start-process
+ "elnode-stud" "elnode-stud"
+ "stud" "-ssl" "-b" "127.0.0.1,8004" "-f" "*,8443" (expand-file-name
pem-file))
+ (switch-to-buffer "elnode-stud"))
+
+(defun elnode-bm-time->org (time)
+ "Format the specified time in org-mode format."
+ (format-time-string "[%Y-%m-%d %a %H:%M]" time))
+
+(defun elnode-bm-save (httpcon)
+ "Take a bookmarklet and save it."
+ (let* ((method (elnode-http-method httpcon))
+ (page (decode-coding-string
+ (elnode-http-param httpcon "u")
+ 'utf-8))
+ (title (or
+ (decode-coding-string
+ (elnode-http-param httpcon "i")
+ 'utf-8)
+ page))
+ (time (seconds-to-time
+ (/ (string-to-int
+ (elnode-http-param httpcon "t"))
+ 1000))))
+ (with-current-buffer
+ (find-file-noselect
+ (expand-file-name elnode-bookmark-file-name))
+ (case major-mode
+ ('org-mode
+ (save-excursion
+ (goto-char (point-min))
+ (let ((org-time-str
+ (elnode-bm-time->org time)))
+ (insert
+ (s-lex-format
+ "* [[${page}][${title}]] ${org-time-str}\n")))))))
+ (elnode-send-json httpcon (list :ok))))
+
+(defun elnode-bm-chrome-ext (httpcon)
+ "Send the chrome extension."
+ (elnode-send-file
+ httpcon
+ (concat
+ (file-name-directory
+ (or (buffer-file-name)
+ load-file-name
+ default-directory))
+ "bookmark4chrome.crx")
+ :mime-types
+ '(("application/x-chrome-extension" . "crx"))))
+
+(defun elnode-bm-index (httpcon)
+ (elnode-send-html httpcon "<html>
+<style>
+body { font-family: sans-serif;}
+</style>
+<body>
+<h1>Elnode Bookmarking IT</h1>
+chrome extension: <a href=\"/elnode-bookmarks.crx\">elnode</a><br></br>
+bookmarklet: <a href=\"javascript:function elnodebm001(){
+var d=document,
+i=''+d.title,
+z=d.createElement('scr'+'ipt'),
+b=d.body,
+l=d.location;
+try{
+if(!b)throw(0);
+z.setAttribute('src','http://localhost:8004/bm/save?u='
++encodeURIComponent(l.href)
++'&t='+(new Date().getTime())
++'&i='+encodeURIComponent(i));
+b.appendChild(z);
+}catch(e){
+alert('Please wait until the page has loaded.');
+}
+}
+elnodebm001();void(0)\">elnode</a>
+</body></html>"))
+
+;;;###autoload
+(defun elnode-bm-handler (httpcon)
+ (elnode-hostpath-dispatcher
+ httpcon
+ '(("^[^/]+//$" . elnode-bm-index)
+ ("^[^/]+//elnode-bookmarks.crx" . elnode-bm-chrome-ext)
+ ("^[^/]+//bm/save" . elnode-bm-save)
+ ("^[^/]+//bm/report" . elnode-bm-report))))
+
+(provide 'elnode-bm)
+
+;;; elnode-bm.el ends here
diff --git a/tests/elnode/elnode-compat.el b/tests/elnode/elnode-compat.el
new file mode 100644
index 0000000..b42d11b
--- /dev/null
+++ b/tests/elnode/elnode-compat.el
@@ -0,0 +1,35 @@
+;;; elnode-compat.el --- compatability stuff
+
+;; Copyright (C) 2014 Nic Ferrier
+
+;; Author: Nic Ferrier <nferrier@ferrier.me.uk>
+;; Keywords:
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'elnode)
+
+(defalias 'elnode-remote-ipaddr 'elnode-get-remote-ipaddr)
+(defalias 'elnode-rfc1123-date 'elnode--rfc1123-date)
+(defalias 'elnode-file-modified-time 'elnode--file-modified-time)
+
+(provide 'elnode-compat)
+
+;;; elnode-compat.el ends here
diff --git a/tests/elnode/elnode-js.el b/tests/elnode/elnode-js.el
new file mode 100644
index 0000000..0bfb60c
--- /dev/null
+++ b/tests/elnode/elnode-js.el
@@ -0,0 +1,147 @@
+;;; elnode-js.el --- elnode js integration tools -*- lexical-binding: t -*-
+
+;; Copyright (C) 2014 Nic Ferrier
+
+;; Author: Nic Ferrier <nferrier@ferrier.me.uk>
+;; Keywords: processes, hypermedia
+
+;; 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:
+
+;; Often we make websites with Javascript. Elnode has built in tools
+;; to help.
+
+;; elnode-js/browserify -- let's elnode take advantage of browserify
+;; to simplify your javascript (by using node's require which
+;; browserify translates into the correct browser code).
+
+;;; Code:
+
+(require 'elnode)
+(require 'noflet)
+
+(defun elnode-js/node-bin ()
+ "Where is the NodeJS binary?
+
+We look in a place provided by `nodejs-repl' package or in
+\"~/nodejs\", \"/usr/local/bin\" or in \"/usr/bin\" in that
+order."
+ (noflet ((file-exists (filename)
+ (and (file-exists-p (expand-file-name filename)) filename)))
+ (or (and (featurep 'nodejs-repl)
+ (symbol-value 'nodejs-repl-command))
+ (or (file-exists "~/nodejs/bin/nodejs")
+ (file-exists "/usr/local/bin/nodejs")
+ (file-exists "/usr/bin/nodejs")))))
+
+(defun elnode-js/browserify-bin (&optional directory)
+ "Where is browserify?
+
+We search DIRECTORY, if it's supplied, and then the project root,
+if there is one (and if `find-file-in-project' is installed) and
+then the `default-directory'."
+ (let ((browserify "node_modules/.bin/browserify"))
+ (noflet ((file-exists (filename)
+ (and (file-exists-p (expand-file-name filename)) filename)))
+ (or
+ (and directory (file-exists (expand-file-name browserify directory)))
+ (and (let ((default-directory (expand-file-name directory)))
+ (file-exists
+ (expand-file-name
+ browserify
+ (locate-dominating-file default-directory "node_modules")))))
+ (file-exists "node_modules/.bin/browserify")))))
+
+(defun elnode-js/browserify (httpcon docroot path)
+ "Run browserify from DOCROOT for the PATH.
+
+Browserify is a nodejs tool that turns nodejs based Javascript
+into Javascript that works inside the browser.
+
+nodejs code can use nodejs's `require' form to import modules,
+which is simpler than many client side solutions. So browserify
+solves the module problem across node.js and the browser."
+ (let ((browserify (elnode-js/browserify-bin docroot))
+ (nodejs (elnode-js/node-bin)))
+ (when (and nodejs browserify)
+ (let ((process-environment
+ (cons (format "PATH=%s:%s" nodejs (getenv "PATH"))
+ process-environment)))
+ (let ((default-directory docroot))
+ (elnode-http-start httpcon 200 '(Content-type .
"application/javascript")))
+ (elnode-child-process httpcon browserify (concat docroot path))))))
+
+(defun elnode-js/browserify-send-func (httpcon targetfile)
+ "An `elnode-send-file-assoc' function for node.js' browserify.
+
+Associate js with this function in the `elnode-send-file-assoc'
+alist to get automatic browserify packaging of JavaScript files
+served by `elnode-send-file'. This includes anything sent by the
+elnode webserver.
+
+An easy way of getting this effect is to use
+`elnode-make-js-server'."
+ (elnode-js/browserify
+ httpcon
+ (file-name-directory targetfile)
+ (file-name-nondirectory targetfile)))
+
+(defvar elnode-make-js-server/docroot-history nil
+ "The history for the docroot in `elnode-make-js-server'.")
+
+(defvar elnode-make-js-server/port-history nil
+ "The history for the port in `elnode-make-js-server'.")
+
+(defvar elnode-make-js-server/host-history nil
+ "The history for the host in `elnode-make-js-server'.")
+
+;;;###autoload
+(defun elnode-make-js-server (docroot port &optional host)
+ "Make a webserver with additional js browserify support.
+
+See `elnode-make-webserver' for basic webserver details."
+ (interactive
+ (list
+ (if (or (member "package.json" (directory-files default-directory))
+ (member "node_modules" (directory-files default-directory)))
+ default-directory
+ (read-from-minibuffer
+ "JS docroot: " default-directory nil nil
+ 'elnode-make-js-server/docroot-history
+ default-directory))
+ (read-from-minibuffer
+ "Port: " nil nil nil
+ 'elnode-make-js-server/port-history)
+ (if current-prefix-arg
+ (read-from-minibuffer
+ "Host: " nil nil nil
+ 'elnode-make-js-server/host-history)
+ elnode-init-host)))
+ (let ((handler
+ (lambda (httpcon)
+ (let ((elnode-send-file-assoc
+ '(("\\.js$" . elnode-js/browserify-send-func))))
+ (elnode--webserver-handler-proc
+ httpcon docroot elnode-webserver-extra-mimetypes)))))
+ (add-to-list
+ 'elnode--make-webserver-store
+ (cons docroot handler))
+ (elnode-start handler
+ :port (string-to-number (format "%s" port))
+ :host host)))
+
+(provide 'elnode-js)
+
+;;; elnode-js.el ends here
diff --git a/tests/elnode/elnode-lists.el b/tests/elnode/elnode-lists.el
new file mode 100644
index 0000000..93a9c63
--- /dev/null
+++ b/tests/elnode/elnode-lists.el
@@ -0,0 +1,163 @@
+;;; elnode-lists.el - management tools for elnode
+
+(require 'elnode)
+(require 'tabulated-list)
+(require 'noflet)
+(require 'dash)
+
+
+;;; Deferred queue list
+
+;;;###autoload
+(defun elnode-deferred-queue (arg)
+ "Message the length of the deferred queue."
+ (interactive "P")
+ (if (not arg)
+ (message
+ "elnode deferred queue: %d %s"
+ (length elnode--deferred)
+ elnode--defer-timer)
+ (setq elnode--deferred (list))
+ (message "elnode deferred queue reset!")))
+
+(defun elnode--list-deferreds ()
+ "List the deferred servers."
+ ;; TODO have the defer stuff put a better reference to the actual
+ ;; handler onto the process?
+ ;;
+ ;; we could have the mapper add the mapped function to the process as well?
+ ;;
+ ;; into a list of mapped functions on this process?
+ (loop for (proc . deferred-closure) in elnode--deferred
+ collect
+ (list
+ proc
+ (let ((pl (process-plist proc)))
+ (vector (apply 'format "%s:%S" (process-contact proc))
+ (apply
+ 'format "%s.%s.%s.%s.:%s"
+ (mapcar 'identity (process-contact proc :local)))
+ (symbol-name (plist-get pl :elnode-http-handler))
+ (plist-get pl :elnode-http-resource))))))
+
+(define-derived-mode
+ elnode-deferred-list-mode tabulated-list-mode "Elnode defered queue list"
+ "Major mode for listing the currently deferred Elnode handlers."
+ (setq tabulated-list-entries 'elnode--list-deferreds)
+ (setq tabulated-list-format
+ [("Address" 15 nil)
+ ("Local server" 15 nil)
+ ("Handler function" 20 nil)
+ ("Resource" 30 nil)])
+ (tabulated-list-init-header))
+
+;;;###autoload
+(defun elnode-deferred-list (&optional prefix)
+ "List the currently deferred Elnode handlers."
+ (interactive "P")
+ (with-current-buffer (get-buffer-create "*elnode deferreds*")
+ (elnode-deferred-list-mode)
+ (tabulated-list-print)
+ (if prefix
+ (switch-to-buffer-other-window (current-buffer))
+ (switch-to-buffer (current-buffer)))))
+
+;;;###autoload
+(defalias 'list-elnode-deferreds 'elnode-deferred-list)
+
+;;; Server list
+
+(defun elnode--list-servers ()
+ "List the current Elnode servers for `elnode-list-mode'."
+ (noflet ((closurep (v)
+ (and (functionp v) (listp v) (eq (car v) 'closure))))
+ (-keep
+ (lambda (pair)
+ (let ((port (car pair)) (socket-proc (cdr pair)))
+ (if (process-live-p socket-proc)
+ (list
+ port
+ (let* ((fn (elnode/con-lookup socket-proc :elnode-http-handler))
+ (doc (when (functionp fn)
+ (documentation fn))))
+ (vector
+ (format "%s" port)
+ (if (rassoc fn elnode--make-webserver-store)
+ "elnode webserver"
+ ;; Else it's not in the webserver list
+ (cond
+ ((closurep fn) (format "%S" fn))
+ ((byte-code-function-p fn) (format "byte-code"))
+ ((and (listp fn)(eq (car fn) 'lambda)) (format
"lambda"))
+ (t (symbol-name fn))))
+ (or (if (and doc (string-match "^\\([^\n]+\\)" doc))
+ (match-string 1 doc)
+ (if (rassoc fn elnode--make-webserver-store)
+ (car (rassoc fn elnode--make-webserver-store))
+ "no documentation."))))))
+ ;; If the socket isn't live then take it out
+ (setq elnode-server-socket (delete pair elnode-server-socket))
+ nil)))
+ elnode-server-socket)))
+
+(defun elnode-lists-server-find-handler ()
+ "Find the handler mentioned in the handler list."
+ (interactive)
+ (let ((line
+ (buffer-substring-no-properties
+ (line-beginning-position)
+ (line-end-position))))
+ (when (string-match "^[0-9]+ +\\([^ ]+\\) .*" line)
+ (let ((handler-name (intern (match-string 1 line))))
+ (with-current-buffer
+ (find-file
+ (or (symbol-file handler-name)
+ (error "no such file")))
+ (find-function handler-name))))))
+
+(defun elnode-lists-kill-server ()
+ (interactive)
+ (goto-char (line-beginning-position))
+ (re-search-forward "^\\([^ ]+\\)" (line-end-position) t)
+ (let ((port (cond
+ ((> (string-to-int (match-string 1)) 0)
+ (string-to-int (match-string 1)))
+ ((file-exists-p (concat "/tmp/" (match-string 1)))
+ (match-string 1)))))
+ (when port
+ (elnode-stop port)
+ (let ((buffer-read-only nil))
+ (erase-buffer)
+ (tabulated-list-print)))))
+
+(define-derived-mode
+ elnode-list-mode tabulated-list-mode "Elnode server list"
+ "Major mode for listing Elnode servers currently running."
+ (setq tabulated-list-entries 'elnode--list-servers)
+ (define-key elnode-list-mode-map (kbd "\r")
+ 'elnode-lists-server-find-handler)
+ (define-key elnode-list-mode-map (kbd "k")
+ 'elnode-lists-kill-server)
+ (setq tabulated-list-format
+ [("Port" 10 nil)
+ ("Handler function" 20 nil)
+ ("Documentation" 80 nil)])
+ (tabulated-list-init-header))
+
+;;;###autoload
+(defun elnode-server-list (&optional prefix)
+ "List the currently running Elnode servers."
+ (interactive "P")
+ (with-current-buffer (get-buffer-create "*elnode servers*")
+ (elnode-list-mode)
+ (tabulated-list-print)
+ (if prefix
+ (switch-to-buffer-other-window (current-buffer))
+ (switch-to-buffer (current-buffer)))))
+
+;;;###autoload
+(defalias 'list-elnode-servers 'elnode-server-list)
+
+(provide 'elnode-list)
+
+;;; enlode-list.el ends here
diff --git a/tests/elnode/elnode-log-mode.el b/tests/elnode/elnode-log-mode.el
new file mode 100644
index 0000000..a84fd6e
--- /dev/null
+++ b/tests/elnode/elnode-log-mode.el
@@ -0,0 +1,22 @@
+;;; elnode-log-mode.el - view elnode log files nicely
+
+;;;###autoload
+(define-generic-mode 'elnode-log-mode
+ nil ; comments
+ nil; keywords
+ `(("^\\([0-9:-]+\\) .*" 1 '(face '(italic (:foreground "blue"))))
+ ("^[0-9:-]+ \\([32][0-9]\\{2\\}\\) .*" 1 '(face '(:foreground "green")))
+ ("^[0-9:-]+ \\(4[0-9]\\{2\\}\\) .*" 1 '(face '(:foreground "yellow")))
+ ("^[0-9:-]+ \\(5[0-9]\\{2\\}\\) .*" 1 '(face '(:foreground "red")))
+ ("^.* \\(GET\\|POST\\|HEAD\\|DELETE\\|TRACE\\)" 1 '(face '(bold
(:foreground "purple"))))) ; font-lock list
+ nil
+ '((lambda ()
+ ;;(use-local-map elnode-log-mode-map)
+ (setq buffer-read-only 't)
+ (set-buffer-modified-p nil)
+ ))
+ "Elnode log viewing mode.
+
+For viewing access log files from Elnode.")
+
+;;; elnode-log-mode.el ends here
diff --git a/tests/elnode/elnode-proxy.el b/tests/elnode/elnode-proxy.el
new file mode 100644
index 0000000..0caf434
--- /dev/null
+++ b/tests/elnode/elnode-proxy.el
@@ -0,0 +1,273 @@
+;;; elnode-proxy.el -- proxying with elnode -*- lexical-binding: t -*-
+
+;;; Commentary:
+
+;; This is stuff to let you make proxy servers with Elnode.
+
+
+;;; Code:
+
+(require 's)
+(require 'dash)
+(require 'web)
+(require 'elnode)
+(require 'kv)
+(require 'cl) ; for destructuring-bind
+
+(defun elnode--web->elnode-hdr (hdr httpcon)
+ "Send the HDR from the web HTTP request to Elnode's HTTPCON."
+ (let ((headers
+ (-filter
+ (lambda (hdr-pair)
+ (unless (member
+ (downcase (symbol-name (car hdr-pair)))
+ '("status-code" "status-string" "status-version"))
+ (cons (symbol-name (car hdr-pair))
+ (cdr hdr-pair))))
+ (kvhash->alist hdr))))
+ (apply 'elnode-http-start httpcon 200 headers)))
+
+(defun elnode--proxy-x-forwarded-for (httpcon)
+ "Return an X-Forwaded-For header."
+ (let ((ipaddr (elnode-get-remote-ipaddr httpcon))
+ (hdr (elnode-http-header httpcon "X-Forwarded-For")))
+ (if hdr
+ (concat hdr (format ", %s" ipaddr))
+ ipaddr)))
+
+(defun elnode-proxy-do (httpcon url)
+ "Do proxying to URL on HTTPCON.
+
+A request is made to the specified URL. The URL may include
+`s-format' patterns for interpolation with any of these
+variables:
+
+ path - the path from the HTTPCON
+ params - the params from the HTTPCON
+ query - the params from the HTTPCON as a query
+
+For example, \"http://myserver:8000${path}${query}\"; would cause
+\"myserver\" on port 8000 to get the query from the user with the
+specified path and query."
+ (let* ((method (elnode-http-method httpcon))
+ (path (elnode-http-pathinfo httpcon))
+ (params (web-to-query-string
+ (elnode-http-params httpcon)))
+ (params-alist
+ (list
+ (cons "path" path)
+ (cons "query" (if (s-blank? params) ""
+ (concat "?" params)))
+ (cons "params" params)))
+ (web-url (s-format url 'aget params-alist))
+ hdr-sent)
+ (process-put
+ httpcon
+ :elnode-child-process
+ (web-http-call
+ method
+ (lambda (httpc hdr data)
+ (unless hdr-sent
+ (elnode--web->elnode-hdr hdr httpcon)
+ (setq hdr-sent t))
+ (if (eq data :done)
+ (elnode-http-return httpcon)
+ (elnode-http-send-string httpcon data)))
+ :mode 'stream
+ :url web-url
+ :extra-headers
+ `(("X-Forwarded-For"
+ . ,(elnode--proxy-x-forwarded-for httpcon))
+ ("X-Proxy-Client" . "elnode/web"))))))
+
+(defun elnode-proxy-bounce (httpcon handler host-port)
+ "Bounce this request.
+
+If HTTPCON is not a request for port HOST-PORT then bounce to
+HOST-PORT, else it is a request on HOST-PORT so pass to HANDLER."
+ (destructuring-bind (hostname this-port)
+ (split-string (elnode-server-info httpcon) ":")
+ (if (equal (format "%s" this-port)
+ (format "%s" host-port))
+ (funcall handler httpcon)
+ (elnode-proxy-do
+ httpcon
+ (format "http://%s:%s${path}${query}"; hostname host-port)))))
+
+(defun elnode-proxy-make-bouncer (handler host-port)
+ "Make a proxy bouncer handler for HANDLER proc on OTHER-PORT.
+
+This is for managing proxy calls. If the resulting handler
+receives a call on anything than HOST-PORT then it proxies the
+request to the HOST-PORT. Otherwise it just handles the
+request."
+ (lambda (httpcon)
+ (elnode-proxy-bounce httpcon handler host-port)))
+
+;;;###autoload
+(defun elnode-make-proxy (url)
+ "Make a proxy handler sending requests to URL.
+
+See `elnode-proxy-do' for how URL is handled.
+
+An HTTP user-agent with a specified HTTP proxy sends the full
+request as the path, eg:
+
+ GET http://somehost:port/path?query HTTP/1.1
+
+So `elnode-make-proxy' can make (something like) a full proxy
+server with:
+
+ (elnode-make-proxy \"${path}${query}\")
+
+There may be many things that a full proxy does that this does
+not do however.
+
+Reverse proxying is a simpler and perhaps more useful.
+
+Proxying is a form of shortcut evaluation. This function returns
+having bound it's HTTP connection paremeter to a process which
+will deliver the content from the downstream HTTP connection."
+ (lambda (httpcon)
+ (elnode-proxy-do httpcon url)))
+
+(defvar elnode--proxy-server-port-history nil
+ "History variable used for proxy server port reading.")
+
+(defvar elnode--proxy-server-goto-url-history nil
+ "History variable used for proxy goto urls.")
+
+;;;###autoload
+(defun elnode-make-proxy-server (port &optional url)
+ "Make a proxy server on the specified PORT.
+
+Optionally have requests go to URL. If URL is not specified it
+is \"${path}${query}\".
+
+Interactively use C-u to specify the URL."
+ (interactive
+ (list
+ (read-from-minibuffer
+ "proxy server port:" nil nil nil
+ 'elnode--proxy-server-port-history)
+ (if current-prefix-arg
+ (read-from-minibuffer
+ "proxy server goto url:" "${path}${query}" nil nil
+ 'elnode--proxy-server-goto-url-history
+ "${path}${query}")
+ "${path}${query}")))
+ (let ((proxy-handler
+ (elnode-make-proxy (or url "${path}${query}"))))
+ (elnode-start proxy-handler :port port)))
+
+
+(defun elnode-send-proxy-redirect (httpcon location)
+ "Send back a proxy redirect to LOCATION.
+
+A proxy redirect is setting \"X-Accel-Redirect\" to a location,
+proxies can interpret the header with some kind of internal only
+URL resolution mechanism and do dispatch to another backend
+without sending the redirect back to the origin UA."
+ (elnode-http-header-set
+ httpcon "X-Accel-Redirect" location)
+ ;; This is an nginx specific hack because it seems nginx kills the
+ ;; socket once the accel header arrives
+ (condition-case err
+ (elnode-send-redirect httpcon location)
+ (error (unless (string-match
+ "\\(SIGPIPE\\|no longer connected\\)"
+ (format "%s" (cdr err)))
+ (signal (car err) (cdr err))))))
+
+(defun elnode-send-proxy-location (httpcon location)
+ "Send LOCATION with proxying techniques.
+
+If the HTTPCON comes from a proxy (detected by checking the
+\"X-Forwarded-For\") then an `elnode-send-proxy-redirect' to
+location is sent.
+
+Alternately it sets up a direct proxy call to the current server
+for the location. So, either way, this call causes a shortcut
+evaluation. Either the upstream proxy server handles the request
+or we return having bound the current HTTPCON to an internal
+proxy connection."
+ (if (and (elnode-http-header httpcon "X-Forwarded-For")
+ (not (equal
+ "elnode/web"
+ (elnode-http-header httpcon "X-Proxy-Client"))))
+ (elnode-send-proxy-redirect httpcon location)
+ ;; Else we're not behind a proxy, send a proxy version
+ (let* ((server (elnode-server-info httpcon))
+ (url (format "http://%s%s"; server location)))
+ (funcall (elnode-make-proxy url) httpcon))))
+
+(defun* elnode-proxy-post (httpcon path
+ &key (mode 'batch)
+ callback data extra-headers)
+ "Make an HTTP call to localhost or the first upstream proxy."
+ (let* ((hp-pair
+ (if (elnode-http-header httpcon "X-Forwarded-For")
+ (elnode-get-remote-ipaddr httpcon)
+ (elnode-server-info httpcon)))
+ (url (format "http://%s%s"; hp-pair path)))
+ (web-http-post
+ (or callback
+ (lambda (httpc hdr data)
+ (elnode-error
+ "%s post response %S %s"
+ httpcon hdr data)))
+ :url url :mode mode :data data
+ :extra-headers extra-headers)))
+
+(defun elnode/proxy-route (httpcon service handler path)
+ "Proxies a particular route from `elnode-route'."
+ (let* ((server (process-get httpcon :server))
+ (p2 path)
+ (maps (process-get server :elnode-service-map))
+ (port
+ (or
+ (kva service maps)
+ (string-to-number
+ (cadr
+ (split-string
+ (elnode-server-info httpcon) ":"))))))
+ ;; Wrap the handler in a bouncer
+ (elnode-proxy-bounce httpcon handler port)))
+
+(defun elnode-route (httpcon routes)
+ "Pass HTTPCON to the handler decided by ROUTES.
+
+ROUTES is a routing table matching regexs to handlers with extra
+meta information. Routes may do additional things like cause a
+route to be proxyed to another server.
+
+Using ROUTES you can describe complex multi-process, multi-port
+elnode configurations.
+
+ROUTES is an alist where each element looks like (REGEXP
+. FUNCTION) or (REGEXP FUNCTION `:service' SERVICE-NAME).
+SERVICE-NAME is a name that may be attached to the route so that
+it can be mapped to a TCP port, or even another Emacs process.
+Mapping service names is done by `elnode-start'."
+ (let*
+ (services
+ (rtable
+ (loop for (path . resource) in table
+ collect
+ (if (atom resource)
+ (list path resource)
+ ;; Else it's a more complex resource description
+ (let* ((handler (car resource))
+ (service (plist-get (cdr resource) :service))
+ ;; Make the function from the resource description
+ (func
+ (lambda (httpcon)
+ (elnode/proxy-route
+ httpcon service handler path))))
+ (when service (push service services))
+ (list path func))))))
+ (elnode-hostpath-dispatcher httpcon rtable)))
+
+(provide 'elnode-proxy)
+
+;;; elnode-proxy.el ends here
diff --git a/tests/elnode/elnode-rle.el b/tests/elnode/elnode-rle.el
new file mode 100644
index 0000000..705e698
--- /dev/null
+++ b/tests/elnode/elnode-rle.el
@@ -0,0 +1,387 @@
+;;; elnode-rle.el --- Remote Lisp Executiion with Elnode -*- lexical-binding:
t -*-
+
+;; Copyright (C) 2012 Nic Ferrier
+
+;; Author: Nic Ferrier
+;; Keywords: lisp, hypermedia, processes
+
+;; 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 an elnode handler and tools for doing asynchrous
+;; programming.
+;;
+;; The idea is that you can setup associated child processes and pass
+;; them work to do and receive their output over HTTP.
+
+;;; Code:
+
+(require 'elnode)
+(require 'web)
+(require 'loadhist)
+(require 'server)
+
+(defun elnode-rle--handler (httpcon)
+ "Remote Lisp Evaluator handler.
+
+This can be spawned in a client to allow any lisp code to be
+passed over the client-server link."
+ (let* ((lisp-to-run (elnode-http-param httpcon "lisp"))
+ (lisp
+ (if lisp-to-run
+ (car (read-from-string lisp-to-run))))
+ (bindings-to-use (elnode-http-param httpcon "bindings"))
+ (bindings
+ (if bindings-to-use
+ (car (read-from-string bindings-to-use))))
+ (to-eval (list 'let bindings lisp)))
+ (elnode-http-start httpcon 200 '("Content-type" . "text/plain"))
+ (let ((nomessage t))
+ (with-stdout-to-elnode httpcon
+ (eval to-eval)))))
+
+(ert-deftest elnode-rle--handler ()
+ "Test the Remote Lisp Evaluator handler."
+ :expected-result :failed
+ (flet ((lisp-encode (param lisp)
+ (cons param (format "%S" lisp)))
+ (do-test (lisp bindings)
+ (fakir-mock-process
+ :httpcon
+ ((:elnode-http-params (list lisp bindings)))
+ (elnode-rle--handler :httpcon)
+ (with-current-buffer (process-buffer :httpcon)
+ (goto-char (point-min))
+ ;; Find the header end.
+ (re-search-forward "\r\n\r\n" nil 't)
+ (buffer-substring (point) (point-max))))))
+ (should
+ (equal
+ ;; Match the content transfer encoded
+ "c\r\nhello world!\r\n0\r\n\r\n"
+ (let*
+ ((lisp (lisp-encode
+ "lisp" '(let ((a "hello world!")) (princ a))))
+ (bindings (lisp-encode
+ "bindings" '((a 10)(b 20)))))
+ (do-test lisp bindings))))
+ (should
+ (equal
+ "2\r\n30\r\n0\r\n\r\n"
+ (let*
+ ((lisp (lisp-encode
+ "lisp" '(let ((a (+ b 10))) (princ a))))
+ (bindings (lisp-encode
+ "bindings" '((a 10)(b 20)))))
+ (do-test lisp bindings))))))
+
+(defvar elnode-rle--servers (make-hash-table :test 'equal)
+ "The hash of RLE servers available.")
+
+(defun elnode-rle--load-path-ize (lisp)
+ "Wrap LISP in the current load-path."
+ (concat
+ ;; There is a very strange thing with sending lisp to
+ ;; (read) over a piped stream... (read) can't cope with
+ ;; multiple lines; so we encode newline here.
+ ;;(replace-regexp-in-string
+ ;; "\n"
+ ;; "\\\\n"
+ (format "(progn (setq load-path (quote %S)) %s)"
+ (append (list default-directory) load-path)
+ lisp)))
+
+(defun elnode-rle--handler-lisp (to-require)
+ "Return a file with Lisp to start Elnode with TO-REQUIRE.
+
+Used to construct the lisp to send. You're unlikely to need to
+override this at all, the function is just here to make the
+implementation easier to debug.
+
+TO-REQUIRE is a list of things to require, currently only 1 is
+allowed."
+ (let ((temp-file
+ (make-temp-file
+ (format "elnode-rle-%s" (symbol-name to-require)))))
+ (with-temp-file temp-file
+ (insert
+ (elnode-rle--load-path-ize
+ (format "(progn
+ (setq elnode-do-init nil)
+ (setq elnode--do-error-logging nil)
+ (require (quote %s))
+ (require (quote elnode-rle))
+ (toggle-debug-on-error)
+ (setq elnode-rle-port (elnode-find-free-service))
+ (elnode-start 'elnode-rle--handler :port elnode-rle-port)
+ (print (format \"\\nelnode-port=%%d\\n\" port)))"
+ to-require))))
+ temp-file))
+
+(defun elnode-rle--httpcon-mapper (client-header
+ client-data
+ elnode-httpcon
+ &optional end-callback)
+ "Elnode specific client connection to HTTP connection mapper.
+
+Maps client async data responses to an elnode server response."
+ (unless (process-get elnode-httpcon :elnode-rle-header-sent)
+ (elnode-http-start
+ elnode-httpcon
+ (gethash 'status-code client-header))
+ (process-put elnode-httpcon :elnode-rle-header-sent t))
+ (if (eq client-data :done)
+ (elnode-http-return elnode-httpcon) ; return if we're done
+ ;; Else just send the data
+ (elnode-http-send-string elnode-httpcon client-data)))
+
+(defun elnode-rle--client-data-mapper (con header data stream end-callback)
+ "Recevies data from the RLE server and sends it to the STREAM.
+
+END-CALLBACK is to be called when the client sees EOF."
+ (cond
+ ((processp stream) ; this should really elnode-http-p
+ (elnode-rle--httpcon-mapper header data stream end-callback))
+ ((bufferp stream)
+ (if (not (eq data :done))
+ (with-current-buffer stream
+ (save-excursion
+ (goto-char (point-max))
+ (insert data)))
+ ;; Process is done.
+ (and (functionp end-callback)
+ (funcall end-callback header))))))
+
+(defun elnode-rle--call-mapper (data-to-send stream port
+ &optional end-callback)
+ "Make a client call to PORT mapping response to STREAM.
+
+When it finishes, call END-CALLBACK, if present, with the header."
+ (web-http-post
+ (lambda (con header data)
+ (elnode-rle--client-data-mapper
+ con
+ header
+ data
+ stream
+ end-callback))
+ "/"
+ :host "localhost"
+ :port port
+ :data data-to-send
+ :mime-type "application/x-elnode"
+ :mode 'stream))
+
+(defun elnode-rle--make-server (to-require)
+ "Make an RLE server, a child Emacs running the RLE handler.
+
+Return a proc that represents the child process. The child
+process has a property `:exec' which is a function that calls the
+RLE handler in the child's Elnode server (waiting for the server
+to start first and provide the relevant port) by calling
+`elnode-rle-call-mapper' with the stream from the `:exec' call
+and the child's remote HTTP port.
+
+The `:exec' proc will signal `elnode-rle-child-port' if the child
+server does not start properly." ; yes. I know it's bloody complicated.
+ (let* ((proc-buffer
+ (get-buffer-create
+ (format "* %s *" "thingy")))
+ (emacsrun
+ "/usr/bin/emacs -Q --daemon=elnode-debugit")
+ (proc
+ (start-process-shell-command
+ "elnode-rle-server"
+ proc-buffer
+ emacsrun))
+ (file-of-lisp
+ (elnode-rle--handler-lisp
+ to-require)))
+ ;; Start elnode in it
+ (server-eval-at "elnode-debugit" `(load-file ,file-of-lisp))
+ (process-put proc :daemonhandle "elnode-debugit")
+ (process-put
+ proc
+ :port
+ (server-eval-at
+ (process-get proc :daemonhandle)
+ 'elnode-rle-port))
+ ;; Collect the port from the remote Emacs
+ ;; - FIXME this should also collect the secure token
+ (set-process-filter
+ proc
+ (lambda (proc data)
+ ;; Optional delay for test reasons
+ (with-current-buffer (process-buffer proc)
+ (save-excursion
+ (goto-char (point-max))
+ (insert data)))))
+ ;; Make a handler to call the server
+ (process-put
+ proc :exec
+ (lambda (data stream &optional end-callback)
+ (let ((ephemeral-port (process-get proc :port)))
+ (elnode-rle--call-mapper data stream ephemeral-port end-callback))))
+ proc))
+
+(defun elnode-rle--sender (stream to-require bindings body
+ &optional end-callback)
+ "Make a call using a client to the RLE server elsewhere.
+
+The RLE server is reused over TO-REQUIRE, if it's not already
+existing, it is created."
+ (let ((server (gethash to-require elnode-rle--servers)))
+ ;; Make the server if we don't have it
+ (unless server
+ (setq server
+ (puthash to-require
+ (elnode-rle--make-server (car to-require))
+ elnode-rle--servers)))
+ ;; Now make the call to the server
+ (let ((data (make-hash-table :test 'equal)))
+ (puthash "bindings" (format "%S" bindings) data)
+ (puthash "lisp" (format "%S" body) data)
+ (let ((client-connection
+ (funcall
+ (process-get server :exec)
+ data
+ stream
+ end-callback)))
+ ;; If we're streaming to elnode then we need to mark the connection
+ (when (processp stream)
+ (process-put
+ stream
+ :elnode-child-process
+ client-connection))))))
+
+(defvar elnode-rle--async-do-end-callback nil
+ "Used by `elnode-async-do' as the source of an end-callback.
+
+This is just used by tests for end signalling.")
+
+(defmacro elnode-async-do (stream
+ requires requirements
+ with-environment bindings
+ do &rest body)
+ "Execute the BODY in a remote Emacs.
+
+The STREAM is used to handle any output.
+
+The REQUIREMENTS is a list of provide symbol names that will be
+used to establish the right environment in the remote.
+
+The BINDINGS are also sent to the remote.
+
+TODO
+
+security for the remote using the stored key."
+ (assert (eq with-environment 'with-environment))
+ (assert (eq requires 'requires))
+ (assert (eq do 'do))
+ (let ((bodyv (make-symbol "body"))
+ (bindsv (make-symbol "binds"))
+ (streamv (make-symbol "streamv"))
+ (requirev (make-symbol "providing")))
+ `(let* ((,streamv ,stream)
+ (,bodyv (quote (progn ,@body)))
+ (,bindsv (list
+ ,@(loop for p in bindings
+ collect
+ (if (and p (listp p))
+ (list 'list `(quote ,(car p)) (cadr p))
+ (list 'cons `,p nil)))))
+ (,requirev (quote ,requirements)))
+ (elnode-rle--sender
+ ,streamv ,requirev ,bindsv ,bodyv
+ elnode-rle--async-do-end-callback))))
+
+(defmacro with-elnode-rle-wait (&rest body)
+ "Simplify the wait for RLE; for testers."
+ `(unwind-protect
+ (let (ended)
+ (progn
+ ,@body)
+ (while (not ended) (sit-for 1)))
+ ;; FIXME - can we get to the name of this?
+ (server-eval-at "elnode-debugit" '(kill-emacs))))
+
+(ert-deftest elnode-rle--make-server ()
+ "Test making an RLE server.
+
+Do it all 3 ways: directly with the `elnode-rle-make-server',
+with the `elnode-rle--sender' function and finally with the user
+facing macro `elnode-async-do'.
+
+The output from the RLE call is collected in a buffer
+and tested."
+ :expected-result :failed
+ (flet ((make-hash (bindings)
+ (let ((h (make-hash-table :test 'equal)))
+ (loop for b in bindings
+ do (puthash (car b) (cadr b) h))
+ h)))
+ ;; Do it RAW
+ (should
+ (equal
+ "hello"
+ (with-temp-buffer
+ (let* ((child-proc (elnode-rle--make-server 'elnode))
+ (daemon-handler (process-get child-proc :daemonhandle))
+ (collect-buf (current-buffer)))
+ (with-elnode-rle-wait
+ (funcall
+ (process-get child-proc :exec)
+ (make-hash '(("bindings" "((a \"hello\"))")
+ ("lisp" "(princ \"hello\")")))
+ (current-buffer)
+ (lambda (hdr) ; the end proc
+ (setq ended t))))
+ (buffer-substring (point-min) (point-max))))))
+ ;; Do it via the sender func
+ (should
+ (equal
+ "40"
+ (with-temp-buffer
+ (with-elnode-rle-wait
+ (let ((elnode-rle--servers (make-hash-table :test 'equal)))
+ (elnode-rle--sender
+ (current-buffer)
+ '(elnode)
+ '((a 10) (b 20))
+ '(let ((c 30))(princ (+ c a)))
+ (lambda (header)
+ (message "elnode-rle: all done!")(setq ended t)))))
+ (buffer-substring (point-min) (point-max)))))
+ ;; Do it with the macro
+ (should
+ (equal
+ "hello"
+ (with-temp-buffer
+ (with-elnode-rle-wait
+ (let ((elnode-rle--servers (make-hash-table :test 'equal))
+ (elnode-rle--async-do-end-callback
+ (lambda (header)
+ (message "elnode-rle: in the dyn bound callback!")
+ (setq ended t))))
+ (elnode-async-do
+ (current-buffer)
+ requires (elnode enode-rle)
+ with-environment ((a 10)(b 20))
+ do (princ "hello"))))
+ (buffer-substring (point-min) (point-max)))))))
+
+(provide 'elnode-rle)
+
+;; elnode-rle ends here
diff --git a/tests/elnode/elnode-testsupport.el
b/tests/elnode/elnode-testsupport.el
new file mode 100644
index 0000000..0b93326
--- /dev/null
+++ b/tests/elnode/elnode-testsupport.el
@@ -0,0 +1,239 @@
+;;; test support functions for elnode -*- lexical-binding: t -*-
+
+(require 'noflet)
+(require 'ert)
+
+(defmacro elnode-sink (httpcon &rest body)
+ "Sink the HTTP response from BODY.
+
+Output to `elnode-http-start', `elnode-http-send-string' and
+`elnode-http-return' is collected and stored internallly.
+
+When `elnode-http-return' is called the form ends with a string
+result of whatever was sent as the response. The string is
+propertized with the header sent to `elnode-http-start'."
+ (declare (indent 1)(debug (sexp &rest form)))
+ `(let (res reshdr)
+ (catch :elnode-sink-ret
+ (noflet ((elnode-http-start (httpcon status &rest header)
+ (setq reshdr
+ (kvalist->plist header)))
+ (elnode-http-header-set (httpcon header &optional value)
+ (setq reshdr
+ (plist-put (intern (concat ":" reshdr))
+ header value)))
+ (elnode-http-send-string (httpcon data)
+ (setq res (apply 'propertize
+ (concat res data) reshdr)))
+ (elnode-http-return (httpcon &optional data)
+ (when data
+ (setq res (apply 'propertize
+ (concat res data) reshdr)))
+ (throw :elnode-sink-ret :end)))
+ ,@body))
+ res))
+
+(defmacro elnode-fake-params (httpcon params-list &rest body)
+ "Fake the PARAM-BINDINGS and evaluate BODY.
+
+PARAM-BINDINGS is an ALIST with string cars for parameter names
+and string cdrs for values. A cdr of a list can be used to
+provide a string value with a property list, for example:
+
+ '((\"param1\" . \"value\" )
+ (\"param2\" \"value\" :elnode-filename \"somefile.txt\"))
+
+Note the first parameter is an improper list.
+
+PARAM-BINDINGS should be quoted."
+ (declare (indent 2)
+ (debug (sexp sexp &rest form)))
+ (let ((httpconv (make-symbol "httpconv"))
+ (paramsv (make-symbol "paramsv")))
+ `(let ((,httpconv ,httpcon)
+ (,paramsv ,params-list))
+ (noflet ((elnode-http-param (httpc param-name)
+ (if (eq httpc ,httpcon)
+ (let ((v (kva param-name ,paramsv)))
+ (cond
+ ((listp v)
+ (apply 'propertize (car v) (cdr v)))
+ (t v)))
+ (funcall this-fn httpcon param-name))))
+ ,@body))))
+
+
+;; Extensions to ert
+
+(defmacro should-equal (a b)
+ "Simple shortcut for `(should (equal a b))'."
+ `(should
+ (equal ,a ,b)))
+
+(defmacro should-match (regex a)
+ "Simple shortcut for a `string-match' with `should'."
+ `(should
+ (string-match
+ ,regex
+ ,a)))
+
+(defmacro* should-elnode-response (call
+ &key
+ status-code
+ header-name
+ header-value
+ header-list
+ header-list-match
+ body-match)
+ "Assert on the supplied RESPONSE.
+
+CALL should be an `elnode-test-call', something that can make a
+response. Assertions are done by checking the specified values
+of the other parameters to this function.
+
+If STATUS-CODE is not nil we assert that the RESPONSE status-code
+is equal to the STATUS-CODE.
+
+If HEADER-NAME is present then we assert that the RESPONSE has
+the header and that its value is the same as the HEADER-VALUE.
+If HEADER-VALUE is `nil' then we assert that the HEADER-NAME is
+NOT present.
+
+If HEADER-LIST is present then we assert that all those headers
+are present and `equal' to the value.
+
+If HEADER-LIST-MATCH is present then we assert that all those
+headers are present and `equal' to the value.
+
+If BODY-MATCH is present then it is a regex used to match the
+whole body of the RESPONSE."
+ (let ((status-codev (make-symbol "status-codev"))
+ (header-namev (make-symbol "header-namev"))
+ (header-valuev (make-symbol "header-valuev"))
+ (header-listv (make-symbol "header-listv"))
+ (header-list-matchv (make-symbol "header-list-match"))
+ (body-matchv (make-symbol "body-matchv"))
+ (responsev (make-symbol "responsev")))
+ `(let ((,responsev ,call)
+ (,status-codev ,status-code)
+ (,header-namev ,header-name)
+ (,header-valuev ,header-value)
+ (,header-listv ,header-list)
+ (,header-list-matchv ,header-list-match)
+ (,body-matchv ,body-match))
+ (when ,status-codev
+ (should
+ (equal
+ ,status-codev
+ (plist-get ,responsev :status))))
+ (when (or ,header-namev ,header-listv ,header-list-matchv)
+ (let ((hdr (plist-get ,responsev :header)))
+ (when ,header-namev
+ (if ,header-valuev
+ (should
+ (equal
+ ,header-valuev
+ (assoc-default ,header-namev hdr)))
+ ;; Else we want to ensure the header isn't there
+ (should
+ (eq nil (assoc-default ,header-namev hdr)))))
+ (when ,header-listv
+ (loop for reqd-hdr in ,header-listv
+ do (should
+ (equal
+ (assoc-default (car reqd-hdr) hdr)
+ (cdr reqd-hdr)))))
+ (when ,header-list-matchv
+ (loop for reqd-hdr in ,header-list-matchv
+ do (should
+ (>=
+ (string-match
+ (cdr reqd-hdr)
+ (assoc-default (car reqd-hdr) hdr)) 0))))))
+ (when ,body-matchv
+ (should-match
+ ,body-matchv
+ (plist-get ,responsev :result-string))))))
+
+
+(defmacro* assert-elnode-response (call
+ &key
+ status-code
+ header-name
+ header-value
+ header-list
+ header-list-match
+ body-match)
+ "Assert on the supplied RESPONSE.
+
+CALL should be an `elnode-test-call', something that can make a
+response. Assertions are done by checking the specified values
+of the other parameters to this function.
+
+If STATUS-CODE is not nil we assert that the RESPONSE status-code
+is equal to the STATUS-CODE.
+
+If HEADER-NAME is present then we assert that the RESPONSE has
+the header and that its value is the same as the HEADER-VALUE.
+If HEADER-VALUE is `nil' then we assert that the HEADER-NAME is
+NOT present.
+
+If HEADER-LIST is present then we assert that all those headers
+are present and `equal' to the value.
+
+If HEADER-LIST-MATCH is present then we assert that all those
+headers are present and `equal' to the value.
+
+If BODY-MATCH is present then it is a regex used to match the
+whole body of the RESPONSE."
+ (let ((status-codev (make-symbol "status-codev"))
+ (header-namev (make-symbol "header-namev"))
+ (header-valuev (make-symbol "header-valuev"))
+ (header-listv (make-symbol "header-listv"))
+ (header-list-matchv (make-symbol "header-list-match"))
+ (body-matchv (make-symbol "body-matchv"))
+ (responsev (make-symbol "responsev")))
+ `(let ((,responsev ,call)
+ (,status-codev ,status-code)
+ (,header-namev ,header-name)
+ (,header-valuev ,header-value)
+ (,header-listv ,header-list)
+ (,header-list-matchv ,header-list-match)
+ (,body-matchv ,body-match))
+ (when ,status-codev
+ (assert
+ (equal
+ ,status-codev
+ (plist-get ,responsev :status))))
+ (when (or ,header-namev ,header-listv ,header-list-matchv)
+ (let ((hdr (plist-get ,responsev :header)))
+ (when ,header-namev
+ (if ,header-valuev
+ (assert
+ (equal
+ ,header-valuev
+ (assoc-default ,header-namev hdr)))
+ ;; Else we want to ensure the header isn't there
+ (assert
+ (eq nil (assoc-default ,header-namev hdr)))))
+ (when ,header-listv
+ (loop for reqd-hdr in ,header-listv
+ do (assert
+ (equal
+ (assoc-default (car reqd-hdr) hdr)
+ (cdr reqd-hdr)))))
+ (when ,header-list-matchv
+ (loop for reqd-hdr in ,header-list-matchv
+ do (assert
+ (>=
+ (string-match
+ (cdr reqd-hdr)
+ (assoc-default (car reqd-hdr) hdr)) 0))))))
+ (when ,body-matchv
+ (assert
+ (string-match ,body-matchv (plist-get ,responsev :result-string))))
+ ,responsev)))
+
+(provide 'elnode-testsupport)
+
+;;; elnode-testsupport.el ends here
diff --git a/tests/elnode/elnode-tools.el b/tests/elnode/elnode-tools.el
new file mode 100644
index 0000000..823b202
--- /dev/null
+++ b/tests/elnode/elnode-tools.el
@@ -0,0 +1,103 @@
+;;; elnode-tools.el --- dev tools for elnode -*- lexical-binding: t -*-
+
+;; Copyright (C) 2014 Nic Ferrier
+
+;; Author: Nic Ferrier <nferrier@ferrier.me.uk>
+;; Keywords: lisp
+
+;; 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:
+
+;; Just some tools to help debug and improve elnode
+
+;;; Code:
+
+(require 'elp)
+(require 'elnode)
+(require 'dash)
+(require 'profiler)
+(require 'cl-macs)
+
+(defun process-sentinel-set (proc func)
+ (set-process-sentinel proc func)
+ proc)
+
+(defvar elnode-elp-do-profiler nil)
+
+(defun elnode-elp-handler (httpcon)
+ (let ((elnode-webserver-visit-file t))
+ (elnode-docroot-for "~/sources/emacs/etc/"
+ :with file
+ :on httpcon
+ :do (elnode-send-file httpcon file))))
+
+(defun elnode-elp (&optional port)
+ (interactive
+ (list
+ (when current-prefix-arg
+ (string-to-number
+ (read-from-minibuffer "port to hit: ")))))
+ (let ((sock (or port 8001))
+ (elnode--do-error-logging :status))
+ (unless (kva sock elnode-server-socket)
+ (elnode-start 'elnode-elp-handler :port 8001))
+ (let ((elnode--do-error-logging :warning))
+ (when elnode-elp-do-profiler
+ (profiler-stop)
+ (profiler-start 'cpu))
+ (elp-reset-all)
+ (elp-instrument-package "elnode")
+ (elp-instrument-package "kv")
+ (elp-instrument-package "process")
+ (elp-instrument-package "set-process")
+ (let (fin)
+ (switch-to-buffer
+ (process-buffer
+ (process-sentinel-set
+ (start-process-shell-command
+ "elnode-ab" "elnode-ab"
+ (format
+ (concat
+ "ab -r -n 4000 -c 200 -s 20 "
+ "http://127.0.0.1:%s/COPYING "
+ " > /tmp/elnode-elp-101.txt") sock))
+ (lambda (proc status) (setq fin t)))))
+ (while (not fin) (sleep-for 20))
+ (when elnode-elp-do-profiler
+ (profiler-report)
+ (profiler-stop))
+ (when (get-buffer "elnode-elp-101.txt")
+ (with-current-buffer (get-buffer "elnode-elp-101.txt")
+ (set-buffer-modified-p nil)))
+ (find-file "/tmp/elnode-elp-101.txt")
+ (elp-results)
+ (elp-reset-all)))))
+
+(defun elnode-check-request-buffers ()
+ (interactive)
+ (noflet ((request-buffers ()
+ (->> (buffer-list)
+ (-filter
+ (lambda (b) (string-match " \\*elnode.*" (buffer-name b)))))))
+ (let ((before (request-buffers)))
+ (-each (request-buffers) (lambda (b) (kill-buffer b)))
+ (message "request buffers: %d > %d"
+ (length before)
+ (length (request-buffers))))))
+
+
+(provide 'elnode-tools)
+
+;;; elnode-tools.el ends here
diff --git a/tests/elnode/elnode-wiki.el b/tests/elnode/elnode-wiki.el
new file mode 100644
index 0000000..2298d83
--- /dev/null
+++ b/tests/elnode/elnode-wiki.el
@@ -0,0 +1,232 @@
+;;; elnode-wiki.el --- a wiki with Elnode -*- lexical-binding: t -*-
+
+;; Copyright (C) 2010, 2011, 2012 Nic Ferrier
+
+;; Author: Nic Ferrier <nferrier@ferrier.me.uk>
+;; Maintainer: Nic Ferrier <nferrier@ferrier.me.uk>
+;; Created: 5th October 2010
+;; Keywords: lisp, http, hypermedia
+
+;; 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 this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; This is a Wiki Engine completely written in EmacsLisp, using Elnode
+;; as a server.
+;;
+;;; Source code
+;;
+;; elnode's code can be found here:
+;; http://github.com/nicferrier/elnode
+
+;;; Style note
+;;
+;; This codes uses the Emacs style of:
+;;
+;; elnode-wiki--private-function
+;;
+;; for private functions.
+
+
+;;; Code:
+
+(require 'elnode)
+(require 'db)
+(eval-when-compile 'fakir)
+(require 'creole nil 't)
+;;(require 'vc)
+
+(defgroup elnode-wikiserver nil
+ "A Wiki server written with Elnode."
+ :group 'elnode)
+
+;;;###autoload
+(defconst elnode-wikiserver-wikiroot-default
+ (expand-file-name (concat elnode-config-directory "wiki/"))
+ "The default location of the wiki root.
+
+This is used to detect whether elnode needs to create this
+directory or not.")
+
+;;;###autoload
+(defcustom elnode-wikiserver-wikiroot
+ elnode-wikiserver-wikiroot-default
+ "The root for the Elnode wiki files.
+
+This is where elnode-wikiserver serves wiki files from."
+ :type '(directory)
+ :group 'elnode-wikiserver)
+
+(defcustom elnode-wikiserver-body-header
+ "<div id='top'></div>"
+ "HTML BODY preamable of a rendered Wiki page."
+ :type '(string)
+ :group 'elnode-wikiserver)
+
+(defcustom elnode-wikiserver-body-footer
+ "<div id='footer'>
+<form action='{{page}}' method='POST'>
+<fieldset>
+<legend>Edit this page</legend>
+<textarea cols='80' rows='20' name='wikitext'>
+{{text}}
+</textarea><br/>
+<input type='text' name='comment' value=''/>
+<input type='submit' name='save' value='save'/>
+<input type='submit' name='preview' value='preview'/>
+</fieldset>
+</form>
+</div>"
+ "HTML BODY footter for a rendered Wiki page."
+ :type '(string)
+ :group 'elnode-wikiserver)
+
+(defcustom elnode-wikiserver-body-footer-not-loggedin
+ "<div id='footer'>
+ <a href='/wiki/login/?redirect={{page}}'>login to edit</a>
+ </div>"
+ "HTML BODY footter for a rendered Wiki page."
+ :type '(string)
+ :group 'elnode-wikiserver)
+
+(defun elnode-wiki--setup ()
+ "Setup the wiki."
+ (elnode--dir-setup elnode-wikiserver-wikiroot
+ elnode-wikiserver-wikiroot-default
+ "default-wiki-index.creole"
+ "index.creole"
+ "default-wiki-logo.gif"))
+
+;; Internal wiki stuff
+
+(defvar elnode-wiki-db
+ (db-make
+ `(db-hash
+ :filename
+ ,(expand-file-name
+ (concat elnode-config-directory "elnode-wiki-auth")))))
+
+;; Define the authentication scheme for the wiki
+(elnode-defauth 'elnode-wiki-auth
+ :auth-db elnode-wiki-db
+ :redirect "/wiki/login/")
+
+(defun elnode-wiki-page (httpcon wikipage &optional pageinfo)
+ "Creole render a WIKIPAGE back to the HTTPCON."
+ ;; Otherwise just do it
+ (elnode-http-start httpcon 200 `("Content-type" . "text/html"))
+ (with-stdout-to-elnode httpcon
+ (let ((page-info (or pageinfo (elnode-http-pathinfo httpcon)))
+ (header elnode-wikiserver-body-header)
+ (footer (if-elnode-auth httpcon 'elnode-wiki-auth
+ elnode-wikiserver-body-footer
+ elnode-wikiserver-body-footer-not-loggedin)))
+ (creole-wiki
+ wikipage
+ :destination t
+ :variables (list (cons 'page page-info))
+ :body-header header
+ :body-footer footer))))
+
+(defun elnode-wiki--text-param (httpcon)
+ "Get the text param from HTTPCON and convert it."
+ (replace-regexp-in-string
+ "\r" "" ; browsers send text in DOS line ending format
+ (elnode-http-param httpcon "wikitext")))
+
+(defun elnode-wiki--save-request (httpcon wikiroot path text)
+ "Process an update request."
+ (let* ((page (if path
+ (save-match-data
+ (string-match "/wiki/\\(.*\\)$" path)
+ (match-string 1 path))))
+ (comment (elnode-http-param httpcon "comment"))
+ (file-name (if (equal page "")
+ (concat wikiroot "index.creole")
+ (concat (file-name-as-directory wikiroot) page)))
+ (buffer (find-file-noselect file-name)))
+ (with-current-buffer buffer
+ (erase-buffer)
+ (insert text)
+ (save-buffer)
+ (let ((git-buf
+ (get-buffer-create
+ (generate-new-buffer-name
+ "* elnode wiki commit buf *"))))
+ (shell-command
+ (format "git commit -m '%s' %s" comment file-name)
+ git-buf)
+ (kill-buffer git-buf))
+ (elnode-wiki-page httpcon file-name))))
+
+(defun elnode-wiki-handler (httpcon wikiroot)
+ "A low level handler for Wiki operations.
+
+Send the Wiki page requested, which must be a file existing under
+the WIKIROOT, back to the HTTPCON.
+
+Update operations are protected by authentication."
+ (elnode-method httpcon
+ (GET
+ (elnode-docroot-for wikiroot
+ with target-path
+ on httpcon
+ do
+ ;; Do we need to serve an index?
+ (if (equal target-path (expand-file-name (concat wikiroot "/")))
+ (elnode-wiki-page httpcon (concat wikiroot "/index.creole"))
+ ;; Else it's a wiki page or some collateral
+ (if (string-match "\\.creole$" target-path)
+ ;; Serve a creole page
+ (elnode-wiki-page httpcon target-path)
+ ;; Else serve just content
+ (elnode-send-file httpcon target-path)))))
+ (POST
+ (with-elnode-auth httpcon 'elnode-wiki-auth
+ (let* ((path (elnode-http-pathinfo httpcon))
+ (text (elnode-wiki--text-param httpcon)))
+ (if (not (elnode-http-param httpcon "preview"))
+ ;; A save request in which case save the new text and then
+ ;; send the wiki text.
+ (elnode-wiki--save-request httpcon wikiroot path text)
+ ;; Might be a preview request in which case send back the WIKI
+ ;; text that's been sent.
+ (with-temp-file "/tmp/preview"
+ (insert text))
+ (elnode-wiki-page httpcon "/tmp/preview" path)))))))
+
+;;;###autoload
+(defun elnode-wikiserver-test ()
+ "Test whether we should serve Wiki or not."
+ (featurep 'creole))
+
+;;;###autoload
+(defun elnode-wikiserver (httpcon)
+ "Serve Wiki pages from `elnode-wikiserver-wikiroot'.
+
+HTTPCON is the request.
+
+The Wiki server is only available if the `creole' package is
+provided. Otherwise it will just error."
+ (if (not (elnode-wikiserver-test))
+ (elnode-send-500 httpcon "The Emacs feature 'creole is required.")
+ (elnode-auth-dispatcher httpcon 'elnode-wiki-auth
+ (elnode-wiki--setup)
+ (elnode-wiki-handler httpcon elnode-wikiserver-wikiroot))))
+
+(provide 'elnode-wiki)
+
+;;; elnode-wiki.el ends here
diff --git a/tests/elnode/elnode.el b/tests/elnode/elnode.el
new file mode 100644
index 0000000..9907b90
--- /dev/null
+++ b/tests/elnode/elnode.el
@@ -0,0 +1,3772 @@
+;;; IMPORTANT!!!
+
+;; The following file is meant for testing, not usage! It has been
+;; heavily modified, so the original author should not be blaimed (or
+;; even bothered) by any bug that happens to be in this version.
+
+;;; elnode.el --- a simple emacs async HTTP server -*- lexical-binding: t -*-
+
+;; Copyright (C) 2010, 2011, 2012 Nic Ferrier
+
+;; Author: Nic Ferrier <nferrier@ferrier.me.uk>
+;; Maintainer: Nic Ferrier <nferrier@ferrier.me.uk>
+;; Created: 5th October 2010
+;; Keywords: lisp, http, hypermedia
+
+;; 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 this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Source code
+;;
+;; elnode's code can be found here:
+;; http://github.com/nicferrier/elnode
+
+;;; Style note
+;;
+;; This codes uses the Emacs style of:
+;;
+;; elnode--private-function
+;;
+;; for private functions.
+
+
+;;; Commentary:
+;;
+;; This is an elisp version of the popular node.js asynchronous
+;; webserver toolkit.
+;;
+;; You can define HTTP request handlers and start an HTTP server
+;; attached to the handler. Many HTTP servers can be started, each
+;; must have its own TCP port. Handlers can defer processing with a
+;; signal (which allows comet style resource management)
+;;
+;; See elnode-start for how to start an HTTP server.
+
+;;; Code:
+
+(require 'fakir)
+(require 'mm-encode)
+(require 'mailcap)
+(require 'mail-parse) ; for mail-header-parse-content-type
+(require 'url-util)
+(require 'kv)
+(require 's)
+(require 'dash)
+(require 'rx)
+(require 'web)
+(require 'json)
+(require 'db)
+(require 'dired) ; needed for the setup
+(require 'tabulated-list)
+(require 'noflet)
+
+(eval-when-compile (require 'cl))
+
+(require 'names)
+(defconst ELNODE-FORM-DATA-TYPE "application/x-www-form-urlencoded"
+ "The type of HTTP Form POSTs.")
+
+(defconst http-referrer 'referer
+ "Helper to bypass idiot spelling of the word `referrer'.")
+
+
+;; Customization stuff
+
+(defgroup elnode nil
+ "An extensible asynchronous web server for Emacs."
+ :group 'applications)
+
+
+
+(defmacro with-elnode-mock-server (handler &rest body)
+ "Execute BODY with a fake server which is bound to HANDLER.
+
+This is useful for doing end to end client testing:
+
+ (ert-deftest elnode-some-page ()
+ (with-elnode-mock-server 'elnode-hostpath-default-handler
+ (elnode-test-call \"/something/test\")))
+
+The test call with be passed to the
+`elnode-hostpath-default-handler' via the normal HTTP parsing
+routines."
+ (declare
+ (indent 1)
+ (debug t))
+ `(let ((elnode--cookie-store (make-hash-table :test 'equal)))
+ (noflet ((elnode/get-server-prop (proc key)
+ (cond
+ ((eq key :elnode-http-handler)
+ ,handler))))
+ ,@body)))
+
+(defmacro with-elnode-mock-httpcon (symbol elnode-plist &rest body)
+ "Mock an HTTP connection for SYMBOL and evaluate BODY.
+
+ELNODE-PLIST is either `nil' or a list of elnode properties, such
+as `:elnode-method'."
+ (declare
+ (debug (sexp sexp &rest form))
+ (indent 2))
+ `(fakir-mock-process ,symbol ()
+ (set-process-plist ,symbol (list (make-hash-table :test
'eq)))
+ (elnode/con-put ,symbol ,@elnode-plist)
+ (progn ,@body)))
+
+(defmacro with-stdout-to-elnode (httpcon &rest body)
+ "Execute BODY so that any output gets sent to HTTPCON."
+ (declare
+ (debug (sexp &rest form))
+ (indent defun))
+ (let ((hv (make-symbol "httpconvar"))
+ (val (make-symbol "value")))
+ `(with-temp-buffer
+ (let ((,hv ,httpcon)
+ (standard-output (current-buffer)))
+ (let ((,val (progn ,@body)))
+ (elnode-http-return ,hv (buffer-string)))))))
+
+(defmacro if-elnode-auth (httpcon scheme authd &rest anonymous)
+ "Check the HTTPCON for SCHEME auth and eval AUTHD.
+
+If the auth fails then evaluate ANONYMOUS instead.
+
+When evaling AUTHD the `:auth-username' property of the process is set
+to the user who authenticated."
+ (declare
+ (debug (sexp sexp form body))
+ (indent 2))
+ (let ((httpconv (make-symbol "httpconv")))
+ `(let ((,httpconv ,httpcon)
+ (scheme-list
+ (gethash ,scheme
+ elnode--defined-authentication-schemes)))
+ (if (eq :cookie (plist-get scheme-list :test))
+ (condition-case token
+ (let* ((cookie (plist-get scheme-list :cookie-name))
+ (username
+ (elnode-auth-cookie-check ,httpconv :cookie-name
cookie)))
+ (elnode/con-put ,httpconv :auth-username username)
+ ;; Do whatever the code was now.
+ ,authd)
+ ;; On auth failure do the ELSE
+ (elnode-auth-token (progn ,@anonymous)))
+ ;; Not a cookie test - not sure what to do...
+ (error 'elnode-not-a-cookie)))))
+
+(defmacro with-elnode-auth (httpcon scheme &rest body)
+ "Protect code with authentication using HTTPCON and SCHEME.
+
+This macro protects code in a handler with a check for an
+authenticated request (the check is configurable). If the check
+fails then an appropriate action is taken; for example, sending a
+login page.
+
+SCHEME is the authentication scheme to use as defined by
+`elnode-auth-define-scheme'."
+ (declare (debug (sexp sexp body))
+ (indent 2))
+ (let ((httpconv (make-symbol "httpconv")))
+ `(let ((,httpconv ,httpcon))
+ (if-elnode-auth ,httpconv ,scheme
+ (progn ,@body)
+ (let ((to
+ (cond
+ (;; We have a wrapper... other lists other
+ ;; than wrappers are probably possible; we
+ ;; should qualify the test here to be
+ ;; wrapper specific
+ (listp (plist-get scheme-list :redirect))
+ (format
+ "%s?redirect=%s"
+ (elt (plist-get scheme-list :redirect) 3)
+ (elnode-http-pathinfo ,httpconv)))
+ ;; A plain string can be used directly
+ ((stringp (plist-get scheme-list :redirect))
+ (plist-get scheme-list :redirect))
+ (t
+ (error
+ ":redirect MUST be a list or a string")))))
+ (elnode-send-redirect ,httpconv to))))))
+
+(defun elnode/con-lookup (con attr)
+ "Dynamic lookup."
+ (gethash attr (car (process-plist con))))
+
+(defmacro elnode/con-put (con attr value &rest other)
+ "Put ATTR with VALUE into an array on CON's plist.
+
+If OTHER is specified it is other pairs of attribute and value."
+ (declare (indent 1)
+ (debug (sexp sexp form &rest sexp)))
+ (let ((valv (make-symbol "val"))
+ (conv (make-symbol "con")))
+ `(let* ((,valv ,value)
+ (,conv ,con)
+ (convec
+ (or (car (process-plist ,conv))
+ (car (set-process-plist
+ ,conv (list (make-hash-table :test 'eq)))))))
+ (puthash ,attr ,valv convec)
+ ,@(when other
+ (loop for (name val) on other by 'cddr
+ collect `(puthash ,name ,val convec))))))
+
+(defmacro elnode/con-get (con attr)
+ "Alternative implementation of `process-get'."
+ (let ((conv (make-symbol "con")))
+ `(let* ((,conv ,con)
+ (convec
+ (or (car (process-plist ,conv))
+ (car (set-process-plist
+ ,conv (list (make-hash-table :test 'eq)))))))
+ (gethash ,attr convec))))
+
+(defun elnode/get-server-prop (process key)
+ "Get the value of the KEY from the server attached to PROCESS.
+
+Server properties are bound with `elnode-start' which sets up
+`elnode--log-fn' to ensure that all sockets created have a link
+back to the server."
+ (let* ((server (elnode/con-get process :server)))
+ (elnode/con-lookup server key)))
+
+(defun elnode/proc-log (server-proc client-proc msg)
+ (set-process-plist client-proc (list (make-hash-table :test 'eq)))
+ (elnode/con-put client-proc :server server-proc))
+
+(defmacro elnode/case (expr &rest clauses)
+ "A better `case' implementation."
+ (declare (indent 1)(debug (form &rest (sexp body))))
+ (let* ((backwards (reverse clauses))
+ (last-clause (car backwards))
+ (other-clauses (cdr backwards))
+ (else-clause (when (eq t (car last-clause)) last-clause)))
+ `(catch :escapesym
+ (let ((value (progn ,expr)))
+ ,@(let (collected)
+ (dolist (c (if else-clause other-clauses clauses) collected)
+ (setq collected
+ (cons `(when (eq ,(car c) value)
+ (throw :escapesym (progn ,@(cdr c))))
+ collected))))
+ ,(if else-clause `(throw :escapesym ,@(cdr else-clause)))))))
+
+(defun elnode/get-or-make-con-buffer (httpcon)
+ (or
+ (process-buffer httpcon)
+ (let* ((port (cadr (process-contact httpcon)))
+ (buf (get-buffer-create (format " *elnode-request-%s*" port))))
+ (set-process-buffer httpcon buf)
+ (process-buffer httpcon))))
+
+(defun elnode/make-service (host port service-mappings request-handler
defer-mode)
+ "Make an actual server TCP or Unix PORT.
+
+If PORT is a number then a TCP port is made on the specified HOST
+on the PORT.
+
+If PORT is a string a Unix socket is made in \"/tmp/\" and HOST
+is ignored."
+ (let* ((name (format "*elnode-webserver-%s:%s*" host port))
+ (an-buf (get-buffer-create name))
+ (unix-sock-file-name (unless (numberp port) (concat "/tmp/" port)))
+ (proc-args
+ (list
+ :name name
+ :buffer an-buf
+ :server (if (numberp port) 300 't)
+ :nowait 't
+ :host (cond
+ ((not (numberp port)) nil)
+ ((equal host "localhost") 'local)
+ ((equal host "*") nil)
+ (t host))
+ :coding '(raw-text-unix . raw-text-unix)
+ :family (if (numberp port) 'ipv4 'local)
+ :service (if (numberp port) port unix-sock-file-name)
+ :filter 'elnode--filter
+ ;;:sentinel 'elnode--sentinel
+ :log 'elnode/proc-log))
+ (proc (apply 'make-network-process proc-args)))
+ (elnode/con-put proc
+ :elnode-service-map service-mappings
+ :elnode-http-handler request-handler
+ :elnode-defer-mode defer-mode)
+ proc))
+
+(define-namespace elnode-
+
+(defvar server-socket nil
+ "Where we store the server sockets.
+
+This is an alist of proc->server-process:
+
+ (port . process)")
+
+
+(defcustom init-port 8000
+ "The port that `elnode-init' starts the default server on."
+ :group 'elnode)
+
+(defcustom init-host "localhost"
+ "The default host for the default webserver.
+
+Also used as the default host for `elnode-make-webserver'.
+
+See `elnode-init' for more details."
+ :group 'elnode)
+
+
+;;;###autoload
+(defconst config-directory
+ (expand-file-name (concat user-emacs-directory "elnode/"))
+ "The config directory for elnode to store peripheral files.
+
+This is used as a base for other constant directory or file
+names (the elnode auth database is a file in this directory, the
+elnode webserver has a docroot directory in this directory).
+
+It is based on the `user-emacs-directory' which always seems to
+be set, even when emacs is started with -Q.")
+
+;; Error log handling
+
+(defun join (&rest parts)
+ "Path join the parts together.
+
+EmacsLisp should really provide this by default."
+ (let* (savedpart
+ (path
+ (loop for p in parts
+ concat
+ (when (> (length p) 0)
+ (setq savedpart p)
+ (file-name-as-directory p)))))
+ (if (equal (elt savedpart (- (length savedpart) 1)) ?\/)
+ path
+ (substring path 0 (- (length path) 1)))))
+
+(defun -dir-setup (dir default default-file-name
+ &optional target-file-name
+ &rest other-files)
+ "Install a DIR and DEFAULT-FILE-NAME if it's not setup already.
+
+This is a packaging helper. It helps an ELPA package install
+files from it's package base into the user's Emacs. If the DIR
+is specified under `user-emacs-directory'.
+
+DIR is the directory to install, DEFAULT is the default for that
+directory, unless DIR equals DEFAULT nothing is done.
+
+DEFAULT-FILE-NAME is the name of the file that will be installed
+in DIR. It is the expected name of the source file inside the
+package. Unless TARGET-FILE-NAME is specified it is also the
+name the installed file will be given. If the TARGET-FILE-NAME
+is specified then that is the the name the file is installed as.
+
+If OTHER-FILES is present it is treated as a list of other
+filenames to copy to the DIR."
+ (when (and
+ (equal
+ dir
+ default)
+ (not (file-exists-p dir)))
+ ;; Do install
+ (let ((source-default-file
+ (concat
+ (file-name-directory
+ (or (buffer-file-name)
+ (symbol-file 'elnode--dir-setup))) ; this not very portable
+ ;; This should probably tie in with the makefile somehow
+ default-file-name)))
+ (when (and source-default-file
+ (file-exists-p source-default-file))
+ (let ((to (concat
+ dir
+ (or target-file-name default-file-name))))
+ (make-directory dir t)
+ (message "copying %s elnode wiki default page to %s" dir to)
+ (dired-copy-file source-default-file to nil)
+ (when other-files
+ (noflet ((resolve-filename (file)
+ (if (file-name-absolute-p file)
+ file
+ (concat
+ (file-name-directory
+ source-default-file)
+ file))))
+ (loop for file in other-files
+ ;; does the file exist?
+ if (and file (file-exists-p (resolve-filename file)))
+ do
+ (dired-copy-file
+ ;; from...
+ (resolve-filename file)
+ ;; to...nd
+ (concat dir (file-name-nondirectory file))
+ nil)))))))))
+
+(defun -protected-load (feature dir)
+ "Try and require FEATURE, if it fails try and load."
+ (condition-case err
+ (require feature)
+ (file-error (progn
+ (load
+ (concat dir (symbol-name feature) ".el"))
+ (require feature)))))
+
+;;;###autoload
+(defmacro app (dir-var &rest features)
+ "A macro that sets up the boring boilerplate for Elnode apps.
+
+This sets up lexical binding, captures the module's parent
+directory in DIR-VAR, requires `cl' and any other features you
+list. Use it like this:
+
+ (elnode-app my-app-dir esxml mongo-elnode)
+
+Once used you can access the variable `my-app-dir' as the dirname
+of your module (which is useful for serving files and such)."
+ (declare (indent 1))
+ (let ((dir-var-v (make-symbol "dv")))
+ `(let ((,dir-var-v (file-name-directory
+ (or (buffer-file-name)
+ load-file-name
+ default-directory))))
+ (setq lexical-binding t)
+ (defconst ,dir-var ,dir-var-v)
+ (require 'cl)
+ (require 'elnode)
+ ,@(loop for f in features
+ collect
+ `(elnode--protected-load
+ (quote ,f) ,dir-var-v)))))
+
+(defcustom log-files-directory nil
+ "The directory to store any Elnode log files.
+
+If this is not-nil (in which case logs are not saved at all) it
+must be the name of a directory Elnode can use for storing logs.
+If a directory is specified but it does not exist it is created."
+ :group 'elnode
+ :type '(choice (const :tag "Off" nil)
+ directory))
+
+(defvar log-buffer-position-written 0
+ "The position in the log buffer written.
+
+This is used by `elnode-log-buffer-log' to track what has been written
+so far.")
+
+(defvar log-buffer-max-size 1000
+ "Maximum number of lines of log.")
+
+(defvar log-buffer-datetime-format "%Y-%m-%dT%H:%M:%S"
+ "The date time format used by `elnode-log-buffer-log'.")
+
+(defun log-buffer-log (text buffer-or-name &optional filename)
+ "Log TEXT to the BUFFER-OR-NAME saving the buffer in FILENAME.
+
+BUFFER-OR-NAME is either a buffer or a string naming a buffer.
+FILENAME is a filename to save the buffer into. If the FILENAME
+is not specified then we try to use the filename of the
+BUFFER-OR-NAME.
+
+If neither a buffer filename nor FILENAME is specified then an
+error is generated.
+
+The TEXT is logged with the current date and time formatted with
+`elnode-log-buffer-datetime-format'."
+ (let ((name (or filename (buffer-file-name (get-buffer buffer-or-name)))))
+ (with-current-buffer (get-buffer-create buffer-or-name)
+ (let ((buffer-read-only nil))
+ (unless (assq
+ 'elnode-log-buffer-position-written
+ (buffer-local-variables))
+ (make-local-variable 'elnode-log-buffer-position-written)
+ (setq log-buffer-position-written (make-marker))
+ (set-marker log-buffer-position-written (point-min)))
+ ;; To test this stuff we could rip these functions out into
+ ;; separate pieces?
+ (save-excursion
+ (goto-char (point-max))
+ (insert
+ (format
+ "%s: %s\n"
+ (format-time-string log-buffer-datetime-format)
+ text))
+ ;; Save the file if we have a filename
+ (when name
+ (if (not (file-exists-p (file-name-directory name)))
+ (make-directory (file-name-directory name) t))
+ ;; could be switched to write-region - probably better
+ (append-to-file log-buffer-position-written (point-max) name)
+ (set-marker log-buffer-position-written (point-max)))
+ ;; Truncate the file if it's grown too large
+ (goto-char (point-max))
+ (forward-line (- log-buffer-max-size))
+ (beginning-of-line)
+ (delete-region (point-min) (point)))))))
+
+(defcustom error-log-to-messages t
+ "Whether to send elnode logging through the messaging system."
+ :group 'elnode
+ :type '(boolean))
+
+(defvar server-error-log "*elnode-server-error*"
+ "The buffer where error log messages are sent.")
+
+(defvar -do-error-logging t
+ "Allows tests to turn off error logging.")
+
+(defvar -http-send-string-debug nil
+ "Whether to do error logging in `elnode-http-send-string'.
+
+That is very high logging, probably a bad idea for anyone but an
+elnode developer.")
+
+(defun -get-error-log-buffer ()
+ "Returns the buffer for the error-log."
+ (get-buffer-create server-error-log))
+
+(defmacro error (msg &rest args)
+ "Log MSG with ARGS as an error.
+
+This function is available for handlers to call. It is also used
+by elnode iteslf.
+
+There is only one error log, in the future there may be more."
+ `(when elnode--do-error-logging
+ (let ((filename (elnode--log-filename "elnode-error"))
+ (fmtmsg (format ,msg ,@args)))
+ (elnode-log-buffer-log
+ fmtmsg
+ (elnode--get-error-log-buffer)
+ filename)
+ (when elnode-error-log-to-messages
+ (message "elnode: %s" fmtmsg)))))
+
+(defconst msg-levels (list :debug :info :status :warning)
+ "Levels of message `elnode-msg' uses.")
+
+(defmacro -posq (element lst)
+ "Return the index in the LST of ELEMENT."
+ (let ((elv (make-symbol "el")))
+ `(let ((,elv ,element))
+ (catch :escape
+ (let ((i 0))
+ (dolist (e ,lst)
+ (when (eq e ,elv)
+ (throw :escape i))
+ (setq i (+ i 1)))
+ nil)))))
+
+(defmacro msg (level msg &rest args)
+ "Log MSG to the error console with a particular LEVEL.
+
+LEVEL is compared to `elnode--do-error-logging'."
+ (declare (indent 2))
+ `(when (or (eq t elnode--do-error-logging)
+ (>= (elnode--posq ,level elnode-msg-levels)
+ (elnode--posq
+ (or elnode--do-error-logging (car elnode-msg-levels))
+ elnode-msg-levels)))
+ (elnode-error ,msg ,@args)))
+
+(defun -log-filename (logname)
+ "Turn LOGNAME into a filename.
+
+`elnode-log-files-directory' is used as the container for log files.
+
+This function mainly exists to make testing easier."
+ (when log-files-directory
+ (expand-file-name
+ (format "%s/%s"
+ log-files-directory
+ logname))))
+
+(defvar log-access-format-path-width 20
+ "How to truncate the path in the access log.")
+
+(defun log-access-format-func (httpcon)
+ "Standard access log format function."
+ (format
+ (concat
+ "%s % 8d %s % "
+ (number-to-string log-access-format-path-width)
+ "s %s")
+ (elnode/con-get httpcon :elnode-httpresponse-status)
+ (or (elnode/con-get httpcon :elnode-bytes-written) 0)
+ (http-method httpcon)
+ (http-pathinfo httpcon)
+ (format-time-string ""
+ (time-subtract (current-time)
+ (elnode/con-get httpcon
:elnode-http-started)))))
+
+(defcustom log-access-default-formatter-function
+ 'elnode-log-access-format-func
+ "The default access log formatter function.
+
+This is used when there is no specific logger function for a
+log-name."
+ :group 'elnode
+ :type 'function)
+
+(defcustom log-access-alist nil
+ "An association list of access log format functions for log names.
+
+An access log format function receives the http connection and
+should return a log line to be entered in the log buffer.
+
+These override the default log formatter."
+ :group 'elnode
+ :type '(alist
+ :key-type string
+ :value-type function))
+
+(defun log-access (logname httpcon)
+ "Log the HTTP access in buffer LOGNAME.
+
+This function is available for handlers to call. It is also used
+by elnode iteslf."
+ (let* ((elnode-log-buffer-datetime-format "%Y-%m-%d-%H:%M:%S")
+ (buffer-name (format "*%s-elnode-access*" logname))
+ (filename (-log-filename logname))
+ (formatter
+ (or
+ (kva logname log-access-alist)
+ log-access-default-formatter-function))
+ (formatted
+ (when formatter
+ (funcall formatter httpcon))))
+ (log-buffer-log formatted buffer-name filename)))
+
+
+;; Defer stuff
+
+(progn
+ ;; Sets up the elnode defer signal
+ (put 'elnode-defer
+ 'error-conditions
+ '(error elnode elnode-defer))
+ (put 'elnode-defer
+ 'error-message
+ "Elnode handler processing defered"))
+
+(defvar -deferred '()
+ "List of deferred pairs: (socket . handler).")
+
+(defun defer-now (handler)
+ "The function you call to defer processing of the current socket.
+
+Pass in the current HANDLER.
+
+FIXME: We could capture the current handler somehow? I think the
+point is that whatever signals elnode-defer should be getting
+control back when the deferred is re-processed."
+ (signal 'elnode-defer handler))
+
+(defmacro defer-until (guard &rest body)
+ "Test GUARD and defer if it fails and BODY if it doesn't.
+
+`httpcon' is captured in this macro which means the macro can
+only be expanded where there is an inscope `httpcon'.
+
+Inside the macro the symbol `elnode-defer-guard-it' is bound to
+the value of the GUARD."
+ (declare (indent 1))
+ (let ((bv (make-symbol "bv"))
+ (gv (make-symbol "gv"))
+ (fv (make-symbol "fv")))
+ `(let* ((,gv (lambda () ,guard))
+ (elnode-defer-guard-it (funcall ,gv))
+ (,bv (lambda (httpcon) ,@body))
+ (,fv ; a y-combinator!
+ (lambda (httpcon proc)
+ (setq elnode-defer-guard-it (funcall ,gv))
+ (if elnode-defer-guard-it
+ (funcall ,bv httpcon)
+ ;; the test failed we should defer again
+ (elnode-defer-now
+ (lambda (http-con)
+ (funcall proc http-con proc)))))))
+ (if elnode-defer-guard-it
+ (funcall ,bv httpcon)
+ ;; The test failed, we should defer.
+ (elnode-defer-now
+ (lambda (httpcon) ; apply the y-combinator
+ (funcall ,fv httpcon ,fv)))))))
+
+(defun -deferred-add (httpcon handler)
+ "Add the specified HTTPCON/HANDLER pair to the deferred list."
+ (msg :info "deferred-add: adding a defer %s for %s" handler httpcon)
+ (push (cons httpcon handler) -deferred))
+
+(defun -deferred-process-open (httpcon handler)
+ "Process the HANDLER with the known open HTTPCON."
+ ;; (elnode-error "defer - just before calling the handler %s" handler)
+ (funcall handler httpcon))
+
+
+;; Log levels
+(defconst log-debug 0)
+(defconst log-info 1)
+(defconst log-warning 2)
+(defconst log-critical 3)
+
+(defvar defer-processor-log-level log-critical
+ "Log level of the defer processor.")
+
+(defun -deferred-log (level msg &rest args)
+ "Special log for deferreds"
+ (when (>= level defer-processor-log-level)
+ (msg :info (format "elnode-deferred-processor %s %s" msg args))))
+
+(defvar defer-failure-hook nil
+ "Hook called when a deferred socket fails.
+
+The hook function is called with the http connection and the
+failure state which either the symbol `closed' or the symbol
+`failed'.")
+
+(defconst -debug-with-backtraces nil
+ "Feature switch to include backtrace debugging support.")
+
+(defun -deferred-processor ()
+ "Process the deferred queue."
+ (let ((run (random 5000)) ; use this to disambiguate runs in the logs
+ (new-deferred (list)))
+ (-deferred-log log-info "start")
+ (loop for pair in -deferred
+ do
+ (let ((httpcon (car pair))
+ (handler (cdr pair)))
+ (elnode/case (process-status httpcon)
+ ('open
+ (-deferred-log log-info
+ "open %s %s" httpcon handler)
+ (condition-case signal-value
+ (-deferred-process-open httpcon handler)
+ ('elnode-defer
+ (push
+ (cons httpcon (cdr signal-value))
+ new-deferred))
+ (error
+ (-deferred-log
+ log-critical
+ "error %s - %s %S" httpcon signal-value
+ (if -debug-with-backtraces
+ debugger-previous-backtrace
+ "")))))
+ ('closed
+ (-deferred-log log-info
+ "closed %s %s" httpcon handler)
+ ;; Call any hook function for defer closes
+ (loop for hook-func in elnode-defer-failure-hook
+ do
+ (funcall hook-func httpcon 'closed)))
+ ('failed
+ (-deferred-log
+ log-info "failed %s %s" httpcon handler)
+ ;; Call any hook function for defer failures
+ (loop for hook-func in defer-failure-hook
+ do
+ (funcall hook-func httpcon 'failed)))
+ ;; Not sure how to do connect... same as open?
+ ;; ... or just put it back?
+ ('connect
+ (push
+ (cons httpcon handler)
+ new-deferred)))))
+ (-deferred-log log-info "complete")
+ ;; Set the correct queue
+ (setq -deferred new-deferred)))
+
+(defun deferred-queue-process ()
+ (interactive)
+ (-deferred-processor))
+
+(defvar defer-on nil
+ "Whether to do deferring or not.")
+
+(defvar -defer-timer nil
+ "The timer used by the elnode defer processing.
+
+This is initialized by `elnode--init-deferring'.")
+
+(defun -init-deferring ()
+ "Initialize elnode defer processing.
+
+Necessary for running comet apps."
+ (setq -defer-timer
+ (run-at-time "2 sec" 2 'elnode--deferred-processor)))
+
+(defun deferred-queue-start ()
+ "Start the deferred queue, unless it's running."
+ (interactive)
+ (unless defer-on
+ (setq defer-on t))
+ (unless -defer-timer
+ (-init-deferring)))
+
+(defun deferred-queue-stop ()
+ "Stop any running deferred queue processor."
+ (interactive)
+ (when -defer-timer
+ (cancel-timer -defer-timer)
+ (setq -defer-timer nil)))
+
+;;; Basic response mangling
+
+(defcustom default-response-table
+ '((201 . "Created")
+ (400 . "Bad request")
+ (404 . "Not found")
+ (500 . "Server error")
+ (t . "Ok"))
+ "The status code -> default message mappings.
+
+When Elnode sends a default response these are the text used.
+
+Alter this if you want to change the messages that Elnode sends
+with the following functions:
+
+ 'elnode-send-400'
+ 'elnode-send-404'
+ 'elnode-send-500'
+
+The function `elnode-send-status' also uses these."
+ :group 'elnode
+ :type '(alist :key-type integer
+ :value-type string))
+
+(defconst -default-response-groups
+ '((1 . "Informing you of something.")
+ (2 . "Ok.")
+ (3 . "")
+ (4 . "Bad.")
+ (5 . "Error."))
+ "Response codes for error code / 100.
+
+These are designed to be used when a specific code is not
+available.")
+
+(defun -format-response (status &optional msg)
+ "Format the STATUS and optionally MESSAGE as an HTML return."
+ (format "<h1>%s</h1>%s\r\n"
+ (cdr (or (assoc status default-response-table)
+ (assoc (/ status 100) -default-response-groups)
+ (assoc t default-response-table)))
+ (if msg (format "<p>%s</p>" msg) "")))
+
+
+;; Main control functions
+
+(defun -http-parse-header (buffer start &optional non-header)
+ "Parse a header from the BUFFER at point START.
+
+The initial header may be parsed with this or if NON-HEADER is
+sent then another header, such as a multipart header, may be read.
+
+If the complete header has not been read then we throw to
+`elnode-parse-http' with either `header' or `non-header'.
+
+We return a list of the leader, which is the first line of the
+header (which is not the header) followed by an alist of
+headers."
+ (with-current-buffer buffer
+ (let ((hdrend (re-search-forward "\r\n\r\n" nil 't)))
+ (when (not hdrend)
+ (throw 'elnode-parse-http (or (and non-header 'non-header) 'header)))
+ (let* ((lines
+ (split-string
+ (buffer-substring start hdrend)
+ "\r\n"
+ 't))
+ (status (car lines)) ;; the first line is the status line
+ (header (cdr lines)) ;; the rest of the lines are the header
+ (header-alist-strings
+ (mapcar
+ (lambda (hdrline)
+ (when (string-match
+ "\\([A-Za-z0-9_-]+\\):[ ]*\\(.*\\)"
+ hdrline)
+ (cons
+ (downcase (match-string 1 hdrline))
+ (match-string 2 hdrline))))
+ header)))
+ (list status header-alist-strings)))))
+
+
+(defun -http-parse (process)
+ "Parse the HTTP header for the PROCESS.
+
+If the request is not fully complete (if the header has not
+arrived yet or we don't have all the content-length yet for
+example) this can throw `elnode-parse-http'. The thing being
+waited for is indicated.
+
+Important side effects of this function are to add certain
+process properties to the HTTP connection. These are the result
+of successful parsing."
+ ;; FIXME - we don't need to do this - we should check for
+ ;; header-parsed and avoid it we we can
+ (with-current-buffer (process-buffer process)
+ (save-excursion
+ (goto-char (point-min))
+ (destructuring-bind (leader alist-strings)
+ (elnode--http-parse-header (current-buffer) (point-min))
+ (let* ((hdrend (point))
+ (alist-syms
+ (kvalist-keys->symbols alist-strings :first-fn 'downcase))
+ (content-len (assq 'content-length alist-syms)))
+ ;; Check the content if we have it.
+ (when content-len
+ (let* ((available-content (- (point-max) hdrend)))
+ (when (> (string-to-number (cdr content-len))
+ available-content)
+ (throw 'elnode-parse-http 'content))))
+ (elnode/con-put process
+ :elnode-header-end hdrend
+ :elnode-http-status leader
+ :elnode-http-header-syms alist-syms
+ :elnode-http-header alist-strings)))))
+ ;; Return a symbol to indicate done-ness
+ 'done)
+
+(defun -http-make-hdr (method resource &rest headers)
+ "Convenience function to make an HTTP header.
+
+METHOD is the method to use. RESOURCE is the path to use.
+HEADERS should be pairs of strings indicating the header values:
+
+ (elnode--http-make-hdr 'get \"/\" '(host . \"localhost\"))
+
+Where symbols are encountered they are turned into strings.
+Inside headers they are capitalized.
+
+A header pair with the key `body' can be used to make a content body:
+
+ (elnode--http-make-hdr 'get \"/\" '(body . \"some text\"))
+ =>
+ GET / HTTP/1.1
+
+ some text
+
+No other transformations are done on the body, no content type
+added or content length computed."
+ (let (body)
+ (noflet ((header-name (hdr)
+ (if (symbolp (car hdr))
+ (symbol-name (car hdr))
+ (car hdr))))
+ (format
+ "%s %s HTTP/1.1\r\n%s\r\n%s"
+ (upcase (if (symbolp method) (symbol-name method) method))
+ resource
+ (loop for header in headers
+ if (equal (header-name header) "body")
+ do (setq body (cdr header))
+ else
+ concat (format
+ "%s: %s\r\n"
+ (capitalize (header-name header))
+ (cdr header)))
+ ;; If we have a body then add that as well
+ (or body "")))))
+
+(defsubst -call (handler con)
+ (funcall handler con))
+
+(defun -filter (process data)
+ "Filtering DATA sent from the client PROCESS..
+
+This does the work of finding and calling the user HTTP
+connection handler for the request on PROCESS.
+
+A buffer for the HTTP connection is created, uniquified by the
+port number of the connection."
+ (with-current-buffer (elnode/get-or-make-con-buffer process)
+ (insert data)
+ (elnode/case (catch 'elnode-parse-http (-http-parse process))
+ ('header (msg :info "filter: partial header data received"))
+ ('content (msg :info "filter: partial header data received"))
+ ('done
+ (save-excursion
+ (goto-char (elnode/con-get process :elnode-header-end))
+ (let ((handler (elnode/get-server-prop process
:elnode-http-handler)))
+ (unwind-protect
+ (condition-case signal-value
+ (funcall handler process)
+ ('elnode-defer ; see elnode-defer-now
+ (msg :info "filter: defer caught on %s" process)
+ ;; Check the timer, this is probably spurious but
useful "for now"
+ (unless defer-on
+ (msg :info "filter: no defer timer for %s"
process))
+ (elnode/case (elnode/get-server-prop process
:elnode-defer-mode)
+ (:managed
+ (elnode/con-put process
:elnode-deferred t)
+ ;; the cdr of the sig value is the
func
+ (-deferred-add process (cdr
signal-value)))
+ (:immediate
+ (msg :info "filter: immediate defer
on %s" process)
+ (funcall (cdr signal-value)
process))))
+ ('t
+ (unless (elnode/con-get process
:elnode-http-started)
+ (msg :info "filter: default handling %S"
signal-value)
+ (process-send-string process (-format-response
500)))))
+ (if (and (not (elnode/con-get process
:elnode-http-started))
+ (not (elnode/con-get process
:elnode-deferred)))
+ (process-send-string process (-format-response
500))
+ (when (elnode/con-get process :elnode-finished)
+ (unwind-protect
+ (progn
+ (delete-process process)
+ (kill-buffer (process-buffer process)))
+ (unless (eq 'closed (process-status process))
+ (msg :warning "elnode--filter failed at the
end"))))))))))))
+
+(defun -ip-addr->string (ip-addr)
+ "Turn a vector IP-ADDR into a string form.
+
+The vector form is produced by `process-contact' and includes the
+port number."
+ (destructuring-bind (a b c d port)
+ (mapcar 'identity ip-addr)
+ (format "%s.%s.%s.%s:%s" a b c d port)))
+
+(defun get-remote-ipaddr (httpcon)
+ "Return the remote IP address from the HTTPCON.
+
+Returned as a dotted ip address followed by a colon separated
+port number. For example: \"127.0.0.1:8080\"."
+ (let* ((remote (plist-get
+ (process-contact httpcon t)
+ :remote)))
+ (-ip-addr->string remote)))
+
+(defun server-info (httpcon)
+ "Returns a string adress of the server host and port for HTTPCON.
+
+For example: \"127.0.0.1:8000\" - localhost on port 8000."
+ (-ip-addr->string
+ (plist-get
+ (process-contact (elnode/con-get httpcon :server) t)
+ :local)))
+
+
+;;; Testing stuff
+
+(defvar -cookie-store nil
+ "Cookie store for test servers.
+
+This is a special defvar for dynamic overriding by
+`with-elnode-mock-server'.")
+
+(defun -alist-to-query (alist)
+ "Turn an alist into a formdata/query string."
+ (noflet ((web--key-value-encode (key value)
+ "Encode a KEY and VALUE for url encoding."
+ (cond
+ ((or
+ (numberp value)
+ (stringp value))
+ (format
+ "%s=%s"
+ (url-hexify-string (format "%s" key))
+ (url-hexify-string (format "%s" value))))
+ (t
+ (format "%s" (url-hexify-string (format
"%s" key))))))
+ (web--to-query-string (object)
+ "Convert OBJECT (a hash-table or alist) to an
HTTP query string."
+ ;; Stolen from web
+ (mapconcat
+ (lambda (pair)
+ (web--key-value-encode (car pair) (cdr
pair)))
+ (cond
+ ((hash-table-p object)
+ (let (result)
+ (maphash
+ (lambda (key value)
+ (setq result (append (list (cons key
value)) result)))
+ object)
+ (reverse result)))
+ ((listp object)
+ object))
+ "&")))
+ (web--to-query-string alist)))
+
+(defun -make-test-call (path method parameters headers)
+ "Construct the HTTP request for a test call.
+
+This should probably be merged with the stuff in the `web'
+module."
+ (let* ((query
+ (if (and parameters (equal method "GET"))
+ (format
+ "?%s"
+ (-alist-to-query parameters))
+ ""))
+ (http-path
+ (if (equal query "")
+ path
+ (format "%s%s" path query)))
+ (http-body
+ (if (equal method "GET")
+ nil
+ (let ((param-data (-alist-to-query parameters)))
+ (setq headers
+ (append
+ (list
+ (cons "Content-Type"
+ "application/x-www-form-urlencoded")
+ (cons "Content-Length"
+ (format "%d" (length param-data))))
+ headers))
+ param-data))))
+ (apply
+ 'elnode--http-make-hdr
+ `(,method
+ ,http-path
+ ,@headers
+ (body . ,http-body)))))
+
+(defun -response-header-to-cookie-store (response)
+ "Add Set-Cookie headers from RESPONSE to the cookie store."
+ (let ((cookie-set (assoc "Set-Cookie" response)))
+ (when cookie-set
+ (let* ((cookie-value (car (split-string (cdr cookie-set) ";"))))
+ (apply
+ 'puthash
+ (append
+ (split-string cookie-value "=")
+ (list -cookie-store))))))
+ -cookie-store)
+
+(defun -cookie-store-to-header-value ()
+ "Turn the current cookie store into a header.
+
+The cookies in the header are sorted alphabetically - makes
+testing easier."
+ (let ((cookie-value
+ (mapconcat
+ (lambda (cookie)
+ (format "%s=%s" (car cookie)
+ (url-hexify-string (cdr cookie))))
+ (kvalist-sort
+ (kvhash->alist -cookie-store)
+ 'string-lessp)
+ "; ")))
+ (unless (equal "" cookie-value)
+ cookie-value)))
+
+(defun* test-call (path
+ &key
+ (method "GET")
+ (parameters '())
+ (headers '()))
+ "Fake a call to elnode with the PATH.
+
+In addition you can specify some extra HTTP stuff:
+
+ :method one of GET, POST, DELETE, etc...
+ :parameters POST parameters, will be turned into a POST body
+ :headers any specific headers you require, you may override
+ test-call headers.
+
+For example:
+
+ (elnode-test-call \"/wiki/test\")
+
+or:
+
+ (elnode-test-call \"/wiki/test\"
+ :method \"POST\"
+ :parameters '((\"a\" . 10)))
+
+For header and parameter names, strings MUST be used currently.
+
+During the test the variable `elnode-webserver-visit-file' is set
+to `t' to ensure that Elnode does not pass fake HTTP connections
+to external processes."
+ (let ((fakir-mock-process-require-specified-buffer t))
+ (fakir-mock-process :httpcon ()
+ (let ((req (-make-test-call
+ path method parameters
+ (append
+ headers
+ (let ((cookies
(-cookie-store-to-header-value)))
+ (when cookies
+ (list (cons "Cookie" cookies)))))))
+ (http-con :httpcon)
+ (the-end nil)
+ (elnode-webserver-visit-file t))
+ (noflet ((process-send-eof (proc) (setq the-end 't))
+ (process-status (proc) (if the-end 'closed
'open))
+ (elnode/get-server-prop (proc prop)
+ (elnode/case prop
+
(:elnode-defer-mode nil)
+ (t
(funcall this-fn proc prop))))
+ ;; Do nothing - we want the test proc
+ (delete-process (proc))
+ ;; Again, do nothing, we want this buffer
+ (kill-buffer (buffer) t))
+ ;; FIXME - we should unwind protect this?
+ (-filter http-con req)
+ ;; Now we sleep till the-end is true
+ (while (not the-end) (sit-for 0.1))
+ (when the-end
+ (-response-header-to-cookie-store
+ (elnode/con-get http-con
:elnode-httpresponse-header))
+ ;; Could we add to the cookie store here?
+ (list
+ :result-string
+ (with-current-buffer
(fakir-get-output-buffer)
+ (buffer-substring-no-properties
(point-min) (point-max)))
+ :buffer (process-buffer http-con)
+ ;; These properties are set by
elnode-http-start
+ :status (elnode/con-get http-con
:elnode-httpresponse-status)
+ :header (elnode/con-get http-con
:elnode-httpresponse-header))))))))
+
+
+(defvar handler-history '()
+ "The history of handlers bound to servers.")
+
+(defvar port-history '()
+ "The history of ports that servers are started on.")
+
+(defvar host-history '()
+ "The history of hosts that servers are started on.")
+
+(defun ports ()
+ "List of all ports currently in use by elnode."
+ (mapcar 'car server-socket))
+
+;;;###autoload
+(defun* start (request-handler
+ &key
+ port
+ (host "localhost")
+ (defer-mode :managed)
+ service-mappings)
+ "Start a server using REQUEST-HANDLER.
+
+REQUEST-HANDLER will handle requests on PORT on HOST (which is
+'localhost' by default).
+
+REQUEST-HANDLER is a function which is called with the request.
+The function is called with one argument, which is the
+http-connection.
+
+You can use functions such as `elnode-http-start' and
+`elnode-http-send-body' to send the http response.
+
+Example:
+
+ (defun nic-server (httpcon)
+ (elnode-http-start httpcon 200 '(\"Content-Type\" . \"text/html\"))
+ (elnode-http-return httpcon \"<html><b>BIG!</b></html>\"))
+ (elnode-start 'nic-server)
+
+Now visit http://127.0.0.1:8000
+
+If PORT is non-nil, then run server on PORT, otherwise default to
+8000.
+
+If HOST is non-nil, then run the server on the specified local IP
+address, otherwise use localhost. A few names are predefined:
+
+ \"localhost\" is 127.0.0.1
+ \"*\" is 0.0.0.0
+
+Additionally, you may specifiy an IP address, e.g \"1.2.3.4\"
+
+Note that although HOST may be specified, elnode does not
+disambiguate on running servers by HOST. So you cannot start two
+elnode servers on the same port on different hosts.
+
+DEFER-MODE may be used to control how deferred handlers are
+managed for this server.
+
+SERVICE-MAPPINGS is an alist of service resource symbols mapped
+to integer port numbers. This can be supplied to elnode-start to
+allow it to map service resources defined by handlers to
+different TCP ports and therefore different Emacs instances.
+
+The list of SERVICE-MAPPINGS is also used to start ancilliary
+port servers. Ancilliary port servers should be automatically
+stopped when the main server is stopped."
+ (interactive
+ (let ((handler (completing-read "Handler function: "
+ obarray 'fboundp t nil nil))
+ (port (read-number "Port: " 8000))
+ (host (read-string "Host: " "localhost" 'elnode-host-history)))
+ (list (intern handler) :port port :host host)))
+ (let ((port (or port 8000))
+ (host (or host "localhost")))
+ (unless (assoc port server-socket)
+ ;; Add a new server socket to the list
+ (setq server-socket
+ (cons
+ (cons port
+ (let ((buf (get-buffer-create "*elnode-webserver*"))
+ (ancilliarys
+ (loop for (resource . port) in service-mappings
+ collect
+ (elnode/make-service
+ host port service-mappings
+ request-handler defer-mode)))
+ (main (elnode/make-service
+ host port service-mappings
+ request-handler defer-mode)))
+ ;; Add the link between the main and the ancilliarys
+ (elnode/con-put main :elnode-ancilliarys ancilliarys)
+ main))
+ server-socket)))))
+
+;; TODO: make this take an argument for the
+(defun stop (port)
+ "Stop the elnode server attached to PORT."
+ (interactive
+ (let ((prt
+ (string-to-number
+ (completing-read
+ "Port: "
+ (mapcar (lambda (n) (format "%s" n))
+ (ports))))))
+ (list prt)))
+ (let* ((server
+ (or (assoc port server-socket)
+ (assoc (format "%d" port) server-socket)))
+ (port-to-kill (car-safe server)))
+ (when server
+ (message "deleting server process")
+ (loop for ancilliary
+ in (elnode/con-get (cdr server) :elnode-ancilliarys)
+ do (delete-process ancilliary))
+ ;; Now the main one
+ (delete-process (cdr server))
+ (setq server-socket
+ ;; remove-if
+ (let ((test (lambda (elem)
+ (equal (car elem) port-to-kill)))
+ (l server-socket)
+ result)
+ (while (car l)
+ (let ((p (pop l))
+ (r (cdr l)))
+ (if (not (funcall test p))
+ (setq result (cons p result)))))
+ result)))))
+
+(defun find-free-service ()
+ "Return a free (unused) TCP port.
+
+The port is chosen randomly from the ephemeral ports. "
+ (let (myserver
+ (port 50000)) ; this should be ephemeral base
+ (while
+ (not
+ (processp
+ (condition-case sig
+ (setq myserver
+ (make-network-process
+ :name "*test-proc*"
+ :server t
+ :nowait 't
+ :host 'local
+ :service port
+ :family 'ipv4))
+ (file-error
+ (if (equal
+ "Cannot bind server socket address already in use"
+ (mapconcat 'identity (cdr sig) " "))
+ (setq port (+ 50000 (random 5000)))))))))
+ (delete-process myserver)
+ port))
+
+(defun list-buffers ()
+ "List the current buffers being managed by Elnode."
+ (interactive)
+ (with-current-buffer (get-buffer-create "*elnode-buffers*")
+ (erase-buffer)
+ (mapc
+ (lambda (b)
+ (save-excursion
+ (if (string-match " \\*elnode-.*" (buffer-name b))
+ (insert (format "%s\n" b)))
+ ))
+ (sort (buffer-list)
+ (lambda (a b)
+ (string-lessp (buffer-name b) (buffer-name a))))))
+ (display-buffer (get-buffer "*elnode-buffers*")))
+
+(defun time-encode (time-str)
+ "Basic TIME-STR to time encoding."
+ (apply 'encode-time (parse-time-string time-str)))
+
+
+;; HTTP API methods
+
+(defun -http-hdr (httpcon)
+ "Return the header cons for the HTTPCON.
+
+The status-line and the header alist."
+ (cons
+ (elnode/con-get httpcon :elnode-http-status)
+ (elnode/con-get httpcon :elnode-http-header)))
+
+(defun http-headers (httpcon)
+ "Return the alist of headers from HTTPCON."
+ (elnode/con-get httpcon :elnode-http-header))
+
+(defun http-header (httpcon name &optional convert)
+ "Get the header specified by NAME from the HTTPCON.
+
+HEADER may be a string or a symbol. If NAME is a symbol it is
+case insensitve.
+
+If optional CONVERT is specified it may specify a conversion,
+currently supported conversions are:
+
+ :time - to convert a time value properly"
+ (let* ((key (if (symbolp name)
+ (intern (downcase (symbol-name name)))
+ name))
+ (hdr (if (symbolp key)
+ (elnode/con-get httpcon :elnode-http-header-syms)
+ (elnode/con-get httpcon :elnode-http-header)))
+ (val (cdr (assoc (if (stringp key) (downcase key) key) hdr))))
+ (elnode/case convert
+ (:time
+ (when val
+ (time-encode val)))
+ (t
+ val))))
+
+(defun* http-host (httpcon &key split just-host)
+ "Return the HTTP `host' name header.
+
+With SPLIT return a list of the hostname and any port part (the
+port part might be empty if not specifically specified). With
+JUST-HOST return just the host-name part, dropping any port entirely."
+ (let ((host (http-header httpcon "Host")))
+ (cond
+ (split
+ (string-match "\\([^:]+\\)\\(:\\([0-9]+\\)\\)*" host)
+ (list (match-string-no-properties 1 host)
+ (match-string-no-properties 3 host)))
+ (just-host
+ (string-match "\\([^:]+\\)\\(:\\([0-9]+\\)\\)*" host)
+ (match-string-no-properties 1 host))
+ (t
+ host))))
+
+(defun http-cookies (httpcon)
+ "Return the list of cookies attached to this HTTPCON.
+
+The list of cookies is an alist."
+ (or
+ (elnode/con-get httpcon :elnode-http-cookie-list)
+ (let* ((cookie-hdr (http-header httpcon 'Cookie))
+ (lst (when cookie-hdr
+ (kvalist-sort
+ (mapcar
+ (lambda (pair)
+ (cons
+ (url-unhex-string (car pair))
+ (url-unhex-string (cdr pair))))
+ (url-parse-args cookie-hdr))
+ 'string-lessp))))
+ (elnode/con-put httpcon :elnode-http-cookie-list lst)
+ lst)))
+
+(defun http-cookie (httpcon name &optional cookie-key)
+ "Return the cookie value for HTTPCON specified by NAME.
+
+The cookie is a cons:
+
+ name . value
+
+If COOKIE-KEY is `t' then only the value is returned, else the
+cons is returned."
+ (let* ((cookie-list (http-cookies httpcon))
+ (cookie (assoc-string name cookie-list)))
+ (if cookie-key
+ (cdr cookie)
+ cookie)))
+
+(defconst -http-status-line-rx
+ (rx (and (group-n 1 (or "GET" "HEAD" "POST" "DELETE" "PUT"))
+ " "
+ (group-n 2 (1+ (any "A-Za-z0-9+&=?./:;-"))) ; FIXME - get this from
the spec?
+ " "
+ "HTTP/"
+ (group-n 3 (and "1." (1+ (any "0-9"))))))
+ "The regex used to match the status line.")
+
+(defun -http-parse-status (httpcon &optional property)
+ "Parse the status line of HTTPCON.
+
+If PROPERTY is non-nil, then return that property."
+ (let* ((http-line (elnode/con-get httpcon :elnode-http-status)))
+ (save-match-data
+ (when (and http-line
+ (string-match -http-status-line-rx http-line))
+ (elnode/con-put httpcon
+ :elnode-http-method (match-string 1 http-line)
+ :elnode-http-resource (match-string 2 http-line)
+ :elnode-http-version (match-string 3 http-line)
+ :elnode-http-parsed-time (current-time))
+ (when property
+ (elnode/con-lookup httpcon property))))))
+
+(defun -http-parse-resource (httpcon &optional property)
+ "Convert the specified resource to a path and a query."
+ (let ((resource
+ (or
+ (elnode/con-get httpcon :elnode-http-resource)
+ (-http-parse-status
+ httpcon :elnode-http-resource))))
+ (save-match-data
+ (if (or
+ ;; root pattern with
+ (string-match "^\\(/\\)\\(\\?.*\\)*$" resource)
+ ;; /somepath or /somepath/somepath
+ (string-match "^\\(/[^?]+\\)\\(\\?.*\\)*$" resource))
+ (let ((path (url-unhex-string (match-string 1 resource))))
+ (elnode/con-put httpcon :elnode-http-pathinfo path)
+ (when (match-string 2 resource)
+ (let ((query (match-string 2 resource)))
+ (string-match "\\?\\(.+\\)" query)
+ (if (match-string 1 query)
+ (elnode/con-put
+ httpcon
+ :elnode-http-query
+ (match-string 1 query))))))
+ ;; Else it might be a more exotic path
+ (elnode/con-put httpcon :elnode-http-pathinfo resource))))
+ (when property
+ (elnode/con-lookup httpcon property)))
+
+(defun http-pathinfo (httpcon)
+ "Get the PATHINFO of the request.
+
+The PATHINFO is the CGI term for the part of the path that is not
+the hostname or the query; the part that relates to the path."
+ (or
+ (elnode/con-get httpcon :elnode-http-pathinfo)
+ (-http-parse-resource httpcon :elnode-http-pathinfo)))
+
+(defun http-query (httpcon)
+ "Get the QUERY of the request."
+ (or
+ (elnode/con-get httpcon :elnode-http-query)
+ (-http-parse-resource httpcon :elnode-http-query)))
+
+(defun -http-param-part-decode (param-thing)
+ "Decode an HTTP URL parameter part.
+
+For example in:
+
+
http://nic.ferrier.me.uk/blog/elnode/?p=10&a+c=20&d=x+y&z=this%20is%09me+and%20this
+
+The following are param parts and the decoding that this function
+will do:
+
+ \"p\" -> \"p\"
+
+ \"10\" -> \"10\"
+
+ \"a+c\" -> \"a c\" - an example of + encoding
+
+ \"d\" -> \"d\"
+
+ \"x+y\" -> \"x y\" - another example of + encoding, in a parameter name
+
+ \"z\" -> \"z\"
+
+ \"this%20is%09me+and%20this\" -> \"this is\tme and this\" -
+ percent encoding and plus encoding"
+ (url-unhex-string (replace-regexp-in-string "\\+" " " param-thing) 't)
+ )
+
+(defun -http-query-to-alist (query)
+ "Crap parser for HTTP QUERY data.
+
+Returns an association list."
+ (--map
+ (if (string-match "\\([^=]+\\)\\(=\\(.*\\)\\)*" it)
+ (cons
+ (-http-param-part-decode (match-string 1 it))
+ (if (match-string 2 it)
+ (-http-param-part-decode (match-string 3 it))
+ nil)))
+ (split-string query "&")))
+
+(defun -alist-merge (a b &optional operator)
+ "Merge two association lists non-destructively.
+
+A is considered the priority (its elements go in first)."
+ (if (not operator)
+ (setq operator 'assq))
+ (let* ((res '()))
+ (let ((lst (append a b)))
+ (while lst
+ (let ((item (car-safe lst)))
+ (setq lst (cdr-safe lst))
+ (let* ((key (car item))
+ (aval (funcall operator key a))
+ (bval (funcall operator key b)))
+ (if (not (funcall operator key res))
+ (setq res (cons
+ (if (and aval bval)
+ ;; the item is in both lists
+ (cons (car item)
+ (list (cdr aval) (cdr bval)))
+ item)
+ res))))))
+ res)))
+
+(defun -http-mp-find-boundary (boundary)
+ "Find the boundary string from point."
+ (let ((boundary-rx
+ (rx-to-string `(seq "\r\n--" ,boundary))))
+ (save-match-data
+ (when (re-search-forward boundary-rx nil t)
+ (let ((mpt (match-beginning 0)))
+ ;; Return status indicator and the start match point
+ (list
+ (if (save-excursion
+ (goto-char (line-beginning-position))
+ (looking-at (rx-to-string `(seq bol "--" ,boundary "--"))))
+ :done :continue)
+ (progn (goto-char mpt) mpt)))))))
+
+(defun -http-mp-decode (buffer header-end-pt boundary)
+ "Decode a multipart/form-data upload with BOUNDARY in BUFFER."
+ (with-current-buffer buffer
+ (goto-char (- header-end-pt 2)) ; moves back over the \r\n
+ (loop while (eq (car next-boundary) :continue)
+ with next-boundary = (elnode--http-mp-find-boundary boundary)
+ collect
+ (destructuring-bind (leader alist)
+ (elnode--http-parse-header (current-buffer) (point) t)
+ (let* ((cde
+ (mail-header-parse-content-disposition
+ (kva "content-disposition" alist)))
+ (name (kva 'name (cdr cde)))
+ (filename (kva 'filename (cdr cde)))
+ (pt (point)))
+ ;; Find the next end point
+ (setq next-boundary
+ (elnode--http-mp-find-boundary boundary))
+ (let* ((lbp (line-beginning-position))
+ (content (buffer-substring pt (cadr next-boundary)))
+ (content-data
+ (if (equal
+ "base64"
+ (downcase (or (kva "content-transfer-encoding"
alist) "")))
+ (base64-decode-string content)
+ content))
+ (content-object
+ (cond
+ ((not filename) content-data)
+ (t (propertize content-data :elnode-filename
filename)))))
+ (cons name content-object)))))))
+
+(defun -http-post-mp-decode (httpcon parsed-content-type)
+ "Decode the HTTP POST multipart thing on HTTPCON."
+ (let ((boundary (kva 'boundary (cdr parsed-content-type)))
+ (buf (process-buffer httpcon))
+ (hdr-end-pt (elnode/con-get httpcon :elnode-header-end)))
+ (-http-mp-decode buf hdr-end-pt boundary)))
+
+(defun -http-post-body (httpcon)
+ "Get the HTTP POST body."
+ (with-current-buffer (process-buffer httpcon)
+ ;; (buffer-substring (point-min) (point-max)) ;debug
+ (buffer-substring
+ ;; we might have to add 2 to this because of trailing \r\n
+ (elnode/con-get httpcon :elnode-header-end)
+ (point-max))))
+
+(defun -http-post-to-alist (httpcon)
+ "Parse the POST body."
+ ;; FIXME: this is ONLY a content length header parser -- it should
+ ;; also cope with transfer encodings.
+ (let* ((content-type (http-header httpcon 'content-type))
+ (parsed-type
+ (when content-type
+ (mail-header-parse-content-type content-type))))
+ (if (equal "multipart/form-data" (car parsed-type))
+ (-http-post-mp-decode httpcon parsed-type)
+ ;; Else it's a non-multipart request
+ (-http-query-to-alist (-http-post-body httpcon)))))
+
+(defun http-params (httpcon &rest names)
+ "Get an alist of the parameters in the request.
+
+If the method is a GET then the parameters are from the url. If
+the method is a POST then the parameters may come from either the
+url or the POST body or both:
+
+ POST /path?a=b&x=y
+ a=c
+
+would result in:
+
+ '((\"a\" \"b\" \"c\")(\"x\" . \"y\"))
+
+If NAMES are specified it is a filter list of symbols or strings
+which will be returned.
+
+File upload with Multipart/form-data is supported by Elnode.
+Uploaded files are present in the params the same as any other
+param except for the fact that uploaded file params have a text
+property :elnode-filename on them:
+
+ (get-text-property 0 :elnode-filename
+ (elnode-http-param httpcon \"myfile\")) => '/somefile.txt'
+
+The value comes from the \"Content-Disposition\" header in the
+multipart upload."
+ (loop for pair in
+ (or
+ (elnode/con-get httpcon :elnode-http-params)
+ (let ((query (http-query httpcon)))
+ (let ((alist (if query
+ (-http-query-to-alist query)
+ '())))
+ (if (equal "POST" (http-method httpcon))
+ ;; If we're a POST we have to merge the params
+ (progn
+ (setq alist
+ (-alist-merge
+ alist
+ (-http-post-to-alist httpcon)
+ 'assoc))
+ (elnode/con-put httpcon :elnode-http-params alist)
+ alist)
+ ;; Else just return the query params
+ (elnode/con-put httpcon :elnode-http-params alist)
+ alist))))
+ if (or (not names)
+ (memq (intern (car pair)) names)
+ (member (car pair) names))
+ collect pair))
+
+(defun http-param (httpcon name &optional default)
+ "Get the parameter named NAME from the request.
+
+If the parameter came from a file upload it has a text property
+indicating the filename:
+
+ (get-text-property 0 :elnode-filename
+ (elnode-http-param httpcon \"myfile\")) => '/somefile.txt'
+
+If the parameter is not present and DEFAULT is present then
+return DEFAULT instead of `nil'."
+ (let* ((params (http-params httpcon))
+ (param-pair
+ (assoc
+ (if (symbolp name) (symbol-name name) name)
+ params)))
+ ;; Should we signal when we don't have a param?
+ (if param-pair
+ (cdr param-pair)
+ default)))
+
+(defun http-method (httpcon)
+ "Get the HTTP request method (GET, PUT, etc...) as a string."
+ (or
+ (elnode/con-get httpcon :elnode-http-method)
+ (-http-parse-status httpcon :elnode-http-method)))
+
+(defun http-version (httpcon)
+ "Get the PATHINFO of the request."
+ (or
+ (elnode/con-get httpcon :elnode-http-version)
+ (-http-parse-status httpcon :elnode-http-version)))
+
+(defun http-send-string (httpcon str)
+ "Send STR to HTTPCON, doing chunked encoding."
+ (msg :debug
+ "elnode-http-send-string %s [[%s]]" httpcon (s-truncate 10 str))
+ (let ((len (string-bytes str)))
+ (elnode/con-put httpcon :elnode-bytes-written
+ (+ len (or (elnode/con-get httpcon :elnode-bytes-written)
0)))
+ ;; FIXME Errors can happen here, because the socket goes away.. it
+ ;; would be nice to trap them and report and then re-raise them.
+ (if (eq (process-status httpcon) 'open)
+ (condition-case err
+ (process-send-string
+ httpcon
+ (format "%x\r\n%s\r\n" (length str) (or str "")))
+ (error
+ (msg :warning
+ "elnode-http-send-string failed to send [%s] on %s (%s)"
+ (length str) httpcon (process-status httpcon))))
+ (msg :warning
+ "elnode-http-send-string can't print [%s] because %s is %s"
+ (length str) httpcon (process-status httpcon)))))
+
+(defconst http-codes-alist
+ (loop for p in '((200 . "Ok")
+ (201 . "Created")
+ (302 . "Redirect")
+ (400 . "Bad Request")
+ (401 . "Authenticate")
+ (404 . "Not Found")
+ (500 . "Server Error"))
+ ;; add an alist entry with an integer key
+ collect p
+ ;; add an alist entry with a string key
+ collect
+ (cons (number-to-string (car p))
+ (cdr p)))
+ "HTTP codes with string keys and integer keys.")
+
+(defun* http-cookie-make (name data &key expiry path)
+ "Make a set-cookie header pair from NAME and DATA.
+
+DATA should be a string to be used as the value of the cookie.
+
+Other key values are standard cookie attributes.
+
+Use this with `elnode-http-start' to make cookie headers:
+
+ (elnode-http-start
+ httpcon 200
+ '(content-type . \"text/html\")
+ (elnode-http-cookie-make \"pi\" 3.14579)
+ (elnode-http-cookie-make \"e\" 1.59
+ :expiry \"Mon, Feb 27 2012 22:10:21 GMT;\")
+
+This will send two Set-Cookie headers setting the cookies 'pi'
+and 'e'.
+
+The return value is a cons pair."
+ (cons
+ "Set-Cookie"
+ (format "%s=%s;%s"
+ name
+ data
+ (if (not (or expiry
+ path))
+ ""
+ (loop for p in `((expires . ,expiry)
+ (path . ,path))
+ if (cdr p)
+ concat
+ (format
+ " %s=%s;"
+ (capitalize (symbol-name (car p)))
+ (cdr p)))))))
+
+(defun http-header-set (httpcon header &optional value)
+ "Sets the HEADER for later processing.
+
+HEADER may be a pair of `name' and `value' or it may just be a
+String, or a Symbol in which case the VALUE must be specified.
+
+If HEADER is a pair and VALUE is also specified then VALUE is
+ignored.
+
+When the HTTP response is started any set headers will be merged
+with any requested headers and sent.
+
+If the response has been started it is an error to try to set a
+header. This function will log the error and return `nil'.
+
+See `elnode-http-start'."
+ (if (elnode/con-get httpcon :elnode-http-started)
+ (msg :warning "can't set header, HTTP already started on %s" httpcon)
+ (let ((headers (elnode/con-get httpcon :elnode-headers-to-set)))
+ (elnode/con-put
+ httpcon
+ :elnode-headers-to-set
+ (append headers
+ (list (if (consp header)
+ header
+ (cons header value))))))))
+
+(defun* http-cookie-set (httpcon name data &key expiry path)
+ "Make a cookie and set it on the HTTPCON.
+
+See `elnode-http-cookie-make' for details about cookie making."
+ (let ((cookie-cons (http-cookie-make
+ name data :expiry expiry :path path)))
+ (http-header-set httpcon (car cookie-cons) (cdr cookie-cons))))
+
+(defun -http-result-header (hdr-alist)
+ "Turn the HDR-ALIST into a result header string.
+
+The HDR-ALIST is an alist of symbol or string keys which are
+header names, against values which should be strings."
+ (let ((hdr-pairs
+ (append
+ (list (cons 'transfer-encoding "chunked"))
+ hdr-alist)))
+ (loop for p in hdr-pairs
+ concat
+ (format
+ "%s: %s\r\n"
+ (let ((hname (car p)))
+ (capitalize
+ (cond
+ ((symbolp hname)
+ (symbol-name hname))
+ ((stringp hname)
+ hname)
+ (t
+ (error "unsupported header type")))))
+ (cdr p)))))
+
+(defun http-start (httpcon status &rest header)
+ "Start the http response on the specified http connection.
+
+HTTPCON is the HTTP connection being handled.
+
+STATUS is the HTTP status, eg: 200 or 404; integers or strings
+are acceptable types.
+
+HEADER is a sequence of (`header-name' . `value') pairs.
+
+For example:
+
+ (elnode-http-start httpcon \"200\" '(\"Content-type\" . \"text/html\"))
+
+The status and the header are also stored on the process as meta
+data. This is done mainly for testing infrastructure."
+ (if (elnode/con-get httpcon :elnode-http-started)
+ (msg :warning "elnode-http-start: HTTP already started on %s" httpcon)
+ ;; Send the header
+ (msg :debug "elnode-http-start: starting HTTP response on %s" httpcon)
+ (let ((header-alist
+ (append (elnode/con-get httpcon :elnode-headers-to-set) header))
+ (status-code (if (stringp status)
+ (string-to-number status)
+ status)))
+ ;; Store the meta data about the response.
+ (elnode/con-put httpcon
+ :elnode-httpresponse-status status-code
+ :elnode-httpresponse-header header-alist)
+ (process-send-string
+ httpcon
+ (format
+ "HTTP/1.1 %d %s\r\n%s\r\n"
+ status-code
+ ;; The status text
+ (kva status-code http-codes-alist)
+ ;; The header
+ (or
+ (-http-result-header header-alist)
+ "\r\n")))
+ (elnode/con-put httpcon :elnode-http-started (current-time)))))
+
+(defun -http-end (httpcon)
+ "Marks the HTTPCON ended and does end of request things.
+
+This makes access log file calls if the socket has a property
+`:elnode-access-log-name'. The property is taken to be the name
+of a buffer."
+ (msg :info "elnode--http-end ending socket %s" httpcon)
+ (let ((access-log-name (elnode/con-get httpcon :elnode-access-log-name)))
+ (when access-log-name
+ (condition-case err
+ (log-access access-log-name httpcon)
+ (error
+ (when nil
+ (msg :warning
+ "elnode--http-end: an error occurred processing the access
log"))))))
+ (when (eq 'open (process-status httpcon)) (process-send-eof httpcon))
+ ;; Signal to elnode--filter that we're done
+ (elnode/con-put httpcon :elnode-finished t))
+
+(defun http-return (httpcon &optional data)
+ "End the response on HTTPCON optionally sending DATA first.
+
+HTTPCON is the http connection which must have had the headers
+sent with `elnode-http-start'
+
+DATA must be a string, it's just passed to `elnode-http-send'."
+ (if (not (elnode/con-get httpcon :elnode-http-started))
+ (msg :warning "elnode-http-return: HTTP not started")
+ (progn
+ (when data
+ (http-send-string httpcon data))
+ ;; Need to close the chunked encoding here
+ (http-send-string httpcon "")
+ (-http-end httpcon))))
+
+(defun send-html (httpcon html)
+ "Simple send for HTML.
+
+Use this for simple sending of a full HTML response:
+
+ (defun my-handler (httpcon)
+ (elnode-send-html httpcon \"<html><h1>Hello!</h1></html>\"))
+
+The data is sent with content type: text/html."
+ (http-start httpcon 200 '("Content-Type" . "text/html"))
+ (http-return httpcon html))
+
+(defun json-fix (data)
+ "Fix JSON "
+ (let ((json-to-send
+ (noflet
+ ((json-alist-p (list)
+ "Proper check for ALIST."
+ (while (consp list)
+ (setq list
+ (if (and
+ (consp (car list))
+ (not (consp (caar list)))
+ (not (vectorp (caar list))))
+ (cdr list)
+ 'not-alist)))
+ (null list)))
+ (json-encode data)))) json-to-send))
+
+(defun send-report (httpcon)
+ "Send back an HTML report on the request.
+
+This is often useful for debugging."
+ (noflet ((alist->html (alist)
+ (mapconcat
+ (lambda (hdr-pair)
+ (format
+ "%s %s"
+ (car hdr-pair)
+ (let ((v (cdr hdr-pair)))
+ (if (and v (not (equal v "")))
+ (format "%S" v) ""))))
+ alist
+ "\n")))
+ (let* ((method (http-method httpcon))
+ (paramters (alist->html
+ (or (http-params httpcon)
+ '(("None". "")))))
+ (headers (alist->html (http-headers httpcon)))
+ (page (s-lex-format "<html>
+<style>
+body { font-family: sans-serif;}
+td {
+vertical-align: top;
+}
+</style>
+<body>
+<table>
+<tr><td>method:</td><td>${method}</td></tr>
+<tr><td>parameters:</td><td><pre>${paramters}</pre></td><tr>
+<tr><td>headers:</td><td><pre>${headers}</pre></td><tr>
+</table>
+</body>
+</html>")))
+ (send-html httpcon page))))
+
+
+(defun* send-json (httpcon data &key content-type jsonp)
+ "Convert DATA to JSON and send to the HTTPCON with a 200 \"Ok\".
+
+DATA is some lisp object.
+
+If CONTENT-TYPE is specified then it is used as the HTTP Content
+Type of the response.
+
+If JSONP is specified the content is sent as a JSON-P response.
+If the variable specifies a name for the JSON-P callback function
+that that is used. Alternately, if the JSONP parameter does not
+specify a name, the parameter `callback' is looked up on the
+HTTPCON and the value of that used. If neither the JSONP
+parameter, not the HTTP parameter `callback' is present that the
+name \"callback\" is used."
+ (let ((json-to-send (json-fix data)))
+ (http-start
+ httpcon 200
+ `("Content-type" . ,(or content-type "application/json")))
+ (http-return
+ httpcon
+ (if jsonp
+ (format
+ "%s(%s);"
+ (or (when (stringp jsonp)
+ jsonp)
+ (http-param httpcon "callback")
+ "callback")
+ json-to-send)
+ json-to-send))))
+
+(defun send-status (httpcon status &optional msg)
+ "A generic handler to send STATUS to HTTPCON.
+
+Sends an HTTP response with STATUS to the HTTPCON. An HTML body
+is sent by looking up the STATUS in the `elnode-default-response'
+table.
+
+Optionally include MSG."
+ (http-start httpcon status '("Content-type" . "text/html"))
+ (http-return httpcon
+ (-format-response status msg)))
+
+(defun send-404 (httpcon &optional msg)
+ "Sends a Not Found error to the HTTPCON.
+
+Optionally include MSG."
+ (send-status httpcon 404 msg))
+
+(defun send-400 (httpcon &optional msg)
+ "Sends a Bad Request error to the HTTPCON.
+
+Optionally include MSG."
+ (send-status httpcon 400 msg))
+
+(defun send-500 (httpcon &optional msg)
+ "Sends a Server Error to the HTTPCON.
+
+Optionally include MSG."
+ (send-status httpcon 500 msg))
+
+(defun send-redirect (httpcon location &optional type)
+ "Sends a redirect to LOCATION.
+
+If TYPE is non-nil, use it as a status code. Defaults to 302 -
+permanent redirect."
+ (let ((status-code (or type 302)))
+ (http-start httpcon status-code `("Location" . ,location))
+ (http-return
+ httpcon
+ (format "<h1>redirecting you to %s</h1>\r\n" location))))
+
+(defun normalize-path (httpcon handler)
+ "A decorator for HANDLER that normalizes paths to have a trailing slash.
+
+This checks the HTTPCON path for a trailing slash and sends a 302
+to the slash trailed url if there is none.
+
+Otherwise it calls HANDLER."
+ (let ((ends-in-slash-or-extension-regex ".*\\(/\\|.*\\.[^/]*\\)$")
+ (path (http-pathinfo httpcon)))
+ (if (not (save-match-data
+ (string-match ends-in-slash-or-extension-regex
+ path)))
+ (send-redirect
+ httpcon
+ (format "%s/" path))
+ (funcall handler httpcon))))
+
+(defun -mapper-find-match-func (match-path match-pair)
+ "Funtion to test MATCH-PATH against MATCH-PAIR."
+ (let ((m (string-match (car match-pair) match-path)))
+ (and m
+ (numberp m)
+ (>= m 0)
+ match-pair)))
+
+(defun -mapper-find-mapping (match-path mapping-table)
+ "Return the mapping that matches MATCH-PATH in MAPPING-TABLE."
+ (loop for mapping in mapping-table
+ if (-mapper-find-match-func match-path mapping)
+ return mapping))
+
+(defun -mapper-find (httpcon path mapping-table)
+ "Try and find the PATH inside the MAPPING-TABLE.
+
+This function exposes its `match-data' on the 'path' variable so
+that you can access that in your handler with something like:
+
+ (match-string 1 (elnode-http-pathinfo httpcon))
+
+Returns the handler function that mapped, or `nil'.
+
+This function also establishes the `:elnode-http-mapping'
+property, adding it to the HTTPCON so it can be accessed from
+inside your handler with `elnode-http-mapping'."
+ ;; First find the mapping in the mapping table
+ (let* ((pair (-mapper-find-mapping path mapping-table))
+ (func-item (and pair
+ (let* ((v (cdr pair)))
+ (or (and (atom v) v)
+ (if (functionp (car v))
+ (car v)
+ (when (functionp v) v)))))))
+ ;; Now work out if we found one and what it was mapped to
+ (when (or (functionp func-item)
+ (functionp (and (symbolp func-item)
+ (symbol-value func-item))))
+ ;; Make the match parts accessible
+ (elnode/con-put
+ httpcon
+ :elnode-http-mapping
+ (when (string-match (car pair) path)
+ (loop for i from 0 to (- (/ (length (match-data path)) 2) 1)
+ collect (match-string i path))))
+ ;; Return the function
+ func-item)))
+
+(defun -http-mapping-implementation (httpcon &optional part)
+ "The actual implementation of `elnode-http-mapping.'
+
+This is here so that you flet `elnode-http-mapping' and still get
+at the real functionality."
+ (if (eq part t)
+ (length (elnode/con-get httpcon :elnode-http-mapping))
+ ;; Else it's a specific part
+ (elt
+ (elnode/con-get httpcon :elnode-http-mapping)
+ (if part part 0))))
+
+(defun http-mapping (httpcon &optional part)
+ "Return the match on the HTTPCON that resulted in the current handler.
+
+With PART it returns a specific part of the match, by default
+PART is 0. If PART is specified as `t' then the count of parts
+is returned.
+
+This results only from a call via `elnode-dispatcher'.
+
+It returns the string which matched your url-mapping, with the
+match-data attached. So given the mapping:
+
+ (\"/static/\\(.*\\)\" . my-handler)
+
+and the request:
+
+ /static/somedir/somefile.jpg
+
+The following is true inside the handler:
+
+ (equal \"/somedir/somefile.jpg\"
+ (match-string 1 (elnode-http-mapping httpcon)))
+
+The function `elnode-test-path' uses this facility to work out a
+target path."
+ (-http-mapping-implementation httpcon part))
+
+(defsubst -strip-leading-slash (str)
+ "Strip any leading slash from STR.
+
+If there is no leading slash then just return STR."
+ (if (and (stringp str) (eq (elt str 0) ?/))
+ (substring str 1)
+ str))
+
+(defun get-targetfile (httpcon docroot)
+ "Get the targeted file from the HTTPCON.
+
+Attempts to resolve the matched path of the HTTPCON against the
+DOCROOT. If that doesn't work then it attempts to use just the
+pathinfo of the request.
+
+The resulting file is NOT checked for existence or safety."
+ (let* ((pathinfo (http-pathinfo httpcon))
+ (path (http-mapping httpcon 1))
+ (targetfile
+ (join
+ (expand-file-name docroot)
+ (-strip-leading-slash
+ (or path pathinfo)))))
+ targetfile))
+
+
+;; We need to declare this before the dispatcher stuff, which uses it.
+(defvar -defined-authentication-schemes
+ (make-hash-table :test 'equal)
+ "The hash of defined authentication schemes.")
+
+(defvar -do-access-logging-on-dispatch t
+ "Needed to suppress logging in testing.")
+
+(defun -auth-entry->dispatch-table (auth-scheme &optional hostpath)
+ "Make a dispatch table from the AUTH-SCHEME.
+
+If HOSTPATH is specified then the resulting match spec is of the
+`hostpath' type for use with `elnode-hostpath-dispatcher'."
+ (let* ((auth-scheme (gethash
+ auth-scheme
+ -defined-authentication-schemes))
+ (redirect (plist-get auth-scheme :redirect))
+ (login-handler (plist-get auth-scheme :login-handler)))
+ (when redirect
+ (list
+ (cons
+ (concat (if hostpath "^.*/" "^") redirect "$")
+ login-handler)))))
+
+(defun* -dispatch-proc (httpcon
+ path
+ url-mapping-table
+ &key
+ (function-404 'elnode-send-404)
+ (log-name "elnode")
+ extra-table)
+ "Dispatch to the matched handler for the PATH on the HTTPCON.
+The handler for PATH is matched in the URL-MAPPING-TABLE via
+`elnode--mapper-find'.
+
+If no handler is found then a 404 is attempted via FUNCTION-404,
+if it's found to be a function, or as a last resort
+`elnode-send-404'.
+
+The function also supports the searching of the map provided by
+an EXTRA-TABLE. This is useful for authentication and other
+wrappers. If it is specified it is searched first."
+ (let ((handler-func
+ (or
+ ;; Either a match from extra-table ...
+ (and extra-table
+ (-mapper-find
+ httpcon path extra-table))
+ ;; ... or from the standard url-mapping-table
+ (-mapper-find
+ httpcon path url-mapping-table))))
+ (when -do-access-logging-on-dispatch
+ (elnode/con-put httpcon :elnode-access-log-name log-name))
+ (cond
+ ;; If we have a handler, use it.
+ ((functionp handler-func)
+ (funcall handler-func httpcon))
+ (t
+ (funcall function-404 httpcon)))))
+
+(defun* dispatcher (httpcon
+ url-mapping-table
+ &key
+ (function-404 'elnode-send-404)
+ auth-scheme)
+ "Dispatch HTTPCON to the function mapped in URL-MAPPING-TABLE.
+
+URL-MAPPING-TABLE is an alist of:
+
+ (url-regex . function-to-dispatch)
+
+To map the root url you should use:
+
+ \"^/$\"
+
+To ensure paths end in /, `elnode-dispatcher' uses
+`elnode-normalize-path'. To map another url you should use:
+
+ \"^/path/$\" or \"^/path/sub-path/$\"
+
+An example server setup:
+
+ (defun my-server (httpcon)
+ (elnode-dispatcher
+ httpcon
+ '((\"^/$\" . root-view)
+ (\"^/1/$\" . view-1))))
+
+If FUNCTION-404 is specified it is called when no regexp is
+matched, otherwise `elnode-send-404' is used.
+
+AUTH-SCHEME is an optional authentication scheme, defined with
+`elnode-defauth', which specifies a redirect mapping for
+authentications."
+ (normalize-path
+ httpcon
+ (lambda (httpcon)
+ ;; Get pathinfo again because we may have redirected.
+ (let ((pathinfo (http-pathinfo httpcon))
+ (extra-table
+ (-auth-entry->dispatch-table auth-scheme)))
+ (-dispatch-proc
+ httpcon
+ pathinfo
+ url-mapping-table
+ :function-404 function-404
+ :extra-table extra-table)))))
+
+(defun -hostpath (host path)
+ "Turn the host and path into a hostpath."
+ (format
+ "%s/%s"
+ (let ((host-name (or host "")))
+ ;; Separate the hostname from any port in the host header
+ (save-match-data
+ (if (string-match "\\([^:]+\\)\\(:[0-9]+.*\\)*" host-name)
+ (match-string 1 host-name)
+ "")))
+ path))
+
+(defun* hostpath-dispatcher (httpcon
+ hostpath-mapping-table
+ &key
+ (function-404 'elnode-send-404)
+ (log-name "elnode")
+ auth-scheme)
+ "Dispatch HTTPCON to a handler based on the HOSTPATH-MAPPING-TABLE.
+
+HOSTPATH-MAPPING-TABLE has regexs of the host and the path double
+slash separated, thus:
+
+ (\"^localhost//pastebin.*\" . pastebin-handler)
+
+FUNCTION-404 should be a 404 handling function, by default it's
+`elnode-send-404'.
+
+LOG-NAME is an optional log-name.
+
+AUTH-SCHEME is an optional authentication scheme, defined with
+`elnode-defauth', which specifies a redirect mapping for
+authentications."
+ (let ((hostpath (-hostpath
+ (http-header httpcon "Host")
+ (http-pathinfo httpcon)))
+ (extra-table
+ ;; Make sure it's a hostpath type
+ (-auth-entry->dispatch-table auth-scheme t)))
+ (-dispatch-proc
+ httpcon
+ hostpath
+ hostpath-mapping-table
+ :function-404 function-404
+ :log-name log-name
+ :extra-table extra-table)))
+
+;;;###autoload
+(defcustom hostpath-default-table
+ '(("[^/]+//wiki/\\(.*\\)" . elnode-wikiserver)
+ ("[^/]+//\\(.*\\)" . elnode-webserver))
+ "Defines mappings for `elnode-hostpath-default-handler'.
+
+This is the default mapping table for Elnode, out of the box. If
+you customize this then elnode will serve these hostpath mappings
+by just loading Elnode.
+
+By default the table maps everything to
+`elnode-webserver'. Unless you're happy with the default you
+should probably get rid of the everything path because it will
+interfere with any other mappings you add."
+ :group 'elnode
+ :type '(alist :key-type string
+ :value-type symbol))
+
+(defun hostpath-default-handler (httpcon)
+ "A default hostpath handler.
+
+This uses the `elnode-hostpath-default-table' for the match
+table. It calls `elnode-hostpath-dispatcher' with
+`elnode-hostpath-default-table'."
+ (hostpath-dispatcher httpcon hostpath-default-table))
+
+
+;; Async handling stuff
+
+;; Elnode child process functions
+
+(defcustom log-worker-elisp nil
+ "If true then worker Elisp (Elisp run in a child-Emacs process) is logged.
+
+The buffer '* elnode-worker-elisp *' is used for the log."
+ :group 'elnode
+ :type '(boolean))
+
+(defcustom log-worker-responses nil
+ "If true then worker Elisp logs responses in a buffer.
+
+The buffer '* elnode-worker-response *' is used for the log."
+ :group 'elnode
+ :type '(boolean))
+
+
+(defun wait-for-exit (process)
+ "Wait for PROCESS status to go to 'exit."
+ (while (not (eq (process-status process) 'exit))
+ (sleep-for 1)))
+
+
+;; TODO: handle errors better than messaging
+(defun -child-process-sentinel (process status)
+ "A sentinel for Elnode child PROCESS.
+
+Elnode child processes are just Emacs asynchronous processes that
+send their output to an Elnode HTTP connection.
+
+The main job of this sentinel is to monitor when the STATUS of
+PROCESS indicates the end of the PROCESS and to do
+`elnode-http-end' on the associated HTTP connection when that
+happens."
+ (cond
+ ((equal status "finished\n")
+ (let ((httpcon (elnode/con-get process :elnode-httpcon)))
+ (msg
+ :info
+ "elnode-child-process-sentinel Status @ finished: %s -> %s on %s"
+ (process-status httpcon)
+ (process-status process)
+ httpcon)
+ (if (not (eq 'closed (process-status httpcon)))
+ (progn
+ (http-send-string httpcon "")
+ (process-send-string httpcon "\r\n")
+ (-http-end httpcon)))))
+ ((string-match "exited abnormally with code \\([0-9]+\\)\n" status)
+ (let ((httpcon (elnode/con-get process :elnode-httpcon)))
+ (msg
+ :info "elnode-child-process-sentinel: %s on %s"
+ status httpcon)
+ (if (not (eq 'closed (process-status httpcon)))
+ (progn
+ ;; Spit out the error at the end of the content
+ (when (elnode/con-get httpcon :elnode-child-process-command)
+ (http-send-string
+ httpcon
+ (format
+ "%s %s"
+ (elnode/con-get httpcon :elnode-child-process-command)
+ status)))
+ ;; Now close the content
+ (http-send-string httpcon "")
+ (process-send-string httpcon "\r\n")
+ (-http-end httpcon)))
+ (delete-process process)
+ (kill-buffer (process-buffer process))))
+ (t
+ (msg
+ :info "elnode-child-process-sentinel: %s on %s"
+ status process))))
+
+(defun -child-process-filter (process data)
+ "A generic filter function for elnode child processes.
+
+Elnode child processes are just Emacs asynchronous processes that
+send their output to an Elnode HTTP connection.
+
+This filter function does the job of taking the output from the
+async process and finding the associated Elnode HTTP connection
+and sending the data there."
+ (let ((httpcon (elnode/con-get process :elnode-httpcon)))
+ (msg
+ :info "elnode-child-process-filter http state: %s data length: %s on %s"
+ (process-status httpcon)
+ (length data)
+ httpcon)
+ (unless (eq 'closed (process-status httpcon))
+ (http-send-string httpcon data))))
+
+(defun child-process (httpcon program &rest args)
+ "Run the specified PROGRAM asynchronously sending output to HTTPCON.
+
+PROGRAM is the path to the program to run, to be resolved by
+`start-process' in the usual way.
+
+ARGS is a list of arguments to pass to the program.
+
+It is NOT POSSIBLE to run more than one process at a time
+directed at the same http connection."
+ (let* ((proc-args
+ (append
+ (list
+ (format "%s-%s" (process-name httpcon) program)
+ (format " %s-%s" (process-name httpcon) program)
+ program) args))
+ (p (let ((process-connection-type nil)
+ (default-directory (file-name-directory program)))
+ (apply 'start-process proc-args))))
+ ;; Store the program and args for later
+ (elnode/con-put
+ httpcon :elnode-child-process-command
+ (format "%s %s" program (s-join " " args)))
+ (set-process-coding-system p 'raw-text-unix)
+ ;; Bind the http connection to the process
+ (elnode/con-put p :elnode-httpcon httpcon)
+ ;; Bind the process to the http connection
+ ;;
+ ;; WARNING: this means you can only have 1 child process at a time
+ (elnode/con-put httpcon :elnode-child-process p)
+ ;; Setup the filter and the sentinel to do the right thing with
+ ;; incomming data and signals
+ (set-process-filter p 'elnode--child-process-filter)
+ (set-process-sentinel p 'elnode--child-process-sentinel)
+ (msg :info "elnode-child-process init %s" httpcon)))
+
+
+;; File management
+
+(defcustom send-file-program "/bin/cat"
+ "The program to use for sending files.
+
+Altering this is not recomended but it may be a good hook for
+certain types of debugging."
+ :group 'elnode
+ :type '(string))
+
+(defvar replacements-pattern "<!##E \\(.*?\\) E##!>"
+ "The regex used for replacing things.
+
+The default regex is rather baroque. This is because it needs to
+be quite unique and there are a lot of different sorts of things
+like this to be unique from.")
+
+(defun -buffer-template (file-buf replacements)
+ "Template render a buffer and return a copy.
+
+FILE-BUF is the source buffer to use, template sections marked up like:
+
+ <!##E \\(.*?\\) E##!>
+
+will be replaced with a value looked up in REPLACEMENTS.
+
+REPLACEMENTS is either a hashtable or an association list.
+
+For example:
+
+ <title><!##E my-title E##!></title>
+ <p>By <!##E my-name E##!>.</p>
+
+with the REPLACEMENTS being:
+
+ my-title => All things Elnode!
+ my-name => Nic Ferrier
+
+would result in the string:
+
+ <title>All things Elnode!</title>
+ <p>By Nic Ferrier</p>
+
+being returned."
+ (with-current-buffer file-buf
+ (replace-regexp-in-string
+ replacements-pattern
+ (lambda (matched)
+ (let ((match-var (match-string-no-properties 1 matched)))
+ (cond
+ ((hash-table-p replacements)
+ (gethash match-var replacements ""))
+ (t
+ ;; Presume it's an alist
+ (or
+ (assoc-default match-var replacements nil t)
+ "")))))
+ (buffer-substring-no-properties (point-min)(point-max)))))
+
+(defcustom webserver-visit-file (eq system-type 'windows-nt)
+ "Whether the webserver reads files by visiting buffers or not.
+
+When set to `t' files to be sent with the `elnode-send-file' are
+read into Emacs using `find-file'."
+ :group 'elnode
+ :type 'boolean)
+
+(defvar replacements-httpcon nil
+ "This is bound by `elnode-send-file' when doing replacements.
+
+It should not be used otherwise.")
+
+(defvar replacements-targetfile nil
+ "This is bound by `elnode-send-file' when doing replacements.
+
+It should not be used otherwise.")
+
+(defun -rfc1123-date (time)
+ "Return TIME in RFC1123 format, suitable for HTTP dates."
+ (let* ((day-names '("Sun" "Mon" "Tue" "Wed" "Thu" "Fri" "Sat"))
+ (month-names '("Jan" "Feb" "Mar" "Apr" "May" "Jun"
+ "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"))
+ (decoded-time (decode-time time))
+ (day (nth (nth 6 decoded-time) day-names))
+ (month (nth (- (nth 4 decoded-time) 1) month-names)))
+ (format "%s, %s %s %s"
+ day
+ (format-time-string "%d" time t)
+ month
+ (format-time-string "%Y %H:%M:%S GMT" time t))))
+
+(defsubst -file-modified-time (file)
+ "Get modification time for FILE."
+ (nth 5 (file-attributes file)))
+
+(defvar send-file-assoc nil
+ "A-list of file patterns vs functions to serve files.
+
+When a file is sent with `elnode-send-file' we try and match the
+targetfile against the regex patterns in the `car' of this alist
+and then use the function in the `cdr' to send the file instead
+of sending it directly.")
+
+(defun* send-file (httpcon targetfile
+ &key
+ preamble
+ mime-types
+ replacements)
+ "Send the TARGETFILE to the HTTPCON.
+
+If the TARGETFILE is relative then resolve it via the current
+`load-file-name' or `buffer-file-name' or `default-directory'.
+
+WARNING: this resolution order is likely to change because,
+especially when developing `default-directory' can be quite
+random (change buffer, change `default-directory').
+
+Optionally you may specify extra keyword arguments:
+
+:PREAMBLE a string of data to send before the file.
+
+:PREAMBLE is most useful for prefixing syntax to some other file,
+for example you could prefix an XML file with XSL transformation
+statements so a compliant user-agent will transform the XML.
+
+:MIME-TYPES is an optional alist of MIME type mappings to help
+resolve the type of a file.
+
+If :REPLACEMENTS is specified it should be a hash-table or an
+association list used to supply values for templating. When
+templating is specified the targetfile is not sent directly but
+opened in Emacs as a buffer and transformed through the
+templating system before being sent. See
+`elnode--buffer-template' for details of templating.
+
+REPLACEMENTS can optionally be a function in which case the
+return value is expected to be the hash-table or alist for the
+variables. The function should have no arguments but two
+variables are bound during the function's execution
+`elnode-replacements-httpcon' is the `httpcon' and
+`elnode-replacements-targetfile' is the targetfile to be
+delivered.
+
+See `elnode-send-file-assoc' for more possible transformations."
+ (let ((filename
+ (if (not (file-name-absolute-p targetfile))
+ (let ((dir (or load-file-name buffer-file-name)))
+ (file-relative-name
+ targetfile
+ (if dir (directory-file-name dir) default-directory)))
+ targetfile)))
+ (if (not (file-exists-p filename))
+ ;; FIXME: This needs improving so we can handle the 404
+ ;; This function should raise an exception?
+ (send-404 httpcon)
+ ;; Else ...
+ (let (send-func)
+ (if (setq send-func
+ (and send-file-assoc
+ (loop for (pattern . func) in send-file-assoc
+ if (string-match-p pattern targetfile)
+ return func)))
+ (funcall send-func httpcon targetfile)
+ ;; Else we don't have a send func so just send it
+ (let ((mimetype
+ (or (when (listp mime-types)
+ (car (rassoc
+ (file-name-extension targetfile)
+ mime-types)))
+ (mm-default-file-encoding targetfile)
+ "application/octet-stream")))
+ (http-start
+ httpcon 200
+ `("Content-type" . ,mimetype)
+ `("Last-Modified" . ,(elnode--rfc1123-date
+ (elnode--file-modified-time targetfile))))
+ (when preamble (http-send-string httpcon preamble))
+ (if (or webserver-visit-file replacements)
+ (http-return
+ httpcon
+ (if replacements
+ (-buffer-template
+ (find-file-noselect filename)
+ ;; Replacements handling
+ (if (functionp replacements)
+ (let ((replacements-httpcon httpcon)
+ (replacements-targetfile targetfile))
+ (funcall replacements))
+ replacements))
+ (with-temp-buffer
+ (insert-file-contents-literally filename)
+ (buffer-string))))
+ (child-process
+ httpcon
+ send-file-program
+ (expand-file-name targetfile)))))))))
+
+(defmacro method (httpcon &rest method-mappings)
+ "Map the HTTP method.
+
+Write code like this:
+
+ (elnode-method
+ (GET
+ (code)
+ (more code))
+ (POST
+ (different code)
+ (evenmorecode)))"
+ (declare
+ (debug (sexp &rest (sexp &rest form)))
+ (indent 1))
+ (let* ((var (make-symbol "v"))
+ (conv (make-symbol "con")))
+ `(let* ((,conv ,httpcon)
+ (,var (intern (elnode-http-method ,conv))))
+ (cond
+ ,@(loop
+ for d in method-mappings
+ unless (eq (car d) t)
+ collect `((eq ,var (quote ,(car d)))
+ ,@(cdr d)))
+ ;; If we don't map then send an error
+ ;;
+ ;; probably should be 405
+ (t
+ ,@(or (cdr (assoc t method-mappings))
+ `((elnode-send-500 ,conv))))))))
+
+
+;; Make simple handlers automatically
+
+(defun make-redirecter (location &optional type)
+ "Make a handler that will redirect to LOCATION.
+
+Optionally, use the specified TYPE as the status code, eg:
+
+ (elnode-make-redirect \"http://somehost.com/\"; 301)"
+ (lambda (httpcon)
+ (send-redirect httpcon location type)))
+
+(defun* make-send-file (filename
+ &key
+ preamble
+ mime-types
+ replacements
+ replacements-pattern)
+ "Make a handler that will serve a single FILENAME.
+
+If the FILENAME is relative then it is resolved against the
+package's `load-file-name'.
+
+Optionally MIME-TYPES and other additional keyword arguments may be
+specified and are passed through, see `elnode-send-file' for
+details.
+
+The REPLACEMENTS parameter can be a function that returns a
+hash-table or alist, this is very useful for this function
+because it allows dynamic variables to be defined. Again, see
+`elnode-send-file' for full documentation of this feature.
+
+The REPLACEMENTS-PATTERN can be used to set the regex used to
+match replacements. See `elnode-replacements-pattern'."
+ (lambda (httpcon)
+ (let ((replacements-pattern
+ (or replacements-pattern
+ replacements-pattern)))
+ (send-file
+ httpcon
+ filename
+ :mime-types mime-types
+ :preamble preamble
+ :replacements replacements))))
+
+
+;; Docroot protection
+
+(defun -under-docroot-p (target-file doc-root &optional ignore-missing)
+ "Is the TARGET-FILE under the DOC-ROOT?
+Optional argument IGNORE-MISSING will inhibit checks for missing files."
+ (let ((docroot (directory-file-name (expand-file-name doc-root))))
+ (and
+ (string-match
+ (format "^%s\\($\\|/\\)" docroot)
+ target-file)
+ (or ignore-missing (file-exists-p target-file)))))
+
+
+(defun not-found (httpcon target-file)
+ "`elnode-docroot-for' calls this when the doc was not found.
+
+You can override this in tests to have interesting effects. By
+default it just calls `elnode-send-404'."
+ (send-404 httpcon))
+
+(defun modified-since (httpcon modified-time)
+ "Implement the HTTP If-Modified-Since test.
+
+MODIFIED-TIME is the time the resource was modified, for example
+a file modification time."
+ (let* ((modified-since
+ (http-header
+ httpcon 'if-modified-since :time)))
+ (and
+ modified-since
+ (time-less-p modified-time modified-since))))
+
+(defun cached-p (httpcon target-file)
+ "Is the specified TARGET-FILE older than the HTTPCON?
+
+This uses `elnode-modified-since'."
+ (modified-since
+ httpcon (-file-modified-time target-file)))
+
+(defun cached (httpcon)
+ "`elnode-docroot-for' calls this when the resources was cached.
+
+By default it just calls `elnode-send-status' with 304."
+ (send-status httpcon 304))
+
+(defvar docroot-for-no-404 nil
+ "When set to true `elnode-docroot-for' doesn't check for missing files.")
+
+(defvar docroot-for-no-cache nil
+ "When set to true `elnode-docroot-for' doesn't check for cached files.")
+
+(defmacro docroot-for (doc-root with target-file-var
+ on httpcon
+ do &rest handling)
+ "Docroot protection for Elnode handlers.
+
+Test the path requested in HTTPCON is safely under the DOC-ROOT
+specified, bind the TARGET-FILE-VAR to the resulting expanded
+file name and execute the HANDLING code.
+
+For example:
+
+ (elnode-docroot-for
+ \"~/work\"
+ with file-var
+ on httpcon
+ do
+ (elnode-send-file httpcon file-var))
+
+checks any resource requested in HTTPCON is a file under the
+doc-root \"~/work\" and if it is, binds the resulting file name
+to FILE-VAR and calls the code following DO (which sends the file
+to the HTTPCON).
+
+When a file is not found (or not safe to return) `elnode-not-found' is called.
+
+When a file is cached on the client (when a client sends a
+conditional GET for the file that shows the client has an up to
+date copy) then `elnode-cached' is called."
+ (declare
+ (debug (sexp "with" sexp "on" sexp "do" &rest form))
+ (indent defun))
+ (let ((dr (make-symbol "docroot"))
+ (con (make-symbol "httpcon")))
+ (assert (or (eq with 'with) (eq with :with)))
+ (assert (or (eq on 'on) (eq on :on)))
+ (assert (or (eq do 'do) (eq do :do)))
+ `(let ((,dr ,doc-root)
+ (,con ,httpcon))
+ (let ((,target-file-var (elnode-get-targetfile ,con ,dr)))
+ (if (not (elnode--under-docroot-p
+ ,target-file-var ,dr elnode-docroot-for-no-404))
+ (elnode-not-found ,con ,target-file-var)
+ (if (and (not elnode-docroot-for-no-cache)
+ (elnode-cached-p ,con ,target-file-var))
+ (elnode-cached ,con)
+ ,@handling))))))
+
+
+;; Webserver stuff
+
+(defconst webserver-docroot-default
+ (expand-file-name (concat config-directory "public_html/"))
+ "The default location of the website.
+
+This is used to detect whether elnode needs to create this
+directory or not.")
+
+(defcustom webserver-docroot
+ webserver-docroot-default
+ "The document root of the webserver.
+
+Webserver functions are free to use this or not. The
+`elnode-webserver' function does use it."
+ :group 'elnode
+ :type 'file)
+
+(defcustom webserver-extra-mimetypes
+ '(("text/plain" . "creole")
+ ("text/plain" . "el"))
+ "Extra mime types to identify special file types.
+
+This is just a way of hacking the mime type discovery so we can
+add more file mappings more easily than editing `/etc/mime.types'."
+ :group 'elnode
+ :type '(alist :key-type string
+ :value-type string))
+
+(defcustom webserver-index '("index.html" "index.htm")
+ "A list of possible index filenames.
+
+Anyone of the values of this list may be picked as the index page
+for a directory."
+ :group 'elnode
+ :type '(repeat string))
+
+(defun -webserver-setup ()
+ "Setup the Elnode webserver by making a default public_html dir.
+
+The server has a single `test.html' file, this is so we can show
+off the standard webserver indexing in elnode's webserver."
+ (-dir-setup webserver-docroot
+ webserver-docroot-default
+ "default-webserver-test.html"
+ "test.html"
+ "default-webserver-image.png"))
+
+(defun url-encode-path (path)
+ "Return a url encoded version of PATH.
+
+This is like `url-hexify-string' but it handles the parts of the
+PATH properly. It also hexifies single quote."
+ (replace-regexp-in-string
+ "'" "%27"
+ (mapconcat
+ 'identity
+ (loop
+ for part in (split-string path "/")
+ collect
+ (concat
+ (url-hexify-string part)))
+ "/")))
+
+(defcustom webserver-index-page-template "<html>
+ <head>
+ <title>%s</title>
+ </head>
+ <body>
+ <h1>%s</h1>
+ <div>%s</div>
+ </body>
+</html>
+"
+ "The page template used to render an index page.
+
+The order of the variables is:
+
+- the title of the document
+- the title of the document
+- the HTML formatted list of files."
+ :group 'elnode
+ :type '(string))
+
+(defcustom webserver-index-file-template "<a href='%s'>%s</a><br/>\r\n"
+ "The template for each file in the webserver index.
+
+This is used to display each file in an automated directory index.
+
+It is expected the template has 2 %s variables in it, the first
+is the url to link to and the second is the content of the link."
+ :group 'elnode
+ :type '(string))
+
+(defun -webserver-index (docroot targetfile pathinfo &optional match)
+ "Constructs index documents.
+
+The index is made for the DOCROOT and TARGETFILE. The web path is
+PATHINFO.
+
+Optional MATCH is passed directly through to
+`directory-files-and-attributes'."
+ ;; TODO make this usable by people generally
+ (let ((dirlist (directory-files-and-attributes targetfile nil match)))
+ ;; TODO make some templating here so people can change this
+ (format
+ webserver-index-page-template
+ pathinfo
+ pathinfo
+ (loop for dir-entry in dirlist
+ concat
+ (let ((entry
+ (format
+ "%s/%s"
+ (if (equal pathinfo "/") "" pathinfo)
+ (car dir-entry))))
+ (format
+ webserver-index-file-template
+ (url-encode-path entry)
+ (car dir-entry)))))))
+
+;;;###autoload
+(defun -webserver-handler-proc (httpcon docroot mime-types)
+ "Actual webserver implementation.
+
+Do webserving to HTTPCON from the DOCROOT using the MIME-TYPES
+for meta information.
+
+This is not a real handler (because it takes more than the
+HTTPCON) but it is called directly by the real webserver
+handlers."
+ (docroot-for docroot
+ with targetfile
+ on httpcon
+ do
+ (let ((pathinfo (http-pathinfo httpcon)))
+ (if (file-directory-p targetfile)
+ ;; Use an existing index file or send a directory index
+ (let* ((indexfile
+ (loop for i in webserver-index
+ if (member i (directory-files targetfile))
+ return i)))
+ (if indexfile
+ (send-file httpcon (concat targetfile "/"
indexfile))
+ (let ((index (-webserver-index
+ docroot
+ targetfile
+ pathinfo)))
+ (http-start httpcon 200 '("Content-type" .
"text/html"))
+ (http-return httpcon index))))
+ ;; Send a file.
+ (send-file
+ httpcon
+ targetfile
+ :mime-types mime-types)))))
+
+(defun webserver-handler-maker (&optional docroot extra-mime-types)
+ "Make a webserver handler possibly with the DOCROOT and EXTRA-MIME-TYPES.
+
+Returns a proc which is the handler. The handler serves files out
+of the docroot and marks them with the content types that Emacs
+knows about. You can add extra content types for the webserver
+just by supplying an alist of mime-types and extensions for
+EXTRA-MIME-TYPES.
+
+The webserver handler also creates file indexes.
+
+The webserver uses `elnode-test-path' to make sure that the
+request does not go above the DOCROOT."
+ (let ((my-docroot (or docroot webserver-docroot))
+ (my-mime-types (or extra-mime-types
+ webserver-extra-mimetypes)))
+ `(lambda (httpcon)
+ ,(format "Webserver serving files on %s" my-docroot)
+ (elnode--webserver-handler-proc
+ httpcon ,my-docroot (quote ,my-mime-types)))))
+
+
+(defvar -make-webserver-store nil
+ "Alist of webservers made by `elnode-make-webserver'.
+
+Stored as `docroot' . `webserver'.")
+
+;;;###autoload
+(defun make-webserver (docroot port &optional host)
+ "Make a webserver interactively, for DOCROOT on PORT.
+
+An easy way for a user to make a webserver for a particular
+directory."
+ (interactive
+ (let ((docroot (read-directory-name "Docroot: " nil nil t))
+ (port (read-from-minibuffer "Port: "))
+ (host (if current-prefix-arg
+ (read-from-minibuffer "Host: ")
+ init-host)))
+ (list docroot port host)))
+ (let ((webserver-proc (webserver-handler-maker docroot)))
+ (add-to-list
+ 'elnode--make-webserver-store
+ (cons docroot webserver-proc))
+ (start
+ webserver-proc
+ :port (string-to-number (format "%s" port))
+ :host host)))
+
+;;;###autoload
+(defun webserver (httpcon)
+ "A simple webserver that serves documents out of `elnode-webserver-docroot'.
+
+This is just an example of an elnode webserver, but it may be all
+that is needed most of the time.
+
+See `elnode-webserver-handler-maker' for more possibilities for
+making webserver functions.
+
+HTTPCON is the HTTP connection to the user agent."
+ (-webserver-setup)
+ (let (use-webserver-handler-maker)
+ (if use-webserver-handler-maker
+ (-webserver-handler-proc
+ httpcon
+ webserver-docroot
+ webserver-extra-mimetypes)
+ ;; Otherwise DO use the handler maker...
+ (let ((webserver (webserver-handler-maker
+ webserver-docroot
+ webserver-extra-mimetypes)))
+ (funcall webserver httpcon)))))
+
+;; Default elnode auth databases
+
+(defconst auth-db-spec-default
+ `(db-hash
+ :filename
+ ,(expand-file-name (concat elnode-config-directory "elnode-auth")))
+ "The default elnode-auth-db specification.")
+
+(defcustom auth-db-spec
+ auth-db-spec-default
+ "The `db' specification of where the auth db is."
+ :group 'elnode
+ :type '(list symbol symbol string))
+
+(defvar auth-db
+ (db-make auth-db-spec)
+ "Authentication database.
+
+This is the data structure storing hashed passwords against
+username keys.
+
+It is an elnode database which can be one of several
+implementations.")
+
+(defvar secret-key "secret"
+ "Secret key used to hash secrets like passwords.")
+
+(defun auth-make-hash (username password)
+ "Hash the `elnode-secret-key' and the USERNAME and PASSWORD.
+
+This is not an ideal hashing function because `elnode-secret-key'
+is not very customizable. We need to find a way of making a
+secret key per elnode app and communicating that to this kind of function.
+
+It is possible to use a different hashing function when you
+define an elnode-auth scheme and that's probably the best way to
+do it right now."
+ (sha1 (format "%s:%s:%s"
+ secret-key
+ username
+ password)))
+
+(defvar -auth-user-add-databases-history nil
+ "The history of symbols used for auth databases.")
+
+(defvar -auth-user-add-username-history nil
+ "The history of usernames used for auth databases.")
+
+(defun auth-user-add (username password &optional auth-db)
+ "Command to add a user to the internal authentication database.
+
+With prefix-arg also request the authentication database variable
+name. The authentication database must exist. By default the
+main `elnode-auth-db' is used."
+ (interactive
+ (list (read-from-minibuffer
+ "username: " nil nil nil
+ 'elnode--auth-user-add-username-history)
+ (read-passwd "password: ")
+ (when current-prefix-arg
+ (intern
+ (completing-read
+ "auth database variable (elnode-auth-user-db): "
+ obarray
+ nil t nil
+ 'elnode--auth-user-add-databases-history
+ 'elnode-auth-db)))))
+ (unless auth-db
+ (setq auth-db 'elnode-auth-db))
+ (db-put
+ username
+ `(("token" . ,(elnode-auth-make-hash username password))
+ ("username" . ,username))
+ (symbol-value auth-db))
+ (message "username is %s" username))
+
+(defun* auth-user-p (username
+ password
+ &key
+ auth-test
+ (make-hash 'elnode-auth-make-hash))
+ "Does the AUTH-TEST pass?
+
+The password is stored in the db hashed keyed by the USERNAME,
+this looks up and tests the hash.
+
+MAKE-HASH is `elnode-auth-make-hash' by default. It takes a
+username and password and returns a token. Implementing a
+different function can implement different hashing algorithms.
+
+AUTH-TEST is passed a username and must return a token.
+AUTH-TEST can be used to change the hashed token lookup to find
+the token in a particular database."
+ (let ((token (funcall (or make-hash 'elnode-auth-make-hash)
+ username password)))
+ (equal token (funcall auth-test username))))
+
+
+(defvar loggedin-db (make-hash-table :test 'equal)
+ "Stores logins - authentication sessions.
+
+See `elnode-auth-login' for how this is updated.")
+
+
+(progn
+ ;; Sets up the elnode auth errors
+ (put 'elnode-auth-credentials
+ 'error-conditions
+ '(error elnode elnode-auth elnode-auth-credentials))
+ (put 'elnode-auth-credentials
+ 'error-message
+ "Elnode authentication failed")
+
+ ;; For failing cookies
+ (put 'elnode-auth-token
+ 'error-conditions
+ '(error elnode elnode-auth elnode-auth-token))
+ (put 'elnode-auth-token
+ 'error-message
+ "Elnode authentication failed"))
+
+(defun* auth-login (username
+ password
+ &key
+ auth-test
+ make-hash
+ (loggedin-db elnode-loggedin-db))
+ "Log a user in.
+
+Check the USERNAME and PASSWORD with `elnode-auth-user-p' and
+then update `elnode-loggedin-db' with the username and the login
+record.
+
+When the authentication test fails `elnode-auth-credentials'
+signal is raised.
+
+The optional AUTH-TEST which is the test to check the username
+and password with. It is passed to `elnode-auth-user-p'.
+
+The optional MAKE-HASH is a hash generation function passed to
+`elnode-auth-user-p'.
+
+LOGGEDIN-DB is the logged-in state database to use. By default,
+this is `elnode-loggedin-db'."
+ (if (auth-user-p username password
+ :auth-test auth-test :make-hash make-hash)
+ (let* ((rndstr (format "%d" (random)))
+ (str (format "%s:%s:%s" username rndstr secret-key))
+ (hash (sha1 str))
+ (user-record
+ (list
+ :user username
+ :token rndstr
+ :hash hash)))
+ (puthash username user-record loggedin-db)
+ hash)
+ ;; Else it was bad so throw an error.
+ (signal 'elnode-auth-credentials (list username password))))
+
+(defun* auth-check-p (username
+ token
+ &key
+ (loggedin-db elnode-loggedin-db))
+ "Check login status of the USERNAME against the hashed TOKEN.
+
+Optionally use the LOGGEDIN-DB supplied. By default this is
+`elnode-loggedin-db'.
+
+Returns USERNAME if true and `nil' if not it fails."
+ (let ((record (gethash username loggedin-db)))
+ (when (equal token (plist-get record :hash))
+ username)))
+
+(defun auth-cookie-decode (cookie-value)
+ "Decode an encoded elnode auth COOKIE-VALUE.
+
+Returns a cons of `username' and `token'"
+ (when (string-match "\\(.*\\)::\\(.*\\)" cookie-value)
+ (cons (match-string 1 cookie-value)
+ (match-string 2 cookie-value))))
+
+(defun* auth-get-cookie-value (httpcon &key (cookie-name "elnode-auth"))
+ "Return the decoded value for COOKIE-NAME.
+
+By default it's \"elnode-auth\" but you should use whatever
+cookie-name you're using for your app."
+ (let* ((cookie-value (http-cookie httpcon cookie-name t))
+ (decoded-cons (auth-cookie-decode (or cookie-value ""))))
+ decoded-cons))
+
+(defun* auth-cookie-check-p (httpcon &key
+ (cookie-name "elnode-auth")
+ (loggedin-db elnode-loggedin-db))
+ "Check that the user is loggedin according to the cookie.
+
+The name of the cookie can be supplied with :COOKIE-NAME - by
+default is is \"elnode-auth\".
+
+LOGGEDIN-DB can be a loggedin state database which is a
+hash-table. By default it is `elnode-loggedin-db'.
+
+Returns the username that authenticated or `nil' if it did not or
+signal's an `elnode-auth-token' error with the COOKIE-NAME if
+that cookie was not found."
+ (let ((cookie-cons (auth-get-cookie-value
+ httpcon :cookie-name cookie-name)))
+ (if (not cookie-cons)
+ (signal 'elnode-auth-token cookie-name)
+ ;; Else check the username and token
+ (let ((username (car cookie-cons))
+ (token (cdr cookie-cons)))
+ (auth-check-p username token :loggedin-db loggedin-db)))))
+
+(defun* auth-cookie-check (httpcon &key
+ (cookie-name "elnode-auth")
+ (loggedin-db elnode-loggedin-db))
+ "Check the COOKIE-NAME has a loggedin cookie in LOGGEDIN-DB.
+
+Signals `elnode-auth-token' on cookie or authentication failure.
+
+See `elnode-auth-cookie-check-p' for more details."
+ (or (auth-cookie-check-p
+ httpcon
+ :cookie-name cookie-name
+ :loggedin-db loggedin-db)
+ ;; Not sure this is the correct token...
+ (signal 'elnode-auth-token :not-logged-in)))
+
+(defvar auth-httpcon nil
+ "Dynamic scope variable for HTTP con while we auth.")
+
+(defun* auth-http-login (httpcon
+ username password logged-in
+ &key
+ (cookie-name "elnode-auth")
+ auth-test
+ make-hash
+ (loggedin-db elnode-loggedin-db))
+ "Log the USERNAME in on the HTTPCON if PASSWORD is correct.
+
+If authentication succeeds set the relevant cookie and redirect
+the user to LOGGED-IN.
+
+Actually uses `elnode-auth-login' to do the assertion.
+`elnode-auth-credentials' is signaled by that if the assertion fails.
+
+AUTH-DB is a database, by default `elnode-auth-db', it's passed
+to `elnode-auth-login'.
+
+AUTH-TEST and MAKE-HASH are both optional and passed down to
+`elnode-auth-user-p' if they exist."
+ (let* ((elnode-auth-httpcon httpcon)
+ (hash
+ (auth-login
+ username password
+ :auth-test auth-test
+ :make-hash make-hash
+ :loggedin-db loggedin-db)))
+ (http-header-set
+ httpcon
+ (http-cookie-make
+ cookie-name
+ (format "%s::%s" username hash)
+ :path "/"))
+ (send-redirect httpcon (or logged-in "/"))))
+
+(defcustom auth-login-page "<html>
+<body>
+<form method='POST' action='<!##E target E##!>'>
+<input type='hidden' name='redirect' value='<!##E redirect E##!>'/>
+username: <input type='text' name='username'/><br/>
+password: <input type='password' name='password'/><br/>
+<input type='submit' name='login'/>
+</form>
+</body>
+</html>"
+ "A standard login page, used by `elnode-auth-login-sender'."
+ :group 'elnode
+ :type '(string))
+
+(defun auth-login-sender (httpcon target redirect)
+ "Send the login page for auth to HTTPCON.
+
+The login page will send its authentication request to TARGET.
+
+The authentication will include username, password AND REDIRECT,
+which is the URL to redirect to when login is successful.
+
+This function sends the contents of the custom variable
+`elnode-auth-login-page' after templating it."
+ (http-start httpcon 200 `("Content-type" . "text/html"))
+ ;; It would be nice to support preambles... not sure how.
+ ;; (when preamble (elnode-http-send-string httpcon preamble))
+ (http-return
+ httpcon
+ (with-temp-buffer
+ (insert auth-login-page)
+ (-buffer-template
+ (current-buffer)
+ `(("target" . ,target)
+ ("redirect" . ,redirect))))))
+
+(defun* auth--login-handler (httpcon
+ sender target
+ &key
+ auth-test ; assert not nil?
+ make-hash
+ (cookie-name "elnode-auth")
+ (loggedin-db elnode-loggedin-db))
+ "An authentication handler implementation.
+
+This is the handler that is mapped to the login path, by default
+\"/login/\".
+
+SENDER is the function which will send the login page to the
+user, it takes an HTTPCON and the TARGET from the call to this
+and a redirect path. The redirect path is taken from the HTTP
+parameter \"redirect\". The SENDER function must send a
+'username' and 'password' HTTP parameters to this handler. The
+SENDER function may also send a \"redirect\" parameter which will
+be used to HTTP redirect the user-agent on successful
+authentication.
+
+TARGET is the path that will be used as the login handler
+path (the path to call this handler).
+
+AUTH-TEST checks the hashed details of the user's password and is
+passed to `elnode-auth-user-p'.
+
+MAKE-HASH is optional and passed down to `elnode-auth-user-p' if
+present."
+ (elnode-method httpcon
+ (GET
+ (funcall sender httpcon target
+ (or (http-param httpcon "redirect") "/")))
+ (POST
+ (let ((username (http-param httpcon "username"))
+ (password (http-param httpcon "password"))
+ (logged-in (http-param httpcon "redirect")))
+ (condition-case err
+ (auth-http-login
+ httpcon
+ username password logged-in
+ :auth-test auth-test
+ :make-hash make-hash
+ :cookie-name cookie-name)
+ (elnode-auth-credentials
+ (send-redirect
+ httpcon
+ (if (not logged-in)
+ target
+ (format "%s?redirect=%s" target logged-in))))
+ (t (msg
+ :warning "elnode-auth--login-handler: unexpected
error: %S"
+ err)))))))
+
+(defun auth-default-test-v001 (username database)
+ "The first test function used for Elnode auth.
+
+This uses just the keyed value of the username as the token. We
+no longer store databases like that by default."
+ (db-get username database))
+
+(defun auth-default-test (username database)
+ "The default test function used for Elnode auth.
+
+Is uses a stored alist against USERNAME, the alist should contain
+the key \"token\" with a user's token. Whatever else the alist
+contains is irrelevant."
+ (let ((user (db-get username database)))
+ (when user
+ (kva "token" user))))
+
+(defun* auth--make-login-handler (&key
+ (sender 'elnode-auth-login-sender)
+ (target "/login/")
+ auth-test
+ make-hash
+ ;; only used if the auth-test is not present
+ (auth-db elnode-auth-db)
+ (cookie-name "elnode-auth")
+ (loggedin-db elnode-loggedin-db))
+ "Make an `elnode-auth--login-handler', binding parameters."
+ (lambda (httpcon)
+ (auth--login-handler
+ httpcon
+ sender target
+ ;; Make a test function if we don't have one
+ :auth-test (if (functionp auth-test)
+ auth-test
+ (lambda (username)
+ (auth-default-test username auth-db)))
+ :make-hash (when (functionp make-hash) make-hash)
+ :cookie-name cookie-name
+ :loggedin-db loggedin-db)))
+
+(defun* defauth (scheme-name
+ &key
+ (test :cookie)
+ auth-test
+ make-hash
+ (auth-db 'elnode-auth-db)
+ (cookie-name "elnode-auth")
+ (failure-type :redirect)
+ (redirect "/login/")
+ (sender 'elnode-auth-login-sender))
+ "Define an Elnode authentication scheme.
+
+An authentication scheme consists of the following attributes:
+
+TEST what sort of test is used to test the authentication, by
+default this is `:cookie'. No other authentication tests are
+possible right now but in the future there might be many (there
+might also be a general `:function' test that allows calling of a
+function to implement the test).
+
+COOKIE-NAME is used when the TEST is `:cookie'. It is the name
+of the cookie to use for authentication. By default this is
+`elnode-auth'. It must be specified as a string.
+
+AUTH-TEST is a function to implement checking authentiation of
+users. It is passed a username and must respond with a token
+that can be checked against the value returned by the hashing
+function (see MAKE-HASH and `elnode-auth-make-hash' which is the
+default hashing function). AUTH-TEST can be nil in which case a
+default based on AUTH-DB will be used.
+
+MAKE-HASH is a function to implement the construction of a hash
+token for authentication. It takes a username and password and
+must produce the same value as AUTH-TEST.
+
+AUTH-DB is the `db' used for authentication information.
+It is used as the authority of information on users. By default
+this is `elnode-auth-db'.
+
+FAILURE-TYPE is what to do if authentication fails. Currently
+only `:redirect' is supported. To redirect on failure means to
+send a 302 with a location to visit a login page. :FAILURE-TYPE
+is `:redirect' by default.
+
+REDIRECT is where to redirect to if FAILURE-TYPE is `:redirect'.
+By default this is \"/login/\". If SENDER is not nil then a
+dispatcher told about this auth scheme will dispatch a path
+naming REDIRECT to SENDER.
+
+SENDER is an Elnode handler taking additional parameters of
+`target' and `redirect'. By default this is the function
+`elnode-auth-login-sender'. Specify a different function if you
+want to totally change the login page."
+ (let* ((login-handler (auth--make-login-handler
+ :sender sender
+ :target redirect
+ :auth-test auth-test
+ :make-hash make-hash
+ :auth-db auth-db
+ :cookie-name cookie-name))
+ (auth-scheme (list
+ :test test
+ :cookie-name cookie-name
+ :failure-type failure-type
+ :redirect redirect
+ :login-handler login-handler)))
+ (puthash scheme-name
+ auth-scheme
+ -defined-authentication-schemes)))
+
+(defmacro auth-dispatcher (httpcon auth-scheme &rest body)
+ "Dispatch HTTPCON to AUTH-SCHEME's handler if it matches.
+
+Otherwise do BODY."
+ (declare
+ (debug (sexp sexp &rest form))
+ (indent 2))
+ (let ((httpcon-v (make-symbol "httpcon-v"))
+ (auth-scheme-v (make-symbol "auth-scheme-v"))
+ (redirect-v (make-symbol "redirect-v"))
+ (handler-v (make-symbol "handler-v")))
+ `(let* ((,httpcon-v ,httpcon)
+ (,auth-scheme-v
+ (gethash
+ ,auth-scheme
+ elnode--defined-authentication-schemes))
+ (,redirect-v (plist-get ,auth-scheme-v :redirect))
+ (,handler-v (plist-get ,auth-scheme-v :login-handler)))
+ (if (elnode--mapper-find-match-func
+ (elnode-http-pathinfo ,httpcon-v)
+ (cons ,redirect-v ,handler-v))
+ ;; If the current path matches call the auth handler
+ (funcall ,handler-v ,httpcon-v)
+ ;; Else do whatever the body was
+ ,@body))))
+
+(defun auth-username (httpcon)
+ "Return the username currently associated to the HTTPCON."
+ (elnode/con-get httpcon :auth-username))
+
+(defun test-login (auth target username password)
+ "Send a test login to Elnode."
+ ;; FIXME - use AUTH as a reference to an elnode-authentication
+ ;; declaration and pull things like /login/ from it
+ (test-call
+ (format "/login/?redirect=%s" target)
+ :method "POST"
+ :parameters (list (cons "username" username)
+ (cons "password" password))))
+
+;;;###autoload
+(defun init ()
+ "Bootstraps the elnode environment when the Lisp is loaded.
+
+It's useful to have elnode start automatically... on Lisp
+load. If the variable `elnode-init-port' is set then this
+function will launch a server on it.
+
+The server is started with `elnode-hostpath-default-handler' as
+the handler and listening on `elnode-init-host'"
+ (interactive)
+ (when init-port
+ (condition-case nil
+ (progn
+ (start
+ 'elnode-hostpath-default-handler
+ :port init-port)
+ (setq -inited t))
+ (error "Elnode could not initialize."))))
+
+;;;###autoload
+(defcustom do-init nil
+ "Should elnode start a server on load?
+
+The server that is started is controlled by more elnode
+customizations.
+
+`elnode-hostpath-default-table' defines the mappings from
+hostpath regexs to handler functions. By default elnode ships
+with this customization setup to serve the document root defined
+in `elnode-webserver-docroot', which by default is ~/public_html."
+ :group 'elnode
+ :type '(boolean))
+
+(defvar -inited nil
+ "Records when elnode is initialized.
+
+This is autoloading mechanics, see the eval-after-load for doing
+init.")
+)
+
+;; Make sure we add elnode/case to the keywords
+(font-lock-add-keywords
+ 'emacs-lisp-mode
+ '(("\\<elnode/case\\>" . 'font-lock-keyword-face)))
+
+
+;; Auto start elnode if we're ever loaded
+;;;###autoload
+(eval-after-load 'elnode
+ '(progn
+ (when (and (boundp 'elnode-do-init)
+ elnode-do-init)
+ (condition-case err
+ (progn
+ (elnode-init)
+ (when (and elnode-defer-on
+ (not elnode--defer-timer))
+ (elnode--init-deferring)))
+ (error "Elnode could not be started.")))))
+
+
+(provide 'elnode)
+
+;;; elnode.el ends here
diff --git a/tests/elnode/elnode_tutorial.creole
b/tests/elnode/elnode_tutorial.creole
new file mode 100644
index 0000000..0e19729
--- /dev/null
+++ b/tests/elnode/elnode_tutorial.creole
@@ -0,0 +1,426 @@
+= Getting Started with Elnode - the webserver for Emacs =
+
+This is a tutorial that will hopefully show you how to install and get
+started making web services with Elnode.
+
+Elnode is a node.js like webserver tool for Emacs. It let's you make
+and run web servers and services from inside Emacs.
+
+
+== Installing Elnode ==
+
+You should install Elnode from the package available on
+[[http://marmalade-repo.org/packages/elnode|Marmalade]].
+
+For dealing with package repositories check out the
+[[http://www.emacswiki.org/emacs/ELPA|Emacs Wiki]] but the short version
+is to add the following to your {{{.emacs}}} or your
+{{{.emacs.d/init.el}}}:
+
+{{{
+(add-to-list
+ 'package-archives
+ '("marmalade" . "http://marmalade-repo.org/packages/";))
+}}}
+
+And then do:
+
+{{{
+M-x list-packages
+}}}
+
+find Elnode in the list and press {{{i}}} or {{{RET}}} to install it.
+
+If you don't want to use packages you can just install {{{elnode.el}}}
+on your {{{load-path}}} somewhere and:
+
+{{{
+(require 'elnode)
+}}}
+
+== Hello World! ==
+
+Now we've installed Elnode you'll want to start making web services
+with it. Let's start with a Hello World example.
+
+open a new Emacs file
+
+{{{
+C-x C-f my-elnode-hello-world.el
+}}}
+
+enter the Lisp code for the handler, for that old time feel you could type
this in, or if you're under 35, maybe just cut and paste
+
+{{{
+(defun my-elnode-hello-world-handler (httpcon)
+ (elnode-http-start httpcon 200 '("Content-Type" . "text/html"))
+ (elnode-http-return
+ httpcon
+ "<html><body><h1>Hello World</h1></body></html>"))
+(elnode-start 'my-elnode-hello-world-handler :port 8028 :host "localhost")
+}}}
+
+make the Lisp code //live//
+
+{{{
+M-x eval-buffer
+}}}
+
+now open [[http://localhost:8028]] in your browser - you should see //Hello
World!//
+
+
+== Publish some files ==
+
+Elnode provides a builtin webserver that can serve files from a
+directory on your computer. The Elnode webserver is turned on by
+default (it's all configurable though).
+
+=== The default webserver ===
+
+By default the webserver delivers files from:
+
+{{{
+~/public_html
+}}}
+
+so if you have a public_html directory in your home directory then
+just browse to [[http://localhost:8000]] and you should see an index
+of that directory.
+
+If you don't have a {{{~/public_html}}} directory then just make one
+and drop a file or two in it.
+
+Alternately, try configuring the webserver root directory:
+
+{{{
+M-x customize-variable RET elnode-webserver-docroot RET
+}}}
+
+to another directory. Then try hitting [[http://localhost:8000]]
+again.
+
+
+=== Making another webserver ===
+Now let's make a new webserver service.
+
+Make a new docroot:
+
+{{{
+mkdir ~/myspecialdocroot
+}}}
+
+Put an html file in there:
+
+{{{
+cat <<EOF > ~/myspecialdocroot/saybum.html
+<html>
+<h1>BUM!</h1>
+</html>
+}}}
+
+Now we have something to serve we can use Elnode to make the web service.
+
+Open a new Emacs file:
+
+{{{
+C-x C-f my-elnode-webserver.el
+}}}
+
+Add this Lisp:
+
+{{{
+(defconst my-elnode-webserver-handler
+ (elnode-webserver-handler-maker "~/myspecialdocroot"))
+(elnode-start my-elnode-webserver-handler :port 8001 :host "localhost")
+}}}
+
+Now evaluate that with: {{{M-x eval-buffer}}}
+
+Now open [[http://localhost:8001/saybum.html]]
+
+Now open [[http://localhost:8001]] - you should see an automated index
+of {{{~/myspecialdocroot}}}.
+
+== Stopping a server ==
+
+We've started a couple of servers now. Let's stop the two servers that
+we've started:
+
+{{{
+M-x elnode-stop RET 8028 RET
+M-x elnode-stop RET 8001 RET
+}}}
+
+Those servers are now stopped and you won't be able to hit them.
+
+== Add a binding to the builtin server ==
+
+Instead of starting new servers all the time we can add bindings to
+the standard Elnode server. Why would we do this? I think using a
+separate server for developing something initially is a good idea, but
+then you either have something you want to package up as it's own
+server (a wiki engine you've developed and want to give to other
+people, for example) or you have something you want to make available
+in your own default server. Of course, it's always a judgement, the
+way URLs work mean that you can pretty much always make any service
+available on it's own server or under a URL on another one.
+
+Let's make our Hello World example available again by binding it to
+the default server (which is still listening on port 8000 if you
+haven't changed anything).
+
+Go back to hello world:
+
+{{{
+C-x b my-elnode-hello-world.el
+}}}
+
+Remove the {{{elnode-start}}} line and add this:
+
+{{{
+(add-to-list 'elnode-hostpath-default-table '("/helloworld/" .
my-elnode-hello-world-handler))
+}}}
+
+So now it should look like this:
+
+{{{
+(defun my-elnode-hello-world-handler (httpcon)
+ (elnode-http-start httpcon 200 '("Content-Type" . "text/html"))
+ (elnode-http-return
+ httpcon
+ "<html><body><h1>Hello World</h1></body></html>"))
+(add-to-list 'elnode-hostpath-default-table '("/helloworld/" .
my-elnode-hello-world-handler))
+}}}
+
+Now eval the buffer with {{{M-x eval-buffer}}}
+
+Now open [[http://localhost:8000/helloworld/]] in your browser.
+
+Just to prove the webserver is still there, open
+[[http://localhost:8000/]]. This should still show your
+{{{~/public_html}}} directory (or whatever you configured
+{{{elnode-webserver-docroot}}} to).
+
+Check the variable {{{elnode-hostpath-default-table}}} with {{{C-h v
elnode-hostpath-default-table}}}
+
+The value should be something like:
+
+{{{
+(("/helloworld/" . my-elnode-hello-world-handler)
+("[^/]+/.*" . elnode-webserver))
+}}}
+
+{{{elnode-hostpath-default-table}}} can also be customized to add more
+services. But any handler mapped in there will have to be loaded in at
+Emacs startup so you either need to package and load your Elnode code
+or put it in your {{{load-path}}} and {{{require}}} it from Emacs
+init.
+
+== A more advanced example - publishing a buffer ==
+
+So far, all the examples have been quite trivial. Though I hope you
+think it's interesting that you can do all these things quite easily
+from inside Emacs.
+
+But now let's try something harder - let's make an web based editor.
+
+This is an exercise that will grow with the tutorial. I hope you'll be
+interested in the first draft, even though it's going to be relatively
+simple.
+
+Make a new file {{{C-x C-f my-elnode-editor.el}}}.
+
+Add the following Lisp code:
+
+{{{
+(defvar my-elnode-editor-buffer (get-buffer-create
"*my-elnode-editor-buffer*"))
+
+(defun my-elnode-editor-handler (httpcon)
+ (elnode-http-start httpcon 200 '("Content-Type" . "text/plain"))
+ (elnode-http-return
+ httpcon
+ (with-current-buffer my-elnode-editor-buffer
+ (buffer-substring-no-properties (point-min) (point-max)))))
+}}}
+
+Eval that with {{{M-x eval-buffer}}}.
+
+Now go and type some text in ~*my-elnode-editor-buffer~*. This will be
+served by the editor service.
+
+Now let's start the service:
+
+{{{
+M-x elnode-start
+my-elnode-editor-handler
+8002
+localhost
+}}}
+
+Now try and hit [[http://localhost:8002]] - you should see whatever
+you typed in the ~*my-elnode-editor-buffer~*.
+
+Try updating the text in the buffer and refreshing the browser. We're
+displaying that buffer whatever it has in it.
+
+Ok. So we've published a buffer. But what about someone else updating
+it?
+
+Let's make another handler to handle updates, add this to your
{{{my-elnode-editor.el}}}:
+
+{{{
+(defun my-elnode-editor-update-handler (httpcon)
+ (let ((change-text (elnode-http-param httpcon "change")))
+ (with-current-buffer my-elnode-editor-buffer
+ (goto-char (point-max))
+ (if (stringp change-text)
+ (insert change-text))))
+ (elnode-http-start httpcon 302 '("Location" . "/"))
+ (elnode-http-return httpcon))
+}}}
+
+Now we have two handlers we'll have to map them together
+somehow. Let's map one to the root ({{{/}}}) and one to
+{{{/update/}}}. Add the following code to {{{my-elnode-editor.el}}}:
+
+{{{
+(defconst my-elnode-editor-urls
+ `(("^/$" . my-elnode-editor-handler)
+ ("^/update/.*$" . my-elnode-editor-update-handler)))
+}}}
+
+And now we need to add a handler to do the dispatching for these URLs,
+add this to {{{my-elnode-editor.el}}} as well:
+
+{{{
+(defun my-elnode-editor-dispatcher-handler (httpcon)
+ (elnode-dispatcher httpcon my-elnode-editor-urls))
+}}}
+
+//What is a dispatcher?// - a dispatcher is a handler that take a list
+of URL pattern mappings and works out, by reading the data from the
+HTTP connection, what handler should be invoked for what request.
+
+Now we have our new dispatcher based code we need to stop the old server:
+
+{{{
+M-x elnode-stop 8002
+}}}
+
+And now start the new server with the dispatcher handler:
+
+{{{
+M-x elnode-start
+my-elnode-editor-dispatcher-handler
+8002
+localhost
+}}}
+
+Now visit [[http://localhost:8002]] and see the buffer as it stands
+and then visit
+[[http://localhost:8002/update/?change=%0dlah+dee+dah%0d]] and see the
+updated buffer.
+
+== More advanced again - Make a webapp around the service ==
+
+Let's take our editor on another step. Let's add some static files and
+have the Elnode handlers be called by client side Javascript.
+
+If we're going to add some static files, we'll need a webserver. We
+already know how to do that. Once we've got some javascript though,
+we'll probably not want to retrieve the text by {{{HTTP GET}}}ing the
+root url, so let's alter that binding to {{{/text/}}} as well:
+
+{{{
+(defconst my-elnode-editor-webserver-handler
+ (elnode-webserver-handler-maker "~/my-directory")
+ "The webserver handler.")
+
+(defconst my-elnode-editor-urls
+ '(("^/text/$" . my-elnode-editor-handler)
+ ("^/update/.*$" . my-elnode-editor-update-handler)
+ ("^/[^/]+/.*$" . my-elnode-editor-webserver-handler)))
+}}}
+
+Obviously {{{~/my-directory}}} needs to be the place where you are
+going to save your HTML and Javascript files.
+
+Now we need those HTML and Javascript files. Let's make the HTML
+first:
+
+{{{
+<html>
+ <head>
+ <script
src="http://ajax.googleapis.com/ajax/libs/jquery/1.6.4/jquery.min.js";
+ language="Javascript">
+ </script>
+ <script src="my-elnode-editor.js" language="Javascript">
+ </script>
+ </head>
+ <body>
+ <textarea id="text" cols="60" rows="10">
+ </textarea>
+ </body>
+</html>
+}}}
+
+We're going to pull jQuery from Google's Content Delivery
+Network. We've put in a placeholder for our own Javascript file and
+other than that the HTML is really just a {{{textarea}}}
+element. We'll use //that// for putting the buffer text in.
+
+Now, what should the Javascript do?
+
+* when the page loads
+* make an AJAX call to Elnode for the buffer text
+* stick the received text into the {{{textarea}}}
+
+Ok. So here is {{{my-elnode-editor.js}}}:
+
+{{{
+var my_elnode_editor = (function () {
+ var self = {
+ /** Get the text from Emacs.
+ */
+ get_text: function () {
+ $.ajax("/text/", {
+ dataType: "text",
+ success: function (data, textStatus, jqXHR) {
+ $("#text").text(data);
+ }
+ });
+ }
+ };
+ return self;
+})();
+
+$(document).ready(
+ function () {
+ my_elnode_editor.get_text();
+ }
+);
+}}}
+
+Save this as {{{my-elnode-editor.js}}} (in whatever directory the
+webserver is serving) and save the HTML in the same directory, call it
+{{{my-elnode-editor.html}}}, say?
+
+You don't even have to restart the Elnode handler, because it already
+is pointing to the dispatcher handler. If you just:
+
+{{{
+M-x eval-buffer
+}}}
+
+this will re-evaluate the URL mappings. Now if you visit
+[[http://localhost:8002/my-elnode-editor.html]] you should see the
+webpage with the {{{textarea}}} and the text of your buffer.
+
+
+
+== That's all for now! ==
+
+This is as far as Nic has got writing the tutorial. More will come soon I hope:
+
+* {{{defer}}} with an example based around the editor service
+* debugging a running Elnode service
diff --git a/tests/elnode/elnode_tutorial.org b/tests/elnode/elnode_tutorial.org
new file mode 100644
index 0000000..df064fa
--- /dev/null
+++ b/tests/elnode/elnode_tutorial.org
@@ -0,0 +1,127 @@
+
+* suggestions
+** How about going from "hello world" on?
+*** Start with that,
+*** and then, move on to publishing a static file,
+*** then a buffer,
+**** with calling functions to manipulate the buffer and re-present it?
+** That'd save me a fair bit of tinkering :)
+
+* installing
+** use elpa/marmalade
+* what elnode gives you by default
+** require elnode
+*** elnode-init
+**** starts a server
+***** on port 8000
+
+
+* hello world
+** install elnode with marmalade
+** open a new emacs buffer C-x C-f my-elnode-hello-world.el
+** make a handler
+(defun my-elnode-hello-world-handler (httpcon)
+ (elnode-http-start httpcon 200 '("Content-Type" . "text/html"))
+ (elnode-http-return
+ httpcon
+ "<html><body><h1>Hello World</h1></body></html>"))
+(elnode-start my-elnode-hello-world-handler 8028 "localhost")
+** now evaluate that with M-x eval-buffer
+** now open localhost:8028 in your browser
+
+* publish some files
+** elnode provides a webserver, more accurately a fileserver
+** the webserver is turned on by default
+** open localhost:8000 and you should see ~/public_html
+*** if you don't have ~/public_html then make one?
+*** or configure elnode-webserver-docroot
+** make a new webserver
+*** make a new docroot
+**** mkdir ~/myspecialdocroot
+*** put an html file in there
+cat <<EOF > ~/myspecialdocroot/saybum.html
+<html>
+<h1>BUM!</h1>
+</html>
+*** open a new emacs buffer
+*** put the following lisp in
+(defvar my-elnode-webserver-handler
+ (elnode-webserver-handler-maker "~/myspecialdocroot"))
+(elnode-start my-elnode-webserver-handler 8001 "localhost")
+*** now evaluate that with M-x eval-buffer
+*** now open localhost:8001/saybum.html
+*** now open localhost:8001
+**** you should see an automatic index
+
+* stopping a server
+** stop 8028
+** stop 8001
+
+* add a binding to the standard server
+** we can add bindings to the standard elnode server
+** go back to hello world - C-x b my-elnode-hello-world.el
+** remove the server-start and add this:
+(add-to-list 'elnode-hostpath-default-table '("/helloworld/" .
my-elnode-hello-world-handler))
+** so now it should be:
+(defun my-elnode-hello-world-handler (httpcon)
+ (elnode-http-start httpcon 200 '("Content-Type" . "text/html"))
+ (elnode-http-return
+ httpcon
+ "<html><body><h1>Hello World</h1></body></html>"))
+(add-to-list 'elnode-hostpath-default-table '("/helloworld/" .
my-elnode-hello-world-handler))
+** now eval the buffer with M-x eval-buffer
+** now open localhost:8000/helloworld/ in your browser
+** just to prove the webserver is still there, open localhost:8000/
+*** check it's still the directory ~/public_html
+** check the variable elnode-hostpath-default-table with C-h v
elnode-hostpath-default-table
+Its value is (("/helloworld/" . my-elnode-hello-world-handler)
+ ("[^/]+/.*" . elnode-webserver))
+** elnode-hostpath-default-table can also be customized
+*** but any handler will have to be loaded so you probably need to package and
load your elnode module
+
+* publishing something else?
+** let's try and make an online editor
+** make a new file my-elnode-editor.el
+(defvar my-elnode-editor-buffer (get-buffer-create
"*my-elnode-editor-buffer*"))
+
+(defun my-elnode-editor-handler (httpcon)
+ (elnode-http-start httpcon 200 '("Content-Type" . "text/plain"))
+ (elnode-http-return
+ httpcon
+ (with-current-buffer my-elnode-editor-buffer
+ (buffer-substring-no-properties (point-min) (point-max)))))
+** eval that
+** go type some data in *my-elnode-editor-buffer*
+** then M-x elnode-start my-elnode-editor-handler 8002 localhost
+** try and hit localhost:8002
+** go update the buffer
+** refresh the webpage
+** but what about someone else updating the buffer?
+** make another handler to handle updates
+(defun my-elnode-editor-update-handler (httpcon)
+ (let ((change-text (elnode-http-param httpcon "change")))
+ (with-current-buffer my-elnode-editor-buffer
+ (goto-char (point-max))
+ (insert (if (stringp change-text)
+ change-text
+ ""))))
+ (elnode-http-start httpcon 302 '("Location" . "/"))
+ (elnode-http-return httpcon))
+** now we need to map these two handlers
+*** one to / and the other to /update/
+** make a new variable
+(defvar my-elnode-editor-urls
+ `(
+ ("$" . my-elnode-editor-handler)
+ ("update/.*$" . my-elnode-editor-update-handler)))
+** and make a dispatcher handler for the urls
+(defun my-elnode-editor-dispatcher-handler (httpcon)
+ (elnode-dispatcher httpcon my-elnode-editor-urls))
+*** a dispatcher handler is a handler that accepts requests and dispatches
them to further handlers.
+*** moar about dispatcher handlers.
+** now stop the old server
+** M-x elnode-stop 8002
+** Now start the new server with the dispatcher handler
+** then M-x elnode-start my-elnode-editor-dispatcher-handler 8002 localhost
+** now visit localhost:8002 and see the buffer
+** now visit localhost:8002/update/?change=lah+dee+dah%0d and see the updated
buffer
diff --git a/tests/elnode/fakir.el b/tests/elnode/fakir.el
new file mode 100644
index 0000000..6bc4cf8
--- /dev/null
+++ b/tests/elnode/fakir.el
@@ -0,0 +1,609 @@
+;;; fakir.el --- fakeing bits of Emacs -*- lexical-binding: t -*-
+;; Copyright (C) 2012 Nic Ferrier
+
+;; Author: Nic Ferrier <nferrier@ferrier.me.uk>
+;; Maintainer: Nic Ferrier <nferrier@ferrier.me.uk>
+;; URL: http://github.com/nicferrier/emacs-fakir
+;; Created: 17th March 2012
+;; Version: 20140417.1347
+;; X-Original-Version: 0.1.9
+;; Keywords: lisp, tools
+;; Package-Requires: ((noflet "0.0.8")(dash "1.3.2")(kv "0.0.19"))
+
+;; 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 this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Source code
+;;
+;; fakir's code can be found here:
+;; http://github.com/nicferrier/fakir
+
+;;; Style note
+;;
+;; This codes uses the Emacs style of:
+;;
+;; fakir--private-function
+;;
+;; for private functions and macros.
+
+;;; Commentary:
+;;
+;; This is a collection of tools to make testing Emacs core functions
+;; easier.
+
+;;; Code:
+
+(require 'ert)
+(require 'dash)
+(require 'noflet)
+(require 'kv)
+(eval-when-compile (require 'cl))
+
+
+(defun fakir-make-unix-socket (&optional name)
+ "Make a unix socket server process optionally based on NAME.
+
+Returns a list of the processes socket file and the process object."
+ (let* ((socket-file
+ (concat "/tmp/" (apply 'make-temp-name
+ (list (or name "fakir-make-unix-socket")))))
+ (myproc (make-network-process
+ :name socket-file
+ :family 'local :server t
+ :service socket-file)))
+ (list socket-file myproc)))
+
+(defmacro* fakir-with-unix-socket ((socket-sym &optional socket-name) &rest
body)
+ "Execute BODY with a Unix socket server bound to SOCKET-SYM.
+
+Optionally the socket is created with SOCKET-NAME which means
+that the file used to back the socket is named after SOCKET-NAME.
+
+The socket process is closed on completion and the associated
+file is deleted."
+ (declare (indent 1))
+ (let ((spv (make-symbol "spv"))
+ (sockfilev (make-symbol "sockfilev")))
+ `(let* ((,spv (fakir-make-unix-socket ,socket-name))
+ (,sockfilev (car ,spv))
+ (,socket-sym (cadr ,spv)))
+ (unwind-protect
+ (progn
+ ,@body)
+ (delete-process ,socket-sym)
+ (delete-file ,sockfilev)))))
+
+(defmacro fakir-with-file-buffer (buffer-var &rest body)
+ "Make a buffer visiting a file and assign it to BUFFER-VAR.
+
+The file only exists for the scope of the macro. Both the file
+and the buffer visiting it are destroyed when the scope exits."
+ (declare (indent 1))
+ (let ((filev (make-symbol "filev")))
+ `(let* ((,filev (make-temp-file "filebuf"))
+ (,buffer-var (find-file-noselect ,filev)))
+ (unwind-protect
+ (progn ,@body)
+ (with-current-buffer ,buffer-var
+ (set-buffer-modified-p nil))
+ (kill-buffer ,buffer-var)
+ (delete-file ,filev)))))
+
+;; Mocking processes
+
+(defvar fakir-mock-process-require-specified-buffer nil
+ "Tell `fakir-mock-process' that you require a buffer to be set.
+
+This is used, for example, to make `elnode--filter' testing work
+properly. Normally, tests do not need to set the process-buffer
+directly, they can just expect it to be there. `elnode--filter',
+though, needs to set the process-buffer to work properly.")
+
+
+(defun fakir/make-hash-table (alist) ; possible redundant now.
+ "Make a hash table from the ALIST.
+
+The ALIST looks like a let-list."
+ (let ((bindings (make-hash-table :test 'equal)))
+ (loop for f in (append
+ (list (list :fakir-mock-process t))
+ alist)
+ do
+ (cond
+ ((and f (listp f))
+ (puthash (car f) (cadr f) bindings))
+ (t
+ (puthash f nil bindings))))
+ bindings))
+
+(defun fakir/get-or-create-buf (pvbuf pv-alist &optional specified-buf)
+ "Special get or create to support the process mocking.
+
+PVBUF is a, possibly existing, buffer reference. If nil then we
+create the buffer.
+
+PV-ALIST is an alist of properties, possibly containing the
+`:buffer' property which specifies a string to be used as the
+content of the buffer.
+
+SPECIFIED-BUF is an optional buffer to use instead of a dummy
+created one."
+ (if (bufferp pvbuf)
+ pvbuf
+ (setq pvbuf
+ (if fakir-mock-process-require-specified-buffer
+ (if (bufferp specified-buf)
+ specified-buf
+ nil)
+ (or specified-buf
+ (get-buffer-create
+ (generate-new-buffer-name
+ "* fakir mock proc buf *")))))
+ ;; If we've got a buffer value then insert it.
+ (when (kva :buffer pv-alist)
+ (with-current-buffer pvbuf
+ (insert (kva :buffer pv-alist))))
+ pvbuf))
+
+
+(defmacro fakir-mock-proc-properties (process-obj &rest body)
+ "Mock process property list functions.
+
+Within BODY the functions `process-get', `process-put' and
+`process-plist' and `set-process-plist' are all mocked to use a
+hashtable if the process passed to them is `eq' to PROCESS-OBJ."
+ (declare (indent 1)
+ (debug (sexp &rest form)))
+ (let ((proc-plist (make-symbol "procpropsv")))
+ `(let (,proc-plist)
+ (macrolet ((or-args (form &rest args)
+ `(if (eq proc ,,process-obj)
+ ,form
+ (apply this-fn ,@args))))
+ (noflet ((process-get (proc name)
+ (or-args (plist-get ,proc-plist name) proc name))
+ (process-put (proc name value)
+ (or-args
+ (if ,proc-plist
+ (plist-put ,proc-plist name value)
+ (setq ,proc-plist (list name value)))
+ proc name value))
+ (process-plist (proc)
+ (or-args ,proc-plist proc))
+ (set-process-plist (proc props)
+ (or-args (setq ,proc-plist props) proc props)))
+ ,@body)))))
+
+(defun fakir/let-bindings->alist (bindings)
+ "Turn let like BINDINGS into an alist.
+
+Makes sure the resulting alist has `consed' pairs rather than
+lists.
+
+Generally useful macro helper should be elsewhere."
+ (loop for p in bindings
+ collect
+ (if (and p (listp p))
+ (list 'cons `(quote ,(car p)) (cadr p))
+ (list 'cons `,p nil))))
+
+(defmacro fakir-mock-process (process-symbol process-bindings &rest body)
+ "Allow easier testing by mocking the process functions.
+
+For example:
+
+ (fakir-mock-process :fake
+ (:elnode-http-params
+ (:elnode-http-method \"GET\")
+ (:elnode-http-query \"a=10\"))
+ (should (equal 10 (elnode-http-param :fake \"a\"))))
+
+Causes:
+
+ (process-get :fake :elnode-http-method)
+
+to always return \"GET\".
+
+`process-put' is also remapped, to set any setting.
+
+`process-buffer' is also remapped, to deliver the value of the
+key `:buffer' if present and a dummy buffer otherwise.
+
+`delete-process' is also remapped, to throw
+`:mock-process-finished' to the catch called
+`:mock-process-finished'. You can implement your own catch to do
+something with the `delete-process' event.
+
+`process-send-string' is also remapped to send to a fake output
+buffer. The fake buffer can be returned with
+`fakir-get-output-buffer'.
+
+In normal circumstances, we return what the BODY returned."
+ (declare
+ (debug (sexp sexp &rest form))
+ (indent defun))
+ (let ((get-or-create-buf (make-symbol "get-or-create-buf"))
+ (fakir-kill-buffer (make-symbol "fakir-kill-buffer"))
+ (pvvar (make-symbol "pv"))
+ (pvoutbuf (make-symbol "pvoutbuf"))
+ (pvbuf (make-symbol "buf"))
+ (result (make-symbol "result")))
+ `(let ((,pvvar (list ,@(fakir/let-bindings->alist process-bindings)))
+ ;; This is a buffer for the output
+ (,pvoutbuf (get-buffer-create "*fakir-outbuf*"))
+ ;; For assigning the result of the body
+ ,result
+ ;; Dummy buffer variable for the process - we fill this in
+ ;; dynamically in 'process-buffer
+ ,pvbuf)
+ (fakir-mock-proc-properties ,process-symbol
+ (flet ((fakir-get-output-buffer () ,pvoutbuf)
+ (,get-or-create-buf (proc &optional specified-buf)
+ (setq ,pvbuf (fakir/get-or-create-buf
+ ,pvbuf
+ ,pvvar
+ specified-buf)))
+ (,fakir-kill-buffer (buf)
+ (when (bufferp buf)
+ (with-current-buffer buf (set-buffer-modified-p nil))
+ (kill-buffer buf))))
+ (unwind-protect
+ (macrolet ((or-args (form &rest args)
+ `(if (eq proc ,,process-symbol)
+ ,form
+ (apply this-fn (list ,@args)))))
+ ;; Rebind the process function interface
+ (noflet
+ ((processp (proc) (or-args t proc))
+ (process-send-eof (proc) (or-args t proc))
+ (process-status (proc) (or-args 'fake proc))
+ (process-buffer (proc) (or-args (,get-or-create-buf
proc) proc))
+ (process-contact (proc &optional arg) ; FIXME - elnode
specific
+ (or-args (list "localhost" 8000) proc))
+ (process-send-string (proc str)
+ (or-args
+ (with-current-buffer ,pvoutbuf
+ (save-excursion
+ (goto-char (point-max))
+ (insert str)))
+ proc))
+ (delete-process (proc)
+ (or-args
+ (throw :mock-process-finished :mock-process-finished)
+ proc))
+ (set-process-buffer (proc buffer)
+ (or-args (,get-or-create-buf proc buffer) proc)))
+ (set-process-plist ,process-symbol (kvalist->plist ,pvvar))
+ (setq ,result
+ (catch :mock-process-finished
+ ,@body))))
+ ;; Now clean up
+ (,fakir-kill-buffer ,pvbuf)
+ (,fakir-kill-buffer ,pvoutbuf)))))))
+
+
+;; Time utils
+
+(defun fakir-time-encode (time-str)
+ "Encode the TIME-STR as an EmacsLisp time."
+ ;; FIXME this should be part of Emacs probably; I've had to
+ ;; implement this in Elnode as well
+ (apply 'encode-time (parse-time-string time-str)))
+
+;; A structure to represent a mock file
+
+(defstruct fakir-file
+ filename
+ directory
+ (content "")
+ ;; obviously there should be all the state of the file here
+ (mtime "Mon, Feb 27 2012 22:10:19 GMT"))
+
+(defun fakir-file (&rest args)
+ "Make a fakir-file, a struct.
+
+:FILENAME is the basename of the file
+
+:DIRECTORY is the dirname of the file
+
+:CONTENT is a string of content for the file
+
+:MTIME is the modified time, with a default around the time fakir
+was written."
+ (apply 'make-fakir-file args))
+
+(defun fakir--file-check (file)
+ "Implements the type check for FILE is a `fakir--file'."
+ (if (not (fakir-file-p file))
+ (error "not an fakir--file")))
+
+(defun fakir--file-fqn (file)
+ "Return the fully qualified name of FILE, an `fakir--file'."
+ (fakir--file-check file)
+ (let* ((fqfn
+ (concat
+ (file-name-as-directory
+ (fakir-file-directory file))
+ (fakir-file-filename file))))
+ fqfn))
+
+(defun fakir--file-rename (src-file to-file-name)
+ "Rename the `fakir-file' SRC-FILE."
+ (fakir--file-check src-file)
+ (let ((base-file-name (file-name-nondirectory to-file-name))
+ (file-dir (file-name-directory to-file-name)))
+ (setf (fakir-file-directory src-file) file-dir)
+ (setf (fakir-file-filename src-file) base-file-name)))
+
+(defun fakir--file-mod-time (file &optional raw)
+ "Return the encoded mtime of FILE, an `fakir--file'.
+
+If RAW is t then return the raw value, a string."
+ (fakir--file-check file)
+ (if raw
+ (fakir-file-mtime file)
+ (fakir-time-encode (fakir-file-mtime file))))
+
+(defun fakir--file-attribs (file)
+ "Return an answer as `file-attributes' for FILE.
+
+Currently WE ONLY SUPPORT MODIFIED-TIME."
+ (fakir--file-check file)
+ (list t t t t t
+ (fakir--file-mod-time file)))
+
+(defun fakir--file-home (file)
+ "Return the home part of FILE or nil.
+
+The home part of FILE is the part that is the home directory of
+the user. If it's not a user FILE then it won't have a home
+part."
+ (fakir--file-check file)
+ (let* ((fqn (fakir--file-fqn file))
+ (home-root
+ (save-match-data
+ (when
+ (string-match
+ "^\\(/home/[A-Za-z][A-Za-z0-9-]+\\)\\(/.*\\)*"
+ fqn)
+ (match-string 1 fqn)))))
+ home-root))
+
+(defun fakir--file-path (faked-file)
+ "Make a path name from the FAKED-FILE."
+ (concat
+ (file-name-as-directory
+ (fakir-file-directory faked-file))
+ (fakir-file-filename faked-file)))
+
+(defvar fakir--home-root "/home/fakir"
+ "String to use as the home-root.")
+
+(defun fakir--join (file-name &optional dir)
+ "Join FILE-NAME to DIR or `fakir--home-root'."
+ (concat
+ (file-name-as-directory (or dir fakir--home-root))
+ file-name))
+
+(defun fakir--expand (file-name rooted-p)
+ "Functional file-name expand."
+ (let ((path
+ (mapconcat
+ 'identity
+ (let ((l
+ (-reduce
+ (lambda (a b)
+ (if (string= b "..")
+ (if (consp a)
+ (reverse (cdr (reverse a)))
+ (list a))
+ (if (consp a)
+ (append a (list b))
+ (list a b))))
+ (cdr (split-string file-name "/")))))
+ (if (listp l) l (list l)))
+ "/")))
+ (if (and rooted-p (not (equal ?\/ (elt path 0))))
+ (concat "/" path)
+ path)))
+
+(defun fakir--expand-file-name (file-name dir)
+ "Implementation of ~ and .. handling for FILE-NAME."
+ (let* ((fqfn
+ (if (string-match "^\\(~/\\|/\\).*" file-name)
+ file-name
+ ;; Else it's both
+ (fakir--join file-name dir)))
+ (file-path
+ ;; Replace ~/ with the home-root
+ (replace-regexp-in-string
+ "^~/\\(.*\\)"
+ (lambda (m) (fakir--join (match-string 1 m)))
+ fqfn))
+ (new-path
+ (fakir--expand
+ file-path
+ (equal ?\/ (elt file-path 0)))))
+ new-path))
+
+(defun fakir--find-file (fakir-file)
+ "`find-file' implementation for FAKIR-FILE."
+ (let ((buf (get-buffer (fakir-file-filename fakir-file))))
+ (if (bufferp buf)
+ buf
+ ;; Else make one and put the content in it
+ (with-current-buffer
+ (get-buffer-create (fakir-file-filename fakir-file))
+ (insert (fakir-file-content fakir-file))
+ (current-buffer)))))
+
+(defun fakir-file-path (fakir-file)
+ "Make the path for FAKIR-FILE."
+ (concat (fakir-file-directory fakir-file)
+ (fakir-file-filename fakir-file)))
+
+
+(defun fakir--file-parent-directories (faked-file)
+ "Return the parent directories for a FAKED-FILE."
+ (let ((directory-path (fakir-file-directory faked-file))
+ (path "")
+ (path-list '("/")))
+ (dolist (path-part (split-string directory-path "/" t))
+ (let ((current-path (concat path "/" path-part)))
+ (push current-path path-list)
+ (setq path current-path)))
+ path-list))
+
+(defun fakir--namespace-put (faked-file namespace)
+ "Put given FAKED-FILE and its parent folders into the given NAMESPACE."
+ (puthash (fakir--file-path faked-file) faked-file namespace)
+ (dolist (parent-dir (fakir--file-parent-directories faked-file))
+ (puthash
+ parent-dir
+ (fakir-file
+ :filename (file-name-nondirectory parent-dir)
+ :directory (file-name-directory parent-dir)
+ :content "")
+ namespace)))
+
+(defun fakir--namespace (faked-file &rest other-files)
+ "Make a namespace with FAKED-FILE in it.
+
+Also adds the directory for the FAKED-FILE.
+
+If OTHER-FILES are specified they are added to."
+ (let ((ns (make-hash-table :test 'equal)))
+ (fakir--namespace-put faked-file ns)
+ (dolist (other-file other-files)
+ (fakir--namespace-put other-file ns))
+ ns))
+
+(defun fakir--namespace-lookup (file-name namespace)
+ "Lookup FILE-NAME in NAMESPACE.
+
+Looks up the FILE-NAME"
+ (kvhash->alist namespace)
+ (or
+ (gethash file-name namespace)
+ (gethash
+ (file-name-as-directory file-name)
+ namespace)))
+
+(defvar fakir-file-namespace nil
+ "Namespace used by `fakir--file-cond'.")
+
+(defmacro fakir--file-cond (file-name then &rest else)
+ "Do THEN or ELSE if FILE-NAME is a faked file.
+
+Uses the `fakir-file-namepsace' to detect that.
+
+The `fakir-file' for the FILE-NAME is locally bound in the THEN
+clause to `this-fakir-file'."
+ (declare (indent 1))
+ (let ((file-name-v (make-symbol "file-namev"))
+ (found-file (make-symbol "ff")))
+ `(let* ((,file-name-v ,file-name)
+ (,found-file
+ (fakir--namespace-lookup
+ ,file-name-v fakir-file-namespace)))
+ (if (fakir-file-p ,found-file)
+ (let ((this-fakir-file ,found-file))
+ ,then)
+ ,@else))))
+
+(defun fakir--write-region (fakir-file start end file-name
+ &optional append visit lockname mustbenew)
+ "Fake `write-region' function to write to FAKIR-FILE.
+
+`fakir-fake-file' does not call this unless the FILE-NAME exists
+as a declared fake-file. Thus you cannot use this to save files
+you have not explicitly declared as fake."
+ (let ((to-write
+ (cond
+ ((equal start nil) (buffer-string))
+ ((stringp start) start)
+ (t (buffer-substring start end)))))
+ (setf
+ (fakir-file-content fakir-file)
+ (if append
+ (concat (fakir-file-content fakir-file) to-write)
+ to-write))))
+
+(defmacro fakir-fake-file (faked-file &rest body)
+ "Fake FAKED-FILE and evaluate BODY.
+
+FAKED-FILE must be a `fakir-file' object or a list of
+`fakir-file' objects."
+ (declare (indent 1)
+ (debug (sexp &rest form)))
+ (let ((ffv (make-symbol "ff")))
+ `(let* ((,ffv ,faked-file)
+ (fakir-file-namespace
+ (if (fakir-file-p ,ffv)
+ (fakir--namespace ,ffv)
+ (apply 'fakir--namespace ,ffv))))
+ (noflet
+ ((expand-file-name (file-name &optional dir)
+ (let ((expanded
+ (fakir--expand-file-name file-name dir)))
+ (fakir--file-cond expanded
+ expanded
+ (funcall this-fn file-name dir))))
+ (file-attributes (file-name)
+ (fakir--file-cond file-name
+ (fakir--file-attribs this-fakir-file)
+ (funcall this-fn file-name)))
+ (file-exists-p (file-name)
+ (fakir--file-cond file-name
+ t
+ (funcall this-fn file-name)))
+ (write-region (start end file-name &optional append visit lockname
mustbenew)
+ (fakir--file-cond file-name
+ (fakir--write-region
+ this-fakir-file ; the faked file - should match file-name
+ start end file-name append visit mustbenew)
+ (funcall this-fn start end file-name append visit mustbenew)))
+ (rename-file (from to)
+ (fakir--file-cond from
+ (fakir--file-rename this-fakir-file to)
+ (funcall this-fn from to)))
+ (insert-file-contents
+ (file-name &optional visit beg end replace)
+ (fakir--file-cond file-name
+ (insert (fakir-file-content this-fakir-file))
+ (funcall this-fn file-name)))
+ (insert-file-contents-literally
+ (file-name &optional visit beg end replace)
+ (fakir--file-cond file-name
+ (insert (fakir-file-content this-fakir-file))
+ (funcall this-fn file-name)))
+ (find-file (file-name)
+ (fakir--file-cond file-name
+ (fakir--find-file this-fakir-file)
+ (funcall this-fn file-name)))
+ (find-file-noselect (file-name)
+ (fakir--file-cond file-name
+ (fakir--find-file this-fakir-file)
+ (funcall this-fn file-name))))
+ ,@body))))
+
+(defmacro fakir-mock-file (faked-file &rest body)
+ (declare (debug (sexp &rest form))
+ (indent 1))
+ `(fakir-fake-file ,faked-file ,@body))
+
+(provide 'fakir)
+
+;;; fakir.el ends here
diff --git a/tests/elnode/kv.el b/tests/elnode/kv.el
new file mode 100644
index 0000000..e75bc23
--- /dev/null
+++ b/tests/elnode/kv.el
@@ -0,0 +1,463 @@
+;;; kv.el --- key/value data structure functions
+
+;; Copyright (C) 2012 Nic Ferrier
+
+;; Author: Nic Ferrier <nferrier@ferrier.me.uk>
+;; Keywords: lisp
+;; Version: 20140108.734
+;; X-Original-Version: 0.0.19
+;; Maintainer: Nic Ferrier <nferrier@ferrier.me.uk>
+;; Created: 7th September 2012
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Some routines for working with key/value data structures like
+;; hash-tables and alists and plists.
+
+;; This also takes over the dotassoc stuff and provides it separately.
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+
+(defun kvalist->hash (alist &rest hash-table-args)
+ "Convert ALIST to a HASH.
+
+HASH-TABLE-ARGS are passed to the hash-table creation."
+ (let ((table (apply 'make-hash-table hash-table-args)))
+ (mapc
+ (lambda (pair)
+ (puthash (car pair) (cdr pair) table))
+ alist)
+ table))
+
+(defun kvhash->alist (hash &optional func)
+ "Convert HASH to an ALIST.
+
+Optionally filter through FUNC, only non-nil values returned from
+FUNC are stored as the resulting value against the converted
+key."
+ (when hash
+ (let (store)
+ (maphash
+ (lambda (key value)
+ (when key
+ (if (and (functionp func))
+ (let ((res (funcall func key value)))
+ (when res
+ (setq store (acons key res store))))
+ ;; else no filtering, just return
+ (setq store (acons key value store)))))
+ hash)
+ store)))
+
+(defun kvfa (key alist receive)
+ "Call RECEIVE with whatever comes out of ALIST for KEY.
+
+RECEIVE can do whatever destructuring you want, the first
+argument is always the car of the alist pair."
+ (apply receive (let ((a (assoc key alist)))
+ (append (list (car a))
+ (if (listp (cdr a))(cdr a)(list (cdr a)))))))
+
+(defun kva (key alist)
+ "Retrieve the value assigned to KEY in ALIST.
+
+This uses `assoc' as the lookup mechanism."
+ (cdr (assoc key alist)))
+
+(defun kvaq (key alist)
+ "Retrieve the value assigned to KEY in ALIST.
+
+This uses `assq' as the lookup mechanism."
+ (cdr (assq key alist)))
+
+(defun kvaqc (key alist)
+ "Retrieve the value assigned to KEY in ALIST.
+
+This uses first the `assq' and then `assoc' as the lookup
+mechanism."
+ (cdr (or (assq key alist)
+ (assoc key alist))))
+
+(defun kvassoc= (key value alist)
+ "Is the value assocd to KEY in ALIST equal to VALUE?
+
+Returns the value looked up by KEY that passes, so normally:
+
+ KEY . VALUE
+"
+ (let ((v (assoc key alist)))
+ (and v (equal (cdr v) value) v)))
+
+(defun kvassoqc (key alist)
+ "String or symbol assoc."
+ (let ((v (or
+ (assq (if (symbolp key) key (intern key)) alist)
+ (or (assoc key alist)
+ ;; not sure about this behaviour... see test
+ (assoc (symbol-name key) alist))))) v))
+
+(defun kvassoq= (key value alist)
+ "Test the VALUE with the value bound to KEY in ALIST.
+
+The lookup mechanism is to ensure the key is a symbol and then
+use assq. Hence the name of the function being a mix of assoc
+and assq.
+
+Returns the value looked up by KEY that passes, so normally:
+
+ KEY . VALUE
+"
+ (let ((v (kvassoqc key alist)))
+ (and v (equal (cdr v) value) v)))
+
+(defun kvmatch (key regex alist)
+ "Test the value with KEY in ALIST matches REGEX."
+ (let ((v (kvassoqc key alist)))
+ (and v (string-match regex (cdr v)) v)))
+
+(defun* kvquery->func (query &key
+ (equal-func 'kvassoc=)
+ (match-func 'kvmatch))
+ "Turn a simple QUERY expression into a filter function.
+
+EQUAL-FUNC is the function that implements the equality
+predicate.
+
+MATCH-FUNC is the function that implements the match predicate.
+
+The query language is:
+
+ | a b - true if a or b is true
+ & a b - true only if a and b is true
+ = a b - true if a equals b as per the EQUAL-FUNC
+ ~ a b - true if a matches b as per the MATCH-FUNC
+
+So, for example:
+
+ (|(= a b)(= c d))
+
+Means: if `a' equals `b', or if `c' equals `d' then the
+expression is true."
+ (flet ((query-parse (query)
+ (let ((part (car query))
+ (rest (cdr query)))
+ (cond
+ ((eq part '|)
+ (cons 'or
+ (loop for i in rest
+ collect (query-parse i))))
+ ((eq part '&)
+ (cons 'and
+ (loop for i in rest
+ collect (query-parse i))))
+ ((eq part '~)
+ (destructuring-bind (field value) rest
+ (list match-func field value (quote record))))
+ ((eq part '=)
+ (destructuring-bind (field value) rest
+ (list equal-func field value (quote record))))))))
+ (eval `(lambda (record) ,(query-parse query)))))
+
+(defun kvplist2get (plist2 keyword value)
+ "Get the plist with KEYWORD / VALUE from the list of plists."
+ (loop for plist in plist2
+ if (equal (plist-get plist keyword) value)
+ return plist))
+
+(defun kvthing->keyword (str-or-symbol)
+ "Convert STR-OR-SYMBOL into a keyword symbol."
+ (let ((str
+ (cond
+ ((symbolp str-or-symbol) (symbol-name str-or-symbol))
+ ((stringp str-or-symbol) str-or-symbol))))
+ (intern
+ (if (eq (aref str 0) ?:) str (concat ":" str)))))
+
+(defun kvalist->plist (alist)
+ "Convert an alist to a plist."
+ ;; Why doesn't elisp provide this?
+ (loop for pair in alist
+ append (list
+ (kvthing->keyword
+ (car pair))
+ (cdr pair))))
+
+(defun kvacons (&rest args)
+ "Make an alist from the plist style args."
+ (kvplist->alist args))
+
+(defun keyword->symbol (keyword)
+ "A keyword is a symbol leading with a :.
+
+Converting to a symbol means dropping the :."
+ (if (keywordp keyword)
+ (intern (substring (symbol-name keyword) 1))
+ keyword))
+
+(defun kvplist->alist (plist &optional keys-are-keywords)
+ "Convert PLIST to an alist.
+
+The keys are expected to be :prefixed and the colons are removed
+unless KEYS-ARE-KEYWORDS is `t'.
+
+The keys in the resulting alist are always symbols."
+ (when plist
+ (loop for (key value . rest) on plist by 'cddr
+ collect
+ (cons (if keys-are-keywords
+ key
+ (keyword->symbol key))
+ value))))
+
+(defun kvalist2->plist (alist2)
+ "Convert a list of alists too a list of plists."
+ (loop for alist in alist2
+ append
+ (list (kvalist->plist alist))))
+
+(defun kvalist->keys (alist)
+ "Get just the keys from the alist."
+ (mapcar (lambda (pair) (car pair)) alist))
+
+(defun kvalist->values (alist)
+ "Get just the values from the alist."
+ (mapcar (lambda (pair) (cdr pair)) alist))
+
+(defun kvalist-sort (alist pred)
+ "Sort ALIST (by key) with PRED."
+ (sort alist (lambda (a b) (funcall pred (car a) (car b)))))
+
+(defun kvalist-sort-by-value (alist pred)
+ "Sort ALIST by value with PRED."
+ (sort alist (lambda (a b) (funcall pred (cdr a) (cdr b)))))
+
+(defun kvalist->filter-keys (alist &rest keys)
+ "Return the ALIST filtered to the KEYS list.
+
+Only pairs where the car is a `member' of KEYS will be returned."
+ (loop for a in alist
+ if (member (car a) keys)
+ collect a))
+
+(defun kvplist->filter-keys (plist &rest keys)
+ "Filter the plist to just those matching KEYS.
+
+`kvalist->filter-keys' is actually used to do this work."
+ (let ((symkeys
+ (loop for k in keys
+ collect (let ((strkey (symbol-name k)))
+ (if (equal (substring strkey 0 1) ":")
+ (intern (substring strkey 1))
+ k)))))
+ (kvalist->plist
+ (apply
+ 'kvalist->filter-keys
+ (cons (kvplist->alist plist) symkeys)))))
+
+(defun kvplist2->filter-keys (plist2 &rest keys)
+ "Return the PLIST2 (a list of plists) filtered to the KEYS."
+ (loop for plist in plist2
+ collect (apply 'kvplist->filter-keys (cons plist keys))))
+
+(defun kvalist2->filter-keys (alist2 &rest keys)
+ "Return the ALIST2 (a list of alists) filtered to the KEYS."
+ (loop for alist in alist2
+ collect (apply 'kvalist->filter-keys (cons alist keys))))
+
+(defun kvalist2->alist (alist2 car-key cdr-key &optional proper)
+ "Reduce the ALIST2 (a list of alists) to a single alist.
+
+CAR-KEY is the key of each alist to use as the resulting key and
+CDR-KEY is the key of each alist to user as the resulting cdr.
+
+For example, if CAR-KEY is `email' and CDR-KEY is `name' the
+records:
+
+ '((user . \"nic\")(name . \"Nic\")(email . \"nic@domain\")
+ (user . \"jim\")(name . \"Jim\")(email . \"jim@domain\"))
+
+could be reduced to:
+
+ '((\"nic@domain\" . \"Nic\")
+ (\"jim@domain\" . \"Jic\"))
+
+If PROPER is `t' then the alist is a list of proper lists, not
+cons cells."
+ (loop for alist in alist2
+ collect (apply (if proper 'list 'cons)
+ (list
+ (assoc-default car-key alist)
+ (assoc-default cdr-key alist)))))
+
+(defun kvalist-keys->* (alist fn)
+ "Convert the keys of ALIST through FN."
+ (mapcar
+ (lambda (pair)
+ (cons
+ (funcall fn (car pair))
+ (cdr pair)))
+ alist))
+
+(defun* kvalist-keys->symbols (alist &key (first-fn 'identity))
+ "Convert the keys of ALIST into symbols.
+
+If key parameter FIRST-FN is present it should be a function
+which will be used to first transform the string key. A popular
+choice might be `downcase' for example, to cause all symbol keys
+to be lower-case."
+ (kvalist-keys->*
+ alist
+ (lambda (key)
+ (intern (funcall first-fn (format "%s" key))))))
+
+(defun kvalist2-filter (alist2 fn)
+ "Filter the list of alists with FN."
+ (let (value)
+ (loop for rec in alist2
+ do (setq value (funcall fn rec))
+ if value
+ collect rec)))
+
+(defun kvidentity (a b)
+ "Returns a cons of A B."
+ (cons a b))
+
+(defun kvcar (a b)
+ "Given A B returns A."
+ a)
+
+(defun kvcdr (a b)
+ "Given A B returns B."
+ b)
+
+(defun kvcmp (a b)
+ "Do a comparison of the two values using printable syntax.
+
+Use this as the function to pass to `sort'."
+ (string-lessp (if a (format "%S" a) "")
+ (if b (format "%S" b) "")))
+
+(defun kvqsort (lst)
+ "Do a sort using `kvcmp'."
+ (sort lst 'kvcmp))
+
+(progn
+ (put 'kvalist-key
+ 'error-conditions
+ '(error))
+ (put 'kvalist-key
+ 'error-message
+ "No such key found in alist."))
+
+(defun kvalist-set-value! (alist key value)
+ "Destructively set the value of KEY to VALUE in ALIST.
+
+If the assoc is not found this adds it to alist."
+ (let ((cell (assoc key alist)))
+ (if (consp cell)
+ (setcdr cell value)
+ ;; Else what to do?
+ (signal 'kvalist-key (list alist key)))))
+
+(defun kvdotassoc-fn (expr table func)
+ "Use the dotted EXPR to access deeply nested data in TABLE.
+
+EXPR is a dot separated expression, either a symbol or a string.
+For example:
+
+ \"a.b.c\"
+
+or:
+
+ 'a.b.c
+
+If the EXPR is a symbol then the keys of the alist are also
+expected to be symbols.
+
+TABLE is expected to be an alist currently.
+
+FUNC is some sort of `assoc' like function."
+ (let ((state table)
+ (parts
+ (if (symbolp expr)
+ (mapcar
+ 'intern
+ (split-string (symbol-name expr) "\\."))
+ ;; Else it's a string
+ (split-string expr "\\."))))
+ (catch 'break
+ (while (listp parts)
+ (let ((traverse (funcall func (car parts) state)))
+ (setq parts (cdr parts))
+ (if parts
+ (setq state (cdr traverse))
+ (throw 'break (cdr traverse))))))))
+
+(defun kvdotassoc (expr table)
+ "Dotted expression handling with `assoc'."
+ (kvdotassoc-fn expr table 'assoc))
+
+(defun kvdotassq (expr table)
+ "Dotted expression handling with `assq'."
+ (kvdotassoc-fn expr table 'assq))
+
+(defun kvdotassoc= (expr value table)
+ (let ((v (kvdotassoc expr table)))
+ (and v (equal v value) v)))
+
+(defalias 'dotassoc 'kvdotassoc)
+(defalias 'dotassq 'kvdotassq)
+
+;; Thank you taylanub for this wonderful abstraction.
+(defmacro kv--destructuring-map (map-function args sequence &rest body)
+ "Helper macro for `destructuring-mapcar' and `destructuring-map'."
+ (declare (indent 3))
+ (let ((entry (gensym)))
+ `(,map-function (lambda (,entry)
+ (destructuring-bind ,args ,entry ,@body))
+ ,sequence)))
+
+(defmacro kvmap-bind (args sexp seq)
+ "A hybrid of `destructuring-bind' and `mapcar'
+ARGS shall be of the form used with `destructuring-bind'
+
+Unlike most other mapping forms this is a macro intended to be
+used for structural transformations, so the expected usage will
+be that ARGS describes the structure of the items in SEQ, and
+SEXP will describe the structure desired."
+ (declare (indent 2))
+ `(kv--destructuring-map mapcar ,args ,seq ,sexp))
+
+(defalias 'map-bind 'kvmap-bind)
+
+(defun kvplist-merge (&rest plists)
+ "Merge the 2nd and subsequent plists into the first.
+
+Values set by lists to the left are clobbered."
+ (let ((result (car plists))
+ (plists (cdr plists)))
+ (loop for plist in plists do
+ (loop for (key val) on plist by 'cddr do
+ (setq result (plist-put result key val))))
+ result))
+
+(provide 'kv)
+(provide 'dotassoc)
+
+;;; kv.el ends here
diff --git a/tests/elnode/recipes/elnode b/tests/elnode/recipes/elnode
new file mode 100644
index 0000000..49eb968
--- /dev/null
+++ b/tests/elnode/recipes/elnode
@@ -0,0 +1,30 @@
+(elnode
+ :version "0.9.9.7.9"
+ :doc "The Emacs webserver."
+ :requires
+ ((web "0.1.4") ;; for rle and proxy
+ (dash "1.1.0")
+ (noflet "0.0.7")
+ (s "1.5.0")
+ (creole "0.8.14") ;; for wiki
+ (fakir "0.1.6") ;; we provide the test-call with fakir
+ (db "0.0.5")
+ (kv "0.0.17"))
+ :files
+ ("elnode.el"
+ "elnode-compat.el"
+ "elnode-lists.el"
+ "elnode-js.el"
+ "elnode-tools.el"
+ "elnode-wiki.el"
+ "elnode-proxy.el"
+ "elnode-log-mode.el"
+ "elnode-testsupport.el"
+ "default-wiki-index.creole"
+ "default-webserver-test.html"
+ "default-webserver-image.png"
+ "README.creole"
+ "COPYING")
+ :test
+ (:files
+ ("elnode-tests.el")))
diff --git a/tests/elnode/web.el b/tests/elnode/web.el
new file mode 100644
index 0000000..8b0b8c6
--- /dev/null
+++ b/tests/elnode/web.el
@@ -0,0 +1,717 @@
+;;; web.el --- useful HTTP client -*- lexical-binding: t -*-
+
+;; Copyright (C) 2012 Nic Ferrier
+
+;; Author: Nic Ferrier <nferrier@ferrier.me.uk>
+;; Maintainer: Nic Ferrier <nferrier@ferrier.me.uk>
+;; Created: 3 Aug 2012
+;; Version: 20140612.1643
+;; X-Original-Version: 0.4.2
+;; Url: http://github.com/nicferrier/emacs-web
+;; Keywords: lisp, http, hypermedia
+;; Package-requires: ((dash "2.3.0"))
+
+;; 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 this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; This is an HTTP client using lexical scope. This makes coding with
+;; callbacks easier than with `url'. This package also provides a
+;; streaming mode where the callback is continually called whenever
+;; chunk encoding chunks are completed.
+
+;;; Code:
+
+;; Style-note: This codes uses the Emacs style of:
+;;
+;; web/private-function
+;;
+;; for private functions.
+
+
+(eval-when-compile
+ (require 'cl))
+
+(require 'url-parse)
+(require 'json)
+(require 'browse-url)
+(require 'dash)
+(require 'time-stamp)
+
+(defconst web/request-mimetype
+ 'application/x-www-form-urlencoded
+ "The default MIME type used for requests.")
+
+(defconst web-multipart-mimetype
+ 'multipart/form-data
+ "The MIME type used for multipart requests.")
+
+(defun web-header-parse (data)
+ "Parse an HTTP response header.
+
+Each header line is stored in the hash with a symbol form of the
+header name.
+
+The status line is expected to be the first line of the data.
+The status is stored in the header as well with the following
+keys:
+
+ status-version
+ status-code
+ status-string
+
+which are stored as symbols the same as the normal header keys."
+ (let* ((header-hash (make-hash-table :test 'equal))
+ (header-lines (split-string data "\r\n"))
+ (status-line (car header-lines)))
+ (when (string-match
+ "HTTP/\\([0-9.]+\\) \\([0-9]\\{3\\}\\)\\( \\(.*\\)\\)*"
+ status-line)
+ (puthash 'status-version (match-string 1 status-line) header-hash)
+ (puthash 'status-code (match-string 2 status-line) header-hash)
+ (puthash 'status-string
+ (or (match-string 4 status-line) "")
+ header-hash))
+ (loop for line in (cdr header-lines)
+ if (string-match
+ "^\\([A-Za-z0-9.-]+\\):[ ]*\\(.*\\)"
+ line)
+ do
+ (let ((name (intern (downcase (match-string 1 line))))
+ (value (match-string 2 line)))
+ (puthash name value header-hash)))
+ header-hash))
+
+(defun web/chunked-decode-stream (con data consumer)
+ "Decode the chunked encoding stream on the process CON.
+
+DATA is a lump of data from the stream, as passed from a filter
+function for example.
+
+CONSUMER is a function that will be called with the resulting
+data like:
+
+ CON CHUNK
+
+the CON is the same as the CON in this call. The `chunk' is the
+chunk that has been read. Only complete chunks are sent to the
+CONSUMER.
+
+When the chunked stream ends the CONSUMER is called with CHUNK
+being `:done'. This can be used to do clean up. It is NOT
+expected that the callback will have to clean up the CON, that
+should be done by the caller.
+
+CON is used to store state with the process property
+`:chunked-encoding-buffer' being used as a buffer."
+ ;; Make data the whole chunk
+ (setq data (let ((saved (process-get con :chunked-encoding-buffer)))
+ (if saved (concat saved data) data)))
+ (if (not (string-match "^\\([0-9A-Fa-f]+\\)\r\n" data))
+ (process-put con :chunked-encoding-buffer data)
+ ;; We have identified a chunk
+ (let* ((chunk-num (match-string 1 data))
+ (chunk-size (string-to-number chunk-num 16))
+ (toread-pos (+ 2 (length chunk-num))) ; +2 == \r\n after chunk sz
+ (chunk-end (+ toread-pos chunk-size)))
+ (if (< (length data) (+ 2 chunk-end)) ; +2 == \r\n at end of chunk
+ (process-put con :chunked-encoding-buffer data)
+ (let ((toread (substring data toread-pos chunk-end))
+ (trailing (substring data chunk-end (+ chunk-end 2)))
+ (left (substring data (+ chunk-end 2))))
+ (if trailing
+ (assert (equal trailing "\r\n") t))
+ (cond
+ ((equal 0 chunk-size)
+ ;; Finished
+ (funcall consumer con :done)
+ :done)
+ ((> chunk-size (length toread))
+ (process-put con :chunked-encoding-buffer data))
+ (t
+ ;; Eat the data
+ (funcall consumer con toread)
+ ;; Clear the buffer
+ (process-put con :chunked-encoding-buffer "")
+ ;; Go round again if we need to
+ (if left
+ (web/chunked-decode-stream
+ con left consumer)))))))))
+
+(defun web/cleanup-process (proc)
+ "Kill the buffer and clean the process."
+ (let ((buf (process-buffer proc)))
+ (delete-process proc)
+ (kill-buffer buf)))
+
+(defun web/content-length-filter (callback con header data)
+ "Does the content-length filtering."
+ (let ((so-far (concat (process-get con :web-buffer) data))
+ (content-len (string-to-number
+ (gethash 'content-length header))))
+ (if (> content-len (length so-far))
+ (process-put con :web-buffer so-far)
+ ;; We have all the data, callback and then kill the process
+ (unwind-protect
+ (funcall callback con header so-far)
+ (web/cleanup-process con)))))
+
+(defun web/http-post-filter (con data callback mode)
+ "Filter function for HTTP POST.
+
+Not actually a filter function because it also receives the
+CALLBACK and the MODE from the actual filter function, a lexical
+closure inside `web-http-post'.
+
+CALLBACK is a user supplied function handling the return from the
+HTTP server.
+
+MODE comes from the `web-http-post' call. This function
+handles the MODE by either streaming the data to the CALLBACK or
+by collecting it and then batching it to the CALLBACK."
+ (with-current-buffer (process-buffer con)
+ (let ((header (process-get con :http-header)))
+ (if (not header)
+ (save-excursion
+ (goto-char (point-max))
+ (insert data)
+ ;; Find the header if we don't have it
+ (if (and (not header)
+ (progn
+ (goto-char (point-min))
+ (re-search-forward "\r\n\r\n" nil t)))
+ (let ((hdr (web-header-parse
+ (buffer-substring (point-min) (point-max))))
+ ;; From the point of the end of header to the end
+ ;; is the data we need... this may be nothing.
+ (part-data (if (> (point-max) (point))
+ (buffer-substring (point) (point-max))
+ nil)))
+ (process-put con :http-header-pos (point))
+ (process-put con :http-header hdr)
+ ;; If we have more data call ourselves to process it
+ (when part-data
+ (web/http-post-filter
+ con part-data callback mode)))))
+ ;; FIXME - We have the header - we could check for cookie header here
+ ;;
+ ;; or indeed for the redirect.
+ ;;
+ ;; We have the header, read the body and call callback
+ (cond
+ ((equal "chunked" (gethash 'transfer-encoding header))
+ (web/chunked-decode-stream
+ con data
+ ;; FIXME we still need the callback to know if this is completion
+ (lambda (con data)
+ (cond
+ ((eq mode 'stream)
+ (funcall callback con header data)
+ (when (eq data :done)
+ (web/cleanup-process con)))
+ ((and (eq mode 'batch)
+ (eq data :done))
+ (funcall callback con header
+ (process-get con :web-buffer))
+ (web/cleanup-process con))
+ (t
+ (process-put
+ con :web-buffer
+ (concat (or (process-get con :web-buffer) "")
+ data)))))))
+ ;; We have a content-length header so just buffer that much data
+ ((gethash 'content-length header)
+ (web/content-length-filter callback con header data)))))))
+
+(defun web/key-value-encode (key value)
+ "Encode a KEY and VALUE for url encoding."
+ (cond
+ ((or
+ (numberp value)
+ (stringp value))
+ (format
+ "%s=%s"
+ (url-hexify-string (format "%s" key))
+ (url-hexify-string (format "%s" value))))
+ (t
+ (format "%s" (url-hexify-string (format "%s" key))))))
+
+(defun web-to-query-string (object)
+ "Convert OBJECT (a hash-table or alist) to an HTTP query string.
+
+If OBJECT is of type `hash-table' then the keys and values of the
+hash are iterated into the string depending on their types.
+
+Keys with `number' and `string' values are encoded as
+\"key=value\" in the resulting query.
+
+Keys with a boolean value (or any other value not already
+described) are encoded just as \"key\".
+
+Keys may be symbols or strings."
+ (mapconcat
+ (lambda (pair)
+ (web/key-value-encode (car pair) (cdr pair)))
+ (cond
+ ((hash-table-p object)
+ (let (result)
+ (maphash
+ (lambda (key value)
+ (setq result (append (list (cons key value)) result)))
+ object)
+ (reverse result)))
+ ((listp object)
+ object))
+ "&"))
+
+
+;; What a multipart body looks like
+;; Content-type: multipart/form-data, boundary=AaB03x
+;;
+;; --AaB03x
+;; content-disposition: form-data; name="field1"
+;;
+;; Joe Blow
+;; --AaB03x
+;; content-disposition: form-data; name="pics"; filename="file1.txt"
+;; Content-Type: text/plain
+;;
+;; ... contents of file1.txt ...
+;; --AaB03x--
+
+(defun web/to-multipart-boundary ()
+ "Make a boundary marker."
+ (sha1 (format "%s%s" (random) (time-stamp-string))))
+
+(defun web/is-file (kv)
+ (let ((b (cdr kv)))
+ (and (bufferp b) (buffer-file-name b) b)))
+
+(defun web-to-multipart (data)
+ "Convert DATA, an ALIST or Hashtable, into a Multipart body.
+
+Returns a string of the multipart body propertized with
+`:boundary' with a value of the boundary string."
+ (let* ((boundary (web/to-multipart-boundary))
+ (parts (mapconcat ; first the params ...
+ (lambda (kv)
+ (let ((name (car kv))
+ (value (cdr kv)))
+ (format "--%s\r
+Content-Disposition: form-data; name=\"%s\"\r\n\r\n%s"
+ boundary name value)))
+ (-filter (lambda (kv) (not (web/is-file kv))) data) "\r\n"))
+ (files (mapconcat ; then the files ...
+ (lambda (kv)
+ (let* ((name (car kv))
+ (buffer (cdr kv))
+ (filename (buffer-file-name buffer))
+ (mime-enc (or
+ (mm-default-file-encoding filename)
+ "text/plain")))
+ (format "--%s\r
+Content-Transfer-Encoding: BASE64\r
+Content-Disposition: form-data; name=\"%s\"; filename=\"%s\"\r
+Content-Type: %s\r\n\r\n%s"
+ boundary name (file-name-nondirectory filename)
mime-enc
+ ;; FIXME - We should base64 the content when
appropriate
+ (base64-encode-string
+ (with-current-buffer buffer (buffer-string))))))
+ (-filter 'web/is-file data) "\r\n")))
+ (propertize
+ (format "%s%s--%s--\r\n"
+ (if (and parts (not (equal parts ""))) (concat parts "\r\n") "")
+ (if (and files (not (equal files ""))) (concat files "\r\n") "")
+ boundary)
+ :boundary boundary)))
+
+(defvar web-log-info nil
+ "Whether to log info messages, specifically from the sentinel.")
+
+(defun web/http-post-sentinel (con evt)
+ "Sentinel for the HTTP POST."
+ ;; FIXME I'm sure this needs to be different - but how? it needs to
+ ;; communicate to the filter function?
+ (cond
+ ((equal evt "closed\n")
+ (when web-log-info
+ (message "web/http-post-sentinel http client post closed")))
+ ((equal evt "deleted\n")
+ (delete-process con)
+ (when web-log-info
+ (message "web/http-post-sentinel http client post deleted")))
+ ((equal evt "connection broken by peer\n")
+ (when web-log-info
+ (message "web/http-post-sentinel http client broken")))
+ (t
+ (when web-log-info
+ (message "web/http-post-sentinel unexpected evt: %s" evt)))))
+
+(defun web/http-post-sentinel-with-logging (con evt logging)
+ "Map a logging variable into the sentinel."
+ (let ((web-log-info logging))
+ (web/http-post-sentinel con evt)))
+
+(defun web/header-list (headers)
+ "Convert HEADERS (hash-table or alist) into a header list."
+ (labels
+ ((hdr (key val)
+ (format "%s: %s\r\n" key val)))
+ (cond
+ ((hash-table-p headers)
+ (let (res)
+ (maphash
+ (lambda (key val)
+ (setq res (append (list (hdr key val)) res)))
+ headers)
+ res))
+ ((listp headers)
+ (mapcar
+ (lambda (pair) (hdr (car pair)(cdr pair)))
+ headers)))))
+
+(defun web/header-string (method headers mime-type to-send)
+ "Return a string of all the HEADERS formatted for a request.
+
+Content-Type and Content-Length are both computed automatically.
+
+METHOD specifies the usual HTTP method and therefore whether
+there might be a Content-Type on the request body.
+
+MIME-TYPE specifies the MIME-TYPE of any TO-SEND.
+
+TO-SEND is any request body that needs to be sent. TO-SEND may
+be propertized with a multipart boundary marker which needs to be
+set on the Content-Type header."
+ (let ((http-hdrs (web/header-list headers))
+ (boundary (and to-send
+ (plist-get (text-properties-at 0 to-send) :boundary))))
+ (when (member method '("POST" "PUT"))
+ (when (> (length to-send) 1)
+ (push (format
+ "Content-type: %s%s\r\n" mime-type
+ (if boundary (format "; boundary=%s" boundary) ""))
+ http-hdrs)))
+ (when (and to-send (> (length to-send) 0))
+ (push
+ (format "Content-length: %d\r\n" (length to-send))
+ http-hdrs))
+ (loop for hdr in http-hdrs if hdr concat hdr)))
+
+(defun web/log (log)
+ (when log
+ (with-current-buffer (get-buffer-create "*web-log*")
+ (save-excursion
+ (goto-char (point-max))
+ (insert "web-http ")
+ (insert (format "%s" log))
+ (insert "\n")))))
+
+;;;###autoload
+(defun* web-http-call (method
+ callback
+ &key
+ url
+ (host "localhost")
+ (port 80)
+ secure
+ (path "/")
+ extra-headers
+ data
+ (mime-type web/request-mimetype)
+ (mode 'batch)
+ logging)
+ "Make an HTTP method to the URL or the HOST, PORT, PATH and send DATA.
+
+If URL is specified then it takes precedence over SECURE, HOST,
+PORT and PATH. URL may be HTTP or HTTPS.
+
+Important note: any query in URL is currently IGNORED!
+
+SECURE is `nil' by default but if `t' then SSL is used.
+
+PORT is 80 by default. Even if SECURE it `t'. If you manually
+specify SECURE you should manually specify PORT to be 443. Using
+URL negates the need for that, an SSL URL will work correctly.
+
+EXTRA-HEADERS is an alist or a hash-table of extra headers to
+send to the server.
+
+DATA is of MIME-TYPE. We try to interpret DATA and MIME-TYPE
+usefully:
+
+If MIME-TYPE is `application/form-www-url-encoded' then
+`web-to-query-string' is used to to format the DATA into a POST
+body.
+
+If MIME-TYPE is `multipart/form-data' then `web-to-multipart' is
+called to get a POST body.
+
+When the request comes back the CALLBACK is called. CALLBACK is
+always passed 3 arguments: the HTTP connection which is a process
+object, the HTTP header which is a `hash-table' and `data', which
+is normally a string. `data' depends somewhat on the context.
+See below.
+
+MODE defines what it means for the request to cause the CALLBACK
+to be fired. When MODE is `stream' then the CALLBACK is called
+for every chunk of data received after the header has arrived.
+This allows streaming data to somewhere else; hence `stream'
+mode. In this mode CALLBACK's `data' argument is a single chunk
+of the stream or `:done' when the stream ends.
+
+The default MODE is `batch' which collects all the data from the
+response before calling CALLBACK with all the data as a string."
+ (when logging (web/log url))
+ (let* ((mode (or mode 'batch))
+ (parsed-url (url-generic-parse-url
+ (if url url
+ (format "%s://%s:%d%s"
+ (if secure "https" "http")
+ host port path))))
+ (host (progn
+ (assert
+ (or (equal (url-type parsed-url) "http")
+ (equal (url-type parsed-url) "https"))
+ t "The url scheme must be http")
+ (url-host parsed-url)))
+ (port (url-port parsed-url))
+ (path (let ((pth (url-filename parsed-url)))
+ (if (equal pth "") "/" pth)))
+ (dest (format "%s:%s%s" host port path))
+ (buf (generate-new-buffer dest))
+ (con (open-network-stream
+ (format "web-http-post-%s" dest)
+ buf host port
+ :type (cond
+ ((equal (url-type parsed-url) "http") 'plain)
+ ((equal (url-type parsed-url) "https") 'tls)))))
+ ;; We must use this coding system or the web dies
+ (set-process-coding-system con 'raw-text-unix 'raw-text-unix)
+ (set-process-sentinel con (lambda (con evt)
+ (web/http-post-sentinel-with-logging
+ con evt logging)))
+ (set-process-filter
+ con
+ (lambda (con data)
+ (let ((mode mode)
+ (cb callback))
+ (web/http-post-filter con data cb mode))))
+ ;; Send the request
+ (let*
+ ((sym-mt (if (symbolp mime-type) mime-type (intern mime-type)))
+ (to-send (case sym-mt
+ ('multipart/form-data
+ (web-to-multipart data))
+ ('application/x-www-form-urlencoded
+ (web-to-query-string data))))
+ (headers (or (web/header-string
+ method extra-headers mime-type to-send)
+ ""))
+ (submission
+ (format
+ "%s %s HTTP/1.1\r\nHost: %s\r\n%s\r\n%s"
+ method path host
+ headers
+ (if to-send to-send ""))))
+ (when logging (web/log submission))
+ (process-send-string con submission))
+ con))
+
+;;;###autoload
+(defun* web-http-get (callback
+ &key
+ url
+ (host "localhost")
+ (port 80)
+ (path "/")
+ extra-headers
+ (mode 'batch)
+ (logging t))
+ "Make a GET calling CALLBACK with the result.
+
+For information on URL or PATH, HOST, PORT and also EXTRA-HEADERS
+and MODE see `web-http-call'.
+
+The callback probably won't work unless you set `lexical-binding'
+to `t'."
+ (web-http-call
+ "GET"
+ callback
+ :url url
+ :host host
+ :port port
+ :path path
+ :extra-headers extra-headers
+ :mode mode
+ :logging logging))
+
+;;;###autoload
+(defun* web-http-post (callback
+ &key
+ url
+ (host "localhost")
+ (port 80)
+ (path "/")
+ extra-headers
+ data
+ (mime-type web/request-mimetype)
+ (mode 'batch)
+ (logging t))
+ "Make a POST and call CALLBACK with the result.
+
+For information on URL or PATH, HOST, PORT and also MODE see
+`web-http-call'.
+
+The callback probably won't work unless you set `lexical-binding'
+to `t'."
+ (web-http-call
+ "POST"
+ callback
+ :url url
+ :host host
+ :port port
+ :path path
+ :extra-headers extra-headers
+ :data data
+ :mime-type mime-type
+ :logging logging
+ :mode mode))
+
+(defvar web-json-expected-mimetypes-list
+ '("application/json"
+ "application/x-javascript"
+ "text/javascript"
+ "text/x-javascript"
+ "text/x-json")
+ "List of mimetypes that we use to accept JSON.")
+
+(defun web-json-default-expectation-failure (data http-con headers)
+ "Default expectation callback for JSON expectation errors."
+ (error "web-json failed to read %S as json with %s and %s"
+ data http-con headers))
+
+(defun* web/json-parse (json-candidate-data
+ &key
+ (json-array-type json-array-type)
+ (json-object-type json-object-type)
+ (json-key-type json-key-type))
+ "Parse DATA as JSON and return the result."
+ (json-read-from-string json-candidate-data))
+
+;;;###autoload
+(defun* web-json-post (callback
+ &key
+ url data headers
+ (mime-type web/request-mimetype)
+ (logging t)
+ (json-array-type json-array-type)
+ (json-object-type json-object-type)
+ (json-key-type json-key-type)
+ (expectation-failure-callback
+ 'web-json-default-expectation-failure))
+ "POST DATA to URL expecting a JSON response sent to CALLBACK.
+
+See `web-json-expected-mimetypes-list' for the list of Mime Types
+we accept JSON for. This may be let bound. If the expectation
+is not met then EXPECTATION-FAILURE-CALLBACK is called being
+passed the CALLBACK parameters. By default
+EXPECTATION-FAILURE-CALLBACK is
+`web-json-default-expectation-failure'.
+
+The CALLBACK is called as:
+
+ CALLBACK RESPONSE-DATA HTTPCON RESPONSE-HEADER
+
+so the function may be defined like this:
+
+ (lambda (data &rest stuff) ...)
+
+HEADERS may be specified, these are treated as extra-headers to
+be sent with the request.
+
+The DATA is sent as `application/x-www-form-urlencoded' by
+default, MIME-TYPE can change that.
+
+JSON-ARRAY-TYPE, JSON-OBJECT-TYPE and JSON-KEY-TYPE, if present,
+are used to let bind the `json-read' variables of the same name
+affecting the resulting lisp structure."
+ (let ((closed-json-array-type json-array-type)
+ (closed-json-object-type json-object-type)
+ (closed-json-key-type json-key-type))
+ (web-http-post
+ (lambda (httpcon header http-data)
+ ;; Add a member test for the MIMETYPE expectation
+ (let ((lisp-data
+ (condition-case err
+ (web/json-parse
+ http-data
+ :json-array-type closed-json-array-type
+ :json-object-type closed-json-object-type
+ :json-key-type closed-json-key-type)
+ (error
+ (when logging
+ (message "web-json-post expectation failure %S" err))
+ (funcall expectation-failure-callback
+ http-data httpcon header)))))
+ (funcall callback lisp-data httpcon header)))
+ :url url
+ :data data
+ :mime-type mime-type
+ :extra-headers headers
+ :logging logging)))
+
+(defvar web-get-history-list nil
+ "History for `web-get' interactive forms.")
+
+;;;###autoload
+(defun web-get (url &optional buffer)
+ "Get the specified URL into the BUFFER."
+ (interactive
+ (list
+ (let ((def-url (browse-url-url-at-point)))
+ (read-from-minibuffer "URL: " def-url nil nil 'web-get-history-list))
+ (when current-prefix-arg
+ (read-buffer "Buffer: " '("*web-get*")))))
+ (let ((handler
+ (lambda (httpc header data)
+ (with-current-buffer
+ (if (bufferp buffer)
+ buffer
+ (if (stringp buffer)
+ (generate-new-buffer buffer)
+ (generate-new-buffer "*web-get*")))
+ (goto-char (point-max))
+ (insert data)
+ (switch-to-buffer (current-buffer))))))
+ (web-http-get handler :url url)))
+
+(defun web-header (header name &optional convert)
+ "Look up NAME in HEADER."
+ (let ((val (if (hash-table-p header)
+ (let ((v (gethash (intern name) header)))
+ (when v (cons name v)))
+ ;; Else presume it's an alist
+ (assoc name header))))
+ (when val
+ (case convert
+ (:num (string-to-number (cdr val)))
+ (t val)))))
+
+
+(provide 'web)
+
+;;; web.el ends here
diff --git a/tests/elpa/aggressive-indent-autoloads-24.1.el
b/tests/elpa/aggressive-indent-autoloads-24.1.el
new file mode 100644
index 0000000..d6b9686
--- /dev/null
+++ b/tests/elpa/aggressive-indent-autoloads-24.1.el
@@ -0,0 +1,64 @@
+;;; aggressive-indent-autoloads.el --- automatically extracted autoloads
+;;
+;;; Code:
+
+
+;;;### (autoloads (aggressive-indent-) "aggressive-indent"
"aggressive-indent.el"
+;;;;;; (21587 41662 658130 132000))
+;;; Generated autoloads from aggressive-indent.el
+
+(let ((loads (get 'aggressive-indent 'custom-loads))) (if (member
'"aggressive-indent" loads) nil (put 'aggressive-indent 'custom-loads (cons
'"aggressive-indent" loads))))
+
+(autoload 'aggressive-indent-indent-defun "aggressive-indent" "\
+Indent current defun.
+Throw an error if parentheses are unbalanced.
+
+\(fn)" t nil)
+
+(autoload 'aggressive-indent-mode "aggressive-indent" "\
+Toggle Aggressive-Indent mode on or off.
+With a prefix argument ARG, enable Aggressive-Indent mode if ARG is
+positive, and disable it otherwise. If called from Lisp, enable
+the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'.
+\\{aggressive-indent-mode-map}
+
+\(fn &optional ARG)" t nil)
+
+(defvar global-aggressive-indent-mode nil "\
+Non-nil if Global-Aggressive-Indent mode is enabled.
+See the command `global-aggressive-indent-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 `global-aggressive-indent-mode'.")
+
+(custom-autoload 'global-aggressive-indent-mode "aggressive-indent" nil)
+
+(autoload 'global-aggressive-indent-mode "aggressive-indent" "\
+Toggle Aggressive-Indent mode in all buffers.
+With prefix ARG, enable Global-Aggressive-Indent mode if ARG is positive;
+otherwise, disable it. If called from Lisp, enable the mode if
+ARG is omitted or nil.
+
+Aggressive-Indent mode is enabled in all buffers where
+`aggressive-indent-mode' would do it.
+See `aggressive-indent-mode' for more information on Aggressive-Indent mode.
+
+\(fn &optional ARG)" t nil)
+
+(defalias 'aggressive-indent-global-mode #'global-aggressive-indent-mode)
+
+;;;***
+
+;;;### (autoloads nil nil ("aggressive-indent-pkg.el") (21587 41662
+;;;;;; 753583 753000))
+
+;;;***
+
+(provide 'aggressive-indent-autoloads)
+;; Local Variables:
+;; version-control: never
+;; no-byte-compile: t
+;; no-update-autoloads: t
+;; coding: utf-8
+;; End:
+;;; aggressive-indent-autoloads.el ends here
diff --git a/tests/elpa/aggressive-indent-autoloads-24.2.el
b/tests/elpa/aggressive-indent-autoloads-24.2.el
new file mode 100644
index 0000000..d6b9686
--- /dev/null
+++ b/tests/elpa/aggressive-indent-autoloads-24.2.el
@@ -0,0 +1,64 @@
+;;; aggressive-indent-autoloads.el --- automatically extracted autoloads
+;;
+;;; Code:
+
+
+;;;### (autoloads (aggressive-indent-) "aggressive-indent"
"aggressive-indent.el"
+;;;;;; (21587 41662 658130 132000))
+;;; Generated autoloads from aggressive-indent.el
+
+(let ((loads (get 'aggressive-indent 'custom-loads))) (if (member
'"aggressive-indent" loads) nil (put 'aggressive-indent 'custom-loads (cons
'"aggressive-indent" loads))))
+
+(autoload 'aggressive-indent-indent-defun "aggressive-indent" "\
+Indent current defun.
+Throw an error if parentheses are unbalanced.
+
+\(fn)" t nil)
+
+(autoload 'aggressive-indent-mode "aggressive-indent" "\
+Toggle Aggressive-Indent mode on or off.
+With a prefix argument ARG, enable Aggressive-Indent mode if ARG is
+positive, and disable it otherwise. If called from Lisp, enable
+the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'.
+\\{aggressive-indent-mode-map}
+
+\(fn &optional ARG)" t nil)
+
+(defvar global-aggressive-indent-mode nil "\
+Non-nil if Global-Aggressive-Indent mode is enabled.
+See the command `global-aggressive-indent-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 `global-aggressive-indent-mode'.")
+
+(custom-autoload 'global-aggressive-indent-mode "aggressive-indent" nil)
+
+(autoload 'global-aggressive-indent-mode "aggressive-indent" "\
+Toggle Aggressive-Indent mode in all buffers.
+With prefix ARG, enable Global-Aggressive-Indent mode if ARG is positive;
+otherwise, disable it. If called from Lisp, enable the mode if
+ARG is omitted or nil.
+
+Aggressive-Indent mode is enabled in all buffers where
+`aggressive-indent-mode' would do it.
+See `aggressive-indent-mode' for more information on Aggressive-Indent mode.
+
+\(fn &optional ARG)" t nil)
+
+(defalias 'aggressive-indent-global-mode #'global-aggressive-indent-mode)
+
+;;;***
+
+;;;### (autoloads nil nil ("aggressive-indent-pkg.el") (21587 41662
+;;;;;; 753583 753000))
+
+;;;***
+
+(provide 'aggressive-indent-autoloads)
+;; Local Variables:
+;; version-control: never
+;; no-byte-compile: t
+;; no-update-autoloads: t
+;; coding: utf-8
+;; End:
+;;; aggressive-indent-autoloads.el ends here
diff --git a/tests/elpa/aggressive-indent-autoloads-24.3.el
b/tests/elpa/aggressive-indent-autoloads-24.3.el
new file mode 100644
index 0000000..5003423
--- /dev/null
+++ b/tests/elpa/aggressive-indent-autoloads-24.3.el
@@ -0,0 +1,64 @@
+;;; aggressive-indent-autoloads.el --- automatically extracted autoloads
+;;
+;;; Code:
+
+
+;;;### (autoloads (aggressive-indent-) "aggressive-indent"
"aggressive-indent.el"
+;;;;;; (21587 41662 658130 132000))
+;;; Generated autoloads from aggressive-indent.el
+
+(let ((loads (get 'aggressive-indent 'custom-loads))) (if (member
'"aggressive-indent" loads) nil (put 'aggressive-indent 'custom-loads (cons
'"aggressive-indent" loads))))
+
+(autoload 'aggressive-indent-indent-defun "aggressive-indent" "\
+Indent current defun.
+Throw an error if parentheses are unbalanced.
+
+\(fn)" t nil)
+
+(autoload 'aggressive-indent-mode "aggressive-indent" "\
+Toggle Aggressive-Indent mode on or off.
+With a prefix argument ARG, enable Aggressive-Indent mode if ARG is
+positive, and disable it otherwise. If called from Lisp, enable
+the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'.
+\\{aggressive-indent-mode-map}
+
+\(fn &optional ARG)" t nil)
+
+(defvar global-aggressive-indent-mode nil "\
+Non-nil if Global-Aggressive-Indent mode is enabled.
+See the command `global-aggressive-indent-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 `global-aggressive-indent-mode'.")
+
+(custom-autoload 'global-aggressive-indent-mode "aggressive-indent" nil)
+
+(autoload 'global-aggressive-indent-mode "aggressive-indent" "\
+Toggle Aggressive-Indent mode in all buffers.
+With prefix ARG, enable Global-Aggressive-Indent mode if ARG is positive;
+otherwise, disable it. If called from Lisp, enable the mode if
+ARG is omitted or nil.
+
+Aggressive-Indent mode is enabled in all buffers where
+`aggressive-indent-mode' would do it.
+See `aggressive-indent-mode' for more information on Aggressive-Indent mode.
+
+\(fn &optional ARG)" t nil)
+
+(autoload 'aggressive-indent-global-mode "aggressive-indent" nil nil nil)
+
+;;;***
+
+;;;### (autoloads nil nil ("aggressive-indent-pkg.el") (21587 41662
+;;;;;; 753583 753000))
+
+;;;***
+
+(provide 'aggressive-indent-autoloads)
+;; Local Variables:
+;; version-control: never
+;; no-byte-compile: t
+;; no-update-autoloads: t
+;; coding: utf-8
+;; End:
+;;; aggressive-indent-autoloads.el ends here
diff --git a/tests/elpa/aggressive-indent-autoloads-25.0.el
b/tests/elpa/aggressive-indent-autoloads-25.0.el
new file mode 100644
index 0000000..aad8a0d
--- /dev/null
+++ b/tests/elpa/aggressive-indent-autoloads-25.0.el
@@ -0,0 +1,57 @@
+;;; aggressive-indent-autoloads.el --- automatically extracted autoloads
+;;
+;;; Code:
+(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
+
+;;;### (autoloads nil "aggressive-indent" "aggressive-indent.el"
+;;;;;; (21568 12512 635357 112000))
+;;; Generated autoloads from aggressive-indent.el
+
+(let ((loads (get 'aggressive-indent 'custom-loads))) (if (member
'"aggressive-indent" loads) nil (put 'aggressive-indent 'custom-loads (cons
'"aggressive-indent" loads))))
+
+(autoload 'aggressive-indent-indent-defun "aggressive-indent" "\
+Indent current defun.
+Throw an error if parentheses are unbalanced.
+
+\(fn)" t nil)
+
+(autoload 'aggressive-indent-mode "aggressive-indent" "\
+Toggle Aggressive-Indent mode on or off.
+With a prefix argument ARG, enable Aggressive-Indent mode if ARG is
+positive, and disable it otherwise. If called from Lisp, enable
+the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'.
+\\{aggressive-indent-mode-map}
+
+\(fn &optional ARG)" t nil)
+
+(defvar global-aggressive-indent-mode nil "\
+Non-nil if Global-Aggressive-Indent mode is enabled.
+See the command `global-aggressive-indent-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 `global-aggressive-indent-mode'.")
+
+(custom-autoload 'global-aggressive-indent-mode "aggressive-indent" nil)
+
+(autoload 'global-aggressive-indent-mode "aggressive-indent" "\
+Toggle Aggressive-Indent mode in all buffers.
+With prefix ARG, enable Global-Aggressive-Indent mode if ARG is positive;
+otherwise, disable it. If called from Lisp, enable the mode if
+ARG is omitted or nil.
+
+Aggressive-Indent mode is enabled in all buffers where
+`aggressive-indent-mode' would do it.
+See `aggressive-indent-mode' for more information on Aggressive-Indent mode.
+
+\(fn &optional ARG)" t nil)
+
+(autoload 'aggressive-indent-global-mode "aggressive-indent" nil nil nil)
+
+;;;***
+
+;; Local Variables:
+;; version-control: never
+;; no-byte-compile: t
+;; no-update-autoloads: t
+;; End:
+;;; aggressive-indent-autoloads.el ends here
diff --git a/tests/elpa/aggressive-indent-autoloads.el
b/tests/elpa/aggressive-indent-autoloads.el
new file mode 100644
index 0000000..aad8a0d
--- /dev/null
+++ b/tests/elpa/aggressive-indent-autoloads.el
@@ -0,0 +1,57 @@
+;;; aggressive-indent-autoloads.el --- automatically extracted autoloads
+;;
+;;; Code:
+(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
+
+;;;### (autoloads nil "aggressive-indent" "aggressive-indent.el"
+;;;;;; (21568 12512 635357 112000))
+;;; Generated autoloads from aggressive-indent.el
+
+(let ((loads (get 'aggressive-indent 'custom-loads))) (if (member
'"aggressive-indent" loads) nil (put 'aggressive-indent 'custom-loads (cons
'"aggressive-indent" loads))))
+
+(autoload 'aggressive-indent-indent-defun "aggressive-indent" "\
+Indent current defun.
+Throw an error if parentheses are unbalanced.
+
+\(fn)" t nil)
+
+(autoload 'aggressive-indent-mode "aggressive-indent" "\
+Toggle Aggressive-Indent mode on or off.
+With a prefix argument ARG, enable Aggressive-Indent mode if ARG is
+positive, and disable it otherwise. If called from Lisp, enable
+the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'.
+\\{aggressive-indent-mode-map}
+
+\(fn &optional ARG)" t nil)
+
+(defvar global-aggressive-indent-mode nil "\
+Non-nil if Global-Aggressive-Indent mode is enabled.
+See the command `global-aggressive-indent-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 `global-aggressive-indent-mode'.")
+
+(custom-autoload 'global-aggressive-indent-mode "aggressive-indent" nil)
+
+(autoload 'global-aggressive-indent-mode "aggressive-indent" "\
+Toggle Aggressive-Indent mode in all buffers.
+With prefix ARG, enable Global-Aggressive-Indent mode if ARG is positive;
+otherwise, disable it. If called from Lisp, enable the mode if
+ARG is omitted or nil.
+
+Aggressive-Indent mode is enabled in all buffers where
+`aggressive-indent-mode' would do it.
+See `aggressive-indent-mode' for more information on Aggressive-Indent mode.
+
+\(fn &optional ARG)" t nil)
+
+(autoload 'aggressive-indent-global-mode "aggressive-indent" nil nil nil)
+
+;;;***
+
+;; Local Variables:
+;; version-control: never
+;; no-byte-compile: t
+;; no-update-autoloads: t
+;; End:
+;;; aggressive-indent-autoloads.el ends here
diff --git a/tests/ert.el b/tests/ert.el
new file mode 100644
index 0000000..cd2d354
--- /dev/null
+++ b/tests/ert.el
@@ -0,0 +1,2544 @@
+;;; ert.el --- Emacs Lisp Regression Testing
+
+;; Copyright (C) 2007, 2008, 2010 Free Software Foundation, Inc.
+
+;; Author: Christian M. Ohler
+;; Keywords: lisp, tools
+
+;; 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 this program. If not, see `http://www.gnu.org/licenses/'.
+
+;;; Commentary:
+
+;; ERT is a tool for automated testing in Emacs Lisp. Its main
+;; features are facilities for defining and running test cases and
+;; reporting the results as well as for debugging test failures
+;; interactively.
+;;
+;; The main entry points are `ert-deftest', which is similar to
+;; `defun' but defines a test, and `ert-run-tests-interactively',
+;; which runs tests and offers an interactive interface for inspecting
+;; results and debugging. There is also
+;; `ert-run-tests-batch-and-exit' for non-interactive use.
+;;
+;; The body of `ert-deftest' forms resembles a function body, but the
+;; additional operators `should', `should-not' and `should-error' are
+;; available. `should' is similar to cl's `assert', but signals a
+;; different error when its condition is violated that is caught and
+;; processed by ERT. In addition, it analyzes its argument form and
+;; records information that helps debugging (`assert' tries to do
+;; something similar when its second argument SHOW-ARGS is true, but
+;; `should' is more sophisticated). For information on `should-not'
+;; and `should-error', see their docstrings.
+;;
+;; See ERT's info manual as well as the docstrings for more details.
+;; To compile the manual, run `makeinfo ert.texinfo' in the ERT
+;; directory, then C-u M-x info ert.info in Emacs to view it.
+;;
+;; To see some examples of tests written in ERT, see its self-tests in
+;; ert-tests.el. Some of these are tricky due to the bootstrapping
+;; problem of writing tests for a testing tool, others test simple
+;; functions and are straightforward.
+
+;;; Code:
+
+(eval-when-compile
+ (require 'cl))
+(require 'button)
+(require 'debug)
+(require 'easymenu)
+(require 'ewoc)
+(require 'find-func)
+(require 'help)
+
+
+;;; UI customization options.
+
+(defgroup ert ()
+ "ERT, the Emacs Lisp regression testing tool."
+ :prefix "ert-"
+ :group 'lisp)
+
+(defface ert-test-result-expected '((((class color) (background light))
+ :background "green1")
+ (((class color) (background dark))
+ :background "green3"))
+ "Face used for expected results in the ERT results buffer."
+ :group 'ert)
+
+(defface ert-test-result-unexpected '((((class color) (background light))
+ :background "red1")
+ (((class color) (background dark))
+ :background "red3"))
+ "Face used for unexpected results in the ERT results buffer."
+ :group 'ert)
+
+
+;;; Copies/reimplementations of cl functions.
+
+(defun ert--cl-do-remf (plist tag)
+ "Copy of `cl-do-remf'. Modify PLIST by removing TAG."
+ (let ((p (cdr plist)))
+ (while (and (cdr p) (not (eq (car (cdr p)) tag))) (setq p (cdr (cdr p))))
+ (and (cdr p) (progn (setcdr p (cdr (cdr (cdr p)))) t))))
+
+(defun ert--remprop (sym tag)
+ "Copy of `cl-remprop'. Modify SYM's plist by removing TAG."
+ (let ((plist (symbol-plist sym)))
+ (if (and plist (eq tag (car plist)))
+ (progn (setplist sym (cdr (cdr plist))) t)
+ (ert--cl-do-remf plist tag))))
+
+(defun ert--remove-if-not (ert-pred ert-list)
+ "A reimplementation of `remove-if-not'.
+
+ERT-PRED is a predicate, ERT-LIST is the input list."
+ (loop for ert-x in ert-list
+ if (funcall ert-pred ert-x)
+ collect ert-x))
+
+(defun ert--intersection (a b)
+ "A reimplementation of `intersection'. Intersect the sets A and B.
+
+Elements are compared using `eql'."
+ (loop for x in a
+ if (memql x b)
+ collect x))
+
+(defun ert--set-difference (a b)
+ "A reimplementation of `set-difference'. Subtract the set B from the set A.
+
+Elements are compared using `eql'."
+ (loop for x in a
+ unless (memql x b)
+ collect x))
+
+(defun ert--set-difference-eq (a b)
+ "A reimplementation of `set-difference'. Subtract the set B from the set A.
+
+Elements are compared using `eq'."
+ (loop for x in a
+ unless (memq x b)
+ collect x))
+
+(defun ert--union (a b)
+ "A reimplementation of `union'. Compute the union of the sets A and B.
+
+Elements are compared using `eql'."
+ (append a (ert--set-difference b a)))
+
+(eval-and-compile
+ (defvar ert--gensym-counter 0))
+
+(eval-and-compile
+ (defun ert--gensym (&optional prefix)
+ "Only allows string PREFIX, not compatible with CL."
+ (unless prefix (setq prefix "G"))
+ (make-symbol (format "%s%s"
+ prefix
+ (prog1 ert--gensym-counter
+ (incf ert--gensym-counter))))))
+
+(defun ert--coerce-to-vector (x)
+ "Coerce X to a vector."
+ (when (char-table-p x) (error "Not supported"))
+ (if (vectorp x)
+ x
+ (vconcat x)))
+
+(defun* ert--remove* (x list &key key test)
+ "Does not support all the keywords of remove*."
+ (unless key (setq key #'identity))
+ (unless test (setq test #'eql))
+ (loop for y in list
+ unless (funcall test x (funcall key y))
+ collect y))
+
+(defun ert--string-position (c s)
+ "Return the position of the first occurrence of C in S, or nil if none."
+ (loop for i from 0
+ for x across s
+ when (eql x c) return i))
+
+(defun ert--mismatch (a b)
+ "Return index of first element that differs between A and B.
+
+Like `mismatch'. Uses `equal' for comparison."
+ (cond ((or (listp a) (listp b))
+ (ert--mismatch (ert--coerce-to-vector a)
+ (ert--coerce-to-vector b)))
+ ((> (length a) (length b))
+ (ert--mismatch b a))
+ (t
+ (let ((la (length a))
+ (lb (length b)))
+ (assert (arrayp a) t)
+ (assert (arrayp b) t)
+ (assert (<= la lb) t)
+ (loop for i below la
+ when (not (equal (aref a i) (aref b i))) return i
+ finally (return (if (/= la lb)
+ la
+ (assert (equal a b) t)
+ nil)))))))
+
+(defun ert--subseq (seq start &optional end)
+ "Return a subsequence of SEQ from START to END."
+ (when (char-table-p seq) (error "Not supported"))
+ (let ((vector (substring (ert--coerce-to-vector seq) start end)))
+ (etypecase seq
+ (vector vector)
+ (string (concat vector))
+ (list (append vector nil))
+ (bool-vector (loop with result = (make-bool-vector (length vector) nil)
+ for i below (length vector) do
+ (setf (aref result i) (aref vector i))
+ finally (return result)))
+ (char-table (assert nil)))))
+
+(defun ert-equal-including-properties (a b)
+ "Return t if A and B have similar structure and contents.
+
+This is like `equal-including-properties' except that it compares
+the property values of text properties structurally (by
+recursing) rather than with `eq'. Perhaps this is what
+`equal-including-properties' should do in the first place; see
+Emacs bug 6581 at URL `http://debbugs.gnu.org/cgi/bugreport.cgi?bug=6581'."
+ ;; This implementation is inefficient. Rather than making it
+ ;; efficient, let's hope bug 6581 gets fixed so that we can delete
+ ;; it altogether.
+ (not (ert--explain-not-equal-including-properties a b)))
+
+
+;;; Defining and locating tests.
+
+;; The data structure that represents a test case.
+(defstruct ert-test
+ (name nil)
+ (documentation nil)
+ (body (assert nil))
+ (most-recent-result nil)
+ (expected-result-type ':passed)
+ (tags '()))
+
+(defun ert-test-boundp (symbol)
+ "Return non-nil if SYMBOL names a test."
+ (and (get symbol 'ert--test) t))
+
+(defun ert-get-test (symbol)
+ "If SYMBOL names a test, return that. Signal an error otherwise."
+ (unless (ert-test-boundp symbol) (error "No test named `%S'" symbol))
+ (get symbol 'ert--test))
+
+(defun ert-set-test (symbol definition)
+ "Make SYMBOL name the test DEFINITION, and return DEFINITION."
+ (when (eq symbol 'nil)
+ ;; We disallow nil since `ert-test-at-point' and related functions
+ ;; want to return a test name, but also need an out-of-band value
+ ;; on failure. Nil is the most natural out-of-band value; using 0
+ ;; or "" or signalling an error would be too awkward.
+ ;;
+ ;; Note that nil is still a valid value for the `name' slot in
+ ;; ert-test objects. It designates an anonymous test.
+ (error "Attempt to define a test named nil"))
+ (put symbol 'ert--test definition)
+ definition)
+
+(defun ert-make-test-unbound (symbol)
+ "Make SYMBOL name no test. Return SYMBOL."
+ (ert--remprop symbol 'ert--test)
+ symbol)
+
+(defun ert--parse-keys-and-body (keys-and-body)
+ "Split KEYS-AND-BODY into keyword-and-value pairs and the remaining body.
+
+KEYS-AND-BODY should have the form of a property list, with the
+exception that only keywords are permitted as keys and that the
+tail -- the body -- is a list of forms that does not start with a
+keyword.
+
+Returns a two-element list containing the keys-and-values plist
+and the body."
+ (let ((extracted-key-accu '())
+ (remaining keys-and-body))
+ (while (and (consp remaining) (keywordp (first remaining)))
+ (let ((keyword (pop remaining)))
+ (unless (consp remaining)
+ (error "Value expected after keyword %S in %S"
+ keyword keys-and-body))
+ (when (assoc keyword extracted-key-accu)
+ (warn "Keyword %S appears more than once in %S" keyword
+ keys-and-body))
+ (push (cons keyword (pop remaining)) extracted-key-accu)))
+ (setq extracted-key-accu (nreverse extracted-key-accu))
+ (list (loop for (key . value) in extracted-key-accu
+ collect key
+ collect value)
+ remaining)))
+
+;;;###autoload
+(defmacro* ert-deftest (name () &body docstring-keys-and-body)
+ "Define NAME (a symbol) as a test.
+
+BODY is evaluated as a `progn' when the test is run. It should
+signal a condition on failure or just return if the test passes.
+
+`should', `should-not' and `should-error' are useful for
+assertions in BODY.
+
+Use `ert' to run tests interactively.
+
+Tests that are expected to fail can be marked as such
+using :expected-result. See `ert-test-result-type-p' for a
+description of valid values for RESULT-TYPE.
+
+\(fn NAME () [DOCSTRING] [:expected-result RESULT-TYPE] \
+\[:tags '(TAG...)] BODY...)"
+ (declare (debug (&define :name test
+ name sexp [&optional stringp]
+ [&rest keywordp sexp] def-body))
+ (doc-string 3)
+ (indent 2))
+ (let ((documentation nil)
+ (documentation-supplied-p nil))
+ (when (stringp (first docstring-keys-and-body))
+ (setq documentation (pop docstring-keys-and-body)
+ documentation-supplied-p t))
+ (destructuring-bind ((&key (expected-result nil expected-result-supplied-p)
+ (tags nil tags-supplied-p))
+ body)
+ (ert--parse-keys-and-body docstring-keys-and-body)
+ `(progn
+ (ert-set-test ',name
+ (make-ert-test
+ :name ',name
+ ,@(when documentation-supplied-p
+ `(:documentation ,documentation))
+ ,@(when expected-result-supplied-p
+ `(:expected-result-type ,expected-result))
+ ,@(when tags-supplied-p
+ `(:tags ,tags))
+ :body (lambda () ,@body)))
+ ;; This hack allows `symbol-file' to associate `ert-deftest'
+ ;; forms with files, and therefore enables `find-function' to
+ ;; work with tests. However, it leads to warnings in
+ ;; `unload-feature', which doesn't know how to undefine tests
+ ;; and has no mechanism for extension.
+ (push '(ert-deftest . ,name) current-load-list)
+ ',name))))
+
+;; We use these `put' forms in addition to the (declare (indent)) in
+;; the defmacro form since the `declare' alone does not lead to
+;; correct indentation before the .el/.elc file is loaded.
+;; Autoloading these `put' forms solves this.
+;;;###autoload
+(progn
+ ;; TODO(ohler): Figure out what these mean and make sure they are correct.
+ (put 'ert-deftest 'lisp-indent-function 2)
+ (put 'ert-info 'lisp-indent-function 1))
+
+(defvar ert--find-test-regexp
+ (concat "^\\s-*(ert-deftest"
+ find-function-space-re
+ "%s\\(\\s-\\|$\\)")
+ "The regexp the `find-function' mechanisms use for finding test
definitions.")
+
+
+(put 'ert-test-failed 'error-conditions '(error ert-test-failed))
+(put 'ert-test-failed 'error-message "Test failed")
+
+(defun ert-pass ()
+ "Terminate the current test and mark it passed. Does not return."
+ (throw 'ert--pass nil))
+
+(defun ert-fail (data)
+ "Terminate the current test and mark it failed. Does not return.
+DATA is displayed to the user and should state the reason of the failure."
+ (signal 'ert-test-failed (list data)))
+
+
+;;; The `should' macros.
+
+(defvar ert--should-execution-observer nil)
+
+(defun ert--signal-should-execution (form-description)
+ "Tell the current `should' form observer (if any) about FORM-DESCRIPTION."
+ (when ert--should-execution-observer
+ (funcall ert--should-execution-observer form-description)))
+
+(defun ert--special-operator-p (thing)
+ "Return non-nil if THING is a symbol naming a special operator."
+ (and (symbolp thing)
+ (let ((definition (indirect-function thing t)))
+ (and (subrp definition)
+ (eql (cdr (subr-arity definition)) 'unevalled)))))
+
+(defun ert--expand-should-1 (whole form inner-expander)
+ "Helper function for the `should' macro and its variants."
+ (let ((form
+ ;; If `cl-macroexpand' isn't bound, the code that we're
+ ;; compiling doesn't depend on cl and thus doesn't need an
+ ;; environment arg for `macroexpand'.
+ (if (fboundp 'cl-macroexpand)
+ ;; Suppress warning about run-time call to cl funtion: we
+ ;; only call it if it's fboundp.
+ (with-no-warnings
+ (cl-macroexpand form (and (boundp 'cl-macro-environment)
+ cl-macro-environment)))
+ (macroexpand form))))
+ (cond
+ ((or (atom form) (ert--special-operator-p (car form)))
+ (let ((value (ert--gensym "value-")))
+ `(let ((,value (ert--gensym "ert-form-evaluation-aborted-")))
+ ,(funcall inner-expander
+ `(setq ,value ,form)
+ `(list ',whole :form ',form :value ,value)
+ value)
+ ,value)))
+ (t
+ (let ((fn-name (car form))
+ (arg-forms (cdr form)))
+ (assert (or (symbolp fn-name)
+ (and (consp fn-name)
+ (eql (car fn-name) 'lambda)
+ (listp (cdr fn-name)))))
+ (let ((fn (ert--gensym "fn-"))
+ (args (ert--gensym "args-"))
+ (value (ert--gensym "value-"))
+ (default-value (ert--gensym "ert-form-evaluation-aborted-")))
+ `(let ((,fn (function ,fn-name))
+ (,args (list ,@arg-forms)))
+ (let ((,value ',default-value))
+ ,(funcall inner-expander
+ `(setq ,value (apply ,fn ,args))
+ `(nconc (list ',whole)
+ (list :form `(,,fn ,@,args))
+ (unless (eql ,value ',default-value)
+ (list :value ,value))
+ (let ((-explainer-
+ (and (symbolp ',fn-name)
+ (get ',fn-name 'ert-explainer))))
+ (when -explainer-
+ (list :explanation
+ (apply -explainer- ,args)))))
+ value)
+ ,value))))))))
+
+(defun ert--expand-should (whole form inner-expander)
+ "Helper function for the `should' macro and its variants.
+
+Analyzes FORM and returns an expression that has the same
+semantics under evaluation but records additional debugging
+information.
+
+INNER-EXPANDER should be a function and is called with two
+arguments: INNER-FORM and FORM-DESCRIPTION-FORM, where INNER-FORM
+is an expression equivalent to FORM, and FORM-DESCRIPTION-FORM is
+an expression that returns a description of FORM. INNER-EXPANDER
+should return code that calls INNER-FORM and performs the checks
+and error signalling specific to the particular variant of
+`should'. The code that INNER-EXPANDER returns must not call
+FORM-DESCRIPTION-FORM before it has called INNER-FORM."
+ (lexical-let ((inner-expander inner-expander))
+ (ert--expand-should-1
+ whole form
+ (lambda (inner-form form-description-form value-var)
+ (let ((form-description (ert--gensym "form-description-")))
+ `(let (,form-description)
+ ,(funcall inner-expander
+ `(unwind-protect
+ ,inner-form
+ (setq ,form-description ,form-description-form)
+ (ert--signal-should-execution ,form-description))
+ `,form-description
+ value-var)))))))
+
+(defmacro* should (form)
+ "Evaluate FORM. If it returns nil, abort the current test as failed.
+
+Returns the value of FORM."
+ (ert--expand-should `(should ,form) form
+ (lambda (inner-form form-description-form value-var)
+ `(unless ,inner-form
+ (ert-fail ,form-description-form)))))
+
+(defmacro* should-not (form)
+ "Evaluate FORM. If it returns non-nil, abort the current test as failed.
+
+Returns nil."
+ (ert--expand-should `(should-not ,form) form
+ (lambda (inner-form form-description-form value-var)
+ `(unless (not ,inner-form)
+ (ert-fail ,form-description-form)))))
+
+(defun ert--should-error-handle-error (form-description-fn
+ condition type exclude-subtypes)
+ "Helper function for `should-error'.
+
+Determines whether CONDITION matches TYPE and EXCLUDE-SUBTYPES,
+and aborts the current test as failed if it doesn't."
+ (let ((signalled-conditions (get (car condition) 'error-conditions))
+ (handled-conditions (etypecase type
+ (list type)
+ (symbol (list type)))))
+ (assert signalled-conditions)
+ (unless (ert--intersection signalled-conditions handled-conditions)
+ (ert-fail (append
+ (funcall form-description-fn)
+ (list
+ :condition condition
+ :fail-reason (concat "the error signalled did not"
+ " have the expected type")))))
+ (when exclude-subtypes
+ (unless (member (car condition) handled-conditions)
+ (ert-fail (append
+ (funcall form-description-fn)
+ (list
+ :condition condition
+ :fail-reason (concat "the error signalled was a subtype"
+ " of the expected type"))))))))
+
+;; FIXME: The expansion will evaluate the keyword args (if any) in
+;; nonstandard order.
+(defmacro* should-error (form &rest keys &key type exclude-subtypes)
+ "Evaluate FORM and check that it signals an error.
+
+The error signalled needs to match TYPE. TYPE should be a list
+of condition names. (It can also be a non-nil symbol, which is
+equivalent to a singleton list containing that symbol.) If
+EXCLUDE-SUBTYPES is nil, the error matches TYPE if one of its
+condition names is an element of TYPE. If EXCLUDE-SUBTYPES is
+non-nil, the error matches TYPE if it is an element of TYPE.
+
+If the error matches, returns (ERROR-SYMBOL . DATA) from the
+error. If not, or if no error was signalled, abort the test as
+failed."
+ (unless type (setq type ''error))
+ (ert--expand-should
+ `(should-error ,form ,@keys)
+ form
+ (lambda (inner-form form-description-form value-var)
+ (let ((errorp (ert--gensym "errorp"))
+ (form-description-fn (ert--gensym "form-description-fn-")))
+ `(let ((,errorp nil)
+ (,form-description-fn (lambda () ,form-description-form)))
+ (condition-case -condition-
+ ,inner-form
+ ;; We can't use ,type here because we want to evaluate it.
+ (error
+ (setq ,errorp t)
+ (ert--should-error-handle-error ,form-description-fn
+ -condition-
+ ,type ,exclude-subtypes)
+ (setq ,value-var -condition-)))
+ (unless ,errorp
+ (ert-fail (append
+ (funcall ,form-description-fn)
+ (list
+ :fail-reason "did not signal an error")))))))))
+
+
+;;; Explanation of `should' failures.
+
+;; TODO(ohler): Rework explanations so that they are displayed in a
+;; similar way to `ert-info' messages; in particular, allow text
+;; buttons in explanations that give more detail or open an ediff
+;; buffer. Perhaps explanations should be reported through `ert-info'
+;; rather than as part of the condition.
+
+(defun ert--proper-list-p (x)
+ "Return non-nil if X is a proper list, nil otherwise."
+ (loop
+ for firstp = t then nil
+ for fast = x then (cddr fast)
+ for slow = x then (cdr slow) do
+ (when (null fast) (return t))
+ (when (not (consp fast)) (return nil))
+ (when (null (cdr fast)) (return t))
+ (when (not (consp (cdr fast))) (return nil))
+ (when (and (not firstp) (eq fast slow)) (return nil))))
+
+(defun ert--explain-format-atom (x)
+ "Format the atom X for `ert--explain-not-equal'."
+ (typecase x
+ (fixnum (list x (format "#x%x" x) (format "?%c" x)))
+ (t x)))
+
+(defun ert--explain-not-equal (a b)
+ "Explainer function for `equal'.
+
+Returns a programmer-readable explanation of why A and B are not
+`equal', or nil if they are."
+ (if (not (equal (type-of a) (type-of b)))
+ `(different-types ,a ,b)
+ (etypecase a
+ (cons
+ (let ((a-proper-p (ert--proper-list-p a))
+ (b-proper-p (ert--proper-list-p b)))
+ (if (not (eql (not a-proper-p) (not b-proper-p)))
+ `(one-list-proper-one-improper ,a ,b)
+ (if a-proper-p
+ (if (not (equal (length a) (length b)))
+ `(proper-lists-of-different-length ,(length a) ,(length b)
+ ,a ,b
+ first-mismatch-at
+ ,(ert--mismatch a b))
+ (loop for i from 0
+ for ai in a
+ for bi in b
+ for xi = (ert--explain-not-equal ai bi)
+ do (when xi (return `(list-elt ,i ,xi)))
+ finally (assert (equal a b) t)))
+ (let ((car-x (ert--explain-not-equal (car a) (car b))))
+ (if car-x
+ `(car ,car-x)
+ (let ((cdr-x (ert--explain-not-equal (cdr a) (cdr b))))
+ (if cdr-x
+ `(cdr ,cdr-x)
+ (assert (equal a b) t)
+ nil))))))))
+ (array (if (not (equal (length a) (length b)))
+ `(arrays-of-different-length ,(length a) ,(length b)
+ ,a ,b
+ ,@(unless (char-table-p a)
+ `(first-mismatch-at
+ ,(ert--mismatch a b))))
+ (loop for i from 0
+ for ai across a
+ for bi across b
+ for xi = (ert--explain-not-equal ai bi)
+ do (when xi (return `(array-elt ,i ,xi)))
+ finally (assert (equal a b) t))))
+ (atom (if (not (equal a b))
+ (if (and (symbolp a) (symbolp b) (string= a b))
+ `(different-symbols-with-the-same-name ,a ,b)
+ `(different-atoms ,(ert--explain-format-atom a)
+ ,(ert--explain-format-atom b)))
+ nil)))))
+(put 'equal 'ert-explainer 'ert--explain-not-equal)
+
+(defun ert--significant-plist-keys (plist)
+ "Return the keys of PLIST that have non-null values, in order."
+ (assert (zerop (mod (length plist) 2)) t)
+ (loop for (key value . rest) on plist by #'cddr
+ unless (or (null value) (memq key accu)) collect key into accu
+ finally (return accu)))
+
+(defun ert--plist-difference-explanation (a b)
+ "Return a programmer-readable explanation of why A and B are different
plists.
+
+Returns nil if they are equivalent, i.e., have the same value for
+each key, where absent values are treated as nil. The order of
+key/value pairs in each list does not matter."
+ (assert (zerop (mod (length a) 2)) t)
+ (assert (zerop (mod (length b) 2)) t)
+ ;; Normalizing the plists would be another way to do this but it
+ ;; requires a total ordering on all lisp objects (since any object
+ ;; is valid as a text property key). Perhaps defining such an
+ ;; ordering is useful in other contexts, too, but it's a lot of
+ ;; work, so let's punt on it for now.
+ (let* ((keys-a (ert--significant-plist-keys a))
+ (keys-b (ert--significant-plist-keys b))
+ (keys-in-a-not-in-b (ert--set-difference-eq keys-a keys-b))
+ (keys-in-b-not-in-a (ert--set-difference-eq keys-b keys-a)))
+ (flet ((explain-with-key (key)
+ (let ((value-a (plist-get a key))
+ (value-b (plist-get b key)))
+ (assert (not (equal value-a value-b)) t)
+ `(different-properties-for-key
+ ,key ,(ert--explain-not-equal-including-properties value-a
+
value-b)))))
+ (cond (keys-in-a-not-in-b
+ (explain-with-key (first keys-in-a-not-in-b)))
+ (keys-in-b-not-in-a
+ (explain-with-key (first keys-in-b-not-in-a)))
+ (t
+ (loop for key in keys-a
+ when (not (equal (plist-get a key) (plist-get b key)))
+ return (explain-with-key key)))))))
+
+(defun ert--abbreviate-string (s len suffixp)
+ "Shorten string S to at most LEN chars.
+
+If SUFFIXP is non-nil, returns a suffix of S, otherwise a prefix."
+ (let ((n (length s)))
+ (cond ((< n len)
+ s)
+ (suffixp
+ (substring s (- n len)))
+ (t
+ (substring s 0 len)))))
+
+(defun ert--explain-not-equal-including-properties (a b)
+ "Explainer function for `ert-equal-including-properties'.
+
+Returns a programmer-readable explanation of why A and B are not
+`ert-equal-including-properties', or nil if they are."
+ (if (not (equal a b))
+ (ert--explain-not-equal a b)
+ (assert (stringp a) t)
+ (assert (stringp b) t)
+ (assert (eql (length a) (length b)) t)
+ (loop for i from 0 to (length a)
+ for props-a = (text-properties-at i a)
+ for props-b = (text-properties-at i b)
+ for difference = (ert--plist-difference-explanation props-a props-b)
+ do (when difference
+ (return `(char ,i ,(substring-no-properties a i (1+ i))
+ ,difference
+ context-before
+ ,(ert--abbreviate-string
+ (substring-no-properties a 0 i)
+ 10 t)
+ context-after
+ ,(ert--abbreviate-string
+ (substring-no-properties a (1+ i))
+ 10 nil))))
+ ;; TODO(ohler): Get `equal-including-properties' fixed in
+ ;; Emacs, delete `ert-equal-including-properties', and
+ ;; re-enable this assertion.
+ ;;finally (assert (equal-including-properties a b) t)
+ )))
+(put 'ert-equal-including-properties
+ 'ert-explainer
+ 'ert--explain-not-equal-including-properties)
+
+
+;;; Implementation of `ert-info'.
+
+;; TODO(ohler): The name `info' clashes with
+;; `ert--test-execution-info'. One or both should be renamed.
+(defvar ert--infos '()
+ "The stack of `ert-info' infos that currently apply.
+
+Bound dynamically. This is a list of (PREFIX . MESSAGE) pairs.")
+
+(defmacro* ert-info ((message-form &key ((:prefix prefix-form) "Info: "))
+ &body body)
+ "Evaluate MESSAGE-FORM and BODY, and report the message if BODY fails.
+
+To be used within ERT tests. MESSAGE-FORM should evaluate to a
+string that will be displayed together with the test result if
+the test fails. PREFIX-FORM should evaluate to a string as well
+and is displayed in front of the value of MESSAGE-FORM."
+ (declare (debug ((form &rest [sexp form]) body))
+ (indent 1))
+ `(let ((ert--infos (cons (cons ,prefix-form ,message-form) ert--infos)))
+ ,@body))
+
+
+
+;;; Facilities for running a single test.
+
+(defvar ert-debug-on-error nil
+ "Non-nil means enter debugger when a test fails or terminates with an
error.")
+
+;; The data structures that represent the result of running a test.
+(defstruct ert-test-result
+ (messages nil)
+ (should-forms nil)
+ )
+(defstruct (ert-test-passed (:include ert-test-result)))
+(defstruct (ert-test-result-with-condition (:include ert-test-result))
+ (condition (assert nil))
+ (backtrace (assert nil))
+ (infos (assert nil)))
+(defstruct (ert-test-quit (:include ert-test-result-with-condition)))
+(defstruct (ert-test-failed (:include ert-test-result-with-condition)))
+(defstruct (ert-test-aborted-with-non-local-exit (:include ert-test-result)))
+
+
+(defun ert--record-backtrace ()
+ "Record the current backtrace (as a list) and return it."
+ ;; Since the backtrace is stored in the result object, result
+ ;; objects must only be printed with appropriate limits
+ ;; (`print-level' and `print-length') in place. For interactive
+ ;; use, the cost of ensuring this possibly outweighs the advantage
+ ;; of storing the backtrace for
+ ;; `ert-results-pop-to-backtrace-for-test-at-point' given that we
+ ;; already have `ert-results-rerun-test-debugging-errors-at-point'.
+ ;; For batch use, however, printing the backtrace may be useful.
+ (loop
+ ;; 6 is the number of frames our own debugger adds (when
+ ;; compiled; more when interpreted). FIXME: Need to describe a
+ ;; procedure for determining this constant.
+ for i from 6
+ for frame = (backtrace-frame i)
+ while frame
+ collect frame))
+
+(defun ert--print-backtrace (backtrace)
+ "Format the backtrace BACKTRACE to the current buffer."
+ ;; This is essentially a reimplementation of Fbacktrace
+ ;; (src/eval.c), but for a saved backtrace, not the current one.
+ (let ((print-escape-newlines t)
+ (print-level 8)
+ (print-length 50))
+ (dolist (frame backtrace)
+ (ecase (first frame)
+ ((nil)
+ ;; Special operator.
+ (destructuring-bind (special-operator &rest arg-forms)
+ (cdr frame)
+ (insert
+ (format " %S\n" (list* special-operator arg-forms)))))
+ ((t)
+ ;; Function call.
+ (destructuring-bind (fn &rest args) (cdr frame)
+ (insert (format " %S(" fn))
+ (loop for firstp = t then nil
+ for arg in args do
+ (unless firstp
+ (insert " "))
+ (insert (format "%S" arg)))
+ (insert ")\n")))))))
+
+;; A container for the state of the execution of a single test and
+;; environment data needed during its execution.
+(defstruct ert--test-execution-info
+ (test (assert nil))
+ (result (assert nil))
+ ;; A thunk that may be called when RESULT has been set to its final
+ ;; value and test execution should be terminated. Should not
+ ;; return.
+ (exit-continuation (assert nil))
+ ;; The binding of `debugger' outside of the execution of the test.
+ next-debugger
+ ;; The binding of `ert-debug-on-error' that is in effect for the
+ ;; execution of the current test. We store it to avoid being
+ ;; affected by any new bindings the test itself may establish. (I
+ ;; don't remember whether this feature is important.)
+ ert-debug-on-error)
+
+(defun ert--run-test-debugger (info debugger-args)
+ "During a test run, `debugger' is bound to a closure that calls this
function.
+
+This function records failures and errors and either terminates
+the test silently or calls the interactive debugger, as
+appropriate.
+
+INFO is the ert--test-execution-info corresponding to this test
+run. DEBUGGER-ARGS are the arguments to `debugger'."
+ (destructuring-bind (first-debugger-arg &rest more-debugger-args)
+ debugger-args
+ (ecase first-debugger-arg
+ ((lambda debug t exit nil)
+ (apply (ert--test-execution-info-next-debugger info) debugger-args))
+ (error
+ (let* ((condition (first more-debugger-args))
+ (type (case (car condition)
+ ((quit) 'quit)
+ (otherwise 'failed)))
+ (backtrace (ert--record-backtrace))
+ (infos (reverse ert--infos)))
+ (setf (ert--test-execution-info-result info)
+ (ecase type
+ (quit
+ (make-ert-test-quit :condition condition
+ :backtrace backtrace
+ :infos infos))
+ (failed
+ (make-ert-test-failed :condition condition
+ :backtrace backtrace
+ :infos infos))))
+ ;; Work around Emacs' heuristic (in eval.c) for detecting
+ ;; errors in the debugger.
+ (incf num-nonmacro-input-events)
+ ;; FIXME: We should probably implement more fine-grained
+ ;; control a la non-t `debug-on-error' here.
+ (cond
+ ((ert--test-execution-info-ert-debug-on-error info)
+ (apply (ert--test-execution-info-next-debugger info) debugger-args))
+ (t))
+ (funcall (ert--test-execution-info-exit-continuation info)))))))
+
+(defun ert--run-test-internal (ert-test-execution-info)
+ "Low-level function to run a test according to ERT-TEST-EXECUTION-INFO.
+
+This mainly sets up debugger-related bindings."
+ (lexical-let ((info ert-test-execution-info))
+ (setf (ert--test-execution-info-next-debugger info) debugger
+ (ert--test-execution-info-ert-debug-on-error info)
ert-debug-on-error)
+ (catch 'ert--pass
+ ;; For now, each test gets its own temp buffer and its own
+ ;; window excursion, just to be safe. If this turns out to be
+ ;; too expensive, we can remove it.
+ (with-temp-buffer
+ (save-window-excursion
+ (let ((debugger (lambda (&rest debugger-args)
+ (ert--run-test-debugger info debugger-args)))
+ (debug-on-error t)
+ (debug-on-quit t)
+ ;; FIXME: Do we need to store the old binding of this
+ ;; and consider it in `ert--run-test-debugger'?
+ (debug-ignored-errors nil)
+ (ert--infos '()))
+ (funcall (ert-test-body (ert--test-execution-info-test info))))))
+ (ert-pass))
+ (setf (ert--test-execution-info-result info) (make-ert-test-passed)))
+ nil)
+
+(defun ert--force-message-log-buffer-truncation ()
+ "Immediately truncate *Messages* buffer according to `message-log-max'.
+
+This can be useful after reducing the value of `message-log-max'."
+ (with-current-buffer (get-buffer-create "*Messages*")
+ ;; This is a reimplementation of this part of message_dolog() in xdisp.c:
+ ;; if (NATNUMP (Vmessage_log_max))
+ ;; {
+ ;; scan_newline (Z, Z_BYTE, BEG, BEG_BYTE,
+ ;; -XFASTINT (Vmessage_log_max) - 1, 0);
+ ;; del_range_both (BEG, BEG_BYTE, PT, PT_BYTE, 0);
+ ;; }
+ (when (and (integerp message-log-max) (>= message-log-max 0))
+ (let ((begin (point-min))
+ (end (save-excursion
+ (goto-char (point-max))
+ (forward-line (- message-log-max))
+ (point))))
+ (delete-region begin end)))))
+
+(defvar ert--running-tests nil
+ "List of tests that are currently in execution.
+
+This list is empty while no test is running, has one element
+while a test is running, two elements while a test run from
+inside a test is running, etc. The list is in order of nesting,
+innermost test first.
+
+The elements are of type `ert-test'.")
+
+(defun ert-run-test (ert-test)
+ "Run ERT-TEST.
+
+Returns the result and stores it in ERT-TEST's `most-recent-result' slot."
+ (setf (ert-test-most-recent-result ert-test) nil)
+ (block error
+ (lexical-let ((begin-marker
+ (with-current-buffer (get-buffer-create "*Messages*")
+ (set-marker (make-marker) (point-max)))))
+ (unwind-protect
+ (lexical-let ((info (make-ert--test-execution-info
+ :test ert-test
+ :result
+ (make-ert-test-aborted-with-non-local-exit)
+ :exit-continuation (lambda ()
+ (return-from error nil))))
+ (should-form-accu (list)))
+ (unwind-protect
+ (let ((ert--should-execution-observer
+ (lambda (form-description)
+ (push form-description should-form-accu)))
+ (message-log-max t)
+ (ert--running-tests (cons ert-test ert--running-tests)))
+ (ert--run-test-internal info))
+ (let ((result (ert--test-execution-info-result info)))
+ (setf (ert-test-result-messages result)
+ (with-current-buffer (get-buffer-create "*Messages*")
+ (buffer-substring begin-marker (point-max))))
+ (ert--force-message-log-buffer-truncation)
+ (setq should-form-accu (nreverse should-form-accu))
+ (setf (ert-test-result-should-forms result)
+ should-form-accu)
+ (setf (ert-test-most-recent-result ert-test) result))))
+ (set-marker begin-marker nil))))
+ (ert-test-most-recent-result ert-test))
+
+(defun ert-running-test ()
+ "Return the top-level test currently executing."
+ (car (last ert--running-tests)))
+
+
+;;; Test selectors.
+
+(defun ert-test-result-type-p (result result-type)
+ "Return non-nil if RESULT matches type RESULT-TYPE.
+
+Valid result types:
+
+nil -- Never matches.
+t -- Always matches.
+:failed, :passed -- Matches corresponding results.
+\(and TYPES...\) -- Matches if all TYPES match.
+\(or TYPES...\) -- Matches if some TYPES match.
+\(not TYPE\) -- Matches if TYPE does not match.
+\(satisfies PREDICATE\) -- Matches if PREDICATE returns true when called with
+ RESULT."
+ ;; It would be easy to add `member' and `eql' types etc., but I
+ ;; haven't bothered yet.
+ (etypecase result-type
+ ((member nil) nil)
+ ((member t) t)
+ ((member :failed) (ert-test-failed-p result))
+ ((member :passed) (ert-test-passed-p result))
+ (cons
+ (destructuring-bind (operator &rest operands) result-type
+ (ecase operator
+ (and
+ (case (length operands)
+ (0 t)
+ (t
+ (and (ert-test-result-type-p result (first operands))
+ (ert-test-result-type-p result `(and ,@(rest operands)))))))
+ (or
+ (case (length operands)
+ (0 nil)
+ (t
+ (or (ert-test-result-type-p result (first operands))
+ (ert-test-result-type-p result `(or ,@(rest operands)))))))
+ (not
+ (assert (eql (length operands) 1))
+ (not (ert-test-result-type-p result (first operands))))
+ (satisfies
+ (assert (eql (length operands) 1))
+ (funcall (first operands) result)))))))
+
+(defun ert-test-result-expected-p (test result)
+ "Return non-nil if TEST's expected result type matches RESULT."
+ (ert-test-result-type-p result (ert-test-expected-result-type test)))
+
+(defun ert-select-tests (selector universe)
+ "Return the tests that match SELECTOR.
+
+UNIVERSE specifies the set of tests to select from; it should be
+a list of tests, or t, which refers to all tests named by symbols
+in `obarray'.
+
+Returns the set of tests as a list.
+
+Valid selectors:
+
+nil -- Selects the empty set.
+t -- Selects UNIVERSE.
+:new -- Selects all tests that have not been run yet.
+:failed, :passed -- Select tests according to their most recent result.
+:expected, :unexpected -- Select tests according to their most recent result.
+a string -- Selects all tests that have a name that matches the string,
+ a regexp.
+a test -- Selects that test.
+a symbol -- Selects the test that the symbol names, errors if none.
+\(member TESTS...\) -- Selects TESTS, a list of tests or symbols naming tests.
+\(eql TEST\) -- Selects TEST, a test or a symbol naming a test.
+\(and SELECTORS...\) -- Selects the tests that match all SELECTORS.
+\(or SELECTORS...\) -- Selects the tests that match any SELECTOR.
+\(not SELECTOR\) -- Selects all tests that do not match SELECTOR.
+\(tag TAG) -- Selects all tests that have TAG on their tags list.
+\(satisfies PREDICATE\) -- Selects all tests that satisfy PREDICATE.
+
+Only selectors that require a superset of tests, such
+as (satisfies ...), strings, :new, etc. make use of UNIVERSE.
+Selectors that do not, such as \(member ...\), just return the
+set implied by them without checking whether it is really
+contained in UNIVERSE."
+ ;; This code needs to match the etypecase in
+ ;; `ert-insert-human-readable-selector'.
+ (etypecase selector
+ ((member nil) nil)
+ ((member t) (etypecase universe
+ (list universe)
+ ((member t) (ert-select-tests "" universe))))
+ ((member :new) (ert-select-tests
+ `(satisfies ,(lambda (test)
+ (null (ert-test-most-recent-result test))))
+ universe))
+ ((member :failed) (ert-select-tests
+ `(satisfies ,(lambda (test)
+ (ert-test-result-type-p
+ (ert-test-most-recent-result test)
+ ':failed)))
+ universe))
+ ((member :passed) (ert-select-tests
+ `(satisfies ,(lambda (test)
+ (ert-test-result-type-p
+ (ert-test-most-recent-result test)
+ ':passed)))
+ universe))
+ ((member :expected) (ert-select-tests
+ `(satisfies
+ ,(lambda (test)
+ (ert-test-result-expected-p
+ test
+ (ert-test-most-recent-result test))))
+ universe))
+ ((member :unexpected) (ert-select-tests `(not :expected) universe))
+ (string
+ (etypecase universe
+ ((member t) (mapcar #'ert-get-test
+ (apropos-internal selector #'ert-test-boundp)))
+ (list (ert--remove-if-not (lambda (test)
+ (and (ert-test-name test)
+ (string-match selector
+ (ert-test-name test))))
+ universe))))
+ (ert-test (list selector))
+ (symbol
+ (assert (ert-test-boundp selector))
+ (list (ert-get-test selector)))
+ (cons
+ (destructuring-bind (operator &rest operands) selector
+ (ecase operator
+ (member
+ (mapcar (lambda (purported-test)
+ (etypecase purported-test
+ (symbol (assert (ert-test-boundp purported-test))
+ (ert-get-test purported-test))
+ (ert-test purported-test)))
+ operands))
+ (eql
+ (assert (eql (length operands) 1))
+ (ert-select-tests `(member ,@operands) universe))
+ (and
+ ;; Do these definitions of AND, NOT and OR satisfy de
+ ;; Morgan's laws? Should they?
+ (case (length operands)
+ (0 (ert-select-tests 't universe))
+ (t (ert-select-tests `(and ,@(rest operands))
+ (ert-select-tests (first operands)
+ universe)))))
+ (not
+ (assert (eql (length operands) 1))
+ (let ((all-tests (ert-select-tests 't universe)))
+ (ert--set-difference all-tests
+ (ert-select-tests (first operands)
+ all-tests))))
+ (or
+ (case (length operands)
+ (0 (ert-select-tests 'nil universe))
+ (t (ert--union (ert-select-tests (first operands) universe)
+ (ert-select-tests `(or ,@(rest operands))
+ universe)))))
+ (tag
+ (assert (eql (length operands) 1))
+ (let ((tag (first operands)))
+ (ert-select-tests `(satisfies
+ ,(lambda (test)
+ (member tag (ert-test-tags test))))
+ universe)))
+ (satisfies
+ (assert (eql (length operands) 1))
+ (ert--remove-if-not (first operands)
+ (ert-select-tests 't universe))))))))
+
+(defun ert--insert-human-readable-selector (selector)
+ "Insert a human-readable presentation of SELECTOR into the current buffer."
+ ;; This is needed to avoid printing the (huge) contents of the
+ ;; `backtrace' slot of the result objects in the
+ ;; `most-recent-result' slots of test case objects in (eql ...) or
+ ;; (member ...) selectors.
+ (labels ((rec (selector)
+ ;; This code needs to match the etypecase in `ert-select-tests'.
+ (etypecase selector
+ ((or (member nil t
+ :new :failed :passed
+ :expected :unexpected)
+ string
+ symbol)
+ selector)
+ (ert-test
+ (if (ert-test-name selector)
+ (make-symbol (format "<%S>" (ert-test-name selector)))
+ (make-symbol "<unnamed test>")))
+ (cons
+ (destructuring-bind (operator &rest operands) selector
+ (ecase operator
+ ((member eql and not or)
+ `(,operator ,@(mapcar #'rec operands)))
+ ((member tag satisfies)
+ selector)))))))
+ (insert (format "%S" (rec selector)))))
+
+
+;;; Facilities for running a whole set of tests.
+
+;; The data structure that contains the set of tests being executed
+;; during one particular test run, their results, the state of the
+;; execution, and some statistics.
+;;
+;; The data about results and expected results of tests may seem
+;; redundant here, since the test objects also carry such information.
+;; However, the information in the test objects may be more recent, it
+;; may correspond to a different test run. We need the information
+;; that corresponds to this run in order to be able to update the
+;; statistics correctly when a test is re-run interactively and has a
+;; different result than before.
+(defstruct ert--stats
+ (selector (assert nil))
+ ;; The tests, in order.
+ (tests (assert nil) :type vector)
+ ;; A map of test names (or the test objects themselves for unnamed
+ ;; tests) to indices into the `tests' vector.
+ (test-map (assert nil) :type hash-table)
+ ;; The results of the tests during this run, in order.
+ (test-results (assert nil) :type vector)
+ ;; The start times of the tests, in order, as reported by
+ ;; `current-time'.
+ (test-start-times (assert nil) :type vector)
+ ;; The end times of the tests, in order, as reported by
+ ;; `current-time'.
+ (test-end-times (assert nil) :type vector)
+ (passed-expected 0)
+ (passed-unexpected 0)
+ (failed-expected 0)
+ (failed-unexpected 0)
+ (start-time nil)
+ (end-time nil)
+ (aborted-p nil)
+ (current-test nil)
+ ;; The time at or after which the next redisplay should occur, as a
+ ;; float.
+ (next-redisplay 0.0))
+
+(defun ert-stats-completed-expected (stats)
+ "Return the number of tests in STATS that had expected results."
+ (+ (ert--stats-passed-expected stats)
+ (ert--stats-failed-expected stats)))
+
+(defun ert-stats-completed-unexpected (stats)
+ "Return the number of tests in STATS that had unexpected results."
+ (+ (ert--stats-passed-unexpected stats)
+ (ert--stats-failed-unexpected stats)))
+
+(defun ert-stats-completed (stats)
+ "Number of tests in STATS that have run so far."
+ (+ (ert-stats-completed-expected stats)
+ (ert-stats-completed-unexpected stats)))
+
+(defun ert-stats-total (stats)
+ "Number of tests in STATS, regardless of whether they have run yet."
+ (length (ert--stats-tests stats)))
+
+;; The stats object of the current run, dynamically bound. This is
+;; used for the mode line progress indicator.
+(defvar ert--current-run-stats nil)
+
+(defun ert--stats-test-key (test)
+ "Return the key used for TEST in the test map of ert--stats objects.
+
+Returns the name of TEST if it has one, or TEST itself otherwise."
+ (or (ert-test-name test) test))
+
+(defun ert--stats-set-test-and-result (stats pos test result)
+ "Change STATS by replacing the test at position POS with TEST and RESULT.
+
+Also changes the counters in STATS to match."
+ (let* ((tests (ert--stats-tests stats))
+ (results (ert--stats-test-results stats))
+ (old-test (aref tests pos))
+ (map (ert--stats-test-map stats)))
+ (flet ((update (d)
+ (if (ert-test-result-expected-p (aref tests pos)
+ (aref results pos))
+ (etypecase (aref results pos)
+ (ert-test-passed (incf (ert--stats-passed-expected stats)
d))
+ (ert-test-failed (incf (ert--stats-failed-expected stats)
d))
+ (null)
+ (ert-test-aborted-with-non-local-exit))
+ (etypecase (aref results pos)
+ (ert-test-passed (incf (ert--stats-passed-unexpected stats)
d))
+ (ert-test-failed (incf (ert--stats-failed-unexpected stats)
d))
+ (null)
+ (ert-test-aborted-with-non-local-exit)))))
+ ;; Adjust counters to remove the result that is currently in stats.
+ (update -1)
+ ;; Put new test and result into stats.
+ (setf (aref tests pos) test
+ (aref results pos) result)
+ (remhash (ert--stats-test-key old-test) map)
+ (setf (gethash (ert--stats-test-key test) map) pos)
+ ;; Adjust counters to match new result.
+ (update +1)
+ nil)))
+
+(defun ert--make-stats (tests selector)
+ "Create a new `ert--stats' object for running TESTS.
+
+SELECTOR is the selector that was used to select TESTS."
+ (setq tests (ert--coerce-to-vector tests))
+ (let ((map (make-hash-table :size (length tests))))
+ (loop for i from 0
+ for test across tests
+ for key = (ert--stats-test-key test) do
+ (assert (not (gethash key map)))
+ (setf (gethash key map) i))
+ (make-ert--stats :selector selector
+ :tests tests
+ :test-map map
+ :test-results (make-vector (length tests) nil)
+ :test-start-times (make-vector (length tests) nil)
+ :test-end-times (make-vector (length tests) nil))))
+
+(defun ert-run-or-rerun-test (stats test listener)
+ ;; checkdoc-order: nil
+ "Run the single test TEST and record the result using STATS and LISTENER."
+ (let ((ert--current-run-stats stats)
+ (pos (ert--stats-test-pos stats test)))
+ (ert--stats-set-test-and-result stats pos test nil)
+ ;; Call listener after setting/before resetting
+ ;; (ert--stats-current-test stats); the listener might refresh the
+ ;; mode line display, and if the value is not set yet/any more
+ ;; during this refresh, the mode line will flicker unnecessarily.
+ (setf (ert--stats-current-test stats) test)
+ (funcall listener 'test-started stats test)
+ (setf (ert-test-most-recent-result test) nil)
+ (setf (aref (ert--stats-test-start-times stats) pos) (current-time))
+ (unwind-protect
+ (ert-run-test test)
+ (setf (aref (ert--stats-test-end-times stats) pos) (current-time))
+ (let ((result (ert-test-most-recent-result test)))
+ (ert--stats-set-test-and-result stats pos test result)
+ (funcall listener 'test-ended stats test result))
+ (setf (ert--stats-current-test stats) nil))))
+
+(defun ert-run-tests (selector listener)
+ "Run the tests specified by SELECTOR, sending progress updates to LISTENER."
+ (let* ((tests (ert-select-tests selector t))
+ (stats (ert--make-stats tests selector)))
+ (setf (ert--stats-start-time stats) (current-time))
+ (funcall listener 'run-started stats)
+ (let ((abortedp t))
+ (unwind-protect
+ (let ((ert--current-run-stats stats))
+ (force-mode-line-update)
+ (unwind-protect
+ (progn
+ (loop for test in tests do
+ (ert-run-or-rerun-test stats test listener))
+ (setq abortedp nil))
+ (setf (ert--stats-aborted-p stats) abortedp)
+ (setf (ert--stats-end-time stats) (current-time))
+ (funcall listener 'run-ended stats abortedp)))
+ (force-mode-line-update))
+ stats)))
+
+(defun ert--stats-test-pos (stats test)
+ ;; checkdoc-order: nil
+ "Return the position (index) of TEST in the run represented by STATS."
+ (gethash (ert--stats-test-key test) (ert--stats-test-map stats)))
+
+
+;;; Formatting functions shared across UIs.
+
+(defun ert--format-time-iso8601 (time)
+ "Format TIME in the variant of ISO 8601 used for timestamps in ERT."
+ (format-time-string "%Y-%m-%d %T%z" time))
+
+(defun ert-char-for-test-result (result expectedp)
+ "Return a character that represents the test result RESULT.
+
+EXPECTEDP specifies whether the result was expected."
+ (let ((s (etypecase result
+ (ert-test-passed ".P")
+ (ert-test-failed "fF")
+ (null "--")
+ (ert-test-aborted-with-non-local-exit "aA"))))
+ (elt s (if expectedp 0 1))))
+
+(defun ert-string-for-test-result (result expectedp)
+ "Return a string that represents the test result RESULT.
+
+EXPECTEDP specifies whether the result was expected."
+ (let ((s (etypecase result
+ (ert-test-passed '("passed" "PASSED"))
+ (ert-test-failed '("failed" "FAILED"))
+ (null '("unknown" "UNKNOWN"))
+ (ert-test-aborted-with-non-local-exit '("aborted" "ABORTED")))))
+ (elt s (if expectedp 0 1))))
+
+(defun ert--pp-with-indentation-and-newline (object)
+ "Pretty-print OBJECT, indenting it to the current column of point.
+Ensures a final newline is inserted."
+ (let ((begin (point)))
+ (pp object (current-buffer))
+ (unless (bolp) (insert "\n"))
+ (save-excursion
+ (goto-char begin)
+ (indent-sexp))))
+
+(defun ert--insert-infos (result)
+ "Insert `ert-info' infos from RESULT into current buffer.
+
+RESULT must be an `ert-test-result-with-condition'."
+ (check-type result ert-test-result-with-condition)
+ (dolist (info (ert-test-result-with-condition-infos result))
+ (destructuring-bind (prefix . message) info
+ (let ((begin (point))
+ (indentation (make-string (+ (length prefix) 4) ?\s))
+ (end nil))
+ (unwind-protect
+ (progn
+ (insert message "\n")
+ (setq end (copy-marker (point)))
+ (goto-char begin)
+ (insert " " prefix)
+ (forward-line 1)
+ (while (< (point) end)
+ (insert indentation)
+ (forward-line 1)))
+ (when end (set-marker end nil)))))))
+
+
+;;; Running tests in batch mode.
+
+(defvar ert-batch-backtrace-right-margin 70
+ "*The maximum line length for printing backtraces in `ert-run-tests-batch'.")
+
+;;;###autoload
+(defun ert-run-tests-batch (&optional selector)
+ "Run the tests specified by SELECTOR, printing results to the terminal.
+
+SELECTOR works as described in `ert-select-tests', except if
+SELECTOR is nil, in which case all tests rather than none will be
+run; this makes the command line \"emacs -batch -l my-tests.el -f
+ert-run-tests-batch-and-exit\" useful.
+
+Returns the stats object."
+ (unless selector (setq selector 't))
+ (ert-run-tests
+ selector
+ (lambda (event-type &rest event-args)
+ (ecase event-type
+ (run-started
+ (destructuring-bind (stats) event-args
+ (message "Running %s tests (%s)"
+ (length (ert--stats-tests stats))
+ (ert--format-time-iso8601 (ert--stats-start-time stats)))))
+ (run-ended
+ (destructuring-bind (stats abortedp) event-args
+ (let ((unexpected (ert-stats-completed-unexpected stats))
+ (expected-failures (ert--stats-failed-expected stats)))
+ (message "\n%sRan %s tests, %s results as expected%s (%s)%s\n"
+ (if (not abortedp)
+ ""
+ "Aborted: ")
+ (ert-stats-total stats)
+ (ert-stats-completed-expected stats)
+ (if (zerop unexpected)
+ ""
+ (format ", %s unexpected" unexpected))
+ (ert--format-time-iso8601 (ert--stats-end-time stats))
+ (if (zerop expected-failures)
+ ""
+ (format "\n%s expected failures" expected-failures)))
+ (unless (zerop unexpected)
+ (message "%s unexpected results:" unexpected)
+ (loop for test across (ert--stats-tests stats)
+ for result = (ert-test-most-recent-result test) do
+ (when (not (ert-test-result-expected-p test result))
+ (message "%9s %S"
+ (ert-string-for-test-result result nil)
+ (ert-test-name test))))
+ (message "%s" "")))))
+ (test-started
+ )
+ (test-ended
+ (destructuring-bind (stats test result) event-args
+ (unless (ert-test-result-expected-p test result)
+ (etypecase result
+ (ert-test-passed
+ (message "Test %S passed unexpectedly" (ert-test-name test)))
+ (ert-test-result-with-condition
+ (message "Test %S backtrace:" (ert-test-name test))
+ (with-temp-buffer
+ (ert--print-backtrace
(ert-test-result-with-condition-backtrace
+ result))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (let ((start (point))
+ (end (progn (end-of-line) (point))))
+ (setq end (min end
+ (+ start
ert-batch-backtrace-right-margin)))
+ (message "%s" (buffer-substring-no-properties
+ start end)))
+ (forward-line 1)))
+ (with-temp-buffer
+ (ert--insert-infos result)
+ (insert " ")
+ (let ((print-escape-newlines t)
+ (print-level 5)
+ (print-length 10))
+ (let ((begin (point)))
+ (ert--pp-with-indentation-and-newline
+ (ert-test-result-with-condition-condition result))))
+ (goto-char (1- (point-max)))
+ (assert (looking-at "\n"))
+ (delete-char 1)
+ (message "Test %S condition:" (ert-test-name test))
+ (message "%s" (buffer-string))))
+ (ert-test-aborted-with-non-local-exit
+ (message "Test %S aborted with non-local exit"
+ (ert-test-name test)))))
+ (let* ((max (prin1-to-string (length (ert--stats-tests stats))))
+ (format-string (concat "%9s %"
+ (prin1-to-string (length max))
+ "s/" max " %S")))
+ (message format-string
+ (ert-string-for-test-result result
+ (ert-test-result-expected-p
+ test result))
+ (1+ (ert--stats-test-pos stats test))
+ (ert-test-name test)))))))))
+
+;;;###autoload
+(defun ert-run-tests-batch-and-exit (&optional selector)
+ "Like `ert-run-tests-batch', but exits Emacs when done.
+
+The exit status will be 0 if all test results were as expected, 1
+on unexpected results, or 2 if the framework detected an error
+outside of the tests (e.g. invalid SELECTOR or bug in the code
+that runs the tests)."
+ (unwind-protect
+ (let ((stats (ert-run-tests-batch selector)))
+ (kill-emacs (if (zerop (ert-stats-completed-unexpected stats)) 0 1)))
+ (unwind-protect
+ (progn
+ (message "Error running tests")
+ (backtrace))
+ (kill-emacs 2))))
+
+
+;;; Utility functions for load/unload actions.
+
+(defun ert--activate-font-lock-keywords ()
+ "Activate font-lock keywords for some of ERT's symbols."
+ (font-lock-add-keywords
+ nil
+ '(("(\\(\\<ert-deftest\\)\\>\\s *\\(\\sw+\\)?"
+ (1 font-lock-keyword-face nil t)
+ (2 font-lock-function-name-face nil t)))))
+
+(defun* ert--remove-from-list (list-var element &key key test)
+ "Remove ELEMENT from the value of LIST-VAR if present.
+
+This can be used as an inverse of `add-to-list'."
+ (unless key (setq key #'identity))
+ (unless test (setq test #'equal))
+ (setf (symbol-value list-var)
+ (ert--remove* element
+ (symbol-value list-var)
+ :key key
+ :test test)))
+
+
+;;; Some basic interactive functions.
+
+(defun ert-read-test-name (prompt &optional default history
+ add-default-to-prompt)
+ "Read the name of a test and return it as a symbol.
+
+Prompt with PROMPT. If DEFAULT is a valid test name, use it as a
+default. HISTORY is the history to use; see `completing-read'.
+If ADD-DEFAULT-TO-PROMPT is non-nil, PROMPT will be modified to
+include the default, if any.
+
+Signals an error if no test name was read."
+ (etypecase default
+ (string (let ((symbol (intern-soft default)))
+ (unless (and symbol (ert-test-boundp symbol))
+ (setq default nil))))
+ (symbol (setq default
+ (if (ert-test-boundp default)
+ (symbol-name default)
+ nil)))
+ (ert-test (setq default (ert-test-name default))))
+ (when add-default-to-prompt
+ (setq prompt (if (null default)
+ (format "%s: " prompt)
+ (format "%s (default %s): " prompt default))))
+ (let ((input (completing-read prompt obarray #'ert-test-boundp
+ t nil history default nil)))
+ ;; completing-read returns an empty string if default was nil and
+ ;; the user just hit enter.
+ (let ((sym (intern-soft input)))
+ (if (ert-test-boundp sym)
+ sym
+ (error "Input does not name a test")))))
+
+(defun ert-read-test-name-at-point (prompt)
+ "Read the name of a test and return it as a symbol.
+As a default, use the symbol at point, or the test at point if in
+the ERT results buffer. Prompt with PROMPT, augmented with the
+default (if any)."
+ (ert-read-test-name prompt (ert-test-at-point) nil t))
+
+(defun ert-find-test-other-window (test-name)
+ "Find, in another window, the definition of TEST-NAME."
+ (interactive (list (ert-read-test-name-at-point "Find test definition: ")))
+ (find-function-do-it test-name 'ert-deftest 'switch-to-buffer-other-window))
+
+(defun ert-delete-test (test-name)
+ "Make the test TEST-NAME unbound.
+
+Nothing more than an interactive interface to `ert-make-test-unbound'."
+ (interactive (list (ert-read-test-name-at-point "Delete test")))
+ (ert-make-test-unbound test-name))
+
+(defun ert-delete-all-tests ()
+ "Make all symbols in `obarray' name no test."
+ (interactive)
+ (when (interactive-p)
+ (unless (y-or-n-p "Delete all tests? ")
+ (error "Aborted")))
+ ;; We can't use `ert-select-tests' here since that gives us only
+ ;; test objects, and going from them back to the test name symbols
+ ;; can fail if the `ert-test' defstruct has been redefined.
+ (mapc #'ert-make-test-unbound (apropos-internal "" #'ert-test-boundp))
+ t)
+
+
+;;; Display of test progress and results.
+
+;; An entry in the results buffer ewoc. There is one entry per test.
+(defstruct ert--ewoc-entry
+ (test (assert nil))
+ ;; If the result of this test was expected, its ewoc entry is hidden
+ ;; initially.
+ (hidden-p (assert nil))
+ ;; An ewoc entry may be collapsed to hide details such as the error
+ ;; condition.
+ ;;
+ ;; I'm not sure the ability to expand and collapse entries is still
+ ;; a useful feature.
+ (expanded-p t)
+ ;; By default, the ewoc entry presents the error condition with
+ ;; certain limits on how much to print (`print-level',
+ ;; `print-length'). The user can interactively switch to a set of
+ ;; higher limits.
+ (extended-printer-limits-p nil))
+
+;; Variables local to the results buffer.
+
+;; The ewoc.
+(defvar ert--results-ewoc)
+;; The stats object.
+(defvar ert--results-stats)
+;; A string with one character per test. Each character represents
+;; the result of the corresponding test. The string is displayed near
+;; the top of the buffer and serves as a progress bar.
+(defvar ert--results-progress-bar-string)
+;; The position where the progress bar button begins.
+(defvar ert--results-progress-bar-button-begin)
+;; The test result listener that updates the buffer when tests are run.
+(defvar ert--results-listener)
+
+(defun ert-insert-test-name-button (test-name)
+ "Insert a button that links to TEST-NAME."
+ (insert-text-button (format "%S" test-name)
+ :type 'ert--test-name-button
+ 'ert-test-name test-name))
+
+(defun ert--results-format-expected-unexpected (expected unexpected)
+ "Return a string indicating EXPECTED expected results, UNEXPECTED
unexpected."
+ (if (zerop unexpected)
+ (format "%s" expected)
+ (format "%s (%s unexpected)" (+ expected unexpected) unexpected)))
+
+(defun ert--results-update-ewoc-hf (ewoc stats)
+ "Update the header and footer of EWOC to show certain information from STATS.
+
+Also sets `ert--results-progress-bar-button-begin'."
+ (let ((run-count (ert-stats-completed stats))
+ (results-buffer (current-buffer))
+ ;; Need to save buffer-local value.
+ (font-lock font-lock-mode))
+ (ewoc-set-hf
+ ewoc
+ ;; header
+ (with-temp-buffer
+ (insert "Selector: ")
+ (ert--insert-human-readable-selector (ert--stats-selector stats))
+ (insert "\n")
+ (insert
+ (format (concat "Passed: %s\n"
+ "Failed: %s\n"
+ "Total: %s/%s\n\n")
+ (ert--results-format-expected-unexpected
+ (ert--stats-passed-expected stats)
+ (ert--stats-passed-unexpected stats))
+ (ert--results-format-expected-unexpected
+ (ert--stats-failed-expected stats)
+ (ert--stats-failed-unexpected stats))
+ run-count
+ (ert-stats-total stats)))
+ (insert
+ (format "Started at: %s\n"
+ (ert--format-time-iso8601 (ert--stats-start-time stats))))
+ ;; FIXME: This is ugly. Need to properly define invariants of
+ ;; the `stats' data structure.
+ (let ((state (cond ((ert--stats-aborted-p stats) 'aborted)
+ ((ert--stats-current-test stats) 'running)
+ ((ert--stats-end-time stats) 'finished)
+ (t 'preparing))))
+ (ecase state
+ (preparing
+ (insert ""))
+ (aborted
+ (cond ((ert--stats-current-test stats)
+ (insert "Aborted during test: ")
+ (ert-insert-test-name-button
+ (ert-test-name (ert--stats-current-test stats))))
+ (t
+ (insert "Aborted."))))
+ (running
+ (assert (ert--stats-current-test stats))
+ (insert "Running test: ")
+ (ert-insert-test-name-button (ert-test-name
+ (ert--stats-current-test stats))))
+ (finished
+ (assert (not (ert--stats-current-test stats)))
+ (insert "Finished.")))
+ (insert "\n")
+ (if (ert--stats-end-time stats)
+ (insert
+ (format "%s%s\n"
+ (if (ert--stats-aborted-p stats)
+ "Aborted at: "
+ "Finished at: ")
+ (ert--format-time-iso8601 (ert--stats-end-time stats))))
+ (insert "\n"))
+ (insert "\n"))
+ (let ((progress-bar-string (with-current-buffer results-buffer
+ ert--results-progress-bar-string)))
+ (let ((progress-bar-button-begin
+ (insert-text-button progress-bar-string
+ :type 'ert--results-progress-bar-button
+ 'face (or (and font-lock
+ (ert-face-for-stats stats))
+ 'button))))
+ ;; The header gets copied verbatim to the results buffer,
+ ;; and all positions remain the same, so
+ ;; `progress-bar-button-begin' will be the right position
+ ;; even in the results buffer.
+ (with-current-buffer results-buffer
+ (set (make-local-variable 'ert--results-progress-bar-button-begin)
+ progress-bar-button-begin))))
+ (insert "\n\n")
+ (buffer-string))
+ ;; footer
+ ;;
+ ;; We actually want an empty footer, but that would trigger a bug
+ ;; in ewoc, sometimes clearing the entire buffer. (It's possible
+ ;; that this bug has been fixed since this has been tested; we
+ ;; should test it again.)
+ "\n")))
+
+
+(defvar ert-test-run-redisplay-interval-secs .1
+ "How many seconds ERT should wait between redisplays while running tests.
+
+While running tests, ERT shows the current progress, and this variable
+determines how frequently the progress display is updated.")
+
+(defun ert--results-update-stats-display (ewoc stats)
+ "Update EWOC and the mode line to show data from STATS."
+ ;; TODO(ohler): investigate using `make-progress-reporter'.
+ (ert--results-update-ewoc-hf ewoc stats)
+ (force-mode-line-update)
+ (redisplay t)
+ (setf (ert--stats-next-redisplay stats)
+ (+ (float-time) ert-test-run-redisplay-interval-secs)))
+
+(defun ert--results-update-stats-display-maybe (ewoc stats)
+ "Call `ert--results-update-stats-display' if not called recently.
+
+EWOC and STATS are arguments for `ert--results-update-stats-display'."
+ (when (>= (float-time) (ert--stats-next-redisplay stats))
+ (ert--results-update-stats-display ewoc stats)))
+
+(defun ert--tests-running-mode-line-indicator ()
+ "Return a string for the mode line that shows the test run progress."
+ (let* ((stats ert--current-run-stats)
+ (tests-total (ert-stats-total stats))
+ (tests-completed (ert-stats-completed stats)))
+ (if (>= tests-completed tests-total)
+ (format " ERT(%s/%s,finished)" tests-completed tests-total)
+ (format " ERT(%s/%s):%s"
+ (1+ tests-completed)
+ tests-total
+ (if (null (ert--stats-current-test stats))
+ "?"
+ (format "%S"
+ (ert-test-name (ert--stats-current-test stats))))))))
+
+(defun ert--make-xrefs-region (begin end)
+ "Attach cross-references to function names between BEGIN and END.
+
+BEGIN and END specify a region in the current buffer."
+ (save-excursion
+ (save-restriction
+ (narrow-to-region begin (point))
+ ;; Inhibit optimization in `debugger-make-xrefs' that would
+ ;; sometimes insert unrelated backtrace info into our buffer.
+ (let ((debugger-previous-backtrace nil))
+ (debugger-make-xrefs)))))
+
+(defun ert--string-first-line (s)
+ "Return the first line of S, or S if it contains no newlines.
+
+The return value does not include the line terminator."
+ (substring s 0 (ert--string-position ?\n s)))
+
+(defun ert-face-for-test-result (expectedp)
+ "Return a face that shows whether a test result was expected or unexpected.
+
+If EXPECTEDP is nil, returns the face for unexpected results; if
+non-nil, returns the face for expected results.."
+ (if expectedp 'ert-test-result-expected 'ert-test-result-unexpected))
+
+(defun ert-face-for-stats (stats)
+ "Return a face that represents STATS."
+ (cond ((ert--stats-aborted-p stats) 'nil)
+ ((plusp (ert-stats-completed-unexpected stats))
+ (ert-face-for-test-result nil))
+ ((eql (ert-stats-completed-expected stats) (ert-stats-total stats))
+ (ert-face-for-test-result t))
+ (t 'nil)))
+
+(defun ert--print-test-for-ewoc (entry)
+ "The ewoc print function for ewoc test entries. ENTRY is the entry to
print."
+ (let* ((test (ert--ewoc-entry-test entry))
+ (stats ert--results-stats)
+ (result (let ((pos (ert--stats-test-pos stats test)))
+ (assert pos)
+ (aref (ert--stats-test-results stats) pos)))
+ (hiddenp (ert--ewoc-entry-hidden-p entry))
+ (expandedp (ert--ewoc-entry-expanded-p entry))
+ (extended-printer-limits-p (ert--ewoc-entry-extended-printer-limits-p
+ entry)))
+ (cond (hiddenp)
+ (t
+ (let ((expectedp (ert-test-result-expected-p test result)))
+ (insert-text-button (format "%c" (ert-char-for-test-result
+ result expectedp))
+ :type 'ert--results-expand-collapse-button
+ 'face (or (and font-lock-mode
+ (ert-face-for-test-result
+ expectedp))
+ 'button)))
+ (insert " ")
+ (ert-insert-test-name-button (ert-test-name test))
+ (insert "\n")
+ (when (and expandedp (not (eql result 'nil)))
+ (when (ert-test-documentation test)
+ (insert " "
+ (propertize
+ (ert--string-first-line (ert-test-documentation test))
+ 'font-lock-face 'font-lock-doc-face)
+ "\n"))
+ (etypecase result
+ (ert-test-passed
+ (if (ert-test-result-expected-p test result)
+ (insert " passed\n")
+ (insert " passed unexpectedly\n"))
+ (insert ""))
+ (ert-test-result-with-condition
+ (ert--insert-infos result)
+ (let ((print-escape-newlines t)
+ (print-level (if extended-printer-limits-p 12 6))
+ (print-length (if extended-printer-limits-p 100 10)))
+ (insert " ")
+ (let ((begin (point)))
+ (ert--pp-with-indentation-and-newline
+ (ert-test-result-with-condition-condition result))
+ (ert--make-xrefs-region begin (point)))))
+ (ert-test-aborted-with-non-local-exit
+ (insert " aborted\n")))
+ (insert "\n")))))
+ nil)
+
+(defun ert--results-font-lock-function (enabledp)
+ "Redraw the ERT results buffer after font-lock-mode was switched on or off.
+
+ENABLEDP is true if font-lock-mode is switched on, false
+otherwise."
+ (ert--results-update-ewoc-hf ert--results-ewoc ert--results-stats)
+ (ewoc-refresh ert--results-ewoc)
+ (font-lock-default-function enabledp))
+
+(defun ert--setup-results-buffer (stats listener buffer-name)
+ "Set up a test results buffer.
+
+STATS is the stats object; LISTENER is the results listener;
+BUFFER-NAME, if non-nil, is the buffer name to use."
+ (unless buffer-name (setq buffer-name "*ert*"))
+ (let ((buffer (get-buffer-create buffer-name)))
+ (with-current-buffer buffer
+ (setq buffer-read-only t)
+ (let ((inhibit-read-only t))
+ (buffer-disable-undo)
+ (erase-buffer)
+ (ert-results-mode)
+ ;; Erase buffer again in case switching out of the previous
+ ;; mode inserted anything. (This happens e.g. when switching
+ ;; from ert-results-mode to ert-results-mode when
+ ;; font-lock-mode turns itself off in change-major-mode-hook.)
+ (erase-buffer)
+ (set (make-local-variable 'font-lock-function)
+ 'ert--results-font-lock-function)
+ (let ((ewoc (ewoc-create 'ert--print-test-for-ewoc nil nil t)))
+ (set (make-local-variable 'ert--results-ewoc) ewoc)
+ (set (make-local-variable 'ert--results-stats) stats)
+ (set (make-local-variable 'ert--results-progress-bar-string)
+ (make-string (ert-stats-total stats)
+ (ert-char-for-test-result nil t)))
+ (set (make-local-variable 'ert--results-listener) listener)
+ (loop for test across (ert--stats-tests stats) do
+ (ewoc-enter-last ewoc
+ (make-ert--ewoc-entry :test test :hidden-p
t)))
+ (ert--results-update-ewoc-hf ert--results-ewoc ert--results-stats)
+ (goto-char (1- (point-max)))
+ buffer)))))
+
+
+(defvar ert--selector-history nil
+ "List of recent test selectors read from terminal.")
+
+;; Should OUTPUT-BUFFER-NAME and MESSAGE-FN really be arguments here?
+;; They are needed only for our automated self-tests at the moment.
+;; Or should there be some other mechanism?
+;;;###autoload
+(defun ert-run-tests-interactively (selector
+ &optional output-buffer-name message-fn)
+ "Run the tests specified by SELECTOR and display the results in a buffer.
+
+SELECTOR works as described in `ert-select-tests'.
+OUTPUT-BUFFER-NAME and MESSAGE-FN should normally be nil; they
+are used for automated self-tests and specify which buffer to use
+and how to display message."
+ (interactive
+ (list (let ((default (if ert--selector-history
+ ;; Can't use `first' here as this form is
+ ;; not compiled, and `first' is not
+ ;; defined without cl.
+ (car ert--selector-history)
+ "t")))
+ (read-from-minibuffer (if (null default)
+ "Run tests: "
+ (format "Run tests (default %s): " default))
+ nil nil t 'ert--selector-history
+ default nil))
+ nil))
+ (unless message-fn (setq message-fn 'message))
+ (lexical-let ((output-buffer-name output-buffer-name)
+ buffer
+ listener
+ (message-fn message-fn))
+ (setq listener
+ (lambda (event-type &rest event-args)
+ (ecase event-type
+ (run-started
+ (destructuring-bind (stats) event-args
+ (setq buffer (ert--setup-results-buffer stats
+ listener
+ output-buffer-name))
+ (pop-to-buffer buffer)))
+ (run-ended
+ (destructuring-bind (stats abortedp) event-args
+ (funcall message-fn
+ "%sRan %s tests, %s results were as expected%s"
+ (if (not abortedp)
+ ""
+ "Aborted: ")
+ (ert-stats-total stats)
+ (ert-stats-completed-expected stats)
+ (let ((unexpected
+ (ert-stats-completed-unexpected stats)))
+ (if (zerop unexpected)
+ ""
+ (format ", %s unexpected" unexpected))))
+ (ert--results-update-stats-display (with-current-buffer buffer
+ ert--results-ewoc)
+ stats)))
+ (test-started
+ (destructuring-bind (stats test) event-args
+ (with-current-buffer buffer
+ (let* ((ewoc ert--results-ewoc)
+ (pos (ert--stats-test-pos stats test))
+ (node (ewoc-nth ewoc pos)))
+ (assert node)
+ (setf (ert--ewoc-entry-test (ewoc-data node)) test)
+ (aset ert--results-progress-bar-string pos
+ (ert-char-for-test-result nil t))
+ (ert--results-update-stats-display-maybe ewoc stats)
+ (ewoc-invalidate ewoc node)))))
+ (test-ended
+ (destructuring-bind (stats test result) event-args
+ (with-current-buffer buffer
+ (let* ((ewoc ert--results-ewoc)
+ (pos (ert--stats-test-pos stats test))
+ (node (ewoc-nth ewoc pos)))
+ (when (ert--ewoc-entry-hidden-p (ewoc-data node))
+ (setf (ert--ewoc-entry-hidden-p (ewoc-data node))
+ (ert-test-result-expected-p test result)))
+ (aset ert--results-progress-bar-string pos
+ (ert-char-for-test-result result
+
(ert-test-result-expected-p
+ test result)))
+ (ert--results-update-stats-display-maybe ewoc stats)
+ (ewoc-invalidate ewoc node))))))))
+ (ert-run-tests
+ selector
+ listener)))
+;;;###autoload
+(defalias 'ert 'ert-run-tests-interactively)
+
+
+;;; Simple view mode for auxiliary information like stack traces or
+;;; messages. Mainly binds "q" for quit.
+
+(define-derived-mode ert-simple-view-mode fundamental-mode "ERT-View"
+ "Major mode for viewing auxiliary information in ERT.")
+
+(loop for (key binding) in
+ '(("q" quit-window)
+ )
+ do
+ (define-key ert-simple-view-mode-map key binding))
+
+
+;;; Commands and button actions for the results buffer.
+
+(define-derived-mode ert-results-mode fundamental-mode "ERT-Results"
+ "Major mode for viewing results of ERT test runs.")
+
+(loop for (key binding) in
+ '(;; Stuff that's not in the menu.
+ ("\t" forward-button)
+ ([backtab] backward-button)
+ ("j" ert-results-jump-between-summary-and-result)
+ ("q" quit-window)
+ ("L" ert-results-toggle-printer-limits-for-test-at-point)
+ ("n" ert-results-next-test)
+ ("p" ert-results-previous-test)
+ ;; Stuff that is in the menu.
+ ("R" ert-results-rerun-all-tests)
+ ("r" ert-results-rerun-test-at-point)
+ ("d" ert-results-rerun-test-at-point-debugging-errors)
+ ("." ert-results-find-test-at-point-other-window)
+ ("b" ert-results-pop-to-backtrace-for-test-at-point)
+ ("m" ert-results-pop-to-messages-for-test-at-point)
+ ("l" ert-results-pop-to-should-forms-for-test-at-point)
+ ("h" ert-results-describe-test-at-point)
+ ("D" ert-delete-test)
+ ("T" ert-results-pop-to-timings)
+ )
+ do
+ (define-key ert-results-mode-map key binding))
+
+(easy-menu-define ert-results-mode-menu ert-results-mode-map
+ "Menu for `ert-results-mode'."
+ '("ERT Results"
+ ["Re-run all tests" ert-results-rerun-all-tests]
+ "--"
+ ["Re-run test" ert-results-rerun-test-at-point]
+ ["Debug test" ert-results-rerun-test-at-point-debugging-errors]
+ ["Show test definition" ert-results-find-test-at-point-other-window]
+ "--"
+ ["Show backtrace" ert-results-pop-to-backtrace-for-test-at-point]
+ ["Show messages" ert-results-pop-to-messages-for-test-at-point]
+ ["Show `should' forms" ert-results-pop-to-should-forms-for-test-at-point]
+ ["Describe test" ert-results-describe-test-at-point]
+ "--"
+ ["Delete test" ert-delete-test]
+ "--"
+ ["Show execution time of each test" ert-results-pop-to-timings]
+ ))
+
+(define-button-type 'ert--results-progress-bar-button
+ 'action #'ert--results-progress-bar-button-action
+ 'help-echo "mouse-2, RET: Reveal test result")
+
+(define-button-type 'ert--test-name-button
+ 'action #'ert--test-name-button-action
+ 'help-echo "mouse-2, RET: Find test definition")
+
+(define-button-type 'ert--results-expand-collapse-button
+ 'action #'ert--results-expand-collapse-button-action
+ 'help-echo "mouse-2, RET: Expand/collapse test result")
+
+(defun ert--results-test-node-or-null-at-point ()
+ "If point is on a valid ewoc node, return it; return nil otherwise.
+
+To be used in the ERT results buffer."
+ (let* ((ewoc ert--results-ewoc)
+ (node (ewoc-locate ewoc)))
+ ;; `ewoc-locate' will return an arbitrary node when point is on
+ ;; header or footer, or when all nodes are invisible. So we need
+ ;; to validate its return value here.
+ ;;
+ ;; Update: I'm seeing nil being returned in some cases now,
+ ;; perhaps this has been changed?
+ (if (and node
+ (>= (point) (ewoc-location node))
+ (not (ert--ewoc-entry-hidden-p (ewoc-data node))))
+ node
+ nil)))
+
+(defun ert--results-test-node-at-point ()
+ "If point is on a valid ewoc node, return it; signal an error otherwise.
+
+To be used in the ERT results buffer."
+ (or (ert--results-test-node-or-null-at-point)
+ (error "No test at point")))
+
+(defun ert-results-next-test ()
+ "Move point to the next test.
+
+To be used in the ERT results buffer."
+ (interactive)
+ (ert--results-move (ewoc-locate ert--results-ewoc) 'ewoc-next
+ "No tests below"))
+
+(defun ert-results-previous-test ()
+ "Move point to the previous test.
+
+To be used in the ERT results buffer."
+ (interactive)
+ (ert--results-move (ewoc-locate ert--results-ewoc) 'ewoc-prev
+ "No tests above"))
+
+(defun ert--results-move (node ewoc-fn error-message)
+ "Move point from NODE to the previous or next node.
+
+EWOC-FN specifies the direction and should be either `ewoc-prev'
+or `ewoc-next'. If there are no more nodes in that direction, an
+error is signalled with the message ERROR-MESSAGE."
+ (loop
+ (setq node (funcall ewoc-fn ert--results-ewoc node))
+ (when (null node)
+ (error "%s" error-message))
+ (unless (ert--ewoc-entry-hidden-p (ewoc-data node))
+ (goto-char (ewoc-location node))
+ (return))))
+
+(defun ert--results-expand-collapse-button-action (button)
+ "Expand or collapse the test node BUTTON belongs to."
+ (let* ((ewoc ert--results-ewoc)
+ (node (save-excursion
+ (goto-char (ert--button-action-position))
+ (ert--results-test-node-at-point)))
+ (entry (ewoc-data node)))
+ (setf (ert--ewoc-entry-expanded-p entry)
+ (not (ert--ewoc-entry-expanded-p entry)))
+ (ewoc-invalidate ewoc node)))
+
+(defun ert-results-find-test-at-point-other-window ()
+ "Find the definition of the test at point in another window.
+
+To be used in the ERT results buffer."
+ (interactive)
+ (let ((name (ert-test-at-point)))
+ (unless name
+ (error "No test at point"))
+ (ert-find-test-other-window name)))
+
+(defun ert--test-name-button-action (button)
+ "Find the definition of the test BUTTON belongs to, in another window."
+ (let ((name (button-get button 'ert-test-name)))
+ (ert-find-test-other-window name)))
+
+(defun ert--ewoc-position (ewoc node)
+ ;; checkdoc-order: nil
+ "Return the position of NODE in EWOC, or nil if NODE is not in EWOC."
+ (loop for i from 0
+ for node-here = (ewoc-nth ewoc 0) then (ewoc-next ewoc node-here)
+ do (when (eql node node-here)
+ (return i))
+ finally (return nil)))
+
+(defun ert-results-jump-between-summary-and-result ()
+ "Jump back and forth between the test run summary and individual test
results.
+
+From an ewoc node, jumps to the character that represents the
+same test in the progress bar, and vice versa.
+
+To be used in the ERT results buffer."
+ ;; Maybe this command isn't actually needed much, but if it is, it
+ ;; seems like an indication that the UI design is not optimal. If
+ ;; jumping back and forth between a summary at the top of the buffer
+ ;; and the error log in the remainder of the buffer is useful, then
+ ;; the summary apparently needs to be easily accessible from the
+ ;; error log, and perhaps it would be better to have it in a
+ ;; separate buffer to keep it visible.
+ (interactive)
+ (let ((ewoc ert--results-ewoc)
+ (progress-bar-begin ert--results-progress-bar-button-begin))
+ (cond ((ert--results-test-node-or-null-at-point)
+ (let* ((node (ert--results-test-node-at-point))
+ (pos (ert--ewoc-position ewoc node)))
+ (goto-char (+ progress-bar-begin pos))))
+ ((and (<= progress-bar-begin (point))
+ (< (point) (button-end (button-at progress-bar-begin))))
+ (let* ((node (ewoc-nth ewoc (- (point) progress-bar-begin)))
+ (entry (ewoc-data node)))
+ (when (ert--ewoc-entry-hidden-p entry)
+ (setf (ert--ewoc-entry-hidden-p entry) nil)
+ (ewoc-invalidate ewoc node))
+ (ewoc-goto-node ewoc node)))
+ (t
+ (goto-char progress-bar-begin)))))
+
+(defun ert-test-at-point ()
+ "Return the name of the test at point as a symbol, or nil if none."
+ (or (and (eql major-mode 'ert-results-mode)
+ (let ((test (ert--results-test-at-point-no-redefinition)))
+ (and test (ert-test-name test))))
+ (let* ((thing (thing-at-point 'symbol))
+ (sym (intern-soft thing)))
+ (and (ert-test-boundp sym)
+ sym))))
+
+(defun ert--results-test-at-point-no-redefinition ()
+ "Return the test at point, or nil.
+
+To be used in the ERT results buffer."
+ (assert (eql major-mode 'ert-results-mode))
+ (if (ert--results-test-node-or-null-at-point)
+ (let* ((node (ert--results-test-node-at-point))
+ (test (ert--ewoc-entry-test (ewoc-data node))))
+ test)
+ (let ((progress-bar-begin ert--results-progress-bar-button-begin))
+ (when (and (<= progress-bar-begin (point))
+ (< (point) (button-end (button-at progress-bar-begin))))
+ (let* ((test-index (- (point) progress-bar-begin))
+ (test (aref (ert--stats-tests ert--results-stats)
+ test-index)))
+ test)))))
+
+(defun ert--results-test-at-point-allow-redefinition ()
+ "Look up the test at point, and check whether it has been redefined.
+
+To be used in the ERT results buffer.
+
+Returns a list of two elements: the test (or nil) and a symbol
+specifying whether the test has been redefined.
+
+If a new test has been defined with the same name as the test at
+point, replaces the test at point with the new test, and returns
+the new test and the symbol `redefined'.
+
+If the test has been deleted, returns the old test and the symbol
+`deleted'.
+
+If the test is still current, returns the test and the symbol nil.
+
+If there is no test at point, returns a list with two nils."
+ (let ((test (ert--results-test-at-point-no-redefinition)))
+ (cond ((null test)
+ `(nil nil))
+ ((null (ert-test-name test))
+ `(,test nil))
+ (t
+ (let* ((name (ert-test-name test))
+ (new-test (and (ert-test-boundp name)
+ (ert-get-test name))))
+ (cond ((eql test new-test)
+ `(,test nil))
+ ((null new-test)
+ `(,test deleted))
+ (t
+ (ert--results-update-after-test-redefinition
+ (ert--stats-test-pos ert--results-stats test)
+ new-test)
+ `(,new-test redefined))))))))
+
+(defun ert--results-update-after-test-redefinition (pos new-test)
+ "Update results buffer after the test at pos POS has been redefined.
+
+Also updates the stats object. NEW-TEST is the new test
+definition."
+ (let* ((stats ert--results-stats)
+ (ewoc ert--results-ewoc)
+ (node (ewoc-nth ewoc pos))
+ (entry (ewoc-data node)))
+ (ert--stats-set-test-and-result stats pos new-test nil)
+ (setf (ert--ewoc-entry-test entry) new-test
+ (aref ert--results-progress-bar-string pos) (ert-char-for-test-result
+ nil t))
+ (ewoc-invalidate ewoc node))
+ nil)
+
+(defun ert--button-action-position ()
+ "The buffer position where the last button action was triggered."
+ (cond ((integerp last-command-event)
+ (point))
+ ((eventp last-command-event)
+ (posn-point (event-start last-command-event)))
+ (t (assert nil))))
+
+(defun ert--results-progress-bar-button-action (button)
+ "Jump to details for the test represented by the character clicked in
BUTTON."
+ (goto-char (ert--button-action-position))
+ (ert-results-jump-between-summary-and-result))
+
+(defun ert-results-rerun-all-tests ()
+ "Re-run all tests, using the same selector.
+
+To be used in the ERT results buffer."
+ (interactive)
+ (assert (eql major-mode 'ert-results-mode))
+ (let ((selector (ert--stats-selector ert--results-stats)))
+ (ert-run-tests-interactively selector (buffer-name))))
+
+(defun ert-results-rerun-test-at-point ()
+ "Re-run the test at point.
+
+To be used in the ERT results buffer."
+ (interactive)
+ (destructuring-bind (test redefinition-state)
+ (ert--results-test-at-point-allow-redefinition)
+ (when (null test)
+ (error "No test at point"))
+ (let* ((stats ert--results-stats)
+ (progress-message (format "Running %stest %S"
+ (ecase redefinition-state
+ ((nil) "")
+ (redefined "new definition of ")
+ (deleted "deleted "))
+ (ert-test-name test))))
+ ;; Need to save and restore point manually here: When point is on
+ ;; the first visible ewoc entry while the header is updated, point
+ ;; moves to the top of the buffer. This is undesirable, and a
+ ;; simple `save-excursion' doesn't prevent it.
+ (let ((point (point)))
+ (unwind-protect
+ (unwind-protect
+ (progn
+ (message "%s..." progress-message)
+ (ert-run-or-rerun-test stats test
+ ert--results-listener))
+ (ert--results-update-stats-display ert--results-ewoc stats)
+ (message "%s...%s"
+ progress-message
+ (let ((result (ert-test-most-recent-result test)))
+ (ert-string-for-test-result
+ result (ert-test-result-expected-p test result)))))
+ (goto-char point))))))
+
+(defun ert-results-rerun-test-at-point-debugging-errors ()
+ "Re-run the test at point with `ert-debug-on-error' bound to t.
+
+To be used in the ERT results buffer."
+ (interactive)
+ (let ((ert-debug-on-error t))
+ (ert-results-rerun-test-at-point)))
+
+(defun ert-results-pop-to-backtrace-for-test-at-point ()
+ "Display the backtrace for the test at point.
+
+To be used in the ERT results buffer."
+ (interactive)
+ (let* ((test (ert--results-test-at-point-no-redefinition))
+ (stats ert--results-stats)
+ (pos (ert--stats-test-pos stats test))
+ (result (aref (ert--stats-test-results stats) pos)))
+ (etypecase result
+ (ert-test-passed (error "Test passed, no backtrace available"))
+ (ert-test-result-with-condition
+ (let ((backtrace (ert-test-result-with-condition-backtrace result))
+ (buffer (get-buffer-create "*ERT Backtrace*")))
+ (pop-to-buffer buffer)
+ (setq buffer-read-only t)
+ (let ((inhibit-read-only t))
+ (buffer-disable-undo)
+ (erase-buffer)
+ (ert-simple-view-mode)
+ ;; Use unibyte because `debugger-setup-buffer' also does so.
+ (set-buffer-multibyte nil)
+ (setq truncate-lines t)
+ (ert--print-backtrace backtrace)
+ (debugger-make-xrefs)
+ (goto-char (point-min))
+ (insert "Backtrace for test `")
+ (ert-insert-test-name-button (ert-test-name test))
+ (insert "':\n")))))))
+
+(defun ert-results-pop-to-messages-for-test-at-point ()
+ "Display the part of the *Messages* buffer generated during the test at
point.
+
+To be used in the ERT results buffer."
+ (interactive)
+ (let* ((test (ert--results-test-at-point-no-redefinition))
+ (stats ert--results-stats)
+ (pos (ert--stats-test-pos stats test))
+ (result (aref (ert--stats-test-results stats) pos)))
+ (let ((buffer (get-buffer-create "*ERT Messages*")))
+ (pop-to-buffer buffer)
+ (setq buffer-read-only t)
+ (let ((inhibit-read-only t))
+ (buffer-disable-undo)
+ (erase-buffer)
+ (ert-simple-view-mode)
+ (insert (ert-test-result-messages result))
+ (goto-char (point-min))
+ (insert "Messages for test `")
+ (ert-insert-test-name-button (ert-test-name test))
+ (insert "':\n")))))
+
+(defun ert-results-pop-to-should-forms-for-test-at-point ()
+ "Display the list of `should' forms executed during the test at point.
+
+To be used in the ERT results buffer."
+ (interactive)
+ (let* ((test (ert--results-test-at-point-no-redefinition))
+ (stats ert--results-stats)
+ (pos (ert--stats-test-pos stats test))
+ (result (aref (ert--stats-test-results stats) pos)))
+ (let ((buffer (get-buffer-create "*ERT list of should forms*")))
+ (pop-to-buffer buffer)
+ (setq buffer-read-only t)
+ (let ((inhibit-read-only t))
+ (buffer-disable-undo)
+ (erase-buffer)
+ (ert-simple-view-mode)
+ (if (null (ert-test-result-should-forms result))
+ (insert "\n(No should forms during this test.)\n")
+ (loop for form-description in (ert-test-result-should-forms result)
+ for i from 1 do
+ (insert "\n")
+ (insert (format "%s: " i))
+ (let ((begin (point)))
+ (ert--pp-with-indentation-and-newline form-description)
+ (ert--make-xrefs-region begin (point)))))
+ (goto-char (point-min))
+ (insert "`should' forms executed during test `")
+ (ert-insert-test-name-button (ert-test-name test))
+ (insert "':\n")
+ (insert "\n")
+ (insert (concat "(Values are shallow copies and may have "
+ "looked different during the test if they\n"
+ "have been modified destructively.)\n"))
+ (forward-line 1)))))
+
+(defun ert-results-toggle-printer-limits-for-test-at-point ()
+ "Toggle how much of the condition to print for the test at point.
+
+To be used in the ERT results buffer."
+ (interactive)
+ (let* ((ewoc ert--results-ewoc)
+ (node (ert--results-test-node-at-point))
+ (entry (ewoc-data node)))
+ (setf (ert--ewoc-entry-extended-printer-limits-p entry)
+ (not (ert--ewoc-entry-extended-printer-limits-p entry)))
+ (ewoc-invalidate ewoc node)))
+
+(defun ert-results-pop-to-timings ()
+ "Display test timings for the last run.
+
+To be used in the ERT results buffer."
+ (interactive)
+ (let* ((stats ert--results-stats)
+ (start-times (ert--stats-test-start-times stats))
+ (end-times (ert--stats-test-end-times stats))
+ (buffer (get-buffer-create "*ERT timings*"))
+ (data (loop for test across (ert--stats-tests stats)
+ for start-time across (ert--stats-test-start-times stats)
+ for end-time across (ert--stats-test-end-times stats)
+ collect (list test
+ (float-time (subtract-time end-time
+ start-time))))))
+ (setq data (sort data (lambda (a b)
+ (> (second a) (second b)))))
+ (pop-to-buffer buffer)
+ (setq buffer-read-only t)
+ (let ((inhibit-read-only t))
+ (buffer-disable-undo)
+ (erase-buffer)
+ (ert-simple-view-mode)
+ (if (null data)
+ (insert "(No data)\n")
+ (insert (format "%-3s %8s %8s\n" "" "time" "cumul"))
+ (loop for (test time) in data
+ for cumul-time = time then (+ cumul-time time)
+ for i from 1 do
+ (let ((begin (point)))
+ (insert (format "%3s: %8.3f %8.3f " i time cumul-time))
+ (ert-insert-test-name-button (ert-test-name test))
+ (insert "\n"))))
+ (goto-char (point-min))
+ (insert "Tests by run time (seconds):\n\n")
+ (forward-line 1))))
+
+;;;###autoload
+(defun ert-describe-test (test-or-test-name)
+ "Display the documentation for TEST-OR-TEST-NAME (a symbol or ert-test)."
+ (interactive (list (ert-read-test-name-at-point "Describe test")))
+ (when (< emacs-major-version 24)
+ (error "Requires Emacs 24"))
+ (let (test-name
+ test-definition)
+ (etypecase test-or-test-name
+ (symbol (setq test-name test-or-test-name
+ test-definition (ert-get-test test-or-test-name)))
+ (ert-test (setq test-name (ert-test-name test-or-test-name)
+ test-definition test-or-test-name)))
+ (help-setup-xref (list #'ert-describe-test test-or-test-name)
+ (called-interactively-p 'interactive))
+ (save-excursion
+ (with-help-window (help-buffer)
+ (with-current-buffer (help-buffer)
+ (insert (if test-name (format "%S" test-name) "<anonymous test>"))
+ (insert " is a test")
+ (let ((file-name (and test-name
+ (symbol-file test-name 'ert-deftest))))
+ (when file-name
+ (insert " defined in `" (file-name-nondirectory file-name) "'")
+ (save-excursion
+ (re-search-backward "`\\([^`']+\\)'" nil t)
+ (help-xref-button 1 'help-function-def test-name file-name)))
+ (insert ".")
+ (fill-region-as-paragraph (point-min) (point))
+ (insert "\n\n")
+ (unless (and (ert-test-boundp test-name)
+ (eql (ert-get-test test-name) test-definition))
+ (let ((begin (point)))
+ (insert "Note: This test has been redefined or deleted, "
+ "this documentation refers to an old definition.")
+ (fill-region-as-paragraph begin (point)))
+ (insert "\n\n"))
+ (insert (or (ert-test-documentation test-definition)
+ "It is not documented.")
+ "\n")))))))
+
+(defun ert-results-describe-test-at-point ()
+ "Display the documentation of the test at point.
+
+To be used in the ERT results buffer."
+ (interactive)
+ (ert-describe-test (ert--results-test-at-point-no-redefinition)))
+
+
+;;; Actions on load/unload.
+
+(add-to-list 'find-function-regexp-alist '(ert-deftest .
ert--find-test-regexp))
+(add-to-list 'minor-mode-alist '(ert--current-run-stats
+ (:eval
+ (ert--tests-running-mode-line-indicator))))
+(add-to-list 'emacs-lisp-mode-hook 'ert--activate-font-lock-keywords)
+
+(defun ert--unload-function ()
+ "Unload function to undo the side-effects of loading ert.el."
+ (ert--remove-from-list 'find-function-regexp-alist 'ert-deftest :key #'car)
+ (ert--remove-from-list 'minor-mode-alist 'ert--current-run-stats :key #'car)
+ (ert--remove-from-list 'emacs-lisp-mode-hook
+ 'ert--activate-font-lock-keywords)
+ nil)
+
+(defvar ert-unload-hook '())
+(add-hook 'ert-unload-hook 'ert--unload-function)
+
+
+(provide 'ert)
+
+;;; ert.el ends here
diff --git a/tests/google-this-tests.el b/tests/google-this-tests.el
new file mode 100644
index 0000000..ababcec
--- /dev/null
+++ b/tests/google-this-tests.el
@@ -0,0 +1,79 @@
+
+(byte-compile-file "google-this.el")
+(require 'noflet)
+(require 'google-this)
+
+;; (ert-deftest google-this-insert-lucky-string-should-replace-region ()
+;; (with-temp-buffer
+;; (insert "prefix ")
+;; (save-excursion (insert " suffix"))
+;; (let ((left (point))
+;; (old-last-url google-this--last-url)
+;; right)
+;; (insert "imdb raiders")
+;; (setq right (point))
+;; (noflet ((region-active-p () t)
+;; (region-beginning () left)
+;; (region-end () right)
+;; (read-string (_ s) s)
+;; (kill-region (l r)
+;; (delete-region l r))
+;; ;; Make this run synchronously, no need for manual search
+;; (google-this--do-lucky-search (_ func)
+;; (funcall func
"http://www.imdb.com/title/tt0082971/";)))
+;; (call-interactively 'google-this-lucky-and-insert-url)
+;; (setq google-this--last-url old-last-url)
+;; (should (equal "prefix http://www.imdb.com/title/tt0082971/
suffix"
+;; (buffer-substring-no-properties (point-min)
(point-max))))))))
+
+(defvar gtt--test-string "This is a test")
+(defvar gtt--base-url (google-this-url))
+(defun gtt--format-and-hexify (term)
+ (format gtt--base-url (url-hexify-string term)))
+
+;;; Google string tests
+(defvar gtt--url-result (gtt--format-and-hexify gtt--test-string))
+(defvar gtt--url-result-quoted (gtt--format-and-hexify (concat "\""
gtt--test-string "\"")))
+(ert-deftest google-this-string-test ()
+ (let ((google-this-wrap-in-quotes nil))
+ (noflet ((browse-url (url) url))
+ (should (equal (google-this-string nil gtt--test-string t)
gtt--url-result))
+ (should (equal (google-this-string t gtt--test-string t)
gtt--url-result-quoted)))))
+(ert-deftest google-this-string-inverted-test ()
+ (let ((google-this-wrap-in-quotes t))
+ (noflet ((browse-url (url) url))
+ (should (equal (google-this-string nil gtt--test-string t)
gtt--url-result-quoted))
+ (should (equal (google-this-string t gtt--test-string t)
gtt--url-result)))))
+
+;;; google-this-search tests
+(ert-deftest google-this-search-test ()
+ (let ((google-this-wrap-in-quotes nil))
+ (noflet ((browse-url (url) url)
+ (google-this-pick-term (_) gtt--test-string))
+ (should (equal
+ (google-this-search nil "foo *%s& url Tester")
+ (format "foo *%s& url Tester" (url-hexify-string
gtt--test-string)))))))
+
+;;; Other google-this-something tests
+(ert-deftest google-this-buffer-test ()
+ (let ((google-this-wrap-in-quotes nil)
+ left right)
+ (with-temp-buffer
+ (insert "This is a ")
+ (setq left (point))
+ (insert "test\nI am doing")
+ (save-excursion (insert " right\nnow"))
+ (setq right (point))
+ (noflet ((region-active-p () t)
+ (region-beginning () left)
+ (region-end () right)
+ (browse-url (url) url)
+ (read-string (_ def) def))
+ (should (equal (google-this-region nil) (gtt--format-and-hexify
"test\nI am doing")))
+ (should (equal (google-this-line nil) (gtt--format-and-hexify "I am
doing right")))
+ (should (equal (google-this-word nil) (gtt--format-and-hexify
"doing")))
+ (should (equal (google-this-symbol nil) (gtt--format-and-hexify
"doing")))))))
+
+;;; Local Variables:
+;;; lisp-indent-function:common-lisp-indent-function
+;;; End:
diff --git a/tests/google-this.el b/tests/google-this.el
new file mode 100755
index 0000000..38fd633
--- /dev/null
+++ b/tests/google-this.el
@@ -0,0 +1,472 @@
+;;; google-this.el --- A set of functions and bindings to google under point.
+
+;; Copyright (C) 2012-2013 Artur Malabarba <bruce.connor.am@gmail.com>
+
+;; Author: Artur Malabarba <bruce.connor.am@gmail.com>
+;; URL: http://github.com/Bruce-Connor/emacs-google-this
+;; Version: 1.9
+;; Package-Requires: ((emacs "24.1") (names "0.5"))
+;; Keywords: convenience hypermedia
+;; Prefix: google-this
+;; Separator: -
+
+;;; Commentary:
+
+;; google-this is a package that provides a set of functions and
+;; keybindings for launching google searches from within Emacs.
+
+;; The main function is `google-this' (bound to C-c / g). It does a
+;; google search using the currently selected region, or the
+;; expression under point. All functions are bound under "C-c /"
+;; prefix, in order to comply with Emacs' standards. If that's a
+;; problem see `google-this-keybind'. To view all keybindings type "C-c
+;; / C-h".
+;;
+;; If you don't like this keybind, just reassign the
+;; `google-this-mode-submap' variable.
+;; My personal preference is "C-x g":
+;;
+;; (global-set-key (kbd "C-x g") 'google-this-mode-submap)
+;;
+;; Or, if you don't want google-this to overwrite the default ("C-c /")
+;; key insert the following line BEFORE everything else (even before
+;; the `require' command):
+;;
+;; (setq google-this-keybind (kbd "C-x g"))
+;;
+
+;; To start a blank search, do `google-search' (C-c / RET). If you
+;; want more control of what "under point" means for the `google-this'
+;; command, there are the `google-word', `google-symbol',
+;; `google-line' and `google-region' functions, bound as w, s, l and space,
+;; respectively. They all do a search for what's under point.
+
+;; If the `google-wrap-in-quotes' variable is t, than searches are
+;; enclosed by double quotes (default is NOT). If a prefix argument is
+;; given to any of the functions, invert the effect of
+;; `google-wrap-in-quotes'.
+
+;; There is also a `google-error' (C-c / e) function. It checks the
+;; current error in the compilation buffer, tries to do some parsing
+;; (to remove file name, line number, etc), and googles it. It's still
+;; experimental, and has only really been tested with gcc error
+;; reports.
+
+;; Finally there's also a google-cpp-reference function (C-c / r).
+
+;;; Instructions:
+
+;; INSTALLATION
+
+;; Make sure "google-this.el" is in your load path, then place
+;; this code in your .emacs file:
+;; (require 'google-this)
+;; (google-this-mode 1)
+
+;;
+;; 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.
+;;
+
+;;; Change Log:
+;; 1.9 - 2014/09/02 - Renamed A LOT of functions to be namespaced correctly.
+;; 1.10 - 2014/09/02 - Fix 24.3 compatibility.
+;; 1.9 - 2014/06/19 - Customizable URL.
+;; 1.8 - 2013/10/31 - Customizable mode-line indicator (credit
https://github.com/mgalgs)
+;; 1.7.1 - 2013/09/17 - google-this-parse-and-search-string returns what
browse-url returns.
+;; 1.7 - 2013/09/08 - Removed some obsolete aliases.
+;; 1.7 - 2013/09/08 - Implemented google-lucky-and-insert-url, with
keybinding.
+;; 1.7 - 2013/09/08 - Implemented google-lucky, with keybinding.
+;; 1.6 - 2013/08/22 - Activated google-instant, so you can navigate straight
for the keyboard
+;; 1.5 - 2013/07/18 - added keybinding for google region.
+;; 1.5 - 2013/07/18 - Fixed cpp-reference.
+;; 1.4 - 2013/06/03 - Added parent groups.
+;; 1.4 - 2013/06/03 - Renamed some functions and variables. Is backwards
incompatible if you were using functions you shouldn't be.
+;; 1.4 - 2013/06/03 - Fixed quoting.
+;; 1.3 - 2013/05/31 - Merged fix for google-forecast. Thanks to ptrv.
+;; 1.3 - 2013/05/31 - More robust google-translate command.
+;; 1.2.1 - 2013/04/26 - Created an error parser for the google-error function.
+;; pre - 2013/02/27 - It works with c-like errors and is extendable to other
types of errors using the varible `google-error-regexp'.
+;; 1.2.1 - 2013/04/26 - autoloaded any functions that the user might want to
call directly.
+;; 1.2 - 2013/04/21 - Fixed docs.
+;; pre - 2013/05/04 - Changed the keybinding to be standards compliant.
+;; pre - 2013/03/03 - Fixed problem with backslash.
+;; pre - 2013/02/27 - Added support for google-translate and google-maps
packages.
+;; pre - 2013/02/27 - And added `google-forecast' function.
+;; pre - 2013/02/27 - And added `google-location-suffix' so we're not
constrained to google.com anymore.
+;;; Code:
+
+(require 'url)
+(require 'names)
+(eval-when-compile
+ (progn
+ (require 'compile)
+ (require 'simple)
+ (declare-function google-maps "google-maps")))
+
+(defgroup google-this '()
+ "Customization group for `google-this-mode'."
+ :link '(url-link "http://github.com/Bruce-Connor/emacs-google-this";)
+ :group 'convenience
+ :group 'comm)
+
+(define-namespace google-this-
+
+(defconst version "1.9"
+ "Version string of the `google-this' package.")
+(defconst version-int 10
+ "Integer version number of the `google-this' package (for comparing
versions).")
+(defcustom wrap-in-quotes nil
+ "If not nil, searches are wrapped in double quotes.
+
+If a prefix argument is given to any of the functions, the
+opposite happens."
+ :type 'boolean
+ :group 'google-this)
+
+(defcustom suspend-after-search nil
+ "Whether Emacs should be minimized after a search is launched (calls
`suspend-frame')."
+ :type 'boolean
+ :group 'google-this)
+
+(defvar mode-submap)
+(define-prefix-command 'google-this-mode-submap)
+(define-key mode-submap [return] #'search)
+(define-key mode-submap " " #'region)
+(define-key mode-submap "t" #'google-this)
+(define-key mode-submap "g" #'lucky-search)
+(define-key mode-submap "i" #'lucky-and-insert-url)
+(define-key mode-submap "w" #'word)
+(define-key mode-submap "s" #'symbol)
+(define-key mode-submap "l" #'line)
+(define-key mode-submap "e" #'error)
+(define-key mode-submap "f" #'forecast)
+(define-key mode-submap "r" #'cpp-reference)
+(when (fboundp #'google-maps)
+ (define-key mode-submap "m" #'google-maps))
+;; "c" is for "convert language" :-P
+(define-key mode-submap "c" #'translate-query-or-region)
+
+(defun translate-query-or-region ()
+ "If region is active `google-translate-at-point', otherwise
`google-translate-query-translate'."
+ (interactive)
+ (unless (require 'google-translate nil t)
+ (error "[google-this]: This command requires the 'google-translate'
package"))
+ (if (region-active-p)
+ (if (functionp 'google-translate-at-point)
+ (call-interactively 'google-translate-at-point)
+ (error "[google-this]: `google-translate-at-point' function not found
in `google-translate' package"))
+ (if (functionp 'google-translate-query-translate)
+ (call-interactively 'google-translate-query-translate)
+ (error "[google-this]: `google-translate-query-translate' function not
found in `google-translate' package"))))
+
+(defcustom base-url "https://www.google.";
+ "The base url to use in google searches.
+
+This will be appended with `google-this-location-suffix', so you
+shouldn't include the final \"com\" here."
+ :type 'string
+ :group 'google-this)
+
+(defcustom location-suffix "com"
+ "The url suffix associated with your location (com, co.uk, fr, etc)."
+ :type 'string
+ :group 'google-this)
+
+(defun url () "URL for google searches."
+ (concat base-url location-suffix "/search?ion=1&q=%s"))
+
+(defcustom error-regexp '(("^[^:]*:[0-9 ]*:\\([0-9 ]*:\\)? *" ""))
+ "List of (REGEXP REPLACEMENT) pairs to parse error strings."
+ :type '(repeat (list regexp string))
+ :group 'google-this)
+
+(defun pick-term (prefix)
+ "Decide what \"this\" and return it.
+PREFIX determines quoting."
+ (let* ((term (if (region-active-p)
+ (buffer-substring-no-properties (region-beginning)
(region-end))
+ (or (thing-at-point 'symbol)
+ (thing-at-point 'word)
+ (buffer-substring-no-properties (line-beginning-position)
+ (line-end-position)))))
+ (term (read-string (concat "Googling [" term "]: ") nil nil term)))
+ term))
+
+:autoload
+(defun search (prefix &optional search-string)
+ "Write and do a google search.
+Interactively PREFIX determines quoting.
+Non-interactively SEARCH-STRING is the string to search."
+ (interactive "P")
+ (let* ((term (pick-term prefix)))
+ (if (stringp term)
+ (parse-and-search-string term prefix search-string)
+ (message "[google-this-string] Empty query."))))
+
+(defun lucky-search-url ()
+ "Return the url for a feeling-lucky google search."
+ (format "%s%s/search?q=%%s&btnI" base-url location-suffix))
+
+(defalias 'google-this--do-lucky-search
+ (if (version< emacs-version "24")
+ '(lambda (term callback)
+ "Build the URL using TERM, perform the `url-retrieve' and call
CALLBACK if we get redirected."
+ (url-retrieve (format (google-this-lucky-search-url)
(url-hexify-string term))
+ (eval `(lambda (status)
+ (if status
+ (if (eq :redirect (car status))
+ (progn (message "Received URL: %s"
(cadr status))
+ (funcall ,callback (cadr
status)))
+ (message "Unkown response: %S" status))
+ (message "Search returned no results."))))
+ nil))
+ '(lambda (term callback)
+ "Build the URL using TERM, perform the `url-retrieve' and call CALLBACK
if we get redirected."
+ (url-retrieve (format (google-this-lucky-search-url) (url-hexify-string
term))
+ (eval `(lambda (status)
+ (if status
+ (if (eq :redirect (car status))
+ (progn (message "Received URL: %s" (cadr
status))
+ (funcall ,callback (cadr status)))
+ (message "Unkown response: %S" status))
+ (message "Search returned no results."))))
+ nil t t))))
+
+(defvar -last-url nil "Last url that was fetched by
`google-this-lucky-and-insert-url'.")
+
+:autoload
+(defun lucky-and-insert-url (term &optional insert)
+ "Fetch the url that would be visited by `google-this-lucky'.
+
+If you just want to do an \"I'm feeling lucky search\", use
+`google-this-lucky-search' instead.
+
+Interactively:
+* Insert the URL at point,
+* Kill the searched term, removing it from the buffer (it is killed, not
+ deleted, so it can be easily yanked back if desired).
+* Search term defaults to region or line, and always queries for
+ confirmation.
+
+Non-Interactively:
+* Runs synchronously,
+* Search TERM is an argument without confirmation,
+* Only insert if INSERT is non-nil, otherwise return."
+ (interactive '(needsQuerying t))
+ (let ((nint (null (called-interactively-p 'any)))
+ (l (if (region-active-p) (region-beginning) (line-beginning-position)))
+ (r (if (region-active-p) (region-end) (line-end-position)))
+ ;; We get current-buffer and point here, because it's
+ ;; conceivable that they could change while waiting for input
+ ;; from read-string
+ (p (point))
+ (b (current-buffer)))
+ (when nint (setq -last-url nil))
+ (when (eq term 'needsQuerying)
+ (setq term (read-string "Lucky Term: " (buffer-substring-no-properties l
r))))
+ (unless (stringp term) (error "TERM must be a string!"))
+ (-do-lucky-search term
+ (eval `(lambda (url)
+ (unless url (error "Received nil url"))
+ (with-current-buffer ,b
+ (save-excursion
+ (if ,nint (goto-char ,p)
+ (kill-region ,l ,r)
+ (goto-char ,l))
+ (when ,insert (insert url))))
+ (setq google-this--last-url url))))
+ (unless nint (deactivate-mark))
+ (when nint
+ (while (null -last-url) (sleep-for 0 10))
+ -last-url)))
+
+:autoload
+(defun lucky-search (prefix)
+ "Exactly like `google-this-search', but use the \"I'm feeling lucky\" option.
+PREFIX determines quoting."
+ (interactive "P")
+ (search prefix (lucky-search-url)))
+
+(defun -maybe-wrap-in-quotes (text flip)
+ "Wrap TEXT in quotes.
+Depends on the value of FLIP and `google-this-wrap-in-quotes'."
+ (if (if flip (not wrap-in-quotes) wrap-in-quotes)
+ (format "\"%s\"" text)
+ text))
+
+(defun parse-and-search-string (text prefix &optional search-url)
+ "Convert illegal characters in TEXT to their %XX versions, and then googles.
+PREFIX determines quoting.
+SEARCH-URL is usually either the regular or the lucky google
+search url.
+
+Don't call this function directly, it could change depending on
+version. Use `google-this-string' instead (or any of the other
+google-this-\"something\" functions)."
+ (let* (;; Create the url
+ (query-string (-maybe-wrap-in-quotes text prefix))
+ ;; Perform the actual search.
+ (browse-result (browse-url (format (or search-url (url))
+ (url-hexify-string
query-string)))))
+ ;; Maybe suspend emacs.
+ (when suspend-after-search (suspend-frame))
+ ;; Return what browse-url returned (very usefull for tests).
+ browse-result))
+
+:autoload
+(defun string (prefix &optional TEXT NOCONFIRM)
+ "Google given TEXT, but ask the user first if NOCONFIRM is nil.
+PREFIX determines quoting."
+ (unless NOCONFIRM
+ (setq TEXT (read-string "Googling: "
+ (if (stringp TEXT) (replace-regexp-in-string
"^[[:blank:]]*" "" TEXT)))))
+ (if (stringp TEXT)
+ (parse-and-search-string TEXT prefix)
+ (message "[google-this-string] Empty query.")))
+
+:autoload
+(defun line (prefix)
+ "Google the current line.
+PREFIX determines quoting."
+ (interactive "P")
+ (let ((Line (buffer-substring (line-beginning-position)
(line-end-position))))
+ (string prefix Line)))
+
+:autoload
+(defun word (prefix)
+ "Google the current word.
+PREFIX determines quoting."
+ (interactive "P")
+ (string prefix (thing-at-point 'word) t))
+
+:autoload
+(defun symbol (prefix)
+ "Google the current symbol.
+PREFIX determines quoting."
+ (interactive "P")
+ (string prefix (thing-at-point 'symbol) t))
+
+
+:autoload
+(defun region (prefix)
+ "Google the current region.
+PREFIX determines quoting."
+ (interactive "P")
+ (string
+ prefix (buffer-substring-no-properties (region-beginning) (region-end))))
+
+:autoload
+(defun google-this (prefix)
+ "Decide what the user wants to google (always something under point).
+
+Unlike `google-this-search' (which presents an empty prompt with
+\"this\" as the default value), this function inserts the query
+in the minibuffer to be edited.
+PREFIX determines quoting."
+ (interactive "P")
+ (cond
+ ((region-active-p) (region prefix))
+ ((thing-at-point 'symbol) (string prefix (thing-at-point 'symbol)))
+ ((thing-at-point 'word) (string prefix (thing-at-point 'word)))
+ (t (line prefix))))
+
+:autoload
+(defun error (prefix)
+ "Google the current error in the compilation buffer.
+PREFIX determines quoting."
+ (interactive "P")
+ (unless (boundp 'compilation-mode-map)
+ (error "No compilation active"))
+ (require 'compile)
+ (require 'simple)
+ (save-excursion
+ (let ((pt (point))
+ (buffer-name (next-error-find-buffer)))
+ (unless (compilation-buffer-internal-p)
+ (set-buffer buffer-name))
+ (string prefix
+ (clean-error-string
+ (buffer-substring (line-beginning-position)
(line-end-position)))))))
+
+
+:autoload
+(defun clean-error-string (s)
+ "Parse error string S and turn it into googleable strings.
+
+Removes unhelpful details like file names and line numbers from
+simple error strings (such as c-like erros).
+
+Uses replacements in `google-this-error-regexp' and stops at the first match."
+ (interactive)
+ (let (out)
+ (catch 'result
+ (dolist (cur error-regexp out)
+ (when (string-match (car cur) s)
+ (setq out (replace-regexp-in-string
+ (car cur) (car (cdr cur)) s))
+ (throw 'result out))))))
+
+:autoload
+(defun cpp-reference ()
+ "Visit the most probable cppreference.com page for this word."
+ (interactive)
+ (parse-and-search-string
+ (concat "site:cppreference.com " (thing-at-point 'symbol))
+ nil (lucky-search-url)))
+
+:autoload
+(defun forecast (prefix)
+ "Search google for \"weather\".
+With PREFIX, ask for location."
+ (interactive "P")
+ (if (not prefix) (parse-and-search-string "weather" nil)
+ (parse-and-search-string
+ (concat "weather " (read-string "Location: " nil nil "")) nil)))
+
+(defcustom keybind (kbd "C-c /")
+ "Keybinding under which `google-this-mode-submap' is assigned.
+
+To change this do something like:
+ (setq google-this-keybind (kbd \"C-x g\"))
+BEFORE activating the function `google-this-mode' and BEFORE `require'ing the
+`google-this' feature."
+ :type 'string
+ :group 'google-this
+ :package-version '(google-this . "1.4"))
+
+(defcustom modeline-indicator " Google"
+ "String to display in the modeline when command `google-this-mode' is
activated."
+ :type 'string
+ :group 'google-this
+ :package-version '(google-this . "1.8"))
+
+:autoload
+(define-minor-mode mode nil nil modeline-indicator
+ `((,keybind . ,mode-submap))
+ :global t
+ :group 'google-this)
+
+;; (setq google-this-keybind (kbd \"C-x g\"))
+)
+
+(define-obsolete-variable-alias 'google-error-regexp 'google-this-error-regexp
"1.9")
+(define-obsolete-variable-alias 'google-location-suffix
'google-this-location-suffix "1.9")
+(define-obsolete-variable-alias 'google-base-url 'google-this-base-url "1.9")
+(define-obsolete-variable-alias 'google-wrap-in-quotes
'google-this-wrap-in-quotes "1.9")
+
+;;;###autoload
+(dolist (it '("-do-lucky-search" "lucky-search-url" "string" "pick-term"
+ "url" "translate-query-or-region" "cpp-reference" "forecast"
+ "error" "line" "symbol" "word" "lucky-and-insert-url"
+ "lucky-search" "region" "search"))
+ (define-obsolete-function-alias
+ (intern (concat "google-" it))
+ (intern (concat "google-this-" it))
+ "1.9"))
+
+(provide 'google-this)
+
+;;; google-this.el ends here
diff --git a/tests/latex-extra-tests.el b/tests/latex-extra-tests.el
new file mode 100644
index 0000000..2141b07
--- /dev/null
+++ b/tests/latex-extra-tests.el
@@ -0,0 +1,71 @@
+(add-to-list 'load-path (expand-file-name "./"))
+(add-to-list 'load-path (expand-file-name "../"))
+(add-to-list 'load-path (expand-file-name "auctex-11.87.7/"))
+(add-to-list 'load-path (expand-file-name "tests/auctex-11.87.7/"))
+
+(require 'ert)
+(load "auctex-autoloads")
+(autoload 'latex-extra-mode "latex-extra")
+
+(defmacro latex/deftest (name &rest body)
+ "Define a test with point at beginning of test.tex."
+ (declare (indent 1)
+ (debug (form body)))
+ `(ert-deftest ,(intern (format "latex/test-%s" name)) ()
+ (cl-letf (((symbol-function 'message) 'ignore))
+ (with-temp-buffer
+ (insert-file-contents ,(expand-file-name "./test.tex"))
+ (add-hook 'LaTeX-mode-hook #'latex-extra-mode)
+ (latex-mode)
+ (goto-char (point-min))
+ ,@body))))
+
+(latex/deftest sections
+ (latex/next-section 3)
+ (should (looking-at "\\\\section{1}"))
+ (latex/next-section-same-level 2)
+ (should (looking-at "\\\\appendix"))
+ (latex/previous-section 1)
+ (should (looking-at "\\\\subsection{4}"))
+ (latex/up-section 2)
+ (should (looking-at "\\\\chapter{7}"))
+ (latex/next-section-same-level 1)
+ (should (looking-at "\\\\appendix")))
+
+(latex/deftest environments
+ (latex/next-section 1)
+ (forward-line 1)
+ (latex/forward-environment 2)
+ (forward-line -1)
+ (should (looking-at "\\\\end{equation}"))
+ (latex/beginning-of-environment 2)
+ (should (looking-at "\\\\begin{document}"))
+ (forward-line 1)
+ (latex/end-of-environment 1)
+ (forward-line -1)
+ (should (looking-at "\\\\end{document}")))
+
+;; (latex/deftest folding
+;; (should (search-forward "\\appendix" nil 'noerror))
+;; (goto-char (line-beginning-position))
+;; (latex/hide-show)
+;; (call-interactively 'next-line)
+;; (call-interactively 'next-line)
+;; (should (string= (thing-at-point 'line) "\\section{6}\n"))
+;; (latex/hide-show-all)
+;; (call-interactively 'previous-line)
+;; (call-interactively 'previous-line)
+;; (call-interactively 'previous-line)
+;; (call-interactively 'previous-line)
+;; (call-interactively 'previous-line)
+;; (call-interactively 'previous-line)
+;; (call-interactively 'previous-line)
+;; (should (string= (thing-at-point 'line) "\\section{2}\n")))
+
+(latex/deftest filling
+ (let ((end (point-max)))
+ (goto-char (point-min))
+ (search-forward "begin{document}" nil 'noerror)
+ (latex/clean-fill-indent-environment)
+ (write-file "out.tex")
+ (should (= (point-max) end))))
diff --git a/tests/latex-extra.el b/tests/latex-extra.el
new file mode 100644
index 0000000..ea11246
--- /dev/null
+++ b/tests/latex-extra.el
@@ -0,0 +1,929 @@
+;;; latex-extra.el --- Adds several useful functionalities to LaTeX-mode.
+
+;; Copyright (C) 2013 Artur Malabarba <bruce.connor.am@gmail.com>
+
+;; Author: Artur Malabarba <bruce.connor.am@gmail.com>>
+;; URL: http://github.com/Bruce-Connor/latex-extra
+;; Version: 1.8
+;; Keywords: tex
+;; Package-Requires: ((auctex "11.86.1") (cl-lib "0.5"))
+;;
+;; Prefix: latex
+;; Separator: /
+
+;;; Commentary:
+;;
+;; Defines extra commands and keys for LaTeX-mode. To activate (after
+;; installing from melpa) just call
+;;
+;; (add-hook 'LaTeX-mode-hook #'latex-extra-mode)
+;;
+;; The additions of this package fall into the following three
+;; categories:
+;;
+;; 1-Key Compilation
+;; =================
+;;
+;; Tired of hitting C-c C-c 4 times (latex, bibtex, latex, view) for
+;; the document to compile? This defines a much needed command that does
+;; *everything* at once, and even handles compilation errors!
+;;
+;; C-c C-a `latex/compile-commands-until-done'
+;;
+;; Navigation
+;; ==========
+;;
+;; Five new keybindings are defined for navigating between
+;; sections/chapters. These are meant to be intuitive to people familiar
+;; with `org-mode'.
+;;
+;; C-c C-n `latex/next-section'
+;; Goes forward to the next section-like command in the buffer (\part,
+;; \chapter, \(sub)section, or \(sub)paragraph, whichever comes first).
+;; C-c C-u `latex/up-section'
+;; Goes backward to the previous section-like command containing this
+;; one. For instance, if you're inside a subsection it goes up to the
+;; section that contains it.
+;; C-c C-f `latex/next-section-same-level'
+;; Like next-section, except it skips anything that's "lower-level" then
+;; the current one. For instance, if you're inside a subsection it finds
+;; the next subsection (or higher), skipping any subsubsections or
+;; paragraphs.
+;; C-M-f `latex/forward-environment'
+;; Skip over the next environment, or exit the current one, whichever
+;; comes first.
+;; C-M-e `latex/end-of-environment'
+;; Exit the current environment, and skip over some whitespace
+;; afterwards. (Like `LaTeX-find-matching-end', but a little more useful.)
+;;
+;; C-M-b `latex/backward-environment'
+;; C-M-a `latex/beginning-of-environment'
+;; C-c C-p `latex/previous-section'
+;; C-c C-b `latex/previous-section-same-level'
+;; Same as above, but go backward.
+;;
+;; Whitespace Handling
+;; ===================
+;;
+;; `latex-extra.el' improves `auto-fill-mode' so that it only applies to
+;; text, not equations. To use this improvement, just activate
+;; `auto-fill-mode' as usual.
+;;
+;; It also defines a new command:
+;;
+;; C-c C-q `latex/clean-fill-indent-environment'
+;; Completely cleans up the entire current environment. This involves:
+;;
+;; 1. Removing extraneous spaces and blank lines.
+;; 2. Filling text (and only text, not equations).
+;; 3. Indenting everything.
+
+;;; Instructions:
+;;
+;; INSTALLATION
+;;
+;; If you install from melpa: just use (as described above)
+;;
+;; (eval-after-load 'latex '(latex/setup-keybinds))
+;;
+;; If you install manually, first require it, then use the code above.
+;; (require 'latex-extra)
+
+;;; License:
+;;
+;; This file is NOT part of GNU Emacs.
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License
+;; as published by the Free Software Foundation; either version 2
+;; of the License, or (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+
+;;; Change Log:
+;; 1.8 - 2014/09/19 - Improve error buffers.
+;; 1.8 - 2014/09/13 - Org-like folding. Hide/display subtrees with
latex/hide-show.
+;; 1.8 - 2014/09/11 - Add \appendix to latex/section-hierarchy.
+;; 1.8 - 2014/09/11 - Refactor into a minor mode `latex-extra-mode'.
+;; 1.7.6 - 2014/08/11 - latex/section-regexp no longer wrongly matches things
like \partial.
+;; 1.7.5 - 2014/05/07 - Fixed next/previous-section bug at top of file.
+;; 1.7.4 - 2014/03/25 - Fixed url in latex-bug-report.
+;; 1.7.3 - 2013/12/01 - Improve region choosing for
latex/clean-fill-indent-environment.
+;; 1.7.3 - 2013/12/01 - latex/override-fill-map.
+;; 1.7.3 - 2013/12/01 - Fix next-section.
+;; 1.7.2 - 2013/11/29 - Only push-mark when interactive and region not active.
+;; 1.7.1 - 2013/11/29 - latex/do-auto-fill-p also knows "\\(".
+;; 1.7 - 2013/11/25 - latex/override-font-map.
+;; 1.6 - 2013/11/21 - latex/clean-fill-indent-environment now marks sections
as well as environments.
+;; 1.5 - 2013/11/21 - Add a couple of LaTeX-clean-intermediate-suffixes.
+;; 1.4 - 2013/11/12 - Small fix for latex/compile-commands-until-done after
bibtex.
+;; 1.3.3 - 2013/11/03 - latex/should-auto-fill-$ variable
+;; 1.3 - 2013/11/03 - latex/cleanup-do-fill controls whether to fill
+;; 1.3 - 2013/11/03 - Use texmathp instead of manually parsing for math
+;; 1.3 - 2013/11/03 - autoload latex/setup-auto-fill
+;; 1.2.3 - 2013/10/25 - More fix for latex/clean-fill-indent-environment
+;; 1.2.2 - 2013/10/23 - Fix for latex/clean-fill-indent-environment
+;; 1.2.1 - 2013/10/11 - Fixed previous section
+;; 1.2.1 - 2013/10/11 - Rename latex-customize
+;;; Code:
+
+(require 'tex)
+(require 'latex)
+(require 'tex-buf)
+(require 'texmathp)
+(require 'cl-lib)
+(require 'outline)
+(require 'names)
+
+(defconst latex-extra-version "1.8" "Version of the latex-extra.el package.")
+(defconst latex-extra-version-int 19 "Version of the latex-extra.el package,
as an integer.")
+(defun latex-bug-report ()
+ "Opens github issues page in a web browser. Please send me any bugs you
find, and please include your Emacs and latex versions."
+ (interactive)
+ (message "Your latex-version is: %s, and your emacs version is: %s.\nPlease
include this in your report!"
+ latex-extra-version emacs-version)
+ (browse-url "https://github.com/Bruce-Connor/latex-extra/issues/new";))
+(defun latex-extra-customize ()
+ "Open the customisation menu in the `latex-extra' group."
+ (interactive)
+ (customize-group 'latex-extra t))
+
+;;; Implementation
+(defun replace-regexp-everywhere (reg rep &optional start end)
+ "Version of `replace-regexp' usable in lisp code."
+ (goto-char (or start (point-min)))
+ (while (re-search-forward reg end t)
+ (replace-match rep nil nil)))
+(defun always-t (&rest x) "Return t." t)
+
+(defvar latex-extra-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [tab] #'latex/hide-show)
+ (define-key map [backtab] #'latex/hide-show-all)
+ (define-key map "" #'latex/next-section)
+ (define-key map "" #'latex/up-section)
+ (define-key map "" #'latex/compile-commands-until-done)
+ (define-key map "" #'latex/beginning-of-line)
+ (define-key map "\C-\M-e" #'latex/end-of-environment)
+ (define-key map "\C-\M-a" #'latex/beginning-of-environment)
+ (define-key map "\C-\M-b" #'latex/backward-environment)
+ (define-key map "\C-\M-f" #'latex/forward-environment)
+ (define-key map "" #'latex/previous-section-same-level)
+ map)
+ "Keymap for latex-extra-mode.")
+
+(defvar texmathp-why)
+
+(define-namespace latex/
+
+;;; Environment navigation
+(defun /found-undesired-string (dir)
+ "Decide whether the last search found the desired string."
+ (if (> dir 0)
+ (looking-back "begin")
+ (looking-at "\\\\end")))
+
+(defun /forward-arguments ()
+ "Skip forward over the arguments."
+ (when (looking-at "\\[") (forward-sexp 1))
+ (when (looking-at "{") (forward-sexp 1)))
+
+(defun /maybe-push-mark (&optional do-push)
+ "push-mark, unless it is active."
+ (unless (region-active-p)
+ (when do-push (push-mark))))
+
+(defun end-of-environment (&optional N do-push-mark)
+ "Move just past the end of the current latex environment.
+
+Leaves point outside the environment.
+Similar to `LaTeX-find-matching-end', but it accepts
+numeric (prefix) argument N and skips some whitespace after the
+closing \"\\end\".
+
+DO-PUSH-MARK defaults to t when interactive, but mark is only
+pushed if region isn't active."
+ (interactive "p\nd")
+ (/maybe-push-mark do-push-mark)
+ (let ((start (point))
+ (count (abs N))
+ (direction 1)
+ (movement-function 'LaTeX-find-matching-end))
+ (when (< N 0)
+ (setq direction -1)
+ (setq movement-function 'LaTeX-find-matching-begin))
+ (while (and (> count 0) (funcall movement-function))
+ (cl-decf count))
+ (when (> direction 0)
+ (/forward-arguments)
+ (skip-chars-forward "[:blank:]")
+ (when (looking-at "\n")
+ (forward-char 1)
+ (skip-chars-forward "[:blank:]")))
+ ;; Return t or nil
+ (cl-case count
+ (0 t)
+ (1 (message "Reached the end.") nil)
+ (t (if (> direction 0)
+ (error "Unclosed \\begin?")
+ (error "Unopened \\end?"))))))
+
+(defun forward-environment (&optional N do-push-mark)
+ "Move to the \\end of the next \\begin, or to the \\end of the current
environment (whichever comes first) N times.
+
+Never goes into deeper environments.
+
+DO-PUSH-MARK defaults to t when interactive, but mark is only
+pushed if region isn't active."
+ (interactive "p")
+ (/maybe-push-mark do-push-mark)
+ (let ((start (point))
+ (count (abs N))
+ (direction (if (< N 0) -1 1)))
+ (while (and (> count 0)
+ (re-search-forward "\\\\\\(begin\\|end\\)\\b"
+ nil t direction))
+ (cl-decf count)
+ (if (/found-undesired-string direction)
+ (unless (end-of-environment direction)
+ (error "Unmatched \\begin?"))
+ (/forward-arguments)))))
+
+(defun beginning-of-environment (&optional N do-push-mark)
+ "Move to the beginning of the current latex environment.
+
+Leaves point outside the environment.
+
+DO-PUSH-MARK defaults to t when interactive, but mark is only
+pushed if region isn't active."
+ (interactive "p")
+ (end-of-environment (- N) do-push-mark))
+
+(defun backward-environment (&optional N do-push-mark)
+ "Move to the \\begin of the next \\end, or to the \\begin of the current
environment (whichever comes first) N times.
+
+Never goes into deeper environments.
+
+DO-PUSH-MARK defaults to t when interactive, but mark is only
+pushed if region isn't active."
+ (interactive "p")
+ (forward-environment (- N) do-push-mark))
+
+
+;;;;;;;;;;;;;;;;;;;;;;
+;;; Section navigation
+(defcustom section-hierarchy
+ '("\\\\headerbox\\_>"
+ "\\\\subparagraph\\_>"
+ "\\\\paragraph\\_>"
+ "\\\\subsubsection\\_>"
+ "\\\\subsection\\_>"
+ "\\\\section\\_>"
+ "\\\\chapter\\_>"
+ "\\\\part\\_>"
+ ;; "\\\\maketitle\\_>"
+ "\\\\appendix\\_>\\|\\\\\\(begin\\|end\\){document}"
+ "\\\\documentclass\\_>"
+ )
+ "List of regexps which define what a section can be.
+
+Ordered from deepest to highest level."
+ :type '(repeat string)
+ :group 'latex-extra
+ :package-version '(latex-extra . "1.8"))
+
+(defun next-section (n &optional do-push-mark)
+ "Move N (or 1) headers forward.
+
+Header stands for any string listed in `latex/section-hierarchy'.
+
+Negative N goes backward.
+
+DO-PUSH-MARK defaults to t when interactive, but mark is only
+pushed if region isn't active."
+ (interactive "p\nd")
+ (goto-char (/find-nth-section-with-predicate n #'always-t do-push-mark)))
+
+(defun previous-section (n &optional do-push-mark)
+ "Move N (or 1) headers backward.
+
+Header stands for any string listed in `latex/section-hierarchy'.
+
+DO-PUSH-MARK defaults to t when interactive, but mark is only
+pushed if region isn't active."
+ (interactive "p\nd")
+ (goto-char (line-beginning-position))
+ (when (/header-at-point)
+ (forward-char -1))
+ (next-section (- (- n 1)) do-push-mark))
+
+(defun up-section (n &optional do-push-mark)
+ "Move backward to the header that contains the current one.
+
+Header stands for any string listed in `latex/section-hierarchy'.
+
+With prefix argument N, goes that many headers up the hierarchy.
+Negative N goes forward, but still goes \"up\" the hierarchy.
+
+DO-PUSH-MARK defaults to t when interactive, but mark is only
+pushed if region isn't active."
+ (interactive "p\nd")
+ (goto-char (/find-nth-section-with-predicate (- n) #'section< do-push-mark)))
+
+(defun next-section-same-level (n &optional do-push-mark)
+ "Move N (or 1) headers forward.
+
+Header stands for any string listed in `latex/section-hierarchy'.
+
+Negative N goes backward.
+
+DO-PUSH-MARK defaults to t when interactive, but mark is only
+pushed if region isn't active.
+
+The default binding for this key (C-c C-f) overrides a binding in
+`LaTeX-mode-map' used for inserting fonts (which is moved to
+C-c f). See the variable `latex/override-font-map' for more
+information (and how to disable this)."
+ (interactive "p\nd")
+ (goto-char (/find-nth-section-with-predicate n #'section<= do-push-mark)))
+
+(defun previous-section-same-level (n &optional do-push-mark)
+ "Move N (or 1) headers backward.
+
+Header stands for any string listed in `section-hierarchy'.
+
+DO-PUSH-MARK defaults to t when interactive, but mark is only
+pushed if region isn't active."
+ (interactive "p\nd")
+ (next-section-same-level (- n) do-push-mark))
+
+(defun /impl-previous-section ()
+ "Find the previous header, avoiding dependencies and chaining.
+Used for implementation."
+ (let ((dest
+ (save-match-data
+ (save-excursion
+ (when (looking-at "\\\\") (forward-char 1))
+ (when (search-forward-regexp (section-regexp) nil :noerror -1)
+ (match-beginning 0))))))
+ (if dest (goto-char dest) nil)))
+
+(defun /find-nth-section-with-predicate (n pred do-push-mark)
+ "Find Nth header satisfying predicate PRED, return the start of last match.
+
+If this function fails, it returns original point position (so
+you can just call it directly inside `goto-char').
+
+PRED is the symbol to a function taking two strings.
+
+Point will be moved up until the first header found. That is
+taken as the \"previous-header\". Then, the following steps will
+be repeated until PRED returns non-nil (abs N) times:
+
+1. Point will move to the next header (in the direction
+determined by the positivity of N.
+
+2. PRED will be used to compare each this header with
+\"previous-header\". It is run as:
+ (PRED PREVIOUS-HEADER CURRENT-HEADER)
+
+3. If PRED returned true, the current header is now taken as
+\"previous-header\", otherwise it is ignored."
+ (let* ((direction (if (> n 0) 1 -1))
+ (amount (* n direction))
+ (hap (/header-at-point)) ;header at point
+ (is-on-header-p hap)
+ (result
+ (save-match-data
+ (save-excursion
+ (if (or is-on-header-p (/impl-previous-section))
+ (progn
+ (setq hap (/header-at-point))
+ (when (looking-at "\\\\")
+ (unless (or (eobp) (= amount 0))
+ (forward-char 1)))
+ (while (and (> amount 0)
+ (search-forward-regexp
+ (section-regexp)
+ nil :noerror direction))
+ (save-match-data
+ (when (eval (list pred hap (/header-at-point)))
+ (setq hap (/header-at-point))
+ (cl-decf amount))))
+ (if (= amount 0)
+ ;; Finished moving
+ (match-beginning 0)
+ ;; Didn't finish moving
+ (if (= amount n)
+ (message "No sections %s! (satisfying %S)"
+ (if (> direction 0) "below" "above") pred)
+ (message "Reached the %s."
+ (if (> direction 0) "bottom" "top")))))
+ (if (< direction 0)
+ (goto-char (point-min))
+ (when (search-forward-regexp
+ (section-regexp) nil :noerror direction)
+ (match-beginning 0))))))))
+ (if (null (number-or-marker-p result))
+ (point)
+ (/maybe-push-mark do-push-mark)
+ result)))
+
+(defun /header-at-point ()
+ "Return header under point or nil, as per `latex/section-hierarchy'."
+ (save-match-data
+ (save-excursion
+ (goto-char (line-beginning-position))
+ (when (looking-at (section-regexp))
+ (match-string-no-properties 0)))))
+
+(defun section<= (x y)
+ "Non-nil if Y comes after (or is equal to) X in `latex/section-hierarchy'."
+ (cl-member-if
+ (lambda (it) (string-match it y))
+ (cl-member-if (lambda (it) (string-match it x))
+ section-hierarchy)))
+
+(defun section< (x y)
+ "Non-nil if Y comes after X in `latex/section-hierarchy'."
+ (cl-member-if
+ (lambda (it) (string-match it y))
+ (cdr-safe (cl-member-if (lambda (it) (string-match it x))
+ section-hierarchy))))
+
+(defun section-regexp ()
+ "Return a regexp matching anything in `latex/section-hierarchy'."
+ (format "^\\(%s\\)" (mapconcat #'identity section-hierarchy "\\|")))
+
+(defun beginning-of-line ()
+ "Do `LaTeX-back-to-indentation' or `beginning-of-line'."
+ (interactive)
+ (let ((bef (point)))
+ (LaTeX-back-to-indentation)
+ (when (= bef (point))
+ (beginning-of-line))))
+
+
+;;; Section Folding
+(defun hide-show ()
+ "Hide or show current header and its contents."
+ (interactive)
+ (if (/header-at-point)
+ (if (null (eq last-command 'latex/hide-show))
+ (hide-leaves)
+ (show-subtree)
+ (setq this-command nil))
+ (when (eq last-command-event 'tab)
+ (define-key latex-extra-mode-map [tab] nil)
+ (call-interactively (key-binding "\t" :accept-default))
+ (define-key latex-extra-mode-map [tab] #'hide-show))))
+
+(defun hide-show-all ()
+ "Hide or show the contents of all headers."
+ (interactive)
+ (if (null (eq last-command 'latex/hide-show-all))
+ (save-excursion
+ (goto-char (point-min))
+ (while (outline-next-heading)
+ (hide-leaves)))
+ (show-all)
+ (setq this-command nil)))
+
+
+;;; Autofilling
+(defun auto-fill-function ()
+ "Perform auto-fill unless point is inside an unsuitable environment.
+
+This function checks whether point is currently inside one of the
+LaTeX environments listed in `latex/no-autofill-environments'. If
+so, it inhibits automatic filling of the current paragraph."
+ (when (do-auto-fill-p)
+ (do-auto-fill)))
+
+(defcustom should-auto-fill-$ t
+ "If non-nil, inline math ($x=1$) will get auto-filled like text."
+ :type 'boolean
+ :group 'latex-extra
+ :package-version '(latex-extra . "1.3.2"))
+
+(defun do-auto-fill-p ()
+ "Decide whether to auto-fill in current environment."
+ (if (texmathp)
+ (if (and (stringp (car-safe texmathp-why))
+ (or (string= (car texmathp-why) "$")
+ (string= (car texmathp-why) "\\(")))
+ should-auto-fill-$
+ nil)
+ t))
+
+:autoload
+(defun setup-auto-fill ()
+ "Set the function used to fill a paragraph to `latex/auto-fill-function'."
+ (interactive)
+ (setq auto-fill-function #'auto-fill-function))
+
+;;; Whitespace cleaning
+(defcustom clean-up-whitespace t
+ "Type of whitespace to be erased by `latex/clean-fill-indent-environment'.
+
+Only excessive whitespace will be erased. That is, when there are
+two or more consecutive blank lines they are turned into one, and
+single blank lines are left untouched.
+
+This variable has 4 possible values:
+t: Erases blank lines and spaces.
+'lines: Erases blank lines only.
+'spaces: Erases spaces only.
+nil: Doesn't erase any whitespace."
+ :type '(choice (const :tag "Erases blank lines and spaces." t)
+ (const :tag "Erases blank lines only." lines)
+ (const :tag "Erases spaces only." spaces)
+ (const :tag "Doesn't erase any whitespace." nil))
+ :group 'latex-extra
+ :package-version '(latex-extra . "1.0"))
+
+(defcustom cleanup-do-fill t
+ "If nil, `latex/clean-fill-indent-environment' won't perform text-filling."
+ :type 'boolean
+ :group 'latex-extra
+ :package-version '(latex-extra . "1.3"))
+
+(defun clean-fill-indent-environment (&optional indent)
+ "Severely reorganise whitespace in current environment.
+
+ (If you want the usual binding back for \"C-c C-q\", see
`latex/override-fill-map')
+
+Performs the following actions (on current region, environment,
+or section):
+ 1. Turn multiple new-lines and spaces into single new-lines and
+ spaces, according to `latex/clean-up-whitespace'.
+ 2. Fill text, unless `latex/cleanup-do-fill' is nil.
+ 3. Indent everything.
+
+It decides where to act in the following way:
+ 1. If region is active, act on it.
+ 2. If inside an environment (other than \"document\") act on it.
+ 3. If inside a section (or chapter, subsection, etc) act on it.
+ 4. If inside a document environment, act on it.
+ 5. If neither of that happened, act on entire buffer."
+ (interactive)
+ (let (bounds)
+ (save-match-data
+ (save-excursion
+ (save-restriction
+ (setq bounds
+ (if (use-region-p)
+ (cons (region-beginning) (region-end))
+ (/bounds-of-current-thing)))
+ (setq indent (or indent (- (point) (line-beginning-position))))
+ (narrow-to-region (car bounds) (cdr bounds))
+ ;; Whitespace
+ (goto-char (point-min))
+ (when clean-up-whitespace
+ (message "Cleaning up...")
+ (unless (eq clean-up-whitespace 'lines)
(replace-regexp-everywhere " +$" ""))
+ (unless (eq clean-up-whitespace 'lines)
(replace-regexp-everywhere " +\\([^% ]\\)" " \\1"))
+ (unless (eq clean-up-whitespace 'spaces)
(replace-regexp-everywhere "\n\n\n+" "\n\n")))
+ ;; Autofill
+ (goto-char (point-min))
+ (when cleanup-do-fill
+ (let* ((size (number-to-string (length (number-to-string
(line-number-at-pos (point-max))))))
+ (message-string (concat "Filling line %" size "s / %" size
"s.")))
+ (goto-char (point-min))
+ (forward-line 1)
+ (while (not (eobp))
+ (if (do-auto-fill-p)
+ (progn (LaTeX-fill-paragraph)
+ (forward-line 1))
+ (if (and (stringp (car-safe texmathp-why))
+ (string= (car texmathp-why) "\\["))
+ (progn (search-forward "\\]")
+ (forward-line 1))
+ (end-of-environment 1)))
+ (message message-string (line-number-at-pos (point))
(line-number-at-pos (point-max))))))
+ ;; Indentation
+ (message "Indenting...")
+ (goto-char (point-min))
+ (insert (make-string indent ?\ ))
+ (setq indent (point))
+ (forward-line 1)
+ (indent-region (point) (point-max))
+ (delete-region (point-min) indent)))))
+ (message "Done."))
+
+(defun /bounds-of-current-thing ()
+ "Mark current section or environment, whichever comes first."
+ (let ((begin (save-excursion (and (ignore-errors
(LaTeX-find-matching-begin)) (point))))
+ (header (save-excursion (ignore-errors (/impl-previous-section)))))
+ (if (or begin header)
+ (progn
+ (goto-char
+ (max (or begin (point-min))
+ (or header (point-min))))
+ (cons (point)
+ (if (looking-at-p "\\\\begin\\b")
+ (save-excursion
+ (forward-environment 1)
+ (point))
+ (save-excursion
+ (let ((l (point)))
+ (next-section-same-level 1)
+ (if (= l (point)) (point-max) l))))))
+ (cons (point-min) (point-max)))))
+
+
+;;; Compilation
+(defcustom view-after-compile t
+ "Start view-command at end of `latex/compile-commands-until-done'?"
+ :type 'boolean
+ :group 'latex-extra)
+
+(defcustom max-runs 10
+ "Max number of times `TeX-command-master' can run.
+
+If it goes beyond this, we decide something's wrong.
+
+Used by `latex/compile-commands-until-done'."
+ :type 'integer
+ :group 'latex-extra)
+
+(defcustom view-skip-confirmation t
+ "If non-nil `latex/compile-commands-until-done' will NOT ask for
confirmation on the \"VIEW\" command."
+ :type 'boolean
+ :group 'latex-extra
+ :package-version '(latex-extra . "1.0"))
+(defvar count-same-command 0)
+
+(defun command-default (name)
+ "Next TeX command to use on file NAME."
+ (cond ((if (string-equal name TeX-region)
+ (TeX-check-files (concat name "." (TeX-output-extension))
+ (list name)
+ TeX-file-extensions)
+ (TeX-save-document (TeX-master-file)))
+ TeX-command-default)
+ ((and (memq major-mode '(doctex-mode latex-mode))
+ (TeX-check-files (concat name ".bbl")
+ (mapcar 'car
+ (LaTeX-bibliography-list))
+ BibTeX-file-extensions))
+ ;; We should check for bst files here as well.
+ TeX-command-BibTeX)
+ ((TeX-process-get-variable name
+ 'TeX-command-next
+ TeX-command-Show))
+ (TeX-command-Show)))
+
+(defcustom next-error-skip-confirmation nil
+ "If non-nil `latex/compile-commands-until-done' calls `TeX-next-error'
without confirmation (if there is an error, of course)."
+ :type 'boolean
+ :group 'latex-extra
+ :package-version '(latex-extra . "1.0"))
+
+(defun compile-commands-until-done (clean-first)
+ "Fully compile the current document, then view it.
+
+If there are errors, call `TeX-next-error' instead of viewing.
+
+With prefix argument CLEAN-FIRST, removes the output and
+auxiliary files before starting (by running (TeX-clean t)). This
+essentially runs the compilation on a clean slate.
+
+This command repeatedly runs `TeX-command-master' until: (1) we
+reach the VIEW command, (2) an error is found, or (3) the limit
+defined in `latex/max-runs' is reached (which indicates something
+is wrong).
+
+`latex/next-error-skip-confirmation' and
+`latex/view-skip-confirmation' can customize this command."
+ (interactive "P")
+ (when clean-first (TeX-clean t))
+ (message "Compilation started.")
+ (let* ((initial-buffer (buffer-name))
+ (TeX-process-asynchronous nil)
+ (master-file (TeX-master-file))
+ (next-command (command-default master-file))
+ (counter 0))
+ (while (and
+ (> counter -1)
+ (not (equal next-command TeX-command-Show)))
+ (when (> counter max-runs)
+ (error "Number of commands run exceeded %d (%S). Something is probably
wrong"
+ max-runs 'latex/max-runs))
+ (message "%d Doing: %s" (cl-incf counter) next-command)
+ (set-buffer initial-buffer)
+ (TeX-command next-command 'TeX-master-file)
+ (if (null (plist-get TeX-error-report-switches (intern master-file)))
+ (if (string= next-command "BibTeX")
+ (setq next-command "LaTeX")
+ (setq next-command (command-default master-file)))
+ (setq counter -1)
+ (when (or next-error-skip-confirmation
+ (y-or-n-p "Error found. Visit it? "))
+ (TeX-next-error t))))
+ (when (>= counter 0) ;;
+ (set-buffer initial-buffer)
+ (when view-after-compile
+ (if view-skip-confirmation
+ (TeX-view)
+ (TeX-command TeX-command-Show 'TeX-master-file))))))
+
+(defvar error-buffer-font-lock
+ '(("--- .* ---" 0 font-lock-keyword-face)
+ ("^l\\.[0-9]+" 0 'underline)
+ ("^\\([[:alpha:]]+\\):\\(.*\\)$"
+ (1 'compilation-warning) (2 font-lock-constant-face))
+ ("^\\(<recently read>\\) \\(.*\\)$"
+ (1 'compilation-warning) (2 font-lock-constant-face)))
+ "Font lock rules used in \"*TeX help*\" buffers.")
+
+(defadvice TeX-help-error (around latex/around-TeX-help-error-advice ()
activate)
+ "Activate `special-mode' and add font-locking in \"*TeX Help*\" buffers."
+ (if (null latex-extra-mode)
+ ad-do-it
+ (when (buffer-live-p (get-buffer "*TeX Help*"))
+ (kill-buffer (get-buffer "*TeX Help*")))
+ ad-do-it
+ (when (buffer-live-p (get-buffer "*TeX Help*"))
+ (with-current-buffer (get-buffer "*TeX Help*")
+ (special-mode)
+ (let ((inhibit-read-only t))
+ (font-lock-add-keywords nil latex/error-buffer-font-lock)
+ (font-lock-ensure))))))
+
+
+;;; Setup and minor mode
+(defcustom override-preview-map t
+ "If non-nil, move the `preview-map' in LaTeX-mode from \"C-c C-p\" to \"C-c
p\".
+
+This this key is needed bind for `latex/previous-section'.
+
+If you set this to nil, we won't bind the command
+`latex/previous-section' to anything (it would be usually bound
+to \"C-c C-p\"), so it will be up to you to bind it to something
+else."
+ :type 'boolean
+ :group 'latex-extra
+ :package-version '(latex-extra . "1.0"))
+
+(defun /rebind-font-list ()
+ "Make add keys to `TeX-font-list' that don't use control."
+ (when (boundp 'TeX-font-list)
+ (mapc (lambda (x)
+ (when (< (car x) 97)
+ (setq LaTeX-font-list
+ (append (list (cons (+ 96 (car x)) (cdr x)))
+ LaTeX-font-list))))
+ LaTeX-font-list)))
+
+(defcustom override-font-map t
+ "Should we rebind `TeX-font' to \"C-c f\"?
+
+This is necessary because the usual keybind conflicts with
+`latex/next-section-same-level'. If this is non-nil, we also
+reconfigure `TeX-font-list' so that you can insert fonts without
+holding control.
+
+If you set this to nil, we won't bind the command
+`latex/next-section-same-level' to anything (it would be usually
+bound to \"C-c C-f\"), so it will be up to you to bind it to
+something else."
+ :type 'boolean
+ :group 'latex-extra
+ :package-version '(latex-extra . "1.7"))
+(defvaralias 'latex/override-font-list 'latex/override-font-map)
+
+(defcustom override-fill-map t
+ "If non-nil, `latex/clean-fill-indent-environment' will be bound to \"C-c
C-q\".
+
+The reason someone what want to disable this, is that \"C-c C-q\"
+is usually a prefix key for 4 other functions:
+ C-e: LaTeX-fill-environment
+ C-p: LaTeX-fill-paragraph
+ C-r: LaTeX-fill-region
+ C-s: LaTeX-fill-section
+
+The reason we take the liberty of overriding this keymap by
+default is that, `LaTeX-fill-paragraph' is already bound to `M-q'
+and the 3 other functions are essentially contained in
+`latex/clean-fill-indent-environment' (read its documentation for
+more information).
+
+If you set this to nil, we won't bind the command
+`latex/clean-fill-indent-environment' to anything (it would be
+usually bound to \"C-c C-p\"), so it will be up to you to bind it
+to something else."
+ :type 'boolean
+ :group 'latex-extra
+ :package-version '(latex-extra . "1.7.3"))
+
+(declare-function preview-map "preview")
+(defun setup ()
+ "Prepare all latex-extra features."
+ (add-hook 'latex-extra-mode-hook #'setup-auto-fill)
+ (add-to-list 'LaTeX-clean-intermediate-suffixes "\\.tdo") ;todonotes package
+ (add-to-list 'LaTeX-clean-intermediate-suffixes "Notes\\.bib") ;revtex
package
+ (if (null override-fill-map)
+ (define-key latex-extra-mode-map "" nil)
+ (define-key latex-extra-mode-map "" #'clean-fill-indent-environment))
+ (if (null override-font-map)
+ (define-key latex-extra-mode-map "" nil)
+ (message "%S changed to \"C-c f\"." 'TeX-font)
+ (define-key latex-extra-mode-map "" #'next-section-same-level)
+ (define-key latex-extra-mode-map "f" #'TeX-font))
+ (/rebind-font-list)
+ (if (null override-preview-map)
+ (define-key latex-extra-mode-map "" nil)
+ (message "%S changed to \"C-c p\"." 'preview-map)
+ (define-key latex-extra-mode-map "" #'previous-section)
+ (define-key latex-extra-mode-map "p" #'preview-map)))
+
+:autoload
+(defun setup-keybinds ()
+ "Obsolete function. Use (add-hook 'LaTeX-mode-hook #'latex-extra-mode)
instead."
+ (interactive)
+ (declare (obsolete "use (add-hook 'LaTeX-mode-hook #'latex-extra-mode)
instead." "1.8"))
+ (add-hook 'LaTeX-mode-hook #'latex-extra-mode))
+
+)
+
+;;;###autoload
+(define-minor-mode latex-extra-mode
+ "Defines extra commands and keys for LaTeX-mode.
+
+To activate just call
+ (add-hook 'LaTeX-mode-hook #'latex-extra-mode)
+
+The additions of this package fall into the following three
+categories:
+
+1-Key Compilation
+=================
+
+Tired of hitting C-c C-c 4 times (latex, bibtex, latex, view) for
+the document to compile? This defines a much needed command that does
+*everything* at once, and even handles compilation errors!
+
+ C-c C-a `latex/compile-commands-until-done'
+
+Navigation
+==========
+
+Five new keybindings are defined for navigating between
+sections/chapters. These are meant to be intuitive to people familiar
+with `org-mode'.
+
+ C-c C-n `latex/next-section'
+ Goes forward to the next section-like command in the buffer (\part,
+ \chapter, \(sub)section, or \(sub)paragraph, whichever comes first).
+ C-c C-u `latex/up-section'
+ Goes backward to the previous section-like command containing this
+ one. For instance, if you're inside a subsection it goes up to the
+ section that contains it.
+ C-c C-f `latex/next-section-same-level'
+ Like next-section, except it skips anything that's \"lower-level\" then
+ the current one. For instance, if you're inside a subsection it finds
+ the next subsection (or higher), skipping any subsubsections or
+ paragraphs.
+ C-M-f `latex/forward-environment'
+ Skip over the next environment, or exit the current one, whichever
+ comes first.
+ C-M-e `latex/end-of-environment'
+ Exit the current environment, and skip over some whitespace
+ afterwards. (Like `LaTeX-find-matching-end', but a little more useful.)
+
+ C-M-b `latex/backward-environment'
+ C-M-a `latex/beginning-of-environment'
+ C-c C-p `latex/previous-section'
+ C-c C-b `latex/previous-section-same-level'
+ Same as above, but go backward.
+
+Whitespace Handling
+===================
+
+`latex-extra.el' improves `auto-fill-mode' so that it only applies to
+text, not equations. To use this improvement, just activate
+`auto-fill-mode' as usual.
+
+It also defines a new command:
+
+ C-c C-q `latex/clean-fill-indent-environment'
+ Completely cleans up the entire current environment. This involves:
+
+ 1. Removing extraneous spaces and blank lines.
+ 2. Filling text (and only text, not equations).
+ 3. Indenting everything."
+ nil " TeXtra" latex-extra-mode-map
+ :global nil
+ :group 'latex-extra
+
+ (when latex-extra-mode
+ (latex/setup)))
+
+(provide 'latex-extra)
+
+;;; latex-extra.el ends here
diff --git a/tests/macro-test-aux.el b/tests/macro-test-aux.el
new file mode 100644
index 0000000..d2b2e70
--- /dev/null
+++ b/tests/macro-test-aux.el
@@ -0,0 +1,51 @@
+(require 'names)
+
+(defmacro !cdr (list)
+ "Destructive: Set LIST to the cdr of LIST."
+ `(setq ,list (cdr ,list)))
+
+(define-namespace test-
+(defmacro each (list &rest body)
+ (declare (debug (form body))
+ (indent 1))
+ (let ((l (make-symbol "list")))
+ `(let ((,l ,list)
+ (it-index 0))
+ (while ,l
+ (let ((it (car ,l)))
+ ,@body)
+ (setq it-index (1+ it-index))
+ (!cdr ,l)))))
+
+(defun message ()
+ (let ((out))
+ (each
+ '(1 2 3 4)
+ (push (format "%s" it) out))
+ out)))
+
+;; (progn
+;; (defmacro la-each (list &rest body)
+;; (declare (debug (form body))
+;; (indent 1))
+;; (let ((l (make-symbol "list")))
+;; `(let ((,l ,list)
+;; (it-index 0))
+;; (while ,l
+;; (let ((it (car ,l)))
+;; ,@body)
+;; (setq it-index (1+ it-index))
+;; (!cdr ,l)))))
+;; (defmacro lo-each (list &rest body)
+;; (declare (debug (form body))
+;; (indent 1))
+;; `(la-each ,list ,@body)))
+;; (progn
+;; (defun la-message ()
+;; (let ((out))
+;; (lo-each
+;; '(1 2 3 4)
+;; (push (format "%s" it) out))
+;; out)))
+
+(provide 'macro-test-aux)
diff --git a/tests/names-tests.el b/tests/names-tests.el
new file mode 100644
index 0000000..6cf3d4d
--- /dev/null
+++ b/tests/names-tests.el
@@ -0,0 +1,292 @@
+(require 'names)
+
+(unless (fboundp 'macrop)
+ (defalias 'macrop #'names--compat-macrop))
+
+(defmacro names-deftest (name doc &rest body)
+ "Test if (namespace NAME FORMS-A) is the same as FORM-B."
+ (declare (indent defun)
+ (debug (&rest sexp)))
+ `(ert-deftest
+ ,(intern (format "names-%s" name)) () ,doc
+ ,@(let (out)
+ (while body
+ (push `(should (equal
+ (macroexpand-all '(define-namespace a- ,@(pop
body)))
+ (macroexpand-all '(progn ,@(pop body)))))
+ out))
+ out)))
+
+(defadvice ert--pp-with-indentation-and-newline (around print-level activate)
+ "Display full sexp in *ert* buffer."
+ (let ((print-level nil)) ad-do-it))
+
+(names-deftest rename-defuns
+ "Test that definitions are namespaced."
+ ((defun foo0 () 1))
+ ((defun a-foo0 () 1))
+ ((defmacro foo2 () 1))
+ ((defmacro a-foo2 () 1))
+ ((defalias 'foo4 'something-else))
+ ((defalias 'foo4 'something-else)))
+
+(names-deftest rename-defvars
+ "Test that definitions are namespaced."
+ ((defvar foo1 1))
+ ((defvar a-foo1 1))
+ ((defconst foo3 1))
+ ((defconst a-foo3 1))
+ ((defcustom foo4 1 "doc"))
+ ((defcustom a-foo4 1 "doc"))
+ ((defvaralias 'foo4 'something-else))
+ ((defvaralias 'foo4 'something-else)))
+
+(names-deftest defun-mass-rename
+ "Test that definitions are namespaced."
+ ((defun foo0 () 1)
+ (defvar foo1 1)
+ (defmacro foo2 () 1)
+ (defconst foo3 1)
+ (defcustom foo4 1 "doc")
+ (defvaralias 'foo4 'something-else)
+ (defalias 'foo0 'something-else)
+ (defalias #'foo0 #'something-else))
+ ((defun a-foo0 () 1)
+ (defvar a-foo1 1)
+ (defmacro a-foo2 () 1)
+ (defconst a-foo3 1)
+ (defcustom a-foo4 1 "doc")
+ (defvaralias 'foo4 'something-else)
+ (defalias 'foo0 'something-else)
+ (defalias #'a-foo0 #'something-else)))
+
+(names-deftest external-unchanged
+ "Test that external function calls are not rewritten."
+ ((defun foo () (message "hello world!")))
+ ((defun a-foo () (message "hello world!"))))
+
+(names-deftest reference-other-internal
+ "Test that one function within a namespace can call another with qualifying
the name."
+ ((defun bar () (foo))
+ (defun foo () (message "hello world!")))
+ ((defun a-bar () (a-foo))
+ (defun a-foo () (message "hello world!"))))
+
+(names-deftest function-form
+ "Test #' behaviour."
+ ;; Undefined
+ ((defalias #'foo0 #'foo1))
+ ((defalias #'foo0 #'foo1))
+ ;; Defined
+ ((defun foo0 () 1)
+ (defun foo1 () 1)
+ (defalias #'foo0 #'foo1))
+ ((defun a-foo0 () 1)
+ (defun a-foo1 () 1)
+ (defalias #'a-foo0 #'a-foo1))
+ ;; And the keyword
+ (:dont-assume-function-quote
+ (defun foo0 () 1)
+ (defun foo1 () 1)
+ (defalias #'foo0 #'foo1))
+ ((defun a-foo0 () 1)
+ (defun a-foo1 () 1)
+ (defalias #'foo0 #'foo1)))
+
+(names-deftest quote-form
+ "Test ' behaviour."
+ ;; Undefined
+ ((defvaralias 'foo0 'foo1))
+ ((defvaralias 'foo0 'foo1))
+ ;; Defined
+ ((defvar foo0 1)
+ (defvar foo1 1)
+ (defvaralias 'foo0 'foo1)
+ (defvaralias #'foo2 #'foo3))
+ ((defvar a-foo0 1)
+ (defvar a-foo1 1)
+ (defvaralias 'foo0 'foo1)
+ (defvaralias #'foo2 #'foo3))
+ ;; And the keyword
+ (:assume-var-quote
+ (defun foo0 () 1)
+ (defcustom foo1 1 "")
+ (defvaralias 'foo0 'foo1)
+ (defvaralias 'a-foo2 #'foo1))
+ ((defun a-foo0 () 1)
+ (defcustom a-foo1 1 "")
+ (defvaralias 'foo0 'a-foo1)
+ (defvaralias 'a-foo2 #'foo1)))
+
+(names-deftest let-vars
+ "Test letbound variables."
+ ;; Neither a-c nor a-b exist
+ (:no-let-vars
+ (defun foo () (let ((c b)) c)))
+ ((defun a-foo () (let ((c b)) c)))
+ ;; Both a-c and a-b exist, but no keyword.
+ ((defvar c nil "")
+ (defvar b nil "")
+ (defun foo () (let ((c b)) c)))
+ ((defvar a-c nil "")
+ (defvar a-b nil "")
+ (defun a-foo () (let ((a-c a-b)) a-c)))
+ ;; Both a-c and a-b exist
+ (:no-let-vars
+ (defvar c nil "")
+ (defvar b nil "")
+ (defun foo () (let ((c b)) c)))
+ ((defvar a-c nil "")
+ (defvar a-b nil "")
+ (defun a-foo () (let ((c a-b)) c))))
+
+(names-deftest backtick
+ "Test \` form."
+ ;; Unfortunately, our edebug hack adds a progn around the form.
+ ((defvar c nil "")
+ (defun b nil "")
+ (defun foo () `(a b c ,@(a (b) c b (c)) ,(b) ,b ,(c) ,c)))
+ ((defvar a-c nil "")
+ (defun a-b nil "")
+ (defun a-foo () (progn `(a b c ,@(a (a-b) a-c b (c)) ,(a-b) ,b ,(c)
,a-c)))))
+
+(defun a-baz () "")
+(defvar a-bio nil "")
+
+(names-deftest global
+ "Test :global keyword."
+ (:global
+ (defun foo () (let ((c bio)) (baz))))
+ ((defun a-foo () (let ((c a-bio)) (a-baz)))))
+
+(unless (fboundp 'string-prefix-p)
+ (defun stringp-prefix-p (x y)
+ ""
+ (string-match (concat "\\`" x) y)))
+
+(add-to-list 'load-path (expand-file-name "./elnode/"))
+
+(defun deep-search-debug (x)
+ "Look for symbols starting with \"edebug-\"."
+ (when x
+ (cond
+ ((consp x)
+ (or (deep-search-debug (car x))
+ (deep-search-debug (cdr x)))
+ ;; (apply 'append
+ ;; (mapcar #'deep-search-debug x))
+ )
+ ((symbolp x)
+ (when (string-prefix-p "edebug-" (symbol-name x))
+ x))
+ (t nil))))
+
+(defun names--find-edebug-traces (sym)
+ ""
+ (let* ((fun (indirect-function sym))
+ (symbol-vec))
+ (when (macrop fun)
+ (setq fun (cdr fun)))
+ (condition-case er
+ (cond
+ ((subrp fun) nil)
+ ((listp fun)
+ (deep-search-debug fun))
+ ((vectorp fun)
+ (setq symbol-vec
+ (aref (or (cdr-safe fun) fun) 2))
+ (append
+ (remove-if
+ (lambda (x) (or (null (symbolp x))
+ (null (string-prefix-p "edebug-" (symbol-name
sym)))))
+ symbol-vec)
+ nil)))
+ (error
+ (error "Symbol: %s\nFunction: %s\nError: %s"
+ sym fun er)))))
+
+(ert-deftest no-leftover-edebug ()
+ "Test no edebug leftover in function definitions."
+ (let ((names--verbose nil))
+ (dolist (lib '((s "s-" "s.el")
+ (dash "-" "dash.el")
+ (elnode "elnode/" "elnode/elnode.el")))
+ ;; (byte-compile-file (nth 2 lib))
+ (require (car lib))
+ (should
+ (equal (loop for x being the symbols
+ if (fboundp x)
+ if (string-prefix-p (cadr lib) (symbol-name x))
+ if (names--find-edebug-traces x)
+ collect x)
+ nil)))))
+
+(defvar macro-file (expand-file-name "./macro-test-aux.el"))
+
+(ert-deftest macro-expansion ()
+ "Test macros work."
+ (setq byte-compile-error-on-warn t)
+ (byte-compile-file macro-file)
+ (require 'macro-test-aux)
+ (should
+ (equal (test-message) '("4" "3" "2" "1"))))
+
+(names-deftest version
+ "Test :version."
+ (:version
+ "1.2" :package aim
+ (defun foo () (let ((c b)) c)))
+ ((defconst a-version "1.2" "Version of the aim package.")
+ (defun a-version () "Version of the aim package." (interactive) (message
"aim version: 1.2") "1.2")
+ (defun a-foo () (let ((c b)) c)))
+ (:version
+ "1.2"
+ (defun foo () (let ((c b)) c)))
+ ((defconst a-version "1.2" "Version of the a package.")
+ (defun a-version () "Version of the a package." (interactive) (message "a
version: 1.2") "1.2")
+ (defun a-foo () (let ((c b)) c))))
+
+(names-deftest cl-letf
+ "Test :version."
+ ((defcustom hi 1 "hi" :type 'boolean :group 'names-tests :package-version
'(names-tests . ""))
+ (defun ok () nil)
+ (cl-letf ()
+ hi
+ (ok)))
+ ((defcustom a-hi 1 "hi" :type 'boolean :group 'names-tests :package-version
'(names-tests . ""))
+ (defun a-ok () nil)
+ (progn
+ (cl-letf ()
+ a-hi
+ (a-ok)))))
+
+(names-deftest group
+ "Test :version."
+ (:group
+ indent :package aim
+ (defcustom hi 1 "hi" :type 'boolean :group 'names-tests :package-version
'(names-tests . ""))
+ (defcustom ok 1 "hi" :type 'boolean :package-version '(names-tests . "")))
+ ((defgroup aim nil "Customization group for aim." :prefix "a-" :group
'indent)
+ (defcustom a-hi 1 "hi" :type 'boolean :group 'names-tests :package-version
'(names-tests . ""))
+ (defcustom a-ok 1 "hi" :type 'boolean :package-version '(names-tests . "")
:group 'aim))
+ (:group
+ indent
+ (defcustom hi 1 "hi" :type 'boolean :group 'names-tests :package-version
'(names-tests . ""))
+ (defcustom ok 1 "hi" :type 'boolean :package-version '(names-tests . "")))
+ ((defgroup a nil "Customization group for a." :prefix "a-" :group 'indent)
+ (defcustom a-hi 1 "hi" :type 'boolean :group 'names-tests :package-version
'(names-tests . ""))
+ (defcustom a-ok 1 "hi" :type 'boolean :package-version '(names-tests . "")
:group 'a)))
+
+(names-deftest functionlike-macros
+ ""
+ (:functionlike-macros
+ (thread-first ->>)
+ (defvar var nil)
+ (defun fun (x &optional y) (concat x y))
+ (thread-first (fun "some string" var) (fun var) fun)
+ (->> "some string" (fun var) fun))
+ ((defvar a-var nil)
+ (defun a-fun (x &optional y) (concat x y))
+ (thread-first (a-fun "some string" a-var) (a-fun a-var) fun)
+ (->> "some string" (a-fun a-var) fun)))
+
diff --git a/tests/noflet.el b/tests/noflet.el
new file mode 100644
index 0000000..70437ff
--- /dev/null
+++ b/tests/noflet.el
@@ -0,0 +1,157 @@
+;;; noflet.el --- locally override functions
+
+;; Copyright (C) 2013 Nic Ferrier
+
+;; Author: Nic Ferrier <nferrier@ferrier.me.uk>
+;; Keywords: lisp
+;; Version: 20140202.1451
+;; X-Original-Version: 0.0.11
+;; Url: https://github.com/nicferrier/emacs-noflet
+
+;; 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 let's you locally override functions, in the manner of `flet',
+;; but with access to the original function through the symbol:
+;; `this-fn'.
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(defun noflet|base ()
+ "A base function."
+ :noflet)
+
+(defun noflet|expand (bindings &rest forms)
+ "Expand BINDINGS and evaluate FORMS.
+
+Used by `noflet' to expand it's contents.
+
+Example:
+
+ (noflet|expand
+ '((find-file-noselect (file-name)
+ (if t
+ (this-fn \"/tmp/mytest\")
+ (this-fn file-name)))
+ (expand-file-name (file-name &optional thing)
+ (if t
+ (concat \"/tmp/\" file-name)
+ (funcall this-fn file-name thing))))
+ '(progn (expand-file-name \"/home/nferrier/thing\")))
+
+It should not be necessary ever to call this. Hence the exotic
+name."
+ (let*
+ ((fsets
+ (cl-loop
+ for i in bindings
+ collect
+ (cl-destructuring-bind (name args &rest body) i
+ (let ((saved-func-namev (make-symbol "saved-func-name")))
+ (let ((saved-func-namev
+ (intern (format "saved-func-%s"
+ (symbol-name name)))))
+ `(fset (quote ,name)
+ (lambda ,args
+ (let ((this-fn ,saved-func-namev))
+ ,@body))))))))
+ (fresets
+ (cl-loop
+ for i in bindings
+ collect
+ (cl-destructuring-bind (name args &rest body) i
+ (let ((saved-func-namev (make-symbol "saved-func-name")))
+ (let ((saved-func-namev
+ (intern (format "saved-func-%s"
+ (symbol-name name)))))
+ `(if
+ (eq (symbol-function (quote noflet|base))
+ ,saved-func-namev)
+ (fmakunbound (quote ,name))
+ (fset (quote ,name) ,saved-func-namev)))))))
+ (lets
+ (cl-loop
+ for i in bindings
+ collect
+ (cl-destructuring-bind (name args &rest body) i
+ (let ((saved-func-namev (make-symbol "saved-func-name")))
+ (let ((saved-func-namev
+ (intern (format "saved-func-%s"
+ (symbol-name name)))))
+ `(,saved-func-namev
+ (condition-case err
+ (symbol-function (quote ,name))
+ (void-function
+ (symbol-function (quote noflet|base)))))))))))
+ `(let ,lets
+ (unwind-protect
+ (progn
+ (progn ,@fsets)
+ ,@forms)
+ (progn ,@fresets)))))
+
+(defun noflet-indent-func (pos &rest state)
+ "Deliver sensible indenting for flet like functions."
+ ;; (message "pos: %s state: %s" pos state)
+ (save-excursion
+ (goto-char (elt (car state) 1))
+ (+ 2
+ (- (point)
+ (line-beginning-position)))))
+
+(defmacro noflet (bindings &rest body)
+ "Make local function BINDINGS allowing access to the original.
+
+Each of the BINDINGS is done like in `flet':
+
+ (noflet
+ ((expand-file-name (file-name &optional default-dir)
+ (concat defaulr-dir file-name)))
+ (expand-file-name \"~/test\"))
+
+In each of the BINDINGS the original function is accessible with
+the name `this-fn':
+
+ (noflet
+ ((expand-file-name (file-name &optional default-dir)
+ (if (string-match-p \"/fake.*\" file-name)
+ (concat default-dir file-name)
+ (funcall this-fn file-name default-dir))))
+ (expand-file-name \"~/test\"))
+
+This is great for overriding in testing and such like.
+
+If new bindings are introduced the binding is discarded upon
+exit. Even with new bindings there is still a `this-fn'. It
+points to `noflet|base' for all new bindings."
+ (declare (debug ((&rest (cl-defun)) cl-declarations body))
+ (indent noflet-indent-func))
+ (apply 'noflet|expand bindings body))
+
+(defmacro nolexflet (bindings &rest body)
+ "Lexical version.
+
+This only exists as an alias for `cl-flet' because Emacs
+maintainers refuse to add the correct indentation spec to
+`cl-flet'."
+ (declare (debug ((&rest (cl-defun)) cl-declarations body))
+ (indent noflet-indent-func))
+ `(cl-flet ,bindings ,@body))
+
+(provide 'noflet)
+
+;;; noflet.el ends here
diff --git a/tests/run-tests.sh b/tests/run-tests.sh
new file mode 100755
index 0000000..fb1f608
--- /dev/null
+++ b/tests/run-tests.sh
@@ -0,0 +1,14 @@
+#!/usr/bin/env bash
+
+if [ -z "$EMACS" ] ; then
+ EMACS="emacs"
+fi
+
+if [[ -n "$1" ]] ; then
+ $EMACS -batch -l tests.el -l "$1" -f ert-run-tests-batch-and-exit || rc=$?
+else
+ for n in *-tests.el; do
+ $EMACS -batch -l tests.el -l "$n" -f ert-run-tests-batch-and-exit ||
exit 1;
+ done;
+fi
+exit $rc
diff --git a/tests/s-tests.el b/tests/s-tests.el
new file mode 100644
index 0000000..d97af80
--- /dev/null
+++ b/tests/s-tests.el
@@ -0,0 +1,375 @@
+
+(byte-compile-file "s.el")
+(require 's)
+
+(ert-deftest s-trim ()
+ (should (equal (s-trim "trim ") "trim"))
+ (should (equal (s-trim " this") "this"))
+ (should (equal (s-trim " only trims beg and end ") "only trims beg and
end")))
+
+(ert-deftest s-trim-left ()
+ (should (equal (s-trim-left "trim ") "trim "))
+ (should (equal (s-trim-left " this") "this")))
+
+(ert-deftest s-trim-right ()
+ (should (equal (s-trim-right "trim ") "trim"))
+ (should (equal (s-trim-right " this") " this")))
+
+(ert-deftest s-chomp ()
+ (should (equal (s-chomp "no newlines\n") "no newlines"))
+ (should (equal (s-chomp "no newlines\r\n") "no newlines"))
+ (should (equal (s-chomp "some newlines\n\n") "some newlines\n")))
+
+(ert-deftest s-collapse-whitespace ()
+ (should (equal (s-collapse-whitespace "only one space please") "only one
space please"))
+ (should (equal (s-collapse-whitespace "collapse \n all \t sorts of \r
whitespace") "collapse all sorts of whitespace")))
+
+(ert-deftest s-word-wrap ()
+ (should (equal (s-word-wrap 10 "This is too long") "This is\ntoo long"))
+ (should (equal (s-word-wrap 10 "This is way way too long") "This is\nway
way\ntoo long"))
+ (should (equal (s-word-wrap 10 "It-wraps-words-but-does-not-break-them")
"It-wraps-words-but-does-not-break-them")))
+
+(ert-deftest s-center ()
+ (should (equal (s-center 5 "a") " a "))
+ (should (equal (s-center 5 "ab") " ab "))
+ (should (equal (s-center 1 "abc") "abc"))
+ (should (equal (s-center 6 "ab") " ab ")))
+
+(ert-deftest s-pad-left ()
+ (should (equal (s-pad-left 3 "0" "3") "003"))
+ (should (equal (s-pad-left 3 "0" "23") "023"))
+ (should (equal (s-pad-left 3 "0" "1234") "1234")))
+
+(ert-deftest s-pad-right ()
+ (should (equal (s-pad-right 3 "." "3") "3.."))
+ (should (equal (s-pad-right 3 "." "23") "23."))
+ (should (equal (s-pad-right 3 "." "1234") "1234")))
+
+(ert-deftest s-truncate ()
+ (should (equal (s-truncate 6 "This is too long") "Thi..."))
+ (should (equal (s-truncate 16 "This is also too long") "This is also ..."))
+ (should (equal (s-truncate 16 "But this is not!") "But this is not!")))
+
+(ert-deftest s-left ()
+ (should (equal (s-left 3 "lib/file.js") "lib"))
+ (should (equal (s-left 3 "li") "li")))
+
+(ert-deftest s-right ()
+ (should (equal (s-right 3 "lib/file.js") ".js"))
+ (should (equal (s-right 3 "li") "li")))
+
+(ert-deftest s-chop-suffix ()
+ (should (equal (s-chop-suffix "-test.js" "penguin-test.js") "penguin"))
+ (should (equal (s-chop-suffix "\n" "no newlines\n") "no newlines"))
+ (should (equal (s-chop-suffix "\n" "some newlines\n\n") "some newlines\n")))
+
+(ert-deftest s-chop-suffixes ()
+ (should (equal (s-chop-suffixes '("_test.js" "-test.js" "Test.js")
"penguin-test.js") "penguin"))
+ (should (equal (s-chop-suffixes '("\r" "\n") "penguin\r\n") "penguin\r"))
+ (should (equal (s-chop-suffixes '("\n" "\r") "penguin\r\n") "penguin")))
+
+(ert-deftest s-chop-prefix ()
+ (should (equal (s-chop-prefix "/tmp" "/tmp/file.js") "/file.js"))
+ (should (equal (s-chop-prefix "/tmp" "/tmp/tmp/file.js") "/tmp/file.js")))
+
+(ert-deftest s-chop-prefixes ()
+ (should (equal (s-chop-prefixes '("/tmp" "/my") "/tmp/my/file.js")
"/file.js"))
+ (should (equal (s-chop-prefixes '("/my" "/tmp") "/tmp/my/file.js")
"/my/file.js")))
+
+(ert-deftest s-shared-start ()
+ (should (equal (s-shared-start "bar" "baz") "ba"))
+ (should (equal (s-shared-start "foobar" "foo") "foo"))
+ (should (equal (s-shared-start "bar" "foo") ""))
+ (should (equal (s-shared-start "" "foo") ""))
+ (should (equal (s-shared-start "foo" "foo") "foo"))
+ (should (equal (s-shared-start "" "") "")))
+
+(ert-deftest s-shared-end ()
+ (should (equal (s-shared-end "bar" "var") "ar"))
+ (should (equal (s-shared-end "foo" "foo") "foo"))
+ (should (equal (s-shared-end "bar" "foo") ""))
+ (should (equal (s-shared-end "" "foo") ""))
+ (should (equal (s-shared-end "" "") "")))
+
+(ert-deftest s-repeat ()
+ (should (equal (s-repeat 10 " ") " "))
+ (should (equal (s-concat (s-repeat 8 "Na") " Batman!") "NaNaNaNaNaNaNaNa
Batman!")))
+
+(ert-deftest s-concat ()
+ (should (equal (s-concat "abc" "def" "ghi") "abcdefghi")))
+
+(ert-deftest s-prepend ()
+ (should (equal (s-prepend "abc" "def") "abcdef")))
+
+(ert-deftest s-append ()
+ (should (equal (s-append "abc" "def") "defabc")))
+
+(ert-deftest s-lines ()
+ (should (equal (s-lines "abc\ndef\nghi") '("abc" "def" "ghi")))
+ (should (equal (s-lines "abc\rdef\rghi") '("abc" "def" "ghi")))
+ (should (equal (s-lines "abc\r\ndef\r\nghi") '("abc" "def" "ghi"))))
+
+(ert-deftest s-match ()
+ (should (equal (s-match "^def" "abcdefg") nil))
+ (should (equal (s-match "^abc" "abcdefg") '("abc")))
+ (should (equal (s-match "^/.*/\\([a-z]+\\)\\.\\([a-z]+\\)"
"/some/weird/file.html") '("/some/weird/file.html" "file" "html")))
+ (should (equal (s-match "^/.*/\\([a-z]+\\)\\.\\([a-z]+\\)"
"/some/weird/file.org") '("/some/weird/file.org" "file" "org")))
+ (should (equal (s-match "^\\(abc\\)\\(def\\)?" "abcdef") '("abcdef" "abc"
"def")))
+ (should (equal (s-match "^\\(abc\\)\\(def\\)?" "abc") '("abc" "abc")))
+ (should (equal (s-match "^\\(abc\\)\\(def\\)?\\(ghi\\)" "abcghi") '("abcghi"
"abc" nil "ghi")))
+ (should (equal (s-match "abc" "abcdef" 1) nil))
+ (should (equal (s-match "abc" "abcdefabc" 2) '("abc"))))
+
+(ert-deftest s-match-strings-all ()
+ (should (equal (s-match-strings-all
+ "{\\([^}]+\\)}" "x is {x} and y is {y}") '(("{x}" "x")
("{y}" "y"))))
+ (should (equal (s-match-strings-all "ab." "abXabY") '(("abX") ("abY"))))
+ (should (equal (s-match-strings-all "\\<" "foo bar baz") '(("") ("") ("")))))
+
+(ert-deftest s-slice-at ()
+ (should (equal (s-slice-at "-" "abc") '("abc")))
+ (should (equal (s-slice-at "-" "abc-def") '("abc" "-def")))
+ (should (equal (s-slice-at "[\.#]" "abc.def.ghi#id") '("abc" ".def" ".ghi"
"#id")))
+ (should (equal (s-slice-at "-" "abc-def-") '("abc" "-def" "-"))))
+
+(ert-deftest s-split ()
+ (should (equal (s-split "|" "a|bc|12|3") '("a" "bc" "12" "3")))
+ (should (equal (s-split ":" "a,c,d") '("a,c,d")))
+ (should (equal (s-split "\n" "z\nefg\n") '("z" "efg" "")))
+ (should (equal (s-split "\n" "z\nefg\n" t) '("z" "efg")))
+ (should (equal (s-split "ö" "xyöözeföklmö") '("xy" "" "zef" "klm" "")))
+ (should (equal (s-split "ö" "xyöözeföklmö" t) '("xy" "zef" "klm"))))
+
+(ert-deftest s-join ()
+ (should (equal (s-join "+" '("abc" "def" "ghi")) "abc+def+ghi"))
+ (should (equal (s-join "\n" '("abc" "def" "ghi")) "abc\ndef\nghi")))
+
+(ert-deftest s-equals? ()
+ (should (equal (s-equals? "abc" "ABC") nil))
+ (should (equal (s-equals? "abc" "abc") t)))
+
+(ert-deftest s-less? ()
+ (should (equal (s-less? "abc" "abd") t))
+ (should (equal (s-less? "abd" "abc") nil))
+ (should (equal (s-less? "abc" "abc") nil)))
+
+(ert-deftest s-matches? ()
+ (should (equal (s-matches? "^[0-9]+$" "123") t))
+ (should (equal (s-matches? "^[0-9]+$" "a123") nil))
+ (should (equal (s-matches? "1" "1a" 1) nil))
+ (should (equal (s-matches? "1" "1a1" 1) t)))
+
+(ert-deftest s-blank? ()
+ (should (equal (s-blank? "") t))
+ (should (equal (s-blank? nil) t))
+ (should (equal (s-blank? " ") nil)))
+
+(ert-deftest s-present? ()
+ (should (equal (s-present? "") nil))
+ (should (equal (s-present? nil) nil))
+ (should (equal (s-present? " ") t)))
+
+(ert-deftest s-ends-with? ()
+ (should (equal (s-ends-with? ".md" "readme.md") t))
+ (should (equal (s-ends-with? ".MD" "readme.md") nil))
+ (should (equal (s-ends-with? ".MD" "readme.md" t) t))
+ (should (equal (s-ends-with? ".md" "md") nil))
+ (should (equal (s-suffix? ".md" "readme.md") t)))
+
+(ert-deftest s-starts-with? ()
+ (should (equal (s-starts-with? "lib/" "lib/file.js") t))
+ (should (equal (s-starts-with? "LIB/" "lib/file.js") nil))
+ (should (equal (s-starts-with? "LIB/" "lib/file.js" t) t))
+ (should (equal (s-starts-with? "lib/" "lib") nil))
+ (should (equal (s-prefix? "lib/" "lib/file.js") t)))
+
+(ert-deftest s-contains? ()
+ (should (equal (s-contains? "file" "lib/file.js") t))
+ (should (equal (s-contains? "nope" "lib/file.js") nil))
+ (should (equal (s-contains? "^a" "it's not ^a regexp") t))
+ (should (equal (s-contains? "FILE" "lib/file.js") nil))
+ (should (equal (s-contains? "FILE" "lib/file.js" t) t)))
+
+(ert-deftest s-lowercase? ()
+ (should (equal (s-lowercase? "file") t))
+ (should (equal (s-lowercase? "File") nil))
+ (should (equal (s-lowercase? "filä") t))
+ (should (equal (s-lowercase? "filÄ") nil))
+ (should (equal (s-lowercase? "123?") t)))
+
+(ert-deftest s-uppercase? ()
+ (should (equal (s-uppercase? "HULK SMASH") t))
+ (should (equal (s-uppercase? "Bruce no smash") nil))
+ (should (equal (s-uppercase? "FöB") nil))
+ (should (equal (s-uppercase? "FÖB") t))
+ (should (equal (s-uppercase? "123?") t)))
+
+(ert-deftest s-mixedcase? ()
+ (should (equal (s-mixedcase? "HULK SMASH") nil))
+ (should (equal (s-mixedcase? "Bruce no smash") t))
+ (should (equal (s-mixedcase? "BRÜCE") nil))
+ (should (equal (s-mixedcase? "BRüCE") t))
+ (should (equal (s-mixedcase? "123?") nil)))
+
+(ert-deftest s-capitalized? ()
+ (should (equal (s-capitalized? "Capitalized") t))
+ (should (equal (s-capitalized? "I am capitalized") t))
+ (should (equal (s-capitalized? "I Am Titleized") nil))
+ (should (equal (s-capitalized? "lower") nil))
+ (should (equal (s-capitalized? "UPPER") nil))
+ (should (equal (s-capitalized? "Привет") t)))
+
+(ert-deftest s-numeric? ()
+ (should (equal (s-numeric? "123") t))
+ (should (equal (s-numeric? "onetwothree") nil))
+ (should (equal (s-numeric? "7a") nil))
+ (should (equal (s-numeric? "a89") nil)))
+
+(ert-deftest s-replace ()
+ (should (equal (s-replace "file" "nope" "lib/file.js") "lib/nope.js"))
+ (should (equal (s-replace "^a" "\\1" "it's not ^a regexp") "it's not \\1
regexp")))
+
+(ert-deftest s-replace-all ()
+ (should (equal (s-replace-all '(("lib" . "test") ("file" . "file_test"))
"lib/file.js") "test/file_test.js"))
+ (should (equal (s-replace-all '(("lib" . "test") ("test" . "lib"))
"lib/test.js") "test/lib.js")))
+
+(ert-deftest s-downcase ()
+ (should (equal (s-downcase "ABC") "abc")))
+
+(ert-deftest s-upcase ()
+ (should (equal (s-upcase "abc") "ABC")))
+
+(ert-deftest s-capitalize ()
+ (should (equal (s-capitalize "abc DEF") "Abc def"))
+ (should (equal (s-capitalize "abc.DEF") "Abc.def")))
+
+(ert-deftest s-titleize ()
+ (should (equal (s-titleize "abc DEF") "Abc Def"))
+ (should (equal (s-titleize "abc.DEF") "Abc.Def")))
+
+(ert-deftest s-with ()
+ (should (equal (s-with " hulk smash " s-trim s-upcase) "HULK SMASH"))
+ (should (equal (s-with "My car is a Toyota" (s-replace "car" "name")
(s-replace "a Toyota" "Bond") (s-append ", James Bond")) "My name is Bond,
James Bond"))
+ (should (equal (s-with "abc \ndef \nghi" s-lines (mapcar 's-trim) (s-join
"-") s-reverse) "ihg-fed-cba")))
+
+(ert-deftest s-index-of ()
+ (should (equal (s-index-of "abc" "abcdef") 0))
+ (should (equal (s-index-of "CDE" "abcdef" t) 2))
+ (should (equal (s-index-of "n.t" "not a regexp") nil)))
+
+(ert-deftest s-reverse ()
+ (should (equal (s-reverse "abc") "cba"))
+ (should (equal (s-reverse "ab xyz") "zyx ba"))
+ (should (equal (s-reverse "") "")))
+
+(ert-deftest s-presence ()
+ (should (equal (s-presence nil) nil))
+ (should (equal (s-presence "") nil))
+ (should (equal (s-presence "foo") "foo")))
+
+(ert-deftest s-format ()
+ ;; One with an alist works
+ (should (equal (s-format
+ "help ${name}! I'm ${malady}"
+ 'aget
+ '(("name" . "nic") ("malady" . "on fire"))) "help nic! I'm
on fire"))
+
+ ;; One with a function works
+ (should (equal (s-format "hello ${name}, nice day" (lambda (var-name)
"nic")) "hello nic, nice day"))
+
+ ;; One with a list works
+ (should (equal (s-format "hello $0, nice $1" 'elt '("nic" "day")) "hello
nic, nice day"))
+
+ ;; Two with a hash-table works
+ (should (equal (s-format
+ "help ${name}! I'm ${malady}"
+ 'gethash
+ #s(hash-table test equal data ("name" "nic" "malady" "on
fire"))) "help nic! I'm on fire"))
+
+ ;; Replacing case has no effect on s-format
+ (should (equal (let ((case-replace t))
+ (s-format "help ${NAME}!" 'aget '(("NAME" . "Nick"))))
"help Nick!"))
+
+ (should (equal (let ((case-replace nil))
+ (s-format "help ${NAME}!" 'aget '(("NAME" . "Nick"))))
"help Nick!"))
+
+ (should (equal (let ((case-replace nil))
+ (s-format "help ${name}!" 'aget '(("name" . "Nick"))))
"help Nick!"))
+
+ ;; What happens when we have literal slashes?
+ (should (equal (s-format "$0" 'elt '("Hello\\nWorld")) "Hello\\nWorld"))
+
+ ;; What happens when we don't have the elements? with hash...
+ (should (equal (condition-case err
+ (s-format
+ "help ${name}! I'm ${malady}"
+ 'gethash
+ #s(hash-table test equal data ("name" "nic" )))
+ (s-format-resolve (car err))) 's-format-resolve)))
+
+(ert-deftest s-lex-format ()
+ ;; lexical stuff
+ (should (equal (let ((x 1))
+ (s-lex-format "x is ${x}")) "x is 1"))
+
+ (should (equal (let ((str1 "this")
+ (str2 "that"))
+ (s-lex-format "${str1} and ${str2}")) "this and that"))
+
+ ;; Have a litteral \ in the replacement
+ (should (equal (let ((foo "Hello\\nWorld"))
+ (s-lex-format "${foo}")) "Hello\\nWorld"))
+ )
+
+(ert-deftest s-count-matches ()
+ (should (equal (s-count-matches "a" "aba") 2))
+ (should (equal (s-count-matches "a" "aba" 0 2) 1))
+ (should (equal (s-count-matches "\\w\\{2\\}[0-9]+" "ab1bab2frobinator") 2)))
+
+(ert-deftest s-split-words ()
+ (should (equal (s-split-words "under_score") '("under" "score")))
+ (should (equal (s-split-words "some-dashed-words") '("some" "dashed"
"words")))
+ (should (equal (s-split-words "evenCamelCase") '("even" "Camel" "Case")))
+ (should (equal (s-split-words "!map (fn list)") '("map" "fn" "list")))
+ (should (equal (s-split-words "Привет, мир") '("Привет" "мир")))
+ (should (equal (s-split-words "e é è e") '("e" "é" "è" "e")))
+ (should (equal (s-split-words "MANYUpperCases") '("MANY" "Upper" "Cases")))
+ (should (equal (s-split-words "Приве́т") '("Приве́т")))
+ (should (equal (s-split-words "漢語") '("漢語"))))
+
+(ert-deftest s-lower-camel-case ()
+ (should (equal (s-lower-camel-case "some words") "someWords"))
+ (should (equal (s-lower-camel-case "dashed-words") "dashedWords"))
+ (should (equal (s-lower-camel-case "under_scored_words")
"underScoredWords")))
+
+(ert-deftest s-upper-camel-case ()
+ (should (equal (s-upper-camel-case "some words") "SomeWords"))
+ (should (equal (s-upper-camel-case "dashed-words") "DashedWords"))
+ (should (equal (s-upper-camel-case "under_scored_words")
"UnderScoredWords")))
+
+(ert-deftest s-snake-case ()
+ (should (equal (s-snake-case "some words") "some_words"))
+ (should (equal (s-snake-case "dashed-words") "dashed_words"))
+ (should (equal (s-snake-case "camelCasedWords") "camel_cased_words")))
+
+(ert-deftest s-dashed-words ()
+ (should (equal (s-dashed-words "some words") "some-words"))
+ (should (equal (s-dashed-words "under_scored_words") "under-scored-words"))
+ (should (equal (s-dashed-words "camelCasedWords") "camel-cased-words")))
+
+(ert-deftest s-capitalized-words ()
+ (should (equal (s-capitalized-words "some words") "Some words"))
+ (should (equal (s-capitalized-words "under_scored_words") "Under scored
words"))
+ (should (equal (s-capitalized-words "camelCasedWords") "Camel cased words")))
+
+(ert-deftest s-titleized-words ()
+ (should (equal (s-titleized-words "some words") "Some Words"))
+ (should (equal (s-titleized-words "under_scored_words") "Under Scored
Words"))
+ (should (equal (s-titleized-words "camelCasedWords") "Camel Cased Words")))
+
+(ert-deftest s-word-initials ()
+ (should (equal (s-word-initials "some words") "sw"))
+ (should (equal (s-word-initials "under_scored_words") "usw"))
+ (should (equal (s-word-initials "camelCasedWords") "cCW"))
+ (should (equal (s-word-initials "dashed-words") "dw")))
+
diff --git a/tests/s.el b/tests/s.el
new file mode 100644
index 0000000..e2973fc
--- /dev/null
+++ b/tests/s.el
@@ -0,0 +1,571 @@
+;;; IMPORTANT!!!
+
+;; The following file is meant for testing, not usage! It has been
+;; heavily modified, so the original author should not be blaimed (or
+;; even bothered) by any bug that happens to be in this version.
+
+;;; s.el --- The long lost Emacs string manipulation library.
+
+;; Copyright (C) 2012 Magnar Sveen
+
+;; Author: Magnar Sveen <magnars@gmail.com>
+;; Version: 1.9.0
+;; Keywords: strings
+
+;; 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 long lost Emacs string manipulation library.
+;;
+;; See documentation on https://github.com/magnars/s.el#functions
+
+;;; Code:
+
+(eval-when-compile (require 'names))
+
+(define-namespace s-
+
+(defun trim-left (s)
+ "Remove whitespace at the beginning of S."
+ (if (string-match "\\`[ \t\n\r]+" s)
+ (replace-match "" t t s)
+ s))
+
+(defun trim-right (s)
+ "Remove whitespace at the end of S."
+ (if (string-match "[ \t\n\r]+\\'" s)
+ (replace-match "" t t s)
+ s))
+
+(defun trim (s)
+ "Remove whitespace at the beginning and end of S."
+ (trim-left (trim-right s)))
+
+(defun collapse-whitespace (s)
+ "Convert all adjacent whitespace characters to a single space."
+ (replace-regexp-in-string "[ \t\n\r]+" " " s))
+
+(defun split (separator s &optional omit-nulls)
+ "Split S into substrings bounded by matches for regexp SEPARATOR.
+If OMIT-NULLS is non-nil, zero-length substrings are omitted.
+
+This is a simple wrapper around the built-in `split-string'."
+ (split-string s separator omit-nulls))
+
+(defun lines (s)
+ "Splits S into a list of strings on newline characters."
+ (split "\\(\r\n\\|[\n\r]\\)" s))
+
+(defun join (separator strings)
+ "Join all the strings in STRINGS with SEPARATOR in between."
+ (mapconcat 'identity strings separator))
+
+(defun concat (&rest strings)
+ "Join all the string arguments into one string."
+ (apply 'concat strings))
+
+(defun prepend (prefix s)
+ "Concatenate PREFIX and S."
+ (concat prefix s))
+
+(defun append (suffix s)
+ "Concatenate S and SUFFIX."
+ (concat s suffix))
+
+(defun repeat (num s)
+ "Make a string of S repeated NUM times."
+ (let (ss)
+ (while (> num 0)
+ (setq ss (cons s ss))
+ (setq num (1- num)))
+ (apply 'concat ss)))
+
+(defun chop-suffix (suffix s)
+ "Remove SUFFIX if it is at end of S."
+ (let ((pos (- (length suffix))))
+ (if (and (>= (length s) (length suffix))
+ (string= suffix (substring s pos)))
+ (substring s 0 pos)
+ s)))
+
+(defun chop-suffixes (suffixes s)
+ "Remove SUFFIXES one by one in order, if they are at the end of S."
+ (while suffixes
+ (setq s (chop-suffix (car suffixes) s))
+ (setq suffixes (cdr suffixes)))
+ s)
+
+(defun chop-prefix (prefix s)
+ "Remove PREFIX if it is at the start of S."
+ (let ((pos (length prefix)))
+ (if (and (>= (length s) (length prefix))
+ (string= prefix (substring s 0 pos)))
+ (substring s pos)
+ s)))
+
+(defun chop-prefixes (prefixes s)
+ "Remove PREFIXES one by one in order, if they are at the start of S."
+ (while prefixes
+ (setq s (chop-prefix (car prefixes) s))
+ (setq prefixes (cdr prefixes)))
+ s)
+
+(defun shared-start (s1 s2)
+ "Returns the longest prefix S1 and S2 have in common."
+ (let ((search-length (min (length s1) (length s2)))
+ (i 0))
+ (while (and (< i search-length)
+ (= (aref s1 i) (aref s2 i)))
+ (setq i (1+ i)))
+ (substring s1 0 i)))
+
+(defun shared-end (s1 s2)
+ "Returns the longest suffix S1 and S2 have in common."
+ (let* ((l1 (length s1))
+ (l2 (length s2))
+ (search-length (min l1 l2))
+ (i 0))
+ (while (and (< i search-length)
+ (= (aref s1 (- l1 i 1)) (aref s2 (- l2 i 1))))
+ (setq i (1+ i)))
+ ;; If I is 0, then it means that there's no common suffix between
+ ;; S1 and S2.
+ ;;
+ ;; However, since (substring s (- 0)) will return the whole
+ ;; string, `s-shared-end' should simply return the empty string
+ ;; when I is 0.
+ (if (zerop i)
+ ""
+ (substring s1 (- i)))))
+
+(defun chomp (s)
+ "Remove one trailing `\\n`, `\\r` or `\\r\\n` from S."
+ (chop-suffixes '("\n" "\r") s))
+
+(defun truncate (len s)
+ "If S is longer than LEN, cut it down to LEN - 3 and add ... at the end."
+ (if (> (length s) len)
+ (::format "%s..." (substring s 0 (- len 3)))
+ s))
+
+(defun word-wrap (len s)
+ "If S is longer than LEN, wrap the words with newlines."
+ (with-temp-buffer
+ (insert s)
+ (let ((fill-column len))
+ (fill-region (point-min) (point-max)))
+ (buffer-substring-no-properties (point-min) (point-max))))
+
+(defun center (len s)
+ "If S is shorter than LEN, pad it with spaces so it is centered."
+ (let ((extra (max 0 (- len (length s)))))
+ (concat
+ (make-string (ceiling extra 2) ? )
+ s
+ (make-string (floor extra 2) ? ))))
+
+(defun pad-left (len padding s)
+ "If S is shorter than LEN, pad it with PADDING on the left."
+ (let ((extra (max 0 (- len (length s)))))
+ (concat (make-string extra (string-to-char padding))
+ s)))
+
+(defun pad-right (len padding s)
+ "If S is shorter than LEN, pad it with PADDING on the right."
+ (let ((extra (max 0 (- len (length s)))))
+ (concat s
+ (make-string extra (string-to-char padding)))))
+
+(defun left (len s)
+ "Returns up to the LEN first chars of S."
+ (if (> (length s) len)
+ (substring s 0 len)
+ s))
+
+(defun right (len s)
+ "Returns up to the LEN last chars of S."
+ (let ((l (length s)))
+ (if (> l len)
+ (substring s (- l len) l)
+ s)))
+
+(defun ends-with? (suffix s &optional ignore-case)
+ "Does S end with SUFFIX?
+
+If IGNORE-CASE is non-nil, the comparison is done without paying
+attention to case differences.
+
+Alias: `s-suffix?'"
+ (let ((start-pos (- (length s) (length suffix))))
+ (and (>= start-pos 0)
+ (eq t (compare-strings suffix nil nil
+ s start-pos nil ignore-case)))))
+
+(defalias 's-ends-with-p #'ends-with?)
+
+(defun starts-with? (prefix s &optional ignore-case)
+ "Does S start with PREFIX?
+
+If IGNORE-CASE is non-nil, the comparison is done without paying
+attention to case differences.
+
+Alias: `s-prefix?'. This is a simple wrapper around the built-in
+`string-prefix-p'."
+ (string-prefix-p prefix s ignore-case))
+
+(defalias 's-starts-with-p #'starts-with?)
+
+(defalias 's-suffix? #'ends-with?)
+(defalias 's-prefix? #'starts-with?)
+(defalias 's-suffix-p #'ends-with?)
+(defalias 's-prefix-p #'starts-with?)
+
+(defun -truthy? (val)
+ (not (null val)))
+
+(defun contains? (needle s &optional ignore-case)
+ "Does S contain NEEDLE?
+
+If IGNORE-CASE is non-nil, the comparison is done without paying
+attention to case differences."
+ (let ((case-fold-search ignore-case))
+ (-truthy? (string-match-p (regexp-quote needle) s))))
+
+(defalias 's-contains-p #'contains?)
+
+(defun equals? (s1 s2)
+ "Is S1 equal to S2?
+
+This is a simple wrapper around the built-in `string-equal'."
+ (string-equal s1 s2))
+
+(defalias 's-equals-p #'equals?)
+
+(defun less? (s1 s2)
+ "Is S1 less than S2?
+
+This is a simple wrapper around the built-in `string-lessp'."
+ (string-lessp s1 s2))
+
+(defalias 's-less-p #'less?)
+
+(defun matches? (regexp s &optional start)
+ "Does REGEXP match S?
+If START is non-nil the search starts at that index.
+
+This is a simple wrapper around the built-in `string-match-p'."
+ (-truthy? (string-match-p regexp s start)))
+
+(defalias 's-matches-p #'matches?)
+
+(defun blank? (s)
+ "Is S nil or the empty string?"
+ (or (null s) (string= "" s)))
+
+(defun present? (s)
+ "Is S anything but nil or the empty string?"
+ (not (blank? s)))
+
+(defun presence (s)
+ "Return S if it's `s-present?', otherwise return nil."
+ (and (present? s) s))
+
+(defun lowercase? (s)
+ "Are all the letters in S in lower case?"
+ (let ((case-fold-search nil))
+ (not (string-match-p "[[:upper:]]" s))))
+
+(defun uppercase? (s)
+ "Are all the letters in S in upper case?"
+ (let ((case-fold-search nil))
+ (not (string-match-p "[[:lower:]]" s))))
+
+(defun mixedcase? (s)
+ "Are there both lower case and upper case letters in S?"
+ (let ((case-fold-search nil))
+ (-truthy?
+ (and (string-match-p "[[:lower:]]" s)
+ (string-match-p "[[:upper:]]" s)))))
+
+(defun capitalized? (s)
+ "In S, is the first letter upper case, and all other letters lower case?"
+ (let ((case-fold-search nil))
+ (-truthy?
+ (string-match-p "^[[:upper:]][^[:upper:]]*$" s))))
+
+(defun numeric? (s)
+ "Is S a number?"
+ (-truthy?
+ (string-match-p "^[0-9]+$" s)))
+
+(defun replace (old new s)
+ "Replaces OLD with NEW in S."
+ (replace-regexp-in-string (regexp-quote old) new s t t))
+
+(defun -aget (alist key)
+ (cdr (assoc key alist)))
+
+(defun replace-all (replacements s)
+ "REPLACEMENTS is a list of cons-cells. Each `car` is replaced with `cdr` in
S."
+ (replace-regexp-in-string (regexp-opt (mapcar 'car replacements))
+ (lambda (it) (-aget replacements it))
+ s))
+
+(defun downcase (s)
+ "Convert S to lower case.
+
+This is a simple wrapper around the built-in `downcase'."
+ (::downcase s))
+
+(defun upcase (s)
+ "Convert S to upper case.
+
+This is a simple wrapper around the built-in `upcase'."
+ (::upcase s))
+
+(defun capitalize (s)
+ "Convert the first word's first character to upper case and the rest to
lower case in S."
+ (concat (upcase (substring s 0 1)) (downcase (substring s 1))))
+
+(defun titleize (s)
+ "Convert each word's first character to upper case and the rest to lower
case in S.
+
+This is a simple wrapper around the built-in `capitalize'."
+ (::capitalize s))
+
+
+(defmacro with (s form &rest more)
+ "Threads S through the forms. Inserts S as the last item
+in the first form, making a list of it if it is not a list
+already. If there are more forms, inserts the first form as the
+last item in second form, etc."
+ (declare (debug (form &rest [&or (function &rest form) fboundp])))
+ (if (null more)
+ (if (listp form)
+ `(,(car form) ,@(cdr form) ,s)
+ (list form s))
+ `(s-with (s-with ,s ,form) ,@more)))
+
+(put 's-with 'lisp-indent-function 1)
+
+(defun index-of (needle s &optional ignore-case)
+ "Returns first index of NEEDLE in S, or nil.
+
+If IGNORE-CASE is non-nil, the comparison is done without paying
+attention to case differences."
+ (let ((case-fold-search ignore-case))
+ (string-match-p (regexp-quote needle) s)))
+
+(defun reverse (s) ;; from org-babel-reverse-string
+ "Return the reverse of S."
+ (apply 'string (nreverse (string-to-list s))))
+
+(defun match-strings-all (regex string)
+ "Return a list of matches for REGEX in STRING.
+
+Each element itself is a list of matches, as per
+`match-string'. Multiple matches at the same position will be
+ignored after the first."
+ (let ((all-strings ())
+ (i 0))
+ (while (and (< i (length string))
+ (string-match regex string i))
+ (setq i (1+ (match-beginning 0)))
+ (let (strings
+ (num-matches (/ (length (match-data)) 2))
+ (match 0))
+ (while (/= match num-matches)
+ (push (match-string match string) strings)
+ (setq match (1+ match)))
+ (push (nreverse strings) all-strings)))
+ (nreverse all-strings)))
+
+(defun match (regexp s &optional start)
+ "When the given expression matches the string, this function returns a list
+of the whole matching string and a string for each matched subexpressions.
+If it did not match the returned value is an empty list (nil).
+
+When START is non-nil the search will start at that index."
+ (save-match-data
+ (if (string-match regexp s start)
+ (let ((match-data-list (match-data))
+ result)
+ (while match-data-list
+ (let* ((beg (car match-data-list))
+ (end (cadr match-data-list))
+ (subs (if (and beg end) (substring s beg end) nil)))
+ (setq result (cons subs result))
+ (setq match-data-list
+ (cddr match-data-list))))
+ (nreverse result)))))
+
+(defun slice-at (regexp s)
+ "Slices S up at every index matching REGEXP."
+ (save-match-data
+ (let (i)
+ (setq i (string-match regexp s 1))
+ (if i
+ (cons (substring s 0 i)
+ (slice-at regexp (substring s i)))
+ (list s)))))
+
+(defun split-words (s)
+ "Split S into list of words."
+ (split
+ "[^[:word:]0-9]+"
+ (let ((case-fold-search nil))
+ (replace-regexp-in-string
+ "\\([[:lower:]]\\)\\([[:upper:]]\\)" "\\1 \\2"
+ (replace-regexp-in-string
"\\([[:upper:]]\\)\\([[:upper:]][0-9[:lower:]]\\)" "\\1 \\2" s)))
+ t))
+
+(defun -mapcar-head (fn-head fn-rest list)
+ "Like MAPCAR, but applies a different function to the first element."
+ (if list
+ (cons (funcall fn-head (car list)) (mapcar fn-rest (cdr list)))))
+
+(defun lower-camel-case (s)
+ "Convert S to lowerCamelCase."
+ (join "" (-mapcar-head 'downcase 'capitalize (split-words s))))
+
+(defun upper-camel-case (s)
+ "Convert S to UpperCamelCase."
+ (join "" (mapcar 'capitalize (split-words s))))
+
+(defun snake-case (s)
+ "Convert S to snake_case."
+ (join "_" (mapcar 'downcase (split-words s))))
+
+(defun dashed-words (s)
+ "Convert S to dashed-words."
+ (join "-" (mapcar 'downcase (split-words s))))
+
+(defun capitalized-words (s)
+ "Convert S to Capitalized words."
+ (let ((words (split-words s)))
+ (join " " (cons (::capitalize (car words)) (mapcar 'downcase (cdr
words))))))
+
+(defun titleized-words (s)
+ "Convert S to Titleized Words."
+ (join " " (mapcar 's-titleize (split-words s))))
+
+(defun word-initials (s)
+ "Convert S to its initials."
+ (join "" (mapcar (lambda (ss) (substring ss 0 1))
+ (split-words s))))
+
+;; Errors for s-format
+(progn
+ (put 's-format-resolve
+ 'error-conditions
+ '(error s-format s-format-resolve))
+ (put 's-format-resolve
+ 'error-message
+ "Cannot resolve a template to values"))
+
+(defun format (template replacer &optional extra)
+ "Format TEMPLATE with the function REPLACER.
+
+REPLACER takes an argument of the format variable and optionally
+an extra argument which is the EXTRA value from the call to
+`s-format'.
+
+Several standard `s-format' helper functions are recognized and
+adapted for this:
+
+ (s-format \"${name}\" 'gethash hash-table)
+ (s-format \"${name}\" 'aget alist)
+ (s-format \"$0\" 'elt sequence)
+
+The REPLACER function may be used to do any other kind of
+transformation."
+ (let ((saved-match-data (match-data)))
+ (unwind-protect
+ (replace-regexp-in-string
+ "\\$\\({\\([^}]+\\)}\\|[0-9]+\\)"
+ (lambda (md)
+ (let ((var
+ (let ((m (match-string 2 md)))
+ (if m m
+ (string-to-number (match-string 1 md)))))
+ (replacer-match-data (match-data)))
+ (unwind-protect
+ (let ((v
+ (cond
+ ((eq replacer 'gethash)
+ (funcall replacer var extra))
+ ((eq replacer 'aget)
+ (funcall 's--aget extra var))
+ ((eq replacer 'elt)
+ (funcall replacer extra var))
+ (t
+ (set-match-data saved-match-data)
+ (if extra
+ (funcall replacer var extra)
+ (funcall replacer var))))))
+ (if v v (signal 's-format-resolve md)))
+ (set-match-data replacer-match-data)))) template
+ ;; Need literal to make sure it works
+ t t)
+ (set-match-data saved-match-data))))
+
+(defvar lex-value-as-lisp nil
+ "If `t' interpolate lisp values as lisp.
+
+`s-lex-format' inserts values with (format \"%S\").")
+
+(defun lex-fmt|expand (fmt)
+ "Expand FMT into lisp."
+ (list 's-format fmt (quote 'aget)
+ (::append '(list)
+ (mapcar
+ (lambda (matches)
+ (list
+ 'cons
+ (cadr matches)
+ `(format
+ (if s-lex-value-as-lisp "%S" "%s")
+ ,(intern (cadr matches)))))
+ (match-strings-all "${\\([^}]+\\)}" fmt)))))
+
+(defmacro lex-format (format-str)
+ "`s-format` with the current environment.
+
+FORMAT-STR may use the `s-format' variable reference to refer to
+any variable:
+
+ (let ((x 1))
+ (s-lex-format \"x is: ${x}\"))
+
+The values of the variables are interpolated with \"%s\" unless
+the variable `s-lex-value-as-lisp' is `t' and then they are
+interpolated with \"%S\"."
+ (declare (debug (form)))
+ (lex-fmt|expand format-str))
+
+(defun count-matches (regexp s &optional start end)
+ "Count occurrences of `regexp' in `s'.
+
+`start', inclusive, and `end', exclusive, delimit the part of `s'
+to match. "
+ (with-temp-buffer
+ (insert s)
+ (goto-char (point-min))
+ (::count-matches regexp (or start 1) (or end (point-max)))))
+
+)
+
+(provide 's)
+;;; s.el ends here
diff --git a/tests/test.tex b/tests/test.tex
new file mode 100644
index 0000000..735eb66
--- /dev/null
+++ b/tests/test.tex
@@ -0,0 +1,40 @@
+\documentclass{book}
+
+\begin{document}
+\begin{abstract}
+ lorem ipsum lorem ipsum lorem ipsum lorem ipsum lorem ipsum lorem ipsum
lorem ipsum lorem ipsum lorem ipsum lorem ipsum lorem ipsum lorem ipsum lorem
ipsum lorem ipsum lorem ipsum lorem ipsum lorem ipsum lorem ipsum lorem ipsum
lorem ipsum lorem ipsum lorem ipsum lorem ipsum lorem ipsum lorem ipsum lorem
ipsum
+\end{abstract}
+
+\chapter{7}
+\label{cha:7}
+\begin{equation}
+ \label{eq:1}
+ okok
+\end{equation}
+
+\section{1}
+\label{sec:1}
+
+lorem ipsum lorem ipsum lorem ipsum lorem ipsum lorem ipsum lorem ipsum lorem
ipsum lorem ipsum lorem ipsum lorem ipsum lorem ipsum lorem ipsum lorem ipsum
lorem ipsum lorem ipsum lorem ipsum lorem ipsum lorem ipsum lorem ipsum lorem
ipsum lorem ipsum lorem ipsum lorem ipsum lorem ipsum lorem ipsum lorem ipsum
+
+\section{2}
+\label{sec:2}
+
+\subsection{3}
+\label{sec:3}
+
+\subsubsection{5}
+\label{sec:5}
+
+\subsection{4}
+\label{sec:4}
+
+\appendix
+
+\chapter{8}
+\label{cha:8}
+
+\section{6}
+\label{sec:6}
+
+\end{document}
diff --git a/tests/tests.el b/tests/tests.el
new file mode 100755
index 0000000..1cbbd81
--- /dev/null
+++ b/tests/tests.el
@@ -0,0 +1,20 @@
+(unless (fboundp 'function-put)
+ (defalias 'function-put
+ ;; We don't want people to just use `put' because we can't conveniently
+ ;; hook into `put' to remap old properties to new ones. But for now,
there's
+ ;; no such remapping, so we just call `put'.
+ #'(lambda (f prop value) (put f prop value))
+ "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."))
+
+(progn
+ (add-to-list 'load-path (expand-file-name "../"))
+ (add-to-list 'load-path (expand-file-name "./"))
+ (byte-compile-file (expand-file-name "../names.el"))
+ (require 'ert)
+ (fset 'ert--print-backtrace 'ignore)
+;; (require 'names)
+ ;; (setq debug-on-error t)
+ ;; (setq byte-compile-debug t)
+ )
- [elpa] externals/names ca0f397 15/44: Travis badge, (continued)
- [elpa] externals/names ca0f397 15/44: Travis badge, Stefan Monnier, 2021/03/27
- [elpa] externals/names 1587d24 29/44: Stop testing 23.4, Stefan Monnier, 2021/03/27
- [elpa] externals/names 097dc46 30/44: Update usage example, Stefan Monnier, 2021/03/27
- [elpa] externals/names 374c903 31/44: Merge branch 'elpa' into dev, Stefan Monnier, 2021/03/27
- [elpa] externals/names 82f12ac 17/44: Merge branch 'elpa' into dev, Stefan Monnier, 2021/03/27
- [elpa] externals/names b488dde 24/44: Merge branch 'dev', Stefan Monnier, 2021/03/27
- [elpa] externals/names 787c1f1 26/44: Merge branch 'dev', Stefan Monnier, 2021/03/27
- [elpa] externals/names d8baba5 43/44: Merge pull request #30 from jabranham/byte-compiler-warns, Stefan Monnier, 2021/03/27
- [elpa] externals/names 00862c5 38/44: Merge branch 'dev', Stefan Monnier, 2021/03/27
- [elpa] externals/names 1d45ec5 41/44: Merge branch 'elpa', Stefan Monnier, 2021/03/27
- [elpa] externals/names b269f61 44/44: Merge remote-tracking branch 'upstream/names/main' into externals/names,
Stefan Monnier <=
- [elpa] externals/names 48ed6aa 03/44: Merge branch 'elpa' into dev, Stefan Monnier, 2021/03/27
- [elpa] externals/names e2c0bd9 13/44: Merge branch 'elpa' into dev, Stefan Monnier, 2021/03/27
- [elpa] externals/names 9ebceab 39/44: Add file tests/.nosearch, Stefan Monnier, 2021/03/27
- [elpa] externals/names 7cad62b 42/44: Silence the byte compiler, Stefan Monnier, 2021/03/27
- [elpa] externals/names 7663049 12/44: Merge branch 'elpa' into dev, Stefan Monnier, 2021/03/27
- [elpa] externals/names 6fa3bc1 14/44: Merge branch 'elpa' into dev, Stefan Monnier, 2021/03/27
- [elpa] externals/names eca83e8 19/44: Merge branch 'elpa' into dev, Stefan Monnier, 2021/03/27
- [elpa] externals/names 3ed0901 21/44: Merge branch 'elpa' into dev, Stefan Monnier, 2021/03/27
- [elpa] externals/names a6932f0 27/44: Merge branch 'elpa' into dev, Stefan Monnier, 2021/03/27
- [elpa] externals/names a36b4b3 35/44: Update Readme.org, Stefan Monnier, 2021/03/27